[Pythianproject-cvsmail] CVS: PythianProject/Source/Units vglcanvas.pas,NONE,1.1

[Kamil K. <kkr...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv31077

Added Files:
	vglcanvas.pas 
Log Message:
@kk

--- NEW FILE ---
unit vglcanvas;

{ ******************************************************************
  ** Visual GL                                                    **
  ** Version 0.1                                                  **
  **                                                              **
  ** Here will be our licence!!!                                  **
  ******************************************************************

  Authors:
    Kamil Krauspe - basic ideas and definitions

  History:
    27.10.00 - (@@kk) first definitions, fundamentals and ideas, 

  To do:
    **** don't have time to write everything what should be done
}

interface

uses
  Points, OpenGL, Classes;

const
  // Visual GL - basic commands
  VGL_LINE           = $000A;
  VGL_RECT           = $000B;
  VGL_TRIANGLE       = $000C;

  // Visual GL - basic properties change commands
  VGL_FONTCHANGE     = $005A;
  VGL_COLORCHANGE    = $005B;
  VGL_PENCHANGE      = $005C;
  VGL_BRUSHCHANGE    = $005D;

  // Return codes
  VGL_OK             =   0;
  VGL_ERROR          = - 1;

type
  // Visual GL - classes
  TvglUObj = class;
  TvglFont = class;
  TvglColor = class;
// !!!!!!!! TODO  TvglPen = class; !!!!!!!!
// !!!!!!!! TODO  TvglBrush = class; !!!!!!!!!

  TvglCommandList = class;
  TvglCanvas = class;

  // Visual GL - command structures
  Pvgl_TRIANGLE_STRUCT = ^Tvgl_TRIANGLE_STRUCT;
  Pvgl_LINE_STRUCT = ^Tvgl_LINE_STRUCT;
  Pvgl_RECT_STRUCT = ^Tvgl_RECT_STRUCT;
  Pvgl_FONT_CHANGE_STRUCT = ^Tvgl_FONT_CHANGE_STRUCT;
  Pvgl_COLOR_CHANGE_STRUCT = ^Tvgl_COLOR_CHANGE_STRUCT;

  Tvgl_FONT_CHANGE_STRUCT = record // used internaly
    FontNumber, Effects: Integer;
    Size, AspectRatio: Single;
  end;

  Tvgl_COLOR_CHANGE_STRUCT = record
    Data: TByteColor;
  end;

  Tvgl_LINE_STRUCT = record
    Pa, Pb: TPoint3D;
  end;
  Tvgl_RECT_STRUCT = record
    Pa, Pb, Pc, Pd: TPoint3D;
  end;
  Tvgl_TRIANGLE_STRUCT = record
    Pa, Pb, Pc: TPoint3D;
  end;

  TvglUObj = class(TPersistent)
  protected
    FCanvas: TvglCanvas;
  public
    constructor Create(ACanvas: TvglCanvas); virtual;
    procedure Update; virtual; abstract;
  end;

  TvglFont = class(TvglUObj)
  private
    FEffects: Integer;
    FFontNumber: Integer;
    FAspectRatio: Single;
    FSize: Single;
    procedure SetAspectRatio(const Value: Single);
    procedure SetEffects(const Value: Integer);
    procedure SetFontNumber(const Value: Integer);
    procedure SetSize(const Value: Single);
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    procedure UseFont(const Data: Pvgl_FONT_CHANGE_STRUCT); virtual;
    constructor Create(ACanvas: TvglCanvas); override;
    destructor Destroy; override;
    procedure Update; override;
    property FontNumber: Integer read FFontNumber write SetFontNumber;
    property Effects: Integer read FEffects write SetEffects;
    property Size: Single read FSize write SetSize;
    property AspectRatio: Single read FAspectRatio write SetAspectRatio; // x:y size - aspect ratio
    // ??? use color here, too or will be using color of pen and brush
  end;

  TvglColor = class(TvglUObj)
  protected
    FAsByteColor: TByteColor;
    procedure SetAsByteColor(const Value: TByteColor);
    procedure SetAsGLColor(const Value: TGLColor);
    procedure AssignTo(Dest: TPersistent); override;
    function GetAsGLColor: TGLColor;
  public
    procedure UseColor(const Data: Pvgl_COLOR_CHANGE_STRUCT); virtual;
    procedure SetValue(R, G, B, A: Single); overload;
    procedure SetValue(R, G, B, A: Byte); overload;
    constructor Create(ACanvas: TvglCanvas); override;
    destructor Destroy; override;
    procedure Update; override;
    property AsGLColor: TGLColor read GetAsGLColor write SetAsGLColor;
    property AsByteColor: TByteColor read FAsByteColor write SetAsByteColor;
  end;

  TvglCommandTwin = record
    ID: Integer;
    Data: Pointer;
  end;

  TvglCommandList = class
  protected
    FCommands: array of TvglCommandTwin;
    function GetCount: Integer;
    procedure FreeItems;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function Enqueue(AID: Integer; Data: Pointer): Integer; overload;
    // appends a command onto FCommands array
    function Pop(ADelete: Boolean): TvglCommandTwin;
    // returns (and deletes) first Command form FCommands
    function GetItem(AIndex: Integer): TvglCommandTwin;
    // returns item at AIndex
    function DeleteItem(AIndex: Integer): Integer;
    // deletes item at AIndex
    property Count: Integer read GetCount;
  end;

  TvglCanvas = class
  protected
    FCommands: TvglCommandList;
    FFont: TvglFont;
    procedure DrawRectangle(const Data: Pvgl_RECT_STRUCT); virtual;
    procedure DrawTriangle(const Data: Pvgl_TRIANGLE_STRUCT); virtual;
    procedure DrawLine(const Data: Pvgl_LINE_STRUCT); virtual;

    procedure ProcessItem(const AItem: TvglCommandTwin); virtual; 
  public
    procedure Draw; virtual;

    constructor Create; virtual;
    destructor Destroy; override;

    procedure Rectangle(APa, APb, APc, APd: TPoint3D);
    procedure Triangle(APa, APb, APc: TPoint3D);
    procedure Line(APa, APb: TPoint3D);

    property Font: TvglFont read FFont;
  // TODO: add another public declarations
  end;

implementation

const
  VGL_BYTE2GL = 1 / 255;
  VGL_GL2BYTE = 255;

{ TvglUObj }

constructor TvglUObj.Create(ACanvas: TvglCanvas);
begin
  inherited Create;
  FCanvas := ACanvas;
end;

{ TvglFont }

procedure TvglFont.AssignTo(Dest: TPersistent);
begin
  if Dest is TvglFont then
  begin
    TvglFont(Dest).FEffects := FEffects;
    TvglFont(Dest).FFontNumber := FFontNumber;
    TvglFont(Dest).FAspectRatio := FAspectRatio;
    TvglFont(Dest).FSize := FSize;
  end
  else
    inherited; // trigger TPersistent.AssignTo(Dest) -> Raise Exception
end;

constructor TvglFont.Create(ACanvas: TvglCanvas);
begin
  inherited Create(ACanvas);
  FEffects := 0;
  FFontNumber := 0;
  FAspectRatio := 1;
  FSize := 1;
end;

destructor TvglFont.Destroy;
begin
  //
  inherited Destroy;
end;

procedure TvglFont.SetAspectRatio(const Value: Single);
begin
  FAspectRatio := Value;
end;

procedure TvglFont.SetEffects(const Value: Integer);
begin
  FEffects := Value;
end;

procedure TvglFont.SetFontNumber(const Value: Integer);
begin
  FFontNumber := Value;
end;

procedure TvglFont.SetSize(const Value: Single);
begin
  FSize := Value;
end;

procedure TvglFont.Update;
var
  ACmd: Pvgl_FONT_CHANGE_STRUCT;
begin
  New(ACmd);
  ACmd^.FontNumber := FFontNumber;
  ACmd^.Effects := FEffects;
  ACmd^.Size := FSize;
  ACmd^.AspectRatio := FAspectRatio;
  FCanvas.FCommands.Enqueue(VGL_FONTCHANGE, ACmd);
end;

procedure TvglFont.UseFont(const Data: Pvgl_FONT_CHANGE_STRUCT);
begin
  // changes the Font (in processing/drawing time) - something like DrawLine...
end;

{ TvglColor }

procedure TvglColor.AssignTo(Dest: TPersistent);
begin
  if Dest is TvglColor then
  begin
    TvglColor(Dest).FAsByteColor := FAsByteColor;
  end
  else
    inherited; // trigger TPersistent.AssignTo(Dest) -> Raise Exception
end;

constructor TvglColor.Create(ACanvas: TvglCanvas);
begin
  inherited Create(ACanvas);
  FillChar(FAsByteColor, SizeOf(FAsByteColor){4 i think}, 0);
end;

destructor TvglColor.Destroy;
begin
  //
  inherited;
end;

function TvglColor.GetAsGLColor: TGLColor;
begin
  Result[0] := FAsByteColor[0] * VGL_BYTE2GL;
  Result[1] := FAsByteColor[1] * VGL_BYTE2GL;
  Result[2] := FAsByteColor[2] * VGL_BYTE2GL;
  Result[3] := FAsByteColor[3] * VGL_BYTE2GL;
end;

procedure TvglColor.SetAsByteColor(const Value: TByteColor);
begin
  FAsByteColor := Value;
end;

procedure TvglColor.SetAsGLColor(const Value: TGLColor);
begin
  FAsByteColor[0] := Round(Value[0] * VGL_GL2BYTE);
  FAsByteColor[1] := Round(Value[1] * VGL_GL2BYTE);
  FAsByteColor[2] := Round(Value[2] * VGL_GL2BYTE);
  FAsByteColor[3] := Round(Value[3] * VGL_GL2BYTE);
end;

procedure TvglColor.SetValue(R, G, B, A: Single);
begin
  SetAsGLColor(MakeGLColor(R, G, B, A));
end;

procedure TvglColor.SetValue(R, G, B, A: Byte);
begin
  FAsByteColor[0] := R;
  FAsByteColor[1] := G;
  FAsByteColor[2] := B;
  FAsByteColor[3] := A;
end;

procedure TvglColor.Update;
var
  ACmd: Pvgl_COLOR_CHANGE_STRUCT;
begin
  New(ACmd);
  ACmd^.Data := FAsByteColor;
  FCanvas.FCommands.Enqueue(VGL_COLORCHANGE, ACmd);
end;

procedure TvglColor.UseColor(const Data: Pvgl_COLOR_CHANGE_STRUCT);
begin
  // changes color: Is this OK?
  glColor4bv(@Data^.Data[0]);
end;

{ TvglCommandList }

constructor TvglCommandList.Create;
begin
  inherited Create;
  SetLength(FCommands, 0);
end;

function TvglCommandList.DeleteItem(AIndex: Integer): Integer;
var
  i, ACount: Integer;
begin
  Result := VGL_ERROR;
  ACount := Length(FCommands);
  if AIndex >= ACount then
    Exit;
  if AIndex = ACount - 1 then
    SetLength(FCommands, AIndex)
  else begin
    i := (ACount - AIndex - 1) * SizeOf(TvglCommandTwin);;
    // moving could be done with Copy function, but this is better and faster
    Move(FCommands[AIndex + 1], FCommands[AIndex], i);
    SetLength(FCommands, ACount - 1);
  end;
  Result := VGL_OK;
end;

destructor TvglCommandList.Destroy;
begin
  FreeItems;
  inherited;
end;

function TvglCommandList.Enqueue(AID: Integer; Data: Pointer): Integer;
var
  AIndex: Integer;
begin
  Result := VGL_ERROR; 
  if Data = nil then
    Exit;
  AIndex := Length(FCommands);
  SetLength(FCommands, AIndex + 1);
  FCommands[AIndex].ID := AID; 
  FCommands[AIndex].Data := Data;
  Result := VGL_OK;
end;

procedure TvglCommandList.FreeItems;
var
  i: Integer;
begin
  for i := 0 to Length(FCommands) - 1 do
    if FCommands[i].Data <> nil then
      Dispose(FCommands[i].Data);
  SetLength(FCommands, 0);
end;

function TvglCommandList.GetCount: Integer;
begin
  Result := Length(FCommands);
end;

function TvglCommandList.GetItem(AIndex: Integer): TvglCommandTwin;
begin
  if AIndex < GetCount then
    Result := FCommands[AIndex]
  else begin
    Result.Data := nil;
    Result.ID := VGL_ERROR;
  end;
end;

function TvglCommandList.Pop(ADelete: Boolean): TvglCommandTwin;
begin
  Result := GetItem(0);
  if ADelete and (Result.ID <> VGL_ERROR) then
    DeleteItem(0);
end;

{ TvglCanvas }

constructor TvglCanvas.Create;
begin
  inherited Create;
  FFont := TvglFont.Create(Self);
  FCommands := TvglCommandList.Create;
end;

destructor TvglCanvas.Destroy;
begin
  FFont.Free;
  FCommands.Free;
  inherited Destroy;
end;

procedure TvglCanvas.Draw;
var
  D: TvglCommandTwin;
begin
  D := FCommands.Pop(True);
  while (D.Data <> nil) and (D.ID <> VGL_ERROR) do
  begin
    ProcessItem(D);
    D := FCommands.Pop(True);
  end;
end;

procedure TvglCanvas.DrawLine(const Data: Pvgl_LINE_STRUCT);
begin
  // Don't know much about OpenGL, is this OK?
  glBegin(GL_LINES);
    glVertex3f(Data^.Pa.X, Data^.Pa.Y, Data^.Pa.Z);  // Point A
    glVertex3f(Data^.Pb.X, Data^.Pb.Y, Data^.Pb.Z);  // Point B
  glEnd;
end;

procedure TvglCanvas.DrawRectangle(const Data: Pvgl_RECT_STRUCT);
begin
  // Don't know much about OpenGL, is this OK?
  glBegin(GL_QUADS);
    glVertex3f(Data^.Pa.X, Data^.Pa.Y, Data^.Pa.Z);  // Point A
    glVertex3f(Data^.Pb.X, Data^.Pb.Y, Data^.Pb.Z);  // Point B
    glVertex3f(Data^.Pc.X, Data^.Pc.Y, Data^.Pc.Z);  // Point C
    glVertex3f(Data^.Pd.X, Data^.Pd.Y, Data^.Pd.Z);  // Point D
  glEnd;
end;

procedure TvglCanvas.DrawTriangle(const Data: Pvgl_TRIANGLE_STRUCT);
begin
  // Don't know much about OpenGL, is this OK?
  glBegin(GL_TRIANGLES);
    glVertex3f(Data^.Pa.X, Data^.Pa.Y, Data^.Pa.Z);  // Point A
    glVertex3f(Data^.Pb.X, Data^.Pb.Y, Data^.Pb.Z);  // Point B
    glVertex3f(Data^.Pc.X, Data^.Pc.Y, Data^.Pc.Z);  // Point C
  glEnd;
end;

procedure TvglCanvas.Line(APa, APb: TPoint3D);
var
  ACmd: Pvgl_LINE_STRUCT;
begin
  New(ACmd);
  ACmd^.Pa := APa;
  ACmd^.Pb := APb;
  FCommands.Enqueue(VGL_LINE, ACmd);
end;

procedure TvglCanvas.ProcessItem(const AItem: TvglCommandTwin);
begin
  case AItem.ID of
    VGL_LINE: DrawLine(AItem.Data);
    VGL_RECT: DrawRectangle(AItem.Data);
    VGL_TRIANGLE: DrawTriangle(AItem.Data);
    VGL_FONTCHANGE: FFont.UseFont(AItem.Data);
    VGL_COLORCHANGE: {Color.UseColor(AItem.Data)};
    VGL_PENCHANGE:;
    VGL_BRUSHCHANGE:;
  end;
end;

procedure TvglCanvas.Rectangle(APa, APb, APc, APd: TPoint3D);
var
  ACmd: Pvgl_RECT_STRUCT;
begin
  New(ACmd);
  ACmd^.Pa := APa;
  ACmd^.Pb := APb;
  ACmd^.Pc := APc;
  ACmd^.Pd := APd;
  FCommands.Enqueue(VGL_RECT, ACmd);
end;

procedure TvglCanvas.Triangle(APa, APb, APc: TPoint3D);
var
  ACmd: Pvgl_TRIANGLE_STRUCT;
begin
  New(ACmd);
  ACmd^.Pa := APa;
  ACmd^.Pb := APb;
  ACmd^.Pc := APc;
  FCommands.Enqueue(VGL_TRIANGLE, ACmd);
end;

end.