/extra/slides/slides.factor

  1! Copyright (C) 2007, 2010 Slava Pestov.
  2! See http://factorcode.org/license.txt for BSD license.
  3USING: arrays hashtables help.markup help.stylesheet io
  4io.styles kernel math models namespaces sequences ui ui.gadgets
  5ui.gadgets.books ui.gadgets.panes ui.gestures ui.pens.gradient
  6parser accessors colors fry ;
  7IN: slides
  8
  9CONSTANT: stylesheet
 10    H{
 11        { default-span-style
 12            H{
 13                { font-name "sans-serif" }
 14                { font-size 36 }
 15            }
 16        }
 17        { default-block-style
 18            H{
 19                { wrap-margin 1100 }
 20            }
 21        }
 22        { code-char-style
 23            H{
 24                { font-name "monospace" }
 25                { font-size 36 }
 26            }
 27        }
 28        { code-style
 29            H{
 30                { page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
 31            }
 32        }
 33        { snippet-style
 34            H{
 35                { font-name "monospace" }
 36                { font-size 36 }
 37                { foreground T{ rgba f 0.1 0.1 0.4 1 } }
 38            }
 39        }
 40        { table-content-style
 41            H{ { wrap-margin 1000 } }
 42        }
 43        { list-style
 44            H{ { table-gap { 10 20 } } }
 45        }
 46    }
 47
 48: $title ( string -- )
 49    [ H{ { font-name "sans-serif" } { font-size 48 } } format ] ($block) ;
 50
 51: $divider ( -- )
 52    [
 53        <gadget>
 54        {
 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
 58        { 800 10 } >>dim
 59        { 1 0 } >>orientation
 60        gadget.
 61    ] ($block) ;
 62
 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>
 65    >>interior drop ;
 66
 67: <page> ( list -- gadget )
 68    [
 69        stylesheet clone [
 70            [ print-element ] with-default-style
 71        ] with-variables
 72    ] make-pane
 73    dup page-theme ;
 74
 75: $slide ( element -- )
 76    unclip $title
 77    $divider
 78    $list ;
 79
 80TUPLE: slides < book ;
 81
 82: <slides> ( slides -- gadget )
 83    0 <model> slides new-book [ <page> add-gadget ] reduce ;
 84
 85: change-page ( book n -- )
 86    over control-value + over children>> length rem
 87    swap model>> set-model ;
 88
 89: next-page ( book -- ) 1 change-page ;
 90
 91: prev-page ( book -- ) -1 change-page ;
 92
 93: (strip-tease) ( data n -- data )
 94    [ first3 ] dip head 3array ;
 95
 96: strip-tease ( data -- seq )
 97    dup third length 1 - iota [
 98        2 + (strip-tease)
 99    ] with map ;
100
101SYNTAX: STRIP-TEASE:
102    parse-definition strip-tease [ suffix! ] each ;
103
104\ slides H{
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 ] }
109} set-gestures
110
111: slides-window ( slides -- )
112    '[ _ <slides> "Slides" open-window ] with-ui ;