Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/gr3d/gr3d_lst.pas

Pascal/Delphi Source File | 1993-08-23 | 6.2 KB | 279 lines

unit Gr3d_Lst;
{$F+,N+,E+}

interface

uses
  Graph, Crt, Gr3d_pt;

const
  VidPageSize : longint = 60*1024;
  VidAddrPtr  : ^Word = Ptr($A000,0);

type

  PointPtr = PPointGroup;

  NameType = 1..100;
  DoWhat = procedure(Item: PointPtr);

  NodePtr = ^Node;
  Node = record
    Item: PointPtr;
    Name: NameType;
    Next: NodePtr;
  end;

  View = object
      WX : Integer;
    WY : Integer;
    WXSize : Integer;
    WYSize : Integer;
    BackColor : integer;

    First : NodePtr;
    Cursor: NodePtr;
    PreCursor: NodePtr;
    constructor Init(InitWX, InitWY, InitWXSize, InitWYSize: Integer;
                     InitBackColor: integer);
    destructor Done; virtual;
    function GetWindowWidth: Integer;
    function GEtWindowHeight: Integer;
    function GetDelta(var DeltaX: Integer; var DeltaY: Integer; var DeltaZ: Integer): Boolean;
    function Search(ToFind: NameType): NodePtr; virtual;
    procedure SetWindow;
    procedure Select;
    procedure Clear;
    procedure ClearScrn;
    procedure Add(Item: PointPtr; ItemName: NameType);
    procedure Delete(ToDelete: NameType); virtual;
    procedure Traverse(P: DoWhat);
    procedure Show;
    procedure Hide;
    procedure Move(DeltaX, DeltaY, DeltaZ: integer);
    procedure Step(IX, IY, IZ: Integer);
    procedure ConvertPoint(x,y,z: integer; var Sx, Sy: integer);
  end;

implementation

var
  GlobalDX, GlobalDY, GlobalDZ: integer;

{--------------------------------------------------------}
{ View's method implementations:                         }
{--------------------------------------------------------}
constructor View.Init(InitWX, InitWY, InitWXSize, InitWYSize: Integer;
                      InitBackColor: integer);
begin
  WX := InitWX;
  WY := InitWY;
  WXSize := InitWXSize;
  WYSize := InitWYSize;
  BackColor := InitBackColor;
  First := nil;
end;

function View.GetWindowWidth: Integer;
begin
    GetWindowWidth := WXSize;
end;

function View.GetWindowHeight: Integer;
begin
    GetWindowHeight := WYSize;
end;

procedure View.SetWindow;
begin
  SetViewPort(WX,WY,WX+WXSize,WY+WYSize,ClipOn);
  Clear;
end;

procedure View.Select;
begin
  GraphMidX := WXSize div 2;
  GraphMidY := WYSize div 2;
  SetViewPort(WX,WY,WX+WXSize,WY+WYSize,ClipOn);
end;

procedure View.ClearScrn;
begin
  FillChar(VidAddrPtr^, VidPageSize, BackColor);
end;

procedure View.Clear;
begin
  SetFillStyle(SolidFill, BackColor);
  Bar(0,0,WXSize,WYSize);
end;

function View.GetDelta(var DeltaX: Integer; var DeltaY: Integer; var DeltaZ: Integer): Boolean;
var
  KeyChar: Char;
  Quit: Boolean;
begin
  DeltaX := 0;                   { 0 means no change in position;  }
    DeltaY := 0;
    DeltaZ := 0;
  GetDelta := True;              { True means we return a delta    }
  repeat
    KeyChar := ReadKey;          { First, read the keystroke }
    Quit := True;                { Assume it's a useable key }
    case Ord(KeyChar) of
       0: begin                  { 0 means an extended, 2-byte code }
            KeyChar := ReadKey;  { Read second byte of code }
            case Ord(KeyChar) of
             80:       DeltaZ := -1;  {Down}
             72:       DeltaZ := 1;   {up}
             75:       DeltaY := -1; {Left}
                     77:       DeltaY := 1;  {Right}
             else Quit := False; { Ignore any other code }
            end; { case }
          end;
       Ord('+'): DeltaX := 1;  {forward}
       Ord('-'): DeltaX := -1; {backward}
      13: GetDelta := False;     { CR pressed means no delta  }
    else Quit := False;          { Ignore any other keystroke }
    end;  { case }
  until Quit;
end;

procedure View.Step(IX, IY, IZ: Integer);
const
  PageNumber: integer = 0;
begin
{  PageNumber := 1-PageNumber; }
{  SetActivePage(PageNumber); }
  Clear;
  Move(IX, IY, IZ);
  Show;
{  SetVisualPage(PageNumber); }
end;

{--------------------------------------------------------}
{ View's list implementations:                           }
{--------------------------------------------------------}


{------ procedures to be assigned to a variable ------}

    procedure HideEach(Item: PointPtr);
  begin
      Item^.Hide;
  end;
    procedure ShowEach(Item: PointPtr);
  begin
      Item^.Draw;
  end;
  procedure MoveEach(Item: PointPtr);
  begin
    Item^.Move(GlobalDX, GlobalDY, GlobalDZ);
  end;

destructor View.Done;
var
  N: NodePtr;
begin
  while First <> nil do
  begin
    N := First;
    First := N^.Next;
    Dispose(N^.Item, Done);
    Dispose(N);
  end;
end;

procedure View.Add(Item: PointPtr; ItemName: NameType);
var
  N, T: NodePtr;
begin
  New(N);
  N^.Item := Item;
  N^.Name := ItemName;

  {place the furthest to the fount}
  if First=nil then
  begin
    First := N;
    First^.Next := nil;
    Exit;
  end;

  if First^.Item^.GetX(1) < Item^.GetX(1) then
  begin
       N^.Next := First; First := N;
  end
    else
  begin
      T := First;
      while (T^.Next <> nil) and (T^.Next^.Item^.GetX(1) > Item^.GetX(1)) do
          T := T^.Next;
      N^.Next := T^.Next; T^.Next := N;
  end;
end;

function View.Search(ToFind: NameType): NodePtr;
begin
    Cursor := First;
  while (Cursor<>nil) and (Cursor^.Name<>ToFind) do
  begin
      PreCursor := Cursor;
      Cursor := Cursor^.Next;
  end;
  Search := Cursor;
end;

procedure View.Delete(ToDelete: NameType);
begin
    Cursor := Search(ToDelete);
  if Cursor<>nil then
  begin
    if Cursor = First then
            First := First^.Next
    else
        PreCursor^.Next := Cursor^.Next;
    Dispose(Cursor^.Item, Done);
    Dispose(Cursor);
  end;
end;

procedure View.Hide;
begin
  Traverse(HideEach);
end;

procedure View.Show;
begin
  Traverse(ShowEach);
end;

procedure View.Move(DeltaX, DeltaY, DeltaZ: integer);
begin
  GlobalDX := DeltaX;
  GlobalDY := DeltaY;
  GlobalDZ := DeltaZ;
  Traverse(MoveEach);
end;

procedure View.Traverse(P: DoWhat);
var
  Current: NodePtr;
begin
  Current := First;
  while Current <> nil do
  begin
        P(Current^.Item);
    Current := Current^.Next;
  end;
end;

procedure View.ConvertPoint(x,y,z: integer; var Sx, Sy: integer);
begin
  Sx := (x*GraphMidx) div y + GraphMidx;
  Sy := GraphMidY - (z*GraphMidy) div y;
end;

end. {unit}