(FILECREATED "19-Nov-84 17:59:20" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-EDITITEM.;2 66490
changes to: (FNS ACQUIRE.ITEMS DISTANCE.BETWEEN.POINTS)
previous date: "23-Aug-84 11:07:51" {AZTEC}<TRILLIUM>BIRTHDAY84>RERELEASE>TRI-EDITITEM.;1)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT TRI-EDITITEMCOMS)
(RPAQQ TRI-EDITITEMCOMS ((FNS ACQUIRE.ITEMS ADD.NEW.ITEM ADD.SUBITEMS ADD.TO.6LISTS ADD.TO.ARTWORK
ADD.TO.DISPLAYERS ADD.TO.IMPLICATIONS ADD.TO.INHIBITORS
ADD.TO.INITIALIZATION ADD.TO.SENSORS ALIGN.ITEMS ALIGN.ITEMS.ALONG.EDGE
BUILD.6LISTS BURY.ITEM CENTER.IN.FRAME CENTER.OVER.ITEM
CLOSE.EDIT.WINDOWS COLLECT.PRIMITIVES COMPRESS.AND.ADD.ARTWORK
COMPRESS.AND.ADD.DISPLAYERS COMPRESS.AND.ADD.IMPLICATIONS
COMPRESS.AND.ADD.INHIBITORS COMPRESS.AND.ADD.INITIALIZATIONS
COMPRESS.AND.ADD.PICTURES COMPRESS.AND.ADD.SENSORS COPY.ITEM
CREATE.NEW.ITEM DELETE.ITEM DELETE.OLD.ITEM DISTANCE.BETWEEN.POINTS
EDIT.ITEM EDIT.WINDOW.OPEN EXCISE.INTERMEDIATE.STRUCTURE EXPAND.ITEM
FLATTEN.ACTIONS FLIP.ALL.ITEMS FORGET.EDIT.WINDOWS FREEZE.ITEM
FREEZE.SUBITEMS GATHER.PRIMITIVE.ITEMS GET.ALIGN.ITEMS.MENU GRAPH.ITEMS
GRAPH.ITEMS.LEFTBUTTONFN GRAPH.ITEMS.MIDDLEBUTTONFN GROUP.ITEMS
HORIZONTAL.ITEM.DISTANCES INTERACT©.ITEM INTERACT&EDIT.ITEM
INTERACT&FREEZE.ITEM INTERACT&THAW.ITEM ITEM.MATCHES MATCH.ITEMS
MERGE.ACTIONS MODIFY.ITEMS MOVE.ITEM MOVE.ITEMS.IN.DIRECTION NAME.ITEM
PRINT.ITEMS REFORM.ITEM REMOVE.FROM.ARTWORK REMOVE.FROM.DISPLAYERS
REMOVE.FROM.IMPLICATIONS REMOVE.FROM.INHIBITORS
REMOVE.FROM.INITIALIZATION REMOVE.FROM.SENSORS REMOVE.ITEM RESET.6LISTS
RESET.ITEM RESHAPE.ITEMS RETRIEVE.SAVED.ITEM RETRIEVE.SAVED.PLACEMENT
SAME.PICTURE.PARAMS? SAVE.ITEM SAVE.PLACEMENT SHAPE.ITEM THAW.ITEM
VERTICAL.ITEM.DISTANCES)
(VARS (CONFIRM.VALUE.CHANGES)
GRAPH.ITEMS.GRAPH.SPEC
(FULL.MENU)
(ALIGN.ITEMS.MENU)
(TRILLIUM.SAVED.ITEM)
(TRILLIUM.SAVED.PLACEMENT)
(TRILLIUM.MOVE.AFTER.SHAPE)
(DISPLAY.CHANGED.ITEM.ONLY))))
(DEFINEQ
(ACQUIRE.ITEMS
[LAMBDA (FRAME PROMPT FROM.SUPERFRAMES.TOO ITYPE) (* kkm "19-Nov-84 12:42")
(* dls " 6-JUN-84 18:55")
(DECLARE (GLOBALVARS CURRENT.DSP))
(bind (NEXTITEM (ITEMS ←(CONS)))
first (COND
(PROMPT (TRILLIUM.PRINTOUT PROMPT)))
(FLIP.ALL.ITEMS FRAME FROM.SUPERFRAMES.TOO ITYPE)
do (WAITNOBUG)
(WAITBUG)
(WAITNOBUG)
(SETQ NEXTITEM (ACQUIRE.ITEM.FROM FRAME FROM.SUPERFRAMES.TOO ITYPE (LASTMOUSEX CURRENT.DSP)
(LASTMOUSEY CURRENT.DSP)))
(COND
(NEXTITEM (FLIP.ITEM NEXTITEM)
(forDuration 30 timerUnits (QUOTE MILLISECONDS))
(FLIP.ITEM NEXTITEM)
(TCONC ITEMS NEXTITEM))
(T (FLIP.ALL.ITEMS FRAME FROM.SUPERFRAMES.TOO ITYPE)
(RETURN (CAR ITEMS])
(ADD.NEW.ITEM
[LAMBDA (FRAME NEW.ITEM AT.FRONT) (* HK "15-JUL-82 12:28")
(PROG ((ITEMS (GET.FIELDQ FRAME ITEMS FRAME)))
(COND
((OR AT.FRONT (NULL ITEMS))
(SET.FIELDQ FRAME ITEMS (CONS NEW.ITEM ITEMS)
FRAME))
(T (NCONC1 ITEMS NEW.ITEM])
(ADD.SUBITEMS
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HK "15-JUL-82 12:32")
(SELECTQ (ITEM.KIND ITEM)
(COMPOSITE (for SUBITEM in (GET.FIELDQ ITEM SUBITEMS) do (ADD.SUBITEMS SUBITEM FRAME
AT.BEGINNING)))
(INITIALIZATION (ADD.TO.INITIALIZATION ITEM FRAME AT.BEGINNING))
(ARTWORK (ADD.TO.ARTWORK ITEM FRAME AT.BEGINNING))
(SENSOR (ADD.TO.SENSORS ITEM FRAME AT.BEGINNING))
(INHIBITOR (ADD.TO.INHIBITORS ITEM FRAME AT.BEGINNING))
(DISPLAYER (ADD.TO.DISPLAYERS ITEM FRAME AT.BEGINNING))
(IMPLICATION (ADD.TO.IMPLICATIONS ITEM FRAME AT.BEGINNING))
(SHOULDNT "Unrecognized KIND in ADD.SUBITEM"])
(ADD.TO.6LISTS
[LAMBDA (ITEM) (* HaKo "27-Jul-84 16:15")
(DECLARE (SPECVARS ARTWORK DISPLAYERS IMPLICATIONS INHIBITORS INITIALIZATIONS SENSORS))
(SELECTQ (ITEM.KIND ITEM)
(COMPOSITE (for SUBITEM in (GET.PARAMQ ITEM SUBITEMS) do (ADD.TO.6LISTS SUBITEM)))
(INITIALIZATION (TCONC INITIALIZATIONS ITEM))
(ARTWORK (TCONC ARTWORK ITEM))
(SENSOR (TCONC SENSORS ITEM))
(INHIBITOR (TCONC INHIBITORS (LIST (OR (GET.PARAMQ ITEM CELL)
(GET.PARAMQ ITEM CELLS))
ITEM)))
(DISPLAYER (TCONC DISPLAYERS (LIST (OR (GET.PARAMQ ITEM CELL)
(GET.PARAMQ ITEM CELLS))
ITEM)))
(IMPLICATION (TCONC IMPLICATIONS (LIST (OR (GET.PARAMQ ITEM CELL)
(GET.PARAMQ ITEM CELLS))
ITEM)))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Unrecognized item kind: " (ITEM.KIND ITEM)
" on item " ITEM])
(ADD.TO.ARTWORK
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HK "15-JUL-82 13:20")
(PROG ((ARTWORKS (GET.FIELDQ FRAME ARTWORK FRAME)))
(COND
((OR AT.BEGINNING (NULL ARTWORKS))
(SET.FIELDQ FRAME ARTWORK (CONS ITEM ARTWORKS)))
(T (NCONC1 ARTWORKS ITEM])
(ADD.TO.DISPLAYERS
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HaKo "27-Jul-84 16:21")
(PROG ((DISPLAYERS (GET.FIELDQ FRAME DISPLAYERS FRAME))
(NEW.DISPLAYER (LIST (OR (GET.PARAMQ ITEM CELL)
(GET.PARAMQ ITEM CELLS))
ITEM)))
(COND
((OR AT.BEGINNING (NULL DISPLAYERS))
(SET.FIELDQ FRAME DISPLAYERS (CONS NEW.DISPLAYER DISPLAYERS)))
(T (NCONC1 DISPLAYERS NEW.DISPLAYER])
(ADD.TO.IMPLICATIONS
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HaKo "27-Jul-84 16:16")
(PROG ((IMPLICATIONS (GET.FIELDQ FRAME IMPLICATIONS FRAME))
(NEW.IMPLICATION (LIST (GET.PARAMQ ITEM CELL)
ITEM)))
(COND
((OR AT.BEGINNING (NULL IMPLICATIONS))
(SET.FIELDQ FRAME IMPLICATIONS (CONS NEW.IMPLICATION IMPLICATIONS)))
(T (NCONC1 IMPLICATIONS NEW.IMPLICATION])
(ADD.TO.INHIBITORS
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HaKo "27-Jul-84 16:16")
(PROG ((INHIBITORS (GET.FIELDQ FRAME INHIBITORS FRAME))
(NEW.INHIBITOR (LIST (GET.PARAMQ ITEM CELL)
ITEM)))
(COND
((OR AT.BEGINNING (NULL INHIBITORS))
(SET.FIELDQ FRAME INHIBITORS (CONS NEW.INHIBITOR INHIBITORS)))
(T (NCONC1 INHIBITORS NEW.INHIBITOR])
(ADD.TO.INITIALIZATION
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HK "15-JUL-82 13:23")
(PROG ((INITIALIZATIONS (GET.FIELDQ FRAME INITIALIZATION FRAME)))
(COND
((OR AT.BEGINNING (NULL INITIALIZATIONS))
(SET.FIELDQ FRAME INITIALIZATION (CONS ITEM INITIALIZATIONS)))
(T (NCONC1 INITIALIZATIONS ITEM])
(ADD.TO.SENSORS
[LAMBDA (ITEM FRAME AT.BEGINNING) (* HK "15-JUL-82 13:26")
(PROG ((SENSORS (GET.FIELDQ FRAME SENSORS FRAME)))
(COND
((OR AT.BEGINNING (NULL SENSORS))
(SET.FIELDQ FRAME SENSORS (CONS ITEM SENSORS)))
(T (NCONC1 SENSORS ITEM])
(ALIGN.ITEMS
[LAMBDA (FRAME) (* HaKo "13-Aug-84 11:57")
(SELECTQ (MENU (GET.ALIGN.ITEMS.MENU))
(NIL NIL)
(ALIGN.ALONG.TOP.EDGE (ALIGN.ITEMS.ALONG.EDGE FRAME (QUOTE TOP)))
(ALIGN.ALONG.BOTTOM.EDGE (ALIGN.ITEMS.ALONG.EDGE FRAME (QUOTE BOTTOM)))
(ALIGN.ALONG.LEFT.EDGE (ALIGN.ITEMS.ALONG.EDGE FRAME (QUOTE LEFT)))
(ALIGN.ALONG.RIGHT.EDGE (ALIGN.ITEMS.ALONG.EDGE FRAME (QUOTE RIGHT)))
(MATCH.WIDTH (MATCH.ITEMS FRAME (QUOTE WIDTH)))
(MATCH.HEIGHT (MATCH.ITEMS FRAME (QUOTE HEIGHT)))
(EXPAND.HEIGHT (RESHAPE.ITEMS FRAME (QUOTE EXPAND.HEIGHT)))
(EXPAND.WIDTH (RESHAPE.ITEMS FRAME (QUOTE EXPAND.WIDTH)))
(SHRINK.HEIGHT (RESHAPE.ITEMS FRAME (QUOTE SHRINK.HEIGHT)))
(SHRINK.WIDTH (RESHAPE.ITEMS FRAME (QUOTE SHRINK.WIDTH)))
(MOVE.LEFT (MOVE.ITEMS.IN.DIRECTION FRAME (QUOTE LEFT)))
(MOVE.RIGHT (MOVE.ITEMS.IN.DIRECTION FRAME (QUOTE RIGHT)))
(MOVE.UP (MOVE.ITEMS.IN.DIRECTION FRAME (QUOTE UP)))
(MOVE.DOWN (MOVE.ITEMS.IN.DIRECTION FRAME (QUOTE DOWN)))
(CENTER.IN.FRAME (CENTER.IN.FRAME FRAME))
(CENTER.OVER.ITEM (CENTER.OVER.ITEM FRAME))
(SAVE.PLACEMENT (SAVE.PLACEMENT FRAME))
(RETRIEVE.SAVED.PLACEMENT (RETRIEVE.SAVED.PLACEMENT FRAME))
(HORIZONTAL.ITEM.DISTANCES (HORIZONTAL.ITEM.DISTANCES FRAME))
(VERTICAL.ITEM.DISTANCES (VERTICAL.ITEM.DISTANCES FRAME))
(DISTANCE.BETWEEN.POINTS (DISTANCE.BETWEEN.POINTS FRAME))
(SHOULDNT "Unrecognized menu selection in ALIGN.ITEMS!"])
(ALIGN.ITEMS.ALONG.EDGE
[LAMBDA (FRAME EDGE) (* HaKo "16-Aug-84 17:02")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (ITEMS.TO.ALIGN ORIG.ITEM ORIG.BBOX CHANGES)
(SETQ ORIG.ITEM (ACQUIRE.ITEM FRAME "Point out the item to align other items with."))
(COND
((NULL ORIG.ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: align command aborted"))
((NOT (TYPE.DEFINEDP ORIG.ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't align by that item, as its type is undefined"))
([NOT (REGIONP (SETQ ORIG.BBOX (BOUNDING.BOX ORIG.ITEM]
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't align by that item; its BOUNDING.BOX is not computable."))
(T (TRILLIUM.PRINTOUT "Point out the items to align; stop by missing.")
(SETQ ITEMS.TO.ALIGN (ACQUIRE.ITEMS FRAME))
(THINKING (for ITEM in ITEMS.TO.ALIGN bind (DX DY ITEM.BBOX)
when (REGIONP (SETQ ITEM.BBOX (BOUNDING.BOX ITEM)))
do (RESET.ITEM ITEM)
(SELECTQ EDGE
(LEFT (SETQ DX (IDIFFERENCE (fetch (REGION LEFT)
of ORIG.BBOX)
(fetch (REGION LEFT)
of ITEM.BBOX)))
(SETQ DY 0))
(RIGHT (SETQ DX (IDIFFERENCE (fetch (REGION RIGHT)
of ORIG.BBOX)
(fetch (REGION RIGHT)
of ITEM.BBOX)))
(SETQ DY 0))
[TOP (SETQ DX 0)
(SETQ DY (IDIFFERENCE (fetch (REGION TOP) of ORIG.BBOX)
(fetch (REGION TOP) of ITEM.BBOX]
[BOTTOM (SETQ DX 0)
(SETQ DY (IDIFFERENCE (fetch (REGION BOTTOM)
of ORIG.BBOX)
(fetch (REGION BOTTOM)
of ITEM.BBOX]
(SHOULDNT))
(TRANSLATE.PLACEMENT ITEM DX DY)
(ANALYZE&COMPLETE.ITEM ITEM)
(SETQ CHANGES T)))
(if CHANGES
then (UPDATE&DISPLAY.FRAME FRAME)
else (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No alignable items selected; command aborted."])
(BUILD.6LISTS
[LAMBDA (FRAME) (* HaKo "13-Aug-84 12:51")
(* DAHJr "16-SEP-83 15:54")
(* RECOMPUTE THE REDUNDANT LISTS OF THE SIX PRIMITIVE
TYPES FOR THIS FRAME)
(DECLARE (SPECVARS ARTWORK DISPLAYERS IMPLICATIONS INHIBITORS INITIALIZATIONS SENSORS))
(PROG ((ARTWORK (CONS))
(INITIALIZATIONS (CONS))
(SENSORS (CONS))
(INHIBITORS (CONS))
(DISPLAYERS (CONS))
(IMPLICATIONS (CONS)))
(for ITEM in (GET.FIELDQ FRAME ITEMS) do (ADD.TO.6LISTS ITEM))
(SET.FIELDQ FRAME INITIALIZATION (CAR INITIALIZATIONS))
(SET.FIELDQ FRAME ARTWORK (CAR ARTWORK))
(SET.FIELDQ FRAME SENSORS (CAR SENSORS))
(SET.FIELDQ FRAME INHIBITORS (CAR INHIBITORS))
(SET.FIELDQ FRAME DISPLAYERS (CAR DISPLAYERS))
(SET.FIELDQ FRAME IMPLICATIONS (CAR IMPLICATIONS))
(SET.FIELDQ FRAME 6LISTS T])
(BURY.ITEM
[LAMBDA (FRAME) (* PI "23-Aug-84 10:52")
(* DAHJr " 5-DEC-83 12:01")
(PROG ((ITEM (ACQUIRE.ITEM FRAME "Point out item to be buried")))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; BURY.ITEM aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot bury that item, as its type is undefined"))
(T (THINKING [SET.FIELDQ FRAME ITEMS (CONS ITEM (DREMOVE ITEM (GET.FIELDQ FRAME ITEMS
FRAME]
(UPDATE&DISPLAY.FRAME FRAME))
(RETURN ITEM])
(CENTER.IN.FRAME
[LAMBDA (FRAME) (* HaKo "13-Aug-84 15:49")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(PROG (ITEMS.TO.CENTER FRAME.WIDTH BBOX DX CHANGES)
(TRILLIUM.PRINTOUT "Point out the items to center; stop by missing.")
(SETQ ITEMS.TO.CENTER (ACQUIRE.ITEMS FRAME))
(SETQ FRAME.WIDTH (GETWINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE WIDTH)))
(THINKING (for ITEM in ITEMS.TO.CENTER when [AND (TYPE.DEFINEDP ITEM)
(REGIONP (SETQ BBOX (BOUNDING.BOX ITEM]
do (SETQ DX (IDIFFERENCE (HALF (IDIFFERENCE FRAME.WIDTH (fetch (REGION WIDTH)
of BBOX)))
(fetch (REGION LEFT) of BBOX)))
(RESET.ITEM ITEM)
(TRANSLATE.PLACEMENT ITEM DX 0)
(ANALYZE&COMPLETE.ITEM ITEM)
(SETQ CHANGES T)))
(if CHANGES
then (UPDATE&DISPLAY.FRAME FRAME)
else (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No centerable items selected; command aborted."])
(CENTER.OVER.ITEM
[LAMBDA (FRAME) (* HaKo "13-Aug-84 15:50")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (REF.ITEM REF.BBOX REF.CENTER ITEMS.TO.CENTER ITEM.BBOX ITEM.CENTER DX DY CHANGES)
(SETQ REF.ITEM (ACQUIRE.ITEM FRAME "Point out item over which to center other items."))
(COND
((NULL REF.ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: center command aborted"))
((NOT (TYPE.DEFINEDP REF.ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't center by that item, as its type is undefined"))
([NOT (REGIONP (SETQ REF.BBOX (BOUNDING.BOX REF.ITEM]
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't center by that item; its BOUNDING.BOX is not computable."))
(T (SETQ REF.CENTER (REGION/CENTER REF.BBOX))
(TRILLIUM.PRINTOUT "Point out the items to center; stop by missing.")
(SETQ ITEMS.TO.CENTER (ACQUIRE.ITEMS FRAME))
(THINKING (for ITEM in ITEMS.TO.CENTER when [AND (TYPE.DEFINEDP ITEM)
(REGIONP (SETQ ITEM.BBOX
(BOUNDING.BOX ITEM]
do (SETQ ITEM.CENTER (REGION/CENTER ITEM.BBOX))
(SETQ DX (IDIFFERENCE (fetch XCOORD of REF.CENTER)
(fetch XCOORD of ITEM.CENTER)))
(SETQ DY (IDIFFERENCE (fetch YCOORD of REF.CENTER)
(fetch YCOORD of ITEM.CENTER)))
(RESET.ITEM ITEM)
(TRANSLATE.PLACEMENT ITEM DX DY)
(ANALYZE&COMPLETE.ITEM ITEM)
(SETQ CHANGES T)))
(if CHANGES
then (UPDATE&DISPLAY.FRAME FRAME)
else (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No centerable items selected; command aborted."])
(CLOSE.EDIT.WINDOWS
[LAMBDA NIL (* DAHJr "23-APR-83 09:55")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(for WINDOW in (WINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE DEPENDENT.WINDOWS))
do (CLOSEW WINDOW])
(COLLECT.PRIMITIVES
[LAMBDA (ITEM INITIALIZATIONS ARTWORK SENSORS INHIBITORS DISPLAYERS IMPLICATIONS TOPFLG)
(* KKM " 3-JAN-84 15:53")
(* Replaced all occurences of
(COPYALL ITEM) with (COPY.ITEM ITEM))
(SELECTQ (ITEM.KIND ITEM)
(COMPOSITE (for SUBITEM in (GET.FIELDQ ITEM SUBITEMS)
do (COLLECT.PRIMITIVES SUBITEM INITIALIZATIONS ARTWORK SENSORS INHIBITORS
DISPLAYERS IMPLICATIONS)))
[INITIALIZATION (TCONC INITIALIZATIONS (COND
(TOPFLG (COPY.ITEM ITEM))
(T ITEM]
[ARTWORK (TCONC ARTWORK (COND
(TOPFLG (COPY.ITEM ITEM))
(T ITEM]
[SENSOR (TCONC SENSORS (COND
(TOPFLG (COPY.ITEM ITEM))
(T ITEM]
[INHIBITOR (TCONC INHIBITORS (COND
(TOPFLG (COPY.ITEM ITEM))
(T ITEM]
[DISPLAYER (TCONC DISPLAYERS (COND
(TOPFLG (COPY.ITEM ITEM))
(T ITEM]
[IMPLICATION (TCONC IMPLICATIONS (COND
(TOPFLG (COPY.ITEM ITEM))
(T ITEM]
(ERROR "Unexpected item kind: " ITEM])
(COMPRESS.AND.ADD.ARTWORK
[LAMBDA (PRIMITIVES ARTWORK COMPRESSFLG) (* HaKo " 9-SEP-83 10:18")
(for ITEM in ARTWORK bind PICLIST do [COND
((NOT COMPRESSFLG)
(TCONC PRIMITIVES ITEM))
((NEQ (ITEM.TYPE ITEM)
(QUOTE PICTURE))
(COND
(PICLIST (COMPRESS.AND.ADD.PICTURES PRIMITIVES PICLIST)
(SETQ PICLIST)))
(TCONC PRIMITIVES ITEM))
((NULL PICLIST)
(SETQ PICLIST (LIST ITEM)))
((SAME.PICTURE.PARAMS? ITEM (CAR PICLIST))
(NCONC1 PICLIST ITEM))
(T (COND
(PICLIST (COMPRESS.AND.ADD.PICTURES PRIMITIVES
PICLIST)))
(SETQ PICLIST (LIST ITEM]
finally (COND
(PICLIST (COMPRESS.AND.ADD.PICTURES PRIMITIVES PICLIST])
(COMPRESS.AND.ADD.DISPLAYERS
[LAMBDA (PRIMITIVES DISPLAYERS) (* HaKo "31-AUG-83 13:36")
(for DISPLAYER in DISPLAYERS do (TCONC PRIMITIVES DISPLAYER])
(COMPRESS.AND.ADD.IMPLICATIONS
[LAMBDA (PRIMITIVES IMPLICATIONS) (* HaKo "27-Jul-84 16:16")
(* For each cell driving two or more implications merge
actions into single implication)
(PROG ((CELLS&IMPLICATIONS (CONS)))
[for IMPLICATION in IMPLICATIONS do (for CELL in (GET.PARAMQ IMPLICATION CELLS)
do (ADD.NV.PAIR CELLS&IMPLICATIONS CELL IMPLICATION)
finally (COND
((SETQ CELL (GET.PARAMQ IMPLICATION CELL))
(ADD.NV.PAIR CELLS&IMPLICATIONS CELL
IMPLICATION]
(for CELL&IMPLICATIONS in (CAR CELLS&IMPLICATIONS)
do (TCONC PRIMITIVES (ITEM.CREATE IMPLICATION (CELL (CAR CELL&IMPLICATIONS))
(PLACEMENT (GET.PARAMQ (CADR CELL&IMPLICATIONS)
PLACEMENT))
(ACTION.FORM (MERGE.ACTIONS (CDR CELL&IMPLICATIONS])
(COMPRESS.AND.ADD.INHIBITORS
[LAMBDA (PRIMITIVES INHIBITORS) (* HaKo "27-Jul-84 16:22")
(* For each cell driving two or more inhibitors merge
actions into single inhibitor)
(PROG ((CELLS&INHIBITORS (CONS)))
[for INHIBITOR in INHIBITORS do (for CELL in (GET.PARAMQ INHIBITOR CELLS)
do (ADD.NV.PAIR CELLS&INHIBITORS CELL INHIBITOR)
finally (COND
((SETQ CELL (GET.PARAMQ INHIBITOR CELL))
(ADD.NV.PAIR CELLS&INHIBITORS CELL INHIBITOR]
(for CELL&INHIBITORS in (CAR CELLS&INHIBITORS)
do (TCONC PRIMITIVES (ITEM.CREATE INHIBITOR (CELL (CAR CELL&INHIBITORS))
(PLACEMENT (GET.PARAMQ (CADR CELL&INHIBITORS)
PLACEMENT))
(ACTION.FORM (MERGE.ACTIONS (CDR CELL&INHIBITORS)
(QUOTE OR])
(COMPRESS.AND.ADD.INITIALIZATIONS
[LAMBDA (PRIMITIVES INITIALIZATIONS) (* HaKo "27-Jul-84 16:22")
(COND
[(CDR INITIALIZATIONS)
(TCONC PRIMITIVES (ITEM.CREATE INITIALIZATION (PLACEMENT (GET.PARAMQ (CAR INITIALIZATIONS)
PLACEMENT))
(ACTION.FORM (MERGE.ACTIONS INITIALIZATIONS]
(INITIALIZATIONS (TCONC PRIMITIVES (CAR INITIALIZATIONS])
(COMPRESS.AND.ADD.PICTURES
[LAMBDA (PRIMITIVES PICLIST) (* HaKo "27-Jul-84 16:23")
(COND
((NULL (CDR PICLIST))
(TCONC PRIMITIVES (CAR PICLIST)))
(T (PROG (NEWBOX LEFT BOTTOM NEWMAP FIRSTPIC OPERATION SOURCE TEXTURE FIGURE-COLOR GROUND-COLOR)
(SETQ NEWBOX (COMPOSITE.BOUNDING.BOX PICLIST))
(SETQ LEFT (fetch (REGION LEFT) of NEWBOX))
(SETQ BOTTOM (fetch (REGION BOTTOM) of NEWBOX))
(SETQ NEWMAP (BITMAPCREATE (fetch (REGION WIDTH) of NEWBOX)
(fetch (REGION HEIGHT) of NEWBOX)))
(SETQ FIRSTPIC (CAR PICLIST))
(SETQ OPERATION (GET.PARAMQ FIRSTPIC OPERATION))
(SETQ SOURCE (GET.PARAMQ FIRSTPIC SOURCE))
(SETQ TEXTURE (GET.PARAMQ FIRSTPIC TEXTURE))
(SETQ FIGURE-COLOR (GET.PARAMQ FIRSTPIC FIGURE-COLOR))
(SETQ GROUND-COLOR (GET.PARAMQ FIRSTPIC GROUND-COLOR))
(for PIC in PICLIST bind (BOX MAP)
do (SETQ BOX (BOUNDING.BOX PIC))
(SETQ MAP (GET.PARAMQ PIC BITMAP))
(OR (BITMAPP MAP)
(SETQ MAP (FIND.BITMAP MAP)))
(BITBLT MAP NIL NIL NEWMAP (IDIFFERENCE (fetch (REGION LEFT) of BOX)
LEFT)
(IDIFFERENCE (fetch (REGION BOTTOM) of BOX)
BOTTOM)
NIL NIL (QUOTE INPUT)
OPERATION TEXTURE NIL))
(TCONC PRIMITIVES (ITEM.CREATE PICTURE (PLACEMENT (CONS LEFT BOTTOM))
(BITMAP NEWMAP)
(OPERATION OPERATION)
(SOURCE SOURCE)
(TEXTURE TEXTURE)
(FIGURE-COLOR FIGURE-COLOR)
(GROUND-COLOR GROUND-COLOR])
(COMPRESS.AND.ADD.SENSORS
[LAMBDA (PRIMITIVES SENSORS) (* HaKo "29-AUG-83 12:35")
(for ITEM in SENSORS do (TCONC PRIMITIVES ITEM])
(COPY.ITEM
[LAMBDA (ITEM) (* HaKo "13-Aug-84 15:19")
(* DAHJr " 7-APR-83 16:23")
(PROG ((ITEMCOPY (APPEND ITEM))
NEW.ITEM)
(RESET.ITEM ITEMCOPY)
(COMPRESS.PROPLIST ITEMCOPY)
(SETQ NEW.ITEM (COPYALL ITEMCOPY))
(ANALYZE&COMPLETE.ITEM NEW.ITEM)
(RETURN NEW.ITEM])
(CREATE.NEW.ITEM
[LAMBDA (ITYPE FRAME) (* HaKo " 6-Aug-84 12:08")
(* edited: " 6-May-84 16:46")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW TRILLIUM.MOVE.AFTER.SHAPE))
(PROG (NEW.ITEM PLACEMENT DELTA.POSITION)
(OR ITYPE (SETQ ITYPE (ACQUIRE.ITEM.TYPE)))
(OR ITYPE (RETURN))
(THINKING (SETQ NEW.ITEM (NEW.ITEM ITYPE))
(ANALYZE.ITEM NEW.ITEM))
(SETQ PLACEMENT (ACQUIRE.PLACEMENT NEW.ITEM "Indicate a placement for the new item"))
(THINKING (SET.PLACEMENT NEW.ITEM PLACEMENT)
(ADD.NEW.ITEM FRAME NEW.ITEM))
[COND
(TRILLIUM.MOVE.AFTER.SHAPE (ANALYZE.ITEM NEW.ITEM)
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT NEW.ITEM
"Indicate a new placement for the item"))
(THINKING (TRANSLATE.PLACEMENT NEW.ITEM DELTA.POSITION]
(THINKING (ANALYZE&COMPLETE.ITEM NEW.ITEM)
(UPDATE&DISPLAY.FRAME FRAME NEW.ITEM))
(EDIT.WINDOW.CREATE NEW.ITEM CURRENT.INTERFACE.WINDOW)
(RETURN NEW.ITEM])
(DELETE.ITEM
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:45")
(PROG ((OLD.ITEM (ACQUIRE.ITEM FRAME "Point out the item to be deleted"))
BOX DOIT)
(COND
[OLD.ITEM (SETQ BOX (BOUNDING.BOX OLD.ITEM))
(FLIP.BOX BOX)
(SETQ DOIT (CONFIRM "Delete the inverted item?"))
(FLIP.BOX BOX)
(COND
(DOIT (THINKING (DELETE.OLD.ITEM FRAME OLD.ITEM)
(UPDATE&DISPLAY.FRAME FRAME (QUOTE IGNORE)
BOX))
(RETURN OLD.ITEM))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Delete command aborted"]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Cannot find any item where you pointed;"
" delete command aborted"])
(DELETE.OLD.ITEM
[LAMBDA (FRAME ITEM) (* DAHJr "24-JUN-83 10:53")
(DECLARE (GLOBALVARS CURRENT.INTERFACE CURRENT.INTERFACE.WINDOW))
(PROG (ITEMS NEWLIST EDIT.WINDOWS CORRESPONDING.EDIT.WINDOW)
(REMOVE.ITEM ITEM FRAME)
(SETQ ITEMS (GET.FIELDQ FRAME ITEMS FRAME))
(SETQ NEWLIST (DREMOVE ITEM ITEMS))
(OR NEWLIST (SET.FIELDQ FRAME ITEMS NIL))
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
(MARK.INTERFACE CURRENT.INTERFACE)
(for WINDOW in (DEPENDENT.WINDOWS CURRENT.INTERFACE.WINDOW)
when (AND (EQ (WINDOWPROP WINDOW (QUOTE TRILLIUM.WINDOW.TYPE))
(QUOTE ITEM.EDITOR))
(EQ (WINDOWPROP WINDOW (QUOTE DATUM))
ITEM))
do (DELETE.DEPENDENT.WINDOW CURRENT.INTERFACE.WINDOW WINDOW)
(CLOSEW WINDOW])
(DISTANCE.BETWEEN.POINTS
[LAMBDA (FRAME) (* kkm "19-Nov-84 14:03")
(* dls "26-JUN-84 11:31")
(DECLARE (GLOBALVARS DEFAULTCURSOR))
(PROG (PTS DX DY)
(FLIP.ALL.ITEMS FRAME T)
(SETCURSOR (CURSORCREATE (BITMAPCREATE 0 0)))
(SETQ PTS (POSITION2/CREATE))
(FLIP.ALL.ITEMS FRAME T)
(SETCURSOR DEFAULTCURSOR)
(SETQ DX (IDIFFERENCE (fetch (POSITION2 XCOORD1) of PTS)
(fetch (POSITION2 XCOORD2) of PTS)))
(SETQ DY (IDIFFERENCE (fetch (POSITION2 YCOORD1) of PTS)
(fetch (POSITION2 YCOORD2) of PTS)))
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS
"The number of pixels between the two points is:"
T 5 (FIX (FPLUS .5 (SQRT (IPLUS (ITIMES DX DX)
(ITIMES DY DY])
(EDIT.ITEM
[LAMBDA (ITEM FRAME) (* HaKo "25-Jul-84 16:46")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(COND
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Cannot edit that item, as its type is undefined"))
(T (EDIT.WINDOW.OPEN ITEM CURRENT.INTERFACE.WINDOW])
(EDIT.WINDOW.OPEN
[LAMBDA (ITEM WINDOW.DEPENDED.UPON) (* DAHJr "10-AUG-83 20:44")
(PROG (EDIT.WINDOW)
[SETQ EDIT.WINDOW (for WINDOW in (DEPENDENT.WINDOWS WINDOW.DEPENDED.UPON)
thereis (AND (EQ (WINDOWPROP WINDOW (QUOTE TRILLIUM.WINDOW.TYPE))
(QUOTE ITEM.EDITOR))
(EQ ITEM (WINDOWPROP WINDOW (QUOTE DATUM]
(COND
(EDIT.WINDOW (INSPECTW.REDISPLAY EDIT.WINDOW))
(T (EDIT.WINDOW.CREATE ITEM WINDOW.DEPENDED.UPON])
(EXCISE.INTERMEDIATE.STRUCTURE
[LAMBDA (ITEM) (* DAHJr " 9-MAR-83 13:58")
(* ASSUMES ITEM IS FULLY ANALYZED.
REPLACES THE SUBITEMS WITH PRIMTIVES ITEMS AT LEAVES OF
THE EXPANSION)
(PROG ((PRIMITIVES (CONS)))
(for SUBITEM in (GET.FIELDQ ITEM SUBITEMS) do (GATHER.PRIMITIVE.ITEMS SUBITEM PRIMITIVES))
(SET.FIELDQ ITEM SUBITEMS (CAR PRIMITIVES))
(RETURN ITEM])
(EXPAND.ITEM
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:47")
(PROG ((OLD.ITEM (ACQUIRE.ITEM FRAME "Point out item to be expanded"))
SUBITEMS BOX DOIT)
(COND
((NULL OLD.ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; delete command aborted"))
((NOT (TYPE.DEFINEDP OLD.ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot expand that item, as its type is undefined"))
((NOT (COMPOSITE? OLD.ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS T "That item is not expandable"))
(T (SETQ BOX (BOUNDING.BOX OLD.ITEM))
(FLIP.BOX BOX)
(SETQ DOIT (CONFIRM "Expand the inverted item?"))
(FLIP.BOX BOX)
(COND
(DOIT (THINKING (DELETE.OLD.ITEM FRAME OLD.ITEM)
(ANALYZE.ITEM OLD.ITEM)
(SETQ SUBITEMS (GET.FIELDQ OLD.ITEM SUBITEMS))
(for SUBITEM in SUBITEMS
do (ADD.NEW.ITEM FRAME SUBITEM)
(ANALYZE&COMPLETE.ITEM SUBITEM))
(UPDATE&DISPLAY.FRAME FRAME SUBITEMS BOX T))
(RETURN OLD.ITEM))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Expand command aborted"])
(FLATTEN.ACTIONS
[LAMBDA (ACTION) (* HaKo "29-AUG-83 12:28")
(* Remove all nested PROGs and PROGNs recursively)
(COND
((LISTP (CAR ACTION))
(for SUBACTION in ACTION join (FLATTEN.ACTIONS SUBACTION)))
((EQ (CAR ACTION)
(QUOTE PROGN))
(FLATTEN.ACTIONS (CDR ACTION)))
((AND (EQ (CAR ACTION)
(QUOTE PROG))
(NULL (CADR ACTION)))
(FLATTEN.ACTIONS (CDDR ACTION)))
(ACTION (LIST ACTION])
(FLIP.ALL.ITEMS
[LAMBDA (FRAME FROM.SUPERFRAMES.TOO ITYPE) (* DAHJr "18-APR-83 18:22")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
[COND
(FROM.SUPERFRAMES.TOO (for SUPERFRAME.NAME in (GET.FIELDQ FRAME SUPERFRAMES FRAME)
do (FLIP.ALL.ITEMS (FIND.FRAME CURRENT.INTERFACE SUPERFRAME.NAME)
FROM.SUPERFRAMES.TOO ITYPE]
(for ITEM in (GET.FIELDQ FRAME ITEMS FRAME) when (OR (NULL ITYPE)
(EQ ITYPE (ITEM.TYPE ITEM)))
do (FLIP.ITEM ITEM])
(FORGET.EDIT.WINDOWS
[LAMBDA NIL (* DAHJr " 5-DEC-83 12:29")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(for WINDOW in (APPEND (DEPENDENT.WINDOWS CURRENT.INTERFACE.WINDOW))
when (EQ (WINDOWPROP WINDOW (QUOTE TRILLIUM.WINDOW.TYPE))
(QUOTE ITEM.EDITOR))
do (CLOSEW WINDOW)
(DELETE.DEPENDENT.WINDOWS WINDOW T)
(DELETE.DEPENDENT.WINDOW CURRENT.INTERFACE.WINDOW WINDOW])
(FREEZE.ITEM
[LAMBDA (ITEM FRAME LOCATION COMPRESSFLG) (* HaKo " 9-SEP-83 10:19")
(DECLARE (GLOBALVARS TRILLIUM.GRID.DX TRILLIUM.GRID.DY TRILLIUM.GRID.X0 TRILLIUM.GRID.Y0))
(COND
((AND (COMPOSITE? ITEM)
(NOT (GET.FIELDQ ITEM FROZEN)))
(PROG (FROZEN.ITEM DX DY (PRIMITIVES (CONS)))
[SETQ DX (MINUS (XCOORD (fetch (LOCATION X) of LOCATION]
[SETQ DY (MINUS (YCOORD (fetch (LOCATION Y) of LOCATION]
(FREEZE.SUBITEMS PRIMITIVES (LIST ITEM)
COMPRESSFLG)
(for PRIM in (CAR PRIMITIVES)
do (TRANSLATE.PLACEMENT PRIM DX DY)
(RESET.ITEM PRIM))
(SETQ FROZEN.ITEM (ITEM.CREATE GROUP (PLACEMENT LOCATION)
(MEMBERS (CAR PRIMITIVES))
(FROZEN ITEM)))
(DELETE.OLD.ITEM FRAME ITEM)
(ADD.NEW.ITEM FRAME FROZEN.ITEM)
(ANALYZE.AND.ADD FROZEN.ITEM FRAME)
(RETURN T])
(FREEZE.SUBITEMS
[LAMBDA (PRIMITIVES ITEMLIST COMPRESSFLG) (* HaKo "27-Jul-84 17:05")
(PROG (BM (INITIALIZATIONS (CONS))
(ARTWORK (CONS))
(SENSORS (CONS))
(INHIBITORS (CONS))
(DISPLAYERS (CONS))
(IMPLICATIONS (CONS)))
(for ITEM in ITEMLIST
do (ANALYZE.ITEM ITEM)
(COLLECT.PRIMITIVES ITEM INITIALIZATIONS ARTWORK SENSORS INHIBITORS DISPLAYERS
IMPLICATIONS T)
(RESET.ITEM ITEM))
(COMPRESS.AND.ADD.ARTWORK PRIMITIVES (CAR ARTWORK)
COMPRESSFLG)
(COMPRESS.AND.ADD.INITIALIZATIONS PRIMITIVES (CAR INITIALIZATIONS))
(COMPRESS.AND.ADD.SENSORS PRIMITIVES (CAR SENSORS))
(COMPRESS.AND.ADD.INHIBITORS PRIMITIVES (CAR INHIBITORS))
(COMPRESS.AND.ADD.DISPLAYERS PRIMITIVES (CAR DISPLAYERS))
(COMPRESS.AND.ADD.IMPLICATIONS PRIMITIVES (CAR IMPLICATIONS))
(for PRIM in (CAR PRIMITIVES) do (for FIELD.NAME in (DEFINING.PTYPENAMES.OF.ITEM
(QUOTE (BITMAP.NAME))
PRIM)
do (OR (BITMAPP (SETQ BM (GET.PARAM PRIM FIELD.NAME)))
(SET.PARAM PRIM FIELD.NAME (FIND.BITMAP BM])
(GATHER.PRIMITIVE.ITEMS
[LAMBDA (ITEM PRIMITIVES) (* DAHJr " 9-MAR-83 13:57")
(* ASSUMES ITEM IS FULLY ANALYZED.
ADDS PRIMITIVES TO THE LIST)
(COND
((COMPOSITE? ITEM)
(for SUBITEM in (GET.FIELDQ ITEM SUBITEMS) do (GATHER.PRIMITIVE.ITEMS SUBITEM PRIMITIVES)))
(T (TCONC PRIMITIVES ITEM])
(GET.ALIGN.ITEMS.MENU
[LAMBDA NIL (* dls "28-JUN-84 11:09")
(DECLARE (GLOBALVARS ALIGN.ITEMS.MENU))
(OR ALIGN.ITEMS.MENU (SETQ ALIGN.ITEMS.MENU (create MENU
TITLE ← "Align items commands"
ITEMS ←(QUOTE ((ALIGN.ALONG.LEFT.EDGE
(QUOTE
ALIGN.ALONG.LEFT.EDGE)
"For aligning along left edge.")
(ALIGN.ALONG.RIGHT.EDGE
(QUOTE
ALIGN.ALONG.RIGHT.EDGE)
"For aligning along right edge.")
(ALIGN.ALONG.TOP.EDGE
(QUOTE ALIGN.ALONG.TOP.EDGE)
"For aligning along top edge.")
(ALIGN.ALONG.BOTTOM.EDGE
(QUOTE
ALIGN.ALONG.BOTTOM.EDGE)
"For aligning along bottom edge.")
(" " NIL)
(MATCH.HEIGHT (QUOTE
MATCH.HEIGHT)
"For matching the height of items to the height of a reference item.")
(MATCH.WIDTH (QUOTE
MATCH.WIDTH)
"For matching the width of items to the width of a reference item.")
(" " NIL)
(EXPAND.HEIGHT (QUOTE
EXPAND.HEIGHT)
"For expanding the height of items by a specified number of bits.")
(EXPAND.WIDTH (QUOTE
EXPAND.WIDTH)
"For expanding the width of items by a specified number of bits.")
(" " NIL)
(SHRINK.HEIGHT (QUOTE
SHRINK.HEIGHT)
"For shrinking the height of items by a specified number of bits.")
(SHRINK.WIDTH (QUOTE
SHRINK.WIDTH)
"For shrinking the width of items by a specified number of bits.")
(" " NIL)
(MOVE.LEFT (QUOTE MOVE.LEFT)
"For moving items left by a specified number of bits.")
(MOVE.RIGHT (QUOTE MOVE.RIGHT)
"For moving items right by a specified number of bits.")
(MOVE.UP (QUOTE MOVE.UP)
"For moving items up by a specified number of bits.")
(MOVE.DOWN (QUOTE MOVE.DOWN)
"For moving items down by a specified number of bits.")
(" " NIL)
(CENTER.IN.FRAME
(QUOTE CENTER.IN.FRAME)
"For centering qualifying items in the interface window.")
(CENTER.OVER.ITEM
(QUOTE CENTER.OVER.ITEM)
"For centering items over a reference item.")
(" " NIL)
(SAVE.PLACEMENT (QUOTE
SAVE.PLACEMENT)
"Save placement of item for later retrieval.")
(RETRIEVE.SAVED.PLACEMENT
(QUOTE
RETRIEVE.SAVED.PLACEMENT)
"Make item placement the same as saved placement.")
(" " NIL)
(HORIZONTAL.ITEM.DISTANCES
(QUOTE
HORIZONTAL.ITEM.DISTANCES)
"Computes the number of pixels between the left and/or right sides of two items.")
(VERTICAL.ITEM.DISTANCES
(QUOTE
VERTICAL.ITEM.DISTANCES)
"Computes the number of pixels between the tops and/or bottoms of two items.")
(DISTANCE.BETWEEN.POINTS
(QUOTE
DISTANCE.BETWEEN.POINTS)
"Computes the number of pixels between two points which you specify.")))
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
(GRAPH.ITEMS
[LAMBDA (FRAME) (* HaKo " 8-SEP-83 11:47")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW GRAPH.ITEMS.GRAPH.SPEC))
(PROG (ITEMS GRAPH.SPEC INTERESTING.ITEMS CELL.NAMES REAL.ROOTS TITLE GRAPH.FRAME.WINDOW)
(THINKING (SETQ ITEMS (GET.FIELDQ FRAME ITEMS FRAME))
(SETQ GRAPH.SPEC GRAPH.ITEMS.GRAPH.SPEC)
(SETQ INTERESTING.ITEMS (DEFINING.ITEMS.OF.FRAME FRAME))
(SETQ CELL.NAMES (DEFINING.PTYPES.OF.FRAME (QUOTE (CELL))
FRAME))
[SETQ REAL.ROOTS (for ITEM in INTERESTING.ITEMS collect (CONS ITEM (QUOTE ITEM]
(SETQ TITLE (CONCAT "Item graph for frame " (GET.FIELDQ FRAME NAME)))
(SETQ GRAPH.FRAME.WINDOW (MAKE.GRAPH NIL TITLE GRAPH.SPEC REAL.ROOTS FRAME
(QUOTE GRAPH.ITEMS.LEFTBUTTONFN)
(QUOTE GRAPH.ITEMS.MIDDLEBUTTONFN)))
(WINDOWPROP CURRENT.INTERFACE.WINDOW (QUOTE FRAME)
FRAME))
(RETURN GRAPH.FRAME.WINDOW])
(GRAPH.ITEMS.LEFTBUTTONFN
[LAMBDA (GRAPHNODE WINDOW) (* DAHJr " 6-APR-83 16:34")
(PROG (REGION)
(COND
((EQ (MAKE.GRAPH.STATE GRAPHNODE)
(QUOTE ITEM))
(SETQ REGION (BOUNDING.BOX (MAKE.GRAPH.DATUM GRAPHNODE)))
(for I to 8
do (FLIP.BOX REGION)
(DISMISS 200])
(GRAPH.ITEMS.MIDDLEBUTTONFN
[LAMBDA (GRAPHNODE WINDOW) (* DAHJr " 6-APR-83 16:14")
(PROG (ITEM REGION)
(COND
((EQ (MAKE.GRAPH.STATE GRAPHNODE)
(QUOTE ITEM))
(SETQ ITEM (MAKE.GRAPH.DATUM GRAPHNODE))
(SETQ REGION (BOUNDING.BOX ITEM))
(for I to 4
do (FLIP.BOX REGION)
(DISMISS 200))
(EDIT.ITEM ITEM (WINDOWPROP WINDOW (QUOTE FRAME])
(GROUP.ITEMS
[LAMBDA (FRAME) (* HaKo "13-Aug-84 15:53")
(PROG (REGION BBOX POSITION DX DY ITEMS NEW.GROUP)
(FLIP.ALL.ITEMS FRAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Surround items to be grouped together")
(SETQ REGION (ACQUIRE.REGION))
(FLIP.ALL.ITEMS FRAME)
(SETQ ITEMS (FIND.ENCLOSED.ITEMS REGION FRAME))
(COND
((NULL ITEMS)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "No items enclosed in that region")
(RETURN)))
(SETQ BBOX (COMPOSITE.BOUNDING.BOX ITEMS))
[COND
((REGIONP BBOX)
(SETQ POSITION (REGION/CENTER BBOX)))
(T (TRILLIUM.PRINTOUT ON PROMPTWINDOW "Indicate reference point of new group")
(SETQ POSITION (CREATE.OBJECT (QUOTE (POSITION]
(SETQ DX (MINUS (fetch (POSITION XCOORD) of POSITION)))
(SETQ DY (MINUS (fetch (POSITION YCOORD) of POSITION)))
(THINKING (for ITEM in ITEMS
do (DELETE.OLD.ITEM FRAME ITEM)
(TRANSLATE.PLACEMENT ITEM DX DY)
(RESET.ITEM ITEM))
(SETQ NEW.GROUP (ITEM.CREATE GROUP (PLACEMENT POSITION)
(MEMBERS ITEMS)))
(ADD.NEW.ITEM FRAME NEW.GROUP)
(ANALYZE&COMPLETE.ITEM NEW.GROUP)
(UPDATE&DISPLAY.FRAME FRAME NEW.GROUP (BOUNDING.BOX NEW.GROUP])
(HORIZONTAL.ITEM.DISTANCES
[LAMBDA (FRAME) (* HaKo "16-Aug-84 14:54")
(DECLARE (GLOBALVARS CURRENT.DSP CURRENT.INTERFACE.WINDOW))
(PROG (ITEM1 ITEM2 REGION X1 X2 EDGE1 EDGE2)
(SETQ ITEM1 (ACQUIRE.ITEM FRAME
"Select 1st item with mouse in left or right half of item region."
T))
(if (NULL ITEM1)
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: command aborted")
(RETURN))
(SETQ REGION (BOUNDING.BOX ITEM1))
[SETQ X1 (if (ILESSP (LASTMOUSEX CURRENT.DSP)
(fetch XCOORD of (REGION/CENTER REGION)))
then (SETQ EDGE1 (QUOTE LEFT))
(fetch LEFT of REGION)
else (SETQ EDGE1 (QUOTE RIGHT))
(IPLUS (fetch LEFT of REGION)
(fetch WIDTH of REGION]
(SETQ ITEM2 (ACQUIRE.ITEM FRAME "Select 2nd item similarly." T))
(if (NULL ITEM2)
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: using the window edge for 2nd reference.")
(SETQ REGION (CREATEREGION 0 0 (GETWINDOWPROP CURRENT.INTERFACE.WINDOW
(QUOTE WIDTH))
0))
else (SETQ REGION (BOUNDING.BOX ITEM2)))
[SETQ X2 (if (ILESSP (LASTMOUSEX CURRENT.DSP)
(fetch XCOORD of (REGION/CENTER REGION)))
then (SETQ EDGE2 (QUOTE LEFT))
(fetch LEFT of REGION)
else (SETQ EDGE2 (QUOTE RIGHT))
(IPLUS (fetch LEFT of REGION)
(fetch WIDTH of REGION]
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS T "The distance between the " EDGE1
" edge of the first item and the "
EDGE2 " edge of the second is:" T 5 (ABS (IDIFFERENCE X1 X2))
" pixels"])
(INTERACT©.ITEM
[LAMBDA (OLD.ITEM FRAME) (* HaKo "27-Jul-84 10:42")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW))
(PROG (NEW.ITEM DELTA.POSITION)
(COND
((NULL OLD.ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; copy command aborted"))
((NOT (TYPE.DEFINEDP OLD.ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot copy that item, as its type is undefined"))
(T (THINKING (SETQ NEW.ITEM (COPY.ITEM OLD.ITEM)))
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT NEW.ITEM
"Indicate a placement for the copied item"))
(THINKING (ADD.NEW.ITEM FRAME NEW.ITEM)
(TRANSLATE.PLACEMENT NEW.ITEM DELTA.POSITION)
(ANALYZE&COMPLETE.ITEM NEW.ITEM)
(UPDATE&DISPLAY.FRAME FRAME NEW.ITEM))
(EDIT.WINDOW.CREATE NEW.ITEM CURRENT.INTERFACE.WINDOW)
(RETURN NEW.ITEM])
(INTERACT&EDIT.ITEM
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:49")
(PROG ((ITEM (ACQUIRE.ITEM FRAME "Point out the item you wish to edit")))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; edit command aborted"))
(T (EDIT.ITEM ITEM FRAME])
(INTERACT&FREEZE.ITEM
[LAMBDA (FRAME INTERFACE) (* PI "23-Aug-84 10:59")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (ITEM LOCATION COMPRESSFLG)
(COND
[(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out ITEM to FREEZE"))
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Indicate reference point of frozen item")
(SETQ LOCATION (ACQUIRE.POSITION))
(SETQ COMPRESSFLG (CONFIRM "Compress artwork?"))
(THINKING (COND
((FREEZE.ITEM ITEM FRAME LOCATION COMPRESSFLG)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
(MARK.INTERFACE (OR INTERFACE CURRENT.INTERFACE))
(DISPLAY.FRAME FRAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Item FROZEN"))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"That ITEM already FROZEN; FREEZE ABORTED"]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "No ITEM found; FREEZE ABORTED"])
(INTERACT&THAW.ITEM
[LAMBDA (FRAME INTERFACE) (* HaKo "16-Aug-84 14:54")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (ITEM)
(COND
[(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out item to THAW" NIL (QUOTE GROUP)))
(THINKING (COND
((THAW.ITEM ITEM FRAME)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
(MARK.INTERFACE (OR INTERFACE CURRENT.INTERFACE))
(DISPLAY.FRAME FRAME)
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Item THAWed"))
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"This ITEM has no proper FROZEN attributes; THAW ABORTED"]
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "No ITEM found; THAW ABORTED"])
(ITEM.MATCHES
[LAMBDA (ITEM PATTERN) (* HaKo "27-Jul-84 16:47")
(for SPEC in PATTERN bind (FIELD VALUE CONDITION)
always (SETQ FIELD (CAR SPEC))
[COND
((EQ FIELD (QUOTE TYPE))
(SETQ FIELD (QUOTE \TYPE]
(COND
((NULL (SETQ VALUE (GET.PARAM ITEM FIELD)))
NIL)
((LISTP (SETQ CONDITION (CADR SPEC)))
(EVAL.WITHIN.ITEM CONDITION ITEM))
(T (EQUAL VALUE CONDITION])
(MATCH.ITEMS
[LAMBDA (FRAME MATCH.ALONG) (* HaKo "13-Aug-84 16:12")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (REF.ITEM REF.BBOX REF.DX REF.DY DX DY ITEMS.TO.REHAPE ITEM.BBOX CHANGES)
(SETQ REF.ITEM (ACQUIRE.ITEM FRAME "Point out the reference item:"))
(COND
((NULL REF.ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: match command aborted"))
((NOT (TYPE.DEFINEDP REF.ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't align by that item, as its type is undefined"))
([NOT (REGIONP (SETQ REF.BBOX (BOUNDING.BOX REF.ITEM]
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Can't match height for that kind of item."))
(T (SELECTQ MATCH.ALONG
(WIDTH (SETQ REF.DX (fetch (REGION WIDTH) of REF.BBOX)))
(HEIGHT (SETQ REF.DY (fetch (REGION HEIGHT) of REF.BBOX)))
(SHOULDNT))
(TRILLIUM.PRINTOUT "Point out the items to match; stop by missing.")
(SETQ ITEMS.TO.REHAPE (ACQUIRE.ITEMS FRAME))
(THINKING (for ITEM in ITEMS.TO.REHAPE when [AND (TYPE.DEFINEDP ITEM)
(REGIONP (SETQ ITEM.BBOX
(BOUNDING.BOX ITEM]
do (SETQ DX (if REF.DX
then (IDIFFERENCE REF.DX (fetch (REGION WIDTH)
of ITEM.BBOX))
else 0))
(SETQ DY (if REF.DY
then (IDIFFERENCE REF.DY (fetch (REGION HEIGHT)
of ITEM.BBOX))
else 0))
(RESET.ITEM ITEM)
(SHAPE.PLACEMENT ITEM 0 0 DX DY)
(ANALYZE&COMPLETE.ITEM ITEM)
(SETQ CHANGES T)))
(if CHANGES
then (UPDATE&DISPLAY.FRAME FRAME)
else (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No matchable items selected; command aborted."])
(MERGE.ACTIONS
[LAMBDA (ITEMS WRAPFN) (* HaKo "27-Jul-84 16:23")
(PROG [(ACTIONS (for ITEM in ITEMS collect (GET.PARAMQ ITEM ACTION.FORM]
(OR WRAPFN (SETQ ACTIONS (FLATTEN.ACTIONS ACTIONS)))
(RETURN (COND
((CDR ACTIONS)
(CONS (OR WRAPFN (QUOTE PROGN))
ACTIONS))
(T (CAR ACTIONS])
(MODIFY.ITEMS
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:51")
(PROG (REGION ITEMS PATTERN CHANGE.SPEC)
(FLIP.ALL.ITEMS FRAME)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Surround items to be modified")
(SETQ REGION (ACQUIRE.REGION))
(FLIP.ALL.ITEMS FRAME)
(SETQ ITEMS (FIND.ENCLOSED.ITEMS REGION FRAME))
(COND
(ITEMS)
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "No items enclosed in that region")
(RETURN)))
(TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Enter a filtering specification %"((PARAMETER VALUE) ... (PARAMETER VALUE))%":")
(SETQ PATTERN (PROMPT.READ))
[COND
((AND (LISTP PATTERN)
(EQ (CAR PATTERN)
(QUOTE EVAL)))
(SETQ PATTERN (EVAL (CADR PATTERN]
(TRILLIUM.PRINTOUT ON PROMPTWINDOW
"Enter a change specification %"((PARAMETER VALUE) ... (PARAMETER VALUE))%": ")
(SETQ CHANGE.SPEC (PROMPT.READ))
[COND
((AND (LISTP CHANGE.SPEC)
(EQ (CAR CHANGE.SPEC)
(QUOTE EVAL)))
(SETQ CHANGE.SPEC (EVAL (CADR CHANGE.SPEC]
(THINKING [for ITEM in ITEMS do (COND
((ITEM.MATCHES ITEM PATTERN)
(MAKE.CHANGES ITEM CHANGE.SPEC)
(ANALYZE&COMPLETE.ITEM ITEM]
(UPDATE&DISPLAY.FRAME FRAME])
(MOVE.ITEM
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:52")
(PROG (ITEM DELTA.POSITION OLD.POSITION)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out the item to be moved"))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: move command aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't move that item, as its type is undefined"))
(T (SETQ OLD.POSITION (BOUNDING.BOX ITEM))
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT ITEM
"Indicate a new placement for the item"))
(THINKING (TRANSLATE.PLACEMENT ITEM DELTA.POSITION)
(ANALYZE&COMPLETE.ITEM ITEM FRAME)
(UPDATE&DISPLAY.FRAME FRAME ITEM OLD.POSITION))
(RETURN ITEM])
(MOVE.ITEMS.IN.DIRECTION
[LAMBDA (FRAME DIRECTION) (* HaKo "13-Aug-84 15:51")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (DISP DX DY ITEMS.TO.MOVE CHANGES)
(TRILLIUM.PRINTOUT "Indicate number of bits to move (0 to abort)")
(SETQ DISP (CREATE.INTEGER))
(if (ZEROP DISP)
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Command aborted.")
(RETURN))
(SELECTQ DIRECTION
(LEFT (SETQ DX (IMINUS DISP))
(SETQ DY 0))
(RIGHT (SETQ DX DISP)
(SETQ DY 0))
(UP (SETQ DX 0)
(SETQ DY DISP))
(DOWN (SETQ DX 0)
(SETQ DY (IMINUS DISP)))
(SHOULDNT))
(TRILLIUM.PRINTOUT "Point out the items to move; stop by missing.")
(SETQ ITEMS.TO.MOVE (ACQUIRE.ITEMS FRAME))
(THINKING (for ITEM in ITEMS.TO.MOVE when (AND (TYPE.DEFINEDP ITEM)
(REGIONP (BOUNDING.BOX ITEM)))
do (RESET.ITEM ITEM)
(TRANSLATE.PLACEMENT ITEM DX DY)
(ANALYZE&COMPLETE.ITEM ITEM)
(SETQ CHANGES T)))
(if CHANGES
then (UPDATE&DISPLAY.FRAME FRAME)
else (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No movable items selected; command aborted."])
(NAME.ITEM
[LAMBDA (FRAME) (* HaKo "27-Jul-84 16:59")
(PROG (ITEM NAME)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out item to be named"))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: name command aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't move that item, as its type is undefined"))
(T (SETQ NAME (ACQUIRE.NAME "Give a name for the item: "))
(THINKING (* NAMING DOESN'T REQUIRE REANALYSIS OR REDISPLAY)
(SET.PARAMQ ITEM NAME NAME))
(RETURN ITEM])
(PRINT.ITEMS
[LAMBDA (FRAME) (* HaKo "16-Aug-84 14:55")
(DECLARE (GLOBALVARS CURRENT.DSP LASTMOUSEBUTTONS PRINT.SEPARATOR.STRING))
(PROG (DONE ITEM ANY)
(TRILLIUM.PRINTOUT ON PROMPTWINDOW "Point out items to be printed; stop by missing.")
(* * USES THE CODE FOR (ACQUIRE.ITEM FRAME))
(FLIP.ALL.ITEMS FRAME NIL NIL)
[until DONE
do (WAITBUG)
(COND
[(LASTMOUSESTATE MIDDLE)
(SETQ ITEM (ACQUIRE.NAMED.ITEM.FROM FRAME))
(COND
(ITEM (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK
PRINT.SEPARATOR.STRING)
(PRINT.ITEM ITEM)
(SETQ ANY T]
(T (WAITNOBUG)
(SETQ ITEM (ACQUIRE.ITEM.FROM FRAME NIL NIL (LASTMOUSEX CURRENT.DSP)
(LASTMOUSEY CURRENT.DSP)))
(COND
(ITEM (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK
PRINT.SEPARATOR.STRING)
(PRINT.ITEM ITEM)
(SETQ ANY T))
(T (SETQ DONE T]
(FLIP.ALL.ITEMS FRAME NIL NIL)
(COND
(ANY (TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS SAME.BLOCK PRINT.SEPARATOR.STRING T])
(REFORM.ITEM
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:53")
(PROG (ITEM COMMAND.MENU)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out the item you wish to reform"))
(RETURN (COND
(ITEM (SETQ COMMAND.MENU (create MENU
ITEMS ←(QUOTE (DEDIT EDITE INSPECT))
CENTERFLG ← T))
(SELECTQ (MENU COMMAND.MENU)
(NIL NIL)
(DEDIT (DEDIT.FORM ITEM))
(EDITE (DEDIT.FORM ITEM))
(INSPECT (PROPLIST.WINDOW.CREATE ITEM))
(SHOULDNT "Unrecognized command in REFORM.ITEM"))
NIL)
(T (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; edit command aborted")
NIL])
(REMOVE.FROM.ARTWORK
[LAMBDA (ITEM FRAME) (* edited: "23-JUN-82 12:10")
(SET.FIELDQ FRAME ARTWORK (DREMOVE ITEM (GET.FIELDQ FRAME ARTWORK FRAME])
(REMOVE.FROM.DISPLAYERS
[LAMBDA (ITEM FRAME) (* HK "20-JUL-82 10:30")
(PROG ((DISPLAYERS (GET.FIELDQ FRAME DISPLAYERS FRAME)))
(for DISPLAYER in DISPLAYERS when (EQ ITEM (CADR DISPLAYER))
do (COND
((EQ DISPLAYER (CAR DISPLAYERS))
(SET.FIELDQ FRAME DISPLAYERS (CDR DISPLAYERS)))
(T (DREMOVE DISPLAYER DISPLAYERS)))
(RETURN])
(REMOVE.FROM.IMPLICATIONS
[LAMBDA (ITEM FRAME) (* HK "20-JUL-82 10:22")
(PROG ((IMPLICATIONS (GET.FIELDQ FRAME IMPLICATIONS FRAME)))
(for IMPLICATION in IMPLICATIONS when (EQ ITEM (CADR IMPLICATION))
do (COND
((EQ IMPLICATION (CAR IMPLICATIONS))
(SET.FIELDQ FRAME IMPLICATIONS (CDR IMPLICATIONS)))
(T (DREMOVE IMPLICATION IMPLICATIONS)))
(RETURN])
(REMOVE.FROM.INHIBITORS
[LAMBDA (ITEM FRAME) (* HK "20-JUL-82 10:40")
(PROG ((INHIBITORS (GET.FIELDQ FRAME INHIBITORS FRAME)))
(for INHIBITOR in INHIBITORS when (EQ ITEM (CADR INHIBITOR))
do (COND
((EQ INHIBITOR (CAR INHIBITORS))
(SET.FIELDQ FRAME INHIBITORS (CDR INHIBITORS)))
(T (DREMOVE INHIBITOR INHIBITORS)))
(RETURN])
(REMOVE.FROM.INITIALIZATION
[LAMBDA (ITEM FRAME) (* edited: "23-JUN-82 12:16")
(SET.FIELDQ FRAME INITIALIZATION (DREMOVE ITEM (GET.FIELDQ FRAME INITIALIZATION FRAME])
(REMOVE.FROM.SENSORS
[LAMBDA (ITEM FRAME) (* edited: "23-JUN-82 12:20")
(SET.FIELDQ FRAME SENSORS (DREMOVE ITEM (GET.FIELDQ FRAME SENSORS FRAME])
(REMOVE.ITEM
[LAMBDA (ITEM FRAME) (* DAHJr " 6-DEC-83 12:27")
(SET.FIELDQ FRAME 6LISTS NIL])
(RESET.6LISTS
[LAMBDA (FRAME) (* DAHJr "16-SEP-83 15:37")
(SET.FIELDQ FRAME INITIALIZATION NIL)
(SET.FIELDQ FRAME ARTWORK NIL)
(SET.FIELDQ FRAME SENSORS NIL)
(SET.FIELDQ FRAME INHIBITORS NIL)
(SET.FIELDQ FRAME DISPLAYERS NIL)
(SET.FIELDQ FRAME IMPLICATIONS NIL)
(SET.FIELDQ FRAME 6LISTS NIL)
(COMPRESS.PROPLIST FRAME])
(RESET.ITEM
[LAMBDA (ITEM) (* DAHJr " 5-JAN-84 20:58")
(SET.FIELDQ ITEM BOUNDING.BOX NIL)
(SET.FIELDQ ITEM SUBITEMS NIL)
(OR (NLSETQ (APPLY* (OR (GETPROP (ITEM.TYPE ITEM)
(QUOTE RESET))
(QUOTE NILL))
ITEM))
(REPORT.LISP.ERROR "reseting an item" ITEM))
(COMPRESS.PROPLIST ITEM)
NIL])
(RESHAPE.ITEMS
[LAMBDA (FRAME RESHAPE.COMMAND) (* HaKo "13-Aug-84 15:51")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(PROG (DX DY ITEMS.TO.REHAPE CHANGES)
(SELECTQ RESHAPE.COMMAND
(EXPAND.WIDTH (TRILLIUM.PRINTOUT "Indicate bits to expand width (0 to abort):")
(SETQ DX (CREATE.INTEGER))
(SETQ DY 0))
(SHRINK.WIDTH (TRILLIUM.PRINTOUT "Indicate bits to shrink width (0 to abort):")
(SETQ DX (IMINUS (CREATE.INTEGER)))
(SETQ DY 0))
(EXPAND.HEIGHT (TRILLIUM.PRINTOUT "Indicate bits to expand height (0 to abort):")
(SETQ DX 0)
(SETQ DY (CREATE.INTEGER)))
[SHRINK.HEIGHT (TRILLIUM.PRINTOUT "Indicate bits to shrink height (0 to abort):")
(SETQ DX 0)
(SETQ DY (IMINUS (CREATE.INTEGER]
(SHOULDNT))
(if (AND (ZEROP DX)
(ZEROP DY))
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "Command aborted.")
(RETURN))
(TRILLIUM.PRINTOUT "Point out the items to reshape; stop by missing:")
(SETQ ITEMS.TO.REHAPE (ACQUIRE.ITEMS FRAME))
(THINKING (for ITEM in ITEMS.TO.REHAPE when (AND (TYPE.DEFINEDP ITEM)
(REGIONP (BOUNDING.BOX ITEM)))
do (RESET.ITEM ITEM)
(SHAPE.PLACEMENT ITEM 0 0 DX DY)
(ANALYZE&COMPLETE.ITEM ITEM)
(SETQ CHANGES T)))
(if CHANGES
then (UPDATE&DISPLAY.FRAME FRAME)
else (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No reshapable items selected; command aborted."])
(RETRIEVE.SAVED.ITEM
[LAMBDA (FRAME) (* HaKo "25-Jul-84 16:54")
(* edited: " 6-May-84 16:59")
(DECLARE (GLOBALVARS CURRENT.INTERFACE.WINDOW TRILLIUM.SAVED.ITEM))
(PROG (NEW.ITEM DELTA.POSITION)
(COND
((NULL TRILLIUM.SAVED.ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS "No item saved"))
(T (THINKING (SETQ NEW.ITEM (COPY.ITEM TRILLIUM.SAVED.ITEM)))
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT NEW.ITEM
"Indicate a placement for the copied item"))
(THINKING (ADD.NEW.ITEM FRAME NEW.ITEM)
(TRANSLATE.PLACEMENT NEW.ITEM DELTA.POSITION)
(ANALYZE&COMPLETE.ITEM NEW.ITEM)
(UPDATE&DISPLAY.FRAME FRAME NEW.ITEM))
(EDIT.WINDOW.CREATE NEW.ITEM CURRENT.INTERFACE.WINDOW)
(RETURN NEW.ITEM])
(RETRIEVE.SAVED.PLACEMENT
[LAMBDA (FRAME)
(DECLARE (GLOBALVARS CURRENT.INTERFACE TRILLIUM.SAVED.PLACEMENT))
(* HaKo "13-Aug-84 15:21")
(PROG (ITEM BBOX DX DY)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out item for retrieved placement."))
(COND
((NULL TRILLIUM.SAVED.PLACEMENT)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"No previously saved placement available; command aborted."))
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; command aborted."))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot change placement of item of undefined type; command aborted."))
([NOT (REGIONP (SETQ BBOX (BOUNDING.BOX ITEM]
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Item has undefined bounding box; command aborted."))
(T (THINKING (SETQ DX (IDIFFERENCE (fetch (REGION LEFT) of TRILLIUM.SAVED.PLACEMENT)
(fetch (REGION LEFT) of BBOX)))
(SETQ DY (IDIFFERENCE (fetch (REGION BOTTOM) of TRILLIUM.SAVED.PLACEMENT)
(fetch (REGION BOTTOM) of BBOX)))
(RESET.ITEM ITEM)
(TRANSLATE.PLACEMENT ITEM DX DY)
(ANALYZE&COMPLETE.ITEM ITEM)
(MARK.FRAME.CONTEXT.OBSOLETE FRAME)
(MARK.INTERFACE CURRENT.INTERFACE)
(DISPLAY.FRAME FRAME])
(SAME.PICTURE.PARAMS?
[LAMBDA (PIC1 PIC2) (* HaKo "27-Jul-84 16:23")
(AND (EQUAL (GET.PARAMQ PIC1 SOURCE)
(GET.PARAMQ PIC2 SOURCE))
(EQUAL (GET.PARAMQ PIC1 OPERATION)
(GET.PARAMQ PIC2 OPERATION))
(EQUAL (GET.PARAMQ PIC1 TEXTURE)
(GET.PARAMQ PIC2 TEXTURE))
(EQUAL (GET.PARAMQ PIC1 FIGURE-COLOR)
(GET.PARAMQ PIC2 FIGURE-COLOR))
(EQUAL (GET.PARAMQ PIC1 GROUND-COLOR)
(GET.PARAMQ PIC2 GROUND-COLOR])
(SAVE.ITEM
[LAMBDA (FRAME) (* HaKo "16-Aug-84 14:55")
(DECLARE (GLOBALVARS TRILLIUM.SAVED.ITEM))
(PROG ((ITEM (ACQUIRE.ITEM FRAME "Point out item to be saved")))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; save command aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot save that item, as its type is undefined"))
(T (SETQ TRILLIUM.SAVED.ITEM (COPY.ITEM ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "A copy of an item of type " (ITEM.TYPE ITEM)
" saved"])
(SAVE.PLACEMENT
[LAMBDA (FRAME)
(DECLARE (GLOBALVARS TRILLIUM.SAVED.PLACEMENT)) (* HaKo "16-Aug-84 14:56")
(PROG (ITEM BBOX)
(SETQ ITEM (ACQUIRE.ITEM FRAME "Point out item with desired placement."))
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed; command aborted."))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot save placement of item of undefined type; command aborted."))
([NOT (REGIONP (SETQ BBOX (BOUNDING.BOX ITEM]
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Item has undefined bounding box; command aborted."))
(T (SETQ TRILLIUM.SAVED.PLACEMENT (COPYALL BBOX))
(TRILLIUM.PRINTOUT ON TRILLIUM.TRACE "Placement saved."])
(SHAPE.ITEM
[LAMBDA (ITEM FRAME) (* HaKo "27-Jul-84 10:48")
(DECLARE (GLOBALVARS TRILLIUM.MOVE.AFTER.SHAPE))
(PROG (PLACEMENT DELTA.POSITION OLD.POSITION)
(COND
((NULL ITEM)
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: move command aborted"))
((NOT (TYPE.DEFINEDP ITEM))
(TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Can't move that item, as its type is undefined"))
(T (SETQ OLD.POSITION (BOUNDING.BOX ITEM))
(SETQ PLACEMENT (ACQUIRE.PLACEMENT ITEM "Indicate a new placement for the item"))
(THINKING (SET.PLACEMENT ITEM PLACEMENT))
[COND
(TRILLIUM.MOVE.AFTER.SHAPE (ANALYZE.ITEM ITEM)
(SETQ DELTA.POSITION (ACQUIRE.MOVED.PLACEMENT ITEM
"Indicate a new placement for the item"))
(THINKING (TRANSLATE.PLACEMENT ITEM DELTA.POSITION]
(THINKING (ANALYZE&COMPLETE.ITEM ITEM)
(UPDATE&DISPLAY.FRAME FRAME ITEM OLD.POSITION))
(RETURN ITEM])
(THAW.ITEM
[LAMBDA (ITEM FRAME) (* HaKo "31-AUG-83 17:37")
(PROG ((ORIGITEM (GET.FIELDQ ITEM FROZEN)))
(COND
((AND ORIGITEM (NEQ ORIGITEM T))
(DELETE.OLD.ITEM FRAME ITEM)
(ADD.NEW.ITEM FRAME ORIGITEM)
(ANALYZE.AND.ADD ORIGITEM FRAME)
(RETURN T])
(VERTICAL.ITEM.DISTANCES
[LAMBDA (FRAME) (* HaKo "16-Aug-84 14:56")
(DECLARE (GLOBALVARS CURRENT.DSP CURRENT.INTERFACE.WINDOW))
(PROG (ITEM1 ITEM2 REGION Y1 Y2 EDGE1 EDGE2)
(SETQ ITEM1 (ACQUIRE.ITEM FRAME
"Select 1st item with mouse in TOP or BOTTOM half of item region."
T))
(if (NULL ITEM1)
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: command aborted")
(RETURN))
(SETQ REGION (BOUNDING.BOX ITEM1))
[SETQ Y1 (if (ILESSP (LASTMOUSEY CURRENT.DSP)
(fetch YCOORD of (REGION/CENTER REGION)))
then (SETQ EDGE1 (QUOTE BOTTOM))
(fetch BOTTOM of REGION)
else (SETQ EDGE1 (QUOTE TOP))
(IPLUS (fetch BOTTOM of REGION)
(fetch HEIGHT of REGION]
(SETQ ITEM2 (ACQUIRE.ITEM FRAME "Select 2nd item similarly." T))
(if (NULL ITEM2)
then (TRILLIUM.PRINTOUT ON TRILLIUM.WARNINGS
"Cannot find any item where you pointed: using the window edge for 2nd reference.")
[SETQ REGION (CREATEREGION 0 0 0 (GETWINDOWPROP CURRENT.INTERFACE.WINDOW
(QUOTE HEIGHT]
else (SETQ REGION (BOUNDING.BOX ITEM2)))
[SETQ Y2 (if (ILESSP (LASTMOUSEY CURRENT.DSP)
(fetch YCOORD of (REGION/CENTER REGION)))
then (SETQ EDGE2 (QUOTE BOTTOM))
(fetch BOTTOM of REGION)
else (SETQ EDGE2 (QUOTE TOP))
(IPLUS (fetch BOTTOM of REGION)
(fetch HEIGHT of REGION]
(TRILLIUM.PRINTOUT ON TRILLIUM.DESCRIPTIONS T "The distance between the " EDGE1
" edge of the first item and the "
EDGE2 " edge of the second is:" T 5 (ABS (IDIFFERENCE Y1 Y2))
" pixels"])
)
(RPAQQ CONFIRM.VALUE.CHANGES NIL)
(RPAQQ GRAPH.ITEMS.GRAPH.SPEC (ITEM (LABEL (ITEM.TYPE DATUM)
SONS
((DEFINING.PTYPES.OF.ITEM (QUOTE (CELL))
DATUM)
(QUOTE CELL)))
CELL
(LABEL DATUM)))
(RPAQQ FULL.MENU NIL)
(RPAQQ ALIGN.ITEMS.MENU NIL)
(RPAQQ TRILLIUM.SAVED.ITEM NIL)
(RPAQQ TRILLIUM.SAVED.PLACEMENT NIL)
(RPAQQ TRILLIUM.MOVE.AFTER.SHAPE NIL)
(RPAQQ DISPLAY.CHANGED.ITEM.ONLY NIL)
(PUTPROPS TRI-EDITITEM COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2211 65933 (ACQUIRE.ITEMS 2221 . 3080) (ADD.NEW.ITEM 3082 . 3388) (ADD.SUBITEMS 3390 .
4116) (ADD.TO.6LISTS 4118 . 5053) (ADD.TO.ARTWORK 5055 . 5364) (ADD.TO.DISPLAYERS 5366 . 5808) (
ADD.TO.IMPLICATIONS 5810 . 6237) (ADD.TO.INHIBITORS 6239 . 6644) (ADD.TO.INITIALIZATION 6646 . 7004) (
ADD.TO.SENSORS 7006 . 7311) (ALIGN.ITEMS 7313 . 8986) (ALIGN.ITEMS.ALONG.EDGE 8988 . 11125) (
BUILD.6LISTS 11127 . 12207) (BURY.ITEM 12209 . 12935) (CENTER.IN.FRAME 12937 . 14001) (
CENTER.OVER.ITEM 14003 . 15799) (CLOSE.EDIT.WINDOWS 15801 . 16095) (COLLECT.PRIMITIVES 16097 . 17294)
(COMPRESS.AND.ADD.ARTWORK 17296 . 18120) (COMPRESS.AND.ADD.DISPLAYERS 18122 . 18324) (
COMPRESS.AND.ADD.IMPLICATIONS 18326 . 19300) (COMPRESS.AND.ADD.INHIBITORS 19302 . 20256) (
COMPRESS.AND.ADD.INITIALIZATIONS 20258 . 20668) (COMPRESS.AND.ADD.PICTURES 20670 . 22308) (
COMPRESS.AND.ADD.SENSORS 22310 . 22496) (COPY.ITEM 22498 . 22939) (CREATE.NEW.ITEM 22941 . 24085) (
DELETE.ITEM 24087 . 24819) (DELETE.OLD.ITEM 24821 . 25683) (DISTANCE.BETWEEN.POINTS 25685 . 26616) (
EDIT.ITEM 26618 . 26980) (EDIT.WINDOW.OPEN 26982 . 27494) (EXCISE.INTERMEDIATE.STRUCTURE 27496 . 28055
) (EXPAND.ITEM 28057 . 29259) (FLATTEN.ACTIONS 29261 . 29823) (FLIP.ALL.ITEMS 29825 . 30364) (
FORGET.EDIT.WINDOWS 30366 . 30843) (FREEZE.ITEM 30845 . 31785) (FREEZE.SUBITEMS 31787 . 33013) (
GATHER.PRIMITIVE.ITEMS 33015 . 33458) (GET.ALIGN.ITEMS.MENU 33460 . 37006) (GRAPH.ITEMS 37008 . 37998)
(GRAPH.ITEMS.LEFTBUTTONFN 38000 . 38354) (GRAPH.ITEMS.MIDDLEBUTTONFN 38356 . 38802) (GROUP.ITEMS
38804 . 40185) (HORIZONTAL.ITEM.DISTANCES 40187 . 42069) (INTERACT©.ITEM 42071 . 43030) (
INTERACT&EDIT.ITEM 43032 . 43413) (INTERACT&FREEZE.ITEM 43415 . 44331) (INTERACT&THAW.ITEM 44333 .
45050) (ITEM.MATCHES 45052 . 45516) (MATCH.ITEMS 45518 . 47379) (MERGE.ACTIONS 47381 . 47773) (
MODIFY.ITEMS 47775 . 49153) (MOVE.ITEM 49155 . 50004) (MOVE.ITEMS.IN.DIRECTION 50006 . 51279) (
NAME.ITEM 51281 . 51999) (PRINT.ITEMS 52001 . 53192) (REFORM.ITEM 53194 . 53929) (REMOVE.FROM.ARTWORK
53931 . 54128) (REMOVE.FROM.DISPLAYERS 54130 . 54553) (REMOVE.FROM.IMPLICATIONS 54555 . 55002) (
REMOVE.FROM.INHIBITORS 55004 . 55427) (REMOVE.FROM.INITIALIZATION 55429 . 55647) (REMOVE.FROM.SENSORS
55649 . 55846) (REMOVE.ITEM 55848 . 55992) (RESET.6LISTS 55994 . 56397) (RESET.ITEM 56399 . 56775) (
RESHAPE.ITEMS 56777 . 58327) (RETRIEVE.SAVED.ITEM 58329 . 59231) (RETRIEVE.SAVED.PLACEMENT 59233 .
60670) (SAME.PICTURE.PARAMS? 60672 . 61138) (SAVE.ITEM 61140 . 61820) (SAVE.PLACEMENT 61822 . 62648) (
SHAPE.ITEM 62650 . 63700) (THAW.ITEM 63702 . 64050) (VERTICAL.ITEM.DISTANCES 64052 . 65931)))))
STOP