C C SYSTEM/MACHINE - IAS V1.1 / PDP-11/45 C C AUTHOR - RANDALL ADAMS C C DATE - DECEMBER 1976 C C TYPE/LANGUAGE - ROUTINE / FORTRAN IV C C C RESTRICTIONS - REQUIRES "VTPLOT" VT52 PLOT SUBROUTINE C RUNS ONLY ON A VT52 TERMINAL. C C C C C ABSTRACT - THIS PROGRAM ALLOWS TO USERS TO C TO PLAY A GAME OF "PING-PONG" ON A C VT 52 TERMINAL C C C C LOGICAL*1 IBUF,UP1,UP2,ST1,ST2,DN1,DN2,ILEV,IEX INTEGER ISTAT(2),IPRM(6) REAL*8 MCR DATA ICL/' '/ DATA MCR/6R...MCR/ DATA IEX/'E'/ DATA IHOM,IERA/"110,"112/ DATA IEND/'|'/ DATA ING,IGR/"107,"106/ DATA IWVB/"11000/ DATA IBELL/"7/ DATA IESC/"33/ DATA UP1,DN1,ST1,UP2,DN2,ST2/"161,"172,"141,"71,"63,"66/ DATA IKILL,IRNE/"12,"1030/ DATA IBL/"141/ DATA IBLL/"141/ C C C CALL ASSIGN(1,'TI:') CALL ASSIGN(2,'TI:') CALL FDBSET(2,'READONLY','SHARE') CALL GETADR(IPRM,IBUF) IFIR=1 IPRM(2)=1 C SPEED =1.0 WRITE(1,1001) 1001 FORMAT('1 PING PONG GAME FOR VT52''S',/,'0', 1' TYPE E FOR "EXPERT" .. B FOR "BEGINNER"') READ(1,1002)ILEV 1002 FORMAT(A1) IF (ILEV.EQ.IEX)SPEED=2.0 C C SETUP C WRITE(1,3)IESC,IHOM WRITE(1,3)IESC,IERA 10 WRITE(1,1) 1 FORMAT('+',13X,56('-'),$) CALL VTPLOT(1,1,ICL) WRITE(1,1) CALL VTPLOT(1,2,ICL) WRITE(1,3)IESC,IGR 3 FORMAT('+',2A1) 7 FORMAT(' ',2A1) IX=25 IY=25 C C C CLEAR C C C=0.3 20 ISCO1=0 ISCO2=0 VBX=0.0 VBY=0.0 VP1=0.0 VP2=0.0 W=0.0 BX=0.0 BY=0.0 P1=0.0 P2=0.0 IMISS=0 ISER=1 C C C SERVE C C 30 VBX=25.0 * SPEED IF (IFIR.EQ.1)GO TO 31 CALL VTPLOT(12,INT(PO1),ICL) CALL VTPLOT(12,INT(PO1)+1,ICL) CALL VTPLOT(12,INT(PO1)-1,ICL) CALL VTPLOT(69,INT(PO2),ICL) CALL VTPLOT(69,INT(PO2)+1,ICL) CALL VTPLOT(69,INT(PO2)-1,ICL) 31 IFIR=0 VBY=(RAN(IX,IY)*5.0) BX=13.0 IF(ISER.EQ.2)VBX=-VBX IF(ISER.EQ.2)BX=68.0 BY=10.0 P1=10.0 P2=10.0 BOX=BX BOY=BY PO1=P1 PO2=P2 VP1=0.0 VP2=0.0 C CALL WAIT(1000,1,IERR) CALL VTPLOT(12,INT(P1),IBL) CALL VTPLOT(12,INT(P1)+1,IBL) CALL VTPLOT(12,INT(P1)-1,IBL) CALL VTPLOT(69,INT(P2),IBL) CALL VTPLOT(69,INT(P2)+1,IBL) CALL VTPLOT(69,INT(P2)-1,IBL) C C CALL WAIT(1,2,IERR) 40 CALL QIO(IRNE,2,1,60,ISTAT,IPRM,ISW) DO 90 I=1,5 CALL WAIT(1,1,IERR) CALL READEF(1,IDS) IF(IDS.LE.0)GO TO 90 CALL CLREF(1) IF(IBUF.EQ.UP1)VP1=VP1+5.*SPEED IF(IBUF.EQ.DN1)VP1=VP1-5.*SPEED IF(IBUF.EQ.ST1)VP1=0.0 IF(IBUF.EQ.UP2)VP2=VP2+5.*SPEED IF(IBUF.EQ.DN2)VP2=VP2-5.*SPEED IF(IBUF.EQ.ST2)VP2=0.0 IF(I.EQ.5)GO TO 100 CALL QIO(IRNE,2,1,60,ISTAT,IPRM,ISW) 90 CONTINUE CALL READEF(1,IDS) IF(IDS.LE.0)CALL WTQIO(IKILL,2,2,20) CALL CLREF(1) 100 CONTINUE C C PADDLE POSITION C P2=P2+VP2/10.0 P1=P1+VP1/10.0 C C C PADDLE 1 C IF(P1.LE.2.0.OR.P1.GE.22.0)VP1=0.0 IF(P1.LE.2.0)P1=2.0 IF(P1.GE.22.0)P1=22.0 C IF(ABS(P1-PO1).LT.1.0)GO TO 150 C NEED TO CHANGE POSITION IF(PO1-P1)110,110,120 110 CALL VTPLOT(12,INT(P1)+1,IBL) CALL VTPLOT(12,INT(P1),IBL) CALL VTPLOT(12,INT(P1)-1,IBL) DO 111 J=INT(PO1)-1,INT(P1)-2 CALL VTPLOT(12,J,ICL) 111 CONTINUE PO1=P1 GO TO 150 120 CALL VTPLOT(12,INT(P1)-1,IBL) CALL VTPLOT(12,INT(P1),IBL) CALL VTPLOT(12,INT(P1)+1,IBL) DO 121 J=INT(P1)+2,INT(PO1)+1 CALL VTPLOT(12,J,ICL) 121 CONTINUE PO1=P1 150 CONTINUE IF(P2.LE.2.0.OR.P2.GE.22.0)VP2=0.0 IF(P2.LE.2.0)P2=2.0 IF(P2.GE.22.0)P2=22.0 C C IF(ABS(PO2-P2).LT.1.0)GO TO 200 IF(PO2-P2)160,160,170 160 CALL VTPLOT(69,INT(P2)+1,IBL) CALL VTPLOT(69,INT(P2),IBL) CALL VTPLOT(69,INT(P2)-1,IBL) DO 161 J=INT(PO2)-1,INT(P2)-2 CALL VTPLOT(69,J,ICL) 161 CONTINUE PO2=P2 GO TO 200 170 CALL VTPLOT(69,INT(P2)-1,IBL) CALL VTPLOT(69,INT(P2),IBL) CALL VTPLOT(69,INT(P2)+1,IBL) DO 171 J=INT(P2)+2,INT(PO2)+1 CALL VTPLOT(69,J,ICL) 171 CONTINUE PO2=P2 200 CONTINUE C C C MOVE BALL C BX=BX+VBX/10.0 BY=BY+VBY/10.0 IF(ABS(BOX-BX).LT.1.0.AND.ABS(BOY-BY).LT.1.0)GO TO 40 C C CHECK FOR SIDE HIT C IF(BY.LE.22.0.AND.BY.GE.2.0.AND.BX.LE.68.0.AND.BX.GE.13.0) 1GO TO 300 IF(BX.GE.13.0.AND.BX.LE.68.0)GO TO 250 IF(VBX.LT.0.0.AND.BX.GE.68.0)GO TO 300 IF(VBX.GT.0.0.AND.BX.LT.13.0)GO TO 300 IF(VBX.LT.0.0.AND.ABS(BOY-PO1-.5).GT.1.75)IMISS=1 IF(VBX.GT.0.0.AND.ABS(BOY-PO2-.5).GT.1.75)IMISS=2 IF(IMISS.GT.0)GO TO 400 WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL IF(VBX)230,230,240 230 VBY=VBY+(1.0-C)*(W+VP1) W=C*(W+VP1) VBX=-VBX GO TO 300 240 VBY=VBY+(1.0-C)*(W+VP2) W=C*(W+VP2) VBX=-VBX GO TO 300 250 VBX=VBX+(C)*W W=(1-C)*W VBY=-VBY WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL 300 CONTINUE IF(BX.GE.68.0)BX=68.0 IF(BX.LE.13.0)BX=13.0 IF(BY.LE.2.0)BY=2.0 IF(BY.GE.22.0)BY=22.0 CALL VTPLOT(INT(BOX),INT(BOY),ICL) CALL VTPLOT(INT(BX),INT(BY),IBLL) BOX=BX BOY=BY GO TO 40 400 CONTINUE WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL WRITE(1,3)IESC,IBELL CALL VTPLOT(INT(BOX),INT(BOY),ICL) IF(IMISS.EQ.1)ISCO2=ISCO2+1 IF(IMISS.EQ.2)ISCO1=ISCO1+1 IF(ISCO1.EQ.0.AND.ISCO2.GE.7)GO TO 411 IF(ISCO2.EQ.0.AND.ISCO1.GE.7)GO TO 422 IF(ISCO1.LT.11.AND.ISCO2.LT.11)GO TO 450 CALL VTPLOT(1,10,ICL) 433 WRITE(1,3)IESC,ING IF(ISCO1.GE.11)WRITE(1,401) IF(ISCO2.GE.11)WRITE(1,402) 401 FORMAT('+',15X,'***** THE WINNER !!! *****',$) 402 FORMAT('+',50X,'***** THE WINNER !!! *****',$) CALL REQUES(MCR) CALL EXIT 411 WRITE(1,3)IESC,ING WRITE(1,412) 412 FORMAT('+',50X,'*** THE WINNER BY A SKUNK ***',$) CALL REQUES(MCR) CALL EXIT 422 WRITE(1,3)IESC,ING WRITE(1,423) 423 FORMAT('+',15X,'*** THE WINNER BY A SKUNK ***',$) CALL REQUES(MCR) CALL EXIT 450 CALL VTPLOT(1,10,ICL) WRITE(1,3)IESC,ING WRITE(1,2)ISCO1,ISCO2 2 FORMAT('+',I5,68X,I5,$) WRITE(1,3)IESC,IGR IMISS=0 IF(MOD(ISCO1+ISCO2,5).NE.0.)GO TO 30 IF(ISER.EQ.1)ISER=3 ISER=ISER-1 GO TO 30 END