X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=87aaba0d00fb9ab7dfffbc6c4d5ce0ed51e95457;hb=9e9ff4e6b6fb6ba272aaba45102b915c0221317c;hp=c6897578d7d6334e3f9f71f964e64753013b6338;hpb=ee55194b1f1e2a8721038eff788b64534393661c;p=d2df-sdl.git

diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas
index c689757..87aaba0 100644
--- a/src/shared/xdynrec.pas
+++ b/src/shared/xdynrec.pas
@@ -45,9 +45,6 @@ type
       // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
       // arrays of chars are pascal shortstrings (with counter in the first byte)
 
-      TDynFieldArray = array of TDynField;
-      TDynRecordArray = array of TDynRecord;
-
   private
     type
       TEBS = (TNone, TRec, TEnum, TBitSet);
@@ -73,6 +70,7 @@ type
     mInternal: Boolean;
     mNegBool: Boolean;
     mBitSetUnique: Boolean; // bitset can contain only one value
+    mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
     // default value
     mDefUnparsed: AnsiString;
     mDefSVal: AnsiString; // default string value
@@ -102,6 +100,7 @@ type
     class function getTypeName (t: TType): AnsiString;
 
     function definition (): AnsiString;
+    function pasdef (): AnsiString;
 
     function clone (newOwner: TDynRecord=nil): TDynField;
 
@@ -124,15 +123,12 @@ type
     property internal: Boolean read mInternal write mInternal;
     property ival: Integer read mIVal;
     property sval: AnsiString read mSVal;
-    //property list: TDynRecordArray read mRVal write mRVal;
-    property maxdim: Integer read mMaxDim; // for fixed-size arrays
-    property binOfs: Integer read mBinOfs; // offset in binary; <0 - none
-    property recOfs: Integer read mRecOfs; // offset in record; <0 - none
     property hasDefault: Boolean read mHasDefault;
     property defsval: AnsiString read mDefSVal;
     property ebs: TEBS read mEBS;
     property ebstype: TObject read mEBSType;
     property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name
+    property list: TDynRecList read mRVal; // for list
 
     property x: Integer read mIVal;
     property w: Integer read mIVal;
@@ -176,6 +172,7 @@ type
     destructor Destroy (); override;
 
     function definition (): AnsiString;
+    function pasdef (): AnsiString;
 
     function clone (): TDynRecord;
 
@@ -185,11 +182,14 @@ type
     procedure parseBinValue (st: TStream; forceData: Boolean=false);
 
     procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
-    procedure writeBinTo (st: TStream; trigbufsz: Integer=-1);
+    procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
 
     // find field with `TriggerType` type
     function trigTypeField (): TDynField;
 
+    // number of records of the given instance
+    function instanceCount (const typename: AnsiString): Integer;
+
   public
     property id: AnsiString read mId; // for map parser
     property pasname: AnsiString read mPasName;
@@ -200,9 +200,10 @@ type
     property field[const aname: AnsiString]: TDynField read getFieldByName;
     property isTrigData: Boolean read getIsTrigData;
     property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
+    property headerType: TDynRecord read mHeaderRec;
+    property isHeader: Boolean read mHeader;
   end;
 
-
   TDynEBS = class
   private
     mOwner: TDynMapDef;
@@ -227,6 +228,7 @@ type
     destructor Destroy (); override;
 
     function definition (): AnsiString;
+    function pasdef (): AnsiString;
 
     // return empty string if not found
     function nameByValue (v: Integer): AnsiString;
@@ -258,6 +260,8 @@ type
     function findTrigFor (const aname: AnsiString): TDynRecord;
     function findEBSType (const aname: AnsiString): TDynEBS;
 
+    function pasdef (): AnsiString;
+
     // creates new header record
     function parseMap (pr: TTextParser): TDynRecord;
 
@@ -272,7 +276,11 @@ type
 implementation
 
 uses
-  SysUtils;
+  SysUtils, e_log;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
 
 
 // ////////////////////////////////////////////////////////////////////////// //
@@ -329,6 +337,7 @@ begin
   mEBSTypeName := '';
   mEBSType := nil;
   mBitSetUnique := false;
+  mAsMonsterId := false;
   mNegBool := false;
   mRecRefId := '';
   if (mType = TType.TList) then mRVal := TDynRecList.Create();
@@ -369,6 +378,7 @@ begin
   result.mInternal := mInternal;
   result.mNegBool := mNegBool;
   result.mBitSetUnique := mBitSetUnique;
+  result.mAsMonsterId := mAsMonsterId;
   result.mDefUnparsed := mDefUnparsed;
   result.mDefSVal := mDefSVal;
   result.mDefIVal := mDefIVal;
@@ -528,6 +538,7 @@ begin
     TEBS.TEnum: result += ' enum '+mEBSTypeName;
     TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
   end;
+  if mAsMonsterId then result += ' as monsterid';
   if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed;
   if mSepPosSize then
   begin
@@ -539,6 +550,34 @@ begin
 end;
 
 
+function TDynField.pasdef (): AnsiString;
+begin
+  result := mPasName+': ';
+  case mType of
+    TType.TBool: result += 'Boolean;';
+    TType.TChar: if (mMaxDim > 0) then result += formatstrf('Char%d;', [mMaxDim]) else result += 'Char;';
+    TType.TByte: result += 'ShortInt;';
+    TType.TUByte: result += 'Byte;';
+    TType.TShort: result += 'SmallInt;';
+    TType.TUShort: result += 'Word;';
+    TType.TInt: result += 'LongInt;';
+    TType.TUInt: result += 'LongWord;';
+    TType.TString: result += 'AnsiString;';
+    TType.TPoint:
+           if mAsT then result := 'tX, tY: Integer;'
+      else if mSepPosSize then result := 'X, Y: Integer;'
+      else result += 'TDFPoint;';
+    TType.TSize:
+           if mAsT then result := 'tWidth, tHeight: Word;'
+      else if mSepPosSize then result := 'Width, Height: Word;'
+      else result += 'TSize;';
+    TType.TList: assert(false);
+    TType.TTrigData: result += formatstrf('Byte%d;', [mMaxDim]);
+    else raise Exception.Create('ketmar forgot to handle some field type');
+  end;
+end;
+
+
 procedure TDynField.parseDef (pr: TTextParser);
 var
   fldname: AnsiString;
@@ -557,6 +596,7 @@ var
   lmaxdim: Integer;
   lebs: TDynField.TEBS;
   unique: Boolean;
+  asmonid: Boolean;
 begin
   fldpasname := '';
   fldname := '';
@@ -574,6 +614,7 @@ begin
   hasdefInt := false;
   hasdefId := false;
   unique := false;
+  asmonid := false;
   lmaxdim := -1;
   lebs := TDynField.TEBS.TNone;
 
@@ -609,6 +650,7 @@ begin
       else if pr.eatId('wh') then aswh := true
       else if pr.eatId('txy') then begin asxy := true; ast := true; end
       else if pr.eatId('twh') then begin aswh := true; ast := true; end
+      else if pr.eatId('monsterid') then begin asmonid := true; end
       else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
       continue;
     end;
@@ -710,6 +752,7 @@ begin
   self.mEBS := lebs;
   self.mEBSTypeName := fldrecname;
   self.mBitSetUnique := unique;
+  self.mAsMonsterId := asmonid;
   self.mMaxDim := lmaxdim;
   self.mBinOfs := fldofs;
   self.mRecOfs := fldofs;
@@ -757,17 +800,6 @@ begin
           exit;
         end;
         // record reference
-        if (mRecRef = nil) then
-        begin
-          // no ref, write -1
-          case mType of
-            TType.TByte, TType.TUByte: writeInt(st, Byte(-1));
-            TType.TShort, TType.TUShort: writeInt(st, SmallInt(-1));
-            TType.TInt, TType.TUInt: writeInt(st, Integer(-1));
-            else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
-          end;
-          exit;
-        end;
         case mType of
           TType.TByte: maxv := 127;
           TType.TUByte: maxv := 254;
@@ -778,13 +810,21 @@ begin
           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
         end;
         // find record number
-        f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
-        if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
-        if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
+        if (mRecRef <> nil) then
+        begin
+          f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
+          if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
+          if mAsMonsterId then Inc(f);
+          if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
+        end
+        else
+        begin
+          if mAsMonsterId then f := 0 else f := -1;
+        end;
         case mType of
           TType.TByte, TType.TUByte: writeInt(st, Byte(f));
           TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
-          TType.TInt, TType.TUInt: writeInt(st, Integer(f));
+          TType.TInt, TType.TUInt: writeInt(st, LongWord(f));
           else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
         end;
         exit;
@@ -1070,6 +1110,7 @@ begin
             TType.TUInt: f := readLongWord(st);
             else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
           end;
+          if mAsMonsterId then Dec(f);
           if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
         end;
         mDefined := true;
@@ -1222,6 +1263,7 @@ var
   es: TDynEBS = nil;
   tfld: TDynField;
   tk: AnsiString;
+  edim: AnsiChar;
 begin
   // if this field should contain struct, convert type and parse struct
   case mEBS of
@@ -1412,7 +1454,7 @@ begin
     TType.TPoint,
     TType.TSize:
       begin
-        pr.expectDelim('(');
+        if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end;
         mIVal := pr.expectInt();
         if (mType = TType.TSize) then
         begin
@@ -1424,7 +1466,7 @@ begin
           if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
         end;
         mDefined := true;
-        pr.expectDelim(')');
+        pr.expectDelim(edim);
         pr.expectTT(pr.TTSemi);
         exit;
       end;
@@ -1487,7 +1529,7 @@ begin
   result := 0;
   while (result < mFields.count) do
   begin
-    if (CompareText(aname, mFields[result].mName) = 0) then exit;
+    if StrEqu(aname, mFields[result].mName) then exit;
     Inc(result);
   end;
   result := -1;
@@ -1520,7 +1562,7 @@ var
   f: Integer;
 begin
   result := true;
-  for f := 0 to High(mTrigTypes) do if (CompareText(mTrigTypes[f], aname) = 0) then exit;
+  for f := 0 to High(mTrigTypes) do if StrEqu(mTrigTypes[f], aname) then exit;
   result := false;
 end;
 
@@ -1565,7 +1607,7 @@ begin
   begin
     for rec in fld.mRVal do
     begin
-      if (CompareText(rec.mId, aid) = 0) then begin result := rec; exit; end;
+      if StrEqu(rec.mId, aid) then begin result := rec; exit; end;
     end;
   end;
   // alas
@@ -1641,12 +1683,23 @@ begin
     if not (fld.mEBSType is TDynEBS) then continue;
     es := (fld.mEBSType as TDynEBS);
     assert(es <> nil);
-    if (CompareText(es.mName, 'TriggerType') = 0) then begin result := fld; exit; end;
+    if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end;
   end;
   result := nil;
 end;
 
 
+// number of records of the given instance
+function TDynRecord.instanceCount (const typename: AnsiString): Integer;
+var
+  fld: TDynField;
+begin
+  result := 0;
+  fld := field[typename];
+  if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count;
+end;
+
+
 procedure TDynRecord.parseDef (pr: TTextParser);
 var
   fld: TDynField;
@@ -1716,6 +1769,30 @@ begin
 end;
 
 
+function TDynRecord.pasdef (): AnsiString;
+var
+  fld: TDynField;
+begin
+  if isTrigData then
+  begin
+    assert(false);
+    result := '';
+  end
+  else
+  begin
+    // record
+    result := '  '+mPasName+' = packed record'#10;
+  end;
+  for fld in mFields do
+  begin
+    if fld.mInternal then continue;
+    if (fld.mBinOfs < 0) then continue;
+    result += '    '+fld.pasdef+#10;
+  end;
+  result += '  end;'#10;
+end;
+
+
 function TDynRecord.definition (): AnsiString;
 var
   f: Integer;
@@ -1785,7 +1862,11 @@ var
       if (Length(fld.mRecRefId) = 0) then continue;
       assert(fld.mEBSType <> nil);
       rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
-      if (rt = nil) then raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%d''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
+      if (rt = nil) then
+      begin
+        e_LogWritefln('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING);
+        //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
+      end;
       //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
       fld.mRecRefId := '';
       fld.mRecRef := rt;
@@ -1815,7 +1896,7 @@ begin
         if (btype = 0) then break; // no more blocks
         readLongWord(st); // reserved
         bsize := readLongInt(st);
-        writeln('btype=', btype, '; bsize=', bsize);
+        {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF}
         if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
         if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
         loaded[btype] := true;
@@ -1823,7 +1904,7 @@ begin
         rect := nil;
         for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
         if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
-        writeln('found type ''', rec.mName, ''' for block type ', btype);
+        //writeln('found type ''', rec.mName, ''' for block type ', btype);
         if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype]));
         // header?
         if (rect.mHeader) then
@@ -1870,7 +1951,7 @@ begin
     end;
 
     // read fields
-    if (CompareText(mName, 'TriggerData') = 0) then mSize := Integer(st.size-st.position);
+    if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
     if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
     GetMem(buf, mSize);
     st.ReadBuffer(buf^, mSize);
@@ -1890,7 +1971,7 @@ begin
 end;
 
 
-procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1);
+procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
 var
   fld: TDynField;
   rec, rv: TDynRecord;
@@ -1930,7 +2011,7 @@ begin
     end;
 
     // write block with normal fields
-    if mHeader then
+    if mHeader and not onlyFields then
     begin
       //writeln('writing header...');
       // signature and version
@@ -1945,7 +2026,7 @@ begin
     FreeMem(buf); buf := nil;
 
     // write other blocks, if any
-    if mHeader then
+    if mHeader and not onlyFields then
     begin
       // calculate blkmax
       blkmax := 0;
@@ -2092,7 +2173,7 @@ begin
             begin
               for rv in fld.mRVal do
               begin
-                if (Length(rv.mId) > 0) and (CompareText(rv.mId, rec.mId) = 0) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
+                if (Length(rv.mId) > 0) and StrEqu(rv.mId, rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
               end;
             end;
           end;
@@ -2157,7 +2238,7 @@ begin
   result := 0;
   while (result < Length(mIds)) do
   begin
-    if (CompareText(aname, mIds[result]) = 0) then exit;
+    if StrEqu(aname, mIds[result]) then exit;
     Inc(result);
   end;
   result := -1;
@@ -2210,6 +2291,19 @@ begin
 end;
 
 
+function TDynEBS.pasdef (): AnsiString;
+var
+  f: Integer;
+begin
+  result := '// '+mName+#10'const'#10;
+  // fields
+  for f := 0 to High(mIds) do
+  begin
+    result += formatstrf('  %s = %d;'#10, [mIds[f], mVals[f]]);
+  end;
+end;
+
+
 function TDynEBS.nameByValue (v: Integer): AnsiString;
 var
   f: Integer;
@@ -2242,9 +2336,9 @@ begin
     idname := pr.expectId();
     for f := 0 to High(mIds) do
     begin
-      if (CompareText(mIds[f], idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
+      if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
     end;
-    if (CompareText(mMaxName, idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
+    if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
     skipAdd := false;
     hasV := false;
     v := cv;
@@ -2339,7 +2433,7 @@ var
 begin
   for rec in recTypes do
   begin
-    if (CompareText(rec.name, aname) = 0) then begin result := rec; exit; end;
+    if StrEqu(rec.name, aname) then begin result := rec; exit; end;
   end;
   result := nil;
 end;
@@ -2363,7 +2457,7 @@ var
 begin
   for ebs in ebsTypes do
   begin
-    if (CompareText(ebs.name, aname) = 0) then begin result := ebs; exit; end;
+    if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
   end;
   result := nil;
 end;
@@ -2451,7 +2545,7 @@ begin
     rec := TDynRecord.Create(pr);
     //writeln(dr.definition); writeln;
     if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
-    if (hdr <> nil) and (CompareText(rec.name, hdr.name) = 0) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
+    if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
     rec.mOwner := self;
     if rec.mHeader then
     begin
@@ -2522,4 +2616,51 @@ begin
 end;
 
 
+function TDynMapDef.pasdef (): AnsiString;
+var
+  ebs: TDynEBS;
+  rec: TDynRecord;
+  fld: TDynField;
+  needComma: Boolean;
+  tn: AnsiString;
+begin
+  result := '';
+  result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
+  result += '// enums and bitsets'#10;
+  for ebs in ebsTypes do result += #10+ebs.pasdef();
+  result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
+  result += '// records'#10'type'#10;
+  for rec in recTypes do
+  begin
+    if (rec.mSize < 1) then continue;
+    result += rec.pasdef();
+    result += #10;
+  end;
+  result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
+  result += '// triggerdata'#10'type'#10;
+  result += '  TTriggerData = record'#10;
+  result += '    case Byte of'#10;
+  result += '      0: (Default: Byte128);'#10;
+  for rec in trigTypes do
+  begin
+    result += '      ';
+    needComma := false;
+    for tn in rec.mTrigTypes do
+    begin
+      if needComma then result += ', ' else needComma := true;
+      result += tn;
+    end;
+    result += ': ('#10;
+    for fld in rec.mFields do
+    begin
+      if fld.mInternal then continue;
+      if (fld.mBinOfs < 0) then continue;
+      result += '        '+fld.pasdef+#10;
+    end;
+    result += '      );'#10;
+  end;
+  result += '  end;'#10;
+end;
+
+
 end.