madler@tybalt.caltech.edu (Mark Adler) (03/30/90)
After getting the Appointment application (APPT and APDIR) from the
HP bulletin board and kermiting it over to my calculator, I found
that I didn't have much memory left. With a few other things loaded
in as well (the stopwatch, some of my own things), I started thinking
about buying more memory for the thing. Then I looked at the
programs in APDIR, and decided it was really a ploy to make me get
more memory. It almost worked too!
Without changing the functionality whatsoever, I reduced the size of
APDIR from 13714 bytes to 8173.5 bytes. I did this by rewriting
parts of the programs, putting them all in one directory, and
combining some programs (and even fixing a bug or two here and
there). It is even a little faster now. The thing really deserves a
total rewrite, and I estimate it could be made faster and more
functional in less than 5 or 6K bytes. But, alas, I don't have time
for that. Anyway, here is the shortened version, first APPT and then
APDIR.
Mark Adler
madler@tybalt.caltech.edu
%%HP: T(3)A(R)F(.);
@ Store as 'APPT'
@ 'APPT' BYTES should give CRC #5470h, and length 83.5.
\<<
APDIR
RCLF 'flags' STO MYFLGS STOF
CNTL
flags STOF HOME 2 MENU
\>>
%%HP: T(3)A(R)F(.);
@ Store as 'APDIR'
@ 'APDIR' BYTES should give CRC #B8C7h, and length 8173.5.
@ Note that if APPT is run, APDIR changes.
DIR
CNTL
@ Main function---called by APPT (not in APDIR)
@ Setup and process keystrokes at top (calendar) level.
\<<
DEPTH \->LIST 'STACK' STO @ save stack
DATE 'DSTR' STO @ set date to current date
REFRESH @ put up calendar
DO @ process keys until ...
-1 WAIT DOKEY
UNTIL
IP 16 == @ menu key F.
END
DROP2 STACK OBJ\-> DROP @ restore stack
\>>
REFRESH
@ called by CNTL, DOKEY (5)
@ Put up calendar display and menu.
\<<
@ SETUP
{ "FIND" "GOTO" "ADD" "UPLD" "APPTS" "Stop" } MENU DSTR SETUP2
MNTH LCD\->
@ HLIT
Dy ADR + 7 / FP 7 * 3 * 6 * 1 - 'COL' STO
Dy ADR + 7 / IP 1 + 8 * 1 - 'ROW' STO
DUP COL R\->B ROW R\->B 2 \->LIST COL 12 + R\->B ROW 8 + R\->B
2 \->LIST SUB NEG COL R\->B ROW R\->B 2 \->LIST SWAP REPL
DUP \->LCD
\>>
DOKEY
@ called by CNTL
@ Execute the keystroke on the stack for the calendar menu, update DSTR.
\<<
{ 11.1 { DROP SRCMAIN REFRESH 11.1 }
12.1 { DROP GOTO REFRESH 12.1 }
13.1 { CLEAR DSTR TIME 100 * IP 100 / "" 0 4 \->LIST
BEG 1 CF REFRESH 13.1 }
14.1 { DROP OVERALL REFRESH 14.1 }
15.1 { APPTS REFRESH 15.1 }
36.1 DYPL 34.1 DYMIN 35.1 NWEEK 25.1 PWEEK
95.1 MOPL 85.1 MOMIN 95.2 YRPLS 85.2 YRMIN
91.3 OFF
}
DUP2 SWAP POS
IF DUP THEN
1 + GET EVAL
ELSE
DROP2
END
Yr OBJ\-> 10000 / Dy + 100 / Mo + 'DSTR' STO
\>>
SRCMAIN
@ called by DOKEY
@ FIND key: find an appointment and go to that date.
\<<
@ GTSTR
DROP2 { } MENU "Type search string\010Then press ENTER." SRCSTR
\Ga 2 \->LIST INPUT 'SRCSTR' STO
CLLCD "Searching" 2 DISP
@ GTALN
DSTR FINDALARM 'NXTALRM' STO
@ SRCALRM
0 'ENDALRM' STO 0 'FNDALRM' STO
DO
NXTALRM
IFERR RCLALARM THEN
1 'ENDALRM' STO
ELSE
@ CHKALRM
1 GETI TIME TSTR 1 12 SUB 4 DISP DROP 3 GETI SWAP DROP
DUP TYPE 2 ==
IF THEN
SRCSTR POS
ELSE
DROP 0
END
IF THEN
1 'FNDALRM' STO
ELSE
DROP
END
END
NXTALRM 1 + 'NXTALRM' STO
UNTIL
ENDALRM FNDALRM OR
END
@ ENDPROC
IF ENDALRM THEN
CLEAR CLLCD "No appointment found\010\010Press a top row key." 3 DISP
-1 WAIT DROP
ELSE
1 GET 'DSTR' STO
END
\>>
GOTO
@ called by DOKEY
@ GOTO key: goto the entered date.
\<<
DROP2 { } MENU "Type date (MM.DDYYYY):\010Then press ENTER."
DSTR \->STR -1 2 \->LIST INPUT OBJ\-> 'DSTR' STO
\>>
YRMIN
@ called by DOKEY
@ left - key: go back one year.
\<<
ROT DROP2 DSTR .000001 - RDOSCR
\>>
YRPLS
@ called by DOKEY
@ left + key: go forward one year.
\<<
ROT DROP2 DSTR .000001 + RDOSCR
\>>
MOMIN
@ called by DOKEY
@ - key: go back one month.
\<<
ROT DROP2 DSTR DUP IP 1 - SWAP 100 * FP 100 / .01 + + DUP
IF 1 < THEN
.000001 - 12 +
END
RDOSCR
\>>
MOPL
@ called by DOKEY
@ + key: go forward one month.
\<<
ROT DROP2 DSTR DUP IP 1 + SWAP 100 * FP 100 / .01 + + DUP
IF 13 > THEN FP
1.000001 +
END
RDOSCR
\>>
PWEEK
@ called by DOKEY
@ down key: go forward one week (but stay in month).
\<<
IF Dy 7 > THEN
SWAP HLIT2 Dy 7 - 'Dy' STO RC HLIT2 DUP \->LCD SWAP
ELSE
400 .2 BEEP
END
\>>
NWEEK
@ called by DOKEY
@ up key: go back one week (but stay in month).
\<<
IF Dy DSTR LMNTH 6 - < THEN
SWAP HLIT2 7 Dy + 'Dy' STO RC HLIT2 DUP \->LCD SWAP
ELSE
400 .2 BEEP
END
\>>
DYMIN
@ called by DOKEY
@ left key: go back one day (but stay in month).
\<<
IF Dy 1 > THEN
SWAP HLIT2 Dy 1 - 'Dy' STO RC HLIT2 DUP \->LCD SWAP
ELSE
400 .2 BEEP
END
\>>
DYPL
@ called by DOKEY
@ right key: go forward one day (but stay in month).
\<<
IF Dy DSTR LMNTH < THEN
SWAP HLIT2 1 Dy + 'Dy' STO RC HLIT2 DUP \->LCD SWAP
ELSE
400 .2 BEEP
END
\>>
OVERALL
@ called by DOKEY
@ UPLD key: dump a range of appointments to I/O device.
\<<
@ GDATES
"Enter Start Date\010(MM.DDYYYY)\010Then press ENTER" DSTR
\->STR -1 2 \->LIST INPUT OBJ\-> 'SDAT' STO
"Enter End Date\010(MM.DDYYYY)\010Then press ENTER" DSTR
\->STR -1 2 \->LIST INPUT OBJ\-> 'ENDAT' STO
"\010"
@ RAPPTS
SDAT FINDALARM DUP 'NXTALRM' STO
SDAT DFLIP 'SDAT' STO
ENDAT DFLIP 'ENDAT' STO
CLLCD
"Finding appointments" 1 DISP
WHILE
@ GDALRM
IFERR RCLALARM THEN
DROP 0
ELSE
DUP 1 GET DFLIP DUP SDAT \>= SWAP ENDAT \<= AND
IF THEN
1
ELSE
DROP 0
END
END
REPEAT
@ MKSTR
DUP 1 GETI 3 ROLLD GET TSTR 1 19 SUB " " + SWAP 3 GET DUP
IF TYPE 2 == THEN
+
ELSE
DROP "Control Alarm" +
END
+ "\010" + NXTALRM 1 + DUP 'NXTALRM' STO
END
'APPTSTR' STO
@ TOPC
CLLCD
"The data is ready.\010Press the appropriate\010key when you are\010ready."
1 DISP { "SEND" "" "" "" "" "ABRT" } MENU
DO
-1 WAIT
IF DUP 11.1 == THEN
DROP 'APPTSTR'
IFERR CLLCD SEND THEN
DROP CLLCD
"I/O Problem\010Check configuration\010and retry." 1 DISP
ELSE
CLLCD "Successful transfer" 1 DISP
END
3 WAIT 16.1
END
UNTIL
16.1 ==
END
CLEAR
\>>
DFLIP
@ called by OVERALL (3)
@ Change MM.DDYYYY to YYYYMMDD for numerical comparisons.
\<<
100 * DUP IP SWAP FP 100000000 * +
\>>
APPTS
@ called by DOKEY
@ APPTS key: show appointments for selected day, allow operations.
\<<
3 DROPN
IF
@ FAPPTS
DSTR FINDALARM DUP
IF THEN
@ ALRM\->
'NXTALRM' STO
DO
NXTALRM
IFERR RCLALARM THEN
DROP DSTR 1 + 1 \->LIST
ELSE
OBJ\-> DROP NXTALRM 5 \->LIST NXTALRM 1 + 'NXTALRM' STO
END
UNTIL
DUP 1 GET DSTR \=/
END
DROP
ELSE
DROP
END
DEPTH
THEN
DEPTH ROLL
@ APS\->MS
DEPTH 1 SWAP
START
@ OAL\->MSG
DUP 5 GET SWAP DUP 3 GET SWAP 2 GET DUP IP DUP
IF 10 < THEN
"0" SWAP +
END
":" + SWAP FP 100 * IP DUP
IF NOT THEN
DROP "00"
END
+ " " + SWAP + SWAP 2 \->LIST
DEPTH ROLL
NEXT
@ PSTMSG
PG
DO
-1 WAIT
@ DOK5 and DOKX
{ 91.3 OFF
25.1 { DROP DEPTH ROLL PG 25.1 }
35.1 { DROP DEPTH ROLLD PG 35.1 }
11.1 \<<
DROP 2 GETI SWAP DROP DUP RCLALARM SWAP DELALARM DUP BEG
IF 1 FC? THEN
STOALARM
ELSE
DROP
END
1 CF 16.1
\>>
12.1 { DROP 2 GETI SWAP DROP
# 18CEAh SYSEVAL # E402h SYSEVAL # 3244h SYSEVAL
# E80Dh SYSEVAL # 172Bh SYSEVAL DROP2 12.1 }
13.1 { DROP 2 GET DELALARM 16.1 }
14.1 { DROP DSTR TIME 100 * IP 100 / "" 0 4 \->LIST BEG 1 CF 16.1 }
15.1 \<<
DROP
@ PRVW
CLLCD DUP 1 GET DUP SIZE 7 SWAP SUB DUP SIZE 1 SWAP
FOR x
DUP 1 22 SUB x 22 / 1 + DISP
IF DUP SIZE 22 > THEN
DUP SIZE 23 SWAP SUB
END
22 STEP
DROP { "" "" "" "" "" "RTRN" } MENU -1 WAIT DROP
PG 15.1
\>>
}
IF DEPTH 7 > THEN
{ 25.2 { DROP 1 5 START DEPTH ROLL NEXT PG 25.2 }
35.2 { DROP 1 5 START DEPTH ROLLD NEXT PG 35.2 }
} +
END
DUP2 SWAP POS
IF DUP THEN
1 + GET EVAL
ELSE
DROP2
END
UNTIL
16.1 ==
END
CLEAR
ELSE
@ NOAPPTS
DO
@ NOHEAD
DSTR TIME TSTR 1 12 SUB " " SWAP + " NO APPTS YET FOR"
CLLCD 1 DISP 3 DISP
@ SETNO
{ "" "" "" "ADD" "" "RTN" } MENU
-1 WAIT
@ DOK3
CASE
DUP 91.3 == THEN OFF END
DUP 14.1 == THEN DROP DSTR 8 "" 0 4 \->LIST BEG 16.1 END
END
UNTIL
16.1 ==
END
END
\>>
PG
@ called by APPTS (5)
@ Put the (first 5) appointments on the stack in the display,
@ and show the menu.
\<<
@ MHEAD
DSTR TIME TSTR 1 12 SUB " " SWAP + "Appts and meetings for"
CLLCD 1 DISP 2 DISP
@ SETU3
{ "EDIT" "ACK" "DEL" "ADD" "VIEW" "RTN" } MENU
DEPTH 5 MIN
@ POSTX
\-> d \<<
1 d FOR i
DUP 1 GET i 2 + DISP DEPTH ROLL
1 STEP
1 d START
DEPTH ROLLD
NEXT
@ TSK1
LCD\-> DUP { # 0h # Fh } { # 87h # 17h } SUB NEG
{ # 0h # Fh } SWAP REPL \->LCD
\>>
\>>
BEG
@ called by DOKEY, APPTS
@ ADD or EDIT key: edit a new or existing appointment.
\<<
DO
@ RFSH
CLLCD 1
GETI "Date " SWAP + 1 DISP
GETI "Hour " SWAP + 2 DISP
GETI "Msg. " SWAP + 3 DISP
DROP "Press a softkey first" 5 DISP
@ SETU4
{ "DATE" "TIME" "MSG" "RPT" "SET" "ABRT" } MENU
-1 WAIT
@ DOK4
{ 91.3 OFF
11.1 { DROP DATTE 11.1 }
12.1 { DROP HOUR 12.1 }
13.1 { DROP MSSG 13.1 }
14.1 { REPEET 14.1 }
15.1 { DROP STOALARM DROP 1 SF 15.1 }
16.1 { 1 CF SWAP DROP }
}
DUP2 SWAP POS
IF DUP THEN
1 + GET EVAL
ELSE
DROP2 1000 .2 BEEP
END
UNTIL
DUP 15.1 == SWAP 16.1 == OR
END
\>>
MSSG
@ called by BEG
@ MSG key: change text message for appointment.
\<<
{ } MENU 3 GETI SWAP DROP \Ga 2 \->LIST
"Message:\010Then press ENTER." SWAP INPUT 3 SWAP PUT
\>>
HOUR
@ called by BEG
@ TIME key: change time for appointment.
\<<
{ } MENU 2 GETI SWAP DROP \->STR -1 2 \->LIST
"Hour (HH.MM):\010Then press ENTER." SWAP INPUT OBJ\-> 2 SWAP PUT
\>>
DATTE
@ called by BEG
@ DATE key: change date for appointment.
\<<
DO
{ } MENU 1 GETI SWAP DROP \->STR -1 2 \->LIST
"Date (MM.DDYYYY):\010Then press ENTER." SWAP INPUT OBJ\->
UNTIL
DUP DUP DUP IP DUP 0 > SWAP 13 < AND SWAP FP 100 * IP 32 < AND
SWAP 100 * FP 10000 * 1990 \>= AND DUP
IF NOT THEN
SWAP DROP CLLCD
"Bad date. The rules:\010\0100 < MM < 13\0100 < DD < 32\0101990 \<= YYYY\010\010Press a top row key"
1 DISP -1 WAIT DROP
END
END
1 SWAP PUT
\>>
REPEET
@ called by BEG
@ RPT key: change repeat specification for appointment.
@ (Note: this function expects no number to be entered if NONE will
@ be pressed on the next menu.)
\<<
{ } MENU
"Repeat #. Then ENTER." "" INPUT OBJ\->
{ "Week" "Day" "Hour" "Min" "Sec" "None" } MENU
"Now press repeat unit" 3 DISP -1 WAIT
{ 11.1 4954521600
12.1 707788800
13.1 29491200
14.1 491520
15.1 8192
}
DUP ROT POS
IF DUP THEN
1 + GET *
ELSE
DROP2 0 @ this assumes no input
END
SWAP DROP 4 SWAP PUT
\>>
RDOSCR
@ called by YRMIN, YRPLS, MOMIN, MOPL
@ Change current date and display the new month.
\<<
SETUP2 MNTH LCD\-> RC HLIT2 DUP \->LCD SWAP
\>>
HLIT2
@ called by RDOSCR, PWEEK (2), NWEEK (2), DYMIN (2), DYPL (2)
@ Toggle the highlighting of the current date in the calendar.
\<<
COL R\->B ROW R\->B 2 \->LIST DUP2
COL 12 + R\->B ROW 8 + R\->B 2 \->LIST
SUB NEG REPL
\>>
RC
@ called by RDOSCR, PWEEK, NWEEK, DYMIN, DYPL
@ Update ROW and COL for the current date in the calendar.
\<<
Dy ADR + 7 / FP 126 * 1 - 'COL' STO
Dy ADR + 7 / IP 1 + 8 * 1 - 'ROW' STO
\>>
SETUP2
@ called by REFRESH, RDOSCR
@ Set DSTR, update Mo, Dy, Yr, Day1, and ADR.
\<<
DUP 'DSTR' STO DUP
@ MMYY
DUP IP 'Mo' STO
FP 100 * DUP IP 'Dy' STO
FP 10000 * \->STR 'Yr' STO
DUP
@ DFRST
DUP IP SWAP FP 100 * FP 1 + 100 / + TIME TSTR 1 3 SUB 'Day1' STO
@ CADR
{ "SUN" "MON" "TUE" "WED" "THU" "FRI" "SAT" } Day1 POS 2 - 'ADR' STO
\>>
MNTH
@ called by REFRESH, RDOSCR
@ Put the current month in the display.
\<<
@ HEADR
{ "January " "February " "March " "April " "May " "June "
"July " "August " "September " "October " "November " "December " }
Mo GET Yr + " " SWAP + 1 DISP
DSTR LMNTH Day1
@ MN
\-> n d \<<
" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31"
{ "SAT" "FRI" "THU" "WED" "TUE" "MON" "SUN" } d POS 3 * 2 -
n 3 * 17 + SUB
2 7 FOR i
DUP i 2 - 21 * 1 + DUP 19 + SUB i DISP
NEXT
DROP
\>>
\>>
LMNTH
@ called by NWEEK, DYPL, MNTH
@ Compute the number of days in the month.
\<<
DUP IP SWAP 100 * FP 100 / .01 + + DUP 1 + DUP
IF 13 > THEN
FP 1.000001 +
END
DDAYS
\>>
SRCSTR "" @ used in CHKALRM, GETSTR
MYFLGS { # 90400000FF0h # 0h } @ used by APPT (not in APDIR)
END @ APDIR