tranleduy2000 / pascalnide

Pascal Compiler for Android
92 stars 25 forks source link

[CRT unit] Failed to render text animation #10

Closed pakLebah closed 7 years ago

pakLebah commented 7 years ago

I got this from my old Pascal codes collection. It's a text animation on console, kinda simple particle on text. It works fine on console using Free Pascal. I just tested it on Linux and Mac terminal. But when I ported it to Pascal N-IDE, the console failed to render the animation correctly. The rendering is so slow that the animation lags and sluggish.

Here's the code:

program animateText;

{ ----------
  Text animation on console
  by: Mr Bee -- @pak_lebah
}

uses CRT;

const
  // global value setup
  THE_TEXT = 'THIS IS PASCAL';
  V_MOTION = 1;   // motion speed
  D_MOTION = 16;  // motion delay

type
  // letter structure
  TLetter = record
    l  : string;  // character
    x,y: integer; // position
    c  : integer; // color
  end;
  TLetters = array of TLetter;

var
  goSpread: boolean; // motion direction
  goStraight: boolean; // animation mode
  doneX,doneY,done: boolean; // anim state

// spread letters all over the screen
procedure spread(var l: TLetters);
var
  i: integer;
begin
  for i := 0 to high(l) do
  begin
    // random all over the screen
    l[i].x := random(ScreenWidth)+1;
    l[i].y := random(ScreenHeight)+1;
    l[i].c := random(7)+9; // bright colors
  end;
end;

// gather all letters into a text
procedure gather(var l: TLetters);
var
  tx,ty: integer;
  i: integer;
  s: string;
begin
  // compute text position
  s := '';
  for i := 0 to high(l) do s += l[i].l;
  tx := random(ScreenWidth-length(s))+1;
  ty := random(ScreenHeight-1)+1;
  // align text onto new position
  for i := 0 to high(l) do
  begin
    l[i].x := tx + i;
    l[i].y := ty;  // horz aligned
    l[i].c := random(7)+9;
  end;
end;

// animate on x position
procedure animX(var f,t: TLetters);
var
  i,v: integer;
begin
  v := V_MOTION;
  doneX := true;
  for i := 0 to high(f) do
  begin
    // move left
    if f[i].x > t[i].x then
    begin
      f[i].x := f[i].x - v;
      if f[i].x < t[i].x then 
        f[i].x := t[i].x;
    end
    // move right
    else if f[i].x < t[i].x then
    begin
      f[i].x := f[i].x + v;
      if f[i].x > t[i].x then
        f[i].x := t[i].x
    end
    else
      f[i].x := t[i].x;
    // save state
    doneX := doneX and (f[i].x = t[i].x);
  end;
end;

// animate on y position
procedure animY(var f,t: TLetters);
var
  i,v: integer;
begin
  v := V_MOTION;
  doneY := true;
  for i := 0 to high(f) do
  begin
    // move up
    if f[i].y > t[i].y then
    begin
      f[i].y := f[i].y - v;
      if f[i].y < t[i].y then 
        f[i].y := t[i].y;
    end
    // move down
    else if f[i].y < t[i].y then
    begin
      f[i].y := f[i].y + v;
      if f[i].y > t[i].y then
        f[i].y := t[i].y
    end
    else
      f[i].y := t[i].y;
    // save state
    doneY := doneY and (f[i].y = t[i].y);
  end;
end;

// animate text
procedure animate(var f,t: TLetters);
begin
  if goStraight then
  begin
    if not doneX then animX(f,t);
    if not doneY then animY(f,t);
  end else
  begin
    if goSpread then
    begin
      // go vertical first
      if not doneY then 
        animY(f,t)
      else begin
        if not doneX then
          animX(f,t);
      end;
    end else
    begin
      // go horizontal first
      if not doneX then 
        animX(f,t)
      else begin
        if not doneY then
          animY(f,t);
      end;
    end;
  end;
  // state
  done := doneX and doneY;
end;

// print letters on the screen
procedure print(l: TLetters);
var
  i: integer;
begin
  for i := 0 to high(l) do
  begin
    textColor(l[i].c);
    gotoXY(l[i].x,l[i].y);
    write(l[i].l);
  end;
end;

// convert regular text to animated letters
function toLetters(s: string): TLetters;
var
  i: integer;
  l: TLetters;
begin
  setLength(l,length(s));
  for i := 0 to length(s)-1 do
  begin
    l[i].l := s[i+1];
    l[i].x := i+1; 
    l[i].y := 1;
    l[i].c := random(7)+9;
  end;
  toLetters := l;
end;

// remove text footprint
procedure untrace(f,t: TLetters);
var
  i: integer;
begin
  for i := 0 to high(f) do
  begin
    // cover last trace
    textColor(0);
    gotoXY(f[i].x,f[i].y);
    write(f[i].l);
    // show destination
    textColor(8);
    gotoXY(t[i].x,t[i].y);
    write(t[i].l); 
  end;
end;

// copy letter colors
procedure copyCol(var f,t: TLetters);
var
  i: integer;
begin
  for i := 0 to high(f) do
    t[i].c := f[i].c;
end;

// screen setup 
procedure openScreen;
begin
  randomize;
  clrscr;
end;

// screen closing
procedure closeScreen;
begin
  textColor(15);
  clrscr;
end;

{+++ MAIN PROGRAM +++}

var
  f,t: TLetters;
  c: char = #0;
begin
  // setup
  openScreen;
  goSpread := true;
  goStraight := true;
  f := toLetters(THE_TEXT);
  t := toLetters(THE_TEXT);  
  gather(f); // from (origin)
  spread(t); // to (target)

  // animate
  repeat
    print(f);
    delay(D_MOTION);
    untrace(f,t);
    animate(f,t);

    // check done
    if done then
    begin
      print(f);

      // switch destination 
      //f := copy(t,0,length(t)); // NOT WORKING!
      copyCol(t,f);  // this is a workaround
      goSpread := not goSpread;
      if goSpread then spread(t)
        else gather(t);

      // freeze for 1 second
      delay(1000);

      // reset state
      doneX := false;
      doneY := false;
      done  := false;
    end;

    // switch mode
    if keyPressed then
    begin
      c := readKey;
      if c = #32 then // on 'space'
        goStraight := not goStraight;
    end;

  // until 'enter' or 'esc'
  until (c = #13) or (c = #27);

  // close down
  closeScreen;
end.

Here's how it supposes to work… licecap record at 1329 as recorded on my Mac terminal just now.

tranleduy2000 commented 7 years ago

This code working perfected in v4.0.1

tranleduy2000 commented 7 years ago

Fixed in v4.0.3