(FILECREATED "11-Dec-84 09:51:22" {AZTEC}<TRILLIUM>BIRTHDAY84>FIXES>TRI-FIX-HENR-TYPES.;3
previous date: " 6-Dec-84 11:08:06" {AZTEC}<TRILLIUM>BIRTHDAY84>FIXES>TRI-FIX-HENR-TYPES.;2)
(PRETTYCOMPRINT TRI-FIX-HENR-TYPESCOMS)
(RPAQQ TRI-FIX-HENR-TYPESCOMS ((* Henrietta fixes to Trillium Itemtypes and Ptypes)
(* ITEMTYPES)
(* LABELLED.BUTTON Changed default LABEL value to be "1" instead of 1)
(ITEMTYPES LABELLED.BUTTON)
(* PTYPES)
(* Submitted by PatH: BITMAP.NAME/CREATE used (LISTGET
CURRENT.FRAME.CLASSES
(QUOTE
BITMAP.FRAMES))
instead of CURRENT.BITMAP.FRAMES)
(FNS BITMAP.NAME/CREATE.Original)
(PTYPES BITMAP.NAME)
(P (COMPILE.INTERNAL.FNS.IF.NECESSARY))))
(* Henrietta fixes to Trillium Itemtypes and Ptypes)
(* ITEMTYPES)
(* LABELLED.BUTTON Changed default LABEL value to be "1" instead of 1)
(READ.ITEMTYPE LABELLED.BUTTON 5)
(\TYPE ITEM.TYPE NAME LABELLED.BUTTON COMMENT
"A button, with a label centered on it, which flashes when pushed, and performs an action" KIND
COMPOSITE PARAMETERS ((\TYPE PARAMETER NAME PLACEMENT TYPE (POSITION) DEFAULT (170 . 170) COMMENT
"The grid position of the lower left corner of the button" GRID.TYPE (LOCATION)) (\TYPE PARAMETER
NAME LABEL TYPE (STRING) DEFAULT "1" COMMENT "The words on the button") (\TYPE PARAMETER NAME FONT
TYPE (FONT) DEFAULT NIL COMMENT "The font for the button label") (\TYPE PARAMETER NAME ACTION.FORM
TYPE (FORM) DEFAULT (ACTION.PRINT "This action brought to you by a LABELLED.BUTTON") COMMENT
"The action caused by this button") (\TYPE PARAMETER NAME PICTURE TYPE (BITMAP.NAME) DEFAULT
SIMPLE.BUTTON.BITMAP COMMENT "The graphic for the button")) SUBITEM.SPECS ((LABEL BUTTON (ITEM
PICTURE (PLACEMENT (PTRANSLATE PLACEMENT (NEW.POSITION (MINUS BUTTON.BITMAP.EXTRA) 0))) (BITMAP
PICTURE))) (ITEM LINE.OF.TEXT (PLACEMENT (PICTURE.CENTER BUTTON)) (LINE LABEL) (XALIGNMENT (
QUOTE CENTER)) (FONT FONT)) (ITEM FLASHING.SENSITIVE.REGION (PLACEMENT (BOUNDING.BOX BUTTON)) (
ACTION.FORM ACTION.FORM))) CLASSES (COMPOSITE BUTTON))
(* PTYPES)
(* Submitted by PatH: BITMAP.NAME/CREATE used (LISTGET CURRENT.FRAME.CLASSES (QUOTE
BITMAP.FRAMES)) instead of CURRENT.BITMAP.FRAMES)
(DEFINEQ
(BITMAP.NAME/CREATE.Original
[LAMBDA (TYPE) (* kkm "19-Nov-84 12:38")
(DECLARE (GLOBALVARS CURRENT.FRAME CURRENT.FRAME.CLASSES CURRENT.INTERFACE))
(PROG [BITMAPNAMEMENU FRAMENAMEMENU BITMAPNAME FRAMELIST (RETURNTOCLASSMENU
(CONSTANT (MENUNAME.FROM.CLASSNAME (QUOTE RETURN.TO.FRAME.LIST]
(* USING STRUCTURED MENUS (PROG (NAMES) (SETQ NAMES (for ITEM in (GET.FIELDQ (FIND.FRAME CURRENT.DIALOG
(QUOTE BITMAPS)) ITEMS FRAME) when (EQ (ITEM.TYPE ITEM) (QUOTE BITMAP)) collect (GET.FIELDQ ITEM NAME)))
(SETQ NAMES (SORT NAMES)) (COND ((EQUAL (CAR BITMAP.NAME.MENU) NAMES)) (T (SETQ BITMAP.NAME.MENU
(CONS NAMES (STRUCTURED.MENU.CREATE NAMES 20 NIL NIL NIL T NIL NIL NIL NIL T))))) (RETURN
(STRUCTURED.MENU.INVOKE (CDR BITMAP.NAME.MENU)))))
[SETQ FRAMELIST (OR (LISTGET CURRENT.FRAME.CLASSES (QUOTE BITMAP.FRAMES))
(LIST (QUOTE BITMAPS]
(SETQ BITMAPNAMEMENU (SETQ FRAMENAMEMENU (create MENU
TITLE ← "Choose Bitmap Frame: "
ITEMS ←[UNION (LIST (
MENUNAME.FROM.CLASSNAME (GET.FIELDQ CURRENT.FRAME NAME FRAME)))
(SORT (for FRAME
in FRAMELIST
collect
(
MENUNAME.FROM.CLASSNAME FRAME]
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
[while (MENUCLASSNAMEP (SETQ BITMAPNAME (MENU BITMAPNAMEMENU)))
do (COND
((EQ BITMAPNAME RETURNTOCLASSMENU)
(SETQ BITMAPNAMEMENU FRAMENAMEMENU))
(T (SETQ BITMAPNAMEMENU (GET.BITMAP.NAME.MENU (for ITEM
in (GET.FIELDQ
(FIND.FRAME CURRENT.INTERFACE
(
CLASSNAME.FROM.MENUNAME BITMAPNAME))
ITEMS FRAME)
when (EQ (ITEM.TYPE ITEM)
(QUOTE BITMAP))
collect (GET.PARAMQ ITEM NAME))
RETURNTOCLASSMENU]
(RETURN (OR BITMAPNAME (QUOTE EXAMPLE.BITMAP])
)
(READ.PTYPE BITMAP.NAME 1)
(\TYPE PTYPE NAME BITMAP.NAME COMMENT "A Bitmap name" OTHER (FNS ((CREATE BITMAP.NAME/CREATE))))
(DEFINEQ
(BITMAP.NAME/CREATE
[LAMBDA (TYPE) (* edited: "11-Dec-84 09:43")
(DECLARE (GLOBALVARS CURRENT.FRAME CURRENT.FRAME.CLASSES CURRENT.INTERFACE))
(PROG [BITMAPNAMEMENU FRAMENAMEMENU BITMAPNAME FRAMELIST (RETURNTOCLASSMENU
(CONSTANT (MENUNAME.FROM.CLASSNAME (QUOTE RETURN.TO.FRAME.LIST]
(* USING STRUCTURED MENUS (PROG (NAMES) (SETQ NAMES (for ITEM in (GET.FIELDQ (FIND.FRAME CURRENT.DIALOG
(QUOTE BITMAPS)) ITEMS FRAME) when (EQ (ITEM.TYPE ITEM) (QUOTE BITMAP)) collect (GET.FIELDQ ITEM NAME)))
(SETQ NAMES (SORT NAMES)) (COND ((EQUAL (CAR BITMAP.NAME.MENU) NAMES)) (T (SETQ BITMAP.NAME.MENU
(CONS NAMES (STRUCTURED.MENU.CREATE NAMES 20 NIL NIL NIL T NIL NIL NIL NIL T))))) (RETURN
(STRUCTURED.MENU.INVOKE (CDR BITMAP.NAME.MENU)))))
(SETQ FRAMELIST (FOR FRAME IN (OR CURRENT.BITMAP.FRAMES (SET.CURRENT.BITMAP.FRAMES))
COLLECT (GET.FIELDQ FRAME NAME FRAME)))
(SETQ BITMAPNAMEMENU (SETQ FRAMENAMEMENU (create MENU
TITLE ← "Choose Bitmap Frame: "
ITEMS ←[UNION (LIST (
MENUNAME.FROM.CLASSNAME (GET.FIELDQ CURRENT.FRAME NAME FRAME)))
(SORT (for FRAME
in FRAMELIST
collect
(
MENUNAME.FROM.CLASSNAME FRAME]
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
[while (MENUCLASSNAMEP (SETQ BITMAPNAME (MENU BITMAPNAMEMENU)))
do (COND
((EQ BITMAPNAME RETURNTOCLASSMENU)
(SETQ BITMAPNAMEMENU FRAMENAMEMENU))
(T (SETQ BITMAPNAMEMENU (GET.BITMAP.NAME.MENU (for ITEM
in (GET.FIELDQ
(FIND.FRAME CURRENT.INTERFACE
(
CLASSNAME.FROM.MENUNAME BITMAPNAME))
ITEMS FRAME)
when (EQ (ITEM.TYPE ITEM)
(QUOTE BITMAP))
collect (GET.PARAMQ ITEM NAME))
RETURNTOCLASSMENU]
(RETURN (OR BITMAPNAME (QUOTE EXAMPLE.BITMAP])
)
(COMPILE.INTERNAL.FNS.IF.NECESSARY)
STOP