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:
# klonstr.icn
# getchlib.icn
# This archive created: Sun Apr 21 15:03:15 1991
# By: Norman H. Azadian (Hasler AG)
export PATH; PATH=/bin:$PATH
echo shar: extracting "'klonstr.icn'" '(5135 characters)'
if test -f 'klonstr.icn'
then
echo shar: will not over-write existing file "'klonstr.icn'"
else
cat << \SHAR_EOF > 'klonstr.icn'
#klonstr.icn 910309 NHA
#Routines to implement strategic play for klondike solitaire.
#For each strategy there is a procedure with the same name.
#findBest() is the interface to the rest of klondike.
# t a k e F i r s t
# This strategy is the simplest possible, simply taking the first suggestion
# proffered by suggest(). Equivalent to find1().
# Note that it is therefore dependent on the exact implementation of suggest().
# When Thumbing, terminate upon second occurrence of *deckDown = 0.
procedure takeFirst ()
local emptySeen, s
until (\emptySeen) & (*deckDown = 0) do {
/emptySeen := (*deckDown = 0)
(s := suggest()) & return (s || "0") #good move found
((*deckUp + *deckDown) = 0) & break #no cards to thumb through
writeInfo (Vbold || "T" || Vnormal || "humb")
push (ops, thumb())
}
fail #nothing left to do
end #takeFirst
# i n t e r a c t i v e
# For multi-choice positions, allows the user to choose.
procedure interactive ()
local suggestions, emptySeen, s, op
until (\emptySeen) & (*deckDown = 0) do {
/emptySeen := (*deckDown = 0)
suggestions := [] #generate a new list of suggestions
every put (suggestions, suggest())
(1 = *suggestions) & (return (suggestions[1] || "0")) #one possibility
if (1 < *suggestions) then { #multiple -- user picks
outputAt (lineCount, 40, VclearEOL, Vreverse)
every s := !suggestions do writes (s[2:0], " ")
writeInfo (Vblink || "choose a move")
until any(cset("123456789abc"[1+:*suggestions]), (s := getch())) do
complain()
op := suggestions["16r" || s]
outputAt (lineCount, 40, VclearEOL, Vnormal)
every s := !suggestions do
if s == op then
output (Vreverse, op[2:0], Vnormal, " ")
else
writes (s[2:0], " ")
return (op || "0")
}
# no useful moves found -- thumb
((*deckUp + *deckDown) = 0) & break #no cards to thumb through
writeInfo (Vbold || "T" || Vnormal || "humb")
push (ops, thumb())
}
fail #nothing left to do
end #interactive
# d e c k F i r s t
# The idea here is that, if possible, nothing will get done in this
# pass through the deck until a card has been taken from the deck.
# Otherwise, the strategy is simply takeFirst.
# We run with automaticAce disabled simply so we can know when
# we take one from the deck.
# Since there is no way to know that we are starting a new game, we cannot
# guarantee that the flags are correct in the event of user intervention.
procedure deckFirst ()
local s
static taken, modified
initial {
taken := &null #assume nothing taken from deck yet
modified := &null #nothing done yet on this pass
}
automaticAce := &null
repeat {
every s := suggest() do
if (\taken) | (s[2] == "D") then {
modified := taken := 1 #[sic]
return (s || "0")
}
((*deckUp + *deckDown) = 0) & break #no cards to thumb through
writeInfo (Vbold || "T" || Vnormal || "humb")
push (ops, thumb())
if 0 = *deckDown then #end of a pass through the deck
if \modified then
modified := taken := &null #normal case -- reset flags
else
if \taken then
break #nothing left to do [sic]
else
taken := 1 #allow other moves for next pass
}
modified := taken := null #reset flags for next game
fail #nothing useful left to do
end #deckFirst
# f i n d B e s t
# If called with a parameter, the parameter is taken to be the name of a play
# strategy and is saved for future use by findBest() after sanity checking.
# An empty string is taken to be a request to use the default strategy.
# Note that, at least for now, the name of the strategy procedure is
# necessarily identical to the name of the strategy.
#
# If called without any parameter, returns with the move selected by the
# pre-determined strategy routine.
# Largely for hysterical raisons, strategy routines are expected to do their
# own Thumbing until either they find a good move to return, or they decide
# there is no point to continuing and so return failure.
# Strategy routines are expected to keep the user informed of any moves
# (e.g. Thumbing) that they do before returning.
#
# Note that the strategy procedure may decide it is necessary to
# unilaterally disable the automaticAce option during its execution.
# Therefore automaticAce is saved here and restored before returning.
# However, if the strategy procedure leaves automaticAce intact, then
# any Ace uncovered whilst thumbing will be automaticall moved and the
# search will continue. It does not count as a move.
procedure findBest (s)
static strategies, strategyProc
local automaticAceSave
initial {
strategies := set ( ["takeFirst", "interactive", "deckFirst"] )
}
if \s then { #remember strategy
(s == "") & (s := "takeFirst") #default strategy
(s == !strategies) | stop ("klondike: unknown strategy ", s)
strategyProc := (strategy := s) #remember for future use
} else { #execute strategy
automaticAceSave := automaticAce
s := strategyProc()
automaticAce := automaticAceSave
(s === &null) & fail
}
return s
end #findBest
SHAR_EOF
if test 5135 -ne "`wc -c < 'klonstr.icn'`"
then
echo shar: error transmitting "'klonstr.icn'" '(should have been 5135 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'getchlib.icn'" '(9166 characters)'
if test -f 'getchlib.icn'
then
echo shar: will not over-write existing file "'getchlib.icn'"
else
cat << \SHAR_EOF > 'getchlib.icn'
############################################################################
#
# Name: getchlib.icn
#
# Title: Implementation of getch() for Unix (and more)
#
# Author: Richard L. Goerwitz
#
# Version: 1.13
#
############################################################################
#
# I place this and future versions of getchlib in the public domain - RLG
#
############################################################################
#
# Implementing getch() is a much, much more complex affair under Unix
# than it is under, say, MS-DOS. This library represents one,
# solution to the problem - one which can be run as a library, and
# need not be compiled into the run-time system. Note that it will
# not work on all systems. In particular, certain Suns (with a
# screwy stty command) and the NeXT 1.0 OS (lacking the -g option for
# stty) do not run getchlib properly. See the bugs section below for
# workarounds.
#
# Four basic utilities are included here:
#
# getch() - waits until a keystroke is available &
# returns it without displaying it on the screen
# getche() - same as getch() only with echo
# getse(s) - like getche() only for strings. The optional
# argument s gives getse() something to start with. Use this
# if, say, you want to read single characters in cbreak mode,
# but get more input if the character read is the first part
# of a longer command. If the user backspaces over everything
# that has been input, getse() fails. Returns on \r or \n.
# reset_tty() - absolutely vital routine for putting the cur-
# rent tty line back into cooked mode; call it before exiting
# or you will find yourself with a locked-up terminal; use it
# also if you must temporarily restore the terminal to cooked
# mode
#
# Note that getse() *must* be used in place of read(&input) if you
# are planning on using getch() or getche(), since read(&input)
# assumes a tty with "sane" settings.
#
# Warning: The routines below do not do any sophisticated output
# processing. As noted above, they also put your tty line in raw
# mode. I know, I know: "Raw is overkill - use cbreak." But in
# a world that includes SysV, one must pick a lowest common denomi-
# nator. And no, icanon != cbreak.
#
# BUGS: These routines will not work on systems that do not imple-
# ment the -g option for the stty command. The NeXT workstation is
# an example of such a system. Tisk, tisk. If you have a SunOS stty
# that is too clever (read stupid) to write its output to a pipe,
# then substitute /usr/5bin/stty (or whatever your system calls the
# System V stty command) for /bin/stty in this file. If you have no
# SysV stty command online, then you can try replacing every instance
# of "stty -g 2>&1" below with "stty -g 2>&1 1> /dev/tty" or
# something similar.
#
############################################################################
#
# Example program:
#
# The following program is a simple file viewer. To run, it
# needs to be linked with itlib.icn, iscreen.icn, and this file
# (getchlib.icn).
#
# procedure main(a)
#
# # Simple pager/file searcher for Unix systems. Must be linked
# # with itlib.icn and iscreen.icn.
#
# local intext, c, s
#
# # Open input file
# intext := open(a[1],"r") | {
# write(&errout,"Can't open input file.")
# exit(1)
# }
#
# # Initialize screen
# clear()
# print_screen(intext) | exit(0)
#
# # Prompt & read input
# repeat {
# iputs(igoto(getval("cm"), 1, getval("li")))
# emphasize()
# writes("More? (y/n or /search):")
# write_ce(" ")
# case c := getche() of {
# "y" : print_screen(intext) | break
# " " : print_screen(intext) | break
# "n" : break
# "q" : break
# "/" : {
# iputs(igoto(getval("cm"), 1, getval("li")))
# emphasize()
# writes("Enter search string:")
# write_ce(" ")
# pattern := GetMoreInput()
# /pattern | "" == pattern & next
# # For more complex patterns, use findre() (IPL findre.icn)
# if not find(pattern, s := !intext) then {
# iputs(igoto(getval("cm"), 1, getval("li")))
# emphasize()
# write_ce("String not found.")
# break
# }
# else print_screen(intext, s) | break
# }
# }
# }
#
# reset_tty()
# write()
# exit(0)
#
# end
#
# procedure GetMoreInput(c)
#
# local input_string
# static BS
# initial BS := getval("bc") | "\b"
#
# /c := ""
# if any('\n\r', chr := getch())
# then return c
# else {
# chr == BS & fail
# writes(chr)
# input_string := getse(c || chr) | fail
# if any('\n\r', input_string)
# then fail else (return input_string)
# }
#
# end
#
# procedure print_screen(f,s)
#
# if /s then
# begin := 1
# # Print top line, if one is supplied
# else {
# iputs(igoto(getval("cm"), 1, 1))
# write_ce(s ? tab(getval("co") | 0))
# begin := 2
# }
#
# # Fill the screen with lines from f; clear and fail on EOF.
# every i := begin to getval("li") - 1 do {
# iputs(igoto(getval("cm"), 1, i))
# if not write_ce(read(f) ? tab(getval("co") | 0)) then {
# # Clear remaining lines on the screen.
# every j := i to getval("li") do {
# iputs(igoto(getval("cm"), 1, j))
# iputs(getval("ce"))
# }
# iputs(igoto(getval("cm"), 1, i))
# fail
# }
# }
# return
#
# end
#
# procedure write_ce(s)
#
# normal()
# iputs(getval("ce")) |
# writes(repl(" ",getval("co") - *s))
# writes(s)
# return
#
# end
#
############################################################################
#
# Requires: UNIX
#
# Links: itlib.icn
#
############################################################################
global c_cc, current_mode # what mode are we in, raw or cooked?
record termio_struct(vintr,vquit,verase,vkill)
procedure getse(s)
# getse() - like getche, only for strings instead of single chars
#
# This procedure *must* be used instead of read(&input) if getch
# and/or getche are to be used, since these put the current tty
# line in raw mode.
#
# Note that the buffer can be initialized by calling getse with a
# string argument. Note also that, as getse now stands, it will
# fail if the user backspaces over everything that has been input.
# This change does not coincide with its behavior in previous ver-
# sions. It can be changed by commenting out the line "if *s < 1
# then fail" below, and uncommenting the line "if *s < 1 then
# next."
local chr
static BS
initial {
BS := getval("bc") | "\b"
if not getval("bs") then {
reset_tty()
stop("Your terminal can't backspace!")
}
}
/s := ""
repeat {
case chr := getch() | fail of {
"\r"|"\n" : return s
c_cc.vkill : {
if *s < 1 then next
every 1 to *s do writes(BS)
s := ""
}
c_cc.verase : {
# if *s < 1 then next
writes(BS) & s := s[1:-1]
if *s < 1 then fail
}
default: writes(chr) & s ||:= chr
}
}
end
procedure setup_tty()
change_tty_mode("setup")
return
end
procedure reset_tty()
# Reset (global) mode switch to &null to show we're in cooked mode.
current_mode := &null
change_tty_mode("reset")
return
end
procedure getch()
local chr
# If the global variable current_mode is null, then we have to
# reset the terminal to raw mode.
if /current_mode := 1 then
setup_tty()
chr := reads(&input)
case chr of {
c_cc.vintr : reset_tty() & stop() # shouldn't hard code this in
c_cc.vquit : reset_tty() & stop()
default : return chr
}
end
procedure getche()
local chr
# If the global variable current_mode is null, then we have to
# reset the terminal to raw mode.
if /current_mode := 1 then
setup_tty()
chr := reads(&input)
case chr of {
c_cc.vintr : reset_tty() & stop()
c_cc.vquit : reset_tty() & stop()
default : writes(chr) & return chr
}
end
procedure change_tty_mode(switch)
# global c_cc (global record containing values for kill, etc. chars)
local get_term_params, i
static reset_string
initial {
getval("li") # check to be sure itlib is set up
find("unix",map(&features)) |
stop("change_tty_mode: These routines must run under Unix.")
get_term_params := open("/bin/stty -g 2>&1","pr")
reset_string := !get_term_params
close(get_term_params)
reset_string ? {
# tab upto the fifth field of the output of the stty -g cmd
# fields of stty -g seem to be the same as those of the
# termio struct, except that the c_line field is missing
every 1 to 4 do tab(find(":")+1)
c_cc := termio_struct("\x03","\x1C","\x08","\x15")
every i := 1 to 3 do {
c_cc[i] := char(integer("16r"||tab(find(":"))))
move(1)
}
c_cc[i+1] := char(integer("16r"||tab(0)))
}
}
if switch == "setup"
then system("/bin/stty -echo raw")
else system("/bin/stty "||reset_string)
return
end
SHAR_EOF
if test 9166 -ne "`wc -c < 'getchlib.icn'`"
then
echo shar: error transmitting "'getchlib.icn'" '(should have been 9166 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