(FILECREATED "23-OCT-83 12:25:43" {PHYLUM}<LISPUSERS>NOTEPAD.;25 82731
changes to: (FNS GET.WINDOW.REGION NOTEPAD.NAMED.OBJECT NOTEPAD.CREATE)
previous date: "11-AUG-83 13:40:09" {PHYLUM}<LISPUSERS>NOTEPAD.;24)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT NOTEPADCOMS)
(RPAQQ NOTEPADCOMS [(FNS ACQUIRE.STYLE ACQUIRE.SYMMETRY ADD.NOTEPAD.TO.BACKGROUND.MENU
BITMAP.INTERIOR DELDEF.NOTEPAD.STYLE DISTANCE DUMP.NOTEPAD.STYLE
ERASE.REGION EXTEND.AREA EXTEND.AREA.X EXTEND.AREA.Y GET.BITMAP
GET.NOTEPAD.BITMAP GET.NOTEPAD.REGION GET.SYMMETRIC.BITMAPS
GETDEF.NOTEPAD.STYLE GETPOSITION.RUBBERBAND GETPOSITION.RUBBERBAND1
MARK.SPOT MASKED.BRUSH MOVE.BITMAP MOVE.BITMAP1 NOTEPAD
NOTEPAD.ADD.TO.BACKGROUND.MENU NOTEPAD.BUTTONEVENTFN NOTEPAD.BUTTONFN
NOTEPAD.CIRCLE NOTEPAD.COMMAND.MENU NOTEPAD.COMMAND.MENU.CREATE
NOTEPAD.COOKIE.CUT NOTEPAD.COPY.FROM.SCREEN NOTEPAD.CURVE
NOTEPAD.DEFINE.BRUSH NOTEPAD.DEFINE.FONT NOTEPAD.HELP NOTEPAD.READ.FONT
NOTEPAD.FONTS.IN.CORE READ.NOTEPAD.STYLE NOTEPAD.DEFINE.GRID
NOTEPAD.DEFINE.GRID1 NOTEPAD.DEFINE.MASK NOTEPAD.DELETE.STYLE
NOTEPAD.EDIT.BRUSH NOTEPAD.EDIT.MASK NOTEPAD.EDIT.RECTANGLE
NOTEPAD.EDIT.SHADE NOTEPAD.ELLIPSE NOTEPAD.LINE NOTEPAD.MASK=BRUSH.OUTLINE
NOTEPAD.NAMED.OBJECT NOTEPAD.POINT.OF.SYMMETRY NOTEPAD.RESTORE.STYLE
NOTEPAD.SETUP.TO.PAINT NOTEPAD.SHADE.RECTANGLE NOTEPAD.SKETCH
NOTEPAD.SKETCH1 NOTEPAD.TEXT NOTEPAD.USE.GRID NOTEPAD.USE.MASK
NOTEPAD.USE.SYMMETRIC.BRUSH/MASK NOTEPAD.USE.SYMMETRY NOTEPAD.FILL
NOTEPAD.CONFIRM NOTEPAD.CREATE NOTEPAD.DEFAULT.CHARACTERISTICS
NOTEPAD.GETPOSITION NOTEPAD.MASK NOTEPAD.ON.GRID NOTEPAD.ON.GRID.X
NOTEPAD.OPERATION NOTEPAD.SOLID.AREA BITMAP.EXTERIOR NOTEPAD.TITLEBUTTONFN
PAINT.A.BITMAP PAINT.ALL.BITMAPS PAINT.AT.POSSIBLE.POINT PAINT.WITH.BITMAP
PICKUP.BITMAP PICKUP.SCREEN.BITMAP READ.FROM.PROMPT.WINDOW PUTBACK.BITMAP
PUTDEF.NOTEPAD.STYLE SAVE.STYLE SBIT TEST.AND.SET)
(FNS GET.WINDOW.REGION GETCOLORPOSITION COLORBITMAPP)
(VARS NOTEPAD.DEFAULT.FONT NOTEPAD.STYLE.REPRESENTATION.NUMBER (NOTEPAD.COMMAND.MENU)
(NOTEPAD.SHOW.FILL)
(NOTEPAD.USE.GRID.MENU))
(VARS (.NOTEPAD.BRUSH.1)
(.NOTEPAD.BRUSH.2)
(.NOTEPAD.BRUSH.3)
(.NOTEPAD.BRUSH.4)
(.NOTEPAD.BRUSH.5)
(.NOTEPAD.BRUSH.6)
(.NOTEPAD.BRUSH.7)
(.NOTEPAD.BRUSH.8)
(.NOTEPAD.MASK.1)
(.NOTEPAD.MASK.2)
(.NOTEPAD.MASK.3)
(.NOTEPAD.MASK.4)
(.NOTEPAD.MASK.5)
(.NOTEPAD.MASK.6)
(.NOTEPAD.MASK.7)
(.NOTEPAD.MASK.8))
(GLOBALVARS NOTEPAD.COMMAND.MENU NOTEPAD.USE.GRID.MENU .NOTEPAD.WINDOW .NOTEPAD.OPERATION
.NOTEPAD.BRUSH.1 .NOTEPAD.BRUSH.2 .NOTEPAD.BRUSH.3 .NOTEPAD.BRUSH.4
.NOTEPAD.BRUSH.5 .NOTEPAD.BRUSH.6 .NOTEPAD.BRUSH.7 .NOTEPAD.BRUSH.8
.NOTEPAD.MASK.1 .NOTEPAD.MASK.2 .NOTEPAD.MASK.3 .NOTEPAD.MASK.4 .NOTEPAD.MASK.5
.NOTEPAD.MASK.6 .NOTEPAD.MASK.7 .NOTEPAD.MASK.8 .NOTEPAD.USE.GRID
.NOTEPAD.GRID.X0 .NOTEPAD.GRID.Y0 .NOTEPAD.GRID.DX .NOTEPAD.GRID.DY
.NOTEPAD.USE.MASK .NOTEPAD.INVERSE.OPERATION .NOTEPAD.USE.SYMMETRIC.BRUSH/MASK
.NOTEPAD.USE.SYMMETRY .NOTEPAD.POSX .NOTEPAD.POSY .NOTEPAD.BRUSH.WIDTH
.NOTEPAD.BRUSH.HEIGHT .NOTEPAD.BRUSH.HALF.WIDTH .NOTEPAD.BRUSH.HALF.HEIGHT
.NOTEPAD.MASK.WIDTH .NOTEPAD.MASK.HEIGHT .NOTEPAD.MASK.HALF.WIDTH
.NOTEPAD.MASK.HALF.HEIGHT .NOTEPAD.PREVIOUS.MIDX .NOTEPAD.PREVIOUS.MIDY)
(VARS (COLORSPOTMARKER))
(INITVARS (NOTEPAD.STYLES))
(GLOBALVARS NOTEPAD.STYLES)
(BITMAPS SPOTMARKER NOTEPAD.DEFAULT.BRUSH NOTEPAD.DEFAULT.MASK)
(GLOBALVARS SPOTMARKER NOTEPAD.DEFAULT.BRUSH NOTEPAD.DEFAULT.MASK)
(CURSORS CIRCLE.CENTER CIRCLE.EDGE ELLIPSE.CENTER ELLIPSE.SEMI.MAJOR ELLIPSE.SEMI.MINOR
CURVE.KNOT)
(GLOBALVARS CIRCLE.CENTER CIRCLE.EDGE ELLIPSE.CENTER ELLIPSE.SEMI.MAJOR ELLIPSE.SEMI.MINOR
CURVE.KNOT)
(FILES (FROM VALUEOF LISPUSERSDIRECTORIES)
EDITBITMAP READNUMBER)
(FILEPKGCOMS NOTEPADSTYLE)
[P (ADD.NOTEPAD.TO.BACKGROUND.MENU)
(FONTCREATE NOTEPAD.DEFAULT.FONT)
(COND ((NULL NOTEPAD.STYLES)
(FILESLOAD NOTEPAD-CORESTYLES]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML
READ.NOTEPAD.STYLE)
(LAMA])
(DEFINEQ
(ACQUIRE.STYLE
[LAMBDA (BITS.PER.PIXEL NAME.PLEASE) (* DAHJr "26-JAN-83 14:29")
(PROG (NAME.MENU NAME)
(SETQ NAME.MENU (create MENU
TITLE ← "Styles"
ITEMS ←(for ELEMENT in NOTEPAD.STYLES
when (EQ (LISTGET (CDR ELEMENT)
(QUOTE BITS.PER.PIXEL))
BITS.PER.PIXEL)
collect (CAR ELEMENT))
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(SETQ NAME (MENU NAME.MENU))
(RETURN (COND
[NAME (COND
(NAME.PLEASE NAME)
(T (CDR (FASSOC NAME NOTEPAD.STYLES]
(T NIL])
(ACQUIRE.SYMMETRY
[LAMBDA (MESSAGE) (* edited: "17-DEC-82 10:36")
(PROG (MENU)
(SETQ MENU (create MENU
TITLE ← MESSAGE
ITEMS ←(QUOTE ((none NIL)
LEFT/RIGHT UP/DOWN 4-FOLD 8-FOLD))
CENTERFLG ← T
CHANGEOFFSETFLG ← T))
(RETURN (MENU MENU])
(ADD.NOTEPAD.TO.BACKGROUND.MENU
[LAMBDA NIL (* DAHJr " 7-APR-83 20:09")
(NOTEPAD.ADD.TO.BACKGROUND.MENU (LIST (QUOTE Notepad)
(QUOTE (NOTEPAD))
"Opens a NOTEPAD window"))
(* don't add the color notepad unless color display is on the machine. But since we can't test for the machine
having a color board, only do it if it is actually on.)
(AND (COLORDISPLAYP)
(NOTEPAD.ADD.TO.BACKGROUND.MENU (LIST (QUOTE Color% Notepad)
(QUOTE (NOTEPAD NIL T))
"Opens a NOTEPAD window for color"])
(BITMAP.INTERIOR
[LAMBDA (BITMAP PT) (* rrb "19-JAN-83 18:53")
(* returns a bitmap which has all 1's at all points that are the same value as PT and touch it or another point of
the same value that touches it.)
(PROG ((WIDTH (BITMAPWIDTH BITMAP))
(HEIGHT (BITMAPHEIGHT BITMAP))
INTERIOR
(X (fetch (POSITION XCOORD) of PT))
(Y (fetch (POSITION YCOORD) of PT))
(NBITS (BITSPERPIXEL BITMAP))
FROMVALUE MAXVAL)
(SETQ MAXVAL (SUB1 (EXPT 2 NBITS)))
(SETQ FROMVALUE (BITMAPBIT BITMAP X Y))
(SETQ INTERIOR (BITMAPCREATE WIDTH HEIGHT NBITS))
(EXTEND.AREA BITMAP INTERIOR X Y (SUB1 WIDTH)
(SUB1 HEIGHT)
FROMVALUE MAXVAL)
(RETURN INTERIOR])
(DELDEF.NOTEPAD.STYLE
[LAMBDA (NAME TYPE) (* DAHJr "26-JAN-83 09:46")
(SETQ NOTEPAD.STYLES (DREMOVE (FASSOC NAME NOTEPAD.STYLES)
NOTEPAD.STYLES])
(DISTANCE
[LAMBDA (P1 P2) (* edited: "18-OCT-82 18:04")
(PROG (DX DY)
(SETQ DX (IDIFFERENCE (fetch (POSITION XCOORD) of P1)
(fetch (POSITION XCOORD) of P2)))
(SETQ DY (IDIFFERENCE (fetch (POSITION YCOORD) of P1)
(fetch (POSITION YCOORD) of P2)))
(RETURN (SQRT (IPLUS (ITIMES DX DX)
(ITIMES DY DY])
(DUMP.NOTEPAD.STYLE
[LAMBDA (NAME) (* DAHJr "26-JAN-83 10:14")
(PROG (NOTEPAD.STYLE)
(SETQ NOTEPAD.STYLE (GETDEF.NOTEPAD.STYLE NAME))
(PRINT (LIST (QUOTE READ.NOTEPAD.STYLE)
NAME NOTEPAD.STYLE.REPRESENTATION.NUMBER))
(HPRINT NOTEPAD.STYLE NIL T)
(RETURN])
(ERASE.REGION
[LAMBDA (WINDOW REGION) (* edited: "13-DEC-82 15:51")
(BITBLT NIL 0 0 WINDOW (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(EXTEND.AREA
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVALUE TOVALUE)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(COND
((TEST.AND.SET DEFINING.BITMAP AREA.BITMAP X Y FROMVALUE TOVALUE)
(EXTEND.AREA.X DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVALUE TOVALUE])
(EXTEND.AREA.X
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVAL TOVAL)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(PROG (LEFT RIGHT)
(SETQ LEFT X)
(for I from (SUB1 X) to 0 by -1 while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP I Y FROMVAL
TOVAL)
do (SETQ LEFT I))
(SETQ RIGHT X)
(for I from (ADD1 X) to MAXX while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP I Y FROMVAL
TOVAL)
do (SETQ RIGHT I))
(for I from LEFT to RIGHT unless (EQ I X)
do (EXTEND.AREA.Y DEFINING.BITMAP AREA.BITMAP I Y MAXX MAXY FROMVAL TOVAL))
(RETURN])
(EXTEND.AREA.Y
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVAL TOVAL)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(PROG (BOTTOM TOP)
(SETQ BOTTOM Y)
(for I from (SUB1 Y) to 0 by -1 while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP X I FROMVAL
TOVAL)
do (SETQ BOTTOM I))
(SETQ TOP Y)
(for I from (ADD1 Y) to MAXY while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP X I FROMVAL
TOVAL)
do (SETQ TOP I))
(for I from BOTTOM to TOP unless (EQ I Y)
do (EXTEND.AREA.X DEFINING.BITMAP AREA.BITMAP X I MAXX MAXY FROMVAL TOVAL))
(RETURN])
(GET.BITMAP
[LAMBDA (CHARACTERISTICS PROP) (* edited: "17-DEC-82 12:43")
(PROG (BITMAPS)
(SETQ BITMAPS (LISTGET CHARACTERISTICS PROP))
(RETURN (COND
((LISTP BITMAPS)
(CAR BITMAPS))
(T BITMAPS])
(GET.NOTEPAD.BITMAP
[LAMBDA (WINDOW) (* edited: "18-OCT-82 10:10")
(DSPDESTINATION NIL (WINDOWPROP WINDOW (QUOTE DSP])
(GET.NOTEPAD.REGION
[LAMBDA (WINDOW) (* rrb "29-JAN-83 14:22")
(PROG (REGION LEFT BOTTOM RIGHT TOP CHARACTERISTICS GRID)
(SETQ REGION (GET.WINDOW.REGION WINDOW))
(SETQ LEFT (fetch (REGION LEFT) of REGION))
(SETQ BOTTOM (fetch (REGION BOTTOM) of REGION))
(SETQ RIGHT (IPLUS LEFT (fetch (REGION WIDTH) of REGION)))
(SETQ TOP (IPLUS BOTTOM (fetch (REGION HEIGHT) of REGION)))
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(COND
[(LISTGET CHARACTERISTICS (QUOTE USE.GRID.TO.DRAW))
(SETQ GRID (LISTGET CHARACTERISTICS (QUOTE GRID.DEFINITION)))
(SETQ LEFT (NOTEPAD.ON.GRID.X LEFT (fetch (REGION LEFT) of GRID)
(fetch (REGION WIDTH) of GRID)))
(SETQ RIGHT (NOTEPAD.ON.GRID.X RIGHT (fetch (REGION LEFT) of GRID)
(fetch (REGION WIDTH) of GRID)))
(SETQ BOTTOM (NOTEPAD.ON.GRID.X BOTTOM (fetch (REGION BOTTOM) of GRID)
(fetch (REGION HEIGHT) of GRID)))
(SETQ TOP (NOTEPAD.ON.GRID.X TOP (fetch (REGION BOTTOM) of GRID)
(fetch (REGION HEIGHT) of GRID)))
(RETURN (create REGION
LEFT ← LEFT
BOTTOM ← BOTTOM
WIDTH ←(IDIFFERENCE RIGHT LEFT)
HEIGHT ←(IDIFFERENCE TOP BOTTOM]
(T (RETURN REGION])
(GET.SYMMETRIC.BITMAPS
[LAMBDA (CHARACTERISTICS PROP) (* edited: "17-DEC-82 15:33")
(PROG (BITMAPS BM1 BM2 BM3 BM4 BM5 BM6 BM7 BM8 NEW.BITMAPS)
(SETQ BITMAPS (LISTGET CHARACTERISTICS PROP))
(RETURN (COND
((LISTP BITMAPS)
BITMAPS)
(T (SETQ BM1 BITMAPS)
(SETQ BM2 (INVERT.BITMAP.HORIZONTALLY BM1))
(SETQ BM3 (INVERT.BITMAP.VERTICALLY BM1))
(SETQ BM4 (INVERT.BITMAP.HORIZONTALLY BM3))
(SETQ BM5 (INVERT.BITMAP.DIAGONALLY BM1))
(SETQ BM6 (INVERT.BITMAP.HORIZONTALLY BM5))
(SETQ BM7 (INVERT.BITMAP.VERTICALLY BM5))
(SETQ BM8 (INVERT.BITMAP.HORIZONTALLY BM7))
(SETQ NEW.BITMAPS (LIST BM1 BM2 BM3 BM4 BM5 BM6 BM7 BM8))
(LISTPUT CHARACTERISTICS PROP NEW.BITMAPS)
NEW.BITMAPS])
(GETDEF.NOTEPAD.STYLE
[LAMBDA (NAME TYPE) (* DAHJr "26-JAN-83 09:44")
(CDR (FASSOC NAME NOTEPAD.STYLES])
(GETPOSITION.RUBBERBAND
[LAMBDA (STARTPOSITION WINDOW) (* rrb "27-DEC-82 16:42")
(* gets the other end of a line via a rubberband
prompting)
(PROG [CHARACTERISTICS GRID X0 GX0 GY0 GDX GDY Y0 DS (COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
(SETQ X0 (fetch (POSITION XCOORD) of STARTPOSITION))
(SETQ Y0 (fetch (POSITION YCOORD) of STARTPOSITION))
[COND
((LISTGET (SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(QUOTE USE.GRID))
(SETQ GRID (LISTGET CHARACTERISTICS (QUOTE GRID.DEFINITION)))
(SETQ GX0 (fetch (REGION LEFT) of GRID))
(SETQ GY0 (fetch (REGION BOTTOM) of GRID))
(SETQ GDX (fetch (REGION WIDTH) of GRID))
(SETQ GDY (fetch (REGION HEIGHT) of GRID]
[SETQ DS (COND
(COLORDS)
(T (WINDOWPROP WINDOW (QUOTE DSP]
(RETURN (COND
(COLORDS (RESETFORM (CHANGECURSORSCREEN (COLORSCREENBITMAP))
(GETPOSITION.RUBBERBAND1 DS X0 Y0 GX0 GY0 GDX GDY)))
(T (GETPOSITION.RUBBERBAND1 DS X0 Y0 GX0 GY0 GDX GDY])
(GETPOSITION.RUBBERBAND1
[LAMBDA (WHERE X0 Y0 GRIDX0 GRIDY0 GRIDDX GRIDDY) (* rrb "27-DEC-82 17:45")
(PROG (X1 Y1 NEW.X1 NEW.Y1 DONE DOWN)
[until DONE
do (GETMOUSESTATE)
(COND
((LASTMOUSESTATE (NOT UP))
(SETQ DOWN T))
((AND X1 DOWN (LASTMOUSESTATE UP))
(SETQ DONE T))
(T (SETQ NEW.X1 (LASTMOUSEX WHERE))
(SETQ NEW.Y1 (LASTMOUSEY WHERE))
[COND
(GRIDX0 (SETQ NEW.X1 (NOTEPAD.ON.GRID.X NEW.X1 GRIDX0 GRIDDX))
(SETQ NEW.Y1 (NOTEPAD.ON.GRID.X NEW.Y1 GRIDY0 GRIDDY]
(COND
((OR (NEQ X1 NEW.X1)
(NEQ Y1 NEW.Y1))
(COND
(X1 (DRAWLINE X0 Y0 X1 Y1 1 (QUOTE INVERT)
WHERE)))
(SETQ X1 NEW.X1)
(SETQ Y1 NEW.Y1)
(DRAWLINE X0 Y0 X1 Y1 1 (QUOTE INVERT)
WHERE]
(DRAWLINE X0 Y0 X1 Y1 1 (QUOTE INVERT)
WHERE)
(RETURN (create POSITION
XCOORD ← X1
YCOORD ← Y1])
(MARK.SPOT
[LAMBDA (X/POSITION Y WINDOW) (* rrb "14-JAN-83 15:40")
(PROG [X WIDTH HEIGHT (COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
(COND
((POSITIONP X/POSITION)
(SETQ X (fetch (POSITION XCOORD) of X/POSITION))
(SETQ Y (fetch (POSITION YCOORD) of X/POSITION)))
(T (SETQ X X/POSITION)))
(SETQ WIDTH (BITMAPWIDTH SPOTMARKER))
(SETQ HEIGHT (BITMAPHEIGHT SPOTMARKER))
(BITBLT (COND
[COLORDS (COND
((AND (BITMAPP COLORSPOTMARKER)
(EQ (BITSPERPIXEL COLORSPOTMARKER)
(COLORNUMBERBITSPERPIXEL)))
COLORSPOTMARKER)
(T (SETQ COLORSPOTMARKER (COLORIZEBITMAP SPOTMARKER 0 (MAXIMUMCOLOR)
(COLORNUMBERBITSPERPIXEL]
(T SPOTMARKER))
0 0 (OR COLORDS WINDOW)
(IDIFFERENCE X (IQUOTIENT WIDTH 2))
(IDIFFERENCE Y (IQUOTIENT HEIGHT 2))
WIDTH HEIGHT (QUOTE INPUT)
(QUOTE INVERT])
(MASKED.BRUSH
[LAMBDA (WINDOW MASK) (* edited: " 5-DEC-82 15:00")
(PROG (BEEN.DOWN DONE POSITION BUFFER.BITMAP LEFT BOTTOM WIDTH HEIGHT NEW.LEFT NEW.BOTTOM BRUSH)
(SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of MASK))
(SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of MASK))
(SETQ BUFFER.BITMAP (BITMAPCREATE WIDTH HEIGHT))
(printout PROMPTWINDOW T "Place mask over desired brush area")
[until DONE
do (GETMOUSESTATE)
(COND
((AND BEEN.DOWN (MOUSESTATE UP)) (* restore bitmap)
[COND
(LEFT (BITBLT BUFFER.BITMAP 0 0 WINDOW LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
(SETQ DONE T))
(T (COND
((MOUSESTATE (NOT UP))
(SETQ BEEN.DOWN T)))
(SETQ NEW.LEFT (LASTMOUSEX WINDOW))
(SETQ NEW.BOTTOM (LASTMOUSEY WINDOW))
(COND
((OR (NEQ NEW.LEFT LEFT)
(NEQ NEW.BOTTOM BOTTOM)) (* restore bitmap)
[COND
(LEFT (BITBLT BUFFER.BITMAP 0 0 WINDOW LEFT BOTTOM WIDTH HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE]
(SETQ LEFT NEW.LEFT)
(SETQ BOTTOM NEW.BOTTOM)
(BITBLT WINDOW LEFT BOTTOM BUFFER.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT MASK 0 0 WINDOW LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
(QUOTE PAINT]
(SETQ BRUSH (BITMAPCOPY BUFFER.BITMAP))
(BITBLT MASK 0 0 BRUSH 0 0 NIL NIL (QUOTE INVERT)
(QUOTE ERASE))
(RETURN BRUSH])
(MOVE.BITMAP
[LAMBDA (WINDOW BITMAP OPERATION) (* rrb "22-DEC-82 11:28")
(PROG [BUFFER.BITMAP WIDTH HEIGHT (COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
(SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
[SETQ BUFFER.BITMAP (BITMAPCREATE WIDTH HEIGHT (COND
(COLORDS (COLORNUMBERBITSPERPIXEL))
(T 1]
(printout PROMPTWINDOW T "Indicate where to copy area to")
(COND
(COLORDS (RESETFORM (CHANGECURSORSCREEN (COLORSCREENBITMAP))
(MOVE.BITMAP1 COLORDS BUFFER.BITMAP WIDTH HEIGHT)))
(T (MOVE.BITMAP1 (WINDOWPROP WINDOW (QUOTE DSP))
BUFFER.BITMAP WIDTH HEIGHT)))
(RETURN])
(MOVE.BITMAP1
[LAMBDA (DS BUFFER.BITMAP WIDTH HEIGHT) (* DAHJr "31-MAY-83 12:16")
(PROG (DONE DOWN LEFT BOTTOM NEW.LEFT NEW.BOTTOM)
(until DONE
do (GETMOUSESTATE)
(COND
((LASTMOUSESTATE (NOT UP))
(SETQ DOWN T)))
(COND
((AND DOWN (LASTMOUSESTATE UP))
(SETQ DONE T))
(T (SETQ NEW.LEFT (LASTMOUSEX DS))
(SETQ NEW.BOTTOM (LASTMOUSEY DS))
(COND
((OR (NEQ NEW.LEFT LEFT)
(NEQ NEW.BOTTOM BOTTOM))
[COND
(LEFT (BITBLT BUFFER.BITMAP 0 0 DS LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
(SETQ LEFT NEW.LEFT)
(SETQ BOTTOM NEW.BOTTOM)
(BITBLT WINDOW LEFT BOTTOM BUFFER.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT BITMAP 0 0 DS LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
OPERATION])
(NOTEPAD
[LAMBDA (BITMAP INCOLORFLG) (* rrb "29-JAN-83 14:30")
(NOTEPAD.CREATE BITMAP (COND
(INCOLORFLG (PROMPTPRINT "Making sure the color functions are loaded...")
(FILESLOAD LLCOLOR COLOR HLCOLOR)
(CLRPROMPT)
(SELECTQ (MACHINETYPE)
(DOLPHIN (* make sure color is on in 4 bit mode)
(COLORDISPLAY T 4)
T)
(DORADO (* make sure color is on)
(COND
((COLORDISPLAYP))
(T
(* used to turn the display on but this hangs the system if the machine doesn't have a color board.
(COLORDISPLAY T (OR (SMALLP INCOLORFLG) 8)))
(PROMPTPRINT
" You will have to turn on the color display before you will see anything. ")))
T)
NIL])
(NOTEPAD.ADD.TO.BACKGROUND.MENU
[LAMBDA (ITEM) (* rrb "22-FEB-83 14:40")
(* adds an item to the background menu.)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(COND
((FASSOC (CAR ITEM)
BackgroundMenuCommands))
(T (SETQ BackgroundMenuCommands (NCONC1 BackgroundMenuCommands ITEM))
(SETQ BackgroundMenu])
(NOTEPAD.BUTTONEVENTFN
[LAMBDA (WINDOW) (* edited: " 4-DEC-82 17:10")
(COND
((INSIDEP (DSPCLIPPINGREGION NIL (WINDOWPROP WINDOW (QUOTE DSP)))
(LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(NOTEPAD.BUTTONFN WINDOW))
(T (NOTEPAD.TITLEBUTTONFN WINDOW])
(NOTEPAD.BUTTONFN
[LAMBDA (WINDOW) (* DAHJr " 4-APR-83 16:06")
(PROG (OPERATION CHARACTERISTICS DSP COMMAND.MENU COMMAND REGION BRUSH NEW.BRUSH FONT MASK
NEW.MASK ORIGIN DX DY USE.GRID USE.MASK SHADE NEW.SHADE P1 P2 P3 POSITION
OLD.BITMAP NEW.BITMAP TEXT NAME OBJECT TEXTWIDTH)
(SETQ OPERATION (NOTEPAD.OPERATION))
(SETQ COMMAND.MENU (NOTEPAD.COMMAND.MENU)) (* USES NOTEPAD.COMMAND.MENU.CREATE)
(SETQ COMMAND (MENU COMMAND.MENU))
(SELECTQ COMMAND
((NIL -- -trajectories- -objects/editing- -styles-)
NIL)
(* -trajectories-)
(SKETCH (NOTEPAD.SKETCH WINDOW OPERATION))
(LINE (NOTEPAD.LINE WINDOW OPERATION))
(CIRCLE (NOTEPAD.CIRCLE WINDOW OPERATION))
(ELLIPSE (NOTEPAD.ELLIPSE WINDOW OPERATION))
(OPEN.CURVE (NOTEPAD.CURVE WINDOW OPERATION))
(CLOSED.CURVE (NOTEPAD.CURVE WINDOW OPERATION T))
(* -objects/editing-)
(TEXT (NOTEPAD.TEXT WINDOW OPERATION))
(EDIT.RECTANGLE (NOTEPAD.EDIT.RECTANGLE WINDOW))
(SHADE.RECTANGLE (NOTEPAD.SHADE.RECTANGLE WINDOW OPERATION))
(FILL (NOTEPAD.FILL WINDOW OPERATION))
(COPY.FROM.SCREEN (NOTEPAD.COPY.FROM.SCREEN WINDOW OPERATION))
(NAMED.OBJECT (NOTEPAD.NAMED.OBJECT WINDOW OPERATION))
(* -styles-)
(DEFINE.BRUSH (NOTEPAD.DEFINE.BRUSH WINDOW))
[EDIT.BRUSH (EVAL.AS.PROCESS (LIST (FUNCTION NOTEPAD.EDIT.BRUSH)
(KWOTE WINDOW]
(BRUSH=COOKIE.CUT.WITH.MASK (NOTEPAD.COOKIE.CUT WINDOW))
(USE.MASK (NOTEPAD.USE.MASK WINDOW))
(DEFINE.MASK (NOTEPAD.DEFINE.MASK WINDOW))
[EDIT.MASK (EVAL.AS.PROCESS (LIST (FUNCTION NOTEPAD.EDIT.MASK)
(KWOTE WINDOW)
(KWOTE WINDOW]
(MASK=OUTLINE.OF.BRUSH (NOTEPAD.MASK=BRUSH.OUTLINE WINDOW))
(DEFINE.FONT (NOTEPAD.DEFINE.FONT WINDOW))
(DEFINE.GRID (NOTEPAD.DEFINE.GRID WINDOW))
(USE.GRID (NOTEPAD.USE.GRID WINDOW))
(USE.SYMMETRY (NOTEPAD.USE.SYMMETRY WINDOW))
(USE.SYMMETRIC.BRUSH/MASK (NOTEPAD.USE.SYMMETRIC.BRUSH/MASK WINDOW))
(DEFINE.POINT.OF.SYMMETRY (NOTEPAD.POINT.OF.SYMMETRY WINDOW))
(EDIT.SHADE (NOTEPAD.EDIT.SHADE WINDOW))
(SAVE.STYLE (SAVE.STYLE WINDOW))
(RESTORE.STYLE (NOTEPAD.RESTORE.STYLE WINDOW))
(DELETE.STYLE (NOTEPAD.DELETE.STYLE WINDOW))
(SHOULDNT (CONCAT "Unrecognized COMMAND in NOTEPAD.BUTTONFN: " COMMAND])
(NOTEPAD.CIRCLE
[LAMBDA (WINDOW OPERATION) (* rrb "14-JAN-83 09:56")
(PROG (CHARACTERISTICS BRUSH P1 P2)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
(printout PROMPTWINDOW T "Indicate center of circle")
(SETQ P1 (NOTEPAD.GETPOSITION WINDOW CIRCLE.CENTER))
(MARK.SPOT P1 NIL WINDOW)
(printout PROMPTWINDOW T "Indicate a point of the circumference of the circle")
(SETQ P2 (NOTEPAD.GETPOSITION WINDOW CIRCLE.EDGE))
(* erase the center pt.)
(MARK.SPOT P1 NIL WINDOW)
(NOTEPAD.SETUP.TO.PAINT WINDOW OPERATION)
(DRAWCIRCLE (fetch (POSITION XCOORD) of P1)
(fetch (POSITION YCOORD) of P1)
(DISTANCE P1 P2)
(QUOTE PAINT.AT.POSSIBLE.POINT)
NIL WINDOW])
(NOTEPAD.COMMAND.MENU
[LAMBDA NIL (* edited: " 6-DEC-82 21:07")
(COND
(NOTEPAD.COMMAND.MENU)
(T (SETQ NOTEPAD.COMMAND.MENU (NOTEPAD.COMMAND.MENU.CREATE])
(NOTEPAD.COMMAND.MENU.CREATE
[LAMBDA NIL (* edited: "18-DEC-82 08:50")
(PROG (OPERATIONS STYLES) (* AFTER EDITING RESET WITH:
(SETQ NOTEPAD.COMMAND.MENU))
(SETQ OPERATIONS
(QUOTE (-trajectories- SKETCH LINE CIRCLE ELLIPSE OPEN.CURVE CLOSED.CURVE
-objects/editing- TEXT NAMED.OBJECT COPY.FROM.SCREEN
SHADE.RECTANGLE FILL EDIT.RECTANGLE -- -- -- -- --)))
(SETQ STYLES
(QUOTE (-styles- DEFINE.BRUSH EDIT.BRUSH BRUSH=COOKIE.CUT.WITH.MASK USE.MASK DEFINE.MASK
EDIT.MASK MASK=OUTLINE.OF.BRUSH USE.GRID DEFINE.GRID USE.SYMMETRY
DEFINE.POINT.OF.SYMMETRY USE.SYMMETRIC.BRUSH/MASK EDIT.SHADE DEFINE.FONT
-- SAVE.STYLE RESTORE.STYLE DELETE.STYLE)))
(RETURN (create MENU
TITLE ← "Adding and editing"
MENUCOLUMNS ← 2
ITEMS ←(for OPERATION in OPERATIONS as STYLE in STYLES
join (LIST OPERATION STYLE))
CHANGEOFFSETFLG ← T])
(NOTEPAD.COOKIE.CUT
[LAMBDA (WINDOW) (* edited: "17-DEC-82 16:15")
(PROG (CHARACTERISTICS NEW.BRUSH)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ MASK (GET.BITMAP CHARACTERISTICS (QUOTE MASK.DEFINITION)))
(SETQ NEW.BRUSH (MASKED.BRUSH WINDOW MASK))
(LISTPUT CHARACTERISTICS (QUOTE BRUSH.DEFINITION)
NEW.BRUSH)
(printout PROMPTWINDOW T "Brush defined"])
(NOTEPAD.COPY.FROM.SCREEN
[LAMBDA (WINDOW OPERATION) (* rrb " 4-JAN-83 17:00")
(PROG (REGION NEW.BITMAP)
(printout PROMPTWINDOW T "Indicate a region of the screen to be copied")
[SETQ NEW.BITMAP (COND
((WINDOWPROP WINDOW (QUOTE INCOLOR))
(PICKUP.SCREEN.BITMAP (GETCOLORREGION)
(COLORSCREENBITMAP)))
(T (PICKUP.SCREEN.BITMAP (GETREGION)
(SCREENBITMAP]
(RETURN (MOVE.BITMAP WINDOW NEW.BITMAP OPERATION])
(NOTEPAD.CURVE
[LAMBDA (WINDOW OPERATION CLOSED) (* DAHJr " 4-APR-83 16:53")
(PROG (CHARACTERISTICS BRUSH REGION P1 P2 PTS DONE)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
[SETQ REGION (DSPCLIPPINGREGION NIL (COND
((WINDOWPROP WINDOW (QUOTE INCOLOR)))
(T (WINDOWPROP WINDOW (QUOTE DSP]
(printout PROMPTWINDOW T "Indicate first point of curve")
(SETQ P1 (NOTEPAD.GETPOSITION WINDOW CURVE.KNOT))
(MARK.SPOT P1 NIL WINDOW)
(printout PROMPTWINDOW " (indicate last point by holding down left shift key)")
(printout PROMPTWINDOW ", point 2")
(SETQ P2 (NOTEPAD.GETPOSITION WINDOW CURVE.KNOT))
(SETQ DONE (KEYDOWNP (QUOTE LSHIFT)))
(MARK.SPOT P2 NIL WINDOW)
(SETQ PTS (LIST P1 P2))
(until DONE as I from 3
do (printout PROMPTWINDOW ", " I)
(SETQ P2 (NOTEPAD.GETPOSITION WINDOW CURVE.KNOT))
(SETQ DONE (KEYDOWNP (QUOTE LSHIFT)))
(NCONC1 PTS P2)
(MARK.SPOT P2 NIL WINDOW))
(for PT in PTS do (MARK.SPOT PT NIL WINDOW))
(NOTEPAD.SETUP.TO.PAINT WINDOW OPERATION)
(DRAWCURVE PTS CLOSED (QUOTE PAINT.AT.POSSIBLE.POINT)
NIL WINDOW])
(NOTEPAD.DEFINE.BRUSH
[LAMBDA (WINDOW) (* rrb "20-DEC-82 15:30")
(PROG (CHARACTERISTICS BRUSH)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(printout PROMPTWINDOW T "Indicate a region to be used as the brush")
[SETQ BRUSH (COND
((WINDOWPROP WINDOW (QUOTE INCOLOR))
(PICKUP.SCREEN.BITMAP (GETCOLORREGION)
(COLORSCREENBITMAP)))
(T (PICKUP.SCREEN.BITMAP (GETREGION)
(SCREENBITMAP]
(LISTPUT CHARACTERISTICS (QUOTE BRUSH.DEFINITION)
BRUSH)
(printout PROMPTWINDOW T "Brush defined"])
(NOTEPAD.DEFINE.FONT
[LAMBDA (WINDOW) (* DAHJr " 7-APR-83 20:13")
(PROG (CHARACTERISTICS FONT)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ FONT (NOTEPAD.READ.FONT))
(COND
(FONT (LISTPUT CHARACTERISTICS (QUOTE PRINTING.FONT.DEFINITION)
FONT)))
(printout PROMPTWINDOW T "Font defined to be " FONT])
(NOTEPAD.HELP
[LAMBDA NIL (* DAHJr " 4-APR-83 16:01")
(CLEARW PROMPTWINDOW)
(printout PROMPTWINDOW "NOTEPAD is menu-driven")
(printout PROMPTWINDOW T "Selection: ")
(printout PROMPTWINDOW T 3 "In the title bar: commands affecting the whole")
(printout PROMPTWINDOW T 3 "Within the window:")
(printout PROMPTWINDOW T 6 "Using Left button:" " => paint")
(printout PROMPTWINDOW T 6 "Using Middle button:" " => erase")
(printout PROMPTWINDOW T 6 "Using Right button:" " window commands"])
(NOTEPAD.READ.FONT
[LAMBDA NIL (* DAHJr "31-MAY-83 12:12")
(PROG (LOADED.FONTS COMMAND.MENU COMMAND REGION BRUSH NEW.FONT)
(SETQ LOADED.FONTS (NOTEPAD.FONTS.IN.CORE))
[SETQ COMMAND.MENU (create MENU
TITLE ← "Style"
ITEMS ←(NCONC1 (for FONT in LOADED.FONTS
collect (LIST FONT (KWOTE FONT)))
(QUOTE NEW.FONT]
(SETQ COMMAND (MENU COMMAND.MENU))
(RETURN (SELECTQ COMMAND
(NIL NIL)
(NEW.FONT (SETQ NEW.FONT (READ.FROM.PROMPT.WINDOW
"New font (FAMILY SIZE FACE):"))
(printout PROMPTWINDOW T "Reading font " NEW.FONT " ... ")
(FONTCREATE NEW.FONT)
(printout PROMPTWINDOW "done")
NEW.FONT)
COMMAND])
(NOTEPAD.FONTS.IN.CORE
[LAMBDA NIL (* edited: " 4-DEC-82 15:28")
(for FAMILY in \FONTSINCORE join (for SIZE in (CDR FAMILY)
join (for FACE in (CDR SIZE)
when (EQ (CAR (CADR (CADR FACE)))
(QUOTE DISPLAY))
collect (LIST (CAR FAMILY)
(CAR SIZE)
(CAR FACE])
(READ.NOTEPAD.STYLE
[NLAMBDA (NAME VERSION) (* DAHJr "26-JAN-83 10:17")
(PROG (NOTEPAD.STYLE)
(SELECTQ VERSION
(1 (* 1: HPRINTED PROPERTY LIST)
(SETQ NOTEPAD.STYLE (HREAD)))
(SHOULDNT "Unrecognized version number in READ.NOTEPAD.STYLE"))
(PUTDEF.NOTEPAD.STYLE NAME (QUOTE NOTEPAD.STYLES)
NOTEPAD.STYLE)
(RETURN])
(NOTEPAD.DEFINE.GRID
[LAMBDA (WINDOW) (* rrb "27-DEC-82 16:21")
(PROG [(COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
[LISTPUT (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS))
(QUOTE GRID.DEFINITION)
(COND
(COLORDS (RESETFORM (CHANGECURSORSCREEN (COLORSCREENBITMAP))
(NOTEPAD.DEFINE.GRID1 COLORDS)))
(T (NOTEPAD.DEFINE.GRID1 WINDOW]
(printout PROMPTWINDOW T "Grid defined"])
(NOTEPAD.DEFINE.GRID1
[LAMBDA (WHERE) (* rrb "22-FEB-83 14:47")
(* prompts for two points and returns a REGION that
defines a grid.)
(PROG (ORIGIN P1)
(printout PROMPTWINDOW T "Indicate an origin for the grid")
(SETQ ORIGIN (NOTEPAD.GETPOSITION WHERE NIL T))
(MARK.SPOT ORIGIN NIL WHERE)
(printout PROMPTWINDOW T "Indicate (1, 1) on the grid")
(SETQ P1 (NOTEPAD.GETPOSITION WHERE NIL T))
(MARK.SPOT ORIGIN NIL WHERE)
(RETURN (create REGION
LEFT ←(fetch (POSITION XCOORD) of ORIGIN)
BOTTOM ←(fetch (POSITION YCOORD) of ORIGIN)
WIDTH ←[MAX 1 (ABS (IDIFFERENCE (fetch (POSITION XCOORD) of P1)
(fetch (POSITION XCOORD) of ORIGIN]
HEIGHT ←(MAX 1 (ABS (IDIFFERENCE (fetch (POSITION YCOORD) of P1)
(fetch (POSITION YCOORD) of ORIGIN])
(NOTEPAD.DEFINE.MASK
[LAMBDA (WINDOW) (* rrb "21-DEC-82 15:26")
(PROG (CHARACTERISTICS MASK)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(printout PROMPTWINDOW T "Indicate a region to be used as the brush")
[SETQ MASK (COND
((WINDOWPROP WINDOW (QUOTE INCOLOR))
(PICKUP.SCREEN.BITMAP (GETCOLORREGION)
(COLORSCREENBITMAP)))
(T (PICKUP.SCREEN.BITMAP (GETREGION)
(SCREENBITMAP]
(LISTPUT CHARACTERISTICS (QUOTE MASK.DEFINITION)
MASK)
(printout PROMPTWINDOW T "Brush defined"])
(NOTEPAD.DELETE.STYLE
[LAMBDA (WINDOW) (* DAHJr "26-JAN-83 14:27")
(PROG (BITS.PER.PIXEL NAME NEW.STYLES)
(SETQ BITS.PER.PIXEL (LISTGET (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS))
(QUOTE BITS.PER.PIXEL)))
(COND
[NOTEPAD.STYLES (SETQ NAME (ACQUIRE.STYLE BITS.PER.PIXEL T))
(COND
((AND NAME (NOTEPAD.CONFIRM (CONCAT "Delete style " NAME)))
(DELDEF.NOTEPAD.STYLE NAME)
(printout PROMPTWINDOW T "Style " NAME " deleted"]
(T (printout PROMPTWINDOW T "No styles to delete"])
(NOTEPAD.EDIT.BRUSH
[LAMBDA (WINDOW) (* DAHJr " 4-APR-83 16:44")
(PROG (CHARACTERISTICS BRUSH NEW.BRUSH)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
(SETQ NEW.BRUSH (EDIT.BITMAP BRUSH))
(LISTPUT CHARACTERISTICS (QUOTE BRUSH.DEFINITION)
NEW.BRUSH)
(printout PROMPTWINDOW T "Brush defined"])
(NOTEPAD.EDIT.MASK
[LAMBDA (WINDOW WINDOW) (* edited: "17-DEC-82 12:43")
(PROG (CHARACTERISTICS MASK NEW.MASK)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ MASK (GET.BITMAP CHARACTERISTICS (QUOTE MASK.DEFINITION)))
(SETQ NEW.MASK (EDIT.BITMAP MASK))
(LISTPUT CHARACTERISTICS (QUOTE MASK.DEFINITION)
NEW.MASK)
(printout PROMPTWINDOW T "Mask defined"])
(NOTEPAD.EDIT.RECTANGLE
[LAMBDA (WINDOW) (* rrb "11-AUG-83 12:24")
(PROG (REGION OLD.BITMAP NEW.BITMAP ALLINFLG)
(printout PROMPTWINDOW T "Indicate a rectangle to be edited")
(SETQ REGION (GET.NOTEPAD.REGION WINDOW))
[COND
((SUBREGIONP (DSPCLIPPINGREGION NIL WINDOW)
REGION) (* region is entirely within window)
(SETQ ALLINFLG T)
(SETQ OLD.BITMAP (PICKUP.BITMAP WINDOW REGION)))
(T (* region is at least partially outside of window
Translate the region into screen coordinates)
(SETQ OLD.BITMAP (PICKUP.BITMAP NIL (CREATEREGION (IPLUS (fetch (REGION LEFT)
of REGION)
(DSPXOFFSET NIL WINDOW))
(IPLUS (fetch (REGION BOTTOM)
of REGION)
(DSPYOFFSET NIL WINDOW))
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION]
(SETQ NEW.BITMAP (EDIT.BITMAP OLD.BITMAP))
(COND
((AND ALLINFLG (EQP (fetch (BITMAP BITMAPWIDTH) of OLD.BITMAP)
(fetch (BITMAP BITMAPWIDTH) of NEW.BITMAP))
(EQP (fetch (BITMAP BITMAPHEIGHT) of OLD.BITMAP)
(fetch (BITMAP BITMAPHEIGHT) of NEW.BITMAP)))
(ERASE.REGION WINDOW REGION)
(PUTBACK.BITMAP WINDOW REGION NEW.BITMAP))
(T (MOVE.BITMAP WINDOW NEW.BITMAP OPERATION])
(NOTEPAD.EDIT.SHADE
[LAMBDA (WINDOW) (* DAHJr " 4-APR-83 16:44")
(PROG (CHARACTERISTICS SHADE NEW.SHADE COLORDS)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ SHADE (LISTGET CHARACTERISTICS (QUOTE SHADE.DEFINITION)))
[COND
((SETQ COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR)))
(SETQ NEW.SHADE (RNUMBER)) (* set the color of the display stream although it
doesn't appear to make any difference it seems like it
should.)
(DSPCOLOR NEW.SHADE COLORDS))
(T (SETQ NEW.SHADE (EDITSHADE SHADE]
(LISTPUT CHARACTERISTICS (QUOTE SHADE.DEFINITION)
NEW.SHADE)
(printout PROMPTWINDOW T "Shade redefined"])
(NOTEPAD.ELLIPSE
[LAMBDA (WINDOW OPERATION) (* rrb "14-JAN-83 09:57")
(PROG (CHARACTERISTICS BRUSH P1 P2 P3 ANGLE)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
(printout PROMPTWINDOW T "Indicate center of ellipse")
(SETQ P1 (NOTEPAD.GETPOSITION WINDOW ELLIPSE.CENTER))
(MARK.SPOT P1 NIL WINDOW)
(printout PROMPTWINDOW T "Indicate semi-major axis")
(SETQ P2 (NOTEPAD.GETPOSITION WINDOW ELLIPSE.SEMI.MAJOR))
(MARK.SPOT P2 NIL WINDOW)
(printout PROMPTWINDOW T "Indicate semi-minor axis")
(SETQ P3 (NOTEPAD.GETPOSITION WINDOW ELLIPSE.SEMI.MINOR))
(MARK.SPOT P2 NIL WINDOW)
(MARK.SPOT P1 NIL WINDOW)
(SETQ ANGLE (DIFFERENCE (ATAN (IDIFFERENCE (fetch (POSITION XCOORD) of P2)
(fetch (POSITION XCOORD) of P1))
(IDIFFERENCE (fetch (POSITION YCOORD) of P2)
(fetch (POSITION YCOORD) of P1)))
90))
(NOTEPAD.SETUP.TO.PAINT WINDOW OPERATION)
(DRAWELLIPSE (fetch (POSITION XCOORD) of P1)
(fetch (POSITION YCOORD) of P1)
(DISTANCE P1 P2)
(DISTANCE P1 P3)
ANGLE
(QUOTE PAINT.AT.POSSIBLE.POINT)
NIL WINDOW])
(NOTEPAD.LINE
[LAMBDA (WINDOW OPERATION) (* rrb "14-JAN-83 09:57")
(PROG (CHARACTERISTICS BRUSH P1 P2)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
(printout PROMPTWINDOW T "Indicate start point for the line")
(SETQ P1 (NOTEPAD.GETPOSITION WINDOW))
(printout PROMPTWINDOW T "Indicate end point for the line")
(SETQ P2 (GETPOSITION.RUBBERBAND P1 WINDOW))
(NOTEPAD.SETUP.TO.PAINT WINDOW OPERATION)
(DRAWCURVE (LIST P1 P2)
NIL
(QUOTE PAINT.AT.POSSIBLE.POINT)
NIL WINDOW])
(NOTEPAD.MASK=BRUSH.OUTLINE
[LAMBDA (WINDOW) (* edited: "17-DEC-82 16:15")
(PROG (CHARACTERISTICS NEW.MASK)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
(SETQ NEW.MASK (BITMAP.EXTERIOR BRUSH))
(BITBLT NIL 0 0 NEW.MASK 0 0 NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(LISTPUT CHARACTERISTICS (QUOTE MASK.DEFINITION)
NEW.MASK)
(printout PROMPTWINDOW T "Mask defined to an outline of the brush"])
(NOTEPAD.NAMED.OBJECT
[LAMBDA (WINDOW OPERATION) (* DAHJr "23-OCT-83 12:13")
(PROG (NAME OBJECT NEW.BITMAP)
(SETQ NAME (READ.FROM.PROMPT.WINDOW
"Lisp expression to EVAL to get object to add to window: "))
(SETQ OBJECT (EVALV NAME))
(COND
((BITMAPP OBJECT)
(SETQ NEW.BITMAP OBJECT)
(MOVE.BITMAP WINDOW NEW.BITMAP OPERATION))
((CURSORP OBJECT)
(SETQ NEW.BITMAP (fetch (CURSOR CURSORBITMAP) of OBJECT))
(MOVE.BITMAP WINDOW NEW.BITMAP OPERATION))
(T (printout PROMPTWINDOW T "Not a bitmap" OBJECT])
(NOTEPAD.POINT.OF.SYMMETRY
[LAMBDA (WINDOW) (* rrb "22-FEB-83 14:47")
(PROG (CHARACTERISTICS ORIGIN)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(printout PROMPTWINDOW T "Indicate the point of symmetry")
(SETQ ORIGIN (NOTEPAD.GETPOSITION WINDOW))
(LISTPUT CHARACTERISTICS (QUOTE POINT.OF.SYMMETRY.DEFINITION)
ORIGIN)
(printout PROMPTWINDOW T "Point of symmetry defined"])
(NOTEPAD.RESTORE.STYLE
[LAMBDA (WINDOW) (* DAHJr "26-JAN-83 14:05")
(PROG (BITS.PER.PIXEL NEW.CHARACTERISTICS)
(SETQ BITS.PER.PIXEL (LISTGET (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS))
(QUOTE BITS.PER.PIXEL)))
(COND
[NOTEPAD.STYLES (SETQ NEW.CHARACTERISTICS (ACQUIRE.STYLE BITS.PER.PIXEL))
(COND
(NEW.CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)
(COPYALL NEW.CHARACTERISTICS))
(printout PROMPTWINDOW T "Style restored"]
(T (printout PROMPTWINDOW T "No styles to restore"])
(NOTEPAD.SETUP.TO.PAINT
[LAMBDA (WINDOW OPERATION) (* rrb "27-DEC-82 16:56")
(PROG (CHARACTERISTICS GRID POINT.OF.SYMMETRY BITMAPS BRUSH MASK)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(* if WINDOW is onto the color screen, its INCOLOR
property is a color display stream)
(SETQ .NOTEPAD.WINDOW (COND
((WINDOWPROP WINDOW (QUOTE INCOLOR)))
(T WINDOW)))
(SETQ .NOTEPAD.OPERATION OPERATION)
(SETQ .NOTEPAD.USE.SYMMETRIC.BRUSH/MASK (LISTGET CHARACTERISTICS (QUOTE
USE.SYMMETRIC.BRUSH/MASK)))
(COND
[.NOTEPAD.USE.SYMMETRIC.BRUSH/MASK (SETQ BITMAPS (GET.SYMMETRIC.BITMAPS CHARACTERISTICS
(QUOTE
BRUSH.DEFINITION)))
(SETQ .NOTEPAD.BRUSH.1 (CAR BITMAPS))
(SETQ .NOTEPAD.BRUSH.2 (CADR BITMAPS))
(SETQ .NOTEPAD.BRUSH.3 (CADDR BITMAPS))
(SETQ .NOTEPAD.BRUSH.4 (CADDDR BITMAPS))
(SETQ .NOTEPAD.BRUSH.5 (CAR (CDDDDR BITMAPS)))
(SETQ .NOTEPAD.BRUSH.6 (CADR (CDDDDR BITMAPS)))
(SETQ .NOTEPAD.BRUSH.7 (CADDR (CDDDDR BITMAPS)))
(SETQ .NOTEPAD.BRUSH.8 (CADDDR (CDDDDR BITMAPS]
(T (SETQ BRUSH (GET.BITMAP CHARACTERISTICS (QUOTE BRUSH.DEFINITION)))
(SETQ .NOTEPAD.BRUSH.1 BRUSH)
(SETQ .NOTEPAD.BRUSH.2 BRUSH)
(SETQ .NOTEPAD.BRUSH.3 BRUSH)
(SETQ .NOTEPAD.BRUSH.4 BRUSH)
(SETQ .NOTEPAD.BRUSH.5 BRUSH)
(SETQ .NOTEPAD.BRUSH.6 BRUSH)
(SETQ .NOTEPAD.BRUSH.7 BRUSH)
(SETQ .NOTEPAD.BRUSH.8 BRUSH)))
(SETQ .NOTEPAD.BRUSH.WIDTH (BITMAPWIDTH .NOTEPAD.BRUSH.1))
(SETQ .NOTEPAD.BRUSH.HEIGHT (BITMAPHEIGHT .NOTEPAD.BRUSH.1))
(SETQ .NOTEPAD.BRUSH.HALF.WIDTH (RSH .NOTEPAD.BRUSH.WIDTH 1))
(SETQ .NOTEPAD.BRUSH.HALF.HEIGHT (RSH .NOTEPAD.BRUSH.HEIGHT 1))
(SETQ .NOTEPAD.USE.GRID (LISTGET CHARACTERISTICS (QUOTE USE.GRID.TO.DRAW)))
[COND
(.NOTEPAD.USE.GRID (SETQ GRID (LISTGET CHARACTERISTICS (QUOTE GRID.DEFINITION)))
(SETQ .NOTEPAD.GRID.X0 (fetch (REGION LEFT) of GRID))
(SETQ .NOTEPAD.GRID.Y0 (fetch (REGION BOTTOM) of GRID))
(SETQ .NOTEPAD.GRID.DX (fetch (REGION WIDTH) of GRID))
(SETQ .NOTEPAD.GRID.DY (fetch (REGION HEIGHT) of GRID]
(SETQ .NOTEPAD.USE.MASK (LISTGET CHARACTERISTICS (QUOTE USE.MASK)))
[COND
(.NOTEPAD.USE.MASK (COND
[.NOTEPAD.USE.SYMMETRIC.BRUSH/MASK (SETQ BITMAPS
(GET.SYMMETRIC.BITMAPS
CHARACTERISTICS
(QUOTE MASK.DEFINITION)))
(SETQ .NOTEPAD.MASK.1
(CAR BITMAPS))
(SETQ .NOTEPAD.MASK.2
(CADR BITMAPS))
(SETQ .NOTEPAD.MASK.3
(CADDR BITMAPS))
(SETQ .NOTEPAD.MASK.4
(CADDDR BITMAPS))
(SETQ .NOTEPAD.MASK.5
(CAR (CDDDDR BITMAPS)))
(SETQ .NOTEPAD.MASK.6
(CADR (CDDDDR BITMAPS)))
(SETQ .NOTEPAD.MASK.7
(CADDR (CDDDDR BITMAPS)))
(SETQ .NOTEPAD.MASK.8
(CADDDR (CDDDDR BITMAPS]
(T (SETQ MASK (GET.BITMAP CHARACTERISTICS (QUOTE MASK.DEFINITION)))
(SETQ .NOTEPAD.MASK.1 MASK)
(SETQ .NOTEPAD.MASK.2 MASK)
(SETQ .NOTEPAD.MASK.3 MASK)
(SETQ .NOTEPAD.MASK.4 MASK)
(SETQ .NOTEPAD.MASK.5 MASK)
(SETQ .NOTEPAD.MASK.6 MASK)
(SETQ .NOTEPAD.MASK.7 MASK)
(SETQ .NOTEPAD.MASK.8 MASK)))
(SETQ .NOTEPAD.MASK.WIDTH (BITMAPWIDTH .NOTEPAD.MASK.1))
(SETQ .NOTEPAD.MASK.HEIGHT (BITMAPHEIGHT .NOTEPAD.MASK.1))
(SETQ .NOTEPAD.MASK.HALF.WIDTH (RSH .NOTEPAD.MASK.WIDTH 1))
(SETQ .NOTEPAD.MASK.HALF.HEIGHT (RSH .NOTEPAD.MASK.HEIGHT 1))
(SETQ .NOTEPAD.INVERSE.OPERATION (COND
((EQ OPERATION (QUOTE PAINT))
(QUOTE ERASE))
(T (QUOTE PAINT]
(SETQ .NOTEPAD.USE.SYMMETRY (LISTGET CHARACTERISTICS (QUOTE USE.SYMMETRY)))
[COND
(.NOTEPAD.USE.SYMMETRY (SETQ POINT.OF.SYMMETRY (LISTGET CHARACTERISTICS (QUOTE
POINT.OF.SYMMETRY.DEFINITION)))
(SETQ .NOTEPAD.POSX (fetch (POSITION XCOORD) of POINT.OF.SYMMETRY))
(SETQ .NOTEPAD.POSY (fetch (POSITION YCOORD) of POINT.OF.SYMMETRY]
(SETQ .NOTEPAD.PREVIOUS.MIDX)
(SETQ .NOTEPAD.PREVIOUS.MIDY])
(NOTEPAD.SHADE.RECTANGLE
[LAMBDA (WINDOW OPERATION) (* rrb "20-DEC-82 15:03")
(PROG (CHARACTERISTICS REGION)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(printout PROMPTWINDOW T "Indicate rectangle to be PAINTED/ERASED with SHADE")
(SETQ REGION (GET.NOTEPAD.REGION WINDOW))
(BITBLT NIL 0 0 (OR (WINDOWPROP WINDOW (QUOTE INCOLOR))
WINDOW)
(fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
(QUOTE TEXTURE)
(COND
((WINDOWPROP WINDOW (QUOTE INCOLOR))
(SELECTQ OPERATION
(PAINT (QUOTE REPLACE))
OPERATION))
(T OPERATION))
(LISTGET CHARACTERISTICS (QUOTE SHADE.DEFINITION])
(NOTEPAD.SKETCH
[LAMBDA (WINDOW OPERATION) (* rrb "27-DEC-82 15:43")
(PROG [BRUSH (COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
(SETQ BRUSH (GET.BITMAP (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS))
(QUOTE BRUSH.DEFINITION)))
(NOTEPAD.SETUP.TO.PAINT WINDOW OPERATION)
(COND
[COLORDS (RESETFORM (CHANGECURSORSCREEN (COLORSCREENBITMAP))
(RESETFORM (SETDISPLAYHEIGHT 8)
(NOTEPAD.SKETCH1 COLORDS (BITMAPCREATE
.NOTEPAD.BRUSH.WIDTH
.NOTEPAD.BRUSH.HEIGHT
(
COLORNUMBERBITSPERPIXEL))
BRUSH]
(T (NOTEPAD.SKETCH1 (WINDOWPROP WINDOW (QUOTE DSP))
(BITMAPCREATE .NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT)
BRUSH)))
(RETURN])
(NOTEPAD.SKETCH1
[LAMBDA (DS BUFFER.BITMAP BRUSH) (* rrb "22-DEC-82 11:36")
(PROG (DOWN DONE MIDX MIDY NEW.MIDX NEW.MIDY)
(until DONE
do (GETMOUSESTATE)
(COND
((LASTMOUSESTATE (NOT UP))
(SETQ DOWN T)))
(COND
((AND DOWN (LASTMOUSESTATE UP)) (* RESTORE BITMAP)
[COND
(MIDX (BITBLT BUFFER.BITMAP 0 0 DS (IDIFFERENCE MIDX .NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
(SETQ DONE T))
(T (SETQ NEW.MIDX (LASTMOUSEX DS))
(SETQ NEW.MIDY (LASTMOUSEY DS))
(COND
((OR (NEQ NEW.MIDX MIDX)
(NEQ NEW.MIDY MIDY)
(LASTMOUSESTATE (NOT UP))) (* RESTORE BITMAP)
[COND
(MIDX (BITBLT BUFFER.BITMAP 0 0 DS (IDIFFERENCE MIDX
.NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
(SETQ MIDX NEW.MIDX)
(SETQ MIDY NEW.MIDY)
(COND
((LASTMOUSESTATE (NOT UP))
(PAINT.AT.POSSIBLE.POINT MIDX MIDY)))
(BITBLT DS (IDIFFERENCE MIDX .NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
BUFFER.BITMAP 0 0 .NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT BRUSH 0 0 DS (IDIFFERENCE MIDX .NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT (QUOTE INPUT)
(QUOTE PAINT])
(NOTEPAD.TEXT
[LAMBDA (WINDOW OPERATION) (* rrb " 4-JAN-83 16:45")
(PROG [CHARACTERISTICS TEXT FONT TEXTWIDTH NEW.BITMAP DSP (COLORDS (WINDOWPROP WINDOW
(QUOTE INCOLOR]
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ TEXT (READ.FROM.PROMPT.WINDOW "Text to be printed: "))
[SETQ FONT (FONTCREATE (LISTGET CHARACTERISTICS (QUOTE PRINTING.FONT.DEFINITION]
(SETQ TEXTWIDTH (STRINGWIDTH TEXT FONT))
[SETQ NEW.BITMAP (BITMAPCREATE TEXTWIDTH (FONTHEIGHT FONT)
(COND
(COLORDS (COLORNUMBERBITSPERPIXEL))
(T 1]
(SETQ DSP (DSPCREATE NEW.BITMAP))
(DSPFONT FONT DSP)
(AND COLORDS (DSPCOLOR (LISTGET CHARACTERISTICS (QUOTE SHADE.DEFINITION))
DSP))
(MOVETO 0 (FONTDESCENT FONT)
DSP)
(PRIN3 TEXT DSP)
(MOVE.BITMAP WINDOW NEW.BITMAP OPERATION])
(NOTEPAD.USE.GRID
[LAMBDA (WINDOW) (* rrb "27-DEC-82 16:53")
(PROG (CHARACTERISTICS USE.GRID USE.GRID.TO.DRAW)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SELECTQ [MENU (COND
((type? MENU NOTEPAD.USE.GRID.MENU)
NOTEPAD.USE.GRID.MENU)
(T (SETQ NOTEPAD.USE.GRID.MENU (create MENU
ITEMS ←(QUOTE
((No% Grid (QUOTE NOGRID)
"no grid will be used")
(When% specifying (QUOTE
SPECIFY)
"the grid will be used when specifying points on the notepad.")
(When% drawing (QUOTE DRAW)
"the grid will be used as points are layed down in the trajectories.")
(Both (QUOTE BOTH)
"The grid will be used to specify points and when drawing trajectories."]
(NOGRID (SETQ USE.GRID NIL)
(SETQ USE.GRID.TO.DRAW NIL))
(SPECIFY (SETQ USE.GRID T)
(SETQ USE.GRID.TO.DRAW NIL))
(DRAW (SETQ USE.GRID NIL)
(SETQ USE.GRID.TO.DRAW T))
(BOTH (SETQ USE.GRID T)
(SETQ USE.GRID.TO.DRAW T))
(RETURN))
(LISTPUT CHARACTERISTICS (QUOTE USE.GRID)
USE.GRID)
(LISTPUT CHARACTERISTICS (QUOTE USE.GRID.TO.DRAW)
USE.GRID.TO.DRAW)
(printout PROMPTWINDOW T "Grid is now " (COND
(USE.GRID (COND
(USE.GRID.TO.DRAW "in use when drawing and specifying.")
(T "in use when specifying points.")))
(T (COND
(USE.GRID.TO.DRAW "in use when drawing.")
(T "not in use"])
(NOTEPAD.USE.MASK
[LAMBDA (WINDOW) (* edited: "17-DEC-82 10:05")
(PROG (CHARACTERISTICS USE.MASK)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
[SETQ USE.MASK (NOT (LISTGET CHARACTERISTICS (QUOTE USE.MASK]
(LISTPUT CHARACTERISTICS (QUOTE USE.MASK)
USE.MASK)
(printout PROMPTWINDOW T "Mask is now " (COND
(USE.MASK "in use")
(T "not in use"])
(NOTEPAD.USE.SYMMETRIC.BRUSH/MASK
[LAMBDA (WINDOW) (* edited: "17-DEC-82 12:04")
(PROG (CHARACTERISTICS USE.SYMMETRIC.BRUSH/MASK)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
[SETQ USE.SYMMETRIC.BRUSH/MASK (NOT (LISTGET CHARACTERISTICS (QUOTE
USE.SYMMETRIC.BRUSH/MASK]
(LISTPUT CHARACTERISTICS (QUOTE USE.SYMMETRIC.BRUSH/MASK)
USE.SYMMETRIC.BRUSH/MASK)
(printout PROMPTWINDOW T "Symmetric brush and mask are now " (COND
(USE.SYMMETRIC.BRUSH/MASK "in use")
(T "not in use"])
(NOTEPAD.USE.SYMMETRY
[LAMBDA (WINDOW) (* edited: "17-DEC-82 10:36")
(PROG (CHARACTERISTICS USE.SYMMETRY)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ USE.SYMMETRY (ACQUIRE.SYMMETRY))
(LISTPUT CHARACTERISTICS (QUOTE USE.SYMMETRY)
USE.SYMMETRY)
(printout PROMPTWINDOW T "Symmetry is now " (SELECTQ USE.SYMMETRY
(NIL "not in use")
USE.SYMMETRY])
(NOTEPAD.FILL
[LAMBDA (WINDOW OPERATION) (* DAHJr " 7-APR-83 18:23")
(PROG [CHARACTERISTICS BITMAP REGION PT INTERIOR LEFT BOTTOM (COLORDS (WINDOWPROP WINDOW
(QUOTE INCOLOR]
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
LP (printout PROMPTWINDOW T "Indicate an exterior box for the filling.")
[SETQ BITMAP (COND
[COLORDS (PICKUP.BITMAP COLORDS (SETQ REGION (GETCOLORREGION]
(T [SETQ REGION (INTERSECTREGIONS (GET.WINDOW.REGION WINDOW)
(DSPCLIPPINGREGION NIL (WINDOWPROP WINDOW
(QUOTE DSP]
(COND
(REGION (PICKUP.BITMAP WINDOW REGION))
(T (printout PROMPTWINDOW T "An empty region: try again")
(GO LP]
(printout PROMPTWINDOW T "Indicate position at which to start filling")
(SETQ PT (NOTEPAD.GETPOSITION WINDOW))
(COND
[(INSIDE? REGION (fetch XCOORD of PT)
(fetch YCOORD of PT))
(SETQ PT (create POSITION
XCOORD ←(IDIFFERENCE (fetch XCOORD of PT)
(SETQ LEFT (fetch LEFT of REGION)))
YCOORD ←(IDIFFERENCE (fetch YCOORD of PT)
(SETQ BOTTOM (fetch BOTTOM of REGION]
(T (PROMPTPRINT "The point should be inside the bounding region.")
(GO LP)))
(SETQ INTERIOR (BITMAP.INTERIOR BITMAP PT)) (* simulate merge since this will work for both color
and b&w where as BITBLT merge only works for b&w NIL)
(BITBLT INTERIOR 0 0 (OR COLORDS WINDOW)
LEFT BOTTOM NIL NIL (QUOTE INPUT)
(QUOTE ERASE))
[BITBLT NIL NIL NIL INTERIOR 0 0 NIL NIL (QUOTE TEXTURE)
(QUOTE ERASE)
(LOGXOR (LISTGET CHARACTERISTICS (QUOTE SHADE.DEFINITION))
(COND
(COLORDS (MAXIMUMCOLOR))
(T BLACKSHADE]
(BITBLT INTERIOR 0 0 (OR COLORDS WINDOW)
LEFT BOTTOM NIL NIL (QUOTE INPUT)
(QUOTE PAINT])
(NOTEPAD.CONFIRM
[LAMBDA (MESSAGE) (* edited: " 2-APR-82 18:04")
(PROG ((MENU (create MENU
TITLE ← MESSAGE
ITEMS ←(QUOTE ((YES T)
(NO NIL)))
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
(RETURN (MENU MENU])
(NOTEPAD.CREATE
[LAMBDA (BITMAP INCOLORFLG) (* DAHJr "23-OCT-83 12:06")
(PROG ((TITLE (COND
(INCOLORFLG "Color Notepad control window")
(T "Black and white Notepad control window")))
NPWINDOW WIDTH HEIGHT WINDOW.WIDTH WINDOW.HEIGHT)
(COND
((AND (NULL INCOLORFLG)
BITMAP)
(GETMOUSESTATE)
(SETQ WIDTH (BITMAPWIDTH BITMAP))
(SETQ HEIGHT (BITMAPHEIGHT BITMAP))
(SETQ WINDOW.WIDTH (IPLUS 8 WIDTH))
(SETQ WINDOW.HEIGHT (IPLUS 20 HEIGHT))
(SETQ NPWINDOW (CREATEW (create REGION
LEFT ←(MAX 0 (MIN (IDIFFERENCE SCREENWIDTH WINDOW.WIDTH)
LASTMOUSEX))
BOTTOM ←(MAX 0 (MIN (IDIFFERENCE SCREENHEIGHT
WINDOW.HEIGHT)
LASTMOUSEY))
WIDTH ← WINDOW.WIDTH
HEIGHT ← WINDOW.HEIGHT)
TITLE 4))
(BITBLT BITMAP 0 0 NPWINDOW 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(printout PROMPTWINDOW T "Move this new notepad to desired position")
(MOVEW NPWINDOW)
(CLRPROMPT))
(T (printout PROMPTWINDOW T "Indicate a region for a NOTEPAD window")
(SETQ NPWINDOW (CREATEW (GETREGION)
TITLE))
(CLRPROMPT)))
(COND
(INCOLORFLG (COLORDISPLAY T (AND (FIXP INCOLORFLG)
INCOLORFLG))
[WINDOWPROP NPWINDOW (QUOTE INCOLOR)
(SETQ INCOLORFLG (DSPCREATE (COLORSCREENBITMAP]
(DSPCLIPPINGREGION WHOLECOLORDISPLAY INCOLORFLG)))
(WINDOWPROP NPWINDOW (QUOTE BUTTONEVENTFN)
(QUOTE NOTEPAD.BUTTONEVENTFN))
(WINDOWPROP NPWINDOW (QUOTE CHARACTERISTICS)
(NOTEPAD.DEFAULT.CHARACTERISTICS INCOLORFLG))
(NOTEPAD.HELP)
(RETURN NPWINDOW])
(NOTEPAD.DEFAULT.CHARACTERISTICS
[LAMBDA (INCOLORFLG) (* DAHJr "31-MAY-83 12:05")
(* returns the default characteristics of a notepad
window's brush style etc.)
(COND
(INCOLORFLG (LIST (QUOTE BITS.PER.PIXEL)
(COLORNUMBERBITSPERPIXEL)
(QUOTE BRUSH.DEFINITION)
(COLORIZEBITMAP NOTEPAD.DEFAULT.BRUSH 0 (MAXIMUMCOLOR)
(COLORNUMBERBITSPERPIXEL))
(QUOTE MASK.DEFINITION)
(COLORIZEBITMAP NOTEPAD.DEFAULT.MASK 0 (MAXIMUMCOLOR)
(COLORNUMBERBITSPERPIXEL))
(QUOTE USE.MASK)
NIL
(QUOTE PRINTING.FONT.DEFINITION)
NOTEPAD.DEFAULT.FONT
(QUOTE GRID.DEFINITION)
(QUOTE (0 0 16 16))
(QUOTE USE.GRID)
NIL
(QUOTE USE.GRID.TO.DRAW)
NIL
(QUOTE USE.SYMMETRY)
NIL
(QUOTE POINT.OF.SYMMETRY.DEFINITION)
(CONS (IQUOTIENT COLORSCREENWIDTH 2)
(IQUOTIENT COLORSCREENHEIGHT 2))
(QUOTE USE.SYMMETRIC.BRUSH/MASK)
NIL
(QUOTE SHADE.DEFINITION)
(MAXIMUMCOLOR)))
(T (LIST (QUOTE BITS.PER.PIXEL)
1
(QUOTE BRUSH.DEFINITION)
NOTEPAD.DEFAULT.BRUSH
(QUOTE MASK.DEFINITION)
NOTEPAD.DEFAULT.MASK
(QUOTE USE.MASK)
NIL
(QUOTE PRINTING.FONT.DEFINITION)
NOTEPAD.DEFAULT.FONT
(QUOTE GRID.DEFINITION)
(QUOTE (0 0 16 16))
(QUOTE USE.GRID)
NIL
(QUOTE USE.GRID.TO.DRAW)
NIL
(QUOTE USE.SYMMETRY)
NIL
(QUOTE POINT.OF.SYMMETRY.DEFINITION)
(CONS 100 100)
(QUOTE USE.SYMMETRIC.BRUSH/MASK)
NIL
(QUOTE SHADE.DEFINITION)
BLACKSHADE])
(NOTEPAD.GETPOSITION
[LAMBDA (WINDOW CURSOR NOGRID) (* rrb "22-FEB-83 14:46")
(* IF USE.GRID IS NOT GIVEN, SEE IF YOU NEED TO GRIDIFY;
OTHERWISE ALWAYS GRIDIFY)
(PROG (PT CHARACTERISTICS USE.GRID DS)
[SETQ PT (COND
((SETQ DS (WINDOWPROP WINDOW (QUOTE INCOLOR)))
(GETCOLORPOSITION DS CURSOR))
(T (GETPOSITION WINDOW CURSOR]
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ USE.GRID (LISTGET CHARACTERISTICS (QUOTE USE.GRID)))
(RETURN (COND
[USE.GRID (NOTEPAD.ON.GRID PT (LISTGET CHARACTERISTICS (QUOTE GRID.DEFINITION]
(T PT])
(NOTEPAD.MASK
[LAMBDA (BITMAP) (* edited: " 2-DEC-82 10:21")
(PROG ((WIDTH (fetch (BITMAP BITMAPWIDTH) of BITMAP))
(HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP))
LEFT RIGHT BOTTOM TOP NEW.BITMAP)
(SETQ NEW.BITMAP (BITMAPCREATE WIDTH HEIGHT))
(DSPFILL NIL -1 PAINT NEW.BITMAP)
[for X from 0 to (SUB1 WIDTH) DO (for Y from 0 to (SUB1 HEIGHT)
THEREIS (COND
((EQ 1 (BITMAPBIT BITMAP X Y))
T)
((BITMAPBIT BITMAP X Y 0]
(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)))
(RETURN NEW.BITMAP])
(NOTEPAD.ON.GRID
[LAMBDA (PT GRID) (* rrb "27-DEC-82 16:59")
(create POSITION
XCOORD ←(NOTEPAD.ON.GRID.X (fetch (POSITION XCOORD) of PT)
(fetch (REGION LEFT) of GRID)
(fetch (REGION WIDTH) of GRID))
YCOORD ←(NOTEPAD.ON.GRID.X (fetch (POSITION YCOORD) of PT)
(fetch (REGION BOTTOM) of GRID)
(fetch (REGION HEIGHT) of GRID])
(NOTEPAD.ON.GRID.X
[LAMBDA (X X0 DX) (* edited: " 7-DEC-82 17:30")
(PROG (X1 NEGATIVE)
(SETQ X1 (IDIFFERENCE X X0))
(COND
((ILESSP X1 0)
(SETQ X1 (MINUS X1))
(SETQ NEGATIVE T)))
(SETQ X1 (ITIMES DX (IQUOTIENT (IPLUS X1 (RSH DX 1))
DX)))
[COND
(NEGATIVE (SETQ X1 (MINUS X1]
(RETURN (IPLUS X0 X1])
(NOTEPAD.OPERATION
[LAMBDA NIL (* edited: " 4-DEC-82 15:55")
(COND
((LASTMOUSESTATE LEFT)
(QUOTE PAINT))
(T (QUOTE ERASE])
(NOTEPAD.SOLID.AREA
[LAMBDA (WINDOW REGION OPERATION) (* edited: " 4-DEC-82 17:31")
(BITBLT NIL 0 0 WINDOW (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
(QUOTE TEXTURE)
(QUOTE REPLACE)
(COND
((EQ OPERATION (QUOTE PAINT))
BLACKSHADE)
(T WHITESHADE])
(BITMAP.EXTERIOR
[LAMBDA (BITMAP) (* rrb "19-JAN-83 19:27")
(PROG ((WIDTH (BITMAPWIDTH BITMAP))
(HEIGHT (BITMAPHEIGHT BITMAP))
INTERIOR
(NBITS (BITSPERPIXEL BITMAP))
FROMVALUE MAXVAL MAXX MAXY)
(SETQ MAXVAL (SUB1 (EXPT 2 NBITS)))
(SETQ INTERIOR (BITMAPCREATE WIDTH HEIGHT NBITS))
(SETQ MAXX (SUB1 WIDTH))
(SETQ MAXY (SUB1 HEIGHT)) (* use the upper right corner bit as the from value in
the color case, 0 in the b&w case.)
[SETQ FROMVALUE (COND
((EQ NBITS 1)
0)
(T (BITMAPBIT BITMAP MAXX MAXY]
(for X from 0 to MAXX
do (EXTEND.AREA BITMAP INTERIOR X 0 MAXX MAXY FROMVALUE MAXVAL)
(EXTEND.AREA BITMAP INTERIOR X MAXY MAXX MAXY FROMVALUE MAXVAL))
(for Y from 1 to (SUB1 MAXY)
do (EXTEND.AREA BITMAP INTERIOR 0 Y MAXX MAXY FROMVALUE MAXVAL)
(EXTEND.AREA BITMAP INTERIOR MAXX Y MAXX MAXY FROMVALUE MAXVAL))
(RETURN INTERIOR])
(NOTEPAD.TITLEBUTTONFN
[LAMBDA (WINDOW) (* DAHJr " 4-APR-83 16:42")
(PROG (CHARACTERISTICS DSP COMMAND.MENU COMMAND NEW.NOTEPAD STARTPT ENDPT REGION POSITION
WINDOWBITMAP BITMAP.NAME NEW.BITMAP TEXT)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ DSP (WINDOWPROP WINDOW (QUOTE DSP)))
[SETQ COMMAND.MENU (create MENU
TITLE ← "Operations on the whole"
ITEMS ←(QUOTE (HELP NEW.NOTEPAD COPY.NOTEPAD SAVE.AS.BITMAP
INSPECT.STYLE]
(SETQ COMMAND (MENU COMMAND.MENU))
(SELECTQ COMMAND
(NIL NIL)
(HELP (NOTEPAD.HELP))
[NEW.NOTEPAD (SETQ NEW.NOTEPAD (NOTEPAD.CREATE))
(WINDOWPROP NEW.NOTEPAD (QUOTE CHARACTERISTICS)
(COPYALL (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS]
[COPY.NOTEPAD (SETQ REGION (DSPCLIPPINGREGION NIL DSP))
(SETQ NEW.BITMAP (PICKUP.BITMAP WINDOW REGION))
(SETQ NEW.NOTEPAD (NOTEPAD.CREATE NEW.BITMAP))
(WINDOWPROP NEW.NOTEPAD (QUOTE CHARACTERISTICS)
(COPYALL (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS]
(SAVE.AS.BITMAP (printout PROMPTWINDOW T "Indicate region to be saved as a bitmap")
(SETQ REGION (GET.NOTEPAD.REGION WINDOW))
(SETQ BITMAP.NAME (READ.FROM.PROMPT.WINDOW "Name for new bitmap: ")
)
(SETQ NEW.BITMAP (PICKUP.BITMAP WINDOW REGION))
(SET BITMAP.NAME NEW.BITMAP))
(INSPECT.STYLE (INSPECT/PLIST CHARACTERISTICS))
(SHOULDNT (CONCAT "Unrecognized COMMAND in NOTEPAD.BUTTONEVENTFN: " COMMAND])
(PAINT.A.BITMAP
[LAMBDA (BRUSH MASK MIDX MIDY POSSIBLY.ROTATED) (* rrb "20-DEC-82 15:46")
(* masks with mask and paints or erases with the brush
bitmaps.)
(COND
((AND POSSIBLY.ROTATED .NOTEPAD.USE.SYMMETRIC.BRUSH/MASK)
(COND
(.NOTEPAD.USE.MASK (BITBLT MASK 0 0 .NOTEPAD.WINDOW (IDIFFERENCE MIDX
.NOTEPAD.MASK.HALF.HEIGHT)
(IDIFFERENCE MIDY .NOTEPAD.MASK.HALF.WIDTH)
.NOTEPAD.MASK.HEIGHT .NOTEPAD.MASK.WIDTH (QUOTE INPUT)
.NOTEPAD.INVERSE.OPERATION)))
(BITBLT BRUSH 0 0 .NOTEPAD.WINDOW (IDIFFERENCE MIDX .NOTEPAD.BRUSH.HALF.HEIGHT)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.WIDTH)
.NOTEPAD.BRUSH.HEIGHT .NOTEPAD.BRUSH.WIDTH (QUOTE INPUT)
.NOTEPAD.OPERATION))
(T (COND
(.NOTEPAD.USE.MASK (BITBLT MASK 0 0 .NOTEPAD.WINDOW (IDIFFERENCE MIDX
.NOTEPAD.MASK.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.MASK.HALF.HEIGHT)
.NOTEPAD.MASK.WIDTH .NOTEPAD.MASK.HEIGHT (QUOTE INPUT)
.NOTEPAD.INVERSE.OPERATION)))
(BITBLT BRUSH 0 0 .NOTEPAD.WINDOW (IDIFFERENCE MIDX .NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT (QUOTE INPUT)
.NOTEPAD.OPERATION])
(PAINT.ALL.BITMAPS
[LAMBDA (MIDX MIDY) (* edited: "17-DEC-82 16:28")
(SELECTQ .NOTEPAD.USE.SYMMETRY
(NIL (PAINT.A.BITMAP .NOTEPAD.BRUSH.1 .NOTEPAD.MASK.1 MIDX MIDY))
(LEFT/RIGHT (PAINT.A.BITMAP .NOTEPAD.BRUSH.1 .NOTEPAD.MASK.1 MIDX MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.2 .NOTEPAD.MASK.2 (IDIFFERENCE (IPLUS
.NOTEPAD.POSX
.NOTEPAD.POSX)
MIDX)
MIDY))
(UP/DOWN (PAINT.A.BITMAP .NOTEPAD.BRUSH.1 .NOTEPAD.MASK.1 MIDX MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.3 .NOTEPAD.MASK.3 MIDX (IDIFFERENCE
(IPLUS .NOTEPAD.POSY .NOTEPAD.POSY)
MIDY)))
(4-FOLD (PROG (REF.MIDX REF.MIDY)
(SETQ REF.MIDX (IDIFFERENCE (IPLUS .NOTEPAD.POSX .NOTEPAD.POSX)
MIDX))
(SETQ REF.MIDY (IDIFFERENCE (IPLUS .NOTEPAD.POSY .NOTEPAD.POSY)
MIDY))
(PAINT.A.BITMAP .NOTEPAD.BRUSH.1 .NOTEPAD.MASK.1 MIDX MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.2 .NOTEPAD.MASK.2 REF.MIDX MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.3 .NOTEPAD.MASK.3 MIDX REF.MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.4 .NOTEPAD.MASK.4 REF.MIDX REF.MIDY)))
(8-FOLD (PROG (REF.MIDX REF.MIDY DIAG.MIDX DIAG.MIDY)
(SETQ REF.MIDX (IDIFFERENCE (IPLUS .NOTEPAD.POSX .NOTEPAD.POSX)
MIDX))
(SETQ REF.MIDY (IDIFFERENCE (IPLUS .NOTEPAD.POSY .NOTEPAD.POSY)
MIDY))
(PAINT.A.BITMAP .NOTEPAD.BRUSH.1 .NOTEPAD.MASK.1 MIDX MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.2 .NOTEPAD.MASK.2 REF.MIDX MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.3 .NOTEPAD.MASK.3 MIDX REF.MIDY)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.4 .NOTEPAD.MASK.4 REF.MIDX REF.MIDY)
(SETQ DIAG.MIDX (IDIFFERENCE (IPLUS .NOTEPAD.POSX MIDY)
.NOTEPAD.POSY))
(SETQ DIAG.MIDY (IDIFFERENCE (IPLUS .NOTEPAD.POSY MIDX)
.NOTEPAD.POSX))
(SETQ REF.MIDX (IDIFFERENCE (IPLUS .NOTEPAD.POSX .NOTEPAD.POSX)
DIAG.MIDX))
(SETQ REF.MIDY (IDIFFERENCE (IPLUS .NOTEPAD.POSY .NOTEPAD.POSY)
DIAG.MIDY))
(PAINT.A.BITMAP .NOTEPAD.BRUSH.5 .NOTEPAD.MASK.5 DIAG.MIDX DIAG.MIDY T)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.6 .NOTEPAD.MASK.6 REF.MIDX DIAG.MIDY T)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.7 .NOTEPAD.MASK.7 DIAG.MIDX REF.MIDY T)
(PAINT.A.BITMAP .NOTEPAD.BRUSH.8 .NOTEPAD.MASK.8 REF.MIDX REF.MIDY T)))
(ERROR USE.SYMMETRY ": unrecognized symmetry type in PAINT.ALL.BITMAPS"])
(PAINT.AT.POSSIBLE.POINT
[LAMBDA (MIDX MIDY) (* edited: " 7-DEC-82 17:34")
(PROG (USABLE.MIDX USABLE.MIDY)
(SETQ USABLE.MIDX (COND
(.NOTEPAD.USE.GRID (NOTEPAD.ON.GRID.X MIDX .NOTEPAD.GRID.X0 .NOTEPAD.GRID.DX))
(T MIDX)))
(SETQ USABLE.MIDY (COND
(.NOTEPAD.USE.GRID (NOTEPAD.ON.GRID.X MIDY .NOTEPAD.GRID.Y0 .NOTEPAD.GRID.DY))
(T MIDY)))
(COND
((OR (NEQ USABLE.MIDX .NOTEPAD.PREVIOUS.MIDX)
(NEQ USABLE.MIDY .NOTEPAD.PREVIOUS.MIDY))
(PAINT.ALL.BITMAPS USABLE.MIDX USABLE.MIDY)
(SETQ .NOTEPAD.PREVIOUS.MIDX USABLE.MIDX)
(SETQ .NOTEPAD.PREVIOUS.MIDY USABLE.MIDY])
(PAINT.WITH.BITMAP
[LAMBDA (WINDOW OPERATION) (* edited: "17-DEC-82 15:44")
(PROG (BUFFER.BITMAP DOWN DONE MIDX MIDY NEW.MIDX NEW.MIDY)
(NOTEPAD.SETUP.TO.PAINT WINDOW OPERATION)
(SETQ BUFFER.BITMAP (BITMAPCREATE .NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT))
[until DONE do ((GETMOUSESTATE)
(COND
((LASTMOUSESTATE (NOT UP)) (* RESTORE BITMAP)
(SETQ DOWN T)))
(COND
((AND DOWN (LASTMOUSESTATE UP))
(* RESTORE BITMAP)
[COND
(MIDX (BITBLT BUFFER.BITMAP 0 0 WINDOW (IDIFFERENCE MIDX
.NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE]
(SETQ DONE T))
(T (SETQ NEW.MIDX (LASTMOUSEX WINDOW))
(SETQ NEW.MIDY (LASTMOUSEY WINDOW))
(COND
((OR (NEQ NEW.MIDX MIDX)
(NEQ NEW.MIDY MIDY)
(LASTMOUSESTATE (OR LEFT MIDDLE)))
(* RESTORE BITMAP)
[COND
(MIDX (BITBLT BUFFER.BITMAP 0 0 WINDOW (IDIFFERENCE MIDX
.NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT
(QUOTE INPUT)
(QUOTE REPLACE]
(SETQ MIDX NEW.MIDX)
(SETQ MIDY NEW.MIDY)
(COND
((LASTMOUSESTATE (NOT UP))
(PAINT.AT.POSSIBLE.POINT MIDX MIDY)))
(BITBLT WINDOW (IDIFFERENCE MIDX .NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
BUFFER.BITMAP 0 0 .NOTEPAD.BRUSH.WIDTH
.NOTEPAD.BRUSH.HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(BITBLT BRUSH 0 0 WINDOW (IDIFFERENCE MIDX
.NOTEPAD.BRUSH.HALF.WIDTH)
(IDIFFERENCE MIDY .NOTEPAD.BRUSH.HALF.HEIGHT)
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT (QUOTE INPUT)
(QUOTE PAINT]
(RETURN])
(PICKUP.BITMAP
[LAMBDA (WINDOW REGION) (* rrb "22-DEC-82 12:14")
(PROG (NEW.BITMAP WIDTH HEIGHT)
(SETQ WIDTH (fetch (REGION WIDTH) of REGION))
(SETQ HEIGHT (fetch (REGION HEIGHT) of REGION))
[SETQ NEW.BITMAP (BITMAPCREATE WIDTH HEIGHT (COND
(WINDOW (fetch (BITMAP BITMAPBITSPERPIXEL)
of (DSPDESTINATION NIL WINDOW)))
(T 1]
(BITBLT (OR WINDOW (SCREENBITMAP))
(fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(RETURN NEW.BITMAP])
(PICKUP.SCREEN.BITMAP
[LAMBDA (REGION SCREEN) (* rrb "22-DEC-82 10:35")
(* pick up a piece of a screen.)
(PROG (NEW.BITMAP WIDTH HEIGHT)
(SETQ WIDTH (fetch (REGION WIDTH) of REGION))
(SETQ HEIGHT (fetch (REGION HEIGHT) of REGION))
(SETQ NEW.BITMAP (BITMAPCREATE WIDTH HEIGHT (BITSPERPIXEL SCREEN)))
(BITBLT SCREEN (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(RETURN NEW.BITMAP])
(READ.FROM.PROMPT.WINDOW
[LAMBDA (PRMPT) (* edited: "15-DEC-82 23:02")
(CLEARBUF T T)
(CAR (PROCESS.READ PROMPTWINDOW PRMPT T])
(PUTBACK.BITMAP
[LAMBDA (WINDOW REGION BITMAP) (* edited: "18-OCT-82 11:57")
(BITBLT BITMAP 0 0 WINDOW (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
(fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)
(QUOTE INPUT)
(QUOTE REPLACE])
(PUTDEF.NOTEPAD.STYLE
[LAMBDA (NAME TYPE NOTEPAD.STYLE) (* DAHJr "26-JAN-83 10:33")
(COND
(NOTEPAD.STYLES (PUTASSOC NAME NOTEPAD.STYLE NOTEPAD.STYLES)
(SORT NOTEPAD.STYLES T))
(T (SETQ NOTEPAD.STYLES (LIST (CONS NAME NOTEPAD.STYLE])
(SAVE.STYLE
[LAMBDA (WINDOW) (* DAHJr "26-JAN-83 10:34")
(PROG (CHARACTERISTICS NAME OLD.ENTRY)
(SETQ CHARACTERISTICS (WINDOWPROP WINDOW (QUOTE CHARACTERISTICS)))
(SETQ NAME (READ.FROM.PROMPT.WINDOW "Give name under which to save the style: "))
(COND
(NAME (SETQ OLD.ENTRY (GETDEF.NOTEPAD.STYLE NAME (QUOTE NOTEPADSTYLE)))
(COND
((OR (NULL OLD.ENTRY)
(CONFIRM (CONCAT "Over-write old entry named " NAME)))
(PUTDEF.NOTEPAD.STYLE NAME (QUOTE NOTEPADSTYLE)
(COPYALL CHARACTERISTICS))
(MARKASCHANGED NAME (QUOTE NOTEPADSTYLE)
(NULL OLD.ENTRY))
(printout PROMPTWINDOW T "Style saved under the name " NAME])
(SBIT
[LAMBDA (X Y) (* edited: " 5-DEC-82 12:39")
(BITBLT NIL 0 0 WINDOW X Y 1 1 (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(TEST.AND.SET
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y FROMVALUE TOVALUE)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(COND
((EQ (BITMAPBIT AREA.BITMAP X Y)
TOVALUE) (* already been here)
NIL)
((NEQ (BITMAPBIT DEFINING.BITMAP X Y)
FROMVALUE) (* hit a boundary point)
NIL)
(T (BITMAPBIT AREA.BITMAP X Y TOVALUE)
T])
)
(DEFINEQ
(GET.WINDOW.REGION
[LAMBDA (W) (* DAHJr "23-OCT-83 11:13")
(* gets a region from a window on either the color
screen or the b&w screen.)
(PROG (DS REG)
(RETURN (COND
((SETQ DS (WINDOWPROP W (QUOTE INCOLOR)))
(SETQ REG (GETCOLORREGION))
(create REGION
LEFT ←(IDIFFERENCE (fetch LEFT of REG)
(DSPXOFFSET NIL DS))
BOTTOM ←(IDIFFERENCE (fetch BOTTOM of REG)
(DSPYOFFSET NIL DS))
WIDTH ←(fetch WIDTH of REG)
HEIGHT ←(fetch HEIGHT of REG)))
(T (SETQ REG (GETREGION))
(SETQ DS (WINDOWPROP W (QUOTE DSP)))
(create REGION
LEFT ←(IDIFFERENCE (fetch LEFT of REG)
(DSPXOFFSET NIL DS))
BOTTOM ←(IDIFFERENCE (fetch BOTTOM of REG)
(DSPYOFFSET NIL DS))
WIDTH ←(fetch WIDTH of REG)
HEIGHT ←(fetch HEIGHT of REG])
(GETCOLORPOSITION
[LAMBDA (DS CURSOR) (* rrb "20-DEC-82 16:07")
(* gets a point from the color screen)
(RESETLST (RESETSAVE (CHANGECURSORSCREEN (COLORSCREENBITMAP)))
(GETPOSITION DS CURSOR])
(COLORBITMAPP
[LAMBDA (BITMAP) (* rrb "22-DEC-82 09:42")
(AND (BITMAPP BITMAP)
(NEQ (BITSPERPIXEL BITMAP)
1)
BITMAP])
)
(RPAQQ NOTEPAD.DEFAULT.FONT (HELVETICA 18 BOLD))
(RPAQQ NOTEPAD.STYLE.REPRESENTATION.NUMBER 1)
(RPAQQ NOTEPAD.COMMAND.MENU NIL)
(RPAQQ NOTEPAD.SHOW.FILL NIL)
(RPAQQ NOTEPAD.USE.GRID.MENU NIL)
(RPAQQ .NOTEPAD.BRUSH.1 NIL)
(RPAQQ .NOTEPAD.BRUSH.2 NIL)
(RPAQQ .NOTEPAD.BRUSH.3 NIL)
(RPAQQ .NOTEPAD.BRUSH.4 NIL)
(RPAQQ .NOTEPAD.BRUSH.5 NIL)
(RPAQQ .NOTEPAD.BRUSH.6 NIL)
(RPAQQ .NOTEPAD.BRUSH.7 NIL)
(RPAQQ .NOTEPAD.BRUSH.8 NIL)
(RPAQQ .NOTEPAD.MASK.1 NIL)
(RPAQQ .NOTEPAD.MASK.2 NIL)
(RPAQQ .NOTEPAD.MASK.3 NIL)
(RPAQQ .NOTEPAD.MASK.4 NIL)
(RPAQQ .NOTEPAD.MASK.5 NIL)
(RPAQQ .NOTEPAD.MASK.6 NIL)
(RPAQQ .NOTEPAD.MASK.7 NIL)
(RPAQQ .NOTEPAD.MASK.8 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS NOTEPAD.COMMAND.MENU NOTEPAD.USE.GRID.MENU .NOTEPAD.WINDOW .NOTEPAD.OPERATION
.NOTEPAD.BRUSH.1 .NOTEPAD.BRUSH.2 .NOTEPAD.BRUSH.3 .NOTEPAD.BRUSH.4 .NOTEPAD.BRUSH.5
.NOTEPAD.BRUSH.6 .NOTEPAD.BRUSH.7 .NOTEPAD.BRUSH.8 .NOTEPAD.MASK.1 .NOTEPAD.MASK.2
.NOTEPAD.MASK.3 .NOTEPAD.MASK.4 .NOTEPAD.MASK.5 .NOTEPAD.MASK.6 .NOTEPAD.MASK.7
.NOTEPAD.MASK.8 .NOTEPAD.USE.GRID .NOTEPAD.GRID.X0 .NOTEPAD.GRID.Y0 .NOTEPAD.GRID.DX
.NOTEPAD.GRID.DY .NOTEPAD.USE.MASK .NOTEPAD.INVERSE.OPERATION
.NOTEPAD.USE.SYMMETRIC.BRUSH/MASK .NOTEPAD.USE.SYMMETRY .NOTEPAD.POSX .NOTEPAD.POSY
.NOTEPAD.BRUSH.WIDTH .NOTEPAD.BRUSH.HEIGHT .NOTEPAD.BRUSH.HALF.WIDTH
.NOTEPAD.BRUSH.HALF.HEIGHT .NOTEPAD.MASK.WIDTH .NOTEPAD.MASK.HEIGHT
.NOTEPAD.MASK.HALF.WIDTH .NOTEPAD.MASK.HALF.HEIGHT .NOTEPAD.PREVIOUS.MIDX
.NOTEPAD.PREVIOUS.MIDY)
)
(RPAQQ COLORSPOTMARKER NIL)
(RPAQ? NOTEPAD.STYLES )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS NOTEPAD.STYLES)
)
(RPAQ SPOTMARKER (READBITMAP))
(17 18
"@@@@@@@@"
"@@@@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@@@@@@@"
"ANMN@@@@"
"ANMN@@@@"
"@@@@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@L@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")
(RPAQ NOTEPAD.DEFAULT.BRUSH (READBITMAP))
(3 3
"@@@@"
"D@@@"
"@@@@")
(RPAQ NOTEPAD.DEFAULT.MASK (READBITMAP))
(3 3
"N@@@"
"N@@@"
"N@@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS SPOTMARKER NOTEPAD.DEFAULT.BRUSH NOTEPAD.DEFAULT.MASK)
)
(RPAQ CIRCLE.CENTER (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@GN@"
"AOOH"
"CLCL"
"G@@N"
"FDBF"
"NJEG"
"LEJC"
"LBDC"
"LBDC"
"LEJC"
"NJEG"
"FDBF"
"G@@N"
"CLCL"
"AOOH"
"@GN@")(RPAQ CIRCLE.EDGE (CURSORCREATE (READBITMAP) 15 8))
(16 16
"@@AL"
"@@@L"
"@@@N"
"@@@F"
"@@BG"
"@@CC"
"@@CK"
"OOOO"
"OOOO"
"@@CK"
"@@CC"
"@@BG"
"@@@F"
"@@@N"
"@@@L"
"@@AL")(RPAQ ELLIPSE.CENTER (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@GN@"
"AOOH"
"CLCL"
"G@@N"
"FDBF"
"NJEG"
"LEJC"
"LBDC"
"LBDC"
"LEJC"
"NJEG"
"FDBF"
"G@@N"
"CLCL"
"AOOH"
"@GN@")(RPAQ ELLIPSE.SEMI.MAJOR (CURSORCREATE (READBITMAP) 15 8))
(16 16
"@@AL"
"@@@L"
"@@@N"
"@@@F"
"@@BG"
"@@CC"
"@@CK"
"OOOO"
"OOOO"
"@@CK"
"@@CC"
"@@BG"
"@@@F"
"@@@N"
"@@@L"
"@@AL")(RPAQ ELLIPSE.SEMI.MINOR (CURSORCREATE (READBITMAP) 8 15))
(16 16
"@OO@"
"COOL"
"OIIO"
"NCLG"
"HGNA"
"@OO@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@"
"@AH@")(RPAQ CURVE.KNOT (CURSORCREATE (READBITMAP) 8 8))
(16 16
"@GN@"
"AOOH"
"CLCL"
"G@@N"
"FDBF"
"NJEG"
"LEJC"
"LBDC"
"LBDC"
"LEJC"
"NJEG"
"FDBF"
"G@@N"
"CLCL"
"AOOH"
"@GN@")(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS CIRCLE.CENTER CIRCLE.EDGE ELLIPSE.CENTER ELLIPSE.SEMI.MAJOR ELLIPSE.SEMI.MINOR
CURVE.KNOT)
)
(FILESLOAD (FROM VALUEOF LISPUSERSDIRECTORIES)
EDITBITMAP READNUMBER)
(PUTDEF (QUOTE NOTEPADSTYLE) (QUOTE FILEPKGCOMS) (QUOTE
([COM MACRO
(X (E (MAPC (QUOTE X)
(FUNCTION DUMP.NOTEPAD.STYLE]
(TYPE DESCRIPTION "NOTEPAD styles" GETDEF
GETDEF.NOTEPAD.STYLE PUTDEF
PUTDEF.NOTEPAD.STYLE DELDEF
DELDEF.NOTEPAD.STYLE))))
(ADD.NOTEPAD.TO.BACKGROUND.MENU)
(FONTCREATE NOTEPAD.DEFAULT.FONT)
(COND ((NULL NOTEPAD.STYLES)
(FILESLOAD NOTEPAD-CORESTYLES)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML READ.NOTEPAD.STYLE)
(ADDTOVAR LAMA )
)
(PUTPROPS NOTEPAD COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4349 76920 (ACQUIRE.STYLE 4359 . 4974) (ACQUIRE.SYMMETRY 4976 . 5333) (
ADD.NOTEPAD.TO.BACKGROUND.MENU 5335 . 5961) (BITMAP.INTERIOR 5963 . 6781) (DELDEF.NOTEPAD.STYLE 6783
. 6987) (DISTANCE 6989 . 7423) (DUMP.NOTEPAD.STYLE 7425 . 7791) (ERASE.REGION 7793 . 8172) (
EXTEND.AREA 8174 . 8555) (EXTEND.AREA.X 8557 . 9359) (EXTEND.AREA.Y 9361 . 10163) (GET.BITMAP 10165 .
10440) (GET.NOTEPAD.BITMAP 10442 . 10616) (GET.NOTEPAD.REGION 10618 . 12087) (GET.SYMMETRIC.BITMAPS
12089 . 12957) (GETDEF.NOTEPAD.STYLE 12959 . 13116) (GETPOSITION.RUBBERBAND 13118 . 14343) (
GETPOSITION.RUBBERBAND1 14345 . 15299) (MARK.SPOT 15301 . 16261) (MASKED.BRUSH 16263 . 17809) (
MOVE.BITMAP 17811 . 18548) (MOVE.BITMAP1 18550 . 19400) (NOTEPAD 19402 . 20241) (
NOTEPAD.ADD.TO.BACKGROUND.MENU 20243 . 20714) (NOTEPAD.BUTTONEVENTFN 20716 . 21041) (NOTEPAD.BUTTONFN
21043 . 23580) (NOTEPAD.CIRCLE 23582 . 24610) (NOTEPAD.COMMAND.MENU 24612 . 24846) (
NOTEPAD.COMMAND.MENU.CREATE 24848 . 25905) (NOTEPAD.COOKIE.CUT 25907 . 26410) (
NOTEPAD.COPY.FROM.SCREEN 26412 . 26942) (NOTEPAD.CURVE 26944 . 28369) (NOTEPAD.DEFINE.BRUSH 28371 .
29034) (NOTEPAD.DEFINE.FONT 29036 . 29476) (NOTEPAD.HELP 29478 . 30079) (NOTEPAD.READ.FONT 30081 .
30912) (NOTEPAD.FONTS.IN.CORE 30914 . 31319) (READ.NOTEPAD.STYLE 31321 . 31781) (NOTEPAD.DEFINE.GRID
31783 . 32259) (NOTEPAD.DEFINE.GRID1 32261 . 33316) (NOTEPAD.DEFINE.MASK 33318 . 33976) (
NOTEPAD.DELETE.STYLE 33978 . 34581) (NOTEPAD.EDIT.BRUSH 34583 . 35085) (NOTEPAD.EDIT.MASK 35087 .
35581) (NOTEPAD.EDIT.RECTANGLE 35583 . 37119) (NOTEPAD.EDIT.SHADE 37121 . 37934) (NOTEPAD.ELLIPSE
37936 . 39402) (NOTEPAD.LINE 39404 . 40132) (NOTEPAD.MASK=BRUSH.OUTLINE 40134 . 40764) (
NOTEPAD.NAMED.OBJECT 40766 . 41415) (NOTEPAD.POINT.OF.SYMMETRY 41417 . 41934) (NOTEPAD.RESTORE.STYLE
41936 . 42564) (NOTEPAD.SETUP.TO.PAINT 42566 . 47119) (NOTEPAD.SHADE.RECTANGLE 47121 . 47997) (
NOTEPAD.SKETCH 47999 . 48796) (NOTEPAD.SKETCH1 48798 . 50439) (NOTEPAD.TEXT 50441 . 51401) (
NOTEPAD.USE.GRID 51403 . 53020) (NOTEPAD.USE.MASK 53022 . 53505) (NOTEPAD.USE.SYMMETRIC.BRUSH/MASK
53507 . 54134) (NOTEPAD.USE.SYMMETRY 54136 . 54644) (NOTEPAD.FILL 54646 . 56653) (NOTEPAD.CONFIRM
56655 . 56944) (NOTEPAD.CREATE 56946 . 58718) (NOTEPAD.DEFAULT.CHARACTERISTICS 58720 . 60410) (
NOTEPAD.GETPOSITION 60412 . 61160) (NOTEPAD.MASK 61162 . 62120) (NOTEPAD.ON.GRID 62122 . 62613) (
NOTEPAD.ON.GRID.X 62615 . 63045) (NOTEPAD.OPERATION 63047 . 63243) (NOTEPAD.SOLID.AREA 63245 . 63697)
(BITMAP.EXTERIOR 63699 . 64797) (NOTEPAD.TITLEBUTTONFN 64799 . 66419) (PAINT.A.BITMAP 66421 . 67735) (
PAINT.ALL.BITMAPS 67737 . 70391) (PAINT.AT.POSSIBLE.POINT 70393 . 71102) (PAINT.WITH.BITMAP 71104 .
73225) (PICKUP.BITMAP 73227 . 73913) (PICKUP.SCREEN.BITMAP 73915 . 74582) (READ.FROM.PROMPT.WINDOW
74584 . 74772) (PUTBACK.BITMAP 74774 . 75139) (PUTDEF.NOTEPAD.STYLE 75141 . 75432) (SAVE.STYLE 75434
. 76198) (SBIT 76200 . 76393) (TEST.AND.SET 76395 . 76918)) (76921 78512 (GET.WINDOW.REGION 76931 .
78007) (GETCOLORPOSITION 78009 . 78324) (COLORBITMAPP 78326 . 78510)))))
STOP