10REM 24 (c) LDL Software may'95
20ONERRORCLOSE#0:GOTO40
30DIMs%(6),d%(6),hs%(10),hs$(10):PROC
io(1)
40MODE1:PROCini:PROCscrn
50REPEAT
60PROCkey:PROCmov:IFk%=8THENPROCout
70UNTILout:MODE7
80*FX4,0
90*FX229,0
100END
110:
120DEFPROCkey
130*FX21,0
140REPEAT:k%=0:z%=GET:IFz%=32THENk%=7
ELSEIF(z%AND95)=81THENk%=8 ELSEIFz%-48<r
d%+1ANDz%-48>0THENk%=z%-48
150UNTILk%:ENDPROC
160:
170DEFPROCmov:IFk%=8 ENDPROC ELSEIFk%=
7THENrd%=6-r%:PROCdice:ENDPROC ELSEIFs%(
k%)=0 ENDPROC
180m%=s%(k%):PROCcheck:IFc% ENDPROC
190s%(k%)=0:FORi%=1TO6:PROCplc(s%(i%),
i%*5-1,8):NEXT:IFm%=1ANDd%(1)=0THENd%(1)
=1 ELSEIFm%=4ANDd%(2)=0THENd%(2)=4 ELSEd
%(p%)=m%:IFp%<7THENp%=p%+1
200r%=r%+1:PROCplc(d%(1),4,20):PROCplc
(d%(2),9,20):COLOUR131-(d%(1)*d%(2)*.25)
:FORi%=3TO6:PROCplc(d%(i%),i%*5-1,20):NE
XT:ok%=1:IF(d%(1)=0ORd%(2)=0) ENDPROC EL
SE gs%=0:FORi%=3TO6:gs%=gs%+d%(i%):NEXT:
PROCtot:PROCbon:ENDPROC
210:
220DEFPROCcheck:c%=0:IF(p%<=6)OR(m%=1A
NDd%(1)=0)OR(m%=4ANDd%(2)=0)OR(p%=7ANDm%
=1ANDd%(1)=0)OR(p%=7ANDm%=4ANDd%(2)=0) E
NDPROC ELSE VDU7:c%=1:ENDPROC
230:
240DEFPROCtot:COLOUR2:COLOUR129:PRINTT
AB(2,3);"Highscore is ";LEFT$(s$,5-LEN(S
TR$(hs%(1))))STR$(hs%(1)):COLOUR3:PRINTT
AB(24,3)"Score is ";LEFT$(s$,5-LEN(STR$(
sc%)))STR$(sc%):COLOUR0:COLOUR130
250VDU31,37,21:IFgs%THENPRINTLEFT$("00
",2-LEN(STR$(gs%)))STR$(gs%):COLOUR131:E
NDPROC ELSEPRINT"--":COLOUR131:ENDPROC
260:
270DEFPROCbon:IFr%<6 ENDPROC
280IFgs%=24THENCOLOUR128:FORi%=1TO4:CO
LOUR2:PRINTTAB(13,9)"BONUS = 100":PROCti
m(70):COLOUR0:PRINTTAB(13,9)"BONUS = 100
":PROCtim(30):NEXT:sc%=sc%+100
290sc%=sc%+gs%:COLOUR0:COLOUR130:FORi%
=8TO10:PRINTTAB(6,i%);SPC(25):NEXT:PRINT
TAB(7,9)"Press key for next game":REPEAT
UNTILGET:PROCscrn:ENDPROC
300:
310DEFPROCover:COLOUR0:COLOUR130:FORi%
=8TO10:PRINTTAB(15,i%);SPC(17);:NEXT:PRI
NTTAB(17,9);"- GAME OVER -";:PROCtim(100
):REPEATUNTILGET:IFhs%(10)<sc%THENPROCen
d:ENDPROC ELSEsc%=0:PROCscrn:ENDPROC
320:
330DEFPROCout:PROCcld(8):COLOUR0:COLOU
R130:FORi%=8TO10:PRINTTAB(8,i%)SPC(20):N
EXT:PRINTTAB(10,9)"QUIT GAME Y/N ?":IFI
NSTR("YyJj",CHR$(GET)) PROCend:ENDPROC
340COLOUR128:FORi%=8TO10:PRINTTAB(8,i%
)SPC(20):NEXT:COLOUR131:FORi%=1TO6:PROCp
lc(s%(i%),i%*5-1,8):NEXT:ENDPROC
350:
360DEFPROCdice:IFok%=0 ENDPROC
370*FX21,0
380PROCcld(8):COLOUR0:COLOUR131:FORi%=
1TO6:s%(i%)=0:PRINTTAB(i%*5-1,15);" ":
NEXT:REPEAT:FORi%=1TOrd%:PROCplc(RND(6),
i%*5-1,8):NEXT:UNTILINKEY(-99):*FX21,0
390FORi%=1TOrd%:s%(i%)=RND(6):PROCplc(
s%(i%),i%*5-1,8):PRINTTAB(i%*5,15);STR$(
i%):NEXT:ok%=0:IFrd%>2 ENDPROC
400IF(d%(1)=0ORd%(2)=0)ANDp%=7ANDrd%=2
THENIF(s%(1)<>1ANDs%(1)<>4)AND(s%(2)<>1A
NDs%(2)<>4)THENPROCover:ENDPROC
410IF(d%(1)=0ORd%(2)=0)ANDp%=7ANDrd%=1
THENIF(d%(1)=0ANDs%(1)<>1)OR(d%(2)=0ANDs
%(1)<>4)THENPROCover:ENDPROC
420:
430DEFPROCcld(h%):FORi%=1TO6:PROCplc(0
,i%*5-1,h%):NEXT:ENDPROC
440:
450DEFPROCplc(v%,x%,y%):o%=240:IFv%=0T
HENCOLOUR0:COLOUR128:VDU31,x%,y%,32,32,3
2,31,x%,y%+1,32,32,32,31,x%,y%+2,32,32,3
2:COLOUR0:COLOUR131
460IFv%=1THENVDU31,x%,y%,32,32,32,31,x
%,y%+1,32,o%,32,31,x%,y%+2,32,32,32
470IFv%=2THENVDU31,x%,y%,o%,32,32,31,x
%,y%+1,32,32,32,31,x%,y%+2,32,32,o%
480IFv%=3THENVDU31,x%,y%,o%,32,32,31,x
%,y%+1,32,o%,32,31,x%,y%+2,32,32,o%
490IFv%=4THENVDU31,x%,y%,o%,32,o%,31,x
%,y%+1,32,32,32,31,x%,y%+2,o%,32,o%
500IFv%=5THENVDU31,x%,y%,o%,32,o%,31,x
%,y%+1,32,o%,32,31,x%,y%+2,o%,32,o%
510IFv%=6THENVDU31,x%,y%,o%,32,o%,31,x
%,y%+1,o%,32,o%,31,x%,y%+2,o%,32,o%
520ENDPROC
530:
540DEFPROCtim(tm%):T%=TIME+tm%:REPEATU
NTILTIME>=T%:ENDPROC
550:
560DEFPROCscrn
570COLOUR3:COLOUR129:CLG:FORi%=2TO4:PR
INTTAB(0,i%);SPC(40);:NEXT:FORi%=14TO16:
PRINTTAB(0,i%);SPC(40);:NEXT:FORi%=26TO2
8:PRINTTAB(0,i%);SPC(40);:NEXT:FORi%=5TO
25:PRINTTAB(36,i%);" ";:NEXT:COLOUR0
580COLOUR130:FORi%=20TO22:PRINTTAB(36,
i%);" ";:NEXT:COLOUR131:FORi%=1TO6:PR
INTTAB(i%*5-1,15);" ";:d%(i%)=0:NEXT:P
RINTTAB(4,27);SPC(8):PRINTTAB(14,27);SPC
(18):q%=0:out=0:ok%=1:gs%=0:rd%=6:r%=0:p
%=3:PROCtot:PROCdice:ENDPROC
590:
600DEFPROCini
610*FX4,2
620s$=" ":*FX229,1
630VDU23,240,0,60,126,126,126,126,60,0
,23,241,8,12,14,255,255,14,12,8:COLOUR3:
COLOUR129:FORi%=1TO3:PRINTTAB(0,i%);SPC4
0;:NEXT:PRINTTAB(16,2)"20-FOUR":COLOUR2:
COLOUR128:PRINTTAB(9,10)"A game to chall
enge!";TAB(15,15)"INFO Y/N?":COLOUR1
640COLOUR131:VDU23,1,0;0;0;0;:T=RND(-T
IME):PROCplc(1,5,24):PROCplc(4,10,24):FO
Ri%=3TO6:PROCplc(6,i%*5+2,24):NEXT:sc%=0
:IF INSTR("YyJj",GET$)=0 ENDPROC
650COLOUR2:COLOUR128:CLS:PRINTTAB(16,2
)"20-FOUR":PRINT'''" Play the game with
six dice by pressing 1, 2, 3, 4, 5 or 6
trying to reach"'" a total of 24 points.
"''" Whenever you get 24, a BONUS of 100
pts is added to your score."
660PRINT'" You must pick up at least O
NE dice, but you are allowed to pick up
more."''" HOWEVER....."
670PRINT" your score only counts wh
en you have obtained a 1 AND 4."''" Pres
s SPACE to roll and stop dice."''''" GO
T ONE AND FOUR? MAKE TWENTY-FOUR !!":PRI
NT''TAB(8)"During the game: Q=QUIT":REPE
ATUNTILGET:ENDPROC
680:
690DEFPROCend
700COLOUR2:COLOUR128:CLS:PRINTTAB(12,3
)"HIGH SCORES ARE:":FORi%=1TO10:PRINTTAB
(4,i%+7);hs$(i%);LEFT$(STRING$(25," "),2
5-LEN(hs$(i%)));LEFT$(" ",6-LEN(ST
R$(hs%(i%))));STR$(hs%(i%));:NEXT:IFsc%>
hs%(10)THENPROCinv:GOTO700
710IFq%THENPRINTTAB(4,20)"Do you want
to save score Y/N ?":IFINSTR("YyJj",CHR
$(GET))THENPROCio(0)
720PRINTTAB(4,23)"Do you want to play
again Y/N ?":IFINSTR("Nn",CHR$(GET))THE
Nout=1:ENDPROC ELSEsc%=0:PROCscrn:ENDPRO
C
730:
740DEFPROCinv:PRINTTAB(4,20)"Enter you
r name for the TOP TEN":VDU31,4,23,241,3
2,23,1,1;0;0;0;:COLOUR0:COLOUR130:FORi%=
22TO24:PRINTTAB(6,i%);SPC(27);:NEXT:VDU3
1,7,23:min%=7:max%=min%+25:pl%=min%:n$="
":REPEAT:i%=GET
750IFi%=13OR(i%=127ANDpl%=min%)OR(i%<>
127ANDpl%=max%)THEN ELSEVDU31,pl%,23,i%:
pl%=pl%+1:n$=n$+CHR$(i%):IFi%=127THENpl%
=pl%-2:n$=LEFT$(n$,pl%-min%)
760UNTILi%=13:FORi%=1TO10:IFsc%>=hs%(i
%)THENFORj%=10TOi%+1STEP-1:hs$(j%)=hs$(j
%-1):hs%(j%)=hs%(j%-1):NEXT:hs$(i%)=n$:h
s%(i%)=sc%:q%=1:sc%=0:i%=10
770NEXT:VDU23,1,0;0;0;0;:ENDPROC
780:
790DEFPROCio(fl%):IFfl%THENFORi%=1TO10
:hs$(i%)="JJ":hs%(i%)=110-i%*10:NEXT:f%=
OPENIN"T4DAT":FORi%=1TO10:INPUT#f%,hs$(i
%),hs%(i%):NEXT:CLOSE#0:ENDPROC ELSEf%=O
PENOUT"T4DAT":FORi%=1TO10:PRINT#f%,hs$(i
%),hs%(i%):NEXT:CLOSE#0:ENDPROC