unit ksheet;
{------------------------------------------------------------------------------}
{
  KSHeet - This file includes Kave 2000 sheet Simulation components:

    TSheet
    TRollSheet
    TSheetStack

   Author:  Vesa Lappalainen
   Date:    9.9.1996
   Changes:

    TSheet      - yksittäinen pelti, joka voi liikuttaa yhtä anturia

    TRollSheet  - yksittäinen pelit, joka tulee rullalta, eli liikkuessa
                  pitenee koko ajan.  Tarvitsee oman rulla-komponentin

    TSheetStack - kasa peltejä.  Yksittäisiä peltejä voidaan lisätä.
                  Lisäksi voidaan suorittaa kasaan kuuluvia laskuja.

}
{------------------------------------------------------------------------------}
interface

uses
  {Windows, }Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, kavesimu,ksimcomp;

const MAXSHEETS = 200;
  
  {----------------------------------------------------------------------------}
  type TSheet = class(TaSimuObject)
  private
    FFromRoll : Double; {  }
    FEncoder : TsEncoder;
    FEncoderAllways : Boolean;
  protected
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
    function Advance(dx:Double) : boolean; override;
    function Drop(dy:Double) : boolean;    virtual;
    function Cut(pos:Double) : TSheet;     virtual;
  published
    property Encoder : TsEncoder read FEncoder write FEncoder;
    property EncoderAllways : Boolean read FEncoderAllways
                                      write FEncoderAllways default False;

  end; { TSheet }

  {----------------------------------------------------------------------------}
  TSheetFromRoll = class(TSheet)
  private
    FFromRoll : Double; {  }
  protected
  public
    constructor Create(AOwner:TComponent); override;
    function Advance(dx:Double) : boolean; override;
    procedure SetFromRoll(fr:Double);
    procedure ShowChange;                  override;
{$ifdef Left}
    procedure SetWidth(AWidth:integer);    override;
{$endif}
  published
    property FromRoll : Double Read FFromRoll Write SetFromRoll;
  end; { TSheetFromRoll }

  {----------------------------------------------------------------------------}
   type TaSheet = class
   private
     FColor : TColor;
     FLen   : Double;
     Fx     : double;
     Fy     : double;
   public
     constructor Create3(c:TColor;il,ix:Double); virtual;
     function IsNext(const s:TaSheet;const scale:TScale;dy:double):boolean;
     function Hit(const s:TaSheet):boolean;
     procedure Move(dx,dy:double);
   published
     property Color : TColor read FColor;
     property x     : Double read Fx;
     property y     : Double read Fy;
     property Len   : Double Read FLen;
   end; { TaSheet }


  {----------------------------------------------------------------------------}
  type TSheetStack = class(TSheet)
  private
    FSheetHeight : Double;
    FNrOfSheets : integer;
    FEmptyLimit : Double;
    FStartX     : Double;
    Sheets : array [0..MAXSHEETS-1] of TaSheet;
  protected

    procedure SetSheetHeight(sh:Double);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Reset; virtual;
    procedure Paint; override;
    function Advance(dx:Double) : boolean; override;
    function Add(var sh:TSheet):boolean;
    function CoG:Double;
    function IsEmpty : boolean; virtual;
  published
    property SheetHeight : Double read FSheetHeight write SetSheetHeight;
    property NrOfSheets : integer read FNrOfSheets;
    property EmptyLimit : Double read FEmptyLimit write FEmptyLimit;
    property StartX     : Double read FStartX write FStartX;
  end; { TSheetStack }

  {----------------------------------------------------------------------------}
  type TSheetTile = class(TaSimuObject)
  private
  protected
  public
    constructor Create(AOwner:TComponent); override;
    procedure Paint; override;
  published

  end; { TSheetTile }



procedure Register;

implementation
{------------------------------------------------------------------------------}
{ TSheet ======================================================================}
{------------------------------------------------------------------------------}
procedure TSheet.Paint;
var
  iWid, ix, iy, iw, ih: Integer;
begin
  CheckScale;
  with Canvas do
  begin
    Canvas.Pen := Self.Pen;
    Canvas.Brush := Self.Brush;
    ix := Pen.Width div 2;
    iy := ix;
    iWid := Width;
    iw := iWid - Pen.Width + 1;
    ih := Height - Pen.Width + 1;
    if Pen.Width = 0 then begin Dec(iw); Dec(ih); end;
    Rectangle(ix, iy, ix + iw, iy + ih);
  end;
end;

{------------------------------------------------------------------------------}
function TSheet.Drop(dy:Double) : boolean;
begin
  y := y + dy;
  Result := True;
end;

{------------------------------------------------------------------------------}
function TSheet.Cut(pos:Double) : TSheet;
var s:TSheet;
begin
  Result := NIL;
  if ( x >= pos ) then exit; { Pelti ei edes leikkurilla }
  s := TSheet.Create(Owner);
  if ( s <> NIL ) then begin
    s.Scale := Scale;
    s.Parent := Parent;
    s.x := x;
    s.y := y;
    s.Height := Height;
    s.XLen := -x + Pos;
    s.Brush.Color := Brush.Color;
    s.Visible := True;
  end;
  XLen := XLen - (-x + Pos); { Koska s voi olla NIL, ei käyt. s.XLen }
  x := pos;
  Result := s;
end;

{------------------------------------------------------------------------------}
function TSheet.Advance(dx:Double) : boolean;
begin
  inherited Advance(dx);

  Result := True;
  if ( Encoder = NIL ) then exit;     { Anturi ei ota peltiin kiinni           }

  if ( EncoderAllways ) then begin
    Encoder.increment(dx);
    exit;
  end;

  if ( Encoder.x < x ) then begin    { Anturi pellin vas. puolella           }
    if ( dx < 0 ) and ( x+dx <= Encoder.x ) then { Jos liikkuu vasemmalle    }
      Encoder.increment( Encoder.x - (x+dx) );
    exit;
  end;

  if ( x+XLen < Encoder.x ) then begin { Anturi pellin oik.pään oik. puol}
    if ( dx > 0 ) and ( Encoder.x <= x+XLen+dx ) then  { Jos liikkuu oikealle }
      Encoder.increment( x+XLen+dx - Encoder.x );
    exit;
  end;

                                           { Anturi pellin alalla            }
  { Vielä jäi käsittelemättä jos siirron aikana pelti menee pois anturin
    kohdalta, mutta pyöriköön tämän verran tyhjää                            }
  Encoder.increment(dx);

end;

{------------------------------------------------------------------------------}
constructor TSheet.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FFromRoll := 0;
  Height := 5;
  FFromRoll := 0.0;
  FEncoder := NIL;
  FEncoderAllways := False;
end;

{------------------------------------------------------------------------------}
{ TSheetFromRoll ==============================================================}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{$ifdef Left}
procedure TSheetFromRoll.SetWidth(AWidth:integer);
begin
  FFromRoll := UpScale(AWidth) + x;
  inherited SetWidth(AWidth);
end;
{$endif}

{------------------------------------------------------------------------------}
procedure TSheetFromRoll.ShowChange;
begin
  XLen := FromRoll - x;
end;

{------------------------------------------------------------------------------}
procedure TSheetFromRoll.SetFromRoll(fr:Double);
begin
  FFromRoll := fr;
  XLen := fr - x;
end;

{------------------------------------------------------------------------------}
function TSheetFromRoll.Advance(dx:Double) : boolean;
begin
  inherited Advance(dx);
  XLen := FromRoll - x;
  Result := True;
end;

{------------------------------------------------------------------------------}
constructor TSheetFromRoll.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FromRoll := 0.0;
end;


{------------------------------------------------------------------------------}
{ TaSheet =====================================================================}
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
constructor TaSheet.Create3(c:TColor;il,ix:Double);
begin
  inherited Create;
  FColor := c;
  FLen := il;
  Fx := ix;
  Fy := 0;
end;

{------------------------------------------------------------------------------}
function TaSheet.IsNext(const s:TaSheet;const scale:TScale; dy:Double):boolean;
begin
  Result := False;
  if ( s = NIL ) then exit;
  if ( scale = NIL ) then exit;
  if ( Color <> s.Color ) then exit;
  if ( scale.DownScaleDX(x) <> scale.DownScaleDX(s.x) ) then exit;
  if ( abs(scale.DownScaleDY(y)-scale.DownScaleDY(s.y-dy)) > 2 ) then exit;
  if ( scale.DownScaleDX(len) <> scale.DownScaleDX(s.len) ) then exit;
  Result := True;
end;

{------------------------------------------------------------------------------}
function TaSheet.Hit(const s:TaSheet):boolean;
{
  hit     ----          ----        ----    -----
            =======    ========    =====     ===

 no hit   ----                     -----
               ======       ======
}

begin
  Result := False;
  if ( x + len      <= s.x ) then exit;
  if ( s.x + s.len  <= x   ) then exit;
  Result := True;
end;

{------------------------------------------------------------------------------}
procedure TaSheet.Move(dx,dy:double);
begin
  Fx := x + dx;
  Fy := y + dy;
end;

{------------------------------------------------------------------------------}
{ TSheetStack =================================================================}
{------------------------------------------------------------------------------}

{------------------------------------------------------------------------------}
function TSheetStack.IsEmpty : boolean;
begin
  Result := FNrOfSHeets = 0;
end;

{------------------------------------------------------------------------------}
procedure TSheetStack.Reset;
var i:integer;
begin
  for i:=0 to NrOfSheets-1 do begin
    Sheets[i].Free;
    Sheets[i] := NIL;
  end;
  FNrOfSHeets := 0;
  x := StartX;
  xLen := 2000;
  yLen := 100;
  Hint := 'Empty Stack';
  if ( Assigned(Encoder) ) then Encoder.Count := 0;
end;

{------------------------------------------------------------------------------}
Procedure StackRectangle(Canvas:TCanvas; xLen,yLen,x,y,dx,dy:Double;scale:TScale);
var ix, iy, iw, ih: Integer;
begin
  if ( scale = NIL ) then exit;
  with Canvas do begin
    if ( scale.FactorX > 0 ) then ix := scale.DownScaleDX(x)
                             else ix := -scale.DownScaleDX(xLen-x-dx);
    ix := Pen.Width div 2 + ix;
    if ( scale.FactorY > 0 ) then iy := scale.DownScaleDY(yLen-y-dy)
                             else iy := -scale.DownScaleDY(y);
    iy := Pen.Width div 2 + iy;
    iw := Abs(scale.DownScaleDX(dx)) - Pen.Width + 1;
    ih := Abs(scale.DownScaleDY(dy)) - Pen.Width + 1;
    if Canvas.Pen.Width = 0 then begin Dec(iw); Dec(ih); end;
    Canvas.Rectangle(ix, iy, ix + iw, iy + ih);
  end;
end;

{------------------------------------------------------------------------------}
procedure TSheetStack.Paint;
var
  i, n: Integer; dy,yh : Double;
begin
  if ( NrOfSheets = 0 ) then begin inherited Paint; exit; end;

  CheckScale;
  i := 0; yh := yLen;
  Canvas.Pen := Self.Pen;
  Canvas.Pen.Style := psSolid;
  Canvas.Brush := Self.Brush;
  Canvas.Brush.Style := bsSolid;
  while ( i < NrOfSheets ) do begin
    n := 1; { Etsitään samankokoiset pellit }
    while ( Sheets[i+n-1].IsNext(Sheets[i+n],Scale,SheetHeight) ) do inc(n);

    Canvas.Brush.Color := Sheets[i].Color;

    dy := SheetHeight*n;
    StackRectangle(Canvas,xLen,yh,Sheets[i].x,Sheets[i].y,Sheets[i].len,dy,Scale);
    i := i + n;
  end;

end;

{------------------------------------------------------------------------------}
function TSheetStack.Advance(dx:Double) : boolean;
begin
  Result := false;
  if ( NrOfSheets = 0 ) then exit;
  if ( not inherited Advance(dx) ) then exit;
  if ( DownScaleX(x + xLen) < 0 ) or ( DownScaleX(x) > Parent.Width ) then Reset;
  Result := True;
end;

{------------------------------------------------------------------------------}
constructor TSheetStack.Create(AOwner:TComponent);
var i:integer;
begin
  inherited Create(AOwner);
  for  i := 0 to MAXSHEETS-1 do Sheets[i] := NIL;
  FSheetHeight := 30.0;
  FNrOfSheets := 0;
  FEmptyLimit := -20000.0;
  FStartX := -2000.0;
  EncoderAllways := True;
  Reset;
end;

{------------------------------------------------------------------------------}
destructor TSheetStack.Destroy;
begin
  Reset;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
procedure TSheetStack.SetSheetHeight(sh:Double);
begin
  FSheetHeight := sh;
  Invalidate;
end;

{------------------------------------------------------------------------------}
function TSheetStack.Add(var sh:TSheet):boolean;
{                              dx = sh.x - x ( huom. kuvassa mol < 0 )
           -------------       dx < 0  => nx = 0,  kaikille x += -dx
              =======          x = sh.x
                               len = sh.len

               ---------       dx >= 0  => nx = dx
              =======          x OK
                               len = dx + sh.len
           ------
              =======          x = sh.x
                               len = -dx + len

                 ---
              =======          x  OK
                               len OK

}
var nas : TaSheet;
    dx,nx,ny,nl : double;
    i : integer;
begin
  Result := False;
  if ( NrOfSheets >= MAXSHEETS-1 ) then exit;
  nl := xLen;
  if ( NrOfSheets = 0 ) then begin x := sh.x; nl := sh.xLen; yLen := 0; end;
  dx := sh.x - x; nx := dx;
  if ( dx < 0 ) then nx := 0;
  nas := TaSheet.Create3(sh.Brush.Color,sh.xLen,nx);
  if ( nas = NIL ) then exit;

  if ( dx < 0 ) then begin
    for i:=0 to NrOfSheets-1 do Sheets[i].Move(-dx,0);
    x := sh.x; nl := xLen - dx;
    if ( sh.xLen > nl ) then nl := sh.xLen;
  end
  else if ( sh.xLen + dx > nl ) then nl := sh.xLen + dx;

  ny := 0;  { Putoaako pohjaan asti }
  for i := NrOfSheets-1 downto 0  do
    if (  Sheets[i].hit(nas) ) then begin
       ny := Sheets[i].y + SheetHeight;
       break;
    end;

  Sheets[NrOfSheets] := nas;  inc(FNrOfSheets);

  nas.Move(0,ny);
  Hint := Format('Last: %2.1f, Total %d',[sh.xLen,NrOfSheets]);
  xLen := nl;
  if ( yLen < nas.y + SheetHeight ) then yLen := nas.y + SheetHeight;
  sh.Free; sh := NIL;
  Invalidate;
  Result := True;
end;

{------------------------------------------------------------------------------}
function TSheetStack.CoG:Double;
{
Teoriaa:


Painopiste ( c  = kappaleen i painopisteen paikka ja
              i
             m  = kappaleen i massa):
              i


         Sum(c m )           Sum(c m )
              i i                 i i
   c = ------------------- = ----------
          Sum(m )                M
               i

  Kun tähän lisätään uusi kappale n, niin


             Sum(c m ) + c m      c M + c m
                  i i     n n            n n
   c   =  -------------------- = ------------
    u        Sum(m ) + m            M + m
                  i     n                n


  Jos c  == c, niin c  <- c, eli painopisteen säilyttämiseksi
       n             u

  tarvitsee lisätä vain massaa M.

  Peltien tapauksessa massa m voidaan korvata pellin
  pituudella l. Pellin tapauksessa c = l/2, eli

                             2
         Sum(l /2 l     Sum(l )
              i    i)        i
   c  = ------------- = ----------
          Sum(l )       2 Sum(l )
               i               i
  Jos kokonaista kasaa siirretään matka d eteenpäin,
  muuttuu painopisteen paikka:



}
var i:integer;
    SumCiMi,SumMi:double;
begin
   Result := 0;
   SumCiMi := 0;
   SumMi := 0;
   for i:=0 to NrOfSheets-1 do begin
     SumCiMi := SumCiMi + (Sheets[i].x+Sheets[i].len/2)*Sheets[i].len;
     SumMi := SumMi + Sheets[i].len;
   end;
   if ( SumMi <> 0 ) then Result := x + SumCiMi/SumMi;
end;

{------------------------------------------------------------------------------}
{ TSheetTile ======================================================================}
{------------------------------------------------------------------------------}
procedure TSheetTile.Paint;
var
  iWid, ix, iy, iw, ih: Integer;
begin
  CheckScale;
  with Canvas do
  begin
    Canvas.Pen := Self.Pen;
    Canvas.Brush := Self.Brush;
    ix := Pen.Width div 2;
    iy := ix;
    iWid := Width;
    iw := iWid - Pen.Width + 1;
    ih := Height - Pen.Width + 1;
    if Pen.Width = 0 then begin Dec(iw); Dec(ih); end;
    Canvas.Polygon([Point(ix, iy+ih), Point(ix, iy),
      Point(ix+iw, iy+ih), Point(ix, iy+ih)]);
  end;
end;

{------------------------------------------------------------------------------}
constructor TSheetTile.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Height := 15;
end;


{------------------------------------------------------------------------------}
procedure Register;
begin
  RegisterComponents('Kave2000', [TSheet,TSheetFromRoll,TSheetStack,TSheetTile]);
end;


end.