-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X ** * ***** ** * *** ** * ** *** * * ********* X * * * * * **** ** ** *** * *** * * * * *`20 X* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *`20 $ CALL UNPACK ASTEROIDS.DAT;1 168427520 $ create 'f' X`7B Copyright * Asteroids * by Graham Joyce and Stefan Spadoni . `7D X XPROGRAM Asteroids(Input,Output, help_file, Data_file); X X`7B this is a scaled down version of asteroids, whith the added extra of a`2 V0 X greebie shooting missiles at you as well. The game was created by`20 X Graham Joyce, and was modified to it's present state by Stefan Spadoni. `7 VD X XLABEL X`091; XCONST X`09Esc`09`09`09= Chr(27); X`09Bell`09`09`09= Chr(7); X`09White_100`09`09= ''(27)'`5B?5h'; X`09Black_100`09`09= ''(27)'`5B?5l'; X`09Home_100`09`09= ''(27)'`5BH'; X`09Clear_100`09`09= ''(27)'`5B2J'; X`09Jump_100`09`09= ''(27)'`5B?4l'; X`09Home_52`09`09`09= ''(27)'H'; X`09Clear_52`09`09= ''(27)'J'; X`09VT52`09`09`09= ''(27)'`5B?2l'; X`09Ansi_Mode `09`09= ''(27)'<'; X`09Line`09`09`09= ''(13)''(10)''; X`09Place`09`09`09= ''(27)'`5B23;0H'; X `09Large_100`09`09= ''(27)'#6'; X`09Scroll_Region `09`09= ''(27)'`5B1;23r'; X X`09Blank `09`09`09= ' '; X`09Star `09`09`09= '*'; X`09Player `09`09`09= 'V'; X`09Greebie `09`09= '#'; X`09Missile `09`09= '!'; X X`09Max_right `09`09= 39; X`09Min_left `09`09= 2; X`09Centre `09`09= 20; X`09Left `09`09`09= -1; X`09Right `09`09`09= +1; X`09Down `09`09`09= 0; X`09Min_player_row`09`09= 5; X XTYPE X`09Num_of_Line`09`09= 1 .. 150; X`09Num_of_Char`09`09= 1 .. 60; X X`09Screen_Line `09`09= Packed Array `5B -6 .. 46 `5D Of Char; X X`09Buffer_St`09`09= Packed Array`5B1..256`5D Of Char; X X`09Buffer_Rec`09`09= Record X`09`09`09`09`09Len`09: Integer; X`09`09`09`09`09String`09: Buffer_St; X`09`09`09`09End; X X XVAR X`09Data_file, X`09help_file`09`09: Text; X X`09Stars_Line`09`09: Packed Array `5B Num_of_line , X`09`09`09`09`09`09 Num_of_Char `5D of Char; X X`09Seed `09`09`09: Real; X X`09Char_String`09`09: Varying `5B150`5D Of Char; X X`09ch `09`09`09: packed array `5B1..7`5D of char; X X `09Out`09`09`09: Buffer_Rec; X X`09Shot_Going, X`09Back_Thrust, X`09Greebie_Dead ,`20 X`09Dead `09`09`09: Boolean; X X`09Answer `09`09`09: Char; X X`09Time_out, X`09Score, X`09Sector ,`20 X `09Field ,`20 X`09Ext_Move ,`20 X`09Greebie_Pos ,`20 X`09Shot_Row ,`20 X`09Down_Count , X`09Player_col ,`20 X`09Player_Row, X`09Test_Num, X`09Moves ,`20 X`09This_Move `09`09: Integer; X X`09Screen `09`09`09: Packed Array `5B 0 .. 26 `5D Of Screen_Line; X X`7B Here end declerations , procedures and functions related to util/lib beg Vin `7D X XPROCEDURE Sleep( Seconds : Integer); Extern; X XPROCEDURE Sleep_Set( Efn , Sec : Integer ); Extern; X XPROCEDURE Sleep_Start; Extern; X XPROCEDURE Sleep_Wait; Extern; X X`5B asynchronous,unbound`5D XPROCEDURE TT_Write( Var Buff : Buffer_St; Var Len : Integer); Extern; X XPROCEDURE Image_Dir; Extern; X XPROCEDURE TT_Init( One : Integer); Extern; X XFUNCTION TT_1_Char_Now: Char; Extern; X XFUNCTION TT_1_Char: Char; extern; X XFUNCTION Random( lb,ub : Integer):integer; X X`09FUNCTION Mth$Random( Var Seed : Real):Real;extern; X XBegin X`09Random := lb + Trunc(Mth$Random(Seed)*(ub-lb+1)); X XEnd; `7B random `7D X XPROCEDURE Break; X XBegin X `09TT_write(out.string,out.len); X `09out.len := 0; X XEnd; `7B break `7D X XProcedure At( row , Col : integer); X XBegin X X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := Esc; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := 'Y'; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := Chr( 31 + Row); X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := Chr( 31 + Col); X XEnd; `7B at `7D X XPROCEDURE Write_1(ch1 : char); X XBegin X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch1; X XEnd; `7B Write_1 `7D X XPROCEDURE Write_3(ch1,ch2,ch3 : char); X XBegin X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch1; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch2; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch3; X XEnd; `7B Write_3 `7D X XPROCEDURE Write_6(ch1,ch2,ch3,ch4,ch5,ch6 : char); X XBegin X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch1; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch2; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch3; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch4; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch5; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch6; X XEnd; `7B Write_6 `7D X X XPROCEDURE write_ch(Row,Col : integer; ch1:char); X XBegin X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := Esc; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := 'Y'; X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := Chr( 31 + Row); X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := Chr( 31 + Col); X`09Out.len := Out.len + 1; X`09Out.String`5BOut.len`5D := ch1; X XEnd; `7B write_ch `7D X XPROCEDURE write_st( write_string : packed array`5Blb..ub:integer`5D of char) V; XVar X `09pos`09: integer; XBegin X `09for pos := 1 to ub do X `09`09out.string`5Bout.len+pos`5D := write_string`5Bpos`5D; X `09out.len := out.len + ub; X XEnd; `7B write_ch `7D X X`7B Main Procedures and Functions Begin Here V `7D X XPROCEDURE top_ten(score : integer ); extern; X`7B a fortran topten score table sub-program `7D X XFUNCTION Last_Score:Integer; Extern; X`7B a fortran function to return the score of an`20 X existing user `7D X XPROCEDURE Set_echo ( var file_var : text ; echo : boolean); Extern; X XPROCEDURE Calculate_score; X`7B obvious ... `7D XBegin X`09Score := ((((Sector * Sector) + (Field * 3))div 2)*3); X XEnd; `7B calculate_score `7D X XPROCEDURE Read_Help_File; X`7B introduce the instructions for playing the game `7D X Xvar X`09len`09`09: integer; X Help_Line `09: Varying `5B256`5D of Char; X XBegin X X`09TT_Init(1); X`09Image_Dir; X`09Out.len := 0; X`09Open(Help_File,'Image_Dir:Asteroids.scn',`20 X`09 History := Readonly, Error := Continue); X`09If Status(Help_File) = 0 Then X`09Begin X`09`09Reset(Help_File); X`09`09While Not Eof(Help_File) Do`20 X`09`09Begin X`09`09`09Readln(Help_File,Help_Line); X`09`09`09Len := Help_Line.Length; X`09`09`09TT_Write(Help_Line.Body,Len);`09 `20 X`09`09End; X`09End`20 X`09Else`20 X`09Begin X`09`09Write_st(' Can''t find help screen. Type to play '); X`09`09Break; X`09End; X`09TT_1_Char; `7B Wait til hit a char `7D X XEnd; `7BRead_Help_File `7D X XPROCEDURE Read_Data_File; X`7B read in data file `7D X Xvar X Help_Line `09: Varying `5B256`5D of Char; X`09line_num, X`09Char_num`09: integer; XBegin X X`09Out.len := 0; X`09Open(Data_file,'Image_Dir:Asteroids.dat',`20 X`09History := Readonly, Error := Continue); X`09If Status(Data_file) = 0 Then`20 X`09Begin X`09`09Reset(Data_file); X`09`09For line_num := 1 to 150 do`20 X`09`09Begin X`09`09`09Readln(Data_file,Help_Line); X`09`09`09For Char_num := 1 to 60 do X`09`09`09 stars_line`5B line_num , Char_num `5D := help_line`5B Char_num ` V5D ; X`09`09end X`09End`20 X`09Else`20 X`09Begin X`09`09write_st(line); X`09`09Write_st(' Can''t find Data File. Game Aborted !'); X`09`09Break;`09 X`09`09Goto 1; X`09End XEnd; `7B Read_Data_File `7D X`09 XPROCEDURE New_Star_Line; X`7B create a new string of stars and blacks `7D X XVar`20 X`09line_num, X`09Index_1, X`09Start_point, X`09index `09: integer; X`20 XBegin X`09IF Back_Thrust then X`09Begin X`09`09Player_Row := Player_Row - 1 ; X`09`09IF Player_Row < 5 then Player_Row := 5; X`09End X`09Else X`09Begin X`09`09For index :=3 To 22 Do Screen`5B index `5D := Screen`5B index + 1 `5D V ; X X`09`09write_st(ansi_mode); X`09`09write_st(place); X`09`09write_st(large_100); X`09`09write_st(vt52); X X`09 `09line_num :=Random( Sector + 1, Sector + Random( 1, 10)); X`09`09IF Line_num > 150 then Line_num := 150; X X`09 `09Start_point :=Random (1, 20); X X`09`09For Index := Start_point TO Start_point + 39 Do X`09`09`09screen`5B 23, Index - Start_point + 1`5D :=`20 X`09`09`09`09stars_line `5B line_num , index `5D; X X`09`09index := 0; X`09`09While index <= 39 do X`09`09Begin X`09`09`09Index := Index + 1; X X`09`09`09If screen `5B 23 , index`5D = star X`09`09`09 then write_ch(23,index,star); X X`09`09`09IF (Index < 39 )`20 X`09`09`09 And (screen `5B23 ,index`5D = Star) X`09`09`09 And (screen `5B23 ,index + 1`5D = Star) then`20 X`09`09`09 Begin X`09`09`09`09write_1(Star); X`09`09`09`09Index := Index + 1; X`09`09`09 End; X X`09`09`09IF (Index < 39 )`20 X`09`09`09 And (screen `5B23 ,index`5D = Star) X`09`09`09 And (screen `5B23 ,index + 1`5D = Blank) then`20 X`09`09`09 Begin X`09`09`09`09write_1(Blank); X`09`09`09`09Index := Index + 1; X`09`09`09 End; X`09`09End; X X`09`09Break; X`09End; `7B if not back thrust `7D X X`09IF Back_Thrust X`09 then write_ch(Player_Row + 1,Player_col,blank) X`09 Else write_ch(Player_Row,Player_col,blank); X`09Write_ch(3,greebie_pos,blank); X`09Write_ch(down_count,shot_row,blank); X X`09at(23,1); X`09IF not Back_Thrust then write_st(line); X X`09Back_Thrust := False; X X`09Break; X XEnd; `7B new_star_line`7D X XPROCEDURE Move_Player; X`7B get the next move from player and move the ship `7D X XBegin X X`09CASE TT_1_Char_Now OF X`09`09'1','4','7' : this_move := left; X X`09`09'2','5','8' : this_move := down; X X`09`09'3','6','9' : this_move := right; X X`09`09'0'`09`09: IF Player_Row > 5`20 X`09`09`09`09 then Back_Thrust := true; X X`09`09'Q','q','e','E' : dead := true; X`09`09otherwise this_move := this_move; X X`09end; `7B case `7D X X`09IF not Back_Thrust Then X`09Begin X`09`09Player_col := Player_col + this_move; X`09`09if Player_col < min_left then Player_col := min_left; X`09`09if Player_col > max_right then Player_col := max_right; X`09End; X X`09write_ch(Player_Row,Player_col,player); X Xend; `7B Move_Player `7D X XPROCEDURE check_dead; X`7B check if player has crashed against an asteroid `7D X XBegin X If screen`5BPlayer_row +1,Player_col`5D = star then dead := true; X XEnd; `7B check_dead `7D X XPROCEDURE Fire_part_1; X`7B part of the fire procedure below `7D X XBegin X`09IF shot_row < min_left then X`09 shot_row := min_left; X`09IF shot_row > max_right then X`09 shot_row := max_right; X`09down_count := down_count + 1; X`09case screen`5Bdown_count - 1,shot_row`5D of X`09blank : begin X`09`09`09IF screen`5Bdown_count, shot_row`5D = star then X`09`09`09Begin X`09`09`09`09shot_going := false; X`09`09`09`09screen`5Bdown_count, shot_row`5D := blank; X`09`09`09`09write_ch(down_count-1,shot_row,blank); X`09`09`09End X`09`09`09else X`09`09`09Begin X`09`09`09`09If down_count >= 23 then`20 X`09`09`09`09begin X`09`09`09`09`09Shot_going := false; X`09`09`09`09`09write_ch(down_count-2,shot_row,blank); X`09`09`09`09End X`09`09`09`09else X`09`09`09`09begin X`09`09`09`09`09write_ch(down_count,shot_row,missile); X`09`09`09`09end; X`09`09`09end X`09`09End;`09 X`09star : begin X`09`09`09write_ch(down_count-2,shot_row,blank); X`09`09`09screen`5Bdown_count - 1,shot_row`5D := blank; X`09`09`09shot_going := false; X`09`09end; X`09OtherWise write_ch(down_count,shot_row,missile); X X`09End; `7B case `7D X`09if ( down_count = Player_Row) AND X`09 (shot_going) AND X `09 (shot_row = Player_col) then`20 X`09begin`20 X`09`09dead := true; X`09`09shot_going := false; X`09end; X X`09If not shot_going then shot_row := 0; X XEnd; `7B fire part 1 `7D X X XPROCEDURE fire_a_shot; X`7B fire a new shot if one is not yet going X and calculate if missile has hit anything `7D XVar`20 X`09Choise : integer; XBegin`20 X`09IF not dead then X`09Begin X`09`09if not shot_going then X`09`09begin X`09`09`09down_count := 3; X`09`09`09shot_going := true; X`09`09`09shot_row := greebie_pos; X`09`09end; X X`09`09IF (Sector < 20 )`20 X`09`09 Then choise := 1`20 X`09`09 Else X`09`09 IF ( Sector >= 20 ) And ( Sector < 40 )`20 X`09`09 Then choise := 2 X`09`09 Else X`09`09 IF (Sector >= 40 ) And ( Sector < 60) X`09`09 Then choise := 3 X`09`09 Else choise := 4; X`09 X`09`09Case choise of X`09`091:fire_part_1; X X`09`092: Begin X`09`09`09IF (Sector = 20 ) and ( field = 1) then X`09`09`09 Write_Ch(1,1,bell); X X`09`09`09IF (screen`5Bdown_count + 1, shot_row`5D = star) And X`09`09`09(screen`5Bdown_count + 1,shot_row + left`5D = star) then X`09`09`09 shot_row := shot_row + 1; X X`09`09`09IF (screen`5Bdown_count + 1, shot_row`5D = star) And X`09`09`09(screen`5Bdown_count + 1,shot_row + right`5D = star) then X`09`09`09 shot_row := shot_row - 1; X X`09`09`09IF (screen`5Bdown_count + 1, shot_row`5D = star) And X`09`09`09(screen`5Bdown_count + 1,shot_row + left`5D = Blank) And X`09`09`09(screen`5Bdown_count + 1,shot_row + right`5D = Blank) then X`09`09`09Begin X`09`09`09`09Case Random( 1,2 ) of X`09`09`09`09`091: shot_row := shot_row - 1; X`09`09`09`09`092: shot_row := shot_row + 1; X`09`09`09`09End; `7Bcase`7D X`09`09`09End; X X`09`09`09IF (screen`5Bdown_count + 2, shot_row`5D = star) And X`09`09`09(screen`5Bdown_count + 2,shot_row + left`5D = star) then X`09`09`09 shot_row := shot_row + 1; X X`09`09`09IF (screen`5Bdown_count + 2, shot_row`5D = star) And X`09`09`09(screen`5Bdown_count + 2,shot_row + right`5D = star) then X`09`09`09 shot_row := shot_row - 1; X X`09`09`09IF (screen`5Bdown_count + 2, shot_row`5D = star) And X`09`09`09(screen`5Bdown_count + 2,shot_row + left`5D = Blank) And X`09`09`09(screen`5Bdown_count + 2,shot_row + right`5D = Blank) then X`09`09`09Begin X`09`09`09`09Case Random( 1,2 ) of X`09`09`09`09`091: shot_row := shot_row - 1; X`09`09`09`09`092: shot_row := shot_row + 1; X`09`09`09`09End; `7Bcase`7D X`09`09`09End; X X`09`09`09fire_part_1; X`09`09end; `7B 2 `7D X X`09`093:Begin X`09`09`09IF (Sector = 40 ) and ( field = 1 ) then`20 X`09`09`09 Write_Ch(1,1,bell); X`09`09`09IF shot_row > Player_col then`20 X`09`09`09`09shot_row := shot_row + left; X`09`09`09IF shot_row < Player_col then`20 X`09`09`09`09shot_row := shot_row + Right; X`09`09`09fire_part_1; X`09`09End; `7B 3 `7D X X`09`094:Begin +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-