sample10.dpr

3D GameStudio 的Delphi开发包

program sample10;

//////////////////////////////////////////////////////////////////////
//
// 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, Engine_Debug, Dialogs, sysutils;

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

var DebugStatusText,
    ScannedText,
    DetectedText,
    TheText : PText;

    BlueArrow : PBmap;

    aEntity,
    bEntity : PEntity;

    aMirror : PView;

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

{.$DEFINE MATERIAL}
{.$DEFINE SPECULARLIGHTS}
{.$DEFINE AMBIENTLIGHT}

{$DEFINE DYNAMICLIGHT}
{$DEFINE UNLIT}
{.$DEFINE LIGHT}
{.$DEFINE EMISSIVELIGHT}
{.$DEFINE AMBIENTLIGHT}
{.$DEFINE DIFFUSELIGHT}
{.$DEFINE SPECULARLIGHTS}

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_SURFACE then
  begin
    if ev.me.skill[2] = 0 then             // traveling away from witch
    begin
      Dec(ev.me.pan,_VAR(180));            // turn around
      ev.me.skill[2] := _VAR(1);           // travel towards witch
    end;
  end
  else
  if TheEvent = EVENT_IMPACT then
  begin
    if ev.you.skill[2] = _VAR(1) then      // traveling towards witch
    begin
      Inc(ev.you.pan,_VAR(180));           // turn around
      ev.you.skill[2] := 0;                // travel away from witch
    end;
  end
  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 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));


  while True do                            // keep action running
  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 ShowDebug = 1 then Debug_DrawBoundBox(ev.me);

    {$IFDEF MATERIAL}
    if ev.me.material <> Nil then
    begin
      {$IFDEF SPECULARLIGHTS}
      if ev.me.material.power > 0 then Dec(ev.me.material.power,_VAR(0.1))
      else
        ev.me.material.power := _VAR(10);
      {$ENDIF}

      {$IFDEF AMBIENTLIGHT}
      if ev.me.material.ambient_green > 0 then Dec(ev.me.material.ambient_green,_VAR(1))
        else ev.me.material.ambient_green := _VAR(150);

      if ev.me.material.ambient_blue > 0 then Dec(ev.me.material.ambient_blue,_VAR(1))
      else
        ev.me.material.ambient_blue  := _VAR(255);

      if ev.me.material.ambient_red > 0 then Dec(ev.me.material.ambient_red,_VAR(1))
      else
        ev.me.material.ambient_red   := _VAR(150);
      {$ENDIF}
    end;
    {$ENDIF}

    if ev.me = BEntity then
    begin
      Found := c_scan(@ev.me.x,@ev.me.pan,_vec(90,45,50),SCAN_ENTS or SCAN_LIMIT or IGNORE_ME) > 0;

      if ShowDebug = 2 then Debug_C_Scan(ev.me,@ev.me.pan,_vec(90,45,50));

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

      Wait(-0.05)                          // give control up for half second
    end
    else
    begin
      c_move(ev.me,_VEC(1,0,0),_VEC(0,0,0),glide or ignore_me or ignore_you or ignore_push or ignore_models or ignore_maps or IGNORE_SPRITES or IGNORE_PASSABLE);

      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
        ScannedText.pos_x := Temp.x;       // keep text with the entity

      Wait(1);                             // give control up for 1 frame
    end;
  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

  {$IFDEF DYNAMICLIGHT}
  ev.me.lightrange := _VAR(400);   // > 0 turns the dynamic light on  equals a lightsphere in quants
  FlagOn(ev.me.flags2,SPOTLIGHT);  // emitted light is spotlight
  {$ENDIF}

  {$IFDEF UNLIT}
  FlagOn(ev.me.flags,UNLIT);  //means no longer affected by static or dynamic lights only the sun,
  {$ENDIF}                     //it's material and it's own light values (ambient) effect it's brightness
                               //this flags needs off for emissive light to be effective
                               //on for ambient light

  {$IFDEF LIGHT}
  FlagOn(ev.me.flags,LIGHT);  //on means lights itself from it's blue,red,green values defaults Off
  ev.me.blue  := _VAR(150);
  ev.me.green := _VAR(200);
  ev.me.red   := _VAR(255);
  {$ENDIF}

  {$IFDEF MATERIAL}
  ev.me.material := mtl_create;
  {$ENDIF}

  {$IFDEF EMISSIVELIGHT}
  ev.me.material.emissive_blue  := _VAR(10);   //color that is emitted by the material itself (a glow)
  ev.me.material.emissive_green := _VAR(255);  //UNLIT ON works, UNLIT Off seems Ambient_xxx needed also
  ev.me.material.emissive_red   := _VAR(20);   //defaults to 0
  {$ENDIF}

  {$IFDEF AMBIENTLIGHT}
  ev.me.material.ambient_green := _VAR(10);    //color that is reflected by static light or
  ev.me.material.ambient_blue  := _VAR(255);   //light emitted by the entity
  ev.me.material.ambient_red   := _VAR(10);    //gives a tint of that color to the entity defaults to 200
  {$ENDIF}

  {$IFDEF DIFFUSELIGHT}
  ev.me.material.diffuse_green := _VAR(50);    //influence of dynamic and sun light independent of camera
  ev.me.material.diffuse_blue  := _VAR(255);   //needs lightrange > 0 to work  possibly needs UNLIT ON
  ev.me.material.diffuse_red   := _VAR(100);   //defaults to 200
  {$ENDIF}

  {$IFDEF SPECULARLIGHTS}
  ev.me.material.specular_blue := _VAR(255);   //influence of dynamic and sun light dependent on camera
  ev.me.material.specular_green:= _VAR(255);   //used for metal effect
  ev.me.material.specular_red  := _VAR(255);   //defaults to 0
  ev.me.material.power         := _VAR(0);     //sharpness of specular highlights defaults to 0
  {$ENDIF}                                     //0=Off 1=greatest effect 10=leaset effect
end;

procedure RemoveEntities;
begin                                          // remove scheduler functions
  Proc_Remove_Sch(aEntity);                    // will remove all functions
  Proc_Remove_Sch(bEntity);                    // for that entity, passing
                                               // a nil entity is okay
  if aEntity <> Nil then ent_remove(aEntity);
  if bEntity <> Nil then ent_remove(bEntity);
end;

procedure CreateText;

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

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(130);              // 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;
end;

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

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

  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);
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);
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 ToggleViewDebug;
begin
  Inc(ShowDebug);

  case ShowDebug of
    1 : str_cpy(DebugStatusText.Astring^,'Showing Bounding Boxes');
    2 : str_cpy(DebugStatusText.Astring^,'Showing c_scan Range');
    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^ := @ToggleViewDebug;

  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.