/extra/slides/slides.factor

http://github.com/abeaumont/factor · Factor · 112 lines · 94 code · 16 blank · 2 comment · 0 complexity · b52ae17a1ab396e98c4cc1723529fad6 MD5 · raw file

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