program SPACE
C***********************************************************************C
C C
C SPACE INVADERS FOR VT52 C
C C
C Original version by: Steve Hillyard April 1980 C
C British Aerospace C
C Warton C
C C
C Modified: Mike McIntosh & Richard Perkin C
C National Coal Board C
C Burton on Trent C
C C
C New style invaders, Score file and cheeky comments:- C
C Steve Hillyard C
C C
C Converted to RT11 under RSTS/E:- C
C Danny O'Mara June 1980 C
C Digital Equipment Co. Ltd C
C FS Product Support C
C Reading C
C C
C Modified: Bruce Harper Sept 1981 C
C for RT-11 V4 Public Works Dept. NSW C
C Hydraulics Laboratory C
C Manly Vale 2093 AUST C
C C
C Auto restart included at end of game, finish using Z C
C OR control-C. C
C Game sped up considerably, ability to tune the game C
C to suit different systems and extra degrees of C
C difficulty added. C
C C
C NLOOP controls relative speed of cannon movement, rockets C
C mystery invader and kills compared with other invaders C
C and bombs. This value set high initially to provide C
C an advantage for cannon then decreased by 1 each game. C
C C
C MMOVE controls the speed of the mystery invader relative to C
C the cannon and rocket. Set high initially to slow C
C mystery and decreased by 1 each new game. C
C C
C PMYS probability of mystery occuring, increased by 20% C
C each game between 3 and 7. C
C C
C PBOMB probability of bombs dropping, increased by 20% each C
C new game between 3 and 7. C
C C
C MSTEP integer step of the mystery invader across the screen C
C initially set to 1 but set to 2 at start of 5th game C
C which means 50% chance of destroying with a C
C "direct hit" and twice as fast. C
C C
C Each of NLOOP, MMOVE, PMYS and PBOMB must be initially C
C specified on the first record of SPACE.DAT and may be C
C dynamically alteredby an inbuilt TUNING procedure (see BASE). C
C Original values of variables were: C
C NLOOP=2 C
C MMOVE=1 C
C PMYS=.01 C
C PBOMB=.1 C
C If the game is still in TUNING MODE when exit occurs (e.g.Z) C
C then the new parameters are output to SPACE.DAT. C
C C
C Some cleanup for DECUS submission: C
C Dr R N Caffin C
C CSIRO Division of Textile Physics C
C 338 Blaxland Road C
C Ryde NSW 2112 C
C Australia C
C C
C***********************************************************************C
integer iscore,ihiscr
integer invder(5,10),invpos(5,10,2),my2(10)
integer bompos(10,2),bombs(10)
integer sh(5,4),sh1(5,4)
integer count,oldcnt,my1(10)
byte string(80)
byte champ(30),tune(22),player(30)
common /scoreb/ iscore,ihiscr,champ,player
common /start/istart
common /ranblk/i1,i2
common /basblk/jx,ioldjx
common /misblk/mx,miss,ifire,nloop,mmove,mstep,pmys,pbomb,ntune
common /invblk/invder,invpos,bompos,bombs,my2
common /shltbl/sh,sh1
c Program starts here.
10 istart=0 !Restart flag: 1 => restart
call vt52 !Make VT100 into VT52
call ranst
iscore=0
clrtop=0 !Says don't clear above invader
igoes=0
invtyp=1 !Set up invader type
open(unit=4,name='SPACE.DAT',type='OLD')
read(4,1000)nloop,mmove,pmys,pbomb
1000 format(2i,2f)
ntune=1
mstep=1
read(4,1010) ihiscr !Read current best score
1010 format(i5)
read(4,1020) champ !and Holder
1020 format(30a1)
close(unit=4)
call intro !set up header and get Players name
itopy=19 !start with 19 as top row.
C Start new game
igame=0
20 igame=igame+1
if(igame.eq.1) goto 40
if(igame.lt.3.or.igame.gt.7) goto 30
pmys=pmys+pmys*0.2
pbomb=pbomb+pbomb*0.2
if(igame.eq.5) mstep=2
30 mmove=mmove-1
if(mmove.lt.1) mmove=1
nloop=nloop-1
if(nloop.lt.1) nloop=1
40 itopy=itopy-1 !Start one lower every time
if(itopy.lt.12) itopy=18 !Min height is 13
oldcnt=50 !No at last count
nogo=0 !Flag 1st time thru
lastgo=-1 !Force drawing of cannon
ioscor=-1 !force drawing of score
do 60 i=1,5 !Set up new array of invaders
do 60 j=1,10
invder(i,j)=1
if(j.gt.4) goto 60
sh(i,j)=10 !and fresh shelters
sh1(i,j)=0
60 continue
call clear !Clear the screen
do 70 i=1,80
string(i)='='
70 continue
call posop(0,0,80,string) !Draw it.
call graphi(0)
call posop(4,23,10,'Champion: ')
call posop(14,23,30,champ)
call posop(44,23,9,' Record: ')
encode(5,1030,a) ihiscr
1030 format(i5)
call posop(53,23,5,a)
call posop(58,23,13,' Your Score: ')
idir=2 !moving right to start
ix=5 !initial position of invaders
iy=itopy
80 continue
jx=4 !New cannon from LHS
ioldjx=-1 !Force drawing
call base !set up base
90 count=0 !count for no. of invaders left
minx=80 !need max & min x positions
maxx=0
miny=24
do 100 i=1,10
my1(i)=0 !lowest invader in each column
100 continue
C Major loop starts here
do 180 j=1,5
do 180 i=1,10
if(invder(j,i).eq.0)goto 170 !If zero invader(i,j) is dead
count=count+1 !count invaders still remaining
nx=ix+6*i !work out x & y Co-ords for invader
ny=iy-2*j
if(ny.lt.miny) miny=ny !Get lowest invaders position
invpos(j,i,1)=nx !store them in position array
invpos(j,i,2)=ny
if(nx.gt.maxx) maxx=nx !Change Max & Min X if necessary
if(nx.lt.minx) minx=nx
if(j.gt.my1(i)) my1(i)=j !Say which invader is lowest in stack
if(j.ne.3) call graphi(1) !turn on graphics mode if not {} or }{
if(invtyp.gt.0) goto 110 !Which invader
if(j.le.2) call posop(nx,ny,6,' <> ')
if(j.eq.3) call posop(nx,ny,6,' }{ ')
if(j.ge.4) call posop(nx,ny,7,' ')
goto 120
110 if(j.le.2) call posop(nx,ny,6,' >< ')
if(j.eq.3) call posop(nx,ny,6,' {} ')
if(j.ge.4) call posop(nx,ny,7,' >a< ')
120 if(clrtop.eq.0) goto 130 !Only clear above on direction change
call posop (nx,ny+1,7,' ')
130 call graphi(0) !Graphics off
if(nogo.eq.0) goto 160 !Not allowed to fire first time
do 140 loop=1,nloop
call base
if(istart.ne.0) goto 10
call kill(ioscor)
call myster
140 continue
if(ny.eq.1) goto 150 !If invader is at ground level
C ! check for crash
call bomb(igoes,oldcnt)
if(istart.ne.0) goto 10
call shlter
goto 160 !can't have crash
150 call dead !Blow-up craft
call leave(0) !sorry, you,ve been invaded
goto 10 !Restart game
160 continue
c End of invaders moving
c Draw up remaining cannon
if(lastgo.eq.igoes) goto 170
call cannon(3-igoes)
lastgo = igoes
170 continue
c Write up tuning details
if(ntune.gt.0) goto 180
encode(22,1040,tune)nloop,mmove,pmys,pbomb
1040 format(2i4,2f7.4)
call posop(6,22,8,'Tuning: ')
call posop(14,22,22,tune)
180 continue
clrtop=0
if(miny.ne.2) goto 200 !If Invader hit shelter level
do 190 i=1,5 ! then it's goodby shelters
do 190 j=1,4 !
sh(i,j)=0
190 continue
call shlter !Draw adjusted shelters
200 nogo=1 !Start shooting
do 210 i=1,10 !store lowest invader
my2(i)=my1(i)
210 continue
if(minx.le.2) goto 220 !Hit left limit
if(maxx.ge.73) goto 220 !Hit right limit
goto 230
220 iy=iy-1 !Down a line
idir=-idir !Change direction
clrtop=1 !Clear above next time thru
230 ix=ix+idir !Move Top left
invtyp=-invtyp !Other invader this time
if(count.eq.0) goto 20 !Got them all start again
oldcnt=count !Keep record of amount to go
goto 90
end
c ****
subroutine leave(ipanic)
c
common /misblk/mx,miss,ifire,nloop,mmove,mstep,pmys,pbomb,ntune
common /scoreb/iscore,ihiscr,champ,player
integer iscore,isco,ihiscr,inewsc,ipanic
logical*1 champ(30),player(30)
integer scores(11),sort
logical*1 names(11,30),temp(30)
c
call spin(0)
isco=iscore
call clear
open(unit=4,name='SPACE.DAT',type='OLD') !reopen file
read(4,1000)ndum,mdum,pmdum,pbdum
1000 format(2i,2f)
c
do 20 i=1,10 !Get top ten scores
read(4,1010) scores(i)
1010 format(i5)
read(4,1020) temp ! and names
1020 format(30A1)
do 10 j=1,30
names(i,j)=temp(j)
10 continue
20 continue
close(unit=4) !Shut file
scores(11)=iscore
do 30 j=1,30
names(11,j)=player(j)
30 continue
40 sort=0
do 60 i=1,10
if(scores(i).ge.scores(i+1)) goto 60
sort=scores(i)
scores(i)=scores(i+1)
scores(i+1)=sort
sort=1
do 50 j=1,30
temp(j)=names(i,j)
names(i,j)=names(i+1,j)
names(i+1,j)=temp(j)
50 continue
60 continue
if(sort.ne.0) goto 40
c
open(unit=4,name='SPACE.DAT',type='NEW',carriagecontrol='LIST')
c
if(iscore.gt.ihiscr) goto 70 !Who is champ.
iscore=iscore/200
if(ipanic.eq.1) goto 90
if(iscore.eq.0) write(5,410)
if(iscore.eq.1) write(5,411)
if(iscore.eq.2) write(5,412)
if(iscore.eq.3) write(5,413)
if(iscore.eq.4) write(5,414)
if(iscore.eq.5) write(5,415)
if(iscore.eq.6) write(5,416)
if(iscore.eq.7) write(5,417)
if(iscore.eq.8) write(5,418)
if(iscore.eq.9) write(5,419)
if(iscore.eq.10) write(5,420)
if(iscore.eq.11) write(5,421)
if(iscore.eq.12) write(5,422)
if(iscore.eq.13) write(5,423)
if(iscore.eq.14) write(5,424)
if(iscore.eq.15) write(5,425)
if(iscore.eq.16) write(5,426)
if(iscore.eq.17) write(5,427)
if(iscore.eq.18) write(5,428)
if(iscore.eq.19) write(5,429)
if(iscore.eq.20) write(5,430)
if(iscore.eq.21) write(5,431)
if(iscore.eq.22) write(5,432)
if(iscore.eq.23) write(5,433)
if(iscore.eq.24) write(5,434)
if(iscore.eq.25) write(5,435)
if(iscore.eq.26) write(5,436)
if(iscore.eq.27) write(5,437)
if(iscore.eq.28) write(5,438)
if(iscore.eq.29) write(5,439)
if(iscore.ge.30) write(5,440)
c
goto 80
70 if(ipanic.eq.1) goto 90
write(5,1030)
1030 format(30x,'Congratulations Champ!')
80 write(5,1040)
1040 format(/20x,' INVADERS SUPER LEAGUE'//
+ 30x,'Player',19x,'Score')
90 if(ntune.gt.0) write(4,1000)ndum,mdum,pmdum,pbdum
if(ntune.lt.0) write(4,1000)nloop,mmove,pmys,pbomb
do 110 i=1,10
do 100 j=1,30
temp(j)=names(i,j)
100 continue
write(4,1010)scores(i)
write(4,1020)temp
if(ipanic.eq.1) goto 110
write(5,1050)i,temp,scores(i)
1050 format(I5,15X,30A1,5X,I5)
110 continue
write(5,1060)isco
1060 format(//,20X,'Your Score ',I5)
close(unit=4) !Close file
tnow = secnds(0)
120 if(secnds(tnow).lt.8.0) goto 120
if(ipanic.ne.1) return !Go back to start again
call vt100 ! Else exit
call exit
410 format(30X'** WORSE THAN BAD **') !0-199
411 format(15X'** TRY USING YOUR HANDS INSTEAD OF YOUR FEET **') !200-399
412 format(30X'** GO BACK TO USING YOUR FEET **') !400-599
413 format(30X'** What can I say **') !600-799
414 format(30X'** Four figures one day **') !800-999
415 format(30X'** Past the magic thousand **') !1000-1199
416 format(30X'** Must try harder **') !1200-1399
417 format(30X'** Well I suppose you''re trying **') !1400-1599
418 format(30X'** Come on **') !1600-1799
419 format(30X'** Almost there **') !1800-1999
420 format(30X'** WOW! over 2000 **') !2000-2199
421 format(30X'** Are you a novice? **') !2200-2399
422 format(30X'** Getting Better **') !2400-2599
423 format(30X'** Keep on trying **') !2600-2799
424 format(30X'** 3000 One of these days **') !2800-2999
425 format(30X'** Practice makes perfect **') !3000-3199
426 format(30X'** OK Now impress me **') !3200-3399
427 format(30X'** You''ve played before **') !3400-3599
428 format(30X'** I''ve seen worse **') !3600-3799
429 format(30X'** Keep it up **') !3800-3999
430 format(30X'** Hurrah! 4000 bust **') !4000-4199
431 format(30X'** Not Bad **') !4200-4399
432 format(30X'** Not bad at all **') !4400-4599
433 format(30X'** Pretty fair **') !4600-4799
434 format(30X'** Oh, So close **') !4800-4999
435 format(30X'** I''m almost impressed **') !5000-5199
436 format(30X'** Pretty Good **') !5200-5399
437 format(30X'** OK I like it **') !5400-5599
438 format(30X'** You''ve got style **') !5600-5799
439 format(30X'** Come on, you can do it **') !5800-5999
440 format(30X'** OK that wasn''t bad **') !6000 et seq
end
c ****
subroutine intro
c
common /scoreb/ iscore,ihiscr,champ,player
integer iscore,ihiscr
logical*1 champ(30),player(30),a
c
type *,' '
call clear
do 10 i=1,30 !clear array player
player (i) = ' '
10 continue
call graphi(1) !Put up initial screen
call posop(0,24,1,' ')
write(5,1000) !Format statements are rather
write(5,1010) ! large, so are at end.
call graphi(0)
call posop(20,3,1,' ')
write(5,1020)
1020 format(' Please enter your name :-')
call posop(5,1,1,' ')
write(5,1030)
1030 format(x,4x,
+'Z - Panic Button / Space Bar - Fire / < Left / > Right')
ichar=1 !Counter for name array
idir=2 !Movement
itype=1 !Type of invader
ix=10
call spin(1) !Set special input mode
20 call graphi(0)
if(itype.gt.0) call posop(ix,10,6,' <> ')
if(itype.lt.0) call posop(ix,10,6,' >< ')
if(itype.gt.0) call posop(ix,8,6,' }{ ')
if(itype.lt.0) call posop(ix,8,6,' {} ')
call graphi(1)
if(itype.gt.0) call posop(ix,6,7,' ')
if(itype.lt.0) call posop(ix,6,7,' >a< ')
ia=0
call graphi(0)
call ittin(a,ia) !see if character available
if(ia.lt.0) goto 50
30 if(a.eq.13) goto 70 !Car. ret. so return to prog.
if(a.lt.32) goto 50 !Nothing printable
if(a.eq.127) goto 40 !delete
if(ichar.eq.31) goto 50 !No more than 30 Chars
player(ichar)=a !Store value in array
ichar=ichar+1 !Point to next char.
goto 50
40 ichar=ichar-1 !if delete back one space
if(ichar.lt.1) ichar=1 !but not past start
player(ichar)=' ' !and cover with a space
50 call posop(47,2,30,player) !Rewrite text
itype=-itype !Change invader type
ix=ix+idir !Keep 'em moving
if(ix.gt.60) idir=-idir !Don't let them go too far
if(ix.lt.8) idir=-idir !at either end
do 60 i=-100,100
x=i*i !Delay loop to make invaders
60 continue ! more visible.
goto 20 !and round again
70 return
1000 format('+',
+12X' aaa aaaa a aaa aaaaa'/
+13X' a a a a a a a a '/
+13X' aaa aaaa aaaaa a aaaa '/
+13X' a a a a a a a '/
+13X' aaa a a a aaa aaaaa'/
+/
+13X'aaa a a a a a aaaa aaaaa aaaa aaa '/
+13X' a aa a a a a a a a a a a a '/
+13X' a a a a a a aaaaa a a aaaa aaaa aaa '/
+13X' a a aa a a a a a a a a a a'/
+13X'aaa a a a a a aaaa aaaaa a a aaa '/
+/)
1010 format(
+ 70x'SCORE 30'//
+ 70x'SCORE 20'//
+ 70x'SCORE 10')
end
c ****
subroutine cannon (icanon)
c
logical*1 cstrng(16)
c Initialise
do 10 i=1,16
cstrng(i) = '='
10 continue
c clear out old drawing
call posop(0,0,16,cstrng)
c exit if none left
if(icanon .lt. 1) goto 30
c draw up remaining cannon
call graphi(1)
do 20 i=1,icanon
call posop((i-1)*5+1,0,5,'=/A\=')
20 continue
call graphi (0)
30 continue
return
end
c ****
subroutine base
common /start/istart
common /basblk/jx,ioldjx
common /misblk/mx,miss,ifire,nloop,mmove,mstep,pmys,pbomb,ntune
common /shltbl/sh,sh1
integer sh(5,4),sh1(5,4)
common /invblk/invder,invpos,bompos,bombs,my2
integer invder(5,10),invpos(5,10,2),my2(10)
integer bompos(10,2),bombs(10)
logical*1 a,com(16)
data ncom/16/,com/' ',',','<','.','>','A','a','Z','z',
1'@','C','M','P','B','U','D'/
C TUNING PROCEDURE
C @ sets and unsets TUNING MODE and displays NLOOP, MMOVE
C PMYS and PBOMB along top of screen.
C C selects cannon speed (NLOOP) for alteration
C (integer steps)
C M selects mystery speed (MMOVE) for alteration
C (integer steps)
C P selects mystery probability (PMYS) for alteration
C (.0001 steps)
C B selects bomb probability (PBOMB) for alteration
C (.001 steps)
C
C U increases selected variable by 1 step
C D decreases " " "
C
C Tune speeds first, then probabilities.
C Variables will only be updated on SPACE.DAT if TUNING MODE is
C set when the game is exited.
C
ia=0
call ittin(a,ia) !any input?
if(ia.lt.0) goto 230 !Nowt
do 10 n=1,ncom !sort them out
if(com(n).ne.a) goto 10
goto(20,40,40,50,50,60,60,70,70,80,90,100,110,120,130,180),n
10 continue
goto 230 !ignore it
20 if(ifire.eq.1) goto 230 !Missile in flight
do 30 i=1,5 !See if we fire into shelter
do 30 j=1,4
ipos=sh(i,j)
if(ipos.eq.0) goto 30 !Not there
ipos=(13*i)+j !Get X displacement
if(jx.ne.ipos) goto 30 !Not above missile
sh(i,j)=sh(i,j)-1 !Knock it down a bit
goto 260
30 continue
mx=jx !Get missile position X
miss=0 !And Y co-ords
ifire=1 !Say its on the move
goto 230
40 if(jx.lt.4) goto 230 !Left hand limit
jx=jx-1
goto 230
50 if(jx.gt.76) goto 230 !Right hand limit
jx=jx+1
goto 230
60 call leave(0) !A leave graciously
istart=1
return
70 call leave(1) !Z panic leave, no return
80 ntune=ntune*(-1) !@ set/unset tuning
90 nch=1 !C select cannon
goto 230
100 nch=4 !M select mystery speed
goto 230
110 nch=3 !P select mystery prob
goto 230
120 nch=2 !B select bomb prob
goto 230
130 if(ntune.gt.0) goto 230 !U increase selection
goto(140,150,160,170),nch
140 nloop=nloop+1
goto 230
150 pbomb=pbomb+0.001
goto 230
160 pmys=pmys+0.0001
goto 230
170 mmove=mmove+1
goto 230
180 if(ntune.gt.0) goto 230 !D decrease selection
goto(190,200,210,220),nch
190 nloop=nloop-1
if(nloop.lt.1) nloop=1
goto 230
200 pbomb=pbomb-0.001
if(pbomb.lt.0.) pbomb=0.
goto 230
210 pmys=pmys-0.0001
if(pmys.lt.0.) pmys=0.
goto 230
220 mmove=mmove-1
if(mmove.lt.1) mmove=1
230 if(ifire.eq.0) goto 260 !No missile
if(miss.lt.21) goto 240 !Not at top yet
call posop(mx,miss+1,1,' ') !Rub it out
ifire=0 !Dead
miss=0
goto 260
240 miss=miss+1 !move it up
call posop(mx,miss+1,1,'|') !Draw it
do 250 j=1,5 !This loop is to stop half erasure
do 250 i=1,10 ! of invaders by missile rub out
nx=invpos(j,i,1) !Get position
ny=invpos(j,i,2)
if(invder(j,i).eq.0) goto 250 !Dead so ignore
if(ny.ne.miss) goto 250 !Not in same row, no action
if(mx.eq.nx+2) goto 260 !Don't overwrite invader
if(mx.eq.nx+3) goto 260 ! ditto
if(j.le.3) goto 250 !Only two wide
if(mx.eq.nx+4) goto 260 !Dont overwrite invaders
250 continue
if(miss.eq.1) goto 260 !Don't rub out base itself
call posop(mx,miss,1,' ') !rub out old one
260 if(ioldjx.eq.jx) goto 270 !Has base moved
ioldjx=jx !Yes
call graphi(1)
call posop(jx-2,1,5,' /A\ ')
call graphi(0)
270 return
end
c ****
subroutine kill(ioscor)
common /scoreb/ iscore,ihiscr,champ,player
integer iscore,ihiscr
logical*1 champ(30),player(30),a(5)
common /misblk/ mx,miss,ifire,nloop,mmove,mstep,pmys,pbomb,ntune
common /invblk/ invder,invpos,bompos,bombs,my2
integer invder(5,10),invpos(5,10,2),my2(10)
integer bompos(10,2),bombs(10)
C
if(ifire.eq.0) goto 40
do 20 j=1,5
do 20 i=1,10
if(invder(j,i).eq.0)goto 20 !This one is already dead
nx=invpos(j,i,1) !Get position of Invader
ny=invpos(j,i,2)
if(mx.eq.nx+2) goto 10 !Is missile in 1st column
if(mx.eq.nx+3) goto 10 !Is missile in 2nd column
if(j.le.3) goto 20 !only 2 wide
if(mx.ne.nx+4) goto 20 !is Missile in 3rd column
10 if(miss+1.ne.ny) goto 20 ! and same row
call explod(mx,miss+1) !Yes kill it
ifire=0 !missile is spent
miss=0
invder(j,i)=0 !Invader is dead
if(j.gt.3) iscore=iscore+10 !10 points scored
if(j.eq.3) iscore=iscore+20 !20 points scored
if(j.lt.3) iscore=iscore+30 !30 points scored
goto 40 !Can't hit owt else
20 continue
if(ifire.eq.0) goto 40
do 30 i=1,10
if(bombs(i).eq.0) goto 30 !This bomb is not going
nx=bompos(i,1) !position of bomb
ny=bompos(i,2)
if(mx.ne.nx) goto 30 !Same column
if(miss.ne.ny) goto 30 ! and row
call explod(nx,ny) !Bang!!!!!
call posop(mx,miss+1,1,' ') !And rub out missile
bompos(i,1)=0 !switch off bomb
bompos(i,2)=0
bombs(i)=0
miss=0
ifire=0
goto 40 !Missile defunct can't do more
30 continue
40 if(ioscor.eq.iscore) goto 50 !No change do nothing
ioscor=iscore !Set old score = current
encode (5,1000,a) iscore
1000 format (i5)
call posop(71,23,5,a)
50 return
end
subroutine bomb(igoes,oldcnt)
common /start/istart
common /ranblk/i1,i2
common /basblk/jx,ioldjx
common /misblk/mx,miss,ifire,nloop,mmove,mstep,pmys,pbomb,ntune
common /invblk/invder,invpos,bompos,bombs,my2
integer invder(5,10),invpos(5,10,2),my2(10)
integer bompos(10,2),bombs(10)
common /shltbl/sh,sh1
integer sh(5,4),sh1(5,4)
integer oldcnt
C See if any bombs to be dropped
do 20 i=1,10
my=my2(i)
if(invder(my,i).eq.0) goto 20 !This invader is dead
n=0 !Clear flag
do 10 j=1,10 !No. of bombs allowed
if(bombs(j).ne.0) goto 10 !See if a bomb can go
if(n.ne.0) goto 10 !Already set one off
n=j !Set No. of bomb to be dropped
10 continue
if(n.eq.0) goto 20 !No spare bombs
if(ran(i1,i2).lt.(1.-pbomb)) goto 20 !Only fire % of time
i1=i1+jx !Keep random pattern
i2=i2+miss !Random
irand=2
if(my.gt.3) irand=3
irand=int(irand*ran(i1,i2))
irand=irand+2
bompos(n,1)=invpos(my,i,1)+irand !Set position for bomb
bompos(n,2)=invpos(my,i,2)
bombs(n)=-1 !Say the bomb is gone
20 continue
C See which bombs are falling and move them
do 120 i=1,10 !Max No. of bombs allowed
if(bombs(i).eq.0) goto 120 !This one is not released
nx=bompos(i,1) !Set position of bomb
ny=bompos(i,2)
if(nx.gt.79) goto 100 !Cant drop them outside here
if(nx.lt.1) goto 100
if(ny.gt.19) goto 100
if(ny.lt.1) goto 100
if(bombs(i).eq.1) goto 30 !This one is on the move
ix=nx-jx
if(ix.lt.0) ix=-ix
if(ix.lt.7) goto 40 !If within +or- 7 them em go
x=float(oldcnt) !less spurious with many
x=x/50. !i.e. with 50 X=1 (no drop
C ! outside 7) with 25
C ! get 50-50 chance of
if(ran(i1,i2).le.x) goto 100 ! drop, with 12.5?
goto 40 !Still get 25% within 7
30 call posop(nx,ny,1,' ') !Rub out old bomb
40 bombs(i)=1 !Say it is dropping
ny=ny-1 !Move bomb down 1
if(ny.eq.1) goto 60 !See if it has hit base
if(ny.eq.2) goto 80 !See if it has shelter
50 call graphi(1)
call posop(nx,ny,1,'f') !draw bomb
call graphi(0)
if(ifire.eq.0) goto 110 !see if missile in flight
if(nx.ne.mx) goto 110 ! & same column
if(ny.ne.miss) goto 110 ! & same row
ifire=0 !If above satisfied
miss=0 !Bomb and missile destroyed
call explod(nx,ny) ! blow it up
goto 100 !Switch off bomb
60 if(nx.eq.jx) goto 70 !See if we hit base
if(nx.eq.jx-1) goto 70
if(nx.eq.jx+1) goto 70
goto 100 !No, Failure
70 call dead !Bang another life gone
igoes=igoes+1
if(igoes.lt.4) goto 100 !Still got some time left
call leave(0) !Bye, thats your lot
istart=1
return
80 do 90 is1=1,5 !See if we hit a shelter
do 90 is2=1,4
if(sh(is1,is2).eq.0) goto 90 !See if its gone
is3=(13*is1)+is2 !No, get its position
if(is3.ne.nx) goto 90 !Do we hit it?
sh(is1,is2)=sh(is1,is2)-1 !Yes, down it goes
goto 100
90 continue
goto 50 !Better see if it hits missile
100 nx=0 !Bomb does not exist anymore
ny=0
bombs(i)=0
110 bompos(i,1)=nx !Store current position
bompos(i,2)=ny
120 continue
return
end
c ****
subroutine dead
common /basblk/jx,ioldjx
common /shltbl/sh,sh1
integer sh(5,4),sh1(5,4)
logical*1 bell(2)
data bell/7,"200/
c
do 10 i=0,5
call posop(jx+i,1+i,1,' ')
call posop(jx,1+i,1,' ')
call posop(jx-i,1+i,1,' ')
call posop(jx-i,1,1,' ')
call posop(jx+i,1,1,' ')
if(i.eq.5) goto 10
call posop(jx+i+1,2+i,1,'*')
call posop(jx,2+i,1,'*')
call posop(jx-1-i,1+i+1,1,'*')
call posop(jx-i-1,1,1,'*')
call posop(jx+i+1,1,1,'*')
call print(bell)
10 continue
c Force drawing of shelters
do 20 i=1,5
do 20 j=1,4
sh1(i,j)=-1
20 continue
c Next cannon from LHS
jx=4
c Force drawing
ioldjx=-1
return
end
c ****
subroutine myster
common /scoreb/ iscore,ihiscr,champ,player
integer iscore,ihiscr
logical*1 champ(30),player(30),a(5)
common /misblk/mx,miss,ifire,nloop,mmove,mstep,pmys,pbomb,ntune
common /ranblk/i1,i2
c
if(mys.eq.1) goto 30 !Already one going?
cmys=ran(i1,i2) !Chance of mystery
if(cmys.lt.(1.-pmys)) goto 30 !Allow it % of the time
mys=1 !Flag it
if(cmys.lt.(1.-pmys*.5)) goto 10 !Half from RHS, half from LHS
mysx=76 !Flag from RHS
mysinc=-1*mstep
goto 20
10 mysx=4 !Flag from LHS
mysinc=1*mstep
20 x=ran(i1,i2)
x=4*x
mysy=int(x)+19 !set up mystery hieght (19-22)
if(mysy.ge.23) mysy=22
30 if(mys.eq.0) goto 70 !No mystery
mcount=mcount+1
if(mod(mcount,mmove).eq.0) mysx=mysx+mysinc !Move it
if((mysx.lt.4).or.(mysx.gt.76)) goto 60 !Reached edge?
call posop(mysx-1,mysy,5,' ') !No draw it
if(ifire.eq.0) goto 70
if(mx.eq.mysx) goto 40
if(mx.eq.mysx+1) goto 40
if(mx.eq.mysx+2) goto 40
goto 70
40 if(miss+1.ne.mysy) goto 70
call posop(mysx-1,mysy,5,' ')
call explod(mysx+1,mysy)
miss=0
mx=0
ifire=0
x=ran(i1,i2)
ix=25*int(x*10)+50
encode(5,1000,a) ix
1000 format(i5)
do 50 i=1,10
call posop(mysx,mysy,5,a)
call posop(mysx,mysy,5,' ')
50 continue
iscore=iscore+(ix)
mys=0
goto 70
60 call posop(mysx-1,mysy,5,' ')
mys=0
mcount=0
70 return
end
c ****
subroutine shlter
common /shltbl/sh,sh1
integer sh(5,4),sh1(5,4)
logical*1 a
c
do 50 i=1,5
do 50 j=1,4
i1=sh(i,j)
i2=sh1(i,j)
if(i2.eq.i1) goto 50 !Have we a new hit
sh1(i,j)=i1 !Yes copy it away
ipos=(13*i)+j !Where are we?
c Specials for top and bottom of shelters
if(i1.eq.10) goto 10
if(i1.eq.1) goto 20
if(i1.eq.0) goto 30
a=122-i1 !Other, levels 9-2 (single scans)
goto 40
10 a=96 !no hits yet - BLOB
goto 40
20 a=105 !Dotted line
goto 40
30 a=95 !Draw it
40 call graphi(1)
call posop(ipos,2,1,a)
call graphi(0)
50 continue
return
end
c ****
subroutine explod(nx,ny)
common /shltbl/sh,sh1
integer sh(5,4),sh1(5,4)
logical*1 a(2) !Set up Buzzer
data a/7,"200/
c
mx=nx-2
call print(a)
do 10 n=1,10 !Flashing star
call posop(mx,ny,5,' * ')
call posop(mx,ny,5,' ')
10 continue
if(ny.ne.2) goto 30 !Explode at shelter level
do 20 i=1,5 !Yes so force redrawing
do 20 j=1,4
sh1(i,j)=-1
20 continue
30 return
end
c ***
subroutine clear
logical*1 cl(6)
data cl/27,'H',27,'J',"200,0/
call print(cl)
call posop(0,23,1,' ') !To normalise screen
return
end
c ****
subroutine graphi(n)
logical*1 g(4)
data g/27,0,"200,0/
c
g(2)='F' !F = on
if(n.eq.0) g(2)='G' !G = off
call print(g)
return
end
c ****
subroutine ranst
common /ranblk/i1,i2
logical*1 ans,timans(9)
integer*2 array(4),hrtim(2),mntim(2),sctim(2)
C
call date(timans)
decode(2,1000,timans(1)) hrtim
decode(2,1000,timans(1)) mntim
decode(2,1000,timans(1)) sctim
1000 format(2i1)
i1=hrtim(1)+mntim(1)+sctim(1)
i2=hrtim(2)+mntim(2)+sctim(2)
return
end
c ****
subroutine posop(nx,ny,nochar,buffer)
logical*1 string(86),buffer(80)
data string/27,89,84*0/
c
ix=nx
iy=ny
if(ix.lt.0) ix=0 !Stop any out of range errors
if(iy.lt.0) iy=0
if(ix.gt.79) ix=79
if(iy.gt.24) iy=24
ix=32+ix !Get X&Y co-ords in VT52
iy=55-iy ! format as opposed to
string(3)=iy
string(4)=ix !O/P Yxy for direct
do 10 i=1,nochar
10 string(i+4)=buffer(i)
string(nochar+5)="200
call print(string)
return
end
c *****
subroutine vt52
logical*1 char(6)
data char/27,'[','?','2','l',"200/
C
call print(char)
return
end
c ******
subroutine vt100
logical*1 char(4)
data char/27,'<',"200,0/
C
call print(char)
return
end
c *****
subroutine spin(iarg)
logical first
data first/.TRUE./
c
if(first) jsw=ipeek("44) !Save JSW
first=.FALSE.
c
if(iarg.eq.0) goto 10
call ipoke("44,jsw.or."50100) !(IARG>0) Enable special mode
goto 20
10 call ipoke("44,jsw) !(IARG=0) Restore normal JSW
20 return
end
c ******
subroutine ittin(char,iarg)
byte char
c CHAR returns as the character (byte) input
c IARG=0 Does not wait for a character to appear
c IARG>0 Waits for a character to appear
c If no character then IARG returned negative
c
10 in=ittinr() !Get a character
if(iarg.gt.0.and.in.lt.0) goto 10 !Wait?
char=in !Set CHAR
iarg=in !Return IARG
return
end