├── .gitignore ├── LICENSE ├── README.md ├── app.js ├── bower.json ├── docs ├── README.md ├── app.js ├── index.html └── style.css ├── example ├── LICENSE ├── app.js ├── bower.json ├── index.html ├── src │ └── Main.purs └── style.css ├── index.html ├── src ├── Slides.js ├── Slides.purs └── Slides │ └── Internal │ └── Input.purs └── style.css /.gitignore: -------------------------------------------------------------------------------- 1 | ### PureScript 2 | 3 | .psci 4 | .psci_modules 5 | .pulp-cache 6 | output 7 | .webpack.js 8 | 9 | # Created by https://www.gitignore.io/api/vim,emacs,bower,node,osx 10 | 11 | ### Vim ### 12 | [._]*.s[a-w][a-z] 13 | [._]s[a-w][a-z] 14 | *.un~ 15 | Session.vim 16 | .netrwhist 17 | *~ 18 | 19 | 20 | ### Emacs ### 21 | # -*- mode: gitignore; -*- 22 | *~ 23 | \#*\# 24 | /.emacs.desktop 25 | /.emacs.desktop.lock 26 | *.elc 27 | auto-save-list 28 | tramp 29 | .\#* 30 | 31 | # Org-mode 32 | .org-id-locations 33 | *_archive 34 | 35 | # flymake-mode 36 | *_flymake.* 37 | 38 | # eshell files 39 | /eshell/history 40 | /eshell/lastdir 41 | 42 | # elpa packages 43 | /elpa/ 44 | 45 | # reftex files 46 | *.rel 47 | 48 | # AUCTeX auto folder 49 | /auto/ 50 | 51 | # cask packages 52 | .cask/ 53 | 54 | 55 | ### Bower ### 56 | bower_components 57 | .bower-cache 58 | .bower-registry 59 | .bower-tmp 60 | 61 | 62 | ### Node ### 63 | # Logs 64 | logs 65 | *.log 66 | npm-debug.log* 67 | 68 | # Runtime data 69 | pids 70 | *.pid 71 | *.seed 72 | 73 | # Directory for instrumented libs generated by jscoverage/JSCover 74 | lib-cov 75 | 76 | # Coverage directory used by tools like istanbul 77 | coverage 78 | 79 | # Grunt intermediate storage (http://gruntjs.com/creating-plugins#storing-task-files) 80 | .grunt 81 | 82 | # node-waf configuration 83 | .lock-wscript 84 | 85 | # Compiled binary addons (http://nodejs.org/api/addons.html) 86 | build/Release 87 | 88 | # Dependency directory 89 | # https://docs.npmjs.com/misc/faq#should-i-check-my-node-modules-folder-into-git 90 | node_modules 91 | 92 | # Optional npm cache directory 93 | .npm 94 | 95 | # Optional REPL history 96 | .node_repl_history 97 | 98 | 99 | 100 | # Created by https://www.gitignore.io/api/osx 101 | 102 | ### OSX ### 103 | .DS_Store 104 | .AppleDouble 105 | .LSOverride 106 | 107 | # Icon must end with two \r 108 | Icon 109 | 110 | 111 | # Thumbnails 112 | ._* 113 | 114 | # Files that might appear in the root of a volume 115 | .DocumentRevisions-V100 116 | .fseventsd 117 | .Spotlight-V100 118 | .TemporaryItems 119 | .Trashes 120 | .VolumeIcon.icns 121 | 122 | # Directories potentially created on remote AFP share 123 | .AppleDB 124 | .AppleDesktop 125 | Network Trash Folder 126 | Temporary Items 127 | .apdisk 128 | 129 | 130 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Gil Mizrahi 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of [project] nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | purescript-slides on Pursuit 4 | 5 | 6 | 7 | 8 | purescript-slides 9 | ----------------- 10 | 11 | A tiny EDSL for creating slides in PureScript. 12 | 13 | 14 | > - Status: Experimental 15 | > - License: BSD3 16 | > - [Try It!](https://try.purescript.org/?backend=slides) 17 | 18 | - [Module Documentation](https://pursuit.purescript.org/packages/purescript-slides/) 19 | - Example: [Code](example/src/Main.purs), [Demo](https://soupi.github.io/purescript-slides) 20 | 21 | To build the example run the following commands in the folder [example/](example/): 22 | 23 | ```sh 24 | bower install 25 | pulp browserify --to app.js 26 | ``` 27 | 28 | 29 | -------------------------------------------------------------------------------- /app.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | require('Main').main(); 3 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-slides", 3 | "authors": [ 4 | "Gil Mizrahi " 5 | ], 6 | "version": "0.5.0", 7 | "repository": { 8 | "type": "git", 9 | "url": "git://github.com/soupi/purescript-slides" 10 | }, 11 | "license": "BSD-3-Clause", 12 | "ignore": [ 13 | "**/.*", 14 | "node_modules", 15 | "bower_components", 16 | "test", 17 | "tests", 18 | "output" 19 | ], 20 | "dependencies": { 21 | "purescript-prelude": "^3.0.0", 22 | "purescript-list-zipper": "git://github.com/soupi/purescript-list-zipper.git#7c618d0", 23 | "purescript-maybe": "^3.0.0", 24 | "purescript-control": "^3.0.0", 25 | "purescript-foldable-traversable": "^3.0.0", 26 | "purescript-signal": "^9.0.0", 27 | "purescript-smolder": "^7.0.0" 28 | }, 29 | "devDependencies": { 30 | "purescript-psci-support": "*" 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | - View it on [Github-Pages](https://soupi.github.io/purescript-slides) 2 | - Source code on [../example/](../example/) directory. 3 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | purescript-slides 8 | 9 | 10 | 11 |
12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /docs/style.css: -------------------------------------------------------------------------------- 1 | 2 | body { 3 | font-family: 'Helvetica Neue', Verdana, Helvetica, Arial, sans-serif; 4 | margin: 0 auto; 5 | -webkit-font-smoothing: antialiased; 6 | font-size: 2vw; 7 | color: #000; 8 | line-height: 1.5em; 9 | } 10 | 11 | pre { 12 | font-size: 1vw !important; 13 | } 14 | 15 | h1, h2, h3 { 16 | color: #000; 17 | } 18 | h1 { 19 | font-size: 3.5vw; 20 | } 21 | 22 | h2 { 23 | font-size: 3vw; 24 | } 25 | 26 | h3 { 27 | font-size: 1.5em 28 | } 29 | 30 | a { 31 | text-decoration: none; 32 | color: #09f; 33 | } 34 | 35 | a:hover { 36 | text-decoration: underline; 37 | } 38 | 39 | 40 | .flexbox { 41 | margin: 5px; 42 | 43 | display: -webkit-box; 44 | display: -moz-box; 45 | display: -ms-flexbox; 46 | display: -webkit-flex; 47 | display: flex; 48 | 49 | flex-flow: row wrap; 50 | } 51 | 52 | 53 | .slide { 54 | width: 80%; 55 | height: 80%; 56 | margin: auto; 57 | display: flex; 58 | justify-content: space-around; 59 | align-items: center; 60 | } 61 | 62 | .title { 63 | display: inline-block; 64 | text-align: center; 65 | margin: auto; 66 | } 67 | 68 | .marwid { 69 | display: inline-block; 70 | margin: auto; 71 | } 72 | 73 | .rowflex { 74 | display: flex; 75 | flex-flow: row wrap; 76 | } 77 | 78 | .colflex { 79 | display: flex; 80 | flex-flow: column wrap; 81 | } 82 | 83 | .block { 84 | display: block; 85 | } 86 | 87 | .padapp { 88 | padding: 0.2vw; 89 | } 90 | 91 | .counter { 92 | margin: 10px; 93 | font-size: initial; 94 | } 95 | 96 | .center { 97 | display: flex; 98 | margin: auto; 99 | justify-content: center; 100 | } 101 | 102 | 103 | .boldEl { 104 | font-weight: bold !important; 105 | } 106 | .italicEl { 107 | font-style: italic !important; 108 | } 109 | -------------------------------------------------------------------------------- /example/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Gil Mizrahi 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of [project] nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | 30 | -------------------------------------------------------------------------------- /example/app.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | require('Main').main(); 3 | -------------------------------------------------------------------------------- /example/bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-slides-example", 3 | "private": true, 4 | "authors": [ 5 | "Gil Mizrahi " 6 | ], 7 | "license": "BSD-3-Clause", 8 | "version": "0.4.0", 9 | "ignore": [ 10 | "**/.*", 11 | "node_modules", 12 | "bower_components", 13 | "test", 14 | "tests", 15 | "output" 16 | ], 17 | "dependencies": { 18 | "purescript-prelude": "latest", 19 | "purescript-slides": "./.." 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /example/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | purescript-slides 8 | 9 | 10 | 11 |
12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /example/src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude (($), (<>)) 4 | import Slides 5 | 6 | main = runSlides slides 7 | 8 | 9 | slides = mkSlides [s1, s2, s3, s4, s5] 10 | 11 | 12 | s1 = slide "Slides" $ 13 | valign 14 | [ image "https://i.imgur.com/Hm9pTxy.gif" 15 | , title "Let's build a presentation!" 16 | , center $ 17 | text "(In " 18 | <+> link "http://purescript.org" (text "PureScript") 19 | <> text ", Using " 20 | <+> link "https://github.com/soupi/purescript-slides" (text "purescript-slides") 21 | <> text ")" 22 | ] 23 | 24 | s2 = slide "Primitives" $ 25 | valign 26 | [ text "We have the following primitives:" 27 | , ulist 28 | [ code "text" <+> text "- write a block of text" 29 | , code "code" <+> text "- write a block of code" 30 | , code "link" <+> text "- turn an element into a clickable link" 31 | , code "image" <+> text "- display an image from a url" 32 | , code "title" <+> text "- a title" 33 | , code "center" <+> text "- center an element" 34 | , code "bold" <> text "/" <> code "italic" <+> text "-" 35 | <+> bold (text "bold") 36 | <+> text "and" 37 | <+> italic (text "italic") 38 | , code "withClass" <> text "/" <> code "withId" <+> text "- add a class or id to element" 39 | ] 40 | ] 41 | 42 | s3 = slide "Combinators" $ 43 | valign 44 | [ text "To combine elements, we can use the following combinators:" 45 | , center $ ulist 46 | [ code "valign" <+> text "- vertically align elements in a list" 47 | , code "halign" <+> text "- horizontally align elements in a list" 48 | , code "group" <+> text "- group an array of elements" 49 | , code "ulist" <+> text "- create a list of bullets" 50 | ] 51 | ] 52 | 53 | s4 = slide "Creating slides" $ 54 | ulist 55 | [ text "to create a slide, call the" <+> code "slide" <+> text "function with a title string and an element" 56 | , text "to create slides, call the" <+> code "mkSlides" <+> text "function with a list of slides" 57 | , text "to run the slides, call the" <+> code "runSlides" <+> text "function with the slides" 58 | ] 59 | 60 | s5 = slide "That's it!" $ 61 | valign 62 | [ text "This library is still tiny and may grow in the future :)" 63 | , center $ text "Interested? Check the source on" <+> link "https://github.com/soupi/purescript-slides" (text "Github") <> text "!" 64 | ] 65 | 66 | 67 | -------------------------------------------------------------------------------- /example/style.css: -------------------------------------------------------------------------------- 1 | 2 | body { 3 | font-family: 'Helvetica Neue', Verdana, Helvetica, Arial, sans-serif; 4 | margin: 0 auto; 5 | -webkit-font-smoothing: antialiased; 6 | font-size: 2vw; 7 | color: #000; 8 | line-height: 1.5em; 9 | } 10 | 11 | pre { 12 | font-size: 1vw !important; 13 | } 14 | 15 | h1, h2, h3 { 16 | color: #000; 17 | } 18 | h1 { 19 | font-size: 3.5vw; 20 | } 21 | 22 | h2 { 23 | font-size: 3vw; 24 | } 25 | 26 | h3 { 27 | font-size: 1.5em 28 | } 29 | 30 | a { 31 | text-decoration: none; 32 | color: #09f; 33 | } 34 | 35 | a:hover { 36 | text-decoration: underline; 37 | } 38 | 39 | 40 | .flexbox { 41 | margin: 5px; 42 | 43 | display: -webkit-box; 44 | display: -moz-box; 45 | display: -ms-flexbox; 46 | display: -webkit-flex; 47 | display: flex; 48 | 49 | flex-flow: row wrap; 50 | } 51 | 52 | 53 | .slide { 54 | width: 80%; 55 | height: 80%; 56 | margin: auto; 57 | display: flex; 58 | justify-content: space-around; 59 | align-items: center; 60 | } 61 | 62 | .title { 63 | display: inline-block; 64 | text-align: center; 65 | margin: auto; 66 | } 67 | 68 | .marwid { 69 | display: inline-block; 70 | margin: auto; 71 | } 72 | 73 | .rowflex { 74 | display: flex; 75 | flex-flow: row wrap; 76 | } 77 | 78 | .colflex { 79 | display: flex; 80 | flex-flow: column wrap; 81 | } 82 | 83 | .block { 84 | display: block; 85 | } 86 | 87 | .padapp { 88 | padding: 0.2vw; 89 | } 90 | 91 | .counter { 92 | margin: 10px; 93 | font-size: initial; 94 | } 95 | 96 | .center { 97 | display: flex; 98 | margin: auto; 99 | justify-content: center; 100 | } 101 | 102 | 103 | .boldEl { 104 | font-weight: bold !important; 105 | } 106 | .italicEl { 107 | font-style: italic !important; 108 | } 109 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | purescript-slides 8 | 9 | 10 | 11 |
12 | 13 | 14 | 15 | -------------------------------------------------------------------------------- /src/Slides.js: -------------------------------------------------------------------------------- 1 | exports.setHtml = function(html) { 2 | return function() { 3 | document.getElementById("main").outerHTML = html; 4 | } 5 | }; 6 | -------------------------------------------------------------------------------- /src/Slides.purs: -------------------------------------------------------------------------------- 1 | -- | A tiny EDSL for creating presentations 2 | 3 | module Slides 4 | ( runSlides 5 | , runSlidesWithMoves 6 | , mkSlides 7 | , Move(..) 8 | , Slides() 9 | , Slide() 10 | , Element() 11 | , (<+>) 12 | , appendPlus 13 | , slide 14 | , empty 15 | , title 16 | , text 17 | , code 18 | , image 19 | , link 20 | , valign 21 | , halign 22 | , ulist 23 | , group 24 | , center 25 | , withClass 26 | , withId 27 | , bold 28 | , italic 29 | ) where 30 | 31 | import Prelude 32 | import Data.List.Zipper as Z 33 | import Signal (Signal) 34 | import Slides.Internal.Input as I 35 | import Control.Comonad (extract) 36 | import Control.Monad.Eff (Eff) 37 | import DOM (DOM) 38 | import Data.Array ((:), uncons, singleton) 39 | import Data.Foldable (foldMap, fold, foldr) 40 | import Data.Generic (class Generic, gShow, gEq) 41 | import Data.List (List(..), length) 42 | import Data.Maybe (Maybe(..), fromMaybe) 43 | import Signal (foldp, runSignal) as S 44 | import Text.Smolder.HTML (p, div, img, a, h2, ul, li, span, pre) as H 45 | import Text.Smolder.HTML.Attributes (className, id, src, href, target) as H 46 | import Text.Smolder.Markup (Markup, text) as H 47 | import Text.Smolder.Markup ((!)) 48 | import Text.Smolder.Renderer.String (render) as H 49 | 50 | ------------- 51 | -- Running -- 52 | ------------- 53 | 54 | 55 | -- | run a component for a presentation 56 | runSlides :: forall e. Slides -> Eff ( dom :: DOM | e ) Unit 57 | runSlides slides = do 58 | inn <- I.input 59 | runSlidesWithMoves (inputToMove <$> inn) slides 60 | 61 | -- | run a component for a presentation with a custom Move 62 | -- | Signal to determine when the slides should move and to which 63 | -- | Slide. 64 | runSlidesWithMoves :: forall e. Signal Move -> Slides -> Eff ( dom :: DOM | e ) Unit 65 | runSlidesWithMoves move (Slides slides) = do 66 | let ui = S.foldp moveSlides slides move 67 | S.runSignal (setHtml <<< H.render <<< render <$> ui) 68 | 69 | 70 | -- Rendering 71 | 72 | render :: forall a. SlidesInternal -> H.Markup a 73 | render slides = 74 | H.div ! H.id "main" $ do 75 | H.span ! H.className "counter" $ 76 | H.text $ show (position slides + 1) <> " / " <> show (zipLength slides) 77 | renderSlides (extract slides) 78 | 79 | foreign import setHtml :: forall e. String -> Eff ( dom :: DOM | e ) Unit 80 | 81 | -- | Which way should the slides move: 82 | -- | - `Back`: Go back one slide. If at the beginning will do nothing 83 | -- | - `Next`: Go to next slide. If at the end will do nothing 84 | -- | - `Start`: Go to the start 85 | -- | - `End`: Go to the end 86 | -- | - `BackOrEnd`: Like `Back` but will wrap around 87 | -- | - `NextOrEnd`: Like `Next` but will wrap around 88 | data Move 89 | = Back 90 | | Next 91 | | Start 92 | | End 93 | | BackOrEnd 94 | | NextOrStart 95 | | None 96 | 97 | derive instance genericMove :: Generic Move 98 | 99 | instance eqMove :: Eq Move where 100 | eq = gEq 101 | 102 | instance showMove :: Show Move where 103 | show = gShow 104 | 105 | inputToMove :: I.Input -> Move 106 | inputToMove i 107 | | I.clickOrHold (i.arrows.right) = Next 108 | | I.clickOrHold (i.arrows.left) = Back 109 | | I.clickOrHold (i.arrows.down) = Start 110 | | I.clickOrHold (i.arrows.up) = End 111 | | otherwise = None 112 | 113 | moveSlides :: Move -> SlidesInternal -> SlidesInternal 114 | moveSlides m slides = case m of 115 | NextOrStart -> 116 | fromMaybe (moveSlides Start slides) (Z.up slides) 117 | 118 | BackOrEnd -> 119 | fromMaybe (moveSlides End slides) (Z.up slides) 120 | 121 | Next -> 122 | fromMaybe slides (Z.down slides) 123 | 124 | Back -> 125 | fromMaybe slides (Z.up slides) 126 | 127 | Start -> 128 | Z.beginning slides 129 | 130 | End -> 131 | Z.end slides 132 | 133 | None -> 134 | slides 135 | 136 | 137 | position :: forall a. Z.Zipper a -> Int 138 | position (Z.Zipper b _ _) = length b 139 | 140 | zipLength :: forall a. Z.Zipper a -> Int 141 | zipLength (Z.Zipper b _ a) = 1 + length b + length a 142 | 143 | ----------- 144 | -- Model -- 145 | ----------- 146 | 147 | -- | Slides state for a component 148 | data Slides = Slides SlidesInternal 149 | 150 | type SlidesInternal 151 | = Z.Zipper Slide 152 | 153 | -- | A single slide 154 | data Slide 155 | = Slide Element 156 | 157 | -- | A data type defining the AST 158 | data Element 159 | = Empty 160 | | Title String 161 | | Text String 162 | | Code String 163 | | Image String 164 | | Link String Element 165 | | HAlign (Array Element) 166 | | VAlign (Array Element) 167 | | UList (Array Element) 168 | | Group (Array Element) 169 | | Class String Element 170 | | Id String Element 171 | 172 | derive instance genericElement :: Generic Element 173 | 174 | -- | A Show instance for testing 175 | instance showElement :: Show Element where 176 | show = gShow 177 | 178 | instance semigroupElement :: Semigroup Element where 179 | append e1 e2 = Group [e1, e2] 180 | 181 | -- | Append two elements with some padding in between 182 | appendPlus :: Element -> Element -> Element 183 | appendPlus e1 e2 = e1 <> Class "padapp" Empty <> e2 184 | 185 | -- | Append two elements with some padding in between 186 | infixr 5 appendPlus as <+> 187 | 188 | 189 | ----------- 190 | -- Utils -- 191 | ----------- 192 | 193 | -- | Create slides component from an array of slides 194 | mkSlides :: Array Slide -> Slides 195 | mkSlides sl = case uncons sl of 196 | Just {head, tail} -> 197 | Slides $ Z.Zipper Nil head (foldr Cons Nil tail) 198 | 199 | Nothing -> 200 | Slides $ Z.Zipper Nil empty Nil 201 | 202 | -- | Create a slide from a title and an element 203 | slide :: String -> Element -> Slide 204 | slide ttl el = Slide (valign [title ttl, el]) 205 | 206 | -- | An empty slide 207 | empty :: Slide 208 | empty = Slide Empty 209 | 210 | -- | A title 211 | title :: String -> Element 212 | title ttl = halign [valign [text ""], Title ttl, valign [text ""]] 213 | 214 | -- | Turn an element into a link to url 215 | link :: String -> Element -> Element 216 | link = Link 217 | 218 | -- | A text element 219 | text :: String -> Element 220 | text = Text 221 | 222 | -- | An image element 223 | image :: String -> Element 224 | image = Image 225 | 226 | -- | A
 element
227 | code :: String -> Element
228 | code = Code
229 | 
230 | -- | Group elements as a unit
231 | group :: Array Element -> Element
232 | group = Group
233 | 
234 | -- | Horizontally align elements in array
235 | halign :: Array Element -> Element
236 | halign = HAlign
237 | 
238 | -- | Vertically align elements in array
239 | valign :: Array Element -> Element
240 | valign = VAlign
241 | 
242 | -- | An unordered list of element from an array of elements
243 | ulist :: Array Element -> Element
244 | ulist = UList
245 | 
246 | -- | Add an Html class to an element
247 | withClass :: String -> Element -> Element
248 | withClass = Class
249 | 
250 | -- | Add an Html id to an element
251 | withId :: String -> Element -> Element
252 | withId = Id
253 | 
254 | -- | Position an element at the center of its parent
255 | center :: Element -> Element
256 | center = withClass "center" <<< group <<< singleton
257 | 
258 | -- | Format text with bold in this element
259 | bold :: Element -> Element
260 | bold = withClass "boldEl" <<< group <<< singleton
261 | 
262 | -- | Format text with italic in this element
263 | italic :: Element -> Element
264 | italic = withClass "italicEl" <<< group <<< singleton
265 | 
266 | 
267 | ---------------
268 | -- Rendering --
269 | ---------------
270 | 
271 | renderSlides :: forall a. Slide -> H.Markup a
272 | renderSlides (Slide el) =
273 |   H.div ! H.className "slide" $ renderE el
274 | 
275 | renderE :: forall a. Element -> H.Markup a
276 | renderE element =
277 |   case element of
278 |     Empty ->
279 |       H.span (H.text "")
280 | 
281 |     Title tl ->
282 |       H.span ! H.className "title" $ H.h2 (H.text tl)
283 | 
284 |     Link l el ->
285 |       H.a ! H.href l ! H.target "_top" $ renderE el
286 | 
287 |     Text str ->
288 |       H.p ! H.className "marwid" $ H.text str
289 | 
290 |     Code c ->
291 |       H.pre ! H.className "marwid" $ H.text c
292 | 
293 |     Image url ->
294 |       H.img ! H.className "marwid" ! H.src url
295 | 
296 |     VAlign els ->
297 |       H.span ! H.className "colflex" $ fold $ applyRest block $ map renderE els
298 | 
299 |     HAlign els ->
300 |       H.span ! H.className "rowflex" $ foldMap renderE els
301 | 
302 |     UList els ->
303 |       H.span $ H.ul $ foldMap (H.li <<< renderE) els
304 | 
305 |     Group els ->
306 |       H.span $ foldMap renderE els
307 | 
308 |     Class c e ->
309 |       renderE e ! H.className c
310 | 
311 |     Id i e ->
312 |       renderE e ! H.id i
313 | 
314 | block :: forall a. H.Markup a -> H.Markup a
315 | block = H.span ! H.className "block"
316 | 
317 | applyRest :: forall a. (a -> a) -> Array a -> Array a
318 | applyRest f xs =
319 |   case uncons xs of
320 |     Nothing -> xs
321 |     Just list -> list.head : map f list.tail
322 | 
323 | 


--------------------------------------------------------------------------------
/src/Slides/Internal/Input.purs:
--------------------------------------------------------------------------------
  1 | module Slides.Internal.Input where
  2 | 
  3 | import Prelude
  4 | import Control.Monad.Eff (Eff)
  5 | import DOM (DOM)
  6 | import Data.Int (toNumber)
  7 | import Signal (map2, merge, sampleOn)
  8 | import Signal (Signal, foldp) as S
  9 | import Signal.DOM (Touch, DimensionPair, touch, windowDimensions)
 10 | import Signal.DOM (keyPressed) as S
 11 | 
 12 | input :: forall e. Eff (dom :: DOM | e) (S.Signal Input)
 13 | input = do
 14 |   arrows <- S.foldp updateInput initInput <$> arrowsSignal
 15 |   taps   <- S.foldp simpleUpdateInput initInput <$> tapsSignal
 16 |   pure $ merge arrows taps
 17 | 
 18 | initInput :: Input
 19 | initInput =
 20 |   { arrows:
 21 |       { right: Idle
 22 |       , left: Idle
 23 |       , down: Idle
 24 |       , up: Idle
 25 |       }
 26 |   }
 27 | 
 28 | updateInput :: Arrows Boolean -> Input -> Input
 29 | updateInput arrI state =
 30 |   { arrows: arrFold arrI state.arrows
 31 |   }
 32 | 
 33 | simpleUpdateInput :: Arrows Boolean -> Input -> Input
 34 | simpleUpdateInput arr _ =
 35 |     { arrows: { left: f arr.left, right: f arr.right, down: f arr.down, up: f arr.up } }
 36 |   where f true = Click
 37 |         f false = Idle
 38 | 
 39 | type Input =
 40 |   { arrows :: Arrows BtnAction
 41 |   }
 42 | 
 43 | showInput :: Input -> String
 44 | showInput i = "Input\n  " <> showArrows i.arrows
 45 | 
 46 | 
 47 | type Arrows a =
 48 |   { right :: a
 49 |   , left  :: a
 50 |   , down  :: a
 51 |   , up    :: a
 52 |   }
 53 | 
 54 | data BtnAction
 55 |   = Click
 56 |   | Hold
 57 |   | Idle
 58 |   | Release
 59 | 
 60 | clickOrHold :: BtnAction -> Boolean
 61 | clickOrHold = case _ of
 62 |   Click -> true
 63 |   Hold  -> true
 64 |   _     -> false
 65 | 
 66 | instance showBtnAction :: Show BtnAction where
 67 |   show Idle = "Idle"
 68 |   show Hold = "Hold"
 69 |   show Click = "Click"
 70 |   show Release = "Release"
 71 | 
 72 | instance eqBtnAction :: Eq BtnAction where
 73 |   eq Hold Hold = true
 74 |   eq Click Click = true
 75 |   eq Idle Idle = true
 76 |   eq Release Release = true
 77 |   eq _ _ = false
 78 | 
 79 | 
 80 | showArrows :: forall a. Show a => Arrows a -> String
 81 | showArrows arrows =
 82 |   "Arrows "
 83 |   <> show arrows.left
 84 |   <> " "
 85 |   <> show arrows.down
 86 |   <> " "
 87 |   <> show arrows.up
 88 |   <> " "
 89 |   <> show arrows.right
 90 | 
 91 | arrFold :: Arrows Boolean -> Arrows BtnAction -> Arrows BtnAction
 92 | arrFold inp arrows =
 93 |   { right: btnStateUpdate inp.right arrows.right
 94 |   , left: btnStateUpdate inp.left arrows.left
 95 |   , down: btnStateUpdate inp.down arrows.down
 96 |   , up: btnStateUpdate inp.up arrows.up
 97 |   }
 98 | 
 99 | btnStateUpdate :: Boolean -> BtnAction -> BtnAction
100 | btnStateUpdate false Hold = Release
101 | btnStateUpdate false _    = Idle
102 | btnStateUpdate true  Idle = Click
103 | btnStateUpdate true  _    = Hold
104 | 
105 | arrowsSignal :: forall e. Eff (dom :: DOM | e) (S.Signal (Arrows Boolean))
106 | arrowsSignal = do
107 |   rightArrow <- S.keyPressed rightKeyCode
108 |   leftArrow  <- S.keyPressed leftKeyCode
109 |   downArrow  <- S.keyPressed downKeyCode
110 |   upArrow    <- S.keyPressed upKeyCode
111 |   pure $ { left: _, right: _, down: _, up: _ }
112 |       <$>  leftArrow
113 |       <*>  rightArrow
114 |       <*>  downArrow
115 |       <*>  upArrow
116 | 
117 | leftKeyCode :: Int
118 | leftKeyCode = 37
119 | 
120 | upKeyCode :: Int
121 | upKeyCode = 38
122 | 
123 | rightKeyCode :: Int
124 | rightKeyCode = 39
125 | 
126 | downKeyCode :: Int
127 | downKeyCode = 40
128 | 
129 | tapsSignal :: forall e. Eff (dom :: DOM | e) (S.Signal (Arrows Boolean))
130 | tapsSignal = do
131 |   sig <- sampleOn <$> touch <*> (map2 { t: _, wd: _ } <$> touch <*> windowDimensions)
132 |   pure $ map touchToArrows sig
133 | 
134 | touchToArrows :: { t :: Array Touch, wd :: DimensionPair } -> Arrows Boolean
135 | touchToArrows = case _ of
136 |   { t: [t], wd: wd }
137 |      | toNumber t.screenX / toNumber wd.w < 0.3 -> initArrBool { left = true }
138 |      | toNumber t.screenX / toNumber wd.w > 0.7 -> initArrBool { right = true }
139 |   _ -> initArrBool
140 | 
141 | initArrBool :: Arrows Boolean
142 | initArrBool =
143 |   { left: false
144 |   , right: false
145 |   , up: false
146 |   , down: false
147 |   }
148 | 


--------------------------------------------------------------------------------
/style.css:
--------------------------------------------------------------------------------
  1 | 
  2 | body {
  3 |   font-family: 'Helvetica Neue', Verdana, Helvetica, Arial, sans-serif;
  4 |   margin: 0 auto;
  5 |   -webkit-font-smoothing: antialiased;
  6 |   font-size: 2vw;
  7 |   color: #000;
  8 |   line-height: 1.5em;
  9 | }
 10 | 
 11 | pre {
 12 |   font-size: 1.5vw !important;
 13 |   line-height: 1.2em;
 14 | }
 15 | 
 16 | h1, h2, h3 {
 17 |   color: #000;
 18 | }
 19 | h1 {
 20 |   font-size: 3.5vw;
 21 | }
 22 | 
 23 | h2 {
 24 |   font-size: 3vw;
 25 | }
 26 | 
 27 | h3 {
 28 |   font-size: 1.5em
 29 | }
 30 | 
 31 | a {
 32 |   text-decoration: none;
 33 |   color: #09f;
 34 | }
 35 | 
 36 | a:hover {
 37 |   text-decoration: underline;
 38 | }
 39 | 
 40 | 
 41 | .flexbox {
 42 |   margin: 5px;
 43 | 
 44 |   display: -webkit-box;
 45 |   display: -moz-box;
 46 |   display: -ms-flexbox;
 47 |   display: -webkit-flex;
 48 |   display: flex;
 49 | 
 50 |   flex-flow: row wrap;
 51 | }
 52 | 
 53 | 
 54 | .slide {
 55 |   width: 80%;
 56 |   height: 80%;
 57 |   margin: auto;
 58 |   display: flex;
 59 |   justify-content: space-around;
 60 |   align-items: center;
 61 | }
 62 | 
 63 | .title {
 64 |   display: inline-block;
 65 |   text-align: center;
 66 |   margin: auto;
 67 | }
 68 | 
 69 | .marwid {
 70 |   display: inline-block;
 71 |   margin: auto;
 72 | }
 73 | 
 74 | .rowflex {
 75 |   display: flex;
 76 |   flex-flow: row wrap;
 77 | }
 78 | 
 79 | .colflex {
 80 |   display: flex;
 81 |   flex-flow: column wrap;
 82 | }
 83 | 
 84 | .block {
 85 |   display: block;
 86 | }
 87 | 
 88 | .padapp {
 89 |   padding: 0.2vw;
 90 | }
 91 | 
 92 | .counter {
 93 |   margin: 10px;
 94 |   font-size: initial;
 95 | }
 96 | 
 97 | .center {
 98 |   display: flex;
 99 |   margin: auto;
100 |   justify-content: center;
101 | }
102 | 
103 | 
104 | .boldEl {
105 |   font-weight: bold !important;
106 | }
107 | .italicEl {
108 |   font-style: italic !important;
109 | }
110 | 


--------------------------------------------------------------------------------