%%HP: T(3)A(D)F(.);
DIR
  KAL
  \<< CLLCD -42. SF -2.
SF -3. SF
    IF DEPTH 2. \>=
    THEN STD 'jj' STO
jj 'jr' STO
      IF 'jr\<=50.'
      THEN jj 2000. +
'jj' STO
      END
      IF 'jr>50. AND
jr<1583.'
      THEN jj 1900. +
'jj' STO
      END 'jr' PURGE
      \<< \-> m
        \<<
          IF 'm\>=1. AND
m\<=12.'
          THEN m 'mm'
STO
          ELSE 1.
'mm' STO
          END
        \>>
      \>> EVAL mm
10000. * jj +
1000000. / 1. +
'DAT1' STO DAT1 WOT
EVAL 'WOT1' STO DAT1
      IF 'mm==12.'
      THEN 10000. jj
1. + + 1000000. / 1.
+
      ELSE mm 1. +
10000. * jj +
1000000. / 1. +
      END DDAYS
'MONL' STO ERASE {
# 0d # 0d } { # 130d
# 63d } PDIM { # 0d
# 0d } { # 130d # 63d
} BOX PICT { # 2d
# 3d } { # 0d # 0d }
PVIEW "Kalender" 1.
\->GROB REPL { # 1d
# 9d } { # 129d # 9d
} LINE PICT { # 60d
# 3d } mm MON EVAL jj
+ 1. \->GROB REPL {
# 13d # 10d } { # 13d
# 63d } LINE PICT {
# 2d # 11d } "KW" 1.
\->GROB REPL PICT {
# 20d # 11d } "Mo" 1.
\->GROB REPL PICT {
# 36d # 11d } "Di" 1.
\->GROB REPL PICT {
# 52d # 11d } "Mi" 1.
\->GROB REPL PICT {
# 68d # 11d } "Do" 1.
\->GROB REPL PICT {
# 84d # 11d } "Fr" 1.
\->GROB REPL PICT {
# 100d # 11d } "Sa"
1. \->GROB REPL PICT {
# 116d # 11d } "So"
1. \->GROB REPL
      IF 'WOT1==0.'
      THEN 7. 'POS1'
STO
      ELSE WOT1
'POS1' STO
      END
      \<< 1. MONL
        FOR d PICT
16. POS1 d + 2. - 7.
MOD * 20. + R\->B 7.
POS1 d + 2. - 7. / IP
* 20. + R\->B 2. \->LIST
          IF 'd<10.'
          THEN " " d
IP R\->I \->STR +
          ELSE d IP
R\->I \->STR
          END 1.
\->GROB REPL
        NEXT
      \>> EVAL
      \<< 1. 22.
        FOR n DAT1 n
+ 1. - KW EVAL POS1 n
+ 2. - 7. / IP 7. *
20. + R\->B # 3d SWAP
2. \->LIST PICT SWAP 3.
ROLL IP R\->I \->STR 1.
\->GROB REPL 7.
        STEP 28. MONL
        FOR n DAT1 n
+ 1. - KW EVAL POS1 n
+ 2. - 7. / IP 7. *
20. + R\->B # 3d SWAP
2. \->LIST PICT SWAP 3.
ROLL IP R\->I \->STR 1.
\->GROB REPL
        NEXT
      \>> EVAL { # 0d
# 0d } PVIEW 7.
FREEZE { mm jj MONL
DAT1 WOT1 POS1 }
PURGE
    ELSE 3000. .1
BEEP
"Monatskalender:
Eingabewerte
Monat und Jahr
unvollst\228ndig!
 (C) 12.03.2000
      Praxelius
  "
MSGBOX
    END
  \>>
  WOT
  \<< 17.101582 SWAP
DDAYS 7. MOD
  \>>
  KW
  \<< DUP 100. * FP
101. + 100. / DUP 3.
ROLL DDAYS 1. + SWAP
WOT EVAL DUP
    \<< \-> ww
      \<<
        IF 'ww==0.'
        THEN 7. +
        END
      \>>
    \>> EVAL
    \<< \-> jt wt
      \<<
        IF 'wt\>=1. AND
wt\<=4.'
        THEN jt wt +
5. + 7. / IP
        ELSE jt wt +
5. + 7. / IP 1. -
        END
      \>>
    \>> EVAL \-> kw
    \<<
      CASE 'kw==0.'
        THEN 52.
        END 'kw==53.'
        THEN 1.
        END kw
      END
    \>> EVAL
  \>>
  MON
  \<< \-> mm
    \<<
      CASE 'mm==1.'
        THEN
"Januar "
        END 'mm==2.'
        THEN
"Februar "
        END 'mm==3.'
        THEN "Maerz "
        END 'mm==4.'
        THEN "April "
        END 'mm==5.'
        THEN "Mai "
        END 'mm==6.'
        THEN "Juni "
        END 'mm==7.'
        THEN "Juli "
        END 'mm==8.'
        THEN
"August "
    