home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / BBS_GAME / LOD400E.ZIP / PROGRAMR.ZIP / MISCO4.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-24  |  33KB  |  1,351 lines
  1. unit misco4;
  2. {$O+,F+,V-,I+}
  3.  
  4. interface
  5. uses dos, crt, gtvideo, ddlod, gtscott, globals, misc, emsalloc, strio, setgen;
  6.  
  7. procedure ReadObjs;
  8. procedure WriteObjs;
  9. procedure OpenFiles;
  10. procedure WriteBases;
  11. procedure WritePuritron;
  12. procedure WriteMdata;
  13. procedure WriteTeams;
  14.  
  15. implementation
  16.  
  17. procedure bwrite(s: string);
  18. begin;
  19.  swrite(#13+' ■ ');
  20.  while length(s)<70 do s:=s+' ';
  21.  swrite(s);
  22. end;
  23.  
  24. procedure Error(s: string);
  25. begin;
  26.  gtextcolor(15);
  27.  gwriteln('');
  28.  gwriteln(s);
  29.  delay(5000);
  30.  halt;
  31. end;
  32.  
  33. procedure ReadObjs;
  34. const
  35.  numtoread=50;
  36. type
  37.  devarray=array[1..numtoread] of devicetype;
  38.  daptr=^devarray;
  39. var
  40.  o: daptr;
  41.  a: integer;
  42.  objfile: file;
  43.  numread: word;
  44. begin;
  45.  assign(objfile,'OBJECTS.DAT');
  46.  reset(objfile,1);
  47.  if filesize(objfile) mod sizeof(devicetype) <>0 then
  48.   error('Error - OBJECTS.DAT is corrupted!');
  49.  
  50.  close(objfile);
  51.  reset(objfile,sizeof(devicetype));
  52.  
  53.  new(o);
  54.  blockread(objfile,o^,1);
  55.  numolist:=0;
  56.  numread:=numtoread;
  57.  while (numread=numtoread) do begin;
  58.   blockread(objfile,o^,numtoread,numread);
  59.   for a:=1 to numread do if (o^[a].num<>0) and (numolist<numobj) then begin;
  60.    inc(numolist);
  61.    new(objects[numolist]);
  62.    objects[numolist]^:=o^[a];
  63.   end;
  64.  end;
  65.  close(objfile);
  66.  dispose(o);
  67. end;
  68.  
  69. procedure WriteObjs;
  70. var
  71.  o: devicetype;
  72.  a,b: integer;
  73.  objfile: file of devicetype;
  74. begin;
  75.  assign(objfile,'OBJECTS.DAT');
  76.  rewrite(objfile);
  77.  fillchar(o,sizeof(o),0);
  78.  b:=0;
  79.  write(objfile,o);
  80.  for a:=1 to numolist do if objects[a]<>nil then begin;
  81.   inc(b);
  82.   write(objfile,objects[a]^);
  83.  end;
  84.  close(objfile);
  85. end;
  86.  
  87. procedure blankbases;
  88. var
  89.  a: integer;
  90. begin;
  91.  fillchar(bases^,sizeof(bases^),0);
  92.  for a:=1 to numbase do bases^[a].active:=false;
  93. end;
  94.  
  95. procedure LoadStringDef;
  96. var
  97.  a: integer;
  98.  b: longint;
  99.  m: longint;
  100.  ch1,ch2: char;
  101.  s: string;
  102.  stroffset: longint;
  103.  bread: integer;
  104. begin;
  105.  bwrite('Loading String Definitions');
  106.  seek(gamebin,0);
  107.  blockread(gamebin,s,8);
  108.  s[0]:=#7;
  109.  val(s,stroffset,a);
  110.  seek(gamebin,stroffset);
  111.  blockread(gamebin,ch1,1);
  112.  blockread(gamebin,ch2,1);
  113.  
  114.  blockread(gamebin,strdef_numindex,2);
  115.  
  116.  strdef_idxsize:=(strdef_numindex+1)*sizeof(idrec);
  117.  strdef_idxstart:=filepos(gamebin);
  118.  strdef_strstart:=strdef_idxsize+strdef_idxstart;
  119.  
  120.  m:=memavail;
  121.  openstringcache;
  122.  m:=m-memavail;
  123.  strdefbytes:=m;
  124.  numstrdef:=strdef_numindex;
  125. end;
  126.  
  127. procedure AddTeleCode(d: word; x,y: word);
  128. var
  129.  a,b,c: integer;
  130.  c1,c2,c3: integer;
  131.  bad: boolean;
  132.  count: word;
  133. begin;
  134.  c1:=(x mod 3)+1;
  135.  c2:=(y mod 3)+1;
  136.  c3:=((x+y) mod 3)+1;
  137.  
  138.  c:=0;
  139.  for a:=1 to numtcode do if (telecodes[a].d=0) and (c=0) then c:=a;
  140.  if c=0 then exit;
  141.  
  142.  count:=1;
  143.  repeat;
  144.   bad:=false;
  145.   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;
  146.   if bad then begin;
  147.    inc(c3);
  148.    if c3>3 then begin;
  149.     c3:=1;
  150.     inc(c2);
  151.     if c2>3 then begin;
  152.      c2:=1;
  153.      inc(c1);
  154.      if c1>1 then c1:=1;
  155.     end;
  156.    end;
  157.   end;
  158.   inc(count);
  159.  until (not bad) or (count=100);
  160.  
  161.  if not bad then begin;
  162.   telecodes[c].c[1]:=c1;
  163.   telecodes[c].c[2]:=c2;
  164.   telecodes[c].c[3]:=c3;
  165.   telecodes[c].x:=x;
  166.   telecodes[c].y:=y;
  167.   telecodes[c].z:=1;
  168.   telecodes[c].d:=d;
  169.  end;
  170. end;
  171.  
  172. procedure maketelecodes;
  173. var
  174.  z,x,y: word;
  175. begin;
  176.  fillchar(telecodes,sizeof(telecodes),0);
  177.  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;
  178.   AddTeleCode(1,x,y);
  179.  end;
  180.  AddTeleCode(2,3,4);
  181.  AddTeleCode(3,5,6);
  182. end;
  183.  
  184. procedure SqrIt(var n: word);
  185. begin;
  186.  n:=n*n;
  187. end;
  188.  
  189. procedure loaddevdef;
  190. var
  191.  devs: devdeftype;
  192.  a,b: word;
  193.  numread: word;
  194.  devofs,devsize: longint;
  195.  s: string;
  196.  junk: integer;
  197. begin;
  198.  seek(gamebin,22);
  199.  blockread(gamebin,s[1],7);
  200.  s[0]:=#7;
  201.  val(s,devofs,junk);
  202.  seek(gamebin,43);
  203.  blockread(gamebin,s[1],7);
  204.  s[0]:=#7;
  205.  val(s,devsize,junk);
  206.  if (devsize mod sizeof(devdeftype))<>0 then error('Error - Fubar in dev def');
  207.  devgood:=0;
  208.  devfill:=0;
  209.  devnil:=0;
  210.  b:=0;
  211.  seek(gamebin,devofs);
  212.  for a:=1 to devsize div sizeof(devdeftype) do begin;
  213.   blockread(gamebin,devs,sizeof(devdeftype));
  214.   if (b<=numdev) then begin;
  215.    if (b<>0) and (stu(devs.name)='NIL') and (devs.store=[]) and (ord(devs.devapp)=0) then begin;
  216.     inc(devnil);
  217.     devicedef[b]:=devicedef[0];
  218.    end else begin;
  219.     getmem(devicedef[b],sizeof(devdeftype));
  220.     devicedef[b]^:=devs;
  221.     devicedef[b]^.num:=b;
  222.     inc(devgood);
  223.    end;
  224.    inc(b);
  225.   end;
  226.  end;
  227.  
  228.  if b<numdev then for a:=b to numdev do begin;
  229.   devicedef[a]:=devicedef[0];
  230.   inc(devfill);
  231.  end;
  232. end;
  233.  
  234. procedure loaddevdefs;
  235. begin;
  236.  bwrite('Loading device definitions');
  237.  devgood:=0;
  238.  devfill:=0;
  239.  devnil:=0;
  240.  loaddevdef;
  241. end;
  242.  
  243. procedure LoadGameDef;
  244. var
  245.  gddone: boolean;
  246.  linepos: word;
  247.  donemonster: boolean;
  248.  donecombat: boolean;
  249.  doneweapsmth: boolean;
  250.  donespweap: boolean;
  251.  donetalk: boolean;
  252.  donetroy: boolean;
  253.  donetrell: boolean;
  254.  donehist: boolean;
  255.  donetavern: boolean;
  256.  donemisc: boolean;
  257.  donelaphelp: boolean;
  258.  donecomm: boolean;
  259.  doneptron: boolean;
  260.  donenpcfort: boolean;
  261.  donegenobj: boolean;
  262.  s: string;
  263.  ofm: word;
  264.  
  265. procedure loadmisc;
  266. var
  267.  s,s2,s3,s4: string;
  268.  done: boolean;
  269.  a,n: integer;
  270. begin;
  271.  bwrite('Loading data set information');
  272.  fillchar(dataset,sizeof(dataset),0);
  273.  done:=false;
  274.  n:=0;
  275.  while (not eof(gamedef)) and (not done) do begin;
  276.   inc(linepos);
  277.   readln(gamedef,s);
  278.   if s='&&&END' then begin;
  279.    done:=true;
  280.   end else begin;
  281.    inc(n);
  282.    case n of
  283.     1: dataset.name:=newstr(s);
  284.     2: dataset.author:=newstr(s);
  285.     3: dataset.menustem:=s;
  286.     4: val(s,dataset.sdstart,a);
  287.     5: val(s,dataset.sdend,a);
  288.     6: dataset.prodname[1]:=newstr(s);
  289.     7: dataset.prodname[2]:=newstr(s);
  290.     8: dataset.prodname[3]:=newstr(s);
  291.     9..18: dataset.cityname[n-8]:=newstr(s);
  292.     19: dataset.hisstr:=newstr(s);
  293.     20: dataset.herstr:=newstr(s);
  294.     21: dataset.itsstr:=newstr(s);
  295.     22: dataset.hestr:=newstr(s);
  296.     23: dataset.shestr:=newstr(s);
  297.     24: dataset.itstr:=newstr(s);
  298.     25: dataset.mhimstr:=newstr(s);
  299.     26: dataset.fhimstr:=newstr(s);
  300.     27: dataset.ihimstr:=newstr(s);
  301.     28: val(s,dataset.obstart,a);
  302.     29: val(s,dataset.obend,a);
  303.     30: dataset.egadoccent:=s;
  304.     31: dataset.egacomcent:=s;
  305.     32: dataset.egaclone:=s;
  306.     33: dataset.egapurroom:=s;
  307.     34: dataset.egafinance:=s;
  308.     35: dataset.egasurr:=s;
  309.     36: dataset.egafortatck:=s;
  310.     37: dataset.egafortcnfg:=s;
  311.     38: dataset.egatavern:=s;
  312.     39: dataset.egabartalk:=s;
  313.     40: dataset.egaftrade:=s;
  314.     41: dataset.egafortfin:=s;
  315.     42: dataset.egafortret:=s;
  316.     43: dataset.egafortmm1:=s;
  317.     44: dataset.egafortbad:=s;
  318.     45: dataset.egafortmain:=s;
  319.     46: dataset.egalaptop:=s;
  320.     47: dataset.egaeeeebig:=s;
  321.     48: dataset.egakillbig:=s;
  322.     49: dataset.egahortbig:=s;
  323.     50: dataset.egahortstor:=s;
  324.     51: dataset.egatport:=s;
  325.     52: dataset.egateam:=s;
  326.     53: dataset.egatquart:=s;
  327.     54..63: dataset.egatown[n-53]:=s;
  328.     64: val(s,dataset.kelpreward,a);
  329.     65: val(s,dataset.emwarpmine,a);
  330.     66: dataset.egatele1:=s;
  331.     67: dataset.egatele2:=s;
  332.     68: dataset.egatranlius:=s;
  333.     69: dataset.charpic[male]:=s;
  334.     70: dataset.charpic[female]:=s;
  335.     71: dataset.charpic[other]:=s;
  336.     72..81: val(s,dataset.townsalv[n-71],a);
  337.     82: dataset.egaacmemain:=s;
  338.     83: dataset.egaacmetech:=s;
  339.     84: dataset.egaacmeweapsmith:=s;
  340.     85: dataset.egaacmeweap:=s;
  341.     86: dataset.egaacmefort:=s;
  342.     87: dataset.egaloki:=s;
  343.     88: dataset.egatadsu:=s;
  344.    end;
  345.   end;
  346.  end;
  347.  donemisc:=true;
  348. end;
  349.  
  350. procedure loadmonster;
  351. var
  352.  done: boolean;
  353.  s: string;
  354.  a,b: integer;
  355. begin;
  356.  bwrite('Indexing monsters');
  357.  nummondef:=0;
  358.  done:=false;
  359.  while (not eof(gamedef)) and (nummondef<maxmon) and (not done) do begin;
  360.   inc(linepos);
  361.   readln(gamedef,s);
  362.   if s='&&&END' then begin;
  363.    done:=true;
  364.   end else if pos('NAME',s)=1 then begin;
  365.    inc(nummondef);
  366.    EAAlloc(mondef[nummondef],sizeof(monsterrec));
  367.    fillchar(EAAddr(mondef[nummondef])^,sizeof(monsterrec),0);
  368.    MonsterRec(EAAddr(mondef[nummondef])^).line:=linepos;
  369.    MonsterRec(EAAddr(mondef[nummondef])^).origx:=255;
  370.    MonsterRec(EAAddr(mondef[nummondef])^).origy:=255;
  371.    MonsterRec(EAAddr(mondef[nummondef])^).origz:=255;
  372.    MonsterRec(EAAddr(mondef[nummondef])^).mindist:=0;
  373.    MonsterRec(EAAddr(mondef[nummondef])^).maxdist:=100;
  374.   end else if (pos('MINDIST',s)=1) and (nummondef>0) then begin;
  375.    delete(s,1,8);
  376.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).mindist,b);
  377.    sqrit(MonsterRec(EAAddr(mondef[nummondef])^).mindist);
  378.   end else if (pos('MAXDIST',s)=1) and (nummondef>0) then begin;
  379.    delete(s,1,8);
  380.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).maxdist,b);
  381.    sqrit(MonsterRec(EAAddr(mondef[nummondef])^).maxdist);
  382.   end else if (pos('ORIGX',s)=1) and (nummondef>0) then begin;
  383.    delete(s,1,6);
  384.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).origx,b);
  385.   end else if (pos('ORIGY',s)=1) and (nummondef>0) then begin;
  386.    delete(s,1,6);
  387.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).origy,b);
  388.   end else if (pos('ORIGZ',s)=1) and (nummondef>0) then begin;
  389.    delete(s,1,6);
  390.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).origz,b);
  391.   end else if (pos('STR',s)=1) and (nummondef>0) then begin;
  392.    delete(s,1,4);
  393.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).str,b);
  394.   end else if (pos('DEX',s)=1) and (nummondef>0) then begin;
  395.    delete(s,1,4);
  396.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).dex,b);
  397.   end else if (pos('AGL',s)=1) and (nummondef>0) then begin;
  398.    delete(s,1,4);
  399.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).agl,b);
  400.   end else if (pos('IFALIVE',s)=1) and (nummondef>0) then begin;
  401.    delete(s,1,8);
  402.    val(s,MonsterRec(EAAddr(mondef[nummondef])^).ifalive,b);
  403.   end else if (pos('ISREAL',s)=1) and (nummondef>0) then begin;
  404.    delete(s,1,7);
  405.    val(s,Monsterrec(EAAddr(mondef[nummondef])^).isreal,b);
  406.    if Monsterrec(EAAddr(mondef[nummondef])^).isreal<>0 then
  407.     MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonisreal;
  408.   end else if (pos('■TR ',s)=1) and (nummondef>0) then begin;
  409.    delete(s,1,4);
  410.    b:=0;
  411.    for a:=1 to maxtrestrict do if (b=0) and (MonsterRec(EAAddr(mondef[nummondef])^).trestrict[a]=0) then b:=a;
  412.    if b<>0 then val(s,MonsterRec(EAAddr(mondef[nummondef])^).trestrict[b],a);
  413.   end else if (pos('WATERONLY',s)=1) and (nummondef>0) then begin;
  414.    MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonwateronly;
  415.   end else if (pos('LANDWATER',s)=1) and (nummondef>0) then begin;
  416.    MonsterRec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonlandwater;
  417.   end else if (pos('NORANDOM',s)=1) and (nummondef>0) then begin;
  418.    Monsterrec(EAAddr(mondef[nummondef])^).flags:=MonsterRec(EAAddr(mondef[nummondef])^).flags or flagmonnorandom;
  419.   end;
  420.  end;
  421.  donemonster:=true;
  422. end;
  423.  
  424. procedure loadtalk;
  425. var
  426.  a: word;
  427.  done: boolean;
  428.  s: string;
  429. begin;
  430.  bwrite('Processing dialog');
  431.  talkstart:=linepos;
  432.  done:=false;
  433.  while (not eof(gamedef)) and (not done) do begin;
  434.   inc(linepos);
  435.   readln(gamedef,s);
  436.   if s='&&&END' then begin;
  437.    done:=true;
  438.   end;
  439.  end;
  440.  donetalk:=true;
  441. end;
  442.  
  443. procedure LoadCstr;
  444. var
  445.  f: text;
  446.  s: string;
  447.  s2,s3,s4: string[80];
  448.  a,b: integer;
  449.  done: boolean;
  450. begin;
  451.  bwrite('Loading combat string tables');
  452.  done:=false;
  453.  numgroups:=0;
  454.  while (not eof(gamedef)) and (not done) do begin;
  455.   inc(linepos);
  456.   readln(gamedef,s);
  457.   if s='&&&END' then begin;
  458.    done:=true;
  459.   end else if stu(s)='NEWGROUP' then begin;
  460.    inc(numgroups);
  461.    new(groups[numgroups]);
  462.    fillchar(groups[numgroups]^,sizeof(groups[numgroups]^),0);
  463.   end else if (pos('INCLUDE',stu(s))=1) and (numgroups>0) then begin;
  464.    if groups[numgroups]^.numinclude<maxinclude then begin;
  465.     delete(s,1,8);
  466.     s2:='';
  467.     s3:='';
  468.     s4:='';
  469.     inc(groups[numgroups]^.numinclude);
  470.     while (s[1]<>' ') and (length(s)>0) do begin;
  471.      s2:=s2+s[1];
  472.      delete(s,1,1);
  473.     end;
  474.     while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
  475.     while (s[1]<>' ') and (length(s)>0) do begin;
  476.      s3:=s3+s[1];
  477.      delete(s,1,1);
  478.     end;
  479.     while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
  480.     while (s[1]<>' ') and (length(s)>0) do begin;
  481.      s4:=s4+s[1];
  482.      delete(s,1,1);
  483.     end;
  484.     while (s[1]=' ') and (length(s)>0) do delete(s,1,1);
  485.     groups[numgroups]^.include[groups[numgroups]^.numinclude].code:=s2;
  486.     val(s3,a,b);
  487.     groups[numgroups]^.include[groups[numgroups]^.numinclude].guy1:=a;
  488.     val(s4,a,b);
  489.     groups[numgroups]^.include[groups[numgroups]^.numinclude].guy2:=a;
  490.    end;
  491.   end else if (numgroups>0) and (s<>'') and (s[1]<>';') then begin;
  492.    inc(groups[numgroups]^.numstr);
  493.    val(s,groups[numgroups]^.strings[groups[numgroups]^.numstr],a);
  494.   end;
  495.  end;
  496.  donecombat:=true;
  497. end;
  498.  
  499. procedure loadtroy;
  500. var
  501.  a: word;
  502.  s: string;
  503. begin;
  504.  if eof(gamedef) then exit;
  505.  inc(linepos);
  506.  readln(gamedef,s);
  507.  val(s,troystart,a);
  508.  if eof(gamedef) then exit;
  509.  inc(linepos);
  510.  readln(gamedef,s);
  511.  val(s,troyend,a);
  512.  if eof(gamedef) then exit;
  513.  inc(linepos);
  514.  readln(gamedef,s);
  515.  if s<>'&&&END' then exit;
  516.  donetroy:=true;
  517. end;
  518.  
  519. procedure loadspweap;
  520. var
  521.  a: word;
  522.  s: string;
  523. begin;
  524.  if eof(gamedef) then exit;
  525.  inc(linepos);
  526.  readln(gamedef,s);
  527.  val(s,spwstart,a);
  528.  if eof(gamedef) then exit;
  529.  inc(linepos);
  530.  readln(gamedef,s);
  531.  val(s,spwend,a);
  532.  if eof(gamedef) then exit;
  533.  inc(linepos);
  534.  readln(gamedef,s);
  535.  if s<>'&&&END' then exit;
  536.  donespweap:=true;
  537. end;
  538.  
  539. procedure loadweapsmth;
  540. var
  541.  a: word;
  542.  s: string;
  543. begin;
  544.  if eof(gamedef) then exit;
  545.  inc(linepos);
  546.  readln(gamedef,s);
  547.  val(s,wpsmstart,a);
  548.  if eof(gamedef) then exit;
  549.  inc(linepos);
  550.  readln(gamedef,s);
  551.  val(s,wpsmend,a);
  552.  if eof(gamedef) then exit;
  553.  inc(linepos);
  554.  readln(gamedef,s);
  555.  if s<>'&&&END' then exit;
  556.  doneweapsmth:=true;
  557. end;
  558.  
  559. procedure loadtrell;
  560. var
  561.  a: word;
  562.  s: string;
  563. begin;
  564.  if eof(gamedef) then exit;
  565.  inc(linepos);
  566.  readln(gamedef,s);
  567.  val(s,trellstart,a);
  568.  if eof(gamedef) then exit;
  569.  inc(linepos);
  570.  readln(gamedef,s);
  571.  val(s,trellend,a);
  572.  if eof(gamedef) then exit;
  573.  inc(linepos);
  574.  readln(gamedef,s);
  575.  if s<>'&&&END' then exit;
  576.  donetrell:=true;
  577. end;
  578.  
  579. procedure loadhist;
  580. var
  581.  a: word;
  582.  s: string;
  583. begin;
  584.  if eof(gamedef) then exit;
  585.  inc(linepos);
  586.  readln(gamedef,s);
  587.  val(s,histstart,a);
  588.  if eof(gamedef) then exit;
  589.  inc(linepos);
  590.  readln(gamedef,s);
  591.  val(s,histend,a);
  592.  if eof(gamedef) then exit;
  593.  inc(linepos);
  594.  readln(gamedef,s);
  595.  if s<>'&&&END' then exit;
  596.  donehist:=true;
  597. end;
  598.  
  599. procedure loadlaphelp;
  600. var
  601.  a: word;
  602.  s: string;
  603. begin;
  604.  if eof(gamedef) then exit;
  605.  inc(linepos);
  606.  readln(gamedef,s);
  607.  val(s,laphelpstart,a);
  608.  if eof(gamedef) then exit;
  609.  inc(linepos);
  610.  readln(gamedef,s);
  611.  val(s,laphelpend,a);
  612.  if eof(gamedef) then exit;
  613.  inc(linepos);
  614.  readln(gamedef,s);
  615.  if s<>'&&&END' then exit;
  616.  donelaphelp:=true;
  617. end;
  618.  
  619. procedure loadcomm;
  620. var
  621.  a: word;
  622.  s: string;
  623. begin;
  624.  if eof(gamedef) then exit;
  625.  inc(linepos);
  626.  readln(gamedef,s);
  627.  val(s,commstart,a);
  628.  if eof(gamedef) then exit;
  629.  inc(linepos);
  630.  readln(gamedef,s);
  631.  val(s,commend,a);
  632.  if eof(gamedef) then exit;
  633.  inc(linepos);
  634.  readln(gamedef,s);
  635.  if s<>'&&&END' then exit;
  636.  donecomm:=true;
  637. end;
  638.  
  639. procedure pullints(s: string; var i1,i2,i3,i4: longint);
  640. var
  641.  junk: integer;
  642.  s1: string;
  643. begin;
  644.  while (s<>'') and (s[1]=' ') do delete(s,1,1);
  645.  while s[length(s)]=' ' do dec(s[0]);
  646.  s:=s+'/';
  647.  s1:=copy(s,1,pos('/',s)-1);
  648.  delete(s,1,pos('/',s));
  649.  val(s1,i1,junk);
  650.  if pos('/',s)<>0 then begin;
  651.   s1:=copy(s,1,pos('/',s)-1);
  652.   delete(s,1,pos('/',s));
  653.   val(s1,i2,junk);
  654.  end;
  655.  if pos('/',s)<>0 then begin;
  656.   s1:=copy(s,1,pos('/',s)-1);
  657.   delete(s,1,pos('/',s));
  658.   val(s1,i3,junk);
  659.  end;
  660.  if pos('/',s)<>0 then begin;
  661.   s1:=copy(s,1,pos('/',s)-1);
  662.   delete(s,1,pos('/',s));
  663.   val(s1,i4,junk);
  664.  end;
  665. end;
  666.  
  667. procedure loadgenobj;
  668. var
  669.  t1,t2,t3,t4,tstart,tend,cnvin,cnvout: longint;
  670.  temp: genobjptr;
  671.  done: boolean;
  672.  current: word;
  673.  junk: integer;
  674.  iflist: ifptr;
  675.  
  676. function addentry(tag: word; ogtype: ogtypetype; tstart,tend: word): genobjptr;
  677. begin;
  678.  if numgenobj<maxgenobj then begin;
  679.   inc(numgenobj);
  680.   new(genobj[numgenobj]);
  681.   genobj[numgenobj]^.tag:=tag;
  682.   genobj[numgenobj]^.ogtype:=ogtype;
  683.   genobj[numgenobj]^.tstart:=tstart;
  684.   genobj[numgenobj]^.tend:=tend;
  685.   genobj[numgenobj]^.iflist:=iflist;
  686.   addentry:=genobj[numgenobj];
  687.  end else begin;
  688.   addentry:=nil;
  689.  end;
  690.  iflist:=nil;
  691. end;
  692.  
  693. procedure addif(iftype: iftypetype; data: longint);
  694. var
  695.  current,temp: ifptr;
  696. begin;
  697.  if iflist=nil then begin;
  698.   new(iflist);
  699.   temp:=iflist;
  700.  end else begin;
  701.   current:=iflist;
  702.   while (current^.next<>nil) do begin;
  703.    current:=current^.next;
  704.   end;
  705.   new(temp);
  706.   current^.next:=temp;
  707.  end;
  708.  temp^.next:=nil;
  709.  temp^.iftype:=iftype;
  710.  temp^.data:=data;
  711. end;
  712.  
  713. begin;
  714.  current:=0;
  715.  numgenobj:=0;
  716.  done:=false;
  717.  iflist:=nil;
  718.  while (not eof(gamedef)) and (not done) do begin;
  719.   inc(linepos);
  720.   readln(gamedef,s);
  721.   if pos('TAG ',s)<>0 then begin;
  722.    delete(s,1,4);
  723.    val(s,current,junk);
  724.   end else if pos('HEADER ',s)<>0 then begin;
  725.    delete(s,1,7);
  726.    pullints(s,tstart,tend,t1,t2);
  727.    addentry(current,ogHeader,tstart,tend);
  728.   end else if pos('FOOTER ',s)<>0 then begin;
  729.    delete(s,1,7);
  730.    pullints(s,tstart,tend,t1,t2);
  731.    addentry(current,ogFooter,tstart,tend);
  732.   end else if pos('RANDOM ',s)<>0 then begin;
  733.    delete(s,1,7);
  734.    pullints(s,tstart,tend,t1,t2);
  735.    addentry(current,ogRandText,tstart,tend);
  736.   end else if pos('CONVERT ',s)<>0 then begin;
  737.    delete(s,1,8);
  738.    pullints(s,cnvin,cnvout,tstart,tend);
  739.    temp:=addentry(current,ogConvert,tstart,tend);
  740.    temp^.cnvin:=cnvin;
  741.    temp^.cnvout:=cnvout;
  742.   end else if pos('ADDITEM ',s)<>0 then begin;
  743.    delete(s,1,8);
  744.    pullints(s,cnvin,cnvout,tstart,tend);
  745.    temp:=addentry(current,ogAddItem,tstart,tend);
  746.    temp^.cnvin:=cnvin;
  747.    temp^.cnvout:=cnvout;
  748.   end else if pos('REPLICATE ',s)<>0 then begin;
  749.    delete(s,1,10);
  750.    pullints(s,tstart,tend,t1,t2);
  751.    temp:=addentry(current,ogreplicate,tstart,tend);
  752.   end else if pos('FAIL ',s)<>0 then begin;
  753.    delete(s,1,5);
  754.    pullints(s,tstart,tend,t1,t2);
  755.    temp:=addentry(current,ogfail,tstart,tend);
  756.   end else if pos('IFTERRAIN ',s)<>0 then begin;
  757.    delete(s,1,10);
  758.    pullints(s,t1,t2,t3,t4);
  759.    addif(ifTerrain,t1);
  760.   end else if pos('IFNTERRAIN ',s)<>0 then begin;
  761.    delete(S,1,11);
  762.    pullints(s,t1,t2,t3,t4);
  763.    addif(ifNTerrain,t1);
  764.   end else if pos('IFQUEST ',s)<>0 then begin;
  765.    delete(s,1,8);
  766.    pullints(s,t1,t2,t3,t4);
  767.    addif(ifQuest,t1);
  768.   end else if pos('IFNQUEST ',s)<>0 then begin;
  769.    delete(s,1,9);
  770.    pullints(s,t1,t2,t3,t4);
  771.    addif(ifNQuest,t1);
  772.   end else if pos('IFPURITRON ',s)<>0 then begin;
  773.    delete(s,1,11);
  774.    pullints(s,t1,t2,t3,t4);
  775.    addif(ifPuritron,t1);
  776.   end else if pos('IFNPURITRON ',s)<>0 then begin;
  777.    delete(s,1,12);
  778.    pullints(s,t1,t2,t3,t4);
  779.    addif(ifNPuritron,t1);
  780.   end else if pos('IFLEVEL ',s)<>0 then begin;
  781.    delete(s,1,8);
  782.    pullints(s,t1,t2,t3,t4);
  783.    addif(ifLevel,t1);
  784.   end else if pos('IFNLEVEL ',s)<>0 then begin;
  785.    delete(s,1,9);
  786.    pullints(s,t1,t2,t3,t4);
  787.    addif(ifNLevel,t1);
  788.   end else if pos('IFEXPER ',s)<>0 then begin;
  789.    delete(s,1,8);
  790.    pullints(s,t1,t2,t3,t4);
  791.    addif(ifExper,t1);
  792.   end else if pos('IFNEXPER ',s)<>0 then begin;
  793.    delete(s,1,9);
  794.    pullints(s,t1,t2,t3,t4);
  795.    addif(ifNExper,t1);
  796.   end else if pos('IFMINDIST ',s)<>0 then begin;
  797.    delete(s,1,10);
  798.    pullints(s,t1,t2,t3,t4);
  799.    addif(ifMindist,t1);
  800.   end else if pos('IFMAXDIST ',s)<>0 then begin;
  801.    delete(s,1,10);
  802.    pullints(s,t1,t2,t3,t4);
  803.    addif(ifMaxdist,t1);
  804.   end else if pos('IFTESTX ',s)<>0 then begin;
  805.    delete(s,1,8);
  806.    pullints(s,t1,t2,t3,t4);
  807.    addif(iftestx,t1);
  808.   end else if pos('IFTESTY ',s)<>0 then begin;
  809.    delete(s,1,8);
  810.    pullints(s,t1,t2,t3,t4);
  811.    addif(iftesty,t1);
  812.   end else if pos('IFTESTZ ',s)<>0 then begin;
  813.    delete(s,1,8);
  814.    pullints(s,t1,t2,t3,t4);
  815.    addif(iftestz,t1);
  816.   end else if pos('IFNTESTX ',s)<>0 then begin;
  817.    delete(s,1,9);
  818.    pullints(s,t1,t2,t3,t4);
  819.    addif(ifntestx,t1);
  820.   end else if pos('IFNTESTY ',s)<>0 then begin;
  821.    delete(s,1,9);
  822.    pullints(s,t1,t2,t3,t4);
  823.    addif(ifntesty,t1);
  824.   end else if pos('IFNTESTZ ',s)<>0 then begin;
  825.    delete(s,1,9);
  826.    pullints(s,t1,t2,t3,t4);
  827.    addif(ifntestz,t1);
  828.   end else if pos('DOSPECIAL ',s)<>0 then begin;
  829.    delete(s,1,10);
  830.    s:=stu(trimstr(s));
  831.    if s='LOKI' then begin;
  832.     addif(ifDoLoki,0);
  833.    end else if s='SERPINE' then begin;
  834.     addif(ifDoSerpine,0);
  835.    end;
  836.   end else if pos('DOQUEST ',s)<>0 then begin;
  837.    delete(s,1,8);
  838.    pullints(s,t1,t2,t3,t4);
  839.    addif(ifDoQuest,t1);
  840.   end else if s='&&&END' then begin;
  841.    donegenobj:=true;
  842.    done:=true;
  843.   end;
  844.  end;
  845. end;
  846.  
  847. procedure loadptron;
  848. var
  849.  s1,s2: string;
  850.  junk: integer;
  851.  partnum: word;
  852.  st,en: word;
  853.  done: boolean;
  854. begin;
  855.  done:=false;
  856.  while not done do begin;
  857.   inc(linepos);
  858.   readln(gamedef,s);
  859.   if pos('PFS ',s)=1 then begin;
  860.    delete(s,1,4);
  861.    s2:=copy(s,1,pos(' ',s)-1);
  862.    val(s2,partnum,junk);
  863.    delete(s,1,pos(' ',s));
  864.    val(s,st,junk);
  865.    inc(linepos);
  866.    readln(gamedef,s);
  867.    delete(s,1,4);
  868.    val(s,en,junk);
  869.    if (partnum>0) and (partnum<=numpurparts) then begin;
  870.     pfstart[partnum]:=st;
  871.     pfend[partnum]:=en;
  872.    end;
  873.   end else if pos('AFS ',s)=1 then begin;
  874.    delete(s,1,4);
  875.    s2:=copy(s,1,pos(' ',s)-1);
  876.    val(s2,partnum,junk);
  877.    delete(s,1,pos(' ',s));
  878.    val(s,st,junk);
  879.    inc(linepos);
  880.    readln(gamedef,s);
  881.    delete(s,1,4);
  882.    val(s,en,junk);
  883.    if (partnum>0) and (partnum<=numpurparts) then begin;
  884.     afstart[partnum]:=st;
  885.     afend[partnum]:=en;
  886.    end;
  887.   end else if s='&&&END' then begin;
  888.    doneptron:=true;
  889.    done:=true;
  890.   end else done:=true;
  891.  end;
  892. end;
  893.  
  894. procedure loadtavern;
  895. var
  896.  a: word;
  897.  done: boolean;
  898.  s,s2: string;
  899.  n1,n2: word;
  900. begin;
  901.  bwrite('Loading tavern data');
  902.  numtav:=0;
  903.  done:=false;
  904.  while (not eof(gamedef)) and (not done) do begin;
  905.   inc(linepos);
  906.   readln(gamedef,s);
  907.   if s='&&&END' then begin;
  908.    done:=true;
  909.   end else begin;
  910.    while (s<>'') and (s[1]=' ') do delete(s,1,1);
  911.    s2:='';
  912.    while (s<>'') and (s[1]<>' ') do begin;
  913.     s2:=s2+s[1];
  914.     delete(s,1,1);
  915.    end;
  916.    val(s2,n1,a);
  917.    while (s<>'') and (s[1]=' ') do delete(s,1,1);
  918.    s2:='';
  919.    while (s<>'') and (s[1]<>' ') do begin;
  920.     s2:=s2+s[1];
  921.     delete(s,1,1);
  922.    end;
  923.    val(s2,n2,a);
  924.    while (s<>'') and (s[1]=' ') do delete(s,1,1);
  925.    if (s<>'') and (n1<>0) and (n2<>0) and (numtav<maxtav) then begin;
  926.     inc(numtav);
  927.     new(tavern[numtav]);
  928.     tavern[numtav]^.personnum:=n2;
  929.     tavern[numtav]^.townnum:=n1;
  930.     tavern[numtav]^.personname:=s;
  931.    end;
  932.   end;
  933.  end;
  934.  donetavern:=true;
  935. end;
  936.  
  937. procedure loadnpcfort;
  938. var
  939.  s: string;
  940. begin;
  941.  donenpcfort:=true;
  942.  npcfortstart:=linepos;
  943.  readln(gamedef,s);
  944.  inc(linepos);
  945. end;
  946.  
  947. begin;
  948.  donemonster:=false;
  949.  donecombat:=false;
  950.  donespweap:=false;
  951.  doneweapsmth:=false;
  952.  donetalk:=false;
  953.  donetrell:=false;
  954.  donetroy:=false;
  955.  donehist:=false;
  956.  donetavern:=false;
  957.  donemisc:=false;
  958.  donelaphelp:=false;
  959.  donecomm:=false;
  960.  doneptron:=false;
  961.  donenpcfort:=false;
  962.  donegenobj:=false;
  963.  linepos:=0;
  964.  gddone:=false;
  965.  while (not eof(gamedef)) and (not gddone) do begin;
  966.   inc(linepos);
  967.   readln(gamedef,s);
  968.   while (s[1]=' ') and (s<>'') do delete(s,1,1);
  969.   while s[length(s)]=' ' do dec(s[0]);
  970.   if (s<>'') and (s[1]<>';') then begin;
  971.    if s='&&&NPCFORT' then loadnpcfort;
  972.    if s='&&&MONSTER' then loadmonster;
  973.    if s='&&&TALK' then loadtalk;
  974.    if s='&&&COMBAT' then loadcstr;
  975.    if s='&&&TROYINFO' then loadtroy;
  976.    if s='&&&TRELLNOT' then loadtrell;
  977.    if s='&&&HISTORY' then loadhist;
  978.    if s='&&&SPWEAP' then loadspweap;
  979.    if s='&&&WEAPSMTH' then loadweapsmth;
  980.    if s='&&&TAVERN' then loadtavern;
  981.    if s='&&&MISC' then loadmisc;
  982.    if s='&&&LAPHELP' then loadlaphelp;
  983. {   if s='&&&COMMUNIC' then loadcomm;}
  984.    if s='&&&GENOBJ' then loadgenobj;
  985.    if s='&&&PTRONTEXT' then loadptron;
  986.    if s='&&&DONE' then gddone:=true;
  987.   end;
  988.  end;
  989.  if not doneweapsmth then error('Err: could not load weapsmth from GAME.DEF.');
  990.  if not donenpcfort then  error('Err: could not load npcfort from GAME.DEF.');
  991.  if not donemonster then  error('Err: could not load monster from GAME.DEF.');
  992.  if not donecombat then   error('Err: could not load combat from GAME.DEF.');
  993.  if not donetalk then     error('Err: could not load talk from GAME.DEF.');
  994.  if not donetroy then     error('Err: could not load troyinfo from GAME.DEF.');
  995.  if not donespweap then   error('Err: could not load spweap from GAME.DEF.');
  996.  if not donetrell then    error('Err: could not load trellnot from GAME.DEF.');
  997.  if not donehist then     error('Err: could not load history from GAME.DEF.');
  998.  if not donetavern then   error('Err: could not load tavern from GAME.DEF.');
  999.  if not donemisc then     error('Err: could not load dataset from GAME.DEF.');
  1000.  if not donelaphelp then  error('Err: could not load latop help from GAME.DEF.');
  1001. { if not donecomm then     error('Err: could not load communic from GAME.DEF.');}
  1002.  if not doneptron then    error('Err: could not load ptron from GAME.DEF.');
  1003. end;
  1004.  
  1005. procedure opengamedef;
  1006. var
  1007.  ofm: word;
  1008.  buf: array[1..1024] of byte;
  1009.  bread: word;
  1010.  f2: file;
  1011.  s: string[8];
  1012.  a,b: integer;
  1013. begin;
  1014.  bwrite('Reading Master Game Definition');
  1015.  assign(gamebin,'GAME.DEF');
  1016.  reset(gamebin,1);
  1017.  
  1018.  seek(gamebin,50);
  1019.  blockread(gamebin,s[1],7);
  1020.  s[0]:=#7;
  1021.  val(s,a,b);
  1022.  if a<>compilerev then begin;
  1023.   sclrscr;
  1024.   swriteln('Error! The Dataset file (GAME.DEF) was compiled for an earlier version');
  1025.   swriteln('of LOD. Please contact the author of that dataset for a new version or');
  1026.   swriteln('revert to original GAME.DEF file that is contained in LODxxxB.ZIP.');
  1027.   delay(8000);
  1028.   halt;
  1029.  end;
  1030.  
  1031.  assign(gamedef,'GAME.DEF');
  1032.  {$I-}
  1033.  reset(gamedef);
  1034.  {$I+}
  1035.  if ioresult<>0 then begin;
  1036.   bwrite('Data access fault: Duplicating GAME.DEF');
  1037.   assign(f2,'GAME.DE2');
  1038.   rewrite(f2,1);
  1039.   bread:=1024;
  1040.   while (bread=1024) do begin;
  1041.    blockread(gamebin,buf,1024,bread);
  1042.    blockwrite(f2,buf,bread);
  1043.   end;
  1044.   close(f2);
  1045.   assign(gamedef,'GAME.DE2');
  1046.   reset(gamedef);
  1047.  end;
  1048. end;
  1049.  
  1050. procedure fixmonsters;
  1051. var
  1052.  cz,cx,cy: byte;
  1053.  a: integer;
  1054. begin;
  1055.  findcity(1,cz,cx,cy);
  1056.  for a:=1 to nummondef do if MonsterRec(EAAddr(mondef[a])^).origz=255 then begin;
  1057.   MonsterRec(EAAddr(mondef[a])^).origz:=cz;
  1058.   MonsterRec(EAAddr(mondef[a])^).origx:=cx;
  1059.   MonsterRec(EAAddr(mondef[a])^).origy:=cy;
  1060.  end;
  1061. end;
  1062.  
  1063. procedure loadmap(n: word);
  1064. var
  1065.  a: integer;
  1066.  s: string[10];
  1067.  mapofs: longint;
  1068. begin;
  1069.  seek(gamebin,8);
  1070.  blockread(gamebin,s[1],7);
  1071.  s[0]:=#7;
  1072.  val(s,mapofs,a);
  1073.  seek(gamebin,mapofs);
  1074.  blockread(gamebin,zmap^,sizeof(zmap^));
  1075. end;
  1076.  
  1077. procedure loadterrain;
  1078. var
  1079.  a: integer;
  1080.  s: string[10];
  1081.  mapofs: longint;
  1082. begin;
  1083.  bwrite('Loading terrain definitions');
  1084.  seek(gamebin,15);
  1085.  blockread(gamebin,s[1],7);
  1086.  s[0]:=#7;
  1087.  val(s,mapofs,a);
  1088.  seek(gamebin,mapofs);
  1089.  blockread(gamebin,terrain,sizeof(terrain));
  1090. end;
  1091.  
  1092. procedure loadquests;
  1093. var
  1094.  a: integer;
  1095.  s: string[10];
  1096.  mapofs: longint;
  1097. begin;
  1098.  bwrite('Loading quest definitions');
  1099.  seek(gamebin,57);
  1100.  blockread(gamebin,s[1],7);
  1101.  s[0]:=#7;
  1102.  val(s,mapofs,a);
  1103.  seek(gamebin,mapofs);
  1104.  blockread(gamebin,quests,sizeof(quests));
  1105. end;
  1106.  
  1107. procedure loadgeneral;
  1108. var
  1109.  a: integer;
  1110.  s: string[10];
  1111.  fsize, mapofs: longint;
  1112.  bread: word;
  1113. begin;
  1114.  bwrite('Loading general data');
  1115.  
  1116.  seek(gamebin,29);
  1117.  blockread(gamebin,s[1],7);
  1118.  s[0]:=#7;
  1119.  val(s,mapofs,a);
  1120.  
  1121.  seek(gamebin,36);
  1122.  blockread(gamebin,s[1],7);
  1123.  s[0]:=#7;
  1124.  val(s,fsize,a);
  1125.  if fsize>sizeof(general) then fsize:=sizeof(general);
  1126.  
  1127.  seek(gamebin,mapofs);
  1128.  blockread(gamebin,general,fsize,bread);
  1129. end;
  1130.  
  1131. procedure OpenFiles;
  1132. var
  1133.  a,b: integer;
  1134.  u: usertype;
  1135.  o: devicetype;
  1136.  f: file;
  1137.  t: text;
  1138.  basfile: file of basearray;
  1139.  genfile: file of generaltype;
  1140.  objfile: file of devicetype;
  1141.  dayfile: file;
  1142.  teafile: file;
  1143.  pfile: file;
  1144.  s: string[80];
  1145.  cz,cx,cy: byte;
  1146.  uidx: file of useridxarray;
  1147.  clone: clonetype;
  1148.  cfile: file;
  1149. begin;
  1150.  if ((exist('USERS.DAT')) or (exist('OBJECTS.DAT')) or (exist('BASES.DAT')))
  1151.   and not exist('LVER400.DAT') then begin;
  1152.    swriteln('Datafiles on disk are not up to date!');
  1153.    swriteln('');
  1154.    swriteln('I suggest you do one of the following:');
  1155.    swriteln('');
  1156.    swriteln('  1) Run CVT400.EXE to convert old datafiles to new ones.');
  1157.    swriteln('');
  1158.    swriteln('  2) DEL *.DAT and re-run GAME.EXE to restart game.');
  1159.    swriteln('');
  1160.    swrite('Press any key to continue.');
  1161.    if sreadkey=' ' then ;
  1162.    halt;
  1163.  end;
  1164.  
  1165.  setgeneral;
  1166.  opengamedef;
  1167.  loadgeneral;
  1168.  loadterrain; {must be before gamedef because of terrain restrictions}
  1169.  loadgamedef;
  1170.  loadmap(1);
  1171.  loaddevdefs;
  1172.  loadquests;
  1173.  
  1174.  assign(t,'LVER400.DAT');
  1175.  rewrite(t);
  1176.  writeln(t,'Version identification file. Do not delete');
  1177.  close(t);
  1178.  
  1179.  assign(userfile,'USERS.DAT');
  1180.  {$I-}
  1181.  reset(userfile);
  1182.  {$I+}
  1183.  if ioresult<>0 then begin;
  1184.   rewrite(userfile);
  1185.   blankuser(u);
  1186.   u.x:=0;
  1187.   u.y:=0;
  1188.   u.z:=0;
  1189.   for a:=0 to 255 do write(userfile,u);
  1190.   reset(userfile);
  1191.  end;
  1192.  
  1193.  bwrite('Reading Objects');
  1194.  if not exist('OBJECTS.DAT') then begin;
  1195.   assign(objfile,'OBJECTS.DAT');
  1196.   rewrite(objfile);
  1197.   fillchar(o,sizeof(o),0);
  1198.   write(objfile,o);
  1199.   close(objfile);
  1200.  end;
  1201.  readobjs;
  1202.  
  1203.  bwrite('Reading Fortresses');
  1204.  assign(basfile,'BASES.DAT');
  1205.  {$I-}
  1206.  reset(basfile);
  1207.  {$I+}
  1208.  if ioresult<>0 then begin;
  1209.   BlankBases;
  1210.   rewrite(basfile);
  1211.   write(basfile,bases^);
  1212.   close(basfile);
  1213.  end else begin;
  1214.   close(basfile);
  1215.   assign(f,'BASES.DAT');
  1216.   reset(f,1);
  1217.   if filesize(f)<>31800 then
  1218.    error('Error - BASES.DAT has been corrupted!');
  1219.   close(f);
  1220.   reset(basfile);
  1221.   read(basfile,bases^);
  1222.   close(basfile);
  1223.  end;
  1224.  
  1225.  assign(uidx,'USERIDX.DAT');
  1226.  {$I-}
  1227.  reset(uidx);
  1228.  {$I+}
  1229.  if ioresult<>0 then begin;
  1230.   fillchar(useridx,sizeof(useridx),0);
  1231.   rewrite(uidx);
  1232.   write(uidx,useridx);
  1233.   close(uidx);
  1234.  end else begin;
  1235.   read(uidx,useridx);
  1236.   close(uidx);
  1237.  end;
  1238.  
  1239.  bwrite('Opening Clone File');
  1240.  assign(clonefile,'CLONES.DAT');
  1241.  {$I-}
  1242.  reset(clonefile);
  1243.  {$I+}
  1244.  if ioresult<>0 then begin;
  1245.   fillchar(clone,sizeof(clone),0);
  1246.   clone.alive:=false;
  1247.   rewrite(clonefile);
  1248.   for a:=0 to 255 do write(clonefile,clone);
  1249.   reset(clonefile);
  1250.  end;
  1251.  
  1252.  bwrite('Opening Puritron File');
  1253.  assign(pfile,'PURITRON.DAT');
  1254.  {$I-}
  1255.  reset(pfile,1);
  1256.  {$I+}
  1257.  if ioresult<>0 then begin;
  1258.   fillchar(puritron,sizeof(puritron),0);
  1259.   for a:=1 to numpurparts do begin;
  1260.    puritron.parts[a].ishere:=false;
  1261.    puritron.parts[a].reset:=false;
  1262.   end;
  1263.   rewrite(pfile,1);
  1264.   blockwrite(pfile,puritron,sizeof(puritron));
  1265.   close(pfile);
  1266.  end else begin;
  1267.   if filesize(pfile)<>sizeof(puritron) then
  1268.    error('Error - Puritron.dat has been corrupted.');
  1269.   blockread(pfile,puritron,sizeof(puritron));
  1270.   close(pfile);
  1271.  end;
  1272.  
  1273.  bwrite('Opening MData File');
  1274.  assign(cfile,'MDATA.DAT');
  1275.  {$I-}
  1276.  reset(cfile,1);
  1277.  {$I+}
  1278.  if ioresult<>0 then begin;
  1279.   fillchar(mdata^,sizeof(mdata^),0);
  1280.   rewrite(cfile,1);
  1281.   blockwrite(cfile,mdata^,sizeof(mdata^));
  1282.   close(cfile);
  1283.  end else begin;
  1284.   if filesize(cfile)<>sizeof(mdata^) then
  1285.    error('Error - MDATA.dat has been corrupted.');
  1286.   Blockread(cfile,mdata^,sizeof(mdata^));
  1287.   close(cfile);
  1288.  end;
  1289.  
  1290.  bwrite('Opening Team File');
  1291.  fillchar(EAAddr(teams)^,sizeof(teamarray),0);
  1292.  assign(teafile,'TEAMS.DAT');
  1293.  {$i-}
  1294.  reset(teafile,1);
  1295.  {$I+}
  1296.  if ioresult=0 then begin;
  1297.   if filesize(teafile)<>sizeof(teamarray) then
  1298.    error('Error - Teams.Dat has been corrupted.');
  1299.   EABlockRead(teafile,teams,sizeof(teamarray));
  1300.   close(teafile);
  1301.  end;
  1302.  
  1303.  fixmonsters;
  1304.  maketelecodes;
  1305.  loadstringdef;
  1306.  
  1307.  bwrite('Startup completed');
  1308.  swriteln('');
  1309. end;
  1310.  
  1311. procedure WriteTeams;
  1312. var
  1313.  teamfile: file;
  1314. begin;
  1315.  assign(teamfile,'TEAMS.DAT');
  1316.  rewrite(teamfile,1);
  1317.  EAblockwrite(teamfile,teams,sizeof(teamarray));
  1318.  close(teamfile);
  1319. end;
  1320.  
  1321. procedure WriteMdata;
  1322. var
  1323.  cfile: file;
  1324. begin;
  1325.  assign(cfile,'MDATA.DAT');
  1326.  rewrite(cfile,1);
  1327.  Blockwrite(cfile,mdata^,sizeof(mdata^));
  1328.  close(cfile);
  1329. end;
  1330.  
  1331. procedure WritePuritron;
  1332. var
  1333.  pfile: file;
  1334. begin;
  1335.  assign(pfile,'PURITRON.DAT');
  1336.  rewrite(pfile,1);
  1337.  blockwrite(pfile,puritron,sizeof(puritron));
  1338.  close(pfile);
  1339. end;
  1340.  
  1341. procedure WriteBases;
  1342. var
  1343.  basfile: file;
  1344. begin;
  1345.  assign(basfile,'BASES.DAT');
  1346.  reset(basfile,1);
  1347.  blockwrite(basfile,bases^,sizeof(bases^));
  1348.  close(basfile);
  1349. end;
  1350.  
  1351. end.