!- Yatzee for VIC 20

!- This file is written in CBM prg Studio. Please support their work!

!- A quick comment about the name: The title Yathzee did not fit into the 
!- scoretable, so I wrote Yatzee instead. When my son (Arvid) drew the cassette 
!- cover, he write Yatzee as the name. I changed the name so he didnt have to
!- redo his work.

!- Variable usage:
!-      d% value of dices
!-      s% select state of dices (-1 = not saved, 1 = saved)
!-      a% number of dices of each value
!-      p% pending scrore calculation (choosable scores)
!-      q% main score table
!-      z  number of rounds completed (15=game is over)
!-      y  number of throw in current rount.
!-      r  flag to tell if the random number has been seeded.
!-      v  selected score table cell.
!-      r  screen row in cell selection logic.
!-      t  temporary integer, may be used in many places
!-      t$ temporary screen 

0 rem yatzee (c) k@llelundberg.se 2021

10 dim d%(5):dim s%(5):dim a%(6): dim p%(19):dim q%(19):poke 36879,29:r%=0

!- Reset main score table. Value below zero meand score cell is empty.
20 for i=0 to 18:q%(i)=-1 :next
22 q%(7)=0:q%(18)=0:z=0

!- Clear screen
30 print "{clear}{blue}";

!- Print score table.
31 print "{down}{down}{down}{down}{down}{down}{down}{cm a}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{cm r}{sh asterisk}{sh asterisk}{cm r}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{cm r}{sh asterisk}{sh asterisk}{cm s}"
32 print "{sh -}aces  {sh -}  {sh -}1 pair{sh -}  {sh -}"
33 print "{sh -}twos  {sh -}  {sh -}2 pair{sh -}  {sh -}"
34 print "{sh -}threes{sh -}  {sh -}3 kind{sh -}  {sh -}"
35 print "{sh -}fours {sh -}  {sh -}4 kind{sh -}  {sh -}"
36 print "{sh -}fives {sh -}  {sh -}sm str{sh -}  {sh -}"
37 print "{sh -}sixes {sh -}  {sh -}la str{sh -}  {sh -}"
38 print "{sh -}      {sh -}  {sh -}f hous{sh -}  {sh -}"
39 print "{sh -}sum   {sh -}  {sh -}chance{sh -}  {sh -}"
40 print "{sh -}bonus {sh -}  {sh -}yatzee{sh -}  {sh -}"
41 print "{cm z}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{cm e}{sh asterisk}{sh asterisk}{cm e}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{sh asterisk}{cm e}{sh asterisk}{sh asterisk}{cm x}"

!- New round, reset the number of throws.
100 y=0
!- Reset and print emtpy dices
101 for i=0 to 4:s%(i)=-1:d%(i)=0:gosub 1100:next 
!- Reset pending scores and print clear scoretable.
102 for i=0 to 18: p%(i)=0:next:gosub 1500
!- If 15 cells has been filled in, the game is over.
103 if z=15 then goto 500
!- Print message and wait for enter to start.
104 m$=" hit return to roll!":gosub 1200:gosub 1300:if k%<>13 goto 104

!- Increase number of throws, clear message.
110 y=y+1:gosub 1200
!- Reset number of die value counter (number of ones, number of twos, etc)
114 for i=1  to 6: a%(i)=0:next
!- For each of the five dices...
120 for i=0 to 4 
!- If the save flag is negative, reset the die value.
130   if s%(i)<0 then d%(i)=0
!- Reset the save flag and repaint the die border.
140   s%(i)=-1:gosub 1100
150 next
!- For each die again...
160 for i=0 to 4
!- If the die has ha value, its saved. Skip throwing this die.
170   if d%(i)>0 then goto 176
!- Play the throw sound.
171   poke 36878,8:for j=0 to 6:poke 36874,120 + j*8:next:poke 36878,0
!- Seed the random generator, but only once.
172   if r%=0 then r%=1:t=rnd(-1*ti)
!- Set a new random value to the die and repaint it.
174   d%(i)=int(rnd(1)*6)+1:gosub 1100
!- Count the number of each die value.
176   a%(d%(i)) = a%(d%(i)) +1
180 next
!- If we have made tree thows, the round is over.
185 if y>=3 goto 300

!- Die selection logic.
200 m$=" select dice (1-5,a)":gosub 1200
!- Read a key
210 gosub 1300
!- Number keys will switch save state of the die.
230 if k%>=49 and k%<=53 then i=k%-49: s%(i)=s%(i)*-1:gosub 1100:goto 210
!- A will save all dices and skip to score selection.
235 if k%=65 then gosub 1200: goto 300
!- Enter will throw the dices.
240 if k%=13 then goto 110
250 goto 210

!- Score calculation logic.
300 for i=1 to 6
!- Cell 0 to 5 is ones to sixes
315   p%(i-1) = a%(i)*i
!- Chance
320   p%(16) = p%(16) + a%(i)*i
!- Two pair
325   if a%(i)>=2 and p%(9)>0 then p%(10)=p%(9)+2*i
!- Full house
330   if a%(i)=3 and p%(9)>0 then p%(15)=p%(9)+3*i
335   if a%(i)=2 and p%(11)>0 then p%(15)=p%(11)+2*i
!- Pair
340   if a%(i)>=2 then p%(9)=2*i
!- Three of a kind
345   if a%(i)>=3 then p%(11)=3*i
!- Four of a kind
350   if a%(i)>=4 then p%(12)=4*i:p%(10)=4*i
!- Yatzee
355   if a%(i)=5 then p%(17)=50:p%(15)=5*i
360 next
!- Small straight (1-5)
365 if a%(1)*a%(2)*a%(3)*a%(4)*a%(5)=1 then p%(13)=15
!- Large strait (2-6)
370 if a%(2)*a%(3)*a%(4)*a%(5)*a%(6)=1 then p%(14)=20
!- Reset pending score if cell alread has a permanent score.
380 for i=0 to 17 :if q%(i)>=0 then p%(i)=0
390 next
!- Print score table with new pending scores.
395 gosub 1500

!- Score cell selection logic.
400 m$=" select (up,dn,re,de)": gosub 1200
405 print "{home}{blue}{down}{down}{down}{down}{down}{down}{down}";
!- Calculate recommended score table (highest value but never chance)
410 v=0
415 for j=1 to 17: if p%(j)>p%(v) and j<>16 then v=j
420 next 
!- r is score table row
425 r = v:t=8:if r>=9 then r=r-9:t=18
!- Move cursor down r steps.
430 for j=0 to r: print"": next
!- Calculate score table cell text (t$)
435 gosub 1600
!- Print score table text with reverse text. t is column, 8 or 18 from line 425
440 print spc(t);"{reverse on}";t$;"{left}{left}";
!- Wait for keypress
445 gosub 1300
!- Reset cell text (reverse off)
455 print "{reverse off}";t$;"{return}{up}";
!- Up arrow moves up one row
460 if k%=145 and v>0 then v=v-1: print "{up}";:if v=8 then v=5:t=8:print "{down}{down}{down}{down}{down}{down}";
!- Down arrow moves down one row
465 if k%=17 and v<17 then v=v+1: print "{down}";:if v=6 then v=9:t=18:print "{up}{up}{up}{up}{up}{up}";
!- Return selects cell, but only if it has a pending value.
470 if k%=13 and q%(v)=-1 and p%(v)>0 then goto 485
!- DEL sets a cell to zero.
475 if k%=20 and q%(v)=-1 and p%(v)=0 then goto 485
480 goto 435

!- Clear message
485 m$="":gosub 1200
!- Write the selected score into the permanent score table
486 q%(v)=p%(v):q%(18)=q%(18)+p%(v):z=z+1
!- Update the left sum and maybe the bonus.
487 if v<9 then q%(7)=q%(7)+p%(v):if q%(7)>=63 then q%(8)=50
!- Continue to next round 
490 goto 100

!- Game over routine.
500 m$="":gosub 1200
!- Clear all dices border
510 print "{home}";:for i=1 to 22*5:print " ";: next
530 print "{home}{down}";
540 if q%(18)<=hi then print "      good game!":goto 570
550 print "    new highscore!":hi=q%(18):gosub 1400
570 print "     press return"
580 print "    to play again"
585 gosub 1300;if k%<>13 then goto 585
590 goto 20

!- Die paint sub routine
1100 t$="             Z    Z       Z  Z Z Z  Z Z   Z ZZ Z Z Z ZZ ZZ ZZ Z"
1120 print "{home}";:if s%(i)>0 then print "{red}";
1150 print spc(4*i);"U{sh asterisk}{sh asterisk}{sh asterisk}"
1160 for j=0 to 2: print spc(4*i);"B" mid$(t$,9*d%(i)+j*3+1,3): next
1190 print spc(4*i);"J{sh asterisk}{sh asterisk}{sh asterisk}";
1192 if i=4 then print "K{left}{up}H{left}{up}H{left}{up}H{left}{up}I";
1195 print "{blue}"
1199 return

!- Clear message sub routine
1200 print "{home}{down}{down}{down}{down}{down}                      {up}";m$:m$="":return

!- Read keypress sub routine.
1300 poke 198,0:wait 198,1:get k$:k%=asc(k$):return

!- Happy sound/graphics effect. Used at Yatzee and new Hiscore.
1400 poke 36878,8: for j=0 to 18
1410 poke 36874,220+j:poke 36879,25+j-int(j/7)*7
1420 next:poke 36878,0:return

!- Scoretable paint sub routine.
1500 print "{home}{down}{down}{down}{down}{down}{down}{down}{down}";
1505 t=8
1511 for v=0 to 17
1514   if v=9 then t=18:print "{up}{up}{up}{up}{up}{up}{up}{up}{up}{up}"
1520   gosub 1600
1522   print spc(t);t$
1530 next
1540 print "{down}{down} total score:    ";right$("  " + str$(q%(18)),3)
1545 if hi>0 then print "{down} high score:     ";right$("  " + str$(hi),3)
1555 if p%(17)=50 then gosub 1400
1590 return

!- Scoretable cell value sub routine. Returns t$.
!- If the scrore is already permanent, just set the value.
1600 if q%(v)>=0 then t$=right$(str$(q%(v)),2):return
!- If the score is pending, set red color.
1610 if p%(v)>0 then t$="{red}" + right$(str$(p%(v)),2) + "{blue}":return
!- If neither, just make it blank.
1620 t$="  ":return