core: subseq-index? -> subseq-of?

[factor.git] / extra / metar / metar.factor

diff --git a/extra/metar/metar.factor b/extra/metar/metar.factor
index cba09c6bd3d6693a159f6757248baccab6e8b9d9..230081f620c316f695095a8eddfe9a46702e9dc8 100644 (file)
--- a/extra/metar/metar.factor
+++ b/extra/metar/metar.factor
@@ -3,8 +3,8 @@
 
 USING: accessors arrays ascii assocs calendar calendar.format
 classes.tuple combinators command-line continuations csv
-formatting fry grouping http.client io io.encodings.ascii
-io.files io.styles kernel math math.extras math.parser memoize
+formatting grouping http.client io io.encodings.ascii io.files
+io.styles kernel math math.extras math.functions math.parser
 namespaces regexp sequences sorting.human splitting strings urls
 wrap.strings ;
 
@@ -151,7 +151,7 @@ MEMO: glossary ( -- assoc )
             dup number?
             [ number>string ]
             [ glossary ?at drop ] if
-        ] map " " join
+        ] map join-words
     ] map "/" join ;
 
 : parse-timestamp ( str -- str' )
@@ -211,6 +211,7 @@ CONSTANT: compass-directions H{
         [ parse-direction ] dip {
             { [ "KT" ?tail ] [ "knots" ] }
             { [ "MPS" ?tail ] [ "meters per second" ] }
+            [ "knots" ]
         } cond [ "G" split1 ] dip '[ _ parse-speed ] bi@
         [ "%s at %s with gusts to %s " sprintf ]
         [ "%s at %s" sprintf ] if*
@@ -275,13 +276,13 @@ CONSTANT: compass-directions H{
             [ drop f ]
         } case [
             2 group dup [ weather key? ] all?
-            [ [ weather at ] map unwords ]
+            [ [ weather at ] map join-words ]
             [ concat parse-glossary ] if
         ] dip prepend
     ] if ;
 
 : parse-weather ( str -- str' )
-    "VC" over subseq? [ "VC" "" replace t ] [ f ] if
+    dup "VC" subseq-of? [ "VC" "" replace t ] [ f ] if
     [ (parse-weather) ]
     [ [ " in the vicinity" append ] when ] bi* ;
 
@@ -488,7 +489,7 @@ CONSTANT: high-clouds H{
     [ [ f ] [ low-clouds at "low clouds are %s" sprintf ] if-zero ]
     [ [ f ] [ mid-clouds at "middle clouds are %s" sprintf ] if-zero ]
     [ [ f ] [ high-clouds at "high clouds are %s" sprintf ] if-zero ]
-    tri* 3array unwords ;
+    tri* 3array join-words ;
 
 : parse-inches ( str -- str' )
     dup [ CHAR: / = ] all? [ drop "unknown" ] [
@@ -524,7 +525,7 @@ CONSTANT: high-clouds H{
     "sea-level pressure is %s hPa" sprintf ;
 
 : parse-lightning ( str -- str' )
-    "LTG" ?head drop 2 group [ lightning at ] map unwords ;
+    "LTG" ?head drop 2 group [ lightning at ] map join-words ;
 
 CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/
 
@@ -547,7 +548,7 @@ CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/
 
 : parse-recent-weather ( str -- str' )
     split-recent-weather
-    [ (parse-recent-weather) ] map unwords ;
+    [ (parse-recent-weather) ] map join-words ;
 
 : parse-varying ( str -- str' )
     "V" split1 [ string>number ] bi@
@@ -604,7 +605,7 @@ CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/
     } cond ;
 
 : metar-remarks ( report seq -- report )
-    [ parse-remark ] map unwords >>remarks ;
+    [ parse-remark ] map join-words >>remarks ;
 
 : <metar-report> ( metar -- report )
     [ metar-report new ] dip [ >>raw ] keep
@@ -617,6 +618,13 @@ CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/
         [ @ [ 65 wrap-string write ] when* ] with-cell
     ] with-row ; inline
 
+: calc-humidity ( report -- humidity/f )
+    [ dew-point>> ] [ temperature>> ] bi 2dup and [
+        [ " " split1 drop string>number ] bi@
+        [ [ 17.625 * ] [ 243.04 + ] bi / e^ ] bi@ / 100 *
+        round "%d%%" sprintf
+    ] [ 2drop f ] if ;
+
 : metar-report. ( report -- )
     standard-table-style [
         {
@@ -630,6 +638,7 @@ CONSTANT: re-recent-weather R/ ((\w{2})?[BE]\d{2,4}((\w{2})?[BE]\d{2,4})?)+/
             [ "Temperature" [ temperature>> ] row. ]
             [ "Dew point" [ dew-point>> ] row. ]
             [ "Altimeter" [ altimeter>> ] row. ]
+            [ "Humidity" [ calc-humidity ] row. ]
             [ "Remarks" [ remarks>> ] row. ]
             [ "Raw Text" [ raw>> ] row. ]
         } cleave
@@ -701,7 +710,7 @@ sky-condition raw ;
     [ re-visibility matches? ] find-one
     [ parse-visibility pick visibility<< ] when*
 
-    [ re-rvr matches? ] find-all " " join
+    [ re-rvr matches? ] find-all join-words
     [ parse-rvr ] map ", " join pick rvr<<
 
     [ re-weather matches? ] find-all
@@ -727,7 +736,7 @@ sky-condition raw ;
     [ re-visibility matches? ] find-one
     [ parse-visibility pick visibility<< ] when*
 
-    [ re-rvr matches? ] find-all " " join
+    [ re-rvr matches? ] find-all join-words
     [ parse-rvr ] map ", " join pick rvr<<
 
     [ re-weather matches? ] find-all
@@ -743,7 +752,7 @@ sky-condition raw ;
 
 : <taf-report> ( taf -- report )
     [ taf-report new ] dip [ >>raw ] keep
-    lines [ [ blank? ] trim ] map
+    split-lines [ [ blank? ] trim ] map
     rest dup first "TAF" = [ rest ] when
     harvest unclip swapd taf-body swap taf-partials ;