goer@ellis.uchicago.edu (Richard L. Goerwitz) (05/29/91)
I logged in this morning, and had six requests for the game. I suspect I'll get more, so let me just post the Unix (test!) port of Chris Tenaglia's yahtzee game. It's been tested by me alone, and this only on ansi terminals. I believe it will work, though, on just about any non-cookie terminal that has cd capability. Part 1 follows. Parts 2 & 3 come in separate mailings. Please let me know about bugs. ---- Cut Here and feed the following to sh ---- #!/bin/sh # This is a shell archive (produced by shar 3.49) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 05/29/1991 05:23 UTC by goer@sophist.uchicago.edu # Source directory /u/richard/Yahtz # # existing files will NOT be overwritten unless -c is specified # This format requires very little intelligence at unshar time. # "if test", "cat", "rm", "echo", "true", and "sed" may be needed. # # This is part 1 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 15750 -r--r--r-- yahtz.icn # 17272 -r--r--r-- iolib.icn # 2391 -r--r--r-- termcap.dos # 994 -rw-r--r-- Makefile.dist # 1194 -rw-r--r-- README # if test -r _shar_seq_.tmp; then echo 'Must unpack archives in sequence!' echo Please unpack part `cat _shar_seq_.tmp` next exit 1 fi # ============= yahtz.icn ============== if test -f 'yahtz.icn' -a X"$1" != X"-c"; then echo 'x - skipping yahtz.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting yahtz.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'yahtz.icn' && X############################################################################ X# X# Name: yahtz.icn X# X# Title: yahtz (alias yahtzee, without a naming conflict) X# X# Author: Chris Tenaglia, modified by Richard Goerwitz X# X# Version: 1.3 (beta!) X# X######################################################################### X# X# Copyright (c) 1991, Chris D. Tenaglia # 12p X# X# This software is intended for free and unrestricted distribution. X# I place only two conditions on its use: 1) That you clearly mark X# any additions or changes you make to the source code, and 2) that X# you do not delete this message therefrom. In order to protect X# myself from spurious litigation, it must also be stated here that, X# because this is free software, I, Chris tenaglia, make no claim X# about the applicability or fitness of this software for any X# purpose, and expressly disclaim any responsibility for any damages X# that might be incurred in conjunction with its use. X# X######################################################################### X# X# This hacked version will run under UNIX, and under DOS as well. It X# should run out of the box on DOS as long as you stay in the current X# directory. See the README file. X# X# This is a test version!! In accordance with the author's wishes, X# I'd like to make it clear that I've altered all the screen I/O X# routines, and have removed characters peculiar to VT terminals. X# I've tried to keep intact the author's indentation and brace style. X# Changes, where present, have been indicated by my initials. The X# IPL-style header was added by me. I also moved Chris's copyright X# notice to the top of the document. It seems to me that such no- X# tices have to be prominently displayed in order to be considered X# valid. X# X# -Richard Goerwitz. X# X############################################################################ X X Xglobal players,slot,team,d,od,dice,round Xprocedure main(param) X paint() X assign_players() X every round := 1 to 13 do X every play(!team) X summarize() X end X X# X# DISPLAYS THE HEADER AND SEPARATOR LINE AT BEGINNING OF GAME X# Xprocedure paint() X # Clear first, separately. Screws up on some terminals of you don't. X writes(cls()) X # Check to be sure the terminal is big enough, and won't leave magic X # cookies on the screen. -RLG X if getval("ug"|"sg") > 0 X then stop("abort: Can't do magic cookie terminals!") X if getval("li") < 24 | getval("co") < 80 then X stop("abort: Your terminal is too small!") X write(high(uhalf(" Y A H T Z E E "))) X write(high(lhalf(" Y A H T Z E E "))) X write(at(1,10),graf(repl("=",75))) X end X X# X# DISPLAYS THE FINAL SCORE OF ALL THE PLAYERS X# Xprocedure summarize() X # blink, high, inverse was just too much for my terminal to handle -RLG X write(at(1,11), high(chop("Final Score Summary"))) X every player := key(players) do X { X card := players[player] X top := 0 ; every i := 1 to 6 do top +:= card[i] X if top > 62 then top +:= 35 X bottom := 0 ; every i := 7 to 13 do bottom +:= card[i] X write("Player ",high(left(player,14))," Top = ",right(top,5), X " Bottom = ",right(bottom,5), X " Total = ",right(top+bottom,5)) X } X input("<press return>") X end X X# X# SETUP AND INITIALIZATION OF YAHTZEE ENVIRONMENT X# Xprocedure assign_players() X n := 1 ; team := [] ; slot := [] ; d := list(6,"") ; od := list(5,0) X &random := map(&clock,":","9") X players := table("n/a") X repeat X { X (player := input(("Name of player #" || n || ": "))) | X stop("Game called off.") X if player == "" then break X n +:= 1 X put(team,player) X players[player] := list(13,"*") X } X if n = 1 then stop("Nobody wants to play!") X X put(slot,"Ones") ; put(slot,"Twos") ; put(slot,"Threes") X put(slot,"Fours") ; put(slot,"Fives") ; put(slot,"Sixes") X put(slot,"3oK") ; put(slot,"4oK") ; put(slot,"FullH") X put(slot,"SmStr") ; put(slot,"LgStr") ; put(slot,"Yahtzee") X put(slot,"Chance") X X # VT-specific characters removed. -RLG X d[1] := "+-----+| || o || |+-----+" X d[2] := "+-----+| || o o || |+-----+" X d[3] := "+-----+|o || o || o|+-----+" X d[4] := "+-----+|o o|| ||o o|+-----+" X d[5] := "+-----+|o o|| o ||o o|+-----+" X d[6] := "+-----+|o o o|| ||o o o|+-----+" X end X X# X# THIS ROUTINE LETS A PLAYER TAKE THEIR TURN X# Xprocedure play(name) X writes(at(1,11),"It's ",high(name),"'s turn",chop()) X writes(at(1,getval("li")-1),high(name)) X input(", please press <RETURN> to begin.") X score(name) X dice := [] ; every 1 to 5 do put(dice,?6) X depict() X shake := obtain("Shake which ones : ") X (shake === []) | (every dice[!shake] := ?6) X depict() X shake := obtain("Shake which ones (last chance) : ") X (shake === []) | (every dice[!shake] := ?6) X depict() X repeat X { X select := input(at(1,22) || clip("Tally to which category (1-13) : ")) X numeric(select) | next X (1 <= select <= 13) | next X (players[name][select] == "*") | next X break X } X tally(name,select) X score(name) X input(at(1,22) || clip("Press <RETURN>")) X end X X# X# THIS ROUTINE DRAWS THE DICE X# Xprocedure depict() X every i := 1 to 5 do X { X if od[i] = dice[i] then next X x := 1 X writes(at(i*10+3,3),inverse(i)) X# writes(at(i*10+4,9),inverse(dice[i])) X every j := 4 to 8 do X { X writes(at(i*10,j),graf(d[dice[i]][x:x+7])) X x +:= 7 X } X od[i] := dice[i] X } X end X X# X# THIS ROUTINE LETS THE PLAYER DECIDE WHAT TO APPLY THE SHAKES TO X# Xprocedure tally(name,area) X case integer(area) of X { X 1 : { # ones X sum := 0 ; every unit := !dice do if unit = 1 then sum +:= 1 X players[name][1] := sum X } X 2 : { # twos X sum := 0 ; every unit := !dice do if unit = 2 then sum +:= 2 X players[name][2] := sum X } X 3 : { # threes X sum := 0 ; every unit := !dice do if unit = 3 then sum +:= 3 X players[name][3] := sum X } X 4 : { # fours X sum := 0 ; every unit := !dice do if unit = 4 then sum +:= 4 X players[name][4] := sum X } X 5 : { # fives X sum := 0 ; every unit := !dice do if unit = 5 then sum +:= 5 X players[name][5] := sum X } X 6 : { # sixes X sum := 0 ; every unit := !dice do if unit = 6 then sum +:= 6 X players[name][6] := sum X } X 7 : { # 3 of a kind X sum := 0 ; flag := 0 X tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1 X every piece := key(tmp) do X if tmp[piece] >= 3 then flag := 1 X if flag = 1 then every sum +:= !dice X players[name][7] := sum X } X 8 : { # four of a kind X sum := 0 ; flag := 0 X tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1 X every piece := key(tmp) do X if tmp[piece] >= 4 then flag := 1 X if flag = 1 then every sum +:= !dice X players[name][8] := sum X } X 9 : { # full house X sum := 0 ; flag := 0 X tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1 X every piece := key(tmp) do X { X if tmp[piece] = 3 then flag +:= 1 X if tmp[piece] = 2 then flag +:= 1 X } X if flag = 2 then sum := 25 X players[name][9] := sum X } X 10 : { # small straight X sum := 0 ; flag := 0 X hold := set() ; every insert(hold,!dice) X tmp := sort(hold) X if tmp[1]+1 = tmp[2] & X tmp[2]+1 = tmp[3] & X tmp[3]+1 = tmp[4] then flag := 1 X if tmp[2]+1 = tmp[3] & X tmp[3]+1 = tmp[4] & X tmp[4]+1 = tmp[5] then flag := 1 X if flag = 1 then sum := 30 X players[name][10] := sum X } X 11 : { # large straight X sum := 0 ; flag := 0 X tmp := sort(dice) X if tmp[1]+1 = tmp[2] & X tmp[2]+1 = tmp[3] & X tmp[3]+1 = tmp[4] & X tmp[4]+1 = tmp[5] then flag := 1 X if flag = 1 then sum := 40 X players[name][11] := sum X } X 12 : { # yahtzee X sum := 0 ; flag := 0 X tmp := table(0) ; every unit := !dice do tmp[unit] +:= 1 X every piece := key(tmp) do X if tmp[piece] = 5 then flag := 1 X if flag = 1 then sum := 50 X players[name][12] := sum X } X 13 : { # chance X sum := 0 ; every sum +:= !dice X players[name][13] := sum X } X } X end X X# X# THIS ROUTINE OBTAINS A VALID SHAKER REQUEST X# Xprocedure obtain(prompt) X repeat X { X writes(at(1,22),prompt) X (line := read()) | next X if match("q",map(line)) then stop("Game Quit") X if trim(line) == "" then return [] X units := parse(line,', \t') X every unit := !units do X (1 <= unit <= 5) | next X break X } X return units X end X X# X# THIS ROUTINE PAINTS THE SCORECARD FOR A GIVEN PLAYER X# Xprocedure score(name) X # Slight realignment. -RLG X writes(at(1,11),chop(),at(18,11),under(),"Player = ",name," Round = ",under(round)) X writes(at(10,12)," 1 : Ones = ",players[name][1]) X writes(at(10,13)," 2 : Twos = ",players[name][2]) X writes(at(10,14)," 3 : Threes = ",players[name][3]) X writes(at(10,15)," 4 : Fours = ",players[name][4]) X writes(at(10,16)," 5 : Fives = ",players[name][5]) X writes(at(10,17)," 6 : Sixes = ",players[name][6]) X writes(at(40,12)," 7 : 3oK = ",players[name][7]) X writes(at(40,13)," 8 : 4oK = ",players[name][8]) X writes(at(40,14)," 9 : FullH = ",players[name][9]) X writes(at(40,15),"10 : SmStr = ",players[name][10]) X writes(at(40,16),"11 : LgStr = ",players[name][11]) X writes(at(40,17),"12 : Yahtzee = ",players[name][12]) X writes(at(40,18),"13 : Chance = ",players[name][13]) X st1 := 0 ; every i := 1 to 6 do st1 +:= numeric(players[name][i]) X if st1 > 62 then bonus := 35 else bonus := 0 X st2 := 0 ; every i := 7 to 13 do st2 +:= numeric(players[name][i]) X writes(at(10,19),"Bonus = ",clip(bonus)) X writes(at(10,20),"Subtotal = ",st1+bonus) X writes(at(40,20),"Subtotal = ",st2) X writes(at(37,21),"Grand Total = ",st1+st2+bonus) X end X X# X# From here down, all CT's VT-specific I/O codes have been replaced X# with calls to iolib/itlib routines. The replacements were quite X# easy to do because of the great modularity of the original program. X# -RLG X# X X# X# VIDEO ROUTINE CLEARS SCREEN X# Xprocedure cls(str) X static clear_string X initial { X clear_string := getval("cl") | X (igoto(getval("cm"),1,1) || getval("cd")) | X stop("abort: Your terminal can't clear screen!") X } X /str := "" X return clear_string || str X end X X# X# VIDEO ROUTINE ERASES REST OF SCREEN X# Xprocedure chop(str) X static clear_rest X initial { X clear_rest := getval("cd") | X stop("abort: Sorry, your terminal must have cd capability.") X } X /str := "" X return clear_rest || str X end X X# X# VIDEO ROUTINE OUTPUTS UPPER HALF OF DOUBLE SIZE MESSAGES X# Xprocedure uhalf(str) X # Disabled for non-VT{2,3,4}XX terminals. I'd have left them in for X # vt100s, but there are so many vt100 terminal emulation programs out X # there that don't do the big characters that I thought better of it. X # -RLG X static isVT X initial X { X if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0))) X then isVT := 1 X } X if \isVT then X { X /str := "" X if str == "" then return "\e#3" X return "\e#3" || str X } X end X X# X# VIDEO ROUTINE OUTPUTS BOTTOM HALF OF DOUBLE SIZE MESSAGES X# Xprocedure lhalf(str) X static isVT X initial X { X if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0))) X then isVT := 1 X } X if \isVT then X { X /str := "" X if str == "" then return "\e#4" X return "\e#4" || str X } X end X X# X# VIDEO ROUTINE OUTPUTS STRING AND CLEARS TO EOL X# Xprocedure clip(str) X static clear_line X initial X { X clear_line := getval("ce") | " " X } X /str := "" X if str == "" then return clear_line X return str ||:= clear_line X end X X# X# VIDEO ROUTINE OUTPUTS HIGHLIGHTED STRINGS X# Xprocedure high(str) X static bold_code, off_other_modes X initial X { X off_other_modes := "" X every off_other_modes ||:= getval("me"|"ue"|"se") X bold_code := off_other_modes || getval("md"|"us"|"so") X } X /str := "" X return bold_code || str || off_other_modes X end X X# X# VIDEO ROUTINE OUTPUTS INVERSE VIDEO STRINGS X# Xprocedure inverse(str) X static reverse_code, off_other_modes X initial X { X off_other_modes := "" X every off_other_modes ||:= getval("se"|"ue"|"me") X reverse_code := off_other_modes || getval("so"|"us"|"md") X } X /str := "" X return reverse_code || str || off_other_modes X end X X# X# VIDEO ROUTINE OUTPUTS UNDERLINED STRINGS X# Xprocedure under(str) X static underline_code, off_other_modes X initial X { X off_other_modes := "" X every off_other_modes ||:= getval("ue"|"me"|"se") X underline_code := off_other_modes || getval("us"|"md"|"so") X } X /str := "" X return underline_code || str || off_other_modes X end X X# X# VIDEO ROUTINE OUTPUTS BLINKING STRINGS X# Xprocedure blink(str) X static blink_code, off_other_modes X initial X { X off_other_modes := "" X every off_other_modes ||:= getval("me"|"se"|"ue") X blink_code := off_other_modes || getval("mb"|"md"|"so"|"us") X } X /str := "" X return blink_code || str || off_other_modes X end X X# X# VIDEO ROUTINE SETS NORMAL VIDEO MODE X# Xprocedure norm(str) X static off_modes X initial X { X off_modes := "" X every off_modes ||:= getval("me"|"se"|"ue") X } X /str := "" X return off_modes || str X end X X# X# VIDEO ROUTINE TURNS ON VT GRAPHICS CHARACTERS X# Xprocedure graf(str) X # Again, disabled for non-VT{234}XX terminals. -RLG X static isVT X initial X { X if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0))) X then isVT := 1 X } X /str := "" X if \isVT then X { X if str == "" then return "\e(0" X str := "\e(0" || str X if (str[-3:0] == "\e(B") X then return str X else return str || "\e(B" X } X else return str X end X X# X# VIDEO ROUTINE TURNS OFF VT GRAPHICS CHARACTERS X# Xprocedure nograf(str) X static isVT X initial X { X if map(getname()) ? (tab(find("vt")+2), tab(any('234')), integer(tab(0))) X then isVT := 1 X } X /str := "" X if \isVT then X { X if str == "" then return "\e(B" X str := "\e(B" || str X } X return str X end X X# X# VIDEO ROUTINE SETS CURSOR TO GIVEN X,Y COORDINATES X# Xprocedure at(x,y) X return igoto(getval("cm"), x, y) X end X X######### Here end the I/O routines I needed to alter. -RLG X X# X# PARSES A STRING INTO A LIST WITH RESPECT TO A GIVEN DELIMITER X# Xprocedure parse(line,delims) X local i, tokens X static chars X chars := &cset -- delims X tokens := [] X line ? while tab(upto(chars)) do put(tokens,tab(many(chars))) X # X # My first time playing, I didn't put spaces between the numbers X # for the dice. When you think about it, though, why bother? X # They can't be any longer than one digit each, so there's no X # ambiguity. This bit of code makes the game a bit more idiot- X # proof. -RLG (one of the idiots) X # X if *!tokens > 1 then line ? X { X tokens := [] X if tab(upto(&digits)) then X { X while put(tokens, move(1)) do X tab(upto(&digits)) | break X put(tokens, integer(tab(0))) X } X } X return tokens X end X X# X# TAKE AN INPUT STRING VIA GIVEN PROMPT X# Xprocedure input(prompt) X writes(prompt) X return read() X end SHAR_EOF true || echo 'restore of yahtz.icn failed' rm -f _shar_wnt_.tmp fi # ============= iolib.icn ============== if test -f 'iolib.icn' -a X"$1" != X"-c"; then echo 'x - skipping iolib.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting iolib.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'iolib.icn' && X######################################################################## X# X# Name: iolib.icn X# X# Title: Icon termlib-type tools for MS-DOS and UNIX X# X# Author: Richard L. Goerwitz (with help from Norman Azadian) X# X# Version: 1.9 X# X######################################################################### X# X# The authors place this and future versions of iolib in the public X# domain. X# X######################################################################### X# X# The following library represents a series of rough functional X# equivalents to the standard Unix low-level termcap routines. It is X# not meant as an exact termlib clone. Nor is it enhanced to take X# care of magic cookie terminals, terminals that use \D in their X# termcap entries, or archaic terminals that require padding. This X# library is geared mainly for use with ANSI and VT-100 devices. X# Note that this file may, in most instances, be used in place of the X# older UNIX-only itlib.icn file. It essentially replaces the DOS- X# only itlibdos routines. For DOS users not familiar with the whole X# notion of generalized screen I/O, I've included extra documentation X# below. Please read it. X# X# The sole disadvantage of this over the old itlib routines is that X# iolib.icn cannot deal with archaic or arcane UNIX terminals and/or X# odd system file arrangements. Note that because these routines X# ignore padding, they can (unlike itlib.icn) be run on the NeXT and X# other systems which fail to implement the -g option of the stty X# command. Iolib.icn is also simpler and faster than itlib.icn. X# X# I want to thank Norman Azadian for suggesting the whole idea of X# combining itlib.icn and itlibdos.icn into one distribution, for SHAR_EOF true || echo 'restore of iolib.icn failed' fi echo 'End of part 1' echo 'File iolib.icn is continued in part 2' echo 2 > _shar_seq_.tmp exit 0 -- -Richard L. Goerwitz goer%sophist@uchicago.bitnet goer@sophist.uchicago.edu rutgers!oddjob!gide!sophist!goer