(FILECREATED "26-Apr-85 14:40:50" {FLOPPY}SMENUEDIT.;1 27951
changes to: (VARS SMENUEDITCOMS))
(* Copyright (c) by NIL. All rights reserved.)
(PRETTYCOMPRINT SMENUEDITCOMS)
(RPAQQ SMENUEDITCOMS [(FNS ADD-SMENUITEM DELETE-SMENUITEM DEMO DONOTHING DRAW-BORDER EDITSMENU
ERASE-SMENUITEM GET-REGIONVALS GET-SELECTION M1 MOVEREGION REDRAW
REENABLE.SMENU RESHAPESMENU SETUP2 SETUP3 UNDELETE-SMENUITEM)
(VARS BM1 BM2 BM3 BM4 BM5)
(P (SETQ SMENU-MENU (M1)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML GET-REGIONVALS)
(LAMA])
(DEFINEQ
(ADD-SMENUITEM
[LAMBDA (SMENU W) (* JTS "21-Apr-85 19:50")
(PROG ((OLDTTY (TTYDISPLAYSTREAM)))
(TTYDISPLAYSTREAM PROMPTWINDOW)
(PROMPTPRINT "** INTERACTIVE ADD **")
(TERPRI)
(PROG ((BORDER (fetch (SMENU SMENUBORDERSIZE) of SMENU))
(BMASSOC (fetch (SMENU BMASSOCLST) of SMENU))
(ITEMS (fetch (SMENU ITEMS) of SMENU))
LEF BOT WID HGT TEMP LABEL FN PROMPT REG FONT NEWITEM)
[SETQ LABEL (TTYIN "ITEM LABEL: " NIL
"THE LABEL MUST BE A STRING OR EVAL TO 1. A BITMAP 2. A LIST OF ATOMS "
(QUOTE (NORAISE LISPXREAD]
(SETQ TEMP (CAR LABEL))
[SETQ LABEL (COND
((AND (ATOM TEMP)
(NEQ TEMP (QUOTE ')))
TEMP)
((STRINGP TEMP)
(LIST (QUOTE QUOTE)
(MKLST TEMP)))
((AND (LISTP (CADR LABEL))
(EQ TEMP (QUOTE ')))
LABEL)
(T (LIST (QUOTE QUOTE)
TEMP]
[SETQ FN (CAR (TTYIN "FUNCTION: " NIL
"FUNCTION ASSOCIATED WITH SELECTING THIS NEW ITEM"
(QUOTE (NORAISE LISPXREAD]
[SETQ PROMPT (TTYIN "HELP STRING: " NIL "WILL BE HELP STIING FOR THIS ITEM"
(QUOTE (NORAISE LISPXREAD]
[SETQ PROMPT (COND
((STRINGP (CAR PROMPT))
(CAR PROMPT))
(T (MKSTRING PROMPT]
[SETQ REG (OR (TTYIN "REGION: " NIL "REGION FOR ITEM: (L B W H) "
(QUOTE (NORAISE LISPXREAD)))
(PROMPTPRINT "SWEEP OUT A REGION FOR THE NEW ITEM ")
(TERPRI)
(do (PRINTBELLS)
(PROMPTPRINT "SWEEP OUT A REGION FOR THE NEW ITEM ")
until [PROGN NIL (SETQ TEMP (GETREGION))
(GET-REGIONVALS LEF BOT WID HGT TEMP)
(AND (EQ W (WHICHW LEF BOT))
(EQ W (WHICHW (IPLUS LEF WID)
(IPLUS BOT HGT]
finally (RETURN TEMP]
(SETQ REG (for R in (COND
((LISTP (CAR REG))
(CAR REG))
(T REG))
collect (EVAL R)))
(DRAW-BORDER W REG BORDER)
[SETQ FONT (CAR (TTYIN "FONT FOR REGION: " NIL "FONT FOR TEXT IN REGION: "
(QUOTE (NORAISE LISPXREAD]
(SETQ NEWITEM (LIST LABEL FN PROMPT REG FONT))
(PROG (RLEF RBOT RWID RHGT NEWITEMBM)
(GET-REGIONVALS RLEF RBOT RWID RHGT REG)
(BITBLT [SETQ NEWITEMBM (COND
((BITMAPP (EVAL LABEL))
(EVAL LABEL))
(T (TEXTMAP NEWITEM REG]
0 0 W RLEF RBOT RWID RHGT)
(PUTASSOC NEWITEM NEWITEMBM BMASSOC))
(replace ITEMS of SMENU with (CONS NEWITEM ITEMS))
(TTYDISPLAYSTREAM OLDTTY])
(DELETE-SMENUITEM
[LAMBDA (SMENU ITEM W) (* JTS "22-Apr-85 13:36")
(PROG [LEF BOT WID HGT (REG (GET-REGION ITEM))
(ITEMLST (fetch (SMENU ITEMS) of SMENU))
(BORDER (fetch (SMENU SMENUBORDERSIZE) of SMENU))
(ITEMBM (ASSOC ITEM (fetch (SMENU BMASSOCLST) of SMENU]
(GET-REGIONVALS LEF BOT WID HGT REG)
(COND
((MOUSECONFIRM "ARE YOU SURE YOU WANT TO DELETE THIS ITEM?")
(replace ITEMS of SMENU with (REMOVE ITEM ITEMLST))
(ERASE-SMENUITEM SMENU ITEM W BORDER T)
(SMENUPROP SMENU (QUOTE LASTDELETEDITEM)
ITEM])
(DEMO
[LAMBDA NIL (* edited: "26-Apr-85 14:06")
(SETQ SMENU-DEMO-SAVE PROMPTWINDOW)
(OR (AND (BOUNDP S2)
(TYPE? SMENU S2))
(SETUP2))
(OR (AND (BOUNDP S3)
(TYPE? SMENU S3))
(SETUP3))
(SETQ PROMPTWINDOW (GETPROMPTWINDOW (ADDSMENU S3 (create POSITION
XCOORD ← 10
YCOORD ← 10))
3])
(DONOTHING
[LAMBDA (A B C) (* edited: "17-Mar-85 17:28")
NIL])
(DRAW-BORDER
[LAMBDA (IMAGE REGION BORDER ERASEFLG) (* JTS "17-Mar-85 20:45")
(PROG (LEF BOT WID HGT)
(GET-REGIONVALS LEF BOT WID HGT REGION)
(GRID (GET-BOXREGION REGION BORDER ERASEFLG)
1 1 BORDER IMAGE (COND
(ERASEFLG WHITESHADE)
(T BLACKSHADE)))
(BITBLT IMAGE (IPLUS LEF WID)
(IPLUS BOT HGT)
IMAGE
(IPLUS LEF WID)
(IPLUS BOT HGT)
BORDER BORDER (QUOTE TEXTURE)
(QUOTE REPLACE)
(COND
(ERASEFLG WHITESHADE)
(T BLACKSHADE])
(EDITSMENU
[LAMBDA (SMENU NEWIMAGEFLG) (* JTS "22-Apr-85 13:38")
(PROG ((SMENUW (fetch (SMENU WINDOW) of SMENU))
(OUTLINE (fetch (SMENU SMENUOUTLINESIZE) of SMENU)))
(COND
[(NEQ (CAR (fetch (SMENU USERDATA) of SMENU))
(QUOTE OLDUSERDATA))
(COND
(SMENUW (CLOSEW SMENUW)))
(PROG ((W (ADDSMENU SMENU NIL (create POSITION
XCOORD ← 0
YCOORD ← 0)
NEWIMAGEFLG))
PROMPTW)
[SETQ PROMPTW (GETPROMPTWINDOW W 3 (FONTCREATE (QUOTE GACHA)
10
(QUOTE BOLD]
(REMOVEPROMPTWINDOW PROMPTW)
(OPENW PROMPTW)
(WINDOWPROP PROMPTW (QUOTE RIGHTBUTTONFN)
(QUOTE DONOTHING))
(WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(QUOTE DONOTHING))
[replace USERDATA of SMENU with (LIST (QUOTE OLDUSERDATA)
(HCOPYALL (fetch (SMENU USERDATA)
of SMENU]
(SMENUPROP SMENU (QUOTE OLDPROMPTW)
PROMPTWINDOW)
(SMENUPROP SMENU (QUOTE SAVEHELDFN)
(fetch (SMENU WHENHELDFN) of SMENU))
(SMENUPROP SMENU (QUOTE SAVEUNHELDFN)
(fetch (SMENU WHENUNHELDFN) of SMENU))
(SMENUPROP SMENU (QUOTE SAVESELECTEDFN)
(fetch (SMENU WHENSELECTEDFN) of SMENU))
(SETQ PROMPTWINDOW PROMPTW)
(replace WHENHELDFN of SMENU with (QUOTE GET-SELECTION))
(replace WHENSELECTEDFN of SMENU with (FUNCTION DONOTHING))
(replace WHENUNHELDFN of SMENU with (FUNCTION DONOTHING]
(T (PRINTBELLS)
(PROMPTPRINT "CANNOT DO NESTED EDITS ON ONE SMENU"])
(ERASE-SMENUITEM
[LAMBDA (SMENU ITEM WINDOW BORDER BLKFLG) (* JTS "21-Apr-85 19:26")
(* * This function will erase a SMENU item and attempt to restore any images that may intersect with the region)
(PROG ((REGION (GET-REGION ITEM))
(ITEMLST (fetch (SMENU ITEMS) of SMENU))
(BMASSOC (fetch (SMENU BMASSOCLST) of SMENU))
LEF WID BOT HGT)
(GET-REGIONVALS LEF BOT WID HGT REGION)
(DRAW-BORDER WINDOW REGION BORDER T)
(BITBLT W LEF BOT W LEF BOT WID HGT (QUOTE TEXTURE)
(QUOTE REPLACE)
(COND
(BLKFLG BLACKSHADE)
(T WHITESHADE)))
(for I in (REMOVE ITEM ITEMLST)
do (SETQ IREG (GET-REGION I))
(if (REGIONSINTERSECTP IREG REGION)
then (PROG (IL IB IW IH ILEF IBOT IWID IHGT INTERSECT)
(GET-REGIONVALS ILEF IBOT IWID IHGT IREG)
(DRAW-BORDER W IREG BORDER)
(SETQ INTERSECT (INTERSECTREGIONS IREG REGION))
(GET-REGIONVALS IL IB IW IH INTERSECT)
(BITBLT (CDR (ASSOC I BMASSOC))
0 0 W ILEF IBOT IWID IHGT)
(BITBLT W IL IB W IL IB IW IH (QUOTE INPUT)
(QUOTE REPLACE])
(GET-REGIONVALS
[NLAMBDA (L B W H R) (* JTS "17-Mar-85 19:05")
(SETQ R (EVAL R))
(SET L (fetch (REGION LEFT) of R))
(SET B (fetch (REGION BOTTOM) of R))
(SET W (fetch (REGION WIDTH) of R))
(SET H (fetch (REGION HEIGHT) of R])
(GET-SELECTION
[LAMBDA (ITEM SMENU BUTTON) (* JTS "16-Mar-85 18:03")
(MENU SMENU-MENU])
(M1
[LAMBDA NIL (* edited: "24-Apr-85 13:27")
(create MENU
ITEMS ←(QUOTE (("Add New ITEM" (ADD-SMENUITEM SMENU W)
"Will INTERACTIVELY ADD a new ITEM.")
("Delete ITEM" (DELETE-SMENUITEM SMENU ITEM W)
"Will DELETE this ITEM from this SMENU.")
("Undelete ITEM" (UNDELETE-SMENUITEM SMENU ITEM W)
"Will RESTORE the LAST item DELETED from this SMENU.")
("Move REGION" (MOVEREGION ITEM (GET-REGION ITEM)
SMENU T)
"Will allow you to MOVE this REGION within this SMENU")
("Shape REGION" (MOVEREGION ITEM (GET-REGION ITEM)
SMENU)
"Will allow you to RESHAPE this REGION within this SMENU")
("Redraw SMENU" (REDRAW ITEM SMENU W)
"Will redraw the SMENU in this WINDOW")
("Reshape SMENU" (RESHAPESMENU ITEM SMENU (fetch (SMENU ITEMS)
of SMENU)
W)
"Will allow you to RESHAPE this SMENU")
("Inspect SMENU" (INSPECT SMENU)
"Will call the INSPECTOR on this SMENU")
("EXIT SMENU EDITOR" (REENABLE.SMENU SMENU W)
"Will EXIT editor and RESTORE smenu functionality."])
(MOVEREGION
[LAMBDA (ITEM REGION SMENU FIXEDFLG) (* edited: "24-Apr-85 13:43")
(PROG (IREG (BORDER (fetch (SMENU SMENUBORDERSIZE) of SMENU))
(OUTLINE (fetch (SMENU SMENUOUTLINESIZE) of SMENU))
(ITEMLST (fetch (SMENU ITEMS) of SMENU))
(W (fetch (SMENU WINDOW) of SMENU))
(BMASSOC (fetch (SMENU BMASSOCLST) of SMENU)))
(SETQ ITEMBM (CDR (ASSOC ITEM BMASSOC)))
(PROG (LEF BOT WID HGT NEWLOC BLEF BBOT BWID BHGT (BIGREG (GET-BOXREGION REGION BORDER T))
NLEF NBOT NWID NHGT LPW BPH)
(GET-REGIONVALS LEF BOT WID HGT REGION)
(GET-REGIONVALS BLEF BBOT BWID BHGT BIGREG)
(SETQ LPW (IPLUS LEF WID))
(SETQ BPH (IPLUS BOT HGT))
[COND
(FIXEDFLG (SETQ NEWLOC (GETBOXREGION WID HGT LEF BOT W)))
(T (COND
[(LISTP (EVAL (CAR ITEM)))
(SETQ NEWLOC (GETREGION (IQUOTIENT WID 2)
(IQUOTIENT HGT 2]
(T (PRINTBELLS)
(PROMPTPRINT "CANNOT RESHAPE BITMAPS")
(SETQ NEWLOC REGION]
(GET-REGIONVALS NLEF NBOT NWID NHGT NEWLOC)
(COND
([AND (EQ W (WHICHW (IDIFFERENCE NLEF OUTLINE)
(IDIFFERENCE NBOT OUTLINE)))
(EQ W (WHICHW (IPLUS NLEF NWID OUTLINE 1)
(IPLUS (FONTPROP (SMENUTITLEFONT SMENU)
(QUOTE HEIGHT))
NHGT OUTLINE NBOT 1]
(ERASE-SMENUITEM SMENU ITEM W BORDER)
(DRAW-BORDER W NEWLOC BORDER)
[COND
([OR FIXEDFLG (BITMAPP (EVAL (CAR ITEM]
(BITBLT ITEMBM 0 0 W NLEF NBOT WID HGT (QUOTE INVERT)
(QUOTE REPLACE)))
((LISTP (EVAL (CAR ITEM)))
(BITBLT (PUTASSOC ITEM (TEXTMAP ITEM NEWLOC)
BMASSOC)
0 0 W NLEF NBOT NWID NHGT (QUOTE INVERT)
(QUOTE REPLACE]
(RPLACA (NTH ITEM 4)
NEWLOC))
(T (PROMPTPRINT "PLEASE STAY WITHIN SMENU REGION! ")
(PRINTBELLS])
(REDRAW
[LAMBDA (ITEM SMENU W) (* edited: "24-Apr-85 13:34")
[PROG ((BMASSOC (fetch (SMENU BMASSOCLST) of SMENU))
(BORDER (fetch (SMENU SMENUBORDERSIZE) of SMENU))
(OUTLINE (fetch (SMENU SMENUOUTLINESIZE) of SMENU)))
(BITBLT NIL NIL NIL W OUTLINE OUTLINE (IDIFFERENCE (fetch (SMENU SMENUWIDTH) of SMENU)
(IPLUS OUTLINE OUTLINE))
(IDIFFERENCE (fetch (SMENU SMENUHEIGHT) of SMENU)
(IPLUS (FONTPROP (SMENUTITLEFONT SMENU)
(QUOTE HEIGHT))
OUTLINE OUTLINE))
(QUOTE TEXTURE)
(QUOTE REPLACE))
(for I in (fetch (SMENU ITEMS) of SMENU) do (PROG (LEF BOT WID HGT (IREG (GET-REGION I)))
(GET-REGIONVALS LEF BOT WID HGT IREG)
(DRAW-BORDER W IREG BORDER)
(BITBLT (CDR (ASSOC I BMASSOC))
0 0 W LEF BOT WID HGT]
(INVERTITEMS ITEM SMENU W])
(REENABLE.SMENU
[LAMBDA (SMENU W) (* JTS "21-Apr-85 19:08")
(CLOSEW (EVAL PROMPTWINDOW))
(SETQ PROMPTWINDOW (SMENUPROP SMENU (QUOTE OLDPROMPTW)))
(COND
((SMENUPROP SMENU (QUOTE OLDWINDOW))
(OPENW SMENUW)))
(WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(QUOTE NIL))
(replace WHENHELDFN of SMENU with (SMENUPROP SMENU (QUOTE SAVEHELDFN)))
(replace WHENUNHELDFN of SMENU with (SMENUPROP SMENU (QUOTE SAVEUNHELDFN)))
(replace WHENSELECTEDFN of SMENU with (SMENUPROP SMENU (QUOTE SAVESELECTEDFN)))
(replace USERDATA of SMENU with (SMENUPROP SMENU (QUOTE OLDUSERDATA)))
(replace SMENUBM of SMENU with (CREATE-IMAGE SMENU))
(CLOSEW W])
(RESHAPESMENU
[LAMBDA (ITEM SMENU ITEMLST W) (* edited: "24-Apr-85 13:32")
(* * THIS EDITOR FUNCTION ALLOWS THE USER TO RESHAPE THE WHOLE SMENU.)
(PROG (REG TITLE TITLEFONT TITLEHEIGHT TITLEWIDTH WID HGT (OUTLINE (fetch (SMENU SMENUOUTLINESIZE)
of SMENU)))
(COND
((SETQ TITLE (fetch (SMENU TITLE) of SMENU))
(SETQ TITLEFONT (SMENUTITLEFONT SMENU))
(SETQ TITLEHEIGHT (FONTPROP TITLEFONT (QUOTE HEIGHT)))
(SETQ TITLEWIDTH (STRINGWIDTH TITLE TITLEFONT)))
(T (TITLEHEIGHT←0)
(TITLEWIDTH ← 0)))
[SETQ REG (GETREGION [IMIN (fetch (SMENU SMENUWIDTH) of SMENU)
(IPLUS OUTLINE OUTLINE (HOWWIDE (for I in ITEMLST
largest (HOWWIDE I]
(IMIN (fetch (SMENU SMENUHEIGHT) of SMENU)
(IPLUS OUTLINE OUTLINE TITLEHEIGHT
(HOWHIGH (for I in ITEMLST largest (HOWHIGH I]
(replace SMENUWIDTH of SMENU with (SETQ WID (fetch (REGION WIDTH) of REG)))
(replace SMENUHEIGHT of SMENU with (SETQ HGT (fetch (REGION HEIGHT) of REG)))
(replace LEFT of REG with 0)
(replace BOTTOM of REG with 0)
(SHAPEW W REG)
(BITBLT NIL NIL NIL W 0 0 (fetch (SMENU SMENUWIDTH) of SMENU)
(fetch (SMENU SMENUHEIGHT) of SMENU)
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(REDRAW ITEM SMENU W)
(BITBLT (TEXTMAP (LIST (QUOTE (MKLST TITLE))
NIL NIL NIL TITLEFONT)
(LIST 0 0 WID TITLEHEIGHT))
0 0 W 0 (IDIFFERENCE HGT TITLEHEIGHT)
WID TITLEHEIGHT (QUOTE INVERT))
(ATTACHWINDOW PROMPTWINDOW W)
(DETACHWINDOW PROMPTWINDOW)
(OPENW PROMPTWINDOW])
(SETUP2
[LAMBDA NIL (* edited: "26-Apr-85 14:26")
(SETQ S2 (create SMENU
TITLE ← "DEMOMSTRATION OF SUPER MENU"
SMENUOUTLINESIZE ← 5
SMENUBORDERSIZE ← 1
ITEMS ←(QUOTE (((QUOTE (first INTERSECTING REGION))
(PRINT "THIS GETS DONE FIRST" PROMPTWINDOW)
"TRY SELECTING THE REGION COMMON TO THIS ITEM AND ITEM #2"
(135 81 120 65)
NIL)
((QUOTE (ITEM #2, (SECOND intersecting region)
%.))
(PRINT "THIS GETS DONE SECOND" PROMPTWINDOW)
"AN EXAMPLE OF INTERSECTING REGIONS."
(96 10 99 89)
NIL)
((QUOTE (SHOW ME THE RECORD FOR THIS SMENU PLEASE !))
(INSPECT S2)
"WILL SHOW YOU THE ITEMS LIST FOR THIS SUPER MENU!"
(8 151 261 29)
FITFONT)
(BM5 (PROMPTPRINT
"CONGRATULATIONS, YOU JUST SELECTED SMILING SAM!")
"SMILING SAM"
(205 10 60 40))
((QUOTE (HAVE A NICE DAY!))
(PROG NIL
(PROMPTPRINT "HAVE A NICE DAY")
(CLOSEW (WHICHW))
(SETQ PROMPTWINDOW SMENU-DEMO-SAVE))
"WILL EXIT THE DEMONSTRATION"
(10 187 259 60)
(FONTCREATE (QUOTE HELVETICAD)
24
(QUOTE BOLD)))
((EXPANDBITMAP BM3 2 2)
(PROMPTPRINT
"The car of the list for this item is: (EXPANDBITMAP BM3 2 2).")
"THIS BITMAP IS TWICE ITS NORMAL SIZE!"
(9 30 80 80])
(SETUP3
[LAMBDA NIL (* edited: "26-Apr-85 14:09")
(SETQ S3
(create SMENU
TITLE ← "DEMONSTRATION OF FITFONT IN SUPERMENU"
TITLEFONT ←(FONTCREATE (QUOTE GACHA)
10
(QUOTE BOLD))
SMENUBORDERSIZE ← 1
SMENUOUTLINESIZE ← 2
ITEMS ←(QUOTE (((QUOTE (GACHA 40 BOLD))
(PROMPTPRINT "GACHA 40 TEXT")
"EXAMPLE OF SELECTING SPECIAL FONT"
(45 281 437 70)
(FONTCREATE (QUOTE GACHA)
40
(QUOTE BOLD)))
((QUOTE (JTS))
(PROMPTPRINT "TIMESROMAND 72")
"THIS IS TIMESROMAND"
(7 22 220 108)
(FONTCREATE (QUOTE TIMESROMAND)
72))
((QUOTE (SELECT THIS ITEM TO CONTINUE))
(PROG NIL
(CLOSEW (WHICHW))
(SETQ PROMPTWINDOW
(GETPROMPTWINDOW (ADDSMENU S2
(create POSITION
XCOORD ← 10
YCOORD ← 10))
3)))
"SELECT THIS ITEM TO SEE MORE FEATURES!"
(9 137 116 132)
(FONTCREATE (QUOTE HELVETICA)
18
(QUOTE BOLD)))
((QUOTE (This text has been formatted using the FITFONT option, notice
the relationship between the size of the region and the
size of the letters))
(OR (PROMPTPRINT "YOU JUST SELECTED THIS ITEM")
(PRINTBELLS))
"TEXT FORMATTED WITH FITFONT"
(240 40 165 221)
FITFONT)
((QUOTE (This text has been formatted using the FITFONT option, notice
the relationship between the size of the region and the
size of the letters))
NIL "One more example of FITFONT" (133 159 99 104)
FITFONT)
((QUOTE (This text has been formatted using the FITFONT option, notice
the relationship between the size of the region and the
size of the letters))
(OR (PROMPTPRINT "YOU JUST SELECTED THIS ITEM")
(PRINTBELLS))
"Another example of FITFONT"
(411 8 102 255)
FITFONT])
(UNDELETE-SMENUITEM
[LAMBDA (SMENU ITEM W) (* edited: "21-Apr-85 16:02")
(PROG [(ITEMLST (fetch (SMENU ITEMS) of SMENU))
(BORDER (fetch (SMENU SMENUBORDERSIZE) of SMENU))
(BMASSOC (fetch (SMENU BMASSOCLST) of SMENU))
(RESTITEM (SMENUPROP SMENU (QUOTE LASTDELETEDITEM]
(COND
((OR (NULL RESTITEM)
(EQ RESTITEM (QUOTE RESTORED)))
(PRINTBELLS)
(PROMPTPRINT "THERE IS NOTHING LEFT TO RESTORE"))
(T (PROG (LEF BOT WID HGT (RESTREG (GET-REGION RESTITEM)))
(GET-REGIONVALS LEF BOT WID HGT RESTREG)
(DRAW-BORDER W RESTREG BORDER)
(BITBLT (CDR (ASSOC RESTITEM BMASSOC))
0 0 W LEF BOT WID HGT (QUOTE INPUT)
(QUOTE REPLACE))
(SMENUPROP SMENU (QUOTE LASTDELETEDITEM)
(QUOTE RESTORED))
(PROMPTPRINT "ITEM RESTORED ... BE MORE CAREFUL NEXT TIME.")
(replace ITEMS of SMENU with (CONS RESTITEM ITEMLST])
)
(RPAQ BM1 (READBITMAP))
(60 20
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@GLA@AH@@@@@@@@@"
"@DFAHAH@CC@@@@@@"
"@DCALAH@CG@CN@@@"
"@DAADCH@FF@FF@@@"
"@DAAFFHGOOHDF@@@"
"@DAACDHGOOH@F@@@"
"@GOAALH@LL@@F@@@"
"@DBAAHHAIH@@F@@@"
"@DCA@@HOON@@F@@@"
"@DAA@@HOON@@F@@@"
"@DAA@@HCC@@@F@@@"
"@DAA@@HCC@@@F@@@"
"@DAA@@HFF@@@F@@@"
"@DGA@@HFF@@COL@@"
"@GLA@@H@@@@COL@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@")
(RPAQ BM2 (READBITMAP))
(50 200
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"AL@AON@@@@@L@@@@"
"GN@COO@GH@AN@@@@"
"OL@COO@ON@AN@@@@"
"OL@CON@OO@AN@@@@"
"OH@CL@@OO@AO@@@@"
"OOLCN@@OOCOOH@@@"
"OONCOL@OKGOOH@@@"
"OONAON@OGOOOL@@@"
"OOL@OO@OGKOOL@@@"
"OH@@COAOGHGOL@@@"
"GL@@@OAOGH@CL@@@"
"GL@@AOAOOH@GL@@@"
"CN@CONAOOH@GL@@@"
"CN@GONAOOH@GH@@@"
"AL@GOL@OO@@GH@@@"
"@@@COH@OL@@C@@@@"
"@@@@@@@GH@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@L@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"CN@@@@@@@@@@@@@@"
"GO@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"OOH@@@@@@@@@@@@@"
"OGH@@@@@@@@@@@@@"
"NGL@@@@@@@@@@@@@"
"OKL@@@@@@@@@@@@@"
"OOL@@@@@@@@@@@@@"
"COH@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AO@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@O@@@@@@@@@@@@@@"
"@F@@@@@@@@@@@@@@"
"GN@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"OOL@@@@@@@@@@@@@"
"OON@@@@@@@@@@@@@"
"NGOH@@@@@@@@@@@@"
"NAOL@@@@@@@@@@@@"
"L@GL@@@@@@@@@@@@"
"L@CL@@@@@@@@@@@@"
"H@CL@@@@@@@@@@@@"
"@@CL@@@@@@@@@@@@"
"@@CL@@@@@@@@@@@@"
"@CCL@@@@@@@@@@@@"
"@ACL@@@@@@@@@@@@"
"@@CL@@@@@@@@@@@@"
"@@CL@@@@@@@@@@@@"
"@@GL@@@@@@@@@@@@"
"@OOL@@@@@@@@@@@@"
"OOON@@@@@@@@@@@@"
"OOOOL@@@@@@@@@@@"
"OOOOO@@@@@@@@@@@"
"OONGOL@@@@@@@@@@"
"OOLCOOH@@@@@@@@@"
"@@@@COL@@@@@@@@@"
"@@@@@OL@@@@@@@@@"
"FG@@@CH@@@@@@@@@"
"OOH@@@@@@@@@@@@@"
"OOL@@@@@@@@@@@@@"
"OOL@@@@@@@@@@@@@"
"OCL@@@@@@@@@@@@@"
"OGL@@@@@@@@@@@@@"
"OGL@@@@@@@@@@@@@"
"OOH@@@@@@@@@@@@@"
"OOH@@@@@@@@@@@@@"
"GO@@@@@@@@@@@@@@"
"CL@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"GL@@@@@@@@@@@@@@"
"ON@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"NO@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"OO@@@@@@@@@@@@@@"
"ON@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@L@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@A@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"AN@@@@@@@@@@@@@@"
"ANA@@@@@@@@@@@@@"
"ANCH@@@@@@@@@@@@"
"INOH@@@@@@@@@@@@"
"MOOH@@@@@@@@@@@@"
"OOO@@@@@@@@@@@@@"
"OON@@@@@@@@@@@@@"
"OOL@@@@@@@@@@@@@"
"OOH@@@@@@@@@@@@@"
"GO@@@@@@@@@@@@@@"
"CN@@@@@@@@@@@@@@"
"AL@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@G@@@@@@G@@@@@@"
"@AOH@@@LLOL@@@@@"
"@COMOOOOOON@@@@@"
"@OOOOOOOOON@@@@@"
"AOOOOOOOOON@@@@@"
"AOOOOOOOOON@@@@@"
"@NOOOOOOOON@@@@@"
"@@GOOOOOOON@@@@@"
"@@GOOOOOOOO@@@@@"
"@@COOOOOOON@@@@@"
"@@@@@CN@@AN@@@@@"
"@@@@@@@@@@L@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@CO@AH@L@@@@@@@@"
"@CALAHAL@@@@@@@@"
"@C@DALCL@@@@@@@@"
"@C@DALFL@@@@@@@@"
"@C@DANDL@@@@@@@@"
"@C@DAKLL@@@@@@@@"
"@CGLAIHL@@@@@@@@"
"@COLAH@L@@@@@@@@"
"@C@FAH@L@@@@@@@@"
"@C@BAH@L@@@@@@@@"
"@C@FAH@L@@@@@@@@"
"@C@NAH@L@@@@@@@@"
"@CONAH@L@@@@@@@@"
"@COL@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@H@@@@@@@@@@@@@"
"@@I@AO@@@@@@@@@@"
"@@I@CA@@@@@@@@@@"
"@@I@@A@@@@@@@@@@"
"@CM@@A@@@@@@@@@@"
"@@OL@A@@@@@@@@@@"
"@@I@AA@@@@@@@@@@"
"@AM@AO@@@@@@@@@@"
"@AOLC@@@@@@@@@@@"
"@AI@BAH@@@@@@@@@"
"@@I@COH@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@COOL@@@@"
"CON@@@@AOOON@@@@"
"GOOL@@AOOOON@@@@"
"GOOOOOOOOOOL@@@@"
"COOOOOOON@@@@@@@"
"@@COOOOO@@@@@@@@"
"@@@GOOOH@@@@@@@@"
"@@@@@@@@@@@@@@@@")
(RPAQ BM3 (READBITMAP))
(40 40
"O@@@@@@@CO@@"
"I@@@@@@@@A@@"
"C@@@@@H@@A@@"
"C@@@@@H@@A@@"
"I@@@@@H@@A@@"
"O@@@@AH@@@@@"
"@@@@@C@@@@@@"
"O@@@@G@@@@@@"
"@@@@@N@@@@@@"
"O@@GMNL@@@@@"
"@@ALGCN@@@@@"
"@@A@BCB@@@@@"
"@@A@OOC@@@@@"
"@@AAH@I@@@@@"
"@@AC@@E@@@@@"
"@@AL@@C@@@@@"
"@@AL@@C@@@@@"
"@@@H@@CH@@@@"
"@@AH@@AH@@@@"
"@@A@@@@L@@@@"
"@@C@@@@D@@@@"
"@@B@AL@D@@@@"
"@@B@CL@D@@@@"
"@@C@GD@D@@@@"
"@@C@EL@D@@@@"
"@@C@MH@L@@@@"
"@@AAHL@H@@@@"
"@@A@CNAH@@@@"
"@@AHCLAH@@@@"
"@@@HANA@@@@@"
"@@@L@HC@@@@@"
"@@@D@HC@@@@@"
"@@@F@HB@@@@@"
"@@@BALF@@@@@"
"@@@CALL@@@@@"
"H@@AHHL@@A@@"
"H@@@OOH@@A@@"
"H@@@@@@@@A@@"
"H@@@AL@@@A@@"
"OH@@GO@@AO@@")
(RPAQ BM4 (READBITMAP))
(40 40
"A@@@CLDL@@@@"
"AFOGAKLK@@@@"
"@@JAHNON@@@@"
"@OGOL@LC@@@@"
"BIAOGODGO@@@"
"BDG@OILMK@@@"
"GMLAHFFDB@@@"
"BOOO@BGMN@@@"
"BOL@@COMJ@@@"
"FNL@@@@OOL@@"
"FOAO@F@MDD@@"
"EJAILG@OIL@@"
"GCCBDMHKKH@@"
"KKBFEJLIOH@@"
"KN@@@@DOFH@@"
"KL@@@@@GM@@@"
"C@B@@@@BM@@@"
"N@B@C@DBKD@@"
"K@B@GLDCJD@@"
"F@F@LFDAKH@@"
"LCLAJJDAO@@@"
"N@D@@@NAL@@@"
"B@D@@AMAH@@@"
"G@G@@AHC@@@@"
"AHCH@GHC@@@@"
"@HAOOOHF@@@@"
"@DAONK@B@@@@"
"@F@LCB@F@@@@"
"@C@F@F@L@@@@"
"@A@COL@D@@@@"
"@AL@@@AH@@@@"
"@AN@@@F@@@@@"
"@@F@@AL@@@@@"
"@@CO@O@@@@@@"
"@@@OOJ@@@@@@"
"@@@L@CN@@@@@"
"O@ON@CCON@@@"
"HO@F@O@@C@@@"
"@@@OOI@@@@@@"
"@@@@@@@@@@@@")
(RPAQ BM5 (READBITMAP))
(60 40
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@H@@"
"@@@@@@@@D@@@@@@@"
"@@@@@@@@L@@@A@@@"
"@@@@@@G@L@@@AH@@"
"@@@@@@OIL@@@@@@@"
"@@@@@CLOGH@@@@@@"
"@@@@@FLCCN@@A@@@"
"@@@@@DHFGO@@@@@@"
"@@@@@MHLLAH@A@@@"
"@@@@AK@IH@H@AH@@"
"@@@@CFAIH@D@BH@@"
"@@@@BLCC@@B@CH@@"
"@@@@OHFB@NC@@@@@"
"@@@AO@LFAJA@@@@@"
"@@@AFAHDADA@GL@@"
"@@@CLC@L@@A@DD@@"
"@@@G@FAHL@A@DD@@"
"@@@F@LCAH@CLFL@@"
"@@@DAHFADCCFOH@@"
"@@@FA@DA@GACN@@@"
"@@@CACNAHA@OL@@@"
"@@@AICL@@@AOH@@@"
"@@@@OCN@@@AI@@@@"
"@@@GNCL@@@C@H@@@"
"@@@D@GH@@@B@H@@@"
"@@@L@OH@@AN@H@@@"
"@@@HKOH@@@L@H@@@"
"@@@HKOO@@@@BH@@@"
"@@@HOOOH@@@BH@@@"
"@@@OOOOL@@@C@@@@"
"@@@@GOOL@@@A@@@@"
"@@@@AOLD@@@B@@@@"
"@@@@@OHD@@@F@@@@"
"@@@@@OOL@@@L@@@@"
"@@@@@GON@@C@@@@@"
"@@@@@@OOOOL@@@@@"
"@@@@@@GN@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@")
(SETQ SMENU-MENU (M1))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML GET-REGIONVALS)
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (631 21454 (ADD-SMENUITEM 641 . 3621) (DELETE-SMENUITEM 3623 . 4343) (DEMO 4345 . 4798)
(DONOTHING 4800 . 4919) (DRAW-BORDER 4921 . 5509) (EDITSMENU 5511 . 7370) (ERASE-SMENUITEM 7372 . 8685
) (GET-REGIONVALS 8687 . 9036) (GET-SELECTION 9038 . 9174) (M1 9176 . 10431) (MOVEREGION 10433 . 12572
) (REDRAW 12574 . 13635) (REENABLE.SMENU 13637 . 14507) (RESHAPESMENU 14509 . 16528) (SETUP2 16530 .
18117) (SETUP3 18119 . 20355) (UNDELETE-SMENUITEM 20357 . 21452)))))
STOP