home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #31 / NN_1992_31.iso / spool / comp / lang / icon / 559 next >
Encoding:
Text File  |  1992-12-28  |  10.0 KB  |  333 lines
  1. Newsgroups: comp.lang.icon
  2. Path: sparky!uunet!mercury.hsi.com!mlfarm!cs.arizona.edu!icon-group
  3. Date: 25 Dec 1992 08:44:16 -0600
  4. From: Chris Tenaglia - 257-8765 <TENAGLIA@mis.mcw.edu>
  5. Subject: Happy Holidays
  6. Message-ID: <01GSQ5VICQ6A8WW2L6@mis.mcw.edu>
  7. Organization: Medical College of Wisconsin (Milwaukee, WI)
  8. Lines: 323
  9.  
  10.  
  11. Hello Colleagues!
  12.  
  13. Chris (kringle) Tenaglia is leaving a little goodie to put under your
  14. directory tree. Here is a cheap attempt at a Missile Command game.
  15. I've run it under Icon V8.7 under VMS, Unix, and V8.5 under MS-DOS.
  16.  
  17. Here are some things you'll need to know. There is a delay() procedure
  18. that keeps the game running at a steady pace. delay() is built into
  19. V8.7 on VMS and unix. Under DOS you'll need to roll your own.
  20. Funny thing is that VMS delay is 1000 per second and unix is different
  21. (maybe 100 per second). Also it does that horrible thing known as
  22. ansi escape sequences. Also to play use 7, 8, and 9 to launch a
  23. missile. 7 is leftward, 8 is straight, and 9 is right. A bug in the
  24. ultrix version (kbhit() and getch()) requires double pressing the buttons.
  25. I think q will quit the game early.
  26.  
  27. Have Fun!
  28.  
  29. Chris Tenaglia (System Manager) |  "The past explained,
  30. Medical College of Wisconsin    |   the future fortold, 
  31. 8701 W. Watertown Plank Rd.     |   the present largely appologized for."
  32. Milwaukee, WI 53226             |   Organon to The Doctor
  33. (414)257-8765                   |     
  34. tenaglia@mis.mcw.edu
  35.  
  36. #
  37. # FILE : MC.ICN
  38. # DESC : SORT OF A MISSILE COMMAND GAME
  39. #
  40. # UPDATE           BY            WHAT
  41. # 17-NOV-1992      TENAGLIA      BEGIN INITIAL WRITE
  42. #
  43. global bonus,             # bonus missile threshhold
  44.        score,             # number of missiles shot down
  45.        munitions,         # munitions supply (# of defensive missiles)
  46.        missilef,          # whether enemy missile is launched flag
  47.        missilex,          # x position of enemy missile
  48.        missiley,          # y position of enemy missile
  49.        incm,              # x increment of enemy missile
  50.        abmf,              # whether defensive missile fired flag
  51.        abmx,              # x position of defensive missile
  52.        abmy,              # y position of defensive missile
  53.        abmix              # x increment of defensive missle
  54.  
  55. procedure main()
  56.   infrastructure()        # set up defaults, globals, and munitions
  57.   banner()                # output initial banner
  58.   repeat
  59.     {
  60.     draw_base()           # initially draw base
  61.     repeat
  62.       {
  63.       enemy_launch()      # possible enemy attack
  64.       friendly_fire()     # possible defensive attack
  65.       animate()           # draw action if any
  66.       sense_status()      # sense status
  67.       delay(1000)         # pace the game
  68.       }
  69.     }
  70.   stop("\7\e[0m",at(12,24),"Game Over. \e[5mInsert another quarter.\e[0m\e[?25h\e=")
  71.   end
  72.  
  73. #
  74. # set up all the initial defaults
  75. #
  76. procedure infrastructure()
  77.   bonus    := 22
  78.   missilef := 0
  79.   missilex := 0
  80.   missiley := 0
  81.   incm     := 0
  82.   abmf     := 0
  83.   abmx     := 0
  84.   abmy     := 0
  85.   score    := 0
  86.   &random  := map(&clock,":","0")
  87.   munitions:= 10 + ?5
  88.   end
  89.  
  90. #
  91. # draw the initial environment
  92. #
  93. procedure draw_base()
  94.   write("\e[?25l\e>\e[?5l\e[0;1;33;44m\e[2J\e[H                 S.D.I. OUTPOST        [TACTICAL SITUATION DISPLAY]")
  95.   writes(at(23,1),repl("#",79))
  96.   writes(at(24,1),repl("=",79))
  97.   writes(at(24,39),"/ \\",at(23,40),"^")
  98.   writes(at(24,5)," Missiles Left : ",munitions," ")
  99.   writes(at(24,60)," Score : ",score," ")
  100.   end
  101.  
  102. #
  103. # check and occasionally launch a missile
  104. #
  105. procedure enemy_launch()
  106.   (?50 = 33) | fail
  107.   if missilef = 1 then fail
  108.   missilex := 1
  109.   missiley := 1 + ?10
  110.   missilef := 1
  111.   incm     := ?3                                                  
  112.   end
  113.  
  114. #
  115. # coordinate launch of defensive missiles
  116. #
  117. procedure friendly_fire()
  118.   kbhit() | fail
  119.   press := getch()
  120.   if abmf = 1 then
  121.     {
  122.     case press of
  123.       {
  124.       "1" | "4" | "7" | "l" | "L" : abmix := -2
  125.       "2" | "5" | "8" | "s" | "S" : abmix :=  0
  126.       "3" | "6" | "9" | "r" | "R" : abmix :=  2
  127.       "q" | "Q" | "\e"                  : stop("\e[2J\e[H")
  128.       default : writes("\7")
  129.       }
  130.     } else {
  131.     ambf :=  1
  132.     abmx := 40
  133.     abmy := 22
  134.     case press of
  135.       {
  136.       "1" | "4" | "7" | "l" | "L" : abmix := -2
  137.       "2" | "5" | "8" | "s" | "S" : abmix :=  0
  138.       "3" | "6" | "9" | "r" | "R" : abmix :=  2
  139.       "q" | "Q" | "\e": stop("\e[2J\e[H",at(12,24),"Game Over. \e[5mInsert another quarter.\e[0m\e[?25h\e=")
  140.       default : {
  141.                 writes("\7")
  142.                 fail
  143.                 }
  144.       }
  145.     if munitions <= 0 then
  146.       stop(at(12,24),"Game Over. \e[5mInsert Another Quarter!\e[0m\e=\e[?25h")
  147.     munitions -:= 1
  148.     abmf       := 1
  149.     writes(at(24,5)," Missiles Left : ",munitions," ")
  150.     }
  151.   end
  152.  
  153. #
  154. # fly the missiles
  155. #
  156. procedure animate()
  157.  
  158.   static  old_abmx,
  159.           old_abmy,
  160.           old_missilex,
  161.           old_missiley
  162.  
  163.   initial {
  164.           old_abmx     := 0
  165.           old_abmy     := 0
  166.           old_missilez := 0
  167.           old_missiley := 0
  168.           }
  169.  
  170.   #
  171.   # move the defensive missile if launched
  172.   #
  173.   if abmf = 1 then
  174.     {
  175.     writes(at(abmy,abmx),"*",at(old_abmy,old_abmx)," ")
  176.     old_abmx := abmx
  177.     old_abmy := abmy
  178.     abmx    +:= abmix
  179.     abmy    -:= 1
  180.     if abmy < 2 then
  181.       {
  182.       writes(at(old_abmy,old_abmx)," ")
  183.       abmf := 0
  184.       abmx := 0
  185.       abmy := 0
  186.       }
  187.     }
  188.  
  189.   #
  190.   # move the offensive missile if launched
  191.   #
  192.   if missilef = 1 then
  193.     {
  194.     writes(at(missiley,missilex),"   =>")
  195.     missilex +:= incm
  196.     if missilex > 76 then
  197.       {
  198.       writes(at(missiley,76),"\e[K")
  199.       missilef := 0                                 
  200.       missilex := 0
  201.       missiley := 0
  202.       incm     := 0
  203.       }
  204.     }
  205.   end
  206.  
  207. #
  208. # sense for hits and handle explosions
  209. #
  210. procedure sense_status()
  211.   static  junk
  212.   initial junk := ["=%!*@",
  213.                    "%^&(!",
  214.                    "(@^$^",
  215.                    "*)@%$",
  216.                    "@&%^(#"]
  217.   if missilef=1 & abmf=1 then
  218.     {
  219.     if abmy=missiley & (missilex < abmx < missilex+6) then
  220.       {
  221.       every 1 to 3 do
  222.         {
  223.         writes(at(abmy,abmx-4),"\e[?5h<<<<>>>>")  ; delay(2000)  # reverse screen
  224.         writes(at(abmy,abmx-4),"\e[?5l>>>><<<<")  ; delay(2000)  # normal  screen
  225.         }
  226.       every j := abmy to 22 do
  227.         {
  228.         writes(at(j,abmx-3),?junk)
  229.         delay(1000)
  230.         }
  231.       if abmx > 67 then abmx := 67   # handle edge of screen problem
  232.       writes(at(23,abmx-3),"********")              ; delay(1000)
  233.       writes(at(22,abmx-3),"\e[?5h||||||||")        ; delay(1000)
  234.       writes(at(21,abmx-5),"\e[?5l. . . . . . .")   ; delay(1000)
  235.       every j := 20 to abmy by -1 do writes(at(j,abmx-6),"\e[K")
  236.       wait(2)
  237.       score   +:= incm * (15 - missiley)
  238.       if score > bonus then
  239.         {
  240.         writes(at(12,30),"\7\e[5mBONUS MISSILE EARNED!\e[0m")
  241.         bonus     +:= 33
  242.         munitions +:= 1
  243.         delay(30000)
  244.         }
  245.       draw_base()
  246.       abmf     := 0
  247.       abmx     := 0
  248.       abmy     := 0
  249.       missilef := 0
  250.       missilex := 0
  251.       missiley := 0
  252.       }
  253.     }
  254.   end
  255.                     
  256. #
  257. # output initial banner for this game
  258. #             
  259. procedure banner()
  260.   write("\e[0;1;33;44m\e[2J\e[H                                                                 ")
  261.   write("                                                                 ")
  262.   write("###############################################################################")
  263.   write("                                                                 ")
  264.   write("             ***   *   *  *****  ****    ***    ****  *****      ")
  265.   write("           *   *  *   *    *    *   *  *   *  *        *         ")
  266.   write("          *   *  *   *    *    ****   *   *   ***     *          ")
  267.   write("         *   *  *   *    *    *      *   *      *    *           ")
  268.   write("         ***    ***     *    *       ***   ****     *            ")
  269.   write("                                                                 ")
  270.   write("                ****          ****          ***                  ")
  271.   write("              *              *   *          *                    ")
  272.   write("              ****          *   *          *                     ")
  273.   write("                 *         *   *          *                      ")
  274.   write("            ****   **     ****   **     ***  **                  ")
  275.   write("                                                                 ")
  276.   write("                                                                 ")
  277.   write("###############################################################################")
  278.   wait(3)
  279.   end
  280.  
  281. #
  282. # move cursor to specified screen position
  283. #
  284. procedure at(row,column)
  285.   return "\e[" || row || ";" || column || "f"
  286.   end
  287.  
  288. #
  289. # procedure to wait n seconds
  290. #
  291. procedure wait(n)
  292.   delay(n * 10000)
  293.   return
  294. ##  secs := &clock[-2:0] + n
  295. ##  if secs > 58 then secs -:= 60
  296. ##  repeat
  297. ##    {
  298. ##    now := &clock[-2:0]
  299. ##    if now > secs then break
  300. ##    }
  301. ##  return
  302.   end
  303.  
  304. ##################################################################
  305. #                                                                #
  306. # THIS PROCEDURE PULLS ALL THE ELEMENTS (TOKENS) OUT OF A LINE   #
  307. # BUFFER AND RETURNS THEM IN A LIST. A VARIABLE NAMED 'CHARS'    #
  308. # CAN BE STATICALLY DEFINED HERE OR GLOBAL. IT IS A CSET THAT    #
  309. # CONTAINS THE VALID CHARACTERS THAT CAN COMPOSE THE ELEMENTS    #
  310. # ONE WISHES TO EXTRACT.                                         #
  311. #                                                                #
  312. ##################################################################
  313. procedure parse(line,delims)
  314.   static chars
  315.   chars  := &cset -- delims
  316.   tokens := []
  317.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  318.   return tokens
  319.   end
  320.  
  321. ##################################################################
  322. #                                                                #
  323. # THIS PROCEDURE IS TERRIBLY HANDY IN PROMPTING AND GETTING      #
  324. # AN INPUT STRING                                                #
  325. #                                                                #
  326. ##################################################################
  327. procedure input(prompt)
  328.   writes(prompt)
  329.   return read()
  330.   end
  331.  
  332.  
  333.