(FILECREATED " 7-Oct-86 15:47:41" {DSK}<LISPFILES>EDITBITMAP.;2
 15312  

      changes to:  (FNS EDIT.BITMAP)

      previous date: "26-Feb-86 00:24:14" {DSK}<LISPFILES>EDITBITMAP.;1)


(* "
Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT EDITBITMAPCOMS)

(RPAQQ EDITBITMAPCOMS
 
       ((FNS ADD.BORDER.TO.BITMAP BIT.IN.COLUMN BIT.IN.ROW EDIT.BITMAP EDIT.BITMAP.REAL 
             FROM.SCREEN.BITMAP GET.EDIT.BITMAP.MENU INTERACT&SHIFT.BITMAP.LEFT 
             INTERACT&SHIFT.BITMAP.RIGHT INTERACT&SHIFT.BITMAP.DOWN INTERACT&SHIFT.BITMAP.UP 
             INTERACT&ADD.BORDER.TO.BITMAP INVERT.BITMAP.B/W INVERT.BITMAP.DIAGONALLY 
             INVERT.BITMAP.HORIZONTALLY INVERT.BITMAP.VERTICALLY ROTATE.BITMAP.LEFT 
             ROTATE.BITMAP.RIGHT SHIFT.BITMAP.DOWN SHIFT.BITMAP.LEFT SHIFT.BITMAP.RIGHT 
             SHIFT.BITMAP.UP TRIM.BITMAP)
        (VARS (EDIT.BITMAP.MENU))
        (GLOBALVARS EDIT.BITMAP.MENU PROMPTWINDOW BLACKSHADE)
        (FILES READNUMBER)
        (P (FONTCREATE (QUOTE (GACHA 12 BOLD))))))
(DEFINEQ

(ADD.BORDER.TO.BITMAP

  [LAMBDA (BITMAP NBITS TEXTURE)                             (* DAHJr "23-APR-83 12:23")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   (REAL.NBITS (OR NBITS 2))
	   NEW.BITMAP)
          [SETQ NEW.BITMAP (BITMAPCREATE (IPLUS WIDTH (ITIMES REAL.NBITS 2))
					 (IPLUS HEIGHT (ITIMES REAL.NBITS 2]
          (BITBLT NIL NIL NIL NEW.BITMAP NIL NIL NIL NIL (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  (OR TEXTURE WHITESHADE))
          (BITBLT BITMAP 0 0 NEW.BITMAP REAL.NBITS REAL.NBITS WIDTH HEIGHT (QUOTE INPUT)
		  (QUOTE REPLACE))
          (RETURN NEW.BITMAP])

(BIT.IN.COLUMN

  [LAMBDA (BITMAP COLUMN)                                    (* AJB "11-Oct-85 16:07")

    (for
 X from
 0 to
 (SUB1 (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
       when
 (EQ 1 (BITMAPBIT BITMAP COLUMN X)) DO
 (RETURN T])

(BIT.IN.ROW

  [LAMBDA (BITMAP ROW)                                       (* AJB "11-Oct-85 16:11")

    (for
 X from
 0 to
 (SUB1 (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
       when
 (EQ 1 (BITMAPBIT BITMAP X ROW)) DO
 (RETURN T])

(EDIT.BITMAP

  (LAMBDA (OBJECT)
                                           (* AJB " 7-Oct-86 15:46")

    (PROG (NEW.OBJECT BM)
          (RETURN (COND
                     ((NULL OBJECT)
                      (EDIT.BITMAP.REAL
 (BITMAPCREATE 50 50)))
                     ((LITATOM OBJECT)
                      (SETQ BM (EVAL OBJECT))
                      (SETQ NEW.OBJECT (EDIT.BITMAP
 BM))
                      (SET OBJECT NEW.OBJECT)
                      OBJECT)
                     ((BITMAPP OBJECT)
                      (EDIT.BITMAP.REAL
 OBJECT))
                     ((CURSORP OBJECT)
                      (SETQ NEW.OBJECT (EDIT.BITMAP.REAL
 (fetch
 (CURSOR CUIMAGE) of
 OBJECT)))
                      (CURSORCREATE NEW.OBJECT (fetch
 (CURSOR CUHOTSPOTX) of
 OBJECT)
                             (fetch
 (CURSOR CUHOTSPOTY) of
 OBJECT)))
                     (T (ERROR "Object of unrecognized type: " OBJECT)))))))

(EDIT.BITMAP.REAL

  [LAMBDA (BITMAP)                                           (* rrb "11-AUG-83 13:31")

    (PROG (NEW.BITMAP COMMAND.MENU DONE COMMAND PREVIOUS.BITMAP NAME TEMP X Y)
          (SETQ NEW.BITMAP (BITMAPCOPY BITMAP))
          (SETQ COMMAND.MENU (GET.EDIT.BITMAP.MENU
))
          [until
 DONE
	     do
 (SETQ COMMAND (MENU COMMAND.MENU))
		(CLEARW PROMPTWINDOW)
		(SELECTQ COMMAND
			 (NIL NIL)
			 (QUIT (SETQ DONE T))
			 [UNDO (COND
				 (PREVIOUS.BITMAP (SETQ NEW.BITMAP (CAR PREVIOUS.BITMAP))
						  (SETQ PREVIOUS.BITMAP (CDR PREVIOUS.BITMAP)))
				 (T (printout
 PROMPTWINDOW T "Can't: no previous bitmap saved"]
			 (PROGN (SETQ PREVIOUS.BITMAP (CONS NEW.BITMAP PREVIOUS.BITMAP))
				(SETQ NEW.BITMAP (SELECTQ COMMAND
							  (HAND.EDIT (EDITBM NEW.BITMAP))
							  (FROM.SCREEN (FROM.SCREEN.BITMAP
))
							  (TRIM (TRIM.BITMAP
 NEW.BITMAP))
							  (INVERT.HORIZONTALLY (
INVERT.BITMAP.HORIZONTALLY
 NEW.BITMAP))
							  (INVERT.VERTICALLY (INVERT.BITMAP.VERTICALLY

									       NEW.BITMAP))
							  (INVERT.DIAGONALLY (INVERT.BITMAP.DIAGONALLY

									       NEW.BITMAP))
							  (ROTATE.BITMAP.LEFT
 (ROTATE.BITMAP.LEFT

										NEW.BITMAP))
							  (ROTATE.BITMAP.RIGHT
 (ROTATE.BITMAP.RIGHT

										 NEW.BITMAP))
							  (SHIFT.LEFT (INTERACT&SHIFT.BITMAP.LEFT

									NEW.BITMAP))
							  (SHIFT.RIGHT (INTERACT&SHIFT.BITMAP.RIGHT

									 NEW.BITMAP))
							  (SHIFT.DOWN (INTERACT&SHIFT.BITMAP.DOWN

									NEW.BITMAP))
							  (SHIFT.UP (INTERACT&SHIFT.BITMAP.UP
 
										       NEW.BITMAP))
							  (INTERCHANGE.BLACK/WHITE (INVERT.BITMAP.B/W

										     NEW.BITMAP))
							  (ADD.BORDER (INTERACT&ADD.BORDER.TO.BITMAP

									NEW.BITMAP))
							  (ERROR "Unrecognized command" COMMAND]
          (RETURN NEW.BITMAP])

(FROM.SCREEN.BITMAP

  (LAMBDA NIL
                                                         (* kbr: 
                                                                          "26-Feb-86 00:16")

    (PROG (SCREENREGION SCREEN REGION NEW.BITMAP)
          (printout PROMPTWINDOW T "Indicate a region from which to take bits")
          (SETQ SCREENREGION (GETSCREENREGION))
          (SETQ SCREEN (fetch
 (SCREENREGION SCREEN) of
 SCREENREGION))
          (SETQ REGION (fetch
 (SCREENREGION REGION) of
 SCREENREGION))
          (SETQ NEW.BITMAP (BITMAPCREATE (fetch
 (REGION WIDTH) of
 REGION)
                                  (fetch
 (REGION HEIGHT) of
 REGION)
                                  (BITSPERPIXEL (SCREENBITMAP SCREEN))))
          (BITBLT (SCREENBITMAP SCREEN)
                 (fetch
 (REGION LEFT) of
 REGION)
                 (fetch
 (REGION BOTTOM) of
 REGION)
                 NEW.BITMAP 0 0 (fetch
 (REGION WIDTH) of
 REGION)
                 (fetch
 (REGION HEIGHT) of
 REGION)
                 (QUOTE INPUT)
                 (QUOTE REPLACE))
          (RETURN NEW.BITMAP))))

(GET.EDIT.BITMAP.MENU

  [LAMBDA NIL                                                (* DAHJr " 7-JUL-83 17:13")

                                                             (* EVAL THIS WHEN CHANGING THE MENU 

							     (SETQ EDIT.BITMAP.MENU))

    (OR EDIT.BITMAP.MENU
	(SETQ EDIT.BITMAP.MENU
	  (create
 MENU
		  TITLE ← "Operations on bitmaps"
		  ITEMS ←(QUOTE (HAND.EDIT FROM.SCREEN TRIM INVERT.HORIZONTALLY INVERT.VERTICALLY 
					   INVERT.DIAGONALLY ROTATE.BITMAP.LEFT ROTATE.BITMAP.RIGHT 
					   SHIFT.LEFT SHIFT.RIGHT SHIFT.DOWN SHIFT.UP 
					   INTERCHANGE.BLACK/WHITE ADD.BORDER UNDO QUIT))
		  CENTERFLG ← T
		  CHANGEOFFSETFLG ← T])

(INTERACT&SHIFT.BITMAP.LEFT

  [LAMBDA (BITMAP)                                           (* edited: "17-DEC-82 08:31")

    (PROG (NBITS NEW.BITMAP)
          (SETQ NBITS (RNUMBER "Number of bits to shift the bitmap left: "))
          (RETURN (SHIFT.BITMAP.LEFT
 BITMAP NBITS])

(INTERACT&SHIFT.BITMAP.RIGHT

  [LAMBDA (BITMAP)                                           (* edited: "17-DEC-82 08:31")

    (PROG (NBITS NEW.BITMAP)
          (SETQ NBITS (RNUMBER "Number of bits to shift the bitmap right: "))
          (RETURN (SHIFT.BITMAP.RIGHT
 BITMAP NBITS])

(INTERACT&SHIFT.BITMAP.DOWN

  [LAMBDA (BITMAP)                                           (* DAHJr "23-MAR-83 14:39")

    (PROG (NBITS)
          (SETQ NBITS (RNUMBER "Number of bits to shift the bitmap down: "))
          (RETURN (SHIFT.BITMAP.DOWN
 BITMAP NBITS])

(INTERACT&SHIFT.BITMAP.UP

  [LAMBDA (BITMAP)                                           (* edited: "17-DEC-82 08:31")

    (PROG (NBITS NEW.BITMAP)
          (SETQ NBITS (RNUMBER "Number of bits to shift the bitmap up: "))
          (RETURN (SHIFT.BITMAP.UP
 BITMAP NBITS])

(INTERACT&ADD.BORDER.TO.BITMAP

  [LAMBDA (BITMAP)                                           (* rrb "24-Jul-84 18:12")

    (PROG (NBITS TEXTURE)
          (COND
	    ((EQ (SETQ NBITS (RNUMBER "Number of bits in the border: "))
		 0)
	      (RETURN BITMAP))
	    ((GREATERP 0 NBITS)
	      (PROMPTPRINT "Can't add a negative border.")
	      (RETURN BITMAP))
	    ((GREATERP NBITS 500)
	      (PROMPTPRINT "Can't add a border of more than 500.")
	      (RETURN BITMAP)))
          (SETQ TEXTURE (EDITSHADE))
          (RETURN (ADD.BORDER.TO.BITMAP
 BITMAP NBITS TEXTURE])

(INVERT.BITMAP.B/W

  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 11:19")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   (NEW.BITMAP (BITMAPCOPY BITMAP)))
          (BITBLT BITMAP 0 0 NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE TEXTURE)
		  (QUOTE INVERT)
		  BLACKSHADE)
          (RETURN NEW.BITMAP])

(INVERT.BITMAP.DIAGONALLY

  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 16:02")

    (PROG (NEW.BITMAP (WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
		      (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP)))
          (SETQ NEW.BITMAP (BITMAPCREATE HEIGHT WIDTH))
          [for
 X from
 0 to
 (SUB1 WIDTH) do
 (for
 Y from
 0 to
 (SUB1 HEIGHT)
					      do
 (BITMAPBIT NEW.BITMAP Y X (BITMAPBIT BITMAP X Y]
          (RETURN NEW.BITMAP])

(INVERT.BITMAP.HORIZONTALLY

  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 11:28")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   (NEW.BITMAP (BITMAPCOPY BITMAP)))
          [for
 X1 from
 0 to
 (SUB1 (IQUOTIENT WIDTH 2)) do
 (for
 Y from
 0 to
 (SUB1 HEIGHT)
							     bind
 (X2 ←(IDIFFERENCE (SUB1 WIDTH)
										    X1))
							     do
 (BITMAPBIT NEW.BITMAP X1 Y
									   (BITMAPBIT BITMAP X2 Y))
								(BITMAPBIT NEW.BITMAP X2 Y
									   (BITMAPBIT BITMAP X1 Y]
          (RETURN NEW.BITMAP])

(INVERT.BITMAP.VERTICALLY

  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 11:33")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   (NEW.BITMAP (BITMAPCOPY BITMAP)))
          [for
 X1 from
 0 to
 (SUB1 (IQUOTIENT HEIGHT 2)) do
 (for
 Y from
 0 to
 (SUB1 WIDTH)
							      bind
 (X2 ←(IDIFFERENCE (SUB1 HEIGHT)
										     X1))
							      do
 (BITMAPBIT NEW.BITMAP Y X1
									    (BITMAPBIT BITMAP Y X2))
								 (BITMAPBIT NEW.BITMAP Y X2
									    (BITMAPBIT BITMAP Y X1]
          (RETURN NEW.BITMAP])

(ROTATE.BITMAP.LEFT

  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 11:48")

    (PROG (NEW.BITMAP (WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
		      (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP)))
          (SETQ NEW.BITMAP (BITMAPCREATE HEIGHT WIDTH))
          [for
 Y from
 0 to
 (SUB1 HEIGHT) do
 (for
 X from
 0 to
 (SUB1 WIDTH)
					       bind
 (Y1 ←(IDIFFERENCE (SUB1 HEIGHT)
								      Y))
					       do
 (BITMAPBIT NEW.BITMAP Y1 X (BITMAPBIT BITMAP X Y]
          (RETURN NEW.BITMAP])

(ROTATE.BITMAP.RIGHT

  [LAMBDA (BITMAP)                                           (* HK "12-JUL-82 11:50")

    (PROG (NEW.BITMAP (WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
		      (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP)))
          (SETQ NEW.BITMAP (BITMAPCREATE HEIGHT WIDTH))
          [for
 X from
 0 to
 (SUB1 WIDTH) do
 (for
 Y from
 0 to
 (SUB1 HEIGHT)
					      bind
 (X1 ←(IDIFFERENCE (SUB1 WIDTH)
								     X))
					      do
 (BITMAPBIT NEW.BITMAP Y X1 (BITMAPBIT BITMAP X Y]
          (RETURN NEW.BITMAP])

(SHIFT.BITMAP.DOWN

  [LAMBDA (BITMAP NBITS)                                     (* edited: "21-OCT-82 16:20")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   NEW.BITMAP)
          (SETQ NEW.BITMAP (BITMAPCREATE WIDTH (IPLUS HEIGHT NBITS)))
          (BITBLT BITMAP 0 0 NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
		  (QUOTE REPLACE))
          (RETURN NEW.BITMAP])

(SHIFT.BITMAP.LEFT

  [LAMBDA (BITMAP NBITS)                                     (* edited: "21-OCT-82 16:16")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   NEW.BITMAP)
          (SETQ NEW.BITMAP (BITMAPCREATE (IPLUS WIDTH NBITS)
					 HEIGHT))
          (BITBLT BITMAP 0 0 NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
		  (QUOTE REPLACE))
          (RETURN NEW.BITMAP])

(SHIFT.BITMAP.RIGHT

  [LAMBDA (BITMAP NBITS)                                     (* edited: "21-OCT-82 16:17")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   NEW.BITMAP)
          (SETQ NEW.BITMAP (BITMAPCREATE (IPLUS WIDTH NBITS)
					 HEIGHT))
          (BITBLT BITMAP 0 0 NEW.BITMAP NBITS 0 WIDTH HEIGHT (QUOTE INPUT)
		  (QUOTE REPLACE))
          (RETURN NEW.BITMAP])

(SHIFT.BITMAP.UP

  [LAMBDA (BITMAP NBITS)                                     (* edited: "21-OCT-82 16:18")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   NEW.BITMAP)
          (SETQ NEW.BITMAP (BITMAPCREATE WIDTH (IPLUS HEIGHT NBITS)))
          (BITBLT BITMAP 0 0 NEW.BITMAP 0 NBITS WIDTH HEIGHT (QUOTE INPUT)
		  (QUOTE REPLACE))
          (RETURN NEW.BITMAP])

(TRIM.BITMAP

  [LAMBDA (BITMAP)                                           (* HK "20-JUL-82 15:59")

    (PROG ((WIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
	   (HEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
	   LEFT RIGHT BOTTOM TOP NEW.BITMAP)
          (SETQ LEFT (for
 X from
 0 to
 (SUB1 WIDTH) thereis
 (BIT.IN.COLUMN
 BITMAP X)))
          (SETQ RIGHT (for
 X from
 (SUB1 WIDTH) to
 0 by
 -1 thereis
 (BIT.IN.COLUMN
 BITMAP X)))
          (SETQ BOTTOM (for
 X from
 0 to
 (SUB1 HEIGHT) thereis
 (BIT.IN.ROW
 BITMAP X)))
          (SETQ TOP (for
 X from
 (SUB1 HEIGHT) to
 0 by
 -1 thereis
 (BIT.IN.ROW
 BITMAP X)))
          (OR (AND LEFT RIGHT BOTTOM TOP)
	      (HELP))
          [SETQ NEW.BITMAP (BITMAPCREATE (ADD1 (IDIFFERENCE RIGHT LEFT))
					 (ADD1 (IDIFFERENCE TOP BOTTOM]
          (BITBLT BITMAP LEFT BOTTOM NEW.BITMAP 0 0 (ADD1 (IDIFFERENCE RIGHT LEFT))
		  (ADD1 (IDIFFERENCE TOP BOTTOM))
		  (QUOTE INPUT)
		  (QUOTE REPLACE))
          (RETURN NEW.BITMAP])
)

(RPAQQ EDIT.BITMAP.MENU
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS EDIT.BITMAP.MENU PROMPTWINDOW BLACKSHADE)
)
(FILESLOAD READNUMBER)
(FONTCREATE (QUOTE (GACHA 12 BOLD)))
(PUTPROPS EDITBITMAP COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1083 15031 (ADD.BORDER.TO.BITMAP 1093 . 1766) (BIT.IN.COLUMN 1768 . 2035) (BIT.IN.ROW 
2037 . 2297) (EDIT.BITMAP 2299 . 3269) (EDIT.BITMAP.REAL 3271 . 5130) (FROM.SCREEN.BITMAP 5132 . 6286)
 (GET.EDIT.BITMAP.MENU 6288 . 6956) (INTERACT&SHIFT.BITMAP.LEFT 6958 . 7246) (
INTERACT&SHIFT.BITMAP.RIGHT 7248 . 7539) (INTERACT&SHIFT.BITMAP.DOWN 7541 . 7816) (
INTERACT&SHIFT.BITMAP.UP 7818 . 8100) (INTERACT&ADD.BORDER.TO.BITMAP 8102 . 8682) (INVERT.BITMAP.B/W 
8684 . 9100) (INVERT.BITMAP.DIAGONALLY 9102 . 9620) (INVERT.BITMAP.HORIZONTALLY 9622 . 10281) (
INVERT.BITMAP.VERTICALLY 10283 . 10947) (ROTATE.BITMAP.LEFT 10949 . 11534) (ROTATE.BITMAP.RIGHT 11536
 . 12118) (SHIFT.BITMAP.DOWN 12120 . 12573) (SHIFT.BITMAP.LEFT 12575 . 13034) (SHIFT.BITMAP.RIGHT 
13036 . 13500) (SHIFT.BITMAP.UP 13502 . 13957) (TRIM.BITMAP 13959 . 15029)))))
STOP