program DROIDS ! This is a version of DROIDS written from scratch but modeled on the ! functionality of the version on the Fall 86 VAX DECUS tape. include 'DROIDS.INC' integer*2 score , total score ! Data for end of room display integer*2 delta ! Score for current move byte reply ! A single char for replies byte double(4) ! String for double width byte bold(5) ! String for bolding logical alive ! True if we are still alive logical sonic ! True if Sonic Zapper armed logical NEXT MOVE ! external logical function data double / "33 , '#' , '6' , "200 / data bold / "33 , '[' , '1' , 'm' , "200 / !----------------------------------------------------------------------------- ! See if the user wants instructions type *, ' ' type *, ' ' type 10 10 format ( 1H+ , 'Do you want instructions? [n] ' , $ ) accept '(A1)' , reply if ( reply .eq. 'Y' .or. reply .eq. 'y' ) call INSTRUCTIONS ! Call system dependent service to ! 1) turn off echoing of characters typed at the terminal ! 2) enable single character activation (characters typed on the terminal are ! returned immediately without typing a RETURN) ! 3) Prevent CTRL-C from aborting program call SYS INIT ! Starting with 5 droids, play a room game. ! After each room game, add five additional droids and play again until ! the number of droids exceeds NDMAX. total score = 0 nroom = 0 do 1000 nstart = 5 , NDMAX , 5 nroom = nroom + 1 alive = .true. sonic = .true. score = 0 NDROIDS = nstart NDEBRIS = 0 ! Erase the display and set all lines on the display to double width, ! single height. call VT ERASE do 20 i=1,NLINES call VT POSIT ( 0 , i ) call PRINT ( double ) 20 continue call PRINT ( bold ) ! Compute new board positions call NEW ROOM ( nstart ) ! Put the stuff on the board do 120 i=1,NDROIDS call VT CHAR ( XA(i) , YA(i) , DROID ) 120 continue call VT CHAR ( XP , YP , PLAYER ) call VT POSIT ( XP , YP ) ! Play the current room 150 alive = NEXT MOVE ( delta , sonic ) score = score + delta total score = total score + delta if ( alive .and. NDROIDS .ne. 0 ) go to 150 ! The current room game is over. Display results call SHOW SCORE ( nroom , nstart , score , total score ) if ( NDROIDS .ne. 0 ) go to 2000 1000 continue call VT ERASE call VT POSIT ( 0 , 11 ) type *, 'Congratulations! You are a master droid slayer.' i = ISLEEP (0,0,5,0) ! Call any system specific stuff to wrap up 2000 call SYS END ( total score ) end c============================================================================= subroutine INSTRUCTIONS byte reply call VT ERASE call VT POSIT ( 0,1 ) type *, 'You have landed on a space-station populated by droids.' type *, 'Each room in the space station is 40 x 24.' type *, 'Each room contains progressively more droids.' type *, ' ' type *, 'These droids have just one function: To destroy all' type *, 'intruders. (Unfortunately, this includes you.)' type *, 'Droids are programmed to walk directly towards intruders.' type *, 'They explode upon impact, leaving a pile of debris.' type *, ' ' type *, 'Press RETURN for next page:' accept '(A1)', reply call VT ERASE call VT POSIT ( 0,1 ) type *, 'You have three choices of action:' type *, ' 1. You can move in any direction or stand still.' type *, ' 2. You can teleport at any time.' type *, ' (Careful - you may end up next to a droid.)' type *, ' 3. You can use the ominous Sonic Zapper once per room.' type *, ' (This disintegrates all droids adjacent to you.)' type *, ' ' type *, 'Your goal is to destroy all droids by causing them to' type *, 'walk into each other or into piles of droid debris.' type *, ' ' type *, 'Your controls:' type *, ' ' type *, ' 1-9 Move one step in any direction' type *, ' T Teleport' type *, ' S Sonic Zapper' type *, ' L Last stand (for this room)' type *, ' Ctrl-R Refresh screen' type *, ' ' type *, 'Scoring:' type *, ' ' type *, ' 10 points for each droid you explode.' type *, ' 1 point for each droid you Sonically Zap.' type *, ' ' type *, ' ' type 10 10 format ( 1H+,'Press RETURN when ready: ',$ ) accept '(A1)' , reply end c============================================================================= subroutine NEW ROOM ( NSTART ) ! Compute droid positions such that no two occupy the same place. ! Compute player position such that it doesn't share place with droid. integer*2 NSTART include 'DROIDS.INC' do 100 i = 1 , NSTART+1 10 call RAN POS ( nx , ny ) if ( i .ne. 1 ) then do 20 k = 1,i-1 if ( nx .eq. XA(k) .and. ny .eq. YA(k) ) go to 10 20 continue end if if ( i .lt. NSTART+1 ) then XA(i) = nx YA(i) = ny STATE(i) = DROID else XP = nx YP = ny end if 100 continue end c============================================================================= logical function NEXT MOVE ( DELTA , SONIC ) ! Play the next move include 'DROIDS.INC' integer*2 DELTA logical SONIC byte char , ctrlC , ctrlR , double(4) data ctrlC / 3 / data ctrlR / 18 / data double / "33 , '#' , '6' , "200 / DELTA = 0 NEXT MOVE = .true. ! Get a typed character. If it is a Ctrl-C, end the game. 10 ichar = ITTINR() if ( ichar .lt. 0 ) go to 10 char = ichar if ( char .eq. ctrlC ) call SYS END ( -1 ) ! T --> TELEPORT: Compute a random board position. If the position is not ! occupied by a droid or debris, move the player there. ! If the position is occupied, let the player die and end ! the game. if ( char .eq. 'T' ) then call RAN POS ( nx , ny ) call VT CHAR ( XP , YP , GONE ) call TELEPORT ( XP , YP , nx , ny ) XP = nx YP = ny do 20 i=1,NDROIDS if ( XP .eq. XA(i) .and. YP .eq. YA(i) ) then DELTA = 0 NEXT MOVE = .false. call VT CHAR ( XP , YP , DEATH ) return end if 20 continue if ( NDEBRIS .ne. 0 ) then do 30 i=1,NDEBRIS if ( XP .eq. XD(i) .and. YP .eq. YD(i) ) then DELTA = 0 NEXT MOVE = .false. call VT CHAR ( XP , YP , DEATH ) return end if 30 continue end if call VT CHAR ( XP , YP , PLAYER ) ! S --> SONIC ZAPPER: If the Zapper is still active, wipe out any droids ! that are within 1 square of player and score one ! point for each. If the Zapper is used, ring the bell ! and return. else if ( char .eq. 'S' ) then if ( SONIC ) then do 40 i=1,NDROIDS if ( IABS( XA(i)-XP ) .le. 1 .and. 1 IABS( YA(i)-YP ) .le. 1 ) 2 then STATE (i) = GONE call VT CHAR ( XA(i) , YA(i) , GONE ) DELTA = DELTA + 1 SONIC = .false. end if 40 continue call PURGE DROIDS if ( NDROIDS .eq. 0 ) then NEXT MOVE = .false. return end if else write (5,50) BELL 50 format ( 1H+,A1,$ ) return end if ! 1-9 --> MOVE: If the move would be off the board, ring the bell and return. ! Otherwise, move the player to the desired square. If the ! player ran into debris, that is the end of the game. else if ( char .ge. '1' .and. char .le. '9' ) then ichar = char - "60 ny = -2 + (ichar+2) / 3 nx = ichar-5 - ny*3 if ( nx .ne. 0 .or. ny .ne. 0 ) then nx = XP + nx ny = YP - ny if ( nx .lt. 1 .or. nx .gt. ncols 1 .or. ny .lt. 1 .or. ny .gt. nlines ) then write (5,60) bell 60 format ( 1H+,A1,$ ) return end if call VT CHAR ( XP , YP , GONE ) XP = nx YP = ny if ( NDEBRIS .ne. 0 ) then do 70 i = 1,NDEBRIS if ( XD(i) .eq. XP .and. YD(i) .eq. YP ) then DELTA = 0 NEXT MOVE = .false. call VT CHAR ( XP , YP , DEATH ) return end if 70 continue end if call VT CHAR ( XP , YP , PLAYER ) end if ! Ctrl-R --> Repaint screen else if ( char .eq. ctrlR ) then call VT ERASE do 71 i=1,NLINES call VT POSIT ( 0 , i ) call PRINT ( double ) 71 continue do 72 i=1,NDROIDS call VT CHAR ( XA(i) , YA(i) , DROID ) 72 continue if ( NDEBRIS .ne. 0 ) then do 73 i=1,NDEBRIS call VT CHAR ( XD(i) , YD(i) , DEBRIS ) 73 continue end if call VT CHAR ( XP , YP , PLAYER ) call VT POSIT ( XP , YP ) return ! All else except L (Last Stand) is unknown, so ring bell and return. else if ( char .ne. 'L' ) then write (5,80) BELL 80 format ( 1H+,A1,$ ) return end if !......................................................................... 9999 continue ! See if I ran into an droid do 90 i = 1,NDROIDS if ( XA(i) .eq. XP .and. YA(i) .eq. YP ) then DELTA = 0 NEXT MOVE = .false. call VT CHAR ( XP , YP , DEATH ) return end if 90 continue ! Move all the droids. If an droid collides with debris, eliminate ! it and score 10 points. If it collides with another droid that has ! already moved, eliminate them both, replace them with debris, and score ! 20 points. If the droid was able to move, check to see if it got ! the player do 200 i=1,NDROIDS if ( i .ne. 1 ) then do 100 j=1,i-1 if ( XA(i) .eq. XA(j) .and. YA(i) .eq. YA(j) ) go to 101 100 continue end if call VT CHAR ( XA(i) , YA(i) , GONE ) 101 continue if ( XA(i) .gt. XP ) XA(i) = XA(i) - 1 if ( XA(i) .lt. XP ) XA(i) = XA(i) + 1 if ( YA(i) .gt. YP ) YA(i) = YA(i) - 1 if ( YA(i) .lt. YP ) YA(i) = YA(i) + 1 if ( NDEBRIS .ne. 0 ) then do 110 j=1,NDEBRIS if ( XA(i) .eq. XD(j) .and. YA(i) .eq. YD(j) ) then STATE(i) = GONE DELTA = DELTA + 10 end if 110 continue end if if ( i .ne. 1 ) then do 120 j = 1 , i-1 if ( STATE(j) .eq. DROID ) then if ( XA(i).eq.XA(j) .and. YA(i).eq.YA(j) ) then call VT CHAR ( XA(i) , YA(i) , DEBRIS ) NDEBRIS = NDEBRIS + 1 XD(NDEBRIS) = XA(i) YD(NDEBRIS) = YA(i) STATE(i) = GONE STATE(j) = GONE DELTA = DELTA + 20 end if end if 120 continue end if if ( STATE(i) .ne. GONE ) call VT CHAR ( XA(i), YA(i), DROID ) if ( XA(i) .eq. XP .and. YA(i) .eq. YP ) then DELTA = 0 NEXT MOVE = .false. call VT CHAR ( XP , YP , DEATH ) return end if 200 continue call PURGE DROIDS ! Move cursor to players position call VT POSIT ( XP , YP ) ! If Last Stand, loop back for more if ( char .eq. 'L' ) then if ( NDROIDS .ne. 0 ) go to 9999 NEXT MOVE = .false. end if end c============================================================================= subroutine PURGE DROIDS include 'DROIDS.INC' i = 1 10 if ( STATE(i) .eq. GONE ) then if ( i .lt. NDROIDS ) then XA(i) = XA(NDROIDS) YA(i) = YA(NDROIDS) STATE(i) = STATE(NDROIDS) i = i - 1 end if NDROIDS = NDROIDS - 1 end if i = i + 1 if ( i .le. NDROIDS ) go to 10 end c============================================================================= subroutine RAN POS ( NX , NY ) include 'DROIDS.INC' integer*4 j data j / 0 / nx = IFIX ( FLOAT(NCOLS) * RAN(j) ) + 1 if ( nx .gt. NCOLS ) nx = NCOLS ny = IFIX ( FLOAT(NLINES) * RAN(j) ) + 1 if ( ny .gt. NLINES ) ny = NLINES end c============================================================================= subroutine RESULTS ( TOTAL SCORE ) byte text(40) , name(40) , datbuf(9) integer*2 TOTAL SCORE , score real*8 filename(2) logical entered data filename / 12RGAMDROIDSNEW , 12RGAMDROIDSSCR / ! Get an ASCII string containing the date call DATE ( datbuf ) ! Open the score file and read the status line. open ( unit = 2 , name = 'GAM:DROIDS.SCR' , type='OLD' , 1 carriagecontrol='LIST' , err=100 ) ! Scan the score file to get the max and min. read ( 2 , '(Q,40A1)' , err=500 ) n , text min = 32765 max = 0 items = 0 1 read ( 2 , '(I7,Q,40A1)' , err=500 , end=2 ) nscore , n , text items = items + 1 if ( nscore .lt. min ) min = nscore if ( nscore .gt. max ) max = nscore go to 1 2 continue ! If there are already 20 entries and the score for this game is less ! than the minimum, do not enter the new score. if ( items .eq. 20 .and. TOTAL SCORE .le. min ) then write (5,3) min 3 format ( ' You did not make the championship list.'/ 1 ' You needed a score of better than ',I5 ) close ( unit=2 ) return end if ! Open a new score file. open ( unit = 3 , name = 'GAM:DROIDS.NEW' , type='NEW' , 1 carriagecontrol='LIST' , err=300 ) ! Get the user's name type *, 'Let me know your name so I can record it for posterity:' accept '(Q,40A1)', nchars , name ! Write the status line and header line to score file. if ( TOTAL SCORE .gt. max ) max = TOTAL SCORE if ( TOTAL SCORE .lt. min ) min = TOTAL SCORE rewind 2 read ( 2 , '(Q,40A1)' , err=500 ) n , text write ( 3 , '(A1)' ) (text(i),i=1,n) write ( 5 , '(1x,A1)' ) (text(i),i=1,n) ! Scan through the data, adding the new score. items = 0 entered = .false. 10 read ( 2 , '(I7,Q,40A1)' , err=500 , end=30 ) nscore , n , text if ( .not. entered ) then if ( TOTAL SCORE .gt. nscore ) then write ( 3 , 20 ) TOTAL SCORE , dat buf , (name(i),i=1,nchars) write ( 5 , 20 ) TOTAL SCORE , dat buf , (name(i),i=1,nchars) 20 format ( I7 , 2x , 9A1 , 2x , A1 ) items = items + 1 if ( items .eq. 20 ) go to 30 entered = .true. end if end if write ( 3 , '(I7,A1)' ) nscore , (text(i),i=1,n) write ( 5 , '(I7,A1)' ) nscore , (text(i),i=1,n) items = items + 1 if ( items .lt. 20 ) go to 10 30 if ( items .lt. 20 .and. .not. entered ) then write ( 3 , 20 ) TOTAL SCORE , dat buf , (name(i),i=1,nchars) write ( 5 , 20 ) TOTAL SCORE , dat buf , (name(i),i=1,nchars) end if close ( unit = 2 ) close ( unit = 3 ) i = IGETC() call IRENAME ( i , FILENAME ) call IDELETE ( i , FILENAME ) call IFREEC ( i ) return ! Create a new score file 100 open ( unit = 2 , name = 'GAM:DROIDS.SCR' , type='NEW' , err=200 ) type *, 'I could not find any championship data, so this game be' type *, 'the first entry. By the way, what is your name?' accept '(Q,40A1)', n , name write ( 2 , 110 ) type 110 110 format ( '======= Droids Champions =======' ) write ( 2 , 120 ) TOTAL SCORE , datbuf , (name(i),i=1,n) type 120 , TOTAL SCORE , datbuf , (name(i),i=1,n) 120 format ( I7 , 2x , 9A1 , 2x , A1 ) close ( unit = 2 ) return 200 type *, 'You have not defined the logical name GAM,' type *, 'or there are too many things loaded,' type *, 'so I could not display championship scores.' return 300 type *, 'Not enough room on GAM to update championship scores.' return 500 type *, 'Error reading score file.' end c============================================================================= subroutine SHOW SCORE ( NROOM , NSTART , SCORE , TOTAL SCORE ) include 'DROIDS.INC' integer*2 NROOM , NSTART , SCORE , TOTAL SCORE , offset byte reply byte decsg(3) , ls2(2) , ls0 , ss2(2) data decsg / "33 , ')' , '0' / ! DEC special graphics -> G1 data ls0 / "17 / ! Lock shift G0 data ls1 / "16 / ! Lock shift G1 if ( YP .gt. 12 ) then offset = 0 else offset = 15 end if call VT POSIT ( 0 , 1+offset ) write ( 5,10 ) decsg , ls1 , ls0 10 format ( 1H+,4A1,'lqqqqqqqqqqqqqqqqqqqqqqqqqk',A1,$ ) call VT POSIT ( 0 , 2+offset ) write ( 5,20 ) ls1,'x',ls0 , NROOM , ls1,'x',ls0 20 format ( 1H+,3A1,' Room #: ',I6,' ',3A1,$ ) call VT POSIT ( 0 , 3+offset ) write ( 5,30 ) ls1,'x',ls0 , NSTART , ls1,'x',ls0 30 format ( 1H+,3A1,' Droids in room: ',I6,' ',3A1,$ ) call VT POSIT ( 0 , 4+offset ) write ( 5,40 ) ls1,'x',ls0 , SCORE , ls1,'x',ls0 40 format ( 1H+,3A1,' Score this round:',I6,' ',3A1,$ ) call VT POSIT ( 0 , 5+offset ) write ( 5,50 ) ls1,'x',ls0 , TOTAL SCORE , ls1,'x',ls0 50 format ( 1H+,3A1' Total score: ',I6,' ',3A1,$ ) call VT POSIT ( 0 , 6+offset ) write ( 5,60 ) ls1 , ls0 60 format ( 1H+,A1,'mqqqqqqqqqqqqqqqqqqqqqqqqqj',A1,$ ) call VT POSIT ( 0 , 7+offset ) if ( NDROIDS .ne. 0 ) write ( 5,70 ) 70 format ( 1H+,'Game over. ',$ ) write ( 5,80 ) 80 format ( 1H+,'Press RETURN when ready: ',$ ) accept '(A1)' , reply if ( reply.eq.'N' .or. reply.eq.'n' ) call sys end (TOTAL SCORE) if ( reply .eq. 3 ) call sys end (TOTAL SCORE) end c============================================================================= subroutine TELEPORT ( IX1 , IY1 , IX2 , IY2 ) ! Draw a streak from (IX1,IY1) to (IX2,IY2) include 'DROIDS.INC' do 1000 ipass = 1,2 dx = IX2 - IX1 dy = IY2 - IY1 if ( dx .eq. 0 .and. dy .eq. 0 ) return if ( abs(dx) .ge. abs(dy) ) then dy = dy / abs(dx) dx = dx / abs(dx) else dx = dx / abs(dy) dy = dy / abs(dy) end if ix = ix1 iy = iy1 t = 0. 10 continue if ( ipass .eq. 2 ) then do 20 i = 1,NDROIDS if ( XA(i) .eq. ix .and. YA(i) .eq. iy ) then call VT CHAR ( ix , iy , DROID ) go to 40 end if 20 continue if ( NDEBRIS .ne. 0 ) then do 30 i = 1,NDEBRIS if ( XD(i) .eq. ix .and. YD(i) .eq. iy ) then call VT CHAR ( ix , iy , DEBRIS ) go to 40 end if 30 continue end if call VT CHAR ( ix , iy , GONE ) 40 continue end if t = t + 1. ix = ix1 + t * dx + 0.5 iy = iy1 + t * dy + 0.5 if ( ipass .eq. 1 ) call VT CHAR ( ix , iy , PLAYER ) if ( ix .ne. ix2 .or. iy .ne. iy2 ) go to 10 1000 continue call VT CHAR ( ix , iy , PLAYER ) end c============================================================================= subroutine VT CHAR ( ix , iy , char ) byte iposit (10) , char data iposit / "33, '[', '0', '0', ';', '0', '0', 'H', 'X', 0 / if ( iy .lt. 10 ) then iposit(3) = iy + "60 iposit(4) = ';' next = 5 else n10 = iy / 10 n1 = iy - 10*n10 iposit(3) = n10 + "60 iposit(4) = n1 + "60 iposit(5) = ';' next = 6 end if if ( ix .lt. 10 ) then iposit(next+0) = ix + "60 iposit(next+1) = 'H' iposit(next+2) = char iposit(next+3) = "200 else n10 = ix / 10 n1 = ix - 10*n10 iposit(next+0) = n10 + "60 iposit(next+1) = n1 + "60 iposit(next+2) = 'H' iposit(next+3) = char iposit(next+4) = "200 end if call print ( iposit ) end c============================================================================= subroutine VT POSIT ( ix , iy ) byte iposit (9) data iposit / "33, '[', '0', '0', ';', '0', '0', 'H', 0 / if ( iy .lt. 10 ) then iposit(3) = iy + "60 iposit(4) = ';' next = 5 else n10 = iy / 10 n1 = iy - 10*n10 iposit(3) = n10 + "60 iposit(4) = n1 + "60 iposit(5) = ';' next = 6 end if if ( ix .lt. 10 ) then iposit(next+0) = ix + "60 iposit(next+1) = 'H' iposit(next+2) = "200 else n10 = ix / 10 n1 = ix - 10*n10 iposit(next+0) = n10 + "60 iposit(next+1) = n1 + "60 iposit(next+2) = 'H' iposit(next+3) = "200 end if call print ( iposit ) end c============================================================================= subroutine VT ERASE byte string (5) data string / "33 , '[' , '2' , 'J' , "200 / call PRINT ( string ) end c============================================================================= subroutine SYS INIT ! System dependent routine to ! ! 1) turn off echoing of characters typed at the terminal ! 2) enable single character activation (characters typed on the terminal are ! returned immediately without typing a RETURN) ! 3) Prevent CTRL-C from aborting program integer*4 j i = IPEEK ( "44 ) i = i .and. '137777'O i = i .or. '010120'O call IPOKE ( "44 , i ) 10 i = ITTINR() if ( i .ge. 0 ) go to 10 call SCCA ( iflag ) call GTIM ( j ) i = j/65500 .and. '1777'O do 20 k=1,i call RAN POS ( NX , NY ) 20 continue end c============================================================================= subroutine SYS END ( TOTAL SCORE ) integer*2 TOTAL SCORE byte attoff (5) data attoff / "33 , '[' , '0' , 'm' , "200 / ! System dependent routine to clean up and return to monitor call VT ERASE call PRINT ( attoff ) call VT POSIT ( 1,1 ) i = IPEEK ( "44 ) i = i .and. '167677'O call IPOKE ( "44 , i ) if ( TOTAL SCORE .ne. -1 ) call RESULTS ( TOTAL SCORE ) call SCCA call EXIT end