pascalabcnet/TestSuite/CompilationSamples/ABCSprites.pas

// Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)

///Ìîäóëü ABCSprites ðåàëèçóåò ñïðàéòû - àíèìàöèîííûå îáúåêòû ñ àâòîìàòè÷åñêè ìåíÿþùèìèñÿ êàäðàìè. 
///Ñïðàéò ïðåäñòàâëÿåòñÿ êëàññîì SpriteABC è ÿâëÿåòñÿ ðàçíîâèäíîñòüþ ìóëüòèêàðòèíêè MultiPictureABC.
unit ABCSprites;

//#savepcu false

interface

uses ABCObjects,Events,GraphABC,Utils;

type
  SpriteState = record
    Name: string;   // èìåíà ñîñòîÿíèé
    Beg: integer;   // íîìåðà êàðòèíîê, ÿâëÿþùèõñÿ íà÷àëàìè ñîñòîÿíèé
    Count: integer; // äëèíû ñîñòîÿíèé
    constructor Create(n: string; b,c: integer);
    begin
      Name := n;
      Beg := b;
      Count := c;
    end;
  end;

  SpriteABC = class(MultiPictureABC)
  private
    States: Array of SpriteState;
    curst: integer;          // íîìåð òåêóùåãî ñîñòîÿíèÿ
    ticks: integer;          // ñêîëüêî òèêîâ ïðîõîäèò äî ñìåíû êàäðà, îáðàòíî ïðîïîðöèîíàëåí ñêîðîñòè: 0..10
    act: boolean;            // àêòèâåí ëè ñïðàéò
    curtick: integer;        // òåêóùèé òèê, êîãäà îí ñòàíîâèòñÿ ðàâíûì
    procedure SetStateName(n: string);
    function GetStateName: string;
    procedure SetState(n: integer);
    function GetStateCount: integer;
    procedure SetSpeed(n: integer);
    function GetSpeed: integer;
    procedure SetActive(b: boolean);
    procedure SetFrame(n: integer);
    function GetFrame: integer;
  protected  
    procedure Init0;
    procedure Init(x,y: integer; fname: string);   // ïîñëå ýòîãî ïðèäåòñÿ âûçûâàòü Add è AddState, çàòåì CheckStates
    procedure Init(x,y,w: integer; fname: string); // ïîñëå ýòîãî ïðèäåòñÿ âûçûâàòü AddState, çàòåì CheckStates
    procedure Init(x,y,w: integer; p: Picture);
    procedure InitWithStates(x,y: integer; fname: string);
    procedure InitBy(g: SpriteABC);
  public
    /// Ñîçäàåò ñïðàéò, çàãðóæàÿ åãî èç ôàéëà ñ èìåíåì fname. 
    ///Èìÿ fname ìîæåò áûòü ëèáî èìåíåì ãðàôè÷åñêîãî ôàéëà, ëèáî èìåíåì èíôîðìàöèîííîãî ôàéëà ñïðàéòà ñ ðàñøèðåíèåì .spinf 
    ///Åñëè èìÿ ÿâëÿåòñÿ èìåíåì ãðàôè÷åñêîãî ôàéëà, òî ñîçäàåòñÿ ñïðàéò ñ îäíèì êàäðîì. Îñòàëüíûå êàäðû äîáàâëÿþòñÿ ìåòîäîì Add.
    ///Ïîñëå ýòîãî ïðè íåîáõîäèìîñòè äîáàâëÿþòñÿ ñîñòîÿíèÿ ìåòîäîì AddStates è âûçûâàåòñÿ ìåòîä CheckStates 
    ///Åñëè ôàéë èìååò ðàñøèðåíèå .spinf, òî îí ñîäåðæèò èíôîðìàöèþ î êàäðàõ è ñîñòîÿíèÿõ ñïðàéòà è
    ///äîëæåí ñîïðîâîæäàòüñÿ ñîîòâåòñòâóþùèì ãðàôè÷åñêèì ôàéëîì.
    ///Ïîñëå ñîçäàíèÿ ñïðàéò îòîáðàæàåòñÿ íà ýêðàíå â ïîçèöèè (x,y)
    constructor Create(x,y: integer; fname: string);   
    /// Ñîçäàåò ñïðàéò, çàãðóæàÿ åãî èç ôàéëà fname. Ôàéë äîëæåí õðàíèòü ðèñóíîê, ïðåäñòàâëÿþùèé ñîáîé 
    ///ïîñëåäîâàòåëüíîñòü êàäðîâ îäíîãî ðàçìåðà, ðàñïîëîæåííûõ ïî ãîðèçîíòàëè. 
    ///Êàæäûé êàäð ñ÷èòàåòñÿ èìåþùèì øèðèíó w. Åñëè øèðèíà ðèñóíêà â ôàéëå fname íå êðàòíà w, òî âîçíèêàåò èñêëþ÷åíèå. 
    ///Ïîñëå ýòîãî ïðè íåîáõîäèìîñòè äîáàâëÿþòñÿ ñîñòîÿíèÿ ìåòîäîì AddStates è âûçûâàåòñÿ ìåòîä CheckStates 
    ///Ïîñëå ñîçäàíèÿ ñïðàéò îòîáðàæàåòñÿ íà ýêðàíå â ïîçèöèè (x,y)
    constructor Create(x,y,w: integer; fname: string); 
    /// Ñîçäàåò ñïðàéò, çàãðóæàÿ åãî èç îáúåêòà p: Picture. Îí äîëæåí õðàíèòü ðèñóíîê, ïðåäñòàâëÿþùèé ñîáîé 
    ///ïîñëåäîâàòåëüíîñòü êàäðîâ îäíîãî ðàçìåðà, ðàñïîëîæåííûõ ïî ãîðèçîíòàëè. 
    ///Êàæäûé êàäð ñ÷èòàåòñÿ èìåþùèì øèðèíó w. Åñëè øèðèíà ðèñóíêà íå êðàòíà w, òî âîçíèêàåò èñêëþ÷åíèå. 
    ///Ïîñëå ýòîãî ïðè íåîáõîäèìîñòè äîáàâëÿþòñÿ ñîñòîÿíèÿ ìåòîäîì AddStates è âûçûâàåòñÿ ìåòîä CheckStates 
    ///Ïîñëå ñîçäàíèÿ ñïðàéò îòîáðàæàåòñÿ íà ýêðàíå â ïîçèöèè (x,y)
    constructor Create(x,y,w: integer; p: Picture);
    /// Ñîçäàåò ñïðàéò - êîïèþ ñïðàéòà g
    constructor Create(g: SpriteABC);
    /// Óäàëÿåò ñïðàéò
    destructor Destroy;
    /// Äîáàâëÿåò ñîñòîÿíèå ê ñïðàéòó. Ïîñëå äîáàâëåíèÿ âñåõ ñîñòîÿíèé ñëåäóåò âûçâàòü CheckStates
    procedure AddState(name: string; count: integer);
    /// Ïðîâåðÿåò êîððåêòíîñòü íàáîðà ñîñòîÿíèé. Âûçûâàåòñÿ ïîñëå äîáàâëåíèÿ âñåõ ñîñòîÿíèé
    procedure CheckStates;
    /// Äîáàâëÿåò êàäð ê ñïðàéòó
    procedure Add(fname: string);
    /// Ñîõðàíÿåò ãðàôè÷åñêèé è èíôîðìàöèîííûé ôàéëû ñïðàéòà
    /// Èìÿ fname çàäàåò èìÿ ãðàôè÷åñêîãî ôàéëà
    /// Èíôîðìàöèîííûé ôàéë ñîõðàíÿåòñÿ â òîò æå êàòàëîã, ÷òî è ãðàôè÷åñêèé, èìååò òî æå èìÿ è ðàñøèðåíèå .spinf
    procedure SaveWithInfo(fname: string); 
    /// Ïåðåõîäèò ê ñëåäóþùåìó êàäðó â òåêóùåì ñîñòîÿíèè
    procedure NextFrame;     
    /// Ïåðåõîäèò ê ñëåäóþùåìó òèêó òàéìåðà; åñëè îí ðàâåí ticks, òî îí ñáðàñûâàåòñÿ â 1 è âûçûâàåòñÿ NextFrame
    procedure NextTick;      
    /// Èìÿ ñîñòîÿíèÿ
    property StateName: string read GetStateName write SetStateName;
    /// Íîìåð ñîñòîÿíèÿ (1..StateCount)
    property State: integer read curst write SetState;
    /// Êîëè÷åñòâî ñîñòîÿíèé
    property StateCount: integer read GetStateCount;
    /// Ñêîðîñòü ñïðàéòà (1..10)
    property Speed: integer read GetSpeed write SetSpeed;
    /// Àêòèâíîñòü ñïðàéòà: True, åñëè ñïðàéò àêòèâåí (ò.å. ïðîèñõîäèò åãî àíèìàöèÿ), è False â ïðîòèâíîì ñëó÷àå
    property Active: boolean read act write SetActive;
    /// Òåêóùèé êàäð â òåêóùåì ñîñòîÿíèè
    property Frame: integer read GetFrame write SetFrame;
    /// Âîçâðàùàåò êîëè÷åñòâî êàäðîâ â òåêóùåì ñîñòîÿíèè
    function FrameCount: integer;
    /// Âîçâðàùàåò íà÷àëüíûé êàäð â òåêóùåì ñîñòîÿíèè
    function FrameBeg: integer;
    /// Âîçâðàùàåò êëîí îáúåêòà
    function Clone0: ObjectABC; override;
    /// Âîçâðàùàåò êëîí îáúåêòà
    function Clone: SpriteABC; 
  end;

/// Ñòàðòóåò àíèìàöèþ âñåõ ñïðàéòîâ
procedure StartSprites;
/// Îñòàíàâëèâàåò àíèìàöèþ âñåõ ñïðàéòîâ
procedure StopSprites;

///--
procedure __InitModule__;
///--
procedure __FinalizeModule__;

implementation

const infoext = '.spinf';
  
var
  _Sprites: System.Collections.ArrayList; // ìàññèâ ñïðàéòîâ
  _t: System.Timers.Timer;                // òàéìåð ñïðàéòîâ
  timerMs: integer;
  
procedure SpriteABC.Init0;
begin
  SetLength(States,1);
  States[0].Name := '';
  States[0].Beg := 1;
  States[0].Count := 1;
  curst := 1;
  curtick := 1;
  Speed := 5;
  act := True;
  _Sprites.Add(Self);
end;

procedure SpriteABC.Init(x,y: integer; fname: string);
begin
  Init0;
  inherited Init(x,y,fname);
end;

procedure SpriteABC.Init(x,y,w: integer; fname: string);
begin
  Init0;
  inherited Init(x,y,w,fname);
  States[0].Count := Count;
end;

procedure SpriteABC.Init(x,y,w: integer; p: Picture);
begin
  Init0;
  inherited Init(x,y,w,p);
  States[0].Count := Count;
end;

procedure SpriteABC.InitWithStates(x,y: integer; fname: string);
var
  vs,sname: string;
  f: PABCSystem.text;
  i,j,w,sp,num: integer;
begin
{  if not FileExists(fname) then
    fname := StandardImageFolder + fname;}
  if not FileExists(fname) then
    raise Exception.Create('Ôàéë '+ExtractFileName(fname)+' íå íàéäåí');
    
  Init0;

{  s := LowerCase(ExtractFileExt(fname));
  i := Pos(s,fname);
  s := fname;
  Delete(s,i,Length(s));
  s := s + infoext;
  if not FileExists(s) then
    raise Exception.Create('Èíôîðìàöèîííûé ôàéë ñïðàéòà '+ExtractFileName(s)+' íå íàéäåí');}

  try
    assign(f,fname);
    reset(f);
    readln(f,vs);
    j := Pos(' ',vs);
    fname := ExtractFilePath(fname)+Copy(vs,1,j-1);
    readln(f,w);
    readln(f,sp);
    Speed := sp;
    readln(f,num);
    for i:=1 to num do
    begin
      readln(f,vs);
      j := Pos(' ',vs);
      sname := Copy(vs,1,j-1);
      Delete(vs,1,j);
      vs := TrimLeft(vs);
      j := Pos(' ',vs);
      if j>0 then
        vs := Copy(vs,1,j-1);
      AddState(sname,StrToInt(vs));
    end;
    close(f);
  except
    on e: Exception do
    begin
      writeln(e);
      raise Exception.Create('Îøèáêà ñ÷èòûâàíèÿ èç èíôîðìàöèîííîãî ôàéëà ñïðàéòà');
    end;  
  end;
  inherited Init(x,y,w,fname);
  CheckStates;
end;

procedure SpriteABC.InitBy(g: SpriteABC);
var i: integer;
begin
  inherited InitBy(g);
  Init0;
  SetLength(States,g.States.Length);
  for i:=0 to States.Length-1 do
  begin
    States[i].Beg := g.States[i].Beg;
    States[i].Count := g.States[i].Count;
    States[i].Name := g.States[i].Name;
  end;
end;

constructor SpriteABC.Create(x,y: integer; fname: string);   
begin
  var s := ExtractFileExt(fname);
  if LowerCase(s) = infoext then
    InitWithStates(x,y,fname)
  else Init(x,y,fname);
  InternalDraw;
end;

constructor SpriteABC.Create(x,y,w: integer; fname: string); 
begin
  Init(x,y,w,fname);
  InternalDraw;
end;

constructor SpriteABC.Create(x,y,w: integer; p: Picture);
begin
  Init(x,y,w,p);
  InternalDraw;
end;

constructor SpriteABC.Create(g: SpriteABC);
begin
  InitBy(g);
end;

destructor SpriteABC.Destroy;
begin
  _Sprites.Remove(Self);
  inherited Destroy;
end;

procedure SpriteABC.SaveWithInfo(fname: string);
var
  s,fnameold: string;
  f: PABCSystem.text;
  i: integer;
begin
  CheckStates;
  s:=LowerCase(ExtractFileExt(fname));
  if (s<>'.bmp') and (s<>'.jpg') and (s<>'.gif') and (s<>'.png') then
    raise Exception.Create('Çàäàí íåâåðíûé ôîðìàò ãðàôè÷åñêîãî ôàéëà');
  Save(fname);
  fnameold := fname;
  i := Pos(s,fname);
  Delete(fname,i,Length(s));
  fname := fname + infoext;
  assign(f,fname);
  rewrite(f);
  writeln(f,ExtractFileName(fnameold),' // èìÿ ôàéëà ñïðàéòà');
  writeln(f,width,' // øèðèíà êàäðà');
//  writeln(f,count,' // êîëè÷åñòâî êàäðîâ');
  writeln(f,Speed,' // ñêîðîñòü');
  writeln(f,StateCount,' // êîëè÷åñòâî ñîñòîÿíèé');
  for i:=0 to StateCount-1 do
    if i=0 then
      writeln(f,States[i].Name,' ',States[i].Count,' // èìåíà ñîñòîÿíèé è êîëè÷åñòâî êàäðîâ â íèõ')
    else writeln(f,States[i].Name,' ',States[i].Count);
  close(f);
end;

procedure SpriteABC.CheckStates;
var
  s: integer;
  i: integer;
begin
  s := 0;
  for i:=0 to StateCount-1 do
    s := s + States[i].Count;
  if s<>Count then
    raise Exception.Create('Ñóììà êàäðîâ â ñîñòîÿíèÿõ ñïðàéòà îòëè÷àåòñÿ îò îáùåãî êîëè÷åñòâà êàäðîâ');
end;

procedure SpriteABC.Add(fname: string);
begin
//  Assert(StateCount=1,'ïðè äîáàâëåíèè êàäðîâ êîëè÷åñòâî ñîñòîÿíèé äîëæíî áûòü ðàâíî 1');
  inherited Add(fname);
  Inc(States[0].Count);
end;

procedure SpriteABC.NextTick;
begin
  if not act then exit;
  Inc(curtick);
  if curtick>ticks then
  begin
    NextFrame;
    curtick := 1;
  end;
end;

procedure SpriteABC.SetStateName(n: string);
var i,ind: integer;
begin
  ind := -1;
  for i:=0 to States.Length-1 do
    if States[i].Name = n then
    begin
      ind := i;
      break;
    end;
  if ind<>-1 then
    State := ind + 1;
end;

function SpriteABC.GetStateName: string;
begin
  Result := States[curst-1].Name;
end;

procedure SpriteABC.SetState(n: integer);
begin
  if curst=n then
    exit;
  if n<1 then
    n := 1;
  if n>StateCount then
    n := StateCount;
  curst := n;
  CurrentPicture := States[curst-1].Beg;
  Redraw;
end;

function SpriteABC.GetStateCount: integer;
begin
  Result := States.Length;
end;

procedure SpriteABC.SetSpeed(n: integer);
begin
  // ïîêà íåò íóëåâîé ñêîðîñòè
  // ñäåëàòü ïîïðàâêó íà èçìåíåíèå òèêà ïðè óìåíüøåíèè ñêîðîñòè!
  if n<1 then n := 1;
  if n>10 then n := 10;
  case n of
1: ticks := 30;
2: ticks := 20;
3: ticks := 14;
4: ticks := 10;
5: ticks := 8;
6: ticks := 6;
7: ticks := 4;
8: ticks := 3;
9: ticks := 2;
10: ticks := 1;
  end;
end;

function SpriteABC.GetSpeed: integer;
begin
  case ticks of
30: Result := 1;
20: Result := 2;
14: Result := 3;
10: Result := 4;
8:  Result := 5;
6:  Result := 6;
4:  Result := 7;
3:  Result := 8;
2:  Result := 9;
1:  Result := 10;
  end;
end;

procedure SpriteABC.SetActive(b: boolean);
begin
  act:=b;
end;

procedure SpriteABC.NextFrame;
var n: integer;
begin
  n := Frame + 1;
  if n>States[curst-1].Count then
    n := 1;
  Frame := n;
//  Redraw; // ýòî íàäî îòêëþ÷àòü ïî ôëàãó!
end;

procedure SpriteABC.SetFrame(n: integer);
begin
  if Frame=n then
    exit;
  if n<1 then
    n := 1;
  if n>States[curst-1].Count then
    n := States[curst-1].Count;
  CurrentPicture := States[curst-1].Beg + n - 1;
end;

function SpriteABC.GetFrame: integer;
begin
  Result := CurrentPicture - States[curst-1].Beg + 1;
end;

function SpriteABC.FrameCount: integer;
begin
  Result := States[curst-1].Count;
end;

function SpriteABC.FrameBeg: integer;
begin
  Result := States[curst-1].Beg;
end;

procedure SpriteABC.AddState(name: string; count: integer);
begin
  if (States[0].Name='') then
  begin
//    StateBegs[1]:=1;
    States[0].Count := count;
    States[0].Name := name;
  end
  else
  begin
    var v := States.Length;
    SetLength(States,v+1);
    States[States.Length-1].Beg := States[States.Length-2].Beg + States[States.Length-2].Count;
    States[States.Length-1].Count := count;
    States[States.Length-1].Name := name;
//    StateBegs.Add(StateBegs[StateCount-1]+StateCounts[StateCount-1]);
//    StateCounts.Add(count);
//    StateNames.Add(name);
  end;
end;

function SpriteABC.Clone0: ObjectABC;
begin
  Result := new SpriteABC(Self);
end;

function SpriteABC.Clone: SpriteABC; 
begin
  Result := new SpriteABC(Self);
end;

procedure StartSprites;
begin
  _t.Start;
end;

procedure StopSprites;
begin
  _t.Stop;
end;

var k: integer;

procedure TimerProc(o: Object; e: System.Timers.ElapsedEventArgs);
var i: integer;
begin
  LockDrawingObjects;
  i := 0;
  while i<_Sprites.Count do
  begin
    SpriteABC(_Sprites[i]).NextTick;
    Inc(i);
  end;
  Inc(k);
  //SetWindowCaption(IntToStr(round(k*1000/Milliseconds)));
  RedrawObjects;
end;

var __initialized := false;

procedure __InitModule;
begin
  timerMs := 50; // äèñêðåòèçàöèÿ òàéìåðà. Ïîòîì äîïóñòèìà ïåðåêàëèáðîâêà
  _Sprites := new System.Collections.ArrayList;
  _t := new System.Timers.Timer(timerMs);
  _t.Elapsed += TimerProc;
end;

procedure __InitModule__;
begin
  if not __initialized then
  begin
    __initialized := true;
    ABCObjects.__InitModule__;
    GraphABC.__InitModule__;
    __InitModule;
  end;
end;

procedure __FinalizeModule__;
begin
  StartSprites;
end;

initialization
  __InitModule;
finalization
  __FinalizeModule__;
end.