PROGRAM DRAGON C C Princess and the Dragons, by R. N. CAFFIN C COMMON /TIME/ITIM(2) COMMON DRGX(11),DRGY(11) COMMON /RAND/IR1,IR2 DATA XM,WCLR,DCLR,DRAD,PRAD/0.9,0.04,0.05,0.18,0.05/ DATA NDRAG,IR1,IR2,FACA,FACR,ISEC/10,0,0,0.002,.004,10/ DATA Y/'Y'/ C C IT IS ASSUMED THAT THE AREA IS 0.9 X 0.9 UNITS. IX(X)=IFIX(2048.*X) C CALL PLOT(9,0,15) TYPE 1000 A=SECNDS(0.0) N=100.0*AMOD(A,2.0) DO 20 I=1,N X=RF() ! RANDOM NUMBER SET UP 20 CONTINUE DLIM=2*DRAD+DCLR ! DRAGON SEPARATION WLIM=XM-(DRAD+WCLR) ! WALL CLEARANCE (ABS) C C DRAW WALLS IN C 50 CALL PLOT(11) IXB=IX(XM) CALL PLOT(3,-IXB,-IXB) CALL PLOT(5,-IXB,+IXB) CALL PLOT(5,IXB,IXB) CALL PLOT(5,+IXB,-IXB) CALL PLOT(5,-IXB,-IXB) NTRY=0 C C DRAW DRAGONS IN C DO 200 ND=1,NDRAG 100 XD=RF()*XM IF(NTRY.GT.1000)GO TO 50 NTRY=NTRY+1 YD=RF()*XM IF(ABS(XD).GT.WLIM.OR.ABS(YD).GT.WLIM)GO TO 100 IF(ND.EQ.1)GO TO 170 DO 160 L=1,ND-1 IF(GAP(XD,YD,L).LT.DLIM)GO TO 100 160 CONTINUE 170 DRGX(ND)=XD DRGY(ND)=YD 200 CALL CIRCLE(XD,YD,DRAD) C C DRAW PRINCESS IN C XP=-XM 250 YP=RF()*XM DO 300 L=1,NDRAG IF(GAP(XP,YP,L).LT.DRAD+PRAD) GO TO 250 300 CONTINUE DRGX(11)=XP DRGY(11)=YP CALL CIRCLE(XP,YP,PRAD) C C DRAW IN KNIGHT C XK=+XM-0.01 350 YK=RF()*XM*0.9 DO 400 L=1,NDRAG IF(GAP(XK,UK,L).LT.DRAD+WCLR) GO TO 350 400 CONTINUE GATEY=YK CALL PLOT(3,IX(XK+.025),IX(YK-.025)) CALL PLOT(5,IX(XK+.025),IX(YK+.025)) CALL PLOT(5,IX(XK-.025),IX(YK+.025)) CALL PLOT(5,IX(XK-.025),IX(YK-.025)) CALL PLOT(5,IX(XK+.025),IX(YK-.025)) 405 IFAIL=0 406 TYPE 407 407 FORMAT(' HOW GOOD A KNIGHT ARE YOU?',/ 1 ' PROWESS RANGES FROM LOW = 1 TO HIGH = 10 ? ',$) ACCEPT 1010,N IF(N.LT.1.OR.N.GT.10)GO TO 406 N=11-N CALL JTIME(0,0,0,N,ITIM) 410 CALL PLOT(3,IX(XK),IX(YK)) CALL PLOT(5,IX(XK-0.01),IX(YK)) C C READY TO GO C PAUSE 'READY? AND USE THE KEYS' XVEL=0 YVEL=0 ITM=0 SPELL=1 CALL IPOKE("44,"10100.OR.IPEEK("44)) K=ITTOUR("12) K=ITTOUR("107) K=ITTOUR("117) K=ITTOUR("15) K=ITTOUR("12) 500 CALL IPOKE("44,"10100.OR.IPEEK("44)) C C GET OPERATOR COMMANDS C 510 CALL INPUT(IXAC,IYAC) XVEL=XVEL+IXAC*FACA YVEL=YVEL+IYAC*FACA IF(XK.GT.0.85.AND.ABS(YK-GATEY).LT.0.05) GO TO 530 XAC=RF()*FACR*SPELL YAC=RF()*FACR*SPELL IF(RF().GT.0.5)XVEL=XVEL+XAC IF(RF().GT.0.5)YVEL=YVEL+YAC IF(ABS(XVEL).GT.0.1)XVEL=AMOD(XVEL,0.1) IF(ABS(YVEL).GT.0.1)YVEL=AMOD(YVEL,0.1) 530 XK=XK+XVEL YK=YK+YVEL IF(XK.GT.1.0)XK=0.999 IF(YK.GT.1.0)YK=0.999 IF(XK.LT.-1.0)XK=-0.999 IF(YK.LT.-1.0)YK=-0.999 CALL PLOT(5,IX(XK),IX(YK)) !NEW KNIGHT POSN. CALL CLEAR() IF(XK.EQ.(XM-0.01).AND.YK.EQ.GATEY)GO TO 500 C C ANY DISASTERS OR RESCUES? C 540 ITM=ITM+1 IF(GAP(XK,YK,11).LT.PRAD)GO TO 700 !RESCUE? IF(ABS(XK).LT.XM)GO TO 550 IF(ABS(YK-GATEY).LT.0.025)GO TO 500 !IN GATEWAY STILL XVEL=-XVEL !RAN INTO VERT. WALL! SPELL=SPELL*1.5 TYPE 1040 550 IF(ABS(YK).LT.XM)GO TO 560 YVEL=-YVEL !RAN INTO HOR. WALL SPELL=SPELL*1.2 TYPE 1040 560 DO 570 I=1,NDRAG IF(GAP(XK,YK,I).LT.DRAD)GO TO 800 !RAN INTO DRAGON 570 CONTINUE GO TO 500 C C RESCUE! C 700 CALL PLOT(1) TYPE 1050,ITM/10 TYPE 1060 ACCEPT 1070,ANS IF(ANS.EQ.Y) GO TO 50 CALL EXIT C C DISASTER! C 800 TYPE 1100 XK=XM YK=GATEY IFAIL=IFAIL+1 IF(IFAIL.LT.5)GO TO 410 TYPE 823 823 FORMAT(' PERHAPS YOU SHOULD BE MORE HUMBLE?',) GO TO 405 1000 FORMAT(1H0,'This is PRINCESS AND THE DRAGONS') 1010 FORMAT(I6) 1030 FORMAT(1H ,2I6) 1040 FORMAT(1H0,'CRASH, BOOM, THUD, TINKLE *&%$#@!!!',/ 1 ' You are a rotten horseman!',/ 2 ' Are you sure you know what you are doing?') 1050 FORMAT(1H0,'YAHOO!!!!****! You''ve SAVED the princess!!'/ 1 ' the Princess is now safe in your arms,'/ 2 ' all the dragons have dissapeared!!',/ 3 ' Hurry up and take her home - she has only',/ 4 ' been waiting',I4,' hours for a handsome HERO',/ 5 ' If neccessary, she might even MARRY you!!') 1060 FORMAT(1H0,//,' Do you want to play again(Y/N)?',$) 1070 FORMAT(A4) 1100 FORMAT(1H0,'!!##** ROAR,BITE,SCRUNCH,SCREAM!!!**##',/ 1 ' The DRAGON got YOU!!!!! You''re mince meat !!',/ 2 ' So who is going to rescue the princess now?') STOP END C SUBROUTINE CIRCLE(XC,YC,R) IX(X)=IFIX(2048.*X) PSI=3.141/18 CALL PLOT(3,IX(XC),IX(YC+R)) DO 100 I=1,36 X=XC+R*SIN(I*PSI) Y=YC+R*COS(I*PSI) 100 CALL PLOT(5,IX(X),IX(Y)) CALL PLOT(1) RETURN END C C FUNCTION RF() COMMON/RAND/IR1,IR2 RF=2.*RAN(IR1,IR2)-1.0 RETURN END C C FUNCTION GAP(X,Y,I) COMMON DX(11),DY(11) GAP=SQRT((X-DX(I))**2+(Y-DY(I))**2) RETURN END C C SUBROUTINE CLEAR () 100 I=ITTINR() IF(I.GE.0)GO TO 100 CALL IPOKE("44,IPEEK("44).AND."167677) RETURN END C C SUBROUTINE INPUT(IXAC,IYAC) COMMON /TIME/ITIM(2) IXAC=0 IYAC=0 CALL ITWAIT(ITIM) 100 K=ITTINR() IF(K.LT.0)RETURN IF(K.LT."101.OR.K.GT."104)GO TO 100 K=K.AND."7 GO TO(200,300,400,500),K 200 IYAC=IYAC+1 !UP GO TO 100 300 IYAC=IYAC-1 !DOWN GO TO 100 400 IXAC=IXAC+1 !RIGHT GO TO 100 500 IXAC=IXAC-1 !LEFT GO TO 100 END