Initial data commit

Task/Date-format/Forth/date-format-1.fth

@@ -0,0 +1,55 @@
+: .-0 ( n -- n )
+  [char] - emit
+  dup 10 < if [char] 0 emit then ;
+
+: .short-date
+  time&date ( s m h D M Y )
+  1 u.r .-0 1 u.r .-0 1 u.r
+  drop drop drop ;
+
+: str-table
+  create ( n -- ) 0 do , loop
+  does>  ( n -- str len ) swap cells + @ count ;
+
+ here ," December"
+ here ," November"
+ here ," October"
+ here ," September"
+ here ," August"
+ here ," July"
+ here ," June"
+ here ," May"
+ here ," April"
+ here ," March"
+ here ," February"
+ here ," January"
+12 str-table months
+
+ here ," Sunday"
+ here ," Saturday"
+ here ," Friday"
+ here ," Thursday"
+ here ," Wednesday"
+ here ," Tuesday"
+ here ," Monday"
+7 str-table weekdays
+
+\ Zeller's Congruence
+: zeller ( m -- days since March 1 )
+  9 + 12 mod 1-   26 10 */ 3 + ;
+
+: weekday ( d m y -- 0..6 )   \ Monday..Sunday
+  over 3 < if 1- then
+  dup    4 /
+  over 100 / -
+  over 400 / +  +
+  swap zeller + +
+  1+ 7 mod ;
+
+: 3dup   dup 2over rot ;
+
+: .long-date
+  time&date ( s m h D M Y )
+  3dup weekday weekdays type ." , "
+  >R 1- months type space 1 u.r ." , " R> .
+  drop drop drop ;

Task/Date-format/Forth/date-format-2.fth

@@ -0,0 +1,61 @@
+\ Build up a "language" for date formatting
+
+\ utility words
+: UNDER+  ( a b c -- a+c b )  ROT + SWAP ;
+: 3DUP    ( a b c -- a b c a b c ) 2 PICK 2 PICK 2 PICK ;
+: WRITE$  ( caddr -- ) COUNT TYPE ;  \ print a counted string
+: ','     ( -- )  ." , "  ;
+: '-'     ( -- )  ." -"   ;
+
+\ day of week calculation
+\ "This is an algorithm I've carried with me for 35 years,
+\  originally in Assembler and Fortran II."
+\  It counts the number of days from March 1, 1900."
+\                                    Wil Baden R.I.P.
+\ *****************************************************
+\ **WARNING** only good until 2078 on 16 bit machine **
+\ *****************************************************
+DECIMAL
+: CDAY    ( dd mm yyyy -- century_day )
+      -3 UNDER+  OVER  0<
+      IF   12 UNDER+  1-   THEN
+      1900 -  1461 4 */   SWAP 306 *  5 +  10 /  + +  ;
+
+: DOW   ( cday -- day_of_week ) 2 + 7 MOD 1+ ; ( 7 is Sunday)
+
+\ formatted number printers
+: ##.   ( n -- )  0 <#  # #      #> TYPE ;
+: ####. ( n -- )  0 <#  # # # #  #> TYPE ;
+
+\ make some string list words
+: LIST[   ( -- ) !CSP  0 C,  ;         \ list starts with 0 bytes, record stack pos.
+: ]LIST   ( -- ) 0 C, ALIGN ?CSP ;     \ '0' ends list, check stack
+
+: NEXT$   ( $[1] -- $[2] )    COUNT + ;               \ get next string
+: NTH$    ( n list -- $addr ) SWAP 0 DO NEXT$ LOOP ;  \ get nth string
+
+: "       ( -- ) [CHAR] " WORD  C@ CHAR+ ALLOT ;      \ compile text upto "
+
+\ make the lists
+CREATE MONTHS
+  LIST[ " January" " February"  " March"   " April" " May" " June" " July"
+        " August"  " September" " October" " November" " December" ]LIST
+
+CREATE DAYS
+  LIST[ " Monday" " Tuesday" " Wednesday"  " Thursday"
+        " Friday" " Saturday" " Sunday" ]LIST
+
+\ expose lists as indexable arrays that print the string
+: ]MONTH$.  ( n -- )  MONTHS NTH$ WRITE$ ;
+: ]DAY$.    ( n -- )  DAYS NTH$ WRITE$ ;
+
+
+\ ===========================================
+\ Rosetta Task Code Begins
+
+\ Rosetta Date Format 1
+: Y-M-D.     ( d m y -- )  ####. '-' ##. '-' ##. ;
+
+\ Rosetta Date Format 2
+: LONG.DATE ( d m y -- )
+    3DUP CDAY DOW ]DAY$. ',' -ROT ]MONTH$. SPACE ##.  ','  ####.  ;

Task/Date-format/Forth/date-format-3.fth

@@ -0,0 +1,3 @@
+ 5 7 2018 Y-M-D. 2018-07-05 ok
+  ok
+5 7 2018 LONG.DATE Thursday, July 05, 2018 ok