unit LDN199u1;

(*A "complex" use of arrays to generate a graphics display which
runs quickly, despite a lot going on.

Basis for a variety of simulations, say of single celled organisms
living on a 2-D world

See http:sheepdogguides.com/Lut/lt3amoeba.htm for tutorial about this.

See http:sheepdogguides.com/Lut/PixelProblem.htm for some of the basics
of pixel plotting with Lazarus.

Note to myself...
Plan of this hatched at Charlie H's, 5 Feb 15, when I was coming down
from first NoviceGuard (PCB261/ 262... 262 was daughter boards for 261, and
was first PCB- via- OSH Park to go out the door) push, day after I posted
first job (PCB262) to OSH Park.
*)

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls,Math{for DegToRad};

const
  //FORK of what was published with https://sheepdogguides.com/lut/lt3amoeba.htm
  //NEEDS TO BE RE_NAMED- but is in own folder won't upset original LDN199.txt
  vers='6 Feb 15';
  //Started 05 Feb 15
  kMaxImageIndexX=400;//Sets width of Image1
  kMaxImageIndexY=400;//Sets height
  kMaxAmIndex=30;//If 15, there are 16 "AMoebas" in the simulation
  kMaxPixelsIndex=18;//Pixels occupied, each critter, incl head and tail.
      //"4" means there are 5 array elements: One for a 1 pixel
      //amoeba, 3 for current tail pixels, and one for "last pixel
      //of tail"... which must be painted color of background (i.e.
      //not actually part of tail) to "erase" oldest pixel each
      //time amoeba moves forward.
  kBkGrndColor=clYellow;

  kSimSpeedSlow=120;
  kSimSpeedMedium=45;
  kSimSpeedFast=22;
  kSimSpeedFastest=1;

type

  { Tldn128orreryf1 }

  Tldn128orreryf1 = class(TForm)
    buGo: TButton;
    buQuit: TButton;
    Image1: TImage;
    laTxtCycles: TLabel;
    LaTxtImgSize: TLabel;
    laTutRef: TLabel;
    laCycles: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Timer1: TTimer;
    procedure buGoClick(Sender: TObject);
    procedure buQuitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioButton1Change(Sender: TObject);
    procedure RadioButton2Change(Sender: TObject);
    procedure RadioButton3Change(Sender: TObject);
    procedure RadioButton4Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
    Bitmap:TBitmap;
    bColPointerHead:byte;//Tells us which column (of array Where) currently
         //has coords of head. Moves to right (higher array index) as time
         //passes. What is IN each array element doesn't change until
         //overwritten because it is oldest pixel at time. But, with each
         //cycle, the color used for a given pixel changes.
         //Points to the pixel at the head of the "trail", which will be
         //the amoeba itself.
    wWhereX,wWhereY:array[0..kMaxPixelsIndex,0..kMaxAmIndex] of word;
         //wWhereX and -Y store WHERE (X/Y) the amoebas and their tails are
    clColColor:array [0..kMaxPixelsIndex] of TColor;//color for amoeba, newest tail pixel,
         //next newest, etc.
    dbX,wCycles:word;

    procedure FillConstants;//Things like the "color for tail posn" tables.
    procedure FillWorld;//Populate "the world". Not ALL of the prgm's inits!
    //procedure Showamoebas;//Core procedure: Redraws world.
    //procedure Moveamoebas;
    procedure OrerryPosnCalc (var dblX,dblY,dblAngle:longint;RSize:double);
    procedure CircleFilled(xCF,yCF,RSizeCF:longint;clFillCF:TColor);
    procedure OrerryProc;

  public
    { public declarations }
  end;

var
  ldn128orreryf1: Tldn128orreryf1;

implementation

{$R *.lfm}
{$R+}    //Range checking on. Take out? (for speed?) in due course.
         //(Taking out didn't seem to make much difference)

{ Tldn128orreryf1 }

procedure Tldn128orreryf1.FormCreate(Sender: TObject);
//var wCount:word;
begin
  dbX:=10;
  application.title:='LDN228';
  ldn128orreryf1.caption:='LDN128Orrery, version '+vers;
  randomize;
  //Timer1.enabled:=false;

  RadioButton1.checked:=true;//Slect Lento as initia speed

  //RadioButton2.checked:=true;//This and next go together... change both
  Timer1.interval:=kSimSpeedMedium;// if changing either

  wCycles:=0;

//ESTABLISH DRAWING AREA... down to "end of..."
Image1.width:=kMaxImageIndexX;
  Image1.height:=kMaxImageIndexY;

  Bitmap:=TBitmap.create;

  Bitmap.width:=kMaxImageIndexX;
  Bitmap.height:=kMaxImageIndexY;

//Next two determine background color. Delphi bitmaps default to white, Lazarus to black.
Bitmap.canvas.pen.color:=kBkGrndColor;
//Only doing border.. if that? Tried...
//   Image1.Canvas.Brush.Color := kBkGrndColor;
//   Image1.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));
//... because that works, later.
//Why not here???

Bitmap.canvas.FillRect
  (0,0,kMaxImageIndexX,kMaxImageIndexY);
//Note rectangle dimensions: "5,5" fills TO, (excluding
//  the cell identified by "5,5". If the image was
//  set up with WIDTH 5, the IDENTIFIER of the
//  lower right hand cell is "4,4", because the
//  upper left hand cell is "0,0"

Image1.Picture.Graphic:=Bitmap; //Assign the bitmap
  //to the image component The size of the image
  //seems to adjust to the size of the bitmap assigned
  //to it, at least if you use the default properties
  //for Image1, which include Align= alNone,
  //AutoSize= false, Stretch= false.
  //I'm not quite sure why Autosize doesn't need
  //to be "true"... it may relate to something else.

//end of ESTABLISH DRAWING AREA

FillConstants;//May or may not be useful to Orerry

end; //FormCreate

procedure Tldn128orreryf1.RadioButton1Change(Sender: TObject);
begin
  Timer1.interval:=kSimSpeedSlow;
end;

procedure Tldn128orreryf1.RadioButton2Change(Sender: TObject);
begin
  Timer1.interval:=kSimSpeedMedium;
end;

procedure Tldn128orreryf1.RadioButton3Change(Sender: TObject);
begin
  Timer1.interval:=kSimSpeedFastest;
end;

procedure Tldn128orreryf1.RadioButton4Change(Sender: TObject);
begin
  Timer1.interval:=kSimSpeedFast;
end;

procedure Tldn128orreryf1.OrerryProc;
var dblX,dblY,RSize,dblAngle,dblOffX,dblOffY:longint;
begin
  Timer1.enabled:=false;
  dblOffX:=90;dblOffY:=90;

  //Clear screen...
  Image1.Canvas.Brush.Color := kBkGrndColor;
  Image1.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));

  (*Leo says..
  // Draw filled circle: Ellipse(Left, Top, Right, Bottom)
  // Center (200, 200), Radius 50 -> Bounding box 150,150 to 250,250
  Canvas.Ellipse(150, 150, 250, 250);
  Image1.Canvas.Brush.Style := bsSolid;
  Image1.Canvas.Brush.Color := clBlue;
  *)

  Image1.Canvas.Brush.Color := clblue;
  RSize:=2;
  dblAngle:=0;
  while dblAngle<360 do
    begin
    OrerryPosnCalc (dblX,dblY,dblAngle,RSize*15);
    //showmessage(inttostr(dblX)+'  '+inttostr(dblY));
    //Image1.Canvas.Rectangle
    //   (dblX+dblOffX,dblY+dblOffY,dblX+RSize+dblOffX,dblY+RSize+dblOffY);
    //Image1.Canvas.Ellipse(320 div 2, 240 div 2, 100, 100);
    //Image1.Canvas.Ellipse(dblX-RSize,dblY-RSize,dblX+RSize,dblY+RSize);

    //CircleFilled(xCF,yCF,RSizeCF:double;clFillCF:TColor);
    CircleFilled(dblX+200,dblY+200,10,clBlue);//+200's: Bodge

    dblAngle:=dblAngle+20;
    end;//while
end;

procedure Tldn128orreryf1.OrerryPosnCalc (var dblX,dblY,dblAngle:longint;RSize:double);
//SR by Loe, 11 Aug 26
(*From Leo, 11 Aug 26...
Coordinate System: This places 0° at the right (East).
   If your application requires 0° at the top (North) and clockwise rotation,
   adjust the angle before calculation: AngleDegrees := 90 - AngleDegrees;.
Center Offset: The above code calculates coordinates relative to the
   origin (0,0). To offset from a center point (Cx, Cy), use: X :=
         Cx + Radius * Cos(DegToRad(AngleDegrees)) and Y :=
             Cy + Radius * Sin(DegToRad(AngleDegrees)). *)
//COS expects a real value, i.e. one of type double
//DegToRAd: Also dbl
var rTmp:real;
begin
   // Convert degrees to radians and calculate coordinates
  rTmp:=RSize * Cos(DegToRad(dblAngle));
  dblX:=round(rTmp);
  rTmp:=RSize * Sin(DegToRad(dblAngle));
  dblY:=round(rTmp);
  //(inttostr(dblX)+'  '+inttostr(dblY));
end;

procedure Tldn128orreryf1.Timer1Timer(Sender: TObject);
begin
  OrerryProc;
  (*scraps  Showamoebas;
  Moveamoebas;
  *)
  inc(wCycles);
  if wCycles>60000 then wCycles:=0;//Could add "cycles of cycles" counter, to
    //track overflows.... but want to keep this fast!
  laCycles.caption:=inttostr(wCycles);
end;

procedure Tldn128orreryf1.buQuitClick(Sender: TObject);
begin
  close;
end;

procedure Tldn128orreryf1.buGoClick(Sender: TObject);
//role of this confused
begin
//buGo.enabled:=false;
FillWorld;
//Showamoebas;
Timer1.enabled:=true;

end;//end Button1Click

(*
procedure Tldn128orreryf1.Showamoebas;
var wCountX,wCountY:word;
    clThisCol:TColor;
begin
for wCountX:=0 to kMaxPixelsIndex do begin //1.. for each column (One col per tail pixel)
 clThisCol:=clColColor[wCountX];
 for wCountY:=0 to kMaxAmIndex do begin //2.. plot that bit of each amoeba
  Image1.Picture.Bitmap.canvas.
      pixels[wWhereX[wCountX,wCountY],wWhereY[wCountX,wCountY]]:=
      clThisCol;
 end;//2
end;//1
end;//procedure Showamoebas
*)

procedure Tldn128orreryf1.FillWorld;
//To (re)populate world with amoebas
//See also FillConstants
var wCountX,wCountY:word;
    wXTmp,wYTmp:word;
begin
//This will fill wWhereX[x,y] with some amoebas, so they can
//  (elsewhere) be moved horizontally across the page,
//  from right to left....
for wCountY:=0 to kMaxAmIndex do begin //1.. for each amoeba
   //HERE the "Y" is the row in the table (of WHERE's) which
   //  stands for a particular amoeba.
   //Pick how far up or down screen that amoeba will be...
   //  Now we're on to "Y" as a graphics coordinate...
   wYTmp:=random(kMaxImageIndexY-4)+2;//Avoid top and bottom bands

   //Pick a start point for that amoeba's trail....
   wXTmp:=random(kMaxImageIndexX-kMaxPixelsIndex-10)+5;//Avoid
      //edge of display area, and leave room for whole
      //amoeba+trail together, not scolled around from right
      //to left... yet

   //I'm not sure this rem is correct! Code works okay!
   //Now fill in the positions of the part of each amoeba's
   //  that is closest to the amoeba, i.e. the current
   //  "head" of trail of the tail.
   for wCountX:=0 to kMaxPixelsIndex do begin //2.. plot that bit of each amoeba

     wWhereX[wCountX,wCountY]:=wXTmp+wCountX;
     wWhereY[wCountX,wCountY]:=wYTmp;

     end;//2
end;//1

bColPointerHead:=kMaxPixelsIndex;//At start, "head" of trail (the amoeba
  //itself) is in the pixel stored in the right hand (highest index)
  //element of the amoeba's row in the "Where" array.

end;//procedure FillWorld

procedure Tldn128orreryf1.FillConstants;
//See also FillWorld.
var wR,wG,wB:word;
    bTmp,bAddR,bAddB,bAddG:byte;
begin
//Set up color table.... "Head" at right, at start, "Head" color
//    goes in clColColor[kMaxPixelsIndex].
//    clColColor[0] should be set to background color.
//    And in between... use in-between colors!

(*
//---
//For a simple "whole line is green, no fading", use...
for bTmp:=0 to kMaxPixelsIndex do begin //1.. for each column
  clColColor[bTmp]:=clgreen;
  end;
clColColor[0]:=kBkGrndColor;
//end of simple "whole line green...
//---
*)


//--
//Crudely programmed, and needs tweaking if length of trail changed...
//   but is clear, and works quite well!
wR:=120;bAddR:=10;
wG:=120;bAddG:=10;
wB:=0;  bAddB:=10;

for bTmp:=kMaxPixelsIndex downto 1 do begin
  wR:=wR+bAddR;
  if wR>255 then wR:=255;

  wG:=wG+bAddG;
  if wG>255 then wG:=255;

  wB:=wB+bAddB;
  if wB>255 then wB:=255;

  clColColor[bTmp]:=RGBToColor(wR,wG,wB);

  end;

clColColor[0]:=kBkGrndColor;

//--
//"color swatch" to show the results of the above...
for bTmp:=1 to kMaxPixelsIndex do begin

  with Image1.Picture.Bitmap.canvas do begin
      pixels[10+bTmp,10]:=clColColor[bTmp];
      pixels[10+bTmp,11]:=clColColor[bTmp];
      pixels[10+bTmp,12]:=clColColor[bTmp];
      pixels[10+bTmp,13]:=clColColor[bTmp];
      pixels[10+bTmp,14]:=clColColor[bTmp];
      pixels[10+bTmp,15]:=clColColor[bTmp];
      pixels[10+bTmp,16]:=clColColor[bTmp];
      pixels[10+bTmp,17]:=clColColor[bTmp];
      pixels[10+bTmp,18]:=clColColor[bTmp];
      end;//with

  end;


end;//FillConstants;

(*
procedure Tldn128orreryf1.Moveamoebas;
//"Moves" amoebas by altering contents of the two
//"Where" arrays. Doesn't actually "move" them, but
//   changes data in array which says where amoeba,
//   and its tail, and the most recently vacated
//   pixel are.
var bTmp,bColPointerHeadWillBe:byte;
    clTmp:TColor;
    wCountY,wTmp,wTmp2:word;

begin //Main block of Moveamoebas

//Change color assignments
clTmp:=clColColor[kMaxPixelsIndex];
for bTmp:=kMaxPixelsIndex downto 1 do begin
 clColColor[bTmp]:=clColColor[bTmp-1];
 end;
clColColor[0]:=clTmp;

//=============
//Overwrite old "last bit of tail" with new "head" coords...
//
//First: Make note of where head coords to go...
bColPointerHeadWillBe:=bColPointerHead+1;//Note: you can't just use inc here
if bColPointerHeadWillBe>kMaxPixelsIndex then bColPointerHeadWillBe:=0;

//----------
//For each amoeba... put new head coords into WhereX, WhereY
//WHICH column of the table currently holds the HEAD's coords
//   changes (cyclically).

for wCountY:=0 to kMaxAmIndex do begin

   //Take a value from "WhereX" table...
   wTmp:=wWhereX[bColPointerHead,wCountY];//Previous
      //x-coord of of "head" pixel
   wTmp:=wTmp+1;//Calc x-coord of new head pixel
   if wTmp>kMaxImageIndexX then wTmp:=0;

   //Repeat for "WhereY"...
   wTmp2:=wWhereY[bColPointerHead,wCountY]; //Not actually necessary, of all
       //movement is only in X direction.

   //Now that the X and Y for the new head is known, store the data
   //   over the top of previous "end of tail"...
   wWhereX[bColPointerHeadWillBe,wCountY]:=wTmp;//Store posn of new head pixel
   wWhereY[bColPointerHeadWillBe,wCountY]:=wTmp2;//See prev comment about wTmp2

end;// of "for CountY..."
//end of overwriting old "last bit of tail" coords with new "head" coords

//---
//Finally, change column designated as holding head's coords
//  by changing value in bColPointerHead
bColPointerHead:=bColPointerHeadWillBe;

end;//Moveamoebas
*)

procedure Tldn128orreryf1.CircleFilled(xCF,yCF,RSizeCF:longint;clFillCF:TColor);
var RadiusDiv2:longint;
begin
RadiusDiv2:=RSizeCF div 2;
with Image1.canvas do begin
  Pen.Color:= clFillCF;
  Brush.Color := clFillCF;

  (*For debugging....
  MoveTo(50, 200);  LineTo(350, 200); //horiz line at y=200- from TOP
  MoveTo(200, 50); LineTo(200, 350);  //vert line at x=200
  *)

  Ellipse(xCF-RadiusDiv2,yCF-RadiusDiv2,
             xCF+RadiusDiv2,yCF+RadiusDiv2);
end;//with
end;//CircleFilled

end.

