(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 9-Sep-87 09:18:10" |{MCS:MCS:STANFORD}<LANE>EDITBG.;4| 16057
previous date%: "26-Mar-87 14:48:50" |{MCS:MCS:STANFORD}<LANE>EDITBG.;2|)
(* "
Copyright (c) 1984, 1985, 1986, 1987 by Stanford University. All rights reserved.
")
(PRETTYCOMPRINT EDITBGCOMS)
(RPAQQ EDITBGCOMS ((FNS EDITBACKGROUND EDITBG.BUTTONFN)
(RECORDS EDITBG.RECORD EDITBG.DATA)
(CONSTANTS (EDITBG.PIXELSIZE 16))
(ALISTS (BackgroundMenuCommands EditBG))
(VARS (BackgroundMenu))
[INITVARS [EDITBG.SHADEREC (create EDITBG.RECORD REGION ← (CREATEREGION
2 2 (LLSH
EDITBG.PIXELSIZE
2)
(LLSH EDITBG.PIXELSIZE
2))
GRIDSPEC ← (CREATEREGION 2 2 EDITBG.PIXELSIZE
EDITBG.PIXELSIZE)
BITWIDTH ← 4 BITHEIGHT ← 4 DSPREGION ←
(CREATEREGION EDITBG.PIXELSIZE (TIMES
EDITBG.PIXELSIZE
6)
(TIMES EDITBG.PIXELSIZE 11)
(LLSH EDITBG.PIXELSIZE 1))
NUMBEREGION ← (CREATEREGION WBorder
(PLUS (LLSH
EDITBG.PIXELSIZE
2)
WBorder)
(DIFFERENCE (LLSH
EDITBG.PIXELSIZE
2)
WBorder)
(DIFFERENCE
EDITBG.PIXELSIZE
WBorder]
[EDITBG.BORDERREC (create EDITBG.RECORD REGION ←
(CREATEREGION (PLUS (TIMES EDITBG.PIXELSIZE 5)
2)
2
(LLSH EDITBG.PIXELSIZE 3)
(LLSH EDITBG.PIXELSIZE 2))
GRIDSPEC ← (CREATEREGION (PLUS (TIMES
EDITBG.PIXELSIZE
5)
2)
2 EDITBG.PIXELSIZE
(LLSH EDITBG.PIXELSIZE 1))
BITWIDTH ← 8 BITHEIGHT ← 2 DSPREGION ←
(CREATEREGION 1 (ADD1 (TIMES EDITBG.PIXELSIZE 5))
(PLUS (TIMES EDITBG.PIXELSIZE 13)
2)
(SUB1 (LLSH EDITBG.PIXELSIZE 2)))
NUMBEREGION ← (CREATEREGION (PLUS (TIMES
EDITBG.PIXELSIZE
5)
WBorder)
(PLUS (LLSH EDITBG.PIXELSIZE
2)
WBorder)
(DIFFERENCE (LLSH
EDITBG.PIXELSIZE
3)
WBorder)
(DIFFERENCE EDITBG.PIXELSIZE
WBorder]
(EDITBG.BUTTONREGION (CREATEREGION (PLUS 2 (LLSH EDITBG.PIXELSIZE 2))
(PLUS 2 (LLSH EDITBG.PIXELSIZE 2))
(SUB1 EDITBG.PIXELSIZE)
(SUB1 EDITBG.PIXELSIZE]
(GLOBALVARS EDITBG.BUTTONREGION EDITBG.BORDERREC EDITBG.SHADEREC EDITBG.PIXELSIZE)
))
(DEFINEQ
(EDITBACKGROUND
[LAMBDA NIL (* ; "Edited 26-Mar-87 14:25 by cdl")
(LET ((WINDOW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (CONSTANT (PLUS (TIMES EDITBG.PIXELSIZE 13)
4)))
(HEIGHTIFWINDOW (CONSTANT (TIMES EDITBG.PIXELSIZE 9))
T))
"Background Texture Edit Tool")))
(for RECORD in (LIST EDITBG.SHADEREC EDITBG.BORDERREC)
do (with EDITBG.RECORD RECORD (with REGION REGION (WBOX (CREATEREGION (DIFFERENCE LEFT 2)
(DIFFERENCE BOTTOM 2)
(PLUS WIDTH 4)
(PLUS HEIGHT 4))
NIL NIL WINDOW))
(GRID GRIDSPEC BITWIDTH BITHEIGHT 'POINT WINDOW)
(CENTERPRINTINREGION 0 NUMBEREGION WINDOW)))
(WBOX EDITBG.BUTTONREGION NIL NIL WINDOW)
(WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION EDITBG.BUTTONFN))
(WINDOWPROP WINDOW 'EDITBG.DATA (create EDITBG.DATA))
WINDOW])
(EDITBG.BUTTONFN
[LAMBDA (WINDOW) (* ; "Edited 26-Mar-87 14:37 by cdl")
(PROG ((DATA (WINDOWPROP WINDOW 'EDITBG.DATA))
POSITION SHADE LEFTFLG PIXEL BIT GRIDX GRIDY RECORD NEWSHADE)
(until (MOUSESTATE UP)
do
(SETQ POSITION (CURSORPOSITION NIL WINDOW POSITION))
(if (INSIDEP EDITBG.BUTTONREGION POSITION)
then (DSPFILL EDITBG.BUTTONREGION BLACKSHADE 'INVERT WINDOW)
(with EDITBG.DATA DATA (CHANGEBACKGROUND INTERIOR)
(CHANGEBACKGROUNDBORDER EXTERIOR))
(DSPFILL EDITBG.BUTTONREGION BLACKSHADE 'INVERT WINDOW)
(RETURN))
(if (INSIDEP (fetch (EDITBG.RECORD REGION) of EDITBG.SHADEREC)
POSITION)
then (SETQ RECORD EDITBG.SHADEREC)
(SETQ SHADE (with EDITBG.DATA DATA INTERIOR))
elseif (INSIDEP (fetch (EDITBG.RECORD REGION) of EDITBG.BORDERREC)
POSITION)
then (SETQ RECORD EDITBG.BORDERREC)
(SETQ SHADE (with EDITBG.DATA DATA EXTERIOR))
else (SETQ RECORD NIL))
(if RECORD
then (SETQ LEFTFLG (LASTMOUSESTATE LEFT))
[with EDITBG.RECORD RECORD (with POSITION POSITION (SETQ GRIDX (GRIDXCOORD
XCOORD GRIDSPEC
))
(SETQ GRIDY (GRIDYCOORD YCOORD GRIDSPEC)))
(SHADEGRIDBOX GRIDX GRIDY (if LEFTFLG
then GRAYSHADE
else WHITESHADE)
NIL GRIDSPEC 'POINT WINDOW)
[SETQ PIXEL (LLSH 1 (PLUS (TIMES GRIDY BITWIDTH)
(SUB1 BITWIDTH)
(MINUS GRIDX]
[SETQ NEWSHADE (if LEFTFLG
then (LOGOR SHADE PIXEL)
else (LOGAND SHADE (LOGNOT PIXEL]
(if (NEQ SHADE NEWSHADE)
then (SETQ SHADE NEWSHADE)
(DSPFILL NUMBEREGION WHITESHADE 'REPLACE WINDOW)
(CENTERPRINTINREGION SHADE NUMBEREGION WINDOW)
(with EDITBG.DATA DATA
(if (EQ RECORD EDITBG.BORDERREC)
then (SETQ BIT (if LEFTFLG
then 1
else 0))
(SETQ GRIDY (LLSH GRIDY 1))
(for X from GRIDX to (PLUS GRIDX 8) by 8
do (for Y from GRIDY to (ADD1 GRIDY)
do (BITMAPBIT BITMAP X Y BIT)))
(DSPFILL DSPREGION BITMAP NIL WINDOW)
(SETQ EXTERIOR SHADE)
else (SETQ INTERIOR SHADE]
(DSPFILL (fetch (EDITBG.RECORD DSPREGION) of EDITBG.SHADEREC)
(with EDITBG.DATA DATA INTERIOR)
NIL WINDOW))
(BLOCK])
)
(DECLARE%: EVAL@COMPILE
(RECORD EDITBG.RECORD (REGION GRIDSPEC BITWIDTH DSPREGION NUMBEREGION BITHEIGHT))
(RECORD EDITBG.DATA (BITMAP INTERIOR EXTERIOR)
BITMAP ← (BITMAPCREATE 16 4)
INTERIOR ← 0 EXTERIOR ← 0)
)
(DECLARE%: EVAL@COMPILE
(RPAQQ EDITBG.PIXELSIZE 16)
(CONSTANTS (EDITBG.PIXELSIZE 16))
)
(ADDTOVAR BackgroundMenuCommands (EditBG '(EDITBACKGROUND) "Opens a Background Texture Edit Tool"))
(RPAQQ BackgroundMenu NIL)
(RPAQ? EDITBG.SHADEREC (create EDITBG.RECORD REGION ← (CREATEREGION 2 2 (LLSH EDITBG.PIXELSIZE 2)
(LLSH EDITBG.PIXELSIZE 2))
GRIDSPEC ← (CREATEREGION 2 2 EDITBG.PIXELSIZE EDITBG.PIXELSIZE)
BITWIDTH ← 4 BITHEIGHT ← 4 DSPREGION ← (CREATEREGION EDITBG.PIXELSIZE
(TIMES EDITBG.PIXELSIZE 6
)
(TIMES EDITBG.PIXELSIZE
11)
(LLSH EDITBG.PIXELSIZE 1)
)
NUMBEREGION ← (CREATEREGION WBorder (PLUS (LLSH EDITBG.PIXELSIZE 2)
WBorder)
(DIFFERENCE (LLSH EDITBG.PIXELSIZE 2)
WBorder)
(DIFFERENCE EDITBG.PIXELSIZE WBorder))))
(RPAQ? EDITBG.BORDERREC (create EDITBG.RECORD REGION ← (CREATEREGION (PLUS (TIMES EDITBG.PIXELSIZE 5)
2)
2
(LLSH EDITBG.PIXELSIZE 3)
(LLSH EDITBG.PIXELSIZE 2))
GRIDSPEC ← (CREATEREGION (PLUS (TIMES EDITBG.PIXELSIZE 5)
2)
2 EDITBG.PIXELSIZE (LLSH EDITBG.PIXELSIZE 1))
BITWIDTH ← 8 BITHEIGHT ← 2 DSPREGION ← (CREATEREGION
1
(ADD1 (TIMES EDITBG.PIXELSIZE
5))
(PLUS (TIMES EDITBG.PIXELSIZE
13)
2)
(SUB1 (LLSH EDITBG.PIXELSIZE 2
)))
NUMBEREGION ← (CREATEREGION (PLUS (TIMES EDITBG.PIXELSIZE 5)
WBorder)
(PLUS (LLSH EDITBG.PIXELSIZE 2)
WBorder)
(DIFFERENCE (LLSH EDITBG.PIXELSIZE 3)
WBorder)
(DIFFERENCE EDITBG.PIXELSIZE WBorder))))
(RPAQ? EDITBG.BUTTONREGION (CREATEREGION (PLUS 2 (LLSH EDITBG.PIXELSIZE 2))
(PLUS 2 (LLSH EDITBG.PIXELSIZE 2))
(SUB1 EDITBG.PIXELSIZE)
(SUB1 EDITBG.PIXELSIZE)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS EDITBG.BUTTONREGION EDITBG.BORDERREC EDITBG.SHADEREC EDITBG.PIXELSIZE)
)
(PUTPROPS EDITBG COPYRIGHT ("Stanford University" 1984 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6208 11664 (EDITBACKGROUND 6218 . 7607) (EDITBG.BUTTONFN 7609 . 11662)))))
STOP