home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
BBS_GAME
/
LOD400E.ZIP
/
PROGRAMR.ZIP
/
MISCO4.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-02-24
|
33KB
|
1,351 lines
unit misco4;
{$O+,F+,V-,I+}
interface
uses dos, crt, gtvideo, ddlod, gtscott, globals, misc, emsalloc, strio, setgen;
procedure ReadObjs;
procedure WriteObjs;
procedure OpenFiles;
procedure WriteBases;
procedure WritePuritron;
procedure WriteMdata;
procedure WriteTeams;
implementation
procedure bwrite(s: string);
begin;
swrite(#13+' ■ ');
while length(s)<70 do s:=s+' ';
swrite(s);
end;
procedure Error(s: string);
begin;
gtextcolor(15);
gwriteln('');
gwriteln(s);
delay(5000);
halt;
end;
procedure ReadObjs;
const
numtoread=50;
type
devarray=array[1..numtoread] of devicetype;
daptr=^devarray;
var
o: daptr;
a: integer;
objfile: file;
numread: word;
begin;
assign(objfile,'OBJECTS.DAT');
reset(objfile,1);
if filesize(objfile) mod sizeof(devicetype) <>0 then
error('Error - OBJECTS.DAT is corrupted!');
close(objfile);
reset(objfile,sizeof(devicetype));
new(o);
blockread(objfile,o^,1);
numolist:=0;
numread:=numtoread;
while (numread=numtoread) do begin;
blockread(objfile,o^,numtoread,numread);
for a:=1 to numread do if (o^[a].num<>0) and (numolist<numobj) then begin;
inc(numolist);
new(objects[numolist]);
objects[numolist]^:=o^[a];
end;
end;
close(objfile);
dispose(o);
end;
procedure WriteObjs;
var
o: devicetype;
a,b: integer;
objfile: file of devicetype;
begin;
assign(objfile,'OBJECTS.DAT');
rewrite(objfile);
fillchar(o,sizeof(o),0);
b:=0;
write(objfile,o);
for a:=1 to numolist do if objects[a]<>nil then begin;
inc(b);
write(objfile,objects[a]^);
end;
close(objfile);
end;
procedure blankbases;
var
a: integer;
begin;
fillchar(bases^,sizeof(bases^),0);
for a:=1 to numbase do bases^[a].active:=false;
end;
procedure LoadStringDef;
var
a: integer;
b: longint;
m: longint;
ch1,ch2: char;
s: string;
stroffset: longint;
bread: integer;
begin;
bwrite('Loading String Definitions');
seek(gamebin,0);
blockread(gamebin,s,8);
s[0]:=#7;
val(s,stroffset,a);
seek(gamebin,stroffset);
blockread(gamebin,ch1,1);
blockread(gamebin,ch2,1);
blockread(gamebin,strdef_numindex,2);
strdef_idxsize:=(strdef_numindex+1)*sizeof(idrec);
strdef_idxstart:=filepos(gamebin);
strdef_strstart:=strdef_idxsize+strdef_idxstart;
m:=memavail;
openstringcache;
m:=m-memavail;
strdefbytes:=m;
numstrdef:=strdef_numindex;
end;
procedure AddTeleCode(d: word; x,y: word);
var
a,b,c: integer;
c1,c2,c3: integer;
bad: boolean;
count: word;
begin;
c1:=(x mod 3)+1;
c2:=(y mod 3)+1;
c3:=((x+y) mod 3)+1;
c:=0;
for a:=1 to numtcode do if (telecodes[a].d=0) and (c=0) then c:=a;
if c=0 then exit;
count:=1;
repeat;
bad:=false;
for a:=1 to numtcode do if (telecodes[a].c[1]=c1) and (telecodes[a].c[2]=c2) and (telecodes[a].c[3]=c3) then bad:=true;
if bad then begin;
inc(c3);
if c3>3 then begin;
c3:=1;
inc(c2);
if c2>3 then begin;
c2:=1;
inc(c1);
if c1>1 then c1:=1;
end;
end;
end;
inc(count);
until (not bad) or (count=100);
if not bad then begin;
telecodes[c].c[1]:=c1;
telecodes[c].c[2]:=c2;
telecodes[c].c[3]:=c3;
telecodes[c].x:=x;
telecodes[c].y:=y;
telecodes[c].z:=1;
telecodes[c].d:=d;
end;
end;
procedure maketelecodes;
var
z,x,y: word;
begin;
fillchar(telecodes,sizeof(telecodes),0);
for z:=1 to maxmapz do for x:=1 to maxmapx do for y:=1 to maxmapy do if getmap(z,x,y) in [9,10] then begin;
AddTeleCode(1,x,y);
end;
AddTeleCode(2,3,4);
AddTeleCode(3,5,6);
end;
procedure SqrIt(var n: word);
begin;
n:=n*n;
end;
procedure loaddevdef;
var
devs: devdeftype;
a,b: word;
numread: word;
devofs,devsize: longint;
s: string;
junk: integer;
begin;
seek(gamebin,22);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,devofs,junk);
seek(gamebin,43);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,devsize,junk);
if (devsize mod sizeof(devdeftype))<>0 then error('Error - Fubar in dev def');
devgood:=0;
devfill:=0;
devnil:=0;
b:=0;
seek(gamebin,devofs);
for a:=1 to devsize div sizeof(devdeftype) do begin;
blockread(gamebin,devs,sizeof(devdeftype));
if (b<=numdev) then begin;
if (b<>0) and (stu(devs.name)='NIL') and (devs.store=[]) and (ord(devs.devapp)=0) then begin;
inc(devnil);
devicedef[b]:=devicedef[0];
end else begin;
getmem(devicedef[b],sizeof(devdeftype));
devicedef[b]^:=devs;
devicedef[b]^.num:=b;
inc(devgood);
end;
inc(b);
end;
end;
if b<numdev then for a:=b to numdev do begin;
devicedef[a]:=devicedef[0];
inc(devfill);
end;
end;
procedure loaddevdefs;
begin;
bwrite('Loading device definitions');
devgood:=0;
devfill:=0;
devnil:=0;
loaddevdef;
end;
procedure LoadGameDef;
var
gddone: boolean;
linepos: word;
donemonster: boolean;
donecombat: boolean;
doneweapsmth: boolean;
donespweap: boolean;
donetalk: boolean;
donetroy: boolean;
donetrell: boolean;
donehist: boolean;
donetavern: boolean;
donemisc: boolean;
donelaphelp: boolean;
donecomm: boolean;
doneptron: boolean;
donenpcfort: boolean;
donegenobj: boolean;
s: string;
ofm: word;
procedure loadmisc;
var
s,s2,s3,s4: string;
done: boolean;
a,n: integer;
begin;
bwrite('Loading data set information');
fillchar(dataset,sizeof(dataset),0);
done:=false;
n:=0;
while (not eof(gamedef)) and (not done) do begin;
inc(linepos);
readln(gamedef,s);
if s='&&&END' then begin;
done:=true;
end else begin;
inc(n);
case n of
1: dataset.name:=newstr(s);
2: dataset.author:=newstr(s);
3: dataset.menustem:=s;
4: val(s,dataset.sdstart,a);
5: val(s,dataset.sdend,a);
6: dataset.prodname[1]:=newstr(s);
7: dataset.prodname[2]:=newstr(s);
8: dataset.prodname[3]:=newstr(s);
9..18: dataset.cityname[n-8]:=newstr(s);
19: dataset.hisstr:=newstr(s);
20: dataset.herstr:=newstr(s);
21: dataset.itsstr:=newstr(s);
22: dataset.hestr:=newstr(s);
23: dataset.shestr:=newstr(s);
24: dataset.itstr:=newstr(s);
25: dataset.mhimstr:=newstr(s);
26: dataset.fhimstr:=newstr(s);
27: dataset.ihimstr:=newstr(s);
28: val(s,dataset.obstart,a);
29: val(s,dataset.obend,a);
30: dataset.egadoccent:=s;
31: dataset.egacomcent:=s;
32: dataset.egaclone:=s;
33: dataset.egapurroom:=s;
34: dataset.egafinance:=s;
35: dataset.egasurr:=s;
36: dataset.egafortatck:=s;
37: dataset.egafortcnfg:=s;
38: dataset.egatavern:=s;
39: dataset.egabartalk:=s;
40: dataset.egaftrade:=s;
41: dataset.egafortfin:=s;
42: dataset.egafortret:=s;
43: dataset.egafortmm1:=s;
44: dataset.egafortbad:=s;
45: dataset.egafortmain:=s;
46: dataset.egalaptop:=s;
47: dataset.egaeeeebig:=s;
48: dataset.egakillbig:=s;
49: dataset.egahortbig:=s;
50: dataset.egahortstor:=s;
51: dataset.egatport:=s;
52: dataset.egateam:=s;
53: dataset.egatquart:=s;
54..63: dataset.egatown[n-53]:=s;
64: val(s,dataset.kelpreward,a);
65: val(s,dataset.emwarpmine,a);
66: dataset.egatele1:=s;
67: dataset.egatele2:=s;
68: dataset.egatranlius:=s;
69: dataset.charpic[male]:=s;
70: dataset.charpic[female]:=s;
71: dataset.charpic[other]:=s;
72..81: val(s,dataset.townsalv[n-71],a);
82: dataset.egaacmemain:=s;
83: dataset.egaacmetech:=s;
84: dataset.egaacmeweapsmith:=s;
85: dataset.egaacmeweap:=s;
86: dataset.egaacmefort:=s;
87: dataset.egaloki:=s;
88: dataset.egatadsu:=s;
end;
end;
end;
donemisc:=true;
end;
procedure loadmonster;
var
done: boolean;
s: string;
a,b: integer;
begin;
bwrite('Indexing monsters');
nummondef:=0;
done:=false;
while (not eof(gamedef)) and (nummondef<maxmon) and (not done) do begin;
inc(linepos);
readln(gamedef,s);
if s='&&&END' then begin;
done:=true;
end else if pos('NAME',s)=1 then begin;
inc(nummondef);
EAAlloc(mondef[nummondef],sizeof(monsterrec));
fillchar(EAAddr(mondef[nummondef])^,sizeof(monsterrec),0);
MonsterRec(EAAddr(mondef[nummondef])^).line:=linepos;
MonsterRec(EAAddr(mondef[nummondef])^).origx:=255;
MonsterRec(EAAddr(mondef[nummondef])^).origy:=255;
MonsterRec(EAAddr(mondef[nummondef])^).origz:=255;
MonsterRec(EAAddr(mondef[nummondef])^).mindist:=0;
MonsterRec(EAAddr(mondef[nummondef])^).maxdist:=100;
end else if (pos('MINDIST',s)=1) and (nummondef>0) then begin;
delete(s,1,8);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).mindist,b);
sqrit(MonsterRec(EAAddr(mondef[nummondef])^).mindist);
end else if (pos('MAXDIST',s)=1) and (nummondef>0) then begin;
delete(s,1,8);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).maxdist,b);
sqrit(MonsterRec(EAAddr(mondef[nummondef])^).maxdist);
end else if (pos('ORIGX',s)=1) and (nummondef>0) then begin;
delete(s,1,6);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).origx,b);
end else if (pos('ORIGY',s)=1) and (nummondef>0) then begin;
delete(s,1,6);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).origy,b);
end else if (pos('ORIGZ',s)=1) and (nummondef>0) then begin;
delete(s,1,6);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).origz,b);
end else if (pos('STR',s)=1) and (nummondef>0) then begin;
delete(s,1,4);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).str,b);
end else if (pos('DEX',s)=1) and (nummondef>0) then begin;
delete(s,1,4);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).dex,b);
end else if (pos('AGL',s)=1) and (nummondef>0) then begin;
delete(s,1,4);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).agl,b);
end else if (pos('IFALIVE',s)=1) and (nummondef>0) then begin;
delete(s,1,8);
val(s,MonsterRec(EAAddr(mondef[nummondef])^).ifalive,b);
end else if (pos('ISREAL',s)=1) and (nummondef>0) then begin;
delete(s,1,7);
val(s,Monsterrec(EAAddr(mondef[nummondef])^).isreal,b);
if Monsterrec(EAAddr(mondef[nummondef])^).isreal<>0 then
MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonisreal;
end else if (pos('■TR ',s)=1) and (nummondef>0) then begin;
delete(s,1,4);
b:=0;
for a:=1 to maxtrestrict do if (b=0) and (MonsterRec(EAAddr(mondef[nummondef])^).trestrict[a]=0) then b:=a;
if b<>0 then val(s,MonsterRec(EAAddr(mondef[nummondef])^).trestrict[b],a);
end else if (pos('WATERONLY',s)=1) and (nummondef>0) then begin;
MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonwateronly;
end else if (pos('LANDWATER',s)=1) and (nummondef>0) then begin;
MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonlandwater;
end else if (pos('NORANDOM',s)=1) and (nummondef>0) then begin;
Monsterrec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonnorandom;
end;
end;
donemonster:=true;
end;
procedure loadtalk;
var
a: word;
done: boolean;
s: string;
begin;
bwrite('Processing dialog');
talkstart:=linepos;
done:=false;
while (not eof(gamedef)) and (not done) do begin;
inc(linepos);
readln(gamedef,s);
if s='&&&END' then begin;
done:=true;
end;
end;
donetalk:=true;
end;
procedure LoadCstr;
var
f: text;
s: string;
s2,s3,s4: string[80];
a,b: integer;
done: boolean;
begin;
bwrite('Loading combat string tables');
done:=false;
numgroups:=0;
while (not eof(gamedef)) and (not done) do begin;
inc(linepos);
readln(gamedef,s);
if s='&&&END' then begin;
done:=true;
end else if stu(s)='NEWGROUP' then begin;
inc(numgroups);
new(groups[numgroups]);
fillchar(groups[numgroups]^,sizeof(groups[numgroups]^),0);
end else if (pos('INCLUDE',stu(s))=1) and (numgroups>0) then begin;
if groups[numgroups]^.numinclude<maxinclude then begin;
delete(s,1,8);
s2:='';
s3:='';
s4:='';
inc(groups[numgroups]^.numinclude);
while (s[1]<>' ') and (length(s)>0) do begin;
s2:=s2+s[1];
delete(s,1,1);
end;
while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
while (s[1]<>' ') and (length(s)>0) do begin;
s3:=s3+s[1];
delete(s,1,1);
end;
while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
while (s[1]<>' ') and (length(s)>0) do begin;
s4:=s4+s[1];
delete(s,1,1);
end;
while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
groups[numgroups]^.include[groups[numgroups]^.numinclude].code:=s2;
val(s3,a,b);
groups[numgroups]^.include[groups[numgroups]^.numinclude].guy1:=a;
val(s4,a,b);
groups[numgroups]^.include[groups[numgroups]^.numinclude].guy2:=a;
end;
end else if (numgroups>0) and (s<>'') and (s[1]<>';') then begin;
inc(groups[numgroups]^.numstr);
val(s,groups[numgroups]^.strings[groups[numgroups]^.numstr],a);
end;
end;
donecombat:=true;
end;
procedure loadtroy;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,troystart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,troyend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
donetroy:=true;
end;
procedure loadspweap;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,spwstart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,spwend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
donespweap:=true;
end;
procedure loadweapsmth;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,wpsmstart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,wpsmend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
doneweapsmth:=true;
end;
procedure loadtrell;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,trellstart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,trellend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
donetrell:=true;
end;
procedure loadhist;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,histstart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,histend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
donehist:=true;
end;
procedure loadlaphelp;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,laphelpstart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,laphelpend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
donelaphelp:=true;
end;
procedure loadcomm;
var
a: word;
s: string;
begin;
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,commstart,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
val(s,commend,a);
if eof(gamedef) then exit;
inc(linepos);
readln(gamedef,s);
if s<>'&&&END' then exit;
donecomm:=true;
end;
procedure pullints(s: string; var i1,i2,i3,i4: longint);
var
junk: integer;
s1: string;
begin;
while (s<>'') and (s[1]=' ') do delete(s,1,1);
while s[length(s)]=' ' do dec(s[0]);
s:=s+'/';
s1:=copy(s,1,pos('/',s)-1);
delete(s,1,pos('/',s));
val(s1,i1,junk);
if pos('/',s)<>0 then begin;
s1:=copy(s,1,pos('/',s)-1);
delete(s,1,pos('/',s));
val(s1,i2,junk);
end;
if pos('/',s)<>0 then begin;
s1:=copy(s,1,pos('/',s)-1);
delete(s,1,pos('/',s));
val(s1,i3,junk);
end;
if pos('/',s)<>0 then begin;
s1:=copy(s,1,pos('/',s)-1);
delete(s,1,pos('/',s));
val(s1,i4,junk);
end;
end;
procedure loadgenobj;
var
t1,t2,t3,t4,tstart,tend,cnvin,cnvout: longint;
temp: genobjptr;
done: boolean;
current: word;
junk: integer;
iflist: ifptr;
function addentry(tag: word; ogtype: ogtypetype; tstart,tend: word): genobjptr;
begin;
if numgenobj<maxgenobj then begin;
inc(numgenobj);
new(genobj[numgenobj]);
genobj[numgenobj]^.tag:=tag;
genobj[numgenobj]^.ogtype:=ogtype;
genobj[numgenobj]^.tstart:=tstart;
genobj[numgenobj]^.tend:=tend;
genobj[numgenobj]^.iflist:=iflist;
addentry:=genobj[numgenobj];
end else begin;
addentry:=nil;
end;
iflist:=nil;
end;
procedure addif(iftype: iftypetype; data: longint);
var
current,temp: ifptr;
begin;
if iflist=nil then begin;
new(iflist);
temp:=iflist;
end else begin;
current:=iflist;
while (current^.next<>nil) do begin;
current:=current^.next;
end;
new(temp);
current^.next:=temp;
end;
temp^.next:=nil;
temp^.iftype:=iftype;
temp^.data:=data;
end;
begin;
current:=0;
numgenobj:=0;
done:=false;
iflist:=nil;
while (not eof(gamedef)) and (not done) do begin;
inc(linepos);
readln(gamedef,s);
if pos('TAG ',s)<>0 then begin;
delete(s,1,4);
val(s,current,junk);
end else if pos('HEADER ',s)<>0 then begin;
delete(s,1,7);
pullints(s,tstart,tend,t1,t2);
addentry(current,ogHeader,tstart,tend);
end else if pos('FOOTER ',s)<>0 then begin;
delete(s,1,7);
pullints(s,tstart,tend,t1,t2);
addentry(current,ogFooter,tstart,tend);
end else if pos('RANDOM ',s)<>0 then begin;
delete(s,1,7);
pullints(s,tstart,tend,t1,t2);
addentry(current,ogRandText,tstart,tend);
end else if pos('CONVERT ',s)<>0 then begin;
delete(s,1,8);
pullints(s,cnvin,cnvout,tstart,tend);
temp:=addentry(current,ogConvert,tstart,tend);
temp^.cnvin:=cnvin;
temp^.cnvout:=cnvout;
end else if pos('ADDITEM ',s)<>0 then begin;
delete(s,1,8);
pullints(s,cnvin,cnvout,tstart,tend);
temp:=addentry(current,ogAddItem,tstart,tend);
temp^.cnvin:=cnvin;
temp^.cnvout:=cnvout;
end else if pos('REPLICATE ',s)<>0 then begin;
delete(s,1,10);
pullints(s,tstart,tend,t1,t2);
temp:=addentry(current,ogreplicate,tstart,tend);
end else if pos('FAIL ',s)<>0 then begin;
delete(s,1,5);
pullints(s,tstart,tend,t1,t2);
temp:=addentry(current,ogfail,tstart,tend);
end else if pos('IFTERRAIN ',s)<>0 then begin;
delete(s,1,10);
pullints(s,t1,t2,t3,t4);
addif(ifTerrain,t1);
end else if pos('IFNTERRAIN ',s)<>0 then begin;
delete(S,1,11);
pullints(s,t1,t2,t3,t4);
addif(ifNTerrain,t1);
end else if pos('IFQUEST ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(ifQuest,t1);
end else if pos('IFNQUEST ',s)<>0 then begin;
delete(s,1,9);
pullints(s,t1,t2,t3,t4);
addif(ifNQuest,t1);
end else if pos('IFPURITRON ',s)<>0 then begin;
delete(s,1,11);
pullints(s,t1,t2,t3,t4);
addif(ifPuritron,t1);
end else if pos('IFNPURITRON ',s)<>0 then begin;
delete(s,1,12);
pullints(s,t1,t2,t3,t4);
addif(ifNPuritron,t1);
end else if pos('IFLEVEL ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(ifLevel,t1);
end else if pos('IFNLEVEL ',s)<>0 then begin;
delete(s,1,9);
pullints(s,t1,t2,t3,t4);
addif(ifNLevel,t1);
end else if pos('IFEXPER ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(ifExper,t1);
end else if pos('IFNEXPER ',s)<>0 then begin;
delete(s,1,9);
pullints(s,t1,t2,t3,t4);
addif(ifNExper,t1);
end else if pos('IFMINDIST ',s)<>0 then begin;
delete(s,1,10);
pullints(s,t1,t2,t3,t4);
addif(ifMindist,t1);
end else if pos('IFMAXDIST ',s)<>0 then begin;
delete(s,1,10);
pullints(s,t1,t2,t3,t4);
addif(ifMaxdist,t1);
end else if pos('IFTESTX ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(iftestx,t1);
end else if pos('IFTESTY ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(iftesty,t1);
end else if pos('IFTESTZ ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(iftestz,t1);
end else if pos('IFNTESTX ',s)<>0 then begin;
delete(s,1,9);
pullints(s,t1,t2,t3,t4);
addif(ifntestx,t1);
end else if pos('IFNTESTY ',s)<>0 then begin;
delete(s,1,9);
pullints(s,t1,t2,t3,t4);
addif(ifntesty,t1);
end else if pos('IFNTESTZ ',s)<>0 then begin;
delete(s,1,9);
pullints(s,t1,t2,t3,t4);
addif(ifntestz,t1);
end else if pos('DOSPECIAL ',s)<>0 then begin;
delete(s,1,10);
s:=stu(trimstr(s));
if s='LOKI' then begin;
addif(ifDoLoki,0);
end else if s='SERPINE' then begin;
addif(ifDoSerpine,0);
end;
end else if pos('DOQUEST ',s)<>0 then begin;
delete(s,1,8);
pullints(s,t1,t2,t3,t4);
addif(ifDoQuest,t1);
end else if s='&&&END' then begin;
donegenobj:=true;
done:=true;
end;
end;
end;
procedure loadptron;
var
s1,s2: string;
junk: integer;
partnum: word;
st,en: word;
done: boolean;
begin;
done:=false;
while not done do begin;
inc(linepos);
readln(gamedef,s);
if pos('PFS ',s)=1 then begin;
delete(s,1,4);
s2:=copy(s,1,pos(' ',s)-1);
val(s2,partnum,junk);
delete(s,1,pos(' ',s));
val(s,st,junk);
inc(linepos);
readln(gamedef,s);
delete(s,1,4);
val(s,en,junk);
if (partnum>0) and (partnum<=numpurparts) then begin;
pfstart[partnum]:=st;
pfend[partnum]:=en;
end;
end else if pos('AFS ',s)=1 then begin;
delete(s,1,4);
s2:=copy(s,1,pos(' ',s)-1);
val(s2,partnum,junk);
delete(s,1,pos(' ',s));
val(s,st,junk);
inc(linepos);
readln(gamedef,s);
delete(s,1,4);
val(s,en,junk);
if (partnum>0) and (partnum<=numpurparts) then begin;
afstart[partnum]:=st;
afend[partnum]:=en;
end;
end else if s='&&&END' then begin;
doneptron:=true;
done:=true;
end else done:=true;
end;
end;
procedure loadtavern;
var
a: word;
done: boolean;
s,s2: string;
n1,n2: word;
begin;
bwrite('Loading tavern data');
numtav:=0;
done:=false;
while (not eof(gamedef)) and (not done) do begin;
inc(linepos);
readln(gamedef,s);
if s='&&&END' then begin;
done:=true;
end else begin;
while (s<>'') and (s[1]=' ') do delete(s,1,1);
s2:='';
while (s<>'') and (s[1]<>' ') do begin;
s2:=s2+s[1];
delete(s,1,1);
end;
val(s2,n1,a);
while (s<>'') and (s[1]=' ') do delete(s,1,1);
s2:='';
while (s<>'') and (s[1]<>' ') do begin;
s2:=s2+s[1];
delete(s,1,1);
end;
val(s2,n2,a);
while (s<>'') and (s[1]=' ') do delete(s,1,1);
if (s<>'') and (n1<>0) and (n2<>0) and (numtav<maxtav) then begin;
inc(numtav);
new(tavern[numtav]);
tavern[numtav]^.personnum:=n2;
tavern[numtav]^.townnum:=n1;
tavern[numtav]^.personname:=s;
end;
end;
end;
donetavern:=true;
end;
procedure loadnpcfort;
var
s: string;
begin;
donenpcfort:=true;
npcfortstart:=linepos;
readln(gamedef,s);
inc(linepos);
end;
begin;
donemonster:=false;
donecombat:=false;
donespweap:=false;
doneweapsmth:=false;
donetalk:=false;
donetrell:=false;
donetroy:=false;
donehist:=false;
donetavern:=false;
donemisc:=false;
donelaphelp:=false;
donecomm:=false;
doneptron:=false;
donenpcfort:=false;
donegenobj:=false;
linepos:=0;
gddone:=false;
while (not eof(gamedef)) and (not gddone) do begin;
inc(linepos);
readln(gamedef,s);
while (s[1]=' ') and (s<>'') do delete(s,1,1);
while s[length(s)]=' ' do dec(s[0]);
if (s<>'') and (s[1]<>';') then begin;
if s='&&&NPCFORT' then loadnpcfort;
if s='&&&MONSTER' then loadmonster;
if s='&&&TALK' then loadtalk;
if s='&&&COMBAT' then loadcstr;
if s='&&&TROYINFO' then loadtroy;
if s='&&&TRELLNOT' then loadtrell;
if s='&&&HISTORY' then loadhist;
if s='&&&SPWEAP' then loadspweap;
if s='&&&WEAPSMTH' then loadweapsmth;
if s='&&&TAVERN' then loadtavern;
if s='&&&MISC' then loadmisc;
if s='&&&LAPHELP' then loadlaphelp;
{ if s='&&&COMMUNIC' then loadcomm;}
if s='&&&GENOBJ' then loadgenobj;
if s='&&&PTRONTEXT' then loadptron;
if s='&&&DONE' then gddone:=true;
end;
end;
if not doneweapsmth then error('Err: could not load weapsmth from GAME.DEF.');
if not donenpcfort then error('Err: could not load npcfort from GAME.DEF.');
if not donemonster then error('Err: could not load monster from GAME.DEF.');
if not donecombat then error('Err: could not load combat from GAME.DEF.');
if not donetalk then error('Err: could not load talk from GAME.DEF.');
if not donetroy then error('Err: could not load troyinfo from GAME.DEF.');
if not donespweap then error('Err: could not load spweap from GAME.DEF.');
if not donetrell then error('Err: could not load trellnot from GAME.DEF.');
if not donehist then error('Err: could not load history from GAME.DEF.');
if not donetavern then error('Err: could not load tavern from GAME.DEF.');
if not donemisc then error('Err: could not load dataset from GAME.DEF.');
if not donelaphelp then error('Err: could not load latop help from GAME.DEF.');
{ if not donecomm then error('Err: could not load communic from GAME.DEF.');}
if not doneptron then error('Err: could not load ptron from GAME.DEF.');
end;
procedure opengamedef;
var
ofm: word;
buf: array[1..1024] of byte;
bread: word;
f2: file;
s: string[8];
a,b: integer;
begin;
bwrite('Reading Master Game Definition');
assign(gamebin,'GAME.DEF');
reset(gamebin,1);
seek(gamebin,50);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,a,b);
if a<>compilerev then begin;
sclrscr;
swriteln('Error! The Dataset file (GAME.DEF) was compiled for an earlier version');
swriteln('of LOD. Please contact the author of that dataset for a new version or');
swriteln('revert to original GAME.DEF file that is contained in LODxxxB.ZIP.');
delay(8000);
halt;
end;
assign(gamedef,'GAME.DEF');
{$I-}
reset(gamedef);
{$I+}
if ioresult<>0 then begin;
bwrite('Data access fault: Duplicating GAME.DEF');
assign(f2,'GAME.DE2');
rewrite(f2,1);
bread:=1024;
while (bread=1024) do begin;
blockread(gamebin,buf,1024,bread);
blockwrite(f2,buf,bread);
end;
close(f2);
assign(gamedef,'GAME.DE2');
reset(gamedef);
end;
end;
procedure fixmonsters;
var
cz,cx,cy: byte;
a: integer;
begin;
findcity(1,cz,cx,cy);
for a:=1 to nummondef do if MonsterRec(EAAddr(mondef[a])^).origz=255 then begin;
MonsterRec(EAAddr(mondef[a])^).origz:=cz;
MonsterRec(EAAddr(mondef[a])^).origx:=cx;
MonsterRec(EAAddr(mondef[a])^).origy:=cy;
end;
end;
procedure loadmap(n: word);
var
a: integer;
s: string[10];
mapofs: longint;
begin;
seek(gamebin,8);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,mapofs,a);
seek(gamebin,mapofs);
blockread(gamebin,zmap^,sizeof(zmap^));
end;
procedure loadterrain;
var
a: integer;
s: string[10];
mapofs: longint;
begin;
bwrite('Loading terrain definitions');
seek(gamebin,15);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,mapofs,a);
seek(gamebin,mapofs);
blockread(gamebin,terrain,sizeof(terrain));
end;
procedure loadquests;
var
a: integer;
s: string[10];
mapofs: longint;
begin;
bwrite('Loading quest definitions');
seek(gamebin,57);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,mapofs,a);
seek(gamebin,mapofs);
blockread(gamebin,quests,sizeof(quests));
end;
procedure loadgeneral;
var
a: integer;
s: string[10];
fsize, mapofs: longint;
bread: word;
begin;
bwrite('Loading general data');
seek(gamebin,29);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,mapofs,a);
seek(gamebin,36);
blockread(gamebin,s[1],7);
s[0]:=#7;
val(s,fsize,a);
if fsize>sizeof(general) then fsize:=sizeof(general);
seek(gamebin,mapofs);
blockread(gamebin,general,fsize,bread);
end;
procedure OpenFiles;
var
a,b: integer;
u: usertype;
o: devicetype;
f: file;
t: text;
basfile: file of basearray;
genfile: file of generaltype;
objfile: file of devicetype;
dayfile: file;
teafile: file;
pfile: file;
s: string[80];
cz,cx,cy: byte;
uidx: file of useridxarray;
clone: clonetype;
cfile: file;
begin;
if ((exist('USERS.DAT')) or (exist('OBJECTS.DAT')) or (exist('BASES.DAT')))
and not exist('LVER400.DAT') then begin;
swriteln('Datafiles on disk are not up to date!');
swriteln('');
swriteln('I suggest you do one of the following:');
swriteln('');
swriteln(' 1) Run CVT400.EXE to convert old datafiles to new ones.');
swriteln('');
swriteln(' 2) DEL *.DAT and re-run GAME.EXE to restart game.');
swriteln('');
swrite('Press any key to continue.');
if sreadkey=' ' then ;
halt;
end;
setgeneral;
opengamedef;
loadgeneral;
loadterrain; {must be before gamedef because of terrain restrictions}
loadgamedef;
loadmap(1);
loaddevdefs;
loadquests;
assign(t,'LVER400.DAT');
rewrite(t);
writeln(t,'Version identification file. Do not delete');
close(t);
assign(userfile,'USERS.DAT');
{$I-}
reset(userfile);
{$I+}
if ioresult<>0 then begin;
rewrite(userfile);
blankuser(u);
u.x:=0;
u.y:=0;
u.z:=0;
for a:=0 to 255 do write(userfile,u);
reset(userfile);
end;
bwrite('Reading Objects');
if not exist('OBJECTS.DAT') then begin;
assign(objfile,'OBJECTS.DAT');
rewrite(objfile);
fillchar(o,sizeof(o),0);
write(objfile,o);
close(objfile);
end;
readobjs;
bwrite('Reading Fortresses');
assign(basfile,'BASES.DAT');
{$I-}
reset(basfile);
{$I+}
if ioresult<>0 then begin;
BlankBases;
rewrite(basfile);
write(basfile,bases^);
close(basfile);
end else begin;
close(basfile);
assign(f,'BASES.DAT');
reset(f,1);
if filesize(f)<>31800 then
error('Error - BASES.DAT has been corrupted!');
close(f);
reset(basfile);
read(basfile,bases^);
close(basfile);
end;
assign(uidx,'USERIDX.DAT');
{$I-}
reset(uidx);
{$I+}
if ioresult<>0 then begin;
fillchar(useridx,sizeof(useridx),0);
rewrite(uidx);
write(uidx,useridx);
close(uidx);
end else begin;
read(uidx,useridx);
close(uidx);
end;
bwrite('Opening Clone File');
assign(clonefile,'CLONES.DAT');
{$I-}
reset(clonefile);
{$I+}
if ioresult<>0 then begin;
fillchar(clone,sizeof(clone),0);
clone.alive:=false;
rewrite(clonefile);
for a:=0 to 255 do write(clonefile,clone);
reset(clonefile);
end;
bwrite('Opening Puritron File');
assign(pfile,'PURITRON.DAT');
{$I-}
reset(pfile,1);
{$I+}
if ioresult<>0 then begin;
fillchar(puritron,sizeof(puritron),0);
for a:=1 to numpurparts do begin;
puritron.parts[a].ishere:=false;
puritron.parts[a].reset:=false;
end;
rewrite(pfile,1);
blockwrite(pfile,puritron,sizeof(puritron));
close(pfile);
end else begin;
if filesize(pfile)<>sizeof(puritron) then
error('Error - Puritron.dat has been corrupted.');
blockread(pfile,puritron,sizeof(puritron));
close(pfile);
end;
bwrite('Opening MData File');
assign(cfile,'MDATA.DAT');
{$I-}
reset(cfile,1);
{$I+}
if ioresult<>0 then begin;
fillchar(mdata^,sizeof(mdata^),0);
rewrite(cfile,1);
blockwrite(cfile,mdata^,sizeof(mdata^));
close(cfile);
end else begin;
if filesize(cfile)<>sizeof(mdata^) then
error('Error - MDATA.dat has been corrupted.');
Blockread(cfile,mdata^,sizeof(mdata^));
close(cfile);
end;
bwrite('Opening Team File');
fillchar(EAAddr(teams)^,sizeof(teamarray),0);
assign(teafile,'TEAMS.DAT');
{$i-}
reset(teafile,1);
{$I+}
if ioresult=0 then begin;
if filesize(teafile)<>sizeof(teamarray) then
error('Error - Teams.Dat has been corrupted.');
EABlockRead(teafile,teams,sizeof(teamarray));
close(teafile);
end;
fixmonsters;
maketelecodes;
loadstringdef;
bwrite('Startup completed');
swriteln('');
end;
procedure WriteTeams;
var
teamfile: file;
begin;
assign(teamfile,'TEAMS.DAT');
rewrite(teamfile,1);
EAblockwrite(teamfile,teams,sizeof(teamarray));
close(teamfile);
end;
procedure WriteMdata;
var
cfile: file;
begin;
assign(cfile,'MDATA.DAT');
rewrite(cfile,1);
Blockwrite(cfile,mdata^,sizeof(mdata^));
close(cfile);
end;
procedure WritePuritron;
var
pfile: file;
begin;
assign(pfile,'PURITRON.DAT');
rewrite(pfile,1);
blockwrite(pfile,puritron,sizeof(puritron));
close(pfile);
end;
procedure WriteBases;
var
basfile: file;
begin;
assign(basfile,'BASES.DAT');
reset(basfile,1);
blockwrite(basfile,bases^,sizeof(bases^));
close(basfile);
end;
end.