diff --git a/library/patches/EDITBMPATCHES b/library/patches/EDITBMPATCHES deleted file mode 100644 index 3e067f526..000000000 --- a/library/patches/EDITBMPATCHES +++ /dev/null @@ -1 +0,0 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 7-Sep-90 17:46:33" {DSK}will>takeshi>color>EDITBMPATCHES.;6 85087 changes to%: (VARS EDITBMPATCHESCOMS) (MACROS \SFInvert) (FNS EDITBMBUTTONFN BITBLT.BIGBM BITMAPBPP BITMAPWIDTH BITMAPHEIGHT EDITBMRESHAPEFN EDITBMSCROLLFN EDITBM BITMAPBIT BITMAPBIT.BIGBM UPDATE/BM/DISPLAY/SELECTED/REGION) previous date%: " 7-Sep-90 17:23:10" {DSK}will>takeshi>color>EDITBMPATCHES.;5) (* ; " Copyright (c) 1990 by Takeshi Shimizu 1988,1989,1990. All rights reserved. ") (PRETTYCOMPRINT EDITBMPATCHESCOMS) (RPAQQ EDITBMPATCHESCOMS [(FNS BITMAPBPP BITMAPWIDTH BITMAPHEIGHT) (FNS EDITBMRESHAPEFN EDITBMBUTTONFN EDITBMSCROLLFN EDITBM) (FNS BITMAPBIT BITMAPBIT.BIGBM) (FNS BITBLT.BIGBM) (MACROS \SFInvert) (FNS UPDATE/BM/DISPLAY/SELECTED/REGION) (P (MOVD 'BITMAPBIT '\BITMAPBIT]) (DEFINEQ (BITMAPBPP [LAMBDA (BITMAP) (* ; "Edited 31-Aug-90 14:35 by Takeshi") (* ;; "If val is not NIL then set val to each bpp field") (* ;; " Otherwise simply returns its BPP") (COND ((type? BITMAP BITMAP) (ffetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP)) ((type? WINDOW BITMAP) (FETCH (BITMAP BITMAPBITSPERPIXEL) OF (ffetch (WINDOW SAVE) OF BITMAP))) [(type? BIGBM BITMAP) (fetch (BITMAP BITMAPBITSPERPIXEL) of (CAR (FFETCH (BIGBM BIGBMLIST) OF BITMAP] (T (\ILLEGAL.ARG BITMAP]) (BITMAPWIDTH [LAMBDA (BITMAP VAL) (* ; "Edited 31-Aug-90 14:23 by Takeshi") (* ;; "returns the width of a bitmap in pixels") (COND [VAL (COND ((type? BITMAP BITMAP) (freplace (BITMAP BITMAPWIDTH) of BITMAP with VAL)) ((type? WINDOW BITMAP) (WINDOWPROP BITMAP 'WIDTH VAL)) ((type? BIGBM BITMAP) (freplace (BIGBM BIGBMWIDTH) of BITMAP with VAL)) (T (\ILLEGAL.ARG BITMAP] (T (COND ((type? BITMAP BITMAP) (ffetch (BITMAP BITMAPWIDTH) of BITMAP)) ((type? WINDOW BITMAP) (WINDOWPROP BITMAP 'WIDTH)) ((type? BIGBM BITMAP) (ffetch (BIGBM BIGBMWIDTH) of BITMAP)) (T (\ILLEGAL.ARG BITMAP]) (BITMAPHEIGHT [LAMBDA (BITMAP VAL) (* ; "Edited 31-Aug-90 14:21 by Takeshi") (* ;; "If val is not NIL it set the val to height field of the bitmap") (* ;; "Else it return the height") (COND [VAL (COND ((type? BITMAP BITMAP) (freplace (BITMAP BITMAPHEIGHT) of BITMAP with VAL)) ((type? WINDOW BITMAP) (WINDOWPROP BITMAP 'HEIGHT VAL)) ((type? BIGBM BITMAP) (freplace (BIGBM BIGBMHEIGHT) of BITMAP with VAL)) (T (\ILLEGAL.ARG BITMAP] (T (* ;; "Returns the height in pixels of a bitmap") (COND ((type? BITMAP BITMAP) (ffetch (BITMAP BITMAPHEIGHT) of BITMAP)) ((type? WINDOW BITMAP) (WINDOWPROP BITMAP 'HEIGHT)) ((type? BIGBM BITMAP) (ffetch (BIGBM BIGBMHEIGHT) of BITMAP)) (T (\ILLEGAL.ARG BITMAP]) ) (DEFINEQ (EDITBMRESHAPEFN [LAMBDA (BMEDITWINDOW OLDIMAGE OLDREGION OLDSCREENREGION ZEROBMFLG) (* ; "Edited 31-Aug-90 14:51 by Takeshi") (* ;; "allows the bitmap edit window to be reshaped to enlarge the editting area. This is also called to set up the image during initialization.") (PROG (BMWINTERIORWIDTH BMWINTERIORHEIGHT EDITAREABITWIDTH EDITAREABITHEIGHT GRIDSQUARE GRIDINTERIOR BITMAPWIDTH BMDISPLAYWIDTH BMDISPLAYBOTTOM BMDISPLAYHEIGHT BITMAPHEIGHT (BM (WINDOWPROP BMEDITWINDOW 'BM)) MINCOMMANDAREAWIDTH EXTENTWIDTH EXTENTHEIGHT TEMPBM) (SETQ MINCOMMANDAREAWIDTH 30) (SETQ BITMAPWIDTH (BITMAPWIDTH BM)) (SETQ BITMAPHEIGHT (BITMAPHEIGHT BM)) (SETQ BMWINTERIORWIDTH (WINDOWPROP BMEDITWINDOW 'WIDTH)) (* ;;  "leave room at the top for the full size display area. But not more than half of the window.") (SETQ BMWINTERIORHEIGHT (IMAX (IDIFFERENCE (WINDOWPROP BMEDITWINDOW 'HEIGHT) (IPLUS BITMAPHEIGHT GRIDTHICKNESS)) (IQUOTIENT (WINDOWPROP BMEDITWINDOW 'HEIGHT) 2))) (* ;; "if the user hasn't set it, determine the grid size as the largest size which fits the interior but not larger than NORMALGRIDSQUARE nor smaller than MINGRIDSQUARE. If GRIDSQUARE was specified, reset it to NIL so that if reshaped it will be recalculated.") (SETQ GRIDSQUARE (OR (WINDOWPROP BMEDITWINDOW 'GRIDSQUARE NIL) (IMAX (IMIN (IQUOTIENT BMWINTERIORWIDTH BITMAPWIDTH) (IQUOTIENT BMWINTERIORHEIGHT BITMAPHEIGHT) NORMALGRIDSQUARE) MINGRIDSQUARE))) (* ;  "calculate how many bits will be displayed at once.") (SETQ EDITAREABITWIDTH (IMIN (IQUOTIENT BMWINTERIORWIDTH GRIDSQUARE) BITMAPWIDTH)) (WINDOWPROP BMEDITWINDOW 'BITSWIDE EDITAREABITWIDTH) (SETQ EDITAREABITHEIGHT (IMIN (IQUOTIENT BMWINTERIORHEIGHT GRIDSQUARE) BITMAPHEIGHT)) (* ;  "calculate offset of display and command regions at the top of the window.") (WINDOWPROP BMEDITWINDOW 'BITSHIGH EDITAREABITHEIGHT) (SETQ BMDISPLAYBOTTOM (IPLUS (ITIMES GRIDSQUARE EDITAREABITHEIGHT) GRIDTHICKNESS)) (SETQ BMDISPLAYWIDTH (IMIN BITMAPWIDTH (IDIFFERENCE BMWINTERIORWIDTH MINCOMMANDAREAWIDTH))) (* ;; "put the offset --- the lower left coordinate --- in the same place unless the new shape allows more to be shown past the upper right corner.") (WINDOWPROP BMEDITWINDOW 'XOFFSET (IMIN (WINDOWPROP BMEDITWINDOW 'XOFFSET) (IDIFFERENCE BITMAPWIDTH EDITAREABITWIDTH))) (WINDOWPROP BMEDITWINDOW 'YOFFSET (IMIN (WINDOWPROP BMEDITWINDOW 'YOFFSET) (IDIFFERENCE BITMAPHEIGHT EDITAREABITHEIGHT))) (* ; "Center edit square") (SETQ GRIDINTERIOR (create REGION LEFT _ (IQUOTIENT (IDIFFERENCE BMWINTERIORWIDTH (ITIMES EDITAREABITWIDTH GRIDSQUARE )) 2) BOTTOM _ (IQUOTIENT (IDIFFERENCE BMDISPLAYBOTTOM (ITIMES EDITAREABITHEIGHT GRIDSQUARE )) 2) WIDTH _ (ITIMES EDITAREABITWIDTH GRIDSQUARE) HEIGHT _ (ITIMES EDITAREABITHEIGHT GRIDSQUARE))) (WINDOWPROP BMEDITWINDOW 'GRIDINTERIOR GRIDINTERIOR) (WINDOWPROP BMEDITWINDOW 'BMDISPLAYBOTTOM BMDISPLAYBOTTOM) (WINDOWPROP BMEDITWINDOW 'BMDISPLAYWIDTH BMDISPLAYWIDTH) (WINDOWPROP BMEDITWINDOW 'BMDISPLAYHEIGHT (SETQ BMDISPLAYHEIGHT (IDIFFERENCE (WINDOWPROP BMEDITWINDOW 'HEIGHT) BMDISPLAYBOTTOM))) (WINDOWPROP BMEDITWINDOW 'DISPLAYREGION (create REGION LEFT _ 0 BOTTOM _ BMDISPLAYBOTTOM WIDTH _ BMDISPLAYWIDTH HEIGHT _ BMDISPLAYHEIGHT)) (WINDOWPROP BMEDITWINDOW 'GRIDSPEC (create REGION LEFT _ (fetch (REGION LEFT) of GRIDINTERIOR ) BOTTOM _ (fetch (REGION BOTTOM) of GRIDINTERIOR ) WIDTH _ GRIDSQUARE HEIGHT _ GRIDSQUARE)) (SETQ EXTENTHEIGHT (QUOTIENT (TIMES BITMAPHEIGHT (WINDOWPROP BMEDITWINDOW 'HEIGHT)) EDITAREABITHEIGHT)) [SETQ EXTENTWIDTH (IDIFFERENCE (QUOTIENT (TIMES BITMAPWIDTH BMWINTERIORWIDTH) EDITAREABITWIDTH) (WINDOWPROP BMEDITWINDOW 'BORDER] (WINDOWPROP BMEDITWINDOW 'EXTENT (CREATEREGION (MINUS (QUOTIENT (TIMES (WINDOWPROP BMEDITWINDOW 'XOFFSET) EXTENTWIDTH) BITMAPWIDTH)) (MINUS (QUOTIENT (TIMES (WINDOWPROP BMEDITWINDOW 'YOFFSET) EXTENTHEIGHT) BITMAPHEIGHT)) EXTENTWIDTH EXTENTHEIGHT)) (* ;; "Build & cache a temporary bitmap.") (* ;; "Could make only (min (bitmapheight bm) (iquotient (bitmapheight window) scale)), except if user changes scale, bitmap might be too small. So, make sufficiently large just to be safe.") (SETQ TEMPBM (WINDOWPROP BMEDITWINDOW 'TEMPBM)) (LET ((TEMPBM.W BMWINTERIORWIDTH) (TEMPBM.H (IMIN BITMAPHEIGHT EDITAREABITHEIGHT))) (if (OR (NOT TEMPBM) (OR (< (BITMAPWIDTH TEMPBM) TEMPBM.W) (< (BITMAPHEIGHT TEMPBM) TEMPBM.H))) then (SETQ TEMPBM (BITMAPCREATE TEMPBM.W TEMPBM.H (BITMAPBPP BM))) (WINDOWPROP BMEDITWINDOW 'TEMPBM TEMPBM))) (EDITBMREPAINTFN BMEDITWINDOW NIL ZEROBMFLG]) (EDITBMBUTTONFN [LAMBDA (W) (* ; "Edited 7-Sep-90 17:35 by Takeshi") (* ;; "inner function of bitmap editor.") (DECLARE (GLOBALVARS \CURRENTCURSOR)) (PROG (GRIDX0 GRIDY0 BITMAPWIDTH BITMAPHEIGHT NEWGRIDSIZE PAINTW ORIGBM GRIDSPEC GRIDINTERIOR BM BITSWIDE BITSHIGH WREGION XOFFSET YOFFSET DXOFFSET DYOFFSET DISPLAYREGION EXTENT BITSPERPIXEL CURSORBM) (SETQ GRIDSPEC (WINDOWPROP W 'GRIDSPEC)) (SETQ GRIDINTERIOR (WINDOWPROP W 'GRIDINTERIOR)) (SETQ BM (WINDOWPROP W 'BM)) (SETQ BITSWIDE (WINDOWPROP W 'BITSWIDE)) (SETQ BITSHIGH (WINDOWPROP W 'BITSHIGH)) (SETQ WREGION (WINDOWPROP W 'REGION)) (SETQ XOFFSET (WINDOWPROP W 'XOFFSET)) (SETQ YOFFSET (WINDOWPROP W 'YOFFSET)) (SETQ DXOFFSET (WINDOWPROP W 'DXOFFSET)) (SETQ DYOFFSET (WINDOWPROP W 'DYOFFSET)) (SETQ DISPLAYREGION (WINDOWPROP W 'DISPLAYREGION)) (SETQ EXTENT (WINDOWPROP W 'EXTENT)) (SETQ GRIDX0 (fetch (REGION LEFT) of GRIDSPEC)) (SETQ GRIDY0 (fetch (REGION BOTTOM) of GRIDSPEC)) (SETQ BITMAPWIDTH (BITMAPWIDTH BM)) (SETQ BITMAPHEIGHT (BITMAPHEIGHT BM)) (SETQ BITSPERPIXEL (BITMAPBPP BM)) (SETQ COLOR (WINDOWPROP W 'COLOR)) (* ;; "mark the region of the bitmap that is being editted.") (COND ((INSIDE? GRIDINTERIOR (LASTMOUSEX W) (LASTMOUSEY W)) (* ;; "if cursor is inside, shade it.") (\SHADEBITS BM GRIDSPEC GRIDINTERIOR W BITSWIDE BITSHIGH COLOR)) ((INSIDE? DISPLAYREGION (LASTMOUSEX W) (LASTMOUSEY W)) (* ;; "Run the menu foe re-windowing into the whole bitmap") (SELECTQ [MENU (COND ((type? MENU EDITBMWINDOWMENU) EDITBMWINDOWMENU) ((SETQ EDITBMWINDOWMENU (create MENU ITEMS _ '((Move 'Move "Selects a different part of the bitmap to edit." )) CENTERFLG _ T] (Move (* ;  "move the editing window's location on the bitmap.") (PROG (POS) [SETQ POS (GETBOXPOSITION BITSWIDE BITSHIGH [IPLUS 4 (fetch (REGION LEFT) of WREGION) (- XOFFSET (WINDOWPROP W 'DXOFFSET] (IPLUS (WINDOWPROP W 'BMDISPLAYBOTTOM) (- YOFFSET (WINDOWPROP W 'DYOFFSET)) 4 (fetch (REGION BOTTOM) of WREGION] [WINDOWPROP W 'XOFFSET (SETQ XOFFSET (IMIN (IDIFFERENCE BITMAPWIDTH BITSWIDE) (IMAX [IPLUS (WINDOWPROP W 'DXOFFSET) (- (fetch (POSITION XCOORD) of POS) (IPLUS 4 (fetch (REGION LEFT) of WREGION] 0] [WINDOWPROP W 'YOFFSET (SETQ YOFFSET (IMAX 0 (IMIN (- BITMAPHEIGHT BITSHIGH) (- (IPLUS (WINDOWPROP W 'DYOFFSET) (- (fetch (POSITION YCOORD) of POS) (IPLUS (fetch (REGION BOTTOM) of WREGION) 4))) (WINDOWPROP W 'BMDISPLAYBOTTOM] (replace (REGION LEFT) of EXTENT with (IMINUS (QUOTIENT (TIMES XOFFSET (fetch (REGION WIDTH) of EXTENT)) BITMAPWIDTH))) (replace (REGION BOTTOM) of EXTENT with (IMINUS (QUOTIENT (TIMES YOFFSET (fetch (REGION HEIGHT) of EXTENT)) BITMAPHEIGHT))) [COND ([OR (ILESSP XOFFSET DXOFFSET) (ILESSP YOFFSET DYOFFSET) [IGREATERP (IPLUS XOFFSET BITSWIDE) (IPLUS DXOFFSET (WINDOWPROP W 'BMDISPLAYWIDTH] (IGREATERP (IPLUS YOFFSET BITSHIGH) (IPLUS DYOFFSET (WINDOWPROP W 'BMDISPLAYHEIGHT] (* ;;  "Adjust the display region left lower corner so the selected region is near the center.") [WINDOWPROP W 'DXOFFSET (SETQ DXOFFSET (IMAX 0 (IMIN (- (BITMAPWIDTH BM) (WINDOWPROP W 'BMDISPLAYWIDTH)) (- (IPLUS XOFFSET (LRSH BITSWIDE 1)) (LRSH (WINDOWPROP W 'BMDISPLAYWIDTH) 1] (WINDOWPROP W 'DYOFFSET (SETQ DYOFFSET (IMAX 0 (IMIN (- (BITMAPHEIGHT BM) (WINDOWPROP W 'BMDISPLAYHEIGHT)) (- (IPLUS YOFFSET (LRSH BITSHIGH 1)) (LRSH (WINDOWPROP W 'BMDISPLAYHEIGHT) 1] (* DSPFILL GRIDINTERIOR WHITESHADE  (QUOTE REPLACE) W) (UPDATE/BM/DISPLAY BM W) (* ;; "FS: More useless code: (COND ((WINDOWPROP W 'GRIDON) (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W)))") (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T))) NIL)) ((LASTMOUSESTATE LEFT) (UPDATE/BM/DISPLAY/SELECTED/REGION W) (SETQ CURSORBM (BITMAPCREATE 16 16 (BITSPERPIXEL BM))) (BITBLT BM NIL NIL CURSORBM) [RESETFORM (CURSOR (CURSORCREATE CURSORBM NIL (fetch (CURSOR CUHOTSPOTX) of \CURRENTCURSOR) (fetch (CURSOR CUHOTSPOTY) of \CURRENTCURSOR))) (until (MOUSESTATE (NOT LEFT] (UPDATE/BM/DISPLAY/SELECTED/REGION W)) (T (* ;; "the region being editted is inverted while the menu is active. Each command must make sure that it is recomplemented.") (UPDATE/BM/DISPLAY/SELECTED/REGION W) (SELECTQ [MENU (COND ((type? MENU EDITBMMENU) EDITBMMENU) (T (SETQ EDITBMMENU (create MENU ITEMS _ [APPEND (COND [(COLORDISPLAYP) '((Color 'Color "Choose color to set bits with" ] (T NIL)) '((Paint 'Paint "Calls the window PAINT command on the bitmap." ) (ShowAsTile 'ShowAsTile "tiles the upper part of the edit window with the bitmap." ) (Grid% On/Off 'GridOnOff "Grid On/Off Switch") (GridSize_ 'GridSize_ "Allows setting of the size of a bit in the edit area." ) (Reset 'Reset "Sets the bitmap back to the state at the start of this edit session." ) (Clear 'Clear "Sets the entire bitmap to 0") (Cursor_ 'Cursor_ "Puts the bitmap into the cursor and exits the editor." ) (OK 'OK "Leaves the edit session.") (Abort 'Abort "Restores the bitmap to its original values and leaves the editor." ] CENTERFLG _ T] (OK (WINDOWPROP W 'FINISHEDFLG T)) (Abort (WINDOWPROP W 'FINISHEDFLG 'KILL)) (Reset (* ;; "allow the user to choose between everything or just visible part. This also give the user a chance to change their mind.") (COND ((SELECTQ (\EDITBMHOWMUCH BM BITSWIDE BITSHIGH "RESET how much?") (VISIBLE [COND [(SETQ ORIGBM (WINDOWPROP W 'ORIGINALBITMAP)) (COND ((REGIONP ORIGBM) (BITBLT \CURSORDESTINATION (IPLUS XOFFSET (fetch (REGION LEFT) of ORIGBM)) (IPLUS YOFFSET (fetch (REGION BOTTOM) of ORIGBM)) BM XOFFSET YOFFSET BITSWIDE BITSHIGH 'INPUT 'REPLACE)) (T (BITBLT ORIGBM XOFFSET YOFFSET BM XOFFSET YOFFSET BITSWIDE BITSHIGH] (T (BLTSHADE WHITESHADE BM XOFFSET YOFFSET BITSWIDE BITSHIGH 'REPLACE] T) (WHOLE [COND [(SETQ ORIGBM (WINDOWPROP W 'ORIGINALBITMAP)) (COND ((REGIONP ORIGBM) (BITBLT \CURSORDESTINATION (fetch (REGION LEFT) of ORIGBM) (fetch (REGION BOTTOM) of ORIGBM) BM)) (T (BITBLT ORIGBM NIL NIL BM] (T (BLTSHADE WHITESHADE BM NIL NIL NIL NIL 'REPLACE] T) (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION W) NIL)) (\EDITBM/PUTUP/DISPLAY W BM GRIDSPEC GRIDINTERIOR BITSWIDE BITSHIGH)))) (Clear (* ;; "allow the user to choose between everything or just visible part. This also give the user a chance to change their mind.") (COND ((SELECTQ (\EDITBMHOWMUCH BM BITSWIDE BITSHIGH "CLEAR how much?") (VISIBLE (BLTSHADE WHITESHADE BM XOFFSET YOFFSET BITSWIDE BITSHIGH 'REPLACE) T) (WHOLE (\CLEARBM BM) T) (PROGN (UPDATE/BM/DISPLAY/SELECTED/REGION W) NIL)) (DSPFILL GRIDINTERIOR WHITESHADE 'REPLACE W) (COND ((WINDOWPROP W 'GRIDON) (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W))) (UPDATE/BM/DISPLAY BM W)))) (GridOnOff (COND ((NOT (WINDOWPROP W 'GRIDON)) (* ; "Turn Grid On") (WINDOWPROP W 'GRIDON T) (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W) (* ;;  "FS: The update here was unnecessary. (UPDATE/BM/DISPLAY BM W)") NIL) (T (* ; "Turn off grid") (WINDOWPROP W 'GRIDON NIL) (* DSPFILL (create REGION LEFT _ 0  BOTTOM _ 0 WIDTH _  (ADD1 (fetch (REGION WIDTH) of  GRIDINTERIOR)) HEIGHT _  (ADD1 (fetch (REGION HEIGHT) of  GRIDINTERIOR))) WHITESHADE  (QUOTE REPLACE) W) (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T) (* ;;  "FS: The update here was unnecessary. (UPDATE/BM/DISPLAY BM W)") NIL))) (GridSize_ (* ;  "sets the grid square size and calls the reshapefn.") (COND ([SETQ NEWGRIDSIZE (NUMBERP (MENU (COND ((TYPENAMEP GRIDSIZEMENU 'MENU) GRIDSIZEMENU) (T (SETQ GRIDSIZEMENU (create MENU ITEMS _ '(3 4 5 6 7 8 12 16 20 24 28 32) MENUROWS _ 4] (WINDOWPROP W 'GRIDSQUARE NEWGRIDSIZE) (EDITBMRESHAPEFN W)))) (ShowAsTile (* ; "tiles the upper part of the window with the bitmap so the user can see what it would be as a shade.") (UPDATE/SHADE/DISPLAY BM W)) (Paint (* ;  "call the window paint command on the contents of the bitmap.") [SETQ PAINTW (CREATEW (create REGION LEFT _ (IQUOTIENT (- SCREENWIDTH BITMAPWIDTH) 2) BOTTOM _ (IQUOTIENT (- SCREENHEIGHT BITMAPHEIGHT) 2) WIDTH _ (WIDTHIFWINDOW BITMAPWIDTH) HEIGHT _ (HEIGHTIFWINDOW BITMAPHEIGHT NIL] (OPENW PAINTW) (BITBLT BM 0 0 PAINTW) (PAINTW PAINTW) (COND ((MENU (create MENU ITEMS _ '((YES T "Will put the newly painted bits back in the bitmap being editted." ) (NO NIL "Will discard the painted bits, not changing the bitmap being editted." )) TITLE _ "Put change into bitmap?" CENTERFLG _ T)) (BITBLT PAINTW 0 0 BM) (\EDITBM/PUTUP/DISPLAY W BM GRIDSPEC GRIDINTERIOR BITSWIDE BITSHIGH))) (CLOSEW PAINTW) (* ;  "set PAINTW so that space can be reclaimed") (SETQ PAINTW)) (Cursor_ (* ;  "Stuffs lower left part of image into the cursor and sets the hotspot.") (READHOTSPOT BM GRIDSPEC GRIDINTERIOR W) (WINDOWPROP W 'FINISHEDFLG T)) (Color (WINDOWPROP W 'COLOR (OR (MENU (COLORMENU BITSPERPIXEL)) COLOR))) (UPDATE/BM/DISPLAY/SELECTED/REGION W]) (EDITBMSCROLLFN [LAMBDA (W DX DY) (* ; "Edited 31-Aug-90 15:04 by Takeshi") (* ;  "Do scrolling for the bitmap editor.") (PROG (GRIDSPEC REG WHEIGHT WWIDTH (DXGRID 0) (DYGRID 0) EXTENT EXTENTWIDTH EXTENTHEIGHT GILEFT GIBOTTOM GIHEIGHT GWIDTH GHEIGHT GRIDINTERIOR EBMXLIMIT EBMYLIMIT EBMXOFFSET EBMYOFFSET BM BITMAPWIDTH BITMAPHEIGHT BITSWIDE BITSHIGH DXOFFSET DYOFFSET) (SETQ GRIDSPEC (WINDOWPROP W 'GRIDSPEC)) (SETQ REG (WINDOWPROP W 'REGION)) (SETQ WHEIGHT (WINDOWPROP W 'HEIGHT)) (SETQ WWIDTH (WINDOWPROP W 'WIDTH)) (SETQ GRIDINTERIOR (WINDOWPROP W 'GRIDINTERIOR)) (SETQ EBMXOFFSET (WINDOWPROP W 'XOFFSET)) (SETQ EBMYOFFSET (WINDOWPROP W 'YOFFSET)) (SETQ BM (WINDOWPROP W 'BM)) (SETQ BITMAPWIDTH (BITMAPWIDTH BM)) (SETQ BITMAPHEIGHT (BITMAPHEIGHT BM)) (SETQ BITSWIDE (WINDOWPROP W 'BITSWIDE)) (SETQ BITSHIGH (WINDOWPROP W 'BITSHIGH)) (SETQ DXOFFSET (WINDOWPROP W 'DXOFFSET)) (SETQ DYOFFSET (WINDOWPROP W 'DYOFFSET)) (SETQ EBMXLIMIT (IPLUS EBMXOFFSET BITSWIDE)) (SETQ EBMYLIMIT (IPLUS EBMYOFFSET BITSHIGH)) (COND (GRIDSPEC (SETQ GILEFT (fetch (REGION LEFT) of GRIDINTERIOR)) (SETQ GIBOTTOM (fetch (REGION BOTTOM) of GRIDINTERIOR)) (SETQ GIHEIGHT (fetch (REGION HEIGHT) of GRIDINTERIOR)) (SETQ GWIDTH (fetch (REGION WIDTH) of GRIDSPEC)) (SETQ GHEIGHT (fetch (REGION HEIGHT) of GRIDSPEC)) (SETQ EXTENT (WINDOWPROP W 'EXTENT)) (SETQ EXTENTWIDTH (fetch (REGION WIDTH) of EXTENT)) (SETQ EXTENTHEIGHT (fetch (REGION HEIGHT) of EXTENT)) (* ; "Make a horizontal adjustment") (COND ((FLOATP DX) (* ; "Horizontal thumbing") [WINDOWPROP W 'XOFFSET (SETQ EBMXOFFSET (FIX (TIMES (IDIFFERENCE BITMAPWIDTH BITSWIDE) DX] (replace (REGION LEFT) of EXTENT with (IMINUS (QUOTIENT (TIMES EBMXOFFSET EXTENTWIDTH) BITMAPWIDTH))) (* BLTSHADE WHITESHADE W GILEFT  GIBOTTOM SCREENWIDTH SCREENHEIGHT  (QUOTE REPLACE) GRIDINTERIOR) (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T)) ((ILESSP DX 0) (* ; "moving to the left.") (* ;  "determine how many grid points to move.") (SETQ DXGRID (IMIN (GRIDXCOORD (IMINUS DX) GRIDSPEC) (IDIFFERENCE BITMAPWIDTH EBMXLIMIT))) (COND ((NOT (IGREATERP DXGRID 0)) (* ;  "right edge is at the right margin") (RETURN))) (WINDOWPROP W 'XOFFSET (SETQ EBMXOFFSET (IPLUS EBMXOFFSET DXGRID))) (* ; "update EXTENT bar") (replace (REGION LEFT) of EXTENT with (IMAX (IMINUS (QUOTIENT (TIMES EBMXOFFSET EXTENTWIDTH) BITMAPWIDTH)) (IMINUS EXTENTWIDTH))) (* ; "move image to the left.") (BITBLT W (IPLUS GILEFT (TIMES DXGRID GWIDTH)) GIBOTTOM W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL GRIDINTERIOR) (* ; "clear the newly exposed area.") (BLTSHADE WHITESHADE W (IPLUS GILEFT (TIMES (IDIFFERENCE BITSWIDE DXGRID) GWIDTH)) GIBOTTOM SCREENWIDTH SCREENHEIGHT 'REPLACE GRIDINTERIOR) (RESETGRID.NEW BM GRIDSPEC DXGRID BITSHIGH (IDIFFERENCE BITSWIDE DXGRID) 0 W)) ((ILESSP 0 DX) (* ;  "determine how many grid point to the left to move.") (SETQ DXGRID (IMIN EBMXOFFSET (GRIDXCOORD DX GRIDSPEC))) (COND ((NOT (IGREATERP DXGRID 0)) (* ; "left edge is at the left margin") (RETURN))) (WINDOWPROP W 'XOFFSET (SETQ EBMXOFFSET (IDIFFERENCE EBMXOFFSET DXGRID))) (* ; "update REGION bar") (replace (REGION LEFT) of EXTENT with (IMIN (IMINUS (IQUOTIENT (TIMES EBMXOFFSET EXTENTWIDTH) BITMAPWIDTH)) 0)) (* ; "move image to the right.") (BITBLT W GILEFT GIBOTTOM W (IPLUS GILEFT (TIMES DXGRID GWIDTH)) GIBOTTOM SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL GRIDINTERIOR) (* ; "clear the newly exposed area.") (BLTSHADE WHITESHADE W GILEFT GIBOTTOM (TIMES DXGRID GWIDTH) GIHEIGHT 'REPLACE) (RESETGRID.NEW BM GRIDSPEC DXGRID BITSHIGH 0 0 W))) (* ; "Make a vertical adjustment") (COND ((FLOATP DY) (* ; "Vertical Thumbing") [WINDOWPROP W 'YOFFSET (SETQ EBMYOFFSET (FIX (TIMES (IDIFFERENCE BITMAPHEIGHT BITSHIGH) (FDIFFERENCE 1.0 DY] (* ; "set EXTENT bar") (replace (REGION BOTTOM) of EXTENT with (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT) BITMAPHEIGHT))) (* ; "Clear Window") (* BLTSHADE WHITESHADE W GILEFT  GIBOTTOM SCREENWIDTH SCREENHEIGHT  (QUOTE REPLACE) GRIDINTERIOR) (* ;  "Repaint the image using grid function") (RESETGRID.NEW BM GRIDSPEC BITSWIDE BITSHIGH 0 0 W T)) ((ILESSP DY 0) (* ;  "determine how many squares to move down.") (SETQ DYGRID (IMIN (IDIFFERENCE (BITMAPHEIGHT BM) EBMYLIMIT) (GRIDYCOORD (IMIN GIHEIGHT (IMINUS DY)) GRIDSPEC))) (COND ((NOT (IGREATERP DYGRID 0)) (* ; "top edge is at the top margin") (RETURN))) (WINDOWPROP W 'YOFFSET (SETQ EBMYOFFSET (IPLUS EBMYOFFSET DYGRID))) (replace (REGION BOTTOM) of EXTENT with (IMAX (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT) BITMAPHEIGHT)) (IMINUS EXTENTHEIGHT))) (BITBLT W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT)) W GILEFT GIBOTTOM SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL GRIDINTERIOR) (* BLTSHADE WHITESHADE W GILEFT  (IPLUS GIBOTTOM (ITIMES  (IDIFFERENCE BITSHIGH DYGRID)  GHEIGHT)) SCREENWIDTH SCREENHEIGHT  (QUOTE REPLACE) GRIDINTERIOR) (RESETGRID.NEW BM GRIDSPEC BITSWIDE DYGRID 0 (IDIFFERENCE BITSHIGH DYGRID) W T)) ((ILESSP 0 DY) (* ;  "moving up; determine how may grid squares to move.") (SETQ DYGRID (IMIN EBMYOFFSET (GRIDYCOORD (IMIN GIHEIGHT DY) GRIDSPEC))) (COND ((NOT (IGREATERP DYGRID 0)) (* ;  "bottom edge is at the bottom margin") (RETURN))) (WINDOWPROP W 'YOFFSET (SETQ EBMYOFFSET (IDIFFERENCE EBMYOFFSET DYGRID))) (replace (REGION BOTTOM) of EXTENT with (IMIN (IMINUS (QUOTIENT (TIMES EBMYOFFSET EXTENTHEIGHT) BITMAPHEIGHT)) 0)) (BITBLT W GILEFT GIBOTTOM W GILEFT (IPLUS GIBOTTOM (ITIMES DYGRID GHEIGHT)) SCREENWIDTH SCREENHEIGHT 'INPUT 'REPLACE NIL GRIDINTERIOR) (* BLTSHADE WHITESHADE W GILEFT  GIBOTTOM (fetch (REGION WIDTH) of  GRIDINTERIOR) (ITIMES DYGRID GHEIGHT)  (QUOTE REPLACE)) (RESETGRID.NEW BM GRIDSPEC BITSWIDE DYGRID 0 0 W T))) (* ;;  "This call to GRID is unnecessary as the grid dots get filled in earlier.") (* ;;  "(COND ((WINDOWPROP W 'GRIDON) (GRID GRIDSPEC BITSWIDE BITSHIGH 'POINT W)))") [COND ([OR (ILESSP EBMXOFFSET DXOFFSET) (ILESSP EBMYOFFSET DYOFFSET) [IGREATERP (IPLUS EBMXOFFSET BITSWIDE) (IPLUS DXOFFSET (WINDOWPROP W 'BMDISPLAYWIDTH] (IGREATERP (IPLUS EBMYOFFSET BITSHIGH) (IPLUS DYOFFSET (WINDOWPROP W 'BMDISPLAYHEIGHT] (* ;  "Adjust the display region left lower corner so the selected region is near the center.") [WINDOWPROP W 'DXOFFSET (SETQ DXOFFSET (IMAX 0 (IMIN (IDIFFERENCE (BITMAPWIDTH BM) (WINDOWPROP W 'BMDISPLAYWIDTH)) (IDIFFERENCE (IPLUS EBMXOFFSET (LRSH BITSWIDE 1)) (LRSH (WINDOWPROP W 'BMDISPLAYWIDTH) 1] (WINDOWPROP W 'DYOFFSET (SETQ DYOFFSET (IMAX 0 (IMIN (IDIFFERENCE (BITMAPHEIGHT BM) (WINDOWPROP W 'BMDISPLAYHEIGHT) ) (IDIFFERENCE (IPLUS EBMYOFFSET (LRSH BITSHIGH 1)) (LRSH (WINDOWPROP W 'BMDISPLAYHEIGHT) 1] (UPDATE/BM/DISPLAY BM W]) (EDITBM [LAMBDA (BMSPEC) (* ; "Edited 31-Aug-90 14:49 by Takeshi") (* ;;; "A simple bitmap editor.") (* ;; "The edit part of the display is from 0 to MAXGRIDWIDTH in width and from 0 to MAXGRIDHEIGHT in height. The commands and display area for the bitmap being edited are above the edit region.") (DECLARE (GLOBALVARS \CURSORDESTWIDTH \CURSORDESTHEIGHT)) (PROG (BMW BMWINTERIOR BMWWIDTH BMWHEIGHT WIDTH HEIGHT BM CR ORIGBM GRIDSQUARE BPP ORIGBPP ORIGWIDTH) (* ;  "set ORIGBM to the input bitmap if any and BM to a copy of it for editting.") [COND ((OR (EQ BMSPEC CursorBitMap) (AND (EQ BMSPEC 'CursorBitMap) (SETQ BMSPEC CursorBitMap))) (* ;  "editing cursor, save old value and make changes to the original.") (SETQ ORIGBM (BITMAPCOPY CursorBitMap)) (SETQ BM CursorBitMap)) [(BITMAPP BMSPEC) (SETQ BM (BITMAPCOPY (SETQ ORIGBM BMSPEC] [(LITATOM BMSPEC) (COND ([BITMAPP (SETQ ORIGBM (EVALV BMSPEC 'EDITBM] (* ; "use value.") (SETQ BM (BITMAPCOPY ORIGBM))) (T (SETQ ORIGBM NIL) (SETQ BM (\READBMDIMENSIONS] ((REGIONP BMSPEC) (* ;  "if BMSPEC is a region, treat it as a region of the screen.") (SETQ BM (BITMAPCREATE (fetch (REGION WIDTH) of BMSPEC) (fetch (REGION HEIGHT) of BMSPEC) (BITSPERPIXEL \CURSORDESTINATION))) (* ;  "note that bm has initial bits in it.") (SETQ ORIGBM BMSPEC) (BITBLT \CURSORDESTINATION (fetch (REGION LEFT) of BMSPEC) (fetch (REGION BOTTOM) of BMSPEC) BM 0 0 NIL NIL 'INPUT 'REPLACE)) ((WINDOWP BMSPEC) (SETQ ORIGBM BMSPEC) (* ;;  "FS: Seems too big below, why not ClipRegion's Width & Height? That's all that's used...") (SETQ BM (BITMAPCREATE (WINDOWPROP BMSPEC 'WIDTH) (WINDOWPROP BMSPEC 'HEIGHT) (BITSPERPIXEL BMSPEC))) (* ;  "open the window and bring it to the top.") (TOTOPW BMSPEC) (SETQ CR (DSPCLIPPINGREGION NIL BMSPEC)) (BITBLT BMSPEC (fetch (REGION LEFT) of CR) (fetch (REGION BOTTOM) of CR) BM 0 0 (fetch (REGION WIDTH) of CR) (fetch (REGION HEIGHT) of CR))) (T (* ; "otherwise create a bitmap") (SETQ BM (\READBMDIMENSIONS] (if (OR (EQ (BITMAPHEIGHT BM) 0) (EQ (BITMAPWIDTH BM) 0)) then (ERROR "Can't edit a bitmap with no bits in it." BMSPEC)) (SETQ BPP (BITSPERPIXEL \CURSORDESTINATION)) (SETQ ORIGBPP (BITMAPBPP BM)) [COND ((NOT (EQ BPP ORIGBPP)) (* ;; "save the actual number of bits per pixel and set it to BPP in the bitmap being edited so that it can be BITBLT ed on the screen.") (SETQ ORIGWIDTH (BITMAPWIDTH BM)) (replace (BITMAP BITMAPBITSPERPIXEL) of BM with BPP) (SETQ WIDTH (IQUOTIENT (ITIMES ORIGBPP ORIGWIDTH) BPP)) (replace (BITMAP BITMAPWIDTH) of BM with WIDTH)) (T (SETQ WIDTH (BITMAPWIDTH BM] (SETQ HEIGHT (BITMAPHEIGHT BM)) (* ;;  "Calculate a default window size. Start by calculating the grid size from the bitmap size.") (SETQ GRIDSQUARE (IMAX (IMIN (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES \CURSORDESTWIDTH 2) 3) GRIDTHICKNESS) WIDTH) (IQUOTIENT (IDIFFERENCE (IQUOTIENT (ITIMES \CURSORDESTHEIGHT 2 ) 3) (ITIMES GRIDTHICKNESS 2)) (ADD1 HEIGHT)) NORMALGRIDSQUARE) MINGRIDSQUARE)) (SETQ BMWWIDTH (IMIN (IPLUS (ITIMES GRIDSQUARE WIDTH) GRIDTHICKNESS) (IQUOTIENT (ITIMES \CURSORDESTWIDTH 2) 3))) (SETQ BMWHEIGHT (IMIN (IPLUS (ITIMES HEIGHT (ADD1 GRIDSQUARE)) (ITIMES GRIDTHICKNESS 2) 1) (IQUOTIENT (ITIMES \CURSORDESTHEIGHT 2) 3))) (SETQ BMW (CREATEW (GETBOXREGION (WIDTHIFWINDOW BMWWIDTH) (HEIGHTIFWINDOW BMWHEIGHT T) NIL NIL NIL "Indicate the position for the Bitmap Edit window.") "Bitmap Editor")) (WINDOWPROP BMW 'BM BM) (WINDOWPROP BMW 'SCROLLFN (FUNCTION EDITBMSCROLLFN)) (WINDOWPROP BMW 'RESHAPEFN (FUNCTION EDITBMRESHAPEFN)) (WINDOWPROP BMW 'REPAINTFN (FUNCTION EDITBMREPAINTFN)) (WINDOWPROP BMW 'BUTTONEVENTFN (FUNCTION EDITBMBUTTONFN)) (WINDOWPROP BMW 'CLOSEFN (FUNCTION EDITBMCLOSEFN)) (WINDOWPROP BMW 'XOFFSET 0) (WINDOWPROP BMW 'YOFFSET 0) (WINDOWPROP BMW 'DXOFFSET 0) (WINDOWPROP BMW 'DYOFFSET 0) (WINDOWPROP BMW 'ORIGINALBITMAP ORIGBM) (WINDOWPROP BMW 'FINISHEDFLG NIL) (WINDOWPROP BMW 'COLOR (MAXIMUMCOLOR BPP)) (WINDOWPROP BMW 'GRIDON T) (* ;  "call reshapefn to initialize the display and values") (EDITBMRESHAPEFN BMW NIL NIL NIL (NOT ORIGBM)) (* ;  "start a mouse process in case this process is the mouse process.") (SPAWN.MOUSE) (while (NOT (WINDOWPROP BMW 'FINISHEDFLG)) do (DISMISS 500)) (* ;  "remove the closefn before closing the window.") (WINDOWPROP BMW 'CLOSEFN NIL) (CLOSEW BMW) (COND ((NOT (EQ ORIGBPP BPP)) (replace (BITMAP BITMAPBITSPERPIXEL) of BM with ORIGBPP) (replace (BITMAP BITMAPWIDTH) of BM with ORIGWIDTH))) (RETURN (COND ((EQ T (WINDOWPROP BMW 'FINISHEDFLG)) (* ;  "editor exited via ok, stuff contents into original bitmap.") (COND ((EQ BMSPEC CursorBitMap) (* ;  "editting happened in original, leave it alone.") CursorBitMap) ((REGIONP ORIGBM) (* ; "put it back into the screen.") (BITBLT BM 0 0 \CURSORDESTINATION (fetch (REGION LEFT) of ORIGBM) (fetch (REGION BOTTOM) of ORIGBM) (fetch (REGION WIDTH) of ORIGBM) (fetch (REGION HEIGHT) of ORIGBM) 'INPUT 'REPLACE) BM) ((WINDOWP ORIGBM) (* ; "put it back into the window") (BITBLT BM 0 0 ORIGBM (fetch (REGION LEFT) of CR) (fetch (REGION BOTTOM) of CR) (fetch (REGION WIDTH) of CR) (fetch (REGION HEIGHT) of CR) 'INPUT 'REPLACE) BM) (ORIGBM (BITBLT BM 0 0 ORIGBM 0 0 WIDTH HEIGHT) [COND ((AND BMSPEC (LITATOM BMSPEC)) (* ;  "if spec was an atom without a bm value, set it. in the environment above EDITBM.") (MARKASCHANGED BMSPEC 'VARS) (STKEVAL 'EDITBM (LIST 'SETQQ BMSPEC BM] ORIGBM) (T BM))) (T (* ;  "error exit, if cursor return it to original value.") (COND ((EQ BMSPEC CursorBitMap) (BITBLT ORIGBM NIL NIL CursorBitMap))) (ERROR!]) ) (DEFINEQ (BITMAPBIT [LAMBDA (BITMAP X Y NEWVALUE) (* ; "Edited 31-Aug-90 18:34 by Takeshi") (* ;;; "reads and optionally sets a bit in a bitmap. If bitmap is a displaystream, it works on the destination through the coordinate transformations.") (* ;; "version of BITMAPBIT that works for multiple bit per pixel bitmaps.") (DECLARE (GLOBALVARS \SCREENBITMAPS)) (PROG (NBITS BITX WORDX OLDVALUE HEIGHT oldword bitmapbase) (RETURN (COND [(type? BITMAP BITMAP) (SETQ NBITS (fetch (BITMAP BITMAPBITSPERPIXEL) of BITMAP)) (COND ([OR (IGREATERP 0 X) (IGEQ X (fetch (BITMAP BITMAPWIDTH) of BITMAP)) (IGREATERP 0 Y) (IGEQ Y (SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP] (* ; "all bitmaps are 0 outside") 0) [(EQ NBITS 1) (* ;; "Special case for single-bit bitmaps, i.e., the display.") (COND ((EQ NEWVALUE 0) (\FBITMAPBIT (fetch (BITMAP BITMAPBASE) of BITMAP) X Y 'ERASE (SUB1 HEIGHT) (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP))) ((NOT NEWVALUE) (\FBITMAPBIT (fetch (BITMAP BITMAPBASE) of BITMAP) X Y 'READ (SUB1 HEIGHT) (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP))) (T (\FBITMAPBIT (fetch (BITMAP BITMAPBASE) of BITMAP) X Y 'PAINT (SUB1 HEIGHT) (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP] (T [SETQ bitmapbase (\ADDBASE (fetch (BITMAP BITMAPBASE) of BITMAP) (ITIMES (SUB1 (\SFInvert BITMAP Y)) (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP] [COND (NEWVALUE (* ;  "check NEWVALUE before going uninterruptable.") (COND ([NOT (AND (IGEQ NEWVALUE MINIMUMCOLOR) (ILEQ NEWVALUE (MAXIMUMCOLOR (fetch (BITMAP BITMAPBITSPERPIXEL ) of BITMAP] (\ILLEGAL.ARG NEWVALUE] (SELECTQ NBITS (1 (SETQ WORDX (FOLDLO X BITSPERWORD)) (* ;; "") (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ BITX (\BITMASK X)) [if NEWVALUE then (if (EQ NEWVALUE 0) then (\PUTBASE bitmapbase WORDX (LOGAND oldword (LOGXOR BITX -1)) ) else (\PUTBASE bitmapbase WORDX (LOGOR oldword BITX] (if (EQ 0 (LOGAND oldword BITX)) then 0 else 1)) (4 (SETQ BITX (LSH X 2)) (SETQ WORDX (FOLDLO BITX BITSPERWORD)) (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ OLDVALUE (LOGAND oldword (\4BITMASK X))) [COND (NEWVALUE (\PUTBASE bitmapbase WORDX (LOGOR (LOGXOR oldword OLDVALUE) (LLSH NEWVALUE (ITIMES 4 (IDIFFERENCE 3 (LOGAND X 3] (* ;  "move the 4 bit current value to the right most bits.") [LRSH OLDVALUE (ITIMES 4 (IDIFFERENCE 3 (LOGAND X 3]) (8 (SETQ BITX (LSH X 3)) (SETQ WORDX (FOLDLO BITX BITSPERWORD)) [COND ((EQ (LOGAND X 1) 0) (* ; "left half of word") (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ OLDVALUE (LOGAND oldword 65280)) [COND (NEWVALUE (\PUTBASE bitmapbase WORDX (LOGOR (LOGXOR oldword OLDVALUE) (LLSH NEWVALUE 8] (SETQ OLDVALUE (LRSH OLDVALUE 8))) (T (* ; "right half of word") (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ OLDVALUE (LOGAND oldword 255)) (COND (NEWVALUE (\PUTBASE bitmapbase WORDX (LOGOR (LOGXOR oldword OLDVALUE) NEWVALUE] OLDVALUE) (24 (SETQ BITX (ITIMES X 24)) (SETQ WORDX (FOLDLO BITX BITSPERWORD)) (SETQ OLDVALUE (\GETBASE24 bitmapbase X)) (COND (NEWVALUE (\PUTBASE24 bitmapbase X NEWVALUE))) OLDVALUE) (ERROR "unknown bits per pixel size." NBITS] ((type? BIGBM BITMAP) (BITMAPBIT.BIGBM BITMAP X Y NEWVALUE)) (T (PROG (TX TY DD) (SETQ DD (\GETDISPLAYDATA BITMAP BITMAP)) (SETQ TX (\DSPCLIPTRANSFORMX X DD)) (SETQ TY (\DSPCLIPTRANSFORMY Y DD)) (RETURN (COND ((AND TX TY) (.WHILE.TOP.DS. BITMAP (SETQ TX (BITMAPBIT (fetch (\DISPLAYDATA DDDestination) of DD) TX TY NEWVALUE))) TX) (T (* ;  "anything outside the clipping region returns 0.") 0]) (BITMAPBIT.BIGBM [LAMBDA (BITMAP X Y NEWVALUE) (* ; "Edited 31-Aug-90 18:31 by Takeshi") (PROG (NBITS BITX WORDX OLDVALUE HEIGHT oldword bitmapbase INV-Y) (RETURN (COND [(type? BIGBM BITMAP) (SETQ NBITS (BITMAPBPP BITMAP)) (COND ([OR (IGREATERP 0 X) (IGEQ X (BITMAPWIDTH BITMAP)) (IGREATERP 0 Y) (IGEQ Y (SETQ HEIGHT (BITMAPHEIGHT BITMAP] (* ; "all bitmaps are 0 outside") 0) ((EQ NBITS 1) (* ;; "Special case for single-bit bitmaps, i.e., the display.") (ERROR "BITMAPBIT.BIGBM supports only COLOR")) (T (* ;; "Serch which part of BIGBM contains (x,y) pixel") [LET [(BMLIST (FFETCH (BIGBM BIGBMLIST) OF BITMAP)) (YPOS (SUB1 (\SFInvert BITMAP Y] (for BMPIECE in BMLIST bind H DO (IF [<= YPOS (SUB1 (SETQ H (FETCH (BITMAP BITMAPHEIGHT ) OF BMPIECE] THEN (SETQ INV-Y YPOS) (SETQ BITMAP BMPIECE) (RETURN) ELSE (SETQ YPOS (- YPOS H] [SETQ bitmapbase (\ADDBASE (fetch (BITMAP BITMAPBASE) of BITMAP) (ITIMES INV-Y (fetch (BITMAP BITMAPRASTERWIDTH ) of BITMAP] [COND (NEWVALUE (* ;  "check NEWVALUE before going uninterruptable.") (COND ([NOT (AND (IGEQ NEWVALUE MINIMUMCOLOR) (ILEQ NEWVALUE (MAXIMUMCOLOR (fetch (BITMAP BITMAPBITSPERPIXEL ) of BITMAP] (\ILLEGAL.ARG NEWVALUE] (SELECTQ NBITS (1 (SETQ WORDX (FOLDLO X BITSPERWORD)) (* ;; "") (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ BITX (\BITMASK X)) [if NEWVALUE then (if (EQ NEWVALUE 0) then (\PUTBASE bitmapbase WORDX (LOGAND oldword (LOGXOR BITX -1)) ) else (\PUTBASE bitmapbase WORDX (LOGOR oldword BITX] (if (EQ 0 (LOGAND oldword BITX)) then 0 else 1)) (8 (SETQ BITX (LSH X 3)) (SETQ WORDX (FOLDLO BITX BITSPERWORD)) [COND ((EQ (LOGAND X 1) 0) (* ; "left half of word") (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ OLDVALUE (LOGAND oldword 65280)) [COND (NEWVALUE (\PUTBASE bitmapbase WORDX (LOGOR (LOGXOR oldword OLDVALUE) (LLSH NEWVALUE 8] (SETQ OLDVALUE (LRSH OLDVALUE 8))) (T (* ; "right half of word") (SETQ oldword (\GETBASE bitmapbase WORDX)) (SETQ OLDVALUE (LOGAND oldword 255)) (COND (NEWVALUE (\PUTBASE bitmapbase WORDX (LOGOR (LOGXOR oldword OLDVALUE) NEWVALUE] OLDVALUE) (ERROR "unknown bits per pixel size." NBITS] (T (ERROR "Arg Not BIGBM " BITMAP]) ) (DEFINEQ (BITBLT.BIGBM [LAMBDA (SRCE SRCELEFT SRCEBOTTOM DEST DESTLEFT DESTBOTTOM WIDTH HEIGHT SRCETYPE OPERATION TEXTURE CLIPPINGREGION) (* ; "Edited 7-Sep-90 17:43 by Takeshi") (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) [SETQ SRCETOP (IPLUS (OR SRCEBOTTOM (SETQ SRCEBOTTOM 0)) (OR HEIGHT (SETQ HEIGHT (BITMAPHEIGHT SRCE] (SETQ DESTTOP (IPLUS (OR DESTBOTTOM (SETQ DESTBOTTOM 0)) HEIGHT)) (if (type? BIGBM SRCE) then (SETQ SRCEBMLIST (fetch (BIGBM BIGBMLIST) of SRCE)) (SETQ SRCEBIGBMHEIGHT (fetch (BIGBM BIGBMHEIGHT) of SRCE)) (SETQ SRCEFRAG (GetNewFragment SRCEBMLIST)) (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] [if (type? BIGBM DEST) then (PROG NIL (* ;; "BIGBM to BIGBM case") (SETQ DESTBMLIST (fetch (BIGBM BIGBMLIST) of DEST)) (SETQ DESTBIGBMHEIGHT (fetch (BIGBM BIGBMHEIGHT) of DEST)) (SETQ DESTFRAG (GetNewFragment DESTBMLIST)) (SETQ DESTFRAGTOP DESTBIGBMHEIGHT) (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] (if (<= SRCEFRAGBOTTOM SRCEBOTTOM) then (SETQ SRCE-H (- SRCETOP SRCEBOTTOM)) else (SETQ SRCE-H (- SRCETOP SRCEFRAGBOTTOM))) (if (<= DESTFRAGBOTTOM DESTBOTTOM) then (SETQ DEST-H (- DESTTOP DESTBOTTOM)) else (SETQ DEST-H (- DESTTOP DESTFRAGBOTTOM))) (SETQ H (MIN DEST-H SRCE-H)) (* ; " Decriments Height") (SETQ NEXT-S-TOP (- SRCETOP H)) (SETQ NEXT-D-TOP (- DESTTOP H)) (SETQ SBOTTOM (- NEXT-S-TOP SRCEFRAGBOTTOM)) (SETQ DBOTTOM (- NEXT-D-TOP DESTFRAGBOTTOM)) (ORG.BITBLT SRCEFRAG SRCELEFT SBOTTOM DESTFRAG DESTLEFT DBOTTOM WIDTH H SRCETYPE OPERATION TEXTURE CLIPPINGREGION) (if (> (SETQ HEIGHT (- HEIGHT H)) 0) then (SETQ SRCETOP NEXT-S-TOP) (SETQ DESTTOP NEXT-D-TOP) [if (<= NEXT-S-TOP SRCEFRAGBOTTOM) then (SETQ SRCEFRAG (GetNewFragment SRCEBMLIST)) (SETQ SRCEFRAGTOP SRCEFRAGBOTTOM) (SETQ SRCEFRAGBOTTOM (- SRCEFRAGTOP (BITMAPHEIGHT SRCEFRAG] [if (<= NEXT-D-TOP DESTFRAGBOTTOM) then (SETQ DESTFRAG (GetNewFragment DESTBMLIST)) (SETQ DESTFRAGTOP DESTFRAGBOTTOM) (SETQ DESTFRAGBOTTOM (- DESTFRAGTOP (BITMAPHEIGHT DESTFRAG] (GO LOOP) (* ;; "I hate goto, but this is temporary one") )) else (PROG NIL LOOP2 (if (<= SRCEFRAGBOTTOM SRCEBOTTOM) then (* ;; " bottom edge") (SETQ SRCE-H (- SRCETOP SRCEBOTTOM)) (* ;; "BIGBM to BITMAP case") else (SETQ SRCE-H (- SRCETOP SRCEFRAGBOTTOM))) (SETQ H (MIN HEIGHT SRCE-H)) (SETQ NEXT-S-TOP (- SRCETOP H)) (SETQ NEXT-D-TOP (- DESTTOP H)) (SETQ SBOTTOM (- NEXT-S-TOP SRCEFRAGBOTTOM)) (ORG.BITBLT SRCEFRAG SRCELEFT SBOTTOM DEST DESTLEFT NEXT-D-TOP WIDTH H SRCETYPE OPERATION TEXTURE CLIPPINGREGION) (if (> (SETQ HEIGHT (- HEIGHT H)) 0) then (SETQ SRCETOP NEXT-S-TOP) (SETQ DESTTOP NEXT-D-TOP) [if (<= NEXT-S-TOP SRCEFRAGBOTTOM) then (SETQ SRCEFRAG (GetNewFragment SRCEBMLIST )) (* ;; "Get next SRCE fragment") (SETQ SRCEFRAGTOP SRCEFRAGBOTTOM) (SETQ SRCEFRAGBOTTOM (- SRCEFRAGTOP (BITMAPHEIGHT SRCEFRAG] (GO LOOP2) (* ;; "I hate goto, but this is temporary one") ] elseif (OR (type? BIGBM DEST)) then (PROG NIL (SETQ DESTBMLIST (fetch (BIGBM BIGBMLIST) of DEST)) (SETQ DESTBIGBMHEIGHT (fetch (BIGBM BIGBMHEIGHT) of DEST)) (SETQ DESTFRAG (GetNewFragment DESTBMLIST)) (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] (if (<= DESTFRAGBOTTOM DESTBOTTOM) then (* ;; " bottom edge") (SETQ DEST-H (- DESTTOP DESTBOTTOM)) else (SETQ DEST-H (- DESTTOP DESTFRAGBOTTOM))) LOOP3 (if (<= DESTFRAGBOTTOM DESTBOTTOM) then (SETQ DEST-H (- DESTTOP DESTBOTTOM)) else (SETQ DEST-H (- DESTTOP DESTFRAGBOTTOM))) (SETQ H (MIN DEST-H HEIGHT)) (SETQ NEXT-S-TOP (- SRCETOP H)) (SETQ NEXT-D-TOP (- DESTTOP H)) (SETQ DBOTTOM (- NEXT-D-TOP DESTFRAGBOTTOM)) (ORG.BITBLT SRCE SRCELEFT NEXT-S-TOP DESTFRAG DESTLEFT DBOTTOM WIDTH H SRCETYPE OPERATION TEXTURE CLIPPINGREGION) (if (> (SETQ HEIGHT (- HEIGHT H)) 0) then (SETQ DESTTOP NEXT-D-TOP) (SETQ SRCETOP NEXT-S-TOP) [if (<= NEXT-D-TOP DESTFRAGBOTTOM) then (SETQ DESTFRAG (GetNewFragment DESTBMLIST)) (SETQ DESTFRAGTOP DESTFRAGBOTTOM) (SETQ DESTFRAGBOTTOM (- DESTFRAGTOP (BITMAPHEIGHT DESTFRAG] (GO LOOP3) (* ;; "I hate goto, but this is temporary one") )) else (* ;; "Normal case, use BITBLT") (ORG.BITBLT SRCE SRCELEFT SRCEBOTTOM DEST DESTLEFT DESTBOTTOM WIDTH HEIGHT SRCETYPE OPERATION TEXTURE CLIPPINGREGION]) ) (DECLARE%: EVAL@COMPILE (PUTPROPS \SFInvert MACRO ((BitMap y) (* corrects for the fact that alto bitmaps are stored with 0,0 as upper left  while lisp bitmaps have 0,0 as lower left.  The correction is actually off by one (greater) because a majority of the  places that it is called actually need one more than corrected Y value.) (IDIFFERENCE (BITMAPHEIGHT BitMap) y))) ) (DEFINEQ (UPDATE/BM/DISPLAY/SELECTED/REGION [LAMBDA (W) (* ; "Edited 31-Aug-90 18:38 by Takeshi") (* Shade the selected region of the  bitmap display area.) (COND ([OR (IGREATERP (BITMAPWIDTH (WINDOWPROP W 'BM)) (WINDOWPROP W 'BITSWIDE)) (IGREATERP (BITMAPHEIGHT (WINDOWPROP W 'BM)) (WINDOWPROP W 'BITSHIGH] (* only invert the region being  editted if it is less than the  entire bitmap.) (BLTSHADE BLACKSHADE W (IDIFFERENCE (WINDOWPROP W 'XOFFSET) (WINDOWPROP W 'DXOFFSET)) (IDIFFERENCE (IPLUS (WINDOWPROP W 'BMDISPLAYBOTTOM) (WINDOWPROP W 'YOFFSET)) (WINDOWPROP W 'DYOFFSET)) (WINDOWPROP W 'BITSWIDE) (WINDOWPROP W 'BITSHIGH) 'INVERT]) ) (MOVD 'BITMAPBIT '\BITMAPBIT) (PUTPROPS EDITBMPATCHES COPYRIGHT ("Takeshi Shimizu 1988,1989,1990" 1990)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1028 3769 (BITMAPBPP 1038 . 1775) (BITMAPWIDTH 1777 . 2696) (BITMAPHEIGHT 2698 . 3767)) (3770 56510 (EDITBMRESHAPEFN 3780 . 12144) (EDITBMBUTTONFN 12146 . 32920) (EDITBMSCROLLFN 32922 . 46565) (EDITBM 46567 . 56508)) (56511 70897 (BITMAPBIT 56521 . 65069) (BITMAPBIT.BIGBM 65071 . 70895)) (70898 83243 (BITBLT.BIGBM 70908 . 83241)) (83756 84958 (UPDATE/BM/DISPLAY/SELECTED/REGION 83766 . 84956))))) STOP \ No newline at end of file diff --git a/library/patches/NEW-SKETCH-COLOR b/obsolete/library/patches/NEW-SKETCH-COLOR similarity index 100% rename from library/patches/NEW-SKETCH-COLOR rename to obsolete/library/patches/NEW-SKETCH-COLOR