! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays ascii assocs calendar calendar.format
-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 namespaces regexp
-sequences sorting.human splitting strings urls wrap.strings ;
+classes.tuple combinators command-line continuations csv
+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 ;
IN: metar
} cleave <station>
] map ;
+: all-stations. ( -- )
+ all-stations standard-table-style [
+ [
+ [
+ tuple-slots [
+ [
+ [
+ dup string? [ "%.2f" sprintf ] unless write
+ ] when*
+ ] with-cell
+ ] each
+ ] with-row
+ ] each
+ ] tabular-output nl ;
+
: find-by-cccc ( cccc -- station )
all-stations swap '[ cccc>> _ = ] find nip ;
dup number?
[ number>string ]
[ glossary ?at drop ] if
- ] map " " join
+ ] map join-words
] map "/" join ;
: parse-timestamp ( str -- str' )
[ 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*
[ drop f ]
} case [
2 group dup [ weather key? ] all?
- [ [ weather at ] map " " join ]
+ [ [ 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* ;
[ [ 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 " " join ;
+ tri* 3array join-words ;
: parse-inches ( str -- str' )
dup [ CHAR: / = ] all? [ drop "unknown" ] [
"sea-level pressure is %s hPa" sprintf ;
: parse-lightning ( str -- str' )
- "LTG" ?head drop 2 group [ lightning at ] map " " join ;
+ "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})?)+/
: parse-recent-weather ( str -- str' )
split-recent-weather
- [ (parse-recent-weather) ] map " " join ;
+ [ (parse-recent-weather) ] map join-words ;
: parse-varying ( str -- str' )
"V" split1 [ string>number ] bi@
} cond ;
: metar-remarks ( report seq -- report )
- [ parse-remark ] map " " join >>remarks ;
+ [ parse-remark ] map join-words >>remarks ;
: <metar-report> ( metar -- report )
[ metar-report new ] dip [ >>raw ] keep
[ @ [ 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 [
{
[ "Temperature" [ temperature>> ] row. ]
[ "Dew point" [ dew-point>> ] row. ]
[ "Altimeter" [ altimeter>> ] row. ]
+ [ "Humidity" [ calc-humidity ] row. ]
[ "Remarks" [ remarks>> ] row. ]
[ "Raw Text" [ raw>> ] row. ]
} cleave
[ 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
[ 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
: <taf-report> ( taf -- report )
[ taf-report new ] dip [ >>raw ] keep
- string-lines [ [ blank? ] trim ] map
+ split-lines [ [ blank? ] trim ] map
rest dup first "TAF" = [ rest ] when
harvest unclip swapd taf-body swap taf-partials ;