]> gitweb.factorcode.org Git - factor.git/blob - extra/lcd/lcd.factor
extra: remove unnecessary yield.
[factor.git] / extra / lcd / lcd.factor
1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors calendar calendar.format fonts fry grouping
4 kernel math sequences timers threads ui ui.gadgets
5 ui.gadgets.labels ;
6 IN: lcd
7
8 : lcd-digit ( digit row -- str )
9     [ dup CHAR: : = [ drop 10 ] [ CHAR: 0 - ] if ] dip {
10         "  _       _  _       _   _   _   _   _      "
11         " | |  |   _| _| |_| |_  |_    | |_| |_|  *  "
12         " |_|  |  |_  _|   |  _| |_|   | |_|   |  *  "
13         "                                            "
14     } nth 4 <groups> nth ;
15
16 : lcd-row ( row digit -- string )
17     '[ _ lcd-digit ] { } map-as concat ;
18
19 : lcd ( digit-str -- string )
20     4 <iota> [ lcd-row ] with map "\n" join ;
21
22 TUPLE: time-display < label timer ;
23
24 : <time-display> ( -- gadget )
25     "99:99:99" lcd time-display new-label
26         monospace-font >>font
27         dup '[ now timestamp>hms lcd _ string<< ]
28         f 1 seconds <timer> >>timer ;
29
30 M: time-display graft*
31     [ timer>> start-timer ] [ call-next-method ] bi ;
32
33 M: time-display ungraft*
34     [ timer>> stop-timer ] [ call-next-method ] bi ;
35
36 MAIN-WINDOW: time-window { { title "Time" } }
37     <time-display> >>gadgets ;