PROGRAM DEMO INTEGER CLOCK,MM(200),J(200) COMMON J,M,TAR COMMON DEPICT,LONG,G,V2,NIM,BASE,XYSCAL,SCALE,PT,P0 EQUIVALENCE (LONG,PATH) , (THETA,GUESS), (XYSCAL,YSCALE) DIMENSION PATH(2,250), LONG(500) , DEPICT(201) INTEGER PATH, DEPICT,PT,P0,TARGET,TAR,WIN,BASE G= 32.174 YSCALE = 464. V2 = 500 V2 = V2*V2 SCALE = 512.*G/V2 BASE = 60B DO 111 I = 1,201 111 DEPICT(I) = 0 DO 112 I = 1,500 112 LONG(I) = 0 BASE = BASE + 7000B XYSCAL=YSCALE/512. J(1)=1003 DELTR = 6105./200. ENCODE(10,4,MM(1))J(1) 4 FORMAT(I10) DO 1 I=2,200 1 J(I) = J(I-1)+DELTR DO 2 M=1,200 J(M)=J(M)+M 2 ENCODE(10,4,MM(M))J(M) CALL SCOPE(DEPICT) 3 IJ=CLOCK(X) TAR = MOD(IJ,3)+1 M =(IJ+22)/20.5 TARGET = J(M) DO 113 I =1,128 PATH(1,I) =6000B+4*(I-1) 113 PATH(2,I) = BASE PATH(2,129)= PATH(2,128) PATH(2,130) = PATH(2,129) PATH(1,129) = 6000B PATH(1,130) = 6000B + 511 TARGET = TARGET*512.*G/V2 PATH(1,131) = 6000B + TARGET PATH(2,131) = BASE PATH(2,132) = 55B PATH(1,133) = 55B P0 = 1 PT = 53 IF (TAR-2) 400,500,600 400 PATH(1,132) = 1100B 404 CALL PACK(LONG) DO 402 I = 1,PT 402 DEPICT(I) = LONG(I) GO TO 405 500 PATH(1,132) = 3000B GO TO 404 600 PATH(1,131) = 6000B + TARGET - 2 PATH(1,132) = 1700B PATH(2,132) = TARGET + 6000B PATH(1,133) = BASE + 4 GO TO 404 405 CALL PLAY(MM(M)) GO TO 3 END SUBROUTINE CALCH(IVAL,RANGE,WIN) INTEGER RANGE INTEGER PATH, DEPICT,PT,P0,TARGET,TAR,WIN,BASE INTEGER T COMMON J(200),IJ,TAR DIMENSION PATH(2,250) , LONG(500) , DEPICT(201) COMMON DEPICT,LONG,G,V2,NIM,BASE,XYSCAL,SCALE,PT,P0 EQUIVALENCE (LONG,PATH) , (THETA,GUESS), (XYSCAL,YSCALE) WIN = 1 DECODE(10,1,IVAL)GUESS 1 FORMAT(F4.1) NIM = 3 J1 = 700 GUESS =GUESS/57.29578 IDIST = 15527.9504*SIN(GUESS)*COS(GUESS) IF(IABS(J(IJ)-IDIST).LT.30)WIN=2 405 VX2 = 2.*V2*COS(THETA)*COS(THETA) TANG=TAN(THETA) MAXX = IDIST*512.*G/V2 GV= G/VX2 L = MAXX/NIM DO 601 I = 1,400 601 LONG(I) = 0 IF(THETA.LT.1.4) GO TO 407 L = 3*L J1 = 240 NIM = 1 GO TO 406 407 IF(THETA.GT.0.8) GO TO 406 L = L/2 NIM = 2*NIM 406 DO 550 K = 1,L LXX = NIM*K PATH(1,K) = 6000B + LXX 550 PATH(2,K) = BASE + IFIX(XYSCAL*LXX*(TANG-LXX*GV/SCALE)) IF(MOD(2*L,5).LT.3) NUMP = 2*L/5 IF(MOD(2*L,5).GE.3) NUMP = 2*L/5 + 1 C C EXPLOSION GENERATOR C JINX = 2*L+1 LONG(JINX) = MAXX + 6000B DO 700 I = 1,9 JIN = JINX + I 700 LONG(JIN) = BASE + 2*I NO = L + 5 DO 701 I = 1,16,2 JIN = NO + I PATH(1,JIN) = 6000B + MAXX - I/2 - 1 PATH(1,JIN+1) = 6000B + MAXX + I/2 + 1 PATH(2,JIN) = BASE + IFIX(0.866*(I+1)) 701 PATH(2,JIN+1) = PATH(2,JIN) NO = JIN + 1 DO 702 I = 1,16,2 JIN = NO + I PATH(1,JIN) = PATH(2,JIN-16) - BASE + 6000B + MAXX PATH(1,JIN+1) = 6000B + MAXX - PATH(2,JIN-15) + BASE PATH(2,JIN) = PATH(1,JIN-15) + BASE - 6000B - MAXX 702 PATH(2,JIN+1) = PATH(2,JIN) JIN = JIN + 1 PATH(1,JIN) = 6000B + MAXX - 3 PATH(2,JIN) = BASE - 3 PATH(1,JIN+1) = 4700B PATH(2,JIN+1) = 6000B + MAXX - 3 PATH(1,JIN+2) = BASE - 3 PATH(2,JIN+2) = 4700B KLUG = 6000B + MAXX PATH(1,JIN+3) = MAX0(6012B,KLUG) PATH(2,JIN+3) = BASE - 16 PATH(1,JIN+4) = 3201B PATH(2,JIN+4) = 2000B IF (TAR.EQ.3) GO TO 709 PATH(1,JIN+4) = 0201B PATH(2,JIN+4) = 1500B 709 JIN = JIN+ 4 NO = 2*JIN/5 + 1 C C EXPLOSION HAS BEEN GENERATED C CALL PACK(LONG) M = NUMP JIN = PT + 1 DO 551 K = 1,M DEPICT(JIN) = LONG(K) JIN = JIN + 1 CALL WAIT(J1) 551 CONTINUE IF(WIN.EQ.2) GO TO 705 703 DO 704 I = NUMP,NO DEPICT(JIN) = LONG(I) 704 JIN = JIN + 1 CALL WAIT(800) T = PT +1 DO 707 I = T,201 707 DEPICT(I) = 0 GO TO 47 705 T = PT-P0 + 1 DO 706 I = T, PT 706 DEPICT(I) = 0 GO TO 703 47 ENCODE(10,2,RANGE)IDIST 2 FORMAT(I10) RETURN END ASCENT CALLER ENTRY SCOPE ENTRY CLOCK ENTRY PLAY EXT CALCH VFD D42/SCOPE,N18/0 SCOPE JP * SX6 B1 SA6 MR SA1 CON .CALL PP BX6 X1 + SA1 1 NZ X1,* SA6 1 + SA1 1 NZ X1,* EQ SCOPE VFD D42/CLOCK,N18/1 CLOCK JP * + SA1 IR NZ X1,* SX6 1 SA6 IR + SA1 IR NZ X1,* SA1 OR BX6 X1 EQ CLOCK VFD D42/PLAY,N18/1 PLAY JP * SA1 B1 BX6 X1 SA6 IR LOOP SA1 IR NZ X1,* SA1 OR BX6 X1 SA6 VAL SB1 VAL SB2 RANGE SB3 WIN + RJ CALCH - LT PLAY-1 SA1 RANGE BX6 X1 SA6 OR SA2 WIN BX6 X2 SA6 IR SX6 1 SA6 MR + SA1 MR NZ X1,* SA1 WIN SX1 X1-2 NZ X1,LOOP EQ PLAY CON VFD D18/DEM,N24/0,A18/IR IR VFD N42/0,A18/OR MR CON 0 OR CON 0 VAL CON 0 RANGE CON 0 WIN CON 0 END SUBROUTINE WAIT(I) LUCKY = 0 DO 601 LL = 1,I 601 LUCKY = LUCKY + 1 + SIN(FLOAT(LUCKY)) RETURN END WAIT ASCENT PACK ENTRY PACK PACK JP * SB2 12 SB5 1 SB7 B1 HERE SA1 B7 BX6 X1 ZR X1 ADD SB6 B7-B1 SB3 B6 TRY SB3 B3-5 LT B0 B3 TRY NE B3 FINE SB6 4 EQ AGAIN FINE SB6 B3+B5 SB6 -B6 POSS NE B6 AGAIN SA6 B7 SB7 B7+B5 EQ HERE AGAIN LX6 B2 X6 SB6 B6-B5 EQ POSS ADD BX7 X7-X7 SB2 B0 SB3 B0 NEXT SB4 B1+B2 SA1 B4+B3 ZR X1 PACK SA2 A1+B5 SA3 A2+B5 SA4 A3+B5 SA5 A4+B5 BX6 X1+X2 BX6 X6+X3 BX6 X6+X4 BX6 X6+X5 SA6 B4 EQ B3 FIRST SA7 A1 FIRST SA7 A1 + B5 SA7 A7+B5 SA7 A7+B5 SA7 A7+B5 SB2 B2+B5 SB3 B3+4 EQ NEXT END ASCENT INTER ENTRY GS VFD D42/GS,N18/2 GS JP * SX6 B1 SA6 CIR SA2 B2 BX7 X2 SA7 CT SA1 CON BX6 X1 + SA1 1 NZ X1,* SA6 1 + SA1 1 NZ X1,* EQ GS CON VFD D18/SPT,N24/0,A18/CIR CIR CON 0 CT CON 0 END