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-style
  36             H{
  37                 { table-gap ${ default-font-size 5/6 *
  38                                default-font-size 10/6 * }
  39                 }
  40             }
  41         }
  42     }
  43
  44 : $title ( string -- )
  45     [
  46         H{
  47             { font-name $ default-sans-serif-font-name }
  48             { font-size $[ default-font-size 4 * ] }
  49         } format
  50     ] ($block) ;
  51
  52 : $divider ( -- )
  53     [
  54         <gadget>
  55             {
  56                 T{ rgba f 0.25 0.25 0.25 1.0 }
  57                 T{ rgba f 1.0 1.0 1.0 0.0 }
  58             } <gradient> >>interior
  59             ${ default-font-size 67 * default-font-size 5/6 * } >>dim
  60             { 1 0 } >>orientation
  61         gadget.
  62     ] ($block) ;
  63
  64 : page-theme ( gadget -- gadget )
  65     {
  66         T{ rgba f 0.8 0.8 1.0 1.0 }
  67         T{ rgba f 0.8 1.0 1.0 1.0 }
  68     } <gradient> >>interior ;
  69
  70 : <page> ( list -- gadget )
  71     [
  72         stylesheet clone [
  73             [ print-element ] with-default-style
  74         ] with-variables
  75     ] make-pane page-theme ;
  76
  77 : $slide ( element -- )
  78     unclip $title $divider $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 set-control-value ;
  88
  89 : next-page ( book -- ) 1 change-page ;
  90
  91 : prev-page ( book -- ) -1 change-page ;
  92
  93 : strip-tease ( data -- seq )
  94     first3 2 over length [a..b] [ head 3array ] with with with map ;
  95
  96 SYNTAX: STRIP-TEASE:
  97     parse-definition strip-tease append! ;
  98
  99 \ slides H{
 100     { T{ button-down } [ request-focus ] }
 101     { T{ key-down f f " " } [ next-page ] }
 102     { T{ key-down f f "DOWN" } [ next-page ] }
 103     { T{ key-down f f "b" } [ prev-page ] }
 104     { T{ key-down f f "UP" } [ prev-page ] }
 105     { T{ key-down f f "q" } [ close-window ] }
 106     { T{ key-down f f "ESC" } [ close-window ] }
 107     { T{ key-down f f "f" } [ toggle-fullscreen ] }
 108 } set-gestures
 109
 110 : slides-window ( slides title -- )
 111     '[ _ <slides> _ open-window ] with-ui ;