(FILECREATED "21-May-85 20:54:58" {ERIS}<LISPCORE>LIBRARY>READNUMBER.;8 13858
changes to: (VARS READNUMBERCOMS)
(FNS \NUMBERPAD.READER.CLOSEFN NUMBERPAD.READ CREATE.NUMBERPAD.READER)
previous date: " 4-Jan-85 17:21:11" {ERIS}<LISPCORE>LIBRARY>READNUMBER.;6)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT READNUMBERCOMS)
(RPAQQ READNUMBERCOMS ((FNS \NUMBERPAD.READER.CLOSEFN \READNUMBER.FLASHAREA RNUMBER NUMBERPAD.READ
CREATE.NUMBERPAD.READER REGIONONSCREEN DISPLAY/NUMBER/READER/TOTAL
NUMBER.READER.HANDLER NUMBERPAD.HELDFN \READNUMBER.OUTLINEREGION)
(UGLYVARS RNUMBER.CLEAR.BITMAP RNUMBER.ABORT.BITMAP)))
(DEFINEQ
(\NUMBERPAD.READER.CLOSEFN
[LAMBDA (WINDOW)
(WINDOWPROP WINDOW (QUOTE FINISHEDFLG)
(QUOTE ABORT])
(\READNUMBER.FLASHAREA
[LAMBDA (LFT BTM WDTH HGHT WIN) (* rrb "28-JUN-82 19:17")
(* flashes a region of a window.)
(BITBLT NIL NIL NIL WIN LFT BTM WDTH HGHT (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(DISMISS 60)
(BITBLT NIL NIL NIL WIN LFT BTM WDTH HGHT (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(RNUMBER
[LAMBDA (MSG POSITION MSGFONT DIGITFONT INCLUDEABORTFLG) (* rrb " 4-Jan-85 16:29")
(* creates a numberpad window menu and lets the user
enter a number.)
(* it is substantially more efficient to save the
NUMBERPAD/READER and call NUMBERPAD.READ directly.)
(NUMBERPAD.READ (CREATE.NUMBERPAD.READER MSG POSITION MSGFONT DIGITFONT INCLUDEABORTFLG])
(NUMBERPAD.READ
[LAMBDA (NUMBERPAD/READER) (* rrb "21-May-85 20:33")
(* allows the user to enter a number with the
numberpad.)
(* position the number pad near the current reading
location.)
(WINDOWPROP NUMBERPAD/READER (QUOTE TOTAL)
0) (* start a mouse process in case this one is it.)
(SPAWN.MOUSE) (* make sure the finished flag is initialized.)
(WINDOWPROP NUMBERPAD/READER (QUOTE FINISHEDFLG)
NIL) (* fix it so that closing the window does an abort.)
(WINDOWADDPROP NUMBERPAD/READER (QUOTE CLOSEFN)
(FUNCTION \NUMBERPAD.READER.CLOSEFN))
(RESETLST (RESETSAVE (OPENW NUMBERPAD/READER)
(LIST (QUOTE CLOSEW)
NUMBERPAD/READER))
(DISPLAY/NUMBER/READER/TOTAL NUMBERPAD/READER)
(* wait for the menu handler to set that it is
finished.)
(bind FINISHVAL until (SETQ FINISHVAL (WINDOWPROP NUMBERPAD/READER (QUOTE FINISHEDFLG)
NIL))
do (* keep bringing the numberpad to the top.)
(TOTOPW NUMBERPAD/READER)
(DISMISS 100)
finally (* remove the closefn so that it doesn't get run on the
way out.)
(WINDOWDELPROP NUMBERPAD/READER (QUOTE CLOSEFN)
(FUNCTION \NUMBERPAD.READER.CLOSEFN))
(RETURN (COND
((EQ FINISHVAL (QUOTE ABORT))
(* means the numberpad reader was closed. If the number pad includes the ABORT command, do what it would do,
otherwise the program is not expecting NIL so cause an error.)
(COND
([MEMBER (QUOTE % )
(fetch (MENU ITEMS)
of (CAR (WINDOWPROP NUMBERPAD/READER (QUOTE MENU]
(* no ABORT command)
(ERROR!))
(T NIL)))
(T (WINDOWPROP NUMBERPAD/READER (QUOTE TOTAL])
(CREATE.NUMBERPAD.READER
[LAMBDA (MSG WPOSITION MSGFONT DIGITFONT INCLUDEABORTFLG)
(* rrb "21-May-85 20:31")
(* creates a window menu that displays the digits in a numberpad and lets the user enter a number.
It also includes a backspace and a enter)
(RESETFORM (RADIX 10)
(PROG ((NUMBER/READER/MAXDIGITS 6)
WIN READERWIDTH PADLEFT TOTALREGION [DIGITFONT (OR DIGITFONT
(FONTCREATE (QUOTE GACHA)
12
(QUOTE BOLD]
[MSGFONT (OR MSGFONT (FONTCREATE (QUOTE GACHA)
12
(QUOTE BOLD]
NUMBERPAD TOTALWIDTH FONTHEIGHT)
[SETQ NUMBERPAD
(create MENU
ITEMS ←[CONS (QUOTE -)
(APPEND [COND
[INCLUDEABORTFLG
(COND
((AND (IGREATERP (SETQ FONTHEIGHT
(FONTPROP MSGFONT
(QUOTE HEIGHT))
)
10)
(ILESSP FONTHEIGHT 20))
(* only use the bitmap for fonts near 10 or 12.0)
(LIST RNUMBER.ABORT.BITMAP
RNUMBER.CLEAR.BITMAP))
(T (QUOTE (abt clr]
(T (QUOTE (% clr]
(QUOTE (1 2 3 4 5 6 7 8 9 bs 0 ok]
MENUCOLUMNS ← 3
CENTERFLG ← T
MENUFONT ← DIGITFONT
WHENHELDFN ←(FUNCTION NUMBERPAD.HELDFN)
WHENSELECTEDFN ←(FUNCTION NUMBER.READER.HANDLER)
MENUOUTLINESIZE ← 2
ITEMHEIGHT ←(IPLUS 2 (FONTPROP DIGITFONT (QUOTE HEIGHT]
(* leave room for three lines at the top and the number
at the left.)
(SETQ WIN
(CREATEW [REGIONONSCREEN
WPOSITION
[WIDTHIFWINDOW (SETQ READERWIDTH
(IPLUS [SETQ PADLEFT
(IPLUS 12 (SETQ TOTALWIDTH
(ITIMES (ADD1
NUMBER/READER/MAXDIGITS)
(CHARWIDTH (CHARCODE
0)
DIGITFONT]
(fetch (MENU IMAGEWIDTH) of NUMBERPAD]
(HEIGHTIFWINDOW (IPLUS (COND
[MSG
(* if there is a msg, leave room for it at the top.)
(ITIMES (IPLUS (IQUOTIENT
(STRINGWIDTH MSG
MSGFONT)
READERWIDTH)
2)
(FONTPROP MSGFONT
(QUOTE HEIGHT]
(T 0))
(fetch (MENU IMAGEHEIGHT) of NUMBERPAD]
NIL NIL T))
[COND
(MSG (* if there is a msg, print it at the top.)
(DSPFONT MSGFONT WIN)
(MOVETOUPPERLEFT WIN)
(COND
[(LISTP MSG)
(PROG ((RMARG (DSPRIGHTMARGIN NIL WIN)))
(for X in MSG
do (COND
((IGREATERP (IPLUS (DSPXPOSITION NIL WIN)
(STRINGWIDTH X WIN))
RMARG)
(TERPRI WIN)))
(PRIN3 X WIN)
(SPACES 1 WIN]
(T (PRIN1 MSG WIN]
(OPENW WIN) (* window is opened because of bug in ADDMENU that it
doesn't work unless window is open.)
(ADDMENU NUMBERPAD WIN (create POSITION
XCOORD ← PADLEFT
YCOORD ← 0))
[WINDOWPROP WIN (QUOTE TOTALREG)
(SETQ TOTALREGION (create REGION
LEFT ← 6
BOTTOM ←(IQUOTIENT (fetch (MENU
IMAGEHEIGHT)
of NUMBERPAD)
2)
WIDTH ← TOTALWIDTH
HEIGHT ←(FONTPROP DIGITFONT (QUOTE HEIGHT]
(\READNUMBER.OUTLINEREGION TOTALREGION WIN 2)
(DSPFONT DIGITFONT WIN)
(WINDOWPROP WIN (QUOTE TOTAL)
0)
(WINDOWPROP WIN (QUOTE MAXDIGITS)
NUMBER/READER/MAXDIGITS)
(DISPLAY/NUMBER/READER/TOTAL WIN)
(CLOSEW WIN)
(RETURN WIN])
(REGIONONSCREEN
[LAMBDA (POS WIDTH HEIGHT) (* rrb "28-JUN-82 18:58")
(* returns the region WIDTH by HEIGHT that is nearest to
POS or the cursor position while still being on the
screen.)
(PROG (LEFT BOTTOM)
(COND
((POSITIONP POS)
(SETQ LEFT (fetch (POSITION XCOORD) of POS))
(SETQ BOTTOM (fetch (POSITION YCOORD) of POS)))
(T (GETMOUSESTATE)
(SETQ LEFT LASTMOUSEX)
(SETQ BOTTOM LASTMOUSEY)))
[COND
((IGREATERP (IPLUS LEFT WIDTH)
SCREENWIDTH)
(SETQ LEFT (IMAX 0 (IDIFFERENCE SCREENWIDTH WIDTH]
[COND
((IGREATERP (IPLUS BOTTOM HEIGHT)
SCREENHEIGHT)
(SETQ BOTTOM (IMAX 0 (IDIFFERENCE SCREENHEIGHT HEIGHT]
(RETURN (create REGION
LEFT ← LEFT
BOTTOM ← BOTTOM
WIDTH ← WIDTH
HEIGHT ← HEIGHT])
(DISPLAY/NUMBER/READER/TOTAL
[LAMBDA (WIN) (* rrb "10-Apr-84 12:24")
(* displays the number total in the box in the window.)
(PROG [(TOTALREG (WINDOWPROP WIN (QUOTE TOTALREG]
(DSPFILL TOTALREG WHITESHADE (QUOTE REPLACE)
WIN)
(RESETFORM (RADIX 12Q)
(CENTERPRINTINREGION (WINDOWPROP WIN (QUOTE TOTAL))
TOTALREG WIN])
(NUMBER.READER.HANDLER
[LAMBDA (DIGIT MENU BUTTON) (* rrb " 4-Jan-85 17:14")
(* selected fn for a numberpad reader.
adds the digit to the current total and updates the
display.)
(PROG (TOTAL (WIN (WFROMMENU MENU)))
(SETQ TOTAL (WINDOWPROP WIN (QUOTE TOTAL)))
[WINDOWPROP WIN (QUOTE TOTAL)
(SELECTQ DIGIT
(bs (IQUOTIENT TOTAL 10))
(- (IMINUS TOTAL))
(% (* empty key)
TOTAL)
(ok (WINDOWPROP WIN (QUOTE FINISHEDFLG)
T)
(RETURN))
(COND
((OR (EQ DIGIT RNUMBER.ABORT.BITMAP)
(EQ DIGIT (QUOTE abt)))
(* abort key)
(WINDOWPROP WIN (QUOTE TOTAL)
NIL)
(WINDOWPROP WIN (QUOTE FINISHEDFLG)
T)
(RETURN))
((OR (EQ DIGIT RNUMBER.CLEAR.BITMAP)
(EQ DIGIT (QUOTE clr)))
(* clear key)
0)
((EQ (WINDOWPROP WIN (QUOTE MAXDIGITS))
(NCHARS (ABS TOTAL)))
(* don't take any more.)
(\READNUMBER.FLASHAREA 0 0 1000 1000 WIN)
TOTAL)
((IGEQ TOTAL 0)
(IPLUS (ITIMES TOTAL 10)
DIGIT))
(T (IDIFFERENCE (ITIMES TOTAL 10)
DIGIT]
(DISPLAY/NUMBER/READER/TOTAL WIN])
(NUMBERPAD.HELDFN
[LAMBDA (ITEM MENU BUTTON) (* rrb " 4-Jan-85 17:12")
(* prints the help information for a numberpad.)
(PROMPTPRINT (SELECTQ ITEM
(bs "Will erase the last digit entered.")
(ok "Indicates that you are through entering the number.")
(clr "Will reset the total to 0")
(abt "will abort this question.")
(- " will change the sign of the total")
(% "doesn't do anything.")
(COND
((NLISTP ITEM)
"Will put this digit on the right of the total.")
((EQ ITEM RNUMBER.ABORT.BITMAP)
(* abort bitmap)
"will abort this question.")
((EQ ITEM RNUMBER.CLEAR.BITMAP)
(* abort bitmap)
"Will reset the total to 0"])
(\READNUMBER.OUTLINEREGION
[LAMBDA (REG WIN OUTLINESIZE) (* rrb "19-MAY-82 15:26")
(* puts a black outline around REG.)
(PROG ((N (OR (FIXP OUTLINESIZE)
2)))
(BITBLT NIL NIL NIL WIN (IDIFFERENCE (fetch LEFT of REG)
N)
(IDIFFERENCE (fetch BOTTOM of REG)
N)
(IPLUS (fetch WIDTH of REG)
(ITIMES N 2))
(IPLUS (fetch HEIGHT of REG)
(ITIMES N 2))
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL NIL NIL WIN (fetch LEFT of REG)
(fetch BOTTOM of REG)
(fetch WIDTH of REG)
(fetch HEIGHT of REG)
(QUOTE TEXTURE)
(QUOTE REPLACE)
(DSPTEXTURE NIL WIN])
)
(READVARS RNUMBER.CLEAR.BITMAP RNUMBER.ABORT.BITMAP)
({(READBITMAP)(14 14
"GJ@@"
"DJCL"
"DBBD"
"DBCL"
"DJB@"
"GKKL"
"@@@@"
"@@@@"
"@GKL"
"@DJD"
"@GKL"
"@DJH"
"@DJD"
"@@@@")} {(READBITMAP)(14 14
"GKL@"
"DJD@"
"DKL@"
"GJD@"
"DJD@"
"DKL@"
"@@@@"
"@@CH"
"GKM@"
"DJE@"
"DKM@"
"DJI@"
"GJM@"
"@@@@")})
(PUTPROPS READNUMBER COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (722 13466 (\NUMBERPAD.READER.CLOSEFN 732 . 853) (\READNUMBER.FLASHAREA 855 . 1287) (
RNUMBER 1289 . 1830) (NUMBERPAD.READ 1832 . 4249) (CREATE.NUMBERPAD.READER 4251 . 8508) (
REGIONONSCREEN 8510 . 9488) (DISPLAY/NUMBER/READER/TOTAL 9490 . 9967) (NUMBER.READER.HANDLER 9969 .
11679) (NUMBERPAD.HELDFN 11681 . 12641) (\READNUMBER.OUTLINEREGION 12643 . 13464)))))
STOP