goer%sophist@GARGOYLE.UCHICAGO.EDU (Richard Goerwitz) (12/08/90)
OK, I hacked this together tonight for fun. It's not perfect.
The saving mechanism isn't working quite right, and when com-
piled under DOS the help screen needs work. I did this so that
I could run the executable under Xenix at an ANSI console. It
will probably work on any Unix variant that implements the -g
option for stty, and which looks remotely USG. Who knows, it
might work under BSD. Definitely not well tested, though. I
kind of hoped that others who had wanted this thing up and run-
ning under Unix would fix it up some more in the usual hand-me-
down fashion....
Five-part shar follows in fairly small pieces.
-Richard
---- 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 12/08/1990 11:18 UTC by goer@sophist.uchicago.edu
# Source directory /u/richard/Klondike
#
# 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
# ------ ---------- ------------------------------------------
# 20981 -r--r--r-- klondike.icn
# 17168 -r--r--r-- kloncon.icn
# 15873 -r--r--r-- klonsub.icn
# 12240 -r--r--r-- itlib.icn
# 8538 -r--r--r-- getchlib.icn
# 4418 -r--r--r-- iscreen.icn
# 4513 -rw-r--r-- klondike.man
# 477 -rw-r--r-- README
# 707 -rw-r--r-- Makefile.dist
#
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
# ============= klondike.icn ==============
if test -f 'klondike.icn' -a X"$1" != X"-c"; then
echo 'x - skipping klondike.icn (File already exists)'
rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting klondike.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'klondike.icn' &&
X############################################################################
X#
X# Name: klondike.icn
X#
X# Title: klondike card game
X#
X# Author: Norman H. Azadian, ported to Unix by Richard Goerwitz
X#
X# Version: 1.5 (beta)
X#
X############################################################################
X#
X# klondike.icn 900720 NHA
X# The Klondike version of Solitaire.
X# Requires ANSI.SYS (or NANSI.SYS) screen driver and a 25-line display.
X#
X# TO FIX:
X#
X#
X# TO DO:
X#
X# - Use space to step to next non-thumb move, and enter to do it ???
X# - Implement an heuristic to discover optimal play strategy.
X#
X# UNIX VERSION: This Unix port of the MS-DOS game classifies as some-
X# thing of a hack. It's what I could do in an evening. Don't bug me
X# about it :-). -RLG
X#
X############################################################################
X#
X# Links:
X#
X# See also: kloncon.icn, klonsub.icn
X#
X############################################################################
X
Xlink kloncon #console I/O
Xlink klonsub #general subroutines
X
Xrecord card(suit, rank) #suit is 1..4, rank is 1..13
X
X# variables
Xglobal deckUp, deckDown, stackUp, stackDown #collections of card
Xglobal pile #ace piles - top rank only
Xglobal ops #list of all operations done
Xglobal debugging, automaticAce #command-line flags
Xglobal invisible, clicking #visual, audible feedback
Xglobal firstSeed, lastSeed #&random remembered
Xglobal totalGames, totalAces #ace pile statistics
X
X
X# a u t o m a t i c 1
X# Do 1 move, thumbing as necessary to achieve it.
X# Fails if there is nothing useful left to do.
X# This is an internal routine that doesn't worry at all about the user.
Xprocedure automatic1 ()
Xlocal s, thumbCount
X thumbCount := 0
X while thumbCount <= ((*deckUp + *deckDown + 2) / 3) do {
X if s := suggest() then {
X push (ops, _move ("M" || s || "0"))
X thumbCount := 0
X return;
X } else { #no good move found -- thumb
X if (*deckUp = 0) & (*deckDown = 0) then
X fail #no cards left to thumb through
X push (ops, s := thumb())
X if 2 < *s then
X return #must have turned up an Ace
X thumbCount +:= 1
X }
X }
Xend #automatic1
X
X
X# a u t o m a t i c
X# Run the game, as far as possible, untouched by human hands
X# This is an internal routine that only worries a little about the user.
X# Returns when either there is nothing useful left to do or a key is struck.
Xprocedure automatic ()
Xlocal s, thumbCount
X thumbCount := 0
X repeat {
X if \isDOS then {
X if kbhit () then
X return #stopped by human intervention
X }
X if pile[1] = pile[2] = pile[3] = pile[4] = 13 then
X return #victory
X automatic1 () | return
X }
Xend #automatic
X
X
X# u a u t o m a t i c
X# Play this hand automatically, untouched by human hands.
X# This is the fuction that interacts with the user.
Xprocedure uautomatic ()
X writes ("utomatic")
X automatic()
X if \isDOS then {
X if kbhit() then
X if getch() == "\0" then getch()
X }
Xend #uautomatic
X
X
X# u c o n t i n u o u s
X# Plays automatic games -- forever (or until any keystroke)
Xprocedure ucontinuous()
X writes ("ontinuous")
X repeat {
X writeInfo (string(totalGames) || " " || string(totalAces))
X automatic()
X if \isDOS & kbhit() then {
X if getch() == "\0" then #eat stopping char(s)
X getch()
X return
X } else
X totalAces +:= pile[1] + pile[2] + pile[3] + pile[4]
X totalGames +:= 1
X if \isUNIX then {
X writeCursor (18, 65)
X iputs(getval("ce"))
X writes ("Continue? ")
X until (s := getCmdChar ())
X map(s) == "n" | next
X return
X }
X lastSeed := newGame()
X }
Xend #ucontinuous
X
X
X# u h e l p
X# Provide command summary for user, plus statistics to date, if any.
Xprocedure uhelp ()
X if \isDOS then
X write (VclearAll, Vnormal)
X else if \isUNIX then {
X normal (); clear ()
X }
X writeCursor (2, 1)
X writes ("Klondike version 1.5 901126 NHA", repl(" ",8), &version)
X writeCursor (5, 1)
X writes ("The following commands are available:")
X writeCursor (8, 8)
X bwrite ("^L\tre-draw", " screen")
X writeCursor (9, 8)
X if \isDOS then
X bwrite ("A\tAutomatic", " mode -- plays 1 game by itself until any key is hit")
X else if \isUNIX then
X bwrite ("A\tAutomatic", " mode -- plays 1 game by itself.")
X writeCursor (10, 8)
X bwrite ("B\tBoss", " key for when you-know-who visits")
X writeCursor (11, 8)
X if \isDOS then
X bwrite ("C\tContinuous", " mode -- plays games continuously until any key hit")
X else if \isUNIX then
X bwrite ("C\tContinuous", " mode -- plays games by itself")
X writeCursor (12, 8)
X bwrite ("H,?\tHelp", ", this help screen")
X writeCursor (13, 8)
X bwrite ("M\tMove", " card (or stack) from Deck/Stack to Stack/Ace pile")
X writeCursor (14, 8)
X bwrite ("Q\tQuit", " this game")
X writeCursor (15, 8)
X bwrite ("S\tSuggest", " (another) possible move")
X writeCursor (16, 8)
X bwrite ("T\tThumb", " through the deck")
X writeCursor (17, 8)
X bwrite ("U\tUndo", " -- back up one move")
X writeCursor (18, 8)
X bwrite ("ESC\tEscape", " -- abort current command")
X writeCursor (19, 9)
X if \debugging then
X bwrite ("Z\tDebug")
X
X writeCursor (20, 1)
X if totalGames ~= 0 then
X writes ("totalGames = ", totalGames, " totalAces = ", totalAces,
X " average = ", real(totalAces) / real(totalGames))
X writeCursor (23, 1)
X bwrite ("", "Press any key to resume game")
X writeCursor (24, 1)
X if getch() == "\0" then getch()
X refreshScreen ()
Xend #uhelp
X
X
X# b w r i t e
X# Boldface first arg in 1-4 string-arg procedure.
Xprocedure bwrite(a, b[])
X if \isDOS then
X writes (Vbold)
X else if \isUNIX then
X emphasize()
X writes(a)
X if \isDOS then
X writes (Vnormal)
X else if \isUNIX then
X normal()
X every writes(\!b)
X return
Xend
X
X
X# u m o v e
X# Move a card from deck to stack, or from stack to ace pile,
X# or move a stack to another stack.
X# Parameter is the source [1-7 or D] or &null to indicate that "M" was used
X# and therefore source should be gathered from the keyboard.
X# Fails if indicated move is not possible
X# This is the routine that interacts with the user.
Xprocedure umove (src)
Xlocal dst, c, op, moved
X if \src then {
X if \isDOS then
X writes ("\bMove ", Vbold, src)
X else if \isUNIX then {
X writes ("\bMove ")
X emphasize ()
X writes (src)
X }
X }
X else {
X if \isDOS then
X writes ("ove " || Vbold)
X else if \isUNIX then {
X writes ("ove ")
X emphasize ()
X }
X until (src := getCmdChar ())
X if src == ESC then return
X }
X if src == "D" then {
X if *deckUp = 0 then fail
X } else {
X if not any ('1234567', src) then fail
X if *stackUp[src] = 0 then fail
X writeStackNumber (src, Vblink)
X }
X
X if \isDOS then
X writes (Vnormal || " to " || Vbold)
X else if \isUNIX then {
X normal ()
X writes (" to ")
X emphasize ()
X }
X until (dst := getCmdChar ())
X if src ~== "D" then writeStackNumber (src, Vnormal)
X if dst == ESC then return
X if not any ('A1234567', dst) then fail
X if dst == src then fail
X
X return push (ops, _move("M" || src || dst || "0"))
Xend #umove
X
X
X# s u g g e s t
X# Find a (reasonable) possible move in this situation
X# This is the internal routine.
Xprocedure suggest ()
Xlocal i, j, k, c
X #look at deckUp to see if the top card fits on a pile
X if c := deckUp[1] then
X if c.rank = (pile[c.suit] + 1) then
X suspend "DA"
X #look at deckUp to see if the top card fits on a stack
X if c := deckUp[1] then
X every i := 1 to 7 do
X if fitOnStack (c, i) then
X suspend "D" || string(i)
X #look at each stack to see if top card can be put on ace pile
X every i := 1 to 7 do
X if c := stackUp[i][-1] then #top card
X if c.rank = (pile[c.suit] + 1) then
X suspend string(i) || "A"
X #look at each stack to see if something can be (reasonably) moved
X every i := 7 to 1 by -1 do
X every j := 1 to 7 do
X if fitOnStack (stackUp[i][1], j) then {
X if (0 < *stackDown[i]) then
X suspend string(i) || string(j)
X else {
X # possibility, but since there are no cards hidden under
X # this pile, we reject it UNLESS there are no empty slots
X # AND one of the following is true:
X # 1) deckUp[1].rank = 13
X # 2) there is a king with cards hidden beneath it
X c := 0 #number of empty stacks
X every k := 1 to 7 do
X if *stackUp[k] = 0 then c +:= 1
X if c = 0 then
X if (deckUp[1].rank = 13) |
X (every k := 1 to 7 do
X if (stackUp[k][1].rank = 13) &
X (0 < *stackDown[k]) then
X break #success
X )
X then
X suspend string(i) || string(j)
X }
X }
X #punt
X fail
Xend #suggest
X
X
X# u s u g g e s t
X# Suggest a (reasonable) possible move in this situation.
X# Repeated invocations produce successive possibilities, until the
X# only thing left to do is Thumb. After this, it cycles around to the start.
Xprocedure usuggest (another)
Xstatic suggestions, i
Xlocal s, ss
X writes ("uggest")
X if another = 0 then {
X suggestions := [] #generate a new list of suggestions
X every put (suggestions, suggest())
X i := 0
X }
X if ss := suggestions[i+:=1] then {
X s := "Move " || if ss[1] == "A" then "Ace"
X else if ss[1] == "D" then "Deck"
X else ss[1]
X s ||:= " to " || if ss[2] == "A" then "Ace" else ss[2]
X writeInfo (s)
X } else {
X writeInfo ("Thumb")
X i := 0
X }
Xend #usuggest
X
X
X# u t e r m i n a t e
X# Parameter should be non-zero if termination is due to complete success.
X# Returns success to quit this game and start another.
X# Returns failure to just continue this game.
X# If program termination is wished, that is done right here.
Xprocedure uterminate (victory)
Xlocal s
X if \victory then {
X totalAces +:= 52
X pile[1] := pile[2] := pile[3] := pile[4] := 0 #prevent victory loops
X writeCursor (12, 22)
X if \isDOS then
X writes (Vbold, Vblink, "Congratulations -- You've WON !!!", Vnormal)
X else if \isUNIX then {
X emphasize ()
X writes ("Congratulations -- You've WON !!!")
X normal ()
X }
X } else
X writes ("uit")
X if \isDOS then
X writeInfo (Vbold || "Another game? ")
X else if \isUNIX then
X writeInfo ("Another game? ")
X until (s := getCmdChar ())
X if s == ESC then fail() #didn't really want to quit anyway
X if s == "Y" then return #please start a new game
X if s ~== "N" then return complain ()
X
X #program termination requested
X if \isDOS then
X writes ("\33[=7h", Vnormal) #set cursor wrap mode, normal attr
X else if \isUNIX then
X normal () & clear ()
X totalGames +:= 1
X if /victory then
X totalAces +:= pile[1] + pile[2] + pile[3] + pile[4]
X writeCursor (2, 1)
X writes (VclearAll, "In ", totalGames, " games, you put ", totalAces,
X " cards on the ace piles")
X writeCursor (3, 1)
X write ("average = ", real(totalAces) / real(totalGames), " per game")
X writeCursor (5, 1)
X if \isUNIX then reset_tty()
X exit ()
Xend #uterminate
X
X
X# u d e b u g
X# Additional commands to support the implementer.
Xprocedure udebug ()
Xlocal s, d, c, name
X if not \debugging then return complain()
X writes ("\bDebug ")
X until (s := getCmdChar ())
X case s of {
X ESC : fail
X "A" : {
X writes ("gain")
X &random := lastSeed
X writeCursor (23, 1)
X write (Vbold, "&random set. Quit to play this game again.",
X Vnormal, VclearEOL)
X }
X "D" : display()
X "H"|"?" : {
X writes (if s == "?" then "\bhelp" else "elp")
X writeCursor (23, 1)
X write (Vbold,
X "Again, Dump, Options, Move, Peek{1-7UD}, Restore, Save, Toggle{ACT}.",
X Vnormal, VclearEOL)
X }
X "M" : {
X writes ("ove ")
X until (s := getCmdChar ()) #Source
X if s == ESC then fail
X if s == "A" then fail
X until (d := getCmdChar ()) #Destination
X if d == ESC then fail
X if d == s then fail
X if not any('1234567', d) then fail
X if s == "D" then {
X if *deckUp = 0 then fail
X put (stackUp[d], get(deckUp))
X writeDeckUp ()
X writeStack (d)
X push (ops, "MD" || d || "0")
X } else {
X c := "123456789abcdef"[*stackUp[s]]
X moveStack (s, d)
X push (ops, "M" || s || d || c)
X }
X }
X "O" : {
X writes ("ptions")
X writeCursor (23, 1)
X write (Vbold,
X if \automaticAce then "AutomaticAce " else " ",
X if \clicking then "Clicking " else " ",
X " &trace=", &trace,
X " seeds=", firstSeed, ",", lastSeed, Vnormal, VclearEOL)
X }
X "P" : {
X writes ("eek ")
X until (s := getCmdChar ())
X if s == ESC then fail
X writeCursor (23, 1)
X writes (VclearEOL, Vnormal)
X if any('1234567', s) then showList (stackDown[s])
X else if s == "D" then showList (deckDown)
X else if s == "U" then showList (deckUp)
X else complain ()
X }
X "R" : {
X writes ("estore")
X until (s := getCmdChar ())
X if s == ESC then fail
X name := "klondike.sv" || s
X if (d := restoreState(name)) then {
X refreshScreen()
X writeCursor (23, 1)
X write (Vbold, "Restored position from file ", name,
X " of ", d, Vnormal, VclearEOL)
X } else {
X writeCursor (23, 1)
X write (Vblink, "Can't restore from file ", name, ".",
X Vnormal, VclearEOL)
X }
X }
X "S" : {
X writes ("ave ")
X until (s := getCmdChar ())
X if s == ESC then fail
X name := "klondike.sv" || s
X writeCursor (23, 1)
X if saveState (name) then
X write (Vbold, "Position saved in file ",name,
X Vnormal, VclearEOL)
X else
X write (Vblink, "Can't save in file ", name, ".",
X Vnormal, VclearEOL)
X }
X "T" : {
X writes ("oggle ")
X until (s := getCmdChar ())
X if s == ESC then fail
X case s of {
X "A" : automaticAce := if \automaticAce then &null
X else 1
X "C" : clicking := if \clicking then &null else 1
X "T" : &trace := if &trace = 0 then -1 else 0
X default : complain ()
X } #case for Toggle
X }
X default : complain ()
X } #case for Debug command
Xend #udebug
X
X
X# u b o s s
X# Cheese it, the Fuzz.
X# Quick -- clear the screen and save the state in a file.
Xprocedure uboss ()
X writes ("oss")
X if \isDOS then {
X writes("\33[=7h", VclearAll, "C>") #set cursor-wrap mode, look innocent
X saveState ("klondike.sav")
X }
X else if \isUNIX then {
X normal()
X clear()
X saveState("~/.klondike.sav")
X reset_tty()
X }
X exit ()
Xend #uboss
X
X
X
X# m a i n
Xprocedure main (av)
Xlocal s, prevsCmd, maxGames, f_nam
X
X # set defaults
X automaticAce := 1 # automatic ace handling
X clicking := 1 # give audible feedback
X debugging := &null # no debugging allowed
X invisible := &null # let's see the action
X maxGames := &null # interactive mode
X &random := map (&clock, ":", "0") # randomize the seed
X
X # deal with command-line parameters
X while s := get (av) do
X case map (s, &lcase, &ucase) of {
X "-A" : automaticAce := &null #disable automatic ace handling
X "-B" : maxGames := get (av) #batch mode, this many games
SHAR_EOF
true || echo 'restore of klondike.icn failed'
fi
echo 'End of part 1'
echo 'File klondike.icn is continued in part 2'
echo 2 > _shar_seq_.tmp
exit 0