new files

Task/Ordered-words/Forth/ordered-words.fth

@@ -0,0 +1,44 @@
+include lib/stmstack.4th               \ include string stack library
+
+: check-word                           ( a n -- a n f)
+  2dup bl >r                           \ start off with a space
+  begin
+    dup                                \ when not end of word
+  while
+    over c@ r@ >=                      \ check character
+  while
+    r> drop over c@ >r chop            \ chop character off
+  repeat r> drop nip 0=                \ cleanup and set flag
+;
+
+: open-file                            ( -- h)
+  1 dup argn = abort" Usage: ordered infile"
+  args input open error? abort" Cannot open file"
+  dup use                              \ return and use the handle
+;
+
+: read-file                            ( --)
+  0 >r                                 \ begin with zero length
+  begin
+    refill                             \ EOF detected?
+  while
+    0 parse dup r@ >=                  \ equal or longer string length?
+    if                                 \ check the word and adjust length
+      check-word if r> drop dup >r >s else 2drop then
+    else                               \ if it checks out, put on the stack
+      2drop                            \ otherwise drop the word
+    then
+  repeat r> drop                       \ clean it up
+;
+
+: read-back                            ( --)
+  s> dup >r type cr                    \ longest string is on top of stack
+  begin s> dup r@ >= while type cr repeat
+  2drop r> drop                        \ keep printing until shorter word
+;                                      \ has been found
+
+: ordered                              ( --)
+  open-file s.clear read-file read-back close
+;                                      \ open file, clear the stack, read file
+                                       \ read it back and close the file
+ordered