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