1 ! Copyright (C) 2007, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays colors fonts fry help.markup help.stylesheet
4 io.styles kernel literals math math.ranges models namespaces parser
5 sequences system ui ui.gadgets ui.gadgets.books ui.gadgets.panes
6 ui.gestures ui.pens.gradient ui.pens.solid ;
13 { font-name $ default-sans-serif-font-name }
14 { font-size $[ default-font-size 3 * ] }
19 { wrap-margin $[ default-font-size 92 * ] }
24 { font-name $ default-monospace-font-name }
25 { font-size $[ default-font-size 3 * ] }
30 { page-color T{ rgba f 0.9 0.9 0.9 1 } }
35 { font-name $ default-monospace-font-name }
36 { font-size $[ default-font-size 3 * ] }
37 { foreground T{ rgba f 0.1 0.1 0.4 1 } }
41 H{ { wrap-margin $[ default-font-size 83 * ] } }
45 { table-gap ${ default-font-size 5/6 *
46 default-font-size 10/6 * }
52 : $title ( string -- )
55 { font-name $ default-sans-serif-font-name }
56 { font-size $[ default-font-size 4 * ] }
60 : divider-interior ( -- interior )
62 T{ rgba f 0.25 0.25 0.25 1.0 } <solid>
64 T{ rgba f 0.25 0.25 0.25 1.0 }
65 T{ rgba f 1.0 1.0 1.0 0.0 }
72 divider-interior >>interior
73 ${ default-font-size 67 * default-font-size 5/6 * } >>dim
78 : page-interior ( -- interior )
80 T{ rgba f 0.8 0.8 1.0 1.0 } <solid>
82 T{ rgba f 0.8 0.8 1.0 1.0 }
83 T{ rgba f 0.8 1.0 1.0 1.0 }
87 : page-theme ( gadget -- gadget )
88 page-interior >>interior ;
90 : <page> ( list -- gadget )
93 [ print-element ] with-default-style
95 ] make-pane page-theme ;
97 : $slide ( element -- )
98 unclip $title $divider $list ;
100 TUPLE: slides < book ;
102 : <slides> ( slides -- gadget )
103 0 <model> slides new-book [ <page> add-gadget ] reduce ;
105 : change-page ( book n -- )
106 over control-value + over children>> length rem
107 swap set-control-value ;
109 : next-page ( book -- ) 1 change-page ;
111 : prev-page ( book -- ) -1 change-page ;
113 : strip-tease ( data -- seq )
114 first3 2 over length [a,b] [ head 3array ] with with with map ;
117 parse-definition strip-tease append! ;
120 { T{ button-down } [ request-focus ] }
121 { T{ key-down f f " " } [ next-page ] }
122 { T{ key-down f f "DOWN" } [ next-page ] }
123 { T{ key-down f f "b" } [ prev-page ] }
124 { T{ key-down f f "UP" } [ prev-page ] }
125 { T{ key-down f f "q" } [ close-window ] }
126 { T{ key-down f f "ESC" } [ close-window ] }
127 { T{ key-down f f "f" } [ toggle-fullscreen ] }
130 : slides-window ( slides title -- )
131 '[ _ <slides> _ open-window ] with-ui ;