Path: utzoo!utgpu!news-server.csri.toronto.edu!rutgers!usc!wuarchive!zaphod.mps.ohio-state.edu!think.com!linus!agate!ucbvax!GARGOYLE.UCHICAGO.EDU!goer%sophist
From: goer%sophist@GARGOYLE.UCHICAGO.EDU (Richard Goerwitz)
Newsgroups: comp.lang.icon
Subject: klondike -> unix (preliminary)
Message-ID: <9012081053.AA08404@sophist>
Date: 8 Dec 90 10:53:09 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: inet
Organization: The Internet
Lines: 596

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