Path: utzoo!utgpu!news-server.csri.toronto.edu!rutgers!usc!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, part 02 of 05
Message-ID: <9012081053.AA08417@sophist>
Date: 8 Dec 90 10:53:59 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: inet
Organization: The Internet
Lines: 559

---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is klondike.02 (part 2 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file klondike.icn continued
#
if test ! -r _shar_seq_.tmp; then
	echo 'Please unpack part 1 first!'
	exit 1
fi
(read Scheck
 if test "$Scheck" != 2; then
	echo Please unpack part "$Scheck" next!
	exit 1
 else
	exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
	echo 'x - still skipping klondike.icn'
else
echo 'x - continuing file klondike.icn'
sed 's/^X//' << 'SHAR_EOF' >> 'klondike.icn' &&
X         "-C"  :  clicking  := &null      #run silent
X         "-D"  :  debugging    := 1       #grant all sorts of perqs
X         "-R"  :  &random      := get (av)   #unrandomize
X      default  :  {write ("klondike  [-ACD]  [-B gameCount]  [-R randomSeed]")
X	       if \isUNIX  then  reset_tty()
X               stop("klondike: bogus option ", s)  }
X      }
X
X   totalGames := totalAces := 0
X
X   if \maxGames  then  {
X      # In Batch mode there is absolutely no console I/O.
X      # The requested number of games is played
X      # and the average result is printed on the standard output.
X      invisible := 1
X      clicking  := &null
X      totalGames := maxGames
X      while 0 <= (maxGames -:= 1)  do  {
X         newGame ()
X         while automatic1 ()              #don't allow user to interrupt
X         totalAces  +:=  pile[1] + pile[2] + pile[3] + pile[4]
X      }
X      write (real(totalAces) / real(totalGames))
X      if \isUNIX  then  reset_tty()
X      exit ()
X   }
X
X
X   initConstants()                        #for console I/O
X   firstSeed := &random                #initial seed
X
X   lastSeed := newGame ()
X   #if last game terminated via the Boss key, then restore it now
X   if \isDOS  then
X      f_nam := "klondike.sav"
X   else if \isUNIX  then
X      f_nam := "~/.klondike.sav"
X   if restoreState (f_nam)  then  {
X      refreshScreen ()
X      writeInfo ("Game restored")
X      close (open (f_nam, "c"))     #truncate boss save file
X   }
X
X
X   repeat  {                           #game loop
X      prevsCmd := "x"                     #anything but "S"uggest
X
X   #respond to user input
X      repeat  {                           #command loop
X         writeCursor (18, 65)
X         if \isDOS  then
X            writes (VclearEOL || Vnormal || "> ")  #clear command line
X         else if \isUNIX  then  {
X            iputs (getval("ce"))
X            normal ()
X            writes ("> ")  #clear command line
X         }
X         if pile[1] = pile[2] = pile[3] = pile[4] = 13  then
X            if uterminate (1) then break     # VICTORY!
X         s := getCmdChar ()
X         writeInfo ("")                   #clear info line
X         writeCursor (18, 68)
X         case  s  of  {
X            "?"|"H"  :  uhelp()
X            "1"|"2"|"3"|"4"|"5"|"6"|"7"|"D"  :
X                     if not umove(s) then complain()
X            "A"      :  uautomatic()               #look Ma, no hands!
X            "B"      :  uboss()                    #bail out -- quick
X            "C"      :  ucontinuous()              #no hands, forever
X            "M"      :  if not umove(&null) then complain()
X            "Q"      :  if uterminate(&null) then break  #new game
X            "S"      :  usuggest (if s == prevsCmd then 1 else 0)
X            "T"      :  { writes("humb");  push(ops, thumb()) }
X            "U"      :  undo()
X            "Z"      :  udebug()
X            "\^L" :  refreshScreen()
X            ESC      :  s                       #do nothing here
X            default  :  complain()
X         }                       #case
X         prevsCmd := s
X      }                          #repeat command
X      totalAces  +:= pile[1] + pile[2] + pile[3] + pile[4]
X      totalGames +:= 1
X      lastSeed := newGame ()
X   }                             #repeat game
Xend                                 #main
SHAR_EOF
echo 'File klondike.icn is complete' &&
true || echo 'restore of klondike.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= kloncon.icn ==============
if test -f 'kloncon.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping kloncon.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting kloncon.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'kloncon.icn' &&
X############################################################################
X#
X#	Name:    kloncon.icn
X#
X#	Title:   klondike console interface routines
X#
X#	Author:  Norman H. Azadian
X#
X#	Version: 1.3
X#
X############################################################################
X#
X#  kloncon.icn 901029   NHA
X#  Console interface routines for Klondike
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#  -  termcap for portability ??
X#  -  click for each card moved in a stack ?
X#
X############################################################################
X#
X#  Links:
X#
X#  See also: klondike.icn, klonsub.icn
X#
X############################################################################
X
X
X# constants
Xglobal   suitID                              #suit identification chars
Xglobal   isDOS                               # 1 when running under DOS
Xglobal   isUNIX			             # 1 when running under UNIX
Xglobal   isXENIXconsole                      # 1 if XENIX ansi console
Xglobal   monochrome                          # 1 when running Black&White
X# Video control strings (ANSI.SYS)
Xglobal  ESC
Xglobal   Vnormal, Vreverse, Vblink, Vbold, VclearAll, VclearEOL, Vbell
Xglobal   color                            #list of suit color strings
X
X
X#  i n i t C o n s t a n t s
X# Initialize the program "constants".  These are actually variables that
X# are set just once at the beginning of the world.
Xprocedure initConstants ()
Xlocal i
Xlocal Vred, Vblack                        #suit color strings
X
X   if \invisible  then  return
X
X   isUNIX := find("UNIX",&features)
X   isDOS := find("MS-DOS",&host)
X   isXENIXconsole := 1(find("XENIX",&host), find("ansi"|"li",getname()))
X
X   if \isDOS  then  {
X      #ensure that we are dealing with an ANSI-compatible screen
X      writes ("\33[6n")                #request cursor position report
X      #NOTE that the first character to match should be an ESCape.
X      #Unfortunately, reads() seems to eat that character
X      match ("[", reads (&input, 8))  |
X         stop ("Klondike:  requires (N)ANSI.SYS screen driver")
X
X      i := ord (Peek([16r40, 16r49]))        #BIOS display mode byte
X      case i  of  {
X         2     :  monochrome := 1
X         3     :  monochrome := &null     #living color
X         7     :  monochrome := 1
X         default  :  {
X            stop ("Klondike:  unknown display mode ", i)
X         }
X      }
X   } else
X      monochrome := 1
X
X   if \isDOS then {
X      ESC         := "\33"             #escape character
X      VclearAll   := "\33[2J"             #also homes cursor
X      VclearEOL   := "\33[K"
X      Vnormal     := "\33[0m"
X      Vbold       := "\33[1m"
X      Vblink      := "\33[5m"
X      Vreverse    := "\33[7m"
X      Vbell       := "\^G"
X      if \monochrome  then  {
X         Vred     := Vnormal
X         Vblack   := Vreverse
X      } else {
X         Vred     := "\33[0;47;31m"       # "extra" 0 seems to be necessary
X         Vblack   := "\33[0;47;30m"
X      }
X   }
X   else if \isUNIX then {
X      # Check terminal size.
X      24 < getval("li") < 29 & 79 < getval("co") < 85 |
X	  { reset_tty(); stop("klondike:  terminal must be 80x25.") }
X      ESC         := "\e"
X      VclearAll   := getval("cl")
X      Vnormal     := getval("se") || (getval("ue") | "") |
X	  { reset_tty(); stop("klondike:  terminal must have standout mode.") }
X      VclearEOL   := Vnormal || getval("ce")
X      Vbold       := getval("so")
X      Vblink      := getval("us")
X      Vreverse    := getval("so")
X      Vbell       := "\^G"
X# color not implemented for UNIX
X#      if \monochrome  then  {
X         Vred     := Vnormal
X         Vblack   := Vreverse
X#      } else {
X#         Vred     := "\33[0;47;31m"       # "extra" 0 seems to be necessary
X#         Vblack   := "\33[0;47;30m"
X#      }
X   }
X   else
X      stop("Klondike:  OS not supported.")
X
X   # Suits are: 1=Hearts, 2=Diamonds, 3=Clubs, 4=Spades
X   suitID := if \isDOS  then  "\3\4\5\6"  else  "HDCS"
X   color  := [Vred, Vred, Vblack, Vblack]
Xend                                 #initConstants
X
X
X#  i n i t S c r e e n
X# Initialize output and write the fixed parts of the screen.
X# initConstants() must have been called earlier.
Xprocedure initScreen ()
Xlocal i
Xstatic vertical
Xinitial {
X   vertical  :=  if \isDOS  then  "\272"  else  "|"
X}
X
X   if \invisible  then  return
X   if \isDOS  then  {
X       if \monochrome  then  writes ("\33[=2h")     #25x80 B&W   text mode
X       else  writes ("\33[=3h")	                    #25x80 color text mode
X       writes (VclearAll, "\33[=7l")             #clear screen, prevent wrap
X   }
X   else if \isUNIX  then  {
X       iputs(getval("se"))
X       iputs(getval("ue"))
X       clear()
X   }
X
X   every  i := 1 to 7  do
X      writeStackNumber (i, Vnormal)
X   every  i := 2 to 25  do  {
X      if \isDOS then
X	 writes ("\33[",i,";64H", vertical)
X      else if \isUNIX then {
X	 iputs(igoto(getval("cm"), 64, i))
X	 writes (vertical)
X      }
X   }
X   if \isDOS  then
X      writes ("\33[2;64H\311\315\315\315\315SOLITAIRE\315\315\315\315")
X   else if \isUNIX then {
X      iputs(igoto(getval("cm"), 64, 2))
X      writes ("=====SOLITAIRE====")
X   }
Xend                                 #initScreen
X
X
X#  w r i t e S t a c k N u m b e r
X# Write the indicated stack number with the specified video attribute.
X# Cursor position is preserved -- WARNING: THIS IS NOT NESTABLE.
Xprocedure writeStackNumber (num, attr)
X   if \invisible  then  return
X   if \isDOS  then
X      writes (ESC, "[s")                  #save cursor position
X   writeCursor (1, [2,11,20,29,38,47,56][num])
X   if \isDOS  then  {
X      writes (attr, num, Vnormal)
X      writes (ESC, "[u")                  #restore cursor position
X   }
X   else if \isUNIX  then  {
X      iputs(attr); writes(num); iputs(Vnormal)
X      writeCursor (18, 73)
X   }
Xend                                    #writeStackNumber
X
X
X#  w r i t e C u r s o r
X# Position the cursor to row,col.
X# Screen origin (top left corner) is row=1 and col=1.
Xprocedure writeCursor (row, col)
X   if /invisible  then {
X       if \isDOS  then
X	   writes ("\33[", row, ";", col, "H")
X       else if \isUNIX then
X	   iputs(igoto(getval("cm"), col, row))
X   }
Xend                                 #writeCursor
X
X
X#  w r i t e F r o n t
X# Displays an image of the specified card fronts at the specified spot.
X# WARNING: this eats the list that you provide -- pass a copy() if you care!!
X# Top left corner of the first card will be placed at the specified position.
X# Successive cards are displayed two rows higher (lower position on the screen).
X# Cursor need not be in any particular position before this, and is left
X# in a random position afterwards.  Video is always left normal (not reversed).
X# Cards are 7 columns wide by 5 rows tall.
X# With 25 rows, we can put 12 cards in a stack (assuming we start in row 2).
X# But if there are 11 in the stack we can only display 4 rows of the top card.
X# If there are 12 cards, we can only display 2 rows of the topmost card.
X##We can only write a row at a time due to a problem with ANSI col 80 handling.
Xprocedure writeFront (cardlist, row, col)
Xlocal suit, rank, card
Xstatic vertical, topHorizontal, bottomHorizontal
Xinitial {
X   if \isDOS  then  {
X      vertical := "\263"
X      topHorizontal    := "\332\304\304\304\304\304\277"
X      bottomHorizontal := "\300\304\304\304\304\304\331"
X   } else {
X      vertical := "|"
X      topHorizontal    := "-------"
X      bottomHorizontal := "-------"
X   }
X}
X   if \isDOS then {
X      while  card := get(cardlist)  do  {
X         #first 2 rows of card
X         writeCursor (row+0, col);
X	 writes (Vreverse, topHorizontal)
X	 writeCursor (row+1, col);
X	 writes (vertical, color[card.suit], "A23456789TJQK"[card.rank],
X		 suitID[card.suit], Vreverse, "   ", vertical)
X	 if (*cardlist = 0)  &  (row < 24)  then  {
X            #next 2 rows of top card unless it's the 12th card on the stack
X	    writeCursor (row+2, col);
X	    writes (Vreverse, vertical, "     ", vertical)
X	    writeCursor (row+3, col);
X	    writes (vertical,"   ",color[card.suit],"A23456789TJQK"[card.rank],
X		    suitID[card.suit], Vreverse, vertical)
X	    if row < 22  then  {
X               #last row of card unless it's the 11th on the stack
X               writeCursor (row+4, col);
X	       writes (bottomHorizontal)
X	    }
X         }
X         row +:= 2
X      }
X      writes (Vnormal)
X   }
X   else if \isUNIX then {
X      if (row = 21, col > 65, getval("li") = 25, \getval("am"))  then
X	  row -:= 1
X      while  card := get(cardlist)  do  {
X         #first 2 rows of card
X         writeCursor (row+0, col);
X	 emphasize (); writes (topHorizontal)
X	 writeCursor (row+1, col);
X	 writes (vertical, color[card.suit], "A23456789TJQK"[card.rank],
X		 suitID[card.suit]); emphasize (); writes ("   ", vertical)
X	 if (*cardlist = 0)  &  (row < 24)  then  {
X            #next 2 rows of top card unless it's the 12th card on the stack
X	    writeCursor (row+2, col);
X	    emphasize (); writes (vertical, "     ", vertical)
X	    writeCursor (row+3, col);
X	    writes (vertical,"   ",color[card.suit],"A23456789TJQK"[card.rank],
X		    suitID[card.suit]); emphasize (); writes (vertical)
X	    if row < 22  then  {
X               #last row of card unless it's the 11th on the stack
X               writeCursor (row+4, col);
X	       writes (bottomHorizontal)
X	    }
X         }
X         row +:= 2
X      }
X      normal ()
X   }
Xend                                 #writeFront
X
X
X#  w r i t e B a c k
X# Puts an image of the back of a card at the specified spot on the screen.
Xprocedure writeBack (row, col)
Xstatic backLine
Xinitial {
X   backLine := repl (if \isDOS  then  "\260"  else  "#",  7)
X}
X   if \invisible  then  return
X   if (row = 21, col > 65, \isUNIX, getval("li") = 25, \getval("am"))  then
X      row -:= 1
X   writeCursor (row+0, col);  writes (backLine)
X   writeCursor (row+1, col);  writes (backLine)
X   writeCursor (row+2, col);  writes (backLine)
X   writeCursor (row+3, col);  writes (backLine)
X   writeCursor (row+4, col);  writes (backLine)
Xend                                 #writeBack
X
X
X#  w r i t e B l a n k
X# Blanks a card-sized area at the specified spot on the screen.
Xprocedure writeBlank (row, col)
Xstatic blankLine
Xinitial {
X   blankLine := repl (" ", 7)
X}
X   if \invisible  then  return
X   if (row = 21, col > 65, \isUNIX, getval("li") = 25, \getval("am"))  then
X      row -:= 1
X   writeCursor (row+0, col);  writes (blankLine)
X   writeCursor (row+1, col);  writes (blankLine)
X   writeCursor (row+2, col);  writes (blankLine)
X   writeCursor (row+3, col);  writes (blankLine)
X   writeCursor (row+4, col);  writes (blankLine)
Xend                                 #writeBlank
X
X
X#  w r i t e S t a c k
X# Display the specified stack.  Left end is bottom of stackUp, top of stackDown.
X# Stacks start in row 2, column1; with 2 columns between stacks.
X# last[] holds, for each stack, the total number of visible cards
X# on that stack as of the last time writeStack() was called.  This allows
X# us to simply draw (or erase) the cards that have been added (or subtracted).
X# By special arrangement, this routine can be called with a negative stack
X# number!  This is a hint that our idea of what is on the display is actually
X# wrong, and therefore the entire stack needs to be re-displayed.  This can
X# happen in two situations:  1) in refreshScreen(), the entire screen is cleared
X# before calling writeStack();  2) in undo() when undoing a move between
X# stacks, the bottom card needs to be changed, although the normal algorithm
X# would consider that it is already correctly displayed.  Note that in neither
X# case is the stack shrinking, therefore we don't need to worry about erasing
X# any cards that were displayed last time.
Xprocedure writeStack (n)
Xlocal row, col, s
Xstatic last, blankLine, firstRow, lastRow
Xinitial  {
X   last := [0,0,0,0,0,0,0]
X   blankLine := repl (" ", 7)
X   firstRow := [2,4,6,8,10,12,14,16,18,20,22,24]   #first row of a card
X   lastRow  := [6,8,10,12,14,16,18,20,22,24,25,25] #last row of a card
X}
X   if \invisible  then  return
X   if n < 0  then  {
X      n := -n
X      last[n] := 0                     #force complete re-write
X   }
X
X   col := 1 + ((n -1) * 9)                #leftmost column for this stack
X
X   if *stackUp[n] <= last[n]  then  {
X      #the stack just got smaller (or stayed the same)
X      #blank out two rows for each card that has been removed
X      row := lastRow[last[n]]             #last row used by top card
X      while *stackUp[n] < last[n]  do  {
X         writeCursor (row-0, col);  writes (blankLine)
X         writeCursor (row-1, col);  writes (blankLine)
X         row -:= 2
X         last[n] -:= 1                 #count and update simultaneously
X      }
X      dieIf (*stackUp[n] ~= last[n], last[n])
X      #re-write new top card
X      if *stackUp[n] = 0  then
X         if *stackDown[n] = 0  then
X            writeBlank (2, col)
X         else
X            writeBack (2, col)
X      else
X         writeFront ([stackUp[n][-1]], firstRow[last[n]], col)
X   } else {
X      #the stack just got bigger -- display new cards
X      s := stackUp[n][last[n]-(*stackUp[n]):0]  #list of new cards
X      writeFront (s, firstRow[last[n]+1], col)
X      last[n] := *stackUp[n]           #remember how much is displayed
X   }
X
X   writeCursor (2, (7 + col))
X   writes (" 123456???"[1+*stackDown[n]]) #display the number of hidden cards
Xend                                 #writeStack
X
X
X#  w r i t e P i l e
X# Displays an image of the specified ace pile, face up (or blank if empty)
Xprocedure writePile (n)
Xstatic pileRow, pileCol
Xinitial {
X   pileRow := [3,3,9,9]
X   pileCol := [66,74,66,74]
X}
X   if \invisible  then  return
X   if  0 = pile[n]  then  writeBlank (pileRow[n], pileCol[n])
X   else  writeFront ([card(n,pile[n])], pileRow[n], pileCol[n])
Xend                                 #writePile
X
X
X#  w r i t e D e c k D o w n
X# Displays an image of deckDown (the face-down deck) in the proper spot.
Xprocedure writeDeckDown ()
X   if \invisible  then  return
X   if 0 < *deckDown  then
X      writeBack (21, 74)
X   else
X      writeBlank (21, 74)
X   if (\isUNIX, getval("li") = 25, \getval("am"))  then
X      writeCursor (19, 76)
X   else
X      writeCursor (20, 76)
X   writes (right(*deckDown, 2))
Xend                                 #writeDeckDown
X
X
X#  w r i t e D e c k U p
X# Displays an image of deckUp (the face-up deck) in the proper spot.
Xprocedure writeDeckUp ()
X   if \invisible  then  return
X   if 0 < *deckUp  then
X      writeFront ([deckUp[1]], 21, 66)
X   else
X      writeBlank (21, 66)
X   if (\isUNIX, getval("li") = 25, \getval("am"))  then
X      writeCursor (19, 68)
X   else
X      writeCursor (20, 68)
X   writes (right(*deckUp, 2))
Xend                                 #writeDeckUp
X
X
X#  w r i t e I n f o
X# Displays a new short string (up to 12 printing characters) in the
X# officially approved information area of the screen.
X# An empty string results in clearing the area and restoring normal attributes.
Xprocedure writeInfo (s)
SHAR_EOF
true || echo 'restore of kloncon.icn failed'
fi
echo 'End of  part 2'
echo 'File kloncon.icn is continued in part 3'
echo 3 > _shar_seq_.tmp
exit 0