(FILECREATED "23-Aug-84 17:36:19" {ICE}<TRILLIUM>BIRTHDAY84>BETA>TRI-SHOW.;2 16797 changes to: (FNS EDIT.COLOR.MAP) previous date: "17-Aug-84 23:33:21" {ICE}<TRILLIUM>BIRTHDAY84>BETA>TRI-SHOW.;1) (* Copyright (c) 1984 by Xerox Corporation) (PRETTYCOMPRINT TRI-SHOWCOMS) (RPAQQ TRI-SHOWCOMS ((FNS BIGGER.BOX CLEAR&SHOW.FRAME CLEAR.BORDER.EXTERIOR CLEAR.BORDER.INTERIOR DEFAULT.DISPLAY.FN DEFAULT.SHOW.FN DISPLAY.FRAME DISPLAY.ITEM EDIT.COLOR.MAP GET.ALTERNATE.DSP GET.COLOR.MAP INSTALL.COLOR.MAP REGION.WITHIN.BORDER SHOW.CAPTION SHOW.COLORED.BITMAP SHOW.FRAME SHOW.FRAME* SHOW.ITEM SHOW.PRINT.IN.BOX SHOW.PRINTED.LINE SHOW.PRINTED.LINES SWITCH.DSP) (VARS BIGGER.BOX.AMOUNT (CURRENT.DSP) (TRILLIUM.FAST.DISPLAY.FLG T)))) (DEFINEQ (BIGGER.BOX [LAMBDA (BOX AMOUNT) (* DAHJr "26-MAR-81 11:23") (DECLARE (GLOBALVARS BIGGER.BOX.AMOUNT)) (OR AMOUNT (SETQ AMOUNT BIGGER.BOX.AMOUNT)) (LIST (IDIFFERENCE (CAR BOX) AMOUNT) (IDIFFERENCE (CADR BOX) AMOUNT) (IPLUS (CADDR BOX) (ITIMES AMOUNT 2)) (IPLUS (CADDDR BOX) (ITIMES AMOUNT 2]) (CLEAR&SHOW.FRAME [LAMBDA (FRAME) (* DAHJr " 8-DEC-83 17:59") (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] (SHOW.FRAME* FRAME) (ACTIVATE.DISPLAYERS* FRAME]) (CLEAR.BORDER.EXTERIOR [LAMBDA (ITEM) (* HaKo "27-Jul-84 16:36") (DECLARE (GLOBALVARS CURRENT.DSP)) (PROG ((REGION (GET.PARAMQ ITEM PLACEMENT BORDER)) (THICKNESS (GET.PARAMQ ITEM THICKNESS))) (BITBLT NIL NIL NIL CURRENT.DSP (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]) (CLEAR.BORDER.INTERIOR [LAMBDA (ITEM) (* HaKo "27-Jul-84 16:37") (* edited: "30-MAR-82 16:14") (DECLARE (GLOBALVARS CURRENT.DSP)) (PROG ((REGION (GET.PARAMQ ITEM PLACEMENT BORDER)) (THICKNESS (GET.PARAMQ ITEM THICKNESS))) (BITBLT NIL NIL NIL CURRENT.DSP (IPLUS THICKNESS (fetch (REGION LEFT) of REGION)) (IPLUS THICKNESS (fetch (REGION BOTTOM) of REGION)) (IDIFFERENCE (fetch (REGION WIDTH) of REGION) (ADD1 (LSH THICKNESS 1))) (IDIFFERENCE (fetch (REGION HEIGHT) of REGION) (ADD1 (LSH THICKNESS 1))) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE]) (DEFAULT.DISPLAY.FN [LAMBDA (ITEM) (* HaKo "27-Jul-84 11:50") (MISSING.ITYPE.FN ITEM (QUOTE DISPLAY]) (DEFAULT.SHOW.FN [LAMBDA (ITEM) (* HaKo "27-Jul-84 11:48") (MISSING.ITYPE.FN ITEM (QUOTE SHOW]) (DISPLAY.FRAME [LAMBDA (FRAME INITIALIZE?) (* HaKo "15-Aug-84 16:53") (DECLARE (GLOBALVARS TRILLIUM.FAST.DISPLAY.FLG)) (ANALYZE.FRAME.IF.NECESSARY FRAME) (SET.FRAME.CONTEXT.IF.NECESSARY FRAME) (COND ((NULL TRILLIUM.FAST.DISPLAY.FLG) (* SWITCH DSP'S BEFORE INITIALIZING) (RESETFORM (SWITCH.DSP T) (COND (INITIALIZE? (ACTIVATE.INITIALIZATIONS FRAME))) (CLEAR&SHOW.FRAME FRAME))) (T (* Switching off the display while painting the new frame is much faster than first painting it to an alternate screen and then copying the alternate screen to the real screen. Firstly, display off increases the # of cycles available by about 50 percent. Secondly, alternate screen bitmap may be as big as the whole screen, which is about 200 pages -- guaranteed to incur page fault penalty!) (RESETFORM (SETDISPLAYHEIGHT 0) (COND (INITIALIZE? (ACTIVATE.INITIALIZATIONS FRAME))) (CLEAR&SHOW.FRAME FRAME]) (DISPLAY.ITEM [LAMBDA (ITEM FRAME) (* HaKo " 8-Aug-84 10:05") (if (NULL (NLSETQ (APPLY* (OR (GETPROP (ITEM.TYPE ITEM) (QUOTE DISPLAY)) (FUNCTION DEFAULT.DISPLAY.FN)) ITEM FRAME))) then (REPORT.LISP.ERROR "displaying an item" ITEM]) (EDIT.COLOR.MAP [LAMBDA (INTERFACE) (* PH "23-Aug-84 17:04") (DECLARE (GLOBALVARS COLOR.AVAILABLE)) (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Would edit color map if color was available") COLOR.AVAILABLE]) (GET.ALTERNATE.DSP [LAMBDA (INTERFACE.WINDOW) (* HaKo "15-Aug-84 17:03") (DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW)) (OR (WINDOWP INTERFACE.WINDOW) (SETQ INTERFACE.WINDOW CURRENT.INTERFACE.WINDOW)) (PROG (DSP BM ALTERNATE.DSP ALTERNATE.BM) (SETQ DSP (WINDOWPROP INTERFACE.WINDOW (QUOTE DSP))) (SETQ BM (DSPDESTINATION NIL DSP)) (SETQ ALTERNATE.DSP (WINDOWPROP INTERFACE.WINDOW (QUOTE ALTERNATE.DSP))) [if ALTERNATE.DSP then (SETQ ALTERNATE.BM (DSPDESTINATION NIL ALTERNATE.DSP)) else (WINDOWPROP INTERFACE.WINDOW (QUOTE ALTERNATE.DSP) (SETQ ALTERNATE.DSP (DSPCREATE] (if (OR (NULL ALTERNATE.BM) (NEQ (BITMAPWIDTH BM) (BITMAPWIDTH ALTERNATE.BM)) (NEQ (BITMAPHEIGHT BM) (BITMAPHEIGHT ALTERNATE.BM))) then (SETQ ALTERNATE.BM (BITMAPCOPY BM)) (DSPDESTINATION ALTERNATE.BM ALTERNATE.DSP)) (RETURN ALTERNATE.DSP]) (GET.COLOR.MAP [LAMBDA (INTERFACE) (* DAHJr " 8-DEC-83 17:14") (PROG (COLORMAP) (SETQ COLORMAP (GET.FIELDQ INTERFACE COLOR.MAP)) (COND ((NULL COLORMAP) (SETQ COLORMAP "create a color map") (SET.FIELDQ INTERFACE COLOR.MAP COLORMAP))) (RETURN COLORMAP]) (INSTALL.COLOR.MAP [LAMBDA (INTERFACE) (* DAHJr " 8-DEC-83 17:22") (DECLARE (GLOBALVARS IN.LIVING.COLOR)) (COND (IN.LIVING.COLOR (* * INSTALL.COLOR.MAP (GET.COLOR.MAP INTERFACE)) ]) (REGION.WITHIN.BORDER [LAMBDA (REGION THICKNESS) (* edited: "21-JUN-82 19:57") (create REGION LEFT ←(IPLUS (fetch (REGION LEFT) of REGION) THICKNESS) BOTTOM ←(IPLUS (fetch (REGION BOTTOM) of REGION) THICKNESS) WIDTH ←(IDIFFERENCE (fetch (REGION WIDTH) of REGION) (LSH THICKNESS 1)) HEIGHT ←(IDIFFERENCE (fetch HEIGHT of REGION) (LSH THICKNESS 1]) (SHOW.CAPTION [LAMBDA (LIST.OF.LINES XCOORD YCOORD XALIGNMENT YALIGNMENT FONT DS) (* edited: "15-JUN-82 11:51") (DECLARE (GLOBALVARS CURRENT.DSP)) (PROG ((DSP (OR DS CURRENT.DSP)) FNT HEIGHT TX TY WIDTH OLDFNT DESCENT) (SETQ FNT (OR FONT (DSPFONT NIL DSP))) (SETQ HEIGHT (FONTPROP FNT (QUOTE HEIGHT))) (SETQ DESCENT (FONTPROP FNT (QUOTE DESCENT))) (SETQ TY (IPLUS (SELECTQ YALIGNMENT [BOTTOM (IPLUS YCOORD (ITIMES HEIGHT (SUB1 (LENGTH LIST.OF.LINES] (TOP YCOORD) (IPLUS YCOORD (IQUOTIENT (ITIMES HEIGHT (LENGTH LIST.OF.LINES)) 2))) DESCENT)) (SETQ OLDFNT (DSPFONT NIL DSP)) (DSPFONT FNT DSP) (for LINE in LIST.OF.LINES do (SETQ WIDTH (STRINGWIDTH LINE FNT)) (SETQ TX (SELECTQ XALIGNMENT (CENTER (IDIFFERENCE XCOORD (IQUOTIENT WIDTH 2))) (RIGHT (IDIFFERENCE XCOORD WIDTH)) XCOORD)) (MOVETO TX TY DSP) (PRIN1 LINE DSP) (SETQ TY (IDIFFERENCE TY HEIGHT))) (DSPFONT OLDFNT DSP]) (SHOW.COLORED.BITMAP [LAMBDA (BITMAP XCOORD YCOORD SOURCE OPERATION TEXTURE FIGURE-COLOR GROUND-COLOR) (* edited: "11-JUN-82 12:26") (DECLARE (GLOBALVARS CURRENT.DSP IN.LIVING.COLOR WHOLECOLORDISPLAY)) (PROG (X Y 0COLOR 1COLOR 1GRAY 0GRAY W H DEST) (SETQ W (fetch (BITMAP BITMAPWIDTH) of BITMAP)) (SETQ H (fetch (BITMAP BITMAPHEIGHT) of BITMAP)) (SETQ DEST CURRENT.DSP) (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 DEST X Y W H SOURCE OPERATION TEXTURE)) (T (SELECTQ OPERATION (REPLACE (SETQ 1GRAY (FIND.REPRESENTATIVE.GRAY FIGURE-COLOR)) (SETQ 0GRAY (FIND.REPRESENTATIVE.GRAY GROUND-COLOR)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE INPUT) (QUOTE ERASE)) (BITBLT BITMAP 0 0 DEST 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 DEST X Y W H (QUOTE INPUT) (QUOTE ERASE)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE MERGE) (QUOTE PAINT) 0GRAY) (BITBLT NIL 0 0 BITMAP 0 0 W H (QUOTE TEXTURE) (QUOTE INVERT) BLACKSHADE)) (PAINT (SETQ 1GRAY (FIND.REPRESENTATIVE.GRAY FIGURE-COLOR)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE INPUT) (QUOTE ERASE)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE MERGE) (QUOTE PAINT) 1GRAY)) (INVERT (SETQ 1GRAY (FIND.REPRESENTATIVE.GRAY FIGURE-COLOR)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE INPUT) (QUOTE ERASE)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE MERGE) (QUOTE PAINT) 1GRAY)) (ERASE (SETQ 1GRAY (FIND.REPRESENTATIVE.GRAY FIGURE-COLOR)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE INPUT) (QUOTE ERASE)) (BITBLT BITMAP 0 0 DEST X Y W H (QUOTE MERGE) (QUOTE PAINT) 1GRAY)) (TROUBLE.WITH.TRILLIUM "Unrecognized operation" OPERATION] (COND (IN.LIVING.COLOR (SETQ 1COLOR (FIND.COLOR.NUMBER FIGURE-COLOR)) (SETQ 0COLOR (FIND.COLOR.NUMBER GROUND-COLOR)) (COND ((ENCLOSESP WHOLECOLORDISPLAY (create REGION LEFT ← X BOTTOM ← Y WIDTH ← W HEIGHT ← H)) (COLORBLT BITMAP NIL X Y OPERATION 0COLOR 1COLOR]) (SHOW.FRAME [LAMBDA (FRAME) (* DAHJr "23-JUN-82 20:21") (for ITEM in (GET.FIELDQ FRAME ARTWORK FRAME) do (SHOW.ITEM ITEM)) (for ITEM in (GET.FIELDQ FRAME DISPLAYERS) do (SHOW.ITEM (CADR ITEM]) (SHOW.FRAME* [LAMBDA (FRAME) (* DAHJr " 5-JAN-84 19:35") (* (for SUPERFRAME.NAME bind SUPERFRAME in (GET.FIELDQ FRAME SUPERFRAMES FRAME) do (COND ((SETQ SUPERFRAME (FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME)) (SHOW.FRAME* SUPERFRAME)) (T (TRILLIUM.PRINTOUT "Frame " (GET.FIELDQ FRAME NAME) " has superframe " SUPERFRAME.NAME " which doesn't exist" " (showing)")))) (SHOW.FRAME FRAME)) (DECLARE (GLOBALVARS FRAME.ALL.ARTWORK FRAME.ALL.DISPLAYERS)) (for ITEM in FRAME.ALL.ARTWORK do (SHOW.ITEM ITEM)) (for ITEM in FRAME.ALL.DISPLAYERS do (SHOW.ITEM (CADR ITEM]) (SHOW.ITEM [LAMBDA (ITEM) (* HaKo " 8-Aug-84 10:03") (if (NULL (NLSETQ (APPLY* (OR (GETPROP (ITEM.TYPE ITEM) (QUOTE SHOW)) (FUNCTION DEFAULT.SHOW.FN)) ITEM))) then (REPORT.LISP.ERROR "showing an item" ITEM]) (SHOW.PRINT.IN.BOX [LAMBDA (LIST.OF.LINES BOX X.ALIGNMENT Y.ALIGNMENT SOURCE OPERATION TEXTURE FONT DSP) (* HaKo " 8-SEP-83 12:07") (DECLARE (GLOBALVARS CURRENT.DSP)) (OR DSP (SETQ DSP CURRENT.DSP)) (OR FONT (SETQ FONT (DSPFONT NIL DSP))) (PROG ((LEFT (fetch (REGION LEFT) of BOX)) (BOTTOM (fetch (REGION BOTTOM) of BOX)) (WIDTH (fetch (REGION WIDTH) of BOX)) (HEIGHT (fetch (REGION HEIGHT) of BOX)) (FONT.HEIGHT (FONTPROP FONT (QUOTE HEIGHT))) (OLD.CLIPPING.REGION (DSPCLIPPINGREGION NIL DSP)) LINES.X LINES.Y) (DSPCLIPPINGREGION BOX DSP) (* If we knew for certain that it returned the old region, should be made into RESETFORM) (SETQ LINES.X (SELECTQ X.ALIGNMENT (LEFT LEFT) (CENTER (IPLUS LEFT (RSH WIDTH 1))) (RIGHT (IPLUS LEFT WIDTH)) (SHOULDNT))) (SETQ LINES.Y (SELECTQ Y.ALIGNMENT (BOTTOM BOTTOM) (CENTER (IPLUS BOTTOM (RSH (IDIFFERENCE HEIGHT FONT.HEIGHT) 1))) (TOP (IPLUS BOTTOM (IDIFFERENCE HEIGHT FONT.HEIGHT))) (SHOULDNT))) (SHOW.PRINTED.LINES LIST.OF.LINES LINES.X LINES.Y X.ALIGNMENT Y.ALIGNMENT SOURCE OPERATION TEXTURE FONT DSP) (DSPCLIPPINGREGION OLD.CLIPPING.REGION DSP]) (SHOW.PRINTED.LINE [LAMBDA (LINE XCOORD YCOORD SOURCE OPERATION TEXTURE FONT DSP) (* HaKo " 8-SEP-83 11:41") (DECLARE (GLOBALVARS ANALYZE.LOT.DSP CURRENT.DSP)) (OR DSP (SETQ DSP CURRENT.DSP)) (OR FONT (SETQ FONT (DSPFONT NIL DSP))) (PROG (BITMAP [DISPLAY.STREAM (OR ANALYZE.LOT.DSP (SETQ ANALYZE.LOT.DSP (DSPCREATE] (FONT.HEIGHT (FONTPROP FONT (QUOTE HEIGHT))) (FONT.DESCENT (FONTPROP FONT (QUOTE DESCENT))) (WIDTH (STRINGWIDTH LINE FONT))) (SETQ BITMAP (BITMAPCREATE WIDTH FONT.HEIGHT)) (DSPDESTINATION BITMAP DISPLAY.STREAM) (DSPFONT FONT DISPLAY.STREAM) (DSPXPOSITION 0 DISPLAY.STREAM) (DSPYPOSITION FONT.DESCENT DISPLAY.STREAM) (PRIN1 LINE DISPLAY.STREAM) (BITBLT BITMAP 0 0 DSP XCOORD YCOORD WIDTH FONT.HEIGHT SOURCE OPERATION TEXTURE]) (SHOW.PRINTED.LINES [LAMBDA (LIST.OF.LINES XCOORD YCOORD X.ALIGNMENT Y.ALIGNMENT SOURCE OPERATION TEXTURE FONT DSP) (* HaKo " 8-SEP-83 11:30") (DECLARE (GLOBALVARS CURRENT.DSP)) (OR DSP (SETQ DSP CURRENT.DSP)) (OR FONT (SETQ FONT (DSPFONT NIL DSP))) (PROG (TX TY WIDTH (FONT.HEIGHT (FONTPROP FONT (QUOTE HEIGHT))) (FONT.DESCENT (FONTPROP FONT (QUOTE DESCENT))) (OLDFONT (DSPFONT NIL DSP))) (SETQ TY (SELECTQ Y.ALIGNMENT [BOTTOM (IPLUS YCOORD (ITIMES FONT.HEIGHT (SUB1 (LENGTH LIST.OF.LINES] (CENTER (IPLUS YCOORD (IQUOTIENT (ITIMES FONT.HEIGHT (SUB1 (LENGTH LIST.OF.LINES))) 2))) (TOP YCOORD) (SHOULDNT))) (DSPFONT FONT DSP) (* If we knew DSPFONT returns old font, this should be made into RESETFORM) (for LINE in LIST.OF.LINES do (SETQ WIDTH (STRINGWIDTH LINE FONT)) (SETQ TX (SELECTQ X.ALIGNMENT (LEFT XCOORD) (CENTER (IDIFFERENCE XCOORD (IQUOTIENT WIDTH 2))) (RIGHT (IDIFFERENCE XCOORD WIDTH)) (SHOULDNT))) (SHOW.PRINTED.LINE LINE TX TY SOURCE OPERATION TEXTURE FONT DSP) (SETQ TY (IDIFFERENCE TY FONT.HEIGHT))) (DSPFONT OLDFONT DSP]) (SWITCH.DSP [LAMBDA (ENTRYFLG) (* HaKo "15-Aug-84 16:54") (DECLARE (GLOBALVARS CURRENT.DSP CURRENT.INTERFACE.WINDOW)) (PROG ((DSP (WINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE DSP))) (ALTERNATE.DSP (GET.ALTERNATE.DSP CURRENT.INTERFACE.WINDOW))) (if ENTRYFLG then (BITBLT DSP 0 0 (SETQ CURRENT.DSP ALTERNATE.DSP)) else (BITBLT ALTERNATE.DSP 0 0 (SETQ CURRENT.DSP DSP))) (WINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE CURRENT.DSP) CURRENT.DSP) (RETURN (NOT ENTRYFLG]) ) (RPAQQ BIGGER.BOX.AMOUNT 2) (RPAQQ CURRENT.DSP NIL) (RPAQQ TRILLIUM.FAST.DISPLAY.FLG T) (PUTPROPS TRI-SHOW COPYRIGHT ("Xerox Corporation" 1984)) (DECLARE: DONTCOPY (FILEMAP (NIL (787 16615 (BIGGER.BOX 797 . 1185) (CLEAR&SHOW.FRAME 1187 . 1919) (CLEAR.BORDER.EXTERIOR 1921 . 2458) (CLEAR.BORDER.INTERIOR 2460 . 3226) (DEFAULT.DISPLAY.FN 3228 . 3387) (DEFAULT.SHOW.FN 3389 . 3542) (DISPLAY.FRAME 3544 . 4619) (DISPLAY.ITEM 4621 . 4936) (EDIT.COLOR.MAP 4938 . 5207) ( GET.ALTERNATE.DSP 5209 . 6217) (GET.COLOR.MAP 6219 . 6572) (INSTALL.COLOR.MAP 6574 . 6839) ( REGION.WITHIN.BORDER 6841 . 7308) (SHOW.CAPTION 7310 . 8431) (SHOW.COLORED.BITMAP 8433 . 11070) ( SHOW.FRAME 11072 . 11357) (SHOW.FRAME* 11359 . 12063) (SHOW.ITEM 12065 . 12362) (SHOW.PRINT.IN.BOX 12364 . 13759) (SHOW.PRINTED.LINE 13761 . 14675) (SHOW.PRINTED.LINES 14677 . 16019) (SWITCH.DSP 16021 . 16613))))) STOP