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