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