]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/slides/slides.factor
factor: trim using lists
[factor.git] / extra / slides / slides.factor
index ecfc2cf00eec06f7b51aaff685ad954f8797cbb1..e11c208cfb88fd7649eb85077c5465d72e333488 100644 (file)
@@ -1,32 +1,24 @@
 ! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors fonts fry help.markup help.stylesheet
-io.styles kernel literals math math.ranges models namespaces parser
-sequences system ui ui.gadgets ui.gadgets.books ui.gadgets.panes
-ui.gestures ui.pens.gradient ui.pens.solid ;
+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 $ default-sans-serif-font-name }
                 { font-size $[ default-font-size 3 * ] }
-            }
-        }
-        { default-block-style
-            H{
                 { wrap-margin $[ default-font-size 92 * ] }
             }
         }
-        { code-char-style
+        { code-style
             H{
                 { font-name $ default-monospace-font-name }
                 { font-size $[ default-font-size 3 * ] }
-            }
-        }
-        { code-style
-            H{
                 { page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
             }
         }
@@ -57,35 +49,23 @@ CONSTANT: stylesheet
         } format
     ] ($block) ;
 
-: divider-interior ( -- interior )
-    os windows? [
-        T{ rgba f 0.25 0.25 0.25 1.0 } <solid>
-    ] [ {
-            T{ rgba f 0.25 0.25 0.25 1.0 }
-            T{ rgba f 1.0 1.0 1.0 0.0 }
-        } <gradient>
-    ] if ;
-
 : $divider ( -- )
     [
         <gadget>
-            divider-interior >>interior
+            {
+                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-interior ( -- interior )
-    os windows? [
-        T{ rgba f 0.8 0.8 1.0 1.0 } <solid>
-    ] [ {
-            T{ rgba f 0.8 0.8 1.0 1.0 }
-            T{ rgba f 0.8 1.0 1.0 1.0 }
-        } <gradient>
-    ] if ;
-
 : page-theme ( gadget -- gadget )
-    page-interior >>interior ;
+    {
+        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 )
     [
@@ -111,17 +91,21 @@ TUPLE: slides < book ;
 : prev-page ( book -- ) -1 change-page ;
 
 : strip-tease ( data -- seq )
-    first3 2 over length [a,b] [ head 3array ] with with with map ;
+    first3 2 over length [a..b] [ head 3array ] with with with map ;
 
 SYNTAX: STRIP-TEASE:
     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 ;