home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / misc / euphoria / lw.ex < prev    next >
Encoding:
Text File  |  1994-04-19  |  7.2 KB  |  324 lines
  1.                ------------------
  2.                -- Language War --
  3.                ------------------
  4. -- See doc\langwar.doc for a complete description of how to play.
  5. -- See doc\langwar.sum for a brief summary of the commands.
  6.  
  7. -- This is based on a space war game developed in 1979 for the TRS-80
  8. -- by David A. Craig with assistance from Robert H. Craig.
  9. -- This program is being placed in the public domain.
  10. -- No rights are reserved - you are encouraged to modify it
  11. -- and redistribute it, along with the Public Domain Edition of Euphoria.
  12. -- The sound and graphics are a bit dated. We're sure you can do 
  13. -- much better! 
  14.  
  15. -- without type_check -- game runs fine with full type_check
  16.  
  17.  
  18. type file_number(integer x)
  19.     return x >= -1
  20. end type
  21.  
  22. file_number sum_no
  23. object line
  24.  
  25. include graphics.e
  26. include vars.e
  27. include screen.e
  28.  
  29. -- display summary file
  30. sum_no = open("lw.sum", "r")
  31. if sum_no != -1 then
  32.     set_bk_color(BLUE)
  33.     set_color(WHITE)
  34.     clear_screen()
  35.     while 1 do
  36.     line = gets(sum_no)
  37.     if atom(line) then
  38.         exit
  39.     end if
  40.     puts(1, line)
  41.     end while
  42. end if
  43.  
  44. include sched.e
  45. include soundeff.e
  46. include display.e
  47. include damage.e
  48. include weapons.e
  49. include commands.e
  50. include emove.e
  51. include enemy.e
  52.  
  53. type energy_source(integer x)
  54.     return x = G_PL or x = G_BS
  55. end type
  56.  
  57. procedure setpb(pb_row row, energy_source stype)
  58. -- initialize a planet or a base
  59.  
  60.     g_index r, c, ri, ci
  61.     h_coord x, xi
  62.     v_coord y, yi
  63.     boolean unique
  64.  
  65.     -- choose a quadrant
  66.     pb[row][P_TYPE] = stype
  67.     r = rand(G_SIZE)
  68.     c = rand(G_SIZE)
  69.     pb[row][P_QR] = r
  70.     pb[row][P_QC] = c
  71.     
  72.     pb[row][P_EN] = (rand(250) + rand(250)) * 50 + 30000
  73.     galaxy[r][c][stype] = galaxy[r][c][stype] + 1
  74.  
  75.     -- choose a position in the quadrant
  76.     while TRUE do
  77.     if stype = G_PL then
  78.         x = rand(HSIZE - length(PLANET_MIDDLE) - 2*length(EUPHORIA_L)) 
  79.         + length(EUPHORIA_L)
  80.         y = rand(VSIZE-4) + 1
  81.     else
  82.         x = rand(HSIZE - length(BASE) - 2*length(EUPHORIA_L))  
  83.         + length(EUPHORIA_L)
  84.         y = rand(VSIZE-3) + 1
  85.         pb[row][P_POD] = 1
  86.         pb[row][P_TORP] = rand(7) + 8
  87.     end if
  88.     pb[row][P_X] = x
  89.     pb[row][P_Y] = y
  90.  
  91.     -- make sure position doesn't overlap another planet or base
  92.     unique = TRUE
  93.     for i = 1 to row - 1 do
  94.         ri = pb[i][P_QR]
  95.         ci = pb[i][P_QC]
  96.         if r = ri and c = ci then
  97.         -- in the same quadrant
  98.         xi = pb[i][P_X]
  99.         if x >= xi - length(PLANET_MIDDLE) and
  100.            x <= xi + length(PLANET_MIDDLE) then
  101.             yi = pb[i][P_Y]
  102.             if y >= yi-2 and y <= yi+2 then
  103.             unique = FALSE
  104.             exit
  105.             end if
  106.         end if
  107.         end if
  108.     end for
  109.     if unique then
  110.         exit
  111.     end if
  112.     end while
  113. end procedure
  114.  
  115.  
  116. procedure init()
  117. -- initialize
  118.     g_index r, c
  119.  
  120.     wrap(0)
  121.     ship = {{EUPHORIA_L, EUPHORIA_R}, -- Euphoria
  122.        {KRC_L,       KRC_R},      -- K&R C
  123.        {ANC_L,       ANC_R},      -- ANSI C
  124.        {CPP_L,       CPP_R},      -- C++
  125.        {BASIC_L,     BASIC_R},    -- BASIC
  126.        {FORTRAN_L,   FORTRAN_R}}  -- FORTRAN
  127.  
  128.     otype = {"EUPHORIA",
  129.          "C",
  130.          "ANSI C",
  131.          "C++",
  132.          "BASIC",
  133.          "FORTRAN",
  134.          "PLANET",
  135.          "BASE"}
  136.  
  137.     -- initial waiting time between activations
  138.     wait = {0.45, -- KEYB
  139.         0.67, -- EMOVE
  140.          6.0, -- LIFE
  141.     INACTIVE, -- DEAD
  142.     INACTIVE, -- BSTAT
  143.     INACTIVE, -- FIRE
  144.          2.3, -- MOVE
  145.     INACTIVE, -- MESSAGE
  146.     INACTIVE, -- DAMAGE
  147.     INACTIVE} -- ENTER
  148.  
  149.     -- early activation tolerance
  150.     eat = {1.0,   -- KEYB
  151.        .04,   -- EMOVE
  152.        .20,   -- LIFE
  153.        .30,   -- DEAD
  154.        .30,   -- BSTAT
  155.        .20,   -- FIRE
  156.        .30,   -- MOVE
  157.        .20,   -- MESSAGE
  158.        .10,   -- DAMAGE
  159.        .30}   -- ENTER
  160.  
  161.     tcb = repeat(2, NTASKS)
  162.     tcb[TASK_EMOVE] = 1 -- task emove scheduled to go first
  163.     sched(TASK_BSTAT, 1 + rand(300))
  164.     sched(TASK_ENTER, 1 + rand(60))
  165.     sched(TASK_DAMAGE, INACTIVE)
  166.     sched(TASK_DEAD, INACTIVE)
  167.     scanon = FALSE
  168.  
  169.     -- blank lower portion
  170.     set_bk_color(WHITE)
  171.     set_color(BLACK)
  172.     for i = WARP_LINE to WARP_LINE + 2 do
  173.     position(i, 1)
  174.     puts(CRT, repeat(' ', 80))
  175.     end for
  176.  
  177.     -- set number of objects in the galaxy
  178.     nobj = {1,  -- Euphoria (must be 1)
  179.        40,  -- regular K&R C ships
  180.         9,  -- ANSI C ships
  181.         1,  -- C++
  182.        50,  -- BASIC ships
  183.        20,  -- Fortran ships
  184.        NPLANETS,  -- planets
  185.        NBASES}    -- bases
  186.  
  187.     quadrant[EUPHORIA][Q_TYPE] = G_EU
  188.     quadrant[EUPHORIA][Q_DEFL] = 3
  189.     ds = repeat(DEFLECTOR, 3)
  190.     quadrant[EUPHORIA][Q_TORP] = 5
  191.     ts = repeat(TORPEDO, 5)
  192.     ps = {POD}
  193.     quadrant[EUPHORIA][Q_EN] = 30000
  194.     wlimit = 5
  195.     curwarp = 4
  196.     curdir = 1
  197.     exi = 3
  198.     eyi = 0
  199.     truce_broken = FALSE
  200.     qrow = 1
  201.     qcol = 1
  202.     stext()
  203.     nchars = 0
  204.  
  205.     -- initialize galaxy array
  206.     galaxy = repeat(repeat(repeat(0, NTYPES), G_SIZE), G_SIZE)
  207.     for i = G_KRC to G_FOR do
  208.     for j = 1 to nobj[i] do
  209.         r = rand(G_SIZE)
  210.         c = rand(G_SIZE)
  211.         galaxy[r][c][i] = galaxy[r][c][i] + 1
  212.     end for
  213.     end for
  214.  
  215.     -- initialize planet/base array
  216.     for i = 1 to nobj[G_BS] do
  217.     setpb(i, G_BS)
  218.     end for
  219.     for i = nobj[G_BS]+1 to PROWS do
  220.     setpb(i, G_PL)
  221.     end for
  222.     esymr = EUPHORIA_R
  223.     esyml = EUPHORIA_L
  224.     esym = EUPHORIA_R
  225.     quadrant[EUPHORIA][Q_X] = HSIZE - length(esym) + 1
  226.     quadrant[EUPHORIA][Q_Y] = VSIZE
  227.     quadrant[EUPHORIA][Q_UNDER] = "   "
  228.     qrow = pb[1][P_QR]
  229.     qcol = gmod(pb[1][P_QC] - 1)
  230.     bstat = TRUCE
  231.     reptime[1..NSYS] = 0
  232.     ndmg = 0
  233.     wait[TASK_DAMAGE] = INACTIVE
  234.     shuttle = FALSE
  235.     set_bk_color(BLACK)
  236.     set_color(WHITE)
  237.     BlankScreen(TRUE)  -- blank upper portion
  238. end procedure
  239.  
  240. global procedure trek()
  241. -- Language Wars Main Routine
  242.  
  243.     natural nk
  244.  
  245.     init()
  246.     current_task = TASK_FIRE
  247.     if level = 'n' then
  248.         wait[TASK_FIRE] = 3.0 -- novice level
  249.     else
  250.     wait[TASK_FIRE] = 1.0 -- expert level
  251.     end if
  252.     gameover = FALSE
  253.  
  254.     while not gameover do
  255.     sched(current_task, wait[current_task])
  256.     current_task = next_task()
  257.  
  258.     if current_task = TASK_KEYB then
  259.         task_keyb()
  260.  
  261.     elsif current_task = TASK_FIRE then
  262.         task_fire()
  263.  
  264.     elsif current_task = TASK_EMOVE then
  265.         task_emove()
  266.  
  267.     elsif current_task = TASK_LIFE then
  268.         task_life()
  269.  
  270.     elsif current_task = TASK_MOVE then
  271.         task_move()
  272.  
  273.     elsif current_task = TASK_MESSAGE then
  274.         task_message()
  275.  
  276.     elsif current_task = TASK_DAMAGE then
  277.         task_dmg()
  278.  
  279.     elsif current_task = TASK_ENTER then
  280.         task_enter()
  281.  
  282.     elsif current_task = TASK_DEAD then
  283.         task_dead()
  284.  
  285.     elsif current_task = TASK_BSTAT then
  286.         task_bstat()
  287.  
  288.     end if
  289.     end while
  290.  
  291.     nk = c_remaining()
  292.     set_msg()
  293.     if nk = 0 then
  294.     victory_sound()
  295.     set_color(RED+BLINKING)
  296.     puts(CRT, "PROGRAMMERS THROUGHOUT THE GALAXY ARE EUPHORIC!!!!!")
  297.     delay(15)
  298.     else
  299.     printf(CRT, "%d C SHIPS REMAIN. YOU ARE DEAD. C RULES THE GALAXY!", nk)
  300.     delay(5)
  301.     end if
  302. end procedure
  303.  
  304. puts(1, "    Type n for novice level: ")
  305. init_delay() -- uses up some time - do it here
  306.  
  307. sequence in 
  308. in = gets(0)
  309. if find('n', in) then
  310.     level = 'n'
  311. else
  312.     level = 'e'    
  313. end if
  314.  
  315. cursor(NO_CURSOR)
  316. trek()
  317. position(25, 1)
  318. cursor(UNDERLINE_CURSOR)
  319. set_bk_color(BLACK)
  320. set_color(WHITE)
  321. puts(CRT, '\n')
  322.  
  323.  
  324.