home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / euphor10.zip / LW.EX < prev    next >
Text File  |  1993-06-14  |  7KB  |  315 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. -- This is a space war game developed in 1979 for the TRS-80
  7. -- by David A. Craig with assistance from Robert H. Craig.
  8. -- This program is being placed in the public domain.
  9. -- No rights are reserved - you are encouraged to modify it
  10. -- and redistribute it, along with the Public Domain Edition of Euphoria.
  11. -- The sound and graphics are admittedly poor. We're sure you can do much
  12. -- better! You will see that some names have been changed externally, (but
  13. -- not in the code). We did this to avoid getting in trouble with
  14. -- Paramount Pictures.
  15.  
  16. type file_number(integer x)
  17.     return x >= -1
  18. end type
  19.  
  20. file_number sum_no
  21. object line
  22.  
  23. include graphics.e
  24. include vars.e
  25. include screen.e
  26.  
  27. sum_no = open("lw.sum", "r")
  28. if sum_no != -1 then
  29.     set_bk_color(BLUE)
  30.     set_color(WHITE)
  31.     clear_screen()
  32.     while 1 do
  33.     line = gets(sum_no)
  34.     if atom(line) then
  35.         exit
  36.     end if
  37.     puts(1, line)
  38.     end while
  39. end if
  40.  
  41. include sched.e
  42. include soundeff.e
  43. include display.e
  44. include damage.e
  45. include weapons.e
  46. include commands.e
  47. include emove.e
  48. include enemy.e
  49.  
  50. type energy_source(integer x)
  51.     return x = G_PL or x = G_BS
  52. end type
  53.  
  54. procedure setpb(pb_row row, energy_source stype)
  55. -- initialize a planet or a base
  56.  
  57.     g_index r, c, ri, ci
  58.     h_coord x, xi
  59.     v_coord y, yi
  60.     positive_atom en
  61.     boolean unique
  62.  
  63.     -- choose a quadrant
  64.     r = rand(G_SIZE)
  65.     c = rand(G_SIZE)
  66.     pb[row][P_QR] = r
  67.     pb[row][P_QC] = c
  68.     pb[row][P_EXIST] = NEVER_DOCKED
  69.     en = (rand(256) + rand(256)) * 32 + 25000
  70.     pb[row][P_EN] = en
  71.     g[r][c][stype] = g[r][c][stype] + 1
  72.  
  73.     -- choose a position in the quadrant
  74.     while TRUE do
  75.     if stype = G_PL then
  76.         x = rand(HSIZE - length(PLANET_MIDDLE) - 2*length(ENTERPRISE_L)) 
  77.         + length(ENTERPRISE_L)
  78.         y = rand(VSIZE-4) + 1
  79.     else
  80.         x = rand(HSIZE - length(BASE) - 2*length(ENTERPRISE_L))  
  81.         + length(ENTERPRISE_L)
  82.         y = rand(VSIZE-3) + 1
  83.         pb[row][P_POD] = 1
  84.         pb[row][P_TORP] = rand(7) + 8
  85.     end if
  86.     pb[row][P_X] = x
  87.     pb[row][P_Y] = y
  88.  
  89.     -- make sure position doesn't overlap another planet or base
  90.     unique = TRUE
  91.     for i = 1 to row - 1 do
  92.         ri = pb[i][P_QR]
  93.         ci = pb[i][P_QC]
  94.         if r = ri and c = ci then
  95.         -- in the same quadrant
  96.         xi = pb[i][P_X]
  97.         if x >= xi-length(PLANET_MIDDLE) and
  98.            x <= xi + length(PLANET_MIDDLE) then
  99.             yi = pb[i][P_Y]
  100.             if y >= yi-2 and y <= yi+2 then
  101.             unique = FALSE
  102.             exit
  103.             end if
  104.         end if
  105.         end if
  106.     end for
  107.     if unique then
  108.         exit
  109.     end if
  110.     end while
  111. end procedure
  112.  
  113.  
  114. procedure init()
  115. -- initialize
  116.     g_index r, c
  117.  
  118.     ship = {{ENTERPRISE_L,    ENTERPRISE_R},      -- Euphoria
  119.        {S_KLINGON_L, S_KLINGON_R},     -- C
  120.        {B_KLINGON_L, B_KLINGON_R},    -- ANSI C
  121.        {J_KLINGON_L, J_KLINGON_R},    -- C++
  122.        {ROMULAN_L, ROMULAN_R},  -- BASIC
  123.        {THOLIAN_L, THOLIAN_R}}      -- FORTRAN
  124.  
  125.     otype = {"EUPHORIA",
  126.          "C",
  127.          "ANSI C",
  128.          "C++",
  129.          "BASIC",
  130.          "FORTRAN",
  131.          "PLANET",
  132.          "BASE"}
  133.  
  134.     wait = {0.45, -- KEYB
  135.            0, -- EMOVE
  136.          6.0, -- LIFE
  137.            0, -- DEAD
  138.            0, -- RSTAT
  139.            0, -- FIRE
  140.          2.3, -- MOVE
  141.            0, -- UREM
  142.            0, -- DAMAGE
  143.            0} -- ENTER
  144.     wait[TASK_EMOVE] = .67
  145.     eat = {1.0, .04, .10, .80, .30, .20, .30, .10, .80, .30}
  146.     tcb = repeat(2, NTASKS)
  147.     tcb[TASK_EMOVE] = 1 -- task emove scheduled to go first
  148.     sched(TASK_RSTAT, 1 + rand(100))
  149.     sched(TASK_ENTER, 1 + rand(60))
  150.     sched(TASK_UREM, 0)
  151.     sched(TASK_DAMAGE, 0)
  152.     sched(TASK_DEAD, 0)
  153.     scanon = FALSE
  154.     set_bk_color(0)
  155.     set_color(7)
  156.  
  157.     -- blank lower portion
  158.     set_bk_color(7)
  159.     set_color(0)
  160.     for i = WARP_LINE to WARP_LINE + 2 do
  161.     position(i, 1)
  162.     puts(CRT, repeat(' ', 80))
  163.     end for
  164.  
  165.     -- set number of objects in the galaxy
  166.     nobj = {1,  -- Enterprise (must be 1)
  167.        40,  -- regular Klingons
  168.         9,  -- big Klingons
  169.         1,  -- Jumbo Klingon
  170.        50,  -- Romulans
  171.        20,  -- Tholians
  172.         6,  -- planets
  173.         3}  -- bases
  174.     f[ENTERPRISE][F_TYPE] = G_EN
  175.     f[ENTERPRISE][F_DEFL] = 3
  176.     ds = repeat(DEFLECTOR, 3)
  177.     f[ENTERPRISE][F_TORP] = 5
  178.     ts = repeat(TORPEDO, 5)
  179.     ps = {}
  180.     f[ENTERPRISE][F_EN] = 30000
  181.     wlimit = 5
  182.     curwarp = 4
  183.     truce_broken = FALSE
  184.     qrow = 1
  185.     qcol = 1
  186.     stext()
  187.     nchars = 0
  188.  
  189.     -- initialize galaxy array
  190.     g = repeat(repeat(repeat(0, NTYPES), G_SIZE), G_SIZE)
  191.     for i = G_SK to G_TH do
  192.     for j = 1 to nobj[i] do
  193.         r = rand(G_SIZE)
  194.         c = rand(G_SIZE)
  195.         g[r][c][i] = g[r][c][i] + 1
  196.     end for
  197.     end for
  198.  
  199.     -- initialize planet/base array
  200.     for i = 1 to nobj[G_BS] do
  201.     setpb(i, G_BS)
  202.     end for
  203.     for i = nobj[G_BS]+1 to PROWS do
  204.     setpb(i, G_PL)
  205.     end for
  206.     exi = 3
  207.     eyi = 0
  208.     esymr = ENTERPRISE_R
  209.     esyml = ENTERPRISE_L
  210.     esym = ENTERPRISE_R
  211.     f[ENTERPRISE][F_X] = HSIZE - length(esym) + 1
  212.     f[ENTERPRISE][F_Y] = VSIZE
  213.     f[ENTERPRISE][F_UNDER] = "   "
  214.     qrow = pb[1][P_QR]
  215.     qcol = gmod(pb[1][P_QC] - 1)
  216.     rstat = TRUCE
  217.     reptime[1..NSYS] = 0
  218.     ndmg = 0
  219.     wait[TASK_DAMAGE] = 0
  220.     gal = FALSE
  221.     set_bk_color(0)
  222.     set_color(7)
  223.     BlankScreen(TRUE)  -- blank upper portion
  224. end procedure
  225.  
  226. global procedure trek()
  227. -- Startrek Main Routine
  228.  
  229.     positive_int nk
  230.  
  231.     init()
  232.     current_task = TASK_FIRE
  233.     wait[TASK_FIRE] = 1.0  -- difficulty level
  234.     gameover = FALSE
  235.  
  236.     while not gameover do
  237.     sched(current_task, wait[current_task])
  238.     current_task = next_task()
  239.  
  240.     if current_task = TASK_KEYB then
  241.         t1keyb()
  242.  
  243.     elsif current_task = TASK_EMOVE then
  244.         t2emove()
  245.  
  246.     elsif current_task = TASK_LIFE then
  247.         if gal then
  248.         p_energy(-3)
  249.         else
  250.         p_energy(-17)
  251.         end if
  252.  
  253.     elsif current_task = TASK_DEAD then
  254.         set_bk_color(0)
  255.         set_color(7)
  256.         for c = 1 to length(wipeout) do
  257.         for i = 0 to wipeout[c][3]-1 do
  258.             if read_screen(wipeout[c][1] + i, wipeout[c][2]) = ' ' then
  259.             display_screen(wipeout[c][1] + i, wipeout[c][2], ' ')
  260.             end if
  261.         end for
  262.         end for
  263.         wipeout = {}
  264.  
  265.     elsif current_task = TASK_RSTAT then
  266.         t5rstat()
  267.  
  268.     elsif current_task = TASK_FIRE then
  269.         t6fire()
  270.  
  271.     elsif current_task = TASK_MOVE then
  272.         t7move()
  273.  
  274.     elsif current_task = TASK_UREM then
  275.         t8ur()
  276.  
  277.     elsif current_task = TASK_DAMAGE then
  278.         t9dmg()
  279.  
  280.     elsif current_task = TASK_ENTER then
  281.         t10enter()
  282.  
  283.     end if
  284.     end while
  285.  
  286.     sounde(0, 0, 0)
  287.     nk = nkl()
  288.     if nk = 0 then
  289.     msg("")
  290.     set_color(RED+BLINKING)
  291.     puts(CRT, "PROGRAMMERS THROUGHOUT THE GALAXY ARE EUPHORIC!!!!!")
  292.     delay(15)
  293.     else
  294.     sounde(14, 6, 1)
  295.     msg("")
  296.     printf(CRT, "%d C SHIPS REMAIN. YOU ARE DEAD. C RULES THE GALAXY!",
  297.      nk)
  298.     delay(5)
  299.     end if
  300. end procedure
  301.  
  302. puts(1, "                  READY? ")
  303. init_delay() -- uses up some time - do it here
  304. if atom(gets(0)) then
  305. end if
  306.  
  307. cursor(NO_CURSOR)
  308. trek()
  309. position(25, 1)
  310. cursor(UNDERLINE_CURSOR)
  311. set_bk_color(BLACK)
  312. set_color(WHITE)
  313. puts(CRT, '\n')
  314.  
  315.