extra/slides/slides.factor

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