home *** CD-ROM | disk | FTP | other *** search
/ PC Underground / UNDERGROUND.ISO / graphic / font.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-02  |  5KB  |  126 lines
  1. Unit Font;
  2.  
  3. Interface
  4.  
  5. Procedure Print_Char(Chr:Char);
  6. {outputs character in Mode X}
  7. Procedure Print_String(Str:String);
  8. {outputs string in Mode X}
  9.  
  10. Procedure Scrl_Move;
  11. {moves visible part of scroll to the left}
  12. Procedure Scrl_Append;
  13. {adds new data to Scrolly on right screen border}
  14.  
  15. Var Scrl_Y:Word;                {vertical position of Scrolly}
  16.  
  17. Const
  18.   Scrl_Number1=4;
  19.   {Number of strings in Scrl_Txt}
  20.   Scrl_Txt:Array [1..Scrl_Number1] of String =
  21.   {Just a demo text, that you can modify or add on to!}
  22.   ('Hello, !!!this is a Demo-Scroller from the book   P C U N D E R G R O U N D'
  23.   +'  by Abacus. While it is not exactly the most ambitious demo, ',
  24.    'it only uses a minimum of CPU time. Even on slower computers you can  '
  25.   +'easily use entirely different effects on the side, but the scroller requires only about ',
  26.    '10 percent of the available CPU time on a 486-40 with turbo switched off. '
  27.   +'Attention, Scrolly is now restarting ',' ---------------------------     ');
  28.  
  29.  
  30. Implementation
  31. Uses ModeXLib;
  32. Const
  33.   CharPos:Array[' '..'Z', 0..1] of Word=
  34.   {Locations and widths of the individual characters,
  35.    CPU addressed bytes}
  36.    ((71,4),(0,0),(0,0),(0,0),(0,0),(0,0),
  37.     (0,0),(0,0),(0,0),(0,0),(0,0),(0,0),
  38.     (1906,3),(1909,3),(1912,3),(1915,4),      {,-./}
  39.     (3600,5),(3605,3),(3608,5),(3613,5),      {0..3}
  40.     (3618,5),(3623,5),(3628,5),(3633,5),      {4..7}
  41.     (3638,5),(3643,5),(3648,3),(3651,3),      {8..;}
  42.     (3654,5),(3659,5),(3664,5),(3669,4),      {<..?}
  43.     (0,0),(0,5),(5,5),(10,5),(15,6),(21,5),    {@..E}
  44.     (26,4),(30,7),(37,5),(42,3),(45,4),(49,5),{F..K}
  45.     (54,4),(58,8),(66,5),(1840,7),(1847,5),    {L..P}
  46.     (1852,7),(1859,5),(1864,4),(1868,4),      {Q..T}
  47.     (1872,5),(1877,6),(1883,8),(1891,5),      {U..X}
  48.     (1896,5),(1901,5));                        {YZ}
  49.  
  50. Var Cur_X,                      {current x }
  51.     Cur_Y:Integer;              {and y location of the cursor}
  52.     Scrl_Number,                {Number of active scroll string}
  53.     Scrl_Pos,                   {Position within this string}
  54.     Scrl_ChrPos:Word;           {Position within the character}
  55.  
  56. Procedure Print_Char(Chr:Char);
  57. {Outputs a character on Mode X screen and moves the cursor 
  58.  over one position}
  59. Begin
  60.   Chr:=UpCase(Chr);             {use only uppercase letters}
  61.   If Chr in [' '..'Z'] Then Begin {is the character in the character set?, yes:}
  62.     If 80- Cur_X <              {enough room ?}
  63.     CharPos[Chr,1] Then Begin
  64.       Cur_X:=0;                 {no, then next line, x at 0}
  65.       Inc(Cur_Y,25);            {and y one space over}
  66.     End;
  67.   Copy_Block(Cur_Y*80+Cur_X, 48000+Charpos[Chr,0], CharPos[Chr,1], 22);
  68.   {Copy character from Font-Position (from CharPos table) to cursor position
  69.    (Cur_Y * 80 bytes per line + Cur_X) (Height 22 lines}
  70.   Inc(Cur_X,CharPos[Chr,1]);    {Move cursor by character width}
  71.   End;
  72. End;
  73.  
  74. Procedure Print_String(Str:String);
  75. {outputs a string to Mode X screen using
  76.  Print_Char}
  77. Var i:Word;
  78. Begin
  79.   For i:=1 to Length(Str) do    {send whole string to Print_Char}
  80.     Print_Char(Str[i]);
  81. End;
  82.  
  83. Procedure Scrl_Move;
  84. {moves screen contents at position of  Scrolly one position to the left,
  85.  that is, copy 79 bytes from x-position 1 to x-position 0}
  86. Begin
  87.   Copy_Block(Scrl_y*80, Scrl_Y*80 +1, 79,22);
  88. End;
  89.  
  90. Procedure Scrl_Append;
  91. Var Chr:Char;                   {current letter}
  92. Begin
  93.   Chr:=UpCase(Scrl_txt[Scrl_Number,Scrl_pos]);
  94.                                 {get letters, only upper case letters}
  95.   If Chr in [' '..'Z'] Then Begin  {is the character in the character set ?, yes:}
  96.     If CharPos[Chr,1] > 0 Then  {display only available characters}
  97.       Copy_Block(Scrl_y*80+79, 48000+CharPos[Chr,0]+Scrl_ChrPos, 1, 22);
  98.                                 {then copy 1 column from the character set}
  99.                                 {to right screen border}
  100.     Inc(Scrl_ChrPos);           {and next column within the character}
  101.     If Scrl_ChrPos >= CharPos[Chr,1] Then Begin
  102.       Inc(Scrl_Pos);            {when character is finished, next character}
  103.       Scrl_ChrPos:=0;           {and column back to 0}
  104.       If Scrl_Pos > Length(Scrl_Txt[Scrl_Number]) Then Begin
  105.         Inc(Scrl_Number);       {when string is finished, next string}
  106.         Scrl_Pos:=1;            {position back to 0}
  107.         If Scrl_Number > Scrl_Number1 Then Begin
  108.            Scrl_Number:=1;      {when text is finished, start all over again}
  109.           Scrl_Pos:=1;
  110.           Scrl_ChrPos:=0;
  111.         End;
  112.       End;
  113.     End;
  114.   End;
  115. End;
  116.  
  117. Begin
  118.   Cur_X:=0;                     {Cursor to upper left corner}
  119.   Cur_Y:=0;
  120.  
  121.   Scrl_Y:=50;                   {Default value for y-position}
  122.   Scrl_Number:=1;               {Start with String 1, Character 1, Column 0}
  123.   Scrl_Pos:=1;
  124.   Scrl_ChrPos:=0;
  125. End.
  126.