goer%sophist@GARGOYLE.UCHICAGO.EDU (Richard Goerwitz) (12/08/90)
---- 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