{$C-}
program Big_Letters;
  (****************************************************)
  (* copyright 1985 by Neil J. Rubenking              *)
  (*    Requires TURBO Pascal 2.xx+                   *)
  (*        May require DOS 2.xx+                     *)
  (****************************************************)
  (*  This program gets at the ROM character graphics *)
  (*  table and uses the dot patterns stored there    *)
  (*  to create LARGE letters on the screen.  It works*)
  (*  for color or monochrome -- the character table  *)
  (*  is there whether or not a color monitor is in   *)
  (*  the system.                                     *)
  (****************************************************)

type
  ROMentry   = array[0..7] of byte;
  ROMtable   = array[0..127] of ROMentry;
              {----------------------------}
              {- Yes, just 0..127.  There -}
              {- is no pre-made graphics  -}
              {- table for the extended   -}
              {- ASCII character set.  You-}
              {- can CREATE such a table, -}
              {- but that is another story-}
              {----------------------------}
  title_type = string[10];

var
  table   : ROMtable absolute $F000:$FA6E;
  N       : byte;
  OddLine : title_type;
  C1, C2  : char;
  R, C    : byte;
  Show_Blocks : boolean;
const
  NoSHows : set of char = [#7,#8,#10,#13];
              {----------------------------}
              {-These characters cannot   -}
              {-be used as building blocks-}
              {-for the BIG characters    -}
              {-because TURBO will not    -}
              {-WRITE them.  If asked to  -}
              {-use one of these, instead -}
              {-the program will put in   -}
              {-the Default character     -}
              {-below. |                  -}
              {--------|-------------------}
  Default = #176;   {<--}

  (****************************************************)
  (*  The "GetKeys" function returns the pressed key  *)
  (*  in "Choice" and an ASCII 00 in "EscChoice" if   *)
  (*  an ordinary key is pressed.  If a special key   *)
  (*  (e.g., function key, arrow key) is pressed,     *)
  (*  "Choice" contains #27 (ESC) and "EscChoice" has *)
  (*  a code as listed in Appendix K of the TURBO 3.0 *)
  (*  manual.                                         *)
  (****************************************************)
  (*  NOTE:  The table in Appendix K contains quite   *)
  (*   a few return codes that simply DO NOT WORK --  *)
  (*   unless you have SuperKey installed.  Any key   *)
  (*   combination with a code > 132 will not return  *)
  (*   ANYTHING, unless SuperKey is running.          *)
  (****************************************************)

procedure GetKeys(var choice, EscChoice:char);
begin
  EscChoice := #0;
  repeat until Keypressed;
  read(Kbd,Choice);
  if choice = #27 then
    if keypressed then read(Kbd,EscChoice);
end;

  (****************************************************)
  (*  The characters are stored in the ROM table in   *)
  (*  8 bytes each -- the 8 bits of the 8 bytes form  *)
  (*  an 8 x 8 matrix.  The procedure ShowEntry below *)
  (*  translates this into 8 rows of 8 characters.  It*)
  (*  tests each bit from least significant to most   *)
  (*  by repeatedly shifting the byte one bit to the  *)
  (*  right -- the "odd" function is true if the right*)
  (*  most bit is 1.                                  *)
  (*     NOTE that we just use the standard "write"   *)
  (*  procedure to put the character CH in locations  *)
  (*  corresponding to bits that are set.  That means *)
  (*  that if CH is #7 (beep), #8 (backspace), #10    *)
  (*  (line feed), or #13 (carriage return), we have  *)
  (*  to substitute another character.                *)
  (****************************************************)

procedure ShowEntry(entry : ROMentry;
                 col, row : byte;
                       CH : char);
var
  eRow, eCol  : 0..7;
  AByte       : byte;
begin
  for eRow := 0 to 7 do
    begin
      AByte := entry[eRow];
      for eCol := 7 downto 0 do
        begin
          if odd(AByte) then
            begin
              gotoXY(col + eCol, row + eRow);
              {----------------------------}
              {- For an amusing variation,-}
              {- reverse the positions of -}
              {- "eRow" and "eCol" in the -}
              {- line directly above.  You-}
              {- may wish at the same time-}
              {- to change "7 downto 0" to-}
              {- "0 to 7" 4 lines before. -}
              {----------------------------}
              if CH in NoShows then
                write(Default)
              else write(CH)
            end;
          AByte := AByte shr 1;
        end;  {for eCol}
    end;   {for eRow}
end;

procedure Key_Message;
var
  dummy : char;
begin
  GotoXY(60,25);
  write('Press a key . . .');
  read(Kbd,dummy);
  ClrScr;
end;


  (****************************************************)
  (*  Procedure Make_Title takes a string of up to    *)
  (*  ten characters as input.  It translates each    *)
  (*  character of the string into an 8 x 8 matrix    *)
  (*  using "Show_Entry" above -- and the BIG string  *)
  (*  of 8x8 size characters is centered starting on  *)
  (*  the row "starting_row".  The character "CH" is  *)
  (*  the block character used for the dots that make *)
  (*  up the BIG character.  If CH is #0 (ASCII 0),   *)
  (*  the character itself is used as its own dots.   *)
  (*                                                  *)
  (*  The "offset" simply moves the whole title line  *)
  (*  to the right by however many columns you say.   *)
  (*  You are NOT protected from running off of the   *)
  (*  right-hand edge when using the offset.  What is *)
  (*  this offset good for?  See the SHADOW title in  *)
  (*  the main program block.                         *)
  (****************************************************)

procedure MakeTitle(        title : title_type;
                     Starting_row : byte;
                           Offset : byte;
                               CH : char);
var
  N, starting_col, this_col : byte;
begin
  starting_col := (((80 - 8*length(title)) div 2) and $00FF) + offset;
  for N := 1 to length(title) do
    begin
      this_col := starting_col + 8*(N-1) +1;
      if ord(title[N]) <= 127 then
        if CH = #0 then
          ShowEntry(table[ord(title[N])],This_Col,starting_Row, title[N])
        else
          ShowEntry(table[ord(title[N])],This_Col,starting_Row, CH);
    end;
end;

  (****************************************************)
  (*  MAIN PROGRAM BLOCK:  Demonstrates usage of the  *)
  (*  ROM character graphics patterns by displaying   *)
  (*  1) a title screen, 2) the alphabet, 3) as many  *)
  (*  of the Control Characters as possible, and 4)   *)
  (*  characters pressed by the user.                 *)
  (****************************************************)


begin
  MakeTitle('This is a',1,0,#219);
  MakeTitle('BIG Title',9,0,#219);
  MakeTitle('with TURBO',17,0,#219);
  Key_Message;
  MakeTitle('ABCDEFGHIJ',1,0,#176);
  MakeTitle('KLMNOPQRST',9,0,#177);
  MakeTitle('UVWXYZ@#$%',17,0,#178);
  Key_Message;
  MakeTitle('Try a',2,1,#176);
  MakeTitle('Try a',1,0,#219);
  MakeTitle('SHADOW',10,1,#176);
  MakeTitle('SHADOW',9,0,#219);
  MakeTitle('Title',18,1,#176);
  MakeTitle('Title',17,0,#219);
  Key_Message;
              {----------------------------}
              {- NOTE that you can string -}
              {- together characters that -}
              {- are represented using the-}
              {- "#" symbol just as well  -}
              {- as you can string any    -}
              {- other characters.        -}
              {----------------------------}
  MakeTitle(#1#2#3#4#5#6#7#8#9#10,1,0,#0);
  MakeTitle(#11#12#13#14#15#16#17#18#19#20,9,0,#0);
  MakeTitle(#21#22#23#24#25#26#27#28#29#30,17,0,#0);
  Key_Message;
  OddLine := '';
  for N := 1 to 10 do OddLine := OddLine + 'A';
  MakeTitle(OddLine,1,0,#220);
  MakeTitle(OddLine,9,0,#221);
  MakeTitle(OddLine,17,0,#206);
  Key_Message;
  WriteLn('Press various keys and fill the screen.  <Esc> to quit.');
  R := 1; C := 0; Show_Blocks := true;
  repeat
    GetKeys(C1,C2);
    if ord(C1) <= 127 then
      begin
        if Show_Blocks then
          ShowEntry(table[ord(C1)],C+1,R, #219)
        else
          ShowEntry(table[ord(C1)],C+1,R, C1);
        C := (C + 8) mod 80;
        if C = 0 then R := R + 8;
        if R >= 25 then
          begin
            Key_Message;
            R := 1;
            Show_Blocks := not Show_Blocks;
          end;
      end;
  until (C1 = #27) and (C2 = #0);
end.