naz@hslrswi.UUCP (Norman H. Azadian) (12/06/90)
#kloncon.icn 901029 NHA
# Console interface routines for Klondike
# Requires ANSI.SYS (or NANSI.SYS) screen driver and a 25-line display.
#
# TO FIX:
#
#
# TO DO:
#
# - termcap for portability ??
# - click for each card moved in a stack ?
#
# constants
global suitID #suit identification chars
global isDOS # 1 when running under DOS
global monochrome # 1 when running Black&White
# Video control strings (ANSI.SYS)
global ESC
global Vnormal, Vreverse, Vblink, Vbold, VclearAll, VclearEOL, Vbell
global color #list of suit color strings
# i n i t C o n s t a n t s
# Initialize the program "constants". These are actually variables that
# are set just once at the beginning of the world.
procedure initConstants ()
local i
local Vred, Vblack #suit color strings
if \invisible then return
#ensure that we are dealing with an ANSI-compatible screen
writes ("\33[6n") #request cursor position report
#NOTE that the first character to match should be an ESCape.
#Unfortunately, reads() seems to eat that character
match ("[", reads (&input, 8)) |
stop ("Klondike: requires ANSI.SYS screen driver")
isDOS := find("MS-DOS", &host)
if \isDOS then {
i := ord (Peek([16r40, 16r49])) #BIOS display mode byte
case i of {
2 : monochrome := 1
3 : monochrome := &null #living color
7 : monochrome := 1
default : stop ("Klondike: unknown display mode ", i)
}
} else
monochrome := 1
ESC := "\33" #escape character
VclearAll := "\33[2J" #also homes cursor
VclearEOL := "\33[K"
Vnormal := "\33[0m"
Vbold := "\33[1m"
Vblink := "\33[5m"
Vreverse := "\33[7m"
Vbell := "\^G"
if \monochrome then {
Vred := Vnormal
Vblack := Vreverse
} else {
Vred := "\33[0;47;31m" # "extra" 0 seems to be necessary
Vblack := "\33[0;47;30m"
}
# Suits are: 1=Hearts, 2=Diamonds, 3=Clubs, 4=Spades
suitID := if \isDOS then "\3\4\5\6" else "HDCS"
color := [Vred, Vred, Vblack, Vblack]
end #initConstants
# i n i t S c r e e n
# Initialize output and write the fixed parts of the screen.
# initConstants() must have been called earlier.
procedure initScreen ()
local i
static vertical
initial {
vertical := if \isDOS then "\272" else "|"
}
if \invisible then return
if \monochrome then writes ("\33[=2h") #25x80 B&W text mode
else writes ("\33[=3h") #25x80 color text mode
writes (VclearAll, "\33[=7l") #clear screen, prevent wrap
every i := 1 to 7 do
writeStackNumber (i, Vnormal)
every i := 2 to 25 do
writes ("\33[",i,";64H", vertical)
if \isDOS then
writes ("\33[2;64H\311\315\315\315\315SOLITAIRE\315\315\315\315")
else
writes ("\33[2;64H=====SOLITAIRE====")
end #initScreen
# w r i t e S t a c k N u m b e r
# Write the indicated stack number with the specified video attribute.
# Cursor position is preserved -- WARNING: THIS IS NOT NESTABLE.
procedure writeStackNumber (num, attr)
if \invisible then return
writes (ESC, "[s") #save cursor position
writeCursor (1, [2,11,20,29,38,47,56][num])
writes (attr, num, Vnormal)
writes (ESC, "[u") #restore cursor position
end #writeStackNumber
# w r i t e C u r s o r
# Position the cursor to row,col.
# Screen origin (top left corner) is row=1 and col=1.
procedure writeCursor (row, col)
if /invisible then
writes ("\33[", row, ";", col, "H")
end #writeCursor
# w r i t e F r o n t
# Displays an image of the specified card fronts at the specified spot.
# WARNING: this eats the list that you provide -- pass a copy() if you care!!
# Top left corner of the first card will be placed at the specified position.
# Successive cards are displayed two rows higher (lower position on the screen).
# Cursor need not be in any particular position before this, and is left
# in a random position afterwards. Video is always left normal (not reversed).
# Cards are 7 columns wide by 5 rows tall.
# With 25 rows, we can put 12 cards in a stack (assuming we start in row 2).
# But if there are 11 in the stack we can only display 4 rows of the top card.
# If there are 12 cards, we can only display 2 rows of the topmost card.
##We can only write a row at a time due to a problem with ANSI col 80 handling.
procedure writeFront (cardlist, row, col)
local suit, rank, card
static vertical, topHorizontal, bottomHorizontal
initial {
if \isDOS then {
vertical := "\263"
topHorizontal := "\332\304\304\304\304\304\277"
bottomHorizontal := "\300\304\304\304\304\304\331"
} else {
vertical := "|"
topHorizontal := "-------"
bottomHorizontal := "-------"
}
}
while card := get(cardlist) do {
#first 2 rows of card
writeCursor (row+0, col);
writes (Vreverse, topHorizontal)
writeCursor (row+1, col);
writes (vertical, color[card.suit], "A23456789TJQK"[card.rank],
suitID[card.suit], Vreverse, " ", vertical)
if (*cardlist = 0) & (row < 24) then {
#next 2 rows of top card unless it's the 12th card on the stack
writeCursor (row+2, col);
writes (Vreverse, vertical, " ", vertical)
writeCursor (row+3, col);
writes (vertical, " ",color[card.suit],"A23456789TJQK"[card.rank],
suitID[card.suit], Vreverse, vertical)
if row < 22 then {
#last row of card unless it's the 11th on the stack
writeCursor (row+4, col);
writes (bottomHorizontal)
}
}
row +:= 2
}
writes (Vnormal)
end #writeFront
# w r i t e B a c k
# Puts an image of the back of a card at the specified spot on the screen.
procedure writeBack (row, col)
static backLine
initial {
backLine := repl (if \isDOS then "\260" else "#", 7)
}
if \invisible then return
writeCursor (row+0, col); writes (backLine)
writeCursor (row+1, col); writes (backLine)
writeCursor (row+2, col); writes (backLine)
writeCursor (row+3, col); writes (backLine)
writeCursor (row+4, col); writes (backLine)
end #writeBack
# w r i t e B l a n k
# Blanks a card-sized area at the specified spot on the screen.
procedure writeBlank (row, col)
static blankLine
initial {
blankLine := repl (" ", 7)
}
if \invisible then return
writeCursor (row+0, col); writes (blankLine)
writeCursor (row+1, col); writes (blankLine)
writeCursor (row+2, col); writes (blankLine)
writeCursor (row+3, col); writes (blankLine)
writeCursor (row+4, col); writes (blankLine)
end #writeBlank
# w r i t e S t a c k
# Display the specified stack. Left end is bottom of stackUp, top of stackDown.
# Stacks start in row 2, column1; with 2 columns between stacks.
# last[] holds, for each stack, the total number of visible cards
# on that stack as of the last time writeStack() was called. This allows
# us to simply draw (or erase) the cards that have been added (or subtracted).
# By special arrangement, this routine can be called with a negative stack
# number! This is a hint that our idea of what is on the display is actually
# wrong, and therefore the entire stack needs to be re-displayed. This can
# happen in two situations: 1) in refreshScreen(), the entire screen is cleared
# before calling writeStack(); 2) in undo() when undoing a move between
# stacks, the bottom card needs to be changed, although the normal algorithm
# would consider that it is already correctly displayed. Note that in neither
# case is the stack shrinking, therefore we don't need to worry about erasing
# any cards that were displayed last time.
procedure writeStack (n)
local row, col, s
static last, blankLine, firstRow, lastRow
initial {
last := [0,0,0,0,0,0,0]
blankLine := repl (" ", 7)
firstRow := [2,4,6,8,10,12,14,16,18,20,22,24] #first row of a card
lastRow := [6,8,10,12,14,16,18,20,22,24,25,25] #last row of a card
}
if \invisible then return
if n < 0 then {
n := -n
last[n] := 0 #force complete re-write
}
col := 1 + ((n -1) * 9) #leftmost column for this stack
if *stackUp[n] <= last[n] then {
#the stack just got smaller (or stayed the same)
#blank out two rows for each card that has been removed
row := lastRow[last[n]] #last row used by top card
while *stackUp[n] < last[n] do {
writeCursor (row-0, col); writes (blankLine)
writeCursor (row-1, col); writes (blankLine)
row -:= 2
last[n] -:= 1 #count and update simultaneously
}
dieIf (*stackUp[n] ~= last[n], last[n])
#re-write new top card
if *stackUp[n] = 0 then
if *stackDown[n] = 0 then
writeBlank (2, col)
else
writeBack (2, col)
else
writeFront ([stackUp[n][-1]], firstRow[last[n]], col)
} else {
#the stack just got bigger -- display new cards
s := stackUp[n][last[n]-(*stackUp[n]):0] #list of new cards
writeFront (s, firstRow[last[n]+1], col)
last[n] := *stackUp[n] #remember how much is displayed
}
writeCursor (2, (7 + col))
writes (" 123456???"[1+*stackDown[n]]) #display the number of hidden cards
end #writeStack
# w r i t e P i l e
# Displays an image of the specified ace pile, face up (or blank if empty)
procedure writePile (n)
static pileRow, pileCol
initial {
pileRow := [3,3,9,9]
pileCol := [66,74,66,74]
}
if \invisible then return
if 0 = pile[n] then writeBlank (pileRow[n], pileCol[n])
else writeFront ([card(n,pile[n])], pileRow[n], pileCol[n])
end #writePile
# w r i t e D e c k D o w n
# Displays an image of deckDown (the face-down deck) in the proper spot.
procedure writeDeckDown ()
if \invisible then return
if 0 < *deckDown then
writeBack (21, 74)
else
writeBlank (21, 74)
writeCursor (20, 76)
writes (right(*deckDown, 2))
end #writeDeckDown
# w r i t e D e c k U p
# Displays an image of deckUp (the face-up deck) in the proper spot.
procedure writeDeckUp ()
if \invisible then return
if 0 < *deckUp then
writeFront ([deckUp[1]], 21, 66)
else
writeBlank (21, 66)
writeCursor (20, 68)
writes (right(*deckUp, 2))
end #writeDeckUp
# w r i t e I n f o
# Displays a new short string (up to 12 printing characters) in the
# officially approved information area of the screen.
# An empty string results in clearing the area and restoring normal attributes.
procedure writeInfo (s)
if \invisible then return
writeCursor (16, 65)
writes (Vnormal, VclearEOL)
if *s ~= 0 then writes (s)
end #writeInfo
# c l i c k
# Make a quick sound to accompany card transfers
procedure click ()
local x
if (\clicking) & (\isDOS) then {
x := InPort (16r61)
OutPort (16r61, 3)
OutPort (16r61, x)
}
end #click
# g e t C m d C h a r
# Returns an upper-case command character, echoed to current cursor position.
# Fails if character wasn't "normal" and complaint was made.
# For ESC, abort information is written, and ESC is returned.
# Normal calling sequence (from within a command procedure) is thus:
# until (s := getCmdChar ())
# if s == ESC then fail
procedure getCmdChar ()
local s
s := getch () #get command character
if s == "\0" then { #non-ASCII character
getch () #discard keyboard scan code
complain ()
fail
}
s := map (s, &lcase, &ucase)
if s == ESC then
writeInfo (Vbold || "Cmd Aborted.")
else
writes (s) #echo the command character
return s
end #getCmdChar
# c o m p l a i n
# Let the boob know he done something wrong
# The short beep produced under isDOS is not as annoying as the normal beeeeep.
procedure complain ()
local x
writeInfo (Vbold || "INVALID")
if \clicking then
if \isDOS then {
x := InPort (16r61)
every 1 to 22 do
OutPort (16r61, 3)
OutPort (16r61, x)
} else
writes (Vbell)
end #complain
# r e f r e s h S c r e e n
# Re-write entire screen.
procedure refreshScreen ()
if \invisible then return
initScreen ()
every writeStack (-1 to -7 by -1)
every writePile (1 to 4)
writeDeckDown ()
writeDeckUp ()
end #refreshScreen
--
PAPER: Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
X.400: naz@hslrswi.hasler
UUCP: ...{uunet,ukc,mcvax,...}!cernvax!hslrswi!naz
VOICE: +41 31 63 2178 BITNET: naz%hslrswi.UUCP@cernvax.BITNET