%include "i:util.inc"
%begin
%constant %shortinteger newfont=20,pagehight=3000,
                        pagewidth=3000
%constant %byteinteger ESC=27,SP=32
%byteinteger character,symbol,white,black
%integer i,x,y
%byte %array characters(0:127),pixels(1:5,1:5),picture(0:255,0:255),scale(0:25)
%string (50) filenam


%routine getafter(%byte %integer a)
%byteinteger b
  %cycle
    readsymbol(b)
  %repeat %until b=a
%end

%routine sendhead(%byte %integer a)
  printsymbol(ESC);write(a,4);printsymbol(';');
  write(5,2);printsymbol(';');write(0,2);printsymbol(';');write(5,2);
  printsymbol(';');write(0,2);printsymbol(SP);printsymbol('K');newline
%end

%routine startpage
  printsymbol(ESC);write(pagehight,5);printsymbol(';');write(pagewidth,5)
  printsymbol(SP);printsymbol('P');newline
%end

%routine endpage
  printsymbol(ESC);printstring(" E");newline
%end

%routine selectfont(%shortinteger font)
  printsymbol(ESC);write(font,5);printstring(" F")
%end

%routine moveup(%shortinteger move)
  printsymbol(ESC);write(move,5);printstring(" A")
%end

%routine sendbitarray
%shortinteger accum,xcoor,ycoor,bitcnt
  %for ycoor=1,1,5 %cycle
     accum=0
     %for xcoor=1,1,5 %cycle
          accum=(accum<<1)+pixels(xcoor,ycoor)
     %repeat
     phex2(accum);newline
  %repeat
%end

%routine fillraster                    {starts after char NL and halts before :}
%integer xcoor,ycoor
%byteinteger sym
  %for xcoor=1,1,5 %cycle                   {clear pixel array}
    %for ycoor=1,1,5 %cycle
       pixels(xcoor,ycoor)=0
    %repeat
  %repeat
  xcoor=1;ycoor=1                            {read in pixel array}
  %cycle
    %exit %if nextsymbol=':'
    readsymbol(sym)
    %if sym='*' %then %start
      pixels(xcoor,ycoor)=1;xcoor=xcoor+1
    %finish %else %if sym=' ' %then %start
      xcoor=xcoor+1
    %finish %else %if sym=NL %then %start
      ycoor=ycoor+1;xcoor=1
    %finish
  %repeat
%end

%integer %function greymap(%integer intens)
  %integer a=0
  %own %byteinteger %array ranges(0:26)=%c
     0,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90,95,100,105,110,%c
     115,120,125,130,135,255
  %while intens>ranges(a+1) %cycle
    a=a+1
  %repeat
  %result=a
%end

prompt("Input file: ")           {main program}
read(filenam);skipsymbol
open input (1,filenam.".FNT") ;open output(1,"protocol")
select input(1);select output(1)

{declare base font}
printsymbol(ESC);printsymbol(SP);write(0,2);printsymbol(';')
write(5,2);printsymbol(';');write(0,2);printsymbol(';');write(5,2)
printsymbol(SP);printsymbol('S');printsymbol(SP);printstring(filenam);newline

{read and declare consecutive characters}
%for i=0,1,127 %cycle
   characters(i)=0
%repeat
%cycle
  getafter(':')
  %exit %if nextsymbol=':'
  readsymbol(character)
  getafter(NL)
  fillraster
  sendhead(character);sendbitarray
  characters(character)=1
%repeat

{declare derived font}
printsymbol(ESC);printsymbol(SP);write(newfont,2);printsymbol(';')
write(5,0);printsymbol(';');write(0,2);printsymbol(';');write(5,2)
printsymbol(SP);printsymbol('T');newline
{send derived characters}
%for i=0,1,127 %cycle
  %if characters(i)#0 %then %start
    printsymbol(ESC);write(i,3);printsymbol(';');write(1,2);printsymbol(';')
    write(i,3);printsymbol(';');write(1,2);printsymbol(';');write(1,2);
    printsymbol(';');write(0,2);printsymbol(SP);printsymbol('I');
    printsymbol(SP);printstring(filenam);newline
  %finish
%repeat

{text file}
select output(0);select input(0)
prompt("picture file: ");read(filenam);skipsymbol
open input(1,filenam);select input(1);select output(1)
{startpage
moveup(6*48)
selectfont(newfont)
%for y=0,1,255 %cycle
  %for x=0,1,255 %cycle
    readsymbol(picture(x,y))
  %repeat
%repeat
%for x=0,1,25 %cycle
  scale(x)=x+65
%repeat
%for y=0,1,255 %cycle
  %for x=0,1,255 %cycle
    printsymbol(scale(greymap(picture(x,y))))
  %repeat
  newline
%repeat
{endpage
close output
%stop
%endofprogram
