diff options
Diffstat (limited to 'ipl/gprogs/spider.icn')
| -rw-r--r-- | ipl/gprogs/spider.icn | 104 |
1 files changed, 96 insertions, 8 deletions
diff --git a/ipl/gprogs/spider.icn b/ipl/gprogs/spider.icn index 0c25529..10ed22a 100644 --- a/ipl/gprogs/spider.icn +++ b/ipl/gprogs/spider.icn @@ -6,7 +6,9 @@ # # Author: William S. Evans # -# Date: February 19, 2002 +# Contributor: Gregg M. Townsend +# +# Date: September 6, 2009 # ############################################################################ # @@ -45,6 +47,11 @@ # 's' Save the current game to a file. # 'r' Read a game from a file. # '1234567890' Move run from indicated pile. +# 'bfhptvwxyz' Move run from indicated pile. +# +# If $HOME/.spdhist exists and is writable at the start of the run, a +# single history record is written to it for each 'n' or 'q' or 'r' +# command, unless no cards have been moved. # ############################################################################ # @@ -52,15 +59,20 @@ # ############################################################################ # -# Links: drawcard, graphics, random +# Links: datetime, drawcard, graphics, random # ############################################################################ +link datetime link drawcard link graphics link random $define SPIDER_VERSION "spider-0.3" # version of spider +$define HISTORY_FILE ".spdhist" # name of history file in $HOME + +$define NUM_LABELS "1234567890" # numeric column labels +$define LTR_LABELS "bfhptvwxyz" # alphabetic column labels global cardw, cardh # card width and height global ymargin, xmargin, xgap # margins, gap between cards @@ -74,6 +86,8 @@ global nextCard # an integer global undoStack # list of integers global currentFile # filename to store/retrieve a game global readingGame # =1 if reading game from file =0 o.w. +global startTime # start time of this game +global histfile # appendable history file, if any, else null procedure main(args) local fromPile,maxCards,e,p @@ -82,6 +96,7 @@ procedure main(args) newgame() repeat case e := Event() of { !"qQ": { + report() exit() } "d": { @@ -94,26 +109,29 @@ procedure main(args) message(hiddenNames(1+(&x-xmargin+xgap/2)/(cardw+xgap))) } "n": { + report() newgame() } "u": { undo() | beep() } "r": { + report() readingGame := 1 WAttrib("bg=pale gray","fg=black") readFile() readingGame := 0 WAttrib("bg=deep moderate green","fg=white") drawBoard() + startTime := &null # unknown original start time } "s": { WAttrib("bg=pale gray","fg=black") saveFile() WAttrib("bg=deep moderate green","fg=white") } - !"1234567890": { - p := 0 < ord(e)-ord("0") | 10 + !(NUM_LABELS | LTR_LABELS): { + p := find(e, NUM_LABELS | LTR_LABELS) click(13,p,p) | beep() } &lpress | &rpress: { @@ -138,6 +156,7 @@ procedure main(args) end procedure initialize(args) + local hfname currentFile := "game1.spd" readingGame := 0 @@ -171,6 +190,10 @@ procedure initialize(args) ymargin <:= fheight + hfname := (getenv("HOME") | "?noHOME?") || "/" || HISTORY_FILE + if close(open(hfname)) then # if file already exists + histfile := open(hfname, "wa") # may fail leaving null if not writable + return end @@ -205,12 +228,19 @@ procedure newgame(initialDeck) up[11] := 0 drawBoard() + + startTime := &clock return end procedure drawPiles(p[]) local i,j,n,x,y,ht,mlap,upstart,yposns + if *pile[11] = 104 then { + drawWin() + return + } + if readingGame = 0 then { every i := 1 <= 10 >= !p do { @@ -219,8 +249,8 @@ procedure drawPiles(p[]) yoff[i] := yposns := list(0) x := xmargin + (i-1) * (cardw + xgap) EraseArea(x,ymargin,cardw,height-2*ymargin) - GotoXY(x+cardw/2,ymargin-descent) - WWrites(10 > i | 0) + GotoXY(x+cardw/2-10,ymargin-descent) + WWrites(LTR_LABELS[i], " ", NUM_LABELS[i]) n := *(pile[i]) mlap := lap if n > 1 then @@ -247,9 +277,28 @@ procedure drawPiles(p[]) return end +procedure drawWin() + local i, j, s, x, y, suits + + EraseArea() + suits := [ + "MLKJIHGFEDCBA", "mlkjihgfedcba", "zyxwvutsrqpon", "ZYXWVUTSRQPON" ] + every i := 1 to 4 do { + s := suits[i] + y := 125 * (i - 1) + every x := 20 | 400 do { + every j := 1 to 13 do { + drawcard(x + 24 * j, y, s[j]) + WDelay(5) + } + } + } + return +end procedure drawBoard() if readingGame = 0 then { + EraseArea() WAttrib("label=Spider Deck "||104-nextCard+1) drawPiles(1,2,3,4,5,6,7,8,9,10) } @@ -424,8 +473,8 @@ procedure succ(c) end procedure beep() - writes("\^g") - flush(&output) + writes(&errout, "\^g") + flush(&errout) return end @@ -505,6 +554,7 @@ procedure saveFile() write(output,deck) every writes(output,!undoStack," ") write(output,"") + close(output) return } else { Notice("Cannot open file for writing.") @@ -565,3 +615,41 @@ procedure doAll() } return end + +procedure report() + local i, u, s, stopTime, elapsed, nmoves, undealt, cardsleft + + if *undoStack = 0 then return # don't report if no moves made + + stopTime := &clock + elapsed := ClockToSec(stopTime,0) - (ClockToSec(\startTime,0)|-1) + if elapsed < 0 then # if wraparound crossing midnight + elapsed +:= 24 * 60 * 60 + elapsed >:= 9999 # 9999 sec means unknown or bogus time + + nmoves := *undoStack/3 + undealt := 104 - nextCard + 1 + cardsleft := 0 + every cardsleft +:= *pile[1 to 10] + write(nmoves, " moves in ", elapsed, " seconds, leaving ", + cardsleft + undealt, " cards") + + if /histfile then return # if no history file, nothing more to do + + writes(histfile, &date, " ", stopTime[1+:5]) # date and time at quit + writes(histfile, right(elapsed, 5), "s") # elapsed time in sec + writes(histfile, right(nmoves, 4), "m") # moves made + writes(histfile, right(undealt, 3), "c") # undealt cards + + every i := 1 to 10 do { + s := pile[i] + u := up[i] + if *s = 0 then + writes(histfile, " -") + else + writes(histfile, " ", s[1+:u], repl("?", *s-u)) + } + + write(histfile) + return +end |