(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 8-Oct-92 16:50:21" "{Pele:mv:envos}library>HRULE.;11" 23325 changes to%: (FNS VRULE.CREATE VRULE.GETFN2) previous date%: "29-Sep-92 21:06:13" "{Pele:mv:envos}library>HRULE.;10") (* ; " Copyright (c) 1985, 1990, 1991, 1992 by Venue & Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT HRULECOMS) (RPAQQ HRULECOMS [[COMS (* ;; "Horizontal rules") (FNS HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN HRULE.WHENOPERATEDONFN) (INITVARS (HRULE.DEFAULT.WIDTH 2)) (VARS (HRULEFNS '(HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN HRULE.WHENOPERATEDONFN)) (HRULE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN) (FUNCTION HRULE.IMAGEBOXFN) (FUNCTION HRULE.PUTFN) (FUNCTION HRULE.GETFN) (FUNCTION HRULE.COPYFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION HRULE.WHENOPERATEDONFN) (FUNCTION NILL] [COMS (* ;; "Vertical rules") (FNS VRULE.CREATE VRULE.DISPLAYFN VRULE.GETFN VRULE.GETFN2 VRULE.IMAGEBOXFN VRULE.PUTFN VRULE.COPYFN VRULE.WHENOPERATEDONFN) (INITVARS (VRULE.DEFAULT.HEIGHT 12)) [VARS (VRULE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION VRULE.DISPLAYFN) (FUNCTION VRULE.IMAGEBOXFN) (FUNCTION VRULE.PUTFN) (FUNCTION VRULE.GETFN2) (FUNCTION VRULE.COPYFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION VRULE.WHENOPERATEDONFN) (FUNCTION NILL] (* ;; "Old fixed-width-rule reader:") (ADDVARS (IMAGEOBJGETFNS (VRULE.GETFN] (COMS (* ;; "Cropping marks") (FNS CROPMARK.CREATE CROPMARK.DISPLAYFN CROPMARK.GETFN CROPMARK.IMAGEBOXFN CROPMARK.PUTFN CROPMARK.COPYFN CROPMARK.WHENOPERATEDONFN) (BITMAPS CROPMARK.IMAGE) (INITVARS (CROPMARK.DEFAULT.PAGESIZE (LIST 612 792))) (VARS (CROPMARK.IMAGEFNS (IMAGEFNSCREATE (FUNCTION CROPMARK.DISPLAYFN) (FUNCTION CROPMARK.IMAGEBOXFN) (FUNCTION CROPMARK.PUTFN) (FUNCTION CROPMARK.GETFN) (FUNCTION CROPMARK.COPYFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION CROPMARK.WHENOPERATEDONFN) (FUNCTION NILL]) (* ;; "Horizontal rules") (DEFINEQ (HRULE.CREATE [LAMBDA (WIDTH) (* jds "11-Sep-85 16:36") (* * Create a Horizontal-Rule image object.  WIDTH may be NIL to default, a number, for a single rule with its width in  points (and fractions thereof)%, or a list of alternating black and white  widths. E.g., to get a hairline over 1pt white over 3pt rule, specify  (0.5 1 3)) (PROG ((HRULE (IMAGEOBJCREATE NIL HRULE.IMAGEFNS))) (COND ((NOT WIDTH) (* USe the default width) (IMAGEOBJPROP HRULE 'RULE.WIDTH HRULE.DEFAULT.WIDTH) (RETURN HRULE)) ((NUMBERP WIDTH) (IMAGEOBJPROP HRULE 'RULE.WIDTH WIDTH) (RETURN HRULE)) ((AND (LISTP WIDTH) (EVERY WIDTH (FUNCTION NUMBERP))) (* It's a list of numbers.  Add (QUOTE em) up) (IMAGEOBJPROP HRULE 'RULE.WIDTH WIDTH) (RETURN HRULE)) (T (* Something was specified, and  there was a non-number in it...) (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Non-numeric widths not desirable: " WIDTH) T]) (HRULE.DISPLAYFN [LAMBDA (HRULE IMAGE.STREAM) (* jds "17-Oct-85 11:35") (* function which displays the bitmap of the hrule on the display or calls an  {inter}press function to draw the rule on a file) (LET* ((RULEWIDTH (IMAGEOBJPROP HRULE 'RULE.WIDTH)) (WIDTHS (COND ((LISTP RULEWIDTH) (REVERSE RULEWIDTH)) (T RULEWIDTH))) (SCALE (DSPSCALE NIL IMAGE.STREAM)) (X (DSPXPOSITION NIL IMAGE.STREAM)) (Y (DSPYPOSITION NIL IMAGE.STREAM))) (bind [RULING _ (OR (NLISTP WIDTHS) (ODDP (FLENGTH WIDTHS] for THICKNESS inside WIDTHS do (* * Run thru the list of alternating rules and spaces %.  Display the rules, and skip over the spaces) [SETQ WIDTH (IMAX 1 (FIXR (FTIMES SCALE THICKNESS] (* Compute the width of this piece,  in stream units.) [COND (RULING (* If we're supposed to be drawing,  draw the line) (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM) (DISPLAY (BITBLT NIL 0 0 IMAGE.STREAM X Y (fetch XSIZE of (IMAGEOBJPROP HRULE 'BOUNDBOX)) WIDTH 'TEXTURE 'PAINT BLACKSHADE)) (DRAWLINE X (IPLUS Y (LRSH WIDTH 1)) [IPLUS X (fetch XSIZE of (IMAGEOBJPROP HRULE 'BOUNDBOX] (IPLUS Y (LRSH WIDTH 1)) WIDTH 'PAINT IMAGE.STREAM] (add Y WIDTH) (SETQ RULING (NOT RULING]) (HRULE.GETFN [LAMBDA (INPUT.STREAM TEXTSTREAM) (* gbn "10-Jan-85 02:56") (* reads the width and creates an  HRULE) (HRULE.CREATE (READ INPUT.STREAM]) (HRULE.IMAGEBOXFN [LAMBDA (HRULE IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* jds "11-Sep-85 17:12") (* returns an imagebox describing  the size of the scaled bitmap.  without caching) (LET [(SCALE (DSPSCALE NIL IMAGE.STREAM)) (WIDTHS (IMAGEOBJPROP HRULE 'RULE.WIDTH] (create IMAGEBOX XSIZE _ (IMAX (IDIFFERENCE RIGHT.MARGIN CURRENT.X) 0) YSIZE _ [for THICKNESS inside WIDTHS sum (IMAX 1 (FIXR (FTIMES SCALE THICKNESS] YDESC _ 0 XKERN _ 0]) (HRULE.PUTFN [LAMBDA (HRULE OUTPUT.STREAM) (* gbn "13-May-84 14:21") (* prints only the rule.width to the  file, the rest can be discovered) (PRINT (IMAGEOBJPROP HRULE 'RULE.WIDTH) OUTPUT.STREAM]) (HRULE.COPYFN [LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM) (* jds "22-Feb-85 13:56") (* This function does not build the  bitmap but lets the imageboxfn cache  a bitmap) (HRULE.CREATE (IMAGEOBJPROP IMAGEOBJ 'RULE.WIDTH) TOSTREAM]) (HRULE.WHENOPERATEDONFN [LAMBDA (A B C C) (* gbn " 6-Jan-85 13:23") (* DUMMY) ]) ) (RPAQ? HRULE.DEFAULT.WIDTH 2) (RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN HRULE.WHENOPERATEDONFN)) (RPAQ HRULE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION HRULE.DISPLAYFN) (FUNCTION HRULE.IMAGEBOXFN) (FUNCTION HRULE.PUTFN) (FUNCTION HRULE.GETFN) (FUNCTION HRULE.COPYFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION HRULE.WHENOPERATEDONFN) (FUNCTION NILL))) (* ;; "Vertical rules") (DEFINEQ (VRULE.CREATE [LAMBDA (WIDTH HEIGHT DASHING) (* ;  "Edited 8-Oct-92 16:46 by sybalsky:mv:envos") (* ;; "Create a Vertical-Rule image object. HEIGHT may be NIL to default, a number, for a single rule with its width in points (and fractions thereof), or a list of alternating black and white widths. E.g., to get a hairline over 1pt white over 3pt rule, specify (0.5 1 3)") (PROG ((VRULE (IMAGEOBJCREATE NIL VRULE.IMAGEFNS))) (COND ((NOT WIDTH) (* ; "Use the default width") (IMAGEOBJPROP VRULE 'RULE.WIDTH 0.5)) ((NUMBERP WIDTH) (IMAGEOBJPROP VRULE 'RULE.WIDTH WIDTH)) ((AND (LISTP WIDTH) (EVERY WIDTH (FUNCTION NUMBERP))) (* ;  "It's a list of numbers. Add 'em up") (IMAGEOBJPROP VRULE 'RULE.WIDTH WIDTH))) (COND ((NOT HEIGHT) (* ; "Use the default width") (IMAGEOBJPROP VRULE 'RULE.HEIGHT VRULE.DEFAULT.HEIGHT) (RETURN VRULE)) ((NUMBERP HEIGHT) (IMAGEOBJPROP VRULE 'RULE.HEIGHT HEIGHT) (RETURN VRULE)) ((AND (LISTP HEIGHT) (EVERY HEIGHT (FUNCTION NUMBERP))) (* ;  "It's a list of numbers. Add 'em up") (IMAGEOBJPROP VRULE 'RULE.HEIGHT HEIGHT) (RETURN VRULE)) (T (* ;  "Something was specified, and there was a non-number in it...") (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Non-numeric widths not desirable: " HEIGHT) T))) (IMAGEOBJPROP VRULE 'RULE.DASHING DASHING]) (VRULE.DISPLAYFN [LAMBDA (HRULE IMAGE.STREAM) (* ; "Edited 29-Sep-92 21:01 by jds") (* ;; "function which displays the bitmap of the hrule on the display or calls an {inter}press function to draw the rule on a file") (LET* ((RULEHEIGHT (IMAGEOBJPROP HRULE 'RULE.HEIGHT)) (WIDTHS (OR (IMAGEOBJPROP HRULE 'RULE.WIDTH) 0.5)) (SCALE (DSPSCALE NIL IMAGE.STREAM)) (REALHEIGHT (FIXR (FTIMES SCALE RULEHEIGHT))) (X (DSPXPOSITION NIL IMAGE.STREAM)) (Y (DSPYPOSITION NIL IMAGE.STREAM))) (bind [RULING _ (OR (NLISTP WIDTHS) (ODDP (FLENGTH WIDTHS] WIDTH for THICKNESS inside WIDTHS do (* ;;; "Run thru the list of alternating rules and spaces . Display the rules, and skip over the spaces") [SETQ WIDTH (IMAX 1 (FIXR (FTIMES SCALE THICKNESS] (* ;  "Compute the width of this piece, in stream units.") [COND (RULING (* ;  "If we're supposed to be drawing, draw the line") (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM) (DISPLAY (BITBLT NIL 0 0 IMAGE.STREAM X Y 1 6 'TEXTURE 'PAINT BLACKSHADE)) (DRAWLINE (IPLUS X (LRSH WIDTH 1)) Y (IPLUS X (LRSH WIDTH 1)) (IDIFFERENCE Y (CL:IF (>= REALHEIGHT 0) (IMAX 1 REALHEIGHT) (IMIN -1 REALHEIGHT))) WIDTH 'PAINT IMAGE.STREAM] (add X WIDTH) (SETQ RULING (NOT RULING]) (VRULE.GETFN [LAMBDA (INPUT.STREAM TEXTSTREAM) (* ; "Edited 15-May-91 13:20 by jds") (* ;; "reads the width and creates a VRULE") (VRULE.CREATE 0.5 (READ INPUT.STREAM]) (VRULE.GETFN2 [LAMBDA (INPUT.STREAM TEXTSTREAM) (* ;  "Edited 8-Oct-92 16:46 by sybalsky:mv:envos") (* ;; "reads the width and creates a VRULE") (VRULE.CREATE (READ INPUT.STREAM) (READ INPUT.STREAM) (READ INPUT.STREAM]) (VRULE.IMAGEBOXFN [LAMBDA (HRULE IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* ; "Edited 30-Apr-91 00:06 by jds") (* ;; "returns an imagebox describing the size of the scaled bitmap. without caching") (LET ((SCALE (DSPSCALE NIL IMAGE.STREAM)) (WIDTHS 0.5)) (create IMAGEBOX XSIZE _ 0 YSIZE _ 1 YDESC _ 0 XKERN _ 0]) (VRULE.PUTFN [LAMBDA (HRULE OUTPUT.STREAM) (* ; "Edited 6-Jul-92 07:02 by jds") (* ;; "prints WIDTH, HEIGHT and DASHING to the file.") (PRINT (IMAGEOBJPROP HRULE 'RULE.WIDTH) OUTPUT.STREAM) (PRINT (IMAGEOBJPROP HRULE 'RULE.HEIGHT) OUTPUT.STREAM) (PRINT (IMAGEOBJPROP HRULE 'RULE.DASHING) OUTPUT.STREAM]) (VRULE.COPYFN [LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM) (* ; "Edited 5-Jul-92 17:03 by jds") (* ;  "This function does not build the bitmap but lets the imageboxfn cache a bitmap") (VRULE.CREATE (IMAGEOBJPROP IMAGEOBJ 'RULE.WIDTH) (IMAGEOBJPROP IMAGEOBJ 'RULE.HEIGHT]) (VRULE.WHENOPERATEDONFN [LAMBDA (A B C C) (* gbn " 6-Jan-85 13:23") (* DUMMY) ]) ) (RPAQ? VRULE.DEFAULT.HEIGHT 12) (RPAQ VRULE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION VRULE.DISPLAYFN) (FUNCTION VRULE.IMAGEBOXFN) (FUNCTION VRULE.PUTFN) (FUNCTION VRULE.GETFN2) (FUNCTION VRULE.COPYFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION VRULE.WHENOPERATEDONFN) (FUNCTION NILL))) (* ;; "Old fixed-width-rule reader:") (ADDTOVAR IMAGEOBJGETFNS (VRULE.GETFN)) (* ;; "Cropping marks") (DEFINEQ (CROPMARK.CREATE [LAMBDA (WIDTH HEIGHT) (* ; "Edited 5-Jun-91 14:56 by jds") (* ;; "Create a CROPMARK, that prints crop-marks for a page that is WIDTH points wide and HEIGHT points high.") (PROG ((CROPMARK (IMAGEOBJCREATE NIL CROPMARK.IMAGEFNS))) (COND ((NOT HEIGHT) (* ; "Use the default width") (IMAGEOBJPROP CROPMARK 'PAGE.SIZE CROPMARK.DEFAULT.PAGESIZE) (RETURN CROPMARK)) ((NUMBERP HEIGHT) (IMAGEOBJPROP CROPMARK 'PAGE.SIZE (LIST WIDTH HEIGHT)) (RETURN CROPMARK)) ((AND (LISTP HEIGHT) (EVERY HEIGHT (FUNCTION NUMBERP))) (* ;  "It's a list of numbers. Add 'em up") (IMAGEOBJPROP CROPMARK 'PAGE.SIZE (LIST WIDTH HEIGHT)) (RETURN CROPMARK)) (T (* ;  "Something was specified, and there was a non-number in it...") (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Non-numeric widths not desirable: " HEIGHT) T]) (CROPMARK.DISPLAYFN [LAMBDA (CROPMARK IMAGE.STREAM) (* ; "Edited 5-Jun-91 15:05 by jds") (* ;; "function which displays the bitmap of the hrule on the display or calls an {inter}press function to draw the rule on a file") (LET* [(PAGESIZE (IMAGEOBJPROP CROPMARK 'PAGE.SIZE)) (WIDTH (CAR PAGESIZE)) (HEIGHT (CADR PAGESIZE)) (SCALE (DSPSCALE NIL IMAGE.STREAM)) (THICK (IMAX 1 (FIXR (FTIMES SCALE 0.5] (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM) (DISPLAY (BITBLT CROPMARK.IMAGE 0 0 IMAGE.STREAM (DSPXPOSITION NIL IMAGE.STREAM) (DSPYPOSITION NIL IMAGE.STREAM) 9 9 'INPUT 'PAINT)) (PROGN (DRAWLINE -12 0 0 0 THICK 'PAINT IMAGE.STREAM) (DRAWLINE 0 -12 0 0 THICK 'PAINT IMAGE.STREAM) (DRAWLINE -12 HEIGHT 0 HEIGHT THICK 'PAINT IMAGE.STREAM) (DRAWLINE 0 (+ 12 HEIGHT) 0 HEIGHT THICK 'PAINT IMAGE.STREAM) (DRAWLINE (+ WIDTH 12) 0 WIDTH 0 THICK 'PAINT IMAGE.STREAM) (DRAWLINE WIDTH -12 WIDTH 0 THICK 'PAINT IMAGE.STREAM) (DRAWLINE (+ WIDTH 12) HEIGHT WIDTH HEIGHT THICK 'PAINT IMAGE.STREAM) (DRAWLINE WIDTH (+ 12 HEIGHT) WIDTH HEIGHT THICK 'PAINT IMAGE.STREAM]) (CROPMARK.GETFN [LAMBDA (INPUT.STREAM TEXTSTREAM) (* ; "Edited 5-Jun-91 15:06 by jds") (* ;; "reads the width and creates a VRULE") (LET ((PAGESIZE (READ INPUT.STREAM))) (VRULE.CREATE (CAR PAGESIZE) (CADR PAGESIZE]) (CROPMARK.IMAGEBOXFN [LAMBDA (HRULE IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* ; "Edited 5-Jun-91 15:07 by jds") (* ;; "returns an imagebox describing the size of the scaled bitmap. without caching") (LET ((SCALE (DSPSCALE NIL IMAGE.STREAM)) (WIDTHS 0.5)) (SELECTQ (IMAGESTREAMTYPE IMAGE.STREAM) (DISPLAY (create IMAGEBOX XSIZE _ 9 YSIZE _ 9 YDESC _ 0 XKERN _ 0)) (create IMAGEBOX XSIZE _ 0 YSIZE _ 0 YDESC _ 0 XKERN _ 0]) (CROPMARK.PUTFN [LAMBDA (HRULE OUTPUT.STREAM) (* ; "Edited 5-Jun-91 15:08 by jds") (* ;; "prints only the rule.width to the file, the rest can be discovered") (PRINT (IMAGEOBJPROP HRULE 'PAGE.SIZE) OUTPUT.STREAM]) (CROPMARK.COPYFN [LAMBDA (IMAGEOBJ FROMSTREAM TOSTREAM) (* ; "Edited 5-Jun-91 15:09 by jds") (* ;  "This function does not build the bitmap but lets the imageboxfn cache a bitmap") (CROPMARK.CREATE (IMAGEOBJPROP IMAGEOBJ 'RULE.HEIGHT) TOSTREAM]) (CROPMARK.WHENOPERATEDONFN [LAMBDA (A B C C) (* gbn " 6-Jan-85 13:23") (* DUMMY) ]) ) (RPAQQ CROPMARK.IMAGE #*(9 9)CN@@DI@@HHH@HHH@OOH@HHH@HHH@DI@@CN@@) (RPAQ? CROPMARK.DEFAULT.PAGESIZE (LIST 612 792)) (RPAQ CROPMARK.IMAGEFNS (IMAGEFNSCREATE (FUNCTION CROPMARK.DISPLAYFN) (FUNCTION CROPMARK.IMAGEBOXFN) (FUNCTION CROPMARK.PUTFN) (FUNCTION CROPMARK.GETFN) (FUNCTION CROPMARK.COPYFN) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION NILL) (FUNCTION CROPMARK.WHENOPERATEDONFN) (FUNCTION NILL))) (PUTPROPS HRULE COPYRIGHT ("Venue & Xerox Corporation" 1985 1990 1991 1992)) (DECLARE%: DONTCOPY (FILEMAP (NIL (4225 10404 (HRULE.CREATE 4235 . 5657) (HRULE.DISPLAYFN 5659 . 8228) (HRULE.GETFN 8230 . 8550) (HRULE.IMAGEBOXFN 8552 . 9354) (HRULE.PUTFN 9356 . 9734) (HRULE.COPYFN 9736 . 10200) ( HRULE.WHENOPERATEDONFN 10202 . 10402)) (11107 17312 (VRULE.CREATE 11117 . 13116) (VRULE.DISPLAYFN 13118 . 15312) (VRULE.GETFN 15314 . 15535) (VRULE.GETFN2 15537 . 15873) (VRULE.IMAGEBOXFN 15875 . 16303) (VRULE.PUTFN 16305 . 16703) (VRULE.COPYFN 16705 . 17108) (VRULE.WHENOPERATEDONFN 17110 . 17310) ) (17951 22601 (CROPMARK.CREATE 17961 . 19228) (CROPMARK.DISPLAYFN 19230 . 20730) (CROPMARK.GETFN 20732 . 21026) (CROPMARK.IMAGEBOXFN 21028 . 21729) (CROPMARK.PUTFN 21731 . 22009) (CROPMARK.COPYFN 22011 . 22394) (CROPMARK.WHENOPERATEDONFN 22396 . 22599))))) STOP