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