C SPACE INVADERS INTEGER INVDER(5,20),INVPOS(5,20,2),MY1(20) INTEGER MY2(20),BOMBS(10),BOMPOS(10,2),SH(5,4),SH1(5,4) COMMON/BLK0/MYS,MYSX,I3,I4 COMMON/BLK1/BOMBS,BOMPOS,I1,I2 COMMON/BLK3/ISTAT DATA MYS/0/,I3/0/,I4/0/,IFIRE/0/,MISS/0/,ISCORE/0/ DATA BOMBS/10*0/ IGOES=1 !Count for no. of times Killed 500 TYPE 1000 ACCEPT 2000,IHARD 1000 FORMAT (' Enter Hardness (2-10) :-'$) 2000 FORMAT (I2) IF(IHARD.LT.2) GOTO 500 IF(IHARD.GT.10) GOTO 500 ISTAT=IPEEK("44) CALL IPOKE("44,"50100.OR.ISTAT) 3 NOGO=0 !No firing yet DO 1 I=1,5 !Set up Invaders & Shelters DO 1 J=1,20 INVDER(I,J)=1 !Say Invader(I,J) is there IF(J.GT.4) GOTO 1 SH(I,J)=7 !SeT Up Shelter Array SH1(I,J)=0 1 CONTINUE CALL CLEAR !Clear Screen CALL POSITN(10,21) WRITE(5,101)ISCORE 101 FORMAT(1H$,I5) CALL POSITN(0,0) !Bottom left corner WRITE(5,100) !Put up Ground ===== HARD=FLOAT(IHARD-1) !Give a difficulty IDIR=INT(HARD/5.0)+1 !Direction & Speed of movvement IX=5 !Starting position for IY=20 !Top left Invader 4 JX=40 !Starting position for Base CALL BASE(JX,MX,MISS,IFIRE,SH) !Draw Base C C Start of Program Loop C 2 COUNT=0 !Clear count of No. Invaders MINX=80 ! set Min & Max X positions MAXX=0 MY=20 !and Min Y DO 5 I=1,20 !Say bottom of each stack MY1(I)=0 C C Set up new Invader positions C 5 CONTINUE DO 10 J=1,5 DO 10 I=1,20 IF(INVDER(J,I).EQ.0) GOTO 10 !If zero Invader(I,J) is dead COUNT=COUNT+1 !Count Invaders still remaining NX=IX+3*I !Work out X & Y Co-ords for NY=IY-2*J !Invader 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(NY.LT.MY) MY=NY !Change Min Y if necessary IF(J.GT.MY1(I)) MY1(I)=J !Say which invader is lowest in stack CALL POSITN(NX,NY) !Piont to position for invader IX1=INT(FLOAT(I)/2) !Alternate invader different IX1=I-IX1*2 JY1=INT(FLOAT(J)/2) JY1=J-JY1*2 IX1=IX1+JY1 IF(IX1.EQ.1) GOTO 999 WRITE (5,31) !Draw hollow Invader GOTO 998 999 WRITE (5,30) !Draw solid Invader 998 CALL POSITN(NX,NY+1) !Clear above Invader WRITE (5,40) IF(NOGO.EQ.0) GOTO 10 !Not allowed to fire first time CALL BASE(JX,MX,MISS,IFIRE,SH) CALL KILL(INVDER,INVPOS,MX,MISS,IFIRE,ISCORE) CALL MYSTER(MX,MISS,IFIRE,ISCORE) IF(MY.LE.1) GOTO 9 !If Invader is at ground level C !check for crash CALL BOMB(MY2,INVDER,INVPOS,IFIRE,JX,MX,MISS,IHARD,SH,IGOES) CALL SHLTER(SH,SH1,0) GOTO 10 !Cant have crash 9 CALL DEAD(JX) !blow up craft IGOES=IGOES+1 !Knock off another life IF(IGOES.LT.4) GOTO 4 !Have another laser base CALL IPOKE("44,ISTAT) CALL EXIT !Sorry thats your lot 10 CONTINUE C end of Invaders moving NOGO=1 !Say not 1st. time through DO 15 I=1,20 MY2(I)=MY1(I) !Set up bottom of stack table 15 CONTINUE IF(MINX.LT.4) GOTO 20 !If in column 4 need to reverse IF(MAXX.GT.76) GOTO 20 !If in column 76 need to reverse GOTO 25 20 IY=IY-1 !Drop a line IF(IY.LT.1) IY=1 IDIR=-IDIR !Reverse direction 25 IX=IX+IDIR !move top left corner IF(COUNT.EQ.0) GOTO 3 !If all Invaders dead reset them GOTO 2 !go round again C Formats to draw Invaders 100 FORMAT(1H$,80(1H=)) 30 FORMAT('$ M ') 31 FORMAT('$ O ') 40 FORMAT('$ ') END SUBROUTINE BASE(JX,MX,MISS,IFIRE,SH) INTEGER SH(5,4) LOGICAL*1 A COMMON/BLK3/ISTAT C TYPE *,' BASE' A=ITTINR() IF(A.LT.0) GOTO 40 !No,go-see if missile in flight IF(A.EQ.' ') GOTO 10 !Space,go to fire missile IF(A.EQ.',') GOTO 20 !',' Move base to left IF(A.EQ.'.') GOTO 30 !'.' Move base to right IF(A.EQ.'A') GOTO 5 !'A' ABORT GAME IF(A.NE.'Z') GOTO 40 !'Z' Clear screen and abort game CALL CLEAR 5 CALL IPOKE("44,ISTAT) CALL EXIT !STOP 10 IF(IFIRE.EQ.1) GOTO 40 !Missile in flight,go and moveit DO 100 I=1,5 DO 100 J=1,4 !see if we fired into shelter IPOS=SH(I,J) !Does this one exist IF(IPOS.EQ.0) GOTO 100 !No ignore it IPOS=(13*I)+J !Yes,calculate position IF(JX.NE.IPOS) GOTO 100 !are we underneath SH(I,J)=SH(I,J)-1 !Yes Knock it down by one GOTO 60 !Go to move Base 100 CONTINUE MX=JX !Say were missile is IFIRE=1 !Say it has been released GOTO 40 !goto move it 20 IF(JX.LT.5) GOTO 40 !if too far over can't move JX=JX-1 !one to left GOTO 40 30 IF(JX.GT.75) GOTO 40 JX=JX+1 !one to right 40 IF(IFIRE.EQ.0) GOTO 60 !No missile set up base IF(MISS.LT.22) GOTO 50 !If not at Top Carry on CALL POSITN(MX,MISS+1) !Delete | WRITE(5,90) IFIRE=0 !Say free to fire again MISS=0 !Say missile is at ground GOTO 60 !goto setup base 50 MISS=MISS+2 !Move missile upwards CALL POSITN(MX,MISS+1) !Draw it WRITE(5,80) CALL POSITN(MX,MISS-1) !Clear it's old position WRITE(5,90) 60 CALL POSITN(JX-1,1) !Position of base WRITE(5,70) !Draw it RETURN C Formats for missile and base 70 FORMAT('$ Y ') 80 FORMAT('$|') 90 FORMAT('$ ') END SUBROUTINE KILL(INVDER,INVPOS,MX,MISS,IFIRE,ISCORE) INTEGER INVDER(5,20),INVPOS(5,20,2) C TYPE *,' KILL' IF(IFIRE.EQ.0) GOTO 50 !no missile in flight DO 10 J=1,5 !Check each Invader DO 10 I=1,20 IF(INVDER(J,I).EQ.0) GOTO 10 !This one is already dead NX=INVPOS(J,I,1) !Get position of Invader NY=INVPOS(J,I,2) IF(MX.NE.NX+2) GOTO 10 !Is Missile in same column IF(MISS.EQ.NY) GOTO 99 IF(MISS+1.NE.NY) GOTO 10 CALL EXPLOD(MX,MISS+1) !Yes Kill it GOTO 101 99 CALL POSITN(MX,MISS+1) WRITE(5,102) 102 FORMAT('$ ') CALL EXPLOD(MX,MISS) 101 IFIRE=0 !Missile is spent MISS=0 INVDER(J,I)=0 !Invader is dead ISCORE=ISCORE+10+5*J 10 CONTINUE 50 CALL POSITN(10,21) WRITE(5,60)ISCORE RETURN C Format to Display score 60 FORMAT(1H$,I5) END SUBROUTINE BOMB(MY2,INVDER,INVPOS,IFIRE,JX +,MX,MISS,IHARD,SH,IGOES) INTEGER INVDER(5,20),INVPOS(5,20,2),BOMPOS(10,2) INTEGER BOMBS(10),MY2(20),SH(5,4) COMMON/BLK1/BOMBS,BOMPOS,I1,I2 COMMON/BLK3/ISTAT C C See if any bombs to be dropped C C TYPE *,' BOMB' DO 30 I=1,20 IF(INVDER(MY2(I),I).EQ.0) GOTO 30 !This Invader is dead N=0 !Clear flag DO 10 J=1,IHARD !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 !get No. of bomb to be dropped 10 CONTINUE IF(N.EQ.0) GOTO 30 !No spare Bombs 20 IF(RAN(I1,I2).GE.0.99) GOTO 25 !Only fire 1% of time STL=ABS(INVPOS(MY2(I),1,1)+2-JX) IF(STL.LE.5..AND.RAN(I3,I4).GE.0.98) GOTO 25 GOTO 30 25 I1=I1+JX !Keep random patern I2=I2+MISS !Random BOMPOS(N,1)=INVPOS(MY2(I),I,1)+2 !Get position for bomb BOMPOS(N,2)=INVPOS(MY2(I),I,2) BOMBS(N)=-1 !Say the bomb is gone 30 CONTINUE C C See which bombs are falling and move them C DO 50 I=1,IHARD !Max No.of bombs allowed IF(BOMBS(I).EQ.0) GOTO 50 !This one is not released NX=BOMPOS(I,1) !get the position of bomb NY=BOMPOS(I,2) IF(NX.GT.76) GOTO 45 !Can't drop them outside here IF(NX.LT.4) GOTO 45 IF(BOMBS(I).EQ.-1) GOTO 33 !Just released CALL POSITN(NX,NY) !Rub out old bomb WRITE(5,70) 33 NY=NY-1 !Move bomb down 1 IF(NY.EQ.1) GOTO 40 !See if it has hit base IF(NY.EQ.2) GOTO 100 !see if it has hit shelter CALL POSITN(NX,NY) !Draw bomb WRITE(5,60) BOMBS(I)=1 !Say it is dropping IF(IFIRE.EQ.0) GOTO 47 !see if missile is in flight IF(NX.NE.MX) GOTO 47 !& in same column IF(NY.EQ.MISS) GOTO 35 !& same row IF(NY.NE.MISS-1) GOTO 11 CALL POSITN(MX,MISS+1) WRITE(5,12) 12 FORMAT('$ ') GOTO 35 11 IF(NY-MISS.NE.1) GOTO 47 !or just below 35 IFIRE=0 !If above satisfied MISS=0 !bomb is distroyed CALL EXPLOD(NX,NY) !blow it up GOTO 45 !Switch off bomb 40 IF(NX.EQ.JX) GOTO 43 !See if we hit base IF(NX.EQ.JX-1) GOTO 43 IF(NX.EQ.JX+1) GOTO 43 GOTO 45 !No , Failure 43 CALL DEAD(JX) !Bang another life gone CALL SHLTER(SH,SH,1) IGOES=IGOES+1 IF(IGOES.LT.4) GOTO 45 !Still got some time left CALL IPOKE("44,ISTAT) CALL EXIT !Bye | That's your lot 100 DO 110 IS1=1,5 !See if we hit a shelter DO 110 IS2=1,4 IF(SH(IS1,IS2).EQ.0) GOTO 110 !See if it's gone IS3=(13*IS1)+IS2 !No, get it's position IF(IS3.NE.NX) GOTO 110 !Do we hit it SH(IS1,IS2)=SH(IS1,IS2)-1 !Yes , Down it goes GOTO 45 110 CONTINUE GOTO 47 45 NX=0 !Bomb does not exist anymore NY=0 BOMBS(I)=0 47 BOMPOS(I,1)=NX !Stores Current position BOMPOS(I,2)=NY 50 CONTINUE RETURN C Format to Draw bomb 60 FORMAT('$v') 70 FORMAT('$ ') END SUBROUTINE DEAD(JX) LOGICAL*1 A C TYPE *,' DEAD' A=0 !This is Buzzer C C Loop to draw explosion C DO 10 I=0,5 CALL POSITN(JX+I,1+I) WRITE(5,20) CALL POSITN(JX,1+I) WRITE(5,20) CALL POSITN(JX-I,1+I) WRITE(5,20) CALL POSITN(JX-I,1) WRITE(5,20) CALL POSITN(JX+I,1) WRITE(5,20) IF(I.EQ.5) GOTO 10 CALL POSITN(JX+I+1,2+I) WRITE(5,30) CALL POSITN(JX,2+I) WRITE(5,30) CALL POSITN(JX-1-I,1+I+1) WRITE(5,30) CALL POSITN(JX-I-1,1) WRITE(5,30) CALL POSITN(JX+I+1,1) WRITE(5,30) WRITE(5,40) A 10 CONTINUE C Reset Position of Base JX=40 RETURN C C Format for explosion C 20 FORMAT('$ ') 30 FORMAT('$*') 40 FORMAT(1H$,A1) END SUBROUTINE MYSTER(MX,MISS,IFIRE,ISCORE) COMMON/BLK0/MYS,MYSX,I3,I4 COMMON/BLK4/IDIRN C TYPE *,' MYSTER' IF(MYS.EQ.1) GOTO 20 !Already one on the go IDIRN=1-2*INT(RAN(I3,I4)+.5) IF(RAN(I3,I4).LT.0.995) GOTO 20 !.5% chance of mystery MYS=1 !Let it go MYSX=76 IF(IDIRN.EQ.-1) MYSX=4 20 IF(MYS.EQ.0) GOTO 30 !No mystery MYSX=MYSX-IDIRN !Move it across CALL POSITN(MYSX,22) !Set position IF(MYSX.LT.4.OR.MYSX.GT.76) GOTO 40 !Reached LHS WRITE(5,10) !Draw craft IF(IFIRE.EQ.0) GOTO 30 !No missile go back STL=ABS(FLOAT(MX-MYSX)) IF(STL.LE.1.5) GOTO 60 !HIT GOTO 30 !No 60 IF(MISS+1.EQ.22) GOTO 61 IF(MISS.NE.22) GOTO 30 CALL POSITN(MX,MISS+1) WRITE(5,102) 102 FORMAT('$ ') 61 CALL POSITN(MYSX,22) !We've got it WRITE(5,50) !rub it out CALL EXPLOD(MYSX+IDIRN,22) !Blow it up X=RAN(I3,I4) !get random score IX=25*INT(X*10)+50 DO 100 I=1,50 !Flash Score on & off CALL POSITN(MYSX,22) WRITE(5,70)IX CALL POSITN(MYSX,22) WRITE(5,50) 100 CONTINUE ISCORE=ISCORE+IX !Increase Score MYS=0 !End of craft GOTO 30 40 WRITE(5,50) !at edge so erase it MYS=0 30 RETURN C C Format for Mystery C 10 FORMAT('$ ') 50 FORMAT('$ ') 70 FORMAT('$ ',I3) END SUBROUTINE SHLTER(SH,SH1,IFORCE) INTEGER SH(5,4),SH1(5,4) LOGICAL*1 A C TYPE *,' SHLTER' DO 20 I=1,5 !Check each shelter DO 20 J=1,4 I1=SH(I,J) !Get values I2=SH1(I,J) IF(IFORCE.EQ.1) GOTO 25 IF(I2.EQ.I1) GOTO 20 !this one is unchanged SH1(I,J)=I1 !get new value 25 IPOS=(13*I)+J !Get position CALL POSITN(IPOS,2) !Point to it IF(I1.EQ.7) GOTO 5 !Want Block IF(I1.EQ.1) GOTO 10 !Want dotted line IF(I1.EQ.0) GOTO 6 A=117-I1 !Makeup char. GOTO 15 5 A=97 !Block GOTO 15 10 A=46 !Dotted Line GOTO 15 6 A=32 15 CALL GRAPHI(1) WRITE(5,30)A !Draw it CALL GRAPHI(0) 20 CONTINUE RETURN C C Format for shelter C 30 FORMAT(1H$,A1) END SUBROUTINE EXPLOD(NX,NY) LOGICAL*1 A C TYPE *,' EXPLOD' A=0 !Set up Buzzer WRITE(5,40) A DO 10 N=1,10 !flashing Star CALL POSITN(NX,NY) WRITE(5,20) CALL POSITN(NX,NY) WRITE(5,30) 10 CONTINUE RETURN 20 FORMAT('$*') 30 FORMAT('$ ') 40 FORMAT(1H$,A1) END SUBROUTINE CLEAR LOGICAL*1 CL(4) CL(1)=27 !OutputHJ CL(2)='H' CL(3)=27 ! To clear screen CL(4)='J' WRITE(5,10) CL RETURN 10 FORMAT(1H$,4A1) END SUBROUTINE POSITN(IX,IY) LOGICAL*1 MOVE(4) C TYPE *,' POSITN' IX1=32+IX !Get X & Y coords in VT52 IY1=55-IY !format as opposed to MOVE(1)=27 !bottom left =0,0 MOVE(2)=89 MOVE(3)=IY1 MOVE(4)=IX1 !Output Yxy for Direct WRITE(5,10) MOVE !Cursor Addressing RETURN 10 FORMAT(1H$,4A1) END C SUBROUTINE GRAPHI(N) LOGICAL*1 G(2) C TYPE *,' GRAPHI' G(1)=27 !Switch Graphics on & off G(2)='F' !F =on IF(N.EQ.0) G(2)='G' !G =off WRITE(5,10) G RETURN 10 FORMAT(1H$,2A1) END