$! ------------------ 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:58:18.88   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. SNAKE.MAR;1
$!       3. SNAKE.SCN;1
$!       4. SNAKEH.FOR;1
$!       5. SNAKEP.PAS;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 SNAKE
X$ PASCAL SNAKEP
X$ FORTRAN SNAKEH
X$!
X$ LINK/NOTRACE SNAKE,SNAKEP,SNAKEH,UTIL/LIB
X$ DELETE/NOCONFIRM *.OBJ;*
X$ EXIT
$ CALL UNPACK BUILD.COM;1 1346713570
$ create 'f'
X`09.title`09SNAKEM`09Snake Game
X;+
X;`09or`09TANKM`09Tank Game
X;`09if $$TANK is defined
X;-
X
X`09$dibdef
X`09$iodef
X`09$qiodef
X`09$secdef
X`09$jpidef
X;`09$ssdef
Xesc`09`09= 27
X
Xsnake`09`09= 8`09`09; number of snakes
X
X;`09meaning of event flags in cluster 2
X
Xflag$v_master`09= 0`09`09; set if a master snake exists
Xflag$v_read`09= 1`09`09; set if all snakes should read command
Xflag$v_update`09= 2`09`09; set if all snakes should update screen
Xflag$v_game`09= 3`09`09; set if game is in progress
Xflag$v_endofgame= 4`09`09; set if we have reached the end of the game
Xflag$v_synch`09= 5
Xflag$v_done`09= 8`09`09; set if operation (read,update) is complete
X
Xcheck_timer`09= 13`09`09; check timer id
X
X
X`09.psect`09$rodata`09nowrt, noexe, shr, pic, long
X
Xttname_descr:
X`09.ascid`09/TT/
X
Xmbxcnv:
X`09.ascid`09/_MBA!UW:/`09; convert mbx unit number to physical name
X
Xmbxbuf_descr:
X`09.word`09mbxbuf_siz, 0
X`09.long`09mbxbuf
X
Xdibbuf_descr:
X`09.word`09dib$k_length, 0
X`09.long`09dibbuf
X
X`09.align long
Xsnake_desc_2:
X.if ndf $$tank
X`09.ascid`09/SNAKE_1/`09`09; name of snake event flags
X.iff
X`09.ascid`09/TANK_1/
X.endc
X
X`09.align`09long
Xsnake_map_name:
X.if ndf $$tank
X`09.ascid`09/SNAKE_DATA/
X.iff
X`09.ascid`09/TANK_DATA/
X.endc
X
Xtext = .
X`09.ascii`09<esc>'<'`09`09; enter ANSI mode
X`09.ascii`09<esc>'(B'`09`09; select ascii character set
X`09.ascii`09<esc>'`5B2J'`09`09; erase entire screen
X`09.ascii`09<esc>'`5B1;1H'`09`09; jump to top left corner
X`09.ascii`09<10>`09`09`09; linefeed
X.if ndf $$tank
X`09.ascii`09<esc>'#3                 SNAKE' ; double-height top half
X.iff
X`09.ascii`09<esc>'#3                 TANK'
X.endc
X`09.ascii`09<13><10>
X.if ndf $$tank
X`09.ascii`09<esc>'#4                 SNAKE' ; double-height bottom half
X.iff
X`09.ascii`09<esc>'#4                 TANK'
X.endc
X`09.ascii`09<13><10><10>
X`09.ascii`09<esc>'#6        Thank you for playing'
X`09.ascii`09<13><10><10>
Xtext_len = . - text
X`09.align`09long
Xtext_end_game:
X`09.long`092
X`09.long`09text
X`09.address 10$
X10$:`09.long`09text_len
X
Xtext = .
X`09.ascii`09<13><10><10>
X`09.ascii`09'Game aborted because master '
X.if ndf $$tank
X`09.ascii`09'snake'
X.iff
X`09.ascii`09'tank'
X.endc
X`09.ascii`09' quitted'<13><10><10>
Xtext_len = . - text
X`09.align`09long
Xtext_abort:
X`09.long`092
X`09.long`09text
X`09.address 10$
X10$:`09.long`09text_len
X
Xtext = .
X`09.ascii`09<esc> 'Y' <31+24> <31+1>`09; col 1, row 24
X`09.ascii`09<esc> 'G'`09`09`09; exit graphics
X`09.ascii`09<7> ' Please wait for next game ...'
X`09.ascii`09<esc> 'F'`09`09`09; enter graphics
Xtext_len = . - text
X`09.align`09long
Xtext_wait:
X`09.long`092
X`09.long`09text
X`09.address 10$
X10$:`09.long`09text_len
X
X`09.align`09long
Xusername_jpi:
X`09.word`0912, jpi$_username
X`09.address username_buf
X`09.address username_siz
X`09.long`090
X
X`09.align`09long
Xstart_wait:
X`09.long`09-10000000*5, -1`09`09; wait 5 seconds
Xsecond_1:
X`09.long`09-10000000*1, -1`09`09; wait 1 second
Xsecond_2:
X`09.long`09-10000000*2, -1`09`09; wait 2 seconds
Xupdate_wait:
X`09.long`09-100000*33, -1`09`09; wait 33/100 ths of a second
Xcheck_wait:
X`09.long`09-10000000*4, -1`09`09; wait 2 seconds for checking
Xvalid_move:
X`09.long`09`5EB101110100`09`09; valid moves are 2,4,6,8 and 5!!
Xstart_direction:
X.if ndf $$tank
X`09.byte`092, 8, 2, 8, 2, 8, 6, 4`09; initial move directions for snake
X.iff
X`09.byte`096, 4, 4, 6, 2, 8, 6, 4`09;  for tank
X.endc
X`09.align`09long
Xadd_head_par:
X`09.long`091`09`09`09; parameter list to Pascal routine
X`09.address move`09`09`09; each players move
Xupdate_par:
X`09.long`092
X`09.address outbuf
X`09.address screen_len
Xupdate_par2:`09`09`09; if we have died, then there is no head
X`09.long`092`09`09; to change to a diamond, so write screen
X`09.address screen_buf`09; update directly from global memory.
X`09.address screen_len
X
X`09.psect`09$rwbuf`09wrt, noexe, noshr, pic, page
X
Xmbxname_len = 16
Xmbxname:`09`09`09; room to hold the physical mbx name
X`09.blkb`09mbxname_len
Xmbxname_descr:
X`09.word`09mbxname_len, 0
X`09.long`09mbxname
Xmbxiosb:
X`09.long`090,0
Xmbxbuf_siz = 32
Xmbxbuf:
X`09.blkb`09mbxbuf_siz
X
Xdibbuf:
X`09.blkb`09dib$k_length
X
X`09.align`09long
Xttiosb:
X`09.long`090,0
X
Xttbuf_siz = 128
Xttbuf:
X`09.blkb`09ttbuf_siz
X`09.align`09page
Xoutbuf_siz = 512
Xoutbuf::
X`09.blkb`09outbuf_siz
X
X
X;snake_fab:
X;.if ndf $$tank
X;`09$fab`09fnm=<GAMES:SNAKE.BIN>, fop=<ufo>,-
X;`09`09fac=<get,put>, shr=<get,upd,upi>
X;.iff
X;`09$fab`09fnm=<GAMES:TANK.BIN>, fop=<ufo>,-
X;`09`09fac=<get,put>, shr=<get,upd,upi>
X;.endc
Xmap_range:
X`09.address share_data
X`09.address share_data+<512*3>
Xret_range:
X`09.long`090, 0
X
X
X`09.psect`09$sharedata wrt, noexe, shr, pic, page
Xshare_data:
X
Xgame_count:
X`09.long`09`09`09; count of number of games played
Xmaster_flag:
X`09.long`09`09`09; = 1 if we are master snake
Xabort:
X`09.long`09`09`09; = 1 if all snakes should abort
Xplayer_bits:
X`09.long`09`09`09; bit set if that snake is playing
Xplayers:
X`09.long`09`09`09; bit set if that snake is reserved
Xother_players:
X`09.long`09`09`09; used by master snake to wait for other
X`09`09`09`09; snakes to indicate operation completed
Xmove_count:
X`09.long`09`09`09; incremented every move.  Used for detecting
X`09`09`09`09; other snakes hanging the game
Xgame_going:
X`09.long`09`09`09; <> 0 if a game is going
Xyou_just_died:
X`09.long`09`09`09; bit I set if snake I just died
Xseed:
X`09.long`09`09`09; random number seed
Xstart_position:
X`09.blkl`09snake`09`09; position of starting (1-8)
X;
X;`09`095
X;    1`09+---------------+  3
X;`09`7C`09`09`7C
X;`09`7C`09`09`7C
X;    7`09`7C`09`09`7C  8
X;`09`7C`09`09`7C
X;`09`7C`09`09`7C
X;    4`09+---------------+  2
X;`09`096
X;
Xscore:
X`09.blkl`09snake`09`09; players' score
Xn_games:
X`09.blkl`09snake`09`09; # of games each player has played
Xwins:
X`09.blkl`09snake`09`09; # of wins for each player
Xplayer_pos:
X`09.blkl`09snake`09`09; starting position of each snake
X`09.align`09quad
Xmove:
X`09.blkb`09snake`09`09; each snakes move
Xname_size = 32
Xname:
X`09.blkb`09name_size * snake ; each snakes name (32 chars long)
X. = . + 512 - < . - share_data >
X`09.align`09long
Xscreen_len:
X`09.long`09`09`09; # chars to be output
Xscreen_buf:
X`09.blkb`09508`09`09; buffer containing screen update
X. = . + <512*4> - < . - share_data >
X
X
X`09.psect`09$rwdata`09wrt, noexe, noshr, pic, long
X
Xttchan:
X`09.word
Xmbxchan:
X`09.word
Xdata_ready:
X`09.word
Xmaster:
X`09.word`09`09`09; = 1 if we are master snake
Xcontrol_c_flag:
X`09.word`09`09`09; non zero if `5EC typed
Xdead:
X`09.word`09`09`09; bit I set if snake I just died
X`09.align`09long
Xcluster_2:
X`09.long
Xcluster_3:
X`09.long
Xplayer:
X`09.long
Xplayer_efn:`09`09`09; my player efn in cluster 2
X`09.long
Xcurrent_players:
X`09.long
Xchars_left:`09`09`09; # of chars left in buffer
X`09.long
Xchar_pointer:
X`09.long`09`09`09; address of next character
Xlast_move_count:
X`09.long
Xusername_buf:
X`09.blkb`0912
Xusername_siz:
X`09.long
X
Xoutbuf_qio:
X`09$qio`09func=io$_writevblk!io$m_noformat,-
X`09`09p1=outbuf
Xoutput_qio:
X`09$qio`09func=io$_writevblk!io$m_noformat
X
Xread_qio:
X`09$qio`09func=io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,-
X`09`09iosb=ttiosb,-
X`09`09p1=ttbuf, p2=ttbuf_siz, p3=0`09; wait time = 0
X
Xexit_block:`09`09`09; exit handler block
X`09.long
X`09.address snake_exit
X`09.long`091`09`09; 1 argument
X`09.address 10$
X10$:`09.long`09`09`09; exit reason
X
X
X`09.psect`09$code`09nowrt, exe, shr, pic
X
X`09.entry`09-
XTTINIT, `5Em<>
X;+
X; Create a mailbox.  Assign a channel to terminal with an associated mailbox
V.
X;-
X`09$crembx_s`09chan=mbxchan, promsk=#`5ExFF00
X`09bsbw`09`09error
X`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr
X`09bsbw`09`09error
X`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,-
X`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit
X`09$assign_s`09devnam=ttname_descr, chan=ttchan, - ; acmode=#`5ExFF00,
X`09`09`09mbxnam=mbxname_descr
X`09blbc`09r0, 100$
X`09movw`09ttchan, outbuf_qio+qio$_chan`09`09;store channel #
X`09movw`09ttchan, output_qio+qio$_chan`09`09;store channel #
X`09movw`09ttchan, read_qio+qio$_chan`09`09;store channel #
X`09$qiow_s`09func=#io$_setmode!io$m_ctrlcast, chan=ttchan,-
X`09`09p1=control_c
X`09ret
X100$:
X`09bsbw`09error
X`09ret
X
X`09.entry`09-
XTT1CHAR,`09`5Em<>
X`09clrb`09ttbuf
X`09$qiow_s`09func=#io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,-
X`09`09chan=ttchan, iosb=ttiosb,-
X`09`09p1=ttbuf, p2=#1, p3=#0`09; wait time = 0
X`09cvtbl`09ttbuf, r0
X`09cmpb`09r0, #13`09`09`09; is it <CR> ?
X`09bneq`09100$
X`09clrb`09data_ready
X100$:`09ret
X
XTTREAD::
X`09blbs`09control_c_flag, 10$
X`09tstl`09chars_left`09`09; have we used all characters ?
X`09bgtr`0950$`09`09`09; no --> 50$
X`09bbsc`09#0, data_ready, 20$`09; check if input ready
X5$:`09mnegl`09#1, r0`09`09`09; no characters read
X`09rsb`09`09`09`09; no
X10$:
X`09clrl`09r0`09`09`09; on `5EC return move 0 = quit
X`09rsb
X20$:
X`09$qiow_g read_qio
X`09blbc`09r0, 5$`09`09`09; error
X;
X;`09$qiow_s`09func=#io$_writevblk,chan=ttchan,-`09; debug write
X;`09`09p1=ttbuf, p2=ttiosb+2, p4=#`5Ex1000
X
X`09movzwl`09ttiosb+2, chars_left`09`09; # chars read
X`09movab`09ttbuf, char_pointer`09`09; store address of character
X50$:
X`09decl`09chars_left
X`09movzbl`09@char_pointer, r0`09`09; get next char
X`09incl`09char_pointer`09`09`09; point to next
X`09subb2`09#`5EA/0/, r0`09`09`09; convert from ascii to binary
X`09blss`09200$`09`09`09`09; invalid command
X`09cmpb`09r0, #9
X`09bgeq`09150$`09`09`09`09; invalid command (maybe quit)
X`09bbc`09r0, valid_move, 200$`09`09; invalid command
X.if df $$tank
X`09tstl`09chars_left`09`09`09; any chars left ?
X`09bleq`09100$`09`09`09`09; no --> 100$
X`09cmpb`09@char_pointer, #`5EA/5/`09`09; is next command fire ?
X`09bneq`09100$`09`09`09`09; no --> 100$
X`09incl`09char_pointer
X`09decl`09chars_left
X`09bisb2`09#`5EB10000, r0`09`09`09; add 16 to indicate fire
X.endc
X100$:
X`09rsb
X150$:
X`09cmpb`09r0, #`5EA/e/-`5EA/0/`09`09; was an "e" typed ?
X`09beql`09180$
X`09cmpb`09r0, #`5EA/E/-`5EA/0/`09`09; was an "E" type ?
X`09bneq`09200$
X180$:
X`09clrl`09r0`09`09`09`09; quit is move = 0
X`09rsb
X200$:
X`09mnegl`09#1, r0`09`09`09`09; no move given
X`09rsb
X
X`09.entry`09-
XMBXREAD,`09`5Em<>
X;+
X; This is an AST routine which executes when the mailbox record has been rea
Vd.
X; The record itself is a status message which is assumed to say that
X; unsolicited data is available at the terminal
X;-
X`09blbc`09mbxiosb, 100$`09`09; on error, dont re-que read
X;`09we could have SS$_CANCEL or SS$_ABORT from the $CANCEL in the
X;`09exit handler
X`09movb`09#1, data_ready`09`09; indicate data is there
X`09bsbw`09queue_mbxread`09`09; queue another read request
X100$:
X`09ret
X
XQUEUE_MBXREAD:
X`09$qio_s`09efn=#2, func=#io$_readvblk, chan=mbxchan, iosb=mbxiosb,-
X`09`09astadr=mbxread,-
X`09`09p1=mbxbuf, p2=#mbxbuf_siz
X`09blbc`09r0, 100$
X`09rsb
X100$:
X`09bsbw`09error
X`09rsb
X
XTTWRITE::
X;+
X;`09bsbw`09ttwrite
X;`09r3 contains length of buffer to write
X;`09the buffer is outbuf
X;-
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-