sample8.dpr

3D GameStudio 的Delphi开发包

program sample8;

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

var TheText : PText;

    BlueArrow : PBmap;

    aEntity,
    bEntity,
    Sprite : PEntity;

procedure SpriteEvent;

var p : PEntity;
begin
  p := ptr_for_handle(ev.me.client_id);    // get the model

  if p = Nil then
  begin
    FlagON(ev.me.flags,INVISIBLE);         // model was deleted
    Exit;
  end;

  ev.me.x := p.x - 20;                     // position sprite
  ev.me.y := p.y;                          // near the model
  ev.me.z := p.z - 40;

  FlagOFF(ev.me.flags,INVISIBLE);          // make sprite visible
end;

procedure SpriteAction;
begin
  ev.me.client_id := handle(ev.you);       // save handle of model

  ev.me.event := @SpriteEvent;             // set the event

  FlagON(ev.me.emask,ENABLE_FRAME);        // sprite event called every frame
  FlagON(ev.me.flags,ZNEAR);               // puts sprite in front of model
end;

procedure EntityEvent;

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

  if TheEvent = EVENT_CLICK then           // the model was clicked on
  begin
    Inc(ev.me.pan,_VAR(45));               // spin the model

    if Sprite = Nil then
      Sprite := ent_create('active.bmp',_VEC(0,0,0),@SpriteAction)
    else
    if Sprite.client_id = ev.me.C_Link.index then  // clicked on active model
    begin
      if AEntity = ev.me then              // must set the actual variable
        AEntity := Nil                     // that ev.me is pointing at to
      else                                 // Nil so our RemoveEntities
        BEntity := Nil;                    // function works correctly

      ent_remove(ev.me);                   // remove the entity
    end
    else
      Sprite.client_id := ev.me.C_Link.index;      // clicked on inactive model
  end;
end;

procedure MorphEntity;

var p : PEntity;
begin
  if Sprite = Nil then Exit;               // no entity was clicked yet

  p := ptr_for_handle(Sprite.client_id);   // get the entity pointer

  if p = Nil then Exit;                    // no active entity

  if p.Atype = 'WARLOCK.MDL' then          // get current model name
    ent_morph(p,'witch.mdl')
  else
    ent_morph(p,'warlock.mdl');
end;

procedure RemoveEntities;
begin
  if aEntity <> Nil then ent_remove(aEntity);
  if bEntity <> Nil then ent_remove(bEntity);
  if Sprite <> Nil then ent_remove(Sprite);
end;

procedure CreateText;

const TheStrings : Array[0..8] of string = ('Click on an Entity to set it Active',
                                            'Hit Enter to Morph Active Entity',
                                            ' ',
                                            'Click on Active Entity to Delete it',
                                            ' ',
                                            'W,S,A,D moves the Warlock',
                                            'I,K,J,L moves the Witch',
                                            ' ',
                                            'Hit Esc to Quit the Program');

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

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

  TheText.font := TheFont;                 // assign the font
  TheText.pos_x := _VAR(400);              // set the x position
  TheText.pos_y := _VAR(25);               // 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),Nil);

  aEntity.event := @EntityEvent;           // assign event function
  FlagON(aEntity.emask,ENABLE_CLICK);      // allow entity to be clicked
  Dec(aEntity.pan,_VAR(90));               // face the witch

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

  bEntity.event := @EntityEvent;           // assign event function
  FlagON(bEntity.emask,ENABLE_CLICK);      // allow entity to be clicked
  Inc(bEntity.pan,_VAR(90));               // face the warlock
end;

procedure Do_C_Move;

var vMove : TVector;	                   // movement vector
begin
  if _INT(ev.freeze_mode^) > 1 then Exit;  // all functions suspened

  if AEntity = Nil then Exit;

  vMove.x := 1 * (ev.key_w^ - ev.key_s^);   // move forward
  vMove.y := 1 * (ev.key_a^ - ev.key_d^);   // move sideward
  vMove.z := 0;

  // this will NOT allow passing through level blocks or entities
  c_move(AEntity,@vMove.x,_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);
end;

procedure Do_Move;

var vMove : TVector;	                   // movement vector
begin
  if _INT(ev.freeze_mode^) > 1 then Exit;  // all functions suspened

  if BEntity = Nil then Exit;

  Dec(BEntity.pan, (3 * ev.key_force.x));  // left/right cursor keys

  vMove.x := 1 * (ev.key_i^ - ev.key_k^);  // move forward
  vMove.y := 1 * (ev.key_j^ - ev.key_l^);  // move sideward
  vMove.z := 0;

  // this will allow passing through level blocks or entities
  vec_rotate(@vMove,@BEntity.pan);
  vec_add(@BEntity.x,@vMove);
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);

  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.on_enter^ := @MorphEntity;

  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;
    Do_C_Move;
    Do_Move;
  end;

  RemoveEntities;
  engine_close();
end;

begin
  Main;
end.