debug.pas

3D GameStudio 的Delphi开发包

//////////////////////////////////////////////////////////////////////
//
// Delphi Debugging routings for the A6_5x Engine (acknex.dll) and plugin dll's done by
// Michal Messerschmidt aka LazyDog of Lazy Dog Software
// (www.LazyDogSoftware.com)
// (c) Lazy Dog Software / Michael Messerschmidt 2006
//
// SDK Version 6.50.6
//
// tested on Delphi 5,6,7,2005 & 2006
//////////////////////////////////////////////////////////////////////

Interface

Uses {$IFDEF USEDLL} A6DLL {$ELSE} A6Engine {$ENDIF};

procedure ShowEntityValues(aEntity : PEntity); {$IFDEF USEDLL} cdecl; exports ShowEntityValues; {$ENDIF}
procedure ShowViewValues(aView : PView); {$IFDEF USEDLL} cdecl; exports ShowViewValues; {$ENDIF}
procedure ShowTextValues(aText : PText); {$IFDEF USEDLL} cdecl; exports ShowTextValues; {$ENDIF}
procedure ShowPanelValues(aPanel : PPanel); {$IFDEF USEDLL} cdecl; exports ShowPanelValues; {$ENDIF}
procedure ShowParticleValues(aParticle : PParticle); {$IFDEF USEDLL} cdecl; exports ShowParticleValues; {$ENDIF}

procedure Debug_DrawRedLine(Start,Stop : PVector); {$IFDEF USEDLL} cdecl; exports Debug_DrawRedLine; {$ENDIF}
procedure Debug_DrawBlueLine(Start,Stop : PVector); {$IFDEF USEDLL} cdecl; exports Debug_DrawBlueLine; {$ENDIF}
procedure Debug_DrawGreenLine(Start,Stop : PVector); {$IFDEF USEDLL} cdecl; exports Debug_DrawGreenLine; {$ENDIF}
procedure Debug_DrawLine_ToFront(Entity : PEntity; Dist : Var_); {$IFDEF USEDLL} cdecl; exports Debug_DrawLine_ToFront; {$ENDIF}
procedure Debug_C_Scan(Entity : PEntity; Angle : PAngle; Scan : PVector); {$IFDEF USEDLL} cdecl; exports Debug_C_Scan; {$ENDIF}
procedure Debug_DrawBoundBox(Entity : PEntity); {$IFDEF USEDLL} cdecl; exports Debug_DrawBoundBox; {$ENDIF}
procedure Debug_DrawTriggerRange(Entity : PEntity); {$IFDEF USEDLL} cdecl; exports Debug_DrawTriggerRange; {$ENDIF}

Implementation

Uses SysUtils, Forms, Windows, Graphics, StdCtrls, Controls,
     {$IFDEF USEDLL}
     DLL_Library, DLL_DX9Library
     {$ELSE}
     Engine_Library, Engine_DX9Library
     {$ENDIF} ;

{.$DEFINE DEBUGFLAGS}

// remove the "." from the above compiler define to allow the
// ShowxxxValues functions defined below to show the RAW data
// in the flags for each object type.  This code was needed when
// working on the SDK because not all the constants for the flags
// were defined in the beginning.

const BitLabel1 : String = '2222222221111111111';
      BitLabel2 : String = '8765432109876543210987654321';
      BitLabel3 : String = '============================';

procedure ShowMsgFixedFont(S : String; TheCaption : String = '');

const BtnWidth   = 50;
      BtnSpace   = 5;
      TheMargin  = 10;

var aForm : TForm;
    TextRect: TRect;
    fCWidth : Integer;
    BtnPos : Integer;
begin
  if not DirectDeviceReset then Exit; // Full Screen Mode needs reset

  aForm := TForm.Create(Nil);
  with aForm do
  try
    Position := poScreenCenter;
    Caption := TheCaption;
    BorderStyle := bsDialog;          // this style is needed to display
    Font.Name := 'Courier';
    Font.Pitch := Graphics.fpFixed;   // we want a fixed font
    Canvas.Font := Font;

    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, PChar(S), Length(S)+1, TextRect,
             DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
             DrawTextBiDiModeFlagsReadingOnly);

    ClientWidth := TextRect.right + (2 * TheMargin);
    ClientHeight := TextRect.Bottom + 40;

    Left := (Screen.Width Div 2) - (Width Div 2);
    Top  := (Screen.Height Div 2) - (Height Div 2);

    fCWidth  := ClientWidth;

    with TLabel.Create(aForm) do
    begin
      Name := 'Message';              // this creates the control
      Parent := aForm;                // that will hold the
      WordWrap := True;               // text of our message
      Caption := S;
      BoundsRect := TextRect;
      BiDiMode := aForm.BiDiMode;
      SetBounds(TheMargin,TheMargin,TextRect.Right, TextRect.Bottom);
    end;

    with TButton.Create(aForm) do
    begin
      Name := 'Button';               // this creates our
      Parent := aForm;                // button
      Caption := '&Ok';
      ModalResult := mrOk;
      Default := True;
      Cancel := True;
      BtnPos := (fCWidth Div 2) - (BtnWidth Div 2);
      SetBounds(BtnPos, TextRect.Bottom + TheMargin, BtnWidth,20);
    end;

    Parent := Nil;
    ParentWindow := ev.hWndMain;      // allow form to be seen

    Windows.SetFocus(Handle);         // allow keyboard access
    SetCapture(Handle);               // allow mouse access

    ShowModal;
  finally
    ReleaseCapture;                   // free mouse capture
    aForm.Free;
  end;
end;

function DecodeFlag(f : LongInt) : String;

var I : Integer;
begin
  Result := '';

  for I := 27 downto 0 do
    if (f and (1 shl I)) = 1 shl I then
      Result := Result + '1'
    else
      Result := Result + '0';
end;

function ConvertNeg(Avar : Var_) : LongInt;
begin
  if Avar < 0 then
    Result := _INT(absv(Avar)) * -1
  else
    Result := _INT(Avar);
end;

function Pad(Val : Var_; MaxLen : Integer; ConvertFromNeg : Boolean = False) : String;

var Str : String;
begin
  if ConvertFromNeg then
    Str := IntToStr(ConvertNeg(Val))
  else
    Str := IntToStr(_INT(Val));

  Result := Str + StringOfChar(' ',MaxLen - Length(Str));
end;

function PadI(Val : Integer; MaxLen : Integer) : String;

var Str : String;
begin
  Str := IntToStr(Val);

  Result := Str + StringOfChar(' ',MaxLen - Length(Str));
end;

function FlagValue(SourceFlag,Flag : LongInt) : String;
begin
  if FlagIsOn(SourceFlag,Flag) then
    Result := 'ON '
  else
    Result := 'OFF';
end;

procedure ShowEntityValues(aEntity : PEntity);

var S : String;
begin
  S :=
  {$IFDEF DEBUGFLAGS}
       '       ' + BitLabel1 + #13#10 +
       ' Bit # ' + BitLabel2 + #13#10 +
       '       ' + BitLabel3 + #13#10 +
       ' Flags:' + DecodeFlag(aEntity.flags) + #13#10 +
       ' emask:' + DecodeFlag(aEntity.emask) + #13#10 +
       'eFlags:' + DecodeFlag(aEntity.eflags) + #13#10 +
       ' sMask:' + DecodeFlag(aEntity.smask) + #13#10 +
       'Flags2:' + DecodeFlag(aEntity.flags2) + #13#10 +
  {$ENDIF}
       '  INVISIBLE ' + FlagValue(aEntity.flags,INVISIBLE)  + '  METAL ' + FlagValue(aEntity.flags,METAL)  + ' LIGHT  ' + FlagValue(aEntity.flags,LIGHT)  + #13#10 +
       '   PASSABLE ' + FlagValue(aEntity.flags,PASSABLE)   + '   CAST ' + FlagValue(aEntity.flags,CAST)   + ' NOFOG  ' + FlagValue(aEntity.flags,NOFOG)  + #13#10 +
       '   NOFILTER ' + FlagValue(aEntity.flags,NOFILTER)   + '  UNLIT ' + FlagValue(aEntity.flags,UNLIT)  + ' FACING ' + FlagValue(aEntity.flags,FACING) + #13#10 +
       '    OVERLAY ' + FlagValue(aEntity.flags,OVERLAY)    + ' BRIGHT ' + FlagValue(aEntity.flags,BRIGHT) + ' ZNEAR  ' + FlagValue(aEntity.flags,ZNEAR)  + #13#10 +
       '    POLYGON ' + FlagValue(aEntity.flags,_POLYGON)   + '  DECAL ' + FlagValue(aEntity.flags,DECAL)  +  #13#10 +
       'TRANSPARENT ' + FlagValue(aEntity.flags,TRANSLUCENT)+ ' SHADOW ' + FlagValue(aEntity.flags,SHADOW) + #13#10#13#10 +
//       ' ORIENTED   ' + #13#10 +
       '    pan:' + Pad(aEntity.pan,5,True)     + ' frame:' + Pad(aEntity.frame,5) + '  floor_dist:' + Pad(aEntity.floor_dist,0) + #13#10 +
       '   tilt:' + Pad(aEntity.tilt,5,True)    + '  skin:' + Pad(aEntity.skin,5)  + '  lightrange:' + Pad(aEntity.lightrange,0) + #13#10 +
       '   roll:' + Pad(aEntity.roll,5,True)    + '  push:' + Pad(aEntity.push,5)  + 'triggerrange:' + Pad(aEntity.trigger_range,0) + #13#10 +
       'ambient:' + Pad(aEntity.ambient,5,True) + '     x:' + Pad(aEntity.x,10,True)   + #13#10 +
       ' albedo:' + Pad(aEntity.albedo,5)       + '     y:' + Pad(aEntity.y,10,True)   + #13#10 +
       '  alpha:' + Pad(aEntity.alpha,5)        + '     z:' + Pad(aEntity.z,10,True)   + #13#10 +
       '   pose:' + Pad(aEntity.pose,5);

  ShowMsgFixedFont(S,'ENTITY: '+String(aEntity.Atype));
end;

procedure ShowViewValues(aView : PView);

var S : String;
begin
  S :=
  {$IFDEF DEBUGFLAGS}
       '         ' + BitLabel1 + #13#10 +
       '   Bit # ' + BitLabel2 + #13#10 +
       '         ' + BitLabel3 + #13#10 +
       '   Flags:' + DecodeFlag(aView.flags) + #13#10#13#10 +
  {$ENDIF}
       'VISIBLE   ' + FlagValue(aView.flags,_VISIBLE) + '  TRANSPARENT ' + FlagValue(aView.flags,TRANSLUCENT) + #13#10 +
       'AUDIBLE   ' + FlagValue(aView.flags,AUDIBLE)  + '  PORTALCLIP  ' + FlagValue(aView.flags,PORTALCLIP) + #13#10 +
       'CULL_CW   ' + FlagValue(aView.flags,CULL_CW)  + '  NOPARTICLE  ' + FlagValue(aView.flags,NOPARTICLE) + #13#10 +
       'NOSHADOW  ' + FlagValue(aView.flags,NOSHADOW) + '  NOCULL      ' + FlagValue(aView.flags,NOCULL) + #13#10 +
       'NOSHADER  ' + FlagValue(aView.flags,NOSHADER) + '  NOFLAG1     ' + FlagValue(aView.flags,NOFLAG1) + #13#10#13#10 +
       '   Layer:' + IntToStr(ConvertNeg(aView.layer)) + #13#10 +
       'clipnear:' + IntToStr(_Int(aView.clip_near)) + #13#10 +
       ' clipfar:' + IntToStr(_Int(aView.clip_far));

  ShowMsgFixedFont(S,'VIEW: '+String(aView.c_link.name));
end;

procedure ShowTextValues(aText : PText);

var S : String;
begin
  S :=
  {$IFDEF DEBUGFLAGS}
       '         ' + BitLabel1 + #13#10 +
       '   Bit # ' + BitLabel2 + #13#10 +
       '         ' + BitLabel3 + #13#10 +
       '   Flags:' + DecodeFlag(aText.flags) + #13#10#13#10 +
  {$ENDIF}
       'CENTER_X  ' + FlagValue(aText.flags,CENTER_X)  + '  OUTLINE     ' + FlagValue(aText.flags,OUTLINE) + #13#10 +
       'CENTER_Y  ' + FlagValue(aText.flags,CENTER_Y)  + '  NARROW      ' + FlagValue(aText.flags,NARROW) + #13#10 +
       'CONDENSED ' + FlagValue(aText.flags,CONDENSED) + '  TRANSLUCENT ' + FlagValue(aText.flags,TRANSLUCENT) + #13#10 +
       'FILTER    ' + FlagValue(aText.flags,FILTER)    + '  SHADOW      ' + FlagValue(aText.flags,SHADOW) + #13#10 +
       'VISIBLE   ' + FlagValue(aText.flags,_VISIBLE) + #13#10#13#10 +
       '   Layer:' + Pad(aText.layer,10) +      ' Scale_x:' + Pad(aText.scale_x,10) +   #13#10 +
       '   Pos_x:' + Pad(aText.pos_x,10,True) + ' Scale_y:' + Pad(aText.scale_y,10) +  #13#10 +
       '   Pos_y:' + Pad(aText.pos_y,10,True) + '  Size_y:' + IntToStr(_Int(aText.size_y)) +  #13#10 +
       '   Alpha:' + Pad(aText.alpha,10) +      'Offset_y:' + IntToStr(ConvertNeg(aText.offset_y)) +  #13#10 +
       ' Strings:' + Pad(aText.strings,10) + #13#10#13#10 +
       '     FONT' + #13#10 +
       '      dx:' + PadI(aText.font.dx,10) + ' num:' + IntToStr(aText.font.num) + #13#10 +
       '      dy:' + PadI(aText.font.dy,10) + ' cpl:' + IntToStr(aText.font.cpl) + #13#10 +
       '   Atype:' + string(aText.font.Atype) + #13#10#13#10 +
       '     BMAP' + #13#10 +
  {$IFDEF DEBUGFLAGS}
       '         ' + BitLabel1 + #13#10 +
       '   Bit # ' + BitLabel2 + #13#10 +
       '         ' + BitLabel3 + #13#10 +
       '   flags:' + DecodeFlag(aText.font.bmap.flags) + #13#10 +
  {$ENDIF}
       '   width:' + PadI(aText.font.bmap.width,10) + #13#10 +
       '  height:' + PadI(aText.font.bmap.height,10) + ' bytespp:' + IntToStr(aText.font.bmap.bytespp) + #13#10;

  ShowMsgFixedFont(S,'TEXT: '+String(aText.c_link.name));
end;

procedure ShowPanelValues(aPanel : PPanel);

var S : String;
begin
  S :=
  {$IFDEF DEBUGFLAGS}
       '        ' + BitLabel1 + #13#10 +
       '  Bit # ' + BitLabel2 + #13#10 +
       '        ' + BitLabel3 + #13#10 +
       '  Flags:' + DecodeFlag(aPanel.flags) + #13#10#13#10 +
  {$ENDIF}
       'VISIBLE   ' + FlagValue(aPanel.flags,_VISIBLE) + '  TRANSLUCENT ' + FlagValue(aPanel.flags,TRANSLUCENT) + #13#10 +
       'OVERLAY   ' + FlagValue(aPanel.flags,OVERLAY)  + '  LIGHT       ' + FlagValue(aPanel.flags,LIGHT) + #13#10 +
       'FILTER    ' + FlagValue(aPanel.flags,FILTER)  + #13#10#13#10 +
       '  Layer:' + IntToStr(ConvertNeg(aPanel.layer)) + #13#10 +
       '  Pos_x:' + IntToStr(ConvertNeg(aPanel.pos_x)) + #13#10 +
       '  Pos_y:' + IntToStr(ConvertNeg(aPanel.pos_y)) + #13#10 +
       '  Alpha:' + IntToStr(_Int(aPanel.alpha)) + #13#10 +
       'Scale_x:' + IntToStr(_Int(aPanel.scale_x)) + #13#10 +
       'Scale_y:' + IntToStr(_Int(aPanel.scale_y)) + #13#10 +
       ' Size_x:' + IntToStr(_Int(aPanel.size_x)) + #13#10 +
       ' Size_y:' + IntToStr(_Int(aPanel.size_y)) + #13#10;

  ShowMsgFixedFont(S,'PANEL: '+String(aPanel.c_link.name));
end;

procedure ShowParticleValues(aParticle : PParticle);

var S : String;
begin
  S := '       ' + BitLabel1 + #13#10 +
       ' Bit # ' + BitLabel2 + #13#10 +
       '       ' + BitLabel3 + #13#10 +
       ' Flags:' + DecodeFlag(aParticle.flags);

  ShowMsgFixedFont(S);
end;

procedure RedParticleLine(p : PParticle); cdecl;
begin
  p.lifespan := _VAR(1);
  p.flags := p.flags OR STREAK;
  p.red := _VAR(100);
  p.green := _VAR(1);
  p.blue := _VAR(1);
  p.size := _VAR(1);
  p.event := Nil;
end;

procedure BlueParticleLine(p : PParticle); cdecl;
begin
  p.lifespan := _VAR(1);
  p.flags := p.flags OR STREAK;
  p.red := _VAR(1);
  p.green := _VAR(1);
  p.blue := _VAR(100);
  p.size := _VAR(1);
  p.event := Nil;
end;

procedure GreenParticleLine(p : PParticle); cdecl;
begin
  p.lifespan := _VAR(1);
  p.flags := p.flags OR STREAK;
  p.red := _VAR(1);
  p.green := _VAR(100);
  p.blue := _VAR(1);
  p.size := _VAR(1);
  p.event := Nil;
end;

procedure Debug_DrawRedLine(Start,Stop : PVector);

// example: Debug_DrawLine(@Entity1.x,@Entity2.x);

var AVec : TVector;
begin
  vec_diff(@AVec.x,Stop,Start);        // AVec is direction of Stop to Start

  // create beam particle effect from Start postion to the Stop position
  effect_local(@RedParticleLine,_VAR(1),Start,@AVec.x);
end;

procedure Debug_DrawBlueLine(Start,Stop : PVector);

// example: Debug_DrawLine(@Entity1.x,@Entity2.x);

var AVec : TVector;
begin
  vec_diff(@AVec.x,Stop,Start);        // AVec is direction of Stop to Start

  // create beam particle effect from Start postion to the Stop position
  effect_local(@BlueParticleLine,_VAR(1),Start,@AVec.x);
end;

procedure Debug_DrawGreenLine(Start,Stop : PVector);

// example: Debug_DrawLine(@Entity1.x,@Entity2.x);

var AVec : TVector;
begin
  vec_diff(@AVec.x,Stop,Start);        // AVec is direction of Stop to Start