Category : Miscellaneous Language Source Code
Archive   : EUPHOR10.ZIP
Filename : LW.EX

------------------
-- Language War --
------------------
-- See doc\langwar.doc for a complete description of how to play.
-- See doc\langwar.sum for a brief summary of the commands.
-- This is a space war game developed in 1979 for the TRS-80
-- by David A. Craig with assistance from Robert H. Craig.
-- This program is being placed in the public domain.
-- No rights are reserved - you are encouraged to modify it
-- and redistribute it, along with the Public Domain Edition of Euphoria.
-- The sound and graphics are admittedly poor. We're sure you can do much
-- better! You will see that some names have been changed externally, (but
-- not in the code). We did this to avoid getting in trouble with
-- Paramount Pictures.

type file_number(integer x)
return x >= -1
end type

file_number sum_no
object line

include graphics.e
include vars.e
include screen.e

sum_no = open("lw.sum", "r")
if sum_no != -1 then
set_bk_color(BLUE)
set_color(WHITE)
clear_screen()
while 1 do
line = gets(sum_no)
if atom(line) then
exit
end if
puts(1, line)
end while
end if

include sched.e
include soundeff.e
include display.e
include damage.e
include weapons.e
include commands.e
include emove.e
include enemy.e

type energy_source(integer x)
return x = G_PL or x = G_BS
end type

procedure setpb(pb_row row, energy_source stype)
-- initialize a planet or a base

g_index r, c, ri, ci
h_coord x, xi
v_coord y, yi
positive_atom en
boolean unique

-- choose a quadrant
r = rand(G_SIZE)
c = rand(G_SIZE)
pb[row][P_QR] = r
pb[row][P_QC] = c
pb[row][P_EXIST] = NEVER_DOCKED
en = (rand(256) + rand(256)) * 32 + 25000
pb[row][P_EN] = en
g[r][c][stype] = g[r][c][stype] + 1

-- choose a position in the quadrant
while TRUE do
if stype = G_PL then
x = rand(HSIZE - length(PLANET_MIDDLE) - 2*length(ENTERPRISE_L))
+ length(ENTERPRISE_L)
y = rand(VSIZE-4) + 1
else
x = rand(HSIZE - length(BASE) - 2*length(ENTERPRISE_L))
+ length(ENTERPRISE_L)
y = rand(VSIZE-3) + 1
pb[row][P_POD] = 1
pb[row][P_TORP] = rand(7) + 8
end if
pb[row][P_X] = x
pb[row][P_Y] = y

-- make sure position doesn't overlap another planet or base
unique = TRUE
for i = 1 to row - 1 do
ri = pb[i][P_QR]
ci = pb[i][P_QC]
if r = ri and c = ci then
-- in the same quadrant
xi = pb[i][P_X]
if x >= xi-length(PLANET_MIDDLE) and
x <= xi + length(PLANET_MIDDLE) then
yi = pb[i][P_Y]
if y >= yi-2 and y <= yi+2 then
unique = FALSE
exit
end if
end if
end if
end for
if unique then
exit
end if
end while
end procedure


procedure init()
-- initialize
g_index r, c

ship = {{ENTERPRISE_L, ENTERPRISE_R}, -- Euphoria
{S_KLINGON_L, S_KLINGON_R}, -- C
{B_KLINGON_L, B_KLINGON_R}, -- ANSI C
{J_KLINGON_L, J_KLINGON_R}, -- C++
{ROMULAN_L, ROMULAN_R}, -- BASIC
{THOLIAN_L, THOLIAN_R}} -- FORTRAN

otype = {"EUPHORIA",
"C",
"ANSI C",
"C++",
"BASIC",
"FORTRAN",
"PLANET",
"BASE"}

wait = {0.45, -- KEYB
0, -- EMOVE
6.0, -- LIFE
0, -- DEAD
0, -- RSTAT
0, -- FIRE
2.3, -- MOVE
0, -- UREM
0, -- DAMAGE
0} -- ENTER
wait[TASK_EMOVE] = .67
eat = {1.0, .04, .10, .80, .30, .20, .30, .10, .80, .30}
tcb = repeat(2, NTASKS)
tcb[TASK_EMOVE] = 1 -- task emove scheduled to go first
sched(TASK_RSTAT, 1 + rand(100))
sched(TASK_ENTER, 1 + rand(60))
sched(TASK_UREM, 0)
sched(TASK_DAMAGE, 0)
sched(TASK_DEAD, 0)
scanon = FALSE
set_bk_color(0)
set_color(7)

-- blank lower portion
set_bk_color(7)
set_color(0)
for i = WARP_LINE to WARP_LINE + 2 do
position(i, 1)
puts(CRT, repeat(' ', 80))
end for

-- set number of objects in the galaxy

nobj = {1, -- Enterprise (must be 1)
40, -- regular Klingons
9, -- big Klingons
1, -- Jumbo Klingon
50, -- Romulans
20, -- Tholians
6, -- planets
3} -- bases
f[ENTERPRISE][F_TYPE] = G_EN
f[ENTERPRISE][F_DEFL] = 3
ds = repeat(DEFLECTOR, 3)
f[ENTERPRISE][F_TORP] = 5
ts = repeat(TORPEDO, 5)
ps = {}
f[ENTERPRISE][F_EN] = 30000
wlimit = 5
curwarp = 4
truce_broken = FALSE
qrow = 1
qcol = 1
stext()
nchars = 0

-- initialize galaxy array
g = repeat(repeat(repeat(0, NTYPES), G_SIZE), G_SIZE)
for i = G_SK to G_TH do
for j = 1 to nobj[i] do
r = rand(G_SIZE)
c = rand(G_SIZE)
g[r][c][i] = g[r][c][i] + 1
end for
end for

-- initialize planet/base array
for i = 1 to nobj[G_BS] do
setpb(i, G_BS)
end for
for i = nobj[G_BS]+1 to PROWS do
setpb(i, G_PL)
end for
exi = 3
eyi = 0
esymr = ENTERPRISE_R
esyml = ENTERPRISE_L
esym = ENTERPRISE_R
f[ENTERPRISE][F_X] = HSIZE - length(esym) + 1
f[ENTERPRISE][F_Y] = VSIZE
f[ENTERPRISE][F_UNDER] = " "
qrow = pb[1][P_QR]
qcol = gmod(pb[1][P_QC] - 1)
rstat = TRUCE
reptime[1..NSYS] = 0
ndmg = 0
wait[TASK_DAMAGE] = 0
gal = FALSE
set_bk_color(0)
set_color(7)
BlankScreen(TRUE) -- blank upper portion
end procedure

global procedure trek()
-- Startrek Main Routine

positive_int nk

init()
current_task = TASK_FIRE
wait[TASK_FIRE] = 1.0 -- difficulty level
gameover = FALSE

while not gameover do
sched(current_task, wait[current_task])
current_task = next_task()

if current_task = TASK_KEYB then
t1keyb()

elsif current_task = TASK_EMOVE then
t2emove()

elsif current_task = TASK_LIFE then
if gal then
p_energy(-3)
else
p_energy(-17)
end if

elsif current_task = TASK_DEAD then
set_bk_color(0)
set_color(7)
for c = 1 to length(wipeout) do
for i = 0 to wipeout[c][3]-1 do
if read_screen(wipeout[c][1] + i, wipeout[c][2]) = ' ' then
display_screen(wipeout[c][1] + i, wipeout[c][2], ' ')
end if
end for
end for
wipeout = {}

elsif current_task = TASK_RSTAT then
t5rstat()

elsif current_task = TASK_FIRE then
t6fire()

elsif current_task = TASK_MOVE then
t7move()

elsif current_task = TASK_UREM then
t8ur()

elsif current_task = TASK_DAMAGE then
t9dmg()

elsif current_task = TASK_ENTER then
t10enter()

end if
end while

sounde(0, 0, 0)
nk = nkl()
if nk = 0 then
msg("")
set_color(RED+BLINKING)
puts(CRT, "PROGRAMMERS THROUGHOUT THE GALAXY ARE EUPHORIC!!!!!")
delay(15)
else
sounde(14, 6, 1)
msg("")
printf(CRT, "%d C SHIPS REMAIN. YOU ARE DEAD. C RULES THE GALAXY!",
nk)
delay(5)
end if
end procedure

puts(1, " READY? ")
init_delay() -- uses up some time - do it here
if atom(gets(0)) then
end if

cursor(NO_CURSOR)
trek()
position(25, 1)
cursor(UNDERLINE_CURSOR)
set_bk_color(BLACK)
set_color(WHITE)
puts(CRT, '\n')