A tiny New Year's programming challenge

[Gerald H]

(01-02-2015 07:17 AM)Dieter Wrote:  

(01-01-2015 06:00 PM)Gerald H Wrote:  For HP 48G, 49G & 49G+ the progs are available here:

Thank you – but I cannot find any source code. So how did you do it?

Dieter

At long last the source for the 49G programme:

GISO

::
CK1&Dispatch
BINT1
::
ID x003
DUP
%20
DATE+DAYS
% 10.0000001
%+
a%>$
BINT6
BINT9
SUB$
FPTR2 ^S>Z
UNROTOVER
DDAYS
DUP
%0<
ITE
::
DROPSWAP
FPTR2 ^Z>R
%1-
DUP
FPTR2 ^R>Z
3UNROLL
% 1000000.
%/
% 18.08
%+
ID x003
SWAPDROPSWAP
DDAYS
;
SWAPDROP
SWAP
FPTR2 ^Z>S
$>ID
SWAP
COERCE
BINT7
#/
#1+
#>$
DUPLEN$
#3=
IT
::
CHR_0
>H$
;
$>ID
SWP1+
FPTR2 ^#>Z
TWO{}N
{}>TAG_
TWO{}N
{}>TAG_
;
;

ISOG

::
CK1&Dispatch
BINT13
::
TAG>_
palparse
DROP
FPTR2 ^CK1Z
FPTR2 ^Z>R
SWAP
DUPTYPETAG?
NcaseTYPEERR
TAG>_
palparse
DROP
FPTR2 ^CK1Z
FPTR2 ^Z>R
SWAP
FPTR2 ^CK1Z
FPTR2 ^Z>R
3UNROLL
%1-
SWAP
% 1000000.
%/
% 18.08
%+
ID x003
SWAPDROPSWAP
%7
%*
ROT
%+
%1-
DATE+DAYS
;
;

x002

{ "MO" "TU" "WE" "TH" "FR" "SA" "SU" }

x003

::
DUP
%100
%*
%FP
%100
%/
% 4.010001
%+
2DUP
DDAYS
%7
%<
ITE
::
ID x002
3PICK
%1
TIMESTR
BINT3
1_#1-SUB$
EQUALPOSCOMP
BINT3
#>
;
TRUE
IT
::
% .000001
%-
;
ID x002
OVER
%1
TIMESTR
BINT3
1_#1-SUB$
EQUALPOSCOMP
#1-
UNCOERCE
%CHS
DATE+DAYS
;