Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!usc!wuarchive!mit-eddie!bloom-beacon!eru!hagbard!sunic!mcsun!cernvax!chx400!hslrswi!naz From: naz@hslrswi.UUCP (Norman H. Azadian) Newsgroups: comp.lang.icon Subject: klondike, version 1.41. part 3/4 Message-ID: <1689@hslrswi.UUCP> Date: 6 Dec 90 12:43:12 GMT Organization: Hasler AG Lines: 391 #kloncon.icn 901029 NHA # Console interface routines for Klondike # Requires ANSI.SYS (or NANSI.SYS) screen driver and a 25-line display. # # TO FIX: # # # TO DO: # # - termcap for portability ?? # - click for each card moved in a stack ? # # constants global suitID #suit identification chars global isDOS # 1 when running under DOS global monochrome # 1 when running Black&White # Video control strings (ANSI.SYS) global ESC global Vnormal, Vreverse, Vblink, Vbold, VclearAll, VclearEOL, Vbell global color #list of suit color strings # 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 () local i local Vred, Vblack #suit color strings if \invisible then return #ensure that we are dealing with an ANSI-compatible screen writes ("\33[6n") #request cursor position report #NOTE that the first character to match should be an ESCape. #Unfortunately, reads() seems to eat that character match ("[", reads (&input, 8)) | stop ("Klondike: requires ANSI.SYS screen driver") isDOS := find("MS-DOS", &host) if \isDOS then { i := ord (Peek([16r40, 16r49])) #BIOS display mode byte case i of { 2 : monochrome := 1 3 : monochrome := &null #living color 7 : monochrome := 1 default : stop ("Klondike: unknown display mode ", i) } } else monochrome := 1 ESC := "\33" #escape character VclearAll := "\33[2J" #also homes cursor VclearEOL := "\33[K" Vnormal := "\33[0m" Vbold := "\33[1m" Vblink := "\33[5m" Vreverse := "\33[7m" Vbell := "\^G" if \monochrome then { Vred := Vnormal Vblack := Vreverse } else { Vred := "\33[0;47;31m" # "extra" 0 seems to be necessary Vblack := "\33[0;47;30m" } # Suits are: 1=Hearts, 2=Diamonds, 3=Clubs, 4=Spades suitID := if \isDOS then "\3\4\5\6" else "HDCS" color := [Vred, Vred, Vblack, Vblack] 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. procedure initScreen () local i static vertical initial { vertical := if \isDOS then "\272" else "|" } if \invisible then return if \monochrome then writes ("\33[=2h") #25x80 B&W text mode else writes ("\33[=3h") #25x80 color text mode writes (VclearAll, "\33[=7l") #clear screen, prevent wrap every i := 1 to 7 do writeStackNumber (i, Vnormal) every i := 2 to 25 do writes ("\33[",i,";64H", vertical) if \isDOS then writes ("\33[2;64H\311\315\315\315\315SOLITAIRE\315\315\315\315") else writes ("\33[2;64H=====SOLITAIRE====") end #initScreen # 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. # Cursor position is preserved -- WARNING: THIS IS NOT NESTABLE. procedure writeStackNumber (num, attr) if \invisible then return writes (ESC, "[s") #save cursor position writeCursor (1, [2,11,20,29,38,47,56][num]) writes (attr, num, Vnormal) writes (ESC, "[u") #restore cursor position end #writeStackNumber # 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) if /invisible then writes ("\33[", row, ";", col, "H") end #writeCursor # w r i t e F r o n t # Displays an image of the specified card fronts at the specified spot. # WARNING: this eats the list that you provide -- pass a copy() if you care!! # 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. # 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. ##We can only write a row at a time due to a problem with ANSI col 80 handling. procedure writeFront (cardlist, row, col) local suit, rank, card static vertical, topHorizontal, bottomHorizontal initial { if \isDOS then { vertical := "\263" topHorizontal := "\332\304\304\304\304\304\277" bottomHorizontal := "\300\304\304\304\304\304\331" } else { vertical := "|" topHorizontal := "-------" bottomHorizontal := "-------" } } while card := get(cardlist) do { #first 2 rows of card writeCursor (row+0, col); writes (Vreverse, topHorizontal) writeCursor (row+1, col); writes (vertical, color[card.suit], "A23456789TJQK"[card.rank], suitID[card.suit], Vreverse, " ", vertical) if (*cardlist = 0) & (row < 24) then { #next 2 rows of top card unless it's the 12th card on the stack writeCursor (row+2, col); writes (Vreverse, vertical, " ", vertical) writeCursor (row+3, col); writes (vertical, " ",color[card.suit],"A23456789TJQK"[card.rank], suitID[card.suit], Vreverse, vertical) if row < 22 then { #last row of card unless it's the 11th on the stack writeCursor (row+4, col); writes (bottomHorizontal) } } row +:= 2 } writes (Vnormal) 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 initial { backLine := repl (if \isDOS then "\260" else "#", 7) } if \invisible then return writeCursor (row+0, col); writes (backLine) writeCursor (row+1, col); writes (backLine) writeCursor (row+2, col); writes (backLine) writeCursor (row+3, col); writes (backLine) writeCursor (row+4, col); writes (backLine) 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) static blankLine initial { blankLine := repl (" ", 7) } if \invisible then return writeCursor (row+0, col); writes (blankLine) writeCursor (row+1, col); writes (blankLine) writeCursor (row+2, col); writes (blankLine) writeCursor (row+3, col); writes (blankLine) writeCursor (row+4, col); writes (blankLine) 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. # last[] holds, for each stack, the total number of visible 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, s static last, blankLine, firstRow, lastRow initial { last := [0,0,0,0,0,0,0] blankLine := repl (" ", 7) firstRow := [2,4,6,8,10,12,14,16,18,20,22,24] #first row of a card lastRow := [6,8,10,12,14,16,18,20,22,24,25,25] #last row of a card } if \invisible then return if n < 0 then { n := -n last[n] := 0 #force complete re-write } col := 1 + ((n -1) * 9) #leftmost column for this stack if *stackUp[n] <= last[n] then { #the stack just got smaller (or stayed the same) #blank out two rows for each card that has been removed row := lastRow[last[n]] #last row used by top card while *stackUp[n] < last[n] do { writeCursor (row-0, col); writes (blankLine) writeCursor (row-1, col); writes (blankLine) row -:= 2 last[n] -:= 1 #count and update simultaneously } dieIf (*stackUp[n] ~= last[n], last[n]) #re-write new top card if *stackUp[n] = 0 then if *stackDown[n] = 0 then writeBlank (2, col) else writeBack (2, col) else writeFront ([stackUp[n][-1]], firstRow[last[n]], col) } else { #the stack just got bigger -- display new cards s := stackUp[n][last[n]-(*stackUp[n]):0] #list of new cards writeFront (s, firstRow[last[n]+1], col) last[n] := *stackUp[n] #remember how much is displayed } writeCursor (2, (7 + col)) writes (" 123456???"[1+*stackDown[n]]) #display the number of hidden cards 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 return if 0 = pile[n] then writeBlank (pileRow[n], pileCol[n]) else writeFront ([card(n,pile[n])], pileRow[n], pileCol[n]) 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. procedure writeDeckDown () if \invisible then return if 0 < *deckDown then writeBack (21, 74) else writeBlank (21, 74) writeCursor (20, 76) writes (right(*deckDown, 2)) 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 return if 0 < *deckUp then writeFront ([deckUp[1]], 21, 66) else writeBlank (21, 66) writeCursor (20, 68) writes (right(*deckUp, 2)) end #writeDeckUp # w r i t e I n f o # Displays a new short string (up to 12 printing characters) in the # officially approved information area of the screen. # An empty string results in clearing the area and restoring normal attributes. procedure writeInfo (s) if \invisible then return writeCursor (16, 65) writes (Vnormal, VclearEOL) if *s ~= 0 then writes (s) end #writeInfo # c l i c k # Make a quick sound to accompany card transfers procedure click () local x if (\clicking) & (\isDOS) then { x := InPort (16r61) OutPort (16r61, 3) OutPort (16r61, x) } end #click # 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 ()) # if s == ESC then fail procedure getCmdChar () local s s := getch () #get command character if s == "\0" then { #non-ASCII character getch () #discard keyboard scan code 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 # c o m p l a i n # Let the boob know he done something wrong # The short beep produced under isDOS is not as annoying as the normal beeeeep. procedure complain () local x writeInfo (Vbold || "INVALID") if \clicking then if \isDOS then { x := InPort (16r61) every 1 to 22 do OutPort (16r61, 3) OutPort (16r61, x) } else writes (Vbell) end #complain # r e f r e s h S c r e e n # Re-write entire screen. procedure refreshScreen () if \invisible then return initScreen () every writeStack (-1 to -7 by -1) every writePile (1 to 4) writeDeckDown () writeDeckUp () end #refreshScreen -- PAPER: Norman Azadian; Ascom AG; Belpstrasse 23; 3000 Berne 14; Switzerland X.400: naz@hslrswi.hasler UUCP: ...{uunet,ukc,mcvax,...}!cernvax!hslrswi!naz VOICE: +41 31 63 2178 BITNET: naz%hslrswi.UUCP@cernvax.BITNET Brought to you by Super Global Mega Corp .com