goer@SOPHIST.UCHICAGO.EDU (Richard Goerwitz) (11/17/89)
It's not as if I only write games for my son, though the code I
post here seems inevitably to tend in that direction. Normally
I use icon to help me reconstruct the phonology of dead langu-
ages by comparing computational models of various phonological
processes against known texts to see if they conform to all the
known evidence. If anyone else is using Icon for natural langu-
age processing of this or any other type, I surely would like to
know about it!
But anyway, here's a kids' game. Sorry it's IBM charset and ANSI
specific. These are the tools I have around the house (Xenix on an
AT-type machine, to be specific):
global name_of_wordfile, termlength, timing
procedure main()
name_of_wordfile := "/so/goer/words"
termlength := 24
timing := 60
# Kind of a hangman game, built for my three year-old son to peel
# him away from Wheel of Fortune (which he calls "the letter game").
# Assumes an ANSI or similar terminal - one has a 256 char IBM set
# and accepts color commands. Before running, create a file of words,
# phrases, or sentences, and then assign name_of_wordfile to the name
# of that file. For 24-line terminals, assign termlength to 24. If
# things happen too slowly for you, try resetting the global variable
# "timing" to 40 or 30. Oh, by the way, the format of the wordfile
# is one word or phrase to a line. Couldn't be simpler. Ask your
# kid what words he or she likes, and the interest level will go up
# several orders of magnitude. Make sure the user has write permis-
# sion on the wordfile. To abort, type "quit." To solve the puz-
# zle, type in the entire word or phrase at the prompt. To give up,
# type "tell me."
hitlst := list()
until *(s := readword()) < 33
writes("\e[30;44m\e[2J")
every i := upto(~(&ucase++&lcase), s)
do put(hitlst,s[i])
writeboxes(s,hitlst)
until *hitlst = *s do {
hitlst := query(s,hitlst)
writeboxes(s,hitlst)
}
T := &time; until &time > (T + timing*8)
writes("\e[37;41m\e[2J")
goodjob(); readword(1)
stop("\e[",string(termlength - 1),";1H\e[37;40m")
end
procedure writeboxes(s,l)
writes("\e[30;44m")
writes("\e[9;11H\e[33m")
every i := 1 to *s do {
T := &time; until &time > (T + timing/2)
if map(s[i]) == map(!\l)
then {
writes("\e[s\e[30m\xDB")
T := &time; until &time > (T + timing/5)
writes("\e[u\e[37m",s[i],"\e[30m")
}
else {
writes("\e[s\e[30m\xDB")
T := &time; until &time > (T + timing/5)
writes("\e[u\e[33m\xDB\e[30m")
}
i ~= *s & writes(" ")
}
writes("\e[30;44m")
return
end
procedure query(s,l)
static tried
initial tried := ""
snew := map(s)
repeat {
ad := string(cset(tried))
writes("\e[",string(termlength),";2HYou've tried: \e[32m",ad,"\e[30m\e[K")
sd := &lcase -- string(cset(ad))
writes("\e[",string(termlength),";40HStill left: \e[32m",sd,"\e[30m\e[K")
writes("\e[11;11HGuess a letter: \e[K\e[31m")
guess := map(read())
writes("\e[30m")
if guess == "quit" then readword(1)
if *guess ~= 1
then {
if guess == map(s) then {
hitlst := []
every put(hitlst,!s)
return hitlst
}
if trim(guess,'.?!') == "tell me" then {
hitlst := []; every put(hitlst,!s)
writeboxes(s,hitlst)
readword(1)
}
writes("\e[14;11HHas to be one letter, not ",*guess," letters!\e[K")
T := &time; until &time > (T + timing*10)
every j := 12 to (termlength - 1) do writes("\e[",j,";1H\e[K")
writes("\e[14;1H\e[K")
}
else {
if any(~(&ucase ++ &lcase),guess) then {
writes("\e[14;11HHas to be a letter!\e[K")
T := &time; until &time > (T + timing*7)
writes("\e[14;1H\e[K")
next
}
if find(guess,tried) then {
writes("\e[14;11HYou already did that one!\e[K")
T := &time; until &time > (T + timing*7)
writes("\e[14;1H\e[K")
next
}
tried ||:= guess
if find(guess,snew)
then {
every find(guess,snew)
do put(l,guess)
break
}
else {
writes("\e[14;11HSorry, try again!\e[K")
T := &time; until &time > (T + timing*4)
writes("\e[14;1H\e[K")
}
}
}
return l
end
procedure readword(c)
static wordlist, count, position
initial {
wordlist := list(200,"")
count := 0; position := 0
intext := open(name_of_wordfile,"r") |
stop("You first have to create a wordfile (see source).")
every "" ~== trim(s := !intext)
do wordlist[count +:= 1] := s
close(intext)
}
if type(c) == "null"
then {
position := getpos(count,position)
return wordlist[position]
}
else {
outtext := open(name_of_wordfile,"w") | stop()
every i := position + 1 to count
do write(outtext,wordlist[i])
every j := 1 to (position)
do write(outtext,wordlist[j]) # if position = 0 it'll fail
close(outtext)
stop("\e[",string(termlength - 1),";1H\e[37;40m")
}
end
procedure getpos(count,position)
if count < (position +:= 1)
then return 1
else return position
end
procedure goodjob()
writes("\e[2J")
every 1 to ((50 * ?5) + 90) do {
every i := 1 to 100 + ?5
write("\e[",?24,";",?71,"H\e[",29+?17,";",29+?17,"mYOU WON!\e[0m")
}
return
end