
{*****************************************************************************
*                                                                            *
*                  DiaPrint Version 1.0, (c) 1989 J. Lamac                   *
*                                                                            *
*****************************************************************************}

program DiaPrint;

type LineBuffer = String[ 255 ];

var Buffer,
    FileName : LineBuffer;
    InpFile  : Text;
    Max, I   : Byte;
    Nlq      : Char;

procedure ChrPut( C : char );

  begin
    case chr( ord( C ) xor $80 ) of
      #$80..#$ff : write( Lst, C );
      'J' :        write( Lst, 'u' );
      'W' :        write( Lst, 'e' );
      'j' :        write( Lst, 'U' );
      'w' :        write( Lst, 'E' );
      else         write( Lst, chr( ord( C ) xor $a0 ) );
    end;
  end;

{$I DiaPrint.Inc }
{ procedures InitPrinter, Graphics, Characters, Space, Carka, Hacek, Krouzek }

procedure DiaPut( C : char );

  begin
    case UpCase( chr( ord( C ) xor $80 ) ) of
      'A','W','I','O','U','Y' :                 Carka;
      'A'..'H','K'..'N','P'..'T','V'..'X','Z' : Hacek;
      'J' :                                     Krouzek;
      else                                      Space;
    end;
  end;

procedure ReadLine( var Buffer : LineBuffer );

  var C : char;

  begin
    Buffer := '';
    if not eof( InpFile ) then
      begin
        read( InpFile, C );
        if ( C in [ #$0a, #$0d, #$8a, #$8d ] ) and not eof( InpFile )
          then read( InpFile, C );
        while not( C in [ #$0a, #$0d, #$8a, #$8d ] ) do
          begin
            Buffer := Buffer + C;
            if not eof( InpFile )
              then read( InpFile, C )
              else C := #$0a;
          end;
      end;
  end;

BEGIN
  writeln; writeln( 'DiaPrint Version 1.0 / (c) 1988 J. Lama'#$c3 );
  writeln; write( 'Enter Filename: ' ); read( FileName );
  writeln; write( 'Near letter quality y/n: ' ); read( Nlq );
  Assign( InpFile, FileName );
  reset( InpFile );
  writeln; writeln; writeln( 'Printing..' );
  InitPrinter; NlqOff; Characters;
  if UpCase( Nlq ) = 'Y' then NlqOn;
  while not eof( InpFile ) do
    begin
      ReadLine( Buffer );
      Max := Length( Buffer );
      while ( Max > 0 ) and ( Buffer[ Max ] < #$80 ) do
        Max := pred( Max );
      if Max > 0 then
        begin
          Graphics;
          for I := 1 to Max do
            DiaPut( Buffer[ I ] );
          Characters;
        end;
      writeln( Lst );
      Max := Length( Buffer );
      while ( Max > 0 ) and ( Buffer[ Max ] = ' ' ) do
        Max := pred( Max );
      for I := 1 to Max do
        begin
          ChrPut( Buffer[ I ] );
          write( Buffer[ I ] );
        end;
      writeln( Lst ); writeln;
    end;
  NlqOff;
  writeln; writeln( 'Print complete.' );
END.
