Article 1670 of comp.sys.handhelds:
From: madler@tybalt.caltech.edu (Mark Adler)
Newsgroups: comp.sys.handhelds
Subject: Shorter APPT, APDIR (this is a LONG message)
Date: 29 Mar 90 20:13:24 GMT
Organization: California Institute of Technology, Pasadena

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