2008-07-05 22:29:02 -04:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2017-10-25 14:53:37 -04:00
|
|
|
USING: accessors calendar calendar.format fonts fry grouping
|
|
|
|
kernel math sequences timers threads ui ui.gadgets
|
2009-11-28 19:36:47 -05:00
|
|
|
ui.gadgets.labels ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: lcd
|
|
|
|
|
2009-11-28 19:36:47 -05:00
|
|
|
: lcd-digit ( digit row -- str )
|
|
|
|
[ dup CHAR: : = [ drop 10 ] [ CHAR: 0 - ] if ] dip {
|
2008-01-28 19:13:35 -05:00
|
|
|
" _ _ _ _ _ _ _ _ "
|
|
|
|
" | | | _| _| |_| |_ |_ | |_| |_| * "
|
|
|
|
" |_| | |_ _| | _| |_| | |_| | * "
|
2008-02-26 15:57:37 -05:00
|
|
|
" "
|
2008-08-27 17:24:04 -04:00
|
|
|
} nth 4 <groups> nth ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-11-28 19:36:47 -05:00
|
|
|
: lcd-row ( row digit -- string )
|
|
|
|
'[ _ lcd-digit ] { } map-as concat ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-01-28 19:13:35 -05:00
|
|
|
: lcd ( digit-str -- string )
|
2017-06-01 17:59:35 -04:00
|
|
|
4 <iota> [ lcd-row ] with map "\n" join ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2017-10-25 14:53:37 -04:00
|
|
|
TUPLE: time-display < label timer ;
|
|
|
|
|
|
|
|
: <time-display> ( -- gadget )
|
|
|
|
"99:99:99" lcd time-display new-label
|
|
|
|
monospace-font >>font
|
|
|
|
dup '[ now timestamp>hms lcd _ string<< ]
|
|
|
|
f 1 seconds <timer> >>timer ;
|
|
|
|
|
|
|
|
M: time-display graft*
|
|
|
|
[ timer>> start-timer yield ] [ call-next-method ] bi ;
|
|
|
|
|
|
|
|
M: time-display ungraft*
|
|
|
|
[ timer>> stop-timer ] [ call-next-method ] bi ;
|
2008-02-26 15:57:37 -05:00
|
|
|
|
2010-01-15 19:55:43 -05:00
|
|
|
MAIN-WINDOW: time-window { { title "Time" } }
|
2017-10-25 14:53:37 -04:00
|
|
|
<time-display> >>gadgets ;
|