hi this is a project for a grade 9 class scoring will not work everything else will work
var winMain : int := Window.Open ("graphics:781;541")
var x, y, x2, y2, dicex, temp, font1, font2, font3, cx, font4, font5, font6 : int
var scorec:array 1..13 of int
for io:1..13
scorec(io):=0
end for
var cy : array 1 .. 13 of int
var keeproll : array 1 .. 5 of string
for n : 1 .. 5
keeproll (n) := "roll"
end for
var di : array 1 .. 5 of int
var current, currentc : int := 1
var any : string (1)
var a2 : string (1)
var yes, no, swapoccurs : string
var dicey : array 1 .. 5 of int
dicey (1) := 40
dicey (2) := 140
dicey (3) := 240
dicey (4) := 340
dicey (5) := 440
dicex := 660
font1 := Font.New ("serif:40")
font2 := Font.New ("serif:15")
font3 := Font.New ("serif:12")
font4 := Font.New ("Segoe Script:45")
font5 := Font.New ("serif:75:italic")
font6 := Font.New ("serif:45")
cx := 151
cy (1) := 101
cy (2) := 121
cy (3) := 141
cy (4) := 161
cy (5) := 181
cy (6) := 201
cy (7) := 221
cy (8) := 321
cy (9) := 341
cy (10) := 361
cy (11) := 381
cy (12) := 401
cy (13) := 421
procedure title
drawfilloval (350, 275, 250, 250, 9)
Font.Draw ("Craig", 215, 400, font4, 12)
Font.Draw ("Games", 350, 350, font4, 12)
Font.Draw ("Presents", 250, 275, font6, 12)
Font.Draw ("Yahtzee", 200, 150, font5, black)
end title
procedure screen
x := 20
y := 40
x2 := 280
y2 := 40
drawfillbox (781, 541, 0, 0, 32)
drawfillbox (20, 20, 280, 520, 12)
drawline (280, 20, 280, 520, black)
drawline (20, 20, 280, 20, black)
drawline (150, 20, 150, 460, black) %middle line for 1 p
%drawline (215,20,215,460,black)%middle line for2p
drawfillbox (dicex, dicey (1), 740, 120, 0)
drawfillbox (dicex, dicey (2), 740, 220, 0)
drawfillbox (dicex, dicey (3), 740, 320, 0)
drawfillbox (dicex, dicey (4), 740, 420, 0)
drawfillbox (dicex, dicey (5), 740, 520, 0)
% drawfillbox (340, 460, 540, 520, 47)%green box around yahtzee
Font.Draw ("Player 1", 161, 441, font3, black)
Font.Draw ("Score Card", 35, 470, font1, black)
%Font.Draw ("Player 2",221,441,font3,black)
Font.Draw ("Yahtzee", 340, 460, font1, red)
Font.Draw ("The rules are simple you push r to roll", 320, 220, font2, red)
Font.Draw ("the dice and you press k to keep the dice", 320, 200, font2, red)
Font.Draw ("If the dice is yellow it is saved if it is ", 320, 180, font2, red)
Font.Draw ("green it will roll", 320, 160, font2, red)
Font.Draw ("Upper section", 20, 441, font3, black)
Font.Draw ("Ones", 20, 421, font3, black)
Font.Draw ("Twos", 20, 401, font3, black)
Font.Draw ("Three", 20, 381, font3, black)
Font.Draw ("Four", 20, 361, font3, black)
Font.Draw ("Five", 20, 341, font3, black)
Font.Draw ("Six", 20, 321, font3, black)
Font.Draw ("Total score", 20, 301, font3, black)
Font.Draw ("Bounus", 20, 281, font3, black)
Font.Draw ("Total top score", 20, 261, font3, black)
Font.Draw ("Lower Section", 20, 241, font3, black)
Font.Draw ("3 of a kind", 20, 221, font3, black)
Font.Draw ("4 of a kind", 20, 201, font3, black)
Font.Draw ("Full House", 20, 181, font3, black)
Font.Draw ("Small Strait", 20, 161, font3, black)
Font.Draw ("Large Strait", 20, 141, font3, black)
Font.Draw ("Yahtzee", 20, 121, font3, black)
Font.Draw ("Chance", 20, 101, font3, black)
Font.Draw ("Total of lower section", 20, 81, font3, black)
Font.Draw ("Total of upper section", 20, 61, font3, black)
Font.Draw ("Grand Total", 20, 41, font3, black)
Font.Draw ("The Winner", 20, 21, font3, black)
loop
drawline (x, y, x2, y2, black)
y := y + 20
y2 := y2 + 20
exit when y = 460
end loop
end screen
procedure swap
loop
swapoccurs := "no"
for i : 1 .. 4
if di (i) > di (i + 1) then
swapoccurs := "yes"
temp := di (i + 1)
di (i + 1) := di (i)
di (i) := temp
end if
end for
exit when swapoccurs = "no"
end loop
end swap
procedure one (dx, dy : int) % dx is 660 dy is 40
drawfilloval (dx + 40, dy + 40, 5, 5, 32)
end one
procedure two (dx, dy : int)
drawfilloval (dx + 20, dy + 20, 5, 5, 32)
drawfilloval (dx + 60, dy + 60, 5, 5, 32)
end two
procedure three (dx, dy : int)
one (dx, dy)
two (dx, dy)
end three
procedure four (dx, dy : int)
drawfilloval (dx + 20, dy + 60, 5, 5, 32)
drawfilloval (dx + +60, dy + 20, 5, 5, 32)
two (dx, dy)
end four
procedure five (dx, dy : int)
four (dx, dy)
one (dx, dy)
end five
procedure six (dx, dy : int)
drawfilloval (dx + 20, dy + 40, 5, 5, 32)
drawfilloval (dx + 60, dy + 40, 5, 5, 32)
four (dx, dy)
end six
procedure cleardice (d : int)
drawfillbox (dicex + 1, dicey (d) + 1, dicex + 78, dicey (d) + 78, 0)
end cleardice
procedure roll
for da : 1 .. 5
randint (di (da), 1, 6)
if keeproll (da) = "roll" then
cleardice (da)
if di (da) = 1 then
one (dicex, dicey (da))
elsif di (da) = 2 then
two (dicex, dicey (da))
elsif di (da) = 3 then
three (dicex, dicey (da))
elsif di (da) = 4 then
four (dicex, dicey (da))
elsif di (da) = 5 then
five (dicex, dicey (da))
elsif di (da) = 6 then
six (dicex, dicey (da))
end if
end if
end for
end roll
procedure score1
for y : 1 .. 5
if di (y) = 1 then
scorec(1) := scorec(1) + 1
else
scorec(1) := scorec(1) + 0
end if
end for
end score1
procedure score2
for u : 1 .. 5
if di (u) = 2 then
scorec(2) := scorec(2) + 2
else
scorec(2) := scorec(2) + 0
end if
end for
end score2
procedure score3
for u : 1 .. 5
if di (u) = 3 then
scorec(3) := scorec(3) + 3
else
scorec(3) := scorec(3) + 0
end if
end for
end score3
procedure score4
for u : 1 .. 5
if di (u) = 4 then
scorec(4) := scorec(4) + 4
else
scorec(4) := scorec(4) + 0
end if
end for
end score4
procedure score5
for u : 1 .. 5
if di (u) = 5 then
scorec(5) := scorec(5) + 5
else
scorec(5) := scorec(5) + 0
end if
end for
end score5
procedure score6
for u : 1 .. 6
if di (u) = 6 then
scorec(6) := scorec(6) + 6
else
scorec(6) := scorec(6) + 0
end if
end for
end score6
procedure score7 %three of a kind
if di (1) = di (3) and di (3) not= di (5) or di (5) = di (3) and di (3) not= di(2) then
scorec(7) := scorec(7) + di (1) * 3
else
scorec(7) := scorec(7) + 0
end if
end score7
procedure score8 %4 of akind
if di (1) = di (4) and di (4) not= di (5)or di (5) = di (2) and di (2) not= di (1) then
scorec(8) := scorec(8) + di (1) * 4
else
scorec(8) := scorec(8) + 0
end if
end score8
procedure score9 % full house
if di (1) = di (3) and di (4) = di (5) and di (3) not= di (4)or di (1) = di (3) and di (4) = di (5) and di (3) not= di (4) then
scorec(9) := scorec(9) + 25
else
scorec(9) := scorec(9) + 0
end if
end score9
% COME BACK TO SMALL & LARGE STRAIT 10 ,11 scorce
procedure score10 %smallstrait
if di(1)=di(2)+1and di(2)=di(3)+1 then
scorec(10):=scorec(10)+ 25
end if
end score10
procedure score11 %lg strait
if di(1)=di(2)+1and di(2)=di(3)+1and di(3)=di(4)+1 then
scorec(11):=scorec(11)+30
end if
end score11
procedure score12 %yahtzee
if di (1) = di (5) or di (5) = di (1) then
scorec(12) := scorec(12) + 50
else
scorec(12) := scorec(12) + 0
end if
end score12
procedure score13 %chance
scorec(13) := di (1) + di (2) + di (3) + di (4) + di (5)
end score13
procedure selectcat
drawfill (cx, cy (currentc), green, black)
loop
getch (a2)
if ord (a2) = 200 then %up arrow
drawfill (cx, cy (currentc), 12, black)
if currentc = 13 then
currentc := 1
else
currentc := currentc + 1
end if
drawfill (cx, cy (currentc), green, black)
elsif ord (a2) = 208 then
drawfill (cx, cy (currentc), 12, black)
if currentc = 1 then
currentc := 13
else
currentc := currentc - 1
end if
drawfill (cx, cy (currentc), green, black)
elsif ord (a2) = 32 then %space bar 32
score (currentc)
end if
end loop
end selectcat
procedure selectdice
drawfill (dicex + 1, dicey (current) + 1, green, 32)
loop
getch (any)
if ord (any) = 200 then % up arrow
drawfill (dicex + 1, dicey (current) + 1, 0, 32)
if current = 5 then
current := 1
else
current := current + 1
end if
drawfill (dicex + 1, dicey (current) + 1, green, 32)
elsif ord (any) = 208 then %down arrow
drawfill (dicex + 1, dicey (current) + 1, 0, 32)
if current = 1 then
current := 5
else
current := current - 1
end if
drawfill (dicex + 1, dicey (current) + 1, green, 32)
elsif any = "k" then % 32 is space bar
if keeproll (current) = "roll" then
keeproll (current) := "keep"
else
keeproll (current) := "roll"
end if
end if
if keeproll (current) = "keep" then
drawfill (dicex + 1, dicey (current) + 1, yellow, 32)
end if
exit when any = "r"
end loop
end selectdice
procedure roll2
var anykey : string (1)
var cnt : int := 0
loop
getch (anykey)
if anykey = "r" then
for er : 1 .. 3
%for pkp : 1 .. 15
roll
delay (200)
%end for
selectdice
end for
swap
selectcat
elsif anykey not= "r" then
end if
cnt := cnt + 1
exit when anykey = "q"
end loop
end roll2
%%%%%%%%%MAIN PROGRAM %%%%%%%%%%%%%%%
title
delay(2500)
screen
roll2