home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / bj.icn < prev    next >
Text File  |  2000-07-29  |  11KB  |  364 lines
  1. ############################################################################
  2. #
  3. #    File:     bj.icn
  4. #
  5. #    Subject:  Program to play blackjack game
  6. #
  7. #    Author:   Chris Tenaglia (modified by Richard L. Goerwitz)
  8. #
  9. #    Date:     December 12, 1995
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.7
  18. #
  19. ############################################################################
  20. #  
  21. #  Simple but fun blackjack game.  The original version was for an ANSI
  22. #  screen.  This version has been modified to work with the UNIX termcap
  23. #  database file.
  24. #
  25. ############################################################################
  26. #
  27. #  Links: itlib, random
  28. #
  29. #  Requires: UNIX
  30. #
  31. ############################################################################
  32.  
  33. link itlib
  34. link random
  35.  
  36. global deck, message, lookup,
  37.        user_money,  host_money,
  38.        user_hand,   host_hand
  39.  
  40. procedure main(param)
  41.   local bonus, user_points, host_points
  42.   user_money := integer(param[1]) | 3 ; host_money := user_money
  43.   write(screen("cls"))
  44. #  Most terminals don't do oversize characters like this.
  45. #  write(screen("cls"),"               ",screen("top"),screen("hinv"),
  46. #        "BLACK JACK",screen("norm"))
  47. #  write("               ",screen("bot"),screen("hinv"),
  48. #        "BLACK JACK",screen("norm"))
  49.   write(screen("high"),"  ---- BLACK JACK ----",screen("norm"))
  50.   bonus := 0
  51.   repeat
  52.     {
  53.     if not any('y',(map(input(at(1,3) || "  " || screen("under") ||
  54.                    "Play a game? y/n :"|| screen("norm") || " " ||
  55.                    screen("eeol")))[1])) then break
  56.     every writes(at(1,3|4),screen("eeos"))
  57.     display_score()
  58.     deck    := xshuffle()
  59.     message := ""
  60.     user_hand := []          ; host_hand := []
  61.     put(user_hand,pop(deck)) ; put(host_hand,pop(deck))
  62.     put(user_hand,pop(deck)) ; put(host_hand,pop(deck))
  63.     user_points := first(host_hand[1])
  64.     if user_points > 21 then
  65.       {
  66.       writes(at(1,13),user_points," points. You went over. You lose.")
  67.       user_money -:= 1 ; host_money +:= 1 + bonus ; bonus := 0
  68.       display_score()
  69.       next
  70.       }
  71.     display_host(2)
  72.     host_points := second(user_points)
  73.     if host_points > 21 then
  74.       {
  75.       writes(at(48,22), right(host_points || " points. " || 
  76.         (&host ? tab(find(" ")|0)) || " went over.", 28))
  77.       writes(at(1,13),screen("hiblink"),"You win.",screen("norm"))
  78.       host_money -:= 1 ; user_money +:= 1 + bonus ; bonus := 0
  79.       display_score()
  80.       next
  81.       }
  82.     if host_points = user_points then
  83.       {
  84.       writes(at(1,22),screen("hiblink"),"It's a draw at ",user_points,
  85.             ". The ANTY goes to bonus.",screen("norm"))
  86.       bonus +:= 2 ; host_money -:= 1 ; user_money -:= 1
  87.       display_score()
  88.       next
  89.       }
  90.     writes(at(1,12),user_points," points for user.")
  91.     writes(at(1,14),host_points," points for ",&host ? tab(find(" ")|0))
  92.     if user_points < host_points then
  93.       {
  94.       write(at(1,22),screen("hiblink"),&host ? tab(find(" ")|0)," wins.",
  95.             screen("norm"),screen("eeol"))
  96.       user_money -:= 1 ; host_money +:= 1 + bonus ; bonus := 0
  97.       display_score()
  98.       next
  99.       } else {
  100.       writes(at(1,12),screen("hiblink"),"You win.",screen("norm"),
  101.          screen("eeol"))
  102.       user_money +:= 1 + bonus ; host_money -:= 1 ; bonus := 0
  103.       display_score()
  104.       next
  105.       }
  106.     }
  107.   write(screen("clear"))
  108.   end
  109.  
  110. #
  111. # THIS PROCEDURE ALLOWS THE USER TO PLAY AND TAKE HITS
  112. #
  113. procedure first(host_card)
  114.   local points
  115.  
  116.   display_user()
  117.   display_host(1)
  118.   points := value(user_hand)   # just in case
  119.   writes(at(1,9),"(",points,") ")
  120.   repeat
  121.     if any('hy',map(input(at(1,23) || "Hit ? y/n : " || screen("eeol")))) then
  122.       {
  123.       put(user_hand,pop(deck))
  124.       display_user()
  125.       if (points := value(user_hand)) > 21 then return points
  126.       writes(at(1,9),"(",points,") ")
  127.       } else break
  128.   (points > 0) | (points := value(user_hand))
  129.   writes(at(1,9),"(",points,") ")
  130.   write(at(55,11),right("You stay with "||points,20))
  131.   return points
  132.   end
  133.  
  134. #
  135. # THIS SECOND PROCEDURE IS THE HOST PLAYING AGAINST THE USER
  136. #
  137. procedure second(ceiling)
  138.   local stop_at, points
  139.  
  140.   static limits
  141.   initial limits := [14,14,15,15,19,16,17,18]
  142.   stop_at := ?limits ; points := 0
  143.   until (points := value(host_hand)) > stop_at do
  144.     {
  145.     if points > ceiling then return points
  146.     writes(at(1,19),"(",points,") ")
  147. #    write(at(1,22),screen("eeol"),&host," will take a hit.",screen("eeol"))
  148.     write(at(1,22),screen("eeol"),&host ? tab(find(" ")|0),
  149.       " will take a hit.",screen("eeol"))
  150.     put(host_hand,pop(deck))
  151.     display_host(2)
  152.     }
  153.   (points > 0) | (points := value(host_hand))
  154.   writes(at(1,19),"(",points,") ")
  155.   return points
  156.   end
  157.  
  158. #
  159. # THIS ROUTINE DISPLAYS THE CURRENT SCORE
  160. #
  161. procedure display_score()
  162.   writes(screen("nocursor"))
  163.   writes(screen("dim"),at(1,7),"Credits",screen("norm"))
  164.   writes(screen("high"),at(1,8),right(user_money,7),screen("norm"))
  165.   writes(screen("dim"),at(1,17),"Credits",screen("norm"))
  166.   writes(screen("high"),at(1,18),right(host_money,7),screen("norm"))
  167.   end
  168. #
  169. # THIS PROCEDURE EVALUATES THE POINTS OF A HAND. IT TRIES TO MAKE THEM
  170. # AS HIGH AS POSSIBLE WITHOUT GOING OVER 21.
  171. #
  172. procedure value(sample)
  173.   local hand, possible, sum, card, i, best_score, gone_over_score, score
  174.  
  175.   hand     := copy(sample)
  176.   possible := []
  177.   repeat
  178.     {
  179.     sum := 0
  180.     every card := !hand do sum +:= lookup[card[1]]
  181.     put(possible,sum)
  182.     if not ("A" == (!hand)[1]) then break else
  183.       every i := 1 to *hand do {
  184.         if hand[i][1] == "A" then {
  185.           hand[i][1] := "a"
  186.           break
  187.         }  
  188.       }
  189.     }
  190.   best_score := 0
  191.   gone_over_score := 100
  192.   every score := !possible do {
  193.     if score > 21
  194.     then gone_over_score >:= score
  195.     else best_score <:= score
  196.   }
  197.   return (0 ~= best_score) | gone_over_score
  198.   end
  199.  
  200. #
  201. # THIS ROUTINE DISPLAYS THE USER HAND AND STATUS
  202. #
  203. procedure display_user()
  204.   local x, y, card
  205.  
  206.   writes(screen("nocursor"),at(1,6),screen("hinv"),"USER",screen("norm"))
  207.   x := 10 ; y := 4
  208.   every card := !user_hand do
  209.     {
  210.     display(card,x,y)
  211.     x +:= 7
  212.     }
  213.   end
  214.  
  215. #
  216. # THIS ROUTINE DISPLAYS THE HOST HAND AND STATUS
  217. #
  218. procedure display_host(flag)
  219.   local x, y, card
  220.  
  221.   writes(screen("nocursor"),at(1,16),screen("hinv"),
  222.      &host ? tab(find(" ")|0),screen("norm"))
  223.   x := 10 ; y := 14 ; /flag := 0
  224.   every card := !host_hand do
  225.     {
  226.     if (flag=1) & (x=10) then card := "XX"
  227.     display(card,x,y)
  228.     x +:= 7
  229.     }
  230.   end
  231.  
  232. #
  233. # THIS ROUTINE DISPLAYS A GIVEN CARD AT A GIVEN X,Y SCREEN LOCATION
  234. #
  235. procedure display(card,x,y)
  236.     local all, j, shape
  237.  
  238.     all := [] ; j := y
  239.     if find(card[2],"CS") then card := screen("hinv") || card || screen("norm")
  240. #    shape := [at(x,(j+:=1)) || screen("gchar") || "lqqqqqqqk"]
  241.     shape := [at(x,(j+:=1)) || screen("inv") || "         " || screen("norm")]
  242.     put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
  243.     " " || card || "    " || screen("inv") || " " || screen("norm"))
  244.     put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
  245.     "       " || screen("inv") || " " || screen("norm"))
  246.     put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
  247.     "       " || screen("inv") || " " || screen("norm"))
  248.     put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
  249.     "       " || screen("inv") || " " || screen("norm"))
  250. #    put(shape,at(x,(j+:=1)) || "x       x")
  251. #    put(shape,at(x,(j+:=1)) || "x       x")
  252.     put(shape,at(x,(j+:=1)) || screen("inv") || " " || screen("norm") ||
  253.     "    " || card || " " || screen("inv") || " " || screen("norm"))
  254. #    put(shape,at(x,(j+:=1)) || "mqqqqqqqj" || screen("nchar"))
  255.     put(shape,at(x,(j+:=1)) || screen("inv") || "         " || screen("norm"))
  256.     put(all,shape)
  257.     x +:= 14
  258.   while shape := pop(all) do every writes(!shape)
  259.   end
  260.  
  261. #
  262. # THIS ROUTINE SHUFFLES THE CARD DECK
  263. #
  264. procedure xshuffle()
  265.   static faces, suits
  266.   local cards, i
  267.   initial {
  268.           randomize()
  269.           faces   := ["2","3","4","5","6","7","8","9","T","J","Q","K","A"]
  270.           suits   := ["D","H","C","S"]
  271.           lookup  := table(0)
  272.           every i := 2 to 9 do insert(lookup,string(i),i)
  273.           insert(lookup,"T",10)
  274.           insert(lookup,"J",10)
  275.           insert(lookup,"Q",10)
  276.           insert(lookup,"K",10)
  277.           insert(lookup,"A",11)
  278.           insert(lookup,"a",1)
  279.           }
  280.   cards   := []
  281.   every put(cards,!faces || !suits)
  282.   every i := *cards to 2 by -1 do cards[?i] :=: cards[i]
  283.   return cards
  284.   end
  285.  
  286. #
  287. # THIS ROUTINE PARSES A STRING WITH RESPECT TO SOME DELIMITER
  288. #
  289. procedure parse(line,delims)
  290.   local tokens
  291.  
  292.   static chars
  293.   chars  := &cset -- delims
  294.   tokens := []
  295.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  296.   return tokens
  297.   end
  298.  
  299. #
  300. # THIS ROUTINE PROMPTS FOR INPUT AND RETURNS A STRING
  301. #
  302. procedure input(prompt)
  303.   writes(screen("cursor"),prompt)
  304.   return read()
  305.   end
  306.  
  307.  
  308. #
  309. # THIS ROUTINE SETS THE VIDEO OUTPUT ATTRIBUTES FOR VT102 OR LATER
  310. # COMPATIBLE TERMINALS.
  311. #
  312. procedure screen(attr)
  313.   initial if getval("ug"|"mg"|"sg") > 0 then
  314.     er("screen","oops, magic cookie terminal!",34)
  315.   return {
  316.     case attr of
  317.       {
  318.       "cls"  : getval("cl")
  319.       "clear": getval("cl")
  320.       # HIGH INTENSITY & INVERSE
  321.       "hinv" : (getval("md") | "") || getval("so")
  322.       "norm" : (getval("se") | "") || (getval("me") | "") || (getval("ue")|"")
  323.       # LOW INTENSITY VIDEO
  324.       "dim"  : getval("mh"|"me"|"se")
  325.       "blink": getval("mb"|"md"|"so")
  326.       # HIGH INTENSITY BLINKING
  327.       "hiblink": (getval("md") | "") || getval("mb") | getval("so")
  328.       "under": getval("us"|"md"|"so")
  329.       "high" : getval("md"|"so"|"ul")
  330.       "inv"  : getval("so"|"md"|"ul")
  331.       # ERASE TO END OF LINE
  332.       "eeol" : getval("ce")
  333.       # ERASE TO START OF LINE
  334.       "esol" : getval("cb")
  335.       # ERASE TO END OF SCREEN
  336.       "eeos" : getval("cd")
  337.       # MAKE CURSOR INVISIBLE
  338.       "cursor": getval("vi"|"CO") | ""
  339.       # MAKE CURSOR VISIBLE
  340.       "nocursor": getval("ve"|"CF") | ""
  341. #      # START ALTERNATE FONT      <- very non-portable
  342. #      "gchar": getval("as") | ""
  343. #      # END ALTERNATE FONT
  344. #      "nchar": getval("ae") | ""
  345. #      "light": return "\e[?5h"     # LIGHT COLORED SCREEN
  346. #      "dark" : return "\e[?5l"     # DARK  COLORED SCREEN
  347. #      "80"   : return "\e[?3l"     # 80    COLUMNS ON SCREEN
  348. #      "132"  : return "\e[?3h"     # 132   COLUMNS ON SCREEN
  349. #      "smooth": return "\e[?4h"    # SMOOTH SCREEN SCROLLING
  350. #      "jump" : return "\e[?4l"     # JUMP   SCREEN SCROLLING
  351.       default : er("screen",attr||" is just too weird for most terminals",34)
  352.       } | er("screen","I just can't cope with your terminal.",35)
  353.     }
  354.   end
  355.  
  356. #
  357. # THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION
  358. #
  359. procedure at(x,y)
  360. #  return "\e[" || y || ";" || x || "f"
  361.   return igoto(getval("cm"),x,y)
  362.   end
  363.  
  364.