(FILECREATED "30-Nov-84 10:08:21" {AZTEC}<TRILLIUM>BIRTHDAY84>ITEMTYPES>IDO-IMPLICATION-ITEMTYPES.;1 7295
changes to: (VARS IDO-IMPLICATION-ITEMTYPESCOMS)
previous date: "26-Aug-84 16:51:06" {AZTEC}<TRILLIUM>BIRTHDAY84>IDO-IMPLICATION-ITEMTYPES.;1)
(PRETTYCOMPRINT IDO-IMPLICATION-ITEMTYPESCOMS)
(RPAQQ IDO-IMPLICATION-ITEMTYPESCOMS ((ITEMTYPES POP.UP.MENU SELECTQ.IMPLICATION)
(P (COMPILE.INTERNAL.FNS.IF.NECESSARY))))
(READ.ITEMTYPE POP.UP.MENU 5)
(\TYPE ITEM.TYPE NAME POP.UP.MENU COMMENT
"A standard Intgerlisp-D pop-up menu; triggers on a cell and puts values in another cell" KIND
IMPLICATION PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (100 . 100) COMMENT
"Lower left corner of the menu") (\TYPE PARAMETER NAME CELL TYPE (CELL) DEFAULT CELL.1 COMMENT
"The cell which triggers this implication") (\TYPE PARAMETER NAME REFERENCE.VALUE TYPE (CONSTANT)
DEFAULT NIL COMMENT "The value for triggering this implication") (\TYPE PARAMETER NAME TITLE TYPE (
STRING) DEFAULT "Confirm" COMMENT "The title of the menu") (\TYPE PARAMETER NAME ITEMS TYPE (LIST
(STRUCTURE ((LABEL (STRING)) (VALUE (CONSTANT))))) DEFAULT (("Yes" 1) ("No" 0)) COMMENT
"The items in the menu and the values to put out") (\TYPE PARAMETER NAME FONT TYPE (FONT) DEFAULT (
HELVETICA 10) COMMENT "The font of the menu") (\TYPE PARAMETER NAME #.OF.COLUMNS TYPE (INTEGER)
DEFAULT 1 COMMENT "The number of columns desired") (\TYPE PARAMETER NAME ORDERING TYPE (ONEOF (
ACROSS DOWN)) DEFAULT ACROSS COMMENT "The direction to order the ITEMS") (\TYPE PARAMETER NAME
OUTPUT.CELL TYPE (CELL) DEFAULT CELL.2 COMMENT "The cell into which to put selected values")) OTHER
(FNS ((ANALYZE ANALYZE.POP.UP.MENU) (BOUNDING.BOX BOUNDING.BOX.POP.UP.MENU) (IMPLY
IMPLY.POP.UP.MENU) (RESET RESET.POP.UP.MENU) (NIL REORDER.MENU.BY.COLUMNS))) CLASSES (IMPLICATION))
(DEFINEQ
(ANALYZE.POP.UP.MENU
[LAMBDA (ITEM FRAME) (* edited: "26-Aug-84 15:54")
(PROG (TITLE ITEMS FONT FONT.DESCRIPTOR MENU.ITEMS MENU)
(SETQ TITLE (GET.PARAMQ ITEM TITLE POP.UP.MENU))
(SETQ ITEMS (GET.PARAMQ ITEM ITEMS))
(SETQ FONT (GET.PARAMQ ITEM FONT))
(SETQ FONT.DESCRIPTOR (FIND.FONT FONT))
[SETQ MENU.ITEMS (for SPEC in ITEMS collect (LIST (CAR SPEC)
(KWOTE (CADR SPEC]
(SETQ MENU (create MENU
TITLE ← TITLE
ITEMS ← MENU.ITEMS
MENUFONT ← FONT.DESCRIPTOR
CENTERFLG ← T))
(SET.PARAMQ ITEM MENU MENU)
(RETURN])
(BOUNDING.BOX.POP.UP.MENU
[LAMBDA (ITEM) (* edited: "26-Aug-84 15:51")
(PROG (POSITION MENU)
(SETQ POSITION (GET.PARAMQ ITEM PLACEMENT POP.UP.MENU))
(SETQ MENU (GET.PARAMQ ITEM MENU))
(RETURN (create REGION
LEFT ←(fetch (POSITION XCOORD) of POSITION)
BOTTOM ←(fetch (POSITION YCOORD) of POSITION)
WIDTH ←(fetch (MENU IMAGEWIDTH) of MENU)
HEIGHT ←(fetch (MENU IMAGEHEIGHT) of MENU])
(IMPLY.POP.UP.MENU
[LAMBDA (ITEM OLD.VALUE NEW.VALUE DONT.TRACE) (* edited: "26-Aug-84 15:55")
(PROG (REFERENCE.VALUE POSITION SCREEN.POSITION ITEM.MENU RES OUTPUT.CELL)
(SETQ REFERENCE.VALUE (GET.PARAMQ ITEM REFERENCE.VALUE))
(COND
((EQUAL NEW.VALUE REFERENCE.VALUE)
(SETQ POSITION (GET.PARAMQ ITEM PLACEMENT POP.UP.MENU))
[SETQ SCREEN.POSITION (create POSITION
XCOORD ←(IPLUS (fetch (POSITION XCOORD) of POSITION)
(DSPXOFFSET NIL CURRENT.DSP))
YCOORD ←(IPLUS (fetch (POSITION YCOORD) of POSITION)
(DSPYOFFSET NIL CURRENT.DSP]
(SETQ ITEM.MENU (GET.PARAMQ ITEM MENU))
(until (SETQ RES (MENU ITEM.MENU SCREEN.POSITION)) do NIL)
(SETQ OUTPUT.CELL (GET.PARAMQ ITEM OUTPUT.CELL))
(CHANGE.CURRENT.VALUE OUTPUT.CELL RES DONT.TRACE)
(RETURN])
(RESET.POP.UP.MENU
[LAMBDA (ITEM) (* edited: "26-Aug-84 15:52")
(SET.PARAMQ ITEM MENU NIL POP.UP.MENU])
(REORDER.MENU.BY.COLUMNS
[LAMBDA (MENU.ITEMS COLUMNS) (* KKM "29-AUG-83 11:53")
(PROG (LENGTH ROWS LEFTOVER POINTER COLUMN#)
(SETQ LENGTH (LENGTH MENU.ITEMS))
(SETQ ROWS (IQUOTIENT LENGTH COLUMNS))
(SETQ LEFTOVER (IREMAINDER LENGTH COLUMNS))
(SETQ POINTER 1)
(RETURN
(for ITEM from 1 to LENGTH
collect
(CAR (NTH MENU.ITEMS
(COND
((EQ ITEM 1)
1)
(T (COND
((ZEROP (SETQ POINTER
(IREMAINDER (IPLUS POINTER ROWS
(COND
((EQP (ADD1 LEFTOVER)
COLUMNS)
1)
((AND (ILEQ (SETQ COLUMN#
(IREMAINDER ITEM
COLUMNS))
(ADD1 LEFTOVER))
(IGREATERP COLUMN# 0))
1)
(T 0)))
LENGTH)))
LENGTH)
(T POINTER])
)
(READ.ITEMTYPE SELECTQ.IMPLICATION 5)
(\TYPE ITEM.TYPE NAME SELECTQ.IMPLICATION COMMENT
"Means by which a change in one cell can cause changes in others" KIND IMPLICATION PARAMETERS ((\TYPE
PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (170 . 170) COMMENT
"A place on the screen so that it can be referenced" GRID.TYPE (LOCATION)) (\TYPE PARAMETER NAME
CELL TYPE (CELL) DEFAULT CELL.1 COMMENT "The cell which triggers this implication") (\TYPE
PARAMETER NAME RESULT.CELL TYPE (CELL) DEFAULT RESULT.CELL COMMENT
"Cell in which the result is put.") (\TYPE PARAMETER NAME ACTION.LIST TYPE (LIST (STRUCTURE ((
TRIGGER.VALUE (CONSTANT)) (RESULT.VALUE (CONSTANT))))) DEFAULT ((1 "ONE") (2 "TWO") (3
"THREE")) COMMENT
"List of trigger values and results; If match of trigger value to TRIGGER.CELL then set RESULT.CELL to result value"
)) OTHER (FNS ((BOUNDING.BOX BOUNDING.BOX.SELECTQ.IMPLICATION) (IMPLY IMPLY.SELECTQ.IMPLICATION)))
CLASSES (IMPLICATION))
(DEFINEQ
(BOUNDING.BOX.SELECTQ.IMPLICATION
[LAMBDA (ITEM) (* edited: "26-Aug-84 15:56")
(PROG (LOCATION)
(SETQ LOCATION (GET.PARAMQ ITEM PLACEMENT SELECTQ.IMPLICATION))
(RETURN (BOUNDING.BOX.FOR.SEGMENTS (fetch (LOCATION X) of LOCATION)
(fetch (LOCATION Y) of LOCATION)
1 1])
(IMPLY.SELECTQ.IMPLICATION
[LAMBDA (ITEM OLD.VALUE NEW.VALUE DONT.TRACE) (* edited: "26-Aug-84 15:57")
(PROG (RESULT.CELL TRIGGER.CELL ACTION.LIST)
(SETQ TRIGGER.CELL NEW.VALUE)
(SETQ RESULT.CELL (GET.PARAMQ ITEM RESULT.CELL SELECTQ.IMPLICATION))
(SETQ ACTION.LIST (GET.PARAMQ ITEM ACTION.LIST SELECTQ.IMPLICATION))
(for X in ACTION.LIST do (COND
((EQUAL TRIGGER.CELL (CAR X))
(CHANGE.CURRENT.VALUE RESULT.CELL (CADR X)))
(T NIL)))
(AND TRILLIUM.TRACE (NOT DONT.TRACE)
(printout PROMPTWINDOW T "Activate selectq.implication on list: " (GET.PARAMQ ITEM
ACTION.LIST])
)
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1932 5138 (ANALYZE.POP.UP.MENU 1942 . 2640) (BOUNDING.BOX.POP.UP.MENU 2642 . 3167) (
IMPLY.POP.UP.MENU 3169 . 4071) (RESET.POP.UP.MENU 4073 . 4234) (REORDER.MENU.BY.COLUMNS 4236 . 5136))
(6131 7237 (BOUNDING.BOX.SELECTQ.IMPLICATION 6141 . 6521) (IMPLY.SELECTQ.IMPLICATION 6523 . 7235)))))
STOP