home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBNWS303.ZIP / GPRINT.ZIP / PUBPRINT.BAS
Encoding:
BASIC Source File  |  1992-11-15  |  12.0 KB  |  483 lines
  1. 'PUBPRINT.BAS Created by Steve Gartrell.  Last mod 8/4/92.
  2. 'USAGE:  QBX/QB.QLB must be loaded if run in the environment.
  3. '        QBX/QB.LIB must be LINKed if done from the command line.
  4. '        Portrait and Landscape subs take no parameters and
  5. '        return no values.  VidConfig returns -1 if a non-graphics
  6. '        mode is in effect.  Various routines pass the printer file
  7. '        number amongst themselves.  Set the Aspect% SHARED variable
  8. '        to True% if you wish aspect correct to be done.
  9. '
  10. '        Released to the Public Domain 8/4/92 by Stephen K. Gartrell.
  11. '
  12. '$DYNAMIC
  13. DEFINT A-Z
  14. '$INCLUDE: 'qbx.bi'       'for PDS; use 'qb.bi' if using QB 4.5
  15. DECLARE SUB LandScape ()
  16. DECLARE SUB Portrait ()
  17. DECLARE SUB PrintIt (Char%(), PrinterFile%, FixUp%)
  18. DECLARE FUNCTION InitPrinter% ()
  19. DECLARE SUB ResetPrinter (PrinterFile%)
  20. DECLARE FUNCTION VidConfig% ()
  21.  
  22. CONST False% = 0, True% = NOT False%
  23.  
  24. DIM SHARED Rows%, Cols%, GrayScale%(1 TO 4, 0 TO 8)
  25. DIM SHARED LandDPI%, PortDPI%, Bits%(0 TO 7), Aspect%
  26. DIM SHARED PortHoriEx%, LandHoriEx%
  27.  
  28. ' These are the "IBM standard" codes as listed by my
  29. ' Tandy 9-pin printer manual
  30.  
  31. ' 75  =   60 DPI density
  32. ' 76  =  120 DPI density half speed  (better row alignment)
  33. ' 89  =  120 DPI density normal speed
  34. ' 90  =  240 DPI density
  35.  
  36. 'Pre-calculate the bit mask needed to check for non-zero bits
  37. ' in an 8-pixel byte
  38.  
  39. FOR BitWeight% = 0 TO 7
  40.    Bits%(BitWeight%) = 2 ^ BitWeight%
  41. NEXT
  42.  
  43. 'Place the colors to print here!!  Although the array is
  44. ' DIMmed for 4 colors, counting the background (blank),
  45. ' you are dealing with 5 colors.
  46. ' Remember, at least one mode only has four colors, which
  47. ' are returned by POINT as 0, 1, 2, and 3.  The two color
  48. ' [B&W] modes only have _1_ color and the background. POINT
  49. ' returns a 0 or a 1, in that case.  Coincidentally, testing
  50. ' for blue ("1" in 16 color modes) reveals whether a pixel
  51. ' is on in B&W modes.
  52. ' Additional colors could be added by increasing the number
  53. ' of elements in the GrayScale% array, and dreaming up your
  54. ' own bit masks.  I have found that 10 to 12 colors are quite
  55. ' feasible without losing your ability to differentiate the
  56. ' printed output.  And that is on a 9-pin printer...
  57.  
  58. GrayScale%(1, 8) = 1    'blue will be tested for
  59. GrayScale%(2, 8) = 2    'green will be tested for
  60. GrayScale%(3, 8) = 4    'red will be tested for
  61. GrayScale%(4, 8) = 14   'yellow will be tested for
  62.  
  63. 'Construct the dot pattern masks to emulate "newsphoto" grayscaling.
  64.  
  65. FOR cnt% = 0 TO 7
  66.   GrayScale%(1, cnt%) = &HFF
  67. NEXT
  68.  
  69. GrayScale%(2, 0) = &HAA
  70. FOR cnt% = 1 TO 7
  71.  
  72.   'NOT &HAA yields (basically) &H55- the MOD is not necessary, just tidy!
  73.  
  74.   GrayScale%(2, cnt%) = NOT (GrayScale%(2, cnt% - 1)) MOD 256
  75. NEXT
  76.  
  77. GrayScale%(3, 0) = &H88
  78. GrayScale%(3, 1) = &H0
  79. GrayScale%(3, 2) = &H22
  80. GrayScale%(3, 3) = &H0
  81. GrayScale%(3, 4) = &H88
  82. GrayScale%(3, 5) = &H0
  83. GrayScale%(3, 6) = &H22
  84. GrayScale%(3, 7) = &H0
  85.  
  86. GrayScale%(4, 0) = &H0
  87. GrayScale%(4, 1) = &H20
  88. GrayScale%(4, 2) = &H0
  89. GrayScale%(4, 3) = &H0
  90. GrayScale%(4, 4) = &H0
  91. GrayScale%(4, 5) = &H0
  92. GrayScale%(4, 6) = &H2
  93. GrayScale%(4, 7) = &H0
  94.  
  95. SCREEN 7
  96.  
  97. 'This call to VidConfig is just made so that Rows% and Cols%
  98. ' (both of which are global variables) are initialized, to make
  99. ' it easier to change SCREENs and experiment without modifying
  100. ' the pattern generator variables.
  101.  
  102. Garbage% = VidConfig
  103.  
  104. 'Borrowed this random pattern generator from Rich Geldreich!!
  105. 'Modified it to limit it to the four chosen colors, and used
  106. 'CIRCLEs to better emphasize ASPECT effects.
  107.  
  108. FOR A = 1 TO 100
  109.   RANDOMIZE TIMER
  110.   Radius% = RND * 50: Colour% = GrayScale%(CINT(RND * 3) + 1, 8)
  111.   x% = RND * Cols%: y% = RND * Rows%
  112.   CIRCLE (x%, y%), Radius%, Colour%
  113.   PAINT (x%, y%), GrayScale%(CINT(RND * 3) + 1, 8), Colour%
  114. NEXT
  115.  
  116. 'This sequence of calls will demonstrate the value of Aspect
  117. ' correction by printing the same screen in Portrait and Landscape
  118. ' modes, first without correction, and then with.  The DO:LOOP at
  119. ' the end is so that you can get the results from the printer and
  120. ' compare them to the screen.  Of course, you've already made sure
  121. ' your printer had at least four sheets available!!!
  122.  
  123. Aspect% = False%
  124.  
  125. Portrait
  126.  
  127. LPRINT
  128. LPRINT "Rows = "; Rows%, "Columns = "; Cols%
  129. LPRINT "Portrait"
  130. LPRINT "Aspect correction OFF."
  131. LPRINT CHR$(12);
  132.  
  133. LandScape
  134.  
  135. LPRINT
  136. LPRINT "Rows = "; Rows%, "Columns = "; Cols%
  137. LPRINT "Landscape"
  138. LPRINT "Aspect correction OFF."
  139. LPRINT CHR$(12);
  140.  
  141. Aspect% = True%
  142.  
  143. Portrait
  144.  
  145. LPRINT
  146. LPRINT "Rows = "; Rows%, "Columns = "; Cols%
  147. LPRINT "Portrait"
  148. LPRINT "Aspect correction ON."
  149. LPRINT CHR$(12);
  150.  
  151. LandScape
  152.  
  153. LPRINT
  154. LPRINT "Rows = "; Rows%, "Columns = "; Cols%
  155. LPRINT "Landscape"
  156. LPRINT "Aspect correction ON."
  157. LPRINT CHR$(12);
  158.  
  159. DO: LOOP UNTIL LEN(INKEY$): SCREEN 0: WIDTH 80: END
  160.  
  161. FUNCTION InitPrinter%
  162.  
  163. 'Open the printer as a file, set up line feed spacing, and return the
  164. ' file number it was opened under.
  165.  
  166. PrinterFile% = FREEFILE
  167.  
  168. OPEN "LPT1:BIN" FOR OUTPUT AS PrinterFile%
  169.  
  170. '1/9" LF
  171. PRINT #PrinterFile%, CHR$(27); CHR$(51); CHR$(24);
  172.  
  173. 'CR/LF
  174. PRINT #PrinterFile%,
  175.  
  176. InitPrinter% = PrinterFile%
  177.  
  178. END FUNCTION
  179.  
  180. SUB LandScape
  181.  
  182. 'If VidConfig% function returns a value, it's a bad SCREEN mode, so
  183. ' quit!
  184.  
  185. IF VidConfig% THEN
  186.    BEEP
  187.    EXIT SUB
  188. END IF
  189.  
  190. 'If the global Aspect% variable is set, aspect correction is on.  Set
  191. ' FixUp% to -1 to differentiate LandScape mode from Portrait mode.
  192.  
  193. IF Aspect% THEN FixUp% = -1
  194.  
  195. 'Call InitPrinter% function, and store returned filenumber
  196.  
  197. PrinterFile% = InitPrinter%
  198.  
  199. 'Initialize printer bits-byte (?!)
  200.  
  201. Pixels% = 0
  202.  
  203. FOR x% = 0 TO Cols% STEP 8
  204.  
  205.   'Setup storage for screen pixel color values
  206.  
  207.   REDIM ColorArray%(x% TO x% + 7, 0 TO Rows%)
  208.   
  209.   'Read screen pixel values
  210.  
  211.   FOR PixColumn% = x% TO x% + 7
  212.    FOR PixRow% = 0 TO Rows%
  213.  
  214.     'POINT returns a -1 if bad coordinates are passed, which makes
  215.     ' life infinitely easier...
  216.  
  217.     ColorArray%(PixColumn%, PixRow%) = POINT(PixColumn%, PixRow%)
  218.    NEXT
  219.   NEXT
  220.  
  221.   'Setup storage for printer output bytes
  222.  
  223.   REDIM Char%(0 TO Rows%)
  224.  
  225.   'Dependent upon the number of colors you've setup masks for,
  226.   ' read the colors from the array, AND them with the appropriate
  227.   ' mask, and then OR the result into the output printer byte array.
  228.  
  229.   FOR Hue% = 1 TO UBOUND(GrayScale%, 1)
  230.    cell% = 0
  231.    FOR y% = Rows% TO 0 STEP -1
  232.     BitWeight% = 7
  233.     FOR PixelColumn% = x% TO x% + 7
  234.       IF ColorArray%(PixelColumn%, y%) = GrayScale%(Hue%, 8) THEN
  235.        Pixels% = Pixels% OR Bits%(BitWeight%)
  236.       END IF
  237.       BitWeight% = BitWeight% - 1
  238.     NEXT PixelColumn%
  239.  
  240.          'The "y% MOD 8" ensures that we cycle through each of the
  241.          ' bit masks for this color, and eliminate 'striping'!
  242.  
  243.     Pixels% = Pixels% AND GrayScale%(Hue%, y% MOD 8)
  244.     Char%(cell%) = Char%(cell%) OR Pixels%
  245.     cell% = cell% + 1
  246.     Pixels% = 0
  247.  
  248.    NEXT y%
  249.   NEXT Hue%
  250.   
  251.   'Send the array of mask-ANDed, ORed-together printer bytes for printing
  252.  
  253.   CALL PrintIt(Char%(), PrinterFile%, FixUp%)
  254.  
  255. NEXT x%
  256.  
  257. 'All done...Return the printer to normal draft mode, and close the file
  258.  
  259. ResetPrinter PrinterFile%
  260.  
  261. END SUB
  262.  
  263. SUB Portrait
  264.  
  265. IF VidConfig% THEN
  266.    BEEP
  267.    EXIT SUB
  268. END IF
  269.  
  270. IF Aspect% THEN FixUp% = 1
  271.  
  272. PrinterFile% = InitPrinter%
  273.  
  274. Pixels% = 0
  275.  
  276. FOR y% = 0 TO Rows% STEP 8
  277.  
  278.   REDIM ColorArray%(y% TO y% + 7, 0 TO Cols%)
  279.   FOR PixRow% = y% TO y% + 7
  280.    FOR PixColumn% = 0 TO Cols%
  281.     ColorArray%(PixRow%, PixColumn%) = POINT(PixColumn%, PixRow%)
  282.    NEXT
  283.   NEXT
  284.  
  285.   REDIM Char%(0 TO Cols%)
  286.  
  287.   FOR Hue% = 1 TO UBOUND(GrayScale%, 1)
  288.    cell% = 0
  289.    FOR x% = 0 TO Cols%
  290.     BitWeight% = 0
  291.     
  292.     FOR PixelRow% = y% + 7 TO y% STEP -1
  293.      IF ColorArray%(PixelRow%, x%) = GrayScale%(Hue%, 8) THEN
  294.       Pixels% = Pixels% OR Bits%(BitWeight%)
  295.      END IF
  296.      BitWeight% = BitWeight% + 1
  297.     NEXT PixelRow%
  298.  
  299.     Pixels% = Pixels% AND GrayScale%(Hue%, x% MOD 8)
  300.     Char%(cell%) = Char%(cell%) OR Pixels%
  301.  
  302.     cell% = cell% + 1
  303.     Pixels% = 0
  304.    NEXT x%
  305.   NEXT Hue%
  306.  
  307.   CALL PrintIt(Char%(), PrinterFile%, FixUp%)
  308.  
  309. NEXT y%
  310.  
  311. ResetPrinter PrinterFile%
  312.  
  313. END SUB
  314.  
  315. SUB PrintIt (Char%(), PrinterFile%, FixUp%)
  316.  
  317. STATIC regs AS RegType
  318.  
  319. 'Derive line length from size of printer byte array
  320.  
  321. CellCnt% = UBOUND(Char%)
  322.  
  323. 'If aspect correction is on then...
  324.  
  325. IF Aspect% THEN
  326.    
  327.    'Set output printer DPI and number of times to duplicate output
  328.    ' bytes (printer columns) to the values of whichever print
  329.    ' orientation routine called us.
  330.  
  331.    IF FixUp% < 1 THEN
  332.       DPI% = LandDPI%
  333.       Hor% = LandHoriEx%
  334.    ELSE
  335.       DPI% = PortDPI%
  336.       Hor% = PortHoriEx%
  337.    END IF
  338.  
  339.    'Tell the printer what DPI to use, and how many consecutive
  340.    ' graphics bytes (printer columns) to expect.
  341.  
  342.    PRINT #PrinterFile%, CHR$(27); CHR$(DPI%);
  343.    PRINT #PrinterFile%, CHR$(((CellCnt% + 1) * Hor%) MOD 256);
  344.    PRINT #PrinterFile%, CHR$(((CellCnt% + 1) * Hor%) \ 256);
  345.  
  346.    'Avoid QB/PDS quirks, and use BIOS interrupt &H17 to get our
  347.    ' bytes to the printer.  Bytes duplicated as often as needed
  348.    ' to achieve good aspect correction.
  349.  
  350.    FOR cell% = 0 TO CellCnt%
  351.      FOR HoriCnt% = 1 TO Hor%
  352.         regs.ax = Char%(cell%)
  353.         regs.dx = 0
  354.         CALL Interrupt(&H17, regs, regs)
  355.      NEXT
  356.    NEXT
  357.    
  358.    'Emit a LF/CR combination
  359.  
  360.    PRINT #PrinterFile%,
  361.  
  362. 'Aspect correction isn't on, so use 120 DPI half speed printing, and
  363. ' just shoot the output array to the printer via INT &H17.
  364.  
  365. ELSE
  366.  
  367.    DPI% = 76
  368.  
  369.    'Still have to tell the printer what DPI, and how many bytes.
  370.  
  371.    PRINT #PrinterFile%, CHR$(27); CHR$(DPI%);
  372.    PRINT #PrinterFile%, CHR$((CellCnt% + 1) MOD 256);
  373.    PRINT #PrinterFile%, CHR$((CellCnt% + 1) \ 256);
  374.  
  375.    FOR cell% = 0 TO CellCnt%
  376.      regs.ax = Char%(cell%)
  377.      regs.dx = 0
  378.      CALL Interrupt(&H17, regs, regs)
  379.    NEXT
  380.  
  381.    PRINT #PrinterFile%,
  382. END IF
  383.  
  384. END SUB
  385.  
  386. REM $STATIC
  387. SUB ResetPrinter (PrinterFile%)
  388.  
  389. 'Restore the passed in file number, which is the printer, to
  390. ' draft mode, and close the file
  391.  
  392. 'back to 1/6" LF
  393. PRINT #PrinterFile%, CHR$(27); CHR$(50);
  394.  
  395. 'select standard font
  396. PRINT #PrinterFile%, CHR$(27); CHR$(73); CHR$(1);
  397.  
  398. 'select 10 CPI
  399. PRINT #PrinterFile%, CHR$(27); CHR$(77);
  400.  
  401. 'select bidirectional printing
  402. PRINT #PrinterFile%, CHR$(27); CHR$(85); CHR$(0);
  403.  
  404. CLOSE #PrinterFile%
  405.  
  406. END SUB
  407.  
  408. REM $DYNAMIC
  409. FUNCTION VidConfig%
  410.  
  411. 'Gotta find out what mode we're in, and set global variables
  412. ' accordingly.  If it's a bad mode, return a value so calling
  413. ' routine ducks out.
  414.  
  415. DIM regs AS RegType
  416.  
  417. ' video driver interrupt
  418.  
  419. intnum% = &H10
  420.  
  421. ' get video mode function
  422.  
  423. regs.ax = &HF00
  424. CALL Interrupt(intnum%, regs, regs)
  425.  
  426. 'Number of columns returned in ah
  427. ' multiply by 8 pixels per column, then sub 1 so that
  428. ' result agrees with QB/PDS graphics coordinate system.
  429.  
  430. Cols% = (regs.ax \ 256) * 8 - 1
  431. CurrentMode% = regs.ax AND 255
  432.  
  433. 'Go through the possible screens, and set the global variables
  434. ' for the number of rows.  Also set the values for the printer
  435. ' DPI and number of printer column repetitions to be used in
  436. ' the event that aspect correction is desired.
  437.  
  438. SELECT CASE CurrentMode%
  439.   CASE &H4, &H6, &HD, &HE, &H13    'Screen 1, 2, 7, 8, 13 in order
  440.    Rows% = 199
  441.    IF CurrentMode% = &H6 OR CurrentMode% = &HE THEN
  442.       LandHoriEx% = 7
  443.       LandDPI% = 90
  444.       PortHoriEx% = 2
  445.       PortDPI% = 90
  446.    ELSE
  447.       LandHoriEx% = 4
  448.       LandDPI% = 90
  449.       PortHoriEx% = 3
  450.       PortDPI% = 90
  451.    END IF
  452.  
  453.   CASE &HF, &H10                   'Screen 10 & 9, RESPECTIVELY!!
  454.    Rows% = 349
  455.    LandHoriEx% = 4
  456.    LandDPI% = 90
  457.    PortHoriEx% = 1
  458.    PortDPI% = 76
  459.  
  460.   CASE &H11, &H12                  'Screen 11 & 12, respectively
  461.    Rows% = 479
  462.    LandHoriEx% = 3
  463.    LandDPI% = 90
  464.    PortHoriEx% = 3
  465.    PortDPI% = 90
  466.  
  467.   CASE ELSE
  468.  
  469.    ' Either a text mode or not valid return; set
  470.    ' the return value so that the calling routine
  471.    ' knows something is wrong.
  472.  
  473.    VidConfig% = True%
  474.    EXIT FUNCTION
  475.  
  476. END SELECT
  477.  
  478. 'Made it here; must be a good SCREEN mode
  479.  
  480. VidConfig% = False%
  481.  
  482. END FUNCTION
  483.