home *** CD-ROM | disk | FTP | other *** search
/ Sound Sensations! / sound_sensations.iso / cmf / laser / laser.prg < prev    next >
Encoding:
Text File  |  1989-12-03  |  14.5 KB  |  329 lines
  1. ********* 
  2. *
  3. *  laser.prg
  4. *
  5. *  HP LaserJet Routines to draw lines and boxes.
  6. *
  7. *  Written 12/89 by 
  8. *        Kevin Talbot
  9. *        KJT enterprises
  10. *        7632 SE 37th Place
  11. *        Mercer Island, WA 98040
  12. *        (206) 236-1060
  13. *        Compuserve ID: 75706,316 
  14. * 
  15. * These are "public domain" and are free for anyone to use or modify.
  16. * Acknowledgement of the author would be appreciated.
  17.  
  18.  
  19. * Notes:
  20. *
  21. *   All coordinates, lengths, widths, etc., for functions assume INCHES.
  22. *
  23. *   All "drawing" functions start with the current cursor position, so be 
  24. *   sure to "lj_gotoxy()" before calling a "draw" function.
  25. *
  26. *   All functions assume that "set print on" has been set previously as they
  27. *   all use the "??" command to send data to the printer. You may also want to
  28. *   "set console off" so the screen is not filled with lots of funny escape 
  29. *   codes.
  30. *
  31. *   All functions save and restore the current prow() and pcol() values so
  32. *   accuracy of "@ r,c" commands directed to the printer is maintained. These
  33. *   functions all send tons of escape codes to the printer which really fouls
  34. *   up the interal printer cursor positon pointer in Clipper! I have found
  35. *   it MUCH easier to dispense with '@ r,c' when using a laser printer and
  36. *   use the 'lj_say()' function instead. Since the LaserJet is a page printer,
  37. *   you can move the printer cursor anywhere you want without triggering a
  38. *   form feed from Clipper just because you moved the printe cursor 'back' or
  39. *   'up' from the present position.
  40. *
  41. *   The LaserJet fill patterns are specified as strings just as they
  42. *   are defined in the LaserJet technical manual. The fill pattern can be
  43. *   one of 7 shades of gray plus white and black or one of six regular line
  44. *   patterns. These routines differentiate between "gray" and "pattern" by
  45. *   having a pattern number prefix with a "#".
  46. * 
  47. *   Gray shades are specified as follows:
  48. *              "0" = 0% gray (white, only supported on the new LaserJet IIP!)
  49. *         "1".."2" = 2% gray 
  50. *        "3".."10" = 10% gray 
  51. *       "11".."20" = 20% gray 
  52. *       "21".."35" = 30% gray 
  53. *       "36".."55" = 45% gray 
  54. *       "56".."80" = 70% gray 
  55. *       "81".."99" = 90% gray
  56. *            "100" = 100% gray (black) 
  57. *
  58. *   Patterns are specified as follows:
  59. *       "#1" = horizontal lines
  60. *       "#2" = vertical lines
  61. *       "#3" = diagonal lines running from lower left to upper right
  62. *       "#4" = diagonal lines running from upper left to lower right 
  63. *       "#5" = orthogonal crosshatch (like #1 and #2 combined)
  64. *       "#6" = diagonal crosshatch (like #3 and #4 combined)
  65. *
  66. ******************************************************************************
  67. ******************************************************************************
  68.  
  69.  
  70. * Function summary:
  71.  
  72. *    lj_inch2dots(inches)                        Convert inches to printer dots
  73. *    lj_gotoxy(x,y)                              Absolute position in inches
  74. *    lj_gotorc(r,c)                              Absolute position in columns
  75. *    lj_move(delta_x,delta_y)                    Relative move 
  76. *    lj_fill(width,height,fill)                  Fills rectangular area
  77. *    lj_line(length,thickness,orientation,fill)  Draws lines
  78. *    lj_box(width,height,thickness,fill)         Draws boxes
  79. *    lj_say(row,col,string)                      Just like "@ R,C say..."
  80.  
  81. * These arguments are real numbers (inches:
  82. *    width, length, thickness, height, x, y, delta_x, delta_y, inches
  83.  
  84. * These arguments are character strings:
  85. *    fill, orientation, string
  86.  
  87. * These arguments are integers:
  88. *    row, col
  89.  
  90.  
  91.  
  92. *────────────────────────────────────────────────────────────────────────────┐
  93. * FUNCTION NAME: lj_inch2dots                                                │
  94. *    PARAMETERS: inches                                                      │
  95. *       RETURNS: Character string of the integer equivalent printer dots     │
  96. *                at 300 DPI.                                                 │
  97. *   DESCRIPTION: Obvious. Mainly intended for internal use.                  │
  98. *       EXAMPLE: foo = lj_inch2dots(3.56) [returns the string "1068"]        │
  99. *────────────────────────────────────────────────────────────────────────────┘
  100.  
  101. function lj_inch2dots
  102.   parameters inches
  103. return alltrim(str(300.0 * inches,10))
  104.  
  105.  
  106.  
  107.  
  108. *────────────────────────────────────────────────────────────────────────────┐
  109. * FUNCTION NAME: lj_gotoxy                      ∙──> +x                      │
  110. *    PARAMETERS: x & y location in inches       │                            │
  111. *       RETURNS: Nothing.                       V +y                         │
  112. *   DESCRIPTION: Moves LJ cursor to the absolute x and y values passed.      │
  113. *       EXAMPLE: lj_gotoxy(4.25,5.5)  [about the middle of the page]         │
  114. *────────────────────────────────────────────────────────────────────────────┘
  115.  
  116. function lj_gotoxy                                                           
  117.   parameters x, y      && real numbers in inches
  118.   private null, row
  119.   null = ""
  120.   ** save Clipper printer position pointer 
  121.   row = prow()           
  122.   col = pcol()
  123.   ?? chr(27) + "*p" + lj_inch2dots(x) + "x" + lj_inch2dots(y) + "Y"
  124.   ** restore Clipper printer position pointer 
  125.   setprc(row,col)         && restore printer row and col
  126. return null
  127.  
  128.  
  129.  
  130.  
  131. *────────────────────────────────────────────────────────────────────────────┐
  132. * FUNCTION NAME: lj_move                                ∙──> +x              │
  133. *    PARAMETERS: deltax, deltay (in inches)             │                    │
  134. *       RETURNS: Nothing.                               V +y                 │
  135. *   DESCRIPTION: Moves LJ "cursor" a relative amount.                        │
  136. *       EXAMPLE: lj_move(1.0,-2.5)  moves the cursor right 1.0" and up 2.5"  │
  137. *          NOTE: Positive amounts move the cursor right or down, negative    │
  138. *                move the cursor left or up.                                 │
  139. *────────────────────────────────────────────────────────────────────────────┘
  140.  
  141. function lj_move 
  142.   parameters dx, dy      && real numbers in inches
  143.   private null, row, col
  144.   null = ""
  145.   ** save Clipper printer position pointer 
  146.   row = prow()           
  147.   col = pcol()
  148.   ?? chr(27) + "*p" + if(dx >= 0.0,"+","") + lj_inch2dots(dx) + "x" + ;
  149.                       if(dy >= 0.0,"+","") + lj_inch2dots(dy) + "Y"
  150.   ** restore Clipper printer position pointer 
  151.   setprc(row,col)         
  152. return null
  153.  
  154.  
  155.  
  156.  
  157.  
  158. *─────────────────────────────────────────────────────────────────────────────┐
  159. * FUNCTION NAME: lj_fill                                                      │
  160. *    PARAMETERS: width, height, fill                                          │
  161. *       RETURNS: Nothing.                                                     │
  162. *   DESCRIPTION: Fills a rectangular area with the specified pattern at the   │
  163. *                current cursor positon. Specify a gray pattern by passing    │
  164. *                a string between "0" and "100" (0=white, 100=black, 1..99    │
  165. *                are levels of gray) or specify a fill pattern with "#1"      │
  166. *                "#6".                                                        │
  167. *       EXAMPLE: lj_fill(1.5, 2.5,"#6") will create a 1.5" wide by 2.5"       │
  168. *                high rectangle filled with HP pattern 6 (crosshatching).     │
  169. *─────────────────────────────────────────────────────────────────────────────┘
  170.  
  171. function lj_fill
  172.   parameters width, height, fill
  173.   private null, row, col, s
  174.   null = ""
  175.   * cleanup parameters
  176.   fill = alltrim(fill)
  177.   ** save Clipper printer position pointer 
  178.   row = prow()           
  179.   col = pcol()
  180.   s = chr(27) + "*c"                       && PCL prefix for area fill
  181.   s = s + lj_inch2dots(width) + "a"        && spec horizontal size....
  182.   s = s + lj_inch2dots(height) + "b"       && spec vertical size....
  183.   if left(fill,1) == "#"                   && fixed pattern is desired 
  184.     s = s + right(fill,1) + 'g3P'          && so strip the "#" character
  185.   else                                     && some shade of gray requested
  186.     if val(fill) = 0                       && "white" is spec'd differently
  187.       s = s + 'g1P'                        && white fill is LJ IIP specific! 
  188.     else                                   && gray or black fill
  189.       s = s + fill + 'g2P'  
  190.     endif
  191.   endif
  192.   ?? s                             && now send the entire string
  193.   setprc(row,col)                  && restore Clipper printer position pointer 
  194. return null
  195.  
  196.  
  197.  
  198. *─────────────────────────────────────────────────────────────────────────────┐
  199. * FUNCTION NAME: lj_line                                                      │
  200. *    PARAMETERS: length, thickness, orientation, fill                         │
  201. *       RETURNS: Nothing.                                                     │
  202. *   DESCRIPTION: Draws lines as specified either horizontal or vertical       │
  203. *                at the current cursor position with the specified fill       │
  204. *                pattern.                                                     │
  205. *          NOTE: A negative length will draw a line to the left               │
  206. *                or up from the current cursor position.                      │
  207. *       EXAMPLE: lj_line(2.5, .01, "H", "20")                                 │
  208. *                                                                             │
  209. *     ∙───────┐┬                         ∙┐┬                                  │
  210. *     └───────┘┼   "H" orientation       │││                                  │
  211. *     ├── L ──┤│                         ││L      "V" orientation             │
  212. *              └ T                       │││                                  │
  213. *                                        └┘┴                                  │
  214. *                                        ├┼─── T                              │
  215. *   ["∙" is the current cursor position]                                      │
  216. *─────────────────────────────────────────────────────────────────────────────┘
  217.  
  218. function lj_line
  219.   parameters length, thickness, orientation, fill
  220.   private null 
  221.   null = ""
  222.   * clean up parameters
  223.   thickness = abs(thickness)
  224.   orientation = upper(left(alltrim(orientation),1))           
  225.   fill = alltrim(fill)
  226.   * figure out how far (relative) we have to move first
  227.   * then use the lj_fill() function to do most of the work
  228.   do case
  229.     case orientation = "H"      
  230.        if length >= 0.0      
  231.          lj_fill(length, thickness, fill)       && draw to the right
  232.        else 
  233.          lj_move(length, 0.0)                   && move left first 
  234.          lj_fill(abs(length), thickness, fill)
  235.        endif
  236.     case orientation = "V" 
  237.        if length >= 0.0      
  238.          lj_fill(thickness, length, fill)       && draw downward 
  239.        else 
  240.          lj_move(0.0, length)                   && move up first 
  241.          lj_fill(thickness, abs(length), fill)
  242.        endif
  243.   endcase
  244. return null
  245.  
  246.  
  247.  
  248.  
  249. *────────────────────────────────────────────────────────────────────────────┐
  250. * FUNCTION NAME: lj_box                                                      │
  251. *    PARAMETERS: width, height, thickness, pattern                           │
  252. *       RETURNS: Nothing.                                                    │
  253. *   DESCRIPTION: Draws a rectangular box at the current cursor postion.      │
  254. *                The current cursor position is the uppe left hand corner.   │
  255. *       EXAMPLE: lj_box(4.0,1.0,.02,"20") will draw a box 4" wide, 1" high   │
  256. *                with .02" wide lines of 20% gray                            │
  257. *          NOTE: Using a gray pattern with thin lines (2 or 3 printer dots)  │
  258. *                sometimes results in invisible lines if you happen to be    │
  259. *                filling with the "white" part of the gray pattern!          │
  260. *────────────────────────────────────────────────────────────────────────────┘
  261.  
  262. function lj_box
  263.   parameters width, height, thickness, pattern
  264.   private null
  265.   null = ""
  266.   * cleanup parameters
  267.   width = abs(width)
  268.   height = abs(height)
  269.   thickness = abs(thickness)
  270.   pattern = upper(alltrim(pattern))           
  271.   lj_line(width,thickness,"H",pattern)     && draw top line first
  272.   lj_line(height,thickness,"V",pattern)    && left side line
  273.   lj_move(width-thickness,0.0)             && move to the right side
  274.   lj_line(height,thickness,"V", pattern)   && right side line
  275.   lj_move(thickness,height-thickness)      && move over and down
  276.   lj_line(-width,thickness,"H",pattern)    && finally, the bottom line
  277. return null
  278.  
  279.  
  280.  
  281. *────────────────────────────────────────────────────────────────────────────┐
  282. * FUNCTION NAME: lj_gotorc                                                   │
  283. *    PARAMETERS: row and comlumn location (in characters)                    │
  284. *       RETURNS: Nothing.                                                    │
  285. *   DESCRIPTION: Moves LJ cursor to the absolute r and c values (0,0 = upper │
  286. *                left corner of logical page                                 │
  287. *       EXAMPLE: lj_gotoxy(40,30)  [about the middle of the page]            │
  288. *────────────────────────────────────────────────────────────────────────────┘
  289.  
  290. function lj_gotorc
  291.   parameters r, c                && assume these are integers        
  292.   private null, row, rs, cs
  293.   null = ""
  294.   ** save Clipper printer position pointer 
  295.   row = prow()           
  296.   col = pcol()
  297.   rs = ltrim(str(r,4))
  298.   cs = ltrim(str(c,4))
  299.   ?? chr(27) + "&a" + rs + "r" + cs + "C"
  300.   setprc(row,col)         && restore printer row and col
  301. return null
  302.  
  303.  
  304.  
  305. *────────────────────────────────────────────────────────────────────────────┐
  306. * FUNCTION NAME: lj_say               (as in "@ r,c say...")                 │
  307. *    PARAMETERS: row, column, string      (in characters)                    │
  308. *       RETURNS: Nothing.                                                    │
  309. *                                                                            │
  310. *   DESCRIPTION: Moves LJ cursor to the absolute r and c values (0,0 = upper │
  311. *                left corner of logical page and prints the string.          │
  312. *       EXAMPLE: lj_gotoxy(40,30,"Hello")  [about the middle of the page]    │
  313. *────────────────────────────────────────────────────────────────────────────┘
  314.  
  315. function lj_say
  316.   parameters r, c, string      && integer columns        
  317.   private null
  318.   null = ""
  319.   ** save Clipper printer position pointer 
  320.   row = prow()           
  321.   col = pcol()
  322.   lj_gotorc(r,c)
  323.   ?? string
  324.   ** restore Clipper printer position pointer 
  325.   setprc(row,col)     
  326. return null
  327.  
  328.  
  329.