You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

2273 lines
49 KiB

##
## This is Daimler's 350-point "Adventure" (circa June 1990, according
## to Russel Dalenberg). Its version information lists
##
## -Conversion to BDS C by J. R. Jaeger
## -Unix standardization by Jerry D. Pohl.
## -OS/2 Conversion by Martin Heller
## -Conversion to TurboC 2.0 by Daimler
##
## It contains Jerry Pohl's original ADVENT.DOC (dated 12 JUNE 1984),
## plus comments from Martin Heller (dated 30-Aug-1988). Strangely for
## an expansion, Daimler's version actually introduces a number of typos
## into the data files, and disables a handful of inessential verbs
## (READ, EAT, FILL) with the comment that there is "no room" for them
## (presumably in the PC's limited memory).
## -------------------------------------------------------------------
## Adapted for HiTech C Z80 under CP/M by Ladislau Szilagyi, Oct. 2023
## Uncommented Daimler's disabled verbs - game is complete again !
## Added a new pseudo-random number generator (Xorshift)
## Adapted to Cowgol language by Ladislau Szilagyi, Feb. 2025
include "misc.coh";
include "string.coh";
include "ranfile.coh";
@decl sub bug(n: uint8) @extern("bug");
@decl sub rspeak(msg: uint8) @extern("rspeak");
@decl sub pspeak(item: uint8, state: int8) @extern("pspeak");
@decl sub desclg(loc: uint8) @extern("desclg");
@decl sub descsh(loc: uint8) @extern("descsh");
@decl sub vocab(word: [uint8], val: uint16): (ret: int16) @extern("vocab");
@decl sub outwords() @extern("outwords");
@decl sub pct(x: uint16): (ret: uint8) @extern("pct");
@decl sub dstroy(obj: uint16) @extern("dstroy");
@decl sub juggle(loc: uint16) @extern("juggle");
@decl sub put(obj: uint16, where: int16, pval: int16): (ret: int16) @extern("put");
@decl sub liq2(pbottle: uint16): (ret: uint16) @extern("liq2");
@decl sub yes(msg1: uint8, msg2: uint8, msg3: uint8): (ret: uint8) @extern("yes");
@decl sub ivkill() @extern("ivkill");
@decl sub normend() @extern("normend");
@decl sub dwarfend() @extern("dwarfend");
@decl sub itverb(verb: int16, object: int16, closed: int16) @extern("itverb");
@decl sub trobj(verb: int16, object: int16, closed: int16) @extern("trobj");
@decl sub scanint(pi: [int16], str: [uint8]) @extern("scanint");
@decl sub english(): (ret: uint8) @extern("english");
@decl sub needobj() @extern("needobj");
@decl sub vread(object: int16, closed: int16, verb: int16) @extern("vread");
@decl sub vocab_ivfoo(): (ret: uint8) @extern("vocab_ivfoo");
@decl sub I_see_no() extern("I_see_no");
@decl sub gettrav(loc: uint8) @extern("gettrav");
@decl sub dotrav(loc: int16, motion: int16, verb:int16) @extern("dotrav");
@decl sub goback(loc: int16, oldloc: int16, oldloc2: int16, verb: int16) @extern("goback");
# ---------------------------------------------------------------------------
const MAXOBJ := 100; # max # of objects in cave
const MAXWC := 301; # max # of adventure words
const MAXLOC := 140; # max # of cave locations
const MAXMSG := 201; # max # of long location descr
const MAXTRAV := (16+1); # max # of travel directions from loc
# +1 for terminator travel[x].tdest=-1
const DWARFMAX := 7; # max # of nasty dwarves
const MAXDIE := 3; # max # of deaths before close
const MAXTRS := 79; # max # of
# Object definitions
const KEYS := 1;
const LAMP := 2;
const GRATE := 3;
const CAGE := 4;
const ROD := 5;
const ROD2 := 6;
const STEPS := 7;
const BIRD := 8;
const DOOR := 9;
const PILLOW := 10;
const SNAKE := 11;
const FISSURE := 12;
const TABLET := 13;
const CLAM := 14;
const OYSTER := 15;
const MAGAZINE := 16;
const DWARF := 17;
const KNIFE := 18;
const FOOD := 19;
const BOTTLE := 20;
const WATER := 21;
const OIL := 22;
const MIRROR := 23;
const PLANT := 24;
const PLANT2 := 25;
const AXE := 28;
const DRAGON := 31;
const CHASM := 32;
const TROLL := 33;
const TROLL2 := 34;
const BEAR := 35;
const MESSAGE := 36;
const VEND := 38;
const BATTERIES := 39;
const NUGGET := 50;
const COINS := 54;
const CHEST := 55;
const EGGS := 56;
const TRIDENT := 57;
const VASE := 58;
const EMERALD := 59;
const PYRAMID := 60;
const PEARL := 61;
const RUG := 62;
const SPICES := 63;
const CHAIN := 64;
# Verb definitions
const NULLX := 21;
const BACK := 8;
const LOOK := 57;
const CAVE := 67;
const ENTRANCE := 64;
const DEPRESSION := 63;
# Action verb definitions
#const TAKE := 1;
#const DROP := 2;
#const SAY := 3;
#const OPEN := 4;
#const NOTHING := 5;
const LOCK := 6;
#const ON := 7;
#const OFF := 8;
#const WAVE := 9;
#const CALM := 10;
#const WALK := 11;
#const KILL := 12;
#const POUR := 13;
#const EAT := 14;
#const DRINK := 15;
#const RUB := 16;
const THROW := 17;
#const QUIT := 18;
#const FIND := 19;
#const INVENTORY := 20;
#const FEED := 21;
#const FILL := 22;
#const BLAST := 23;
#const SCORE := 24;
#const FOO := 25;
#const BRIEF := 26;
#const READ := 27;
#const BREAK := 28;
#const WAKE := 29;
#const SUSPEND := 30;
#const HOURS := 31;
#const LOG := 32;
# BIT mapping of "cond" array which indicates location status
const LIGHT := 1;
const WATOIL := 2;
const LIQUID := 4;
const NOPIRAT := 8;
const HINTC := 16;
const HINTB := 32;
const HINTS := 64;
const HINTM := 128;
const HINT := 240;
# Structure definitions
record trav is
tdest: int16;
tverb: int16;
tcond: int16;
end record;
# ---------------------------------------------------------------
# WARNING: GLOBAL variable allocations for adventure
var dummy: [uint8];
# Database variables
var travel: trav[MAXTRAV];
var actmsg: int16[32]; # action messages
# English variables
var verb: int16;
var object: int16;
var motion: int16;
# Play variables
var turns: int16;
var loc: int16;
var oldloc: int16;
var oldloc2: int16;
var newloc: int16; # location variables
var cond: int16[MAXLOC]; # location status
var place: int16[MAXOBJ]; # object location
var fixed: int16[MAXOBJ]; # second object loc
var visited: int16[MAXLOC]; # >0 if has been here
var prop: int16[MAXOBJ]; # status of object
var tally: int16;
var tally2: int16; # item counts
var limit: int16; # time limit
var lmwarn: int16; # lamp warning flag
var wzdark: int16;
var closing: int16;
var closed: int16; # game state flags
var holding: int16; # count of held items
var detail: int16; # LOOK count
var knfloc: int16; # knife location
var clock1: int16;
var clock2: int16;
var panic: int16; # timing variables
var dloc: int16[DWARFMAX]; # dwarf locations
var dflag: int16; # dwarf flag
var dseen: int16[DWARFMAX]; # dwarf seen flag
var odloc: int16[DWARFMAX]; # dwarf old locations
var daltloc: int16; # alternate appearance
var dkill: int16; # dwarves killed
var chloc: int16;
var chloc2: int16; # chest locations
var bonus: int16; # to pass to end
var numdie: int16; # number of deaths
var object1: int16; # to help intrans.
var gaveup: int16; # 1 if he quit early
var foobar: int16; # fie fie foe foo...
var saveflg: int16; # if game being saved
var dbugflg: int16; # if game is in debug
# Utility Routines --------------------------------------
sub get_dbugflg(): (ret: int16) @extern("get_dbugflg") is
ret := dbugflg;
end sub;
sub get_saveflg(): (ret: int16) @extern("get_saveflg") is
ret := saveflg;
end sub;
sub set_saveflg(v: int16) @extern("set_saveflg") is
saveflg:= v;
end sub;
sub set_dbugflg(v: int16) @extern("set_dbugflg") is
dbugflg:= v;
end sub;
record CpmFCB is
dr: uint8;
f: uint8[11];
ex: uint8;
s1: uint8;
s2: uint8;
rc: uint8;
d: uint8[16];
cr: uint8;
r: uint16;
r2: uint8;
end record;
record FCB is
bufferptr: uint8; # byte just read
dirty: uint8;
cpm: CpmFCB;
buffer: uint8[128];
end record;
var saverest: FCB;
sub getword(fcb: [FCB]): (ret: int16) is
ret := FCBGetChar(fcb) as int16;
ret := ret + (FCBGetChar(fcb) as int16) * 256;
end sub;
sub putword(fcb: [FCB], word: int16) is
FCBPutChar(fcb, (word & 0xFF) as uint8);
FCBPutChar(fcb, (word >> 8) as uint8);
end sub;
sub save() @extern("save") is
var i: uint8;
var err: uint8;
err := FCBOpenOut(&saverest, "advent.sav");
if err != 0 then
print("Sorry, file ADVENT.SAV was not saved!\n");
return;
end if;
putword(&saverest, turns);
putword(&saverest, loc);
putword(&saverest, oldloc);
putword(&saverest, oldloc2);
putword(&saverest, newloc);
i := 0; while i < MAXLOC loop putword(&saverest, cond[i]); i := i+1; end loop;
i := 0; while i < MAXOBJ loop putword(&saverest, place[i]); i := i+1; end loop;
i := 0; while i < MAXOBJ loop putword(&saverest, fixed[i]); i := i+1; end loop;
i := 0; while i < MAXLOC loop putword(&saverest, visited[i]); i := i+1; end loop;
i := 0; while i < MAXOBJ loop putword(&saverest, prop[i]); i := i+1; end loop;
putword(&saverest, tally);
putword(&saverest, tally2);
putword(&saverest, limit);
putword(&saverest, lmwarn);
putword(&saverest, wzdark);
putword(&saverest, closing);
putword(&saverest, closed);
putword(&saverest, holding);
putword(&saverest, detail);
putword(&saverest, knfloc);
putword(&saverest, clock1);
putword(&saverest, clock2);
putword(&saverest, panic);
i := 0; while i < DWARFMAX loop putword(&saverest, dloc[i]); i := i+1; end loop;
putword(&saverest, dflag);
i := 0; while i < DWARFMAX loop putword(&saverest, dseen[i]); i := i+1; end loop;
i := 0; while i < DWARFMAX loop putword(&saverest, odloc[i]); i := i+1; end loop;
putword(&saverest, daltloc);
putword(&saverest, dkill);
putword(&saverest, chloc);
putword(&saverest, chloc2);
putword(&saverest, bonus);
putword(&saverest, numdie);
putword(&saverest, object1);
putword(&saverest, gaveup);
putword(&saverest, foobar);
putword(&saverest, saveflg);
putword(&saverest, dbugflg);
err := FCBClose(&saverest);
if err != 0 then
print("Sorry, file ADVENT.SAV was not saved!\n");
else
print("File ADVENT.SAV was saved!\n");
end if;
end sub;
sub restore() @extern("restore") is
var i: uint8;
var err: uint8;
err := FCBOpenIn(&saverest, "advent.sav");
if err != 0 then
print("Sorry, I can't open the ADVENT.SAV file!\n");
return;
end if;
turns := getword(&saverest);
loc := getword(&saverest);
oldloc := getword(&saverest);
oldloc2 := getword(&saverest);
newloc := getword(&saverest);
i := 0; while i < MAXLOC loop cond[i] := getword(&saverest); i := i+1; end loop;
i := 0; while i < MAXOBJ loop place[i] := getword(&saverest); i := i+1; end loop;
i := 0; while i < MAXOBJ loop fixed[i] := getword(&saverest); i := i+1; end loop;
i := 0; while i < MAXLOC loop visited[i] := getword(&saverest); i := i+1; end loop;
i := 0; while i < MAXOBJ loop prop[i] := getword(&saverest); i := i+1; end loop;
tally := getword(&saverest);
tally2 := getword(&saverest);
limit := getword(&saverest);
lmwarn := getword(&saverest);
wzdark := getword(&saverest);
closing := getword(&saverest);
closed := getword(&saverest);
holding := getword(&saverest);
detail := getword(&saverest);
knfloc := getword(&saverest);
clock1 := getword(&saverest);
clock2 := getword(&saverest);
panic := getword(&saverest);
i := 0; while i < DWARFMAX loop dloc[i] := getword(&saverest); i := i+1; end loop;
dflag := getword(&saverest);
i := 0; while i < DWARFMAX loop dseen[i] := getword(&saverest); i := i+1; end loop;
i := 0; while i < DWARFMAX loop odloc[i] := getword(&saverest); i := i+1; end loop;
daltloc := getword(&saverest);
dkill := getword(&saverest);
chloc := getword(&saverest);
chloc2 := getword(&saverest);
bonus := getword(&saverest);
numdie := getword(&saverest);
object1 := getword(&saverest);
gaveup := getword(&saverest);
foobar := getword(&saverest);
saveflg := getword(&saverest);
dbugflg := getword(&saverest);
print("Game restored from the ADVENT.SAV file!\n");
err := FCBClose(&saverest);
end sub;
sub set_limit(v: int16) @extern("set_limit") is
limit := v;
end sub;
sub set_verb(v: int16) @extern("set_verb") is
verb := v;
end sub;
sub set_object(v: int16) @extern("set_object") is
object := v;
end sub;
sub set_motion(v: int16) @extern("set_motion") is
motion := v;
end sub;
sub set_newloc(v: int16) @extern("set_newloc") is
newloc := v;
end sub;
sub set_oldloc(v: int16) @extern("set_oldloc") is
oldloc := v;
end sub;
sub set_oldloc2(v: int16) @extern("set_oldloc2") is
oldloc2 := v;
end sub;
sub get_prop(obj: uint8): (ret: int16) @extern("get_prop") is
ret := prop[obj];
end sub;
# ensure uniqueness as objects are searched
# out for an intransitive verb
sub addobj(obj: uint16) is
if object1 != 0 then
return;
end if;
if object != 0 then
object1 := -1;
return;
end if;
object := obj as int16;
end sub;
# Routine to tell if an item is being carried.
sub toting(item: uint16): (ret: uint8) @extern("toting") is
if place[item as uint8] == -1 then
ret := 1;
else
ret := 0;
end if;
end sub;
# Routine to tell if an item is present.
sub here(item: uint16): (ret: uint8) is
if place[item as uint8] == loc or toting(item) == 1 then
ret := 1;
else
ret := 0;
end if;
end sub;
# Routine to test for darkness
sub dark(): (ret: uint8) @extern("dark") is
if ((cond[loc as uint8] & LIGHT) == 0) and (prop[LAMP] == 0 or here(LAMP) == 0) then
ret := 1;
else
ret := 0;
end if;
end sub;
# Routine to tell if a location causes a forced move.
sub forced(atloc: uint16): (ret: uint8) @extern("forced") is
if cond[atloc as uint8] == 2 then
ret := 1;
else
ret := 0;
end if;
end sub;
# Routine to tell if player is on either side of a two sided object.
sub at(item: uint16): (ret: uint8) @extern("at") is
if place[item as uint8] == loc or fixed[item as uint8] == loc then
ret := 1;
else
ret := 0;
end if;
end sub;
# Routine to carry an object
sub carry(obj: uint16, where: int16) is
if obj < MAXOBJ then
if place[obj as uint8] == -1 then
return;
end if;
place[obj as uint8] := -1;
holding := holding + 1;
end if;
end sub;
# Routine to drop an object
sub drop(obj: uint16, where: int16) is
if obj < MAXOBJ then
if place[obj as uint8] == -1 then
holding := holding - 1;
end if;
place[obj as uint8] := where;
else
fixed[obj as uint8 - MAXOBJ] := where;
end if;
end sub;
# Routine to move an object
sub move(obj: uint16, where: int16) @extern("move") is
var from: int16;
if obj < MAXOBJ then
from := place[obj as uint8];
else
from := fixed[obj as uint8];
end if;
if from > 0 and from <= 300 then
carry(obj, from);
end if;
drop(obj, where);
end sub;
# Routine to check for presence of dwarves..
sub dcheck(): (ret: uint8) is
var i: uint8;
i := 1;
while i < (DWARFMAX-1) loop
if dloc[i] == loc then
ret := i; return;
end if;
i := i + 1;
end loop;
ret := 0;
end sub;
# Determine liquid in the bottle
sub liq(): (ret: uint16) is
var i: int16;
var j: int16;
i := prop[BOTTLE];
j := -i - 1;
if i > j then
ret := liq2(i as uint16);
else
ret := liq2(j as uint16);
end if;
end sub;
# Determine liquid at a location
sub liqloc(loc: uint16): (ret: uint16) is
if cond[loc as uint8] & LIQUID != 0 then
ret := liq2((cond[loc as uint8] & WATOIL) as uint16);
else
ret := liq2(1);
end if;
end sub;
# Routine to speak default verb message
sub actspk(verb: uint16) @extern("actspk") is
var i: int16;
if verb < 1 or verb > 31 then
bug(39);
end if;
i := actmsg[verb as uint8];
if i > 0 then
rspeak(i as uint8);
end if;
end sub;
# scoring
sub score() @extern("score") is
var t: uint8;
var i: uint8;
var k: uint8;
var s: uint8;
s := 0;
t := 0;
i := 50;
while i <= MAXTRS loop
if i == CHEST then
k := 14;
elseif i > CHEST then
k := 16;
else
k := 12;
end if;
if prop[i] >= 0 then
t := t + 2;
end if;
if place[i] == 3 and prop[i] == 0 then
t := t + k-2;
end if;
i := i + 1;
end loop;
s := t;
print("Treasures: ");
print(itoa(s as int16));
print_nl();
t := (MAXDIE - numdie as uint8)*10;
if t != 0 then
print("Survival: ");
print(itoa(t as int16));
print_nl();
end if;
s := s + t;
if gaveup == 0 then
s := s + 4;
end if;
if dflag != 0 then
t := 25;
else
t := 0;
end if;
if t != 0 then
print("Getting well in: ");
print(itoa(t as int16));
print_nl();
end if;
s := s + t;
if closing == 1 then
t := 25;
else
t := 0;
end if;
if t != 0 then
print("Masters section: ");
print(itoa(t as int16));
print_nl();
end if;
s := s + t;
if closed != 0 then
if (bonus == 0) then
t := 10;
elseif bonus == 135 then
t := 25;
elseif bonus == 134 then
t := 30;
elseif bonus == 133 then
t := 45;
end if;
print("Bonus: ");
print(itoa(t as int16));
print_nl();
s := s + t;
end if;
if place[MAGAZINE] == 108 then
s := s + 1;
end if;
s := s + 2;
print("Score: ");
print(itoa(s as int16));
print_nl();
end sub;
# Routine to handle the passing on of one
# of the player's incarnations...
sub death() @extern("death") is
var yea: uint8;
var i: uint8;
var j: uint8;
var k: uint8;
if closing == 0 then
yea := yes(81+(numdie as uint8)*2, 82+(numdie as uint8)*2, 54);
numdie := numdie + 1;
if numdie >= MAXDIE or yea == 0 then
normend();
end if;
place[WATER] := 0;
place[OIL] := 0;
if toting(LAMP) == 1 then
prop[LAMP] := 0;
end if;
j := 1;
while j < 101 loop
i := 101 - j;
if toting(i as uint16) == 1 then
if i == LAMP then
drop(i as uint16, 1);
else
drop(i as uint16, oldloc2);
end if;
end if;
j := j + 1;
end loop;
newloc := 3;
oldloc := loc;
return;
end if;
# closing -- no resurrection...
rspeak(131);
numdie := numdie + 1;
normend();
end sub;
# DROP etc.
sub vdrop() @extern("vdrop") is
var i: int16;
# check for dynamite
if toting(ROD2) == 1 and object == ROD and toting(ROD) == 0 then
object := ROD2;
end if;
if toting(object as uint16) == 0 then
actspk(verb as uint16);
return;
end if;
# snake and bird
if object == BIRD and here(SNAKE) == 1 then
rspeak(30);
if closed == 1 then
dwarfend();
end if;
dstroy(SNAKE);
prop[SNAKE] := -1;
# coins and vending machine
elseif object == COINS and here(VEND) == 1 then
dstroy(COINS);
drop(BATTERIES,loc);
pspeak(BATTERIES,0);
return;
# bird and dragon (ouch!!)
elseif object == BIRD and at(DRAGON) == 1 and prop[DRAGON] == 0 then
rspeak(154);
dstroy(BIRD);
prop[BIRD] := 0;
if (place[SNAKE] != 0) then
tally2 := tally2 + 1;
end if;
return;
end if;
# Bear and troll
if object == BEAR and at(TROLL) == 1 then
rspeak(163);
move(TROLL,0);
move((TROLL+MAXOBJ),0);
move(TROLL2,117);
move((TROLL2+MAXOBJ),122);
juggle(CHASM);
prop[TROLL] := 2;
# vase
elseif object == VASE then
if loc == 96 then
rspeak(54);
else
if at(PILLOW) == 1 then
prop[VASE] := 0;
else
prop[VASE] := 2;
end if;
pspeak(VASE,prop[VASE] as int8 + 1);
if prop[VASE] != 0 then
fixed[VASE] := -1;
end if;
end if;
end if;
# handle liquid and bottle
i := liq() as int16;
if i == object then
object := BOTTLE;
end if;
if object == BOTTLE and i != 0 then
place[i as uint8] := 0;
end if;
# handle bird and cage
if object == CAGE and prop[BIRD] != 0 then
drop(BIRD,loc);
end if;
if object == BIRD then
prop[BIRD] := 0;
end if;
drop(object as uint16,loc);
end sub;
# FILL
sub vfill() @extern("vfill") is
var msg: uint8;
var i: uint16;
case object is
when BOTTLE:
if liq() != 0 then
msg := 105;
elseif liqloc(loc as uint16) == 0 then
msg := 106;
else
prop[BOTTLE] := cond[loc as uint8] & WATOIL;
i := liq();
if (toting(BOTTLE) == 1) then
place[i as uint8] := -1;
end if;
if i == OIL then
msg := 108;
else
msg := 107;
end if;
end if;
when VASE:
if liqloc(loc as uint16) == 0 then
msg := 144;
else
if toting(VASE) == 0 then
msg := 29;
else
rspeak(145);
vdrop();
return;
end if;
end if;
when else:
msg := 29;
end case;
rspeak(msg);
end sub;
# CARRY TAKE etc.
sub vtake() @extern("vtake") is
var msg: uint8;
var i: uint16;
if toting(object as uint16) == 1 then
actspk(verb as uint16);
return;
end if;
# special case objects and fixed objects
msg := 25;
if object == PLANT and prop[PLANT] <= 0 then
msg := 115;
end if;
if object == BEAR and prop[BEAR] == 1 then
msg := 169;
end if;
if object == CHAIN and prop[BEAR] != 0 then
msg := 170;
end if;
if fixed[object as uint8] != 0 then
rspeak(msg);
return;
end if;
# special case for liquids
if object == WATER or object == OIL then
if here(BOTTLE) == 0 or liq() != object as uint16 then
object := BOTTLE;
if toting(BOTTLE) == 1 and prop[BOTTLE] == 1 then
vfill();
return;
end if;
if prop[BOTTLE] != 1 then
msg := 105;
end if;
if toting(BOTTLE) == 0 then
msg := 104;
end if;
rspeak(msg);
return;
end if;
object := BOTTLE;
end if;
if holding >= 7 then
rspeak(92);
return;
end if;
# special case for bird.
if object == BIRD and prop[BIRD] == 0 then
if toting(ROD) == 1 then
rspeak(26);
return;
end if;
if toting(CAGE) == 0 then
rspeak(27);
return;
end if;
prop[BIRD] := 1;
end if;
if (object == BIRD or object == CAGE) and prop[BIRD] != 0 then
carry((BIRD+CAGE)-object as uint16, loc);
end if;
carry(object as uint16,loc);
# handle liquid in bottle
i := liq();
if object == BOTTLE and i != 0 then
place[i as uint8] := -1;
end if;
rspeak(54);
end sub;
# LOCK, UNLOCK, OPEN, CLOSE etc.
sub vopen() @extern("vopen") is
var msg: uint8;
var oyclam: uint8;
var o := object;
if o == CLAM then o := OYSTER; end if;
case o is
#when CLAM:
when OYSTER:
if object == OYSTER then
oyclam := 1;
else
oyclam := 0;
end if;
if verb == LOCK then
msg := 61;
elseif toting(TRIDENT) == 0 then
msg := 122+oyclam;
elseif toting(object as uint16) == 1 then
msg := 120+oyclam;
else
msg := 124+oyclam;
dstroy(CLAM);
drop(OYSTER,loc);
drop(PEARL,105);
end if;
when DOOR:
if prop[DOOR] == 1 then
msg := 54;
else
msg := 111;
end if;
when CAGE:
msg := 32;
when KEYS:
msg := 55;
when CHAIN:
if here(KEYS) == 0 then
msg := 31;
elseif verb == LOCK then
if prop[CHAIN] != 0 then
msg := 34;
elseif loc != 130 then
msg := 173;
else
prop[CHAIN] := 2;
if toting(CHAIN) == 1 then
drop(CHAIN,loc);
end if;
fixed[CHAIN] := -1;
msg := 172;
end if;
else
if prop[BEAR] == 0 then
msg := 41;
elseif prop[CHAIN] == 0 then
msg := 37;
else
prop[CHAIN] := 0;
fixed[CHAIN] := 0;
if prop[BEAR] != 3 then
prop[BEAR] := 2;
end if;
fixed[BEAR] := 2-prop[BEAR];
msg := 171;
end if;
end if;
when GRATE:
if here(KEYS) == 0 then
msg := 31;
elseif closing == 1 then
if panic == 0 then
clock2 := 15;
panic := panic + 1;
end if;
msg := 130;
else
msg := 34+prop[GRATE] as uint8;
if verb == LOCK then
prop[GRATE] := 0;
else
prop[GRATE] := 1;
end if;
msg := msg + 2*prop[GRATE] as uint8;
end if;
when else:
msg := 33;
end case;
rspeak(msg);
end sub;
# Routine to describe current location
sub describe() is
if toting(BEAR) == 1 then
rspeak(141);
end if;
if dark() == 1 then
rspeak(16);
elseif visited[loc as uint8] == 1 then
descsh(loc as uint8);
else
desclg(loc as uint8);
end if;
if loc == 33 and pct(25) == 1 and closing == 0 then
rspeak(8);
end if;
end sub;
# ON etc.
sub von() @extern("von") is
if here(LAMP) == 0 then
actspk(verb as uint16);
elseif limit < 0 then
rspeak(184);
else
prop[LAMP] := 1;
rspeak(39);
if wzdark == 1 then
wzdark := 0;
describe();
end if;
end if;
end sub;
# OFF etc.
sub voff() @extern("voff") is
if here(LAMP) == 0 then
actspk(verb as uint16);
else
prop[LAMP] := 0;
rspeak(40);
end if;
end sub;
# WAVE etc.
sub vwave() @extern("vwave") is
if toting(object as uint16) == 0 and (object != ROD or toting(ROD2) == 0) then
rspeak(29);
elseif object != ROD or at(FISSURE) == 0 or toting(object as uint16) == 0 or closing == 1 then
actspk(verb as uint16);
else
prop[FISSURE] := 1-prop[FISSURE];
pspeak(FISSURE,2-prop[FISSURE] as int8);
end if;
end sub;
# ATTACK, KILL etc.
sub vkill() @extern("vkill") is
var msg: uint8;
var i: uint16;
var o := object;
if o == CLAM then o := OYSTER; end if;
case o is
when BIRD:
if closed == 1 then
msg := 137;
else
dstroy(BIRD);
prop[BIRD] := 0;
if place[SNAKE] == 19 then
tally2 := tally2 + 1;
end if;
msg := 45;
end if;
when 0:
msg := 44;
#when CLAM:
when OYSTER:
msg := 150;
when SNAKE:
msg := 46;
when DWARF:
if closed == 1 then
dwarfend();
end if;
msg := 49;
when TROLL:
msg := 157;
when BEAR:
msg := 165+(prop[BEAR] as uint8+1)/2;
when DRAGON:
if prop[DRAGON] != 0 then
msg := 167;
elseif yes(49,0,0) != 0 then
pspeak(DRAGON,1);
prop[DRAGON] := 2;
prop[RUG] := 0;
move((DRAGON+MAXOBJ),-1);
move((RUG+MAXOBJ),0);
move(DRAGON,120);
move(RUG,120);
i := 1;
while i < MAXOBJ loop
if place[i as uint8] == 119 or place[i as uint8] == 121 then
move(i,120);
end if;
i := 1 + 1;
end loop;
newloc := 120;
return;
end if;
when else:
actspk(verb as uint16);
return;
end case;
rspeak(msg);
end sub;
# POUR
sub vpour() @extern("vpour") is
if object == BOTTLE or object == 0 then
object := liq() as int16;
end if;
if object == 0 then
needobj();
return;
end if;
if toting(object as uint16) == 0 then
actspk(verb as uint16);
return;
end if;
if object != OIL and object != WATER then
rspeak(78);
return;
end if;
prop[BOTTLE] := 1;
place[object as uint8] := 0;
if at(PLANT) == 1 then
if object != WATER then
rspeak(112);
else
pspeak(PLANT,prop[PLANT] as int8 +1);
prop[PLANT] := (prop[PLANT]+2)%6;
prop[PLANT2] := prop[PLANT]/2;
describe();
end if;
elseif at(DOOR) == 1 then
if object == OIL then
prop[DOOR] := 1;
else
prop[DOOR] := 0;
end if;
rspeak(113+prop[DOOR] as uint8);
else
rspeak(77);
end if;
end sub;
# EAT
sub veat() @extern("veat") is
var msg: uint8;
var o := object;
if o == BIRD or o == SNAKE or o == CLAM or o == OYSTER or o == DWARF or o == DRAGON or o == TROLL then o := BEAR; end if;
case o is
when FOOD:
dstroy(FOOD);
msg := 72;
#when BIRD:
#when SNAKE:
#when CLAM:
#when OYSTER:
#when DWARF:
#when DRAGON:
#when TROLL:
when BEAR:
msg := 71;
when else:
actspk(verb as uint16);
return;
end case;
rspeak(msg);
end sub;
# DRINK
sub vdrink() @extern("vdrink") is
if object != WATER then
rspeak(110);
elseif liq() != WATER or here(BOTTLE) == 0 then
actspk(verb as uint16);
else
prop[BOTTLE] := 1;
place[WATER] := 0;
rspeak(74);
end if;
end sub;
# FEED
sub vfeed() @extern("vfeed") is
var msg: uint8;
case object is
when BIRD:
msg := 100;
when DWARF:
if here(FOOD) == 0 then
actspk(verb as uint16);
return;
end if;
dflag := dflag + 1;
msg := 103;
when BEAR:
if here(FOOD) == 0 then
if prop[BEAR] == 0 then
msg := 102;
elseif prop[BEAR] == 3 then
msg := 110;
else
actspk(verb as uint16);
return;
end if;
else
dstroy(FOOD);
prop[BEAR] := 1;
fixed[AXE] := 0;
prop[AXE] := 0;
msg := 168;
end if;
when DRAGON:
if prop[DRAGON] != 0 then
msg := 110;
else
msg := 102;
end if;
when TROLL:
msg := 182;
when SNAKE:
if closed == 1 or here(BIRD) == 0 then
msg := 102;
else
msg := 101;
dstroy(BIRD);
prop[BIRD] := 0;
tally2 := tally2 + 1;
end if;
when else:
msg := 14;
end case;
rspeak(msg);
end sub;
# THROW etc.
sub vthrow() @extern("vthrow") is
var msg: uint8;
var i: uint8;
if toting(ROD2) == 1 and object == ROD and toting(ROD) == 0 then
object := ROD2;
end if;
if toting(object as uint16) == 0 then
actspk(verb as uint16);
return;
end if;
# treasure to troll
if at(TROLL) == 1 and object >= 50 and object < MAXOBJ then
rspeak(159);
drop(object as uint16,0);
move(TROLL,0);
move((TROLL+MAXOBJ),0);
drop(TROLL2,117);
drop((TROLL2+MAXOBJ),122);
juggle(CHASM);
return;
end if;
# feed the bears...
if object == FOOD and here(BEAR) == 1 then
object := BEAR;
vfeed();
return;
end if;
# if not axe, same as drop...
if object != AXE then
vdrop();
return;
end if;
# AXE is THROWN
# at a dwarf...
i := dcheck();
if i > 0 then
msg := 48;
if pct(33) == 1 then
dseen[i] := 0;
dloc[i] := 0;
msg := 47;
dkill := dkill + 1;
if dkill == 1 then
msg := 149;
end if;
end if;
# at a dragon...
elseif at(DRAGON) == 1 and prop[DRAGON] == 0 then
msg := 152;
# at the troll...
elseif at(TROLL) == 1 then
msg := 158;
# at the bear...
elseif here(BEAR) == 1 and prop[BEAR] == 0 then
rspeak(164);
drop(AXE,loc);
fixed[AXE] := -1;
prop[AXE] := 1;
juggle(BEAR);
return;
# otherwise it is an attack
else
#verb := KILL;
object := 0;
#itverb();
ivkill(); #instead of itverb --> ivkill
return;
end if;
# handle the left over axe...
rspeak(msg);
drop(AXE,loc);
describe();
end sub;
# INVENTORY, FIND etc.
sub vfind() @extern("vfind") is
var msg: uint8;
if toting(object as uint16) == 1 then
msg := 24;
elseif closed == 1 then
msg := 138;
elseif dcheck() > 1 and dflag >= 2 and object == DWARF then
msg := 94;
elseif at(object as uint16) == 1 or (liq() as int16 == object and here(BOTTLE) == 1) or object == liqloc(loc as uint16) as int16 then
msg := 94;
else
actspk(verb as uint16);
return;
end if;
rspeak(msg);
end sub;
# BLAST etc.
sub vblast() @extern("vblast") is
if prop[ROD2] < 0 or closed == 0 then
actspk(verb as uint16);
else
bonus := 133;
if loc == 115 then
bonus := 134;
end if;
if here(ROD2) == 1 then
bonus := 135;
end if;
rspeak(bonus as uint8);
normend();
end if;
end sub;
# BREAK etc.
sub vbreak() @extern("vbreak") is
var msg: uint8;
if object == MIRROR then
msg := 148;
if closed == 1 then
rspeak(197);
dwarfend();
end if;
elseif object == VASE and prop[VASE] == 0 then
msg := 198;
if toting(VASE) == 1 then
drop(VASE,loc);
end if;
prop[VASE] := 2;
fixed[VASE] := -1;
else
actspk(verb as uint16);
return;
end if;
rspeak(msg);
end sub;
# WAKE etc.
sub vwake() @extern("vwake") is
if object != DWARF or closed == 0 then
actspk(verb as uint16);
else
rspeak(199);
dwarfend();
end if;
end sub;
# CARRY, TAKE etc.
sub ivtake() @extern("ivtake") is
var anobj: uint16;
var item: uint16;
anobj := 0;
item := 1;
while item < MAXOBJ loop
if place[item as uint8] == loc then
if anobj != 0 then
needobj();
return;
end if;
anobj := item;
end if;
item := item + 1;
end loop;
if anobj==0 or (dcheck() > 0 and dflag >= 2) then
needobj();
return;
end if;
object := anobj as int16;
vtake();
end sub;
# OPEN, LOCK, UNLOCK
sub ivopen() @extern("ivopen") is
if here(CLAM) == 1 then
object := CLAM;
end if;
if here(OYSTER) == 1 then
object := OYSTER;
end if;
if at(DOOR) == 1 then
object := DOOR;
end if;
if at(GRATE) == 1 then
object := GRATE;
end if;
if here(CHAIN) == 1 then
if object != 0 then
needobj();
return;
end if;
object := CHAIN;
end if;
if object==0 then
rspeak(28);
return;
end if;
vopen();
end sub;
# ATTACK, KILL etc
@impl sub ivkill is
object1 := 0;
if dcheck() > 1 and dflag >=2 then
object:=DWARF;
end if;
if here(SNAKE) == 1 then
addobj(SNAKE);
end if;
if at(DRAGON) == 1 and prop[DRAGON]==0 then
addobj(DRAGON);
end if;
if at(TROLL) == 1 then
addobj(TROLL);
end if;
if here(BEAR) == 1 and prop[BEAR]==0 then
addobj(BEAR);
end if;
if object1 != 0 then
needobj();
return;
end if;
if object != 0 then
vkill();
return;
end if;
if here(BIRD) == 1 and verb!= THROW then
object:=BIRD;
end if;
if here(CLAM) == 1 or here(OYSTER) == 1 then
addobj(CLAM);
end if;
if object1 != 0 then
needobj();
return;
end if;
vkill();
end sub;
# EAT
sub iveat() @extern("iveat") is
if here(FOOD) == 0 then
needobj();
else
object:=FOOD;
veat();
end if;
end sub;
# DRINK
sub ivdrink() @extern("ivdrink") is
if liqloc(loc as uint16) != WATER and (liq() != WATER or here(BOTTLE) == 0) then
needobj();
else
object:=WATER;
vdrink();
end if;
end sub;
# QUIT
sub ivquit() @extern("ivquit") is
gaveup := yes(22,54,54) as int16;
if gaveup == 1 then
normend();
end if;
end sub;
# FILL
sub ivfill() @extern("ivfill") is
if here(BOTTLE) == 0 then
needobj();
else
object:=BOTTLE;
vfill();
end if;
end sub;
# Handle fee fie foe foo...
sub ivfoo() @extern("ivfoo") is
var k: uint8;
var msg: uint8;
k := vocab_ivfoo();
msg := 42;
if foobar != 1-k as int16 then
if foobar != 0 then
msg := 151;
end if;
rspeak(msg);
return;
end if;
foobar := k as int16;
if k != 4 then
return;
end if;
foobar := 0;
if place[EGGS] == 92 or (toting(EGGS) == 1 and loc == 92) then
rspeak(msg);
return;
end if;
if place[EGGS] == 0 and place[TROLL] == 0 and prop[TROLL] == 0 then
prop[TROLL] := 1;
end if;
if here(EGGS) == 1 then
k := 1;
elseif loc == 92 then
k := 0;
else
k := 2;
end if;
move(EGGS,92);
pspeak(EGGS,k as int8);
return;
end sub;
# read etc...
sub ivread() @extern("ivread") is
if here(MAGAZINE) == 1 then
object := MAGAZINE;
end if;
if here(TABLET) == 1 then
object := object*100 + TABLET;
end if;
if here(MESSAGE) == 1 then
object := object*100 + MESSAGE;
end if;
if object > 100 or object == 0 or dark() == 1 then
needobj();
return;
end if;
vread(object, closed, verb);
end sub;
# ----------------------------------------------------------
# Initialization of adventure play variables
sub initplay() @extern("initplay") is
turns := 0;
# initialize location status array
dummy := memset(&cond[0] as [uint8], 0, 2 * MAXLOC);
scanint(&cond[1], "5,1,5,5,1,1,5,17,1,1,");
scanint(&cond[13], "32,0,0,2,0,0,64,2,");
scanint(&cond[21], "2,2,0,6,0,2,");
scanint(&cond[31], "2,2,0,0,0,0,0,4,0,2,");
scanint(&cond[42], "128,128,128,128,136,136,136,128,128,");
scanint(&cond[51], "128,128,136,128,136,0,8,0,2,");
scanint(&cond[79], "2,128,128,136,0,0,8,136,128,0,2,2,");
scanint(&cond[95], "4,0,0,0,0,1,");
scanint(&cond[113], "4,0,1,1,");
scanint(&cond[122], "8,8,8,8,8,8,8,8,8,");
# initialize object locations
dummy := memset(&place[0] as [uint8], 0, 2 * MAXOBJ);
scanint(&place[1], "3,3,8,10,11,0,14,13,94,96,");
scanint(&place[11], "19,17,101,103,0,106,0,0,3,3,");
scanint(&place[23], "109,25,23,111,35,0,97,");
scanint(&place[31], "119,117,117,0,130,0,126,140,0,96,");
scanint(&place[50], "18,27,28,29,30,");
scanint(&place[56], "92,95,97,100,101,0,119,127,130,");
# initialize second (fixed) locations
dummy := memset(&fixed[0] as [uint8], 0, 2 * MAXOBJ);
scanint(&fixed[3], "9,0,0,0,15,0,-1,");
scanint(&fixed[11], "-1,27,-1,0,0,0,-1,");
scanint(&fixed[23], "-1,-1,67,-1,110,0,-1,-1,");
scanint(&fixed[31], "121,122,122,0,-1,-1,-1,-1,0,-1,");
scanint(&fixed[62], "121,-1,");
# initialize default verb messages
scanint(&actmsg[0], "0,24,29,0,33,0,33,38,38,42,14,");
scanint(&actmsg[11], "43,110,29,110,73,75,29,13,59,59,");
scanint(&actmsg[21], "174,109,67,13,147,155,195,146,110,13,13,");
# initialize various flags and other variables
dummy := memset(&visited[0] as [uint8], 0, 2 * MAXLOC);
dummy := memset(&prop[0] as [uint8], 0, 2 * MAXOBJ);
dummy := memset(&prop[50] as [uint8], 0xFF, 2 * (MAXOBJ-50));
wzdark := 0;
closed := 0;
closing := 0;
holding := 0;
detail := 0;
limit := 100;
tally := 15;
tally2 := 0;
newloc := 3;
loc := 1;
oldloc := 1;
oldloc2 := 1;
knfloc := 0;
chloc := 114;
chloc2 := 140;
# dloc[DWARFMAX-1] := chloc;
scanint(&dloc[0], "0,19,27,33,44,64,114,");
scanint(&odloc[0], "0,0,0,0,0,0,0,");
dkill := 0;
scanint(&dseen[0], "0,0,0,0,0,0,0,");
clock1 := 30;
clock2 := 50;
panic := 0;
bonus := 0;
numdie := 0;
daltloc := 18;
lmwarn := 0;
foobar := 0;
dflag := 0;
gaveup := 0;
saveflg := 0;
end sub;
# Routine to describe visible items
sub descitem() is
var i: uint8;
var state: uint8;
i := 1;
while i < MAXOBJ loop
if at(i as uint16) == 1 then
if i == STEPS and toting(NUGGET) == 1 then
i := i + 1;
continue;
end if;
if prop[i] < 0 then
if closed == 1 then
i := i + 1;
continue;
else
prop[i] := 0;
if i == RUG or i == CHAIN then
prop[i] := prop[i] + 1;
end if;
tally := tally - 1;
end if;
end if;
if i == STEPS and loc == fixed[STEPS] then
state := 1;
else
state := prop[i] as uint8;
end if;
pspeak(i, state as int8);
end if;
i := i + 1;
end loop;
if tally == tally2 and tally != 0 and limit > 35 then
limit := 35;
end if;
end sub;
# Routine to handle very special movement.
sub spcmove(rdest: uint16) @extern("spcmove") is
case rdest-300 is
when 1: # plover movement via alcove
if holding == 0 or (holding == 1 and toting(EMERALD) == 1) then
newloc := (99+100)-loc;
else
rspeak(117);
end if;
when 2: # trying to remove plover, bad route
drop(EMERALD, loc);
when 3: # troll bridge
if prop[TROLL] == 1 then
pspeak(TROLL, 1);
prop[TROLL] := 0;
move(TROLL2, 0);
move((TROLL2+MAXOBJ), 0);
move(TROLL, 117);
move((TROLL+MAXOBJ), 122);
juggle(CHASM);
newloc := loc;
else
if loc == 117 then
newloc := 122;
else
newloc := 117;
end if;
if prop[TROLL] == 0 then
prop[TROLL] := prop[TROLL] + 1;
end if;
if toting(BEAR) == 0 then
return;
end if;
rspeak(162);
prop[CHASM] := 1;
prop[TROLL] := 2;
drop(BEAR, newloc);
fixed[BEAR] := -1;
prop[BEAR] := 3;
if prop[SPICES] < 0 then
tally2 := tally2 + 1;
end if;
oldloc2 := newloc;
death();
end if;
when else:
bug(38);
end case;
end sub;
# Routine to handle motion requests
sub domove() is
var m := motion;
gettrav(loc as uint8);
if m == NULLX then m := BACK; end if;
case m is
#when NULLX:
when BACK:
goback(loc, oldloc, oldloc2, verb);
when LOOK:
detail := detail + 1;
if detail < 3 then
rspeak(15);
end if;
wzdark := 0;
visited[loc as uint8] := 0;
newloc := loc;
loc := 0;
when CAVE:
if loc < 8 then
rspeak(57);
else
rspeak(58);
end if;
when else:
oldloc2 := oldloc;
oldloc := loc;
dotrav(loc, motion, verb);
end case;
end sub;
# pirate stuff
sub dopirate() is
var j: uint8;
var k: uint8;
if newloc == chloc or prop[CHEST] >= 0 then
return;
end if;
k := 0;
j := 50;
while j <= MAXTRS loop
if j != PYRAMID or (newloc != place[PYRAMID] and newloc != place[EMERALD]) then
if toting(j as uint16) == 1 then
rspeak(128);
if place[MESSAGE] == 0 then
move(CHEST, chloc);
end if;
move(MESSAGE, chloc2);
j := 50;
while j <= MAXTRS loop
if j == PYRAMID and (newloc == place[PYRAMID] or newloc == place[EMERALD]) then
j := j + 1;
continue;
end if;
if at(j as uint16) == 1 and fixed[j] == 0 then
carry(j as uint16, newloc);
end if;
if toting(j as uint16) == 1 then
drop(j as uint16, chloc);
end if;
j := j + 1;
end loop;
dloc[6] := chloc;
odloc[6] := chloc;
dseen[6] := 0;
end if;
if here(j as uint16) == 1 then
k := k + 1;
end if;
end if;
j := j + 1;
end loop;
if tally == tally2 + 1 and k == 0 and place[CHEST] == 0 and here(LAMP) == 1 and prop[LAMP] == 1 then
rspeak(186);
move(CHEST, chloc);
move(MESSAGE, chloc2);
dloc[6] := chloc;
odloc[6] := chloc;
dseen[6] := 0;
return;
end if;
if odloc[6] != dloc[6] and pct(20) == 1 then
rspeak(127);
return;
end if;
end sub;
# dwarf stuff.
sub dwarves() is
var i: uint8;
var j: uint8;
var k: uint8;
var try: uint8;
var attack: uint8;
var stick: uint8;
var dtotal: uint8;
# see if dwarves allowed here
if newloc == 0 or forced(newloc as uint16) == 1 or (cond[newloc as uint8] & NOPIRAT) != 0 then
return;
end if;
# see if dwarves are active.
if dflag == 0 then
if newloc > 15 then
dflag := dflag + 1;
end if;
return;
end if;
# if first close encounter (of 3rd kind) kill 0, 1 or 2
if dflag == 1 then
if newloc < 15 or pct(95) != 0 then
return;
end if;
dflag := dflag + 1;
i := 1;
while i < 3 loop
if pct(50) == 1 then
dloc[(xrnd() % 5 + 1) as uint8] := 0;
end if;
i := 1 + 1;
end loop;
i := 1;
while i < (DWARFMAX-1) loop
if dloc[i] == newloc then
dloc[i] := daltloc;
end if;
odloc[i] := dloc[i];
i := i + 1;
end loop;
rspeak(3);
drop(AXE, newloc);
return;
end if;
dtotal := 0;
attack := 0;
stick := 0;
i := 1;
while i < DWARFMAX loop
if dloc[i] == 0 then
i := i + 1;
continue;
end if;
# move a dwarf at random.
try := 1;
while try < 20 loop
j := (xrnd() % 106 + 15) as uint8; # allowed area
if j != odloc[i] as uint8 and j != dloc[i] as uint8 and not(i == (DWARFMAX-1) and (cond[j] & NOPIRAT) == 1) then
break;
end if;
try := try + 1;
end loop;
if j == 0 then
j := odloc[i] as uint8;
end if;
odloc[i] := dloc[i];
dloc[i] := j as int16;
if dseen[i] > 0 and newloc >= 15 or
dloc[i] == newloc or odloc[i] == newloc then
dseen[i] := 1;
else
dseen[i] := 0;
end if;
if dseen[i] == 0 then
i := i + 1;
continue;
end if;
dloc[i] := newloc;
if i == 6 then
dopirate();
else
dtotal := dtotal + 1;
if odloc[i] == dloc[i] then
attack := attack + 1;
if knfloc >= 0 then
knfloc := newloc;
end if;
if xrnd() % 1000 < 95*(dflag as uint16 - 2) then
stick := stick + 1;
end if;
end if;
end if;
i := i + 1;
end loop;
if dtotal == 0 then
return;
end if;
if dtotal > 1 then
print("There are ");
print(itoa(dtotal as int16));
print(" threatening little dwarves in the room with you!\n");
else
rspeak(4);
end if;
if attack == 0 then
return;
end if;
if dflag == 2 then
dflag := dflag + 1;
end if;
if attack > 1 then
print(itoa(attack as int16));
print(" of them throw knives at you!!\n");
k := 6;
else
rspeak(5);
k := 52;
end if;
if stick <= 1 then
rspeak(stick+k);
if stick == 0 then
return;
end if;
else
print(itoa(stick as int16));
print(" of them get you !!!\n");
end if;
oldloc2 := newloc;
death();
end sub;
# special time limit stuff...
sub stimer(): (ret: uint8) is
var i: uint8;
if foobar > 0 then
foobar := -foobar;
else
foobar := 0;
end if;
if tally == 0 and loc >= 15 and loc != 33 then
clock1 := clock1 - 1;
end if;
if clock1 == 0 then
# start closing the cave
prop[GRATE] := 0;
prop[FISSURE] := 0;
i := 1;
while i < DWARFMAX loop
dseen[i] := 0;
i := i + 1;
end loop;
move(TROLL, 0);
move((TROLL+MAXOBJ), 0);
move(TROLL2, 117);
move((TROLL2+MAXOBJ), 122);
juggle(CHASM);
if prop[BEAR] != 3 then
dstroy(BEAR);
end if;
prop[CHAIN] := 0;
fixed[CHAIN] := 0;
prop[AXE] := 0;
fixed[AXE] := 0;
rspeak(129);
clock1 := -1;
closing := 1;
ret := 0;
return;
end if;
if clock1 < 0 then
clock2 := clock2 - 1;
end if;
if clock2 == 0 then
# set up storage room... and close the cave...
prop[BOTTLE] := put(BOTTLE, 115, 1);
prop[PLANT] := put(PLANT, 115, 0);
prop[OYSTER] := put(OYSTER, 115, 0);
prop[LAMP] := put(LAMP, 115, 0);
prop[ROD] := put(ROD, 115, 0);
prop[DWARF] := put(DWARF, 115, 0);
loc := 115;
oldloc := 115;
newloc := 115;
var tmp: int16 := put(GRATE, 116, 0);
prop[SNAKE] := put(SNAKE, 116, 1);
prop[BIRD] := put(BIRD, 116, 1);
prop[CAGE] := put(CAGE, 116, 0);
prop[ROD2] := put(ROD2, 116, 0);
prop[PILLOW] := put(PILLOW, 116, 0);
prop[MIRROR] := put(MIRROR, 115, 0);
fixed[MIRROR] := 116;
i := 1;
while i <= MAXOBJ loop
if toting(i as uint16) == 1 then
dstroy(i as uint16);
end if;
i := i + 1;
end loop;
rspeak(132);
closed := 1;
ret := 1;
return;
end if;
if prop[LAMP] == 1 then
limit := limit - 1;
end if;
if limit <= 30 and here(BATTERIES) == 1 and prop[BATTERIES] == 0 and here(LAMP) == 1 then
rspeak(188);
prop[BATTERIES] := 1;
if (toting(BATTERIES) == 1) then
drop(BATTERIES, loc);
end if;
limit := limit + 2500;
lmwarn := 0;
ret := 0;
return;
end if;
if limit == 0 then
limit := limit - 1;
prop[LAMP] := 0;
if here(LAMP) == 1 then
rspeak(184);
end if;
ret := 0;
return;
end if;
if limit < 0 and loc <= 8 then
rspeak(185);
gaveup := 1;
normend();
end if;
if limit <= 30 then
if lmwarn > 0 or here(LAMP) == 0 then
ret := 0;
return;
end if;
lmwarn := 1;
i := 187;
if place[BATTERIES] == 0 then
i := 183;
end if;
if prop[BATTERIES] == 1 then
i := 189;
end if;
rspeak(i);
ret := 0;
return;
end if;
ret := 0;
end sub;
# Routine to process an object.
sub doobj() is
var wtype: int16;
var wval: int16;
var i: uint8;
var valid: uint8;
# is object here? if so, transitive
if fixed[object as uint8] == loc or here(object as uint16) == 1 then
trobj(verb, object, closed);
# did he give grate as destination?
elseif object == GRATE then
if loc == 1 or loc == 4 or loc == 7 then
motion := DEPRESSION;
domove();
elseif loc > 9 and loc < 15 then
motion := ENTRANCE;
domove();
end if;
# is it a dwarf he is after?
elseif dcheck() > 0 and dflag >= 2 then
object := DWARF;
trobj(verb, object, closed);
# is he trying to get/use a liquid?
elseif liq() == object as uint16 and here(BOTTLE) == 1 or liqloc(loc as uint16) == object as uint16 then
trobj(verb, object, closed);
elseif object == PLANT and at(PLANT2) == 1 and prop[PLANT2] == 0 then
object := PLANT2;
trobj(verb, object, closed);
# is he trying to grab a knife?
elseif object == KNIFE and knfloc == loc then
rspeak(116);
knfloc := -1;
# is he trying to get at dynamite?
elseif object == ROD and here(ROD2) == 1 then
object := ROD2;
trobj(verb, object, closed);
else
I_see_no();
end if;
end sub;
# Routine to take 1 turn
sub turn() @extern("turn") is
var i: uint8;
# if closing, then he can't leave except via
# the main office.
if newloc < 9 and newloc != 0 and closing == 1 then
rspeak(130);
newloc := loc;
if panic == 0 then
clock2 := 15;
end if;
panic := 1;
end if;
# see if a dwarf has seen him and has come
# from where he wants to go.
if newloc != loc and forced(loc as uint16) == 0 and cond[loc as uint8] & NOPIRAT == 0 then
i := 1;
while i < (DWARFMAX-1) loop
if odloc[i] == newloc and dseen[i] == 1 then
newloc := loc;
rspeak(2);
break;
end if;
i := i + 1;
end loop;
end if;
dwarves(); # & special dwarf(pirate who steals)
if loc != newloc then
turns := turns + 1;
loc := newloc;
# check for death
if loc == 0 then
death();
return;
end if;
# check for forced move
if forced(loc as uint16) == 1 then
describe();
domove();
return;
end if;
# check for wandering in dark
if wzdark == 1 and dark() == 1 and pct(35) == 1 then
rspeak(23);
oldloc2 := loc;
death();
return;
end if;
# describe his situation
describe();
if dark() == 0 then
visited[loc as uint8] := visited[loc as uint8] + 1;
descitem();
end if;
end if;
if closed == 1 then
if prop[OYSTER] < 0 and toting(OYSTER) == 1 then
pspeak(OYSTER, 1);
end if;
i := 1;
while i <= MAXOBJ loop
if toting(i as uint16) == 1 and prop[i] < 0 then
prop[i] := -1 - prop[i];
end if;
i := i + 1;
end loop;
end if;
wzdark := dark() as int16;
if knfloc > 0 and knfloc != loc then
knfloc := 0;
end if;
if stimer() == 1 then # as the grains of sand slip by
return;
end if;
while english() == 0 loop # retrieve player instructions
end loop;
if dbugflg == 1 then
print("loc = ");
print(itoa(loc));
print(", verb = ");
print(itoa(verb));
print(", object = ");
print(itoa(object));
print(", motion = ");
print(itoa(motion));
print_nl();
end if;
if motion != 0 then # execute player instructions
domove();
elseif object != 0 then
doobj();
else
itverb(verb, object, closed);
end if;
end sub;