text animation on console

animText.pas

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
      copyCol(t,f);
      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.