program demos2;

{ add writecolour in too }

uses crt;

const
   SPEED_NUMBER = 14;

type
   speed_type = array[1..SPEED_NUMBER] of word;

const
   RETURN_KEY   = #13;
   SPACE        = #32;
   ESCAPE       = #27;
   DELETE_KEY   = #8;
   NULL         = #0;
   SKIP         = ' ';
   DEMO_NUMBER  = 13;

   c1 : integer = 9;
   c2 : integer = 12;

   speed : speed_type =
   (14,100,100,2000,10,100,500,500,1500,10,100,100,100,100);

{
   scroll_text    (1)
   colourtext     (2)
   scroll_colour  (3)
   leftTOright    (4,5)
   side_ways      (6)
   up_down        (7,8)
   end_intro      (9,10)
   single_display (11)
   bullet_intro   (12,13)
   display_ver3   (14)
}

   demo : array[1..DEMO_NUMBER] of string[14] =
   ('scroll_text','colours','colourtext','colourchar',
    'scroll_colour','leftToRight','side_ways',
    'two_colours','up_down','end_intro','single_display',
    'bullet_intro','display');


function return_column(len : integer): integer;

begin
   return_column := 40-(len div 2);
end;


procedure pause(var ch : char);

begin
   ch := readkey;
   if ch = #0 then
      ch := readkey;

   if ch = ESCAPE then
   begin
      textcolor(lightgray);
      clrscr;
      nosound;
      halt;
   end;
end;


procedure writexy(txt1 : string;
                   row : integer;
                colour : integer);

var   len    : integer;
      column : integer;

begin
   len := length(txt1);
   column := return_column(len);
   textcolor(colour);
   gotoxy(column,row);
   write(txt1);
end;


procedure writeto(txt1 : string;
                   x,y : byte;
                colour : byte);

begin
   textcolor(colour);
   gotoxy(x,y);
   write(txt1);
end;


procedure readto(var txt1 : string;
                      x,y : byte;
                  col,max : byte);

var
   count : byte;
   ch    : char;

begin
   txt1 := '';
   count := 1;
   repeat
      pause(ch);
      case ch of
         DELETE_KEY :
         if count > 1 then
         begin
            textcolor(black);
            write(DELETE_KEY,SKIP,DELETE_KEY);
            dec(count);
            delete(txt1,count,1);
         end;
         SPACE..#127,#156 :
         if count <= max then
         begin
            writeto(ch,x+count-1,y,col);
            inc(count);
            txt1 := txt1 + ch;
         end;
         ESCAPE :
         begin
            count := 1;
            gotoxy(x,y);
            clreol;
            txt1 := '';
         end;
      end;
   until ch = RETURN_KEY;
end;


procedure clear;

begin
   textcolor(black);
   clrscr;
end;


function rnd_limits(min,max : integer) : integer;

var
   rnd : integer;

begin
   repeat
      rnd := random(max+1);
   until rnd >= min;
   rnd_limits := rnd;
end;


procedure centre_line(txt1 : string;
            var len,column : integer);

begin
   len := length(txt1);
   column := (80 - len + 1) div 2;
end;


procedure enter_details(var txt : string;
                     var speedno : byte);

var
   tmpstr : string;
   error  : integer;

begin
   clear;
   writexy('Press RETURN for default text',16,11);
   writeto('Please type in a sentence  : ',20,12,9);
   readto(txt,49,12,11,14);

   clear;
   writexy('3 for Normal...5 for fastest',16,11);
   writexy('Press RETURN for default',17,11);
   repeat
      writeto('  ',41,12,0);
      writeto('Enter speed (1-5) : ',20,12,9);
      readto(tmpstr,41,12,11,2);

      if tmpstr = '' then {default speed}
          tmpstr := '3';
      val(tmpstr,speedno,error);
   until speedno in [1..5];
end;


procedure colourchar(txt : string;
                     row : integer);

var  len,rnd  : integer;
     column,i : integer;
     ch       : char;

begin
   len := length(txt);
   column := return_column(len);
   gotoxy(column,row);

   for i := 1 to len do
   begin
      rnd := rnd_limits(1,15);
      textcolor(rnd);
      write(txt[i]);
   end;
   pause(ch);
end;


procedure side_ways(title : string;
                    row   : integer);

var  moving    : integer;
     direction : boolean;
     x1,x2,tmp : integer;
     exit      : boolean;
     ch        : char;

begin
   clear;
   tmp := 40-(length(title) div 2);
   x1  := tmp-5;
   x2  := tmp+5;
   direction := true;
   exit := false;
   moving := x1;
   repeat
      window(1,row,79,row);
      clear;
      window(1,1,80,25);

      gotoxy(moving,row);
      textcolor(4);
      write(title);

      delay(speed[6]);

      if direction then
         inc(moving,1)
      else
         dec(moving,1);

      if (moving = x2) and (direction) then
         direction := false;
      if (moving = x1) and (not direction) then
         direction := true;

      if keypressed then
      begin
         pause(ch);
         if ch = RETURN_KEY then
            ch := #0;
         exit := true;
      end;
   until exit;
   clear;
end;


procedure two_colours(menu_items : string;
                      row        : integer);

var  len,i  : integer;
     column : integer;
     ch     : char;

begin
   len := length(menu_items);
   column := return_column(len);
   textcolor(6);
   gotoxy(column,row);

   for i := 1 to len div 2 do
      write(menu_items[i]);

   textcolor(4);
   for i := (len div 2)+1 to len do
      write(menu_items[i]);

   pause(ch);
   clear;
end;


procedure up_down(sentence : string;
                       row : integer);

var  x,y    : integer;
     len    : integer;
     letter : integer;

begin
   clear;
   len := length(sentence);
   x := return_column(len);
   y := row;
   repeat
      writexy(sentence,y,6);    { shows the whole sentence }

      letter := random(len)+1;  { picks a random letter }

      textcolor(black);
      gotoxy(x+letter-1,y);     { clears the letter }
      write(SKIP);

      textcolor(4);
      gotoxy(x+letter-1,y-1);   { moves the letter up }
      write(sentence[letter]);

      delay(speed[7]);

      textcolor(black);
      gotoxy(x+letter-1,y-1);   { then clears the letter }
      write(SKIP);

      delay(speed[8]);
   until keypressed;
end;


procedure leftTOright(txt : string;
                      row : integer);

var
   x,y   : integer;
   count : integer;
   len   : integer;

begin
   clear;
   len := length(txt);
   x := 1; y:= row;
   count := 0;
   while txt <> '' do
   begin
      gotoxy(x,y);
      textcolor(cyan);
      write(txt);

      if x = 40-(len div 2) then
         delay(speed[4]);

      if x >= 80-len then
      begin
         delete(txt,len-count,1);
         inc(count,1);
      end;

      delay(speed[5]);

      textcolor(black);
      gotoxy(x,y);
      write(SKIP:len);

      inc(x,1);
   end;
end;


procedure end_intro(txt : string;
                    row : integer);

var
   len,pos : integer;
   column  : integer;
   i,m,y   : integer;

begin
   centre_line(txt,len,column);
   pos := len;
   for i := 1 to len do
   begin
      gotoxy(column,row);
      textcolor(c2);
      write(txt);
      if i = 1 then
      begin
         textcolor(black);
         gotoxy(1,25);
         delay(speed[9]);
      end;
      delete(txt,pos,1);
      dec(pos,1);
      y := pos+column;
      for m := pos+column to 80 do
      begin
         gotoxy(y,row);
         textcolor(c1);
         write('-');
         gotoxy(1,25);
         delay(speed[10]);
         gotoxy(y,row);
         write(SKIP);
         inc(y,1);
      end;
   end;
end;


procedure scroll_colour(txt : string;
                        row : integer);

var
   count,len : integer;
   column,i  : integer;
   m         : integer;
   ch        : char;

begin
   clear;
   centre_line(txt,len,column);
   count := column;
   for i := 1 to len do
   begin
      gotoxy(column,row);
      textcolor(c2);
      write(txt);
      gotoxy(count,row);
      textcolor(c1);
      write(txt[i]);
      for m := 1 to speed[3] div 10 do
      begin
         gotoxy(1,25);
         textcolor(black);
         delay(10);
         if keypressed then
         begin
            pause(ch);
            exit;
         end;
      end;
      inc(count,1);
   end;
   clear;
end;


procedure colourtext(txt : string;
                     row : integer);
var
   ok : boolean;
   ch : char;

begin
   repeat
      writexy(txt,row,rnd_limits(1,15));
      delay(speed[2]);
      if keypressed then
      begin
         pause(ch);
         ok := true;
      end;
   until ok;
end;


procedure single_display(txt : string;
                         row : integer);

var
   len,column  : integer;
   count,char1 : integer;
   ok          : boolean;
   ch          : char;

begin
   while keypressed do pause(ch);
   while keypressed do pause(ch);

   char1 := 1;
   ok := false;
   centre_line(txt,len,column);
   count := column;
   repeat
      gotoxy(column,row);
      textcolor(c2);
      write(txt);
      gotoxy(count,12);
      textcolor(c1);
      write(txt[char1]);
      gotoxy(1,25);
      textcolor(black);
      delay(speed[11]);

      if column+len-1 = count then
         ok := true
      else
      if count = column then
         ok := false;

      if ok then
      begin
         dec(count,1);
         dec(char1,1);
      end else
      begin
         inc(count,1);
         inc(char1,1);
      end;
   until keypressed;

   while keypressed do pause(ch);
   while keypressed do pause(ch);
end;


procedure bullet_intro(txt : string;
                       row : integer);

var len,i  : integer;
    column : integer;

begin
   textcolor(12);
   clrscr;
   len := length(txt);
   column := 40 - (len div 2);
   gotoxy(column,row);
   textcolor(9);
   for i := 1 to len do
   begin
      write(txt[i]);
      delay(speed[12]);
      sound(220);
      delay(speed[13]);
      nosound;
   end;
end;


procedure display_ver3(name : string);

var
   x,y,col : byte;
   count   : integer;
   change  : boolean;

begin
   clear;

   count := 0;
   change := false;
   repeat
      inc(count,1);
      case count of
         500  : change := not(change);
         1000 :
         begin
            change := not(change);
            count := 0;
         end;
      end;

      if change then
         col := rnd_limits(8,15)
      else
         col := rnd_limits(1,7);

      x := rnd_limits(1,80-length(name));
      y := rnd_limits(1,25);

      gotoxy(x,y);
      textcolor(col);
      write(name);

      delay(speed[14]);
   until keypressed;
end;


procedure scroll_text(txt : string;
                      row : integer);

var
   x,y,len,i : integer;
   start,fin : integer;
   ok        : boolean;
   ch        : char;

begin
   clear;
   len := length(txt);
   start := 1; fin := 1;
   x := 80; y := row;
   ok := false;

   repeat
      delline;

      textcolor(9);
      gotoxy(x,y);
      for i := start to fin do
         write(txt[i]);

      textcolor(black);
      gotoxy(1,25);

      delay(speed[1]); { try 7 }
      dec(x,1);

      if keypressed then
      begin
         pause(ch);
         ok := true;
      end;

      if x > 1 then
      begin
         inc(fin,1);
         if fin = len then
            fin := len;
      end else
      if x < 1 then
      begin
         inc(start,1);
         x := 1;
      end;

      if start = len+2 then
      begin
         start := 1; fin := 1;
         x := 80;
      end;
   until ok;
   clear;
   demo[1] := ' ';
end;


procedure colours(name : string;
                   row : integer);

var
   column : integer;
   i,len  : integer;
   ch     : char;

begin
   clear;
   centre_line(name,len,column);
   gotoxy(column,row);
   for i := 1 to len do
   begin
      if odd(i) then
         textcolor(c1)
      else
         textcolor(c2);
      write(name[i]);
   end;
   pause(ch);
end;


procedure select_speed(speedno : byte;
                        Tspeed : speed_type);

var
   i   : byte;
   tmp : byte;

begin
   for i := 1 to SPEED_NUMBER do {restores speed}
      speed[i] := Tspeed[i];

   case speedno of {swaps the slow speed numbers}
      1 : tmp := 3; {slowest speed}
      2 : tmp := 2;
      3 : tmp := 1; {normal speed}
   end;

   for i := 1 to SPEED_NUMBER do
      if speedno > 3 then
         speed[i] := speed[i] div (speedno-2) {faster}
      else
         speed[i] := speed[i] * tmp; {slower}
end;


var
   txt     : string;
   i       : byte;
   speedno : byte;
   ch      : char;
   Tspeed  : speed_type;

begin
   textmode(80);
   randomize;

   for i := 1 to SPEED_NUMBER do {stores speed numbers}
      Tspeed[i] := speed[i];

   repeat
      while keypressed do pause(ch);
      while keypressed do pause(ch);

      clear;

      writexy('Press any key to start',12,7);
      writexy('Or press Escape to exit',13,8);

      pause(ch);

      enter_details(txt,speedno);
      select_speed(speedno,Tspeed);

      if txt <> '' then
         for i := 1 to DEMO_NUMBER do
            demo[i] := txt;

{      scroll_text (demo[1],12);}
      colours (demo[2],12);
      colourtext (demo[3],12);
      colourchar (demo[4],12);
      scroll_colour (demo[5],12);
      leftToRight (demo[6],12);
      side_ways (demo[7],12);
      two_colours (demo[8],12);
      up_down (demo[9],12);
      end_intro (demo[10],12);
      single_display (demo[11],12);
      bullet_intro (demo[12],12);
      display_ver3 (demo[13]);
   until ch = Escape;

   textcolor(lightgray);
   clrscr;
end.