unit Shadow1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  cOpenGL, Material, light, Transfrm, OpenGL, MMSystem;

type
  TForm1 = class(TForm)
    OpenGL1: TOpenGL;
    TransformCube: TTransform;
    TransformLight: TTransform;
    TransformFloor: TTransform;
    Light1: TLight;
    MaterialCube: TMaterial;
    MaterialLight: TMaterial;
    MaterialFloor: TMaterial;
    MaterialShadow: TMaterial;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure TransformCubePaint(Sender: TObject);
    procedure TransformLightPaint(Sender: TObject);
    procedure TransformFloorPaint(Sender: TObject);
  private
    angl,
    rspeed,
    speed,
    tran,
    rot,
    wx,
    wy,
    wz: GLfloat;
    bufType: GLenum;
    how_many: GLsizei;
    frames,
    elapsed,
    start,
    ShadStart: integer;
    buffer: array[1..256] of GLfloat;
    procedure Adjust;
    procedure Feedback;
    procedure DumpBuffer;
    function ParseFeedback(var lastToken,values,verts,kind:integer;
      index:integer):string;
    function ValuesPerVertex:integer;
    function ProcessVertexValues(var lastToken,values,kind:integer;
      index:integer):string;
    procedure Idle(Sender:TObject;var Done:boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  pi180: double=pi/180.0;

implementation

uses Shapes;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,GL_TRUE);
  Application.OnIdle := Idle;
  bufType := GL_2D;
  start := TimeGetTime;
  glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  deltaX,
  deltaY,
  deltaZ,
  slopeY,
  slopeZ,
  x,y,z,h,w,
  x1,y1,z1,
  x2,y2,z2,
  by,bz: GLfloat; 
  ix,v: integer;
begin
  case Key of
    VK_UP: tran := +speed;
    VK_DOWN: tran := -speed;
    VK_LEFT: rot := -rspeed;
    VK_RIGHT: rot := +rspeed;
    VK_ESCAPE: Close;
    ord('R'): begin
      if ssShift in Shift then
        rspeed := rspeed+0.01
      else begin
        if rspeed>0.01 then
          rspeed := rspeed-0.01;
      end;
    end;
    ord('S'): begin
      if ssShift in Shift then
        speed := speed+0.001
      else begin
        if speed>0.001 then
          speed := speed-0.001;
      end;
    end;
    ord('F'): begin
      Feedback;
    end;
    ord('2'): begin
      bufType := GL_2D;
    end;
    ord('3'): begin
      bufType := GL_3D;
    end;
    ord('C'): begin
      bufType := GL_3D_COLOR;
    end;
    ord('T'): begin
      bufType := GL_3D_COLOR_TEXTURE;
    end;
    ord('X'): begin
      if ssShift in Shift then
        wx := wx+0.1
      else
        wx := wx-0.1;
      Caption := Format('wx=%0.2f wy=%0.2f wz=%0.2f a=%0.2f',
        [wx,wy,wz,angl]);
    end;
    ord('Y'): begin
      if ssShift in Shift then
        wy := wy+0.1
      else
        wy := wy-0.1;
      Caption := Format('wx=%0.2f wy=%0.2f wz=%0.2f a=%0.2f',     
        [wx,wy,wz,angl]);
    end;
    ord('Z'): begin
      if ssShift in Shift then
        wz := wz+0.1
      else
        wz := wz-0.1;
      Caption := Format('wx=%0.2f wy=%0.2f wz=%0.2f a=%0.2f',
        [wx,wy,wz,angl]);
    end;
    ord('A'): begin
      if ssShift in Shift then
        angl := angl+1.0
      else
        angl := angl-1.0;
      Caption := Format('wx=%0.2f wy=%0.2f wz=%0.2f a=%0.2f',
        [wx,wy,wz,angl]);
    end;
    ord('B'): begin {y=mx+b}
      {point 1 is cube center}
      with TransformCube do
      begin
        x1 := TranX;
        y1 := TranY;
        z1 := TranZ;
      end;
      {point 2 is light center}
      with TransformLight do
      begin
        x2 := TranX;
        y2 := TranY;
        z2 := TranZ;
      end;
      deltaX := x2-x1;
      deltaY := y2-y1;
      deltaZ := z2-z1;
      slopeY := deltaY/deltaX;
      slopeZ := deltaZ/deltaX;
      by := y1-x1*slopeY;
      bz := z1-x1*slopeZ;
      y := -1.0;
      {y := slopeY*x+by;}
      x := (y-by)/slopeY;
      z := slopeZ*x+bz;
      Caption := Format('x=%0.3f y=%0.3f z=%0.3f',[x,y,z]);
      wx := -x;
      wy := -y+2.0;
      wz := -z; 
      angl := -90.0;
      glFeedbackBuffer(256,GL_2D,@buffer);
      glRenderMode(GL_FEEDBACK);
      FormPaint(nil);
      how_many := glRenderMode(GL_RENDER);
      wx := 0.0;
      wy := 0.0;
      wz := 0.0; 
      angl := 0.0;
      ShadStart := 0;
      repeat
        inc(ShadStart);
      until buffer[ShadStart]<0.0;
      with OpenGL1 do
      begin
        h := (prxTop-prxBottom)/ClientHeight;
        w := (prxRight-prxLeft)/ClientWidth;
        ix := ShadStart+2;
        repeat
          for v := 1 to 3 do
          begin
            buffer[ix] := x+prxLeft+buffer[ix]*w; 
            buffer[ix+1] := z+prxBottom+buffer[ix+1]*h;
            inc(ix,2);
          end;
          inc(ix,2);
        until (ix>=how_many) or (buffer[ix]<-20.0);
      end; {with}
    end; {Build Shadow}
  end; {case}
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  tran := 0.0;
  rot := 0.0;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  v,
  ix: integer;
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  if wy=0 then
  begin
    glRotatef(angl,0.0,1.0,0.0);
    glTranslatef(wx,0.0,wz);
    glDisable(GL_BLEND);
  end else begin
    glRotatef(angl,1.0,0.0,0.0);
    glTranslatef(wx,wy,wz);     
    glEnable(GL_BLEND);
  end;
  TransformLight.Apply;
  TransformCube.Apply;
  TransformFloor.Apply;
  {Draw shadow here}
  if ShadStart>0 then
  begin
    ix := ShadStart+2;
    MaterialShadow.Apply;
    glBegin(GL_TRIANGLES);
    repeat
      for v := 1 to 3 do
      begin
        glVertex3f(buffer[ix],-1.0,buffer[ix+1]);
        inc(ix,2);
      end;
      inc(ix,2);
    until (ix>=how_many) or (buffer[ix]<-20.0);
    glEnd;
  end; {if}

  OpenGL1.Swap;
  OpenGL1.ErrorCheck('FormPaint');
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if OpenGL1.Smaller then
    FormPaint(Sender);
end;

procedure TForm1.TransformCubePaint(Sender: TObject);
begin
  MaterialCube.Apply;
  glPassthrough(-21.00);
  Cube;
  glPassthrough(-22.00);
end;

procedure TForm1.TransformLightPaint(Sender: TObject);
begin
  MaterialLight.Apply;
  Light1.Apply;
  Cube;
end;

procedure TForm1.TransformFloorPaint(Sender: TObject);
begin
  MaterialFloor.Apply;
  glBegin(GL_POLYGON);
    glVertex3f(-32.0,0.0,-32.0);
    glVertex3f(-32.0,0.0,+32.0);
    glVertex3f(+32.0,0.0,+32.0);
    glVertex3f(+32.0,0.0,-32.0);
  glEnd;
end;

procedure TForm1.Adjust;
var
  theta: GLfloat;
begin
  angl := angl+rot;
  theta := angl*pi180;
  wx := wx-tran*sin(theta);
  wz := wz+tran*cos(theta);
end;

procedure TForm1.Feedback;
begin
  glFeedbackBuffer(256,bufType,@buffer);
  glRenderMode(GL_FEEDBACK);
  FormPaint(nil);
  how_many := glRenderMode(GL_RENDER);
  DumpBuffer;
  ShadStart := 0;
end;

procedure TForm1.DumpBuffer;
var
  ix: integer;
  tf: TextFile;
  len,
  kind,
  values,
  vertices,
  lastToken: integer;
  s: string;
begin
  assignFile(tf,'Feedback.dmp');
  rewrite(tf);
  writeln(tf,Format('Feedback values returned=%d',[how_many]));
  writeln(tf);
  lastToken := 0;
  for ix := 1 to how_many do
  begin
    s := ParseFeedback(lastToken,values,vertices,kind,ix);
    len := length(s);
    write(tf,s);
    if (s='') or (s[len]<>' ') then
      writeln(tf);
  end;
  closeFile(tf);
end;

function TForm1.ParseFeedback(var lastToken,values,verts,kind:integer;
  index:integer):string;
var
  value: GLfloat;
begin
  value := buffer[index];
  case lastToken of
    0: begin
      lastToken := round(value);
      case lastToken of
        GL_POLYGON_TOKEN: begin
          result := 'GL_POLYGON_TOKEN: ';
          values := -1;
        end;
        GL_POINT_TOKEN: begin
          result := 'GL_POINT_TOKEN: vertices=1';
          kind := 0;
          verts := 1;
          values := ValuesPerVertex;
        end;
        GL_BITMAP_TOKEN: begin
          result := 'GL_BITMAP_TOKEN: coordinates=1';
          kind := 0;
          verts := 1;
          values := ValuesPerVertex;
        end;
        GL_LINE_RESET_TOKEN,
        GL_LINE_TOKEN: begin
          result := 'GL_LINE_TOKEN: vertices=2';
          kind := 0;
          verts := 2;
          values := verts*ValuesPerVertex;
        end;
        GL_PASS_THROUGH_TOKEN: begin
          result := #13#10'GL_PASS_THROUGH_TOKEN: ';
          values := 1;
        end;
      end;
    end; {new token}
    GL_POLYGON_TOKEN: begin
      if values=-1 then
      begin
        verts := round(value);
        result := Format('Vertices=%d',[verts]);
        values := verts*ValuesPerVertex;
        kind := 0;
      end else
        result := ProcessVertexValues(lastToken,values,kind,index);
    end;
    GL_LINE_RESET_TOKEN,
    GL_LINE_TOKEN,
    GL_BITMAP_TOKEN,
    GL_POINT_TOKEN: begin
      result := ProcessVertexValues(lastToken,values,kind,index);
    end;
    GL_PASS_THROUGH_TOKEN:
    begin
      result := Format('id=%0.4f',[value]);
      dec(values);
      lastToken := 0;
    end;
  end; {case}
end;

function TForm1.ProcessVertexValues(var lastToken,values,kind:integer;
  index:integer):string; 
var
  value: GLfloat;
begin
  value := buffer[index];  
  inc(kind);
  dec(values);
  case kind of
    1: result := Format('  x=%6.2f',[value]);
    2: result := Format('y=%6.2f',[value]);
    3: result := Format('z=%6.2f',[value]);
    4: result := Format('r=%4.2f',[value]);
    5: result := Format('g=%4.2f',[value]);
    6: result := Format('b=%4.2f',[value]);
    7: result := Format('a=%4.2f',[value]);
    8: result := Format('s=%4.2f',[value]);
    9: result := Format('t=%4.2f',[value]);
   10: result := Format('u=%4.2f',[value]);
   11: result := Format('v=%4.2f',[value]);    
  end; {case}
  if kind<ValuesPerVertex then
    result := result+' '
  else
    kind := 0; 
  if values=0 then
    lastToken := 0; 
end;

function TForm1.ValuesPerVertex: integer;
begin
  case bufType of
    GL_2D: result := 2;
    GL_3D: result := 3;
    GL_3D_COLOR: result := 7;
    GL_3D_COLOR_TEXTURE: result := 11;
  end; {case}
end;

procedure TForm1.Idle(Sender:TObject;var Done:boolean);
var
  fps: GLfloat;
const
  rollover=1000;
  mspersec=1000.0;
begin
  Done := false;
  Adjust;
  inc(frames);
  if frames>=rollover then
  begin
    elapsed := TimeGetTime;
    Caption := Format('fps=%0.1f wz=%0.2f',[rollover*mspersec/(elapsed-start),wz]);
    start := elapsed;
    frames := 0;
  end else
    FormPaint(nil);
end;

end.
