(FILECREATED "26-OCT-81 15:22:15" {PHYLUM}<SYBALSKY>ODOMETER.;28 7869
changes to: ODOCREATE
previous date: "21-SEP-81 11:25:58" {PHYLUM}<SYBALSKY>ODOMETER.;27)
(PRETTYCOMPRINT ODOMETERCOMS)
(RPAQQ ODOMETERCOMS ((VARS * ODOMETERVARS)
(FNS * ODOMETERFNS)))
(RPAQQ ODOMETERVARS NIL)
(RPAQQ ODOMETERFNS (ODOBUTTONFN ODOCLOSE ODOCREATE ODODEC ODOINC ODOOPEN ODOPUT ODOSET ODOVAL WSCROLL
WSCROLLD))
(DEFINEQ
(ODOBUTTONFN
[LAMBDA (W) (* jds "21-SEP-81 11:02")
(while (MOUSESTATE (OR RED YELLOW)) do (COND
((MOUSESTATE (ONLY RED))
(ODOINC W))
((MOUSESTATE (ONLY YELLOW))
(ODODEC W])
(ODOCLOSE
[LAMBDA (ODOMETER) (* jds "15-SEP-81 16:21")
(for W in ODOMETER do (CLOSEW W])
(ODOCREATE
[LAMBDA (#DIGITS FONT PLACE) (* jds "26-OCT-81 15:22")
(* Set up the odometer windows * digit bitmaps)
(PROG ((BMARRAY (ARRAY 11 0))
FIGSP FIGSP2 FONTH ODOLIST W0 TDS W I BM REG)
(OR FONT (SETQ FONT (FONTCREATE (QUOTE TimesRomanD)
36)))
[OR PLACE (PROGN (PRINT "Please indicate a place for the odometer." (WINDOWPROP
PROMPTWINDOW
(QUOTE DSP)))
(SETQ PLACE (GETPOSITION]
(SETQ FIGSP (CHARWIDTH 48 FONT)) (* A figure space)
(SETQ FIGSP2 (IPLUS FIGSP FIGSP))
(SETQ FONTH (FONTPROP FONT (QUOTE HEIGHT))) (* Build the units, tens, and hundreds digit windows)
(SETQ REG (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ← FIGSP
HEIGHT ← FONTH))
[SETQ ODOLIST (for LEFT from (fetch XCOORD of PLACE) by (IPLUS FIGSP 12) as I from 1
to #DIGITS collect (CREATEW (create REGION
LEFT ← LEFT
BOTTOM ←(fetch YCOORD of PLACE)
WIDTH ←(IPLUS FIGSP 8)
HEIGHT ←(IPLUS FONTH 8]
(for W in ODOLIST do (WINDOWPROP W (QUOTE DGT)
-1)
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(QUOTE ODOBUTTONFN))
(WINDOWPROP W (QUOTE BMARRAY)
BMARRAY)
(WINDOWPROP W (QUOTE CLIPREGION)
REG))
(SETQ W0 (CAR ODOLIST))
(for W in (CDR ODOLIST) do (WINDOWPROP W (QUOTE NXTD)
W0)
(SETQ W0 W)) (* Build the digit bitmaps)
(SETQ TDS (DSPCREATE))
(DSPFONT FONT TDS)
(for I from 0 to 9 do (SETA BMARRAY (IPLUS I 2)
(SETQ BM (BITMAPCREATE FIGSP FONTH)))
(DSPDESTINATION BM TDS)
(DSPXPOSITION 0 TDS)
(DSPYPOSITION 3 TDS)
(PRIN1 I TDS))
(SETA BMARRAY 1 (BITMAPCREATE FIGSP FONTH))
(RETURN ODOLIST])
(ODODEC
[LAMBDA (W COUPLEDFLAG) (* jds "21-SEP-81 10:37")
(PROG (D ND FN CPL)
(SETQ D (WINDOWPROP W (QUOTE DGT)))
(COND
((ZEROP D)
(WSCROLLD W 0 9)
(COND
((WINDOWPROP W (QUOTE NXTD))
(ODODEC (WINDOWPROP W (QUOTE NXTD))
T)))
(WINDOWPROP W (QUOTE DGT)
9))
((EQ D -1)
(WSCROLLD W -1 9)
[COND
((WINDOWPROP W (QUOTE NXTD))
(ODODEC (WINDOWPROP W (QUOTE NXTD]
(WINDOWPROP W (QUOTE DGT)
9))
(T (SETQ ND (SUB1 D))
(WSCROLLD W D ND)
(WINDOWPROP W (QUOTE DGT)
ND)))
(IF (SETQ FN (WINDOWPROP W (QUOTE ODODECFN)))
THEN (APPLY* FN W))
(if (NOT COUPLEDFLAG)
then (if (SETQ CPL (WINDOWPROP W (QUOTE COUPLED)))
then (for C in CPL do (ODODEC C T])
(ODOINC
[LAMBDA (W COUPLEDFLAG) (* jds "21-SEP-81 10:37")
(PROG (D ND FN CPL)
(SETQ D (WINDOWPROP W (QUOTE DGT)))
[COND
((EQ D 9)
(PROGN (WSCROLL W 9 0)
(COND
((WINDOWPROP W (QUOTE NXTD))
(ODOINC (WINDOWPROP W (QUOTE NXTD))
T)))
(WINDOWPROP W (QUOTE DGT)
0)))
(T (PROGN (COND
((EQ D -1)
(PROGN (WSCROLL W -1 1)
(SETQ D 0)))
(T (PROGN (SETQ ND (ADD1 D))
(WSCROLL W D ND)
(WINDOWPROP W (QUOTE DGT)
ND]
(COND
((SETQ FN (WINDOWPROP W (QUOTE ODOINCFN)))
(APPLY* FN W)))
(if (NOT COUPLEDFLAG)
then (COND
((SETQ CPL (WINDOWPROP W (QUOTE COUPLED)))
(for C in CPL do (ODOINC C T])
(ODOOPEN
[LAMBDA (ODOMETER) (* jds "15-SEP-81 16:21")
(for W in ODOMETER do (OPENW W])
(ODOPUT
[LAMBDA (W DIGIT) (* jds "15-SEP-81 16:31")
(* Set (QUOTE window') to contain
(QUOTE digit'.))
(PROG [(DIGITBM (ELT (WINDOWPROP W (QUOTE BMARRAY))
(IPLUS DIGIT 2]
(BITBLT DIGITBM 0 0 (WINDOWPROP W (QUOTE DSP))
0 0 (fetch BITMAPWIDTH of DIGITBM)
(fetch BITMAPHEIGHT of DIGITBM)
(QUOTE INSERT)
(QUOTE REPLACE))
(WINDOWPROP W (QUOTE DGT)
DIGIT])
(ODOSET
[LAMBDA (ODOMETER VALUE) (* jds "18-SEP-81 12:37")
(PROG (RESID)
(for W in (REVERSE ODOMETER) do [COND
((ZEROP VALUE)
(SETQ RESID -1))
(T (SETQ RESID (IREMAINDER VALUE 10]
(ODOPUT W RESID)
(SETQ VALUE (IQUOTIENT (IDIFFERENCE VALUE RESID)
10])
(ODOVAL
[LAMBDA (ODOMETER) (* jds "21-SEP-81 10:25")
(PROG ((VALUE 0))
[for W in ODOMETER do (SETQ VALUE (IPLUS (ITIMES VALUE 10)
(MAX 0 (WINDOWPROP W (QUOTE DGT]
(RETURN VALUE])
(WSCROLL
[LAMBDA (WINDOW OLDDIG NEWDIG) (* jds "18-SEP-81 12:38")
(PROG [(REG (WINDOWPROP WINDOW (QUOTE CLIPREGION)))
FONTH FIGSP WDS OBM NBM (BMARRAY (WINDOWPROP WINDOW (QUOTE BMARRAY]
(SETQ WDS (WINDOWPROP WINDOW (QUOTE DSP)))
(SETQ OBM (ELT BMARRAY (IPLUS 2 OLDDIG)))
(SETQ NBM (ELT BMARRAY (IPLUS 2 NEWDIG)))
(SETQ FONTH (fetch BITMAPHEIGHT of OBM))
(SETQ FIGSP (fetch BITMAPWIDTH of OBM))
(for BOT from 0 to (SUB1 FONTH)
do (PROGN (BITBLT OBM 0 0 WDS 0 BOT FIGSP FONTH (QUOTE INSERT)
(QUOTE REPLACE)
NIL REG)
(BITBLT NBM 0 0 WDS 0 (IDIFFERENCE BOT FONTH)
FIGSP FONTH (QUOTE INSERT)
(QUOTE REPLACE)
NIL REG)))
(WINDOWPROP WINDOW (QUOTE DGT)
NEWDIG])
(WSCROLLD
[LAMBDA (WINDOW OLDDIG NEWDIG) (* jds "18-SEP-81 12:38")
(PROG [WDS OBM NBM (REG (WINDOWPROP WINDOW (QUOTE CLIPREGION)))
FONTH FIGSP BOT (BMARRAY (WINDOWPROP WINDOW (QUOTE BMARRAY]
(SETQ WDS (WINDOWPROP WINDOW (QUOTE DSP)))
(SETQ OBM (ELT BMARRAY (IPLUS 2 OLDDIG)))
(SETQ NBM (ELT BMARRAY (IPLUS 2 NEWDIG)))
(SETQ FONTH (fetch BITMAPHEIGHT of OBM))
(SETQ FIGSP (fetch BITMAPWIDTH of OBM))
(for BOT from (SUB1 FONTH) to 0 by -1
do (PROGN (BITBLT OBM 0 0 WDS 0 (IDIFFERENCE BOT (SUB1 FONTH))
FIGSP FONTH (QUOTE INSERT)
(QUOTE REPLACE)
NIL REG)
(BITBLT NBM 0 0 WDS 0 BOT FIGSP FONTH (QUOTE INSERT)
(QUOTE REPLACE)
NIL REG)))
(WINDOWPROP WINDOW (QUOTE DGT)
NEWDIG])
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (442 7847 (ODOBUTTONFN 452 . 745) (ODOCLOSE 747 . 901) (ODOCREATE 903 . 2968) (ODODEC
2970 . 3877) (ODOINC 3879 . 4707) (ODOOPEN 4709 . 4861) (ODOPUT 4863 . 5414) (ODOSET 5416 . 5792) (
ODOVAL 5794 . 6067) (WSCROLL 6069 . 6943) (WSCROLLD 6945 . 7845)))))
STOP