1 ! Copyright (C) 2007, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays hashtables help.markup help.stylesheet io
4 io.styles kernel math models namespaces sequences ui ui.gadgets
5 ui.gadgets.books ui.gadgets.panes ui.gestures ui.pens.gradient
6 parser accessors colors fry ;
13 { font-name "sans-serif" }
24 { font-name "monospace" }
30 { page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
35 { font-name "monospace" }
37 { foreground T{ rgba f 0.1 0.1 0.4 1 } }
41 H{ { wrap-margin 1000 } }
44 H{ { table-gap { 10 20 } } }
48 : $title ( string -- )
49 [ H{ { font-name "sans-serif" } { font-size 48 } } format ] ($block) ;
55 T{ rgba f 0.25 0.25 0.25 1.0 }
56 T{ rgba f 1.0 1.0 1.0 0.0 }
57 } <gradient> >>interior
63 : page-theme ( gadget -- )
64 { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } <gradient>
67 : <page> ( list -- gadget )
70 [ print-element ] with-default-style
75 : $slide ( element -- )
80 TUPLE: slides < book ;
82 : <slides> ( slides -- gadget )
83 0 <model> slides new-book [ <page> add-gadget ] reduce ;
85 : change-page ( book n -- )
86 over control-value + over children>> length rem
87 swap model>> set-model ;
89 : next-page ( book -- ) 1 change-page ;
91 : prev-page ( book -- ) -1 change-page ;
93 : (strip-tease) ( data n -- data )
94 [ first3 ] dip head 3array ;
96 : strip-tease ( data -- seq )
97 dup third length 1 - [
102 parse-definition strip-tease [ parsed ] each ;
105 { T{ button-down } [ request-focus ] }
106 { T{ key-down f f "DOWN" } [ next-page ] }
107 { T{ key-down f f "UP" } [ prev-page ] }
108 { T{ key-down f f "f" } [ dup fullscreen? not set-fullscreen ] }
111 : slides-window ( slides -- )
112 '[ _ <slides> "Slides" open-window ] with-ui ;