(FILECREATED "11-Oct-85 16:18:42" {ERIS}<LISPCORE>LIBRARY>EDITBITMAP.;2
 14612  

      changes to:  (FNS BIT.IN.COLUMN BIT.IN.ROW)

      previous date: "24-Jul-84 18:20:34" {ERIS}<LISPCORE>LIBRARY>EDITBITMAP.;1)


(* Copyright (c) 1983, 1984, 1985 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)                                           (* DAHJr "23-MAR-83 17:38")

    (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 CURSORBITMAP) of
 OBJECT)))
		      (CURSORCREATE NEW.OBJECT (fetch
 (CURSOR CURSORHOTSPOTX) of
 OBJECT)
				    (fetch
 (CURSOR CURSORHOTSPOTY) 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                                                (* DAHJr " 7-JUL-83 17:20")

    (PROG (REGION NEW.BITMAP)
          (printout
 PROMPTWINDOW T "Indicate a region of the screen from which to take bits")
          (SETQ REGION (GETREGION))
          (SETQ NEW.BITMAP (BITMAPCREATE (fetch
 (REGION WIDTH) of
 REGION)
					 (fetch
 (REGION HEIGHT) of
 REGION)))
          (BITBLT (SCREENBITMAP)
		  (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))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1033 14336 (ADD.BORDER.TO.BITMAP 1043 . 1716) (BIT.IN.COLUMN 1718 . 1985) (BIT.IN.ROW 
1987 . 2247) (EDIT.BITMAP 2249 . 3017) (EDIT.BITMAP.REAL 3019 . 4878) (FROM.SCREEN.BITMAP 4880 . 5591)
 (GET.EDIT.BITMAP.MENU 5593 . 6261) (INTERACT&SHIFT.BITMAP.LEFT 6263 . 6551) (
INTERACT&SHIFT.BITMAP.RIGHT 6553 . 6844) (INTERACT&SHIFT.BITMAP.DOWN 6846 . 7121) (
INTERACT&SHIFT.BITMAP.UP 7123 . 7405) (INTERACT&ADD.BORDER.TO.BITMAP 7407 . 7987) (INVERT.BITMAP.B/W 
7989 . 8405) (INVERT.BITMAP.DIAGONALLY 8407 . 8925) (INVERT.BITMAP.HORIZONTALLY 8927 . 9586) (
INVERT.BITMAP.VERTICALLY 9588 . 10252) (ROTATE.BITMAP.LEFT 10254 . 10839) (ROTATE.BITMAP.RIGHT 10841
 . 11423) (SHIFT.BITMAP.DOWN 11425 . 11878) (SHIFT.BITMAP.LEFT 11880 . 12339) (SHIFT.BITMAP.RIGHT 
12341 . 12805) (SHIFT.BITMAP.UP 12807 . 13262) (TRIM.BITMAP 13264 . 14334)))))
STOP