TENAGLIA@mis.mcw.edu (Chris Tenaglia - 257-8765) (05/28/91)
Another holiday has passed, and with it came another icon game. This is
Yahtzee, the poker dice game. I use ICON 8 under VMS 5.4-1, but I tried
to avoid system specific stuff. I'll probably get flamed again for my
screen management methods (I tried a little something different.) It's
written for VT100,2XX,3XX,4XX and compatible terminals, since that's all
I have at this site. Bye the way, this version allows for multiple players.
I've played it several times with my daughter and it seems pretty solid.
Game design involves many tricky decisions. The two in this implementation
were..
o Not to repaint dice if the value stayed the same
This is seen in procedure depict(). I use a list
'od' to remember former values. Then when choosen
dice are shaken, the unshaken ones stay put. But,
so do the ones that come up the same. Oh well.
o To give the player the feel of the three shakes,
I provide a prompt saying whose turn it is, and
asking them to press <RETURN>. These lines can be
found at the beginning of procedure play(name).
I also ask them to press return after their turn
is over in order to allow some time to read their
scorecard and think about future strategy.
So here's the code. Enjoy!
Chris Tenaglia (System Manager) | Medical College of Wisconsin
8701 W. Watertown Plank Rd. | Milwaukee, WI 53226
(414)257-8765 | tenaglia@mis.mcw.edu, mcwmis!tenaglia
#
# YAHT.ICN 5/27/91 BY TENAGLIA
#
# YAHTZEE GAME
#
global players,slot,team,d,od,dice,round
procedure main(param)
paint()
assign_players()
every round := 1 to 13 do
every play(!team)
summarize()
end
#
# DISPLAYS THE HEADER AND SEPARATOR LINE AT BEGINNING OF GAME
#
procedure paint()
write(cls(),high(uhalf(" Y A H T Z E E ")))
write(high(lhalf(" Y A H T Z E E ")))
write(at(1,10),graf(repl("q",75)))
end
#
# DISPLAYS THE FINAL SCORE OF ALL THE PLAYERS
#
procedure summarize()
write(at(1,11),blink(high(inverse(chop("Final Score Summary")))))
every player := key(players) do
{
card := players[player]
top := 0 ; every i := 1 to 6 do top +:= card[i]
if top > 62 then top +:= 35
bottom := 0 ; every i := 7 to 13 do bottom +:= card[i]
write("Player ",high(left(player,14))," Top = ",right(top,5),
" Bottom = ",right(bottom,5),
" Total = ",right(top+bottom,5))
}
input("<press return>")
end
#
# SETUP AND INITIALIZATION OF YAHTZEE ENVIRONMENT
#
procedure assign_players()
n := 1 ; team := [] ; slot := [] ; d := list(6,"") ; od := list(5,0)
&random := map(&clock,":","9")
players := table("n/a")
repeat
{
(player := input(("Name of player #" || n || ":"))) | stop("Game called off.")
if player == "" then break
n +:= 1
put(team,player)
players[player] := list(13,"*")
}
if n = 1 then stop("Nobody wants to play!")
put(slot,"Ones") ; put(slot,"Twos") ; put(slot,"Threes")
put(slot,"Fours") ; put(slot,"Fives") ; put(slot,"Sixes")
put(slot,"3oK") ; put(slot,"4oK") ; put(slot,"FullH")
put(slot,"SmStr") ; put(slot,"LgStr") ; put(slot,"Yahtzee")
put(slot,"Chance")
d[1] := "lqqqqqkx xx ` xx xmqqqqqj"
d[2] := "lqqqqqkx xx ` ` xx xmqqqqqj"
d[3] := "lqqqqqkx` xx ` xx `xmqqqqqj"
d[4] := "lqqqqqkx` `xx xx` `xmqqqqqj"
d[5] := "lqqqqqkx` `xx ` xx` `xmqqqqqj"
d[6] := "lqqqqqkx` ` `xx xx` ` `xmqqqqqj"
end
#
# THIS ROUTINE LETS A PLAYER TAKE THEIR TURN
#
procedure play(name)
writes(at(1,11),"It's ",high(name),"'s turn",chop())
writes(at(1,12),high(name)) ; input(", Please press <RETURN> to begin.")
score(name)
dice := [] ; every 1 to 5 do put(dice,?6)
depict()
shake := obtain("Shake which ones :")
(shake === []) | (every dice[!shake] := ?6)
depict()
shake := obtain("(Last Chance) Shake which ones :")
(shake === []) | (every dice[!shake] := ?6)
depict()
repeat
{
select := input(at(1,22) || clip("Tally to which category (1 -> 13) :"))
numeric(select) | next
(1 <= select <= 13) | next
(players[name][select] == "*") | next
break
}
tally(name,select)
score(name)
input(at(1,22) || clip("Press <RETURN>"))
end
#
# THIS ROUTINE DRAWS THE DICE
#
procedure depict()
every i := 1 to 5 do
{
if od[i] = dice[i] then next
x := 1
writes(at(i*10+4,3),inverse(i))
# writes(at(i*10+4,9),inverse(dice[i]))
every j := 4 to 8 do
{
writes(at(i*10,j),graf(d[dice[i]][x:x+7]))
x +:= 7
}
od[i] := dice[i]
}
end
#
# THIS ROUTINE LETS THE PLAYER DECIDE WHAT TO APPLY THE SHAKES TO
#
procedure tally(name,area)
case integer(area) of
{
1 : { # ones
sum := 0 ; every unit := !dice do if unit = 1 then sum +:= 1
players[name][1] := sum
}
2 : { # twos
sum := 0 ; every unit := !dice do if unit = 2 then sum +:= 2
players[name][2] := sum
}
3 : { # threes
sum := 0 ; every unit := !dice do if unit = 3 then sum +:= 3
players[name][3] := sum
}
4 : { # fours
sum := 0 ; every unit := !dice do if unit = 4 then sum +:= 4
players[name][4] := sum
}
5 : { # fives
sum := 0 ; every unit := !dice do if unit = 5 then sum +:= 5
players[name][5] := sum
}
6 : { # sixes
sum := 0 ; every unit := !dice do if unit = 6 then sum +:= 6
players[name][6] := sum
}
7 : { # 3 of a kind
sum := 0 ; flag := 0
tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
every piece := key(tmp) do
if tmp[piece] >= 3 then flag := 1
if flag = 1 then every sum +:= !dice
players[name][7] := sum
}
8 : { # four of a kind
sum := 0 ; flag := 0
tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
every piece := key(tmp) do
if tmp[piece] >= 4 then flag := 1
if flag = 1 then every sum +:= !dice
players[name][8] := sum
}
9 : { # full house
sum := 0 ; flag := 0
tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
every piece := key(tmp) do
{
if tmp[piece] = 3 then flag +:= 1
if tmp[piece] = 2 then flag +:= 1
}
if flag = 2 then sum := 25
players[name][9] := sum
}
10 : { # small straight
sum := 0 ; flag := 0
hold := set() ; every insert(hold,!dice)
tmp := sort(hold)
if tmp[1]+1 = tmp[2] &
tmp[2]+1 = tmp[3] &
tmp[3]+1 = tmp[4] then flag := 1
if tmp[2]+1 = tmp[3] &
tmp[3]+1 = tmp[4] &
tmp[4]+1 = tmp[5] then flag := 1
if flag = 1 then sum := 30
players[name][10] := sum
}
11 : { # large straight
sum := 0 ; flag := 0
tmp := sort(dice)
if tmp[1]+1 = tmp[2] &
tmp[2]+1 = tmp[3] &
tmp[3]+1 = tmp[4] &
tmp[4]+1 = tmp[5] then flag := 1
if flag = 1 then sum := 40
players[name][11] := sum
}
12 : { # yahtzee
sum := 0 ; flag := 0
tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1
every piece := key(tmp) do
if tmp[piece] = 5 then flag := 1
if flag = 1 then sum := 50
players[name][12] := sum
}
13 : { # chance
sum := 0 ; every sum +:= !dice
players[name][13] := sum
}
}
end
#
# THIS ROUTINE OBTAINS A VALID SHAKER REQUEST
#
procedure obtain(prompt)
repeat
{
writes(at(1,22),prompt)
(line := read()) | next
if match("q",map(line)) then stop("Game Quit")
if trim(line) == "" then return []
units := parse(line,', \t')
every unit := !units do
(1 <= unit <= 5) | next
break
}
return units
end
#
# THIS ROUTINE PAINTS THE SCORECARD FOR A GIVEN PLAYER
#
procedure score(name)
writes(at(1,11),chop(),at(25,11),under(),"Player = ",name," Round = ",under(round))
writes(at(10,12)," 1 : Ones = ",players[name][1])
writes(at(10,13)," 2 : Twos = ",players[name][2])
writes(at(10,14)," 3 : Threes = ",players[name][3])
writes(at(10,15)," 4 : Fours = ",players[name][4])
writes(at(10,16)," 5 : Fives = ",players[name][5])
writes(at(10,17)," 6 : Sixes = ",players[name][6])
writes(at(40,12)," 7 : 3oK = ",players[name][7])
writes(at(40,13)," 8 : 4oK = ",players[name][8])
writes(at(40,14)," 9 : FullH = ",players[name][9])
writes(at(40,15),"10 : SmStr = ",players[name][10])
writes(at(40,16),"11 : LgStr = ",players[name][11])
writes(at(40,17),"12 : Yahtzee = ",players[name][12])
writes(at(40,18),"13 : Chance = ",players[name][13])
st1 := 0 ; every i := 1 to 6 do st1 +:= numeric(players[name][i])
if st1 > 62 then bonus := 35 else bonus := 0
st2 := 0 ; every i := 7 to 13 do st2 +:= numeric(players[name][i])
writes(at(10,19),"Bonus = ",clip(bonus))
writes(at(10,20),"Subtotal = ",st1+bonus)
writes(at(40,20),"Subtotal = ",st2)
writes(at(37,21),"Grand Total = ",st1+st2+bonus)
end
#
# VIDEO ROUTINE CLEARS SCREEN
#
procedure cls(str)
/str := ""
return "\e[2J\e[H" || str
end
#
# VIDEO ROUTINE ERASES REST OF SCREEN
#
procedure chop(str)
/str := ""
return "\e[J" || str
end
#
# VIDEO ROUTINE OUTPUTS UPPER HALF OF DOUBLE SIZE MESSAGES
#
procedure uhalf(str)
/str := ""
if str == "" then return "\e#3"
return "\e#3" || str
end
#
# VIDEO ROUTINE OUTPUTS BOTTOM HALF OF DOUBLE SIZE MESSAGES
#
procedure lhalf(str)
/str := ""
if str == "" then return "\e#4"
return "\e#4" || str
end
#
# VIDEO ROUTINE OUTPUTS STRING AND CLEARS TO EOL
#
procedure clip(str)
/str := ""
if str == "" then return "\e[K "
return str ||:= "\e[K"
end
#
# VIDEO ROUTINE OUTPUTS HIGHLIGHTED STRINGS
#
procedure high(str)
/str := ""
if str == "" then return "\e[1m"
str := "\e[1m" || str
if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
then return str
else return str || "\e[m"
end
#
# VIDEO ROUTINE OUTPUTS INVERSE VIDEO STRINGS
#
procedure inverse(str)
/str := ""
if str == "" then return "\e[7m"
str := "\e[7m" || str
if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
then return str
else return str || "\e[m"
end
#
# VIDEO ROUTINE OUTPUTS UNDERLINED STRINGS
#
procedure under(str)
/str := ""
if str == "" then return "\e[4m"
str := "\e[4m" || str
if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
then return str
else return str || "\e[m"
end
#
# VIDEO ROUTINE OUTPUTS BLINKING STRINGS
#
procedure blink(str)
/str := ""
if str == "" then return "\e[5m"
str := "\e[5m" || str
if (str[-3:0] == "\e[m") | (str[-4:0] == "\e[0m")
then return str
else return str || "\e[m"
end
#
# VIDEO ROUTINE SETS NORMAL VIDEO MODE
#
procedure norm(str)
/str := ""
if str == "" then return "\e[m"
str := "\e[m" || str
return str
end
#
# VIDEO ROUTINE TURNS ON VT GRAPHICS CHARACTERS
#
procedure graf(str)
/str := ""
if str == "" then return "\e(0"
str := "\e(0" || str
if (str[-3:0] == "\e(B")
then return str
else return str || "\e(B"
end
#
# VIDEO ROUTINE TURNS OFF VT GRAPHICS CHARACTERS
#
procedure nograf(str)
/str := ""
if str == "" then return "\e(B"
str := "\e(B" || str
return str
end
#
# VIDEO ROUTINE SETS CURSOR TO GIVEN X,Y COORDINATES
#
procedure at(x,y)
return "\e[" || y || ";" || x || "f"
end
#
# PARSES A STRING INTO A LIST WITH RESPECT TO A GIVEN DELIMITER
#
procedure parse(line,delims)
static chars
chars := &cset -- delims
tokens := []
line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
return tokens
end
#
# TAKE AN INPUT STRING VIA GIVEN PROMPT
#
procedure input(prompt)
writes(prompt)
return read()
end
#
# DISCLAIMER
#
#########################################################################
# #
# Copyright (c) 1991, Chris D. Tenaglia # 12p #
# #
# This software is intended for free and unrestricted distribution. #
# I place only two conditions on its use: 1) That you clearly mark #
# any additions or changes you make to the source code, and 2) that #
# you do not delete this message therefrom. In order to protect #
# myself from spurious litigation, it must also be stated here that, #
# because this is free software, I, Chris tenaglia, make no claim #
# about the applicability or fitness of this software for any #
# purpose, and expressly disclaim any responsibility for any damages #
# that might be incurred in conjunction with its use. #
# #
#########################################################################goer@ellis.uchicago.edu (Richard L. Goerwitz) (05/29/91)
If anyone wants a Unix version of Chris Tenaglia's yahtzee game (will probably work for DOS, too), please let me know. If I get more than a few requests, I'll post it. -Richard -- -Richard L. Goerwitz goer%sophist@uchicago.bitnet goer@sophist.uchicago.edu rutgers!oddjob!gide!sophist!goer