
unit lpunit;
interface
FUNCTION LJBEG(LPORT:BYTE; LSIZE:WORD):BOOLEAN;
PROCEDURE LJEND;
PROCEDURE LJPRINT(LAND:BOOLEAN; SIZE,THRESHOLD:WORD);
PROCEDURE PRINTSCREEN(LPT,THRESHOLD:WORD; LAND:BOOLEAN);

implementation
USES GRAPH;

TYPE STRING12 = STRING[12];
VAR LST : TEXT;

CONST PRNPORT : WORD = 0;       {0=LPT1, 1=LPT2}

{-------------------------------------------------------------}
{LASER PRINTER SETUP TABLES}


const ESCHR = #$1B;
      NULL  = #0;

      PRNBEG = ESCHR+'E';	{RESET PRNTR, EJECT PAGE IF REQ}
      PRN75  = ESCHR+'*t75R';	{SET 75 DOTS PER INCH}
      PRN100 = ESCHR+'*t100R';	{SET 100 DOTS PER INCH}
      PRN150 = ESCHR+'*t150R';	{SET 150 DOTS PER INCH}
      PRN300 = ESCHR+'*t300R';	{SET 300 DOTS PER INCH}

      PRITOP = ESCHR+'&a100H'+	{SET CURSOR TO START POS}
               ESCHR+'&a100V';

      PRLINI = ESCHR+'*b';	{RASTER LINE HEADER FOR PRINTER}
      PRLINE = 'W';	        {RASTER LINE HEADER FOR PRINTER}

      PRNRST = ESCHR+'*r1A';	{BEGIN RASTER GRAPHICS}

      PRNEND = ESCHR+'*rB';	{END RASTER GRAPHICS}

      PRNRES = ESCHR+'E';	{RESET PRINTER AND EJECT PAGE}


FUNCTION PRNSTAT:BYTE; ASSEMBLER;
ASM
  MOV AH,2
  MOV DX,[PRNPORT]
  INT $17
  MOV AL,AH
END;

PROCEDURE PRINTCHAR(C:CHAR); ASSEMBLER;
ASM
  MOV AL,[C]
  MOV DX,[PRNPORT]
  MOV AH,0
  INT $17
END;


PROCEDURE PRINT(C:CHAR);
BEGIN
  WHILE PRNSTAT AND $a0 <> $80 DO {NOP};
  PRINTCHAR(C);
END;

PROCEDURE LPRINT(S:STRING);
VAR I : WORD;
BEGIN
  FOR I := 1 TO LENGTH(S) DO
  BEGIN
    PRINT(S[I]);
  END;
END;

FUNCTION FSTR(L:LONGINT):STRING12;
VAR S:STRING;
BEGIN
  STR(L,S);
  FSTR := S;
END;

{---------------------------------------------}
{PREPARE EXTERNAL PRINTER FOR OUTPUT}
FUNCTION LJBEG(LPORT:BYTE; LSIZE:WORD):BOOLEAN;
BEGIN
  LJBEG := TRUE;
  IF LPORT > 2 THEN EXIT;
  PRNPORT := LPORT;
  LPRINT(PRNBEG);
  CASE LSIZE OF
     50: LPRINT(PRN75);
     75: LPRINT(PRN75);
    100: LPRINT(PRN100);
    150: LPRINT(PRN150);
    300: LPRINT(PRN300);
    ELSE LJBEG := FALSE;
  END;
END;

{---------------------------------------------}
{RESTORE EXTERNAL PRINTER TO NORMAL OPERATION}
PROCEDURE LJEND;
BEGIN
  LPRINT(PRNRES);
END;

{----------------------------------------------}
{PRINT GRAPHICS AS LANDSCAPE}
PROCEDURE DOLAND(Size,THRESHOLD:WORD);
VAR Y,X,L : WORD;
    C : BYTE;
    D : CHAR;
    RASTER : STRING;
  procedure GetDot;
  begin
    C := GETPIXEL(X,Y);
    IF C > THRESHOLD THEN C := 1 ELSE C := 0;
    D := CHAR((ORD(D) SHL 1) OR C);
    INC(Y);
  end;
  procedure DoScan;
  var I,B : word;
  begin
    Y := 0;
    L := ((GETMAXY+1) DIV 8)*size;
    LPRINT(PRLINI+FSTR(L)+PRLINE);
    FOR B := 1 TO L DO
    BEGIN
      D := #0;
      FOR I := 0 TO 3 DO
      BEGIN
        GetDot;
        if Size > 1 then
          D := CHAR((ORD(D) SHL 1) OR C)
        else
          GetDot;
      END;
      RASTER[B] := D;
    END;
    RASTER[0] := CHAR(B);
    LPRINT(RASTER);
  end;
BEGIN
  FOR X := GETMAXX DOWNTO 0 DO
  BEGIN
    DoScan;
    if Size > 1 then DoScan;
  END;
END;

{----------------------------------------------}
{PRINT GRAPHICS AS PORTRAIT}
PROCEDURE DOPORT(Size,THRESHOLD:WORD);
VAR Y,X,L,I,B : WORD;
    C : BYTE;
    D : CHAR;
    RASTER : STRING;
BEGIN
  FOR Y := 0 TO GETMAXY DO
  BEGIN
    X := 0;
    L := ((GETMAXX+1) DIV 8);
    LPRINT(PRLINI+FSTR(L)+PRLINE);
    FOR B := 1 TO L DO
    BEGIN
      D := #0;
      FOR I := 0 TO 7 DO
      BEGIN
        C := GETPIXEL(X,Y);
        IF C > THRESHOLD THEN C := 1 ELSE C := 0;
        D := CHAR((ORD(D) SHL 1) OR C);
        INC(X);
      END;
      RASTER[B] := D;
    END;
    RASTER[0] := CHAR(B);
    LPRINT(RASTER);
  END;
END;

{----------------------------------------------}
{DUMP THE SCREEN TO EXTERNAL LASER PRINTER}
{LAND=TRUE DO LANDSCAPE; LAND=FALSE DO PORTRAIT}
{THRESHOLD=COLOR->MONOCHROME CONVERSION THRESHOLD}
PROCEDURE LJPRINT(LAND:BOOLEAN; Size,THRESHOLD:WORD);
BEGIN
  LPRINT(PRITOP); {POSITION CURSOR}
  LPRINT(PRNRST); {ENTER GRAPHICS MODE}
  IF LAND THEN
    DOLAND(Size,THRESHOLD)
  ELSE
    DOPORT(Size,THRESHOLD);
  LPRINT(PRNEND); {CLOSE PRINTER GRAPHICS}
END;


{----------------------------------------------}
{DO A SCREEN DUMP. LPT=LPT PORT (0-2)}
{LAND=TRUE=LANDSCAPE; FALSE=PORTRAIT}
{THRESHOLD=COLOR->MONOCHROME CONVERSION THRESHOLD}
PROCEDURE PRINTSCREEN(LPT,THRESHOLD:WORD; LAND:BOOLEAN);
VAR   Y : INTEGER;
    DPI : INTEGER;
    Size : word;
BEGIN
  Y := GetMaxY;     {7" max high on page}
  Size := 1;

  CASE Y OF
      0..350: begin DPI := 50; if Land then Size := 2; end;
      0..525: DPI := 75;   {320x200, 640x480}
    526..700: DPI := 100;  {800x600 (laserjet)}
   701..1050: DPI := 150;  {1024x768, 1280x1024}
         else DPI := 300;  {say what!?}
  END; {CASE Y OF}
  if not LJBEG(LPT,DPI) then Exit;
  LJPRINT({LAND}false,Size,THRESHOLD);
  LJEND;
END;

end.

    526..630: DPI := 90;   {800x600 (paintjet)}
    631..700: DPI := 100;  {800x600 (laserjet)}
