(FILECREATED "17-Oct-85 11:39:25" {ERIS}<TEDIT>IMAGEOBJS>HRULE.;8 6771 changes to: (FNS HRULE.DISPLAYFN) previous date: "26-Sep-85 10:50:49" {ERIS}<TEDIT>IMAGEOBJS>HRULE.;7) (* Copyright (c) 1985 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT HRULECOMS) (RPAQQ HRULECOMS [(FNS * HRULEFNS) (INITVARS (HRULE.DEFAULT.WIDTH 2)) (VARS (HRULEFNS (QUOTE (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]) (RPAQQ HRULEFNS (HRULE.CREATE HRULE.DISPLAYFN HRULE.GETFN HRULE.IMAGEBOXFN HRULE.PUTFN HRULE.COPYFN HRULE.WHENOPERATEDONFN)) (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 (.5 1 3)) (PROG ((HRULE (IMAGEOBJCREATE NIL HRULE.IMAGEFNS))) (COND ((NOT WIDTH) (* USe the default width) (IMAGEOBJPROP HRULE (QUOTE RULE.WIDTH) HRULE.DEFAULT.WIDTH) (RETURN HRULE)) ((NUMBERP WIDTH) (IMAGEOBJPROP HRULE (QUOTE RULE.WIDTH) WIDTH) (RETURN HRULE)) ((AND (LISTP WIDTH) (EVERY WIDTH (FUNCTION NUMBERP))) (* It's a list of numbers. Add (QUOTE em) up) (IMAGEOBJPROP HRULE (QUOTE 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 (QUOTE 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 (QUOTE BOUNDBOX))) WIDTH (QUOTE TEXTURE) (QUOTE PAINT) BLACKSHADE)) (DRAWLINE X (IPLUS Y (LRSH WIDTH 1)) [IPLUS X (fetch XSIZE of (IMAGEOBJPROP HRULE (QUOTE BOUNDBOX] (IPLUS Y (LRSH WIDTH 1)) WIDTH (QUOTE 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 (QUOTE 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 (QUOTE 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 (QUOTE 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))) (PUTPROPS HRULE COPYRIGHT ("Xerox Corporation" 1985)) (DECLARE: DONTCOPY (FILEMAP (NIL (1084 6078 (HRULE.CREATE 1094 . 2403) (HRULE.DISPLAYFN 2405 . 4294) (HRULE.GETFN 4296 . 4556) (HRULE.IMAGEBOXFN 4558 . 5179) (HRULE.PUTFN 5181 . 5512) (HRULE.COPYFN 5514 . 5874) ( HRULE.WHENOPERATEDONFN 5876 . 6076))))) STOP