$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 30-MAY-1992 02:56:17.98 By user MASLIB $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 4 PARTS, TO KEEP EACH PART $! BELOW 30 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. ASTEROIDL.FOR;1 $! 2. ASTEROIDS.DAT;1 $! 3. ASTEROIDS.PAS;1 $! 4. ASTEROIDS.SCN;1 $! 5. ASTEROIDT.FOR;1 $! 6. BUILD.COM;1 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' X Integer Function`09Last_Score X X Implicit none XC X Parameter`20 X .`09max_keep = 31 ! Max num Scores held + 1 X `20 X Byte X .`09Temp(12), X . Username(12,max_keep), X .`09Name(12,max_keep), X . Month_Username(12,12), X .`09Month_Name(12,12) X X Integer*4 X . month_of_Year(12) X X Integer*2 X . Date_Time(7) X `20 X Integer X .`09This_Score, X . Prev_Score, X .`09Errnum, X . Month_now, X . Month_top, X .`09Year_now, X .`09num_games, X . month_Score(12), X . Games(max_keep), X .`09Score(max_keep), X . Me, X .`09I, X .`09J, X .`09K, X . M X X logical*1 X .`09same X X`09 X Byte X .`09This_User(12) X X Integer*2 X . Len_user X X Integer*2`20 X .`09Jpi_rec_Word(8) X X integer*4`20 X .`09Jpi_rec_Long(4) X X Equivalence (Jpi_rec_Word,Jpi_rec_Long) X XC Begin X X Len_User = 0`20 X Jpi_rec_Word(1) = 12 X Jpi_rec_Word(2) = '202'X X Jpi_rec_Long(2) = %loc(This_USer) X Jpi_rec_Long(3) = %loc(len_user) X Jpi_rec_Long(4) = 0 X Call sys$getjpi(%val(0),%val(0),%val(0), X .`09`09Jpi_rec_Long, X .`09`09%val(0),%val(0),%val(0)) X X `20 X1 Open(unit=4,file='Image_dir:Asteroids.acn',form='UNFORMATTED', X .`09recordtype='FIXED',Status='OLD',Recl=1024,IoStat=ErrNum,readonly) X If (Errnum.eq.30) Goto 50 X If (Errnum.gt.1) Goto 999 X read(4) Num_games,month_top, X . `09`09month_username,month_name,Month_Score X read(4) username,name,score,games X I = 0 X Same = .false. X Do While (.Not.same.and.I.Lt.(max_keep-1))`20 X I = I + 1 X same = .true. X J = 1 X do while (same.and.J.le.len_user) X If (Username(J,I).ne.This_User(J)) Then`20 X Same = .false. X else X J = J + 1 X endif X enddo X enddo X If (same) Then`20 X Last_Score = Score(I) X Else X `09 Last_Score = 0 X endif X Close(4) X return X XC X50 continue X Call Sleep(4) X Goto 1 XC XC XC X999 last_score = 0 X return X X End $ CALL UNPACK ASTEROIDL.FOR;1 421178635 $ create 'f' X `20 X * `20 X * `20 X * * * * `20 X * * * `20 X * * * `20 X * * * `20 X* * * `20 X * * * * * `20 X * * `20 X * * * `20 X * * * * * `20 X * * * * * `20 X * ** * * * `20 X * * * * `20 X ** * * * `20 X * * ** * * * `20 X * `20 X * * * * * * X ** * ** `20 X * * * `20 X * * * * `20 X * * `20 X * * * * * * `20 X * * * * * `20 X * * * `20 X * * * * * * * * * `20 X * * * ** * * * * `20 X * * * * `20 X * * * * * ** * * ** * * `20 X * * * * ** * `20 X* * * * * * `20 X * * * ** * `20 X ** * * * `20 X* * * * * * `20 X * * * * * * * * ** * * `20 X ** * * * ** * * * `20 X * * * * * * * `20 X * *** ** * * * * * * `20 X* * * * * * * * `20 X * * * * * * * * `20 X * * * * * * * * * `20 X* * * * ** * * * `20 X* * ** * * * * * * * *`20 X * * ** * * * * * `20 X* * * * * * * * * `20 X * * * ** * * **`20 X * *** ** ** * * * * ** X * ** * * * `20 X ** * ** * **** * * `20 X * * * * * * * X * * * * ** ** * `20 X * * * * *** * *** * `20 X * * ***** * * * * * * X ** * * ** * * * * * `20 X * * * * * * * * `20 X * * * * * * * * * X * * * ** * * * ** * * `20 X*** * * * * * * * * * `20 X * * * * * * * * * * `20 X ** * * * * * X* ** ** * * * * * ** ** * * `20 X * * * * * * * * ** * * * `20 X * * * ** * * * ** * `20 X * * * * * ** * * * * * * ** X * * * * ** * ** * * * ** * * `20 X *** * ** * * ** * * ** * * * `20 X * ** * * * * * * ** * * X ** * * * ** * ** * ** * * `20 X * **** * ** * * * ** `20 X * * ** * * * * ** * X * ** *** * * * * * * * `20 X* * * * * * * ** ** `20 X * * * * * ** * * * * *** * * `20 X * * ** * * ** * ** * * *** X ** * * * * ** *** * ** * ** * X * * * *** * * * * ** * * * ** `20 X * * * ***** * * * `20 X * * * * * * ** `20 X * ** * * * * * * * `20 X* * * **** * ** * * ** * ** * ** *`20 X * ** ** ** * * * * * `20 X * ** * ** * * * ** * **** * *`20 X* * * * * * * * * * * * ** * * X ** * * * ** * * * ** * * * *`20 X * **** ** ** * * * *** *** * * ** `20 X ** * * ***** * * * *** * * * **`20 X * ** * * * * * * ** * * * * * `20 X * * * * * ** ** * * * * * * ** ** `20 X ** * * * * ** ** * * `20 X * ***** *** * * * * ** * *** `20 X ** * ** * * * * ** ** * ** * * `20 X * ** * * * * * * * * ** *`20 X * * *** * ** *** * *** ** ** * * `20 X * * * * * ** * * * ** * *`20 X* * ** * * * * ** * ** ** ** * ** * * * ** X * ** * * ** ** ** * ** * * * * * * X * * * * * * * * * ** * * ** X*** * ** * *** * *** ** **** * * * X * * * * ****** ** * * * * * **** *`20 X * * * * * * * * ** * **** * ** * * * X * ** ** * * * ** ** ** * * * * ** * **`20 X ** * * ** *** * * *** * * * `20 X ** * * * * * ** * * ** ** * *`20 X * ** * * * * * * * ** * * ** **`20 X ** * * * ** *** * *** * * * * * `20 X * ** ** * * * * * ** * ** * X * * * * * * * * * * ** * ** * *`20 X* * * * * * * * * ** ** ** **** * * `20 X* * *** * **** * * * * ** *** ** ** * * * X * * ** * * * ** **** * ** * **`20 X * * * * * * *** * **** * * ** * `20 X* * * * * * * ** ** * ** *** *** ** **`20 X **** ** * ** * ** * * * * ** * * X * *** * ****** * * ** * ** * ** ** ***`20 X ** * * * * * **** * * * * **** X * * *** **** * * ** ** ** * * ***** * X* * *** ** * ** * * * *** *** * * **** X * * * * ***** ** * ** * ** * **`20 X* * *** ** *** ** **** * * ** * * * ** `20 X * *** * ** ***** * * * * * * ** * * * X * * * * * ** ** * ** * ** * ** * X * *** ** * ** * * * *** * * * * ** X* ** * * **** *** * ** * * * ** * ** `20 X* ** ** * ** * * * ***** * **** ** * *** * X * * * ** * * ** ** ***** * * * ***** * *** X*** ** **** * * * * * * * **** * * ** * *`20 X *** * * * ****** * * ** * * ** * * * * * *`20 X * ** ** * * * * * * * * * * * * `20 X * * * * ** *** * * * * ** ***** * ** * `20 X ** *** ** *** **** **** * * * * * * *** * * ** X ** *** ******* ** * * * * * * *** * * `20 X * ** * * * * * ** ** *** * * * * * * * `20 X * * * * ** ** * * * ** * * * *** ** * X*** * ** ** ** ** * * * ** * ** * * X* ** ** *** *** ** * * ** * * **** ** * * * X*** * * * **** * **** * ** **** *** *** * * **`20 X ** * ***** *** * *** ** * * ** * * ** ** *`20 X *** * * * * * * ** * ** * * * * * * * *** * X * * *** *** ***** * ** ******* *** `20 X ** **** ** * * * ** * * ** * * * *** X * * ** ** * * * * *** ** **** ** * *** * `20 X ** *** * ** **** *** * * * ** *** * *** * * X *** ****** * ** * *** * * ** ** ** *** ** * * * * X * * ** ** * ** * ** * **** ** ** *** ***** X** ** * **** ** *** **** * * ** ** ***`20 X**** * *** *** ** ** * * ** *** * * * * *** * ** * +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+- * Program ASTEROIDS by Graham Joyce and Stephan Spadoni. * For compilation you will need file UTIL.OLB which can be found in the * LIBRARY directory. * ASTEROIDS.$PACKAGE ASTEROIDS.1 ASTEROIDS.2 ASTEROIDS.3 ASTEROIDS.4 -+-+-+-+-+-+-+-+ 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 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X`09`09`09IF (Sector = 60 ) and ( field = 1 ) then`20 X`09`09`09 Write_Ch(1,1,bell); X`09`09`09Case Random( 1,2 ) of X`09`09`091: Begin X`09`09`09`09IF shot_row > Player_col then`20 X`09`09`09`09 shot_row := shot_row + left; X`09`09`09`09IF shot_row < Player_col then`20 X`09`09`09`09 shot_row := shot_row + Right; X X`09`09`09Fire_part_1; X X`09`09`09End; `7B 1 `7D X X`09`09`092: Begin X`09`09`09`09IF (screen`5Bdown_count + 1,shot_row`5D = star) And X`09`09`09`09(screen`5Bdown_count + 1,shot_row + left`5D = star) X`09`09`09`09 then shot_row := shot_row + 1; X X`09`09`09`09IF (screen`5Bdown_count + 1,shot_row`5D = star) And X`09`09`09`09(screen`5Bdown_count+ 1,shot_row + right`5D = star) X`09`09`09`09 then shot_row := shot_row - 1; X X`09`09`09`09IF (screen`5Bdown_count + 1,shot_row`5D = star) And X`09`09`09`09(screen`5Bdown_count+1,shot_row+left`5D =Blank) And X`09`09`09`09(screen`5Bdown_count +1,shot_row+ right`5D = Blank) X`09`09`09`09then X`09`09`09`09Begin X`09`09`09`09`09Case Random( 1,2 ) of X`09`09`09`09`09`091: shot_row := shot_row - 1; X`09`09`09`09`09`092: shot_row := shot_row + 1; X`09`09`09`09`09End; `7Bcase`7D X`09`09`09`09End; X X`09`09`09`09IF (screen`5Bdown_count+ 2, shot_row`5D = star) And X`09`09`09`09(screen`5Bdown_count + 2,shot_row + left`5D = star) X`09`09`09`09 then shot_row := shot_row + 1; X`09`09`09 X`09`09`09`09IF (screen`5Bdown_count + 2,shot_row`5D = star) And X`09`09`09`09(screen`5Bdown_count +2,shot_row + right`5D = star) X`09`09`09`09 then shot_row := shot_row - 1; X`09`09`09 X`09`09`09`09IF (screen`5Bdown_count +2, shot_row`5D = star) And X`09`09`09`09(screen`5Bdown_count+2,shot_row+left`5D =Blank) And X`09`09`09`09(screen`5Bdown_count+2,shot_row + right`5D = Blank) X`09`09`09`09 then X`09`09`09`09Begin X`09`09`09`09`09Case Random( 1,2 ) of X`09`09`09`09`09`091: shot_row := shot_row - 1; X`09`09`09`09`09`092: shot_row := shot_row + 1; X`09`09`09`09`09End; `7Bcase`7D X X`09`09`09`09End; X X`09`09`09`09Fire_part_1; X X`09`09`09`09End; `7B 2 `7D X`09`09`09End; `7Bcase`7D X X`09`09End; `7B 4 `7D X X`09`09end;`7Bcase`7D X X`09End; `7B if not dead `7D X XEnd; `7B fire_a_shot `7D X X XPROCEDURE move_greebie; X`7B work out the next position of the greebie `7D X XBegin X`09IF greebie_pos > Player_col then`20 X`09begin X`09`09greebie_pos := greebie_pos + left; X`09`09IF greebie_pos > Player_col then`20 X`09`09 greebie_pos := greebie_pos - ext_move; X`09end; X X`09IF greebie_pos < Player_col then`20 X`09begin X`09`09greebie_pos := greebie_pos + Right; X`09`09IF greebie_pos < Player_col then`20 X`09`09 greebie_pos := greebie_pos + ext_move; X`09end; X X`09IF (screen`5B4, greebie_pos`5D = star) AND X`09 (screen`5B4,greebie_pos + left`5D = star) then X`09 greebie_pos := greebie_pos + 1; X X`09IF (screen`5B4, greebie_pos`5D = star) AND X`09 (screen`5B4,greebie_pos + Right `5D = star) then X`09 greebie_pos := greebie_pos - 1; X X`09IF (screen`5B4, greebie_pos`5D = star) AND X`09 (screen`5B4,greebie_pos + Right `5D = Blank) AND X`09 (screen`5B4, greebie_pos + Left`5D = Blank) then X`09Begin X `09`09Case Random( 1, 2) of X`09`09`091: greebie_pos := greebie_pos + 1; X`09`09`092: greebie_pos := greebie_pos - 1; X`09`09end; X`09end; X X IF greebie_pos < min_left then X greebie_pos := min_left; X X`09IF greebie_pos > max_right then X`09 greebie_pos := max_right; X`09write_ch(3,greebie_pos,greebie); X`09 Xend; `7B move_greebie `7D X XPROCEDURE display_dead; X`7B a little bit of flashy graphics `7D XVar X`09i : integer; X Xbegin X`09write_st(Ansi_mode); X`09for i:=1 to 10 do X`09Begin X`09`09if odd(i) then X`09`09 Begin X`09`09`09 write_st(White_100); X`09`09 `09 Break; X`09`09 End X`09`09else X`09`09 Begin X`09`09`09 write_st(Black_100); X`09`09 `09 Break; X`09`09`09 writeln(bell); X`09`09 End; X`09end; XEnd;`7B display_dead `7D X XPROCEDURE set_up; X`7B initialisation of variables etc.. `7D XVar X`09t`09: Integer; X XBegin X X`09seed := clock; X X`09write_st(Ansi_mode); X`09write_st(clear_100); X`09write_st(scroll_region); X`09write_st(Jump_100); X X`09for t := 1 to 22 do`20 X`09begin X`09`09writev(char_string,Esc,'`5B',t:1,';',0:1,'H'); X`09`09write_st(Char_string); X`09`09write_st(large_100); X`09Break; X`09end; X X`09Back_Thrust := False; X`09dead := false; X`09greebie_dead := false; X`09shot_going := false; X X`09Score := 0; X X`09Player_Row := 12; X X`09ext_move := 0; X X`09Time_out := 30; X X`09test_num := 970; X X`09field := 0; X `09 X`09greebie_pos := Random (3,38); X X`09Player_col := centre; X X writev(char_string,esc,'`5B',24:1,';',12:1,'H','SECTOR : V FIELD : SCORE :'); X X write_st(char_string); X`09write_st(vt52); X X`09break; X XEnd; `7B set_up `7D X XPROCEDURE change_int( temp : integer); XVar X`09i`09: integer; XBegin X`09For i := 1 to 7 do ch`5Bi`5D := blank; X`09i := 0; X`09While temp > 0 Do X`09Begin X`09`09i := i + 1; X`09`09ch `5B i `5D := chr((temp mod 10 ) + ord('0')); X`09`09temp := temp div 10; X`09End; X XEnd; `7B change_int `7D X XPROCEDURE Check_Previous_Score; X`7B Check to see if player wants to start further ahead. `7D X XBegin X`09IF Last_Score > 2440 then X`09Begin X`09`09write_st(clear_100); X`09`09write_st(Home_100); X`09`09At(1,1); X`09`09write_st(large_100); X`09`09At(1,1); X`09`09write_st(' Hi there HOT SHOT !!!'); X`09`09write_st(line); X`09`09write_st(line); X`09`09write_st(' Do you want to Begin anew ,'); X`09`09write_st(line); X`09`09write_st(' OR continue from sector 30 ?'); X`09`09write_st(line); X`09`09write_st(line); X`09`09write_st(' Press "B" to start Anew OR any character to start a Vt Sector 30.'); X`09`09Break; X`09`09Case TT_1_Char of X`09`09`09'b','B': Sector := 0; X`09`09`09Otherwise Sector := 30; X`09`09End; `7B case `7D X`09End; X XEnd; `7B Check previous Score `7D X XPROCEDURE increment_Sector; X`7B add 1 to Sector if fields is = to 20 `7D X XBegin X X`09Sector := Sector + 1; X`09field := 0; X`09test_num:= test_num - 3; X`09if Sector > 10 then ext_move := 1; X XEnd; `7B increment_Sector `7D X XBegin `7B ...main... `7D X X`09Read_Help_File; X`09Read_Data_File; X`09Check_Previous_score; X`09set_up; X X`09repeat X`09`09IF field = 20 then X`09`09 time_out := Time_out - 1; X X`09`09If time_out < 1 then time_out := 1; X X`09`09Sleep_set( 21, Time_out); X X`09`09Sleep_Start; X X`09`09Field := Field + 1; X X`09`09if field = 1 then`20 X`09`09begin X`09`09`09change_int(sector); X`09`09`09At(24,21); X`09`09`09write_3(ch`5B3`5D,ch`5B2`5D,ch`5B1`5D); X`09`09End; X X`09`09change_int(field); X`09`09at(24,44); X`09`09write_3(ch`5B3`5D,ch`5B2`5D,ch`5B1`5D); X X`09`09calculate_score; X X`09`09change_int(score); X`09`09at(24,67); X`09`09write_6(Ch`5B6`5D, Ch`5B5`5D, Ch`5B4`5D, Ch`5B3`5D, Ch`5B2`5D, Ch`5B1` V5D); X X`09`09Break; X X`09`09new_star_line; X X`09`09Move_Player; X X`09`09move_greebie; X X`09`09Fire_a_shot; X X`09`09check_dead; X X`09`09if field = 20 then`20 X`09`09 increment_Sector; X X`09`09write_ch(24,78,blank); X X`09`09Break; X X`09`09Sleep_Wait; X X`09until dead; X X`09if dead then display_dead; X X`09top_ten( Score ); X X`091: `7B the end of program `7D Xend. `7B ...main... `7D $ CALL UNPACK ASTEROIDS.PAS;1 325034616 $ create 'f' X`1B`5BH`1B`5BJ`1B(B`1B`5B0m X`1B`5B1;6H`1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B` V5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m V `1B`5B7m `1B`5B0m`20 X`1B`5B1;58H `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B2;6H `1B`5B0m `1B` V5B7m `1B`5B0m `1B`5B7m `1B`5B2;24H `1B`5B0m `1B`5B7m `1B`5B0m ` V1B`5B7m `1B`5B0m`20 X`1B`5B2;40H `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m ` V1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B V3;5H `1B`5B0m `1B`5B7m `1B`5B0m`20 X`1B`5B3;12H `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1 VB`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1 VB`5B7m `1B`5B0m `1B`5B7m`20 X`1B`5B3;62H `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B4;5H `1B` V5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m V `1B`5B7m `20 X`1B`5B4;40H`1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5 VB0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5 VB7m `20 X`1B`5B5;5H `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m V `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m V `1B`5B7m `1B`5B0m`20 X`1B`5B5;53H `1B`5B7m `1B`5B0m `1B`5B7m `1B`5B0m `1B`5B7m `1B V`5B6;1H`1B`5B0m`1B(0lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq X`1B`5B6;42Hqqqqk lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk`1B`5B7;1Hx `1B`5B7mO`1B(Bb Vject`1B`5B0m :- To get through the star X`1B`5B7;38H field `1B(0x x `1B`5B7mC`1B(Bontrols`1B`5B0m :- <- `1B`5B7m1`1 VB`5B0m `1B`5B7m2`1B`5B0m `1B`5B7m3`1B`5B0m -> `1B(0x X`1B`5B8;1Hx `1B(Bwithout the greebie shooting you. Hitting `1B(0x x V `1B(Bv`1B`5B8;79H`1B(0x X`1B`5B9;1Hx `1B(Bthe greebie missiles or the asteroids will `1B(0x x `1B`5B9 V;79Hx`1B`5B10;1Hx `1B(Bzap you. Bewar X`1B`5B10;18He ! The Greebies missiles `1B(0x x `1B`5B7m 0 `1B`5B0m ` V1B(B= Back Thust. `1B(0x X`1B`5B11;1Hx `1B(Bget tougher the longer you play . `1B(0x x`1B`5B1 V1;79Hx`1B`5B12;1Hx`1B`5B12;46Hx x Q `1B(Bto X`1B`5B12;55H Quit or E to Exit. `1B(0x`1B`5B13;1Hx `1B`5B7mW`1B(Bho is w Vhat`1B`5B0m :-`1B`5B13;46H`1B(0x mqqqqqqqqqqqqqqqqq X`1B`5B13;66Hqqqqqqqqqqqqqj`1B`5B14;1Hx `1B(B# Greebie - A horrible chap t Vhat wants `1B(0x lqqqqqqqqqqqqqqqq X`1B`5B14;65Hqqqqqqqqqqqqqqk`1B`5B15;1Hx`1B`5B15;17H`1B(Bto shoot You.`1B`5B1 V5;46H`1B(0x x`1B(B* * * * * * * * `20 X`1B`5B15;76H *`1B(0x`1B`5B16;1Hx `1B(B! Missile - What he wants to shoo Vt you `1B(0x x `1B(B* * # * * `20 X`1B`5B16;69H * * `1B(0x`1B`5B17;1Hx`1B`5B17;17H`1B(Bwith.`1B`5B17;46H`1 VB(0x x `1B(B* * * * * * `1B(0x X`1B`5B18;1Hx V Y`1B(Bou - The one who is trying to `1B(0x x`1B(B* V * !* * * * * `1B(0x X`1B`5B19;1Hx`1B`5B19;17H`1B(Blive.`1B`5B19;46H`1B(0x x `1B(B* * * * V *** * `1B(0x`1B`5B20;1Hx `1B(B* Asteroid X`1B`5B20;14H - Innocent bystander who kills `1B(0x x`1B(B* * *`1B`5B20;65H V*`1B`5B20;76H* *`1B(0x X`1B`5B21;1Hx`1B`5B21;17H`1B(Bon contact.`1B`5B21;46H`1B(0x x `1B(B** V* V * * * * `1B(0x X`1B`5B22;1Hmqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj mqqqqqqqqqqqqqqqqq Vqqqqqqqqqqqqqj X`1B`5B23;1H`1B`5B7mC`1B(Breated by Graham Joyce And Stefan Spadoni.`1B`5B23; V54H`1B`5B0mHit Any key To Play`20 X`1B* $ CALL UNPACK ASTEROIDS.SCN;1 1896969179 $ create 'f' X Subroutine `09Top_Ten(This_Score) X X Implicit none XC X Parameter`20 X . `09Esc = 27, X .`09max_keep = 31 ! Max num Scores held + 1 X `20 X Byte X .`09Temp(12), X . Username(12,max_keep), X .`09Name(12,max_keep), X . Month_Username(12,12), X .`09Month_Name(12,12) X X Integer*4 X . month_of_Year(12) X X Integer*2 X . Date_Time(7) X `20 X Integer X .`09This_Score, X . Prev_Score, X .`09Errnum, X . Month_now, X . Month_top, X .`09Year_now, X .`09num_games, X . month_Score(12), X . Games(max_keep), X .`09Score(max_keep), X . Me, X .`09I, X .`09J, X .`09K, X . M X X logical*1 X .`09sorted X X`09 X Byte X .`09This_User(12) X X Integer X . Len_user X X Integer*2`20 X .`09Jpi_rec_Word(8) X X integer*4`20 X .`09Jpi_rec_Long(4) X X Equivalence (Jpi_rec_Word,Jpi_rec_Long) X X Data month_of_year/ X .`09`09`09'Jan ', X .`09`09`09'Feb ', X .`09`09`09'Mar ', X .`09`09`09'Apr ', X .`09`09`09'May ', X .`09`09`09'Jun ', X .`09`09`09'Jul ', X .`09`09`09'Aug ', X .`09`09`09'Sep ', X .`09`09`09'Oct ', X .`09`09`09'Nov ', X .`09`09`09'Dec '/ X XC Begin X X Type 100,Esc,Esc,Esc,Esc X100 Format(X,A1,'<',A1,'`5B1;24r',A1,'`5BH',A1,'`5B2JPlease Wait ...') X Jpi_rec_Word(1) = 12 X Jpi_rec_Word(2) = '202'X X Jpi_rec_Long(2) = %loc(This_USer) X Jpi_rec_Long(3) = %loc(len_user) X Jpi_rec_Long(4) = 0 X Call sys$getjpi(%val(0),%val(0),%val(0), X .`09`09Jpi_rec_Long, X .`09`09%val(0),%val(0),%val(0)) X X Call sys$numTim(date_time,%val(0)) X Year_now = date_Time(1) X Month_now = date_Time(2) X X `20 X1 Open(unit=4,file='Image_dir:Asteroids.acn',form='UNFORMATTED', X .`09recordtype='FIXED',Status='OLD',Recl=1024,IoStat=ErrNum) X If (Errnum.eq.30) Goto 50 X If (Errnum.gt.1) Goto 999 X read(4) Num_games,month_top, X . `09`09month_username,month_name,Month_Score X read(4) username,name,score,games X num_games = num_games + 1 X If (Month_top.ne.month_now) Then ! Clear Month X If (month_top.ne.0) Then`20 X`09 Do J = 1,12`20 X`09 month_username(J,month_top) = Username(J,1) X`09 month_name(J,month_top) = name(J,1) X`09 enddo X`09 month_Score(month_top) = Score(1) X `09endif X`09Do I = 1,max_keep X`09 Do J = 1,12`20 X`09 username(J,I) = ' ' X`09 name(J,I) = ' ' X`09 enddo X`09 Score(i) = 0 X `09 games(i) = 0 X`09enddo X`09Month_top = Month_now X endif`09 `20 X I = 1 X J = 0 X Score(max_keep) = 0 X do while ((J.lt.12).and.(Score(I).ne.0)) X `09J = 1 X `09do While (( Username(J,I).eq.This_User(J)).and.(J.lt.12)) X `09 J = J + 1 X `09enddo X `09I = I + 1 X enddo X If ( J.eq.12 ) Then ! if the same username`20 X `09 I = I - 1 X endif X Me = I X If (score(I).eq.0) Then`20 X `09 Do J = 1,12`20 X `09 Username(J,I) = this_user(J) X `09 name(J,I) = ' ' X enddo X `09 If ( This_Score.lt.0 ) This_Score = 10 X `09 Prev_Score = 0 X Score(I) = This_Score X `09 Games(I) = 1 X Else X Prev_Score = Score(I) X Score(I) = Max(Score(I),this_Score) +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+ X `09 Games(i) = Games(i) + 1 X endif X sorted = .false. X do while (.not.sorted)`20 X `09sorted = .true. X`09Do I=1,max_keep-1 X`09 IF ( Score(I).Lt.Score(I+1)) Then`20 X `09 Sorted = .false. X `09 IF (I+1.eq.me) me = Me - 1 X`09 K=Score(I) X`09 Score(I)=Score(I+1) X`09 Score(I+1)=K X`09 K=games(I) X`09 Games(I)=Games(I+1) X`09 Games(I+1)=K X`09 Do J=1,12 X`09`09Temp(J)=name(J,I) X`09`09Name(J,I)=name(J,I+1) X`09`09Name(J,I+1)=Temp(J) X`09 enddo X`09 Do J=1,12`20 X`09`09Temp(J)=username(J,I) X`09`09UserName(J,I)=username(J,I+1) X`09`09UserName(J,I+1)=Temp(J) X`09 enddo X`09 endif X`09enddo X enddo XC XC Now To display The Top Players Of The Year`20 XC `20 X type 110,Esc,Esc,Year_now-1,Year_now,Esc,Esc X110 Format(X,A1,'`5BH',A1,'`5B2J' X . ,'Immortal Players For ',I4,' - ',I4,A1,'(0',/ X .`09 X,'oooooooooooooooooooooooooooooooooo',A1,'(B',/ X .`09 X,'Month Username Name Score',/) X If (month_now.eq.1) month_now = 13 X `09 X Do M = month_now - 1 ,1,-1 X If ( Month_Score(M).gt.0) Then`20 X `09 type 120,Month_of_year(M), X .`09`09(Month_username(K,M),K=1,10), X .`09`09(month_name(K,M),K=1,12),month_Score(m) X `09 endif X enddo X Do M = 12 ,month_now,-1 X If ( Month_Score(M).gt.0) Then`20 X `09 type 120,Month_of_year(M), X .`09`09(Month_username(K,M),K=1,10), X .`09`09(month_name(K,M),K=1,12),month_Score(m) X `09 endif X enddo X120 Format(2X,A4,2X,10A1,12A1,I6) X X type 210,Esc,Esc,Month_of_year(Month_top), X .`09`09Esc,num_games,Esc,Esc,Esc,Esc,Esc X210 Format(X,A1,'`5BH',A1,'`5B40C Top Players For ',A4, X .`09`09A1,'`5B1m',I6,' Games',A1,'`5B0m',/ X .`09 X,A1,'`5B40C ',A1, X .`09`09'(0ooooooooooooooooooo',A1,'(B',/ X .`09 X,A1,'`5B40CNum Username Name Score Games'/) X Do I = 1,12 X If ( Score(I).ne.0) Then`20 X `09 type 220,Esc,I,(username(K,I),K=1,10), X .`09`09(name(K,I),K=1,12),Score(I), X .`09`09Games(I) X endif X enddo X220 Format(X,A1,'`5B40C',I3,X,10A1,12A1,I6,I6) X `20 X If ( This_Score.Ge.Prev_Score.and.Me.le.12) Then`20 X Type 311,Esc,Me,Prev_Score,Esc,Esc,This_Score X else X Type 312,Esc,Me,Prev_Score,This_Score X endif X311 Format(X,A1,'`5B18;1H', X . 4X,'You Are Seated At ',I2,' In Asteroids ', X . 6X,'Previous Score ',I6,//,X, X . 4X,A1,'`5B1m','Enter Your Name `5B Return to leave `5D ', X . A1,'`5B0m',6X,'Current Score ',I6) X312 Format(X,A1,'`5B18;1H', X . 4X,'You Are Seated At ',I2,' In Asteroids ', X . 6X,'Previous Score ',I6,//,X, X . 4X,'Not The Best .... ', X . 6X,'Current Score ',I6) X If ( Me.LE.12.and.This_Score.GE.Prev_Score) then`20 X`09 If ( Me + 4.ge.10) then`20 X`09 Type 320,Esc,Me + 4 `20 X320`09 Format(X,A1,'`5B',I2,';55H',$) X`09 else`20 X`09 Type 321,Esc,me + 4 X321`09 Format(X,A1,'`5B',I1,';55H',$) X`09 endif X`09 Accept 323, I, ( Name(K,Me),K = 1 ,I ) X323`09 Format(Q,A1) X Endif X Type 324,Esc X324 Format(X,A1,'`5B22;1H') X rewind(4) X write(4) Num_games,month_top, X . month_username,month_name,Month_Score X write(4) username,name,score,Games X Close (4) X Return XC XC X XC X50 type 51,Esc,Esc,Esc X51 Format(X,A1,'<',A1,'`5B2J',A1,'`5B1;1HPlease Wait ...') X Call Sleep(4) X Goto 1 XC XC XC X999 type 1000 X1000 Format(X,'Can''t Find Asteroids.Acn Creating New File') X Open(unit=4,file='Image_dir:Asteroids.Acn',form='UNFORMATTED', X .`09recordtype='FIXED',Status='New',Recl=1024,IoStat=ErrNum) X num_games = 0 X Do I = 1,12 X Do J = 1,12`20 X month_username(J,I) = ' ' X`09 month_name(J,I) = ' ' X`09 enddo X`09 month_Score(i) = 0 X enddo X Month_top = 0 X write(4) Num_games,month_top, X .`09`09month_username,month_name,Month_Score X write(4) Username,name,score,Games X close(4) X goto 1 X End $ CALL UNPACK ASTEROIDT.FOR;1 1345539874 $ create 'f' X$ FORTRAN ASTEROIDL X$ FORTRAN ASTEROIDT X$ PASCAL ASTEROIDS X$ LINK /NODEBUG /NOTRACE ASTEROIDS, ASTEROIDT, ASTEROIDL, UTIL/LIB X$ DELETE *.OBJ;*/NOCONFIRM X$ EXIT $ CALL UNPACK BUILD.COM;1 1126577192 $ v=f$verify(v) $ EXIT