diff --git a/library/BIGBITMAPS b/library/BIGBITMAPS index a94840329..833f554e2 100644 --- a/library/BIGBITMAPS +++ b/library/BIGBITMAPS @@ -1,28 +1,34 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "31-Jul-2023 13:39:50" |{WMEDLEY}BIGBITMAPS.;13| 109376 +(FILECREATED "30-Sep-2025 19:20:23" |{DSK}frank>il>qmedley>library>BIGBITMAPS.;1| 102572 - :EDIT-BY |rmk| + :EDIT-BY "FGH" :CHANGES-TO (VARS BIGBITMAPSCOMS) - (FNS BIGBITMAPEQUAL) + (RECORDS BIGBM) + (MACROS |GetNewFragment|) + (FNS BIGBITMAPP BITBLT.BIGBM BITMAPCREATE.BIGBM BITMAPCREATE BITMAPCOPY + BIGBITMAPEQUAL BLTSHADE.BIGBM BITBLT \\ORG.BITBLT \\BLTSHADE.DISPLAY + \\RESHOWBORDER1 \\DRAWCIRCLE.BIGBM \\FILLCIRCLE.BIGBM \\DRAWELLIPSE.BIGBM + \\DRAWCURVE.BIGBM \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH + \\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM DSPDESTINATION |\\SFFixY| + |\\SFFixDestination| |\\SFFixClippingRegion| \\SW2BM BITMAPHEIGHT BITMAPWIDTH + |\\SFFixFont| BITSPERPIXEL COLORIZEBITMAP \\BWTOCOLORBLT UNCOLORIZEBITMAP) - :PREVIOUS-DATE " 9-Jul-2022 09:41:26" |{WMEDLEY}BIGBITMAPS.;12|) + :PREVIOUS-DATE "30-Sep-2025 18:49:17" |{DSK}frank>il>qmedley>library>BIGBITMAPS.;1|) -; Copyright (c) 1991, 1993-1994 by Venue. - (PRETTYCOMPRINT BIGBITMAPSCOMS) (RPAQQ BIGBITMAPSCOMS - ((DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BIGBM) + ((DECLARE\: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS BIGBM)) (CONSTANTS (|\\MaxBitMapHeight| 65535) (|\\MaxBitMapWidth| 65535) (|\\MaxBitMapWords| 131066)) (MACROS |GetNewFragment|) (MACROS |\\SFInvert|)) (INITRECORDS BIGBM) - (FNS BIGBITMAPP BITBLT.BIGBM BITMAPCREATE.BIGBM BITMAPCREATE BITMAPCOPY BIGBITMAPEQUAL + (FNS BIGBITMAPP BITBLT.BIGBM BITMAPCREATE.BIGBME BITMAPCREATE BITMAPCOPY BIGBITMAPEQUAL BLTSHADE.BIGBM BITBLT \\ORG.BITBLT \\BLTSHADE.DISPLAY \\RESHOWBORDER1) (FNS \\DRAWCIRCLE.BIGBM \\FILLCIRCLE.BIGBM \\DRAWELLIPSE.BIGBM \\DRAWCURVE.BIGBM \\DRAWLINE.BIGBM.DASH \\DRAWLINE.BIGBM.NODASH) @@ -37,7 +43,7 @@ (MOVD 'BLTSHADE.BIGBM 'BLTSHADE) (MOVD 'BITBLT 'BKBITBLT))))) (DECLARE\: EVAL@COMPILE DONTCOPY -(DECLARE\: EVAL@COMPILE +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE\: EVAL@COMPILE (DATATYPE BIGBM (BIGBMWIDTH BIGBMHEIGHT BIGBMLIST)) ) @@ -48,6 +54,9 @@ (BIGBM 4 POINTER)) '6) +(* "END EXPORTED DEFINITIONS") + + (DECLARE\: EVAL@COMPILE (RPAQQ |\\MaxBitMapHeight| 65535) @@ -92,12 +101,12 @@ (DEFINEQ (BIGBITMAPP - (LAMBDA (X) (* \; "Edited 13-Jun-2021 13:27 by rmk:") - (TYPE? BIGBM X))) + (LAMBDA (X) (* \; "Edited 13-Jun-2021 13:27 by rmk:") + (|type?| BIGBM X))) (BITBLT.BIGBM (LAMBDA (SRCE SRCELEFT SRCEBOTTOM DEST DESTLEFT DESTBOTTOM WIDTH HEIGHT SRCETYPE OPERATION TEXTURE - CLIPPINGREGION) (* \; "Edited 24-Jan-91 11:19 by matsuda") + CLIPPINGREGION) (* \; "Edited 24-Jan-91 11:19 by matsuda") (PROG (SRCEBMLIST DESTBMLIST SRCEBIGBMHEIGHT DESTBIGBMHEIGHT SRCETOP DESTTOP SRCEFRAG DESTFRAG SRCEFRAGTOP DESTFRAGTOP SRCEFRAGBOTTOM DESTFRAGBOTTOM SRCE-H DEST-H H NEXT-S-TOP NEXT-D-TOP SBOTTOM DBOTTOM) @@ -119,16 +128,14 @@ (SETQ SRCEFRAGTOP SRCEBIGBMHEIGHT) (SETQ SRCEFRAGBOTTOM (- SRCEFRAGTOP (BITMAPHEIGHT SRCEFRAG))) (|until| (< SRCEFRAGBOTTOM SRCETOP) |do| - - (* |;;| - "Search the first fragment of SRCE bitmaps") - - (SETQ SRCEFRAG (|GetNewFragment| - SRCEBMLIST)) - (SETQ SRCEFRAGTOP SRCEFRAGBOTTOM) - (SETQ SRCEFRAGBOTTOM (- SRCEFRAGTOP - (BITMAPHEIGHT - SRCEFRAG)))) + (* |;;| + "Search the first fragment of SRCE bitmaps") + + (SETQ SRCEFRAG (|GetNewFragment| SRCEBMLIST)) + (SETQ SRCEFRAGTOP SRCEFRAGBOTTOM) + (SETQ SRCEFRAGBOTTOM (- SRCEFRAGTOP + (BITMAPHEIGHT SRCEFRAG + )))) (COND ((|type?| BIGBM DEST) (PROG NIL @@ -142,19 +149,15 @@ (SETQ DESTFRAGBOTTOM (- DESTFRAGTOP (BITMAPHEIGHT DESTFRAG))) LOOP (|until| (<= DESTFRAGBOTTOM DESTTOP) |do| + (* |;;| + "Serch the first fragment of DEST bitmaps") - (* |;;| - "Serch the first fragment of DEST bitmaps") - - (SETQ DESTFRAG ( - |GetNewFragment| - DESTBMLIST)) - (SETQ DESTFRAGTOP - DESTFRAGBOTTOM) - (SETQ DESTFRAGBOTTOM - (- DESTFRAGTOP ( - BITMAPHEIGHT - DESTFRAG)))) + (SETQ DESTFRAG (|GetNewFragment| + DESTBMLIST)) + (SETQ DESTFRAGTOP DESTFRAGBOTTOM) + (SETQ DESTFRAGBOTTOM + (- DESTFRAGTOP (BITMAPHEIGHT + DESTFRAG)))) (COND ((<= SRCEFRAGBOTTOM SRCEBOTTOM) (SETQ SRCE-H (- SRCETOP SRCEBOTTOM))) @@ -238,16 +241,15 @@ (SETQ DESTFRAGTOP DESTBIGBMHEIGHT) (SETQ DESTFRAGBOTTOM (- DESTFRAGTOP (BITMAPHEIGHT DESTFRAG))) (|until| (< DESTFRAGBOTTOM DESTTOP) |do| - - (* |;;| - "Serch the first fragment of DEST bitmaps") - - (SETQ DESTFRAG (|GetNewFragment| - DESTBMLIST)) - (SETQ DESTFRAGTOP DESTFRAGBOTTOM) - (SETQ DESTFRAGBOTTOM - (- DESTFRAGTOP (BITMAPHEIGHT - DESTFRAG)))) + (* |;;| + "Serch the first fragment of DEST bitmaps") + + (SETQ DESTFRAG (|GetNewFragment| + DESTBMLIST)) + (SETQ DESTFRAGTOP DESTFRAGBOTTOM) + (SETQ DESTFRAGBOTTOM (- DESTFRAGTOP + (BITMAPHEIGHT + DESTFRAG)))) (COND ((<= DESTFRAGBOTTOM DESTBOTTOM) @@ -287,30 +289,11 @@ (ORG.BITBLT SRCE SRCELEFT SRCEBOTTOM DEST DESTLEFT DESTBOTTOM WIDTH HEIGHT SRCETYPE OPERATION TEXTURE CLIPPINGREGION)))))) -(BITMAPCREATE.BIGBM - (LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* \; "Edited 7-Sep-89 18:14 by takeshi") - (LET (H HLEFT BM BIGBM) - (SETQ H (FLOOR (IQUOTIENT |\\MaxBitMapWords| WIDTH) - BITSPERWORD)) (* \; - "slice should be a multiple of 16 so that textures tesselate nicely.") - (SETQ HLEFT HEIGHT) - (SETQ BIGBM (|create| BIGBM)) - (|freplace| (BIGBM BIGBMWIDTH) OF BIGBM WITH WIDTH) - (|freplace| (BIGBM BIGBMHEIGHT) OF BIGBM WITH HEIGHT) - (|freplace| (BIGBM BIGBMLIST) OF BIGBM WITH (|while| (IGREATERP HLEFT 0) - |collect| - (SETQ BM (BITMAPCREATE - WIDTH - (MIN H HLEFT) - BITSPERPIXEL)) - (SETQ HLEFT (- HLEFT H)) - BM)) - BIGBM))) (BITMAPCREATE - (LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* \; "Edited 1-Nov-91 15:47 by jds") + (LAMBDA (WIDTH HEIGHT BITSPERPIXEL) (* \; "Edited 1-Nov-91 15:47 by jds") (* \; - "creates a bitmap & bigbm data structure.") + "creates a bitmap & bigbm data structure.") (PROG (RW) (OR (AND (IGEQ WIDTH 0) (ILEQ WIDTH |\\MaxBitMapWidth|)) @@ -337,17 +320,17 @@ NIL (AND (NULL WINDFLG) 0)))) - (T (BITMAPCREATE.BIGBM WIDTH HEIGHT BITSPERPIXEL))))))) + (T (BITMAPCREATE.BIGBM WIDTH HEIGHT BITSPERPIXEL))))))) (BITMAPCOPY - (LAMBDA (BITMAP) (* \; "Edited 1-Nov-91 15:49 by jds") + (LAMBDA (BITMAP) (* \; "Edited 1-Nov-91 15:49 by jds") (* |;;| "makes a copy of an existing BitMap") (PROG (NEWBITMAP) (BITBLT BITMAP 0 0 (SETQ NEWBITMAP (BITMAPCREATE (BITMAPWIDTH BITMAP) - (BITMAPHEIGHT BITMAP) - (BITSPERPIXEL BITMAP))) + (BITMAPHEIGHT BITMAP) + (BITSPERPIXEL BITMAP))) 0 0 NIL NIL 'INPUT 'REPLACE 0) (RETURN NEWBITMAP)))) @@ -386,16 +369,15 @@ (SETQ DESTFRAGBOTTOM (- DESTFRAGTOP (BITMAPHEIGHT DESTFRAG))) LOOP (|until| (<= DESTFRAGBOTTOM DESTTOP) |do| - - (* |;;| - "Serch the first fragment of DEST bitmaps") - - (SETQ DESTFRAG (|GetNewFragment| - DESTBMLIST)) - (SETQ DESTFRAGTOP DESTFRAGBOTTOM) - (SETQ DESTFRAGBOTTOM - (- DESTFRAGTOP (BITMAPHEIGHT - DESTFRAG)))) + (* |;;| + "Serch the first fragment of DEST bitmaps") + + (SETQ DESTFRAG (|GetNewFragment| + DESTBMLIST)) + (SETQ DESTFRAGTOP DESTFRAGBOTTOM) + (SETQ DESTFRAGBOTTOM + (- DESTFRAGTOP (BITMAPHEIGHT DESTFRAG + )))) (COND ((<= DESTFRAGBOTTOM DESTBOTTOM) (SETQ DEST-H (- DESTTOP DESTBOTTOM))) @@ -453,7 +435,7 @@ (\\ORG.BITBLT (LAMBDA (SOURCE SOURCELEFT SOURCEBOTTOM DESTINATION DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION) - (DECLARE (LOCALVARS . T)) (* \; "Edited 24-Jul-90 16:34 by matsuda") + (DECLARE (LOCALVARS . T)) (* \; "Edited 24-Jul-90 16:34 by matsuda") (* |;;| "IRM defined defaults") @@ -479,32 +461,28 @@ (SETQ SOURCEBM SOURCE) (SETQ CLIPPEDSOURCELEFT SOURCELEFT) (SETQ CLIPPEDSOURCEBOTTOM SOURCEBOTTOM) (* \; - "limit the WIDTH and HEIGHT to the source size.") + "limit the WIDTH and HEIGHT to the source size.") (SETQ WIDTH (COND (WIDTH (IMIN WIDTH (IDIFFERENCE (|fetch| (BITMAP BITMAPWIDTH) |of| SOURCE) SOURCELEFT))) (T (|fetch| (BITMAP BITMAPWIDTH) |of| SOURCE)))) (SETQ HEIGHT (COND - (HEIGHT (IMIN HEIGHT (IDIFFERENCE (|fetch| (BITMAP - BITMAPHEIGHT - ) + (HEIGHT (IMIN HEIGHT (IDIFFERENCE (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCE) SOURCEBOTTOM))) (T (|fetch| (BITMAP BITMAPHEIGHT) |of| SOURCE))))) ((SETQ SOURCEDD (\\GETDISPLAYDATA SOURCE)) - (OR SOURCELEFT (SETQ SOURCELEFT (|fetch| (REGION LEFT) - |of| (|ffetch| (\\DISPLAYDATA - |DDClippingRegion| - ) |of| - SOURCEDD)))) + (OR SOURCELEFT (SETQ SOURCELEFT (|fetch| (REGION LEFT) |of| (|ffetch| + (\\DISPLAYDATA + |DDClippingRegion|) + |of| SOURCEDD)))) (OR SOURCEBOTTOM (SETQ SOURCEBOTTOM (|fetch| (REGION BOTTOM) - |of| (|ffetch| (\\DISPLAYDATA - |DDClippingRegion| - ) |of| - SOURCEDD)) - )) (* \; - "do transformations coming out of source") + |of| (|ffetch| (\\DISPLAYDATA + |DDClippingRegion|) + |of| SOURCEDD)))) + (* \; + "do transformations coming out of source") (SETQ SOURCEBM (|fetch| (\\DISPLAYDATA |DDDestination|) |of| SOURCEDD)) (SETQ CLIPPEDSOURCELEFT (IMAX (SETQ SOURCELEFT (\\DSPTRANSFORMX SOURCELEFT SOURCEDD)) @@ -515,32 +493,32 @@ (|fetch| (\\DISPLAYDATA |DDClippingBottom|) |of| SOURCEDD))) (* \; - "limit the WIDTH and HEIGHT by the source dimensions.") + "limit the WIDTH and HEIGHT by the source dimensions.") (SETQ WIDTH (COND (WIDTH (IMIN WIDTH (IDIFFERENCE (|fetch| (\\DISPLAYDATA - |DDClippingRight| - ) |of| - SOURCEDD) + |DDClippingRight|) + |of| SOURCEDD) CLIPPEDSOURCELEFT))) (T (IDIFFERENCE (|fetch| (\\DISPLAYDATA |DDClippingRight|) |of| SOURCEDD) CLIPPEDSOURCELEFT)))) (SETQ HEIGHT (COND - (HEIGHT (IMIN HEIGHT (IDIFFERENCE (|fetch| (\\DISPLAYDATA - |DDClippingTop|) - |of| SOURCEDD) + (HEIGHT (IMIN HEIGHT (IDIFFERENCE (|fetch| (\\DISPLAYDATA + |DDClippingTop| + ) |of| SOURCEDD + ) CLIPPEDSOURCEBOTTOM))) (T (IDIFFERENCE (|fetch| (\\DISPLAYDATA |DDClippingTop|) |of| SOURCEDD) CLIPPEDSOURCEBOTTOM)))) (* \; - "if texture is not given, use the display stream's.") - (OR TEXTURE (SETQ TEXTURE (|ffetch| (\\DISPLAYDATA |DDTexture|) |of| - SOURCEDD))))) + "if texture is not given, use the display stream's.") + (OR TEXTURE (SETQ TEXTURE (|ffetch| (\\DISPLAYDATA |DDTexture|) |of| SOURCEDD)))) + ) (COND ((OR (IGEQ 0 WIDTH) (IGEQ 0 HEIGHT)) (* \; - "if either width or height is 0, don't do anything.") + "if either width or height is 0, don't do anything.") (RETURN))) (RETURN (COND ((|type?| BITMAP DESTINATION) @@ -585,18 +563,18 @@ SOURCEBOTTOM (SETQ SCRATCHBM (BITMAPCREATE WIDTH HEIGHT - (BITSPERPIXEL - SOURCEBM))) + (BITSPERPIXEL SOURCEBM) + )) 0 0 WIDTH HEIGHT 'INPUT 'REPLACE)) - (RETURN (BITBLT SCRATCHBM 0 0 - STREAM DESTINATIONLEFT + (RETURN (BITBLT SCRATCHBM 0 0 STREAM + DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE OPERATION TEXTURE CLIPPINGREGION)))))))) (* \; - "bring the source to the top. this should be done uninterruptably but is better than nothing.") + "bring the source to the top. this should be done uninterruptably but is better than nothing.") (TOTOPW SOURCE))) (IMAGEOP 'IMBITBLT STREAM SOURCEBM SOURCELEFT SOURCEBOTTOM STREAM DESTINATIONLEFT DESTINATIONBOTTOM WIDTH HEIGHT SOURCETYPE @@ -620,14 +598,14 @@ (SETQ DESTINATIONLEFT (\\DSPTRANSFORMX DESTINATIONLEFT DESTDD)) (SETQ DESTINATIONBOTTOM (\\DSPTRANSFORMY DESTINATIONBOTTOM DESTDD)) (PROGN (* \; - "compute limits based on clipping regions.") + "compute limits based on clipping regions.") (SETQ |left| (|fetch| (\\DISPLAYDATA |DDClippingLeft|) |of| DESTDD)) (SETQ |bottom| (|fetch| (\\DISPLAYDATA |DDClippingBottom|) |of| DESTDD)) (SETQ |right| (|fetch| (\\DISPLAYDATA |DDClippingRight|) |of| DESTDD)) (SETQ |top| (|fetch| (\\DISPLAYDATA |DDClippingTop|) |of| DESTDD)) (COND (CLIPPINGREGION (* \; - "hard case, two destination clipping regions: do calculations to merge them.") + "hard case, two destination clipping regions: do calculations to merge them.") (PROG (CRLEFT CRBOTTOM) (SETQ |left| (IMAX |left| (SETQ CRLEFT (\\DSPTRANSFORMX (|fetch| (REGION LEFT) @@ -640,13 +618,11 @@ CLIPPINGREGION ) DESTDD)))) - (SETQ |right| (IMIN |right| (IPLUS CRLEFT (|fetch| (REGION - WIDTH) - |of| CLIPPINGREGION - )))) + (SETQ |right| (IMIN |right| (IPLUS CRLEFT (|fetch| (REGION WIDTH) + |of| CLIPPINGREGION)))) (SETQ |top| (IMIN |top| (IPLUS CRBOTTOM (|fetch| (REGION HEIGHT) - |of| CLIPPINGREGION)) - )))))) + |of| CLIPPINGREGION)))))) + )) (SETQ DESTINATIONNBITS (BITSPERPIXEL DESTINATIONBITMAP)) (* |;;| "left, right top and bottom are the limits in destination taking into account Clipping Regions. Clip to region in the arguments of this call.") @@ -668,7 +644,7 @@ (SETQ TEXTURE (SELECTQ (TYPENAME TEXTURE) (LITATOM (COND ((NULL TEXTURE) (* \; - "NIL case. default texture to background texture.") + "NIL case. default texture to background texture.") (|ffetch| (\\DISPLAYDATA |DDTexture|) |of| DESTDD)) ((NOT (EQ DESTINATIONNBITS 1)) (* \; "should be a color name") @@ -679,7 +655,7 @@ (LOGAND TEXTURE (MAXIMUMSHADE DESTINATIONNBITS))) (BITMAP TEXTURE) (LISTP (* \; - "should be a list of levels rgb or hls.") + "should be a list of levels rgb or hls.") (OR (AND (NOT (EQ DESTINATIONNBITS 1)) (COLORNUMBERP TEXTURE DESTINATIONNBITS)) (\\ILLEGAL.ARG TEXTURE))) @@ -705,29 +681,26 @@ |top|) HEIGHT 'TEXTURE - (OR OPERATION (|ffetch| (\\DISPLAYDATA - DDOPERATION) + (OR OPERATION (|ffetch| (\\DISPLAYDATA DDOPERATION) |of| DESTDD)) TEXTURE - (ITIMES DESTINATIONNBITS (|fetch| ( - \\DISPLAYDATA - DDXOFFSET) + (ITIMES DESTINATIONNBITS (|fetch| (\\DISPLAYDATA + DDXOFFSET) |of| DESTDD)) - (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| - DESTDD)))) + (|fetch| (\\DISPLAYDATA DDYOFFSET) |of| DESTDD)))) (T (PROG (HEIGHT) (SETQ HEIGHT (IDIFFERENCE |top| |bottom|)) (BLTSHADE.BIGBM TEXTURE DESTINATIONBITMAP |left| |bottom| (IDIFFERENCE |right| |left|) (IDIFFERENCE |top| |bottom|) (OR OPERATION (|ffetch| (\\DISPLAYDATA - DDOPERATION) + DDOPERATION) |of| DESTDD)) CLIPPINGREGION))))) (RETURN T)))) (\\RESHOWBORDER1 - (LAMBDA (NEWBORDER OLDBORDER WINDOW) (* \; "Edited 26-Jul-90 12:52 by matsuda") + (LAMBDA (NEWBORDER OLDBORDER WINDOW) (* \; "Edited 26-Jul-90 12:52 by matsuda") (* |;;| "redisplays the border of a window. Is called by RESHOWBORDER and RESHOWTITLE. It doesn't check for equality between the new and old borders because it is also used when a title is added or deleted.") @@ -738,52 +711,48 @@ (SETQ NUWIDTH (IPLUS (|fetch| (REGION WIDTH) |of| REGION) (ITIMES DELTA 2))) (SETQ NUHEIGHT (IDIFFERENCE (IPLUS (|fetch| (REGION HEIGHT) - |of| (DSPCLIPPINGREGION NIL (|fetch| - (WINDOW DSP) - |of| WINDOW))) + |of| (DSPCLIPPINGREGION NIL (|fetch| (WINDOW DSP) + |of| WINDOW))) (ITIMES NEWBORDER 2)) (COND ((|fetch| (WINDOW WTITLE) |of| WINDOW) (DSPLINEFEED NIL (|fetch| (SCREEN SCTITLEDS) - |of| (|fetch| (WINDOW SCREEN) - |of| WINDOW)))) + |of| (|fetch| (WINDOW SCREEN) |of| WINDOW)))) (T 0)))) (SETQ NUSAV (BITMAPCREATE NUWIDTH NUHEIGHT (BITSPERPIXEL OLDSAVE))) (.WHILE.TOP.DS. WINDOW (* \; "Save window image") - (\\SW2BM (|fetch| (SCREEN SCDESTINATION) |of| (|fetch| (WINDOW - SCREEN) - |of| WINDOW)) + (\\SW2BM (|fetch| (SCREEN SCDESTINATION) |of| (|fetch| (WINDOW SCREEN) |of| WINDOW)) REGION (|fetch| (WINDOW SAVE) |of| WINDOW) NIL) (* \; "put new save image into window") (|replace| (WINDOW SAVE) |of| WINDOW |with| NUSAV) (|replace| (WINDOW WBORDER) |of| WINDOW |with| NEWBORDER) (* \; - "create a region that coresponds to the old region with the new border.") - (|replace| (WINDOW REG) |of| WINDOW - |with| (|create| REGION - LEFT _ (IDIFFERENCE (|fetch| (REGION LEFT) |of| REGION) - DELTA) - BOTTOM _ (IDIFFERENCE (|fetch| (REGION BOTTOM) |of| - REGION) - DELTA) - WIDTH _ NUWIDTH - HEIGHT _ NUHEIGHT)) + "create a region that coresponds to the old region with the new border.") + (|replace| (WINDOW REG) |of| WINDOW |with| (|create| REGION + LEFT _ (IDIFFERENCE + (|fetch| (REGION LEFT) + |of| REGION) + DELTA) + BOTTOM _ + (IDIFFERENCE (|fetch| (REGION + BOTTOM) + |of| REGION) + DELTA) + WIDTH _ NUWIDTH + HEIGHT _ NUHEIGHT)) (UPDATE/SCROLL/REG WINDOW) (* \; "draw border in the new image.") (SHOWWFRAME WINDOW) (* \; - "copy the visible part from the old image into the new one.") + "copy the visible part from the old image into the new one.") (BITBLT OLDSAVE OLDBORDER OLDBORDER NUSAV NEWBORDER NEWBORDER (IDIFFERENCE (BITMAPWIDTH OLDSAVE) (ITIMES 2 OLDBORDER)) - (|fetch| (REGION HEIGHT) |of| (DSPCLIPPINGREGION NIL - (|fetch| (WINDOW DSP) - |of| WINDOW))) + (|fetch| (REGION HEIGHT) |of| (DSPCLIPPINGREGION NIL (|fetch| (WINDOW DSP) + |of| WINDOW))) 'INPUT 'REPLACE) (* \; - "put the new image up on the screen.") - (\\SW2BM (|fetch| (SCREEN SCDESTINATION) |of| (|fetch| (WINDOW - SCREEN) - |of| WINDOW)) + "put the new image up on the screen.") + (\\SW2BM (|fetch| (SCREEN SCDESTINATION) |of| (|fetch| (WINDOW SCREEN) |of| WINDOW)) (|fetch| (WINDOW REG) |of| WINDOW) (|fetch| (WINDOW SAVE) |of| WINDOW) NIL))))) @@ -803,45 +772,40 @@ (SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)) (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) (SETQ |ClippingTop| (|ffetch| (\\DISPLAYDATA |DDClippingTop|) |of| DD)) - (SETQ |ClippingBottom| (|ffetch| (\\DISPLAYDATA |DDClippingBottom|) - |of| DD)) + (SETQ |ClippingBottom| (|ffetch| (\\DISPLAYDATA |DDClippingBottom|) |of| DD)) (SETQ BM (|GetNewFragment| BIGBMLIST)) (|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|)) |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) - (SETQ |CTop| (COND - ((IGREATERP |ClippingTop| HEIGHT) - (IDIFFERENCE HEIGHT BOTTOM)) - (T (IDIFFERENCE |ClippingTop| BOTTOM)))) - (COND - ((IGEQ |CTop| 0) - (SETQ |CBottom| (COND - ((ILESSP |ClippingBottom| BOTTOM) - 0) - (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) - (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD - |with| BM) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD - |with| |CTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD - |with| |CBottom|) - (\\DRAWCIRCLE.DISPLAY DISPLAYSTREAM CENTERX (IDIFFERENCE CENTERY - BOTTOM) - RADIUS BRUSH DASHING) - (SETQ BM (|GetNewFragment| BIGBMLIST)) - (SETQ HEIGHT BOTTOM)))) + (SETQ |CTop| (COND + ((IGREATERP |ClippingTop| HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE |ClippingTop| BOTTOM)))) + (COND + ((IGEQ |CTop| 0) + (SETQ |CBottom| (COND + ((ILESSP |ClippingBottom| BOTTOM) + 0) + (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) + (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| BM) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| |CTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| + |CBottom| + ) + (\\DRAWCIRCLE.DISPLAY DISPLAYSTREAM CENTERX (IDIFFERENCE CENTERY + BOTTOM) + RADIUS BRUSH DASHING) + (SETQ BM (|GetNewFragment| BIGBMLIST)) + (SETQ HEIGHT BOTTOM)))) (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| BITMAP) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| - |ClippingTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| - |ClippingBottom| - ) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| |ClippingTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| |ClippingBottom|) (MOVETO CENTERX CENTERY DISPLAYSTREAM) (RETURN NIL))) (T (\\DRAWCIRCLE.DISPLAY DISPLAYSTREAM CENTERX CENTERY RADIUS BRUSH DASHING)))))) (\\FILLCIRCLE.BIGBM (LAMBDA (DISPLAYSTREAM CENTERX CENTERY RADIUS TEXTURE) - (DECLARE (LOCALVARS . T)) (* \; "Edited 29-Jan-91 16:21 by matsuda") + (DECLARE (LOCALVARS . T)) (* \; "Edited 29-Jan-91 16:21 by matsuda") (COND ((OR (NOT (NUMBERP RADIUS)) (ILESSP (SETQ RADIUS (FIXR RADIUS)) @@ -856,41 +820,37 @@ ) (SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)) (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) - (SETQ |ClippingTop| (|ffetch| (\\DISPLAYDATA |DDClippingTop|) - |of| DD)) + (SETQ |ClippingTop| (|ffetch| (\\DISPLAYDATA |DDClippingTop|) |of| DD)) (SETQ |ClippingBottom| (|ffetch| (\\DISPLAYDATA |DDClippingBottom|) |of| DD)) (SETQ BM (|GetNewFragment| BIGBMLIST)) (|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|)) |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) - (SETQ |CTop| (COND - ((IGREATERP |ClippingTop| HEIGHT) - (IDIFFERENCE HEIGHT BOTTOM)) - (T (IDIFFERENCE |ClippingTop| BOTTOM)))) - (COND - ((IGEQ |CTop| 0) - (SETQ |CBottom| (COND - ((ILESSP |ClippingBottom| BOTTOM) - 0) - (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) - (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD - |with| BM) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD - |with| |CTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| - DD - |with| |CBottom|) - (\\FILLCIRCLE.DISPLAY DISPLAYSTREAM CENTERX (IDIFFERENCE - CENTERY BOTTOM) - RADIUS TEXTURE) - (SETQ BM (|GetNewFragment| BIGBMLIST)) - (SETQ HEIGHT BOTTOM)))) - (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| - BITMAP) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| - |ClippingTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| - + (SETQ |CTop| (COND + ((IGREATERP |ClippingTop| HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE |ClippingTop| BOTTOM)))) + (COND + ((IGEQ |CTop| 0) + (SETQ |CBottom| (COND + ((ILESSP |ClippingBottom| BOTTOM) + 0) + (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) + (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| + BM) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| + |CTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD + |with| |CBottom|) + (\\FILLCIRCLE.DISPLAY DISPLAYSTREAM CENTERX (IDIFFERENCE + CENTERY + BOTTOM) + RADIUS TEXTURE) + (SETQ BM (|GetNewFragment| BIGBMLIST)) + (SETQ HEIGHT BOTTOM)))) + (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| BITMAP) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| |ClippingTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| |ClippingBottom| ) (MOVETO CENTERX CENTERY DISPLAYSTREAM) @@ -899,7 +859,7 @@ (\\DRAWELLIPSE.BIGBM (LAMBDA (DISPLAYSTREAM CENTERX CENTERY SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH DASHING) - (DECLARE (LOCALVARS . T)) (* \; "Edited 29-Jan-91 12:52 by matsuda") + (DECLARE (LOCALVARS . T)) (* \; "Edited 29-Jan-91 12:52 by matsuda") (PROG ((DD (|fetch| IMAGEDATA |of| DISPLAYSTREAM) BITMAP)) (SETQ BITMAP (|fetch| (\\DISPLAYDATA |DDDestination|) |of| DD)) @@ -918,42 +878,37 @@ |CBottom|) (SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)) (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) - (SETQ |ClippingTop| (|ffetch| (\\DISPLAYDATA |DDClippingTop|) - |of| DD)) + (SETQ |ClippingTop| (|ffetch| (\\DISPLAYDATA |DDClippingTop|) |of| DD)) (SETQ |ClippingBottom| (|ffetch| (\\DISPLAYDATA |DDClippingBottom|) |of| DD)) (SETQ BM (|GetNewFragment| BIGBMLIST)) (|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|)) |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) - (SETQ |CTop| (COND - ((IGREATERP |ClippingTop| HEIGHT) - (IDIFFERENCE HEIGHT BOTTOM)) - (T (IDIFFERENCE |ClippingTop| BOTTOM)))) - (COND - ((IGEQ |CTop| 0) - (SETQ |CBottom| (COND - ((ILESSP |ClippingBottom| BOTTOM) - 0) - (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) - (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD - |with| BM) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD - |with| |CTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| - DD - |with| |CBottom|) - (\\DRAWELLIPSE.DISPLAY DISPLAYSTREAM CENTERX (IDIFFERENCE - CENTERY BOTTOM) - SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH - DASHING) - (SETQ BM (|GetNewFragment| BIGBMLIST)) - (SETQ HEIGHT BOTTOM)))) - (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| - BITMAP) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| - |ClippingTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| - + (SETQ |CTop| (COND + ((IGREATERP |ClippingTop| HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE |ClippingTop| BOTTOM)))) + (COND + ((IGEQ |CTop| 0) + (SETQ |CBottom| (COND + ((ILESSP |ClippingBottom| BOTTOM) + 0) + (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) + (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| + BM) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| + |CTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD + |with| |CBottom|) + (\\DRAWELLIPSE.DISPLAY DISPLAYSTREAM CENTERX (IDIFFERENCE + CENTERY BOTTOM) + SEMIMINORRADIUS SEMIMAJORRADIUS ORIENTATION BRUSH + DASHING) + (SETQ BM (|GetNewFragment| BIGBMLIST)) + (SETQ HEIGHT BOTTOM)))) + (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| BITMAP) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| |ClippingTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| |ClippingBottom| ) (MOVETO CENTERX CENTERY DISPLAYSTREAM) @@ -963,7 +918,7 @@ (\\DRAWCURVE.BIGBM (LAMBDA (DISPLAYSTREAM KNOTS CLOSED BRUSH DASHING) - (DECLARE (LOCALVARS . T)) (* \; "Edited 29-Jan-91 17:48 by matsuda") + (DECLARE (LOCALVARS . T)) (* \; "Edited 29-Jan-91 17:48 by matsuda") (PROG ((DD (|fetch| (STREAM IMAGEDATA) |of| DISPLAYSTREAM)) BITMAP) (SETQ BITMAP (|fetch| (\\DISPLAYDATA |DDDestination|) |of| DD)) @@ -972,104 +927,90 @@ (PROG (BIGBMLIST HEIGHT BOTTOM BM |ClippingTop| |ClippingBottom| |CTop| |CBottom| POINTS) (|for| KNOT |in| KNOTS |do| (OR (|type?| POSITION KNOT) - (ERROR "bad knot" KNOT))) + (ERROR "bad knot" KNOT))) (SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)) (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) (SETQ |ClippingTop| (|ffetch| (\\DISPLAYDATA |DDClippingTop|) |of| DD)) - (SETQ |ClippingBottom| (|ffetch| (\\DISPLAYDATA |DDClippingBottom|) - |of| DD)) + (SETQ |ClippingBottom| (|ffetch| (\\DISPLAYDATA |DDClippingBottom|) |of| DD)) (SETQ BM (|GetNewFragment| BIGBMLIST)) (|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|)) |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) - (SETQ |CTop| (COND - ((IGREATERP |ClippingTop| HEIGHT) - (IDIFFERENCE HEIGHT BOTTOM)) - (T (IDIFFERENCE |ClippingTop| BOTTOM)))) - (COND - ((IGEQ |CTop| 0) - (SETQ |CBottom| (COND - ((ILESSP |ClippingBottom| BOTTOM) - 0) - (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) - (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD - |with| BM) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD - |with| |CTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD - |with| |CBottom|) - (SETQ POINTS (|for| KNOT |in| KNOTS - |collect| (|create| POSITION - XCOORD _ (CAR KNOT) - YCOORD _ (DIFFERENCE - (CDR KNOT) - BOTTOM)))) - (\\DRAWCURVE.DISPLAY DISPLAYSTREAM POINTS CLOSED BRUSH DASHING) - (SETQ BM (|GetNewFragment| BIGBMLIST)) - (SETQ HEIGHT BOTTOM)))) + (SETQ |CTop| (COND + ((IGREATERP |ClippingTop| HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE |ClippingTop| BOTTOM)))) + (COND + ((IGEQ |CTop| 0) + (SETQ |CBottom| (COND + ((ILESSP |ClippingBottom| BOTTOM) + 0) + (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) + (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| BM) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| |CTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| + |CBottom| + ) + (SETQ POINTS (|for| KNOT |in| KNOTS + |collect| (|create| POSITION + XCOORD _ (CAR KNOT) + YCOORD _ (DIFFERENCE (CDR KNOT) + BOTTOM)))) + (\\DRAWCURVE.DISPLAY DISPLAYSTREAM POINTS CLOSED BRUSH DASHING) + (SETQ BM (|GetNewFragment| BIGBMLIST)) + (SETQ HEIGHT BOTTOM)))) (|replace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| BITMAP) - (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| - |ClippingTop|) - (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| - |ClippingBottom| - ) + (|replace| (\\DISPLAYDATA |DDClippingTop|) |of| DD |with| |ClippingTop|) + (|replace| (\\DISPLAYDATA |DDClippingBottom|) |of| DD |with| |ClippingBottom|) (RETURN DISPLAYSTREAM))) (T (\\DRAWCURVE.DISPLAY DISPLAYSTREAM KNOTS CLOSED BRUSH DASHING)))))) (\\DRAWLINE.BIGBM.DASH - (LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 BRUSH DASHING OPERATION) - (* \; "Edited 13-Jun-2021 14:02 by rmk:") + (LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 BRUSH DASHING OPERATION) + (* \; "Edited 13-Jun-2021 14:02 by rmk:") (GLOBALRESOURCES \\BRUSHBBT (LET ((DD (|fetch| IMAGEDATA |of| DISPLAYSTREAM)) BITMAP BIGBMLIST HEIGHT BOTTOM BM YY1 YY2 |ClippingTop| |ClippingBottom| |CTop| |CBottom|) (SETQ BITMAP (|ffetch| |DDDestination| |of| DD)) (SETQ BIGBMLIST (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)) (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) - (SETQ |ClippingTop| (|ffetch| |DDClippingTop| |of| - DD)) - (SETQ |ClippingBottom| (|ffetch| |DDClippingBottom| - |of| DD)) + (SETQ |ClippingTop| (|ffetch| |DDClippingTop| |of| DD)) + (SETQ |ClippingBottom| (|ffetch| |DDClippingBottom| |of| DD)) (SETQ BM (|GetNewFragment| BIGBMLIST)) (|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|)) - |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT - BM))) - (SETQ |CTop| (COND - ((IGREATERP |ClippingTop| HEIGHT) - (IDIFFERENCE HEIGHT BOTTOM)) - (T (IDIFFERENCE |ClippingTop| BOTTOM))) - ) - (|if| (IGEQ |CTop| 0) - |then| (SETQ |CBottom| - (COND - ((ILESSP |ClippingBottom| BOTTOM) - 0) - (T (IDIFFERENCE |ClippingBottom| - BOTTOM)))) - (|replace| |DDDestination| |of| - DD - |with| BM) - (|replace| |DDClippingTop| |of| - DD - |with| |CTop|) - (|replace| |DDClippingBottom| - |of| DD |with| |CBottom|) - (\\LINEWITHBRUSH X1 (IDIFFERENCE Y1 BOTTOM) - X2 - (IDIFFERENCE Y2 BOTTOM) - BRUSH - (\\GOOD.DASHLST DASHING BRUSH) - DISPLAYSTREAM \\BRUSHBBT OPERATION) - (SETQ BM (|GetNewFragment| BIGBMLIST)) - (SETQ HEIGHT BOTTOM))) - (|freplace| |DDDestination| |of| DD |with| BITMAP) - (|freplace| |DDClippingTop| |of| DD |with| - |ClippingTop|) - (|freplace| |DDClippingBottom| |of| DD |with| + |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) + (SETQ |CTop| (COND + ((IGREATERP |ClippingTop| HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE |ClippingTop| BOTTOM)))) + (|if| (IGEQ |CTop| 0) + |then| (SETQ |CBottom| (COND + ((ILESSP |ClippingBottom| + BOTTOM) + 0) + (T (IDIFFERENCE |ClippingBottom| - ))))) + BOTTOM)))) + (|replace| |DDDestination| |of| DD + |with| BM) + (|replace| |DDClippingTop| |of| DD + |with| |CTop|) + (|replace| |DDClippingBottom| |of| DD + |with| |CBottom|) + (\\LINEWITHBRUSH X1 (IDIFFERENCE Y1 BOTTOM) + X2 + (IDIFFERENCE Y2 BOTTOM) + BRUSH + (\\GOOD.DASHLST DASHING BRUSH) + DISPLAYSTREAM \\BRUSHBBT OPERATION) + (SETQ BM (|GetNewFragment| BIGBMLIST)) + (SETQ HEIGHT BOTTOM))) + (|freplace| |DDDestination| |of| DD |with| BITMAP) + (|freplace| |DDClippingTop| |of| DD |with| |ClippingTop|) + (|freplace| |DDClippingBottom| |of| DD |with| |ClippingBottom|)) + ))) (\\DRAWLINE.BIGBM.NODASH - (LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR) - (* \; "Edited 13-Jun-2021 13:59 by rmk:") + (LAMBDA (DISPLAYSTREAM X1 Y1 X2 Y2 WIDTH OPERATION COLOR)(* \; "Edited 13-Jun-2021 13:59 by rmk:") (LET ((DD (|fetch| IMAGEDATA |of| DISPLAYSTREAM)) BITMAP BIGBMLIST HEIGHT BOTTOM BM |CTop| |CBottom| |ClippingTop| |ClippingBottom| YY1 YY2) (SETQ BITMAP (|ffetch| |DDDestination| |of| DD)) @@ -1086,42 +1027,42 @@ DD)) (|while| (AND BM (IGREATERP HEIGHT |ClippingBottom|)) |do| (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) - (SETQ |CTop| (COND - ((IGREATERP |ClippingTop| HEIGHT) - (IDIFFERENCE HEIGHT BOTTOM)) - (T (IDIFFERENCE |ClippingTop| BOTTOM)))) - (COND - ((IGEQ |CTop| 0) - (SETQ |CBottom| (COND - ((ILESSP |ClippingBottom| BOTTOM) - 0) - (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) - (\\CLIPANDDRAWLINE (\\DSPTRANSFORMX (OR (FIXP X1) - (FIXR X1)) - DD) - (IDIFFERENCE YY1 BOTTOM) - (\\DSPTRANSFORMX (OR (FIXP X2) - (FIXR X2)) - DD) - (IDIFFERENCE YY2 BOTTOM) - (COND - ((NULL WIDTH) - 1) - ((OR (FIXP WIDTH) - (FIXR WIDTH)))) - (SELECTQ OPERATION - (NIL (|ffetch| DDOPERATION |of| DD)) - ((REPLACE PAINT INVERT ERASE) - OPERATION) - (\\ILLEGAL.ARG OPERATION)) - BM - (|ffetch| |DDClippingLeft| |of| DD) - (SUB1 (|ffetch| |DDClippingRight| |of| DD)) - |CBottom| - (SUB1 |CTop|) - DISPLAYSTREAM COLOR))) - (SETQ BM (|GetNewFragment| BIGBMLIST)) - (SETQ HEIGHT BOTTOM))))) + (SETQ |CTop| (COND + ((IGREATERP |ClippingTop| HEIGHT) + (IDIFFERENCE HEIGHT BOTTOM)) + (T (IDIFFERENCE |ClippingTop| BOTTOM)))) + (COND + ((IGEQ |CTop| 0) + (SETQ |CBottom| (COND + ((ILESSP |ClippingBottom| BOTTOM) + 0) + (T (IDIFFERENCE |ClippingBottom| BOTTOM)))) + (\\CLIPANDDRAWLINE (\\DSPTRANSFORMX (OR (FIXP X1) + (FIXR X1)) + DD) + (IDIFFERENCE YY1 BOTTOM) + (\\DSPTRANSFORMX (OR (FIXP X2) + (FIXR X2)) + DD) + (IDIFFERENCE YY2 BOTTOM) + (COND + ((NULL WIDTH) + 1) + ((OR (FIXP WIDTH) + (FIXR WIDTH)))) + (SELECTQ OPERATION + (NIL (|ffetch| DDOPERATION |of| DD)) + ((REPLACE PAINT INVERT ERASE) + OPERATION) + (\\ILLEGAL.ARG OPERATION)) + BM + (|ffetch| |DDClippingLeft| |of| DD) + (SUB1 (|ffetch| |DDClippingRight| |of| DD)) + |CBottom| + (SUB1 |CTop|) + DISPLAYSTREAM COLOR))) + (SETQ BM (|GetNewFragment| BIGBMLIST)) + (SETQ HEIGHT BOTTOM))))) ) (DEFINEQ @@ -1140,64 +1081,58 @@ (DEFINEQ (DSPDESTINATION - (LAMBDA (DESTINATION DISPLAYSTREAM) (* \; "Edited 22-Sep-89 13:53 by takeshi") - (DECLARE (GLOBALVARS \\DISPLAYIMAGEOPS \\4DISPLAYIMAGEOPS \\8DISPLAYIMAGEOPS - \\24DISPLAYIMAGEOPS)) + (LAMBDA (DESTINATION DISPLAYSTREAM) (* \; "Edited 22-Sep-89 13:53 by takeshi") + (DECLARE (GLOBALVARS \\DISPLAYIMAGEOPS \\4DISPLAYIMAGEOPS \\8DISPLAYIMAGEOPS \\24DISPLAYIMAGEOPS) + ) (PROG (DD) (SETQ DD (\\GETDISPLAYDATA DISPLAYSTREAM DISPLAYSTREAM)) (RETURN (PROG1 (|ffetch| (\\DISPLAYDATA |DDDestination|) |of| DD) (COND (DESTINATION (* \; - "(SETQ DESTINATION (OR (\\\\DTEST DESTINATION 'BITMAP) (\\\\DTEST DESTINATION 'BIGBM)))") + "(SETQ DESTINATION (OR (\\\\DTEST DESTINATION 'BITMAP) (\\\\DTEST DESTINATION 'BIGBM)))") (COND ((|type?| BITMAP DESTINATION) (UNINTERRUPTABLY (|replace| (STREAM DEVICE) |of| DISPLAYSTREAM - |with| (SELECTQ (|fetch| (BITMAP - BITMAPBITSPERPIXEL - ) |of| - DESTINATION - ) - (1 |DisplayFDEV|) - (4 \\4DISPLAYFDEV) - (8 \\8DISPLAYFDEV) - (24 \\24DISPLAYFDEV) - (SHOULDNT))) + |with| (SELECTQ (|fetch| (BITMAP BITMAPBITSPERPIXEL) + |of| DESTINATION) + (1 |DisplayFDEV|) + (4 \\4DISPLAYFDEV) + (8 \\8DISPLAYFDEV) + (24 \\24DISPLAYFDEV) + (SHOULDNT))) (|replace| (STREAM IMAGEOPS) |of| DISPLAYSTREAM - |with| (SELECTQ (|fetch| (BITMAP - BITMAPBITSPERPIXEL - ) |of| - DESTINATION - ) - (1 \\DISPLAYIMAGEOPS) - (4 \\4DISPLAYIMAGEOPS) - (8 \\8DISPLAYIMAGEOPS) - (24 \\24DISPLAYIMAGEOPS) - (SHOULDNT))) - (|freplace| (\\DISPLAYDATA |DDDestination|) |of| - DD + |with| (SELECTQ (|fetch| (BITMAP BITMAPBITSPERPIXEL) + |of| DESTINATION) + (1 \\DISPLAYIMAGEOPS) + (4 \\4DISPLAYIMAGEOPS) + (8 \\8DISPLAYIMAGEOPS) + (24 \\24DISPLAYIMAGEOPS) + (SHOULDNT))) + (|freplace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| DESTINATION) (|\\SFFixDestination| DD DISPLAYSTREAM))) ((|type?| BIGBM DESTINATION) (UNINTERRUPTABLY - (|replace| (STREAM DEVICE) |of| DISPLAYSTREAM - |with| \\8DISPLAYFDEV) + (|replace| (STREAM DEVICE) |of| DISPLAYSTREAM |with| + \\8DISPLAYFDEV + ) (* |;;| "I'll add the bpp slot in BIGBM") - (|replace| (STREAM IMAGEOPS) |of| DISPLAYSTREAM - |with| \\8DISPLAYIMAGEOPS) - (|freplace| (\\DISPLAYDATA |DDDestination|) |of| - DD + (|replace| (STREAM IMAGEOPS) |of| DISPLAYSTREAM |with| + \\8DISPLAYIMAGEOPS + ) + (|freplace| (\\DISPLAYDATA |DDDestination|) |of| DD |with| DESTINATION) (|\\SFFixDestination| DD DISPLAYSTREAM))))))))))) (|\\SFFixY| - (LAMBDA (DISPLAYDATA CSINFO) (* \; "Edited 6-Jul-90 10:13 by matsuda") + (LAMBDA (DISPLAYDATA CSINFO) (* \; "Edited 6-Jul-90 10:13 by matsuda") (* |;;| "makes that part of the bitblt table of a display stream which deals with the Y information consistent. This is called from \\BLTCHAR whenever a character is being printed and the charset/y-position caches are invalid") (* \; - "assumes DISPLAYDATA has already been type checked.") + "assumes DISPLAYDATA has already been type checked.") (PROG ((PBT (|ffetch| DDPILOTBBT |of| DISPLAYDATA)) (Y (\\DSPTRANSFORMY (|ffetch| DDYPOSITION |of| DISPLAYDATA) DISPLAYDATA)) @@ -1212,60 +1147,52 @@ 0)) (|freplace| PBTDEST |of| PBT |with| NIL) (|freplace| PBTSOURCE |of| PBT - |with| (\\ADDBASE (|ffetch| BITMAPBASE |of| (SETQ BM (|ffetch| - (CHARSETINFO - CHARSETBITMAP) - |of| CSINFO) - )) - (ITIMES (|ffetch| BITMAPRASTERWIDTH |of| BM) - (|freplace| DDCHARHEIGHTDELTA |of| DISPLAYDATA - |with| (IMIN (IMAX (IDIFFERENCE CHARTOP TOP) - 0) - MAX.SMALL.INTEGER))))) + |with| (\\ADDBASE (|ffetch| BITMAPBASE |of| (SETQ BM (|ffetch| (CHARSETINFO + CHARSETBITMAP) + |of| CSINFO))) + (ITIMES (|ffetch| BITMAPRASTERWIDTH |of| BM) + (|freplace| DDCHARHEIGHTDELTA |of| DISPLAYDATA + |with| (IMIN (IMAX (IDIFFERENCE CHARTOP TOP) + 0) + MAX.SMALL.INTEGER))))) (|freplace| PBTHEIGHT |of| PBT - |with| (IMAX (IDIFFERENCE TOP (IMAX (IDIFFERENCE Y (|freplace| - DDCHARSETDESCENT - |of| DISPLAYDATA - |with| (|ffetch| - CHARSETDESCENT - |of| - CSINFO))) - (|ffetch| |DDClippingBottom| - |of| DISPLAYDATA))) - 0))) + |with| (IMAX (IDIFFERENCE TOP (IMAX (IDIFFERENCE Y (|freplace| DDCHARSETDESCENT + |of| DISPLAYDATA + |with| (|ffetch| + CHARSETDESCENT + |of| CSINFO))) + (|ffetch| |DDClippingBottom| |of| DISPLAYDATA))) + 0))) (T (|freplace| PBTDEST |of| PBT |with| (\\ADDBASE (|fetch| BITMAPBASE |of| BM) - (ITIMES (|ffetch| BITMAPRASTERWIDTH |of| BM) - (|\\SFInvert| BM (SETQ TOP - (IMAX (IMIN (|ffetch| - |DDClippingTop| - |of| DISPLAYDATA) - CHARTOP) - 0)))))) + (ITIMES (|ffetch| BITMAPRASTERWIDTH |of| BM) + (|\\SFInvert| BM (SETQ TOP + (IMAX (IMIN (|ffetch| |DDClippingTop| + |of| DISPLAYDATA) + CHARTOP) + 0)))))) (|freplace| PBTSOURCE |of| PBT - |with| (\\ADDBASE (|ffetch| BITMAPBASE |of| (SETQ BM - (|ffetch| - (CHARSETINFO - CHARSETBITMAP) - |of| CSINFO))) - (ITIMES (|ffetch| BITMAPRASTERWIDTH |of| BM) - (|freplace| DDCHARHEIGHTDELTA |of| DISPLAYDATA - |with| (IMIN (IMAX (IDIFFERENCE CHARTOP TOP) - 0) - MAX.SMALL.INTEGER))))) + |with| (\\ADDBASE (|ffetch| BITMAPBASE |of| (SETQ BM (|ffetch| (CHARSETINFO + CHARSETBITMAP + ) + |of| CSINFO))) + (ITIMES (|ffetch| BITMAPRASTERWIDTH |of| BM) + (|freplace| DDCHARHEIGHTDELTA |of| DISPLAYDATA + |with| (IMIN (IMAX (IDIFFERENCE CHARTOP TOP) + 0) + MAX.SMALL.INTEGER))))) (|freplace| PBTHEIGHT |of| PBT - |with| (IMAX (IDIFFERENCE TOP (IMAX (IDIFFERENCE Y - (|freplace| DDCHARSETDESCENT - |of| DISPLAYDATA - |with| (|ffetch| + |with| (IMAX (IDIFFERENCE TOP (IMAX (IDIFFERENCE Y (|freplace| DDCHARSETDESCENT + |of| DISPLAYDATA + |with| (|ffetch| CHARSETDESCENT |of| CSINFO))) - (|ffetch| |DDClippingBottom| - |of| DISPLAYDATA))) - 0))))))) + (|ffetch| |DDClippingBottom| |of| DISPLAYDATA) + )) + 0))))))) (|\\SFFixDestination| - (LAMBDA (DISPLAYDATA DISPLAYSTREAM) (* \; "Edited 6-Jul-90 13:55 by matsuda") + (LAMBDA (DISPLAYDATA DISPLAYSTREAM) (* \; "Edited 6-Jul-90 13:55 by matsuda") (* |;;| "fixes up those parts of the bitblt array which are dependent upon the destination") @@ -1273,56 +1200,52 @@ (BM (|ffetch| (\\DISPLAYDATA |DDDestination|) |of| DISPLAYDATA))) (|replace| (PILOTBBT PBTDESTBPL) |of| PBT |with| (UNFOLD (COND - ((|type?| BITMAP BM) - (|ffetch| (BITMAP BITMAPRASTERWIDTH) |of| BM)) - (T (|ffetch| (BITMAP BITMAPRASTERWIDTH) - |of| (CAR (|fetch| (BIGBM BIGBMLIST) OF BM))))) - BITSPERWORD)) (* \; - "line width information will be updated by \\SFFixFont") + ((|type?| BITMAP BM) + (|ffetch| (BITMAP BITMAPRASTERWIDTH) |of| BM)) + (T (|ffetch| (BITMAP BITMAPRASTERWIDTH) + |of| (CAR (|fetch| (BIGBM BIGBMLIST) OF BM))))) + BITSPERWORD)) (* \; + "line width information will be updated by \\SFFixFont") (|\\SFFixClippingRegion| DISPLAYDATA) (\\INVALIDATEDISPLAYCACHE DISPLAYDATA) (|\\SFFixFont| DISPLAYSTREAM DISPLAYDATA) (RETURN)))) (|\\SFFixClippingRegion| - (LAMBDA (DISPLAYDATA) (* \; "Edited 6-Jul-90 13:55 by matsuda") + (LAMBDA (DISPLAYDATA) (* \; "Edited 6-Jul-90 13:55 by matsuda") (* |;;| "compute the top, bottom, left and right edges of the clipping region in destination coordinates to save computation every BltChar and coordinate transformation taking into account the size of the bit map as well as the clipping region.") (PROG ((CLIPREG (|ffetch| (\\DISPLAYDATA |DDClippingRegion|) |of| DISPLAYDATA)) (BM (|ffetch| (\\DISPLAYDATA |DDDestination|) |of| DISPLAYDATA))) (|freplace| (\\DISPLAYDATA |DDClippingRight|) |of| DISPLAYDATA - |with| (IMAX 0 (IMIN (\\DSPTRANSFORMX (IPLUS (|ffetch| (REGION LEFT) - |of| CLIPREG) - (|ffetch| (REGION WIDTH) - |of| CLIPREG)) - DISPLAYDATA) - (BITMAPWIDTH BM)))) + |with| (IMAX 0 (IMIN (\\DSPTRANSFORMX (IPLUS (|ffetch| (REGION LEFT) |of| CLIPREG) + (|ffetch| (REGION WIDTH) |of| CLIPREG)) + DISPLAYDATA) + (BITMAPWIDTH BM)))) (|freplace| (\\DISPLAYDATA |DDClippingLeft|) |of| DISPLAYDATA |with| (IMIN (IMAX (\\DSPTRANSFORMX (|ffetch| (REGION LEFT) |of| CLIPREG) - DISPLAYDATA) - 0) - MAX.SMALL.INTEGER)) + DISPLAYDATA) + 0) + MAX.SMALL.INTEGER)) (|freplace| (\\DISPLAYDATA |DDClippingTop|) |of| DISPLAYDATA - |with| (IMAX 0 (IMIN (\\DSPTRANSFORMY (IPLUS (|ffetch| (REGION BOTTOM) - |of| CLIPREG) - (|ffetch| (REGION HEIGHT) - |of| CLIPREG)) - DISPLAYDATA) - (BITMAPHEIGHT BM)))) + |with| (IMAX 0 (IMIN (\\DSPTRANSFORMY (IPLUS (|ffetch| (REGION BOTTOM) |of| CLIPREG) + (|ffetch| (REGION HEIGHT) |of| CLIPREG)) + DISPLAYDATA) + (BITMAPHEIGHT BM)))) (|freplace| (\\DISPLAYDATA |DDClippingBottom|) |of| DISPLAYDATA |with| (IMIN (IMAX (\\DSPTRANSFORMY (|ffetch| (REGION BOTTOM) |of| CLIPREG) - DISPLAYDATA) - 0) - MAX.SMALL.INTEGER))))) + DISPLAYDATA) + 0) + MAX.SMALL.INTEGER))))) ) (DEFINEQ (\\SW2BM - (LAMBDA (P PR Q QR) (* \; "Edited 8-Sep-89 16:14 by takeshi") + (LAMBDA (P PR Q QR) (* \; "Edited 8-Sep-89 16:14 by takeshi") (* |Switches| |the| |areas| |of| P |and| Q |defined| |by| |the| |regions| PR - |and| QR |respectively|) + |and| QR |respectively|) (PROG (PL PH PW PB QL QH QW QB) (COND @@ -1402,7 +1325,7 @@ (BITBLT P XP YP Q XQ YQ CW CH 'INPUT 'INVERT))))))) (BITMAPHEIGHT - (LAMBDA (BITMAP) (* \; "Edited 22-Sep-89 14:05 by takeshi") + (LAMBDA (BITMAP) (* \; "Edited 22-Sep-89 14:05 by takeshi") (* |;;| "returns the height in pixels of a bitmap.") @@ -1416,7 +1339,7 @@ (T (\\ILLEGAL.ARG BITMAP))))) (BITMAPWIDTH - (LAMBDA (BITMAP) (* \; "Edited 22-Sep-89 14:07 by takeshi") + (LAMBDA (BITMAP) (* \; "Edited 22-Sep-89 14:07 by takeshi") (* |;;| "returns the width of a bitmap in pixels") @@ -1430,23 +1353,22 @@ (T (\\ILLEGAL.ARG BITMAP))))) (|\\SFFixFont| - (LAMBDA (DISPLAYSTREAM DISPLAYDATA) (* \; "Edited 6-Jul-90 10:11 by matsuda") + (LAMBDA (DISPLAYSTREAM DISPLAYDATA) (* \; "Edited 6-Jul-90 10:11 by matsuda") (* |;;| "used to fix up those parts of the bitblt table which depend upon the FONT. DISPLAYDATA is the IMAGEDATA for DISPLAYSTREAM, for convenience.") (PROG ((PILOTBBT (|ffetch| (\\DISPLAYDATA DDPILOTBBT) |of| DISPLAYDATA)) (FONT (|ffetch| (\\DISPLAYDATA DDFONT) |of| DISPLAYDATA)) - (BITSPERPIXEL (BITSPERPIXEL (|ffetch| (\\DISPLAYDATA |DDDestination|) - |of| DISPLAYDATA)))) + (BITSPERPIXEL (BITSPERPIXEL (|ffetch| (\\DISPLAYDATA |DDDestination|) |of| DISPLAYDATA)))) (|freplace| (\\DISPLAYDATA |DDSlowPrintingCase|) |of| DISPLAYDATA |with| (OR (NOT (EQ BITSPERPIXEL 1)) - (NOT (EQ (|ffetch| (FONTDESCRIPTOR ROTATION) |of| FONT) - 0))))) + (NOT (EQ (|ffetch| (FONTDESCRIPTOR ROTATION) |of| FONT) + 0))))) (\\INVALIDATEDISPLAYCACHE DISPLAYDATA) (\\SFFIXLINELENGTH DISPLAYSTREAM))) (BITSPERPIXEL - (LAMBDA (BITMAP) (* \; "Edited 29-Jun-90 10:15 by matsuda") + (LAMBDA (BITMAP) (* \; "Edited 29-Jun-90 10:15 by matsuda") (* |;;| "returns the height in pixels of a bitmap.") @@ -1454,14 +1376,12 @@ ((|type?| BITMAP BITMAP) (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| BITMAP)) ((|type?| BIGBM BITMAP) - (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| (CAR (|fetch| (BIGBM BIGBMLIST) - |of| BITMAP)))) + (|fetch| (BITMAP BITMAPBITSPERPIXEL) |of| (CAR (|fetch| (BIGBM BIGBMLIST) |of| BITMAP)))) ((|type?| SCREEN BITMAP) (BITSPERPIXEL (|fetch| (SCREEN SCDESTINATION) |of| BITMAP))) ((|type?| WINDOW BITMAP) (BITSPERPIXEL (|fetch| (WINDOW SCREEN) |of| BITMAP))) - ((ARRAYP BITMAP) (* \; - "Consider array to be a colormap.") + ((ARRAYP BITMAP) (* \; "Consider array to be a colormap.") (SELECTQ (ARRAYSIZE BITMAP) (256 8) (16 4) @@ -1471,10 +1391,8 @@ (DEFINEQ (COLORIZEBITMAP - (LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL) (* \; - "Edited 26-Oct-2021 14:23 by larry") - (* \; - "Edited 13-Jul-90 14:42 by matsuda") + (LAMBDA (BITMAP 0COLOR 1COLOR BITSPERPIXEL) (* \; "Edited 26-Oct-2021 14:23 by larry") + (* \; "Edited 13-Jul-90 14:42 by matsuda") (* |;;| "creates a copy of BITMAP that is in color form allowing BITSPERPIXEL per pixel. 0COLOR and 1COLOR are the color numbers that get translated from 0 and 1 respectively.") @@ -1484,8 +1402,7 @@ BITSPERPIXEL)) (COND ((NOT (|type?| BIGBM COLORBITMAP)) - (\\BWTOCOLORBLT BITMAP 0 0 COLORBITMAP 0 0 (|fetch| (BITMAP BITMAPWIDTH) - |of| BITMAP) + (\\BWTOCOLORBLT BITMAP 0 0 COLORBITMAP 0 0 (|fetch| (BITMAP BITMAPWIDTH) |of| BITMAP) (|fetch| (BITMAP BITMAPHEIGHT) |of| BITMAP) (COLORNUMBERP 0COLOR BITSPERPIXEL) (COLORNUMBERP 1COLOR BITSPERPIXEL) @@ -1494,31 +1411,24 @@ (SETQ DESTBMLIST (|fetch| (BIGBM BIGBMLIST) |of| COLORBITMAP)) (SETQ DESTBM (|GetNewFragment| DESTBMLIST)) (SETQ SOURCEBOOTTOM (|fetch| (BITMAP BITMAPHEIGHT) |of| BITMAP)) - (|while| DESTBM |do| (SETQ DESTBMHEIGHT (|fetch| (BITMAP - BITMAPHEIGHT - ) - |of| DESTBM)) - (SETQ SOURCEBOOTTOM (- SOURCEBOOTTOM DESTBMHEIGHT)) - (\\BWTOCOLORBLT BITMAP 0 SOURCEBOOTTOM DESTBM 0 0 - (|fetch| (BITMAP BITMAPWIDTH) |of| - BITMAP) - DESTBMHEIGHT - (COLORNUMBERP 0COLOR BITSPERPIXEL) - (COLORNUMBERP 1COLOR BITSPERPIXEL) - BITSPERPIXEL) - (SETQ DESTBM (|GetNewFragment| DESTBMLIST)))))) + (|while| DESTBM |do| (SETQ DESTBMHEIGHT (|fetch| (BITMAP BITMAPHEIGHT) + |of| DESTBM)) + (SETQ SOURCEBOOTTOM (- SOURCEBOOTTOM DESTBMHEIGHT)) + (\\BWTOCOLORBLT BITMAP 0 SOURCEBOOTTOM DESTBM 0 0 + (|fetch| (BITMAP BITMAPWIDTH) |of| BITMAP) + DESTBMHEIGHT + (COLORNUMBERP 0COLOR BITSPERPIXEL) + (COLORNUMBERP 1COLOR BITSPERPIXEL) + BITSPERPIXEL) + (SETQ DESTBM (|GetNewFragment| DESTBMLIST)))))) (RETURN COLORBITMAP)))) (\\BWTOCOLORBLT - (LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS) - (* \; - "Edited 26-Oct-2021 14:36 by larry") - (* \; - "Edited 26-Oct-2021 14:32 by larry") - (* \; - "Edited 26-Oct-2021 14:26 by larry") - (* \; - "Edited 8-May-2021 22:31 by rmk:") + (LAMBDA (SOURCEBWBM SLEFT SBOTTOM DESTCOLORBM DLEFT DBOTTOM WIDTH HEIGHT 0COLOR 1COLOR DESTNBITS) + (* \; "Edited 26-Oct-2021 14:36 by larry") + (* \; "Edited 26-Oct-2021 14:32 by larry") + (* \; "Edited 26-Oct-2021 14:26 by larry") + (* \; "Edited 8-May-2021 22:31 by rmk:") (* |;;| "blits from a black and white bitmap into a color bitmap which has DESTNBITS bits per pixel. DESTCOLORBM is a pointer to the color bitmap.") @@ -1540,44 +1450,40 @@ (SETQ DESOFF (MOD DLEFT 4)) (SETQ NBITS 4) - (* |;;| - "DESTCOLORBM is used to allow one bit per pixel bitblt operations on the bitmap.") + (* |;;| "DESTCOLORBM is used to allow one bit per pixel bitblt operations on the bitmap.") (COND ((NOT (EQ 0 DESOFF)) (* |;;| - "save the left bits of the destination bitmap so it can be word aligned.") + "save the left bits of the destination bitmap so it can be word aligned.") (SETQ SCR (BITMAPCREATE 4 HEIGHT 4)) (BITBLT DESTCOLORBM (SETQ DESALIGNLEFT (LLSH DESWRD 2)) DBOTTOM SCR 0 0 DESOFF HEIGHT 'INPUT 'REPLACE))) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do| - - (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.") - - (\\4BITLINEBLT (\\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT - (IPLUS LINECOUNTER - SBOTTOM)) - SRCRW) - SRCWRD)) - SRCOFFSET - (\\ADDBASE DESBASE (IPLUS (ITIMES (IDIFFERENCE DESHEIGHT - (IPLUS LINECOUNTER DBOTTOM) - ) - DESRW) - DESWRD)) - WIDTH MAP 0COLOR 1COLOR)) + (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.") + + (\\4BITLINEBLT (\\ADDBASE SRCBASE (IPLUS (ITIMES (IDIFFERENCE SRCHEIGHT + (IPLUS LINECOUNTER + SBOTTOM)) + SRCRW) + SRCWRD)) + SRCOFFSET + (\\ADDBASE DESBASE (IPLUS (ITIMES (IDIFFERENCE DESHEIGHT + (IPLUS LINECOUNTER DBOTTOM)) + DESRW) + DESWRD)) + WIDTH MAP 0COLOR 1COLOR)) (COND (DESALIGNLEFT (* |;;| - "move the color bits to the right and restore the saved color bits.") + "move the color bits to the right and restore the saved color bits.") - (BITBLT DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM (IPLUS - DESALIGNLEFT - DESOFF) + (BITBLT DESTCOLORBM DESALIGNLEFT DBOTTOM DESTCOLORBM (IPLUS DESALIGNLEFT + DESOFF) DBOTTOM WIDTH HEIGHT 'INPUT 'REPLACE) (BITBLT SCR 0 0 DESTCOLORBM DESALIGNLEFT DBOTTOM DESOFF HEIGHT 'INPUT @@ -1593,30 +1499,24 @@ (SETQ DESRW (|fetch| (BITMAP BITMAPRASTERWIDTH) |of| DESTCOLORBM)) (|for| LINECOUNTER |from| 1 |to| HEIGHT |do| + (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.") - (* |;;| "linecounter goes from 1 to height because bitmaps are stored internally with top first so subtracting height is necessary to get offset of line and the 1 corrects for height difference.") - - (\\24BITLINEBLT (\\ADDBASE SRCBASE (ITIMES (IDIFFERENCE SRCHEIGHT - (IPLUS LINECOUNTER - SBOTTOM)) - SRCRW)) - SLEFT - (\\ADDBASE DESBASE (ITIMES (IDIFFERENCE DESHEIGHT (IPLUS - LINECOUNTER - DBOTTOM)) - DESRW)) - DLEFT WIDTH 0COLOR 1COLOR)))) + (\\24BITLINEBLT (\\ADDBASE SRCBASE (ITIMES (IDIFFERENCE SRCHEIGHT + (IPLUS LINECOUNTER + SBOTTOM)) + SRCRW)) + SLEFT + (\\ADDBASE DESBASE (ITIMES (IDIFFERENCE DESHEIGHT (IPLUS LINECOUNTER + DBOTTOM)) + DESRW)) + DLEFT WIDTH 0COLOR 1COLOR)))) (SHOULDNT)))) (UNCOLORIZEBITMAP - (LAMBDA (BITMAP COLORMAP) (* \; - "Edited 26-Oct-2021 14:51 by larry") - (* \; - "Edited 26-Oct-2021 14:44 by larry") - (* \; - "Edited 26-Oct-2021 14:44 by larry") - (* \; - "Edited 13-Jul-90 16:54 by matsuda") + (LAMBDA (BITMAP COLORMAP) (* \; "Edited 26-Oct-2021 14:51 by larry") + (* \; "Edited 26-Oct-2021 14:44 by larry") + (* \; "Edited 26-Oct-2021 14:44 by larry") + (* \; "Edited 13-Jul-90 16:54 by matsuda") (PROG (BITSPERPIXEL MAXCOLOR MAXX MAXY BWBITMAP TABLE RGB R G B BIT BASE BWBASE RASTERWIDTH BWRASTERWIDTH WORD) (SETQ MAXX (SUB1 (BITMAPWIDTH BITMAP))) @@ -1629,14 +1529,13 @@ 1)) (SETQ TABLE (\\ALLOCBLOCK (FOLDHI (ADD1 MAXCOLOR) 2))) - (|for| I |from| 0 |to| MAXCOLOR - |do| (SETQ RGB (ELT COLORMAP I)) - (SETQ R (|fetch| (RGB RED) |of| RGB)) - (SETQ G (|fetch| (RGB GREEN) |of| RGB)) - (SETQ B (|fetch| (RGB BLUE) |of| RGB)) - (SETQ BIT (IDIFFERENCE 1 (IQUOTIENT (IPLUS R G B) - 384))) - (\\PUTBASE TABLE I BIT)) + (|for| I |from| 0 |to| MAXCOLOR |do| (SETQ RGB (ELT COLORMAP I)) + (SETQ R (|fetch| (RGB RED) |of| RGB)) + (SETQ G (|fetch| (RGB GREEN) |of| RGB)) + (SETQ B (|fetch| (RGB BLUE) |of| RGB)) + (SETQ BIT (IDIFFERENCE 1 (IQUOTIENT (IPLUS R G B) + 384))) + (\\PUTBASE TABLE I BIT)) (COND ((|type?| BITMAP BITMAP) (SETQ BASE (|fetch| (BITMAP BITMAPBASE) |of| BITMAP)) @@ -1646,25 +1545,26 @@ (SELECTQ BITSPERPIXEL (4 (|for| Y |from| 0 |to| MAXY |do| (SETQ WORD 0) - (|for| X |from| 0 |to| MAXX - |do| (SETQ WORD (LOGOR (LLSH WORD 1) - (\\GETBASE TABLE (\\GETBASENYBBLE BASE X)))) - (COND - ((EQ (LOGAND X 15) - 15) - (\\PUTBASE BWBASE (FOLDLO X 16) - WORD) - (SETQ WORD 0)))) - (COND - ((NOT (EQ (LOGAND MAXX 15) - 15)) - (SETQ WORD (LLSH WORD (IDIFFERENCE 15 (LOGAND MAXX 15)))) - (\\PUTBASE BWBASE (FOLDLO MAXX 16) - WORD))) - (COND - ((NOT (EQ Y MAXY)) - (SETQ BASE (\\ADDBASE BASE RASTERWIDTH)) - (SETQ BWBASE (\\ADDBASE BWBASE BWRASTERWIDTH)))))) + (|for| X |from| 0 |to| MAXX |do| (SETQ WORD (LOGOR (LLSH WORD 1) + (\\GETBASE TABLE + (\\GETBASENYBBLE + BASE X)))) + (COND + ((EQ (LOGAND X 15) + 15) + (\\PUTBASE BWBASE (FOLDLO X 16) + WORD) + (SETQ WORD 0)))) + (COND + ((NOT (EQ (LOGAND MAXX 15) + 15)) + (SETQ WORD (LLSH WORD (IDIFFERENCE 15 (LOGAND MAXX 15)))) + (\\PUTBASE BWBASE (FOLDLO MAXX 16) + WORD))) + (COND + ((NOT (EQ Y MAXY)) + (SETQ BASE (\\ADDBASE BASE RASTERWIDTH)) + (SETQ BWBASE (\\ADDBASE BWBASE BWRASTERWIDTH)))))) (8 (COND ((NOT (|type?| BIGBM BITMAP)) (SUBRCALL UNCOLORIZE-BITMAP BITMAP BWBITMAP TABLE)) @@ -1677,25 +1577,21 @@ (ADD1 MAXY) 1))) (SETQ SRCBITMAP (|GetNewFragment| SRCBIGBMLIST)) - (|while| SRCBITMAP |do| (SETQ DESTBOTTOM - (IDIFFERENCE DESTBOTTOM - (SETQ HEIGHT (|fetch| - (BITMAP - BITMAPHEIGHT - ) - |of| - SRCBITMAP) - ))) - (SUBRCALL UNCOLORIZE-BITMAP SRCBITMAP - TEMPBM TABLE) - (BITBLT TEMPBM 0 (IDIFFERENCE - (ADD1 MAXY) - HEIGHT) - BWBITMAP 0 DESTBOTTOM WIDTH HEIGHT - 'INPUT - 'REPLACE) - (SETQ SRCBITMAP (|GetNewFragment| - SRCBIGBMLIST))))))) + (|while| SRCBITMAP |do| (SETQ DESTBOTTOM (IDIFFERENCE + DESTBOTTOM + (SETQ HEIGHT + (|fetch| (BITMAP BITMAPHEIGHT + ) + |of| SRCBITMAP)))) + (SUBRCALL UNCOLORIZE-BITMAP SRCBITMAP TEMPBM + TABLE) + (BITBLT TEMPBM 0 (IDIFFERENCE (ADD1 MAXY) + HEIGHT) + BWBITMAP 0 DESTBOTTOM WIDTH HEIGHT + 'INPUT + 'REPLACE) + (SETQ SRCBITMAP (|GetNewFragment| SRCBIGBMLIST)) + ))))) NIL) (RETURN BWBITMAP)))) ) @@ -1709,17 +1605,16 @@ (MOVD 'BITBLT 'BKBITBLT) ) -(PUTPROPS BIGBITMAPS COPYRIGHT ("Venue" 1991 1993 1994)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (3364 48769 (BIGBITMAPP 3374 . 3520) (BITBLT.BIGBM 3522 . 14345) (BITMAPCREATE.BIGBM -14347 . 15689) (BITMAPCREATE 15691 . 17293) (BITMAPCOPY 17295 . 17830) (BIGBITMAPEQUAL 17832 . 18537) -(BLTSHADE.BIGBM 18539 . 21675) (BITBLT 21677 . 23325) (\\ORG.BITBLT 23327 . 34896) (\\BLTSHADE.DISPLAY - 34898 . 44136) (\\RESHOWBORDER1 44138 . 48767)) (48770 72048 (\\DRAWCIRCLE.BIGBM 48780 . 52143) ( -\\FILLCIRCLE.BIGBM 52145 . 56191) (\\DRAWELLIPSE.BIGBM 56193 . 60713) (\\DRAWCURVE.BIGBM 60715 . 64565 -) (\\DRAWLINE.BIGBM.DASH 64567 . 68926) (\\DRAWLINE.BIGBM.NODASH 68928 . 72046)) (72049 72418 ( -\\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM 72059 . 72416)) (72550 85693 (DSPDESTINATION 72560 . -76458) (|\\SFFixY| 76460 . 82182) (|\\SFFixDestination| 82184 . 83367) (|\\SFFixClippingRegion| 83369 - . 85691)) (85694 93780 (\\SW2BM 85704 . 90728) (BITMAPHEIGHT 90730 . 91228) (BITMAPWIDTH 91230 . -91722) (|\\SFFixFont| 91724 . 92696) (BITSPERPIXEL 92698 . 93778)) (93781 109134 (COLORIZEBITMAP 93791 - . 96601) (\\BWTOCOLORBLT 96603 . 103196) (UNCOLORIZEBITMAP 103198 . 109132))))) + (FILEMAP (NIL (4138 46815 (BIGBITMAPP 4148 . 4300) (BITBLT.BIGBM 4302 . 14741) (BITMAPCREATE 14744 . +16348) (BITMAPCOPY 16350 . 16881) (BIGBITMAPEQUAL 16883 . 17588) (BLTSHADE.BIGBM 17590 . 20699) ( +BITBLT 20701 . 22349) (\\ORG.BITBLT 22351 . 33504) (\\BLTSHADE.DISPLAY 33506 . 42277) (\\RESHOWBORDER1 + 42279 . 46813)) (46816 68361 (\\DRAWCIRCLE.BIGBM 46826 . 49950) (\\FILLCIRCLE.BIGBM 49952 . 53782) ( +\\DRAWELLIPSE.BIGBM 53784 . 57990) (\\DRAWCURVE.BIGBM 57992 . 61510) (\\DRAWLINE.BIGBM.DASH 61512 . +65335) (\\DRAWLINE.BIGBM.NODASH 65337 . 68359)) (68362 68731 ( +\\GENERIC.DSPCREATE.DESTINATION.BITMAP?.BIGBM 68372 . 68729)) (68863 80404 (DSPDESTINATION 68873 . +72194) (|\\SFFixY| 72196 . 77207) (|\\SFFixDestination| 77209 . 78382) (|\\SFFixClippingRegion| 78384 + . 80402)) (80405 88325 (\\SW2BM 80415 . 85445) (BITMAPHEIGHT 85447 . 85949) (BITMAPWIDTH 85951 . +86447) (|\\SFFixFont| 86449 . 87367) (BITSPERPIXEL 87369 . 88323)) (88326 102387 (COLORIZEBITMAP 88336 + . 90638) (\\BWTOCOLORBLT 90640 . 96689) (UNCOLORIZEBITMAP 96691 . 102385))))) STOP diff --git a/library/BIGBITMAPS.LCOM b/library/BIGBITMAPS.LCOM index 4783daae8..d7acaebb2 100644 Binary files a/library/BIGBITMAPS.LCOM and b/library/BIGBITMAPS.LCOM differ diff --git a/scripts/do_compiles.sh b/scripts/do_compiles.sh new file mode 100755 index 000000000..34853b8e6 --- /dev/null +++ b/scripts/do_compiles.sh @@ -0,0 +1,249 @@ +#!/bin/sh +# +# do_compiles.sh +# +# Script to compile all files in MEDLEYDIR sources, one at a time each time in a fresh MEDLEY +# +# FGH 2025-09-30 +# +# Copyright 2025 Interlisp.org +# + +main() { + MEDLEYDIR=$(cd "${SCRIPTDIR}/.." && pwd) + export MEDLEYDIR + SOURCESDIR="${MEDLEYDIR}/sources" + logindir=/tmp/compiles + mkdir -p "${logindir}" + cmfile=${logindir}/compile.cm + + nextDribble + + for f in "${SOURCESDIR}"/*.LCOM "${SOURCESDIR}"/*.lcom + do + if [ "$f" = "${SOURCESDIR}/*.LCOM" ] || [ "$f" = "${SOURCESDIR}/*.lcom" ] + then + continue + fi + ff="$(basename "$f" | sed -e s-.lcom\$-- -e s-.LCOM\$--)" + if grep "COMPILED-FILEd" "$f" 2> /dev/null + then + doCompile "$ff" "IL:FAKE-COMPILE-FILE" "$f" + else + doCompile "$ff" "IL:TCOMPL" "$f" + fi + done + + # + for f in ${SOURCESDIR}/*.DFASL ${SOURCESDIR}/*.dfasl + do + if [ "$f" = "${SOURCESDIR}/*.DFASL" ] || [ "$f" = "${SOURCESDIR}/*.dfasl" ] + then + continue + fi + ff="$(basename "$f" | sed -e s-\.dfasl\$-- -e s-\.DFASL\$--)" + doCompile "$ff" "CL:COMPILE-FILE" "$f" + done +} + + + +doCompile() { + + + findMaxVersion "$3" + oldver=$? + + cat >"${cmfile}" <<-EOF + " + + (PROGN + (IL:MEDLEY-INIT-VARS 'IL:GREET) + (IL:FILESLOAD ${MEDLEYDIR}/loadups/exports.all) + (IL:ADVISE 'IL:ASKUSER :BEFORE '(RETURN (IL:QUOTE IL:F))) + (IL:DRIBBLE '${DRIBBLE} T) + (PRINT '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>) + (PRINT '$1) + (PRINT '$2) + (IL:CNDIR '${MEDLEYDIR}/sources) + ($2 '$1) + (PRINT '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<) + (IL:DRIBBLE) + (IL:LOGOUT T) + ) + + " + EOF + + /bin/sh "${MEDLEYDIR}/scripts/medley/medley.command" \ + --config - \ + --id $1 \ + --geometry 1024x768 \ + --noscroll \ + --logindir "${logindir}" \ + --greet - \ + --rem.cm "${cmfile}" \ + --full + + findMaxVersion "$3" + newver=$? + + if [ $newver -eq $oldver ] + then + echo " " >> "${DRIBBLE}" + echo !!!!!!!!!!!!!!!!!!!! FAIL "$3" >> "${DRIBBLE}" + echo !!!!!!!!!!!!!!!!!!!! FAIL "$3" + fi + +} + + +nextDribble() { + + export DRIBBLE="${MEDLEYDIR}/loadups/compiles.dribble" + dest="${DRIBBLE}" + if [ ! -e "$dest" ] + then + touch $dest + fi + + findMaxVersion $dest + + if [ $max -eq 0 ]; then # no current versions + mv $dest $dest.~1~ # change version to version 1 + new=2 + else + if cmp -q $dest $dest.~$max~ >/dev/null 2>&1 + then # they're different + max=`expr $max + 1` # make newer version + mv $dest $dest.~$max~ + new=`expr $max + 1` + else # dest and dest.~nn~ are equal so + rm $dest # delete dest leave old version behind + new=`expr $max + 1` + fi + fi + DRIBBLE="$dest.~$new~" + +} + + +findMaxVersion() { + dest="$1" + # find maximum version of dest + max=0 + for vf in "$dest".~[1-9]*~ + do vn=`echo $vf | sed -e 's/^.*\.~\([1-9][0-9]*\)~$/\1/'` + if [ -f $dest.~$vn~ ]; then + if [ $max -lt $vn ]; then + max=$vn + fi + fi + done + if [ $max -eq 0 ]; then + ln $dest $dest.~1~ + max=1 + fi + return $max +} + +# shellcheck disable=SC2164,SC2034 +if [ -z "${SCRIPTDIR}" ] +then + # + # + # Some functions to determine what directory this script is being executed from + # + # + get_abs_filename() { + # $1 : relative filename + echo "$(cd "$(dirname "$1")" && pwd)/$(basename "$1")" + } + + # This function taken from + # https://stackoverflow.com/questions/29832037/how-to-get-script-directory-in-posix-sh + rreadlink() ( + + # Execute this function in a *subshell* to localize variables and the effect of `cd`. + + target=$1 + fname= + targetDir= + CDPATH= + + # Try to make the execution environment as predictable as possible: + # All commands below are invoked via `command`, so we must make sure that `command` + # itself is not redefined as an alias or shell function. + # (Note that command is too inconsistent across shells, so we don't use it.) + # `command` is a *builtin* in bash, dash, ksh, zsh, and some platforms do not even have + # an external utility version of it (e.g, Ubuntu). + # `command` bypasses aliases and shell functions and also finds builtins + # in bash, dash, and ksh. In zsh, option POSIX_BUILTINS must be turned on for that + # to happen. + { \unalias command; \unset -f command; } >/dev/null 2>&1 + [ -n "$ZSH_VERSION" ] && options[POSIX_BUILTINS]=on # make zsh find *builtins* with `command` too. + + while :; do # Resolve potential symlinks until the ultimate target is found. + [ -L "$target" ] || [ -e "$target" ] || { command printf '%s\n' "ERROR: '$target' does not exist." >&2; return 1; } + command cd "$(command dirname -- "$target")" # Change to target dir; necessary for correct resolution of target path. + fname=$(command basename -- "$target") # Extract filename. + [ "$fname" = '/' ] && fname='' # !! curiously, `basename /` returns '/' + if [ -L "$fname" ]; then + # Extract [next] target path, which may be defined + # *relative* to the symlink's own directory. + # Note: We parse `ls -l` output to find the symlink target + # which is the only POSIX-compliant, albeit somewhat fragile, way. + target=$(command ls -l "$fname") + target=${target#* -> } + continue # Resolve [next] symlink target. + fi + break # Ultimate target reached. + done + targetDir=$(command pwd -P) # Get canonical dir. path + # Output the ultimate target's canonical path. + # Note that we manually resolve paths ending in /. and /.. to make sure we have a normalized path. + if [ "$fname" = '.' ]; then + command printf '%s\n' "${targetDir%/}" + elif [ "$fname" = '..' ]; then + # Caveat: something like /var/.. will resolve to /private (assuming /var@ -> /private/var), i.e. the '..' is applied + # AFTER canonicalization. + command printf '%s\n' "$(command dirname -- "${targetDir}")" + else + command printf '%s\n' "${targetDir%/}/$fname" + fi + ) + + get_script_dir() { + + # call this with $0 (from main script) as its (only) parameter + # if you need to preserve cwd, run this is a subshell since + # it can change cwd + + # set -x + + local_SCRIPT_PATH="$( get_abs_filename "$1" )"; + + while [ -h "$local_SCRIPT_PATH" ]; + do + cd "$( dirname -- "$local_SCRIPT_PATH"; )"; + local_SCRIPT_PATH="$( rreadlink "$local_SCRIPT_PATH" )"; + done + + cd "$( dirname -- "$local_SCRIPT_PATH"; )" > '/dev/null'; + local_SCRIPT_PATH="$( pwd; )"; + + # set +x + + echo "${local_SCRIPT_PATH}" + } + + # end of script directory functions + ############################################################################### + + # figure out the script dir + SCRIPTDIR="$(get_script_dir "$0")" + export SCRIPTDIR + +fi + +main "$@" diff --git a/sources/ADISPLAY b/sources/ADISPLAY index bccc0ab80..e8e720f4b 100644 --- a/sources/ADISPLAY +++ b/sources/ADISPLAY @@ -1,22 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 8-Jul-2025 20:19:58"  -{DSK}kaplan>Local>medley3.5>working-medley>sources>ADISPLAY.;14 244883 +(FILECREATED "30-Sep-2025 19:16:28" {DSK}frank>il>qmedley>sources>ADISPLAY.;1 244895 - :EDIT-BY rmk + :EDIT-BY "FGH" - :CHANGES-TO (VARS ADISPLAYCOMS) - - :PREVIOUS-DATE "19-Dec-2023 11:23:08" -{DSK}kaplan>Local>medley3.5>working-medley>sources>ADISPLAY.;13) + :PREVIOUS-DATE " 8-Jul-2025 20:19:58" {DSK}frank>il>qmedley>sources>ADISPLAY.;1) (PRETTYCOMPRINT ADISPLAYCOMS) (RPAQQ ADISPLAYCOMS - [(COMS (* ; "COMPILE SUPPORT") + [[COMS (* ; "COMPILE SUPPORT") (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) - WINDOW))) + WINDOW) + (P (IMPORTFILE (FINDFILE 'BIGBITMAPS T] (P (MOVD? 'NILL 'BIGBITMAPP)) (COMS (* ; "Interlisp-D dependent stuff.") (EXPORT (RECORDS REGION BITMAP BITMAPWORD POSITION CURSOR MOUSEEVENT SCREENREGION @@ -119,6 +116,9 @@ (FILESLOAD (LOADCOMP) WINDOW) + + +(IMPORTFILE (FINDFILE 'BIGBITMAPS T)) ) (MOVD? 'NILL 'BIGBITMAPP) @@ -398,7 +398,7 @@ (T (printout T "******** " BITMAP " is not a BITMAP." T) (RETURN NIL))) (printout FILE "(" .P2 (BITMAPWIDTH BM) - %, .P2 (BITMAPHEIGHT BM)) (* ; + %, .P2 (BITMAPHEIGHT BM)) (* ;  "if the number of bits per pixel is not 1, write it out.") (COND ((NEQ (BITSPERPIXEL BM) @@ -431,7 +431,7 @@ (* ;; "Print this bitmap in the preferred way.") (LET* ((WIDTH (BITMAPWIDTH BITMAP)) - (HEIGHT (BITMAPHEIGHT BITMAP)) + (HEIGHT (BITMAPHEIGHT BITMAP)) (BITS-PER-PIXEL (BITSPERPIXEL BITMAP)) (BASE (fetch BITMAPBASE of BITMAP)) (QUAD-CHARS-PER-ROW (FOLDHI (CL:* WIDTH BITS-PER-PIXEL) @@ -1506,12 +1506,12 @@ CBottom) (SETQ BITMAP (ffetch DDDestination of DD)) (SETQ BIGBMLIST (fetch (BIGBM BIGBMLIST) of BITMAP)) - (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) + (SETQ HEIGHT (BITMAPHEIGHT BITMAP)) (SETQ ClippingTop (ffetch DDClippingTop of DD)) (SETQ ClippingBottom (ffetch DDClippingBottom of DD)) (SETQ BM (GetNewFragment BIGBMLIST)) (while (AND BM (IGREATERP HEIGHT ClippingBottom)) - do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) + do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) [SETQ CTop (COND ((IGREATERP ClippingTop HEIGHT) (IDIFFERENCE HEIGHT BOTTOM)) @@ -1576,7 +1576,7 @@ (SUB1 (ffetch DDClippingTop of DD)) DISPLAYSTREAM COLOR)) (T (PROG ((BIGBMLIST (fetch (BIGBM BIGBMLIST) of BITMAP)) - (HEIGHT (BITMAPHEIGHT BITMAP)) + (HEIGHT (BITMAPHEIGHT BITMAP)) BOTTOM BM CTop CBottom (ClippingTop (ffetch DDClippingTop of DD)) (ClippingBottom (ffetch DDClippingBottom of DD)) (YY1 (\DSPTRANSFORMY (OR (FIXP Y1) @@ -1587,7 +1587,7 @@ DD))) (SETQ BM (GetNewFragment BIGBMLIST)) (while (AND BM (IGREATERP HEIGHT ClippingBottom)) - do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) + do (SETQ BOTTOM (IDIFFERENCE HEIGHT (BITMAPHEIGHT BM))) [SETQ CTop (COND ((IGREATERP ClippingTop HEIGHT) (IDIFFERENCE HEIGHT BOTTOM)) @@ -3753,19 +3753,17 @@ X]) (BITSPERPIXEL - [LAMBDA (BITMAP) (* ; "Edited 15-Feb-94 16:10 by nilsson") + [LAMBDA (BITMAP) (* ; "Edited 29-Jun-90 10:15 by matsuda") (* ;; "returns the height in pixels of a bitmap.") (COND ((type? BITMAP BITMAP) (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP)) + [(type? BIGBM BITMAP) + (fetch (BITMAP BITMAPBITSPERPIXEL) of (CAR (fetch (BIGBM BIGBMLIST) of BITMAP] ((type? SCREEN BITMAP) - - (* ;; "Read the propper slots, not the implicit bitmap.") - - (OR (fetch (SCREEN SCDEPTH) of BITMAP) - (fetch (SCREEN SCBITSPERPIXEL) of BITMAP))) + (BITSPERPIXEL (fetch (SCREEN SCDESTINATION) of BITMAP))) ((type? WINDOW BITMAP) (BITSPERPIXEL (fetch (WINDOW SCREEN) of BITMAP))) ((ARRAYP BITMAP) (* ; "Consider array to be a colormap.") @@ -4424,40 +4422,40 @@ (ADDTOVAR LAMA UNIONREGIONS INTERSECTREGIONS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (10589 10783 (SCREENREGIONP 10599 . 10781)) (12227 19588 (\BBTCURVEPT 12237 . 19586)) ( -19589 29405 (CREATETEXTUREFROMBITMAP 19599 . 21529) (PRINTBITMAP 21531 . 22882) (PRINT-BITMAPS-NICELY -22884 . 26735) (PRINTCURSOR 26737 . 27770) (\WRITEBITMAP 27772 . 29403)) (29448 31996 (\GETINTEGERPART - 29458 . 31003) (\CONVERTTOFRACTION 31005 . 31994)) (32133 33005 (CURSORP 32143 . 32362) (CURSORBITMAP - 32364 . 32410) (CreateCursorBitMap 32412 . 33003)) (37367 46290 (CARET 37377 . 39137) (\CARET.CREATE -39139 . 39317) (\CARET.DOWN 39319 . 40671) (\CARET.FLASH? 40673 . 42367) (\CARET.SHOW 42369 . 42938) ( -CARETRATE 42940 . 43598) (\CARET.FLASH.AGAIN 43600 . 44766) (\CARET.FLASH.MULTIPLE 44768 . 45291) ( -\CARET.FLASH 45293 . 46288)) (46291 51363 (\MEDW.CARET.SHOW 46301 . 51361)) (51727 53562 ( -\AREAVISIBLE? 51737 . 52661) (\REGIONOVERLAPAREAP 52663 . 53208) (\AREAINREGIONP 53210 . 53560)) ( -53611 66087 (CREATEREGION 53621 . 53957) (REGIONP 53959 . 54105) (INTERSECTREGIONS 54107 . 56877) ( -UNIONREGIONS 56879 . 59030) (REGIONSINTERSECTP 59032 . 59640) (SUBREGIONP 59642 . 60287) (EXTENDREGION - 60289 . 62446) (EXTENDREGIONBOTTOM 62448 . 63090) (EXTENDREGIONLEFT 63092 . 63711) (EXTENDREGIONRIGHT - 63713 . 64266) (EXTENDREGIONTOP 64268 . 64809) (INSIDEP 64811 . 65579) (STRINGREGION 65581 . 66085)) -(66332 71606 (\BRUSHBITMAP 66342 . 68059) (\GETBRUSH 68061 . 68372) (\GETBRUSHBBT 68374 . 70402) ( -\InitCurveBrushes 70404 . 71470) (\BrushFromWidth 71472 . 71604)) (71607 74674 (\MAKEBRUSH.DIAGONAL -71617 . 71897) (\MAKEBRUSH.HORIZONTAL 71899 . 72293) (\MAKEBRUSH.VERTICAL 72295 . 72607) ( -\MAKEBRUSH.SQUARE 72609 . 72886) (\MAKEBRUSH.ROUND 72888 . 74672)) (74675 75840 (INSTALLBRUSH 74685 . -75838)) (76241 87643 (\DRAWLINE.DISPLAY 76251 . 86358) (RELMOVETO 86360 . 86747) (MOVETOUPPERLEFT -86749 . 87641)) (87644 111129 (\CLIPANDDRAWLINE 87654 . 94100) (\CLIPANDDRAWLINE1 94102 . 105850) ( -\CLIPCODE 105852 . 107226) (\LEASTPTAT 107228 . 107826) (\GREATESTPTAT 107828 . 108456) (\DRAWLINE1 -108458 . 109574) (\DRAWLINE.UFN 109576 . 111127)) (115659 161706 (\DRAWCIRCLE.DISPLAY 115669 . 124482) - (\DRAWARC.DISPLAY 124484 . 124774) (\DRAWARC.GENERIC 124776 . 125529) (\COMPUTE.ARC.POINTS 125531 . -127796) (\DRAWELLIPSE.DISPLAY 127798 . 143467) (\DRAWCURVE.DISPLAY 143469 . 145758) ( -\DRAWPOINT.DISPLAY 145760 . 146956) (\DRAWPOLYGON.DISPLAY 146958 . 150486) (\LINEWITHBRUSH 150488 . -161704)) (161707 193399 (LOADPOLY 161717 . 162277) (PARAMETRICSPLINE 162279 . 172476) (\CURVE 172478 - . 178080) (\CURVE2 178082 . 189413) (\CURVEEND 189415 . 189897) (\CURVESLOPE 189899 . 192382) ( -\CURVESTART 192384 . 192708) (\FDIFS/FROM/DERIVS 192710 . 193397)) (205928 220264 (\FILLCIRCLE.DISPLAY - 205938 . 216686) (\LINEBLT 216688 . 220262)) (220308 221930 (SCREENBITMAP 220318 . 220795) (BITMAPP -220797 . 221031) (BITSPERPIXEL 221033 . 221928)) (222571 223564 (DSPFILL 222581 . 223264) (INVERTW -223266 . 223562)) (223565 227208 (\DSPCOLOR.DISPLAY 223575 . 224872) (\DSPBACKCOLOR.DISPLAY 224874 . -226253) (DSPEOLFN 226255 . 227206)) (227641 232295 (DSPCLEOL 227651 . 228527) (DSPRUBOUTCHAR 228529 . -228961) (\DSPMOVELR 228963 . 232293)) (232425 233543 (\CURSOR.DEFPRINT 232435 . 233541)) (233955 -242529 (TEXTUREOFCOLOR 233965 . 235227) (\PRIMARYTEXTURE 235229 . 235811) (\LEVELTEXTURE 235813 . -236314) (INSURE.B&W.TEXTURE 236316 . 237711) (INSURE.RGB.COLOR 237713 . 239141) (\LOOKUPCOLORNAME -239143 . 239413) (RGBP 239415 . 240180) (HLSP 240182 . 240557) (HLSTORGB 240559 . 241699) (\HLSVALUEFN - 241701 . 242527))))) + (FILEMAP (NIL (10603 10797 (SCREENREGIONP 10613 . 10795)) (12241 19602 (\BBTCURVEPT 12251 . 19600)) ( +19603 29411 (CREATETEXTUREFROMBITMAP 19613 . 21543) (PRINTBITMAP 21545 . 22892) (PRINT-BITMAPS-NICELY +22894 . 26741) (PRINTCURSOR 26743 . 27776) (\WRITEBITMAP 27778 . 29409)) (29454 32002 (\GETINTEGERPART + 29464 . 31009) (\CONVERTTOFRACTION 31011 . 32000)) (32139 33011 (CURSORP 32149 . 32368) (CURSORBITMAP + 32370 . 32416) (CreateCursorBitMap 32418 . 33009)) (37373 46296 (CARET 37383 . 39143) (\CARET.CREATE +39145 . 39323) (\CARET.DOWN 39325 . 40677) (\CARET.FLASH? 40679 . 42373) (\CARET.SHOW 42375 . 42944) ( +CARETRATE 42946 . 43604) (\CARET.FLASH.AGAIN 43606 . 44772) (\CARET.FLASH.MULTIPLE 44774 . 45297) ( +\CARET.FLASH 45299 . 46294)) (46297 51369 (\MEDW.CARET.SHOW 46307 . 51367)) (51733 53568 ( +\AREAVISIBLE? 51743 . 52667) (\REGIONOVERLAPAREAP 52669 . 53214) (\AREAINREGIONP 53216 . 53566)) ( +53617 66093 (CREATEREGION 53627 . 53963) (REGIONP 53965 . 54111) (INTERSECTREGIONS 54113 . 56883) ( +UNIONREGIONS 56885 . 59036) (REGIONSINTERSECTP 59038 . 59646) (SUBREGIONP 59648 . 60293) (EXTENDREGION + 60295 . 62452) (EXTENDREGIONBOTTOM 62454 . 63096) (EXTENDREGIONLEFT 63098 . 63717) (EXTENDREGIONRIGHT + 63719 . 64272) (EXTENDREGIONTOP 64274 . 64815) (INSIDEP 64817 . 65585) (STRINGREGION 65587 . 66091)) +(66338 71612 (\BRUSHBITMAP 66348 . 68065) (\GETBRUSH 68067 . 68378) (\GETBRUSHBBT 68380 . 70408) ( +\InitCurveBrushes 70410 . 71476) (\BrushFromWidth 71478 . 71610)) (71613 74680 (\MAKEBRUSH.DIAGONAL +71623 . 71903) (\MAKEBRUSH.HORIZONTAL 71905 . 72299) (\MAKEBRUSH.VERTICAL 72301 . 72613) ( +\MAKEBRUSH.SQUARE 72615 . 72892) (\MAKEBRUSH.ROUND 72894 . 74678)) (74681 75846 (INSTALLBRUSH 74691 . +75844)) (76247 87633 (\DRAWLINE.DISPLAY 76257 . 86348) (RELMOVETO 86350 . 86737) (MOVETOUPPERLEFT +86739 . 87631)) (87634 111119 (\CLIPANDDRAWLINE 87644 . 94090) (\CLIPANDDRAWLINE1 94092 . 105840) ( +\CLIPCODE 105842 . 107216) (\LEASTPTAT 107218 . 107816) (\GREATESTPTAT 107818 . 108446) (\DRAWLINE1 +108448 . 109564) (\DRAWLINE.UFN 109566 . 111117)) (115649 161696 (\DRAWCIRCLE.DISPLAY 115659 . 124472) + (\DRAWARC.DISPLAY 124474 . 124764) (\DRAWARC.GENERIC 124766 . 125519) (\COMPUTE.ARC.POINTS 125521 . +127786) (\DRAWELLIPSE.DISPLAY 127788 . 143457) (\DRAWCURVE.DISPLAY 143459 . 145748) ( +\DRAWPOINT.DISPLAY 145750 . 146946) (\DRAWPOLYGON.DISPLAY 146948 . 150476) (\LINEWITHBRUSH 150478 . +161694)) (161697 193389 (LOADPOLY 161707 . 162267) (PARAMETRICSPLINE 162269 . 172466) (\CURVE 172468 + . 178070) (\CURVE2 178072 . 189403) (\CURVEEND 189405 . 189887) (\CURVESLOPE 189889 . 192372) ( +\CURVESTART 192374 . 192698) (\FDIFS/FROM/DERIVS 192700 . 193387)) (205918 220254 (\FILLCIRCLE.DISPLAY + 205928 . 216676) (\LINEBLT 216678 . 220252)) (220298 221942 (SCREENBITMAP 220308 . 220785) (BITMAPP +220787 . 221021) (BITSPERPIXEL 221023 . 221940)) (222583 223576 (DSPFILL 222593 . 223276) (INVERTW +223278 . 223574)) (223577 227220 (\DSPCOLOR.DISPLAY 223587 . 224884) (\DSPBACKCOLOR.DISPLAY 224886 . +226265) (DSPEOLFN 226267 . 227218)) (227653 232307 (DSPCLEOL 227663 . 228539) (DSPRUBOUTCHAR 228541 . +228973) (\DSPMOVELR 228975 . 232305)) (232437 233555 (\CURSOR.DEFPRINT 232447 . 233553)) (233967 +242541 (TEXTUREOFCOLOR 233977 . 235239) (\PRIMARYTEXTURE 235241 . 235823) (\LEVELTEXTURE 235825 . +236326) (INSURE.B&W.TEXTURE 236328 . 237723) (INSURE.RGB.COLOR 237725 . 239153) (\LOOKUPCOLORNAME +239155 . 239425) (RGBP 239427 . 240192) (HLSP 240194 . 240569) (HLSTORGB 240571 . 241711) (\HLSVALUEFN + 241713 . 242539))))) STOP diff --git a/sources/CMLWALK.dfasl b/sources/CMLWALK.dfasl deleted file mode 100644 index 94240536d..000000000 Binary files a/sources/CMLWALK.dfasl and /dev/null differ diff --git a/sources/SEDIT-CONVERT.dfasl b/sources/SEDIT-CONVERT.dfasl deleted file mode 100644 index 865b2ebf9..000000000 Binary files a/sources/SEDIT-CONVERT.dfasl and /dev/null differ