Monster Media 1994 #1/monster.zip/monster/PROG_GEN/TCYBER.ZIP/CFSPRITE.PAS

Pascal/Delphi Source File | 1994-01-15 | 12KB | 557 lines

{
Turbo Vision CyberTools 1.0
(C) 1994 Steve Goldsmith
All Rights Reserved

Character Sprite objects using non-modal dialogs.  Broadcast cmAnimate to
update and draw sprites.
}

unit CFSprite;

{$I APP.INC}

interface

uses

  Objects, App, Views, Dialogs, Drivers, CFCmds, ColorSel;

type

  PBackView = ^TBackView;
  TBackView = object (TView)
    procedure Draw; virtual;
  end;

  PSpriteView = ^TSpriteView;
  TSpriteView = object (TView)
    FrameSize,
    FramePos,
    EndPos,
    PalIndex : byte;
    Dir : TPoint;
    SpriteStr : PString;
    constructor Init (var Bounds : TRect; S : PString; D : TPoint);
    procedure CalcMove; virtual;
    procedure Draw; virtual;
  end;

  PAniDlg = ^TAniDlg;
  TAniDlg = object (TDialog)
    AniFlag : boolean;
    AniGroup : PGroup;
    constructor Init (T : string);
    procedure InitSprites; virtual;
    procedure DrawSprites; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PUfoView = ^TUfoView;
  TUfoView = object (TSpriteView)
    procedure CalcMove; virtual;
  end;

  PBombView = ^TBombView;
  TBombView = object (TSpriteView)
    procedure CalcMove; virtual;
  end;

  PExpView = ^TExpView;
  TExpView = object (TSpriteView)
    procedure CalcMove; virtual;
  end;

  PUfoDlg = ^TUfoDlg;
  TUfoDlg = object (TAniDlg)
    Ufo : PUfoView;
    Bomb : PBombView;
    Exp : PExpView;
    procedure InitSprites; virtual;
    procedure DrawSprites; virtual;
  end;

  PShipView = ^TShipView;
  TShipView = object (TSpriteView)
    procedure CalcMove; virtual;
  end;

  PShotView = ^TShotView;
  TShotView = object (TSpriteView)
    procedure CalcMove; virtual;
  end;

  PShipDlg = ^TShipDlg;
  TShipDlg = object (TAniDlg)
    Ship : PShipView;
    Shot : PShotView;
    procedure InitSprites; virtual;
    procedure DrawSprites; virtual;
  end;

const

  {dialog palette additions for animation}
  CAniColor = #$00#$00#$00#$00#$00#$00#$00;
  CAniPal   = #136#137#138#139#140#141#142;

  {frame sequences using character value.  animate.cgf or compatible}
  {character patterns must be loaded into font used for text}
  invSprite  : string[12] = #128#129#32#130#131#132#133#134#135#136#137#138;
  ufoSprite  : string[6]  = #139#140#32#141#142#143;
  bombSprite : string[4]  = #144#145#146#147;
  expSprite  : string[18] = #148#148#148#148#149#149#149#149#150#150#150#150#149#149#149#149#148#148#148#148;
  shipSprite : string[12] = #151#152#32#153#154#155#156#157#158#159#160#161;
  shotSprite : string[4]  = #162#163#164#165;

implementation

{TBackView}

procedure TBackView.Draw;

var

  Buf : TDrawBuffer;

begin {animation group background}
  MoveChar (Buf[0],' ',GetColor (33),Size.X);
  WriteLine (0,0,Size.X,Size.Y,Buf)
end;

{TSpriteView}

constructor TSpriteView.Init (var Bounds : TRect; S : PString; D : TPoint);

begin
  inherited Init (Bounds);
  SpriteStr := S;      {sprite sequence string}
  Dir := D;            {x and y direction}
  FrameSize := Size.X; {characters used in frame}
  FramePos := 1;       {start with first frame}
  EndPos := Length (SpriteStr^)-FrameSize+1 {last frame}
end;

procedure TSpriteView.CalcMove;

begin {default calc uses desending invaders logic which restart at top}
  if Dir.X > 0 then           {when they reach the bottom}
  begin                       {see if x dir = 1 (moving left)}
    if FramePos < EndPos then {if not last frame then inc for next}
      Inc (FramePos,FrameSize)
    else
    begin                     {if last frame then move sprite x dir chrs}
      Origin.X := Origin.X+Dir.X;
      FramePos := 1
    end
  end
  else
    if Dir.X < 0 then
    begin
      if FramePos > 1 then
        Dec (FramePos,FrameSize)
      else
      begin
        Origin.X := Origin.X+Dir.X;
        FramePos := EndPos
      end
    end;
  if Origin.X > Owner^.Size.X then {boundry checking logic}
  begin
    FramePos := EndPos;
    Origin.X := Owner^.Size.X;
    Dir.X := -1;
    Inc (Origin.Y);
    if Origin.Y > Owner^.Size.Y then
      Origin.Y := 0
  end
  else
    if Origin.X < -Size.X  then
    begin
      FramePos := 1;
      Origin.X := -Size.X;
      Dir.X := 1;
      Inc (Origin.Y);
      if Origin.Y > Owner^.Size.Y then
        Origin.Y := 0
    end
end;

procedure TSpriteView.Draw;

var

  Buf : TDrawBuffer;
  X : byte;

begin {draw current frame}
  for X := 0 to Size.X-1 do
    MoveChar(Buf[X],SpriteStr^[FramePos+X],GetColor (PalIndex),1);
  WriteLine (0,0,Size.X,1,Buf)
end;

{TAniDlg}

constructor TAniDlg.Init (T : string);

var

  R : TRect;
  BackView : PBackView;

begin
  R.Assign (0,0,45,10);
  inherited Init (R,T);

  R.Assign(32, 1, 43, 3);
  Insert(New(PButton, Init(R, '~A~nimate', cmAniOn, bfNormal)));
  R.Assign(32, 3, 43, 5);
  Insert(New(PButton, Init(R, '~S~top', cmAniOff, bfNormal)));
  R.Assign(32, 5, 43, 7);
  Insert(New(PButton, Init(R, '~C~lose', cmClose, bfDefault)));

  R.Assign (2,1,31,9);
  AniGroup := New (PGroup, Init (R));
  AniGroup^.GetExtent (R);
  BackView := New (PBackView, Init (R));
  AniGroup^.Insert (BackView);
  InitSprites;             {initilize sprites}
  Insert (AniGroup);
  Palette := dpBlueDialog; {use blue dialog}
  AniFlag := true          {turn animation on}
end;

procedure TAniDlg.InitSprites;

var

  X, Y : byte;
  B, R : TRect;
  P : TPoint;
  SV : PSpriteView;

begin {default to using two rows of invaders}
  AniGroup^.GetBounds (B);
  P.X := 1;
  P.Y := 0;
  for Y := 0 to 1 do
    for X := 0 to 5 do
    begin
      R.Assign (X*3+B.A.X,Y*2+B.A.Y,X*3+B.A.X+3,Y*2+B.A.Y+1);
      SV := New (PSpriteView, Init (R,@invSprite,P));
      SV^.PalIndex := 34;
      AniGroup^.Insert (SV)
    end
end;

procedure TAniDlg.DrawSprites;

procedure DrawSpr (P : PView); far;

begin
  if TypeOf (P^) = TypeOf (TSpriteView) then
    PSpriteView (P)^.CalcMove;
  P^.DrawView
end;

begin {update and draw all sprites in group}
  AniGroup^.Lock;
  AniGroup^.ForEach (@DrawSpr);
  AniGroup^.Unlock
end;

function TAniDlg.GetPalette: PPalette;

const

  CNewBlueDialog = CBlueDialog+CAniPal;
  CNewCyanDialog = CCyanDialog+CAniPal;
  CNewGrayDialog = CGrayDialog+CAniPal;
  P: array[dpBlueDialog..dpGrayDialog] of string[Length(CNewBlueDialog)] =
  (CNewBlueDialog, CNewCyanDialog, CNewGrayDialog);

begin  {defines additional colors for animation starting at dialog palette index 33}
  GetPalette := @P[Palette];
end;

procedure TAniDlg.HandleEvent(var Event: TEvent);

begin
  inherited HandleEvent(Event);
  case Event.What of
    evCommand:
    begin {process commands}
      case Event.Command of
        cmClose  : Close;
        cmAniOn  : AniFlag := true;
        cmAniOff : AniFlag := false
      else
        Exit
      end;
      ClearEvent (Event)
    end;
    evBroadcast :
    begin {process broadcasts}
      case Event.Command of
        cmAnimate : if AniFlag then
                      DrawSprites
      else
        Exit
      end;
      ClearEvent (Event)
    end
  end
end;

{TUfoView}

procedure TUfoView.CalcMove;

begin {logic for ufo starting at random y axis and moving horz}
  if Dir.X > 0 then
  begin
    if FramePos < EndPos then
      Inc (FramePos,FrameSize)
    else
    begin
      Origin.X := Origin.X+Dir.X;
      FramePos := 1
    end
  end
  else
    if Dir.X < 0 then
    begin
      if FramePos > 1 then
        Dec (FramePos,FrameSize)
      else
      begin
        Origin.X := Origin.X+Dir.X;
        FramePos := EndPos
      end
    end;
  if Origin.X > Owner^.Size.X then
  begin
    FramePos := EndPos;
    Origin.X := Owner^.Size.X;
    Dir.X := -1;
    Origin.Y := Random (Owner^.Size.Y)
  end
  else
    if Origin.X < -Size.X then
    begin
      FramePos := 1;
      Origin.X := -Size.X;
      Dir.X := 1;
      Origin.Y := Random (Owner^.Size.Y)
    end
end;

{TBombView}

procedure TBombView.CalcMove;

begin {logic for decending bomb that hides when it hits bottom}
  if State and sfVisible = sfVisible then
  begin
    if FramePos < EndPos then
      Inc (FramePos,FrameSize)
    else
    begin
      Origin.Y := Origin.Y+Dir.Y;
      FramePos := 1
    end
  end
end;

{TExpView}

procedure TExpView.CalcMove;

begin {logic for updating frames without moving}
  if State and sfVisible = sfVisible then
  begin
    if FramePos < EndPos then
      Inc (FramePos,FrameSize)
    else
      Hide
  end
end;


{TUfoDlg}

procedure TUfoDlg.InitSprites;

var

  B, R : TRect;
  P : TPoint;

begin
  GetBounds (B);
  P.X := 0;
  P.Y := 1;
  R.Assign (B.A.X+1,B.A.Y,B.A.X+2,B.A.Y+1);
  Bomb := New (PBombView, Init (R,@bombSprite,P));
  Bomb^.PalIndex := 36;
  Bomb^.Hide;
  AniGroup^.Insert (Bomb);
  P.X := 0;
  P.Y := 0;
  Exp := New (PExpView, Init (R,@expSprite,P));
  Exp^.PalIndex := 37;
  Exp^.Hide;
  AniGroup^.Insert (Exp);
  P.X := 1;
  P.Y := 0;
  R.Assign (B.A.X+1,B.A.Y,B.A.X+4,B.A.Y+1);
  Ufo := New (PUfoView, Init (R,@ufoSprite,P));
  Ufo^.PalIndex := 35;
  AniGroup^.Insert (Ufo)
end;

procedure TUfoDlg.DrawSprites;

begin
  AniGroup^.Lock;
  if (Random (20) = 0) and {randomly drop bombs}
  (Bomb^.State and sfVisible = 0) then
  begin
    Bomb^.Origin.X := Ufo^.Origin.X;
    Bomb^.Origin.Y := Ufo^.Origin.Y;
    Bomb^.Show
  end;
  if (Bomb^.State and sfVisible = sfVisible) and
  (Bomb^.Origin.Y = AniGroup^.Size.Y) then
  begin {if bomb hits bottom then explode!}
    Exp^.Origin.X := Bomb^.Origin.X;
    Exp^.Origin.Y := Bomb^.Origin.Y-1;
    Exp^.FramePos := 1;
    Bomb^.Hide;
    Exp^.Show
  end;
  Ufo^.CalcMove;
  Bomb^.CalcMove;
  Exp^.CalcMove;
  AniGroup^.Last^.DrawView;
  Ufo^.DrawView;
  Bomb^.DrawView;
  Exp^.DrawView;
  AniGroup^.Unlock
end;

{TShipView}

procedure TShipView.CalcMove;

begin {logic that randomly moves ship in horz dir}
  if Random (50) = 0 then
    Dir.X := 1
  else
    if Random (50) = 0 then
      Dir.X := -1
    else
      if Random (50) = 0 then
        Dir.X := 0;
  if Dir.X > 0 then
  begin
    if FramePos < EndPos then
      Inc (FramePos,FrameSize)
    else
    begin
      Origin.X := Origin.X+Dir.X;
      FramePos := 1
    end
  end
  else
    if Dir.X < 0 then
    begin
      if FramePos > 1 then
        Dec (FramePos,FrameSize)
      else
      begin
        Origin.X := Origin.X+Dir.X;
        FramePos := EndPos
      end
    end;
  if Origin.X > Owner^.Size.X then
  begin
    FramePos := EndPos;
    Origin.X := Owner^.Size.X;
    Dir.X := -1
  end
  else
    if Origin.X < -Size.X then
    begin
      FramePos := 1;
      Origin.X := -Size.X;
      Dir.X := 1
    end
end;

{TShotView}

procedure TShotView.CalcMove;

begin {logic for vert moving shot}
  if FramePos < EndPos then
    Inc (FramePos,FrameSize)
  else
  begin
    Origin.Y := Origin.Y+Dir.Y;
    FramePos := 1
  end;
  if Origin.Y < 0 then
    Hide
end;

{TShipDlg}

procedure TShipDlg.InitSprites;

var

  B, R : TRect;
  P : TPoint;

begin
  AniGroup^.GetBounds (B);
  P.X := 1;
  P.Y := 0;
  R.Assign (B.A.X+1,B.B.Y-2,B.A.X+4,B.B.Y-1);
  Ship := New (PShipView, Init (R,@shipSprite,P));
  Ship^.PalIndex := 38;
  AniGroup^.Insert (Ship);
  P.X := 0;
  P.Y := -1;
  R.Assign (B.A.X+1,B.A.Y,B.A.X+2,B.A.Y+1);
  Shot := New (PShotView, Init (R,@shotSprite,P));
  Shot^.PalIndex := 39;
  Shot^.Hide;
  AniGroup^.Insert (Shot)
end;

procedure TShipDlg.DrawSprites;

begin
  AniGroup^.Lock;
  if (Random (10) = 0) and {randomly shoot}
  (Shot^.State and sfVisible = 0) and
  (Ship^.FramePos = 1)then
  begin
    Shot^.Origin.X := Ship^.Origin.X;
    Shot^.Origin.Y := Ship^.Origin.Y-1;
    Shot^.FramePos := 1;
    Shot^.Show
  end;
  Ship^.CalcMove;
  Shot^.CalcMove;
  AniGroup^.Last^.DrawView;
  Ship^.DrawView;
  Shot^.DrawView;
  AniGroup^.Unlock
end;

end.