unit hashiri1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  dddd,ddraw, Ddidex;

type
  TDDForm = class(TForm)
    DDDD1: TDDDD;
    Joy: TDDIDEX;
    procedure DDDD1Init(Sender: TObject; fNeedChange: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure DDDD1Restore(Sender: TObject);
  private
    { Private 宣言 }
    FFull:Boolean;
  public
    { Public 宣言 }
    PATH:String;
    Surf1:TDDDDSurface;
    px,py,pt,dpt,k,dk,s:Integer;  //視点位置,角度,角速度,拡大率,Δ拡大率,速度…すべて64倍で保持(固定小数)
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure Drive(vx,vy,vt,k:Integer);
  end;

var
  DDForm: TDDForm;

implementation

type

(******** 角度は1024度系 ********)

TSPoint=record
  X:SmallInt;
  Y:SmallInt;
end;

var
SinT:Array[0..1023] of Integer; //1024度系Sinテーブル (65536倍)
CosT:Array[0..1023] of Integer; //1024度系Cosテーブル (65536倍)
SrcImg:Array[0..511,0..511] of BYTE;  //走り回る対象となる原画


(******************************************************************************
  ルーチンず
******************************************************************************)

//視点から、地面を描く
{ vx,vy ... 視点の座標
  vt    ... 角度
  k     ... 高さ(∝拡大率)(64の時、等倍) }
procedure TDDForm.Drive(vx,vy,vt,k:Integer);
var
  ox,oy:Integer;
  x,y,dx,dy:Integer;
  ddsd:DDSURFACEDESC2;
  pLine,pPix:pByte; //VRAMへのポインタ
begin

  //Surf1をロック
  if Surf1.IsLost then Exit;  //サーフェスがロストしているなら、ロックできない
  Surf1.Lock(ddsd);

  //pLineは、VRAM上の或る1ラインの先頭アドレス
  pLine:=ddsd.lpSurface;  //このように、ddsd.lpSurfaceでVRAMの先頭アドレスGet!
  vx:=vx And (512 Shl 6 -1);
  vy:=vy And (512 Shl 6 -1);
  vt:=vt And 1023;

  dx:= cosT[vt] * k Shr 6;
  dy:= -sinT[vt] * k Shr 6;
  For y:=-99 to 100 do begin
    pPix:=pLine;  //pPixは各ピクセルの先頭アドレス
    ox:= (-160*cosT[vt] + y*sinT[vt]) * k Shr 6 + (vx Shl 10);  //回転の計算
    oy:= ( 160*sinT[vt] + y*cosT[vt]) * k Shr 6 + (vy Shl 10);
    For x:=-159 to 160 do begin
      Inc(ox,dx); //なんでこれで回転出来るのかは、考えてみて(^^;)
      Inc(oy,dy);
      pPix^:=SrcImg[(oy Shr 16) And 511,(ox Shr 16) And 511];
      Inc(pPix);
    end;
    Inc(pLine,ddsd.lPitch);
  end;

  //忘れちゃダメだよ
  Surf1.Unlock;

  //で、転送
  Surf1.PutFast(0,0,Rect(0,0,320,200), DDBLTFAST_WAIT);
end;


(******************************************************************************
  メインループ
******************************************************************************)
procedure TDDForm.AppIdle(Sender: TObject; var Done: Boolean);
//var
  //ddc:TDDDDCanvas;
  //clk:Comp;
  //numの絶対値がmaxを超えたら、値をmaxに合わせる
  procedure Limitation(var num:Integer; max:Integer);
  var
    fMinus:Boolean;
  begin
    fMinus := num<0;
    if fMinus then
      num:=-num;
    if num>max then
      num:=max;
    if fMinus then
      num:=-num;
  end;
  //numの絶対値を1下げる
  procedure Breaking(var num:Integer);
  begin
    if num < 0 then
      Inc(num,1)
    else if num > 0 then
      Dec(num,1);
  end;
begin


  (***********  ここに繰り返し実行させたい処理 **********)

  //ジョイパッド or キーボードの状態を得る
  Joy.OrScan([DI_JOY1,DI_KEYB]);

  //上昇・下降 (加速付き)
  if Joy.Buttons[DI_B1] then begin
    Dec(dk);
    Limitation(dk,20);
  end else if Joy.Buttons[DI_B2] then begin
    Inc(dk);
    Limitation(dk,20);
  end else begin
    Breaking(dk);
  end;
  Inc(k,dk);
  if k<1 then
    k:=1;
  if k>16384 then
    k:=16384;

  //前進・後退
  with Joy do begin
    if Stick.Y=0 then
      Breaking(s)
    else begin
      Inc(s,Stick.Y);
      Limitation(s,40);
    end;
    Inc(px,(s *SinT[pt And 1023]) Shr 10);
    Inc(py,(s *CosT[pt And 1023]) Shr 10);
  end;

  //回転
  with Joy do begin
    if Stick.X=0 then
      Breaking(dpt)
    else begin
      Dec(dpt,Stick.X);
      Limitation(dpt,20);
    end;
    Inc(pt,dpt);
  end;

  //clk:=GetClk;
  Drive(px,py,pt,k);
  //clk:=GetClk-clk;

  //ddc:=TDDDDCanvas.Create(DDDD1.BackBuffer);
  //if ddc.Enabled then begin
  //  ddc.TextOut(0,0,Format('p(%010d,%010d,%010d,%010d) ,%f',[px,py,pt,k,clk]));
  //  ddc.Free;
  //end;
  DDDD1.Flip;

  (***********  ここまで **********)
  Done:=False;
end;


{$R *.DFM}

procedure TDDForm.DDDD1Init(Sender: TObject; fNeedChange: Boolean);
var
  reqDepth:Integer; //この値で画面の色数を変える
  f:FILE;
  i,x:Integer;
  p:pByte;
begin
  reqDepth:=8;

  //各種テーブル作成
  for x:=0 to 1023 do
    SinT[x]:=Trunc(Sin(x/512.0*Pi)*65536.0);
  for x:=0 to 1023 do
    CosT[x]:=Trunc(Cos(x/512.0*Pi)*65536.0);

  //画像データのメモリへの読み込み
  //  ここではサーフェスにではなく、メモリに読むことにする
  AssignFile(f,PATH+'hashiri.bmp');
  Reset(f,1);
  Seek(f,1024+54);  //ヘッダ・パレットは読み飛ばす
  //上下逆に読む
  p:=@SrcImg;
  Inc(p,512*512-512);
  For i:=1 to 512 do begin
    BlockRead(f,p^,512);
    Dec(p,512);
  end;
  CloseFile(f);

  //画面モードのチェック
  if DDDD1.BitDepth <> reqDepth then begin
    if MessageDlg(Format('画面の色数が %dビット以外になっています。全画面モードで起動していいですか',[reqDepth]),mtInformation,[mbYES,mbNO],0)=mrNo then
      Halt
    else begin
      ShowCursor(False);
      if not DDDD1.isAvailableDisplayMode(320,200,8,0) then begin
        MessageDlg('このビデオカードは 320x200ドット 256色モードを持っていません',mtWarning,[mbOK],0);
        Halt;
      end;
      DDDD1.FullScreenMode(320,200,reqDepth,0,'');
      FFull:=True;
    end;
  end else begin
    if MessageDlg('全画面モードで起動しますか',mtInformation,[mbYES,mbNO],0)=mrNo then begin
      DDDD1.WindowMode(320,200);
      FFull:=False;
    end else begin
      if not DDDD1.isAvailableDisplayMode(320,200,8,0) then begin
        MessageDlg('このビデオカードは 320x200ドット 256色モードを持っていません',mtWarning,[mbOK],0);
        Halt;
      end;
      ShowCursor(False);
      DDDD1.FullScreenMode(320,200,reqDepth,0,'');
      FFull:=True;
    end;
  end;
  //ここに、サーフェス作ったりとかの各種初期化
  Surf1:=TDDDDSurface.Create(DDDD1,320,200,0);


  //変数の初期化
  px:=255 shl 6;  py:=255 shl 6;
  pt:=0;  dpt:=0; k:=128;  dk:=0;  s:=0;

  //アイドリングルーチンの取り付け
  Application.OnIdle:=AppIdle;

end;

procedure TDDForm.FormCreate(Sender: TObject);
begin
  PATH:=ExtractFilePath(Application.Exename);

  ClientHeight:=400;
  ClientWidth:=640;
end;

procedure TDDForm.DDDD1Restore(Sender: TObject);
begin
  //パレットの読み直し
  DDDD1.ReadPalette(PATH+'hashiri.bmp');
  DDDD1.UpdatePalette;
end;

procedure TDDForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = VK_ESCAPE then begin
    Application.Terminate;
  end;
end;

end.
