(FILECREATED " 2-NOV-83 09:47:12" {ICE}<TRILLIUM>PCM3>UISS-ITEMTYPES.;1 39845
previous date: " 3-OCT-83 09:35:48" {ICE}<TRILLIUM>PCM2.5>UISS-ITEMTYPES;5)
(PRETTYCOMPRINT UISS-ITEMTYPESCOMS)
(RPAQQ UISS-ITEMTYPESCOMS ((ITEMTYPES PAGEICON 2LIGHT.BAR.REGION.W/BKGD BORDERED.SHADED.REGION
PARAGRAPH PARAGRAPH.SINGLE.FONT UISSPRIMTEXT UP.DOWNX10.BUTTONS)
))
(READ.ITEMTYPE PAGEICON 4)
(\TYPE ITEM.TYPE NAME PAGEICON COMMENT "A two-dimensional light bar with a bacground picture" KIND
DISPLAYER PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (100 . 100) COMMENT
"The placement of the lower left corner") (\TYPE PARAMETER NAME CELLS TYPE (STRUCTURE ((
BASETOP.CELL (CELL)) (BASEBOTTOM.CELL (CELL)) (BASELEFT.CELL (CELL)) (BASERIGHT.CELL (CELL)) (
MERGETOP.CELL (CELL)) (MERGEBOTTOM.CELL (CELL)) (MERGELEFT.CELL (CELL)) (MERGERIGHT.CELL (CELL)
))) DEFAULT (CELL.1 CELL.2 CELL.3 CELL.4 CELL.5 CELL.6 CELL.7 CELL.8) COMMENT
"A list of cells (BASETOP BASEBOTTOM BASELEFT BASERIGHT MERGETOP MERGEBOTTOM MERGELEFT MERGERIGHT) whose value are reflected by the base and merge windows in the region."
) (\TYPE PARAMETER NAME PAGEHEIGHT.CELL TYPE (CELL) DEFAULT CELL.1 COMMENT
"A cell containing the height of the page to be portrayed.") (\TYPE PARAMETER NAME PAGEWIDTH.CELL
TYPE (CELL) DEFAULT CELL.1 COMMENT "A cell containing the width of the page to be portrayed.") (
\TYPE PARAMETER NAME PIXELSPERINCH TYPE (INTEGER) DEFAULT 14 COMMENT
"The number of pixels per inch used to represent the page.") (\TYPE PARAMETER NAME HORIZONTAL.MINIMUM
TYPE (INTEGER) DEFAULT 1 COMMENT "The minimum value to be indicated in the horizontal direction")
(\TYPE PARAMETER NAME HORIZONTAL.MAXIMUM TYPE (INTEGER) DEFAULT 10 COMMENT
"The maximum value to be indicated in the horizontal direction") (\TYPE PARAMETER NAME
VERTICAL.MINIMUM TYPE (INTEGER) DEFAULT 1 COMMENT
"The minimum value to be indicated in the vertical direction") (\TYPE PARAMETER NAME VERTICAL.MAXIMUM
TYPE (INTEGER) DEFAULT 10 COMMENT "The maximum value to be indicated in the vertical direction") (
\TYPE PARAMETER NAME BACKGROUND.BITMAP TYPE (BITMAP.NAME) DEFAULT EXAMPLE.BITMAP COMMENT
"The background picture to be displayed") (\TYPE PARAMETER NAME BASEWINDOW.OPERATION TYPE (ONEOF (
REPLACE PAINT INVERT ERASE)) DEFAULT PAINT COMMENT "Operation for BITBLT for window area of region")
(\TYPE PARAMETER NAME BASEWINDOW.TEXTURE TYPE (SHADE) DEFAULT 0 COMMENT
"Texture for BITBLT for window area of region") (\TYPE PARAMETER NAME MERGEWINDOW.OPERATION TYPE (
ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT PAINT COMMENT
"Operation for BITBLT for window area of region") (\TYPE PARAMETER NAME MERGEWINDOW.TEXTURE TYPE (
SHADE) DEFAULT 0 COMMENT "Texture for BITBLT for window area of region") (\TYPE PARAMETER NAME
MARGIN.OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT REPLACE COMMENT
"Operation for BITBLT for margin portion of region") (\TYPE PARAMETER NAME MARGIN.TEXTURE TYPE (
SHADE) DEFAULT 65535 COMMENT "Texture for BITBLT for margin portion of region")) SUBITEM.SPECS NIL
OTHER (FNS ((BOUNDING.BOX BOUNDING.BOX.PAGEICON) (SHOW SHOW.PAGEICON) (DISPLAY DISPLAY.PAGEICON)))
)
(DEFINEQ
(BOUNDING.BOX.PAGEICON
[LAMBDA (ITEM) (* edited: "11-JUL-83 15:35")
(* (KKM) "11-FEB-83 10:26")
(PROG ((BITMAP (GET.FIELDQ ITEM BACKGROUND.BITMAP PAGEICON))
POS)
(OR (BITMAPP BITMAP)
(SETQ BITMAP (FIND.BITMAP BITMAP)))
(SETQ POS (GET.FIELDQ ITEM PLACEMENT))
(RETURN (LIST (fetch (POSITION XCOORD) of POS)
(fetch (POSITION YCOORD) of POS)
(fetch (BITMAP BITMAPWIDTH) of BITMAP)
(fetch (BITMAP BITMAPHEIGHT) of BITMAP])
(SHOW.PAGEICON
[LAMBDA (ITEM) (* edited: "14-MAY-82 11:44")
NIL])
(DISPLAY.PAGEICON
[LAMBDA (ITEM FRAME) (* edited: "11-JUL-83 15:35")
(* (KKM) "11-FEB-83 11:30")
(PROG (CELLS CURRENT.BASETOP CURRENT.BASEBOTTOM CURRENT.BASELEFT CURRENT.BASERIGHT
CURRENT.MERGETOP CURRENT.MERGEBOTTOM CURRENT.MERGELEFT CURRENT.MERGERIGHT POS BITMAP
HMAX HMIN VMAX VMIN X Y MX MY WIDTH HEIGHT VSCALE HSCALE VSTEPS HSTEPS Y.MIDDLE
HEIGHT.MIDDLE MWIDTH MHEIGHT MY.MIDDLE MHEIGHT.MIDDLE BASEWINDOW.OPERATION
MERGEWINDOW.OPERATION MERGEWINDOW.TEXTURE MARGIN.OPERATION MARGIN.TEXTURE DRAW.WIDTH
DRAW.HEIGHT PIXEL)
(SETQ POS (GET.FIELDQ ITEM PLACEMENT PAGEICON))
(SETQ HMIN (GET.FIELDQ ITEM HORIZONTAL.MINIMUM))
(SETQ HMAX (GET.FIELDQ ITEM HORIZONTAL.MAXIMUM))
(SETQ VMIN (GET.FIELDQ ITEM VERTICAL.MINIMUM))
(SETQ VMAX (GET.FIELDQ ITEM VERTICAL.MAXIMUM))
(SETQ CELLS (GET.FIELDQ ITEM CELLS))
(SETQ DRAW.HEIGHT (GET.CURRENT.VALUE (GET.FIELDQ ITEM PAGEHEIGHT.CELL)))
(SETQ DRAW.WIDTH (GET.CURRENT.VALUE (GET.FIELDQ ITEM PAGEWIDTH.CELL)))
(SETQ PIXEL (GET.FIELDQ ITEM PIXELSPERINCH))
(SETQ CURRENT.BASETOP (IDIFFERENCE (GET.CURRENT.VALUE (CAR CELLS))
VMIN))
(SETQ CURRENT.BASEBOTTOM (IDIFFERENCE (GET.CURRENT.VALUE (CADR CELLS))
VMIN))
(SETQ CURRENT.BASELEFT (IDIFFERENCE (GET.CURRENT.VALUE (CADDR CELLS))
HMIN))
(SETQ CURRENT.BASERIGHT (IDIFFERENCE (GET.CURRENT.VALUE (CADDDR CELLS))
HMIN))
(SETQ CURRENT.MERGETOP (IDIFFERENCE [GET.CURRENT.VALUE (CAR (CDR (CDDDR CELLS]
VMIN))
(SETQ CURRENT.MERGEBOTTOM (IDIFFERENCE [GET.CURRENT.VALUE
(CAR (CDR (CDR (CDDDR CELLS]
VMIN))
(SETQ CURRENT.MERGELEFT (IDIFFERENCE [GET.CURRENT.VALUE
(CAR (CDR (CDR (CDR (CDDDR CELLS]
HMIN))
(SETQ CURRENT.MERGERIGHT (IDIFFERENCE
[GET.CURRENT.VALUE (CAR (CDR (CDR (CDR (CDR (CDDDR CELLS]
HMIN))
(SETQ BASEWINDOW.OPERATION (GET.FIELDQ ITEM BASEWINDOW.OPERATION))
(SETQ BASEWINDOW.TEXTURE (GET.FIELDQ ITEM BASEWINDOW.TEXTURE))
(SETQ MERGEWINDOW.OPERATION (GET.FIELDQ ITEM MERGEWINDOW.OPERATION))
(SETQ MERGEWINDOW.TEXTURE (GET.FIELDQ ITEM MERGEWINDOW.TEXTURE))
(SETQ MARGIN.OPERATION (GET.FIELDQ ITEM MARGIN.OPERATION))
(SETQ MARGIN.TEXTURE (GET.FIELDQ ITEM MARGIN.TEXTURE))
(SETQ BITMAP (GET.FIELDQ ITEM BACKGROUND.BITMAP))
[SETQ BITMAP (BITMAPCOPY (OR (BITMAPP BITMAP)
(FIND.BITMAP BITMAP]
(SETQ BITMAP (DRAW.PAGE DRAW.WIDTH DRAW.HEIGHT BITMAP PIXEL))
(SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of BITMAP))
(SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP))
(SETQ X (fetch (POSITION XCOORD) of POS))
(SETQ Y (fetch (POSITION YCOORD) of POS))
(SETQ VSTEPS (IDIFFERENCE VMAX VMIN))
(SETQ VSCALE (FQUOTIENT HEIGHT VSTEPS))
(SETQ HSTEPS (IDIFFERENCE HMAX HMIN))
(SETQ HSCALE (FQUOTIENT WIDTH HSTEPS))
(SETQ Y.MIDDLE (FIX (PLUS (TIMES VSCALE CURRENT.BASEBOTTOM)
.99)))
(SETQ HEIGHT.MIDDLE (FIX (PLUS (TIMES VSCALE (IDIFFERENCE VSTEPS (IPLUS CURRENT.BASETOP
CURRENT.BASEBOTTOM)))
.99)))
(SETQ X.LEFT (FIX (PLUS (TIMES HSCALE CURRENT.BASELEFT)
.99)))
(SETQ WIDTH.RIGHT (FIX (PLUS (TIMES HSCALE CURRENT.BASERIGHT)
.99)))
(SETQ X.RIGHT (IDIFFERENCE WIDTH WIDTH.RIGHT))
(SETQ MY.MIDDLE (FIX (PLUS (TIMES VSCALE CURRENT.MERGEBOTTOM)
.99)))
(SETQ MHEIGHT.MIDDLE (FIX (PLUS (TIMES VSCALE (IDIFFERENCE VSTEPS (IPLUS CURRENT.MERGETOP
CURRENT.MERGEBOTTOM)))
.99)))
(SETQ MX.LEFT (FIX (PLUS (TIMES HSCALE CURRENT.MERGELEFT)
.99)))
(SETQ MWIDTH.RIGHT (FIX (PLUS (TIMES HSCALE CURRENT.MERGERIGHT)
.99)))
(SETQ MX.RIGHT (IDIFFERENCE WIDTH MWIDTH.RIGHT))
(OR (EQ CURRENT.BASEBOTTOM 0)
(BITBLT NIL 0 0 BITMAP 0 0 WIDTH Y.MIDDLE (QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (EQ CURRENT.BASELEFT 0)
(BITBLT NIL 0 0 BITMAP 0 Y.MIDDLE X.LEFT HEIGHT.MIDDLE (QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (EQ CURRENT.BASERIGHT 0)
(BITBLT NIL 0 0 BITMAP X.RIGHT Y.MIDDLE WIDTH.RIGHT HEIGHT.MIDDLE (QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (EQ CURRENT.BASETOP 0)
(BITBLT NIL 0 0 BITMAP 0 (IPLUS Y.MIDDLE HEIGHT.MIDDLE)
WIDTH
(FIX (PLUS (TIMES VSCALE CURRENT.BASETOP)
.99))
(QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (OR (IGEQ (IPLUS CURRENT.BASETOP CURRENT.BASEBOTTOM)
VSTEPS)
(IGEQ (IPLUS CURRENT.BASERIGHT CURRENT.BASELEFT)
HSTEPS))
(BITBLT NIL 0 0 BITMAP X.LEFT Y.MIDDLE (IDIFFERENCE X.RIGHT X.LEFT)
HEIGHT.MIDDLE
(QUOTE TEXTURE)
BASEWINDOW.OPERATION BASEWINDOW.TEXTURE))
(OR (OR (IGEQ (IPLUS CURRENT.MERGETOP CURRENT.MERGEBOTTOM)
VSTEPS)
(IGEQ (IPLUS CURRENT.MERGERIGHT CURRENT.MERGELEFT)
HSTEPS))
(BITBLT NIL 0 0 BITMAP MX.LEFT MY.MIDDLE (IDIFFERENCE MX.RIGHT MX.LEFT)
MHEIGHT.MIDDLE
(QUOTE TEXTURE)
MERGEWINDOW.OPERATION MERGEWINDOW.TEXTURE))
(BITBLT BITMAP 0 0 CURRENT.DSP X Y NIL NIL (QUOTE INPUT)
(QUOTE REPLACE])
)
(READ.ITEMTYPE 2LIGHT.BAR.REGION.W/BKGD 4)
(\TYPE ITEM.TYPE NAME 2LIGHT.BAR.REGION.W/BKGD COMMENT
"A two-dimensional light bar with a bacground picture" KIND DISPLAYER PARAMETERS ((\TYPE PARAMETER
NAME PLACEMENT TYPE (POSITION) DEFAULT (100 . 100) COMMENT "The placement of the lower left corner"
) (\TYPE PARAMETER NAME CELLS TYPE (STRUCTURE ((BASETOP.CELL (CELL)) (BASEBOTTOM.CELL (CELL)) (
BASELEFT.CELL (CELL)) (BASERIGHT.CELL (CELL)) (MERGETOP.CELL (CELL)) (MERGEBOTTOM.CELL (CELL))
(MERGELEFT.CELL (CELL)) (MERGERIGHT.CELL (CELL)))) DEFAULT (CELL.1 CELL.2 CELL.3 CELL.4 CELL.5
CELL.6 CELL.7 CELL.8) COMMENT
"A list of cells (BASETOP BASEBOTTOM BASELEFT BASERIGHT MERGETOP MERGEBOTTOM MERGELEFT MERGERIGHT) whose value are reflected by the base and merge windows in the region."
) (\TYPE PARAMETER NAME PAGEHEIGHT.CELL TYPE (CELL) DEFAULT CELL.1 COMMENT
"A cell containing the height of the page to be portrayed.") (\TYPE PARAMETER NAME PAGEWIDTH.CELL
TYPE (CELL) DEFAULT CELL.1 COMMENT "A cell containing the width of the page to be portrayed.") (
\TYPE PARAMETER NAME PIXELSPERINCH TYPE (INTEGER) DEFAULT 14 COMMENT
"The number of pixels per inch used to represent the page.") (\TYPE PARAMETER NAME HORIZONTAL.MINIMUM
TYPE (INTEGER) DEFAULT 1 COMMENT "The minimum value to be indicated in the horizontal direction")
(\TYPE PARAMETER NAME HORIZONTAL.MAXIMUM TYPE (INTEGER) DEFAULT 10 COMMENT
"The maximum value to be indicated in the horizontal direction") (\TYPE PARAMETER NAME
VERTICAL.MINIMUM TYPE (INTEGER) DEFAULT 1 COMMENT
"The minimum value to be indicated in the vertical direction") (\TYPE PARAMETER NAME VERTICAL.MAXIMUM
TYPE (INTEGER) DEFAULT 10 COMMENT "The maximum value to be indicated in the vertical direction") (
\TYPE PARAMETER NAME BACKGROUND.BITMAP TYPE (BITMAP.NAME) DEFAULT EXAMPLE.BITMAP COMMENT
"The background picture to be displayed") (\TYPE PARAMETER NAME BASEWINDOW.OPERATION TYPE (ONEOF (
REPLACE PAINT INVERT ERASE)) DEFAULT PAINT COMMENT "Operation for BITBLT for window area of region")
(\TYPE PARAMETER NAME BASEWINDOW.TEXTURE TYPE (SHADE) DEFAULT 0 COMMENT
"Texture for BITBLT for window area of region") (\TYPE PARAMETER NAME MERGEWINDOW.OPERATION TYPE (
ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT PAINT COMMENT
"Operation for BITBLT for window area of region") (\TYPE PARAMETER NAME MERGEWINDOW.TEXTURE TYPE (
SHADE) DEFAULT 0 COMMENT "Texture for BITBLT for window area of region") (\TYPE PARAMETER NAME
MARGIN.OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT REPLACE COMMENT
"Operation for BITBLT for margin portion of region") (\TYPE PARAMETER NAME MARGIN.TEXTURE TYPE (
SHADE) DEFAULT 65535 COMMENT "Texture for BITBLT for margin portion of region")) SUBITEM.SPECS NIL
OTHER (FNS ((BOUNDING.BOX BOUNDING.BOX.2LIGHT.BAR.REGION.W/BKGD) (SHOW
SHOW.2LIGHT.BAR.REGION.W/BKGD) (DISPLAY DISPLAY.2LIGHT.BAR.REGION.W/BKGD))))
(DEFINEQ
(BOUNDING.BOX.2LIGHT.BAR.REGION.W/BKGD
[LAMBDA (ITEM) (* edited: " 1-APR-83 13:03")
(* (KKM) "11-FEB-83 10:26")
(PROG ((BITMAP (GET.FIELDQ ITEM BACKGROUND.BITMAP 2LIGHT.BAR.REGION.W/BKGD))
POS)
(OR (BITMAPP BITMAP)
(SETQ BITMAP (FIND.BITMAP BITMAP)))
(SETQ POS (GET.FIELDQ ITEM PLACEMENT))
(RETURN (LIST (fetch (POSITION XCOORD) of POS)
(fetch (POSITION YCOORD) of POS)
(fetch (BITMAP BITMAPWIDTH) of BITMAP)
(fetch (BITMAP BITMAPHEIGHT) of BITMAP])
(SHOW.2LIGHT.BAR.REGION.W/BKGD
[LAMBDA (ITEM) (* edited: "14-MAY-82 11:44")
NIL])
(DISPLAY.2LIGHT.BAR.REGION.W/BKGD
[LAMBDA (ITEM FRAME) (* edited: "11-JUL-83 13:00")
(* (KKM) "11-FEB-83 11:30")
(PROG (CELLS CURRENT.BASETOP CURRENT.BASEBOTTOM CURRENT.BASELEFT CURRENT.BASERIGHT
CURRENT.MERGETOP CURRENT.MERGEBOTTOM CURRENT.MERGELEFT CURRENT.MERGERIGHT POS BITMAP
HMAX HMIN VMAX VMIN X Y MX MY WIDTH HEIGHT VSCALE HSCALE VSTEPS HSTEPS Y.MIDDLE
HEIGHT.MIDDLE MWIDTH MHEIGHT MY.MIDDLE MHEIGHT.MIDDLE BASEWINDOW.OPERATION
MERGEWINDOW.OPERATION MERGEWINDOW.TEXTURE MARGIN.OPERATION MARGIN.TEXTURE DRAW.WIDTH
DRAW.HEIGHT PIXEL)
(SETQ POS (GET.FIELDQ ITEM PLACEMENT 2LIGHT.BAR.REGION.W/BKGD))
(SETQ HMIN (GET.FIELDQ ITEM HORIZONTAL.MINIMUM))
(SETQ HMAX (GET.FIELDQ ITEM HORIZONTAL.MAXIMUM))
(SETQ VMIN (GET.FIELDQ ITEM VERTICAL.MINIMUM))
(SETQ VMAX (GET.FIELDQ ITEM VERTICAL.MAXIMUM))
(SETQ CELLS (GET.FIELDQ ITEM CELLS))
(SETQ DRAW.HEIGHT (GET.CURRENT.VALUE (GET.FIELDQ ITEM PAGEHEIGHT.CELL)))
(SETQ DRAW.WIDTH (GET.CURRENT.VALUE (GET.FIELDQ ITEM PAGEWIDTH.CELL)))
(SETQ PIXEL (GET.FIELDQ ITEM PIXELSPERINCH))
(SETQ CURRENT.BASETOP (IDIFFERENCE (GET.CURRENT.VALUE (CAR CELLS))
VMIN))
(SETQ CURRENT.BASEBOTTOM (IDIFFERENCE (GET.CURRENT.VALUE (CADR CELLS))
VMIN))
(SETQ CURRENT.BASELEFT (IDIFFERENCE (GET.CURRENT.VALUE (CADDR CELLS))
HMIN))
(SETQ CURRENT.BASERIGHT (IDIFFERENCE (GET.CURRENT.VALUE (CADDDR CELLS))
HMIN))
(SETQ CURRENT.MERGETOP (IDIFFERENCE [GET.CURRENT.VALUE (CAR (CDR (CDDDR CELLS]
VMIN))
(SETQ CURRENT.MERGEBOTTOM (IDIFFERENCE [GET.CURRENT.VALUE
(CAR (CDR (CDR (CDDDR CELLS]
VMIN))
(SETQ CURRENT.MERGELEFT (IDIFFERENCE [GET.CURRENT.VALUE
(CAR (CDR (CDR (CDR (CDDDR CELLS]
HMIN))
(SETQ CURRENT.MERGERIGHT (IDIFFERENCE
[GET.CURRENT.VALUE (CAR (CDR (CDR (CDR (CDR (CDDDR CELLS]
HMIN))
(SETQ BASEWINDOW.OPERATION (GET.FIELDQ ITEM BASEWINDOW.OPERATION))
(SETQ BASEWINDOW.TEXTURE (GET.FIELDQ ITEM BASEWINDOW.TEXTURE))
(SETQ MERGEWINDOW.OPERATION (GET.FIELDQ ITEM MERGEWINDOW.OPERATION))
(SETQ MERGEWINDOW.TEXTURE (GET.FIELDQ ITEM MERGEWINDOW.TEXTURE))
(SETQ MARGIN.OPERATION (GET.FIELDQ ITEM MARGIN.OPERATION))
(SETQ MARGIN.TEXTURE (GET.FIELDQ ITEM MARGIN.TEXTURE))
(SETQ BITMAP (GET.FIELDQ ITEM BACKGROUND.BITMAP))
[SETQ BITMAP (BITMAPCOPY (OR (BITMAPP BITMAP)
(FIND.BITMAP BITMAP]
(SETQ BITMAP (PAGECREATOR DRAW.WIDTH DRAW.HEIGHT BITMAP PIXEL))
(SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of BITMAP))
(SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of BITMAP))
(SETQ X (fetch (POSITION XCOORD) of POS))
(SETQ Y (fetch (POSITION YCOORD) of POS))
(SETQ VSTEPS (IDIFFERENCE VMAX VMIN))
(SETQ VSCALE (FQUOTIENT HEIGHT VSTEPS))
(SETQ HSTEPS (IDIFFERENCE HMAX HMIN))
(SETQ HSCALE (FQUOTIENT WIDTH HSTEPS))
(SETQ Y.MIDDLE (FIX (PLUS (TIMES VSCALE CURRENT.BASEBOTTOM)
.99)))
(SETQ HEIGHT.MIDDLE (FIX (PLUS (TIMES VSCALE (IDIFFERENCE VSTEPS (IPLUS CURRENT.BASETOP
CURRENT.BASEBOTTOM)))
.99)))
(SETQ X.LEFT (FIX (PLUS (TIMES HSCALE CURRENT.BASELEFT)
.99)))
(SETQ WIDTH.RIGHT (FIX (PLUS (TIMES HSCALE CURRENT.BASERIGHT)
.99)))
(SETQ X.RIGHT (IDIFFERENCE WIDTH WIDTH.RIGHT))
(SETQ MY.MIDDLE (FIX (PLUS (TIMES VSCALE CURRENT.MERGEBOTTOM)
.99)))
(SETQ MHEIGHT.MIDDLE (FIX (PLUS (TIMES VSCALE (IDIFFERENCE VSTEPS (IPLUS CURRENT.MERGETOP
CURRENT.MERGEBOTTOM)))
.99)))
(SETQ MX.LEFT (FIX (PLUS (TIMES HSCALE CURRENT.MERGELEFT)
.99)))
(SETQ MWIDTH.RIGHT (FIX (PLUS (TIMES HSCALE CURRENT.MERGERIGHT)
.99)))
(SETQ MX.RIGHT (IDIFFERENCE WIDTH MWIDTH.RIGHT))
(OR (EQ CURRENT.BASEBOTTOM 0)
(BITBLT NIL 0 0 BITMAP 0 0 WIDTH Y.MIDDLE (QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (EQ CURRENT.BASELEFT 0)
(BITBLT NIL 0 0 BITMAP 0 Y.MIDDLE X.LEFT HEIGHT.MIDDLE (QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (EQ CURRENT.BASERIGHT 0)
(BITBLT NIL 0 0 BITMAP X.RIGHT Y.MIDDLE WIDTH.RIGHT HEIGHT.MIDDLE (QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (EQ CURRENT.BASETOP 0)
(BITBLT NIL 0 0 BITMAP 0 (IPLUS Y.MIDDLE HEIGHT.MIDDLE)
WIDTH
(FIX (PLUS (TIMES VSCALE CURRENT.BASETOP)
.99))
(QUOTE TEXTURE)
MARGIN.OPERATION MARGIN.TEXTURE))
(OR (OR (IGEQ (IPLUS CURRENT.BASETOP CURRENT.BASEBOTTOM)
VSTEPS)
(IGEQ (IPLUS CURRENT.BASERIGHT CURRENT.BASELEFT)
HSTEPS))
(BITBLT NIL 0 0 BITMAP X.LEFT Y.MIDDLE (IDIFFERENCE X.RIGHT X.LEFT)
HEIGHT.MIDDLE
(QUOTE TEXTURE)
BASEWINDOW.OPERATION BASEWINDOW.TEXTURE))
(OR (OR (IGEQ (IPLUS CURRENT.MERGETOP CURRENT.MERGEBOTTOM)
VSTEPS)
(IGEQ (IPLUS CURRENT.MERGERIGHT CURRENT.MERGELEFT)
HSTEPS))
(BITBLT NIL 0 0 BITMAP MX.LEFT MY.MIDDLE (IDIFFERENCE MX.RIGHT MX.LEFT)
MHEIGHT.MIDDLE
(QUOTE TEXTURE)
MERGEWINDOW.OPERATION MERGEWINDOW.TEXTURE))
(BITBLT BITMAP 0 0 CURRENT.DSP X Y NIL NIL (QUOTE INPUT)
(QUOTE REPLACE])
)
(READ.ITEMTYPE BORDERED.SHADED.REGION 4)
(\TYPE ITEM.TYPE NAME BORDERED.SHADED.REGION COMMENT "A bitmap to be added to the screen as artwork"
KIND COMPOSITE PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (REGION) DEFAULT (100 100 30 30)
COMMENT "The region to be shaded") (\TYPE PARAMETER NAME OPERATION TYPE (ONEOF (REPLACE PAINT
INVERT ERASE)) DEFAULT REPLACE COMMENT "Operation for BITBLT") (\TYPE PARAMETER NAME SHADE.TEXTURE
TYPE (SHADE) DEFAULT 42405 COMMENT "The texture for the shaded region") (\TYPE PARAMETER NAME
BORDER.THICKNESS TYPE (INTEGER) DEFAULT 2 COMMENT "The width in screen points of the border") (
\TYPE PARAMETER NAME BORDER.TEXTURE TYPE (SHADE) DEFAULT 65535 COMMENT "The texture for the border")
) SUBITEM.SPECS ((ITEM SHADED.REGION (PLACEMENT PLACEMENT) (OPERATION OPERATION) (TEXTURE
SHADE.TEXTURE)) (ITEM BORDER (PLACEMENT PLACEMENT) (THICKNESS BORDER.THICKNESS) (OPERATION
OPERATION) (COLOR BORDER.TEXTURE))) OTHER NIL)
(READ.ITEMTYPE PARAGRAPH 4)
(\TYPE ITEM.TYPE NAME PARAGRAPH COMMENT "A located line of text" KIND COMPOSITE PARAMETERS ((\TYPE
PARAMETER NAME PLACEMENT TYPE (REGION) DEFAULT (100 100 300 50) COMMENT
"The box within which the text is to be printed") (\TYPE PARAMETER NAME CONTENT TYPE (FORM) DEFAULT
(The text of a paragraph) COMMENT "A list of words and looks") (\TYPE PARAMETER NAME JUSTIFICATION
TYPE (ONEOF (LEFT CENTER RIGHT)) DEFAULT LEFT COMMENT "Horizontal alignment") (\TYPE PARAMETER
NAME FILLED.TO.EDGES TYPE (ONEOF (YES NO)) DEFAULT YES COMMENT "Horizontal alignment") (\TYPE
PARAMETER NAME FONT TYPE (FONT) DEFAULT (HELVETICA 14) COMMENT
"The font the line is to be printed in") (\TYPE PARAMETER NAME INTERLINE.SPACING TYPE (INTEGER)
DEFAULT 0 COMMENT "Space in addition to the normal font height") (\TYPE PARAMETER NAME SOURCE TYPE
(ONEOF (INPUT INVERT MERGE TEXTURE)) DEFAULT INPUT COMMENT "Source for BITBLT") (\TYPE PARAMETER
NAME OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT REPLACE COMMENT
"Operation for BITBLT") (\TYPE PARAMETER NAME TEXTURE TYPE (SHADE) DEFAULT 65535 COMMENT
"Texture for BITBLT") (\TYPE PARAMETER NAME FIGURE-COLOR TYPE (COLOR.NAME) DEFAULT BLACK COMMENT
"The color corresponding to the figure") (\TYPE PARAMETER NAME GROUND-COLOR TYPE (COLOR.NAME)
DEFAULT WHITE COMMENT "The color corresponding to ground")) SUBITEM.SPECS ((EVAL (ANALYZE.PARAGRAPH
) (LINE.OF.TEXT))) OTHER (FNS ((ANALYZE ANALYZE.PARAGRAPH) (NIL LAYOUT.LINE))))
(DEFINEQ
(ANALYZE.PARAGRAPH
[LAMBDA NIL (* DAHJr "14-JAN-83 10:51")
(PROG (LEFT WIDTH HEIGHT TOP BOTTOM FONT.DESCRIPTOR LINE.WIDTH FONT.FONT FONT.DESCRIPTOR
FONT.ASCENT FONT.SPACE.WIDTH ENTRY DONE WORD ENTRY CHAR SPACE CARRIAGE.RETURN
WIDTH.SO.FAR WIDTH.OF.WORDS.SO.FAR LINE.ASCENT LINE.DESCENT NEW.WIDTH SPACE.WIDTH
ITEMS WORD.WIDTH TY GOT.LINE ENDING.LINE FONT.STACK)
(SETQ LEFT (fetch (REGION LEFT) of PLACEMENT))
(SETQ BOTTOM (fetch (REGION BOTTOM) of PLACEMENT))
(SETQ WIDTH (fetch (REGION WIDTH) of PLACEMENT))
(SETQ HEIGHT (fetch (REGION HEIGHT) of PLACEMENT))
(SETQ TOP (IPLUS BOTTOM HEIGHT))
(SETQ LINE.WIDTH WIDTH)
(SETQ FONT.FONT FONT)
(SETQ FONT.DESCRIPTOR (FIND.FONT FONT))
(SETQ FONT.ASCENT (FONTPROP FONT.DESCRIPTOR (QUOTE ASCENT)))
(SETQ FONT.DESCENT (FONTPROP FONT.DESCRIPTOR (QUOTE DESCENT)))
(SETQ FONT.SPACE.WIDTH (STRINGWIDTH (QUOTE % )
FONT.DESCRIPTOR))
(SETQ ITEMS (CONS))
(SETQ LINE.WORDS (CONS))
(SETQ TY TOP)
(SETQ FIRST.WORD NIL)
(SETQ WIDTH.SO.FAR (MINUS FONT.SPACE.WIDTH))
(SETQ WIDTH.OF.WORDS.SO.FAR 0)
(SETQ LINE.ASCENT 0)
(SETQ LINE.DESCENT 0)
(SETQ ENTRY CONTENT)
[until DONE
do (COND
[ENTRY (SETQ WORD (CAR ENTRY))
(COND
((LISTP WORD)
(SELECTQ (CAR WORD)
(LINE.BREAK (SETQ ENDING.LINE T)
(SETQ GOT.LINE T))
(NEW.FONT (* PUSH A NEW FONT)
(SETQ FONT.STACK (CONS FONT.FONT FONT.STACK))
(SETQ FONT.FONT (CADR WORD))
(SETQ FONT.DESCRIPTOR (FIND.FONT FONT.FONT))
(SETQ FONT.ASCENT (FONTPROP FONT.DESCRIPTOR
(QUOTE ASCENT)))
(SETQ FONT.DESCENT (FONTPROP FONT.DESCRIPTOR
(QUOTE DESCENT)))
(SETQ FONT.SPACE.WIDTH (STRINGWIDTH (QUOTE % )
FONT.DESCRIPTOR)))
[PREVIOUS.FONT (COND
(FONT.STACK (SETQ FONT.FONT (CAR FONT.STACK))
(SETQ FONT.DESCRIPTOR FONT.FONT)
(SETQ FONT.STACK (CDR FONT.STACK))
(SETQ FONT.ASCENT
(FONTPROP FONT.DESCRIPTOR
(QUOTE ASCENT)))
(SETQ FONT.DESCENT
(FONTPROP FONT.DESCRIPTOR
(QUOTE DESCENT)))
(SETQ FONT.SPACE.WIDTH
(STRINGWIDTH (QUOTE % )
FONT.DESCRIPTOR)))
(T (printout PROMPTWINDOW T
"No PREVIOUS.FONT to return to at: "
ENTRY]
(ERROR (CAR WORD)
": unrecognized keyword in ANALYZE.PARAGRAPH"))
(SETQ ENTRY (CDR ENTRY)))
(T (SETQ WORD.WIDTH (STRINGWIDTH WORD FONT.DESCRIPTOR))
(SETQ NEW.WIDTH (IPLUS WIDTH.SO.FAR WORD.WIDTH FONT.SPACE.WIDTH))
(COND
((IGREATERP NEW.WIDTH LINE.WIDTH)
(* GOT A LINE)
[COND
((NULL (CAR LINE.WORDS))
(* SINGLE WORD IS LONGER THAN THE LINE)
(TCONC LINE.WORDS (LIST WORD FONT.FONT WORD.WIDTH
FONT.SPACE.WIDTH))
(SETQ WIDTH.OF.WORDS.SO.FAR (IPLUS WIDTH.OF.WORDS.SO.FAR
WORD.WIDTH))
(COND
((IGREATERP FONT.ASCENT LINE.ASCENT)
(SETQ LINE.ASCENT FONT.ASCENT)))
(COND
((IGREATERP FONT.DESCENT LINE.DESCENT)
(SETQ LINE.DESCENT FONT.DESCENT)))
(SETQ ENTRY (CDR ENTRY]
(SETQ GOT.LINE T))
(T (TCONC LINE.WORDS (LIST WORD FONT.FONT WORD.WIDTH FONT.SPACE.WIDTH)
)
(SETQ WIDTH.SO.FAR NEW.WIDTH)
(SETQ WIDTH.OF.WORDS.SO.FAR (IPLUS WIDTH.OF.WORDS.SO.FAR
WORD.WIDTH))
(COND
((IGREATERP FONT.ASCENT LINE.ASCENT)
(SETQ LINE.ASCENT FONT.ASCENT)))
(COND
((IGREATERP FONT.DESCENT LINE.DESCENT)
(SETQ LINE.DESCENT FONT.DESCENT)))
(SETQ ENTRY (CDR ENTRY]
(T (SETQ GOT.LINE T)
(SETQ ENDING.LINE T)
(SETQ DONE T)))
(COND
(GOT.LINE (* GOT A LINE)
(COND
((ZEROP LINE.ASCENT)
(SETQ LINE.ASCENT FONT.ASCENT)
(SETQ LINE.DESCENT FONT.DESCENT)))
(COND
((ILESSP (IDIFFERENCE TY (IPLUS LINE.ASCENT LINE.DESCENT))
BOTTOM)
(SETQ DONE T))
(T (LAYOUT.LINE (CAR LINE.WORDS)
WIDTH.OF.WORDS.SO.FAR ENDING.LINE LEFT LINE.WIDTH TY
LINE.ASCENT LINE.DESCENT ITEMS)
(SETQ TY (IDIFFERENCE TY (IPLUS LINE.ASCENT LINE.DESCENT
INTERLINE.SPACING)))
(SETQ LINE.WORDS (CONS))
(SETQ WIDTH.SO.FAR (MINUS FONT.SPACE.WIDTH))
(SETQ WIDTH.OF.WORDS.SO.FAR 0)
(SETQ ENDING.LINE)
(SETQ LINE.ASCENT 0)
(SETQ LINE.DESCENT 0)
(SETQ GOT.LINE]
(RETURN (CAR ITEMS])
(LAYOUT.LINE
[LAMBDA (WORDS TOTAL.WORD.WIDTH ENDING.LINE LEFT LINE.WIDTH LINE.TOP LINE.ASCENT LINE.DESCENT ITEMS
EXTRAS) (* DAHJr "13-JAN-83 21:30")
(* EACH WORD IS REALLY A LIST: WORD FONT WIDTH.OF.WORD
WIDTH.OF.A.SPACE)
(PROG (TX DX TY POSITION WORD.COUNT SPACE.WIDTH WORD)
(SETQ TY (IDIFFERENCE LINE.TOP LINE.ASCENT))
(SETQ WORD.COUNT (LENGTH WORDS))
(SELECTQ WORD.COUNT
(0 NIL)
[1 (* LINE HAS ONLY ONE WORD -
FILLING IS IRRELEVANT)
(SETQ WORD (CAR WORDS))
(SETQ TX (SELECTQ JUSTIFICATION
(LEFT LEFT)
(CENTER (IPLUS LEFT (IQUOTIENT (IDIFFERENCE LINE.WIDTH
TOTAL.WORD.WIDTH)
2)))
(RIGHT (IPLUS LEFT LINE.WIDTH (MINUS TOTAL.WORD.WIDTH)))
(REPORT.TRILLIUM.ERROR "unrecognized JUSTIFICATION"
JUSTIFICATION ITEM "laying out a line")
))
(SETQ POSITION (create POSITION
XCOORD ← TX
YCOORD ← TY))
(TCONC ITEMS (ITEM.CREATE LINE.OF.TEXT (PLACEMENT POSITION)
(LINE (CAR WORD))
(XALIGNMENT (QUOTE LEFT))
(FONT (CADR WORD))
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR]
(COND
[(AND (NULL ENDING.LINE)
(EQ FILLED.TO.EDGES (QUOTE YES)))
(* FILLING AND MORE THAN 1 WORD -
JUSTIFICATION IS IRRELEVANT)
(SETQ DX (IQUOTIENT (IDIFFERENCE LINE.WIDTH TOTAL.WORD.WIDTH)
(SUB1 WORD.COUNT)))
(SETQ EXTRAS (IREMAINDER (IDIFFERENCE LINE.WIDTH TOTAL.WORD.WIDTH)
(SUB1 WORD.COUNT)))
(SETQ TX LEFT)
(for WORD in WORDS as I from 0
do (SETQ POSITION (create POSITION
XCOORD ← TX
YCOORD ← TY))
(TCONC ITEMS (ITEM.CREATE LINE.OF.TEXT (PLACEMENT POSITION)
(LINE (CAR WORD))
(XALIGNMENT (QUOTE LEFT))
(FONT (CADR WORD))
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR)))
(SETQ TX (IPLUS TX (CADDR WORD)
DX))
(COND
((ILESSP I EXTRAS)
(SETQ TX (ADD1 TX]
(T (* NOT FILLING AND MORE THAN ONE WORD -
ADD UP THE SPACES)
[SETQ SPACE.WIDTH (for ENTRY on WORDS when (CDR ENTRY)
sum (* USES THE SMALLER OF THE TWO SPACES)
(MIN (CADDDR (CAR ENTRY))
(CADDDR (CADR ENTRY]
(SETQ TX (SELECTQ JUSTIFICATION
(LEFT LEFT)
(CENTER (IPLUS LEFT (IQUOTIENT (IDIFFERENCE LINE.WIDTH
(IPLUS
TOTAL.WORD.WIDTH
SPACE.WIDTH))
2)))
(RIGHT (IPLUS LEFT LINE.WIDTH (MINUS TOTAL.WORD.WIDTH)
(MINUS SPACE.WIDTH)))
(REPORT.TRILLIUM.ERROR "unrecognized JUSTIFICATION"
JUSTIFICATION ITEM
"laying out a line")))
(for ENTRY on WORDS
do (SETQ WORD (CAR ENTRY))
(SETQ POSITION (create POSITION
XCOORD ← TX
YCOORD ← TY))
(TCONC ITEMS (ITEM.CREATE LINE.OF.TEXT (PLACEMENT POSITION)
(LINE (CAR WORD))
(XALIGNMENT (QUOTE LEFT))
(FONT (CADR WORD))
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR)))
(COND
((CDR ENTRY)
(SETQ TX (IPLUS TX (CADDR WORD)
(MIN (CADDDR WORD)
(CADDDR (CADR ENTRY])
)
(READ.ITEMTYPE PARAGRAPH.SINGLE.FONT 4)
(\TYPE ITEM.TYPE NAME PARAGRAPH.SINGLE.FONT COMMENT "A located line of text" KIND COMPOSITE
PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (REGION) DEFAULT (100 100 300 50) COMMENT
"The box within which the text is to be printed") (\TYPE PARAMETER NAME TEXT TYPE (STRING) DEFAULT
"The text of a PARAGRAPH.SINGLE.FONT" COMMENT "The line of text itself") (\TYPE PARAMETER NAME
JUSTIFICATION TYPE (ONEOF (LEFT CENTER RIGHT)) DEFAULT LEFT COMMENT "Horizontal alignment") (\TYPE
PARAMETER NAME FILLED.TO.EDGES TYPE (ONEOF (YES NO)) DEFAULT YES COMMENT "Horizontal alignment")
(\TYPE PARAMETER NAME FONT TYPE (FONT) DEFAULT (HELVETICA 14) COMMENT
"The font the line is to be printed in") (\TYPE PARAMETER NAME INTERLINE.SPACING TYPE (INTEGER)
DEFAULT 0 COMMENT "Space in addition to the normal font height") (\TYPE PARAMETER NAME SOURCE TYPE
(ONEOF (INPUT INVERT MERGE TEXTURE)) DEFAULT INPUT COMMENT "Source for BITBLT") (\TYPE PARAMETER
NAME OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE)) DEFAULT REPLACE COMMENT
"Operation for BITBLT") (\TYPE PARAMETER NAME TEXTURE TYPE (SHADE) DEFAULT 65535 COMMENT
"Texture for BITBLT") (\TYPE PARAMETER NAME FIGURE-COLOR TYPE (COLOR.NAME) DEFAULT BLACK COMMENT
"The color corresponding to the figure") (\TYPE PARAMETER NAME GROUND-COLOR TYPE (COLOR.NAME)
DEFAULT WHITE COMMENT "The color corresponding to ground")) SUBITEM.SPECS ((EVAL (
ANALYZE.PARAGRAPH.SINGLE.FONT) (LINE.OF.TEXT))) OTHER (FNS ((ANALYZE ANALYZE.PARAGRAPH.SINGLE.FONT)
(NIL BREAK.INTO.WORDS))))
(DEFINEQ
(ANALYZE.PARAGRAPH.SINGLE.FONT
[LAMBDA NIL (* DAHJr "14-JAN-83 10:04")
(LIST (ITEM.CREATE PARAGRAPH (PLACEMENT PLACEMENT)
(CONTENT (BREAK.INTO.WORDS TEXT))
(JUSTIFICATION JUSTIFICATION)
(FILLED.TO.EDGES FILLED.TO.EDGES)
(FONT FONT)
(INTERLINE.SPACING INTERLINE.SPACING)
(SOURCE SOURCE)
(OPERATION OPERATION)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR])
(BREAK.INTO.WORDS
[LAMBDA (TEXT) (* DAHJr "13-JAN-83 16:35")
(* BREAKS UP A STRING INTO WORDS AND CARRIAGE RETURNS;
WORDS ARE BROKEN UP ON SPACES AND CARRIAGE RETURNS;
RETURNS A LIST OF WORDS)
(PROG (WORDS FIRST.CHARACTER DONE CHAR.COUNT CHAR SPACE CARRIAGE.RETURN)
(SETQ SPACE (CONSTANT (QUOTE % )))
(SETQ CARRIAGE.RETURN (CONSTANT (QUOTE %
)))
(SETQ WORDS (CONS))
(SETQ CHAR.COUNT (NCHARS TEXT))
(SETQ FIRST.CHARACTER NIL)
[for THIS.CHARACTER from 1 to CHAR.COUNT
do (SETQ CHAR (NTHCHAR TEXT THIS.CHARACTER))
(COND
[(OR (EQ CHAR SPACE)
(EQ CHAR CARRIAGE.RETURN))
(COND
(FIRST.CHARACTER (TCONC WORDS (SUBSTRING TEXT FIRST.CHARACTER (SUB1
THIS.CHARACTER)))
(SETQ FIRST.CHARACTER NIL)))
(COND
((EQ CHAR CARRIAGE.RETURN)
(TCONC WORDS (QUOTE (LINE.BREAK]
((NULL FIRST.CHARACTER)
(SETQ FIRST.CHARACTER THIS.CHARACTER)))
finally (COND
(FIRST.CHARACTER (TCONC WORDS (SUBSTRING TEXT FIRST.CHARACTER CHAR.COUNT]
(RETURN (CAR WORDS])
)
(READ.ITEMTYPE UISSPRIMTEXT 4)
(\TYPE ITEM.TYPE NAME UISSPRIMTEXT COMMENT "A located line of text" KIND ARTWORK PARAMETERS ((\TYPE
PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (100 . 100) COMMENT
"The left baseline of the first character of the line") (\TYPE PARAMETER NAME LINE TYPE (STRING)
DEFAULT "The text of UISSPRIMTEXT" COMMENT "The line of text itself") (\TYPE PARAMETER NAME
XALIGNMENT TYPE (ONEOF (LEFT CENTER RIGHT)) DEFAULT LEFT COMMENT "Horizontal alignment") (\TYPE
PARAMETER NAME FONT TYPE (FONT) DEFAULT (GACHA 10) COMMENT "The font the line is to be printed in")
(\TYPE PARAMETER NAME SOURCE TYPE (ONEOF (INPUT INVERT MERGE TEXTURE)) DEFAULT INPUT COMMENT
"Source for BITBLT") (\TYPE PARAMETER NAME OPERATION TYPE (ONEOF (REPLACE PAINT INVERT ERASE))
DEFAULT REPLACE COMMENT "Operation for BITBLT") (\TYPE PARAMETER NAME TEXTURE TYPE (SHADE) DEFAULT
65535 COMMENT "Texture for BITBLT") (\TYPE PARAMETER NAME FIGURE-COLOR TYPE (COLOR.NAME) DEFAULT
BLACK COMMENT "The color corresponding to the figure") (\TYPE PARAMETER NAME GROUND-COLOR TYPE (
COLOR.NAME) DEFAULT WHITE COMMENT "The color corresponding to ground")) SUBITEM.SPECS NIL OTHER (FNS
((SHOW SHOW.UISSPRIMTEXT) (BOUNDING.BOX BOUNDING.BOX.UISSPRIMTEXT))))
(DEFINEQ
(SHOW.UISSPRIMTEXT
[LAMBDA (ITEM) (* PH "28-SEP-83 13:59")
(PROG ((PLACEMENT (GET.FIELDQ ITEM PLACEMENT))
(LINE (GET.FIELDQ ITEM LINE))
(XALIGNMENT (GET.FIELDQ ITEM XALIGNMENT))
(FONT.DESCRIPTOR (FIND.FONT (GET.FIELDQ ITEM FONT)))
(SOURCE (GET.FIELDQ ITEM SOURCE))
(OPERATION (GET.FIELDQ ITEM OPERATION))
(TEXTURE (GET.FIELDQ ITEM TEXTURE))
(FIGURE-COLOR (GET.FIELDQ ITEM FIGURE-COLOR))
(GROUND-COLOR (GET.FIELDQ ITEM GROUND-COLOR))
XCOORD YCOORD HEIGHT WIDTH DESCENT TX TY OLDFONT OLDX OLDY)
(SETQ XCOORD (fetch (POSITION XCOORD) of PLACEMENT))
(SETQ YCOORD (fetch (POSITION YCOORD) of PLACEMENT))
(SETQ HEIGHT (FONTPROP FONT.DESCRIPTOR (QUOTE HEIGHT)))
(SETQ WIDTH (STRINGWIDTH LINE FONT.DESCRIPTOR))
(SETQ DESCENT (FONTPROP FONT.DESCRIPTOR (QUOTE DESCENT)))
(SETQ TX (SELECTQ XALIGNMENT
(LEFT XCOORD)
(CENTER (IDIFFERENCE XCOORD (IQUOTIENT WIDTH 2)))
(RIGHT (IDIFFERENCE XCOORD WIDTH))
(SHOULDNT "Unrecognized keyword in UISSPRIMTEXT")))
(SETQ TY (IDIFFERENCE YCOORD DESCENT))
(BITBLT CURRENT.DSP TX TY CURRENT.DSP TX TY WIDTH HEIGHT (QUOTE INPUT)
(QUOTE ERASE))
(SETQ OLDFONT (DSPFONT FONT.DESCRIPTOR CURRENT.DSP))
(SETQ OLDX (DSPXPOSITION TX CURRENT.DSP))
(SETQ OLDY (DSPYPOSITION YCOORD CURRENT.DSP))
(PRIN1 LINE CURRENT.DSP)
(DSPYPOSITION OLDY CURRENT.DSP)
(DSPXPOSITION OLDX CURRENT.DSP)
(DSPFONT OLDFONT CURRENT.DSP)
(COND
([OR (EQ SOURCE (QUOTE INVERT))
(AND (EQ FIGURE-COLOR (QUOTE WHITE))
(EQ GROUND-COLOR (QUOTE BLACK]
(BITBLT CURRENT.DSP TX TY CURRENT.DSP TX TY WIDTH HEIGHT (QUOTE INVERT)
(QUOTE REPLACE])
(BOUNDING.BOX.UISSPRIMTEXT
[LAMBDA (ITEM) (* PH "28-SEP-83 14:12")
(PROG ((PLACEMENT (GET.FIELDQ ITEM PLACEMENT))
(LINE (GET.FIELDQ ITEM LINE))
(XALIGNMENT (GET.FIELDQ ITEM XALIGNMENT))
(FONT.DESCRIPTOR (GET.FIELDQ ITEM FONT.DESCRIPTOR))
XCOORD YCOORD HEIGHT WIDTH DESCENT TX TY)
(SETQ XCOORD (fetch (POSITION XCOORD) of PLACEMENT))
(SETQ YCOORD (fetch (POSITION YCOORD) of PLACEMENT))
(SETQ HEIGHT (FONTPROP FONT.DESCRIPTOR (QUOTE HEIGHT)))
(SETQ WIDTH (STRINGWIDTH LINE FONT.DESCRIPTOR))
(SETQ DESCENT (FONTPROP FONT.DESCRIPTOR (QUOTE DESCENT)))
(SETQ TX (SELECTQ XALIGNMENT
(LEFT XCOORD)
(CENTER (IDIFFERENCE XCOORD (IQUOTIENT WIDTH 2)))
(RIGHT (IDIFFERENCE XCOORD WIDTH))
(SHOULDNT "Unrecognized keyword in UISSPRIMTEXT")))
(SETQ TY (ADD1 (IDIFFERENCE YCOORD DESCENT)))
(RETURN (create REGION
LEFT ← TX
BOTTOM ← TY
WIDTH ← WIDTH
HEIGHT ← HEIGHT])
)
(READ.ITEMTYPE UP.DOWNX10.BUTTONS 4)
(\TYPE ITEM.TYPE NAME UP.DOWNX10.BUTTONS COMMENT "Pair of Up/Down Buttons for Thermometer controls"
KIND COMPOSITE PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (LOCATION) DEFAULT (10 . 10)
COMMENT "The location of this item") (\TYPE PARAMETER NAME CELL TYPE (CELL) DEFAULT CELL.1 COMMENT
"The cell affected") (\TYPE PARAMETER NAME VERTICAL.SPACING TYPE (INTEGER) DEFAULT 3 COMMENT
"Vertical spacing between buttons") (\TYPE PARAMETER NAME HORIZONTAL.SPACING TYPE (INTEGER) DEFAULT
0 COMMENT "Horizontal spacing between buttons") (\TYPE PARAMETER NAME UP.PICTURE TYPE (BITMAP.NAME)
DEFAULT UP.BUTTON COMMENT "Bitmap picture for Up button") (\TYPE PARAMETER NAME DOWN.PICTURE TYPE
(BITMAP.NAME) DEFAULT DOWN.BUTTON COMMENT "Bitmap picture for Down button") (\TYPE PARAMETER NAME
MAXIMUM TYPE (INTEGER) DEFAULT 10 COMMENT "Maximum value of cell") (\TYPE PARAMETER NAME MINIMUM
TYPE (INTEGER) DEFAULT 1 COMMENT "Minimum value of cell") (\TYPE PARAMETER NAME AT.LIMIT TYPE (
ONEOF (STICK.AT.LIMIT WRAP.AROUND)) DEFAULT STICK.AT.LIMIT COMMENT
"What to do when you reach the limit") (\TYPE PARAMETER NAME RATE TYPE (INTEGER) DEFAULT 300 COMMENT
"Delay in milliseconds")) SUBITEM.SPECS ((ITEM GENERAL.BUTTON (PLACEMENT (TRANSLATE PLACEMENT (
NEW.LOCATION HORIZONTAL.SPACING VERTICAL.SPACING))) (TEXT (LIST " ")) (PICTURE UP.PICTURE) (
ACTION (LIST (QUOTE INCREASE.CELL) (KWOTE CELL) 10 MAXIMUM (COND ((EQ AT.LIMIT (QUOTE
STICK.AT.LIMIT)) NIL) (T MINIMUM)) RATE))) (ITEM GENERAL.BUTTON (PLACEMENT PLACEMENT) (TEXT (LIST
" ")) (PICTURE DOWN.PICTURE) (ACTION (LIST (QUOTE DECREASE.CELL) (KWOTE CELL) 10 MINIMUM (COND
((EQ AT.LIMIT (QUOTE STICK.AT.LIMIT)) NIL) (T MAXIMUM)) RATE)))) OTHER NIL)
(DECLARE: DONTCOPY
(FILEMAP (NIL (3280 9611 (BOUNDING.BOX.PAGEICON 3290 . 3912) (SHOW.PAGEICON 3914 . 4037) (
DISPLAY.PAGEICON 4039 . 9609)) (12583 18996 (BOUNDING.BOX.2LIGHT.BAR.REGION.W/BKGD 12593 . 13247) (
SHOW.2LIGHT.BAR.REGION.W/BKGD 13249 . 13388) (DISPLAY.2LIGHT.BAR.REGION.W/BKGD 13390 . 18994)) (21526
30368 (ANALYZE.PARAGRAPH 21536 . 26503) (LAYOUT.LINE 26505 . 30366)) (31976 33798 (
ANALYZE.PARAGRAPH.SINGLE.FONT 31986 . 32523) (BREAK.INTO.WORDS 32525 . 33796)) (35084 38023 (
SHOW.UISSPRIMTEXT 35094 . 36947) (BOUNDING.BOX.UISSPRIMTEXT 36949 . 38021)))))
STOP