goer@quads.uchicago.edu (Richard L. Goerwitz) (01/02/91)
Tenaglia's blackjack game was very cleanly written, and I ported it before dinner tonight. Some of the character graphics and fonts couldn't be reproduced portably using standard Unix terminals, so I had to remove them. Oh well. Needless to say, I haven't tested this program terribly thoroughly on any system but my own, and even there some bugs might remain. Still, I don't expect that anyone will encounter any big problems running it (or fixing it up). It's a nice game. In fact, I must hurry up, since my son is breathing down my neck to let him have the console so that he can run it here at home. Here's the first of three shell archives. -Richard (goer@sophist.uchicago.edu) stty: Operation not supported on socket ---- Cut Here and feed the following to sh ---- #!/bin/sh # This is a shell archive (produced by shar 3.49) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 01/02/1991 02:37 UTC by goer@sophist.uchicago.edu # Source directory /u/richard/Bj # # existing files will NOT be overwritten unless -c is specified # This format requires very little intelligence at unshar time. # "if test", "cat", "rm", "echo", "true", and "sed" may be needed. # # This is part 1 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 10389 -r--r--r-- bj.icn # 12240 -r--r--r-- itlib.icn # 14586 -r--r--r-- itlibdos.icn # 2391 -r--r--r-- termcap.dos # 1654 -rw-r--r-- README # 754 -rw-r--r-- Makefile.dist # if test -r _shar_seq_.tmp; then echo 'Must unpack archives in sequence!' echo Please unpack part `cat _shar_seq_.tmp` next exit 1 fi # ============= bj.icn ============== if test -f 'bj.icn' -a X"$1" != X"-c"; then echo 'x - skipping bj.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting bj.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'bj.icn' && X############################################################################ X# X# Names: bj.icn X# X# Title: blackjack game X# X# Author: Chris Tenaglia (modified by Richard L. Goerwitz) X# X# Version: 1.1 X# X############################################################################ X# X# Simple but fun blackjack game. The original version was for an ANSI X# screen. This version has been modified to work with the Unix termcap X# database file. X# X############################################################################ X# X# Links: X# X############################################################################ X Xglobal deck, message, lookup, X user_money, host_money, X user_hand, host_hand X Xprocedure main(param) X user_money := integer(param[1]) | 3 ; host_money := user_money X write(screen("cls")) X# Most terminals don't do oversize characters like this. X# write(screen("cls")," ",screen("top"),screen("hinv"), X# "BLACK JACK",screen("norm")) X# write(" ",screen("bot"),screen("hinv"), X# "BLACK JACK",screen("norm")) X write(screen("high")," ---- BLACK JACK ----",screen("norm")) X bonus := 0 X repeat X { X if not any('y',(map(input(at(1,3) || " " || screen("under") || X "Play a game? y/n : "|| screen("norm") || X screen("eeol")))[1])) then break X every writes(at(1,3|4),screen("eeos")) X display_score() X deck := shuffle() X message := "" X user_hand := [] ; host_hand := [] X put(user_hand,pop(deck)) ; put(host_hand,pop(deck)) X put(user_hand,pop(deck)) ; put(host_hand,pop(deck)) X user_points := first(host_hand[1]) X if user_points > 21 then X { X writes(at(1,13),user_points," points. You went over. You lose.") X user_money -:= 1 ; host_money +:= 1 + bonus ; bonus := 0 X display_score() X next X } X display_host(2) X host_points := second(user_points) X if host_points > 21 then X { X writes(at(50,22),host_points," points. ",&host ? tab(find(" ")), X " went over.") X writes(at(1,13),screen("hiblink"),"You win.",screen("norm")) X host_money -:= 1 ; user_money +:= 1 + bonus ; bonus := 0 X display_score() X next X } X if host_points = user_points then X { X writes(at(1,22),screen("hiblink"),"It's a draw at ",user_points, X ". The ANTY goes to bonus.",screen("norm")) X bonus +:= 2 ; host_money -:= 1 ; user_money -:= 1 X display_score() X next X } X writes(at(20,12),user_points," points for user.") X writes(at(1,14),host_points," points for ",&host ? tab(find(" "))) X if user_points < host_points then X { X write(at(1,22),screen("hiblink"),&host ? tab(find(" "))," wins.", X screen("norm"),screen("eeol")) X user_money -:= 1 ; host_money +:= 1 + bonus ; bonus := 0 X display_score() X next X } else { X writes(at(1,12),screen("hiblink"),"You win.",screen("norm"), X screen("eeol")) X user_money +:= 1 + bonus ; host_money -:= 1 ; bonus := 0 X display_score() X next X } X } X write(screen("clear")) X end X X# X# THIS PROCEDURE ALLOWS THE USER TO PLAY AND TAKE HITS X# Xprocedure first(host_card) X display_user() X display_host(1) X points := value(user_hand) # just in case X writes(at(1,9),"(",points,") ") X repeat X if any('hy',map(input(at(1,23) || "Hit ? y/n : " || screen("eeol")))) then X { X put(user_hand,pop(deck)) X display_user() X if (points := value(user_hand)) > 21 then return points X writes(at(1,9),"(",points,") ") X } else break X (points > 0) | (points := value(user_hand)) X writes(at(1,9),"(",points,") ") X write(at(60,11),"You stay with ",points) X return points X end X X# X# THIS SECOND PROCEDURE IS THE HOST PLAYING AGAINST THE USER X# Xprocedure second(ceiling) X static limits X initial limits := [14,14,15,15,19,16,17,18] X stop_at := ?limits ; points := 0 X until (points := value(host_hand)) > stop_at do X { X if points > ceiling then return points X writes(at(1,19),"(",points,") ") X# write(at(1,22),screen("eeol"),&host," will take a hit.",screen("eeol")) X write(at(1,22),screen("eeol"),&host ? tab(find(" ")), X " will take a hit.",screen("eeol")) X put(host_hand,pop(deck)) X display_host(2) X } X (points > 0) | (points := value(host_hand)) X writes(at(1,19),"(",points,") ") X return points X end X X# X# THIS ROUTINE DISPLAYS THE CURRENT SCORE X# Xprocedure display_score() X writes(screen("nocursor")) X writes(screen("dim"),at(1,7),"Credits",screen("norm")) X writes(screen("high"),at(1,8),right(user_money,7),screen("norm")) X writes(screen("dim"),at(1,17),"Credits",screen("norm")) X writes(screen("high"),at(1,18),right(host_money,7),screen("norm")) X end X# X# THIS PROCEDURE EVALUATES THE POINTS OF A HAND. IT TRIES TO MAKE THEM X# AS HIGH AS POSSIBLE WITHOUT GOING OVER 21. X# Xprocedure value(sample) X hand := copy(sample) X possible := [] X repeat X { X sum := 0 X every card := !hand do sum +:= lookup[card[1]] X put(possible,sum) X if Aces(hand) == "none" then break else X every i := 1 to *hand do if hand[i][1] == "A" then hand[i][1] := "a" X } X every score := !possible do X if score <= 21 then return score X return possible[1] X end X X# X# ARE THERE ANY 11 POINT ACES LEFT IN HAND X# Xprocedure Aces(cards) X every look := !cards do if look[1] == "A" then return "some" X return "none" X end X X# X# THIS ROUTINE DISPLAYS THE USER HAND AND STATUS X# Xprocedure display_user() X writes(screen("nocursor"),at(1,6),screen("hinv"),"USER",screen("norm")) X x := 10 ; y := 4 X every card := !user_hand do X { X display(card,x,y) X x +:= 7 X } X end X X# X# THIS ROUTINE DISPLAYS THE HOST HAND AND STATUS X# Xprocedure display_host(flag) X writes(screen("nocursor"),at(1,16),screen("hinv"), X &host ? tab(find(" ")),screen("norm")) X x := 10 ; y := 14 ; /flag := 0 X every card := !host_hand do X { X if (flag=1) & (x=10) then card := "XX" X display(card,x,y) X x +:= 7 X } X end X X# X# THIS ROUTINE DISPLAYS A GIVEN CARD AT A GIVEN X,Y SCREEN LOCATION X# Xprocedure display(card,x,y) X all := [] ; j := y X if find(card[2],"CS") then card := screen("hinv") || card || screen("norm") X# shape := [at(x,(j+:=1)) || screen("gchar") || "lqqqqqqqk"] X shape := [at(x,(j+:=1)) || screen("inv") || " " || screen("norm")] X put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") || X " " || card || " " || screen("inv") || " " || screen("norm")) X put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") || X " " || screen("inv") || " " || screen("norm")) X put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") || X " " || screen("inv") || " " || screen("norm")) X put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") || X " " || screen("inv") || " " || screen("norm")) X# put(shape,at(x,(j+:=1)) || "x x") X# put(shape,at(x,(j+:=1)) || "x x") X put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") || X " " || card || " " || screen("inv") || " " || screen("norm")) X# put(shape,at(x,(j+:=1)) || "mqqqqqqqj" || screen("nchar")) X put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm")) X put(all,shape) X x +:= 14 X while shape := pop(all) do every writes(!shape) X end X X# X# THIS ROUTINE SHUFFLES THE CARD DECK X# Xprocedure shuffle() X static faces, suits X local cards, i X initial { X &random := map(&clock,":","7") # initial on multiple shuffles X faces := ["2","3","4","5","6","7","8","9","T","J","Q","K","A"] X suits := ["D","H","C","S"] X lookup := table(0) X every i := 2 to 9 do insert(lookup,string(i),i) X insert(lookup,"T",10) X insert(lookup,"J",10) X insert(lookup,"Q",10) X insert(lookup,"K",10) X insert(lookup,"A",11) X insert(lookup,"a",1) X } X cards := [] X every put(cards,!faces || !suits) X every i := *cards to 2 by -1 do cards[?i] :=: cards[i] X return cards X end X X# X# THIS ROUTINE PARSES A STRING WITH RESPECT TO SOME DELIMITER X# Xprocedure parse(line,delims) X static chars X chars := &cset -- delims X tokens := [] X line ? while tab(upto(chars)) do put(tokens,tab(many(chars))) X return tokens X end X X# X# THIS ROUTINE PROMPTS FOR INPUT AND RETURNS A STRING X# Xprocedure input(prompt) X writes(screen("cursor"),prompt) X return read() X end X X X# X# THIS ROUTINE SETS THE VIDEO OUTPUT ATTRIBUTES FOR VT102 OR LATER X# COMPATIBLE TERMINALS. X# Xprocedure screen(attr) X initial if getval("ug"|"mg"|"sg") > 0 then X er("screen","oops, magic cookie terminal!",34) X return { X case attr of X { X "cls" : getval("cl") X "clear": getval("cl") X # HIGH INTENSITY & INVERSE X "hinv" : (getval("md") | "") || getval("so") X "norm" : (getval("se") | "") || (getval("me") | "") || (getval("ue")|"") X # LOW INTENSITY VIDEO X "dim" : getval("mh"|"me") X "blink": getval("mb"|"md"|"so") X # HIGH INTENSITY BLINKING X "hiblink": (getval("md") | "") || getval("mb") | getval("so") X "under": getval("us"|"md"|"so") X "high" : getval("md"|"so"|"ul") X "inv" : getval("so"|"md"|"ul") X # ERASE TO END OF LINE X "eeol" : getval("ce") X # ERASE TO START OF LINE X "esol" : getval("cb") X # ERASE TO END OF SCREEN X "eeos" : getval("cd") X # MAKE CURSOR INVISIBLE X "cursor": getval("vi"|"CO") | "" X # MAKE CURSOR VISIBLE X "nocursor": getval("ve"|"CF") | "" X# # START ALTERNATE FONT <- very non-portable X# "gchar": getval("as") | "" X# # END ALTERNATE FONT X# "nchar": getval("ae") | "" X# "light": return "\e[?5h" # LIGHT COLORED SCREEN X# "dark" : return "\e[?5l" # DARK COLORED SCREEN X# "80" : return "\e[?3l" # 80 COLUMNS ON SCREEN X# "132" : return "\e[?3h" # 132 COLUMNS ON SCREEN X# "smooth": return "\e[?4h" # SMOOTH SCREEN SCROLLING X# "jump" : return "\e[?4l" # JUMP SCREEN SCROLLING X default : er("screen",attr||" is just too weird for most terminals",34) X } | er("screen","I just can't cope with your terminal.",35) X } X end X X# X# THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION X# Xprocedure at(x,y) X# return "\e[" || y || ";" || x || "f" X return igoto(getval("cm"),x,y) X end X SHAR_EOF true || echo 'restore of bj.icn failed' rm -f _shar_wnt_.tmp fi # ============= itlib.icn ============== if test -f 'itlib.icn' -a X"$1" != X"-c"; then echo 'x - skipping itlib.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting itlib.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'itlib.icn' && X######################################################################## X# X# Name: itlib.icn X# X# Title: Icon termlib-type tools X# X# Author: Richard L. Goerwitz X# X# Version: 1.23 X# X######################################################################### X# X# I place this and future versions of itlib in the public domain - RLG X# X######################################################################### X# X# The following library represents a series of rough functional X# equivalents to the standard Unix low-level termcap routines. They X# are not meant as exact termlib clones. Nor are they enhanced to X# take care of magic cookie terminals, terminals that use \D in their X# termcap entries, or, in short, anything I felt would not affect my X# normal, day-to-day work with ANSI and vt100 terminals. X# X# Requires: A unix platform & co-expressions. There is an MS-DOS X# version, itlibdos.icn. X# X# setname(term) X# Use only if you wish to initialize itermlib for a terminal X# other than what your current environment specifies. "Term" is the X# name of the termcap entry to use. Normally this initialization is X# done automatically, and need not concern the user. X# X# getval(id) X# Works something like tgetnum, tgetflag, and tgetstr. In the X# spirit of Icon, all three have been collapsed into one routine. X# Integer valued caps are returned as integers, strings as strings, X# and flags as records (if a flag is set, then type(flag) will return X# "true"). Absence of a given capability is signalled by procedure X# failure. X# X# igoto(cm,destcol,destline) - NB: default 1 offset (*not* zero)! X# Analogous to tgoto. "Cm" is the cursor movement command for X# the current terminal, as obtained via getval("cm"). Igoto() X# returns a string which, when output via iputs, will cause the X# cursor to move to column "destcol" and line "destline." Column and X# line are always calculated using a *one* offset. This is far more X# Iconish than the normal zero offset used by tgoto. If you want to X# go to the first square on your screen, then include in your program X# "iputs(igoto(getval("cm"),1,1))." X# X# iputs(cp,affcnt) X# Equivalent to tputs. "Cp" is a string obtained via getval(), X# or, in the case of "cm," via igoto(getval("cm"),x,y). Affcnt is a X# count of affected lines. It is only relevant for terminals which X# specify proportional (starred) delays in their termcap entries. X# X# Bugs: I have not tested these routines on terminals that require X# padding. These routines WILL NOT WORK if your machines stty com- X# mand has no -g option (tisk, tisk). This includes NeXT worksta- X# tions, and some others that I haven't had time to pinpoint. X# X########################################################################## X# X# Requires: UNIX, co-expressions X# X# See also: iscreen.icn (a set of companion utilities) X# X########################################################################## X X Xglobal tc_table, tty_speed Xrecord true() X X Xprocedure check_features() X X local in_params, line X # global tty_speed X X initial { X find("unix",map(&features)) | X er("check_features","unix system required",1) X find("o-expres",&features) | X er("check_features","co-expressions not implemented - &$#!",1) X system("/bin/stty tabs") | X er("check_features","can't set tabs option",1) X } X X # clumsy, clumsy, clumsy, and probably won't work on all systems X tty_speed := getspeed() X return "term characteristics reset; features check out" X Xend X X X Xprocedure setname(name) X X # Sets current terminal type to "name" and builds a new termcap X # capability database (residing in tc_table). Fails if unable to X # find a termcap entry for terminal type "name." If you want it X # to terminate with an error message under these circumstances, X # comment out "| fail" below, and uncomment the er() line. X X #tc_table is global X X check_features() X X tc_table := table() X tc_table := maketc_table(getentry(name)) | fail X # er("setname","no termcap entry found for "||name,3) X return "successfully reset for terminal " || name X Xend X X X Xprocedure getname() X X # Getname() first checks to be sure we're running under Unix, and, X # if so, tries to figure out what the current terminal type is, X # checking successively the value of the environment variable X # TERM, and then the output of "tset -". Terminates with an error X # message if the terminal type cannot be ascertained. X X local term, tset_output X X check_features() X X if not (term := getenv("TERM")) then { X tset_output := open("/bin/tset -","pr") | X er("getname","can't find tset command",1) X term := !tset_output X close(tset_output) X } X return \term | X er("getname","can't seem to determine your terminal type",1) X Xend X X X Xprocedure er(func,msg,errnum) X X # short error processing utility X write(&errout,func,": ",msg) X exit(errnum) X Xend X X X Xprocedure getentry(name, termcap_string) X X # "Name" designates the current terminal type. Getentry() scans X # the current environment for the variable TERMCAP. If the X # TERMCAP string represents a termcap entry for a terminal of type X # "name," then getentry() returns the TERMCAP string. Otherwise, X # getentry() will check to see if TERMCAP is a file name. If so, X # getentry() will scan that file for an entry corresponding to X # "name." If the TERMCAP string does not designate a filename, X # getentry() will scan /etc/termcap for the correct entry. X # Whatever the input file, if an entry for terminal "name" is X # found, getentry() returns that entry. Otherwise, getentry() X # fails. X X local f, getline, line, nm, ent1, ent2 X X # You can force getentry() to use a specific termcap file by cal- X # ling it with a second argument - the name of the termcap file X # to use instead of the regular one, or the one specified in the X # termcap environment variable. X /termcap_string := getenv("TERMCAP") X X if \termcap_string ? (not match("/"), pos(0) | tab(find("|")+1), =name) X then return termcap_string X else { X X # The logic here probably isn't clear. The idea is to try to use X # the termcap environment variable successively as 1) a termcap en- X # try and then 2) as a termcap file. If neither works, 3) go to X # the /etc/termcap file. The else clause here does 2 and, if ne- X # cessary, 3. The "\termcap_string ? (not match..." expression X # handles 1. X X if find("/",\termcap_string) X then f := open(termcap_string) X /f := open("/etc/termcap") | X er("getentry","I can't access your /etc/termcap file",1) X X getline := create read_file(f) X X while line := @getline do { X if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then { X entry := "" X while (\line | @getline) ? { X if entry ||:= 1(tab(find(":")+1), pos(0)) X then { X close(f) X # if entry ends in tc= then add in the named tc entry X entry ?:= tab(find("tc=")) || X # recursively fetch the new termcap entry X (move(3), getentry(tab(find(":"))) ? X # remove the name field from the new entry SHAR_EOF true || echo 'restore of itlib.icn failed' fi echo 'End of part 1' echo 'File itlib.icn is continued in part 2' echo 2 > _shar_seq_.tmp exit 0