├── .github └── FUNDING.yml ├── .gitignore ├── .htaccess ├── .travis.yml ├── LICENSE ├── README.md ├── bower.json ├── cli ├── Solver.purs └── cli.purs ├── css └── main.less ├── docs ├── DOMHelper.md ├── Helper.md ├── Levels.md ├── Sortable.md ├── Storage.md ├── Transformer.md ├── Types.md └── Unsafe.md ├── gulpfile.js ├── img ├── cube-composer.png ├── cube-composer.svg ├── favicon-196.png ├── favicon-32.png └── favicon.svg ├── index.html ├── package-lock.json ├── package.json └── src ├── Analytics.js ├── Analytics.purs ├── DOMHelper.js ├── DOMHelper.purs ├── Helper.purs ├── Levels.purs ├── Levels ├── Chapter0.purs ├── Chapter1.purs ├── Chapter2.purs ├── Chapter3.purs ├── Chapter4.purs └── Chapter5.purs ├── ListHelper.purs ├── Main.purs ├── Sortable.js ├── Sortable.purs ├── Storage.js ├── Storage.purs ├── Transformer.purs ├── Types.purs ├── Unsafe.js └── Unsafe.purs /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: sharkdp 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | output 3 | node_modules 4 | bower_components 5 | .psci 6 | .psci_modules 7 | .pulp-cache 8 | -------------------------------------------------------------------------------- /.htaccess: -------------------------------------------------------------------------------- 1 | AddOutputFilterByType DEFLATE text/html 2 | AddOutputFilterByType DEFLATE application/javascript 3 | AddOutputFilterByType DEFLATE text/css 4 | AddOutputFilterByType DEFLATE image/svg+xml 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | sudo: false 3 | node_js: 4 | - stable 5 | install: 6 | - npm install purescript gulp bower -g 7 | - bower install 8 | - npm install 9 | script: 10 | - gulp 11 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015-2016 David Peter 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ![cube composer](https://raw.githubusercontent.com/sharkdp/cube-composer/master/img/cube-composer.png) 2 | 3 | A puzzle game inspired by functional programming, 4 | written in [PureScript](https://github.com/purescript/purescript). 5 | 6 | [**Play it online!**](https://david-peter.de/cube-composer) 7 | 8 | ## Local install 9 | 10 | ```sh 11 | git clone https://github.com/sharkdp/cube-composer.git 12 | cd cube-composer 13 | npm install 14 | bower install 15 | gulp 16 | ``` 17 | If no errors occur, the game can now be played on a browser by opening `index.html`. 18 | 19 | ## Creating new levels 20 | 21 | Levels are grouped into chapters. Each chapter has a dedicated file in the folder [`src/Levels/`](src/Levels/). To create a new chapter, you can copy one of the existing files, bump the chapter number and add it to the `allChapters` list in [`Levels.purs`](src/Levels.purs). Each chapter comes with a specific list of `transformers` (functions). As an example, we look at `map (Yellow ↦ Red)` in `Chapter0.purs`: 22 | ``` purescript 23 | "replaceYbyR" :> { 24 | name: "map {Yellow}↦{Red}", 25 | function: replaceSingle Yellow Red 26 | } 27 | ``` 28 | Here, `replaceYbyR` is an internal ID which is used to identify the transformer, `map {Yellow}↦{Red}` is the displayed name of the transformer (`{x}` will be replaced by a small cube of color `x`) and `replaceSingle Yellow Red` is the implementation of the transformer. The `function` field in the record has to be of type `Transformer`, where 29 | ``` purescript 30 | type Stack = List Cube 31 | type Wall = List Stack 32 | type Transformer = Wall -> Wall 33 | ``` 34 | Consequently, a `Transformer` is a function that transforms a 2D array of cubes (`Wall`). Some basic transformers are given in [`Transformer.purs`](src/Transformer.purs). 35 | 36 | Each level is given by a record like 37 | ``` purescript 38 | "0.2" :-> { 39 | name: "Level title", 40 | help: Just "...", 41 | difficulty: Easy, 42 | initial: [[Yellow, Yellow, Red], [Yellow, Red], ...], 43 | target: [[Red], [Red], [Red], [Red], [Red], [Red]] 44 | } 45 | ``` 46 | where `0.2` is the `Chapter.Level` ID of the level, `name` is the title of the puzzle, `help` is the help text shown in the right panel, difficulty is `Easy`, `Medium` or `Hard` and `initial :: Wall` and `target :: Wall` are the inital and target 2D arrays of cubes. 47 | 48 | To view all levels with all shortest solutions for each (can be useful, among other things, to verify newly introduced levels can be solved as planned – and cannot be solved in another way which undermines their point): 49 | ```sh 50 | gulp prod 51 | node dist/cli.js 52 | ``` 53 | 54 | Please send a pull request if you would like to add your puzzles to the game. 55 | 56 | ## CI status 57 | [![Build Status](https://img.shields.io/travis/sharkdp/cube-composer.svg?style=flat)](https://travis-ci.org/sharkdp/cube-composer) 58 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "cube-composer", 3 | "homepage": "https://github.com/sharkdp/cube-composer", 4 | "authors": [ 5 | "David Peter " 6 | ], 7 | "description": "A puzzle game inspired by functional programming", 8 | "license": "MIT", 9 | "ignore": [ 10 | "**/.*", 11 | "node_modules", 12 | "bower_components" 13 | ], 14 | "dependencies": { 15 | "purescript-arrays": "^4.0.1", 16 | "purescript-console": "^3.0.0", 17 | "purescript-dom": "^4.3.1", 18 | "purescript-enums": "^3.0.0", 19 | "purescript-foldable-traversable": "^3.0.0", 20 | "purescript-integers": "^3.0.0", 21 | "purescript-maps": "^3.0.0", 22 | "purescript-math": "^2.0.0", 23 | "purescript-nullable": "^3.0.0", 24 | "purescript-strings": "^3.1.0", 25 | "purescript-isometric": "^3.0.0", 26 | "Sortable": "^1.10.1" 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /cli/Solver.purs: -------------------------------------------------------------------------------- 1 | module Solver ( 2 | Solution() 3 | , solve 4 | ) where 5 | 6 | import Prelude 7 | import Data.Function (on) 8 | import Data.List (List(..), fromFoldable, filter, snoc, concatMap, length, sortBy, 9 | mapMaybe, takeWhile, (:)) 10 | import Data.StrMap as SM 11 | 12 | import Levels (getChapter, getLevel, getTransformer) 13 | import Transformer (transformed) 14 | import Types (LevelId, TransformerId, Wall, Chapter) 15 | 16 | type Solution = List TransformerId 17 | 18 | -- | Takes from a list of lists until the length increases 19 | takeShortest :: forall a. List (List a) -> List (List a) 20 | takeShortest Nil = Nil 21 | takeShortest (Cons x xs) = x : takeWhile (\y -> length y == length x) xs 22 | 23 | -- | Helper function for the solver 24 | solve' :: Chapter -> Wall -> Wall -> List TransformerId -> List TransformerId -> List Solution 25 | solve' ch initial target chain ts = 26 | if final == target 27 | then pure chain 28 | else takeShortest $ sortBy (compare `on` length) 29 | $ concatMap (\t -> solve' ch initial target (chain `snoc` t) (filter (_ /= t) ts)) ts 30 | where final = transformed (mapMaybe (getTransformer ch) chain) initial 31 | 32 | -- | Brute force solver. Returns a list of all shortest solutions, if any exist 33 | solve :: LevelId -> List Solution 34 | solve lid = solve' chapter level.initial level.target Nil (fromFoldable $ SM.keys chapter.transformers) 35 | where level = getLevel lid 36 | chapter = getChapter lid 37 | 38 | -------------------------------------------------------------------------------- /cli/cli.purs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Prelude 4 | import Control.Monad.Eff (Eff) 5 | import Control.Monad.Eff.Console (CONSOLE, log) 6 | import Data.Array as A 7 | import Data.List (List) 8 | import Data.Traversable (for, for_) 9 | 10 | import Types (Cube(..)) 11 | import Solver (solve) 12 | import Levels (levelTitle, getLevel, getChapter, allLevelIds) 13 | 14 | ttyColor :: Cube -> Int 15 | ttyColor Yellow = 0 16 | ttyColor Orange = 1 17 | ttyColor Brown = 2 18 | ttyColor Red = 3 19 | ttyColor Cyan = 4 20 | 21 | showList :: forall a. (Show a) => List a -> String 22 | showList xs = show (A.fromFoldable xs :: Array a) 23 | 24 | showList2 :: forall a. (Show a) => List (List a) -> String 25 | showList2 xss = show ((A.fromFoldable <<< map A.fromFoldable) xss :: Array (Array a)) 26 | 27 | main :: forall eff. Eff (console :: CONSOLE | eff) Unit 28 | main = void do 29 | for allLevelIds $ \lid -> do 30 | let chapter = getChapter lid 31 | level = getLevel lid 32 | solutions = solve lid 33 | 34 | log $ levelTitle lid level 35 | log $ " Initial: " <> showList2 (map (map ttyColor) level.initial) 36 | log $ " Target: " <> showList2 (map (map ttyColor) level.target) 37 | log $ " Solutions: " 38 | for_ solutions $ \sol -> 39 | log $ " " <> showList sol 40 | log "" 41 | -------------------------------------------------------------------------------- /css/main.less: -------------------------------------------------------------------------------- 1 | // Ocean Five palette (http://www.colourlovers.com/palette/1473/Ocean_Five) 2 | @cyan: #00A0B0; 3 | @brown: #6A4A3C; 4 | @red: #CC333F; 5 | @orange: #EB6841; 6 | @yellow: #EDC951; 7 | 8 | @transformerGray: #eee; 9 | @borderGray: #ccc; 10 | 11 | // Font 12 | @fontSize: 16px; 13 | @fontSizeSmall: 14px; 14 | @fontSizeLarge: 24px; 15 | 16 | // Dimensions 17 | @width: 800px; 18 | 19 | @canvasWidth: @width; 20 | @canvasHeight: 430px; 21 | 22 | @logoWidth: 216px; 23 | @logoMargin: 10px; 24 | 25 | @panelWidth: 200px; 26 | 27 | @boxWidth: 240px; 28 | @boxSpacing: 80px; 29 | @boxHeightMin: 100px; 30 | 31 | @transformerHeight: 30px; 32 | @transformerSpacing: 7px; 33 | 34 | @cubeSize: 11px; 35 | 36 | html, body { 37 | margin: 0; 38 | padding: 0; 39 | } 40 | 41 | body, select { 42 | font-family: 'Roboto Condensed', sans; 43 | font-weight: 400; 44 | font-size: @fontSize; 45 | } 46 | 47 | .bold() { 48 | font-weight: 700; 49 | } 50 | 51 | b { 52 | .bold; 53 | } 54 | 55 | #logo { 56 | position: absolute; 57 | top: @logoMargin; 58 | left: (@width - @logoWidth) / 2; 59 | width: @logoWidth; 60 | } 61 | 62 | #container { 63 | position: relative; 64 | margin: 0 auto; 65 | width: @width; 66 | } 67 | 68 | #canvas { 69 | margin: 0 auto; 70 | width: @canvasWidth; 71 | height: @canvasHeight; 72 | } 73 | 74 | .border() { 75 | border-radius: 5px; 76 | border: 1px solid @borderGray; 77 | } 78 | 79 | #panel { 80 | position: absolute; 81 | width: @panelWidth; 82 | top: 10px; 83 | right: 0px; 84 | 85 | padding: 0px; 86 | } 87 | 88 | #goal { 89 | height: 120px; 90 | width: 100%; 91 | } 92 | 93 | #levels { 94 | width: 100%; 95 | 96 | margin: 4px 0 15px 0; 97 | padding: 3px 0px; 98 | font-size: @fontSize; 99 | background-color: #fff; 100 | 101 | border: 1px solid @borderGray; 102 | border-bottom: 1px solid #aaa; 103 | border-radius: 3px; 104 | outline: none; 105 | } 106 | 107 | #help { 108 | font-size: @fontSizeSmall; 109 | margin-top: 0; 110 | } 111 | 112 | #message { 113 | visibility: hidden; 114 | 115 | position: absolute; 116 | top: 310px; 117 | left: 50px; 118 | 119 | padding: 1px; 120 | 121 | #solved { 122 | font-size: @fontSizeLarge; 123 | .bold; 124 | } 125 | } 126 | 127 | #controls { 128 | overflow: hidden; 129 | } 130 | 131 | .controlBox { 132 | text-align: center; 133 | float: left; 134 | } 135 | 136 | .left { 137 | margin-left: (@width - 2 * @boxWidth - @boxSpacing) / 2; 138 | } 139 | 140 | .right { 141 | margin-left: @boxSpacing; 142 | } 143 | 144 | .sortable { 145 | margin: 0; 146 | 147 | width: @boxWidth; 148 | min-height: @boxHeightMin; 149 | 150 | // always leave space for one more transformer 151 | padding: @transformerSpacing 0 @transformerHeight 0; 152 | 153 | list-style-type: none; 154 | 155 | .border; 156 | } 157 | 158 | #program:empty::after { 159 | content: "Drop functions here"; 160 | font-weight: bold; 161 | color: #ccc; 162 | } 163 | 164 | #available:empty::after { 165 | content: "No functions available"; 166 | font-weight: bold; 167 | color: #ccc; 168 | } 169 | 170 | .transformerStyle() { 171 | background-color: @transformerGray; 172 | border-bottom: 1px solid darken(@transformerGray, 30); 173 | border-radius: 5px; 174 | } 175 | 176 | .transformer { 177 | display: inline-block; 178 | padding: 1px 4px; 179 | margin: 0; 180 | 181 | .transformerStyle; 182 | } 183 | 184 | .sortable li { 185 | width: @boxWidth - 26px; 186 | line-height: 24px; 187 | margin: 0px auto @transformerSpacing auto; 188 | padding: 2px @transformerSpacing 2px @transformerSpacing; 189 | 190 | .transformerStyle; 191 | 192 | cursor: move; 193 | } 194 | 195 | li.sortable-ghost { 196 | opacity: 0.4; 197 | } 198 | 199 | .buttons { 200 | margin: 5px 0; 201 | } 202 | 203 | .button { 204 | cursor: pointer; 205 | 206 | color: #000; 207 | font-size: @fontSizeSmall; 208 | text-decoration: none; 209 | 210 | @bgCol: #f0f0f0; 211 | background-color: @bgCol; 212 | padding: 2px 5px; 213 | 214 | border: 1px solid #666; 215 | border-bottom: 1px solid #000; 216 | border-radius: 3px; 217 | 218 | &:hover { 219 | background-color: darken(@bgCol, 10); 220 | } 221 | } 222 | 223 | p.footer { 224 | margin-top: 30px; 225 | font-size: @fontSizeSmall; 226 | text-align: center; 227 | color: #444; 228 | } 229 | 230 | a { 231 | color: @red; 232 | } 233 | 234 | .cube { 235 | display: inline-block; 236 | vertical-align: middle; 237 | width: @cubeSize; 238 | height: @cubeSize; 239 | margin: 0 1px; 240 | border: 1px solid #444; 241 | border-radius: 3px; 242 | } 243 | 244 | .stack { 245 | // Set this to 0. They would determine the height, otherwise. 246 | font-size: 0; 247 | 248 | // Spacing between the two cubes 249 | line-height: 2px; 250 | 251 | display: inline-block; 252 | vertical-align: middle; 253 | width: @cubeSize + 4px; 254 | 255 | .cube { 256 | width: @cubeSize - 2px; 257 | height: @cubeSize - 2px; 258 | vertical-align: baseline; 259 | } 260 | } 261 | 262 | .X { background-color: #fff; border: 1px dotted #222; } 263 | .Cyan { background-color: @cyan; } 264 | .Brown { background-color: @brown; } 265 | .Red { background-color: @red; } 266 | .Orange { background-color: @orange; } 267 | .Yellow { background-color: @yellow; } 268 | 269 | // 'flash' animation from Animate.css (https://github.com/daneden/animate.css) 270 | .animated { 271 | -webkit-animation-duration: 1s; 272 | animation-duration: 1s; 273 | -webkit-animation-fill-mode: both; 274 | animation-fill-mode: both; 275 | } 276 | 277 | @-webkit-keyframes flash { 278 | 0%, 50%, 100% { 279 | opacity: 1; 280 | } 281 | 282 | 25%, 75% { 283 | opacity: 0; 284 | } 285 | } 286 | 287 | @keyframes flash { 288 | 0%, 50%, 100% { 289 | opacity: 1; 290 | } 291 | 292 | 25%, 75% { 293 | opacity: 0; 294 | } 295 | } 296 | 297 | .flash { 298 | -webkit-animation-name: flash; 299 | animation-name: flash; 300 | } 301 | 302 | #ghstars { 303 | margin-top: 8px; 304 | } 305 | -------------------------------------------------------------------------------- /docs/DOMHelper.md: -------------------------------------------------------------------------------- 1 | ## Module DOMHelper 2 | 3 | #### `getDocument` 4 | 5 | ``` purescript 6 | getDocument :: forall eff. Eff (dom :: DOM | eff) Document 7 | ``` 8 | 9 | #### `getElementById'` 10 | 11 | ``` purescript 12 | getElementById' :: forall eff. String -> Document -> Eff (dom :: DOM | eff) (Maybe Element) 13 | ``` 14 | 15 | #### `withElementById` 16 | 17 | ``` purescript 18 | withElementById :: forall eff. String -> Document -> (Element -> Eff (dom :: DOM | eff) Unit) -> Eff (dom :: DOM | eff) Unit 19 | ``` 20 | 21 | Perform a DOM action with a single element which can be accessed by ID 22 | 23 | #### `children'` 24 | 25 | ``` purescript 26 | children' :: forall eff. Element -> Eff (dom :: DOM | eff) (Array HTMLElement) 27 | ``` 28 | 29 | #### `addEventListener'` 30 | 31 | ``` purescript 32 | addEventListener' :: forall eff. EventType -> (Event -> Eff (dom :: DOM | eff) Unit) -> EventTarget -> Eff (dom :: DOM | eff) Unit 33 | ``` 34 | 35 | #### `unsafeElementToHTMLElement` 36 | 37 | ``` purescript 38 | unsafeElementToHTMLElement :: Element -> HTMLElement 39 | ``` 40 | 41 | #### `unsafeEventToKeyboardEvent` 42 | 43 | ``` purescript 44 | unsafeEventToKeyboardEvent :: Event -> KeyboardEvent 45 | ``` 46 | 47 | #### `unsafeGetAttribute` 48 | 49 | ``` purescript 50 | unsafeGetAttribute :: forall eff. String -> Element -> Eff (dom :: DOM | eff) String 51 | ``` 52 | 53 | #### `getSelectedValue` 54 | 55 | ``` purescript 56 | getSelectedValue :: forall eff. Element -> Eff (dom :: DOM | eff) String 57 | ``` 58 | 59 | #### `setInnerHTML` 60 | 61 | ``` purescript 62 | setInnerHTML :: forall eff. String -> Element -> Eff (dom :: DOM | eff) Unit 63 | ``` 64 | 65 | #### `htmlCollectionToArray` 66 | 67 | ``` purescript 68 | htmlCollectionToArray :: HTMLCollection -> Array HTMLElement 69 | ``` 70 | 71 | #### `keyCode` 72 | 73 | ``` purescript 74 | keyCode :: KeyboardEvent -> Int 75 | ``` 76 | 77 | #### `ctrlKey` 78 | 79 | ``` purescript 80 | ctrlKey :: KeyboardEvent -> Boolean 81 | ``` 82 | 83 | #### `setStyleAttribute` 84 | 85 | ``` purescript 86 | setStyleAttribute :: forall eff. String -> String -> HTMLElement -> Eff (dom :: DOM | eff) Unit 87 | ``` 88 | 89 | #### `classAdd` 90 | 91 | ``` purescript 92 | classAdd :: forall eff. String -> Element -> Eff (dom :: DOM | eff) Unit 93 | ``` 94 | 95 | #### `classRemove` 96 | 97 | ``` purescript 98 | classRemove :: forall eff. String -> Element -> Eff (dom :: DOM | eff) Unit 99 | ``` 100 | 101 | 102 | -------------------------------------------------------------------------------- /docs/Helper.md: -------------------------------------------------------------------------------- 1 | ## Module Helper 2 | 3 | #### `fromArray` 4 | 5 | ``` purescript 6 | fromArray :: forall a. Array (Tuple String a) -> StrMap a 7 | ``` 8 | 9 | Create a StrMap from an Array of (key, value) pairs 10 | 11 | #### `tuple` 12 | 13 | ``` purescript 14 | tuple :: forall a b. a -> b -> Tuple a b 15 | ``` 16 | 17 | Operator to create tuples, especially for creating maps with 18 | `Map.fromList ["key1" :> "value1", "key2" :> "value2"]` 19 | 20 | #### `(:>)` 21 | 22 | ``` purescript 23 | infixl 6 tuple as :> 24 | ``` 25 | 26 | #### `AStack` 27 | 28 | ``` purescript 29 | type AStack = Array Cube 30 | ``` 31 | 32 | Array analogs of the Stack and Wall types 33 | 34 | #### `AWall` 35 | 36 | ``` purescript 37 | type AWall = Array AStack 38 | ``` 39 | 40 | #### `convert` 41 | 42 | ``` purescript 43 | convert :: AWall -> Wall 44 | ``` 45 | 46 | Convert 2D Array to List 47 | 48 | #### `LevelEntry` 49 | 50 | ``` purescript 51 | type LevelEntry = { name :: String, help :: Maybe String, difficulty :: Difficulty, initial :: AWall, target :: AWall } 52 | ``` 53 | 54 | Helper type to create levels from arrays 55 | 56 | #### `level` 57 | 58 | ``` purescript 59 | level :: LevelId -> LevelEntry -> Tuple LevelId Level 60 | ``` 61 | 62 | Helper function to create levels from arrays of cubes (instead of lists) 63 | 64 | #### `(:->)` 65 | 66 | ``` purescript 67 | infixl 6 level as :-> 68 | ``` 69 | 70 | 71 | -------------------------------------------------------------------------------- /docs/Levels.md: -------------------------------------------------------------------------------- 1 | ## Module Levels 2 | 3 | #### `allChapters` 4 | 5 | ``` purescript 6 | allChapters :: List Chapter 7 | ``` 8 | 9 | A simple list of all available chapters 10 | 11 | #### `allLevels` 12 | 13 | ``` purescript 14 | allLevels :: StrMap Level 15 | ``` 16 | 17 | A dictionary of all available levels across the chapters 18 | 19 | #### `allLevelIds` 20 | 21 | ``` purescript 22 | allLevelIds :: List LevelId 23 | ``` 24 | 25 | A list of all level ids across the chapters 26 | 27 | #### `firstLevel` 28 | 29 | ``` purescript 30 | firstLevel :: LevelId 31 | ``` 32 | 33 | ID of the first level 34 | 35 | #### `getLevel` 36 | 37 | ``` purescript 38 | getLevel :: LevelId -> Level 39 | ``` 40 | 41 | Find a given level by its id 42 | 43 | #### `levelTitle` 44 | 45 | ``` purescript 46 | levelTitle :: LevelId -> Level -> String 47 | ``` 48 | 49 | Level id, name and difficulty as a single string 50 | 51 | #### `getChapter` 52 | 53 | ``` purescript 54 | getChapter :: LevelId -> Chapter 55 | ``` 56 | 57 | Get the chapter to which a level belongs 58 | 59 | #### `getTransformerRecord` 60 | 61 | ``` purescript 62 | getTransformerRecord :: Chapter -> TransformerId -> Maybe TransformerRecord 63 | ``` 64 | 65 | Find a specific transformer + metadata by its id 66 | 67 | #### `getTransformer` 68 | 69 | ``` purescript 70 | getTransformer :: Chapter -> TransformerId -> Maybe Transformer 71 | ``` 72 | 73 | Find a specific transformer by its id 74 | 75 | 76 | -------------------------------------------------------------------------------- /docs/Sortable.md: -------------------------------------------------------------------------------- 1 | ## Module Sortable 2 | 3 | #### `installSortable` 4 | 5 | ``` purescript 6 | installSortable :: forall eff. Element -> (Eff (dom :: DOM | eff) Unit) -> Eff (dom :: DOM | eff) Unit 7 | ``` 8 | 9 | Install 'Sortable' on the given DOM element. The second argument is 10 | an event handler that is called if the list is modified. 11 | 12 | 13 | -------------------------------------------------------------------------------- /docs/Storage.md: -------------------------------------------------------------------------------- 1 | ## Module Storage 2 | 3 | #### `STORAGE` 4 | 5 | ``` purescript 6 | data STORAGE :: Effect 7 | ``` 8 | 9 | #### `SaveableGameState` 10 | 11 | ``` purescript 12 | type SaveableGameState = { currentLevel :: LevelId, levelState :: StrMap (Array TransformerId) } 13 | ``` 14 | 15 | #### `toSaveable` 16 | 17 | ``` purescript 18 | toSaveable :: GameState -> SaveableGameState 19 | ``` 20 | 21 | #### `fromSaveable` 22 | 23 | ``` purescript 24 | fromSaveable :: SaveableGameState -> GameState 25 | ``` 26 | 27 | #### `unsafeLoadGameState` 28 | 29 | ``` purescript 30 | unsafeLoadGameState :: forall a eff. (a -> Maybe a) -> (Maybe a) -> Eff (storage :: STORAGE | eff) (Maybe SaveableGameState) 31 | ``` 32 | 33 | Retrieve the current game state from local storage (FFI, needs 'Just' and 'Nothing' as input) 34 | 35 | #### `loadGameState` 36 | 37 | ``` purescript 38 | loadGameState :: forall eff. Eff (storage :: STORAGE | eff) (Maybe GameState) 39 | ``` 40 | 41 | Retrieve game state from local storage 42 | 43 | #### `unsafeSaveGameState` 44 | 45 | ``` purescript 46 | unsafeSaveGameState :: forall eff. SaveableGameState -> Eff (storage :: STORAGE | eff) Unit 47 | ``` 48 | 49 | Store a game state in local storage (unsafe) 50 | 51 | #### `saveGameState` 52 | 53 | ``` purescript 54 | saveGameState :: forall eff. GameState -> Eff (storage :: STORAGE | eff) Unit 55 | ``` 56 | 57 | Store a game state in local storage 58 | 59 | 60 | -------------------------------------------------------------------------------- /docs/Transformer.md: -------------------------------------------------------------------------------- 1 | ## Module Transformer 2 | 3 | #### `map2d` 4 | 5 | ``` purescript 6 | map2d :: (Cube -> Cube) -> Wall -> Wall 7 | ``` 8 | 9 | Map a function over the two dimensional array (= wall) 10 | 11 | #### `reject` 12 | 13 | ``` purescript 14 | reject :: forall a. (a -> Boolean) -> List a -> List a 15 | ``` 16 | 17 | Opposite of filter, reject all values which satisfy the pattern 18 | 19 | #### `allSteps` 20 | 21 | ``` purescript 22 | allSteps :: List Transformer -> Wall -> List Wall 23 | ``` 24 | 25 | Successively apply all transformers to the initial wall and return 26 | all (intermediate) transformation steps 27 | 28 | #### `transformed` 29 | 30 | ``` purescript 31 | transformed :: List Transformer -> Wall -> Wall 32 | ``` 33 | 34 | Return the final step of the transformation chain 35 | 36 | #### `clearEmpty` 37 | 38 | ``` purescript 39 | clearEmpty :: Transformer 40 | ``` 41 | 42 | Remove emtpy stacks 43 | 44 | #### `mapReject` 45 | 46 | ``` purescript 47 | mapReject :: Cube -> Transformer 48 | ``` 49 | 50 | Reject all cubes of a certain color 51 | 52 | #### `mapStack` 53 | 54 | ``` purescript 55 | mapStack :: Cube -> Transformer 56 | ``` 57 | 58 | Stack a single cube on top of each column 59 | 60 | #### `replaceSingle` 61 | 62 | ``` purescript 63 | replaceSingle :: Cube -> Cube -> Transformer 64 | ``` 65 | 66 | Replace all occurences of a certain cube with another 67 | 68 | #### `replaceMultiple` 69 | 70 | ``` purescript 71 | replaceMultiple :: Cube -> List Cube -> Transformer 72 | ``` 73 | 74 | Replace all occurences of a certain cube with a list of new cubes 75 | 76 | 77 | -------------------------------------------------------------------------------- /docs/Types.md: -------------------------------------------------------------------------------- 1 | ## Module Types 2 | 3 | #### `Cube` 4 | 5 | ``` purescript 6 | data Cube 7 | = Cyan 8 | | Brown 9 | | Red 10 | | Orange 11 | | Yellow 12 | ``` 13 | 14 | ##### Instances 15 | ``` purescript 16 | Show Cube 17 | Eq Cube 18 | Ord Cube 19 | Bounded Cube 20 | Enum Cube 21 | BoundedEnum Cube 22 | ``` 23 | 24 | #### `Stack` 25 | 26 | ``` purescript 27 | type Stack = List Cube 28 | ``` 29 | 30 | #### `Wall` 31 | 32 | ``` purescript 33 | type Wall = List Stack 34 | ``` 35 | 36 | #### `Transformer` 37 | 38 | ``` purescript 39 | type Transformer = Wall -> Wall 40 | ``` 41 | 42 | #### `TransformerId` 43 | 44 | ``` purescript 45 | type TransformerId = String 46 | ``` 47 | 48 | #### `TransformerRecord` 49 | 50 | ``` purescript 51 | type TransformerRecord = { name :: String, function :: Transformer } 52 | ``` 53 | 54 | #### `LevelId` 55 | 56 | ``` purescript 57 | type LevelId = String 58 | ``` 59 | 60 | #### `Difficulty` 61 | 62 | ``` purescript 63 | data Difficulty 64 | = Easy 65 | | Medium 66 | | Hard 67 | ``` 68 | 69 | ##### Instances 70 | ``` purescript 71 | Show Difficulty 72 | ``` 73 | 74 | #### `Level` 75 | 76 | ``` purescript 77 | type Level = { name :: String, help :: Maybe String, difficulty :: Difficulty, initial :: Wall, target :: Wall } 78 | ``` 79 | 80 | #### `Chapter` 81 | 82 | ``` purescript 83 | type Chapter = { name :: String, transformers :: StrMap TransformerRecord, levels :: StrMap Level } 84 | ``` 85 | 86 | #### `GameState` 87 | 88 | ``` purescript 89 | type GameState = { currentLevel :: LevelId, levelState :: StrMap (List TransformerId) } 90 | ``` 91 | 92 | 93 | -------------------------------------------------------------------------------- /docs/Unsafe.md: -------------------------------------------------------------------------------- 1 | ## Module Unsafe 2 | 3 | #### `unsafeError` 4 | 5 | ``` purescript 6 | unsafeError :: forall a. String -> a 7 | ``` 8 | 9 | Layman error handling 10 | 11 | 12 | -------------------------------------------------------------------------------- /gulpfile.js: -------------------------------------------------------------------------------- 1 | /* jshint node: true */ 2 | 3 | "use strict"; 4 | 5 | var gulp = require("gulp"); 6 | var purescript = require("gulp-purescript"); 7 | var less = require("gulp-less"); 8 | var uglify = require("gulp-uglify"); 9 | var concat = require("gulp-concat"); 10 | var rimraf = require("rimraf"); 11 | 12 | var sources = [ 13 | "src/**/*.purs", 14 | "bower_components/purescript-*/src/**/*.purs" 15 | ]; 16 | 17 | var foreigns = [ 18 | "src/**/*.js", 19 | "bower_components/purescript-*/src/**/*.js" 20 | ]; 21 | 22 | var sourcesCli = [ 23 | "bower_components/purescript-*/src/**/*.purs", 24 | "src/ListHelper.purs", 25 | "src/Types.purs", 26 | "src/Transformer.purs", 27 | "src/Levels.purs", 28 | "src/Helper.purs", 29 | "src/Unsafe.purs", 30 | "src/Levels/*.purs", 31 | "cli/*.purs" 32 | ]; 33 | 34 | gulp.task("clean-docs", function(cb) { 35 | rimraf("docs", cb); 36 | }); 37 | 38 | gulp.task("clean-dist", function(cb) { 39 | rimraf("dist", cb); 40 | }); 41 | 42 | gulp.task("clean", gulp.series("clean-docs", "clean-dist")); 43 | 44 | gulp.task("psc", function() { 45 | return purescript.compile({ 46 | src: sources, 47 | ffi: foreigns, 48 | output: "output/main" 49 | }); 50 | }); 51 | 52 | gulp.task("bundle", gulp.series("psc", function() { 53 | return purescript.bundle({ 54 | src: "output/main/**/*.js", 55 | output: "dist/main.js", 56 | module: "Main", 57 | main: "Main" 58 | }); 59 | })); 60 | 61 | gulp.task("psc:cli", function() { 62 | return purescript.compile({ 63 | src: sourcesCli, 64 | ffi: foreigns, 65 | output: "output/cli" 66 | }); 67 | }); 68 | 69 | gulp.task("bundle:cli", gulp.series("psc:cli", function() { 70 | return purescript.bundle({ 71 | src: "output/cli/**/*.js", 72 | output: "dist/cli.js", 73 | module: "Main", 74 | main: "Main" 75 | }); 76 | })); 77 | 78 | gulp.task("psci", function () { 79 | return purescript.psci({ 80 | src: sourcesCli, 81 | ffi: foreigns 82 | }) 83 | .pipe(gulp.dest(".")); 84 | }); 85 | 86 | gulp.task("less", function() { 87 | return gulp.src("css/*.less") 88 | .pipe(less({})) 89 | .pipe(gulp.dest("dist")); 90 | }); 91 | 92 | gulp.task("concat", gulp.series("bundle", function() { 93 | return gulp.src([ 94 | "bower_components/Sortable/Sortable.min.js", 95 | "dist/main.js" 96 | ]) 97 | .pipe(concat("main.js")) 98 | .pipe(gulp.dest("dist")); 99 | })); 100 | 101 | gulp.task("compress", gulp.series("concat", function() { 102 | return gulp.src("dist/main.js") 103 | .pipe(uglify()) 104 | .pipe(gulp.dest("dist")); 105 | })); 106 | 107 | gulp.task("docs", gulp.series("clean-docs", function () { 108 | return purescript.docs({ 109 | src: sources, 110 | docgen: { 111 | "DOMHelper": "docs/DOMHelper.md", 112 | "Helper": "docs/Helper.md", 113 | "Levels": "docs/Levels.md", 114 | "Sortable": "docs/Sortable.md", 115 | "Storage": "docs/Storage.md", 116 | "Transformer": "docs/Transformer.md", 117 | "Types": "docs/Types.md", 118 | "Unsafe": "docs/Unsafe.md" 119 | } 120 | }); 121 | })); 122 | 123 | gulp.task("prod", gulp.series("clean", "less", "psci", "bundle:cli", "bundle", "concat", "compress", "docs")); 124 | gulp.task("dev", gulp.series("less", "psci", "bundle", "concat")); 125 | gulp.task("default", gulp.series("less", "psci", "bundle", "concat", "docs")); 126 | -------------------------------------------------------------------------------- /img/cube-composer.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sharkdp/cube-composer/a891ffe5de79b072819da04718820d0452b9a201/img/cube-composer.png -------------------------------------------------------------------------------- /img/cube-composer.svg: -------------------------------------------------------------------------------- 1 | 2 | 13 | 15 | 17 | 18 | 20 | image/svg+xml 21 | 23 | 24 | 25 | 26 | 27 | 30 | 33 | 37 | 41 | 44 | 48 | 52 | 56 | 60 | 61 | 64 | 68 | 72 | 76 | 80 | 84 | 88 | 92 | 96 | 97 | 98 | 99 | 100 | -------------------------------------------------------------------------------- /img/favicon-196.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sharkdp/cube-composer/a891ffe5de79b072819da04718820d0452b9a201/img/favicon-196.png -------------------------------------------------------------------------------- /img/favicon-32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sharkdp/cube-composer/a891ffe5de79b072819da04718820d0452b9a201/img/favicon-32.png -------------------------------------------------------------------------------- /img/favicon.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 19 | 21 | 49 | 56 | 60 | 64 | 65 | 67 | 68 | 70 | image/svg+xml 71 | 73 | 74 | 75 | 76 | 77 | 82 | 85 | 91 | 95 | 100 | 101 | 107 | 111 | 116 | 117 | 118 | 119 | 120 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | cube composer 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
16 | 17 |
18 | Choose level:
19 | 20 | Goal: 21 |
22 |

23 |
24 |
25 | Solved ✓ 26 |
Next level
27 |
28 | 29 |
30 |
31 |
    32 |
    33 |
    34 |
      35 |
      36 | Reset 37 |
      38 |
      39 |
      40 |

      41 | A game by David Peter. Source code on GitHub.
      42 | 43 |

      44 |
      45 | 46 | 47 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "cube-composer", 3 | "description": "A puzzle game inspired by functional programming", 4 | "repository": { 5 | "type": "git", 6 | "url": "https://github.com/sharkdp/cube-composer.git" 7 | }, 8 | "author": "David Peter ", 9 | "license": "MIT", 10 | "homepage": "https://github.com/sharkdp/cube-composer", 11 | "devDependencies": { 12 | "gulp": "^4.0.2", 13 | "gulp-concat": "^2.6.1", 14 | "gulp-less": "^3.5.0", 15 | "gulp-purescript": "^2.0.0", 16 | "gulp-uglify": "^2.1.2", 17 | "purescript": "0.11.6", 18 | "rimraf": "^2.7.1" 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /src/Analytics.js: -------------------------------------------------------------------------------- 1 | exports.analyticsEvent = function(category) { 2 | return function(action) { 3 | return function(label) { 4 | return function() { 5 | ga('send', 'event', category, action, label); 6 | return {}; 7 | }; 8 | }; 9 | }; 10 | }; 11 | -------------------------------------------------------------------------------- /src/Analytics.purs: -------------------------------------------------------------------------------- 1 | module Analytics where 2 | 3 | import Prelude (Unit) 4 | import Control.Monad.Eff (Eff) 5 | import DOM (DOM) 6 | 7 | import Types (LevelId) 8 | 9 | foreign import analyticsEvent :: forall eff. String 10 | -> String 11 | -> String 12 | -> Eff (dom :: DOM | eff) Unit 13 | 14 | analyticsLevelChanged :: forall eff. LevelId -> Eff (dom :: DOM | eff) Unit 15 | analyticsLevelChanged = analyticsEvent "level" "changed" 16 | -------------------------------------------------------------------------------- /src/DOMHelper.js: -------------------------------------------------------------------------------- 1 | exports.getSelectedValue = function (src) { 2 | return function() { 3 | return src.options[src.selectedIndex].value; 4 | }; 5 | }; 6 | 7 | exports.setInnerHTML = function (value) { 8 | return function (element) { 9 | return function () { 10 | element.innerHTML = value; 11 | return {}; 12 | }; 13 | }; 14 | }; 15 | 16 | exports.htmlCollectionToArray = function (collection) { 17 | return Array.prototype.slice.call(collection); 18 | }; 19 | 20 | exports.keyCode = function (ev) { 21 | return ev.keyCode; 22 | }; 23 | 24 | exports.ctrlKey = function (ev) { 25 | return ev.ctrlKey; 26 | }; 27 | 28 | exports.setStyleAttribute = function (name) { 29 | return function (value) { 30 | return function (element) { 31 | return function () { 32 | element.style[name] = value; 33 | return {}; 34 | }; 35 | }; 36 | }; 37 | }; 38 | 39 | 40 | exports.classAdd = function (value) { 41 | return function (element) { 42 | return function () { 43 | element.classList.add(value); 44 | return {}; 45 | }; 46 | }; 47 | }; 48 | 49 | exports.classRemove = function (value) { 50 | return function (element) { 51 | return function () { 52 | element.classList.remove(value); 53 | return {}; 54 | }; 55 | }; 56 | }; 57 | -------------------------------------------------------------------------------- /src/DOMHelper.purs: -------------------------------------------------------------------------------- 1 | module DOMHelper where 2 | 3 | import Prelude 4 | import Control.Monad.Eff (Eff()) 5 | import DOM (DOM()) 6 | import DOM.Event.Types (Event(), EventType(), EventTarget(), KeyboardEvent(), readKeyboardEvent) 7 | import DOM.Event.EventTarget (addEventListener, eventListener) 8 | import DOM.HTML (window) 9 | import DOM.HTML.Types (HTMLElement(), htmlDocumentToDocument, readHTMLElement) 10 | import DOM.HTML.Window (document) 11 | import DOM.Node.Element (getAttribute) 12 | import DOM.Node.NonElementParentNode (getElementById) 13 | import DOM.Node.ParentNode (children) 14 | import DOM.Node.Types (HTMLCollection(), Element(), Document(), ElementId(..), 15 | documentToNonElementParentNode, elementToParentNode) 16 | import Data.Either (fromRight) 17 | import Data.Foreign (toForeign) 18 | import Data.Maybe (Maybe(), maybe, fromJust) 19 | import Partial.Unsafe (unsafePartial) 20 | import Control.Monad.Except (runExcept) 21 | 22 | getDocument :: forall eff. Eff (dom :: DOM | eff) Document 23 | getDocument = window >>= document <#> htmlDocumentToDocument 24 | 25 | getElementById' :: forall eff. String 26 | -> Document 27 | -> Eff (dom :: DOM | eff) (Maybe Element) 28 | getElementById' id doc = do 29 | let docNode = documentToNonElementParentNode doc 30 | getElementById (ElementId id) docNode 31 | 32 | -- | Perform a DOM action with a single element which can be accessed by ID 33 | withElementById :: forall eff. String 34 | -> Document 35 | -> (Element -> Eff (dom :: DOM | eff) Unit) 36 | -> Eff (dom :: DOM | eff) Unit 37 | withElementById id doc action = getElementById' id doc >>= maybe (pure unit) action 38 | 39 | children' :: forall eff. Element -> Eff (dom :: DOM | eff) (Array HTMLElement) 40 | children' el = htmlCollectionToArray <$> children (elementToParentNode el) 41 | 42 | addEventListener' :: forall eff. EventType -> (Event -> Eff (dom :: DOM | eff) Unit) -> EventTarget -> Eff (dom :: DOM | eff) Unit 43 | addEventListener' etype listener target = 44 | addEventListener etype (eventListener listener) true target 45 | 46 | unsafeElementToHTMLElement :: Element -> HTMLElement 47 | unsafeElementToHTMLElement = unsafePartial (fromRight <<< runExcept <<< readHTMLElement <<< toForeign) 48 | 49 | unsafeEventToKeyboardEvent :: Event -> KeyboardEvent 50 | unsafeEventToKeyboardEvent = unsafePartial (fromRight <<< runExcept <<< readKeyboardEvent <<< toForeign) 51 | 52 | unsafeGetAttribute :: forall eff. String -> Element -> Eff (dom :: DOM | eff) String 53 | unsafeGetAttribute key el = unsafePartial fromJust <$> getAttribute key el 54 | 55 | foreign import getSelectedValue :: forall eff. Element 56 | -> Eff (dom :: DOM | eff) String 57 | 58 | foreign import setInnerHTML :: forall eff. String -> Element -> Eff (dom :: DOM | eff) Unit 59 | 60 | foreign import htmlCollectionToArray :: HTMLCollection -> Array HTMLElement 61 | 62 | foreign import keyCode :: KeyboardEvent -> Int 63 | 64 | foreign import ctrlKey :: KeyboardEvent -> Boolean 65 | 66 | foreign import setStyleAttribute :: forall eff. String -> String -> HTMLElement -> Eff (dom :: DOM | eff) Unit 67 | 68 | foreign import classAdd :: forall eff. String -> Element -> Eff (dom :: DOM | eff) Unit 69 | 70 | foreign import classRemove :: forall eff. String -> Element -> Eff (dom :: DOM | eff) Unit 71 | -------------------------------------------------------------------------------- /src/Helper.purs: -------------------------------------------------------------------------------- 1 | module Helper where 2 | 3 | import Prelude 4 | import Data.List (fromFoldable) 5 | import Data.Maybe (Maybe) 6 | import Data.Tuple (Tuple(..)) 7 | import Data.StrMap as SM 8 | 9 | import Types (Level, LevelId, Difficulty, Wall, Cube) 10 | 11 | -- | Create a StrMap from an Array of (key, value) pairs 12 | fromArray :: forall a. Array (Tuple String a) -> SM.StrMap a 13 | fromArray = SM.fromFoldable 14 | 15 | -- | Operator to create tuples, especially for creating maps with 16 | -- | `Map.fromList ["key1" :> "value1", "key2" :> "value2"]` 17 | tuple :: forall a b. a -> b -> Tuple a b 18 | tuple a b = Tuple a b 19 | 20 | infixl 6 tuple as :> 21 | 22 | -- | Array analogs of the Stack and Wall types 23 | type AStack = Array Cube 24 | type AWall = Array AStack 25 | 26 | -- | Convert 2D Array to List 27 | convert :: AWall -> Wall 28 | convert = fromFoldable <<< map fromFoldable 29 | 30 | -- | Helper type to create levels from arrays 31 | type LevelEntry = { 32 | name :: String, 33 | help :: Maybe String, 34 | difficulty :: Difficulty, 35 | initial :: AWall, 36 | target :: AWall 37 | } 38 | 39 | -- | Helper function to create levels from arrays of cubes (instead of lists) 40 | level :: LevelId 41 | -> LevelEntry 42 | -> Tuple LevelId Level 43 | level lid entry = 44 | lid :> { 45 | name: entry.name, 46 | help: entry.help, 47 | difficulty: entry.difficulty, 48 | initial: convert entry.initial, 49 | target: convert entry.target 50 | } 51 | 52 | infixl 6 level as :-> 53 | -------------------------------------------------------------------------------- /src/Levels.purs: -------------------------------------------------------------------------------- 1 | module Levels where 2 | 3 | import Prelude 4 | import Data.List (List(..), head, sort, fromFoldable, (:)) 5 | import Data.Foldable (find) 6 | import Data.Maybe (Maybe(..), fromMaybe) 7 | import Data.StrMap as SM 8 | 9 | import Types (Transformer, TransformerId, Chapter, TransformerRecord, LevelId, Level) 10 | import Unsafe (unsafeError) 11 | 12 | import Levels.Chapter0 (chapter0) 13 | import Levels.Chapter1 (chapter1) 14 | import Levels.Chapter2 (chapter2) 15 | import Levels.Chapter3 (chapter3) 16 | import Levels.Chapter4 (chapter4) 17 | import Levels.Chapter5 (chapter5) 18 | 19 | -- | A simple list of all available chapters 20 | allChapters :: List Chapter 21 | allChapters = chapter0 : chapter1 : chapter2 : chapter3 : chapter4: chapter5 : Nil 22 | 23 | -- | A dictionary of all available levels across the chapters 24 | allLevels :: SM.StrMap Level 25 | allLevels = SM.unions (map _.levels allChapters) 26 | 27 | -- | A list of all level ids across the chapters 28 | allLevelIds :: List LevelId 29 | allLevelIds = allChapters >>= (_.levels >>> SM.keys >>> fromFoldable) >>> sort 30 | 31 | -- | ID of the first level 32 | firstLevel :: LevelId 33 | firstLevel = fromMaybe "" (head allLevelIds) 34 | 35 | -- | Find a given level by its id 36 | getLevel :: LevelId -> Level 37 | getLevel lid = 38 | case (SM.lookup lid allLevels) of 39 | Just level -> level 40 | Nothing -> unsafeError $ "Could not find level " <> show lid 41 | 42 | -- | Level id, name and difficulty as a single string 43 | levelTitle :: LevelId -> Level -> String 44 | levelTitle lid level = lid <> " - " <> level.name <> " (" <> show level.difficulty <> ")" 45 | 46 | -- | Get the chapter to which a level belongs 47 | getChapter :: LevelId -> Chapter 48 | getChapter lid = 49 | case (find hasLevel allChapters) of 50 | Just chapter -> chapter 51 | Nothing -> unsafeError $ "Could not find chapter " <> show lid 52 | where hasLevel ch = SM.member lid ch.levels 53 | 54 | -- | Find a specific transformer + metadata by its id 55 | getTransformerRecord :: Chapter -> TransformerId -> Maybe TransformerRecord 56 | getTransformerRecord chapter tid = SM.lookup tid chapter.transformers 57 | 58 | -- | Find a specific transformer by its id 59 | getTransformer :: Chapter -> TransformerId -> Maybe Transformer 60 | getTransformer ch tid = _.function <$> getTransformerRecord ch tid 61 | -------------------------------------------------------------------------------- /src/Levels/Chapter0.purs: -------------------------------------------------------------------------------- 1 | module Levels.Chapter0 where 2 | 3 | import Prelude 4 | import Data.List (List(..), (:), snoc) 5 | import Data.Maybe (Maybe(..)) 6 | 7 | import Helper (fromArray, (:->), (:>)) 8 | import Transformer (mapReject, replaceMultiple, replaceSingle) 9 | import Types (Chapter, Cube(..), Difficulty(..)) 10 | 11 | chapter0 :: Chapter 12 | chapter0 = { 13 | name: "Introduction", 14 | 15 | transformers: fromArray [ 16 | "replaceYbyR" :> { 17 | name: "map {Yellow}↦{Red}", 18 | function: replaceSingle Yellow Red 19 | }, 20 | "stackY" :> { 21 | name: "map (stack {Yellow})", 22 | function: map (_ `snoc` Yellow) 23 | }, 24 | "replaceYbyYR" :> { 25 | name: "map {Yellow}↦[{Red}{Yellow}]", 26 | function: replaceMultiple Yellow (Yellow : Red : Nil) 27 | }, 28 | "rejectY" :> { 29 | name: "map (reject {Yellow})", 30 | function: mapReject Yellow 31 | } 32 | ], 33 | 34 | levels: fromArray [ 35 | "0.1" :-> { 36 | name: "Transformation", 37 | help: Just """In this game, your goal is to create a sequence of functions which 38 | transforms the colored cubes into the desired pattern (shown above). 39 | To change yellow cubes to red cubes, add the function `replaceYbyR` to your program. 40 | You can do so by clicking on the function or by dragging it to the 41 | program on the right.""", 42 | difficulty: Easy, 43 | initial: [[Yellow, Yellow, Red], [Yellow, Red], [Red], [Red], [Yellow, Red], [Yellow, Yellow, Red]], 44 | target: [[Red, Red, Red], [Red, Red], [Red], [Red], [Red, Red], [Red, Red, Red]] 45 | }, 46 | "0.2" :-> { 47 | name: "Rejection", 48 | help: Just """To remove all cubes of a specified color, use the reject 49 | function.""", 50 | difficulty: Easy, 51 | initial: [[Yellow, Yellow, Red], [Yellow, Red], [Red], [Red], [Yellow, Red], [Yellow, Yellow, Red]], 52 | target: [[Red], [Red], [Red], [Red], [Red], [Red]] 53 | }, 54 | "0.3" :-> { 55 | name: "Composition", 56 | help: Just """Most levels require a combination of two or more functions. Try to 57 | add the functions `stackY` and `rejectY` to your program. Note that 58 | you can change the order of the functions by drag and drop. Try to 59 | understand the effect of `stackY` by observing how the cubes change.""", 60 | difficulty: Easy, 61 | initial: [[Yellow, Yellow, Red], [Yellow, Red], [Red], [Red], [Yellow, Red], [Yellow, Yellow, Red]], 62 | target: [[Red, Yellow], [Red, Yellow], [Red, Yellow], [Red, Yellow], [Red, Yellow], [Red, Yellow]] 63 | }, 64 | "0.4" :-> { 65 | name: "Spanish flag", 66 | help: Just """Try this on your own. You need to compose three 67 | functions.""", 68 | difficulty: Medium, 69 | initial: [[Yellow, Yellow, Red], [Yellow, Red], [Red], [Red], [Yellow, Red], [Yellow, Yellow, Red]], 70 | target: [[Red, Yellow, Red], [Red, Yellow, Red], [Red, Yellow, Red], [Red, Yellow, Red], [Red, Yellow, Red], [Red, Yellow, Red]] 71 | } 72 | ] 73 | } 74 | -------------------------------------------------------------------------------- /src/Levels/Chapter1.purs: -------------------------------------------------------------------------------- 1 | module Levels.Chapter1 where 2 | 3 | import Prelude 4 | import Data.List (List(..), reverse, snoc, filter, (:)) 5 | import Data.Maybe (Maybe(..)) 6 | 7 | import Helper (fromArray, (:->), (:>)) 8 | import ListHelper (contains) 9 | import Transformer (clearEmpty, mapReject, replaceMultiple) 10 | import Types (Chapter, Cube(..), Difficulty(..)) 11 | 12 | chapter1 :: Chapter 13 | chapter1 = { 14 | name: "Chapter 1", 15 | 16 | transformers: fromArray [ 17 | "mapYtoYR" :> { 18 | name: "map {Yellow}↦[{Red}{Yellow}]", 19 | function: replaceMultiple Yellow (Yellow : Red : Nil) 20 | }, 21 | "mapCtoRC" :> { 22 | name: "map {Cyan}↦[{Cyan}{Red}]", 23 | function: replaceMultiple Cyan (Red : Cyan : Nil) 24 | }, 25 | "rejectY" :> { 26 | name: "map (reject {Yellow})", 27 | function: mapReject Yellow 28 | }, 29 | "rejectC" :> { 30 | name: "map (reject {Cyan})", 31 | function: mapReject Cyan 32 | }, 33 | "filterContainsR" :> { 34 | name: "filter (contains {Red})", 35 | function: filter (contains Red) >>> clearEmpty 36 | }, 37 | "stackR" :> { 38 | name: "map (stack {Red})", 39 | function: map (_ `snoc` Red) 40 | }, 41 | "mapReverse" :> { 42 | name: "map reverse", 43 | function: map reverse 44 | } 45 | ], 46 | 47 | levels: fromArray [ 48 | "1.1" :-> { 49 | name: "Mercury", 50 | help: Just """There are some new types of functions in this chapter. We will 51 | introduce them when they are needed. Note that you can always 52 | skip levels and come back later.""", 53 | difficulty: Easy, 54 | initial: [[Red, Red], [Red, Yellow], [Cyan, Yellow], [Cyan, Cyan]], 55 | target: [[Red, Red, Red], [Red, Yellow, Red], [Red, Yellow, Red], [Red, Red, Red]] 56 | }, 57 | "1.2" :-> { 58 | name: "Venus", 59 | help: Just """The function `filterContainsR` removes columns without a red cube.""", 60 | difficulty: Medium, 61 | initial: [[Red, Red], [Red, Yellow], [Cyan, Yellow], [Cyan, Cyan]], 62 | target: [[Red, Red], [Red, Red]] 63 | }, 64 | "1.3" :-> { 65 | name: "Earth", 66 | help: Just """You can flip each column vertically with `mapReverse`.""", 67 | difficulty: Easy, 68 | initial: [[Cyan, Cyan, Yellow], [Cyan, Red], [Cyan, Red], [Cyan, Cyan, Yellow]], 69 | target: [[Red, Cyan, Cyan], [Red, Cyan], [Red, Cyan], [Red, Cyan, Cyan]] 70 | }, 71 | "1.4" :-> { 72 | name: "Mars", 73 | help: Just """In case you were wondering: the level names have a rather deep 74 | philosophical meaning are chosen randomly.""", 75 | difficulty: Medium, 76 | initial: [[Red, Red], [Red, Yellow], [Cyan, Yellow], [Cyan, Cyan]], 77 | target: [[Red, Red], [Red, Red], [Red, Red], [Red, Red]] 78 | } 79 | ] 80 | } 81 | -------------------------------------------------------------------------------- /src/Levels/Chapter2.purs: -------------------------------------------------------------------------------- 1 | module Levels.Chapter2 where 2 | 3 | import Prelude 4 | import Data.List (List(..), (:), concat, span) 5 | import Data.Maybe (Maybe(..)) 6 | 7 | import Helper (fromArray, (:->), (:>)) 8 | import Transformer (mapStack, mapReject, replaceMultiple, replaceSingle) 9 | import Types (Chapter, Transformer, Cube(..), Difficulty(..)) 10 | 11 | -- | concat adjacent lists if they are equal 12 | stackEqualColumns :: Transformer 13 | stackEqualColumns Nil = Nil 14 | stackEqualColumns (Cons s ss) = concat (s:split.init) : stackEqualColumns split.rest 15 | where split = span (_ == s) ss 16 | 17 | chapter2 :: Chapter 18 | chapter2 = { 19 | name: "Chapter 2", 20 | 21 | transformers: fromArray [ 22 | "replaceYbyB" :> { 23 | name: "map {Yellow}↦{Brown}", 24 | function: replaceSingle Yellow Brown 25 | }, 26 | "replaceYbyBY" :> { 27 | name: "map {Yellow}↦[{Yellow}{Brown}]", 28 | function: replaceMultiple Yellow (Brown : Yellow : Nil) 29 | }, 30 | "replaceBbyOO" :> { 31 | name: "map {Brown}↦[{Orange}{Orange}]", 32 | function: replaceMultiple Brown (Orange : Orange : Nil) 33 | }, 34 | "rejectO" :> { 35 | name: "map (reject {Orange})", 36 | function: mapReject Orange 37 | }, 38 | "stackY" :> { 39 | name: "map (stack {Yellow})", 40 | function: mapStack Yellow 41 | }, 42 | "stackEqualColumns" :> { 43 | name: "stackEqualColumns", 44 | function: stackEqualColumns 45 | } 46 | ], 47 | 48 | levels: fromArray [ 49 | "2.1" :-> { 50 | name: "Bricklayer", 51 | help: Just """This chapter introduces a new function `stackEqualColumns`. It 52 | takes adjacent equal columns and stacks them on top of 53 | each other. Try it!""", 54 | difficulty: Easy, 55 | initial: [[Brown], [Orange], [Orange], [Yellow], [Yellow], [Yellow], [Orange], [Orange], [Brown]], 56 | target: [[Brown], [Orange, Orange], [Brown, Brown, Brown], [Orange, Orange], [Brown]] 57 | }, 58 | "2.2" :-> { 59 | name: "Gizeh", 60 | help: Just """You are on your own now...""", 61 | difficulty: Medium, 62 | initial: [[Brown], [Orange], [Orange], [Yellow], [Yellow], [Yellow], [Orange], [Orange], [Brown]], 63 | target: [[Brown, Brown], [Orange, Brown, Orange, Brown], [Brown, Brown, Brown, Brown, Brown, Brown], [Orange, Brown, Orange, Brown], [Brown, Brown]] 64 | }, 65 | "2.3" :-> { 66 | name: "Poseidon", 67 | help: Nothing, 68 | difficulty: Hard, 69 | initial: [[Brown], [Orange], [Orange], [Yellow], [Yellow], [Yellow], [Orange], [Orange], [Brown]], 70 | target: [[Brown, Brown], [Brown], [Brown, Brown, Brown, Brown], [Brown], [Brown, Brown]] 71 | }, 72 | "2.4" :-> { 73 | name: "Bowl", 74 | help: Nothing, 75 | difficulty: Hard, 76 | initial: [[Brown], [Orange], [Orange], [Brown]], 77 | target: [[Orange, Orange, Orange, Orange], [Orange, Orange], [Orange, Orange], [Orange, Orange, Orange, Orange]] 78 | }, 79 | "2.5" :-> { 80 | name: "Stamp", 81 | help: Nothing, 82 | difficulty: Hard, 83 | initial: [[Brown], [Orange], [Orange], [Yellow], [Yellow], [Yellow], [Orange], [Orange], [Brown]], 84 | target: [[Yellow], [Yellow], [Yellow, Yellow, Yellow, Yellow], [Yellow], [Yellow]] 85 | } 86 | ] 87 | } 88 | -------------------------------------------------------------------------------- /src/Levels/Chapter3.purs: -------------------------------------------------------------------------------- 1 | module Levels.Chapter3 where 2 | 3 | import Prelude 4 | import Data.List (List(..), (:), concatMap) 5 | import Data.Maybe (Maybe(..)) 6 | 7 | import Helper (fromArray, (:->), (:>)) 8 | import Transformer (replaceSingle) 9 | import Types (Chapter, Stack, Cube(..), Difficulty(..)) 10 | 11 | cxToX :: Stack -> Stack 12 | cxToX Nil = Nil 13 | cxToX (Cons Cyan (Cons y xs)) = y : cxToX xs 14 | cxToX (Cons x xs) = x : cxToX xs 15 | 16 | ooToC :: Stack -> Stack 17 | ooToC Nil = Nil 18 | ooToC (Cons Orange (Cons Orange xs)) = Cyan : ooToC xs 19 | ooToC (Cons x cs) = x : ooToC cs 20 | 21 | chapter3 :: Chapter 22 | chapter3 = { 23 | name: "Chapter 3", 24 | 25 | transformers: fromArray [ 26 | "mapXtoOX" :> { 27 | name: "map {X}↦[{X}{Orange}]", 28 | function: map (concatMap (\x -> (Orange : x : Nil))) 29 | }, 30 | "mapCXtoX" :> { 31 | name: "map [{X}{Cyan}]↦{X}", 32 | function: map cxToX 33 | }, 34 | "mapOOtoC" :> { 35 | name: "map [{Orange}{Orange}]↦{Cyan}", 36 | function: map ooToC 37 | }, 38 | "mapCtoO" :> { 39 | name: "map {Cyan}↦{Orange}", 40 | function: replaceSingle Cyan Orange 41 | } 42 | ], 43 | 44 | levels: fromArray [ 45 | "3.1" :-> { 46 | name: "Brick", 47 | help: Just """This chapter introduces wildcard cubes: {X}.""", 48 | difficulty: Easy, 49 | initial: [[Cyan, Orange], [Cyan, Cyan, Orange], [Orange, Orange], [Cyan, Cyan, Orange], [Cyan, Orange]], 50 | target: [[Cyan], [Cyan, Orange], [Cyan], [Cyan, Orange], [Cyan]] 51 | }, 52 | "3.2" :-> { 53 | name: "Fort", 54 | help: Nothing, 55 | difficulty: Hard, 56 | initial: [[Cyan, Orange], [Cyan, Cyan, Orange], [Orange, Orange], [Cyan, Cyan, Orange], [Cyan, Orange]], 57 | target: [[Orange, Cyan], [Orange, Orange], [Orange, Cyan], [Orange, Orange], [Orange, Cyan]] 58 | }, 59 | "3.3" :-> { 60 | name: "Castle", 61 | help: Nothing, 62 | difficulty: Medium, 63 | initial: [[Orange], [Orange, Orange], [Orange, Orange, Orange], [Orange, Orange, Orange, Orange], [Orange, Orange, Orange], [Orange, Orange], [Orange]], 64 | target: [[Orange, Orange], [Orange, Cyan], [Orange, Orange], [Orange, Cyan], [Orange, Orange], [Orange, Cyan], [Orange, Orange]] 65 | } 66 | ] 67 | } 68 | -------------------------------------------------------------------------------- /src/Levels/Chapter4.purs: -------------------------------------------------------------------------------- 1 | module Levels.Chapter4 where 2 | 3 | import Data.List (List(..), (:), partition, concat) 4 | import Data.Maybe (Maybe(..)) 5 | 6 | import Helper (fromArray, (:->), (:>)) 7 | import ListHelper (contains) 8 | import Transformer (replaceSingle) 9 | import Types (Chapter, Transformer, Cube(..), Difficulty(..)) 10 | 11 | partitionContains :: Cube -> Transformer 12 | partitionContains cube wall = 13 | let parts = partition (contains cube) wall 14 | in concat (parts.no : parts.yes : Nil) 15 | 16 | chapter4 :: Chapter 17 | chapter4 = { 18 | name: "Chapter 4", 19 | 20 | transformers: fromArray [ 21 | "replaceYbyR" :> { 22 | name: "map {Yellow}↦{Red}", 23 | function: replaceSingle Yellow Red 24 | }, 25 | "replaceRbyC" :> { 26 | name: "map {Red}↦{Cyan}", 27 | function: replaceSingle Red Cyan 28 | }, 29 | "replaceCbyY" :> { 30 | name: "map {Cyan}↦{Yellow}", 31 | function: replaceSingle Cyan Yellow 32 | }, 33 | "partitionContainsC" :> { 34 | name: "partition (contains {Cyan})", 35 | function: partitionContains Cyan 36 | }, 37 | "partitionContainsR" :> { 38 | name: "partition (contains {Red})", 39 | function: partitionContains Red 40 | } 41 | ], 42 | 43 | levels: fromArray [ 44 | "4.1" :-> { 45 | name: "Take sides!", 46 | help: Just """This chapter introduces partitioning. The function `partitionContainsR` reorders the columns 47 | so that the columns which do not contain a red cube are grouped on the left, and the columns 48 | which do are gouped on the right.""", 49 | difficulty: Easy, 50 | initial: [[Cyan, Red], [Cyan, Cyan], [Red, Red], [Cyan, Cyan], [Cyan, Red]], 51 | target: [[Cyan, Cyan], [Cyan, Cyan], [Cyan, Red], [Red, Red], [Cyan, Red]] 52 | }, 53 | "4.2" :-> { 54 | name: "Take sides – again!", 55 | help: Just """Note that within each partition – the columns which don't satisfy the condition and the 56 | columns which do – the order remains the same as it was prior to partitioning.""", 57 | difficulty: Medium, 58 | initial: [[Cyan, Red], [Cyan, Cyan], [Red, Red], [Cyan, Cyan], [Cyan, Red]], 59 | target: [[Cyan, Cyan], [Cyan, Cyan], [Red, Red], [Cyan, Red], [Cyan, Red]] 60 | }, 61 | "4.3" :-> { 62 | name: "Shift", 63 | help: Just "Can you partition this?", 64 | difficulty: Medium, 65 | initial: [[Cyan, Red], [Red, Cyan], [Cyan, Red], [Red, Cyan], [Cyan, Red]], 66 | target: [[Red, Cyan], [Cyan, Red], [Red, Cyan], [Cyan, Red], [Red, Cyan]] 67 | }, 68 | "4.4" :-> { 69 | name: "Robot eyes", 70 | help: Nothing, 71 | difficulty: Medium, 72 | initial: [[Brown, Brown, Brown], [Brown, Yellow, Brown], [Brown, Brown, Brown], [Brown, Yellow, Brown], [Brown, Brown, Brown]], 73 | target: [[Brown, Brown, Brown], [Brown, Brown, Brown], [Brown, Brown, Brown], [Brown, Yellow, Brown], [Brown, Yellow, Brown]] 74 | }, 75 | "4.5" :-> { 76 | name: "Mountains", 77 | help: Nothing, 78 | difficulty: Hard, 79 | initial: [[Brown, Brown, Red, Red], [Brown, Brown, Brown, Cyan], [Brown, Yellow, Yellow, Yellow], [Brown, Brown, Brown, Red], [Brown, Brown, Cyan, Cyan], [Brown, Brown, Yellow, Yellow]], 80 | target: [[Brown, Cyan, Cyan, Cyan], [Brown, Brown, Cyan, Cyan], [Brown, Brown, Cyan, Cyan], [Brown, Brown, Brown, Cyan], [Brown, Brown, Brown, Cyan], [Brown, Brown, Cyan, Cyan]] 81 | } 82 | ] 83 | } 84 | -------------------------------------------------------------------------------- /src/Levels/Chapter5.purs: -------------------------------------------------------------------------------- 1 | module Levels.Chapter5 where 2 | 3 | import Prelude 4 | import Data.Foldable (sum) 5 | import Data.Int (even) 6 | import Data.Int.Bits ((.&.)) 7 | import Data.List (List(..), filter, fromFoldable, (:), zipWith) 8 | import Data.Maybe (Maybe(..)) 9 | 10 | import Helper (AStack, fromArray, (:->), (:>)) 11 | import Types (Chapter, Transformer, Stack, Cube(..), Difficulty(..)) 12 | 13 | toDigit :: Cube -> Int 14 | toDigit Orange = 0 15 | toDigit _ = 1 16 | 17 | toCube :: Int -> Cube 18 | toCube 0 = Orange 19 | toCube _ = Brown 20 | 21 | toInt :: Stack -> Int 22 | toInt w = sum $ zipWith (\f c -> f * toDigit c) (1 : 2 : 4 : Nil) w 23 | 24 | -- | Get the (first three bits of the) binary representation of a number 25 | digits :: Int -> Array Int 26 | digits n = map bit [1, 2, 4] 27 | where bit m = if n .&. m == m then 1 else 0 28 | 29 | toAStack :: Int -> AStack 30 | toAStack num = map toCube (digits num) 31 | 32 | toStack :: Int -> Stack 33 | toStack = fromFoldable <<< toAStack 34 | 35 | mapNumbers :: (Int -> Int) -> Transformer 36 | mapNumbers f = map (toInt >>> f >>> toStack) 37 | 38 | chapter5 :: Chapter 39 | chapter5 = { 40 | name: "Chapter 5", 41 | 42 | transformers: fromArray [ 43 | "mapAdd1" :> { 44 | name: "map (+1)", 45 | function: mapNumbers (_ + 1) 46 | }, 47 | "mapSub1" :> { 48 | name: "map (-1)", 49 | function: mapNumbers (_ - 1) 50 | }, 51 | "mapMul2" :> { 52 | name: "map (×2)", 53 | function: mapNumbers (_ * 2) 54 | }, 55 | "mapPow2" :> { 56 | name: "map (^2)", 57 | function: mapNumbers (\x -> x * x) 58 | }, 59 | "filterEven" :> { 60 | name: "filter even", 61 | function: filter (toInt >>> even) 62 | } 63 | ], 64 | 65 | levels: fromArray [ 66 | "5.1" :-> { 67 | name: "0b0 .. 0b111", 68 | help: Just """What could be the meaning of the title 0b0 .. 0b111? 69 | Read from top to bottom. Calculate modulo eight.""", 70 | difficulty: Medium, 71 | initial: map toAStack [0, 1, 2, 3, 4, 5, 6, 7], 72 | target: map toAStack [1, 3, 5, 7, 1, 3, 5, 7] 73 | }, 74 | "5.2" :-> { 75 | name: "Odd..", 76 | help: Nothing, 77 | difficulty: Easy, 78 | initial: map toAStack [0, 1, 2, 3, 4, 5, 6, 7], 79 | target: map toAStack [1, 3, 5, 7] 80 | }, 81 | "5.3" :-> { 82 | name: "Zero", 83 | help: Nothing, 84 | difficulty: Hard, 85 | initial: map toAStack [0, 1, 2, 3, 4, 5, 6, 7], 86 | target: map toAStack [0, 0, 0, 0, 0, 0, 0, 0] 87 | }, 88 | "5.4" :-> { 89 | name: "Don't panic", 90 | help: Just """This is the last level ... for now. But you can design your own puzzles! 91 | See the GitHub repository 92 | for more information. I hope you enjoyed the game.""", 93 | difficulty: Hard, 94 | initial: map toAStack [0, 1, 2, 3, 4, 5, 6, 7], 95 | target: map toAStack [4, 2, 4, 2, 4, 2, 4, 2] 96 | } 97 | ] 98 | } 99 | -------------------------------------------------------------------------------- /src/ListHelper.purs: -------------------------------------------------------------------------------- 1 | module ListHelper where 2 | 3 | import Prelude 4 | import Data.List (List, elemIndex) 5 | import Data.Maybe (isJust) 6 | 7 | contains :: forall a. (Eq a) => a -> List a -> Boolean 8 | contains x xs = isJust $ elemIndex x xs 9 | -------------------------------------------------------------------------------- /src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main (App(..), main) where 2 | 3 | import Prelude 4 | import Color (rgb, graytone) 5 | import Control.Monad.Eff (Eff) 6 | import Control.Monad.Eff.Console (CONSOLE, log, logShow) 7 | import DOM (DOM) 8 | import DOM.HTML.Event.EventTypes (change, click, keydown) 9 | import DOM.Event.Types (Event()) 10 | import DOM.HTML (window) 11 | import DOM.HTML.Types (windowToEventTarget, htmlElementToEventTarget, htmlElementToElement) 12 | import DOM.Node.Document (createElement) 13 | import DOM.Node.Element (setAttribute) 14 | import DOM.Node.Node (appendChild, setTextContent, parentElement) 15 | import DOM.Node.Types (Element(), elementToNode, elementToEventTarget) 16 | import Data.Array as A 17 | import Data.Enum (enumFromTo) 18 | import Data.Either (fromRight) 19 | import Data.Foldable (foldl, traverse_) 20 | import Data.Int (toNumber) 21 | import Data.List (List(..), fromFoldable, filter, snoc, dropWhile, tail, head, (:), last, mapMaybe, reverse, length) 22 | import Data.Maybe (Maybe(..), fromMaybe, maybe, fromJust) 23 | import Data.Monoid (class Monoid, mempty) 24 | import Data.StrMap as SM 25 | import Data.String.Regex (regex, parseFlags, replace) 26 | import Data.Traversable (traverse) 27 | import Partial.Unsafe (unsafePartial) 28 | import Graphics.Drawing as D 29 | import Graphics.Canvas (CANVAS, getCanvasElementById, getContext2D, clearRect, getCanvasWidth, getCanvasHeight) 30 | import Graphics.Isometric (Scene, Color, scale, renderScene, prism, filled, cube) 31 | 32 | import Analytics (analyticsLevelChanged) 33 | import DOMHelper (addEventListener', withElementById, getElementById', getDocument, unsafeGetAttribute, children', getSelectedValue, setInnerHTML, ctrlKey, keyCode, unsafeEventToKeyboardEvent, unsafeElementToHTMLElement, setStyleAttribute, classRemove, classAdd) 34 | import Levels (firstLevel, levelTitle, getLevel, getChapter, allLevelIds, getTransformer, getTransformerRecord) 35 | import Sortable (installSortable) 36 | import Storage (STORAGE, saveGameState, loadGameState) 37 | import Transformer (allSteps) 38 | import Types (GameState, LevelId, TransformerRecord, Chapter, TransformerId, Wall, Stack, Cube(..)) 39 | 40 | -- | Type synonyms for different combinations of effects 41 | type EffDOM = forall eff. Eff (dom :: DOM | eff) Unit 42 | type App = forall eff. Eff (dom :: DOM, console :: CONSOLE, canvas :: CANVAS, storage :: STORAGE | eff) Unit 43 | 44 | -- | RGB codes for the abstract colors 45 | cubeColor :: Cube -> Color 46 | cubeColor Cyan = rgb 0 160 176 47 | cubeColor Brown = rgb 106 74 60 48 | cubeColor Red = rgb 204 51 63 49 | cubeColor Orange = rgb 235 104 65 50 | cubeColor Yellow = rgb 237 201 81 51 | 52 | -- | Spacing between two walls 53 | spacing :: Number 54 | spacing = 5.5 55 | 56 | -- | Like `foldMap` on `List`, but the function also takes an index parameter 57 | foldMapIndexed :: forall a m. (Monoid m) => (Int -> a -> m) -> List a -> m 58 | foldMapIndexed f xs' = go 0 xs' 59 | where go _ Nil = mempty 60 | go i (Cons x xs) = f i x <> go (i + 1) xs 61 | 62 | -- | Traverse a StrMap while performing monadic side effects 63 | traverseWithKey_ :: forall a m. (Monad m) => (String -> a -> m Unit) -> SM.StrMap a -> m Unit 64 | traverseWithKey_ f sm = SM.foldM (const f) unit sm 65 | 66 | renderCube :: Int -> Int -> Int -> Cube -> Scene 67 | renderCube x y z c = filled (cubeColor c) $ cube point 0.9 68 | where point = { x: toNumber (-x) 69 | , y: spacing * toNumber y 70 | , z: toNumber z } 71 | 72 | -- | Render a single stack of cubes 73 | renderStack :: Int -> Int -> Int -> Stack -> Scene 74 | renderStack len y x stack = foldMapIndexed (renderCube (len - x) y) stack 75 | 76 | -- | Render a wall (multiple stacks) 77 | renderWall :: Int -> Wall -> Scene 78 | renderWall y Nil = 79 | -- Render a gray placeholder for the empty wall 80 | filled gray $ prism { x: -8.0, y: spacing * toNumber y, z: 0.0 } 8.0 0.9 0.1 81 | where gray = graytone 0.4 82 | renderWall y wall = foldMapIndexed (renderStack len y) (reverse wall) 83 | where len = length wall 84 | 85 | -- | Render a series of walls 86 | renderWalls :: List Wall -> Scene 87 | renderWalls walls = foldMapIndexed renderWall walls 88 | 89 | -- | Render the target shape 90 | renderTarget :: Wall -> Scene 91 | renderTarget target = renderWall 0 target 92 | 93 | -- | Get program (list of transformer ids) of the active level 94 | getCurrentIds :: GameState -> (List TransformerId) 95 | getCurrentIds gs = case (SM.lookup gs.currentLevel gs.levelState) of 96 | Just ids -> ids 97 | Nothing -> Nil 98 | 99 | -- | Render all UI components, DOM and canvas 100 | render :: Boolean -> GameState -> App 101 | render setupUI gs = do 102 | doc <- getDocument 103 | canvas <- unsafeFromJust <$> getCanvasElementById "canvas" 104 | ctx <- getContext2D canvas 105 | 106 | w <- getCanvasWidth canvas 107 | h <- getCanvasHeight canvas 108 | 109 | let level = getLevel gs.currentLevel 110 | chapter = getChapter gs.currentLevel 111 | tids = getCurrentIds gs 112 | 113 | -- Set up UI, only if new level is loaded 114 | when setupUI $ do 115 | ulAvailable <- unsafeFromJust <$> getElementById' "available" doc 116 | ulProgram <- unsafeFromJust <$> getElementById' "program" doc 117 | 118 | setInnerHTML "" ulAvailable 119 | setInnerHTML "" ulProgram 120 | 121 | let unused = foldl (flip SM.delete) chapter.transformers tids 122 | insert sm id = case (getTransformerRecord chapter id) of 123 | (Just tr) -> SM.insert id tr sm 124 | Nothing -> sm 125 | active = foldl insert SM.empty tids 126 | 127 | -- create li elements for transformers 128 | traverseWithKey_ (appendTransformerElement ulAvailable) unused 129 | traverseWithKey_ (appendTransformerElement ulProgram) active 130 | 131 | -- set up mouse event handlers 132 | let installClickHandler li = addEventListener' click (clickLi (htmlElementToElement li)) (htmlElementToEventTarget li) 133 | children' ulAvailable >>= traverse_ installClickHandler 134 | children' ulProgram >>= traverse_ installClickHandler 135 | 136 | withElementById "levels" doc $ \selectLevel -> do 137 | setInnerHTML "" selectLevel 138 | traverse_ (appendLevelElement selectLevel gs.currentLevel) allLevelIds 139 | 140 | let transformers = mapMaybe (getTransformer chapter) tids 141 | let steps = allSteps transformers level.initial 142 | 143 | -- On-canvas rendering 144 | let lightPos = { x: -2.0, y: 1.0, z: 3.0 } 145 | _ <- clearRect ctx { x: 0.0, y: 0.0, w, h } 146 | 147 | let renderCanvas x y s scene = D.render ctx $ D.translate x y $ 148 | renderScene lightPos (scale s scene) 149 | renderCanvas 2.0 284.0 49.0 (renderWalls steps) 150 | renderCanvas 1280.0 380.0 35.0 (renderTarget level.target) 151 | 152 | -- DOM 'rendering' 153 | let solved = maybe false (_ == (level.target)) (last steps) 154 | visibility = if solved then "visible" else "hidden" 155 | cssAction = if solved then classAdd "flash" else classRemove "flash" 156 | 157 | withElementById "message" doc (setStyleAttribute "visibility" visibility <<< unsafeElementToHTMLElement) 158 | withElementById "solved" doc cssAction 159 | 160 | let helpHTML = maybe "" (nameToHTML <<< replaceTransformers chapter) level.help 161 | withElementById "help" doc (setInnerHTML helpHTML) 162 | 163 | -- Debug output: 164 | let toArray = A.fromFoldable :: forall a. List a -> Array a 165 | toArrays = toArray <<< map toArray 166 | log $ "Program: " <> show (toArray tids) 167 | log $ "Target: " <> show (toArrays level.target) 168 | log "Steps:" 169 | traverse_ (logShow <<< toArrays) steps 170 | log "" 171 | 172 | -- | Replace all occurences of a pattern in a string with a replacement 173 | replaceAll :: String -> String -> String -> String 174 | replaceAll regexString replacement = replace pattern replacement 175 | where 176 | flags = parseFlags "g" 177 | pattern = unsafePartial $ fromRight (regex regexString flags) 178 | 179 | -- | Replace color placeholders in the transformer description by colored rectangular divs 180 | replaceColors :: String -> String 181 | replaceColors s' = 182 | foldl replaceColor s' ("X" : map show (Cyan `enumFromTo` Yellow)) 183 | where replaceColor s c = replaceAll (pattern c) (replacement c) s 184 | pattern c = "{" <> c <> "}" 185 | replacement c = "
      c <> "\">
      " 186 | 187 | -- | Replace stack markers 188 | replaceStacks :: String -> String 189 | replaceStacks = replaceAll "\\[" """
      """ <<< 190 | replaceAll "\\]" "
      " 191 | 192 | -- | Render a transformer name as HTML 193 | nameToHTML :: String -> String 194 | nameToHTML = replaceColors <<< replaceStacks 195 | 196 | -- | Replace transformer names by boxes 197 | replaceTransformers :: Chapter -> String -> String 198 | replaceTransformers ch initial = SM.fold replaceT initial ch.transformers 199 | where replaceT text id tr = replaceAll (pattern id) (replacement tr) text 200 | pattern id = "`" <> id <> "`" 201 | replacement tr = "" <> tr.name <> "" 202 | 203 | -- | Clear all functions for the current level 204 | resetLevel :: App 205 | resetLevel = modifyGameStateAndRender true mod 206 | where mod gs = gs { levelState = SM.insert gs.currentLevel Nil gs.levelState } 207 | 208 | -- | Go to the previous level 209 | prevLevel :: App 210 | prevLevel = modifyGameStateAndRender true mod 211 | where mod gs = gs { currentLevel = prev gs.currentLevel } 212 | prev cur = fromMaybe cur $ before cur allLevelIds 213 | before _ Nil = Nothing 214 | before _ (Cons _ Nil) = Nothing 215 | before x (Cons b (Cons x' xs)) = if x == x' 216 | then Just b 217 | else before x (x':xs) 218 | 219 | -- | Go to the next level 220 | nextLevel :: App 221 | nextLevel = do 222 | mgs <- loadGameState 223 | let gs' = fromMaybe initialGS mgs 224 | analyticsLevelChanged (next gs'.currentLevel) 225 | 226 | modifyGameStateAndRender true mod 227 | where mod gs = gs { currentLevel = next gs.currentLevel } 228 | next cur = fromMaybe cur $ head =<< (tail $ dropWhile (_ /= cur) allLevelIds) 229 | 230 | -- | General key press handler 231 | keyPress :: Event -> App 232 | keyPress event = void do 233 | doc <- getDocument 234 | let kev = unsafeEventToKeyboardEvent event 235 | code = keyCode kev 236 | ctrlPressed = ctrlKey kev 237 | 238 | when (not ctrlPressed) $ 239 | case code of 240 | -- 'r': reset lists 241 | 82 -> resetLevel 242 | -- '<-', 'p': previous level 243 | 37 -> prevLevel 244 | 80 -> prevLevel 245 | -- '->', 'n': next level 246 | 39 -> nextLevel 247 | 78 -> nextLevel 248 | _ -> pure unit 249 | 250 | -- | Click handler for the
    • elements (transformers) 251 | clickLi :: Element -> Event -> App 252 | clickLi liEl event = do 253 | newId <- unsafeGetAttribute "id" liEl 254 | ul <- unsafeFromJust <$> parentElement (elementToNode liEl) 255 | ulId <- unsafeGetAttribute "id" ul 256 | modifyGameStateAndRender true (modify ulId newId) 257 | 258 | where modify ulId clicked gs = let program = getCurrentIds gs 259 | program' = 260 | if ulId == "available" 261 | then program `snoc` clicked 262 | else filter (_ /= clicked) program 263 | in gs { levelState = SM.insert gs.currentLevel program' gs.levelState } 264 | 265 | -- | Add a li-element corresponding to the given Transformer 266 | appendTransformerElement :: Element -> String -> TransformerRecord -> EffDOM 267 | appendTransformerElement ul id t = void do 268 | doc <- getDocument 269 | li <- createElement "li" doc 270 | setAttribute "id" id li 271 | setInnerHTML (nameToHTML t.name) li 272 | appendChild (elementToNode li) (elementToNode ul) 273 | 274 | -- | Add an option-element corresponding to the given Level 275 | appendLevelElement :: Element -> LevelId -> LevelId -> EffDOM 276 | appendLevelElement select currentId lid = void do 277 | let chapter = getChapter lid 278 | level = getLevel lid 279 | doc <- getDocument 280 | option <- createElement "option" doc 281 | setAttribute "value" lid option 282 | when (currentId == lid) $ 283 | setAttribute "selected" "selected" option 284 | setTextContent (levelTitle lid level) (elementToNode option) 285 | appendChild (elementToNode option) (elementToNode select) 286 | 287 | -- | Initial game state for first-time visitors 288 | initialGS :: GameState 289 | initialGS = { currentLevel: firstLevel, levelState: SM.empty } 290 | 291 | -- | Load, modify and store the game state. Render the new state 292 | modifyGameStateAndRender :: Boolean 293 | -> (GameState -> GameState) 294 | -> forall eff. Eff (dom :: DOM, console :: CONSOLE, canvas :: CANVAS, storage :: STORAGE | eff) Unit 295 | modifyGameStateAndRender setupUI modifyGS = do 296 | -- Load old game state from local storage 297 | mgs <- loadGameState 298 | let gs = fromMaybe initialGS mgs 299 | 300 | -- Modify by supplied function 301 | let gs' = modifyGS gs 302 | 303 | -- Render the new state and save back to local storage 304 | render setupUI gs' 305 | saveGameState gs' 306 | 307 | -- | Event handler for a level change 308 | levelChangeHandler :: Element -> Event -> App 309 | levelChangeHandler selectLevel _ = do 310 | levelId <- getSelectedValue selectLevel 311 | 312 | analyticsLevelChanged levelId 313 | 314 | modifyGameStateAndRender true $ \gs -> 315 | gs { currentLevel = levelId } 316 | 317 | -- | Event handler for a 'reprogram' (new instruction, re-ordering, ..) 318 | reprogramHandler :: App 319 | reprogramHandler = do 320 | doc <- getDocument 321 | 322 | -- Retrieve current 'program' 323 | ulAvailable <- unsafeFromJust <$> getElementById' "program" doc 324 | lis <- children' ulAvailable 325 | let getId = unsafeGetAttribute "id" <<< htmlElementToElement 326 | program <- fromFoldable <$> traverse getId lis 327 | 328 | modifyGameStateAndRender false $ \gs -> 329 | gs { levelState = SM.insert gs.currentLevel program gs.levelState } 330 | 331 | -- | Unsafe version of `fromJust` 332 | unsafeFromJust :: forall a. Maybe a -> a 333 | unsafeFromJust = unsafePartial fromJust 334 | 335 | main :: App 336 | main = do 337 | doc <- getDocument 338 | 339 | -- install sortable 340 | ulAvailable <- unsafeFromJust <$> getElementById' "available" doc 341 | ulProgram <- unsafeFromJust <$> getElementById' "program" doc 342 | installSortable ulAvailable (pure unit) 343 | installSortable ulProgram reprogramHandler 344 | 345 | -- set up keyboard event handlers 346 | win <- windowToEventTarget <$> window 347 | addEventListener' keydown keyPress win 348 | 349 | -- set up 'change' handler for the level selector 350 | withElementById "levels" doc $ \selectLevel -> 351 | addEventListener' change (levelChangeHandler selectLevel) (elementToEventTarget selectLevel) 352 | 353 | -- Click handlers for buttons 354 | withElementById "reset" doc $ \button -> 355 | addEventListener' click (const resetLevel) (elementToEventTarget button) 356 | 357 | withElementById "nextlevel" doc $ \button -> 358 | addEventListener' click (const nextLevel) (elementToEventTarget button) 359 | 360 | -- load game state (or set initial one) 361 | gs <- fromMaybe initialGS <$> loadGameState 362 | saveGameState gs 363 | 364 | -- render initial state 365 | render true gs 366 | -------------------------------------------------------------------------------- /src/Sortable.js: -------------------------------------------------------------------------------- 1 | exports.installSortable = function (el) { 2 | return function(sortHandler) { 3 | return function() { 4 | new Sortable(el, { 5 | group: 'function-lists', 6 | ghostClass: 'sortable-ghost', 7 | animation: 150, 8 | onSort: sortHandler 9 | }); 10 | }; 11 | }; 12 | }; 13 | -------------------------------------------------------------------------------- /src/Sortable.purs: -------------------------------------------------------------------------------- 1 | module Sortable where 2 | 3 | import Prelude 4 | import Control.Monad.Eff (Eff) 5 | import DOM (DOM) 6 | import DOM.Node.Types (Element) 7 | 8 | -- | Install 'Sortable' on the given DOM element. The second argument is 9 | -- | an event handler that is called if the list is modified. 10 | foreign import installSortable :: forall eff. Element 11 | -> (Eff (dom :: DOM | eff) Unit) 12 | -> Eff (dom :: DOM | eff) Unit 13 | -------------------------------------------------------------------------------- /src/Storage.js: -------------------------------------------------------------------------------- 1 | exports.unsafeLoadGameState = function (just) { 2 | return function(nothing) { 3 | return function() { 4 | var data = localStorage.getItem('gameState'); 5 | if (!data) { 6 | return nothing; 7 | } 8 | return just(JSON.parse(data)); 9 | }; 10 | }; 11 | }; 12 | 13 | exports.unsafeSaveGameState = function (gs) { 14 | return function() { 15 | localStorage.setItem('gameState', JSON.stringify(gs)); 16 | return {}; 17 | }; 18 | }; 19 | -------------------------------------------------------------------------------- /src/Storage.purs: -------------------------------------------------------------------------------- 1 | module Storage where 2 | 3 | import Prelude 4 | import Control.Monad.Eff (kind Effect, Eff) 5 | import Data.Array as A 6 | import Data.List (fromFoldable) 7 | import Data.Maybe (Maybe(..)) 8 | 9 | import Data.StrMap as SM 10 | 11 | import Types (GameState, TransformerId, LevelId) 12 | 13 | foreign import data STORAGE :: Effect 14 | 15 | type SaveableGameState = { 16 | currentLevel :: LevelId, 17 | levelState :: SM.StrMap (Array TransformerId) 18 | } 19 | 20 | toSaveable :: GameState -> SaveableGameState 21 | toSaveable gs = { 22 | currentLevel: gs.currentLevel, 23 | levelState: A.fromFoldable <$> gs.levelState 24 | } 25 | 26 | fromSaveable :: SaveableGameState -> GameState 27 | fromSaveable sgs = { 28 | currentLevel: sgs.currentLevel, 29 | levelState: fromFoldable <$> sgs.levelState 30 | } 31 | 32 | 33 | -- | Retrieve the current game state from local storage (FFI, needs 'Just' and 'Nothing' as input) 34 | foreign import unsafeLoadGameState :: forall a eff. (a -> Maybe a) 35 | -> (Maybe a) 36 | -> Eff (storage :: STORAGE | eff) (Maybe SaveableGameState) 37 | 38 | -- | Retrieve game state from local storage 39 | loadGameState :: forall eff. Eff (storage :: STORAGE | eff) (Maybe GameState) 40 | loadGameState = map fromSaveable <$> unsafeLoadGameState Just Nothing 41 | 42 | -- | Store a game state in local storage (unsafe) 43 | foreign import unsafeSaveGameState :: forall eff. SaveableGameState 44 | -> Eff (storage :: STORAGE | eff) Unit 45 | 46 | -- | Store a game state in local storage 47 | saveGameState :: forall eff. GameState 48 | -> Eff (storage :: STORAGE | eff) Unit 49 | saveGameState = toSaveable >>> unsafeSaveGameState 50 | -------------------------------------------------------------------------------- /src/Transformer.purs: -------------------------------------------------------------------------------- 1 | module Transformer where 2 | 3 | import Prelude 4 | import Data.List (List, concatMap, singleton, snoc, null, (:), filter) 5 | import Data.Foldable (foldl) 6 | import Data.Traversable (scanl) 7 | import Types (Transformer, Cube, Wall) 8 | 9 | -- | Map a function over the two dimensional array (= wall) 10 | map2d :: (Cube -> Cube) -> Wall -> Wall 11 | map2d = map <<< map 12 | 13 | -- | Opposite of filter, reject all values which satisfy the pattern 14 | reject :: forall a. (a -> Boolean) -> List a -> List a 15 | reject f = filter (not <<< f) 16 | 17 | -- | Successively apply all transformers to the initial wall and return 18 | -- | all (intermediate) transformation steps 19 | allSteps :: List Transformer -> Wall -> List Wall 20 | allSteps ts initial = initial : scanl (#) initial ts 21 | 22 | -- | Return the final step of the transformation chain 23 | transformed :: List Transformer -> Wall -> Wall 24 | transformed ts initial = foldl (#) initial ts 25 | 26 | -- | Remove emtpy stacks 27 | clearEmpty :: Transformer 28 | clearEmpty = reject null 29 | 30 | -- | Reject all cubes of a certain color 31 | mapReject :: Cube -> Transformer 32 | mapReject c = map (reject (_ == c)) >>> clearEmpty 33 | 34 | -- | Stack a single cube on top of each column 35 | mapStack :: Cube -> Transformer 36 | mapStack c = map (_ `snoc` c) 37 | 38 | -- | Replace all occurences of a certain cube with another 39 | replaceSingle :: Cube -> Cube -> Transformer 40 | replaceSingle a b = map2d replace 41 | where replace x = if x == a then b else x 42 | 43 | -- | Replace all occurences of a certain cube with a list of new cubes 44 | replaceMultiple :: Cube -> List Cube -> Transformer 45 | replaceMultiple a bs = map (concatMap replace) 46 | where replace x = if x == a then bs else singleton x 47 | -------------------------------------------------------------------------------- /src/Types.purs: -------------------------------------------------------------------------------- 1 | module Types 2 | ( Cube(..) 3 | , GameState(..) 4 | , LevelId(..) 5 | , TransformerRecord(..) 6 | , Chapter(..) 7 | , TransformerId(..) 8 | , Wall(..) 9 | , Stack(..) 10 | , Transformer(..) 11 | , Level(..) 12 | , Difficulty(..) 13 | ) where 14 | 15 | import Prelude 16 | import Data.List (List) 17 | import Data.Enum (class Enum, class BoundedEnum, Cardinality(..), defaultSucc, 18 | defaultPred, fromEnum) 19 | import Data.Maybe (Maybe(..)) 20 | import Data.StrMap as SM 21 | 22 | -- Cube, Stack, Wall 23 | 24 | data Cube = Cyan | Brown | Red | Orange | Yellow 25 | 26 | instance showCube :: Show Cube where 27 | show Cyan = "Cyan" 28 | show Brown = "Brown" 29 | show Red = "Red" 30 | show Orange = "Orange" 31 | show Yellow = "Yellow" 32 | 33 | instance eqCube :: Eq Cube where 34 | eq a b = fromEnum a == fromEnum b 35 | 36 | instance ordCube :: Ord Cube where 37 | compare a b = fromEnum a `compare` fromEnum b 38 | 39 | instance boundedCube :: Bounded Cube where 40 | top = Yellow 41 | bottom = Cyan 42 | 43 | instance enumCube :: Enum Cube where 44 | succ = defaultSucc cubeToEnum cubeFromEnum 45 | pred = defaultPred cubeToEnum cubeFromEnum 46 | 47 | instance boundedEnumCube :: BoundedEnum Cube where 48 | cardinality = Cardinality 5 49 | toEnum = cubeToEnum 50 | fromEnum = cubeFromEnum 51 | 52 | cubeFromEnum :: Cube -> Int 53 | cubeFromEnum Cyan = 0 54 | cubeFromEnum Brown = 1 55 | cubeFromEnum Red = 2 56 | cubeFromEnum Orange = 3 57 | cubeFromEnum Yellow = 4 58 | 59 | cubeToEnum :: Int -> Maybe Cube 60 | cubeToEnum 0 = Just Cyan 61 | cubeToEnum 1 = Just Brown 62 | cubeToEnum 2 = Just Red 63 | cubeToEnum 3 = Just Orange 64 | cubeToEnum 4 = Just Yellow 65 | cubeToEnum _ = Nothing 66 | 67 | type Stack = List Cube 68 | 69 | type Wall = List Stack 70 | 71 | -- Transformer 72 | type Transformer = Wall -> Wall 73 | 74 | type TransformerId = String 75 | 76 | type TransformerRecord = { 77 | name :: String, 78 | function :: Transformer 79 | } 80 | 81 | -- Levels and chapters 82 | 83 | type LevelId = String 84 | 85 | data Difficulty = Easy | Medium | Hard 86 | 87 | instance showDifficulty :: Show Difficulty where 88 | show Easy = "Easy" 89 | show Medium = "Medium" 90 | show Hard = "Hard" 91 | 92 | type Level = { 93 | name :: String, 94 | help :: Maybe String, 95 | difficulty :: Difficulty, 96 | initial :: Wall, 97 | target :: Wall 98 | } 99 | 100 | type Chapter = { 101 | name :: String, 102 | transformers :: SM.StrMap TransformerRecord, 103 | levels :: SM.StrMap Level 104 | } 105 | 106 | -- Game state 107 | 108 | type GameState = { 109 | currentLevel :: LevelId, 110 | levelState :: SM.StrMap (List TransformerId) 111 | } 112 | -------------------------------------------------------------------------------- /src/Unsafe.js: -------------------------------------------------------------------------------- 1 | exports.unsafeError = function(msg) { 2 | // Try to recover from this error by resetting the global state. 3 | if (confirm(msg + ". Clear localStorage and reload?")) { 4 | localStorage.clear(); 5 | location.reload(); 6 | } 7 | 8 | // Abort execution 9 | throw new Error(msg); 10 | }; 11 | -------------------------------------------------------------------------------- /src/Unsafe.purs: -------------------------------------------------------------------------------- 1 | module Unsafe where 2 | 3 | -- | Layman error handling 4 | foreign import unsafeError :: forall a. String -> a 5 | --------------------------------------------------------------------------------