'PUBPRINT.BAS Created by Steve Gartrell.  Last mod 8/4/92.
'USAGE:  QBX/QB.QLB must be loaded if run in the environment.
'        QBX/QB.LIB must be LINKed if done from the command line.
'        Portrait and Landscape subs take no parameters and
'        return no values.  VidConfig returns -1 if a non-graphics
'        mode is in effect.  Various routines pass the printer file
'        number amongst themselves.  Set the Aspect% SHARED variable
'        to True% if you wish aspect correct to be done.
'
'        Released to the Public Domain 8/4/92 by Stephen K. Gartrell.
'
'$DYNAMIC
DEFINT A-Z
'$INCLUDE: 'qbx.bi'       'for PDS; use 'qb.bi' if using QB 4.5
DECLARE SUB LandScape ()
DECLARE SUB Portrait ()
DECLARE SUB PrintIt (Char%(), PrinterFile%, FixUp%)
DECLARE FUNCTION InitPrinter% ()
DECLARE SUB ResetPrinter (PrinterFile%)
DECLARE FUNCTION VidConfig% ()

CONST False% = 0, True% = NOT False%

DIM SHARED Rows%, Cols%, GrayScale%(1 TO 4, 0 TO 8)
DIM SHARED LandDPI%, PortDPI%, Bits%(0 TO 7), Aspect%
DIM SHARED PortHoriEx%, LandHoriEx%

' These are the "IBM standard" codes as listed by my
' Tandy 9-pin printer manual

' 75  =   60 DPI density
' 76  =  120 DPI density half speed  (better row alignment)
' 89  =  120 DPI density normal speed
' 90  =  240 DPI density

'Pre-calculate the bit mask needed to check for non-zero bits
' in an 8-pixel byte

FOR BitWeight% = 0 TO 7
   Bits%(BitWeight%) = 2 ^ BitWeight%
NEXT

'Place the colors to print here!!  Although the array is
' DIMmed for 4 colors, counting the background (blank),
' you are dealing with 5 colors.
' Remember, at least one mode only has four colors, which
' are returned by POINT as 0, 1, 2, and 3.  The two color
' [B&W] modes only have _1_ color and the background. POINT
' returns a 0 or a 1, in that case.  Coincidentally, testing
' for blue ("1" in 16 color modes) reveals whether a pixel
' is on in B&W modes.
' Additional colors could be added by increasing the number
' of elements in the GrayScale% array, and dreaming up your
' own bit masks.  I have found that 10 to 12 colors are quite
' feasible without losing your ability to differentiate the
' printed output.  And that is on a 9-pin printer...

GrayScale%(1, 8) = 1    'blue will be tested for
GrayScale%(2, 8) = 2    'green will be tested for
GrayScale%(3, 8) = 4    'red will be tested for
GrayScale%(4, 8) = 14   'yellow will be tested for

'Construct the dot pattern masks to emulate "newsphoto" grayscaling.

FOR cnt% = 0 TO 7
  GrayScale%(1, cnt%) = &HFF
NEXT

GrayScale%(2, 0) = &HAA
FOR cnt% = 1 TO 7

  'NOT &HAA yields (basically) &H55- the MOD is not necessary, just tidy!

  GrayScale%(2, cnt%) = NOT (GrayScale%(2, cnt% - 1)) MOD 256
NEXT

GrayScale%(3, 0) = &H88
GrayScale%(3, 1) = &H0
GrayScale%(3, 2) = &H22
GrayScale%(3, 3) = &H0
GrayScale%(3, 4) = &H88
GrayScale%(3, 5) = &H0
GrayScale%(3, 6) = &H22
GrayScale%(3, 7) = &H0

GrayScale%(4, 0) = &H0
GrayScale%(4, 1) = &H20
GrayScale%(4, 2) = &H0
GrayScale%(4, 3) = &H0
GrayScale%(4, 4) = &H0
GrayScale%(4, 5) = &H0
GrayScale%(4, 6) = &H2
GrayScale%(4, 7) = &H0

SCREEN 7

'This call to VidConfig is just made so that Rows% and Cols%
' (both of which are global variables) are initialized, to make
' it easier to change SCREENs and experiment without modifying
' the pattern generator variables.

Garbage% = VidConfig

'Borrowed this random pattern generator from Rich Geldreich!!
'Modified it to limit it to the four chosen colors, and used
'CIRCLEs to better emphasize ASPECT effects.

FOR A = 1 TO 100
  RANDOMIZE TIMER
  Radius% = RND * 50: Colour% = GrayScale%(CINT(RND * 3) + 1, 8)
  x% = RND * Cols%: y% = RND * Rows%
  CIRCLE (x%, y%), Radius%, Colour%
  PAINT (x%, y%), GrayScale%(CINT(RND * 3) + 1, 8), Colour%
NEXT

'This sequence of calls will demonstrate the value of Aspect
' correction by printing the same screen in Portrait and Landscape
' modes, first without correction, and then with.  The DO:LOOP at
' the end is so that you can get the results from the printer and
' compare them to the screen.  Of course, you've already made sure
' your printer had at least four sheets available!!!

Aspect% = False%

Portrait

LPRINT
LPRINT "Rows = "; Rows%, "Columns = "; Cols%
LPRINT "Portrait"
LPRINT "Aspect correction OFF."
LPRINT CHR$(12);

LandScape

LPRINT
LPRINT "Rows = "; Rows%, "Columns = "; Cols%
LPRINT "Landscape"
LPRINT "Aspect correction OFF."
LPRINT CHR$(12);

Aspect% = True%

Portrait

LPRINT
LPRINT "Rows = "; Rows%, "Columns = "; Cols%
LPRINT "Portrait"
LPRINT "Aspect correction ON."
LPRINT CHR$(12);

LandScape

LPRINT
LPRINT "Rows = "; Rows%, "Columns = "; Cols%
LPRINT "Landscape"
LPRINT "Aspect correction ON."
LPRINT CHR$(12);

DO: LOOP UNTIL LEN(INKEY$): SCREEN 0: WIDTH 80: END

FUNCTION InitPrinter%

'Open the printer as a file, set up line feed spacing, and return the
' file number it was opened under.

PrinterFile% = FREEFILE

OPEN "LPT1:BIN" FOR OUTPUT AS PrinterFile%

'1/9" LF
PRINT #PrinterFile%, CHR$(27); CHR$(51); CHR$(24);

'CR/LF
PRINT #PrinterFile%,

InitPrinter% = PrinterFile%

END FUNCTION

SUB LandScape

'If VidConfig% function returns a value, it's a bad SCREEN mode, so
' quit!

IF VidConfig% THEN
   BEEP
   EXIT SUB
END IF

'If the global Aspect% variable is set, aspect correction is on.  Set
' FixUp% to -1 to differentiate LandScape mode from Portrait mode.

IF Aspect% THEN FixUp% = -1

'Call InitPrinter% function, and store returned filenumber

PrinterFile% = InitPrinter%

'Initialize printer bits-byte (?!)

Pixels% = 0

FOR x% = 0 TO Cols% STEP 8

  'Setup storage for screen pixel color values

  REDIM ColorArray%(x% TO x% + 7, 0 TO Rows%)
  
  'Read screen pixel values

  FOR PixColumn% = x% TO x% + 7
   FOR PixRow% = 0 TO Rows%

    'POINT returns a -1 if bad coordinates are passed, which makes
    ' life infinitely easier...

    ColorArray%(PixColumn%, PixRow%) = POINT(PixColumn%, PixRow%)
   NEXT
  NEXT

  'Setup storage for printer output bytes

  REDIM Char%(0 TO Rows%)

  'Dependent upon the number of colors you've setup masks for,
  ' read the colors from the array, AND them with the appropriate
  ' mask, and then OR the result into the output printer byte array.

  FOR Hue% = 1 TO UBOUND(GrayScale%, 1)
   cell% = 0
   FOR y% = Rows% TO 0 STEP -1
    BitWeight% = 7
    FOR PixelColumn% = x% TO x% + 7
      IF ColorArray%(PixelColumn%, y%) = GrayScale%(Hue%, 8) THEN
       Pixels% = Pixels% OR Bits%(BitWeight%)
      END IF
      BitWeight% = BitWeight% - 1
    NEXT PixelColumn%

         'The "y% MOD 8" ensures that we cycle through each of the
         ' bit masks for this color, and eliminate 'striping'!

    Pixels% = Pixels% AND GrayScale%(Hue%, y% MOD 8)
    Char%(cell%) = Char%(cell%) OR Pixels%
    cell% = cell% + 1
    Pixels% = 0

   NEXT y%
  NEXT Hue%
  
  'Send the array of mask-ANDed, ORed-together printer bytes for printing

  CALL PrintIt(Char%(), PrinterFile%, FixUp%)

NEXT x%

'All done...Return the printer to normal draft mode, and close the file

ResetPrinter PrinterFile%

END SUB

SUB Portrait

IF VidConfig% THEN
   BEEP
   EXIT SUB
END IF

IF Aspect% THEN FixUp% = 1

PrinterFile% = InitPrinter%

Pixels% = 0

FOR y% = 0 TO Rows% STEP 8

  REDIM ColorArray%(y% TO y% + 7, 0 TO Cols%)
  FOR PixRow% = y% TO y% + 7
   FOR PixColumn% = 0 TO Cols%
    ColorArray%(PixRow%, PixColumn%) = POINT(PixColumn%, PixRow%)
   NEXT
  NEXT

  REDIM Char%(0 TO Cols%)

  FOR Hue% = 1 TO UBOUND(GrayScale%, 1)
   cell% = 0
   FOR x% = 0 TO Cols%
    BitWeight% = 0
    
    FOR PixelRow% = y% + 7 TO y% STEP -1
     IF ColorArray%(PixelRow%, x%) = GrayScale%(Hue%, 8) THEN
      Pixels% = Pixels% OR Bits%(BitWeight%)
     END IF
     BitWeight% = BitWeight% + 1
    NEXT PixelRow%

    Pixels% = Pixels% AND GrayScale%(Hue%, x% MOD 8)
    Char%(cell%) = Char%(cell%) OR Pixels%

    cell% = cell% + 1
    Pixels% = 0
   NEXT x%
  NEXT Hue%

  CALL PrintIt(Char%(), PrinterFile%, FixUp%)

NEXT y%

ResetPrinter PrinterFile%

END SUB

SUB PrintIt (Char%(), PrinterFile%, FixUp%)

STATIC regs AS RegType

'Derive line length from size of printer byte array

CellCnt% = UBOUND(Char%)

'If aspect correction is on then...

IF Aspect% THEN
   
   'Set output printer DPI and number of times to duplicate output
   ' bytes (printer columns) to the values of whichever print
   ' orientation routine called us.

   IF FixUp% < 1 THEN
      DPI% = LandDPI%
      Hor% = LandHoriEx%
   ELSE
      DPI% = PortDPI%
      Hor% = PortHoriEx%
   END IF

   'Tell the printer what DPI to use, and how many consecutive
   ' graphics bytes (printer columns) to expect.

   PRINT #PrinterFile%, CHR$(27); CHR$(DPI%);
   PRINT #PrinterFile%, CHR$(((CellCnt% + 1) * Hor%) MOD 256);
   PRINT #PrinterFile%, CHR$(((CellCnt% + 1) * Hor%) \ 256);

   'Avoid QB/PDS quirks, and use BIOS interrupt &H17 to get our
   ' bytes to the printer.  Bytes duplicated as often as needed
   ' to achieve good aspect correction.

   FOR cell% = 0 TO CellCnt%
     FOR HoriCnt% = 1 TO Hor%
        regs.ax = Char%(cell%)
        regs.dx = 0
        CALL Interrupt(&H17, regs, regs)
     NEXT
   NEXT
   
   'Emit a LF/CR combination

   PRINT #PrinterFile%,

'Aspect correction isn't on, so use 120 DPI half speed printing, and
' just shoot the output array to the printer via INT &H17.

ELSE

   DPI% = 76

   'Still have to tell the printer what DPI, and how many bytes.

   PRINT #PrinterFile%, CHR$(27); CHR$(DPI%);
   PRINT #PrinterFile%, CHR$((CellCnt% + 1) MOD 256);
   PRINT #PrinterFile%, CHR$((CellCnt% + 1) \ 256);

   FOR cell% = 0 TO CellCnt%
     regs.ax = Char%(cell%)
     regs.dx = 0
     CALL Interrupt(&H17, regs, regs)
   NEXT

   PRINT #PrinterFile%,
END IF

END SUB

REM $STATIC
SUB ResetPrinter (PrinterFile%)

'Restore the passed in file number, which is the printer, to
' draft mode, and close the file

'back to 1/6" LF
PRINT #PrinterFile%, CHR$(27); CHR$(50);

'select standard font
PRINT #PrinterFile%, CHR$(27); CHR$(73); CHR$(1);

'select 10 CPI
PRINT #PrinterFile%, CHR$(27); CHR$(77);

'select bidirectional printing
PRINT #PrinterFile%, CHR$(27); CHR$(85); CHR$(0);

CLOSE #PrinterFile%

END SUB

REM $DYNAMIC
FUNCTION VidConfig%

'Gotta find out what mode we're in, and set global variables
' accordingly.  If it's a bad mode, return a value so calling
' routine ducks out.

DIM regs AS RegType

' video driver interrupt

intnum% = &H10

' get video mode function

regs.ax = &HF00
CALL Interrupt(intnum%, regs, regs)

'Number of columns returned in ah
' multiply by 8 pixels per column, then sub 1 so that
' result agrees with QB/PDS graphics coordinate system.

Cols% = (regs.ax \ 256) * 8 - 1
CurrentMode% = regs.ax AND 255

'Go through the possible screens, and set the global variables
' for the number of rows.  Also set the values for the printer
' DPI and number of printer column repetitions to be used in
' the event that aspect correction is desired.

SELECT CASE CurrentMode%
  CASE &H4, &H6, &HD, &HE, &H13    'Screen 1, 2, 7, 8, 13 in order
   Rows% = 199
   IF CurrentMode% = &H6 OR CurrentMode% = &HE THEN
      LandHoriEx% = 7
      LandDPI% = 90
      PortHoriEx% = 2
      PortDPI% = 90
   ELSE
      LandHoriEx% = 4
      LandDPI% = 90
      PortHoriEx% = 3
      PortDPI% = 90
   END IF

  CASE &HF, &H10                   'Screen 10 & 9, RESPECTIVELY!!
   Rows% = 349
   LandHoriEx% = 4
   LandDPI% = 90
   PortHoriEx% = 1
   PortDPI% = 76

  CASE &H11, &H12                  'Screen 11 & 12, respectively
   Rows% = 479
   LandHoriEx% = 3
   LandDPI% = 90
   PortHoriEx% = 3
   PortDPI% = 90

  CASE ELSE

   ' Either a text mode or not valid return; set
   ' the return value so that the calling routine
   ' knows something is wrong.

   VidConfig% = True%
   EXIT FUNCTION

END SELECT

'Made it here; must be a good SCREEN mode

VidConfig% = False%

END FUNCTION