10REM "THE DOMINO GAME" 20REM ****************** 30REM 40REM BY S.ANGELL 1983 50MODE7 60ENVELOPE2,128,55,8.3,5,1,3,5,127,0, 0,-127,126,126 70ENVELOPE3,128,-25,-8.3,-5,1,3,5,127 ,0,0,-127,126,126 80DIM DOMS%(2),POSN%(2,2),D%(2,2),CLO R%(2),ROUTE%(2,100),TN%(2) 90DIM TL%(2),SCR%(2,5) 100ROUND%=0:FORI%=0TO2:FORJ%=1TO5:SCR% (I%,J%)=0:NEXT:NEXT 110PROCsetup 120PROCintro 130MODE1 140PROCarena 150PROCplay 160MODE7 170PROCscore 180PROCsetup 190GOTO130 200REM************************* 210DEFPROCsetup 220VDU23,241,0,24,24,24,24,24,24,24 230VDU23,243,0,0,0,255,255,0,0,0 240CLOR%(0)=2:CLOR%(1)=3:COLP%=FALSE 250FORI%=0TO2 260DOMS%(I%)=0:TN%(I%)=0:FORJ%=0TO100 270ROUTE%(I%,J%)=0:NEXT:NEXT 280RESTORE 290FORI%=0 TO 1 300READ POSN%(I%,0):READPOSN%(I%,1) 310DOMS%(I%)=0:D%(I%,0)=3:D%(I%,1)=3 320ROUTE%(I%,TN%(I%))=-1 330NEXT 340ENDPROC 350DATA 5,26,31,26 360REM************************** 370DEFPROCplay 380FORI%=0 TO 1 390IFDOMS%(I%)>80 THEN WAITTIME =TIME+ 5 ELSE WAITTIME =TIME+10 400REPEAT:UNTIL TIME>WAITTIME 410PROCgetdirection 420PROCdomino(D%(I%,0),D%(I%,1),POSN%( I%,0),POSN%(I%,1),CLOR%(I%)) 430D%(I%,1)=D%(I%,0) 440PROCsound(3+I%) 450NEXT 460IFCOLP%=TRUE COLP%=FALSE:ENDPROC 470GOTO380:ENDPROC 480REM************************** 490DEFPROCdomino(D%,LASTD%,X%,Y%,CLOR% ) 500COLOUR CLOR% 510VDU31,X%,Y% 520IFD%=1 PROCchk:VDU241:PROCposition: ENDPROC 530IFD%=2 AND (LASTD%=4 OR LASTD%=3) P ROCchk:VDU241:PROCposition:ELSEIFD%=2 VD U8,8:PROCchk:VDU241:PROCposition:ENDPROC 540IFD%=3 AND LASTD%=2 VDU8,8:PROCchk: VDU243,11,8:PROCposition:ELSEIFD%=3 PROC chk:VDU243,11,8:PROCposition:ENDPROC 550IFD%=4 AND LASTD%=2 VDU8,8:PROCchk: VDU243,10,8:PROCposition:ELSEIFD%=4 PROC chk:VDU243,10,8:PROCposition:ENDPROC 560ENDPROC 570REM********************** 580DEFPROCposition 590POSN%(I%,0)=POS 600POSN%(I%,1)=VPOS 610PRINTTAB(2+30*I%,2);DOMS%(I%) 620IFCOLP%=TRUE ENDPROC 630IFD%(I%,0)<>D%(I%,1) ROUTE%(I%,TN%( I%)+1)=D%(I%,1):TN%(I%)=TN%(I%)+2:ENDPRO C 640ROUTE%(I%,TN%(I%))=ROUTE%(I%,TN%(I% ))+1 650ENDPROC 660REM******************** 670DEFPROCintro 680PRINTTAB(15,5);CHR$141" THE" 690PRINTTAB(15,6);CHR$141" THE" 700PRINTTAB(13,8);CHR$141" DOMINO" 710PRINTTAB(13,9);CHR$141" DOMINO" 720PRINTTAB(14,11);CHR$141" GAME" 730PRINTTAB(14,12);CHR$141" GAME" 740 PRINTTAB(5,14);" Use your joystick to control the" 750 PRINT" direction that the dominoes take." 760PROCsound(2) 770PRINTTAB(5,18);" Pressing the fire button of the" 780PRINT" joystick controling the yell ow dominoes" 790PRINTTAB(0,20)" will start the game ." 791PRINTTAB(2,22)" PRESS SPACE BAR IF NO JOYSTICKS" 800IF((ADVAL(0) AND 3)=1) PRINT"FIRED" :ky%=FALSE:ENDPROC 801IF INKEY$(5)=" " PROCkeyinstr:ky%=T RUE:ENDPROC 802GOTO800 810ENDPROC 820REM******************** 830DEFPROCgetdirection 840IF NOTky% D%(I%,0)=1*-(ADVAL(I%*2+1 )<2000)+2*-(ADVAL(I%*2+1)>60000) 841IF ky% D%(0,0)=1*-(INKEY(-83))+2*-( INKEY(-67)):D%(1,0)=1*-(INKEY(-104))+2*- (INKEY(-103)) 850IF(D%(I%,0)=0)ANDNOTky% D%(I%,0)=3* -(ADVAL(I%*2+2)>50000)+4*-(ADVAL(I%*2+2) <2000) 851IF(D%(I%,0)=0)ANDky% D%(0,0)=3*-(IN KEY(-66))+4*-(INKEY(-98)) 852IF(D%(I%,0)=0)ANDky% D%(1,0)=3*-(IN KEY(-73))+4*-(INKEY(-105)) 860IFD%(I%,0)=0 D%(I%,0)=D%(I%,1) 870ENDPROC 880REM********************* 890DEFPROCchk 900IFCOLP%=TRUE ENDPROC 910A%=135 920C=USR(&FFF4) 930C=C AND &FFFF 940C=C DIV &100 950IF CHR$(C)<>" " VDU7:PROCcolapse:EN DPROC 960DOMS%(I%)=DOMS%(I%)+1 970ENDPROC 980REM******************** 990DEFPROCarena 1000GCOL0,1:CLG 1010MOVE30,30:DRAW 30,1000:DRAW 1200,10 00:DRAW 1200,30:DRAW 30,30 1020COLOUR1:PRINTTAB(15,2);"DOMINOES" 1030ENDPROC 1040REM********************* 1050DEFPROCcolapse 1060COLP%=TRUE 1070IFD%(I%,1)=1 AND D%(I%,0)=1 POSN%(I %,0)=POSN%(I%,0)+2 1080IFD%(I%,1)=2 POSN%(I%,0)=POSN%(I%,0 )-2 1090IFD%(I%,1)=1 AND D%(I%,0)=2 POSN%(I %,0)=POSN%(I%,0)+2 1100IFD%(I%,1)=4 AND D%(I%,0)=2 POSN%(I %,0)=POSN%(I%,0)+2 1110IFD%(I%,1)=3 AND D%(I%,0)=2 POSN%(I %,0)=POSN%(I%,0)+2 1120VDU23,241,0,0,0,3,31,252,224,0,23,2 43,48,48,48,24,24,12,12,12 1130LASTDI%=D%(I%,0):DI%=D%(I%,1) 1140DI%=DI%+ABS(DI%=1)+(DI%=2) 1150DI%=DI%+ABS(DI%=3)+(DI%=4) 1160REPEAT 1170PROCdomino(DI%,LASTDI%,POSN%(I%,0), POSN%(I%,1),CLOR%(I%)) 1180ROUTE%(I%,TN%(I%))=ROUTE%(I%,TN%(I% ))-1 1190PROCsound(1) 1200DOMS%(I%)=(DOMS%(I%)-1)*-(DOMS%(I%) >0) 1210PRINTTAB(2+30*I%,2);DOMS%(I%);" " 1220LASTDI%=DI% 1230UNTIL (ROUTE%(I%,TN%(I%))<0) 1240IFTN%(I%)<=0 IN%=INKEY(500):ENDPROC 1250 DI%=ROUTE%(I%,TN%(I%)-1):TN%(I%)=T N%(I%)-2 1260GOTO1140 1270REM*************** 1280DEFPROCsound(N%) 1290ON N% GOTO 1300,1320,1360,1370 1300ENVELOPE 1,128.0,33.3,0,-66.7,3.0,0 ,0,127,0,0,-127,126,126 1310SOUND 0,1,100,2:ENDPROC 1320FORF%=101 TO 13 STEP -4 1330PRINTTAB(((F%-13)/4)+5,16);" |" 1340SOUND 1,-15,F%,2:SOUND1,-10,F%+16,2 :SOUND1,-10,F%+28,2:NEXT 1350SOUND1,-15,5,20:ENDPROC 1360SOUND2,-10,20,1:ENDPROC 1370SOUND3,-10,2,1:ENDPROC 1380REM************************ 1390DEFPROCscore 1400CLS:PRINTTAB(5,3);CHR$141;" DOMINO CHAMPIONSHIP":PRINTTAB(5,4);CHR$141;" DO MINO CHAMPIONSHIP" 1410ROUND%=ROUND%+1 1420PRINTTAB(0,6);" ROUND";TAB(15);" YE LLOW";TAB(25);" WHITE" 1430PRINTTAB(0,7);" `````";TAB(15);" `` ````";TAB(25);" `````" 1440 SCR%(1,ROUND%)=DOMS%(0) 1450SCR%(2,ROUND%)=DOMS%(1) 1460FORI%=1TO5 1470 PRINTTAB(3,7+I%);" ";I%;TAB(14);" ";SCR%(1,I%);TAB(23);" ";SCR%(2,I%) 1480NEXT 1490TL%(1)=TL%(1)+DOMS%(0):TL%(2)=TL%(2 )+DOMS%(1) 1500 PRINTTAB(15,14);" ``````";TAB(8);" ``````" 1510PRINTTAB(17,15);TL%(1);TAB(11);TL%( 2) 1520IF ROUND%=5 PRINTTAB(10,20);CHR$141 " GAME OVER":PRINTTAB(10,21);CHR$141" GA ME OVER":PRINTTAB(5)"Would you like anot her contest Y/N?" ELSE PRINTTAB(10,20)" Press space to play" 1521*FX15,0 1540REPEAT:IN$=GET$:UNTIL INSTR("YN ",I N$) 1550IF IN$="Y" ANDROUND%=5:RUN 1560IFROUND%=5 CHAIN"SELECT" 1570ENDPROC 1580REM***************************** 1590DEFPROCkeyinstr 1600CLS:PRINTTAB(5,2)" The control keys are:`" 1610PRINTTAB(2,5)" YELLOW DOMINOES X= LEFT":PRINTTAB(19,6)" C= RIGHT":PRINTTAB (19,7)" A= UP":PRINTTAB(19,8)" Z= DOWN" 1620PRINTTAB(2,10)" WHITE DOMINOES ,= LEFT":PRINTTAB(19,11)" .= RIGHT":PRINTT AB(19,12)" := UP":PRINTTAB(19,13)" /= DO WN" 1621PRINTTAB(5,20)" Press any key to s tart game":x=GET 1630ENDPROC 1640REM*****************************