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