@Retrochallenge – World’s Latest Homework

January 27, 2013January 21, 2015Retrocosm 3 Comments

Picture the scene, it’s a hot summer’s day in 1985, Frankie by Sister Sledge tops the singles chart, Filofaxes are the new big thing, and I’m at school sat in front of a BBC Model B trying in vain to finish my Computer Studies project before the term ends, a computer version of the dice game Yahtzee. To my right David is putting the finishing touches to his military magazine database, on my left Simon is entertaining most of the class with his Hungry Horace goes Skiing clone.

How It Used To Look

Behind me, dreamy Donna and her friend Jackie are arguing over which band is best, Duran Duran or Wham and across the class Nick is throwing Jeff’s school bag out of the second floor window while Mark (Urbancamo) distracts the teacher Mr Rigby. Only a few days until the end of term and the summer holidays.

Faced by the choice of finishing my code or intervening in the Duran Duran/Wham debate, I choose the later, if only to spend more time with Donna. So I type SAVE”YAHTZEE” for the last time, remove the disk from the drive and throw it into my Adidas school bag.

28 years later at the beginning of January this year I found the aforementioned disk whilst digging around in the loft and miraculously managed to recover the contents. My Retrochallenge was therefore decided, to try to finish Yahtzee.

Roll & Hold Toggle

Since the last update I’ve managed to eliminate the need to jump out of Mode 7 to display the dice by building the graphical representation of each die using Sixels.

Although I’ve lost the roundness of the dots and the squareness of the dice and I still prefer the end result plus it gives a more consistent feel to the overall aesthetic of the program.

Using this mode has also allowed me to improve the layout by placing the dice horizontally, label them more clearly and fit in more text where necessary. Here’s a list of improvements made since my last entry:-

Graphics updated to Mode 7
Dice properly labelled and numbered
Hold/Roll toggle selection
Option to amend Hold/Toggle choices
Option to skip 2nd and 3rd rolls
Current round displayed
Used GET$ to remove unwanted question marks

Everything seems to be working correctly and although I might be tempted to tinker a little more I think Yahtzee is finally at a stage where I could submit it as finished coursework and hope to improve upon the ‘C’ I was originally graded.

Given that I started this code 28 years ago I confess it is a tad late. If Mr Rigby, our put upon Computer Studies teacher is indeed still alive (his nickname was Rigamortis) then I hope he won’t give me a detention for what is presumably the world’s latest homework. I’ve included the finished code and a short video of it in action below.

MMC Solid State Drive

I’ve also received the MMC solid state disk drive that I ordered. This great little device hooks up to the BBC’s user port and makes the transfer of files back and forth between the PC and BBC via SD cards relatively simple.

Currently the unit is dangling around on the end of its ribbon cable but it does come supplied with the parts needed to fit it inside the BBC’s case. I have to make a decision however on whether I want to attempt to cut a whole in the case to allow card changes to be made without the need to open the old girl up.

Here is the final Yahtzee code, if you’re still out there Mr Rigby, let me know what you think and I’m sorry it’s late:-

 10 REM YAHTZEE BY RETROCOSM
 20 REM RETROCHALLENGE 2013 WINTER WARMUP
 30 REM DEFINE VARIABLES
 40 CONE=0:CTWO=0:CTHREE=0:CFOUR=0
 50 P=0:Q=0:SC=0:ST=0:Y=0:C=0
 60 JUMP=0:RSCORE=0:SORTED=0:ROUND=1
 70 DIM Q$(5):DIM A(5):DIM V(5):DIM D(5)
 80 IF RND(-TIME)
 90 REM START SCREEN
 100 CLS:MODE 7
 110 PRINT:PRINT:PRINT
 120 PRINTCHR$(141);CHR$(131)" YAHTZEE"
 130 PRINTCHR$(141);CHR$(130)" YAHTZEE"
 140 PRINT:PRINT:PRINT
 150 PRINTCHR$(132)" By Retrocosm.net"
 160 PRINT:PRINT:PRINT:PRINT
 170 PRINTCHR$(129)" Press Any Key"
 180 LET B$=GET$:IF B$="" THEN 150
 190 CLS
 200 PRINT:PRINT:PRINT
 210 PRINTCHR$(132)"Instructions(Y/N)"
 220 PRINT:PRINT
 230 LET A$=GET$
 240 IF A$="Y" THEN 2000
 250 IF A$<>"N" THEN 190
 260 CLS
 270 PRINT:PRINT
 280 PRINTCHR$(132)"Please Enter Your Name"
 290 PRINT:INPUT NAME$
 300 PRINT:PRINT"THANK YOU"
 310 CLS
 320 PRINTCHR$(141);CHR$(131)" YAHTZEE"
 330 PRINTCHR$(141);CHR$(130)" YAHTZEE"
 340 PRINTCHR$(141);CHR$(129)" ======="
 350 PRINTCHR$(141);CHR$(129)" ======="
 360 PRINT:PRINT:PRINT
 370 PRINTCHR$(132)"Player One Is ";CHR$(129);CHR$(136);NAME$
 380 PRINT:PRINT:PRINT
 390 PRINT CHR$(129)"Press Any Key To Play"
 400 LET B$=GET$:IF B$="" THEN 370
 500
 510
 520 PRINT:PRINT
 530 CLS
 540 REM RANDOMISE & PRINT DICE
 550 FOR L=0 TO 4
 560 PRINT TAB(L*8,3);CHR$(132)"ROLL"
 570 LET Z=INT(RND(1)*6)+1:LET V(L+1)=Z
 580 ON Z GOSUB 1000,1020,1040,1060,1080,1100
 590 PRINT TAB(L*8,10);CHR$(132)"DIE ";L+1
 595 PRINT TAB(0,1);CHR$(131)"Round ";ROUND
 600 NEXT L
 610 C=1
 620 FOR F=0 TO 4
 630 PRINT TAB(0,12);CHR$(129);"Hold Die ";F+1;" (Y/N) "
 640 LET A$=GET$
 650 IF A$="Y" THEN LET A(F+1)=1 ELSE A(F+1)=0
 660 IF A$="Y" THEN PRINT TAB(F*8,3);CHR$(129)"HOLD"
 670 IF A$="N" THEN PRINT TAB(F*8,3);CHR$(131)"ROLL"
 680 NEXT F
 690 PRINT TAB(0,12);CHR$(132);"Roll(R) Go Back(B) Finish(F)"
 700 LET C$=GET$
 710 IF C$="R" THEN 730
 715 IF C$="F" THEN C=2:GOTO 870
 720 IF C$="B" THEN 620 ELSE 690
 730 FOR F=1 TO 5
 740 LET Z=INT(RND(1)*6)+1
 750 IF A(F)=0 THEN LET V(F)=Z
 760 NEXT F
 770 CLS
 780 FOR L=0 TO 4
 785 PRINT TAB(0,1);CHR$(131)"Round ";ROUND
 790 PRINT TAB(L*8,3);CHR$(132)"ROLL"
 800 PRINT TAB(L*8,10);CHR$(132)"DIE ";L+1
 805 IF SORTED=1 THEN PRINT TAB(L*8,3);CHR$(132)" "
 810 ON V(L+1) GOSUB 1000,1020,1040,1060,1080,1100
 820 NEXT L
 830 IF C=2 THEN GOTO 860
 840 LET C=C+1
 850 GOTO 620
 860 IF SORTED=1 GOTO 920
 870 PRINT TAB(0,12);CHR$(129);"Any Key To Sort "
 880 LET A$=GET$
 890 REM SORT DICE
 900 PROCsort
 910 IF SORTED=1 GOTO 780
 920 PROCreadice
 930 PROCscores
 940 ROUND=ROUND+1
 950 IF ROUND=6 THEN GOTO 2310
 960 GOTO 520
 1000 PROCone
 1010 RETURN
 1020 PROCtwo
 1030 RETURN
 1040 PROCthree
 1050 RETURN
 1060 PROCfour
 1070 RETURN
 1080 PROCfive
 1090 RETURN
 1100 PROCsix
 1110 RETURN
 2000 REM SHOW INSTRUCTIONS
 2010 CLS
 2020 PRINT:PRINT:PRINT CHR$(129)"YAHTZEE INSTRUCTIONS"
 2030 PRINT:PRINT CHR$(131)"Yahtzee is a simulated dice throwing"
 2040 PRINT CHR$(131)"game for one player."
 2050 PRINT CHR$(131)"The player shakes his dice."
 2060 PRINT CHR$(131)"After shaking you may pick up any"
 2070 PRINT CHR$(131)"amount of the dice you wish and shake"
 2080 PRINT CHR$(131)"again until you are satisfied with"
 2090 PRINT CHR$(131)"your score.You may do this twice after"
 2100 PRINT CHR$(131)"your first shake."
 2110 PRINT:PRINT:PRINT CHR$(132)"Press Any Key"
 2120 LET B$=GET$:IF B$="" THEN 1130
 2130 CLS
 2140 PRINT:PRINT:PRINT CHR$(129)"YAHTZEE SCORING"
 2150 PRINT:PRINT CHR$(131)"Points are awarded for getting certain"
 2160 PRINT CHR$(131)"amounts and patterns on the dice."
 2170 PRINT CHR$(131)"For example runs, sets or pairs"
 2180 PRINT:PRINT:PRINT CHR$(132)"Press any key to play"
 2190 LET B$=GET$:IF B$="" THEN 2190
 2200 GOTO 260
 2300 REM PRINT FINAL SCORE
 2310 CLS:PRINT:PRINT CHR$(132);"Final Score"
 2320 PRINT:PRINT CHR$(129);"After 5 Goes You Have A Score Of";CHR$(136);RSCORE
 2330 PROCsound
 2340 PRINT:PRINT CHR$(131);"Play Again(Y/N)":PRINT
 2350 LET Y$=GET$
 2360 IF Y$="Y" THEN 2390
 2370 IF Y$<>"N" THEN 2300
 2380 GOTO 2410
 2390 RESTORE
 2400 RUN
 2410 CLS
 2420 PRINT:PRINT CHR$(131);"Goodbye, Thank You For Playing Yahtzee."
 2430 END
 4000 DEFPROCsound
 4100 SOUND 1,-15,97,10
 4200 SOUND 1,-15,105,10
 4300 SOUND 1,-15,89,10
 4400 SOUND 1,-15,41,10
 4500 SOUND 1,-15,69,20
 4600 ENDPROC
 5000 DEFPROCone
 5010 PRINT TAB(L*8,5);CHR$151;CHR$255;CHR$255;CHR$255;CHR$255;CHR$255;CHR$255;CHR$159
 5020 PRINT TAB(L*8,6);CHR$151;CHR$255;CHR$255;CHR$191;CHR$239;CHR$255;CHR$255;CHR$159
 5030 PRINT TAB(L*8,7);CHR$151;CHR$255;CHR$255;CHR$253;CHR$254;CHR$255;CHR$255;CHR$159
 5035 PRINT TAB(L*8,8);CHR$151;CHR$255;CHR$255;CHR$255;CHR$255;CHR$255;CHR$255;CHR$159
 5040 ENDPROC
 5050 DEFPROCtwo
 5060 PRINT TAB(L*8,5);CHR$151;CHR$255;CHR$255;CHR$255;CHR$255;CHR$191;CHR$239;CHR$159
 5070 PRINT TAB(L*8,6);CHR$151;CHR$255;CHR$255;CHR$255;CHR$255;CHR$253;CHR$254;CHR$159
 5080 PRINT TAB(L*8,7);CHR$151;CHR$191;CHR$239;CHR$255;CHR$255;CHR$255;CHR$255;CHR$159
 5085 PRINT TAB(L*8,8);CHR$151;CHR$253;CHR$254;CHR$255;CHR$255;CHR$255;CHR$255;CHR$159
 5090 ENDPROC
 5100 DEFPROCthree
 5110 PRINT TAB(L*8,5);CHR$151;CHR$255;CHR$255;CHR$255;CHR$255;CHR$191;CHR$239;CHR$159
 5120 PRINT TAB(L*8,6);CHR$151;CHR$255;CHR$255;CHR$191;CHR$239;CHR$253;CHR$254;CHR$159
 5130 PRINT TAB(L*8,7);CHR$151;CHR$191;CHR$239;CHR$253;CHR$254;CHR$255;CHR$255;CHR$159
 5135 PRINT TAB(L*8,8);CHR$151;CHR$253;CHR$254;CHR$255;CHR$255;CHR$255;CHR$255;CHR$159
 5140 ENDPROC
 5150 DEFPROCfour
 5160 PRINT TAB(L*8,5);CHR$151;CHR$191;CHR$239;CHR$255;CHR$255;CHR$191;CHR$239;CHR$159
 5170 PRINT TAB(L*8,6);CHR$151;CHR$253;CHR$254;CHR$255;CHR$255;CHR$253;CHR$254;CHR$159
 5180 PRINT TAB(L*8,7);CHR$151;CHR$191;CHR$239;CHR$255;CHR$255;CHR$191;CHR$239;CHR$159
 5185 PRINT TAB(L*8,8);CHR$151;CHR$253;CHR$254;CHR$255;CHR$255;CHR$253;CHR$254;CHR$159
 5190 ENDPROC
 5200 DEFPROCfive
 5210 PRINT TAB(L*8,5);CHR$151;CHR$191;CHR$239;CHR$255;CHR$255;CHR$191;CHR$239;CHR$159
 5220 PRINT TAB(L*8,6);CHR$151;CHR$253;CHR$254;CHR$191;CHR$239;CHR$253;CHR$254;CHR$159
 5230 PRINT TAB(L*8,7);CHR$151;CHR$191;CHR$239;CHR$253;CHR$254;CHR$191;CHR$239;CHR$159
 5235 PRINT TAB(L*8,8);CHR$151;CHR$253;CHR$254;CHR$255;CHR$255;CHR$253;CHR$254;CHR$159
 5240 ENDPROC
 5250 DEFPROCsix
 5260 PRINT TAB(L*8,5);CHR$151;CHR$191;CHR$239;CHR$255;CHR$255;CHR$191;CHR$239;CHR$159
 5270 PRINT TAB(L*8,6);CHR$151;CHR$189;CHR$238;CHR$255;CHR$255;CHR$189;CHR$238;CHR$159
 5280 PRINT TAB(L*8,7);CHR$151;CHR$189;CHR$238;CHR$255;CHR$255;CHR$189;CHR$238;CHR$159
 5285 PRINT TAB(L*8,8);CHR$151;CHR$253;CHR$254;CHR$255;CHR$255;CHR$253;CHR$254;CHR$159
 5290 ENDPROC
 6000 DEFPROCsort
 6010 FOR PASS=1 TO 5
 6020 FOR SORT=1 TO 4
 6030 ST=V(SORT+1)
 6040 IF V(SORT)<V(SORT+1) THEN ST=V(SORT)
 6050 IF V(SORT)<V(SORT+1) THEN V(SORT)=V(SORT+1)
 6060 V(SORT+1)=ST
 6070 NEXT SORT
 6080 NEXT PASS
 6090 SORTED=1
 6100 ENDPROC
 7000 DEFPROCreadice
 7010 CONE=0:CTWO=0:CTHREE=0:CFOUR=0
 7020 SORTED=0:JUMP=0
 7030 FOR I=1 TO 4
 7040 IF V(1)=V(I+1) THEN CONE=CONE+1 ELSE JUMP=(I+1)
 7050 IF JUMP>0 THEN I=4
 7060 REM
 7070 NEXT I
 7080 K=JUMP:JUMP=0
 7090 IF K>4 THEN GOTO 7260
 7100 FOR I=K TO 4
 7110 IF V(I)=V(I+1) THEN CTWO=CTWO+1 ELSE JUMP=(I+1)
 7120 IF JUMP>0 THEN I=4
 7130 REM
 7140 NEXT I
 7150 Q=JUMP:JUMP=0
 7160 IF Q>4 THEN GOTO 7260
 7170 FOR I=Q TO 4
 7180 IF V(I)=V(I+1) THEN CTHREE=CTHREE+1 ELSE JUMP=(I+1)
 7190 IF JUMP>0 THEN I=4
 7200 NEXT I
 7210 T=JUMP:JUMP=0
 7220 IF T>4 THEN GOTO 7260
 7230 FOR I=T TO 4
 7240 IF V(I)=V(I+1) THEN CFOUR=CFOUR+1 ELSE I=4
 7250 NEXT I
 7260 ENDPROC
 8000 DEFPROCscores
 8010 PRINT:PRINT
 8020 SC=0:CHK=CONE+CTWO+CTHREE+CFOUR
 8030 IF CONE=4 THEN SC=100:PRINTCHR$(129);"YAHTZEE! "
 8040 IF CONE=3 OR CTWO=3 THEN SC=75:PRINTCHR$(129);"FOUR OF A KIND "
 8050 IF CONE=2 AND CTWO=1 THEN SC=50:PRINTCHR$(129);"FULL HOUSE "
 8060 IF CONE=1 AND CTWO=2 THEN SC=50:PRINTCHR$(129);"FULL HOUSE "
 8070 IF CONE=2 AND CTWO=0 THEN SC=40:PRINTCHR$(129);"THREE OF A KIND "
 8080 IF CTWO=2 AND CONE 8090 IF CTHREE=2 THEN SC=40:PRINTCHR$(129);"THREE OF A KIND "
 8100 IF CONE=1 AND CTWO=1 THEN SC=30:PRINTCHR$(129);"TWO PAIRS "
 8110 IF CONE=1 AND CTHREE=1 THEN SC=30:PRINTCHR$(129);"TWO PAIRS "
 8120 IF CTWO=1 AND CTHREE=1 THEN SC=30:PRINTCHR$(129);"TWO PAIRS "
 8130 IF CHK=1 THEN SC=20:PRINTCHR$(129);"ONE PAIR "
 8140 IF CHK=0 AND V(1)=6 AND V(5)=2 THEN SC=30:PRINTCHR$(129);"HIGH RUN "
 8150 IF CHK=0 AND V(1)=5 AND V(5)=1 THEN SC=30:PRINTCHR$(129);"LOW RUN "
 8160 IF SC=0 PRINTCHR$(129);"NO SCORE "
 8170 PRINT:PRINTCHR$(131);"SCORE ";CHR$(136);SC:PRINT
 8180 RSCORE=RSCORE+SC
 8190 PRINTCHR$(132);"Running Score ";RSCORE
 8200 PRINT:PRINTCHR$(129);"Any Key To Continue"
 8210 LET B$=GET$:IF B$="" THEN 8210
 8220 CONE=0:CTWO=0:CTHREE=0:CFOUR=0
 8230 ENDPROC

@Retrochallenge – 28 Years Later

January 23, 2013January 23, 2013Retrocosm 5 Comments

Remember those halcyon days when you used to cycle excitedly to the local newsagent for the latest copy of your favourite computer magazine, rush home and spend three hours typing in a BASIC listing, fail to save it and then watch as your computer crashed due to an errant semi colon.

It’s Been 28 Years

Well I remember it especially vividly given that yesterday I spent an hour or so typing Yahtzee into my BBC Master. That’s right, I took one for the team. Unable to successfully transfer the code I’d worked on whilst waiting for the Master to arrive I opted for the manual option.

Jokes aside it was actually quite a pleasant experience. The BBC keyboard is very responsive and the screen was actually pretty easy on my eyes (remembers hours playing M.U.D. on a C64 hooked up to a TV and the subsequent migraines.)

Of course editing the code is a tad more laborious on the BBC than with a modern editor but nevertheless I’ve continued to make improvements, mostly aesthetic. I’ve banished the garish red dice and gone for more subtle black and white in a slightly less in your face graphics mode so everything’s a bit smaller.

Scores At Last

I’ve also numbered the dice so it’s more obvious which ones you’re holding, realigned some of the text and cleared out a few other redundant lines of code.

I’ve also been looking at the possibility of using the Mode 7 – Teletext mode to render the dice. I found a good resource here that covers Mode 7 and the Sixel graphical elements. Incidentally Ceefax, the BBC’s text information service, introduced in 1974 was finally retired on the 23rd of October 2012 when the last remaining analogue TV symbol in the UK was switched off in Northern Ireland in favour of digital broadcasts.

Old & New

When running Yahtzee on the actual Beeb rather than the emulator the previously reported issue with the lack of randomness of the dice throws has resolved itself.

Presumably the random number generator is now being correctly seeded and is as random as such computer generated things can be.

@Retrochallenge – Kinda Working

January 20, 2013January 21, 2013Retrocosm 1 Comment

I knew it would be a mistake to get involved in any sort of coding project alongside Urbancamo. He released his flash new code in about 3 seconds flat while I was still trying to work out what my original variables do, and apparently for quite a few of them that’s absolutely nothing.

Still I think I’ve almost completely debugged Yahtzee now (see below), removed all unnecessary code and generally cleaned things up a bit. I’ve been using Textedit on the Mac and copy and pasting it into BeebEm for testing. Hopefully this coming week I’ll be able to transfer it over to the Master and run and edit it on a real machine.

I don’t think my approach to coding has changed a great deal since I was fifteen, it’s an interesting approach if nothing else. Perhaps most importantly it works, although I have the distinct impression that I rely on five lines of code where someone who knew what they were doing would achieve the same result in one.

I’ve written a couple of new procedures, one to sort the dice and one to score the player’s final throw. The scoring system is currently my own invention, if time permits I shall try to achieve something closer to the original game.

There is currently one fatal and moderately hilarious flaw to the program, specifically that the random number generator generates the same numbers every game. Therefore whenever you load and run a new game you will always roll the same dice. Bit of an issue really in a dice rolling game.

I don’t know at this stage whether the bug is in my code or in the way the BBC generates random numbers, the former seems more likely although I can’t for the life of me find it. Further investigation is clearly required.

Here’s the code as it stands now, you can copy and paste it directly into BeebEm and it should run:-

10 REM YAHTZEE BY RETROCOSM
20 REM RETROCHALLENGE WINTER WARMUP 2013
30 REM DEFINE VARIABLES
40 CONE=0:CTWO=0:CTHREE=0:CFOUR=0
50 P=0:Q=0:SC=0:ST=0:Y=0:C=0
60 JUMP=0:RSCORE=0:SORTED=0
70 DIM Q$(5):DIM A(5):DIM V(5):DIM D(5)
80
90 REM START SCREEN
100 CLS:MODE 7
110 PRINT:PRINT:PRINT
120 PRINTCHR$(141)" àÇYAHTZEE"
130 PRINTCHR$(141)" àÜYAHTZEE"
140 PRINT:PRINT:PRINT
150 PRINT" ÅBy Retrocosm"
160 PRINT:PRINT:PRINT:PRINT
170 PRINT" ÉPRESS ANY KEY"
180 LET B$=GET$:IF B$="" THEN 150
190 CLS
200 PRINT:PRINT:PRINT
210 PRINT"ÉINSTRUCTIONS(Y/N)"
220 PRINT:PRINT
230 INPUT A$
240 IF A$="Y" THEN 2000
250 IF A$<>"N" THEN 190
260 CLS
270 PRINT:PRINT
280 PRINT"ÑPLEASE ENTER YOUR NAME"
290 INPUT NAME$
300 PRINT:PRINT"ÅTHANKYOU"
310 CLS
320 PRINTCHR$(141);" ÖYAHTZEE"
330 PRINTCHR$(141);" ÇYAHTZEE"
340 PRINTCHR$(141);" Å======="
350 PRINTCHR$(141);" É======="
360 PRINT:PRINT:PRINT
370 PRINT"ÅPLAYER ONE IS ";NAME$
380 PRINT:PRINT:PRINT
390 PRINT"ÜPress any key to play"
400 LET B$=GET$:IF B$=""THEN 370
500 CLS:MODE 17:COLOUR 3
510
520 PRINT:PRINT
530 CLS
540 PROCcubes
600 REM Randomise Cubes
610 FOR L=1 TO 5
620 LET Z=INT(RND(1)*6)+1:LET V(L)=Z
630 ON Z GOSUB 1000,1020,1040,1060,1080,1100
640 PRINT
650 NEXT L
660 C=1:REM counter
670 FOR F=1 TO 5
680 PRINT TAB(0,25);"HOLD DIE ";F
690 INPUT A$
700 IF A$="Y" THEN LET A(F)=1
710 IF A$<>"Y" THEN LET A(F)=0
720 NEXT F
730 FOR F=1 TO 5
740 LET Z=INT(RND(1)*6)+1
750 IF A(F)=0 THEN LET V(F)=Z
760 NEXT F
780 CLS
790 FOR F=1 TO 5
800 PRINT
810 ON V(F) GOSUB 1000,1020,1040,1060,1080,1100
820 NEXT F
830 IF C=2 THEN GOTO 860
840 LET C=C+1
850 GOTO 670
860 IF SORTED=1 GOTO 920
870 PRINT TAB(0,25);"Any Key To Sort"
880 INPUT X
890 REM Sort Dice
900 PROCsort
910 IF SORTED=1 GOTO 780
920 PROCreadice
930 PROCscores
940 V=V+1
950 IF V=5 THEN GOTO 2310
960 GOTO 520
1000 PROCone
1010 RETURN
1020 PROCtwo
1030 RETURN
1040 PROCthree
1050 RETURN
1060 PROCfour
1070 RETURN
1080 PROCfive
1090 RETURN
1100 PROCsix
1110 RETURN
2000 REM SHOW INSTRUCTIONS
2010 CLS:MODE 7
2020 PRINT:PRINT:PRINT"ÅYAHTZEE INSTRUCTIONS"
2030 PRINT:PRINT"ÉYahtzee is a simulated dice throwing"
2040 PRINT"Égame for one player."
2050 PRINT"ÉThe player shakes his dice."
2060 PRINT"ÉAfter shaking you may pick up any"
2070 PRINT"Éamount of the dice you wish and shake"
2080 PRINT"Éagain until you are satisfied with"
2090 PRINT"Éyour score.You may do this twice after"
2100 PRINT"Éyour first shake."
2110 PRINT:PRINT:PRINT"ÑPRESS ANY KEY"
2120 LET B$=GET$:IF B$="" THEN 1130
2130 CLS
2140 PRINT:PRINT:PRINT"ÅYAHTZEE SCORING"
2150 PRINT:PRINT"ÉPoints are awarded for getting certain"
2160 PRINT"Éamounts and patterns on the dice."
2170 PRINT"ÉFor example Runs,Sets and Pairs"
2180 PRINT:PRINT:PRINT"ÑPress any key to play"
2190 LET B$=GET$:IF B$="" THEN 2190
2200 GOTO 260
2300 REM PRINT FINAL SCORE
2310 MODE 7:CLS:PRINT"ÅSCORES"
2320 PRINT:PRINT"ÉAfter 5 goes you have a score of ";RSCORE
2330 PROCsound
2340 PRINT:PRINT"ÑPlay Again(Y/N)":PRINT
2350 INPUT Y$
2360 IF Y$="Y" THEN 2390
2370 IF Y$<>"N" THEN 2300
2380 GOTO 2410
2390 RESTORE
2400 RUN
2410 CLS:MODE 7
2420 PRINT:PRINT"ÅGoodbye, thank you for playing."
2430 END
3000 DEFPROCcubes
3100 VDU 23,224,255,255,255,255,255,255,255,255
3200 VDU 23,225,255,255,231,195,195,231,255,255
3300 ENDPROC
4000 DEFPROCsound
4100 SOUND 1,-15,97,10
4200 SOUND 1,-15,105,10
4300 SOUND 1,-15,89,10
4400 SOUND 1,-15,41,10
4500 SOUND 1,-15,69,20
4600 ENDPROC
5000 DEFPROCone
5010 PRINTCHR$(224);CHR$(224);CHR$(224)
5020 PRINTCHR$(224);CHR$(225);CHR$(224)
5030 PRINTCHR$(224);CHR$(224);CHR$(224)
5040 ENDPROC
5050 DEFPROCtwo
5060 PRINTCHR$(225);CHR$(224);CHR$(224)
5070 PRINTCHR$(224);CHR$(224);CHR$(224)
5080 PRINTCHR$(224);CHR$(224);CHR$(225)
5090 ENDPROC
5100 DEFPROCthree
5110 PRINTCHR$(225);CHR$(224);CHR$(224)
5120 PRINTCHR$(224);CHR$(225);CHR$(224)
5130 PRINTCHR$(224);CHR$(224);CHR$(225)
5140 ENDPROC
5150 DEFPROCfour
5160 PRINTCHR$(225);CHR$(224);CHR$(225)
5170 PRINTCHR$(224);CHR$(224);CHR$(224)
5180 PRINTCHR$(225);CHR$(224);CHR$(225)
5190 ENDPROC
5200 DEFPROCfive
5210 PRINTCHR$(225);CHR$(224);CHR$(225)
5220 PRINTCHR$(224);CHR$(225);CHR$(224)
5230 PRINTCHR$(225);CHR$(224);CHR$(225)
5240 ENDPROC
5250 DEFPROCsix
5260 PRINTCHR$(225);CHR$(224);CHR$(225)
5270 PRINTCHR$(225);CHR$(224);CHR$(225)
5280 PRINTCHR$(225);CHR$(224);CHR$(225)
5290 ENDPROC
6000 DEFPROCsort
6010 FOR PASS=1 TO 5
6020 FOR SORT=1 TO 4
6030 ST=V(SORT+1)
6040 IF V(SORT)<V(SORT+1) THEN ST=V(SORT)
6050 IF V(SORT)<V(SORT+1) THEN V(SORT)=V(SORT+1)
6060 V(SORT+1)=ST
6070 NEXT SORT
6080 NEXT PASS
6090 SORTED=1
6100 ENDPROC
7000 DEFPROCreadice
7010 CONE=0:CTWO=0:CTHREE=0:CFOUR=0
7020 SORTED=0:JUMP=0
7030 FOR I=1 TO 4
7040 IF V(1)=V(I+1) THEN CONE=CONE+1 ELSE JUMP=(I+1)
7050 IF JUMP>0 THEN I=4
7060
7070 NEXT I
7080 K=JUMP:JUMP=0
7090 IF K>4 THEN GOTO 7260
7100 FOR I=K TO 4
7110 IF V(I)=V(I+1) THEN CTWO=CTWO+1 ELSE JUMP=(I+1)
7120 IF JUMP>0 THEN I=4
7130
7140 NEXT I
7150 Q=JUMP:JUMP=0
7160 IF Q>4 THEN GOTO 7260
7170 FOR I=Q TO 4
7180 IF V(I)=V(I+1) THEN CTHREE=CTHREE+1 ELSE JUMP=(I+1)
7190 IF JUMP>0 THEN I=4
7200 NEXT I
7210 T=JUMP:JUMP=0
7220 IF T>4 THEN GOTO 7260
7230 FOR I=T TO 4
7240 IF V(I)=V(I+1) THEN CFOUR=CFOUR+1 ELSE I=4
7250 NEXT I
7260 ENDPROC
8000 DEFPROCscores
8010 PRINT
8020 SC=0:CHK=CONE+CTWO+CTHREE+CFOUR
8030 IF CONE=4 THEN SC=100:PRINT"YAHTZEE"
8040 IF CONE=3 OR CTWO=3 THEN SC=75:PRINT"FOUR OF A KIND!"
8050 IF CONE=2 AND CTWO=1 THEN SC=50:PRINT"FULL HOUSE!"
8060 IF CONE=1 AND CTWO=2 THEN SC=50:PRINT"FULL HOUSE!"
8070 IF CONE=2 AND CTWO=0 THEN SC=40:PRINT"THREE OF A KIND"
8080 IF CTWO=2 AND CONE<1 THEN SC=40:PRINT"THREE OF A KIND"
8090 IF CTHREE=2 THEN SC=40:PRINT"THREE OF A KIND"
8100 IF CONE=1 AND CTWO=1 THEN SC=30:PRINT"TWO PAIRS"
8110 IF CONE=1 AND CTHREE=1 THEN SC=30:PRINT"TWO PAIRS"
8120 IF CTWO=1 AND CTHREE=1 THEN SC=30:PRINT"TWO PAIRS"
8130 IF CHK=1 THEN SC=20:PRINT"ONE PAIR"
8140 IF CHK=0 AND V(1)=6 AND V(5)=2 THEN SC=30:PRINT"HIGH RUN"
8150 IF CHK=0 AND V(1)=5 AND V(5)=1 THEN SC=30:PRINT"LOW RUN"
8160 IF SC=0 PRINT"No Score"
8170 PRINT:PRINT"Score-";SC:PRINT
8180 RSCORE=RSCORE+SC
8190 PRINT"Running Score-";RSCORE
8200 PRINT:PRINT"Any Key To Continue"
8210 LET B$=GET$:IF B$="" THEN 8210
8220 CONE=0:CTWO=0:CTHREE=0:CFOUR=0
8230 ENDPROC