sample9.dpr

3D GameStudio 的Delphi开发包

program sample9;

//////////////////////////////////////////////////////////////////////
//
// 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;

var TheText : PText;

    FireBall,
    BlueArrow : PBmap;

    aEntity,
    bEntity : PEntity;

procedure FadeOut(p : PParticle); cdecl;
begin
  if _INT(p.size) < 16 then
    Inc(p.size,_VAR(0.5));

  Inc(p.blue,_VAR(25));

  if _INT(p.alpha) > 0 then
    Dec(p.alpha,_VAR(1));
end;

procedure Boom(p : PParticle); cdecl;

//var aVec : TVector;
begin
  p.size := _VAR(2);
  p.bmap := FireBall;
  p.event := @fadeout;
  p.alpha := _VAR(100);
  p.lifespan := _VAR(20);
  p.flags := p.flags or Move or Translucent; // internal flags are already set, don't reset them

  p.vel_x := _random(_VAR(1)) - _VAR(0.5);
  p.vel_y := _random(_VAR(1)) - _VAR(0.5);
  p.vel_z := _random(_VAR(1)) - _VAR(0.5);

  //or this way
{  avec.x := _random(_VAR(1)) - _VAR(0.5);
  avec.y := _random(_VAR(1)) - _VAR(0.5);
  avec.z := _random(_VAR(1)) - _VAR(0.5);

  vec_set(PVector(@p.vel_x),@avec);}
end;

procedure EntityEvent;

var TheEvent : Integer;
    aVec : TVector;
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
      vec_set(PVector(@aVec),@ev.me.x);
      vec_add(PVector(@aVec),_vec(0,0,30));
      effect(@Boom,_VAR(5),PVector(@aVec),ev.normal);

      // or this way
      //effect(@Boom,_VAR(5),vector(ev.me.x,ev.me.y,ev.me.z+_VAR(30)),ev.normal);

      Inc(ev.you.pan,_VAR(180));           // turn around
      ev.you.skill[2] := 0;                // travel away from witch
    end;
  end;
end;

procedure AnimateAction(Param : Pointer);
begin
  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 ev.me = BEntity then
      Wait(-0.05)                          // give control up for half second
    else
    begin
      if aEntity <> Nil then
        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);

      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
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..0] of string = ('Hit Esc to Quit the Program');

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

  TheText := txt_create(_VAR(1),_VAR(1));  // create a text with 1 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
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

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

  bEntity.event := @EntityEvent;           // assign event function
  Inc(bEntity.pan,_VAR(90));               // face the warlock
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 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);

  FireBall  := bmap_create('fball.pcx');       // needed for particle function
  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);

  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

  CreateText;
  CreateEntities;

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

  RemoveEntities;
  engine_close();
end;

begin
  Main;
end.