extra/slides/slides.factor

   1 USING: arrays hashtables help.markup help.stylesheet io
   2 io.styles kernel math models namespaces sequences ui ui.gadgets
   3 ui.gadgets.books ui.gadgets.panes ui.gestures ui.render
   4 parser ;
   5 IN: slides
   6
   7 : stylesheet
   8     H{
   9         { default-span-style
  10             H{
  11                 { font "sans-serif" }
  12                 { font-size 36 }
  13             }
  14         }
  15         { default-block-style
  16             H{
  17                 { wrap-margin 1000 }
  18             }
  19         }
  20         { code-style
  21             H{
  22                 { font "monospace" }
  23                 { font-size 36 }
  24                 { page-color { 0.4 0.4 0.4 0.3 } }
  25             }
  26         }
  27         { snippet-style
  28             H{
  29                 { font "monospace" }
  30                 { font-size 36 }
  31                 { foreground { 0.1 0.1 0.4 1 } }
  32             }
  33         }
  34         { table-content-style
  35             H{ { wrap-margin 800 } }
  36         }
  37         { list-style
  38             H{ { table-gap { 10 20 } } }
  39         }
  40         { bullet "\u0000b7" }
  41     } ;
  42
  43 : $title ( string -- )
  44     [ H{ { font "sans-serif" } { font-size 48 } } format ] ($block) ;
  45
  46 : $divider ( -- )
  47     [
  48         <gadget>
  49         T{ gradient f { { 0.25 0.25 0.25 1.0 } { 1.0 1.0 1.0 0.0 } } }
  50         over set-gadget-interior
  51         { 800 10 } over set-gadget-dim
  52         { 1 0 } over set-gadget-orientation
  53         gadget.
  54     ] ($block) ;
  55
  56 : page-theme ( gadget -- )
  57     T{ gradient f { { 0.8 0.8 1.0 1.0 } { 0.8 1.0 1.0 1.0 } } }
  58     swap set-gadget-interior ;
  59
  60 : <page> ( list -- gadget )
  61     [
  62         stylesheet clone [
  63             [ print-element ] with-default-style
  64         ] bind
  65     ] make-pane
  66     dup page-theme ;
  67
  68 : $slide ( element -- )
  69     unclip $title
  70     $divider
  71     $list ;
  72
  73 TUPLE: slides ;
  74
  75 : <slides> ( slides -- gadget )
  76     [ <page> ] map 0 <model> <book>
  77     slides construct-gadget
  78     [ set-gadget-delegate ] keep ;
  79
  80 : change-page ( book n -- )
  81     over control-value + over gadget-children length rem
  82     swap gadget-model set-model ;
  83
  84 : next-page ( book -- ) 1 change-page ;
  85
  86 : prev-page ( book -- ) -1 change-page ;
  87
  88 : (strip-tease) ( data n -- data )
  89     >r first3 r> head 3array ;
  90
  91 : strip-tease ( data -- seq )
  92     dup third length 1- [
  93         2 + (strip-tease)
  94     ] with map ;
  95
  96 : STRIP-TEASE:
  97     parse-definition strip-tease [ parsed ] each ; parsing
  98
  99 \ slides H{
 100     { T{ key-down f f "DOWN" } [ next-page ] }
 101     { T{ key-down f f "UP" } [ prev-page ] }
 102 } set-gestures
 103
 104 : slides-window ( slides -- )
 105     [ <slides> "Slides" open-window ] with-ui ;
 106
 107 MAIN: slides-window