(FILECREATED "21-May-86 17:19:19" {ERIS}<LISPCORE>LIBRARY>READNUMBER.;13 22420
changes to: (FNS REGIONONSCREEN RNUMBER NUMBERPAD.READ CREATE.NUMBERPAD.READER
DISPLAY/NUMBER/READER/TOTAL NUMBER.READER.HANDLER NUMBERPAD.READER.DECODE
NUMBERPAD.READER.HANDLE.CHAR)
(VARS READNUMBERCOMS)
previous date: "27-Aug-85 14:48:02" {ERIS}<LISPCORE>LIBRARY>READNUMBER.;11)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT READNUMBERCOMS)
(RPAQQ READNUMBERCOMS [(FNS \NUMBERPAD.READER.CLOSEFN \READNUMBER.FLASHAREA RNUMBER NUMBERPAD.READ
NUMBERPAD.READER.HANDLE.CHAR NUMBERPAD.READER.DECODE
CREATE.NUMBERPAD.READER BREAK.MSG.INTO.LINES REGIONONSCREEN
DISPLAY/NUMBER/READER/TOTAL NUMBER.READER.HANDLER NUMBERPAD.HELDFN
\READNUMBER.OUTLINEREGION)
(UGLYVARS RNUMBER.CLEAR.BITMAP RNUMBER.ABORT.BITMAP)
(COMS (* stuff to dummy up a definition of TEDIT.GETSYNTAX if it isn't
defined.)
(INITVARS (TEDIT.READTABLE T))
(P (MOVD? (QUOTE GETSYNTAX)
(QUOTE TEDIT.GETSYNTAX])
(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 FLOATINGPTFLG POSITIVEONLYFLG
ACCEPTTYPEINFLG) (* rrb "14-May-86 19:02")
(* 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
FLOATINGPTFLG POSITIVEONLYFLG)
ACCEPTTYPEINFLG])
(NUMBERPAD.READ
[LAMBDA (NUMBERPAD/READER ACCEPTTYPEINFLG) (* rrb "14-May-86 18:51")
(* allows the user to enter a number with the numberpad. if ACCEPTTYPEINFLG is T, it also allows the user to type
in numbers as well.)
(* 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 [COND
(ACCEPTTYPEINFLG (RESETSAVE (TTYDISPLAYSTREAM NUMBERPAD/READER))
(RESETSAVE (CONTROL T))
(RESETSAVE (ECHOMODE NIL]
(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)
(COND
((AND ACCEPTTYPEINFLG (HASTTYWINDOWP)
(READP T)) (* this process has the tty and the user typed a
character)
(NUMBERPAD.READER.HANDLE.CHAR (NUMBERPAD.READER.DECODE (READC
T))
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])
(NUMBERPAD.READER.HANDLE.CHAR
[LAMBDA (DIGIT WIN) (* rrb "14-May-86 18:45")
(* handles a key stroke or menu digit selection for a
number pad reader.)
(PROG (TOTAL POWER)
(SETQ TOTAL (WINDOWPROP WIN (QUOTE TOTAL)))
[WINDOWPROP
WIN
(QUOTE TOTAL)
(SELECTQ DIGIT
[bs (COND
[(SETQ POWER (WINDOWPROP WIN (QUOTE DECIMALPOWER)))
(* have read decimal pt -
much harder)
(COND
((EQ POWER 1) (* backspace over the decimal point.)
(WINDOWPROP WIN (QUOTE DECIMALPOWER)
NIL)
(FIX TOTAL))
(T (WINDOWPROP WIN (QUOTE DECIMALPOWER)
(SETQ POWER (SUB1 POWER)))
(* dirty but effective.)
(PROG ((TOTSTR (MKSTRING TOTAL)))
(* SUBSTRING will be NIL if the total has a trailing
zero.)
(RETURN (MKATOM (OR (SUBSTRING
TOTSTR 1
(PLUS (STRPOS "."
TOTSTR)
(SUB1 POWER)))
TOTSTR]
(T (* no decimal point)
(IQUOTIENT TOTAL 10]
(- (MINUS TOTAL))
(% (* empty key)
TOTAL)
[%. (* decimal point)
(COND
((WINDOWPROP WIN (QUOTE DECIMALPOWER))
(* already has a decimal pt, don't do anything)
(RETURN))
(T (WINDOWPROP WIN (QUOTE DECIMALPOWER)
1)
(FLOAT 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)
(WINDOWPROP WIN (QUOTE DECIMALPOWER)
NIL)
0)
((EQ (WINDOWPROP WIN (QUOTE MAXDIGITS))
(NCHARS (ABS TOTAL)))
(* don't take any more.)
(\READNUMBER.FLASHAREA 0 0 1000 1000 WIN)
TOTAL)
[(NUMBERP DIGIT)
(COND
[(SETQ POWER (WINDOWPROP WIN (QUOTE DECIMALPOWER)))
(* have read decimal pt)
(WINDOWPROP WIN (QUOTE DECIMALPOWER)
(ADD1 POWER))
(SETQ POWER (bind (N ← 1.0) for I from 1 to POWER
do (SETQ N (FTIMES N .1))
finally (RETURN N)))
(COND
((GEQ TOTAL 0)
(PLUS TOTAL (TIMES DIGIT POWER)))
(T (DIFFERENCE TOTAL (TIMES DIGIT POWER]
((GEQ TOTAL 0)
(PLUS (TIMES TOTAL 10)
DIGIT))
(T (DIFFERENCE (TIMES TOTAL 10)
DIGIT]
(T (* uninteresting key struck, ignore it)
(RETURN]
(DISPLAY/NUMBER/READER/TOTAL WIN])
(NUMBERPAD.READER.DECODE
[LAMBDA (CHAR) (* rrb "14-May-86 18:49")
(* decodes a keystroke into the corresponding number
pad reader menu item.)
(OR (NUMBERP CHAR)
(SELECTQ (TEDIT.GETSYNTAX CHAR TEDIT.READTABLE)
(CHARDELETE (QUOTE bs))
((WORDDELETE LINEDELETE)
(QUOTE clr))
(DELETE (QUOTE abt))
(COND
((OR (EQ CHAR (QUOTE %
))
(EQ CHAR (QUOTE %
)))
(QUOTE ok))
(T CHAR])
(CREATE.NUMBERPAD.READER
[LAMBDA (MSG WPOSITION MSGFONT DIGITFONT INCLUDEABORTFLG FLOATINGPTFLG POSITIVEONLYFLG)
(* rrb "14-May-86 18:57")
(* 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 (COND
(FLOATINGPTFLG 8)
(T 6)))
WIN READERWIDTH PADLEFT TOTALREGION (DIGITFONT (OR DIGITFONT
(FONTCREATE BOLDFONT)
))
(MSGFONT (OR MSGFONT (FONTCREATE DEFAULTFONT)))
NUMBERPAD TOTALWIDTH FONTHEIGHT MSGLINES)
[SETQ NUMBERPAD
(create MENU
ITEMS ←[CONS
(COND
[POSITIVEONLYFLG (COND
((AND INCLUDEABORTFLG FLOATINGPTFLG)
(* no other place to put the backspace)
(QUOTE bs))
(T (QUOTE % ]
(T (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]
(FLOATINGPTFLG
(* put backspace in top row because decimal pt appears
in the bottom.)
(QUOTE (bs clr)))
(T (QUOTE (% clr]
(QUOTE (1 2 3 4 5 6 7 8 9))
[COND
(FLOATINGPTFLG
(* if floating point numbers are ok, include decimal
point.)
(QUOTE (%.)))
(T (QUOTE (bs]
(QUOTE (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 (LENGTH (SETQ MSGLINES
(
BREAK.MSG.INTO.LINES
MSG MSGFONT
READERWIDTH)))
(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)
(for LINE in MSGLINES
do (PRIN3 LINE WIN)
(TERPRI 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])
(BREAK.MSG.INTO.LINES
[LAMBDA (MSG FONT WIDTH) (* rrb "27-Aug-85 14:35")
(* returns a list of string that will fit in WIDTH if
printed in FONT)
(PROG ([MSGSTR (COND
((LISTP MSG) (* remove the outer parens)
(SUBSTRING (MKSTRING MSG)
2 -2))
(T (MKSTRING MSG]
(THISLINE 0)
(BEGIN 1)
LASTSPACE STRLST CHARWIDTH CHARCODE)
[for I from 1 to (NCHARS MSGSTR)
do (SETQ CHARWIDTH (CHARWIDTH (SETQ CHARCODE (NTHCHARCODE MSGSTR I))
FONT))
(COND
[(GREATERP (SETQ THISLINE (IPLUS THISLINE CHARWIDTH))
WIDTH) (* this character would go past)
(COND
((EQ CHARCODE (CHARCODE SPACE))
[SETQ STRLST (NCONC1 STRLST (SUBSTRING MSGSTR BEGIN (SUB1 I]
(SETQ THISLINE 0)
(SETQ BEGIN (ADD1 I))
(SETQ LASTSPACE))
(LASTSPACE (* this line has a space in it.)
[SETQ STRLST (NCONC1 STRLST (SUBSTRING MSGSTR BEGIN (SUB1 LASTSPACE]
(SETQ BEGIN (ADD1 LASTSPACE))
(SETQ THISLINE 0)
(for NL from (ADD1 LASTSPACE) to I
do (SETQ THISLINE (IPLUS (CHARWIDTH (NTHCHARCODE MSGSTR NL)
FONT)
THISLINE)))
(SETQ LASTSPACE))
(T (* this line doesn't have a space)
[SETQ STRLST (NCONC1 STRLST (SUBSTRING MSGSTR BEGIN (SUB1 I]
(SETQ BEGIN I)
(SETQ THISLINE CHARWIDTH]
((EQ CHARCODE (CHARCODE SPACE)) (* note the position of the space)
(SETQ LASTSPACE I)))
finally (COND
((GREATERP (SUB1 I)
BEGIN)
(SETQ STRLST (NCONC1 STRLST (SUBSTRING MSGSTR BEGIN -1]
(RETURN STRLST])
(REGIONONSCREEN
[LAMBDA (POS WIDTH HEIGHT) (* rrb "20-May-86 11:42")
(* 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 (IMAX (fetch (POSITION XCOORD) of POS)
0))
(SETQ BOTTOM (IMAX (fetch (POSITION YCOORD) of POS)
0)))
(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 "14-May-86 18:36")
(* displays the number total in the box in the
window.)
(PROG [(TOTALREG (WINDOWPROP WIN (QUOTE TOTALREG)))
(DECIMALPLACES (WINDOWPROP WIN (QUOTE DECIMALPOWER]
(DSPFILL TOTALREG WHITESHADE (QUOTE REPLACE)
WIN)
(RESETFORM
(RADIX 10)
(CENTERPRINTINREGION
[COND
[DECIMALPLACES (* printing a decimal number must check to make sure
the correct number of decimal places print.)
(PROG ([TOTSTR (MKSTRING (WINDOWPROP WIN (QUOTE TOTAL]
DECPOS NAFTERDEC NCHARS)
(SETQ NCHARS (NCHARS TOTSTR))
(SETQ DECPOS (STRPOS "." TOTSTR))
(RETURN (COND
((EQ (SUB1 DECIMALPLACES)
(SETQ NAFTERDEC (DIFFERENCE NCHARS
DECPOS)))
(* right number of places)
TOTSTR)
[(GEQ NAFTERDEC DECIMALPLACES)
(* strip off the unwanted ones.)
(SUBSTRING TOTSTR 1 (PLUS DECPOS
(SUB1
DECIMALPLACES]
(T (* not enough zeros on the end)
(CONCAT TOTSTR
(bind STR for I from 1
to (DIFFERENCE (SUB1
DECIMALPLACES)
NAFTERDEC)
do (COND
(STR (SETQ STR
(CONCAT STR "0"))
)
(T (SETQ STR "0")))
finally (RETURN STR]
(T (WINDOWPROP WIN (QUOTE TOTAL]
TOTALREG WIN])
(NUMBER.READER.HANDLER
[LAMBDA (DIGIT MENU BUTTON) (* rrb "14-May-86 15:37")
(* selected fn for a numberpad reader.
adds the digit to the current total and updates the
display.)
(NUMBERPAD.READER.HANDLE.CHAR DIGIT (WFROMMENU MENU])
(NUMBERPAD.HELDFN
[LAMBDA (ITEM MENU BUTTON) (* rrb "26-Aug-85 13:50")
(* 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")
(%. "will enter a decimal point.")
(% "doesn't do anything.")
(COND
((EQ ITEM RNUMBER.ABORT.BITMAP)
(* abort bitmap)
"will abort this question.")
((EQ ITEM RNUMBER.CLEAR.BITMAP)
(* abort bitmap)
"Will reset the total to 0")
((NLISTP ITEM)
"Will put this digit on the right of the total."])
(\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@"
"@@@@")})
(* stuff to dummy up a definition of TEDIT.GETSYNTAX if it isn't defined.)
(RPAQ? TEDIT.READTABLE T)
(MOVD? (QUOTE GETSYNTAX)
(QUOTE TEDIT.GETSYNTAX))
(PUTPROPS READNUMBER COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1131 21852 (\NUMBERPAD.READER.CLOSEFN 1141 . 1262) (\READNUMBER.FLASHAREA 1264 . 1696)
(RNUMBER 1698 . 2384) (NUMBERPAD.READ 2386 . 5329) (NUMBERPAD.READER.HANDLE.CHAR 5331 . 9102) (
NUMBERPAD.READER.DECODE 9104 . 9740) (CREATE.NUMBERPAD.READER 9742 . 14524) (BREAK.MSG.INTO.LINES
14526 . 16607) (REGIONONSCREEN 16609 . 17687) (DISPLAY/NUMBER/READER/TOTAL 17689 . 19637) (
NUMBER.READER.HANDLER 19639 . 20021) (NUMBERPAD.HELDFN 20023 . 21027) (\READNUMBER.OUTLINEREGION 21029
. 21850)))))
STOP