Unit Font;

Interface

Procedure Print_Char(Chr:Char);
{outputs character in Mode X}
Procedure Print_String(Str:String);
{outputs string in Mode X}

Procedure Scrl_Move;
{moves visible part of scroll to the left}
Procedure Scrl_Append;
{adds new data to Scrolly on right screen border}

Var Scrl_Y:Word;                {vertical position of Scrolly}

Const
  Scrl_Number1=4;
  {Number of strings in Scrl_Txt}
  Scrl_Txt:Array [1..Scrl_Number1] of String =
  {Just a demo text, that you can modify or add on to!}
  ('Hello, !!!this is a Demo-Scroller from the book   P C U N D E R G R O U N D'
  +'  by Abacus. While it is not exactly the most ambitious demo, ',
   'it only uses a minimum of CPU time. Even on slower computers you can  '
  +'easily use entirely different effects on the side, but the scroller requires only about ',
   '10 percent of the available CPU time on a 486-40 with turbo switched off. '
  +'Attention, Scrolly is now restarting ',' ---------------------------     ');


Implementation
Uses ModeXLib;
Const
  CharPos:Array[' '..'Z', 0..1] of Word=
  {Locations and widths of the individual characters,
   CPU addressed bytes}
   ((71,4),(0,0),(0,0),(0,0),(0,0),(0,0),
    (0,0),(0,0),(0,0),(0,0),(0,0),(0,0),
    (1906,3),(1909,3),(1912,3),(1915,4),      {,-./}
    (3600,5),(3605,3),(3608,5),(3613,5),      {0..3}
    (3618,5),(3623,5),(3628,5),(3633,5),      {4..7}
    (3638,5),(3643,5),(3648,3),(3651,3),      {8..;}
    (3654,5),(3659,5),(3664,5),(3669,4),      {<..?}
    (0,0),(0,5),(5,5),(10,5),(15,6),(21,5),    {@..E}
    (26,4),(30,7),(37,5),(42,3),(45,4),(49,5),{F..K}
    (54,4),(58,8),(66,5),(1840,7),(1847,5),    {L..P}
    (1852,7),(1859,5),(1864,4),(1868,4),      {Q..T}
    (1872,5),(1877,6),(1883,8),(1891,5),      {U..X}
    (1896,5),(1901,5));                        {YZ}

Var Cur_X,                      {current x }
    Cur_Y:Integer;              {and y location of the cursor}
    Scrl_Number,                {Number of active scroll string}
    Scrl_Pos,                   {Position within this string}
    Scrl_ChrPos:Word;           {Position within the character}

Procedure Print_Char(Chr:Char);
{Outputs a character on Mode X screen and moves the cursor 
 over one position}
Begin
  Chr:=UpCase(Chr);             {use only uppercase letters}
  If Chr in [' '..'Z'] Then Begin {is the character in the character set?, yes:}
    If 80- Cur_X <              {enough room ?}
    CharPos[Chr,1] Then Begin
      Cur_X:=0;                 {no, then next line, x at 0}
      Inc(Cur_Y,25);            {and y one space over}
    End;
  Copy_Block(Cur_Y*80+Cur_X, 48000+Charpos[Chr,0], CharPos[Chr,1], 22);
  {Copy character from Font-Position (from CharPos table) to cursor position
   (Cur_Y * 80 bytes per line + Cur_X) (Height 22 lines}
  Inc(Cur_X,CharPos[Chr,1]);    {Move cursor by character width}
  End;
End;

Procedure Print_String(Str:String);
{outputs a string to Mode X screen using
 Print_Char}
Var i:Word;
Begin
  For i:=1 to Length(Str) do    {send whole string to Print_Char}
    Print_Char(Str[i]);
End;

Procedure Scrl_Move;
{moves screen contents at position of  Scrolly one position to the left,
 that is, copy 79 bytes from x-position 1 to x-position 0}
Begin
  Copy_Block(Scrl_y*80, Scrl_Y*80 +1, 79,22);
End;

Procedure Scrl_Append;
Var Chr:Char;                   {current letter}
Begin
  Chr:=UpCase(Scrl_txt[Scrl_Number,Scrl_pos]);
                                {get letters, only upper case letters}
  If Chr in [' '..'Z'] Then Begin  {is the character in the character set ?, yes:}
    If CharPos[Chr,1] > 0 Then  {display only available characters}
      Copy_Block(Scrl_y*80+79, 48000+CharPos[Chr,0]+Scrl_ChrPos, 1, 22);
                                {then copy 1 column from the character set}
                                {to right screen border}
    Inc(Scrl_ChrPos);           {and next column within the character}
    If Scrl_ChrPos >= CharPos[Chr,1] Then Begin
      Inc(Scrl_Pos);            {when character is finished, next character}
      Scrl_ChrPos:=0;           {and column back to 0}
      If Scrl_Pos > Length(Scrl_Txt[Scrl_Number]) Then Begin
        Inc(Scrl_Number);       {when string is finished, next string}
        Scrl_Pos:=1;            {position back to 0}
        If Scrl_Number > Scrl_Number1 Then Begin
           Scrl_Number:=1;      {when text is finished, start all over again}
          Scrl_Pos:=1;
          Scrl_ChrPos:=0;
        End;
      End;
    End;
  End;
End;

Begin
  Cur_X:=0;                     {Cursor to upper left corner}
  Cur_Y:=0;

  Scrl_Y:=50;                   {Default value for y-position}
  Scrl_Number:=1;               {Start with String 1, Character 1, Column 0}
  Scrl_Pos:=1;
  Scrl_ChrPos:=0;
End.
