diff --git a/library/patches/EDITBMPATCHES b/library/patches/EDITBMPATCHES
deleted file mode 100644
index 3e067f52..00000000
--- a/library/patches/EDITBMPATCHES
+++ /dev/null
@@ -1 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 7-Sep-90 17:46:33" {DSK}<home>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}<home>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
