(FILECREATED "24-Jul-84 18:20:34" {ERIS}<LISPUSERS>EDITBITMAP.;7
 14565  

      changes to:  (FNS INTERACT&ADD.BORDER.TO.BITMAP)

      previous date: "28-AUG-83 13:10:40" {ERIS}<LISPUSERS>EDITBITMAP.;6)


(* Copyright (c) 1983, 1984 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)                                    (* HK "12-JUL-82 12:31")

    (for
 X from
 0 to
 (SUB1 (fetch
 (BITMAP BITMAPHEIGHT) of
 BITMAP))
       thereis
 (EQ 1 (BITMAPBIT BITMAP COLUMN X])

(BIT.IN.ROW

  [LAMBDA (BITMAP ROW)                                       (* HK "12-JUL-82 12:27")

    (for
 X from
 0 to
 (SUB1 (fetch
 (BITMAP BITMAPWIDTH) of
 BITMAP))
       thereis
 (EQ 1 (BITMAPBIT BITMAP X ROW])

(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

(ADDTOVAR GLOBALVARS EDIT.BITMAP.MENU PROMPTWINDOW BLACKSHADE)
)
(FILESLOAD READNUMBER)
(FONTCREATE (QUOTE (GACHA 12 BOLD)))
(PUTPROPS EDITBITMAP COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1016 14285 (ADD.BORDER.TO.BITMAP 1026 . 1699) (BIT.IN.COLUMN 1701 . 1951) (BIT.IN.ROW 
1953 . 2196) (EDIT.BITMAP 2198 . 2966) (EDIT.BITMAP.REAL 2968 . 4827) (FROM.SCREEN.BITMAP 4829 . 5540)
 (GET.EDIT.BITMAP.MENU 5542 . 6210) (INTERACT&SHIFT.BITMAP.LEFT 6212 . 6500) (
INTERACT&SHIFT.BITMAP.RIGHT 6502 . 6793) (INTERACT&SHIFT.BITMAP.DOWN 6795 . 7070) (
INTERACT&SHIFT.BITMAP.UP 7072 . 7354) (INTERACT&ADD.BORDER.TO.BITMAP 7356 . 7936) (INVERT.BITMAP.B/W 
7938 . 8354) (INVERT.BITMAP.DIAGONALLY 8356 . 8874) (INVERT.BITMAP.HORIZONTALLY 8876 . 9535) (
INVERT.BITMAP.VERTICALLY 9537 . 10201) (ROTATE.BITMAP.LEFT 10203 . 10788) (ROTATE.BITMAP.RIGHT 10790
 . 11372) (SHIFT.BITMAP.DOWN 11374 . 11827) (SHIFT.BITMAP.LEFT 11829 . 12288) (SHIFT.BITMAP.RIGHT 
12290 . 12754) (SHIFT.BITMAP.UP 12756 . 13211) (TRIM.BITMAP 13213 . 14283)))))
STOP