maurice@bruce.cs.monash.OZ.AU (Maurice David Castro) (04/21/91)
Having Noticed that people have started distributin parts of a Calander
program similar to one I was working on, I thought it about time to
release my own. This program is fully operational, however, it
probably needs some modification to make it neater. (Unfortunately
I just do not have the time at the moment to do it!)
Operation is straight forward, just down load it to the HP48SX as CAL and then
press CAL. The menu is in 2 parts and allows the user to increment by a week
or year or day, and to display a calander in Month format. (P.S. I am
Australian, so my appologies the dates{will look backwards to those in
America.) One last comment: Use Exit to leave the program as it leaves
a heap of small subroutines lying around in its current dirrectory if you
fail to do so.
Good Luck with the program but bear in mind the Standard disclaimer.
All care has been taken in the writing, however, the program is to be
used at your own risk. The author is not responsible for any loss, damage or
subsequent problems resulting from the use of this program. The
program is placed into the Public Domain.
Maurice Castro
Monash University, Clayton, Australia
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
%%HP: T(3)A(D)F(.);
\<<
IF -42 FS?
THEN 1 'F42' STO
ELSE 0 'F42' STO
END -42 SF
\<< DUP FP
IFERR DUP 31 +
1 TSTR DROP2 DROP
31
THEN
IFERR DROP2
DUP 30 + 1 TSTR
DROP2 DROP 30
THEN
IFERR DROP2
DUP 29 + 1 TSTR
DROP2 DROP 29
THEN DROP2
DROP2 28
END
END
END
\>> 'LASTDAY' STO
\<< FP 1 +
\>> 'FIRSTMTH' STO
\<< TIME TSTR 1 3
SUB
CASE DUP "SUN"
SAME
THEN 1
END DUP "MON"
SAME
THEN 2
END DUP "TUE"
SAME
THEN 3
END DUP "WED"
SAME
THEN 4
END DUP "THU"
SAME
THEN 5
END DUP "FRI"
SAME
THEN 6
END DUP "SAT"
SAME
THEN 7
END
END SWAP DROP
\>> 'DAYNO' STO
\<< 1 "" 0 2 \-> TDAY
LDAY FDWK DAY LNE
CNT LNO
\<< CLLCD
" Su Mo Tu We Th Fr Sa"
1 DISP FDWK 1 -
'CNT' STO
WHILE CNT 0 >
REPEAT " "
LNE + 'LNE' STO
'CNT' DECR DROP
END 1 7 FDWK
- 1 +
FOR DAY LNE
IF DAY TDAY
1 + SAME NOT
THEN " " +
END
IF DAY TDAY
SAME
THEN "\<<" +
ELSE " " +
END DAY
\->STR +
IF DAY TDAY
SAME
THEN "\>>" +
END 'LNE'
STO 1
STEP LNE LNO
DISP 7 FDWK - 1 +
'DAY' STO
WHILE DAY
LDAY <
REPEAT 1
'CNT' STO 'LNO'
INCR DROP "" 'LNE'
STO
WHILE CNT 7
\<= DAY LDAY < AND
REPEAT
'DAY' INCR DROP
'CNT' INCR DROP LNE
IF DAY 9
\<=
THEN " "
+
END
IF DAY
TDAY SAME
THEN "\<<"
+
ELSE
IF DAY
TDAY 1 + SAME NOT
CNT 2 SAME OR
THEN
" " +
END
END DAY
\->STR +
IF DAY
TDAY SAME
THEN "\>>"
+
END 'LNE'
STO
END LNE LNO
DISP
END 3 FREEZE
\>>
\>> 'DM' STO DATE
CLLCD DATE TIME
TSTR 1 12 SUB 3
DISP 3 FREEZE 0
'STAT' STO { {
"SHOW"
\<<
IF STAT 0 SAME
THEN DUP DUP
DUP IP ROT ROT
LASTDAY SWAP
FIRSTMTH DAYNO DM 1
'STAT' STO
ELSE CLLCD DUP
TIME TSTR 1 12 SUB
3 DISP 3 FREEZE 0
'STAT' STO
END
\>> } { "+Day"
\<< 1 +
IF DUP DUP 1 -
LASTDAY >
THEN DUP 1 -
LASTDAY SWAP FP +
END CLLCD DUP
TIME TSTR 1 12 SUB
3 DISP 3 FREEZE 0
'STAT' STO
\>> } { "-Day"
\<< 1 -
IF DUP 1 <
THEN 1 +
END CLLCD DUP
TIME TSTR 1 12 SUB
3 DISP 3 FREEZE 0
'STAT' STO
\>> } { "+Mth"
\<< .01 +
IF DUP FP .13 >
THEN .01 -
.000001 + .11 -
END CLLCD DUP
TIME TSTR 1 12 SUB
3 DISP 3 FREEZE 0
'STAT' STO
\>> } { "-Mth"
\<< .01 -
IF DUP FP .01 <
THEN .01 +
.000001 - .11 +
END CLLCD DUP
TIME TSTR 1 12 SUB
3 DISP 3 FREEZE 0
'STAT' STO
\>> } { "EXIT"
\<<
IF F42 0 SAME
THEN -42 CF
END { CST
LASTDAY FIRSTMTH
DAYNO DM F42 STAT }
PURGE 2 MENU DROP
KILL
\>> } { "+Yr"
\<< .000001 + CLLCD
DUP TIME TSTR 1 12
SUB 3 DISP 3 FREEZE
0 'STAT' STO
\>> } { "-Yr"
\<< .000001 - CLLCD
DUP TIME TSTR 1 12
SUB 3 DISP 3 FREEZE
0 'STAT' STO
\>> } { "Today"
\<< DROP DATE CLLCD
DUP TIME TSTR 1 12
SUB 3 DISP 3 FREEZE
0 'STAT' STO
\>> } { "+Wk"
\<< 7 DATE+ CLLCD
DUP TIME TSTR 1 12
SUB 3 DISP 3 FREEZE
0 'STAT' STO
\>> } { "-Wk"
\<< -7 DATE+ CLLCD
DUP TIME TSTR 1 12
SUB 3 DISP 3 FREEZE
0 'STAT' STO
\>> } } MENU HALT
\>>
--
Maurice Castro
maurice@bruce.cs.monash.edu.au