$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On  7-APR-1993 18:54:43.71   By user MASTER 
$!
$! 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 5 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. BUILD.COM;1
$!       2. TANK.PAS;1
$!       3. TANK.SCN;1
$!       4. TANKH.FOR;1
$!       5. TANKM.MAR;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$ MACRO TANKM
X$ PASCAL TANK`09`09! ignore the warnings
X$ FORTRAN TANKH
X$!
X$ LINK /NOTRACE TANK,TANKM,TANKH,UTIL/LIB
X$ DELETE /NOCONFIRM *.OBJ;*
X$ EXIT
$ CALL UNPACK BUILD.COM;1 1249736874
$ create 'f'
X
X`7B$S-`7D
X`7B$C+`7D
X`7B
X
X`09`09Program`09: Tank
X
X`09`09Authors`09: Rex Croft       - Macro
X
X                          Murray Speight - Pascal`20
X
X`09`09Place`09: University Of Waikato`20
X
X`09`09Date `09: May 1982`20
X
X`09Software Is Subject To Change Without Notification
X        The Author And His Family assume No Rsponsability For
X`09Its Reliabliity Or Use.`20
X
X         `7D
X
XProgram Tank(Input,Output);
X
XLabel`099999;  `7B For Abortive exit Of Pgm `7D
X
X
XConst `09Max_Num_Players`09= 8;             `7B Up To 8 Players `7D
X`09Screen_Dim_X `09= 23;            `7B PLaying Board 40 * 23 `7D
X`09Screen_Dim_Y`09= 40;
X`09Len_Of_Buff`09= 1024;          `7B Buffer to Write Chars `7D
X        Max_Name_Length = 32;            `7B Lenngth of a players name `7D
X
XType `09Player_Responce = Packed Array `5B1..Max_Num_Players`5D Of Char;
X`09Buffer`09`09= Packed Array `5B1..Len_Of_Buff`5D Of Char;`09
X`09Positions`09= Array `5B1..Max_Num_Players`5D Of INteger;
X`09Players_Screen`09= Array `5B1..Screen_Dim_X,1..Screen_Dim_Y`5D Of Char;
X`09Died_Type`09= Array `5B1..Max_NUm_Players`5D Of Boolean;
X`09Name_Line`09= Packed array `5B1..max_Name_Length`5D of Char;
X        Name_Table`09= Array `5B1..Max_Num_Players`5D of name_LIne;
X
XVar `09Responce `09,`09`09`09`7B What Players Have Typed `7D
X`09Head_Sym`09: Player_Responce;      `7B What Symbol is THe Head `7D
X`09Screen`09`09: Players_Screen;       `7B 23 * 40 Array For Screen`7D
X`09Name`09`09: Name_Table;           `7B Names Of Each Player `7D
X        Init_Pos_X`09,                       `7B Where initaially Players St
Vart `7D
X        Init_Pos_Y      ,                       `7B  "" "" For Y Coord `7D
X`09Score`09`09,                       `7B Score Of Each PLayer `7D
X        Game`09`09,                       `7B Num Games Each PLayer Played `
V7D
X`09Games_Won `09,                       `7B Games Won By Each PLayer `7D
X`09Move_X`09`09,                       `7B What Dir Each Playe Is Moving X C
Voord `7D
X`09Move_Y`09`09,                       `7B "" "" Y Coord `7D
X`09Head_X`09`09,                       `7B Where The Head Is For Each Player
V X Coord `7D
X`09Head_Y`09 `09,                       `7B "" "" Y Coord `7D
X`09Start_X`09`09,
X`09Start_Y`09`09,
X        Rand`09`09,
X        Laser_Charge`09,
X`09End_X`09`09,
X`09End_Y`09`09: Positions;            `7B "" "" Y Cord `7D
X`09TT_Buff`09`09: Buffer;               `7B Lenght Of Buffer To Hold Screen
V Output `7D
X`09TT_Len`09`09,                       `7B String To Hold Screen Output `7D
X        Who_Is_PLaying  ,                       `7B Word With Bits Set As To
V Who is Playing `7D
X`09You`09`09,                       `7B Which Number You are `7D`20
X`09Dummy `09`09,                       `7B Dummy argument `7D
X`09Num_players     ,                       `7B How Many people are Playing `
V7D
X`09Max_Player_Number ,                     `7B The Highest PLayers Number wh
Vo is Playing `7D
X`09Move_Count`09,
X        Num_Moved_Last_Round    ,               `7B Number of players who mo
Vved last Round ( Last Screen Update ) `7D
X`09Players_Removing`09: Integer;      `7B Are We Removing Odd 1 or even 2 pl
Vayers Tails `7D
X`09Fired`09`09,
X        Shields         ,
X`09Quit`09`09,                       `7B Has The PLayer Quit (not playing )
V or is He Playing `7D
X`09Died `09`09: Died_Type;            `7B Has The PLayer Died ( Died If He h
Vas Quit ) `7D
X`09Back_space`09,
X`09Line_Feed`09,
X`09Up_Line`09`09,
X`09Esc`09`09: Char;                 `7B esc For escape sequences `7D
X`09Seed`09`09: Real;                 `7B Seed for random number generaotor `
V7D
X        Time_Now`09: Packed array `5B1..11`5D Of Char;
X
XProcedure Break_Buff;
X
X   Procedure Snake_Screen( Var Line : Buffer ; Var Lenght : Integer );extern
V;`20
X
X`7B Only Call This Once From The Add_head Function`20
X
X   Does not write array to screen `7D
X
XBegin
X   Snake_Screen(TT_Buff,TT_Len);`20
X   TT_Len := 0;
Xend;
X
X
XProcedure Help_Screen;extern;
X
XProcedure Buff_Pos_Char_1( X,Y : Integer ; Ch : Char );
X
X`7B Write Char at Pos X,Y in Buffer `7D
X
XBegin
X   TT_Buff`5BTT_Len+1`5D := Esc;
X   TT_Buff`5BTT_Len+2`5D := 'Y';
X   TT_Buff`5BTT_Len+3`5D := Chr(31+X);
X   TT_Buff`5BTT_Len+4`5D := Chr(31+Y);
X   TT_Buff`5BTT_Len+5`5D := Ch;
X   TT_Len := TT_Len + 5;
Xend;
X
XProcedure Buff_Pos( X,Y : Integer);
X
X`7B Write Char at Pos X,Y in Buffer `7D
X
XBegin
X   TT_Buff`5BTT_Len+1`5D := Esc;
X   TT_Buff`5BTT_Len+2`5D := 'Y';
X   TT_Buff`5BTT_Len+3`5D := Chr(31+X);
X   TT_Buff`5BTT_Len+4`5D := Chr(31+Y);
X   TT_Len := TT_Len + 4;
Xend;
X
XProcedure Buff_Char_1( Ch : Char );
X
X`7B Write Char at Pos X,Y in Buffer `7D
X
XBegin
X   TT_Buff`5BTT_Len+1`5D := Ch;
X   TT_Len := TT_Len + 1;
Xend;
X
XProcedure Buff_Char_3( Ch_1,Ch_2,Ch_3 : Char );
X
X`7B Write Char at Pos X,Y in Buffer `7D
X
XBegin
X   TT_Buff`5BTT_Len+1`5D := Ch_1;
X   TT_Buff`5BTT_Len+2`5D := Ch_2;
X   TT_Buff`5BTT_Len+3`5D := Ch_3;
X   TT_Len := TT_Len + 3;
Xend;
X
X
XFunction at(X,Y: Integer):Char;
X
X`7B Posotion Cursor at X , Y this Is For Use In Write Statments `7D
X
XBegin
X   Write(esc,'Y',chr(31+X),Chr(31+Y));
X   at := Chr(0);
Xend;
X
X
XFunction Snake_Init(Var You :  INteger ; Var Game_going : Integer):Integer;e
Vxtern;
X
XProcedure Name_Set(Var Name : Name_Line );extern;
X
XProcedure Name_Get(Var Name : Name_Line ; var Play : Integer );extern;
X
XProcedure Score_Set( Var Player,Score,Games_PLayed,wins : INteger);extern;
X
XProcedure Score_Get( Var Player,Score,Games_Played,wins : Integer );extern;
X
XProcedure Snake_Start(var Whos_PLaying : Integer ; var Rand : Positions );Ex
Vtern;
X
XProcedure Snake_Read(Var Directions : Player_Responce );Extern;
X
XProcedure Snake_Game_End;extern;
X
XProcedure Snake_Wait;Extern;
X
XProcedure Snake_Game_count( Var Num : Integer);extern;
X
XProcedure Snake_Dead(Var PLayer : Integer );extern;
X
XProcedure Sleep( Num_Sec : Integer);extern;
X
XFunction Mth$Random(var Seed : real):Real;extern;
X
XProcedure Draw_Scores;
X
XConst Len_Scale = 50;
X
XVar I,num_on_table,play,Top_play,Total_Num_Games: Integer;
X    This_Score,`09Max_score , Score_Ratio : Real;
X
X
XBegin
X   Time(Time_Now);
X   Num_on_Table := 0;
X   Write(esc,'H',Esc,'J',Esc,'G',esc,'<');
X   Write(' Player   User         Name               Score  Game  Won     ');
X   If ( Time_Now`5B1`5D = '2' ) Then Begin
X      If ( Time_Now`5B2`5D >= '2' ) Then Begin
X         Time_Now`5B1`5D := '1';
X         Time_Now`5B2`5D := chr( Ord(Time_Now`5B2`5D) - 2);
X      end Else begin
X         Time_Now`5B1`5D := ' ';
X         Time_Now`5B2`5D := chr( Ord(Time_Now`5B2`5D) + 8);
X      end;
X      Write(esc,'`5B1m',Time_Now:5);
X      Writeln(' pm',esc,'`5B0m');
X   End Else Begin
X      If (( Time_Now`5B1`5D = '1' ) and ( Time_Now`5B2`5D > '2' )) THen Begi
Vn
X         Time_Now`5B1`5D := ' ';
X         Time_Now`5B2`5D := chr( Ord(Time_Now`5B2`5D) - 2);
X         Write(esc,'`5B1m',Time_Now:5);
X         Writeln(' pm',esc,'`5B0m');
X      end Else Begin
X         If Time_Now`5B1`5D = '0' Then`20
X            Time_Now`5B1`5D := ' ';
X         Write(esc,'`5B1m',Time_Now:5);
X         If Time_Now`5B2`5D = '2' Then`20
X            Writeln(' pm',esc,'`5B0m')
X         else
X            Writeln(' am',esc,'`5B0m');
X      end;
X   end;
X   writeln;
X   Max_score := -99999.0;
X
X   `7B Find The Top Player  goes By The his Score And Num Of Games Played `7
VD
X   For PLay := 1 to Max_Num_PLayers do  begin
X      Score_get(Play,Score`5BPLay`5D,Game`5BPLay`5D,Games_won`5Bplay`5D);
X      If Game`5BPlay`5D > 0 Then Begin
X         This_score := (Score`5Bplay`5D+ Games_won`5Bplay`5D*10) / (Game`5Bp
Vlay`5D)**(0.9);
X         If This_score > Max_score Then Begin
X            Top_Play := Play;
X            Max_score := This_score + 1.0;
X         end;
X      end;
X   end;
X   For Play := 1 to Max_Num_PLayers do Begin
X      If Game`5BPLay`5D > 0  Then Begin   `7B IF Games PLayed > 0 Then You A
Vre PLaying  `7D
X         Num_On_Table := Num_On_Table + 1;
X         If PLay = Top_PLay Then`20
X            Write(esc,'`5B1m');  `7B High intensity Flash `7D
X         Write(Play:4);
X         Write('    ',Name`5BPlay`5D:32);
X         write(Score`5BPLay`5D:7);         `7B Print Info `7D
X         Write(Game`5BPlay`5D:6);
X         Writeln(Games_won`5Bplay`5D:5,esc,'`5B0m'); `7B Exit High Intens `7
VD
X      End;
X   End;
X   writeln;`20
X   Writeln(' Player  Score Indicator ');
X   Writeln;
X   For Play := 1 to Max_Num_PLayers do Begin
X      If Game`5BPLay`5D > 0  Then Begin   `7B IF Games PLayed > 0 Then You A
Vre PLaying  `7D
X         If PLay = Top_PLay Then`20
X            Write(esc,'`5B1m');  `7B High intensity Flash `7D
X         Write(Play:4);
X         Write('     ',Esc,'`5B7m'); `7B Rev Video `7D
X         Score_Ratio := (Score`5Bplay`5D+Games_won`5BPLay`5D*10)*Len_Scale
X                            / ((Game`5Bplay`5D)**(0.9)*Round(max_score));
X         For I := 1 to Round(Score_Ratio) do`20
X            Write(' ');
X         If PLay = Top_PLay Then`20
X             Write(Esc,'`5B0m',Esc,'`5B1;5m ** Champ ** ');
X         Writeln(esc,'`5B0m'); `7B Normal Video `7D
X      end;
X    End;
X
X`7B Print The Games You Have Played With The Totak Num of Games Played so Fa
Vr `7D
X   Snake_Game_Count( Total_Num_games );
X   writeln;
X   Writeln(' Game # ',Game`5BYou`5D:1,'    Total # ',Total_Num_Games:1,
X           '`09`09Please Wait For Next Game ... ',Esc,'`5B?2l',Esc,'F');
X   If Num_on_Table <= 1 Then`20
X      Goto 9999;
Xend;
X
XProcedure Draw_screen;
X
XVar play,I,X,Y,Line_at : Integer;
X
X   Function Min(A,B:Integer):Integer;
X
X   Begin
X      If A < B Then`20
X         Min := A`20
X      Else
X         Min := B
X   end;
X
XBegin `7B Draw Screen `7D
X   Write(at(1,1),esc,'J',esc,'<',esc,'(0',esc,'<',esc,'(0');     `7B Clear H
Vome `7D
X   Write(esc,'#6l');
X   For Y := 1 To (Screen_Dim_Y-2) Do`20
X      Write('q');
X   Writeln('k');
X   For X := 2 To ( Screen_dim_X - 1 )  Do begin
X      Write(esc,'#6x');
X      Writeln(Esc,'`5B',(Screen_dim_Y-2):1,'Cx');
X   end;
X   write(esc,'#6m');
X   For Y := 1 to (Screen_Dim_Y-1) Do`20
X      Write('q');
X   Writeln('j');
X   Writeln(Esc,'`5B1;1H',Esc,'`5B?2l',esc,'F');
X
Xend;
X
X  `20
XProcedure initalise_Positions;
X
X
X
XVar Mult,Play,X,Y : Integer;
X
X
XBegin
X
XPlayers_Removing := -1;  `7B On First Few Moves Want To Draw Hazzards `7D
X
XSnake_Start(Who_Is_Playing,Rand);
X
X
X`7B Randomly Position The Starting Pos Of The PLayers `7D
XFor play := 1 to Max_num_players do  Begin
X   Head_X`5BPlay`5D := Init_Pos_X`5BRand`5BPlay`5D`5D;
X   Head_Y`5Bplay`5D := Init_Pos_Y`5BRand`5BPLay`5D`5D;
X   Laser_Charge`5Bplay`5D := 0;
X   Shields`5Bplay`5D := True;
X   Fired`5Bplay`5D := False;
X   Move_X`5BPlay`5D := 0;
X   Move_Y`5BPLay`5D := 0;
Xend;
X
XMult := 2**(Max_num_Players - 1 );  `7B 2 ** Number of PLayers - 1`7D
XNum_Players := 0;
X
X`7B Examine Each Bit In Mult To See If You Are Playing `7D
XMax_player_number := 0;
XFor Play := Max_Num_PLayers downto 1 do begin
X   If ( Who_Is_PLaying div Mult ) = 1 Then begin
X      Name_Get(Name`5BPlay`5D,Play);
X      Num_Players := Num_PLayers + 1;
X      Quit`5Bplay`5D := False;   `7B Bit Set You Are Playing `7D
X      Who_is_Playing := Who_is_Playing - Mult;
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-