-+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+
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
Xsnake_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;-
X`09movl`09r3, outbuf_qio+qio$_p2`09`09; store length of buffer
X`09$qiow_g`09outbuf_qio
X`09blbc`09r0, 100$
X`09rsb
X100$:
X`09bsbw`09error
X`09rsb
X
X
X`09.entry`09-
Xsnake_screen, `5Em<r2,r3,r4,r5>
X;+
X;`09CALL SNAKE_SCREEN( array, length )
X;`09BYTE ARRAY( LENGTH )
X;`09copies string to update screen into shared memory
X;-
X`09movl`09@8(ap), r0`09`09; get length
X`09movl`09r0, screen_len`09`09; store length
X`09movc3`09r0, @4(ap), screen_buf`09; copy text
X`09ret
X
X`09.entry`09-
Xsnake_write, `5Em<>
X;+
X;`09CALL SNAKE_WRITE( array, length )
X;`09BYTE ARRAY( LENGTH )
X;`09writes buffer to terminal in noformat mode
X;-
X`09movl`094(ap), output_qio+qio$_p1`09; store address of buffer
X`09movl`09@8(ap), output_qio+qio$_p2`09; store length of buffer
X`09$qiow_g`09output_qio
X`09blbc`09r0, 100$
X`09ret
X100$:
X`09bsbw`09error
X`09ret
X
X`09.entry`09-
Xsnake_dead, `5Em<>
X;+
X;`09CALL SNAKE_DEAD( player # )
X;-
X`09subl3`09#1, @4(ap), r0`09`09`09; get # of snake who died
X`09bbss`09r0, you_just_died, 100$`09`09; set flag saying he died
X100$:`09ret
X
X
X`09.entry -
XCANCELTYPEAHEAD, `5Em<>
X`09clrl`09r0
X`09tstw`09ttchan`09`09; check channel is open
X`09beql`09100$
X`09$qiow_s`09func=#io$_readvblk!io$m_purge!io$m_timed,-
X`09`09chan=ttchan, p1=ttbuf`09; do read with 0 length buffer (p2)
X100$:`09ret`09`09`09; return with status in r0
X
XERROR:
X`09blbs`09r0, 100$
X`09pushl`09r0
X`09calls`09#1, G`5Elib$signal
X100$:
X`09rsb
X
X`09.entry`09-
Xcontrol_c, `5Em<>
X`09movb`09#1, control_c_flag
X`09ret
X
X
X`09.page
X`09.entry`09-
XSNAKE_INIT, `5Em<r2,r3,r4,r5>`09`09`09`09; snake game
X;+
X;`09I = SNAKE_INIT( player # , game )
X;`09returns I = 1 if you are master snake.
X;`09returns your player # as a integer
X;`09returns game = 1 if there is a game in progress
X;-
X
X`09calls`09#0, G`5Ettinit`09`09`09; open terminal
X;
X`09$ascefc_s efn=#64, name=snake_desc_2`09; associate event flag cluster
X`09bsbw`09error
X;
X;`09$open`09fab=snake_fab`09`09`09; open section file
X;`09bsbw`09error
X
X`09$deltva_s inadr=map_range`09`09; delete memory were global
X`09bsbw`09error`09`09`09`09;  memory will be mapped
X
X`09$crmpsc_s inadr=map_range, flags=#sec$m_gbl!sec$m_wrt!sec$m_pagfil, -
X`09`09gsdnam=snake_map_name, -`09; chan=snake_fab+fab$l_stv,-
X`09`09pagcnt=#4
X`09bsbw`09error
X
X`09cmpl`09r0, #ss$_created`09`09; are we first to map section
X`09bneq`0950$`09`09`09`09; no
X`09movab`09share_data+4, r3
X`09movc5`09#0, (r3), #0, #512-4, (r3)`09; clear everything except count
X`09$clref_s efn=#flag$v_game+64`09`09; say not game
X`09movl`09#39814571, seed`09`09`09; init random n.g. seed
X`09movl`09#snake, r0`09`09`09; 8 snakes
X20$:
X`09movl`09r0, start_position-4`5Br0`5D`09; init start position
X`09sobgtr`09r0, 20$
X50$:
X`09blbc`09abort, 60$`09`09`09; if not abort --> 60$
X`09callg`09text_abort, snake_write
X`09$exit_s #1
X60$:
X`09bsbw`09queue_mbxread`09`09`09; start terminal read
X;
X`09bbss`09#0, master_flag, 100$`09`09; see if a master snake exists
X`09`09`09; this should be interlocked on a multi-processor
X;+
X; We will have to be the master snake
X;-
X`09movb`09#1, master`09`09`09; indicate we are master snake
X`09$setef_s efn=#7`09`09`09`09; set for first call
X100$:
X;
X`09clrl`09r1`09`09`09`09; start at player 0 (bit0=1)
X150$:
X`09bbcs`09r1, players, 200$`09`09; see if this snake is free
X`09incl`09r1`09`09`09`09; go to next snake
X`09cmpl`09r1, #snake`09`09`09; have we checked all snakes?
X`09blss`09150$`09`09`09`09; no --> 150$
X`09mnegl`09#1, r1`09`09`09`09; player = -1 means none
X200$:
X`09movl`09r1, player`09`09`09; store my snake number (0-7)
X`09movl`09player, @4(ap)`09`09`09;  and return it
X500$:
X`09movzbl`09game_going, @8(ap)`09`09; return game going flag
X
X`09movl`09r1, r3
X`09$getjpi_s itmlst=username_jpi`09`09; get our username
X`09mull2`09#name_size, r3`09`09`09; get offset to start of name
X`09blss`09600$`09`09`09`09; no snakes available
X`09movc5`09username_siz, username_buf, #`5Ea/ /, #name_size, name(r3)
X`09`09`09`09`09`09; copy username
X600$:
X`09$dclexh_s desblk=exit_block`09`09; declare exit handler
X`09bsbw`09error
X
X`09movzbl`09master, r0`09`09`09; return master snake status
X`09ret
X
Xmaster_wait:
X;+
X; master snake has to wait some time for other snakes to start playing
X; called from SNAKE_START
X;-
X`09incl`09game_count`09`09`09; say another game being played
X220$:`09clrb`09player_bits`09`09`09; no other players
X`09bbss`09player, player_bits, 400$`09; say I am playing
X400$:
+-+-+-+-+-+-+-+-  END  OF PART 4 +-+-+-+-+-+-+-+-