naz@hslrswi.hasler.ascom.ch (Norman H. Azadian) (04/21/91)
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# kloncon.icn
# This archive created: Sun Apr 21 15:04:11 1991
# By: Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'kloncon.icn'" '(19868 characters)'
if test -f 'kloncon.icn'
then
echo shar: will not over-write existing file "'kloncon.icn'"
else
cat << \SHAR_EOF > 'kloncon.icn'
#kloncon.icn 901029 NHA
# Console interface routines for Klondike.
#
# TO FIX:
#
#
# TO DO:
#
# - develop a visual indication (for isQuiet) for a PC
# - Click for each card moved in a stack ??
#
link iolib #non-ANSI screen output subroutines
# constants
global rankID, suitID #card identification chars
global isANSI # non-&null for ANSI-compatible
global isMonochrome # non-&null when running Black&White
global output #function for writing control chars
global lineCount #total possible rows on screen
# Video control strings, etc
global Vnormal, Vreverse, Vblink, Vbold, VclearAll, VclearEOL, VbackSpace,Vbell
global Vcontrols, ESC #set of control strings, ESC char
global visualBell # non-&null when Vbell is visual
global color #list of suit color strings
# u s e r I n t e r r u p t
# Succeeds iff the user wishes to interrupt the action.
# THIS ROUTINE IS SYSTEM DEPENDENT.
# For DOS, we simply look to see if any keystroke is waiting, discarding
# it/them. Your system may be different.
procedure userInterrupt ()
static keyWaiting
initial {
keyWaiting := if \type(kbhit) then "kbhit"
}
if \isDOS then
while keyWaiting() do {
(getch() == "\0") & getch() #eat interrupting keystroke
return #success means "interrupt requested"
}
else
(\keyWaiting) & keyWaiting() & getch() & return
fail #failure = "interrupt NOT requested"
end #userInterrupt
# m y P u t s
# Output all the strings, using iputs() for control strings.
# This slightly cheesy algorithm requires that all control strings
# start with ESC. This, however, does not apply when \isANSI,
# since this routine isn't called then.
# Note that if isQuiet changes while running (using debug command), then
# Vbell and visualBell may not be optimally set.
procedure myPuts (sl[])
static outstr
local s
initial {
outstr := table("Oops!")
outstr[VclearAll] := getval("cl") | (getval("ho") || getval("cd"))
outstr[VclearEOL] := getval("ce")
outstr[Vnormal] := getval("me") || getval("ue")
outstr[Vbold] := getval("md" | "us")
outstr[Vblink] := getval("mb")
outstr[Vreverse] := getval("mr" | "so")
outstr[VbackSpace] := if getval("bs") then "\b" else getval("le")
if \isQuiet then
outstr[Vbell] := (visualBell := getval("vb")) | getval("bl")
else
outstr[Vbell] := getval ("bl") | "\^G";
}
while s := string(get(sl)) do
s ? {
while writes (tab(upto(ESC))) do
iputs (outstr[=(!Vcontrols)])
writes (tab(0))
}
return
end #myPuts
# g e t A N S I t y p e
# Determine if this ANSI-compatible screen is monochrome or color.
# This only works on a PC with the ANSI.SYS (or similar) driver installed.
procedure getANSItype ()
local i
if \isPC then {
i := ord (Peek([16r40, 16r49])) #BIOS display mode byte
case i of {
2 : isMonochrome := 1
3 : isMonochrome := &null #living color
7 : isMonochrome := 1
default : stop ("Klondike: unknown BIOS display mode ", i)
}
} else
runerr (500, "Klondike: but I thought you were on a PC !")
return
end #getANSItype
# 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 (termtype)
local Vred, Vblack #suit color strings
lineCount := 25 #assume the best
case (map(termtype, &lcase, &ucase)) of {
"PC" : { getANSItype (); isANSI := 1 }
"MONO" : { isMonochrome := 1; isANSI := 1 }
"COLOR" : { isMonochrome := &null; isANSI := 1 }
default : { isMonochrome := 1; isANSI := &null
(0 < *termtype) & setname (termtype)
lineCount := getval("li")
}
}
(lineCount < 24) &
stop ("klondike: need at least 24-line terminal. Yours is ", lineCount)
# Use this function for outputting any string containing control characters,
# unless you're sure that the screen is ANSI-compatible.
output := if \isANSI then writes else myPuts
# set Video control strings, plus the set of all Video control strings
ESC := "\e" #escape character
VclearAll := "\e[2J" #clear screen and home cursor
VclearEOL := "\e[K" #clear to End Of Line
Vnormal := "\e[0m"
Vbold := "\e[1m"
Vblink := "\e[5m"
Vreverse := "\e[7m"
if \isANSI then {
VbackSpace := "\b"
Vbell := "\^G"
} else {
#additional escape required for myPuts()
VbackSpace := "\e\b"
Vbell := "\e\^G" #ding dong, Avon calling
}
Vcontrols := set( [VclearAll, VclearEOL, Vnormal, Vbold,
Vblink, Vreverse, VbackSpace, Vbell] )
if \isMonochrome then {
Vred := Vnormal
Vblack := Vreverse
} else {
Vred := "\e[0;47;31m" # "extra" 0 seems to be necessary
Vblack := "\e[0;47;30m" # "extra" 0 seems to be necessary
}
# Suits are: 1=Hearts, 2=Diamonds, 3=Clubs, 4=Spades
suitID := if \isPC then "\3\4\5\6" else "HDCS"
color := [Vred, Vred, Vblack, Vblack]
rankID := "A23456789TJQK"
return
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.
# Note that the screen and its mode must remain unmodified if \invisible.
procedure initScreen ()
local f
static vertical
initial {
vertical := if \isANSI then "\272" else "|"
}
(\invisible) & return
if \isANSI then {
if (\isPC) then
if \isMonochrome then writes ("\e[=2h") #25x80 B&W text mode
else writes ("\e[=3h") #25x80 color text mode
writes (Vnormal, VclearAll, "\e[=7l") #clear screen, prevent wrap
} else {
if not iputs (getval("is")) then { #terminal Init Ftring
if f := open (getval("if"), "r") then { #terminal Init File
while writes (reads(f)) ## should use iputs() ??
close (f)
}
}
iputs (getval("ti")) #Termcap Init string
output (VclearAll)
}
every writeStackNumber (1 to 7, Vnormal)
writeCursor (2, 64)
if \isANSI then
writes ("\311\315\315\315\315SOLITAIRE\315\315\315\315")
else
writes ("=====SOLITAIRE====")
every writeAt (3 to lineCount, 64, vertical)
outputAt ((if lineCount = 25 then 25 else 1), 66,
Vbold, "Q", Vnormal, "=Quit ", Vbold, "H", Vnormal, "=Help")
return
end #initScreen
# t e r m i n a t e S c r e e n
# Put the screen in the correct state prior to program termination.
procedure terminateScreen ()
static resetCooked
initial {
resetCooked := if \type(reset_tty) then "reset_tty"
}
if /invisible then
if \isANSI then
write ("\e[=7h", VclearAll, Vnormal) #set cursor wrap mode
else {
output (VclearAll, Vnormal, getval("te"))
(/isDOS) & (\resetCooked) & resetCooked ()
}
return
end #terminateScreen
# 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)
static cm
initial {
(\isANSI) | (cm := (getval("cm") | (getval("ch") || getval("cv"))))
}
if /invisible then
if \isANSI then
writes ("\e[", row, ";", col, "H")
else
iputs (igoto(cm, col, row))
return
end #writeCursor
# w r i t e A t
# Position the cursor to row,col and then write the following string(s).
# Screen origin (top left corner) is row=1 and col=1.
# Note that the standard write() should normally not be used because the newline
# doesn't work when running in raw mode under unix.
procedure writeAt (row, col, s[])
if /invisible then {
writeCursor (row, col)
writes! (s)
}
return
end #writeAt
# o u t p u t A t
# Position the cursor to row,col and then write the following string(s).
# Screen origin (top left corner) is row=1 and col=1.
procedure outputAt (row, col, s[])
if /invisible then {
writeCursor (row, col)
output! (s)
}
return
end #outputAt
# 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.
# Note that this will almost surely alter your current cursor position.
procedure writeStackNumber (num, attr)
(\invisible) | outputAt (1, [3,12,21,30,39,48,57][num], attr, num, Vnormal)
return
end #writeStackNumber
# w r i t e F r o n t
# Displays an image of the specified card fronts at the specified spot.
## WARNING: The input cards must be in a list!
# 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.
# We only display the first 2 rows of each card, except for the top card.
# 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.
# With a 24 row screen, the topmost card (a 2) is moved up one line on a full
# stack. This will obscure the 3 that it is resting on, but the topmost 2 will
# be visible, which is rather more important.
##We can only write a row at a time due to a problem with ANSI col 80 handling.
procedure writeFront (cardlist, row, col)
local card
static vertical, topHorizontal, bottomHorizontal
initial {
if \isANSI then {
topHorizontal := "\332\304\304\304\304\304\277"
vertical := "\263"
bottomHorizontal := "\300\304\304\304\304\304\331"
} else {
topHorizontal := "-------"
vertical := "|"
bottomHorizontal := "-------"
}
}
dieIf (lineCount < row, row)
# output first 2 rows of every card
# for long stack and short screen the next-to-top card is mostly obscured
every card := !cardlist do {
(row = lineCount) & (row -:= 1) #long stack, short screen
outputAt (row, col, Vreverse, topHorizontal)
outputAt (row+:=1, col, vertical, color[card.suit], rankID[card.rank],
suitID[card.suit], Vreverse, " ", vertical)
row +:= 1
}
# maybe put out some more rows of the top card
if row <= lineCount then {
outputAt (row, col, Vreverse, vertical, " ", vertical)
if (row +:= 1) <= lineCount then {
outputAt (row, col, vertical, " ", color[card.suit],
rankID[card.rank], suitID[card.suit], Vreverse, vertical)
if (row +:= 1) <= lineCount then
writeAt (row, col, bottomHorizontal) #last row of top card
}
}
output (Vnormal)
return
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
local i
initial {
backLine := list(5)
if \isANSI then {
backLine[1] := "\332\304\304\304\304\304\277"
backLine[2] := "\263\332\304\304\304\277\263"
backLine[3] := "\263\263\040\040\040\263\263"
backLine[4] := "\263\300\304\304\304\331\263"
backLine[5] := "\300\304\304\304\304\304\331"
} else {
backLine[1] := "-------"
backLine[2] := "| --- |"
backLine[3] := "| | | |"
backLine[4] := "| --- |"
backLine[5] := "-------"
}
}
(\invisible) | (every writeAt (row, col, !backLine) do row +:= 1)
return
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)
(\invisible) | (every writeAt (row + (0 to 4), col, " "))
return
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.
# Optimized to avoid re-writing cards that are already on the screen.
# prevs[] holds, for each stack, the total number of visible (up) 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
static prevs, blankLine, firstRow, lastRow
initial {
prevs := [0,0,0,0,0,0,0] #previous stack height displayed
blankLine := repl (" ", 7)
# first and last screen rows for each card in a stack
firstRow := [2,4,6,8,10,12,14,16,18,20,22,24]
lastRow := [6,8,10,12,14,16,18,20,22,24,lineCount,lineCount]
}
(\invisible) & return
(n < 0) & (prevs[n := abs(n)] := 0) #n < 0 forces complete re-write
col := (n * 9) - 8 #leftmost column for this stack
if (*stackUp[n]) <= prevs[n] then {
# the stack just got smaller (or stayed the same)
# blank out two rows for each card that has been removed
row := lastRow[prevs[n]] + 1 #<last row used by top card> + 1
while *stackUp[n] < prevs[n] do {
every writeAt (row -:= (1 | 1), col, blankLine)
prevs[n] -:= 1 #countdown and update
}
dieIf (*stackUp[n] ~= prevs[n], prevs[n])
# re-write new top card
if *stackUp[n] = 0 then
(if *stackDown[n] = 0 then writeBlank else writeBack) (2, col)
else
writeFront ([stackUp[n][-1]], firstRow[prevs[n]], col)
} else {
# the stack just got bigger -- display new cards
writeFront (stackUp[n][prevs[n]+1:0], firstRow[prevs[n]+1], col)
prevs[n] := *stackUp[n] #remember how much is displayed
}
# display the number of hidden cards
writeAt (4, (7 + col), " 123456???"[1+*stackDown[n]])
return
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
if 0 = pile[n] then
writeBlank (pileRow[n], pileCol[n])
else
writeFront ([card(n,pile[n])], pileRow[n], pileCol[n])
return
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.
# Avoids re-displaying blank or card back that is already on the screen.
# Parameter is non-null to force displaying something (assuming not invisible).
procedure writeDeckDown (forget)
static p
initial {
forget := 1 #assume the screen is blank
}
if /invisible then {
(\forget) & (p := writeDeckDown) #anything but writeBlank | writeBack
(p ~===:= (if 0 < *deckDown then writeBack else writeBlank)) (20, 74)
writeAt (19, 76, right(*deckDown, 2)) #display card count in deckDown
}
return
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 {
writeFront ([deckUp[1]], 20, 66) | writeBlank (20, 66)
writeAt (19, 68, right(*deckUp, 2)) #write number of cards in deckUp
}
return
end #writeDeckUp
# c o u n t C o n t r o l s
# Returns a count of video control sequences in the proffered string.
# This is not a very general algorithm, being valid only for our V constants.
procedure countControls (s)
local count #of [invisible] video control chars
local seq #control sequence found
count := 0
every find ((seq := (!Vcontrols)), s) do count +:= *seq
return count
end #countControls
# w r i t e I n f o
# Displays a new short string (up to 16 printing characters) centered in the
# officially approved information area of the screen.
# All known video attributes (in set "Vcontrols") are specially handled.
# An empty string results in clearing the area.
# We always revert to normal text mode after outputting the string.
procedure writeInfo (s)
(\invisible) | outputAt (15, 65, Vnormal, VclearEOL,
trim(center(s, 16+countControls(s)), ' '), Vnormal)
return
end #writeInfo
# c l i c k
# Make a quick sound to accompany card transfers, if possible and not Quiet.
procedure click ()
local x
if (not \isQuiet) & (\isPC) then {
x := InPort (16r61)
OutPort (16r61, 3)
OutPort (16r61, x)
}
return
end #click
# b e e p
# The short beep produced under isPC is not as annoying as the normal beeeeep.
# This always puts out something, although it might be a visual indication.
procedure beep ()
local x
if (\isPC) then { #no visual indication yet for a PC
x := InPort (16r61)
every | OutPort (16r61, 3) \ 22
OutPort (16r61, x)
} else
output (Vbell)
return
end #beep
# c o m p l a i n
# Let the boob know he done something wrong, with a dash of humor.
# Complaint can be specified, otherwise a generic one will be selected for you.
# Phrases can be up to 16 visible characters long.
# Additionally there may be embedded recognized video control sequences.
# Complaint will always be bold, and will blink if isQuiet.
procedure complain (complaint)
static phrases
local f, s
initial {
phrases := ["INVALID"] #irreducible minimum
if \phraseFile then {
if f := open((directory || phraseFile), "r") then {
while put (phrases,
trim(center(s, 16+countControls(s := read(f))), ' '))
close (f)
(1 < *phrases) & pop(phrases) #success -- remove ours
}
} else {
phrases |||:= [
"cut that out!", "oops!", "be nice!", "get real",
"be serious", "What??", "huh?", "idiot alert",
"dummy!", "Hey man!", "giggle giggle", "engage brain",
"NOW what?", "yuk yuk", "funky dude", "wake up, man",
"yeah, real funny", "totally awesome", "boffo", "boogie boogie",
"Bozo!", "watch it!", "oi vey", "~@?$!&*=(*%^!*",
"forty lashes!", "way cool, dude", "ha ha ha", "see an analyst",
"go fly a kite", "wish upon a star", "basket case", "braindamaged",
"dummkopf", "holy cow", "reject", "try harder",
"think again", "watch your hands", "We're not amused", "adjust fingers",
"gimme a break", "R U 4 real ?", "that's a laugh", "Ho Ho Ho",
"space case", "space cadet", "call AA", "oh yeah?",
"dum de dum dum", "try thinking", "sigh", "get a life"
]
}
(\debugging) & writeInfo (*phrases || " phrases")
}
/complaint := ?phrases
#Note that isQuiet can change while running if debugging is enabled (-Z)
if (\isQuiet) & (not \visualBell) then
writeInfo (Vbold || Vblink || complaint)
else {
writeInfo (Vbold || complaint)
beep()
}
return
end #complain
# 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 ())
# (s == ESC) & fail
# Under DOS, F1 [function key 1] is specially treated as a request for Help.
procedure getCmdChar ()
local s
s := getch () #get command character
if s == "\0" then { #non-ASCII character
s := getch () #check keyboard scan code
if (\isDOS) & (s == ";") then {
s := "h" #jigger F1 to look like "Help"
} else {
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
# r e f r e s h S c r e e n
# Re-write entire screen.
procedure refreshScreen ()
if /invisible then {
initScreen ()
every writeStack (-1 to -7 by -1)
every writePile (1 to 4)
writeDeckDown (1)
writeDeckUp ()
}
return
end #refreshScreen
SHAR_EOF
if test 19868 -ne "`wc -c < 'kloncon.icn'`"
then
echo shar: error transmitting "'kloncon.icn'" '(should have been 19868 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
--
PAPER: Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland
INTERNET: naz%hslrswi.uucp@uunet.uu.net
UUCP: ...{uunet,ukc,mcvax,...}!chx400!hslrswi!naz
VOICE: +41 31 63 2178 BITNET: naz%hslrswi.UUCP@cernvax.BITNET