USING: accessors namespaces kernel sequences arrays urls present farkup combinators classes ; USING: math.parser math.text.english ; USING: io.sockets.secure io.servers ; USING: furnace.actions furnace.boilerplate furnace.utilities furnace.chloe-tags ; USING: calendar calendar.english ; USING: html.forms ; USING: http.server http.server.dispatchers http.server.static ; USING: triangle-beer-league.daysmart ; IN: triangle-beer-league SYMBOLS: key-password key-file dh-file ; ! DTOs TUPLE: game start-time home away summary show-summary? show-times? ; TUPLE: schedule header games ; TUPLE: tbl < dispatcher ; : team-schedule>time-string ( schedule -- str ) [ start>> ] [ end>> ] bi [ timestamp>relative-hh:mm "pm" append ] bi@ 2array " - " join ; : timestamp>day-header ( timestamp -- str ) [ day-of-week day-name ] [ month>> month-name ] [ day>> dup number>string swap ordinal-suffix append ] tri 3array " " join ; : summary>string ( summary -- str ) [ [ away-score>> ] [ home-score>> ] bi 2array " - " join ] [ "" ] if* ; : tbl-game-schedules>tbl-games ( game-schedules -- games ) [ { [ team-schedule>time-string ] [ home>> color>> ] [ away>> color>> ] [ summary>> summary>string ] } cleave dup empty? not dup not game boa ] map ; : tbl-games>schedule ( game-schedules -- schedules ) [ [ first timestamp>day-header ] [ second tbl-game-schedules>tbl-games ] bi schedule boa ] map ; : ( -- action ) { tbl "tbl" } >>template ; : ( -- action ) [ t "show-header?" set-value tbl-game-schedules tbl-games>schedule "schedule" set-value ] >>init { tbl "schedule" } >>template ; : ( -- responder ) tbl new-dispatcher "resource:work/triangle-beer-league" >>default "" add-responder "schedule" add-responder { tbl "tbl-common" } >>template ; : ( -- threaded-server ) f >>secure 8080 >>insecure ; : start-tbl-site ( -- server ) main-responder set-global start-server ; : start-tbl ( -- ) start-tbl-site wait-for-server ; MAIN: start-tbl