sample11.dpr

3D GameStudio 的Delphi开发包

program sample11;

//////////////////////////////////////////////////////////////////////
//
// Delphi sample for using the A6_5x Engine (acknex.dll) done by
// Michal Messerschmidt aka LazyDog of Lazy Dog Software
// (www.LazyDogSoftware.com)
//
// SDK Version 6.50.6
//
// tested on Delphi 5,6,7 & 2005
//////////////////////////////////////////////////////////////////////

{$R 'icon.res' 'icon.rc'}  // this allows defining your own .ico file
                           // without the overhead of using the forms unit
                           // to get to the application.icon.  simply change
                           // the icon.rc file to point to your icon

uses A6Engine, Engine_Library, Scheduler, Dialogs, sysutils, Engine_Debug;

const FoundHim = 'I detected someone!';
      Looking  = 'I am looking';
      Hidden   = 'I am hidden';
      WasFound = 'I was Scanned!';

var DebugStatusText,
    ScannedText,
    DetectedText,
    SeenText,
    TheText : PText;

    BlueArrow : PBmap;

    aEntity,
    bEntity,
    cEntity : PEntity;

    aMirror : PView;

    ShowDebug : Integer = 0;
    Saw      : Boolean = False;
    Trigger  : Boolean = False;
    Found    : Boolean = False;
    Scanned  : Boolean = False;


procedure InitMirror;
begin
  aMirror := view_create(_VAR(-1));        // negative layer for mirror
  ev.camera.portal := aMirror;
  FlagOn(aMirror.flags,PORTALCLIP or NOSHADOW or NOCULL or _VISIBLE);
end;

procedure UpdateMirror;
begin
  if aMirror = Nil then Exit;

  aMirror.genius := ev.camera.genius;
  aMirror.aspect := -ev.camera.aspect;
  aMirror.arc    := ev.camera.arc;
  aMirror.x      := ev.camera.x;
  aMirror.y      := ev.camera.y;
  aMirror.z      := 2 * ev.camera.portal_z - ev.camera.z;
  aMirror.pan    := ev.camera.pan;
  aMirror.tilt   := -ev.camera.tilt;
  aMirror.roll   := -ev.camera.roll;
end;

procedure EntityEvent;

var TheEvent : Integer;
begin
  TheEvent := _INT(ev.event_type^);        // get the event type

  if TheEvent = EVENT_TRIGGER then
    Trigger := True
  else
  if TheEvent = EVENT_DETECT then          // detected an entity
    Found := True                          // ev.you is detected entity
  else
  if TheEvent = EVENT_SCAN then            // an entity was detected
    Scanned := True;                       // if ev.you <> Nil then
end;                                       // ev.you is the entity that scanned

procedure NoAnimateAction(Param : Pointer);
begin
  // this initializing code before the loop needs to be done after
  // at least 1 frame has executed after the entity has been created;
  // therefore, the code was placed here in this action which is called
  // by the scheduler and doesn't get called until after 1 frame has
  // already executed.

  // set both flags on so that entities' bounding box uses our values
  FlagOn(ev.me.eflags,FAT or NARROW);

  // reduce the bounding box for collision so they get closer together
  vec_set(@ev.me.bmin,_VEC(-10,-10,-10));
  vec_set(@ev.me.bmax,_VEC(10,10,10));

  // keep action running all the time
  while True do
  begin
    if ShowDebug = 2 then
      Debug_DrawTriggerRange(ev.me);

    Wait(1);                               // give control up for 1 frame
  end;
end;

procedure AnimateAction(Param : Pointer);

var Temp : TVector;
begin
  // this initializing code before the loop needs to be done after
  // at least 1 frame has executed after the entity has been created;
  // therefore, the code was placed here in this action which is called
  // by the scheduler and doesn't get called until after 1 frame has
  // already executed.

  // set both flags on so that entities' bounding box uses our values
  FlagOn(ev.me.eflags,FAT or NARROW);

  // reduce the bounding box for collision so they get closer together
  vec_set(@ev.me.bmin,_VEC(-10,-10,-10));
  vec_set(@ev.me.bmax,_VEC(10,10,10));

  // keep action running all the time
  while True do
  begin
    // this keeps a steady speed for the animation no matter the
    // FPS rate so a slow or fast computer would see the same rate
    Inc(ev.me.skill[1],_VAR(0.007 * ev.time_step^));

    if ev.me.skill[1] >= _VAR(100) then
      ev.me.skill[1] := 0;

    ent_animate(ev.me,'walk',ev.me.skill[1],anm_cycle);

    if ev.me = BEntity then                // witch scans for warlock
    begin
      Found := c_scan(@ev.me.x,@ev.me.pan,_vec(15,15,125),_VAR(SCAN_ENTS or SCAN_LIMIT or IGNORE_ME)) > 0;

      if ShowDebug = 1 then
        Debug_C_Scan(ev.me,@ev.me.pan,_vec(15,15,125));

      if not Found then Scanned := False;  // no longer getting scanned
    end;

    if ShowDebug = 2 then
      Debug_DrawTriggerRange(ev.me);

    // when the distance to the next node is 0 change direction
    // ev.me.skill[4],[5],[6] holds the position vector of the next node
    if _INT(vec_dist(@ev.me.skill[4],@ev.me.x)) = 0 then
    begin
      Dec(ev.me.pan,_VAR(2));            // turn clockwise 2 degress

      if ev.me.pan mod _VAR(90) = 0 then // did we turn a full 90 degrees?
      begin
        Inc(ev.me.skill[3],_VAR(1));     // increment next node

        if ev.me.skill[3] = _VAR(5) then // values are 1-4 only
          ev.me.skill[3] := _VAR(1);

        // save the position of the next node into skill[4],[5],[6]
        // if I wanted the skills from the node, replace Nil with the
        // code that is commented out at the end of the next line
        path_getnode(ev.me,ev.me.skill[3],@ev.me.skill[4],Nil);//@ev.me.skill[4]);
      end;
    end
    else
      c_move(ev.me,_VEC(1,0,0),_VEC(0,0,0),_VAR(glide or ACTIVATE_TRIGGER or ignore_me));

    vec_set(@Temp,@ev.me.x);               // get entity vector
    vec_to_screen(@Temp,ev.camera);        // convert to screen coordinates

    if Temp.x > 0 then                     // if visible on screen
      if ev.me = aEntity then
        ScannedText.pos_x := Temp.x        // keep text with the entity
      else
        DetectedText.pos_x := Temp.x;

    Wait(1);                               // give control up for 1 frame
  end;
end;

procedure EntityAction;
begin
  ev.me.skill[1] := 0;                     // keep track of animation cycle

  FlagON(ev.me.emask,ENABLE_IMPACT or ENABLE_SURFACE);

  ev.me.event := @EntityEvent;             // assign event function

  Proc_Add_Sch(ev.me,@AnimateAction);      // add function to scheduler
end;

procedure EntityAction2;
begin
  Inc(ev.me.pan,_VAR(180));              // face the camera
  FlagON(ev.me.flags,PASSABLE);          // don't want collisions
  FlagON(ev.me.emask,ENABLE_TRIGGER);    // want to use trigger range

  ev.me.event := @EntityEvent;           // assign event function

  ev.me.trigger_range := _VAR(20);       // set trigger range

  Proc_Add_Sch(ev.me,@NoAnimateAction);  // add function to scheduler
end;

procedure RemoveEntities;
begin                                          // remove scheduler functions
  Proc_Remove_Sch(aEntity);                    // will remove all functions
  Proc_Remove_Sch(bEntity);                    // for that entity, passing
  Proc_Remove_Sch(cEntity);                    // a nil entity is okay

  if aEntity <> Nil then ent_remove(aEntity);  // passing nil to ent_remove
  if bEntity <> Nil then ent_remove(bEntity);  // is bad and will cause a
  if cEntity <> Nil then ent_remove(cEntity);  // crash!
end;

procedure CreateText;

const TheStrings : Array[0..1] of string = ('Hit Esc to Quit the Program',
                                            'Click anywhere to toggle viewing scan');

var TheFont : PFont_;

begin
  TheFont := font_create('font1_red.pcx'); // create a font

  TheText := txt_create(_VAR(2),_VAR(1));  // create a text with 2 strings
                                           // setting the layer = 1

  TheText.font := TheFont;                 // assign the font
  TheText.pos_x := _VAR(400);              // set the x position
  TheText.pos_y := _VAR(100);              // set the y position
  TheText.flags := _VISIBLE or CENTER_X;   // set it visible, centered on x

  Txt_Fill(TheText,TheStrings);            // fill the text object from array
                                           // txt_fill defined in Engine_Library

  ScannedText := txt_create(_VAR(1),_VAR(1));
  ScannedText.font := theFont;
  ScannedText.pos_x := _VAR(200);
  ScannedText.pos_y := _VAR(170);
  ScannedText.flags := _VISIBLE;

  str_cpy(ScannedText.Astring^,Hidden);

  DetectedText := txt_create(_VAR(1),_VAR(1));
  DetectedText.font := theFont;
  DetectedText.pos_x := _VAR(550);
  DetectedText.pos_y := _VAR(240);
  DetectedText.flags := _VISIBLE;

  str_cpy(DetectedText.Astring^,Looking);

  DebugStatusText := txt_create(_VAR(1),_VAR(1));
  DebugStatusText.font := TheFont;
  DebugStatusText.pos_x := _VAR(400);
  DebugStatusText.pos_y := _VAR(70);
  DebugStatusText.flags := CENTER_X;

  str_cpy(DebugStatusText.Astring^,'Showing c_scan Range');

  SeenText := txt_create(_VAR(1),_VAR(1));
  SeenText.font := TheFont;
  SeenText.pos_x := _VAR(10);
  SeenText.pos_y := _VAR(200);

  str_cpy(SeenText.Astring^,'Trigger hit');
end;

procedure CreateEntities;
begin
  aEntity := ent_create('warlock.mdl',_VEC(-115,180,192),@EntityAction);

  aEntity.event := @EntityEvent;           // assign event function
  aEntity.skill[2] := _VAR(1);             // travel to witch
  FlagON(aEntity.emask,ENABLE_SCAN);

  path_next(aEntity);                      // get our path

  // set the position of the entity to the 2nd node
  // if I wanted the skills from the node, replace Nil with the
  // code that is commented out at the end of the next line
  path_getnode(aEntity,_VAR(2),@aEntity.x,Nil);//@aEntity.skill[4]);

  aEntity.skill[3] := _VAR(3);             // store next node number

  // save the position of the 3rd node into skill[4],[5],[6]
  path_getnode(aEntity,_VAR(3),@aEntity.skill[4],Nil);

  bEntity := ent_create('witch.mdl',_VEC(-115,120,192),@EntityAction);

  bEntity.event := @EntityEvent;           // assign event function
  Inc(bEntity.pan,_VAR(90));               // face the warlock
  FlagON(bEntity.emask,ENABLE_DETECT);

  path_next(bEntity);                      // get our path

  // set the position of the entity to the 1st node
  // if I wanted the skills from the node, replace Nil with the
  // code that is commented out at the end of the next line
  path_getnode(bEntity,_VAR(1),@bEntity.x,Nil);//@aEntity.skill[4]);

  bEntity.skill[3] := _VAR(2);             // store next node number

  // save the position of the 2nd node into skill[4],[5],[6]
  path_getnode(bEntity,_VAR(2),@bEntity.skill[4],Nil);

  cEntity := ent_create('cbabe.mdl',_VEC(-120,210,192),@EntityAction2);
end;

procedure UpdateText;
begin
  if Scanned then
    str_cpy(ScannedText.Astring^,WasFound)
  else
    str_cpy(ScannedText.Astring^,Hidden);

  if Found then
    str_cpy(DetectedText.Astring^,FoundHim)
  else
    str_cpy(DetectedText.Astring^,Looking);

  if Trigger then
    FlagOn(SeenText.flags,_VISIBLE)
  else
    FlagOff(SeenText.flags,_VISIBLE);

  Trigger := False;
end;

procedure MoveMouse;
begin
  if ev.mouse_map = Nil then Exit;

  if _INT(ev.freeze_mode^) > 1 then Exit;  // all functions suspended

  if ev.mouse_valid^ = 0 then              // makes cursor disappear when
    ev.mouse_mode^ := 0                    // no longer over the engine window
  else
    ev.mouse_mode^ := _VAR(1);

  if ev.mouse_mode^ > 0 then               // move it over the screen
  begin
    ev.mouse_pos.x := ev.mouse_cursor.x;
    ev.mouse_pos.y := ev.mouse_cursor.y;
  end;
end;

procedure ToggleViewScan;
begin
  Inc(ShowDebug);

  case ShowDebug of
    1 : str_cpy(DebugStatusText.Astring^,'Showing c_scan Range');
    2 : str_cpy(DebugStatusText.Astring^,'Showing Trigger Range Boxes');
    3 : ShowDebug := 0;
  end;

  if ShowDebug = 0 then
    FlagOff(DebugStatusText.flags,_VISIBLE)
  else
    FlagOn(DebugStatusText.flags,_VISIBLE);
end;

procedure Quit;
begin
  sys_exit('');     // quit running and shut down the engine
end;

procedure Main;
begin
  if FindDirectX < 9 then
  begin
    ShowMessage('DirectX 9 is required to run this program');
    Exit;
  end;

  ev := engine_open('');         // commands like -diag can be used here

  if ev = Nil then Exit;

  add_folder('files');           // point to subdirectory that holds level files

  ev.camera.arc := _VAR(120);

  BlueArrow := bmap_create('arrow_blue.pcx');  // needed for clicking on entities

  ev.on_close^ := @Quit;         // [X] close icon clicked quits program
  ev.on_esc^   := @Quit;         // ESC key quits program

  ev.mouse_mode^    := _VAR(1);  // windows cursor is visible
  ev.mouse_pointer^ := _VAR(1);  // default cursor is hand
  ev.mouse_map      := BlueArrow;

  ev.video_screen^ := _VAR(2);   // default to window mode
  ev.video_mode^   := _VAR(7);   // default to 800x600
  ev.video_depth^  := _VAR(32);  // default to 32 bit depth

  ev.fps_min^ := _VAR(16);
  ev.fps_max^ := _VAR(60);

  ev.on_mouse_left^ := @ToggleViewScan;

  level_load('paths.wmb');       // this is loaded from the files subdirectory

  engine_frame;                  // need to wait 2 frames after a level_load
  engine_frame;                  // before creating entities

  InitMirror;
  CreateText;
  CreateEntities;

  // here is the engine main loop
  while engine_frame <> 0 do
  begin
    UpdateText;
    MoveMouse;
    ExecScheduler;
    UpdateMirror;
  end;

  RemoveEntities;
  engine_close();
end;

begin
  Main;
end.