factor: trim using lists

[factor.git] / extra / slides / slides.factor

diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor
old mode 100755 (executable)
new mode 100644 (file)
index 32ceb3b..e11c208
--- a/extra/slides/slides.factor
+++ b/extra/slides/slides.factor
@@ -1,77 +1,81 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays hashtables help.markup help.stylesheet io
-io.styles kernel math models namespaces sequences ui ui.gadgets
-ui.gadgets.books ui.gadgets.panes ui.gestures ui.pens.gradient
-parser accessors colors fry ;
+USING: accessors arrays colors fonts help.markup help.stylesheet
+io.styles kernel literals math models namespaces parser ranges
+sequences ui ui.gadgets ui.gadgets.books ui.gadgets.panes
+ui.gestures ui.pens.gradient ;
 IN: slides
 
 CONSTANT: stylesheet
     H{
-        { default-span-style
+        { default-style
             H{
-                { font-name "sans-serif" }
-                { font-size 36 }
-            }
-        }
-        { default-block-style
-            H{
-                { wrap-margin 1100 }
+                { font-name $ default-sans-serif-font-name }
+                { font-size $[ default-font-size 3 * ] }
+                { wrap-margin $[ default-font-size 92 * ] }
             }
         }
         { code-style
             H{
-                { font-name "monospace" }
-                { font-size 36 }
+                { font-name $ default-monospace-font-name }
+                { font-size $[ default-font-size 3 * ] }
                 { page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
             }
         }
         { snippet-style
             H{
-                { font-name "monospace" }
-                { font-size 36 }
+                { font-name $ default-monospace-font-name }
+                { font-size $[ default-font-size 3 * ] }
                 { foreground T{ rgba f 0.1 0.1 0.4 1 } }
             }
         }
         { table-content-style
-            H{ { wrap-margin 1000 } }
+            H{ { wrap-margin $[ default-font-size 83 * ] } }
         }
         { list-style
-            H{ { table-gap { 10 20 } } }
+            H{
+                { table-gap ${ default-font-size 5/6 *
+                               default-font-size 10/6 * }
+                }
+            }
         }
     }
 
 : $title ( string -- )
-    [ H{ { font-name "sans-serif" } { font-size 48 } } format ] ($block) ;
+    [
+        H{
+            { font-name $ default-sans-serif-font-name }
+            { font-size $[ default-font-size 4 * ] }
+        } format
+    ] ($block) ;
 
 : $divider ( -- )
     [
         <gadget>
-        {
-            T{ rgba f 0.25 0.25 0.25 1.0 }
-            T{ rgba f 1.0 1.0 1.0 0.0 }
-        } <gradient> >>interior
-        { 800 10 } >>dim
-        { 1 0 } >>orientation
+            {
+                T{ rgba f 0.25 0.25 0.25 1.0 }
+                T{ rgba f 1.0 1.0 1.0 0.0 }
+            } <gradient> >>interior
+            ${ default-font-size 67 * default-font-size 5/6 * } >>dim
+            { 1 0 } >>orientation
         gadget.
     ] ($block) ;
 
-: page-theme ( gadget -- )
-    { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } <gradient>
-    >>interior drop ;
+: page-theme ( gadget -- gadget )
+    {
+        T{ rgba f 0.8 0.8 1.0 1.0 }
+        T{ rgba f 0.8 1.0 1.0 1.0 }
+    } <gradient> >>interior ;
 
 : <page> ( list -- gadget )
     [
         stylesheet clone [
             [ print-element ] with-default-style
-        ] bind
-    ] make-pane
-    dup page-theme ;
+        ] with-variables
+    ] make-pane page-theme ;
 
 : $slide ( element -- )
-    unclip $title
-    $divider
-    $list ;
+    unclip $title $divider $list ;
 
 TUPLE: slides < book ;
 
@@ -80,28 +84,28 @@ TUPLE: slides < book ;
 
 : change-page ( book n -- )
     over control-value + over children>> length rem
-    swap model>> set-model ;
+    swap set-control-value ;
 
 : next-page ( book -- ) 1 change-page ;
 
 : prev-page ( book -- ) -1 change-page ;
 
-: (strip-tease) ( data n -- data )
-    [ first3 ] dip head 3array ;
-
 : strip-tease ( data -- seq )
-    dup third length 1 - [
-        2 + (strip-tease)
-    ] with map ;
+    first3 2 over length [a..b] [ head 3array ] with with with map ;
 
 SYNTAX: STRIP-TEASE:
-    parse-definition strip-tease [ parsed ] each ;
+    parse-definition strip-tease append! ;
 
 \ slides H{
     { T{ button-down } [ request-focus ] }
+    { T{ key-down f f " " } [ next-page ] }
     { T{ key-down f f "DOWN" } [ next-page ] }
+    { T{ key-down f f "b" } [ prev-page ] }
     { T{ key-down f f "UP" } [ prev-page ] }
+    { T{ key-down f f "q" } [ close-window ] }
+    { T{ key-down f f "ESC" } [ close-window ] }
+    { T{ key-down f f "f" } [ toggle-fullscreen ] }
 } set-gestures
 
-: slides-window ( slides -- )
-    '[ _ <slides> "Slides" open-window ] with-ui ;
+: slides-window ( slides title -- )
+    '[ _ <slides> _ open-window ] with-ui ;