(FILECREATED "11-Jan-85 19:29:34" {PHYLUM}<TRILLIUM>BIRTHDAY84>INTERFACES>PUBLIC-PTYPES.;1 24467
changes to: (VARS PUBLIC-PTYPESCOMS))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PUBLIC-PTYPESCOMS)
(RPAQQ PUBLIC-PTYPESCOMS ((PTYPES BITMAP BITMAP.NAME CELL COLOR.NAME COLOR.NUMBER COMPUTED.VALUE
CONSTANT COPY FONT FORM FRAME FRAME.CLASSES INTEGER ITEM
ITYPE.CLASSES LIST OFFSET.VECTOR ONEOF POSITION POSITION2 QUOTE
REGION SHADE STRING STRUCTURE)))
(READ.PTYPE BITMAP 1)
(\TYPE PTYPE NAME BITMAP COMMENT "A BITBLT texture" OTHER (FNS ((CREATE BITMAP/CREATE) (EDIT
BITMAP/EDIT))))
(DEFINEQ
(BITMAP/CREATE
[LAMBDA (TYPE) (* HaKo " 6-Aug-84 13:00")
(* DAHJr "13-JUN-83 19:04")
(DECLARE (SPECVARS NEW.BITMAP))
(PROG (SCREEN.REGION NEW.BITMAP WIDTH HEIGHT)
(TRILLIUM.PRINTOUT "Indicate size and initial bitmap by designating a region of the screen")
(SETQ SCREEN.REGION (GETREGION))
(SETQ WIDTH (fetch (REGION WIDTH) of SCREEN.REGION))
(SETQ HEIGHT (fetch (REGION HEIGHT) of SCREEN.REGION))
(SETQ NEW.BITMAP (BITMAPCREATE WIDTH HEIGHT))
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of SCREEN.REGION)
(fetch (REGION BOTTOM) of SCREEN.REGION)
NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(NLSETQ (EDITBM NEW.BITMAP))
(RETURN NEW.BITMAP])
(BITMAP/EDIT
[LAMBDA (TYPE OBJECT)
(EDIT.BITMAP OBJECT])
)
(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) (* HaKo " 6-Aug-84 13:02")
(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 CELL 1)
(\TYPE PTYPE NAME CELL COMMENT "A cell name" OTHER (FNS ((CREATE CELL/CREATE))))
(DEFINEQ
(CELL/CREATE
[LAMBDA (TYPE) (* DAHJr "13-JUN-83 19:11")
(DECLARE (GLOBALVARS CURRENT.MACHINE.STATE))
(PROG (COMMAND.MENU COMMAND)
[SETQ COMMAND.MENU (create MENU
TITLE ← "Cells"
ITEMS ←(NCONC1 (for ELEMENT on CURRENT.MACHINE.STATE
by (CDDR ELEMENT) unless (EQ (CAR ELEMENT)
(QUOTE \TYPE))
collect (CAR ELEMENT))
(QUOTE NEW.CELL]
(SETQ COMMAND (MENU COMMAND.MENU))
(RETURN (SELECTQ COMMAND
(NIL NIL)
(NEW.CELL (TRILLIUM.PRINTOUT "New cell name: ")
(PROMPT.READ))
COMMAND])
)
(READ.PTYPE COLOR.NAME 1)
(\TYPE PTYPE NAME COLOR.NAME COMMENT "A color name" OTHER (FNS ((CREATE COLOR.NAME/CREATE))))
(DEFINEQ
(COLOR.NAME/CREATE
[LAMBDA (PTYPE) (* HaKo "14-Aug-84 16:35")
(CREATE.COLOR.NAME])
)
(READ.PTYPE COLOR.NUMBER 1)
(\TYPE PTYPE NAME COLOR.NUMBER COMMENT "A color number" OTHER (FNS ((CREATE COLOR.NUMBER/CREATE))))
(DEFINEQ
(COLOR.NUMBER/CREATE
[LAMBDA NIL (* DAHJr " 8-DEC-83 18:05")
(MENU (create MENU
TITLE ← "Choose one of"
ITEMS ←(QUOTE (0 1 2 3 4 5 6 7))
CENTERFLG ← T
CHANGEOFFSETFLG ← T])
)
(READ.PTYPE COMPUTED.VALUE 1)
(\TYPE PTYPE NAME COMPUTED.VALUE COMMENT "A value computed by a form" OTHER (FNS ((CREATE
COMPUTED.VALUE/CREATE))))
(DEFINEQ
(COMPUTED.VALUE/CREATE
[LAMBDA (TYPE) (* HaKo " 6-Aug-84 13:06")
(TRILLIUM.EVAL (CADR TYPE)
(CONCAT "Creating a new computed value using form " (CADR TYPE])
)
(READ.PTYPE CONSTANT 1)
(\TYPE PTYPE NAME CONSTANT COMMENT "A constant" OTHER (FNS ((CREATE CONSTANT/CREATE))))
(DEFINEQ
(CONSTANT/CREATE
[LAMBDA NIL (* DAHJr "19-JAN-83 16:58")
(TRILLIUM.PRINTOUT "Enter a constant (word or number): ")
(PROMPT.READ])
)
(READ.PTYPE COPY 1)
(\TYPE PTYPE NAME COPY COMMENT "A quoted thing" OTHER (FNS ((CREATE COPY/CREATE))))
(DEFINEQ
(COPY/CREATE
[LAMBDA (PTYPE) (* DAHJr "13-JUN-83 19:15")
(COPYALL (CADR PTYPE])
)
(READ.PTYPE FONT 1)
(\TYPE PTYPE NAME FONT COMMENT "A font descriptor" OTHER (FNS ((CREATE FONT/CREATE))))
(DEFINEQ
(FONT/CREATE
[LAMBDA NIL (* HaKo " 3-AUG-83 09:20")
(PROG (FONT FAMILY SIZE WEIGHT SLOPE EXPANSION LOADED.FONTS FAMILIES)
[SETQ LOADED.FONTS (SORT (FONTS.IN.CORE)
(FUNCTION (LAMBDA (X Y)
(COND
[(EQ (CAR X)
(CAR Y))
(NOT (IGREATERP (CADR X)
(CADR Y]
(T (ALPHORDER (CAR X)
(CAR Y]
[SETQ FONT (MENU (create MENU
TITLE ← "Font:"
ITEMS ←(NCONC (for FONT in LOADED.FONTS
collect (LIST FONT (KWOTE FONT)))
(LIST (QUOTE (" " NIL))
(QUOTE NEW.FONT]
(OR (EQ FONT (QUOTE NEW.FONT))
(RETURN FONT))
(SETQ FAMILIES (for FONT in LOADED.FONTS collect (CAR FONT)))
(SETQ FAMILIES (SORT (INTERSECTION FAMILIES FAMILIES)))
(OR (SETQ FAMILY (MENU (create MENU
TITLE ← "Font family:"
ITEMS ←(NCONC FAMILIES (LIST (QUOTE (" " NIL))
(QUOTE NEW.FAMILY)))
CENTERFLG ← T)))
(RETURN))
[COND
((EQ FAMILY (QUOTE NEW.FAMILY))
(OR (SETQ FAMILY (ACQUIRE.NAME "Type new font family"))
(RETURN]
(SETQ SIZE (RNUMBER "Font size:"))
(OR (SETQ WEIGHT (MENU (create MENU
TITLE ← "Font weight:"
ITEMS ←(QUOTE (LIGHT MEDIUM BOLD))
CENTERFLG ← T)))
(RETURN))
(OR (SETQ SLOPE (MENU (create MENU
TITLE ← "Font slope:"
ITEMS ←(QUOTE (REGULAR ITALIC))
CENTERFLG ← T)))
(RETURN))
(OR (SETQ EXPANSION (MENU (create MENU
TITLE ← "Font expansion:"
ITEMS ←(QUOTE (REGULAR COMPRESSED EXPANDED))
CENTERFLG ← T)))
(RETURN))
(RETURN (LIST FAMILY SIZE (LIST WEIGHT SLOPE EXPANSION])
)
(READ.PTYPE FORM 1)
(\TYPE PTYPE NAME FORM COMMENT "A Lisp form" OTHER (FNS ((CREATE FORM/CREATE) (EDIT FORM/EDIT))))
(DEFINEQ
(FORM/CREATE
[LAMBDA (TYPE) (* HaKo "17-Aug-84 10:58")
(EDIT.FORM (QUOTE (Edit this form into what you want])
(FORM/EDIT
[LAMBDA (TYPE OBJECT) (* HaKo "17-Aug-84 10:59")
(EDIT.FORM OBJECT])
)
(READ.PTYPE FRAME 1)
(\TYPE PTYPE NAME FRAME COMMENT "A frame" OTHER (FNS ((CREATE FRAME/CREATE))))
(DEFINEQ
(FRAME/CREATE
[LAMBDA NIL (* DAHJr "19-JAN-83 22:53")
(DECLARE (GLOBALVARS CURRENT.INTERFACE))
(ACQUIRE.FRAME.NAME CURRENT.INTERFACE])
)
(READ.PTYPE FRAME.CLASSES 1)
(\TYPE PTYPE NAME FRAME.CLASSES COMMENT "A frame class" OTHER (FNS ((CREATE FRAME.CLASSES/CREATE)
(EDIT FRAME.CLASSES/EDIT))))
(DEFINEQ
(FRAME.CLASSES/CREATE
[LAMBDA NIL (* HK "27-JUL-82 16:52")
(EDIT.CLASS NIL (QUOTE FRAMES])
(FRAME.CLASSES/EDIT
[LAMBDA (TYPE OBJECT) (* DAHJr "13-JUN-83 19:23")
(EDIT.CLASS OBJECT (QUOTE FRAMES])
)
(READ.PTYPE INTEGER 1)
(\TYPE PTYPE NAME INTEGER COMMENT "An integer" OTHER (FNS ((CREATE INTEGER/CREATE))))
(DEFINEQ
(INTEGER/CREATE
[LAMBDA (PTYPE) (* HaKo "14-Aug-84 16:37")
(CREATE.INTEGER])
)
(READ.PTYPE ITEM 1)
(\TYPE PTYPE NAME ITEM COMMENT "An item of any sort" OTHER (FNS ((CREATE ITEM/CREATE) (EDIT
ITEM/EDIT) (WALK ITEM/WALK))))
(DEFINEQ
(ITEM/CREATE
[LAMBDA (TYPE) (* HaKo "14-Aug-84 16:41")
(* DAHJr "13-JUN-83 19:17")
(CREATE.ITEM (COND
((LISTP (CADR TYPE))
(CAADR TYPE))
(T (ACQUIRE.ITEM.TYPE])
(ITEM/EDIT
[LAMBDA (TYPE OBJECT)
(EDIT.WINDOW.CREATE OBJECT])
(ITEM/WALK
[LAMBDA (ITEM PTYPE CONTEXT ACTIONFN ACTIONFNARG) (* HaKo "15-Aug-84 13:47")
(WALK.ITEM ITEM CONTEXT ACTIONFN ACTIONFNARG])
)
(READ.PTYPE ITYPE.CLASSES 1)
(\TYPE PTYPE NAME ITYPE.CLASSES COMMENT "An itemtype class" OTHER (FNS ((CREATE
ITYPE.CLASSES/CREATE) (EDIT ITYPE.CLASSES/EDIT))))
(DEFINEQ
(ITYPE.CLASSES/CREATE
[LAMBDA NIL (* HK "27-JUL-82 16:51")
(EDIT.CLASS NIL (QUOTE ITEM.TYPES])
(ITYPE.CLASSES/EDIT
[LAMBDA (TYPE OBJECT) (* HaKo "17-Aug-84 11:04")
(EDIT.CLASS OBJECT (QUOTE ITEM.TYPES])
)
(READ.PTYPE LIST 1)
(\TYPE PTYPE NAME LIST COMMENT "A list" OTHER (FNS ((CREATE LIST/CREATE) (EDIT LIST/EDIT) (WALK
LIST/WALK))))
(DEFINEQ
(LIST/CREATE
[LAMBDA (PTYPE) (* DAHJr "23-JUN-83 09:16")
(CREATE.LIST (CADR PTYPE])
(LIST/EDIT
[LAMBDA (TYPE OBJECT)
(EDIT.LIST OBJECT (CADR TYPE])
(LIST/WALK
[LAMBDA (LIST PTYPE CONTEXT ACTIONFN ACTIONFNARG) (* HaKo "15-Aug-84 14:02")
(for OBJECT in LIST bind (RESULT (SUB.TYPE ←(CADR PTYPE))
(NEWCONTEXT ←(LIST LIST CONTEXT)))
when (SETQ RESULT (WALK.OBJECT OBJECT SUB.TYPE NEWCONTEXT ACTIONFN ACTIONFNARG))
do (RETURN RESULT])
)
(READ.PTYPE OFFSET.VECTOR 1)
(\TYPE PTYPE NAME OFFSET.VECTOR COMMENT "A position in screen coordinates" OTHER (FNS ((CREATE
OFFSET.VECTOR/CREATE) (NIL FLIP.X))))
(DEFINEQ
(OFFSET.VECTOR/CREATE
[LAMBDA (TYPE PNAME ITEM) (* HaKo "17-Aug-84 15:26")
(PROG (REF.PNAME P1 P2)
[COND
([SETQ REF.PNAME (CAR (LISTP (CADR (LISTP TYPE]
(SETQ P1 (GET.PARAM ITEM REF.PNAME)))
(T (TRILLIUM.PRINTOUT "Point out the reference point for the offset")
(SETQ P1 (ACQUIRE.POSITION]
(TRILLIUM.PRINTOUT "Point out the offset")
(SETQ P2 (ACQUIRE.POSITION P1 T))
(RETURN (NEW.POSITION (IDIFFERENCE (fetch (POSITION XCOORD) of P2)
(fetch (POSITION XCOORD) of P1))
(IDIFFERENCE (fetch (POSITION YCOORD) of P2)
(fetch (POSITION YCOORD) of P1])
(FLIP.X
[LAMBDA (XCOORD YCOORD) (* KKM "12-Jun-84 08:53")
(DECLARE (GLOBALVARS CURRENT.DSP TRILLIUM.X.BITMAP))
(PROG (WIDTH HEIGHT)
(SETQ WIDTH (fetch (BITMAP BITMAPWIDTH) of TRILLIUM.X.BITMAP))
(SETQ HEIGHT (fetch (BITMAP BITMAPHEIGHT) of TRILLIUM.X.BITMAP))
(BITBLT TRILLIUM.X.BITMAP 0 0 CURRENT.DSP (IDIFFERENCE XCOORD (IQUOTIENT WIDTH 2))
(IDIFFERENCE YCOORD (IQUOTIENT HEIGHT 2))
WIDTH HEIGHT (QUOTE INPUT)
(QUOTE INVERT])
)
(READ.PTYPE ONEOF 1)
(\TYPE PTYPE NAME ONEOF COMMENT "A choice" OTHER (FNS ((CREATE ONEOF/CREATE))))
(DEFINEQ
(ONEOF/CREATE
[LAMBDA (TYPE)
(CREATE.ONEOF (CADR TYPE])
)
(READ.PTYPE POSITION 1)
(\TYPE PTYPE NAME POSITION COMMENT "A position in screen coordinates" OTHER (FNS ((CREATE
POSITION/CREATE) (TRANSLATE POSITION/TRANSLATE))))
(DEFINEQ
(POSITION/CREATE
[LAMBDA (TYPE) (* HaKo "13-Aug-84 09:26")
(* * old way: (* DAHJr "13-JUN-83 17:59") (PROG (LASTX LASTY MARKX MARKY PREVIOUSX PREVIOUSY)
(SETQ LASTX (LASTMOUSEX CURRENT.DSP)) (SETQ LASTY (LASTMOUSEY CURRENT.DSP)) (SETQ MARKX LASTX)
(SETQ MARKY LASTY) (FLIP.SPOT MARKX MARKY) (while (ZEROP (MOUSEBUTTONS)) do (SETQ LASTX (LASTMOUSEX CURRENT.DSP))
(SETQ LASTY (LASTMOUSEY CURRENT.DSP)) (COND ((KEYDOWNP (QUOTE LSHIFT)) (SETQ LASTX (XGRIDIFY LASTX))
(SETQ LASTY (YGRIDIFY LASTY)))) (COND ((OR (NEQ LASTX PREVIOUSX) (NEQ LASTY PREVIOUSY)) (FLIP.SPOT MARKX MARKY)
(SETQ MARKX LASTX) (SETQ MARKY LASTY) (FLIP.SPOT MARKX MARKY) (SETQ PREVIOUSX LASTX) (SETQ PREVIOUSY LASTY))))
(FLIP.SPOT MARKX MARKY) (WAITNOBUG) (RETURN (CONS LASTX LASTY))))
(ACQUIRE.POSITION])
(POSITION/TRANSLATE
[LAMBDA (POSITION DX DY) (* DAHJr " 6-OCT-83 17:39")
(COND
[DX (PROG (RDX RDY)
[COND
(DY (SETQ RDX DX)
(SETQ RDY DY))
(T (SETQ RDX (fetch (POSITION XCOORD) of DX))
(SETQ RDY (fetch (POSITION YCOORD) of DX]
(RETURN (create POSITION
XCOORD ←(IPLUS RDX (fetch (POSITION XCOORD) of POSITION))
YCOORD ←(IPLUS RDY (fetch (POSITION YCOORD) of POSITION]
(T POSITION])
)
(READ.PTYPE POSITION2 1)
(\TYPE PTYPE NAME POSITION2 COMMENT "A 2-point position in screen coordinates" OTHER (FNS ((CREATE
POSITION2/CREATE CREATE.POSITION2) (TRANSLATE POSITION2/TRANSLATE))))
(DEFINEQ
(POSITION2/CREATE
[LAMBDA (TYPE) (* HaKo "17-Aug-84 11:31")
(* DAHJr "13-JUN-83 18:44")
(PROG (P1 P2)
(TRILLIUM.PRINTOUT "Point out first position (of two)")
(SETQ P1 (ACQUIRE.POSITION))
(TRILLIUM.PRINTOUT "Point out second position (of two)")
(SETQ P2 (ACQUIRE.POSITION P1 T))
(RETURN (NEW.POSITION2 P1 P2])
(POSITION2/TRANSLATE
[LAMBDA (PLACEMENT DX DY) (* DAHJr " 6-OCT-83 18:40")
(COND
[DX (PROG (RDX RDY)
[COND
(DY (SETQ RDX DX)
(SETQ RDY DY))
(T (SETQ RDX (fetch (POSITION XCOORD) of DX))
(SETQ RDY (fetch (POSITION YCOORD) of DX]
(RETURN (create POSITION2
XCOORD1 ←(IPLUS RDX (fetch (POSITION2 XCOORD1) of PLACEMENT))
YCOORD1 ←(IPLUS RDY (fetch (POSITION2 YCOORD1) of PLACEMENT))
XCOORD2 ←(IPLUS RDX (fetch (POSITION2 XCOORD2) of PLACEMENT))
YCOORD2 ←(IPLUS RDY (fetch (POSITION2 YCOORD2) of PLACEMENT]
(T (create POSITION
XCOORD ←(fetch (POSITION2 XCOORD1) of PLACEMENT)
YCOORD ←(fetch (POSITION2 YCOORD1) of PLACEMENT])
)
(READ.PTYPE QUOTE 1)
(\TYPE PTYPE NAME QUOTE COMMENT "A quoted thing" OTHER (FNS ((CREATE QUOTE/CREATE))))
(DEFINEQ
(QUOTE/CREATE
[LAMBDA (PTYPE) (* DAHJr "13-JUN-83 18:52")
(CADR PTYPE])
)
(READ.PTYPE REGION 1)
(\TYPE PTYPE NAME REGION COMMENT "A region in screen coordinates" OTHER (FNS ((CREATE REGION/CREATE
) (TRANSLATE REGION/TRANSLATE) (NIL REGION/LEFT) (NIL REGION/RIGHT) (NIL REGION/BOTTOM) (NIL
REGION/TOP) (NIL REGION/WIDTH) (NIL REGION/HEIGHT) (NIL REGION/CENTER) (NIL REGION/NORTH) (NIL
REGION/NORTHEAST) (NIL REGION/EAST) (NIL REGION/SOUTHEAST) (NIL REGION/SOUTH) (NIL
REGION/SOUTHWEST) (NIL REGION/WEST) (NIL REGION/NORTHWEST))))
(DEFINEQ
(REGION/CREATE
[LAMBDA (TYPE) (* DAHJr "23-JUN-83 17:17")
(ACQUIRE.REGION])
(REGION/TRANSLATE
[LAMBDA (PLACEMENT DX DY) (* DAHJr " 6-OCT-83 18:11")
(COND
[DX (PROG (RDX RDY)
[COND
(DY (SETQ RDX DX)
(SETQ RDY DY))
(T (SETQ RDX (fetch (POSITION XCOORD) of DX))
(SETQ RDY (fetch (POSITION YCOORD) of DX]
(RETURN (create REGION
LEFT ←(IPLUS RDX (fetch (REGION LEFT) of PLACEMENT))
BOTTOM ←(IPLUS RDY (fetch (REGION BOTTOM) of PLACEMENT))
WIDTH ←(fetch (REGION WIDTH) of PLACEMENT)
HEIGHT ←(fetch (REGION HEIGHT) of PLACEMENT]
(T (create POSITION
XCOORD ←(fetch (REGION LEFT) of PLACEMENT)
YCOORD ←(fetch (REGION BOTTOM) of PLACEMENT])
(REGION/LEFT
[LAMBDA (REGION)
(fetch (REGION LEFT) of REGION])
(REGION/RIGHT
[LAMBDA (REGION) (* DAHJr " 4-JUN-83 22:10")
(IPLUS (fetch (REGION LEFT) of REGION)
(fetch (REGION WIDTH) of REGION)
-1])
(REGION/BOTTOM
[LAMBDA (REGION) (* DAHJr " 4-JUN-83 22:11")
(fetch (REGION BOTTOM) of REGION])
(REGION/TOP
[LAMBDA (REGION) (* DAHJr " 4-JUN-83 22:12")
(IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION)
-1])
(REGION/WIDTH
[LAMBDA (REGION) (* DAHJr " 4-JUN-83 22:12")
(fetch (REGION WIDTH) of REGION])
(REGION/HEIGHT
[LAMBDA (REGION) (* DAHJr " 4-JUN-83 22:13")
(fetch (REGION HEIGHT) of REGION])
(REGION/CENTER
[LAMBDA (REGION) (* DAHJr "15-JAN-83 16:37")
(create POSITION
XCOORD ←(IPLUS (fetch (REGION LEFT) of REGION)
(IQUOTIENT (fetch (REGION WIDTH) of REGION)
2))
YCOORD ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(IQUOTIENT (fetch (REGION HEIGHT) of REGION)
2])
(REGION/NORTH
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:55")
(create POSITION
XCOORD ←(IPLUS (fetch (REGION LEFT) of REGION)
(IQUOTIENT (fetch (REGION WIDTH) of REGION)
2))
YCOORD ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION)
-1])
(REGION/NORTHEAST
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:55")
(create POSITION
XCOORD ←(IPLUS (fetch (REGION LEFT) of REGION)
(fetch (REGION WIDTH) of REGION)
-1)
YCOORD ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION)
-1])
(REGION/EAST
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:56")
(create POSITION
XCOORD ←(IPLUS (fetch (REGION LEFT) of REGION)
(fetch (REGION WIDTH) of REGION)
-1)
YCOORD ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(IQUOTIENT (fetch (REGION HEIGHT) of REGION)
2])
(REGION/SOUTHEAST
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:56")
(create POSITION
XCOORD ←(IPLUS (fetch (REGION LEFT) of REGION)
(fetch (REGION WIDTH) of REGION)
-1)
YCOORD ←(fetch (REGION BOTTOM) of REGION])
(REGION/SOUTH
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:57")
(create POSITION
XCOORD ←(IPLUS (fetch (REGION LEFT) of REGION)
(IQUOTIENT (fetch (REGION WIDTH) of REGION)
2))
YCOORD ←(fetch (REGION BOTTOM) of REGION])
(REGION/SOUTHWEST
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:57")
(create POSITION
XCOORD ←(fetch (REGION LEFT) of REGION)
YCOORD ←(fetch (REGION BOTTOM) of REGION])
(REGION/WEST
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:58")
(create POSITION
XCOORD ←(fetch (REGION LEFT) of REGION)
YCOORD ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(IQUOTIENT (fetch (REGION HEIGHT) of REGION)
2])
(REGION/NORTHWEST
[LAMBDA (REGION) (* DAHJr "12-JUN-83 22:58")
(create POSITION
XCOORD ←(fetch (REGION LEFT) of REGION)
YCOORD ←(IPLUS (fetch (REGION BOTTOM) of REGION)
(fetch (REGION HEIGHT) of REGION)
-1])
)
(READ.PTYPE SHADE 1)
(\TYPE PTYPE NAME SHADE COMMENT "A BITBLT texture" OTHER (FNS ((CREATE SHADE/CREATE) (EDIT
SHADE/EDIT))))
(DEFINEQ
(SHADE/CREATE
[LAMBDA (PTYPE)
(EDITSHADE])
(SHADE/EDIT
[LAMBDA (PTYPE OBJECT)
(EDITSHADE OBJECT])
)
(READ.PTYPE STRING 1)
(\TYPE PTYPE NAME STRING COMMENT "A string" OTHER (FNS ((CREATE STRING/CREATE) (EDIT STRING/EDIT))
))
(DEFINEQ
(STRING/CREATE
[LAMBDA (TYPE)
(TEDIT.STRING "Edit this string into what you want"])
(STRING/EDIT
[LAMBDA (TYPE OBJECT)
(TEDIT.STRING OBJECT])
)
(READ.PTYPE STRUCTURE 1)
(\TYPE PTYPE NAME STRUCTURE COMMENT "A structure" OTHER (FNS ((CREATE STRUCTURE/CREATE) (EDIT
STRUCTURE/EDIT) (WALK STRUCTURE/WALK))))
(DEFINEQ
(STRUCTURE/CREATE
[LAMBDA (TYPE)
(CREATE.STRUCTURE (CADR TYPE])
(STRUCTURE/EDIT
[LAMBDA (TYPE OBJECT)
(EDIT.FORM OBJECT])
(STRUCTURE/WALK
[LAMBDA (STRUCTURE PTYPE CONTEXT ACTIONFN ACTIONFNARG) (* HaKo "15-Aug-84 14:02")
(for FIELD in (CADR PTYPE) as OBJECT in STRUCTURE bind (RESULT (NEWCONTEXT ←(LIST STRUCTURE
CONTEXT)))
when (SETQ RESULT (WALK.OBJECT OBJECT (CADR FIELD)
NEWCONTEXT ACTIONFN ACTIONFNARG))
do (RETURN RESULT])
)
(PUTPROPS PUBLIC-PTYPES COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (668 1725 (BITMAP/CREATE 678 . 1651) (BITMAP/EDIT 1653 . 1723)) (1853 3940 (
BITMAP.NAME/CREATE 1863 . 3938)) (4045 4803 (CELL/CREATE 4055 . 4801)) (4927 5082 (COLOR.NAME/CREATE
4937 . 5080)) (5214 5487 (COLOR.NUMBER/CREATE 5224 . 5485)) (5638 5885 (COMPUTED.VALUE/CREATE 5648 .
5883)) (6001 6211 (CONSTANT/CREATE 6011 . 6209)) (6319 6475 (COPY/CREATE 6329 . 6473)) (6586 8680 (
FONT/CREATE 6596 . 8678)) (8803 9126 (FORM/CREATE 8813 . 8988) (FORM/EDIT 8990 . 9124)) (9230 9453 (
FRAME/CREATE 9240 . 9451)) (9615 9951 (FRAME.CLASSES/CREATE 9625 . 9784) (FRAME.CLASSES/EDIT 9786 .
9949)) (10064 10213 (INTEGER/CREATE 10074 . 10211)) (10363 10939 (ITEM/CREATE 10373 . 10697) (
ITEM/EDIT 10699 . 10774) (ITEM/WALK 10776 . 10937)) (11105 11448 (ITYPE.CLASSES/CREATE 11115 . 11278)
(ITYPE.CLASSES/EDIT 11280 . 11446)) (11585 12201 (LIST/CREATE 11595 . 11743) (LIST/EDIT 11745 . 11826)
(LIST/WALK 11828 . 12199)) (12369 13756 (OFFSET.VECTOR/CREATE 12379 . 13166) (FLIP.X 13168 . 13754))
(13861 13946 (ONEOF/CREATE 13871 . 13944)) (14117 15613 (POSITION/CREATE 14127 . 15025) (
POSITION/TRANSLATE 15027 . 15611)) (15813 17205 (POSITION2/CREATE 15823 . 16332) (POSITION2/TRANSLATE
16334 . 17203)) (17316 17460 (QUOTE/CREATE 17326 . 17458)) (17938 23050 (REGION/CREATE 17948 . 18085)
(REGION/TRANSLATE 18087 . 18883) (REGION/LEFT 18885 . 18965) (REGION/RIGHT 18967 . 19186) (
REGION/BOTTOM 19188 . 19346) (REGION/TOP 19348 . 19568) (REGION/WIDTH 19570 . 19726) (REGION/HEIGHT
19728 . 19886) (REGION/CENTER 19888 . 20307) (REGION/NORTH 20309 . 20709) (REGION/NORTHEAST 20711 .
21096) (REGION/EAST 21098 . 21496) (REGION/SOUTHEAST 21498 . 21814) (REGION/SOUTH 21816 . 22147) (
REGION/SOUTHWEST 22149 . 22397) (REGION/WEST 22399 . 22729) (REGION/NORTHWEST 22731 . 23048)) (23183
23321 (SHADE/CREATE 23193 . 23249) (SHADE/EDIT 23251 . 23319)) (23450 23632 (STRING/CREATE 23460 .
23557) (STRING/EDIT 23559 . 23630)) (23799 24383 (STRUCTURE/CREATE 23809 . 23890) (STRUCTURE/EDIT
23892 . 23963) (STRUCTURE/WALK 23965 . 24381)))))
STOP