extra/slides/slides.factor

   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 ;
   7 IN: slides
   8
   9 CONSTANT: 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         ] bind
  72     ] make-pane
  73     dup page-theme ;
  74
  75 : $slide ( element -- )
  76     unclip $title
  77     $divider
  78     $list ;
  79
  80 TUPLE: 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 - [
  98         2 + (strip-tease)
  99     ] with map ;
 100
 101 SYNTAX: 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 ;