unit1.~pas

类似超级玛丽模型之二(DELPHIX)

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  directx, DXDraws, DXClass, DXInput, DXSounds, DXPlay, joffaclass, math, registry;


Type objtype = Record
    ox, oy, xx, yy: single;
    py, vx, vy, ovy: single;
    typo: integer;
    ax, ay: single;
    direction: byte;
    tag: String[10];
    pic: single;
    energy, itag, stall, invince: integer;
    istrampo, crashx, crashy: boolean;
    pusher, pushable, blockcrash: boolean;
    gravity: boolean;
  End;

Type
  TMainForm = Class(TDXForm)
    DXDraw1: TDXDraw;
    DXTimer1: TDXTimer;
    DXImageList1: TDXImageList;
    DXInput1: TDXInput;
    DXSound1: TDXSound;
    DXSfx1: TDXWaveList;
    DXMusic1: TDXWaveList;
    DXPlay1: TDXPlay;
    Procedure DXTimer1Timer(Sender: TObject; LagCount: Integer);
    Procedure DXPlay1Message(Sender: TObject; From: TDXPlayPlayer;
      Data: Pointer; DataSize: Integer);
    Procedure UpdateGamma;
    Procedure FormKeyDown(Sender: TObject; Var Key: Word;
      Shift: TShiftState);
    Procedure DXDraw1InitializeSurface(Sender: TObject);
    Procedure FormKeyUp(Sender: TObject; Var Key: Word;
      Shift: TShiftState);
    Procedure FormCreate(Sender: TObject);
    Procedure DXDraw1Click(Sender: TObject);
  Private
    { Private declarations }
    Slide: Boolean;
  Public
    { Public declarations }

    Function CreateObjectOfBlock(blockno: integer; xx, yy: single): integer;
    Procedure PlaySoundFX(xx, yy: single; sample: integer);
    Procedure calcbmask(imageno: integer);
    Procedure killenemy(objnr: integer);
    Procedure killjoffa(objnr, enemynr: integer);
    Function pushobjsx(cx, cy, dx: single; discard, level: integer): boolean;
    Function pushobjsy(cx, cy: single; Var dy: single; discard, level: integer): boolean;
    Procedure MoveObject(obj: integer; dvx, dvy: single; level: integer);
    Procedure ProcessObjs;
    Procedure PlayerInput(PlayerObj: integer; dxistates: tdxinputstates);
    Procedure PlayGame;
    Procedure loadlevel(levelfilename: String);
    Procedure loadgfx;
    Procedure LoadWorld(dff: String);
    Procedure InitApp;
    Procedure InitGame;
    Function GetHandle: integer;
    Procedure SwitchMode;
    Procedure SetObj(ObjNo: integer; Obj: objtype);
  End;

Const DefaultWidth  = 1024;
  DefaultHeight     = 512;
  DefaultLayers     = 3;
  maxplayers        = 16;
//      maxobjs = 256;
  LiftSpeed         = 1;

Type levelextrainfotype = Record
    startx, starty: integer;
    layers: integer;
    width, height: integer;
    name: String[32];
    megaobjs, bypass, background, backobjs, sprites: String[32];
    scrollbackground: byte;
  End;


Type leveltype = Record
    info: levelextrainfotype;
    l: Array Of Array Of Array Of smallint;
    filename: String[255];
    currentfile: String[255];
  End;


Type playertype = Record
    id: cardinal;
    objnr: integer;
    score: integer;
    invince: integer;
    name: String[255];
  End;


Type gametype = Record
    players: Array[0..maxplayers - 1] Of playertype;
    level: leveltype;
    objs: Array Of objtype;
    scrollx, scrolly: integer;
    done: Array[0..15] Of boolean;
    fireup: boolean;
    levelscore, score, nextfire: integer;
    gamma: Record
      r, g, b: single;
    End;
  End;

Var
  MainForm          : TMainForm;
  Game              : gametype;
  currentobj, MyHandle: integer;
  bmask             : Array[0..1024, 0..31, 0..31] Of boolean;
  playing           : boolean = false;
  introframe        : integer = 0;
  frame             : integer = 0;
  visiblescore      : integer;

Const SnowPixels    = 200;
  GameLayer         = 1;

Var snow            : Array[0..SnowPixels - 1] Of Record
    x, y, z: single;
    d: byte;
  End;

Function deviceBitsPerPixel: integer;

Implementation

Uses jUnit2, Unit2, Unit3;

{$R *.DFM}

Var GammaRamp       : TDDGammaRamp;

Function deviceBitsPerPixel: integer;
Var
  DC                : HDC;
Begin
  DC := getDC(0);

  Try
    result := GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL);
  Finally
    releaseDC(0, DC);
  End;
End;

Procedure TMainForm.SetObj(ObjNo: integer; Obj: objtype);
Begin
  game.objs[objno] := obj;
{ with game.objs[objno] do
  begin
    gravity:=obj.gravity;
    xx:=obj.xx;
    yy:=obj.yy;
    vx:=obj.vx;
    vy:=obj.vy;
    typo:=obj.typo;
    ox:=obj.ox;
    oy:=obj.oy;
    py:=obj.py;
    ovy:=obj.ovy;
    ax:=obj.ax;
    ay:=obj.ay;
    direction:=obj.direction;
    tag:=obj.tag;
    pic:=obj.pic;
    energy:=obj.energy;
    itag:=obj.itag;
    stall:=obj.stall;
    invince:=obj.invince;
    istrampo:=obj.istrampo;
    crashx:=obj.crashx;
    crashy:=obj.crashy;
    pusher:=obj.pusher;
    pushable:=obj.pushable;
    blockcrash:=obj.blockcrash;
  end;{}
End;

Procedure TMainForm.SwitchMode;
Begin
  DXDraw1.Finalize;

  If doFullScreen In DXDraw1.Options Then
  Begin
    RestoreWindow;
    DXDraw1.Display.BitCount := devicebitsperpixel;
    DXDraw1.Cursor := crDefault;
    BorderStyle := bsSingle;
    DXDraw1.Options := DXDraw1.Options - [doFullScreen];
    ClientWidth := 640;
    ClientHeight := 480;
  End Else
  Begin
    StoreWindow;
    DXDraw1.Display.BitCount := 16;
    DXDraw1.Cursor := crNone;
    BorderStyle := bsNone;
    DXDraw1.Options := DXDraw1.Options + [doFullScreen];
    Top := 0;
    Left := 0;
  End;

  DXDraw1.Initialize;
  If playing Then LoadGFX;
  With TRegIniFile.Create('Joffa') Do
  Begin
    If (dofullscreen In dxdraw1.options) Then
      WriteBool('Settings', 'Fullscreen', True) Else
      WriteBool('Settings', 'Fullscreen', False);
    Free;
  End;

End;

Procedure TMainForm.UpdateGamma;
Var
  i                 : Integer;
  r, g, b           : integer;
Begin
  With game Do
    For i := 0 To 255 Do
    Begin
      r := round((i Shl 8) * gamma.r);
      g := round((i Shl 8) * gamma.g);
      b := round((i Shl 8) * gamma.b);
      If r > 65534 Then r := 65534;
      If g > 65534 Then g := 65534;
      If b > 65534 Then b := 65534;

      GammaRamp.Red[i] := r;
      GammaRamp.Green[i] := g;
      GammaRamp.Blue[i] := b;
    End;

  DXDraw1.Primary.GammaControl.SetGammaRamp(0, GammaRamp);
End;

Function TMainForm.CreateObjectOfBlock(blockno: integer; xx, yy: single): integer;
Var handl           : integer;
Begin
  result := -1;
  If (blockno = 7) Then
  Begin
    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := 16 * 4;
    game.objs[handl].typo := 40;
    game.objs[handl].stall := 0;
    game.objs[handl].itag := -1;

    If game.level.info.layers >= 3 Then
      If game.level.l[2][trunc(xx) Shr 5, trunc(yy) Shr 5] <> -1 Then
      Begin
        game.objs[handl].itag := game.level.l[2][trunc(xx) Shr 5, trunc(yy) Shr 5];
        game.level.l[2][trunc(xx) Shr 5, trunc(yy) Shr 5] := -1;
      End;
    game.objs[handl].pusher := true;
    game.objs[handl].pushable := false;
    result := handl;
  End;


  If (blockno = 5) Then
  Begin
    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := -blockno;
    game.objs[handl].typo := 77;
    game.objs[handl].pusher := true;
    game.objs[handl].pushable := true;
    result := handl;
  End;

  If (blockno >= 48) And (blockno <= 63) Then
  Begin
    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := -blockno;
    game.objs[handl].typo := 50;
    game.objs[handl].tag := inttostr(blockno - 47);
    result := handl;
  End;

  If (blockno >= 2) And (blockno <= 4) Then
  Begin
    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := -blockno;
    game.objs[handl].typo := 78;
    game.objs[handl].gravity := false;
    If blockno = 2 Then game.objs[handl].tag := '1';
    If blockno = 3 Then game.objs[handl].tag := '2';
    If blockno = 4 Then game.objs[handl].tag := '0';
    result := handl;
  End;




  If (blockno >= 2 * 16) And (blockno < 3 * 16) Then
  Begin                                 // flyvekloss
    handl := gethandle;
    game.objs[handl].pusher := true;
//    game.objs[handl].pushable:=true;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := -blockno;
    game.objs[handl].typo := 4;
    game.objs[handl].tag := 'N';        // Oppover/Nedover/Venstre/H鴜re
    game.objs[handl].gravity := false;
    result := handl;
  End;

  If blockno = 0 Then
    With game.level.info Do
    Begin
      startx := trunc(xx);
      starty := trunc(yy);
      game.scrollx := round(xx - dxdraw1.display.width / 2);
      game.scrolly := round(yy - dxdraw1.display.height / 2);
      result := 0;
    End;

  If (blockno >= 144) And (blockno <= 144 + 15) Then
  Begin                                 // Frukt
    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := 2 * 16 + blockno - 144;
    game.objs[handl].typo := 78;
    game.objs[handl].gravity := false;
    result := handl;
  End;

  If (blockno = 6) Then
  Begin
    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := 17;
    game.objs[handl].typo := 2;         // trampotopp
    game.objs[handl].istrampo := true;  // trampotopp
    game.objs[handl].pusher := true;

    handl := gethandle;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := 16;
    game.objs[handl].typo := 3;         // trampo bunn
    result := handl;
  End;

  If (blockno >= 16) And (blockno < 16 + 16) Then
  Begin                                 //fiende
    handl := gethandle;

    game.objs[handl].energy := 1;
    If blockno = 19 Then game.objs[handl].energy := 2;
    game.objs[handl].xx := xx;
    game.objs[handl].yy := yy;
    game.objs[handl].pic := 0;
//    game.objs[handl].pic:=(l[xx,yy]-16+8)*16;
    game.objs[handl].typo := 100 + blockno - 16; // fiende
    game.objs[handl].direction := random(2);
    ;
    game.objs[handl].stall := 0;
    game.objs[handl].pushable := true;
    game.objs[handl].pusher := true;

    result := handl;
  End;
End;

Procedure initsnow;
Var i               : integer;
Begin
  For i := 0 To snowpixels Do
  Begin
    Snow[i].X := random(640);
    Snow[i].Y := random(480);
    Snow[i].Z := random(9) + 1;
    Snow[i].d := random(256);
  End;
End;

Procedure TMainForm.PlaySoundFX(xx, yy: single; sample: integer);
Var centerdist      : single;
Begin
  centerdist := sqrt(sqr((game.scrollx + 320) - (xx + 16)) + sqr((game.scrolly + 240) - (yy + 16)));
  If centerdist < 320 + 32 Then
    With dxsfx1.items[sample] Do
    Begin
      volume := 0;
      pan := 0;
      play(false)
    End;
End;

Function TMainForm.GetHandle: integer;
Var i               : integer;
  l                 : integer;
Begin
  l := length(game.objs);
  For i := 0 To l - 1 Do
    If (game.objs[i].typo = 0) Then
    Begin
//  if game.lastobj<i then game.lastobj:=i;
      zeromemory(@game.objs[i], sizeof(game.objs[i]));
//default settings
      game.objs[i].gravity := true;
      result := i;
      exit;
    End;
  setlength(game.objs, l + 1);
  game.objs[l].gravity := true;
  result := l;
End;



Function isenemy(sxx, syy: integer): integer; // return obj handle
Var i               : integeR;
Begin
  For i := 0 To length(game.objs) - 1 Do
//i:=1;
    With game.objs[i] Do
      If typo >= 100 Then
      Begin
        If (sxx >= xx) And (sxx <= xx + 31) And
          (syy >= yy + py) And (syy <= yy + 31 + py) Then
        Begin
          isenemy := i;
          exit;
        End;
      End;
  isenemy := -1;
End;

Function isenemytop(sxx, syy: integer): integer; // return obj handle
Var i               : integeR;
Begin
  For i := 0 To length(game.objs) - 1 Do
//i:=1;
    With game.objs[i] Do
      If typo >= 100 Then
      Begin
        If (sxx >= xx) And (sxx <= xx + 31) And
          (syy >= yy + py) And (syy <= yy + 8 + py) Then
        Begin
          isenemytop := i;
          exit;
        End;
      End;
  isenemytop := -1;
End;

Type hubba = Array[0..1] Of byte;