Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB13.ZIP/NOFLASH2.PAS

Pascal/Delphi Source File | 1986-02-06 | 13.5 KB | 361 lines

{This program was originally obtained from a bulletin board.  The original
author is unknown.  During the course of analyzing how various functions
were accomplished, a number of changes were made.  The most notable of
these are as follows:
1)  The shadow that follows the word LYNN down the screen.  This originally
    was the word TEST, but I decided it was more fun to see my name on the
    screen.  Programmer vanity I suppose.
2)  The routines associated with the "face".
3)  The addition of color.
4)  Various delays to slow the action.
5)  Extensive Documentation.
Note for Monochrome users:  Be sure to change the parameters noted.  It
       may be necessary to change the attribute bytes to a value of 15 (White)
       in order to see everything.

Being a novice at Turbo Pascal, some of the assumptions made in the
documentation are probably not technically correct.  If you find something
wrong or if you can tell me how the "port" array addresses are determined
or what the actual definition of the "^" in the update
procedure is, please let me know.  Hopefully this program and the
documentation will provide some insight into screen updating.
Lynn Canning, 9107 Grandview, Overland Park, Ks. 66212 }

{$u-}   {Turn off CNTL C interupts}
{$c-}   {Turn off CNTL C & S}
{$u-}   {I don't know why there are two sets of these.  See Appendix}
{$c-}   { E, Version 2.0 of the Turbo Pascal Reference Manual}
{$x+}   {Maximize array generation}
{$k-}   {Turn off stack checking}
const
  time_array : array[1..7] of array[1..50] of char =

    ('~~~          ~~      ~~   ~~      ~~   ~~      ~~ ',
     '~~~           ~~    ~~    ~~~     ~~   ~~~     ~~ ',
     '~~~            ~~ ~~      ~~ ~~   ~~   ~~ ~~   ~~ ',
     '~~~             ~~        ~~  ~~  ~~   ~~  ~~  ~~ ',
     '~~~             ~~        ~~   ~~ ~~   ~~   ~~ ~~ ',
     '~~~~~~~~~~~     ~~        ~~     ~~~   ~~     ~~~ ',
     '~~~~~~~~~~~     ~~        ~~      ~~   ~~      ~~ ');

type
  char_cell   = record
                  code : char;
                  attr : byte;
                  end;

  screen_type = array[1..25] of array[1..80] of char_cell;

var
  ch          : char;
  i,j,k,l,m,n : byte;
  screen      : screen_type;
  real_screen : ^screen_type;
  mode        : integer;

{The lines above define the arrays used.  The "^" in ^screen_type
 defines the array real_screen as actual screen memory.  Screen is
 the array used as a work area and is the RAM or virtual screen.
 When everything is defined as desired, the changed portions are
 moved to screen memory via the port array.
 Note the record definition.  The value of "code" is the actual value
 to be shown.  The value of "attr" may have additional purposes, but
 is used to define the color of "code".  If this is not populated for
 a particular coordinate, nothing will show on the screen even if the
 "code" is populated.}

{Procedure "Update" moves the data from the screen work array to
 screen memory.  You can change things as much as you want in the
 work array, but if you don't move it to screen memory, by
 executing "Update" nothing changes on the screen.
 As previously stated, I don't understand how the port array
 addresses are determined or exactly how the value "^" defines
 the actual screen memory.  Since mode is set to "2" for a color
 monitor, apparently the data must be sent to the screen port for
 display.  Direct updating to the screen apparently can be done with
 a monochrome monitor.  The value of "y" identifies which screen line
 to begin moving, while the value of "lines" identifies the number
 of lines to move.  If you want to update lines 17,18 & 19, y would
 be set at 17 and lines would be set at 3.  Note that both the "code"
 and "attr" values must be moved to the 80 character display screen,
 hence the value of 160 in the move statement.}

procedure update_screen(y,lines : byte);

  begin
  if mode <> 1 then
    repeat until (port[$3da] and 8) = 8;
  if mode <> 1 then
    port[$3d8] := 1;
  move(screen[y],real_screen^[y],lines * 160);
  if mode <> 1 then
    port[$3d8] := 9;
  end;

{Procedure "Read" is the opposite of "Update".  It reads from the screen
 memory array into the work array.  I can't see that it actually does anything
 in this program.}

procedure read_screen(y,lines : byte);

  begin
  if mode <> 1 then
    repeat until (port[$3da] and 8) = 8;
  if mode <> 1 then
    port[$3d8] := 1;
  move(real_screen^[y],screen[y],lines * 160);
  if mode <> 1 then
    port[$3d8] := 9;
  end;

{Procedure "March" defines and moves "This is not a test" down the
 left and right side of the screen.  How this is accomplished can be
 more easily understood by noting how the face moves in the "face"
 routines.  "March" contains the embedded procedures "Position" &
 "Print".}

procedure march;

const first_half  : string[18] = 'n si sihT         ';
      second_half : string[18] = 'ot a test         ';

var i,j : byte;
    ch  : char;


procedure position(i : integer;
                   var x,y : byte);
begin
  if i <= 16                   {                                       }
  then begin                   {Defines x & y for marching down left & }
         x := 1;               {right of screen                        }
         y := i;               {                                       }
       end
  else begin
         x := i - 16;          {Defines x & y for marching across      }
         y := 17;              {line 17                                }
       end;
end;

procedure print(num : byte);
var x,y,
    j,k,l : byte;
    i     : integer;
begin
  j := 0;
  for i := num downto num - 17 do
    if i > 0
    then begin
           j := j + 1;
           position(i,x,y);
           screen[y,x].code := first_half[j];
           screen[y,81 - x].code := second_half[j];
           if y < 16 then
             k := y
           else
             k := k + 1;
           if k = 16 then
             k := 1;
           l := k - 1;
           if l = 0 then
             l := 1;
           if (k = 1) and (mode = 1) then
             k := 2;
           if (k = 9) and (mode = 1) then
             k := 10;
           screen[y,x].attr := k;
           screen[y,81 - x].attr := l;
         end;

  if y < 17 then
    begin
    update_screen(1,8);
    update_screen(8,8);
    update_screen(16,8);
delay(100);
    end
  else
    update_screen(y,1);
end;

begin
  for i := 1 to 56 do            {BEGIN for procedure march}
    print(i);
  delay(500);
end;


begin

  ClrScr;
  real_screen := ptr($b800,0);   {change to $b800 for color, $b000 for mono}
  fillchar(screen,4000,0);       {initializes the screen work array to 0}
  mode := 2;                     {change to 2 for color, 1 for mono}

  for i := 1 to 50 do                      {Display initial banner}
    for j := 1 to 7 do
      begin
      screen[j,i].code := time_array[j,i];
      screen[j,i].attr := j;            {set color for banner}
      end;

  update_screen(1,8);

  for i := 1 to 8 do          {This routine moves the banner down the }
    begin                     {screen one line at a time.             }
    for j := 7 downto 0 do    {                                       }
      begin
      move(screen[j + i],screen[j + i + 1],120);
{     fillchar(screen[j + i],120,0);}{removal of this line allowed the}
      end;                           {shadow to remain on the screen}
    update_screen(i,8);
    delay(25);
    end;

 for i := 1 to 8 do begin      {                                       }
   fillchar(screen[i],120,0);  {This routine was inserted in place of  }
   update_screen(i,8);         {the fillchar line above.  It removes   }
   delay(25);                  {the shadow left on the screen.         }
   end;                        {The fillchar command is used to overlay}
  delay(500);                  {residual data left from a previous move}

{Tilting, Untilting and Centering the banner is accomplished by moving
 the line left or right a certain number of characters.  This will cause
 screen wrap.  If you increase the length of the banner, the screen wrap
 may in fact overlay some of the banner.  The way around this would be to
 move only the actual number of characters involved thus eliminating the
 wrapping problem.  Evidence of the wrap can be seen by changing the zero
 in the fillchar statement to another character, say 1.}

  for i := 9 downto 1 do                       {Tilt banner}
    begin
    move(screen[i + 8,1],screen[i + 8,11 - i],120);
    fillchar(screen[i + 8,1],19 - (2 * i),0);
    end;

  update_screen(8,8);
  delay(250);

  for k := 1 to 14 do                      {Center banner}
    begin
    for j := 9 to 17 do
      move(screen[j,k],screen[j,k + 1],120);
    update_screen(8,8);
    end;

  for i := 9 downto 1 do                       {UnTilt banner}
    move(screen[i + 8,11 - i],screen[i + 8,1],160);
  update_screen(8,8);

  march;                                  {Bring in the rest of the title}

{---------------------------------------------------------------------------}
{                           FACE Routines}
fillchar(screen[1,1],1,2);                   {define face at coord 1,1}
update_screen(1,1);
for k := 1 to 15 do     {move face down left of screen to line 16}
    begin
     move(screen[k,1],screen[k + 1,1],1);    {move face down one line}
     screen[k + 1,1].attr := 6;              {set face color to brown}
     fillchar(screen[k,1],1,0);              {fill in behind face}
     update_screen(1,8);
     update_screen(8,8);                     {display current face position}
     update_screen(16,8);                    {on screen}
     delay(100);
     end;
for k := 1 to 39 do      {move face across line 16 to col 40}
    begin
     move(screen[16,k],screen[16,k + 1],1); {move face right one column}
     screen[16,k + 1].attr := 6;            {set face color to brown}
     fillchar(screen[16,k],1,0);            {fill in behind face}
     update_screen(16,1);        {display current face position of screen}
     end;
for k := 40 to 42 do            {kick "not" down to line 18}
  begin
  move(screen[17,k],screen[18,k],1);      {move letter at pos k to line 18}
  screen[18,k].attr := screen[17,k].attr; {maintain same color}
  move(screen[16,k],screen[17,k],1);      {duplicate face in line 17}
  update_screen(16,3);                    {update lines 16-18}
  fillchar(screen[17,k],1,0);             {blank out face in line 17}
  update_screen(17,1);                    {update line 17}
  delay(200);
  move(screen[16,k],screen[16,k + 1],1);  {move face 1 position to right}
  screen[16,k + 1].attr := 6;             {maintain same face color}
  fillchar(screen[16,k],1,0);             {blank out previous face}
  update_screen(16,1);                    {update line 16}
  end;                                    {continue until 3 letters kicked}
for k :=43 to 49 do             {move face to above end of line (pos 50)}
  begin
  move(screen[16,k],screen[16,k + 1],1);  {move face 1 position to right}
  screen[16,k + 1].attr := 6;             {maintain same face color}
  fillchar(screen[16,k],1,0);             {blank out previous face}
  update_screen(16,1);                    {update line 16}
  delay(100);
  end;
move(screen[16,50],screen[17,50],1);      {move face down 1}
screen[17,50].attr := 6;                  {maintain same face color}
fillchar(screen[16,50],1,0);              {blank out previous face}
update_screen(16,2);                      {update lines 16-17}

for k := 1 to 4 do     {move right half of line 4 positions left to }
 begin                 {eliminate spaces}
 for j := 44 to 50 do    {move 4 characters and face}
  begin
   screen[17,j - k] := screen[17,j - k + 1]; {move char 1 position left}
   screen[17,j - k].attr := screen[17,j - k +1].attr; {maintain color}
   fillchar(screen[17,j - k + 1],1,0);       {fill in behind face}
   end;
 update_screen(17,1);                     {update line 17}
 end;

screen[18,46] := screen[17,46];           {move face down 1}
screen[18,46].attr := screen[17,46].attr; {maintain color}
fillchar(screen[17,46],1,0);              {fill in behind face}
update_screen(17,2);                      {update lines 17-18}
delay(200);

for k :=46 downto 44 do             {move face to "not"}
  begin
  move(screen[18,k],screen[18,k - 1],1);  {move face 1 position left}
  screen[18,k - 1].attr := 6;             {maintain color}
  fillchar(screen[18,k],1,0);             {fill in behind face}
  delay(100);
  update_screen(18,1);                    {update line 18}
  end;

for k := 1 to 43 do       {move "not" off screen to left}
  begin
  for j := 1 to 44 do
  begin
  screen[18,j - k] := screen[18,j - k + 1];
  screen[18,j - k + 1].attr := screen[18,j - k].attr;
  end;
  update_screen(18,1);
  delay(100);
  end;

{End FACE Routines}
{--------------------------------------------------------------------------}
  textcolor(red);
  gotoxy(28,25);
  write('(Press Any Key To Continue)');
  read(kbd,ch);
  read_screen(1,25);

  for i := 8 downto 1 do                       {Tilt banner}
    begin
    move(screen[i+8,1],screen[i + 8,11 - i],160);
    fillchar(screen[i + 8,1],19 - (2 * i),0);
    end;

  update_screen(8,8);
  Delay(950);

  for k := 11 to 79 do                    {Remove banner}
    begin
    for j := 9 to 15 do
      move(screen[j,k],screen[j,k + 1],160 - k * 2);
    update_screen(8,8);
    end;

end.