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 / hr.icn < prev    next >
Text File  |  2000-07-29  |  25KB  |  794 lines
  1. ############################################################################
  2. #
  3. #    File:     hr.icn
  4. #
  5. #    Subject:  Program to play horse-race game
  6. #
  7. #    Author:   Chris Tenaglia
  8. #
  9. #    Date:     August 14, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program implements a horse-race game.
  18. #
  19. ############################################################################
  20. #
  21. #  Links:  random
  22. #
  23. ############################################################################
  24.  
  25. link random
  26.  
  27. global horse1, horse2, horse3,                 # horses are global
  28.        players, money, bets,                   # player info is global
  29.        vectors, leg1,  leg2, leg3,             # track parameters
  30.        front,   back,  y1  , y2,   y3,         # horse parameters
  31.        pos1,    pos2,  pos3,                   # more horse parameters
  32.        oops1,   oops2, oops3                   # accident flags
  33.  
  34. procedure main()
  35.    local winner
  36.  
  37. banner()
  38. if ready() == "no" then stop("Game Over.")     # ask if ready
  39. players := get_players()                       # get player name list
  40. money   := table(100)                          # everyone starts w/$100
  41. randomize()
  42.  
  43. repeat
  44.   {
  45.   if ready() == "no" then break
  46.   writes("\e[2J\e[H")                          # clear old junk off screen
  47.   repeat                                       # choose 3 fresh horses
  48.     {
  49.     horse1  := get_horse()                     # get first horse list
  50.     horse2  := get_horse()                     # get second horse list
  51.     horse3  := get_horse()                     # get third horse list
  52.     if horse1[1] == horse2[1] |                # disallow duplicates
  53.        horse2[1] == horse3[1] |                # because a horse can't
  54.        horse3[1] == horse1[1] then next        # race against himself
  55.     break                                      # continue...
  56.     }
  57.   bets   := get_bet()                          # bets initially 0
  58.   winner := race()                             # race the horses, get winner
  59.   pay(winner)                                  # pay winner(s) if any
  60.   }
  61. done()
  62. end
  63. #
  64. #
  65. # ask if ready to play the game, return yes or no
  66. #
  67. procedure ready()
  68.   local answer
  69.   static  pass,sh
  70.   initial {
  71.           pass := 0                # initialize pass counter
  72.           sh   := "\e[1;7m \e[0;1;33;44m"   # initialize a shadow for box
  73.           }
  74.   if (pass +:= 1) = 1 then
  75.     {
  76.     writes("\e[0;1;33;44m\e[2J\e[H")
  77.     write(" +----------------------------------------------------------+")
  78.     write(" |          WELCOME TO ICON PARK VIRTUAL RACE TRACK         |",sh)
  79.     write(" |                                                          |",sh)
  80.     write(" |   The following game allow one or more players to bet on |",sh)
  81.     write(" |   three Cyberspace steeds that will run on an ANSI VT100 |",sh)
  82.     write(" |   dirt track. Of course the bets are Cyberspace dollars, |",sh)
  83.     write(" |   which have no real world value. We use only the oldest |",sh)
  84.     write(" |   escape sequences to condition the track surface, which |",sh)
  85.     write(" |   may not appeal  to TEK crowds,  and I'm sure some fans |",sh)
  86.     write(" |   will hurl curses. C'est la vie!                        |",sh)
  87.     write(" |                                                          |",sh)
  88.     write(" +----------------------------------------------------------+",sh)
  89.     write("  \e[1;7m                                                            \e[0;1;33;44m")
  90.     write("")
  91.     write("    Are we ready to enter our names, and begin?")
  92.     answer := map(input("Enter yes or no:"))
  93.     if answer[1] == "n" then return "no" else return "yes"
  94.     }
  95.   end
  96.  
  97. #
  98. # get the names of the players
  99. #
  100. procedure get_players()
  101.   local counter, people, who
  102.   people  := []
  103.   counter := 1
  104.   write("\nEnter Player Names. Enter blank when done.")
  105.   repeat
  106.     {
  107.     (who := input("  Player #" || counter || ":")) | break
  108.     if trim(who) == "" then break
  109.     put(people,who)
  110.     counter +:= 1
  111.     }
  112.   if *people < 1 then stop("Not enough players. Need at least one.")
  113.   return people
  114.   end
  115. #
  116. #
  117. # build a horse list structure
  118. #
  119. procedure get_horse()
  120.   local odds, pic, tmp
  121.   static  stable,photos
  122.   initial {
  123.           photos := [pick1(),pick2(),pick3(),
  124.                      pick4(),pick5(),pick6()]
  125.           stable := ["Incredible Hash",
  126.                      "Random Number",
  127.                      "Floppy Crash",
  128.                      "RAM Dump",
  129.                      "Programmers Nightmare",
  130.                      "Spaghetti Code",
  131.                      "Infinite Loop",
  132.                      "User Blues",
  133.                      "See Plus Plus",
  134.                      "Press Any Key",
  135.                      "Paradigm Shift",
  136.                      "Adricks' Abend",
  137.                      "Client Server",
  138.                      "Network Storm",
  139.                      "Mr. Cobol",
  140.                      "Forgotten Password",
  141.                      "Hackers' Byte",
  142.                      "Chad Hollerith",
  143.                      "ASCII Question",
  144.                      "EBCDIC Object",
  145.                      "Recursive Instance",
  146.                      "RunTime Error"]
  147.           }
  148.   name := ?stable                      # pick a horse name
  149.   odds := 1 + real((?30)/real(10.0))   # calculate the odds
  150.   tmp  := ?photos                      # choose a photo file
  151.   pic  := [name,odds]
  152.   every put(pic,!tmp)
  153.   return pic
  154.   end
  155. #
  156. #
  157. # obtain bets from the players
  158. #
  159. procedure get_bet()
  160.   local items, person, summation, wager
  161.   (&features == "MS-DOS") | writes("\e[?25h")
  162.   bets := table(0)
  163.   summation    := 0
  164.   every person := !players do
  165.     {
  166.     if money[person] <= 0 then next
  167.     summation +:= money[person]
  168.     write("\e[2J\e[H",person,", enter your bet. You have $",money[person],"\n")
  169.     write("1. ",left(horse1[1],32)," odds = ",horse1[2]," : 1")
  170.     write("2. ",left(horse2[1],32),"   \"  = ",horse2[2]," : 1")
  171.     write("3. ",left(horse3[1],32),"   \"  = ",horse3[2]," : 1")
  172.     write("\n       (enter 5 on 2 for $5 on ",horse2[1],")\n")
  173.     wager := trim(map(input("Your decision : ")))
  174.     if wager == "" then next
  175.     if wager == "q" then done()
  176.     items := parse(wager,' ')
  177.     if not(numeric(items[1])) | not(numeric(items[3])) then
  178.       {
  179.       input("\7Wager Improperly Entered. No wager made. Press RETURN")
  180.       next
  181.       }
  182.     if (*items ~= 3)              |
  183.        (items[2] ~== "on")        |
  184.        (items[1] > money[person]) |
  185.        (1 > items[3] > 3)         then
  186.          {
  187.          input("\7Wager Improperly Entered. No wager made. Press RETURN")
  188.          next
  189.          }
  190.     bets[person]   := wager
  191.     money[person] -:= parse(wager,' ')[1]
  192.     }
  193.   if summation = 0 then
  194.     {
  195.     write("\e[2J\e[HICON PARK CYBER RACE TRACK BIDS YOU ADIEU\n")
  196.     write("It looks you'all lost all your money here today.")
  197.     write("Take it easy now. Better luck next time")
  198.     stop("Game Over")
  199.     }
  200.   input("Done Entering Wagers. Press RETURN to Continue.")
  201.   end
  202. #
  203. #
  204. # determine the victor and pay out winnings. if there is a tie
  205. # then nothing gets payed out (bets are refunded)
  206. #
  207. procedure pay(victor)
  208.   local check, i, msg, nag, odds, pair, player, prize, test
  209.   local wager, winner, winnings, y
  210.  
  211.   (&features == "MS-DOS") | writes("\e[?25h")          # turn on cursor again
  212.   winner := case victor of
  213.     {
  214.     1 : horse1
  215.     2 : horse2
  216.     3 : horse3
  217.     default : ["tie"]
  218.     }
  219.   if victor = 4 then
  220.     {
  221.     writes(at(12,14),"All The Steeds Fell Down! Too many injuries!\7")
  222.     wait(1)
  223.     writes(at(12,14),"The judges are coming to a decision....")
  224.     wait(2)
  225.     writes(at(12,14),"All bets will be refunded. Sorry.......")
  226.     check := sort(bets,1)
  227.     every pair := !check do
  228.       {
  229.       name         := pair[1]
  230.       wager        := pair[2]
  231.       odds         := winner[2]
  232.       prize        := parse(bets[name],' ')[1]
  233.       money[name] +:= integer(prize)
  234.       }
  235.     test := map(input(at(13,1) || "Press RETURN to Continue."))
  236.     if test[1] == "q" then done()
  237.     return
  238.     }
  239.   if winner[1] == "tie" then
  240.     {
  241.     writes(at(12,14),"It was a photo finish!\7")
  242.     wait(1)
  243.     writes(at(12,14),"The judges are coming to a decision....")
  244.     wait(2)
  245.     writes(at(12,14),"All bets will be refunded. Sorry.......")
  246.     check := sort(bets,1)
  247.     every pair := !check do
  248.       {
  249.       name         := pair[1]
  250.       wager        := pair[2]
  251.       odds         := winner[2]
  252.       prize        := parse(bets[name],' ')[1]
  253.       money[name] +:= integer(prize)
  254.       }
  255.     test := map(input(at(13,1) || "Press RETURN to Continue."))
  256.     if test[1] == "q" then done()
  257.     return
  258.     } else {
  259.     writes(at(12,14),winner[1],"   WINS!                              ")
  260.     writes(at(victor+21,1),"\e[1;5;33;44m",victor,"  : ",left(winner[1],32),"\e[0;1;33;44m")
  261.     wait(2)
  262.     writes(at(12,14),"And now for a closeup of the winner....")
  263.     wait(3)
  264.     y := 4
  265.     writes(at((y+:=1),40),"+",repl("-",35),"+")
  266.     every i := 3 to *winner do
  267.       writes(at((y+:=1),40),"|",left(winner[i],35),"|")
  268.     writes(at(y,40),"+",repl("-",35),"+")
  269.     }
  270.   check := sort(bets,1)
  271.   every pair := !check do
  272.     {
  273.     name  := pair[1]
  274.     wager := pair[2]
  275.     nag   := parse(wager,' ')[3]
  276.     if nag = victor then
  277.       {
  278.       odds         := winner[2]
  279.       prize        := odds * parse(bets[name],' ')[1]
  280.       money[name] +:= integer(prize)
  281.       }
  282.     }
  283.   test := map(input(at(13,1) || "Press RETURN to Continue."))
  284.   if test[1] == "q" then
  285.     {
  286.     #
  287.     # evaluate results from todays races
  288.     #
  289.     write("\e[2J\e[HICON PARK CYBER RACE TRACK BIDS YOU ADIEU\n")
  290.     write("    We all started with $100. And now for the results...\n")
  291.     every player := !players do
  292.       {
  293.       winnings := money[player]
  294.       if winnings < 100 then msg := "Looks like you lost some $ today."
  295.       if winnings = 0   then msg := "Lost all your money today."
  296.       if winnings = 100 then msg := "Looks like you broke even today."
  297.       if winnings > 100 then msg := "Looks like a winner. Stop at the IRS window please!"
  298.       if winnings > 300 then msg := "Wow! The IRS agent will escort you to his office."
  299.       write("OK ",player,", you have $",winnings," left. ",msg)
  300.       }
  301.     }
  302.   end
  303. #
  304. #
  305. # run the race and return the winning horse # (1, 2, or 3)
  306. #
  307. procedure race()
  308.   local diamx, diamy, finish, inc1, inc2, inc3, platform, result
  309.  
  310.   vectors := draw_track()
  311.   #
  312.   # set up starting positions
  313.   #
  314.   pos1  := 1
  315.   pos2  := 1
  316.   pos3  := 1
  317.   
  318.   #
  319.   # select lanes to run in
  320.   #
  321.   y1    := 5
  322.   y2    := 7
  323.   y3    := 9
  324.  
  325.   #
  326.   # set up for the legs of the race, 3 normal + 3 accidentsal
  327.   #
  328.   leg1  := 1
  329.   leg2  := 1
  330.   leg3  := 1
  331.  
  332.   #
  333.   # set up accident multipliers
  334.   #
  335.   oops1 := 1
  336.   oops2 := 1
  337.   oops3 := 1
  338.  
  339.   #
  340.   # designate vector milestones, marking legs of the race
  341.   #
  342.   diamx   := 68
  343.   diamy   := 10
  344.   finish  := 146
  345.   
  346.   #
  347.   # design horse bodies from different vantage points
  348.   #
  349.   front    := list(6)
  350.   front[1] := "#^"
  351.   front[2] := "V"
  352.   front[3] := "#'  "
  353.   front[4] := "_X  "
  354.   front[5] := "X"
  355.   front[6] := "_X  "
  356.  
  357.   back     := list(6)
  358.   back[1]  := "  `#"
  359.   back[2]  := "/"
  360.   back[3]  := "^#"
  361.   back[4]  := "  X_"
  362.   back[5]  := "X"
  363.   back[6]  := "  X_"
  364.  
  365.   #
  366.   # display the starting positions and fire the gun to begin!
  367.   #
  368.     (&features == "MS-DOS") | writes("\e[?25l")         # deactivate cursor
  369.     writes(at(5,1),back[1],1,front[1])                  # horse 1
  370.     writes(at(22,6),left(horse1[1],32)," / ",horse1[2]," : 1 / ")
  371.  
  372.     writes(at(7,1),back[1],2,front[1])                  # horse 2
  373.     writes(at(23,6),left(horse2[1],32)," / ",horse2[2]," : 1 / ")
  374.  
  375.     writes(at(9,1),back[1],3,front[1])                  # horse 3
  376.     writes(at(24,6),left(horse3[1],32)," / ",horse3[2]," : 1 / ")
  377.  
  378.     writes(at(12,14),"ON YOUR MARK...  GET SET...")
  379.     wait(1)
  380.     writes("\7",at(12,14),"AND THEY'RE OFF!                           ")
  381.   #
  382.   # run the race
  383.   #
  384.   repeat
  385.     {
  386.     case &features of
  387.         {
  388.         "VMS" : delay(500)                    # delay 10,000/sec VMS
  389.         "UNIX": delay(50)                     # delay  1,000/sec UNIX
  390.         default : platform := &features       # not on DOS icon 8.5
  391.         }
  392.     inc1    := ?3-1 * oops1
  393.     if oops1 = 1 then pos1 +:= inc1
  394.  
  395.     inc2    := ?3-1 * oops2
  396.     if oops2 = 1 then pos2 +:= inc2
  397.  
  398.     inc3    := ?3-1 * oops3
  399.     if oops3 = 1 then pos3 +:= inc3
  400.  
  401.     if (pos1 >= 68) & (leg1 = 1) then leg1 := 2
  402.     if (pos2 >= 68) & (leg2 = 1) then leg2 := 2
  403.     if (pos3 >= 68) & (leg3 = 1) then leg3 := 2
  404.     if (pos1 > 78)  & (leg1 = 2) then leg1 := 3
  405.     if (pos2 > 78)  & (leg2 = 2) then leg2 := 3
  406.     if (pos3 > 78)  & (leg3 = 2) then leg3 := 3
  407.  
  408.     if (78 >= pos1 >= 68) then y1 +:= inc1
  409.     if (78 >= pos2 >= 68) then y2 +:= inc2
  410.     if (78 >= pos3 >= 68) then y3 +:= inc3
  411.  
  412.     if y1 > 15 then y1 := 15
  413.     if y2 > 17 then y2 := 17
  414.     if y3 > 19 then y3 := 19
  415.  
  416.     result := accident()
  417.     display()
  418.  
  419.     if result = 0 then  return 4
  420.     if (pos1 >= finish) & (pos2 < finish) & (pos3 < finish) then return 1
  421.     if (pos2 >= finish) & (pos1 < finish) & (pos3 < finish) then return 2
  422.     if (pos3 >= finish) & (pos1 < finish) & (pos2 < finish) then return 3
  423.  
  424.     if (pos1 >= finish) & (pos2 >= finish) |
  425.        (pos2 >= finish) & (pos3 >= finish) |
  426.        (pos3 >= finish) & (pos1 >= finish) then return 0
  427.     }
  428.   end
  429. #
  430. #
  431. # display the horses at different legs of the race
  432. #
  433. procedure display()
  434.   static  oldy1,oldy2,oldy3,blanks
  435.   initial {
  436.           oldy1 := 5
  437.           oldy2 := 7
  438.           oldy3 := 9
  439.           blanks:= "       "
  440.           }
  441.   if leg1 = 2 then
  442.     {
  443.     writes(at(5,68),blanks)
  444.     writes(at(oldy1,68),blanks)
  445.     if y1 < 12 then
  446.       {
  447.       writes(at(y1,68),"  ",back[2],"  ")
  448.       writes(at(y1+1,68),"  1  ")
  449.       writes(at(y1+2,68),"  ",front[2],"  ")
  450.       }
  451.     oldy1 := y1
  452.     } else {
  453.     writes(at(y1,vectors[pos1]),back[leg1],1,front[leg1])
  454.     }
  455.  
  456.   if leg2 = 2 then
  457.     {
  458.     writes(at(7,68),blanks)
  459.     writes(at(oldy2,68),blanks)
  460.     if y2 < 14 then
  461.       {
  462.       writes(at(y2,69),"  ",back[2],"  ")
  463.       writes(at(y2+1,69),"  2  ")
  464.       writes(at(y2+2,69),"  ",front[2],"  ")
  465.       }
  466.     oldy2 := y2
  467.     } else {
  468.     writes(at(y2,vectors[pos2]),back[leg2],2,front[leg2])
  469.     }
  470.   if leg3 = 2 then
  471.     {
  472.     writes(at(9,68),blanks)
  473.     writes(at(oldy3,68),blanks)
  474.     if y3 < 16 then
  475.       {
  476.       writes(at(y3,70),"  ",back[2],"  ")
  477.       writes(at(y3+1,70),"  3  ")
  478.       writes(at(y3+2,70),"  ",front[2],"  ")
  479.       }
  480.     oldy3 := y3
  481.     } else {
  482.     writes(at(y3,vectors[pos3]),back[leg3],3,front[leg3])
  483.     }
  484.   end
  485.  
  486. #
  487. # simulate rare freakish accidents
  488. #
  489. procedure accident()
  490.   if (?2000 = 111) & (leg1 ~= 2) then
  491.     {
  492.     oops1 := 0
  493.     leg1 +:= 3
  494.     write(at(13,1),"\7OH NO! ",horse1[1]," fell down!")
  495.     }
  496.  
  497.   if (?2000 = 111) & (leg2 ~= 2) then
  498.     {
  499.     oops2 := 0
  500.     leg2 +:= 3
  501.     write(at(13,1),"\7OH NO! ",horse2[1]," fell down!")
  502.     }
  503.  
  504.   if (?2000 = 111) & (leg3 ~= 2) then
  505.     {
  506.     oops3 := 0
  507.     leg3 +:= 3
  508.     write(at(13,1),"\7OH NO! ",horse3[1]," fell down!")
  509.     }
  510.  
  511.   if oops1+oops2+oops3 = 0 then return 0
  512.   return 1
  513.   end
  514. #                             
  515. #
  516. # return a list of track x positions
  517. #
  518. procedure draw_track()
  519.   local i, offset
  520.   static  pavement
  521.   initial pavement := copy(mktrack())
  522.   offset     := []
  523.   every i    := 1  to 68       do put(offset,i)
  524.   every i    := 1  to 10       do put(offset,72)
  525.   every i    := 68 to 1  by -1 do put(offset,i)
  526.   offset  |||:= [1,1,1,1,1]
  527.   writes("\e[0;1;33;44m\e[2J\e[H")
  528.   every i := 1 to *pavement do
  529.     writes(at(i,1),pavement[i])
  530.   return offset
  531.   end
  532.  
  533. #
  534. # generate racing track
  535. #
  536. procedure mktrack()
  537.   local track
  538.   track := []
  539.   put(track,"                 WELCOME TO ICON PARK CYBER STEED RACE TRACK")
  540.   put(track,"")
  541.   put(track,"___________________________________________________________________________")
  542.   put(track,"                                                                           \\")
  543.   put(track,"`#1#^                                                                       \\")
  544.   put(track,"                                                                             \\")
  545.   put(track,"`#2#^                                                                         \\")
  546.   put(track,"                                                                              |")
  547.   put(track,"`#3#^                                                                         |")
  548.   put(track,"_________________________________________________________________             |")
  549.   put(track,"                                                                 \\            |")
  550.   put(track,"Commentator:                                                      |           |")
  551.   put(track,"                                                                  |           |")
  552.   put(track,"_________________________________________________________________/            |")
  553.   put(track,"                                                                              |")
  554.   put(track,"                                                                              |")
  555.   put(track,"                                                                              /")
  556.   put(track,"                                                                             /")
  557.   put(track,"                                                                            /")
  558.   put(track,"                                                                           /")
  559.   put(track,"__________________________________________________________________________/")
  560.   put(track,"1  :")
  561.   put(track,"2  :")
  562.   put(track,"3  :")
  563.   return track
  564.   end
  565.  
  566. #
  567. # final wrapup procedure, summarize winnings
  568. #
  569. procedure done()
  570.   local msg, player, winnings
  571.   write("\e[2J\e[HICON PARK CYBER RACE TRACK BIDS YOU ADIEU\n")
  572.   write("    We all started with $100. And now for the results...\n")
  573.   every player := !players do
  574.     {
  575.     winnings := money[player]
  576.     if winnings < 100 then msg := "\nLooks like you lost some $ today.\n"
  577.     if winnings = 100 then msg := "\nLooks like you broke even today.\n"
  578.     if winnings > 100 then msg := "\nLooks like a winner. Stop at the IRS window please!\n"
  579.     write("OK ",player,", you have $",winnings," left. ",msg)
  580.     }
  581.   stop("Game Over.")
  582.   end
  583. #
  584. #
  585. # generate horse 1 portraite
  586. #
  587. procedure pick1()
  588.   local pferd
  589.  
  590.   pferd := []
  591.   put(pferd,"")
  592.   put(pferd,"                  /\\")
  593.   put(pferd,"              |||/  \\")
  594.   put(pferd,"             /       \\\\")
  595.   put(pferd,"            /        \\\\\\\\")
  596.   put(pferd,"           /   o     \\\\\\\\\\\\")
  597.   put(pferd,"          /          \\\\\\\\\\\\")
  598.   put(pferd,"         /           \\\\\\\\\\\\\\")
  599.   put(pferd,"        /               \\\\\\\\\\\\")
  600.   put(pferd,"       O     /-----\\     \\\\\\\\\\___")
  601.   put(pferd,"        \\/|_/       \\")
  602.   put(pferd,"                     \\")
  603.   put(pferd,"                      \\")
  604.   put(pferd,"                       \\")
  605.   return pferd
  606.   end
  607.  
  608. #
  609. # generate horse 2 portraite
  610. #
  611. procedure pick2()
  612.   local pferd
  613.  
  614.   pferd := []
  615.   put(pferd,"")
  616.   put(pferd,"                  /\\")
  617.   put(pferd,"              |||/  \\")
  618.   put(pferd,"             /       \\\\")
  619.   put(pferd,"            /  /     \\\\\\\\")
  620.   put(pferd,"           /   O      \\\\\\\\")
  621.   put(pferd,"          /            \\\\\\\\")
  622.   put(pferd,"         /              \\\\\\\\")
  623.   put(pferd,"        /                \\\\\\\\")
  624.   put(pferd,"        o     /----\\\\      \\\\\\\\\\___")
  625.   put(pferd,"         \\/|_/     \\\\")
  626.   put(pferd,"                   \\\\\\")
  627.   put(pferd,"                      \\")
  628.   put(pferd,"                       \\")
  629.   put(pferd,"")
  630.   return pferd
  631.   end
  632.  
  633. #
  634. # generate horse 3 portraite
  635. #
  636. procedure pick3()
  637.   local pferd
  638.  
  639.   pferd := []
  640.   put(pferd,"                    \\/          ")
  641.   put(pferd,"                   \\  /|||      ")
  642.   put(pferd,"                 \\       /      ")
  643.   put(pferd,"               \\\\        /     ")
  644.   put(pferd,"              \\\\\\     o   /   ")
  645.   put(pferd,"             \\\\\\\\          / ")
  646.   put(pferd,"            \\\\\\\\\\           / ")
  647.   put(pferd,"          \\\\\\\\\\               / ")
  648.   put(pferd,"      ___\\\\\\\\    \\\\-----/     O")
  649.   put(pferd,"                  \\\\       /_|/\\ ")
  650.   put(pferd,"                 \\               ")
  651.   put(pferd,"                \\                ")
  652.   put(pferd,"               \\                 ")
  653.   put(pferd,"")
  654.   return pferd
  655.   end
  656. #
  657. #
  658. # generate horse 4 portraite
  659. #
  660. procedure pick4()
  661.   local pferd
  662.  
  663.   pferd := []
  664.   put(pferd,"                    \\/           ")
  665.   put(pferd,"                   \\\\//|||       ")
  666.   put(pferd,"                 \\\\       /     ")
  667.   put(pferd,"               \\\\\\     /  /    ")
  668.   put(pferd,"              \\\\\\      O   /   ")
  669.   put(pferd,"             \\\\\\            /  ")
  670.   put(pferd,"            \\\\\\              / ")
  671.   put(pferd,"           \\\\\\                /")
  672.   put(pferd,"      ___\\\\\\      \\----/     o")
  673.   put(pferd,"                   \\\\     /_|/\\  ")
  674.   put(pferd,"                  \\\\             ")
  675.   put(pferd,"                 \\               ")
  676.   put(pferd,"                \\                ")
  677.   put(pferd,"")
  678.   return pferd
  679.   end
  680.  
  681. #
  682. # generate horse 5 portraite
  683. #
  684. procedure pick5()
  685.   local pferd
  686.  
  687.   pferd := []
  688.   put(pferd,"         /\\     /\\")
  689.   put(pferd,"        |  |||||  |")
  690.   put(pferd,"        |    |||  |")
  691.   put(pferd,"        |     ||  |\\")
  692.   put(pferd,"        |         | \\")
  693.   put(pferd,"        | 0     0 | |\\")
  694.   put(pferd,"        |         |  |\\")
  695.   put(pferd,"        |         |   |\\")
  696.   put(pferd,"        |         |    |\\")
  697.   put(pferd,"        |         |     |")
  698.   put(pferd,"        |  o   o  |\\")
  699.   put(pferd,"        \\  ____  /  \\")
  700.   put(pferd,"         \\______/    \\")
  701.   put(pferd,"")
  702.   return pferd
  703.   end
  704.  
  705. #
  706. # generate horse 6 portraite
  707. #
  708. procedure pick6()
  709.   local pferd
  710.  
  711.   pferd := []
  712.   put(pferd,"                 \\/     \\/ ")
  713.   put(pferd,"                |  |||||  |  ")
  714.   put(pferd,"                |  |||    |  ")
  715.   put(pferd,"               \\|  ||     | ")
  716.   put(pferd,"              \\ |         | ")
  717.   put(pferd,"             \\| | 0     0 | ")
  718.   put(pferd,"            \\|  |         | ")
  719.   put(pferd,"           \\|   |         | ")
  720.   put(pferd,"          \\|    |         | ")
  721.   put(pferd,"          |     |         |  ")
  722.   put(pferd,"               \\|  o   o  | ")
  723.   put(pferd,"              \\  /  ____  \\")
  724.   put(pferd,"             \\    /______\\ ")
  725.   put(pferd,"")
  726.   return pferd
  727.   end
  728.  
  729. procedure banner()
  730.   write("\e[0;1;33;44m\e[2J\e[H")
  731.   write("###############################################################################")
  732.   write("                                                                               ")
  733.   write("      ****  *   *  ****   *****  ****         ****  *****  *****  *****  ****  ")
  734.   write("    *       * *   *   *  *      *   *       *        *    *      *      *   *  ")
  735.   write("   *        *    ****   ***    ****         ***     *    ***    ***    *   *   ")
  736.   write("  *        *    *   *  *      * *             *    *    *      *      *   *    ")
  737.   write("  ****    *    ****   *****  *  *        ****     *    *****  *****  ****      ")
  738.   write("                                                                               ")
  739.   write("                         ****     *     ****  ***  *   *   ****                ")
  740.   write("                        *   *   * *   *       *   **  *  *                     ")
  741.   write("                       ****   *****  *       *   * * *  *  ***                 ")
  742.   write("                      * *    *   *  *       *   *  **  *   *                   ")
  743.   write("                     *  *   *   *   ****  ***  *   *   ****                    ")
  744.   write("                                                                               ")
  745.   write("   \e[1;5m               by tenaglia\e[0;1;33;44m")
  746.   write("                                                                               ")
  747.   write("###############################################################################")
  748.   wait(3)
  749.   end
  750. #
  751. #
  752. # move cursor to specified screen position
  753. #
  754. procedure at(row,column)
  755.   return "\e[" || row || ";" || column || "f"
  756.   end
  757.  
  758. #
  759. # procedure to wait n seconds
  760. #
  761. procedure wait(n)
  762.   local now, secs
  763.  
  764.   secs := &clock[-2:0] + n
  765.   if secs > 60 then secs -:= 60
  766.   repeat
  767.     {
  768.     now := &clock[-2:0]
  769.     if now = secs then break
  770.     }
  771.   return
  772.   end
  773.  
  774. #
  775. # this procedure prompts for an input string
  776. #
  777. procedure input(prompt)
  778.   writes(prompt)
  779.   return read()
  780.   end
  781.  
  782. #
  783. # parse a string into a list with respect to a delimiter
  784. #
  785. procedure parse(line,delims)
  786.   local tokens
  787.   static chars
  788.   chars  := &cset -- delims
  789.   tokens := []
  790.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  791.   return tokens
  792.   end
  793.  
  794.