program banner;

var
  p: array[0..7,0..7] of boolean;
  b: byte;
  i,j,k,n,an,x: integer;
  pchr,size,ch,c: char;
  aa: string[72];
  istr: string[80];

begin
  clrscr;
  writeln('Enter the character to be used in printing the banner');
  write('(for example "X") or press return to use the entered character:  ');
  read(kbd,pchr); writeln(pchr);
  writeln;
  write('Enter the banner size  1) 24 chars wide, 2) 48 chars wide, 3) 72 chars wide:  ');
  repeat read(kbd,size) until size in ['1'..'3']; writeln(size);
  n:=ord(size)-ord('0');
  writeln;
  writeln;
  writeln('Press any key when printer is ready');
  read(kbd,ch);
  writeln;
  writeln;
  writeln('Begin typing your banner (press return to end the line).');
  writeln;
  readln(istr);
  for x:=1 to length(istr) do
  begin
    ch:=istr[x];
    if ch in [' '..'~'] then
    begin
      if pchr=^M then c:=ch else c:=pchr;
      aa:='';
      for i:=1 to 3*n do aa:=aa+c;
      an:=$FA6D+8*ord(ch);
      for i:=0 to 7 do
      begin
        b:=mem[$F000:an+i];
        if (b and $80)=$80 then p[i,7]:=true else p[i,7]:=false;
        if (b and $40)=$40 then p[i,6]:=true else p[i,6]:=false;
        if (b and $20)=$20 then p[i,5]:=true else p[i,5]:=false;
        if (b and $10)=$10 then p[i,4]:=true else p[i,4]:=false;
        if (b and $08)=$08 then p[i,3]:=true else p[i,3]:=false;
        if (b and $04)=$04 then p[i,2]:=true else p[i,2]:=false;
        if (b and $02)=$02 then p[i,1]:=true else p[i,1]:=false;
        if (b and $01)=$01 then p[i,0]:=true else p[i,0]:=false;
      end;
      for i:=7 downto 0 do
        for j:=1 to n do
        begin
          write(lst,'':12*(3-n));
          for k:=7 downto 0 do
            if p[k,i] then write(lst,aa) else write(lst,'':3*n);
          writeln(lst);
        end;
      writeln(lst);
    end;
  end;
  if istr<>'' then write(lst,^L);
  writeln;
  writeln('End of BANNER program');
end.
                                                                         