(FILECREATED "26-Nov-84 12:04:03" {AZTEC}<TRILLIUM>BIRTHDAY84>SOURCES>TRI-COLOR.;2 27234
changes to: (FNS COLOR.INIT TRILLIUM.COLOR.FILENAME)
(VARS TRI-COLORCOMS)
previous date: "13-Sep-84 12:56:35" {ICE}<TRILLIUM>BIRTHDAY84>TRI-COLOR.;5)
(PRETTYCOMPRINT TRI-COLORCOMS)
(RPAQQ TRI-COLORCOMS ((FNS CLEARCOLORSCREEN CLEAR&SHOW.FRAME COLOR.INIT COLOR.ON.OFF
CREATE.NEW.INTERFACE EDIT.COLOR.MAP FIND.COLOR.NUMBER
FIND.REPRESENTATIVE.GRAY FLIP.BOX GET.COLORS.FOR.COLOR.FRAME
GET.CONTROL.WINDOW.COMMAND.MENU GET.MANIPULATE.INTERFACE.COMMAND.MENU
INSTALL.COLOR.MAP MANIPULATE.INTERFACE RETRIEVE.SAVED.COLOR.MAP
SAVE.COLOR.MAP SHOW.ARTWORK.IN.COLOR SHOW.COLORED.BITMAP SWITCH.COLOR.MAPS
TRILLIUM.COLOR.FILENAME UPGRADE.INTERFACE.TO.COLOR)
(INITVARS (IN.LIVING.COLOR)
(TRILLIUM.COLOR.DSP)
(TRILLIUM.COLOR.MAP)
(TRILLIUM.SAVED.COLOR.MAP))))
(DEFINEQ
(CLEARCOLORSCREEN
[LAMBDA (COLOR) (* PH " 8-Jun-84 11:18")
(BITBLT NIL NIL NIL (COLORSCREENBITMAP)
0 0 640 480 (QUOTE TEXTURE)
(QUOTE REPLACE)
(OR COLOR (QUOTE BLACK])
(CLEAR&SHOW.FRAME
[LAMBDA (FRAME) (* PH "13-Sep-84 12:46")
(DECLARE (GLOBALVARS CURRENT.DSP CURRENT.INTERFACE IN.LIVING.COLOR WHOLECOLORDISPLAY))
(PROG (BACKGROUND.COLOR REPRESENTATIVE.GRAY)
(SETQ BACKGROUND.COLOR (GET.FIELDQ CURRENT.INTERFACE BACKGROUND.COLOR INTERFACE))
(SETQ REPRESENTATIVE.GRAY (FIND.REPRESENTATIVE.GRAY BACKGROUND.COLOR))
(DSPFILL NIL REPRESENTATIVE.GRAY (QUOTE REPLACE)
CURRENT.DSP)
(* * (COND (IN.LIVING.COLOR (COLORFILL WHOLECOLORDISPLAY (FIND.COLOR.NUMBER BACKGROUND.COLOR)
(COLORSCREENBITMAP) (QUOTE REPLACE)))))
(COND
(IN.LIVING.COLOR (CLEARCOLORSCREEN BACKGROUND.COLOR)))
(SHOW.FRAME* FRAME)
(ACTIVATE.DISPLAYERS* FRAME])
(COLOR.INIT
[LAMBDA NIL (* kkm "26-Nov-84 12:03")
(DECLARE (GLOBALVARS INTERFACES TRILLIUM.COLOR.DSP TRILLIUM.COLOR.MAP
TRILLIUM.COLOR.MAP.INTENSITIES TRILLIUM.GRAYSCALE.INTENSITIES
TRILLIUM.SAVED.COLOR.MAP))
(PROG (ITYPES.TOO)
[SETQ ITYPES.TOO (COND
((GETPROP (QUOTE COLOR-PRIMITIVE-ITEMTYPES)
(QUOTE FILEDATES))
NIL)
(T (CONFIRM "Load set of color primitive itemtypes?"]
(* * Load color software and initialize global variables)
[COND
((AND (LOAD? (QUOTE COLOR.DCOM)
(QUOTE SYSLOAD))
(LOAD? (QUOTE COLORUTILITIES.DCOM)
(QUOTE SYSLOAD)))
(COLORSWITCHDISPLAYON/OFF)
[for WINDOW in (ACTIVEWINDOWS) bind REGION when (STREQUAL (SUBSTRING
(WINDOWPROP WINDOW
(QUOTE TITLE))
1 11)
"Trillium of")
do (SETQ REGION (WINDOWPROP WINDOW (QUOTE REGION)))
(CLOSEW WINDOW)
(CONTROL.WINDOW.CREATE (create POSITION
XCOORD ←(fetch (REGION LEFT) of REGION)
YCOORD ←(fetch (REGION BOTTOM) of REGION]
[SETQ TRILLIUM.COLOR.MAP.INTENSITIES (QUOTE ((0 0 0)
(0 0 255)
(0 255 0)
(255 0 0)
(255 255 0)
(255 0 255)
(0 255 255)
(255 255 255)
(0 0 0)
(128 128 128)
(252 128 0)
(212 182 129)
(0 255 132)
(171 171 255)
(0 201 39)
(255 255 255]
(SETQ TRILLIUM.GRAYSCALE.INTENSITIES (QUOTE ((0 0 0)
(130 130 130)
(160 160 160)
(190 190 190)
(220 220 220)
(235 235 235)
(245 245 245)
(255 255 255)
(245 245 245)
(235 235 235)
(220 220 220)
(190 190 190)
(160 160 160)
(130 130 130)
(0 0 0]
(* * Load color itemtypes and attempt to upgrade interfaces)
(COND
(ITYPES.TOO (TRILLIUM.PRINTOUT T "Loading set of color primitive itemtypes ....")
(LOAD? (TRILLIUM.COLOR.FILENAME (QUOTE COLOR-PRIMITIVE-ITEMTYPES)))
(TRILLIUM.PRINTOUT SAME.LINE "Done!" T)))
(for INTERFACE in INTERFACES do (UPGRADE.INTERFACE.TO.COLOR INTERFACE])
(COLOR.ON.OFF
[LAMBDA NIL (* PH "12-Sep-84 11:22")
(DECLARE (GLOBALVARS CURRENT.INTERFACE IN.LIVING.COLOR TRILLIUM.COLOR.DSP TRILLIUM.COLOR.MAP
TRILLIUM.COLOR.MAP.INTENSITIES))
(PROG (INTERFACE.INTENSITIES)
(COND
((COLORDISPLAYP)
(COLORDISPLAY)
(VIDEOCOLOR NIL)
(SETDISPLAYHEIGHT T)
(SETQ IN.LIVING.COLOR)
(TRILLIUM.PRINTOUT T "Color off" T)
(RETURN)))
[COND
((AND (BOUNDP (QUOTE CURRENT.INTERFACE))
CURRENT.INTERFACE)
(SETQ INTERFACE.INTENSITIES (OR (GET.FIELDQ CURRENT.INTERFACE COLOR.MAP.INTENSITIES)
(SET.FIELDQ CURRENT.INTERFACE COLOR.MAP.INTENSITIES
TRILLIUM.COLOR.MAP.INTENSITIES)))
(SETQ TRILLIUM.COLOR.MAP (COLORMAPCREATE INTERFACE.INTENSITIES)))
(T (SETQ TRILLIUM.COLOR.MAP (COLORMAPCREATE TRILLIUM.COLOR.MAP.INTENSITIES]
(COLORDISPLAY TRILLIUM.COLOR.MAP)
(SETQ TRILLIUM.COLOR.DSP (DSPCREATE (COLORSCREENBITMAP)))
(SETQ IN.LIVING.COLOR T)
(DSPXPOSITION 0 TRILLIUM.COLOR.DSP)
(DSPYPOSITION 0 TRILLIUM.COLOR.DSP)
(DSPCOLOR (QUOTE WHITE)
TRILLIUM.COLOR.DSP)
(DSPBACKCOLOR (QUOTE BLACK)
TRILLIUM.COLOR.DSP)
(TRILLIUM.PRINTOUT T "Color on" T)
(RETURN])
(CREATE.NEW.INTERFACE
[LAMBDA NIL (* PH "12-Sep-84 11:23")
(DECLARE (GLOBALVARS COLOR.AVAILABLE INITIAL.BITMAPS TRILLIUM.COLOR.MAP.INTENSITIES))
(PROG (NEW.NAME NEW.INTERFACE BITMAP.ITEM)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Creating new interface; Name of new interface: ")
(SETQ NEW.NAME (PROMPT.READ))
(COND
((NOT (ATOM NEW.NAME))
(TRILLIUM.PRINTOUT "Name must be one word")
(RETURN))
((FIND.INTERFACE NEW.NAME)
(TRILLIUM.PRINTOUT "The name " NEW.NAME " is already in use")
(RETURN))
(T [SETQ NEW.INTERFACE
(ITEM.CREATE INTERFACE (NAME NEW.NAME)
[FRAMES (LIST (ITEM.CREATE FRAME (NAME (QUOTE BEGIN)))
(ITEM.CREATE FRAME (NAME (QUOTE BITMAPS))
(ITEMS (for SPEC in INITIAL.BITMAPS
bind (X ← 10)
collect
[SETQ BITMAP.ITEM
(ITEM.CREATE
BITMAP
(PLACEMENT (CONS X 200))
(NAME (CAR SPEC))
(BITMAP (CADR SPEC]
[SETQ X
(IPLUS X 10
(fetch (BITMAP
BITMAPWIDTH)
of (CADR SPEC]
BITMAP.ITEM)))
(ITEM.CREATE FRAME (NAME (QUOTE COLORS))
(ITEMS (GET.COLORS.FOR.COLOR.FRAME]
(FIRST.FRAME (QUOTE BEGIN))
(COLOR.MAP.INTENSITIES (COND
(COLOR.AVAILABLE
TRILLIUM.COLOR.MAP.INTENSITIES)
(T NIL)))
(BACKGROUND.COLOR (QUOTE WHITE]
(ADD.NEW.INTERFACE NEW.INTERFACE)
(MARK.INTERFACE NEW.INTERFACE T)
(RETURN NEW.NAME])
(EDIT.COLOR.MAP
[LAMBDA (INTERFACE) (* PH "31-Aug-84 13:10")
(PROG [(COLORMAP (COLORMAPCREATE (GET.FIELDQ INTERFACE COLOR.MAP.INTENSITIES]
(COND
((AND (NOT (COLORDISPLAYP))
(CONFIRM "Do you want the colordisplay on?"))
(COLOR.ON.OFF)))
(SETQ COLORMAP (EDITCOLORMAP COLORMAP))
(COND
((CONFIRM "Make changes to interface?")
(INSTALL.COLOR.MAP INTERFACE (INTENSITIESFROMCOLORMAP COLORMAP])
(FIND.COLOR.NUMBER
[LAMBDA (COLOR.NAME) (* PH "12-Sep-84 11:23")
(* HaKo "27-Jul-84 16:40")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(OR (NUMBERP COLOR.NAME (SELECTQ COLOR.NAME
(CLEAR NIL)
(WHITE 0)
(BLACK 15)
(for ITEM in (GET.FIELDQ (FIND.FRAME CURRENT.INTERFACE
(QUOTE COLORS))
ITEMS FRAME)
when (AND (EQ (ITEM.TYPE ITEM)
(QUOTE COLOR))
(EQ (GET.PARAMQ ITEM NAME)
COLOR.NAME))
do (RETURN (GET.PARAMQ ITEM COLOR))
finally (TRILLIUM.PRINTOUT T "Color " COLOR.NAME
" not found!"
T)
(RETURN 15])
(FIND.REPRESENTATIVE.GRAY
[LAMBDA (COLOR) (* PH "12-Sep-84 11:24")
(* COLOR CAN BE A NAME OR A NUMBER)
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (PARAM (GRAY))
(COND
((NUMBERP COLOR)
(SETQ PARAM (QUOTE COLOR)))
((LITATOM COLOR)
(SETQ PARAM (QUOTE NAME)))
(T (SHOULDNT "Incorrect color spec in Find.Representative.Gray")))
(for ITEM in (GET.FIELDQ (FIND.FRAME CURRENT.INTERFACE (QUOTE COLORS))
ITEMS FRAME)
when (AND (EQUAL (ITEM.TYPE ITEM)
(QUOTE COLOR))
(EQUAL (GET.PARAM ITEM PARAM COLOR)
COLOR))
do (SETQ GRAY (GET.PARAMQ ITEM REPRESENTATIVE.GRAY COLOR)))
(RETURN (OR GRAY 42405])
(FLIP.BOX
[LAMBDA (BOX) (* PH "15-Jun-84 16:01")
(FLIP.REGION.IN.WINDOW BOX CURRENT.DSP)
(COND
(IN.LIVING.COLOR (BITBLT NIL NIL NIL TRILLIUM.COLOR.DSP (fetch (REGION LEFT) of BOX)
(fetch (REGION BOTTOM) of BOX)
(fetch (REGION WIDTH) of BOX)
(fetch (REGION HEIGHT) of BOX)
(QUOTE TEXTURE)
(QUOTE INVERT)
15])
(GET.COLORS.FOR.COLOR.FRAME
[LAMBDA NIL (* PH " 8-Jun-84 13:04")
(LIST (ITEM.CREATE COLOR (PLACEMENT (QUOTE (0 . 10)))
(NAME (QUOTE BLACK))
(COLOR 0)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (50 . 10)))
(NAME (QUOTE BLUE))
(COLOR 1)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (100 . 10)))
(NAME (QUOTE GREEN))
(COLOR 2)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (150 . 10)))
(NAME (QUOTE RED))
(COLOR 3)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (200 . 10)))
(NAME (QUOTE YELLOW))
(COLOR 4)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (250 . 10)))
(NAME (QUOTE MAGENTA))
(COLOR 5)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (300 . 10)))
(NAME (QUOTE CYAN))
(COLOR 6)
(REPRESENTATIVE.GRAY 65535))
(ITEM.CREATE COLOR (PLACEMENT (QUOTE (350 . 10)))
(NAME (QUOTE WHITE))
(COLOR 7)
(REPRESENTATIVE.GRAY 0])
(GET.CONTROL.WINDOW.COMMAND.MENU
[LAMBDA NIL (* PH "13-Sep-84 12:17")
(DECLARE (GLOBALVARS CONTROL.WINDOW.COMMAND.MENU))
(SETQ CONTROL.WINDOW.COMMAND.MENU (create MENU
ITEMS ←(QUOTE ((DISPLAY.BILLBOARD NIL
"Puts up a billboard announcing Trillium")
(" " NIL "No action")
(SETUP.EVENT.MODE NIL
"For setting the mode for the event recording and playback mechanism")
(TURN.COLOR.ON.OR.OFF NIL
"Controls turning color screen on & off")
(" " NIL "No action")
(CREATE.NEW.INTERFACE NIL
"Will prompt for a name for a new interface, and then create it")
(COPY.INTERFACE NIL
"Will prompt for a interface, and a name for a copy, and then make the copy")
(DELETE.INTERFACE NIL
"Will prompt for a interface, and then delete it")
(MERGE.INTERFACE NIL
"Will prompt for two interfaces, and then merge the second into the first")
(OPEN.WINDOW.FOR.INTERFACE NIL
"Will prompt for a interface, and then open a window for it")
(" " NIL "No action")
(EDIT.ITEM.TYPES NIL
"Gives access to the item types")
(EDIT.USER.PROFILE NIL
"will open an editor for the user profile")
(" " NIL "No action")
(LOADING.&.MAKING.FILES NIL
"Access to functions for loading and making files containing interfaces and itemtypes")))
MENUFONT ←(FONTCREATE (QUOTE HELVETICA)
12)
MENUOUTLINESIZE ← 0
WHENSELECTEDFN ←(QUOTE
CONTROL.WINDOW.WHENSELECTEDFN.REFER])
(GET.MANIPULATE.INTERFACE.COMMAND.MENU
[LAMBDA NIL (* PH "31-Aug-84 13:29")
(* HaKo " 8-Aug-84 12:39")
(* WHEN MENU CHANGES EVAL: (SETQ
MANIPULATE.INTERFACE.COMMAND.MENU NIL))
(DECLARE (GLOBALVARS MANIPULATE.INTERFACE.COMMAND.MENU))
(OR MANIPULATE.INTERFACE.COMMAND.MENU (SETQ MANIPULATE.INTERFACE.COMMAND.MENU
(create MENU
ITEMS ←(QUOTE (ANALYZE.INTERFACE ANALYZE.INTERFACE.WHERE.NECESSARY RESET.INTERFACE
HARDCOPY.INTERFACE USED.ITEM.TYPES
UNDEFINED.ITEM.TYPES SET.FIRST.FRAME (" " NIL)
SET.BACKGROUND.COLOR EDIT.COLOR.MAP
SWITCH.COLOR.MAPS SAVE.COLOR.MAP
RETRIEVE.SAVED.COLOR.MAP (" " NIL)
INSPECT.MACHINE.STATE SET.INTERFACE.LOCATION
SET.WINDOW.FROM.INTERFACE CENTER.FRAME.IN.WINDOW
FIT.WINDOW.AROUND.FRAME ALIGN.FRAME.WITH.WINDOW
(" " NIL)
QUIT))
TITLE ← "Interface manipulation"
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(INSTALL.COLOR.MAP
[LAMBDA (INTERFACE COLOR.MAP.INTENSITIES) (* PH "31-Aug-84 13:33")
(DECLARE (GLOBALVARS CURRENT.FRAME IN.LIVING.COLOR TRILLIUM.COLOR.DSP TRILLIUM.COLOR.MAP
TRILLIUM.COLOR.MAP.INTENSITIES))
(PROG (COLORMAP)
(COND
(COLOR.MAP.INTENSITIES (SET.FIELDQ INTERFACE COLOR.MAP.INTENSITIES COLOR.MAP.INTENSITIES))
)
(SETQ COLORMAP (COLORMAPCREATE (OR COLOR.MAP.INTENSITIES (GET.FIELDQ INTERFACE
COLOR.MAP.INTENSITIES)
TRILLIUM.COLOR.MAP.INTENSITIES)))
(COND
(IN.LIVING.COLOR (SETQ TRILLIUM.COLOR.MAP COLORMAP)
(CLEARCOLORSCREEN (DSPBACKCOLOR NIL TRILLIUM.COLOR.DSP))
(SCREENCOLORMAP TRILLIUM.COLOR.MAP)
(DISPLAY.FRAME CURRENT.FRAME])
(MANIPULATE.INTERFACE
[LAMBDA (INTERFACE) (* PH "12-Sep-84 11:27")
(* DAHJr "31-Mar-84 17:42")
(DECLARE (GLOBALVARS CURRENT.FRAME CURRENT.INTERFACE CURRENT.INTERFACE.WINDOW ITEM.TYPES))
(PROG (COMMAND.MENU COMMAND INTERFACE.NAME ITYPES FRAME.NAME COLOR.MAP COLOR.NAME)
(SETQ COMMAND.MENU (GET.MANIPULATE.INTERFACE.COMMAND.MENU))
(SETQ INTERFACE.NAME (GET.FIELDQ INTERFACE NAME INTERFACE))
(do (SETQ COMMAND (MENU COMMAND.MENU))
(TRILLIUM.CLEAR.ALL.PROMPTING)
(SELECTQ COMMAND
(NIL)
(QUIT (RETURN))
(ANALYZE.INTERFACE (TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Analyzing all frames in interface "
INTERFACE.NAME)
(ANALYZE.INTERFACE INTERFACE)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Interface "
INTERFACE.NAME " fully re-analyzed."))
(ANALYZE.INTERFACE.WHERE.NECESSARY (TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Analyzing unanalyzed frames in interface "
INTERFACE.NAME)
(ANALYZE.INTERFACE INTERFACE T)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Interface "
INTERFACE.NAME
" fully analyzed."))
[RESET.INTERFACE (COND
((CONFIRM (CONCAT "Reset interface " INTERFACE.NAME))
(RESET.INTERFACE INTERFACE T)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Interface "
INTERFACE.NAME " reset."]
(HARDCOPY.INTERFACE (HARDCOPY.INTERFACE INTERFACE))
(USED.ITEM.TYPES (SETQ ITYPES (USED.ITEM.TYPES INTERFACE))
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
"Item types used in interface "
INTERFACE.NAME T)
(for ITYPE in ITYPES do (TRILLIUM.PRINTOUT ON
TRILLIUM.DESCRIPTIONS
SAME.LINE ITYPE 1))
)
[UNDEFINED.ITEM.TYPES (SETQ ITYPES (LDIFFERENCE (USED.ITEM.TYPES INTERFACE)
ITEM.TYPES))
(COND
(ITYPES (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
"Item types used but not defined in interface "
INTERFACE.NAME T)
(for ITYPE in ITYPES
do (TRILLIUM.PRINTOUT ON
TRILLIUM.DESCRIPTIONS
SAME.LINE ITYPE 1)))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
"All item types used in interface "
INTERFACE.NAME " are defined"]
[SET.FIRST.FRAME (SETQ FRAME.NAME (ACQUIRE.FRAME.NAME INTERFACE))
(COND
(FRAME.NAME (SET.FIELDQ INTERFACE FIRST.FRAME FRAME.NAME
DIALOG)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW
"First frame is now "
FRAME.NAME]
(EDIT.COLOR.MAP (EDIT.COLOR.MAP INTERFACE))
[SET.BACKGROUND.COLOR (SETQ COLOR.NAME (CREATE.COLOR.NAME))
(COND
(COLOR.NAME (SET.FIELDQ INTERFACE BACKGROUND.COLOR
COLOR.NAME INTERFACE)
(DISPLAY.FRAME CURRENT.FRAME]
(SWITCH.COLOR.MAPS (SWITCH.COLOR.MAPS INTERFACE))
(SAVE.COLOR.MAP (SAVE.COLOR.MAP INTERFACE))
[RETRIEVE.SAVED.COLOR.MAP (SETQ COLOR.MAP (RETRIEVE.SAVED.COLOR.MAP))
(COND
(COLOR.MAP (COND
((CONFIRM "Save current color map?")
(SAVE.COLOR.MAP INTERFACE)))
(INSTALL.COLOR.MAP INTERFACE COLOR.MAP)
(DISPLAY.FRAME CURRENT.FRAME))
(T (TRILLIUM.PRINTOUT ON PROMPTWINDOW
"No color map has been saved"]
(SET.INTERFACE.LOCATION (SET.FIELDQ CURRENT.INTERFACE REGION
(WINDOWPROP CURRENT.INTERFACE.WINDOW
(QUOTE REGION))
INTERFACE)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Location of the interface set from the current window"))
(INSPECT.MACHINE.STATE (INSPECTW.REDISPLAY (TRILLIUM.TRACE.MACHINE.WINDOW
CURRENT.INTERFACE.WINDOW))
NIL)
(SET.WINDOW.FROM.INTERFACE (LOWERLEFTW CURRENT.INTERFACE.WINDOW)
(SHAPEW CURRENT.INTERFACE.WINDOW
(GET.FIELDQ INTERFACE REGION INTERFACE)))
(CENTER.FRAME.IN.WINDOW (TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Command not implemented yet"))
(FIT.WINDOW.AROUND.FRAME (TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Command not implemented yet"))
(ALIGN.FRAME.WITH.WINDOW (INTERFACE.WINDOW.LOWERLEFT INTERFACE
CURRENT.INTERFACE.WINDOW))
(SHOULDNT])
(RETRIEVE.SAVED.COLOR.MAP
[LAMBDA NIL (* PH "12-Sep-84 11:28")
(DECLARE (GLOBALVARS TRILLIUM.SAVED.COLOR.MAP))
(PROG (MAP)
(COND
((SETQ MAP TRILLIUM.SAVED.COLOR.MAP)
(SETQ TRILLIUM.SAVED.COLOR.MAP))
(T (TRILLIUM.PRINTOUT ON PROMPTWINDOW T "No color map has been saved" T)))
(RETURN MAP])
(SAVE.COLOR.MAP
[LAMBDA (INTERFACE) (* PH "31-Aug-84 12:50")
(DECLARE (GLOBALVARS TRILLIUM.SAVED.COLOR.MAP))
(COND
((AND TRILLIUM.SAVED.COLOR.MAP (NOT (CONFIRM "Colormap already saved, save anyway?")))
NIL)
(T (SETQ TRILLIUM.SAVED.COLOR.MAP (GET.FIELDQ INTERFACE COLOR.MAP.INTENSITIES])
(SHOW.ARTWORK.IN.COLOR
[LAMBDA (BITMAP X Y W H SOURCE OPERATION TEXTURE FIGURE-COLOR GROUND-COLOR)
(* PH "12-Sep-84 11:35")
(DECLARE (GLOBALVARS CURRENT.INTERFACE TRILLIUM.COLOR.DSP WHOLECOLORDISPLAY))
(PROG (OLD.1COLOR OLD.0COLOR)
(COND
((ENCLOSESP WHOLECOLORDISPLAY
(create REGION
LEFT ← X
BOTTOM ← Y
WIDTH ← W
HEIGHT ← H))
[COND
((EQ SOURCE (QUOTE TEXTURE))
(SETQ TEXTURE (FIND.COLOR.NUMBER FIGURE-COLOR)))
((EQUAL SOURCE (QUOTE INVERT))
(SETQ OLD.1COLOR (DSPCOLOR (FIND.COLOR.NUMBER (OR GROUND-COLOR (GET.FIELDQ
CURRENT.INTERFACE
BACKGROUND.COLOR)))
TRILLIUM.COLOR.DSP))
(SETQ OLD.0COLOR (DSPBACKCOLOR (FIND.COLOR.NUMBER FIGURE-COLOR)
TRILLIUM.COLOR.DSP)))
(T (SETQ OLD.1COLOR (DSPCOLOR (FIND.COLOR.NUMBER FIGURE-COLOR)
TRILLIUM.COLOR.DSP))
(SETQ OLD.0COLOR (DSPBACKCOLOR (FIND.COLOR.NUMBER (OR GROUND-COLOR
(GET.FIELDQ
CURRENT.INTERFACE
BACKGROUND.COLOR)))
TRILLIUM.COLOR.DSP]
(BITBLT BITMAP NIL NIL TRILLIUM.COLOR.DSP X Y W H SOURCE (QUOTE REPLACE)
TEXTURE)
(DSPCOLOR OLD.1COLOR TRILLIUM.COLOR.DSP)
(DSPBACKCOLOR OLD.0COLOR TRILLIUM.COLOR.DSP)
(RETURN T))
(T (TRILLIUM.PRINTOUT ON PROMPTWINDOW T "ARTWORK NOT IN REGION OF COLOR DISPLAY" T])
(SHOW.COLORED.BITMAP
[LAMBDA (BITMAP XCOORD YCOORD SOURCE OPERATION TEXTURE FIGURE-COLOR GROUND-COLOR)
(* PH "31-Aug-84 13:48")
(* edited: "11-JUN-82 12:26")
(DECLARE (GLOBALVARS BLACKSHADE CURRENT.DSP IN.LIVING.COLOR))
(PROG (X Y 0COLOR 1COLOR 1GRAY 0GRAY W H OLD.1COLOR OLD.0COLOR)
(SETQ W (fetch (BITMAP BITMAPWIDTH) of BITMAP))
(SETQ H (fetch (BITMAP BITMAPHEIGHT) of BITMAP))
(COND
((LISTP XCOORD)
(SETQ X (fetch (POSITION XCOORD) of XCOORD))
(SETQ Y (fetch (POSITION YCOORD) of XCOORD)))
(T (SETQ X XCOORD)
(SETQ Y YCOORD)))
[COND
((AND (EQ FIGURE-COLOR (QUOTE BLACK))
(EQ GROUND-COLOR (QUOTE WHITE)))
(BITBLT BITMAP 0 0 CURRENT.DSP X Y W H SOURCE OPERATION TEXTURE))
(T (SETQ 1GRAY (FIND.REPRESENTATIVE.GRAY FIGURE-COLOR))
(BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE INPUT)
(QUOTE ERASE))
(SELECTQ OPERATION
(REPLACE (SETQ 0GRAY (FIND.REPRESENTATIVE.GRAY GROUND-COLOR))
(BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE MERGE)
(QUOTE PAINT)
1GRAY)
(BITBLT NIL 0 0 BITMAP 0 0 W H (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE INPUT)
(QUOTE ERASE))
(BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE MERGE)
(QUOTE PAINT)
0GRAY)
(BITBLT NIL 0 0 BITMAP 0 0 W H (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE))
(PAINT (BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE MERGE)
(QUOTE PAINT)
1GRAY))
(INVERT (BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE MERGE)
(QUOTE PAINT)
1GRAY))
(ERASE (BITBLT BITMAP 0 0 CURRENT.DSP X Y W H (QUOTE MERGE)
(QUOTE PAINT)
1GRAY))
(TROUBLE.WITH.TRILLIUM "Unrecognized operation" OPERATION]
(COND
(IN.LIVING.COLOR (SHOW.ARTWORK.IN.COLOR BITMAP X Y W H SOURCE OPERATION TEXTURE
FIGURE-COLOR GROUND-COLOR])
(SWITCH.COLOR.MAPS
[LAMBDA (INTERFACE) (* PH "31-Aug-84 12:53")
(DECLARE (GLOBALVARS TRILLIUM.COLOR.MAP.INTENSITIES TRILLIUM.GRAYSCALE.INTENSITIES))
(PROG (MAP.NAME COLORMAP.INTENSITIES)
(SETQ MAP.NAME (MENU (create MENU
ITEMS ←(LIST (QUOTE GRAYSCALE)
(QUOTE COLOR)
(QUOTE SAVED.COLOR.MAP))
TITLE ← "Choose color map"
CHANGEOFFSETFLG ← T
CENTERFLG ← T)))
(SELECTQ MAP.NAME
(NIL (RETURN))
(GRAYSCALE (SETQ COLORMAP.INTENSITIES TRILLIUM.GRAYSCALE.INTENSITIES))
(SAVED.COLOR.MAP (OR (SETQ COLORMAP.INTENSITIES (RETRIEVE.SAVED.COLOR.MAP
INTERFACE))
(RETURN)))
(COLOR (SETQ COLORMAP.INTENSITIES TRILLIUM.COLOR.MAP.INTENSITIES))
(SHOULDNT))
(COND
((CONFIRM "Save current color map?")
(SAVE.COLOR.MAP INTERFACE)))
(INSTALL.COLOR.MAP INTERFACE COLORMAP.INTENSITIES])
(TRILLIUM.COLOR.FILENAME
[LAMBDA (FILE COMPILED) (* kkm "26-Nov-84 12:03")
(DECLARE (GLOBALVARS COMPILE.EXT TRILLIUM.DIRECTORY TRILLIUM.HOST))
(PROG (DIRECTORY.STR)
(RETURN (PACKFILENAME (QUOTE HOST)
TRILLIUM.HOST
(QUOTE DIRECTORY)
(COND
((STREQUAL (SUBSTRING (SETQ DIRECTORY.STR (MKSTRING
TRILLIUM.DIRECTORY))
-7)
"SOURCES")
(CONCAT (SUBSTRING DIRECTORY.STR 1 -8)
"COLOR"))
(T TRILLIUM.DIRECTORY))
(QUOTE NAME)
FILE])
(UPGRADE.INTERFACE.TO.COLOR
[LAMBDA (INTERFACE.NAME DESTROY.COLOR.FRAME?) (* PH "13-Sep-84 10:46")
(DECLARE (SPECVARS INTERFACE.NAME))
(PROG (INTERFACE COLORFRAME ITEMS COUNT)
(SETQ INTERFACE (FIND.INTERFACE INTERFACE.NAME))
[COND
((NULL INTERFACE)
(RETURN (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Undefined interface: " INTERFACE.NAME]
(COND
((GET.FIELDQ INTERFACE COLOR.MAP.INTENSITIES))
(T (SET.FIELDQ INTERFACE COLOR.MAP.INTENSITIES TRILLIUM.COLOR.MAP.INTENSITIES)))
(SETQ COLORFRAME (FIND.FRAME INTERFACE (QUOTE COLORS)))
(* * Add color frame if there isn't one & Change color frame to have the default colors if necessary)
(COND
((NULL COLORFRAME)
(TRILLIUM.PRINTOUT T "Creating frame COLORS in interface " INTERFACE.NAME T)
[ADD.NEW.FRAME INTERFACE (SETQ COLORFRAME (ITEM.CREATE FRAME (NAME (QUOTE COLORS]
(MARK.INTERFACE INTERFACE)))
(SETQ ITEMS (GET.FIELDQ COLORFRAME ITEMS))
(COND
([OR DESTROY.COLOR.FRAME? (NULL ITEMS)
(AND (EQUAL (LENGTH ITEMS)
1)
(EQUAL (ITEM.TYPE (CAR ITEMS))
(QUOTE COLOR]
(SET.FIELD COLORFRAME (QUOTE ITEMS)
(GET.COLORS.FOR.COLOR.FRAME))
(RESET.FRAME COLORFRAME)
(RETURN)))
(SETQ COUNT 0)
[for ITEM in ITEMS do (COND
((EQUAL (ITEM.TYPE ITEM)
(QUOTE COLOR))
(ADD1 COUNT]
(COND
((IGREATERP COUNT 7))
(T (TRILLIUM.PRINTOUT T "Could not change items in color frame of interface " T
"If you wish to do it, type (UPGRADE.INTERFACE.TO.COLOR "
INTERFACE.NAME " T)"])
)
(RPAQ? IN.LIVING.COLOR )
(RPAQ? TRILLIUM.COLOR.DSP )
(RPAQ? TRILLIUM.COLOR.MAP )
(RPAQ? TRILLIUM.SAVED.COLOR.MAP )
(DECLARE: DONTCOPY
(FILEMAP (NIL (919 27077 (CLEARCOLORSCREEN 929 . 1168) (CLEAR&SHOW.FRAME 1170 . 1988) (COLOR.INIT 1990
. 4362) (COLOR.ON.OFF 4364 . 5710) (CREATE.NEW.INTERFACE 5712 . 7372) (EDIT.COLOR.MAP 7374 . 7879) (
FIND.COLOR.NUMBER 7881 . 8656) (FIND.REPRESENTATIVE.GRAY 8658 . 9497) (FLIP.BOX 9499 . 9967) (
GET.COLORS.FOR.COLOR.FRAME 9969 . 11209) (GET.CONTROL.WINDOW.COMMAND.MENU 11211 . 12950) (
GET.MANIPULATE.INTERFACE.COMMAND.MENU 12952 . 14107) (INSTALL.COLOR.MAP 14109 . 14891) (
MANIPULATE.INTERFACE 14893 . 19447) (RETRIEVE.SAVED.COLOR.MAP 19449 . 19842) (SAVE.COLOR.MAP 19844 .
20204) (SHOW.ARTWORK.IN.COLOR 20206 . 21656) (SHOW.COLORED.BITMAP 21658 . 23805) (SWITCH.COLOR.MAPS
23807 . 24800) (TRILLIUM.COLOR.FILENAME 24802 . 25370) (UPGRADE.INTERFACE.TO.COLOR 25372 . 27075)))))
STOP