RosettaCodeData/Task/Palindrome-dates/Quackery/palindrome-dates.quackery
2023-07-01 13:44:08 -04:00

45 lines
1.1 KiB
Text

[ dup 400 mod 0 = iff
[ drop true ] done
dup 100 mod 0 = iff
[ drop false ] done
4 mod 0 = ] is leap ( y --> b )
[ 1 -
[ table
31 [ dup leap 28 + ]
31 30 31 30 31 31 30
31 30 31 ]
do nip ] is monthdays ( y m --> n )
[ 1+ dip [ 2dup monthdays ]
tuck < while
drop 1+ 1
over 13 = if
[ 2drop 1+ 1 1 ] ] is nextday ( y m d --> y m d )
[ dip 2dup dup dip unrot ] is 3dup ( a b c --> a b c a b c )
[ swap 100 * +
swap 10000 * +
number$ ] is date$ ( y m d --> $ )
[ dup reverse = ] is palindrome ( $ --> b )
[ char - swap 4 stuff
char - swap 7 stuff ] is +dashes ( $ --> $ )
[] temp put
2020 02 02
[ nextday
3dup date$
dup palindrome iff
[ temp take
swap nested join
temp put ]
else drop
temp share
size 15 = until ]
drop 2drop
temp take witheach
[ +dashes echo$ cr ]