├── .gitignore ├── .travis.yml ├── LICENSE ├── README.ja.md ├── README.md ├── asset ├── index.css ├── index.html └── index.js ├── bower.json ├── doc └── usage.md ├── emo8.jpg ├── example ├── basic │ └── Main.purs ├── emodius │ ├── Asset.purs │ ├── Class │ │ └── Object.purs │ ├── Collision.purs │ ├── Constants.purs │ ├── Data │ │ ├── Bullet.purs │ │ ├── Enemy.purs │ │ ├── EnemyBullet.purs │ │ ├── Particle.purs │ │ └── Player.purs │ ├── Helper.purs │ ├── Main.purs │ └── Types.purs └── hello │ └── Main.purs ├── package.json ├── packages.dhall ├── spago.dhall ├── src ├── Emo8.purs └── Emo8 │ ├── Data │ ├── Color.purs │ ├── Dir.purs │ ├── Draw.purs │ ├── Emoji.purs │ ├── Input.purs │ ├── Key.purs │ ├── Note.purs │ ├── Sound.purs │ ├── Tone.purs │ └── Update.purs │ ├── FFI │ ├── Emo8Retina.js │ ├── Emo8Retina.purs │ ├── LocalStorage.js │ ├── LocalStorage.purs │ ├── TextBaseline.js │ └── TextBaseline.purs │ ├── Game.purs │ ├── Game │ ├── Draw.purs │ ├── Sound.purs │ └── Update.purs │ ├── GameBoot.purs │ ├── GameDev.purs │ ├── GameWithBoot.purs │ ├── Input.purs │ ├── Input │ ├── Direction.purs │ ├── Keyboard.purs │ ├── Merged.purs │ ├── Swipe.purs │ └── Touch.purs │ ├── Parser.purs │ ├── Parser │ ├── EConvert.purs │ ├── NConstraint.purs │ ├── NConvert.purs │ └── Type.purs │ ├── Type.purs │ └── Util │ ├── Collide.purs │ ├── Config.purs │ ├── Input.purs │ ├── List.purs │ └── State.purs ├── test └── Main.purs └── yarn.lock /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | /.spago 11 | /.cache 12 | /dist/ 13 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | node_js: 3 | - node 4 | install: 5 | - yarn 6 | script: 7 | - yarn build 8 | - yarn bundle:example 9 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 peus 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. -------------------------------------------------------------------------------- /README.ja.md: -------------------------------------------------------------------------------- 1 | # Emo8 2 | 3 | [![Build status](https://travis-ci.org/opyapeus/purescript-emo8.svg?branch=master)](https://travis-ci.org/opyapeus/purescript-emo8) 4 | [![purescript-emo8 on Pursuit](https://pursuit.purescript.org/packages/purescript-emo8/badge)](https://pursuit.purescript.org/packages/purescript-emo8) 5 | 6 | 絵文字だけでゲームが作れるユニークな関数型2Dゲームエンジン 7 | 8 | [ [English](README.md) ] 9 | 10 | ![emo8](emo8.jpg) 11 | ![emodius](https://opyapeus.github.io/emo8/img/emodius-half.gif) 12 | 13 | ## こんな人にどうぞ 14 | 15 | - 絵文字だけって面白い 16 | - 作ったゲームを簡単にシェアしたい 17 | - PureScriptで見通しの良いプログラムを書きたい 18 | 19 | ### なぜ絵文字？ 20 | 21 | - あらゆるところで使える見慣れた素材 22 | - LEGOブロックを組み立てる感覚でゲーム作り 23 | - 敢えて制約があることが面白い（[PICO-8](https://www.lexaloffle.com/pico-8.php)に倣って） 24 | 25 | ### なぜPureScript？ 26 | 27 | | | 言語の抽象力 | 配布性 | 28 | | ---------- | ------------ | ------ | 29 | | PureScript | ○ | ○ | 30 | | Haskell | ○ | △ ※1 | 31 | | Elm | △ ※2 | ○ | 32 | 33 | - ※1: JavaScriptへの変換に難がある 34 | - ※2: 型クラスがない 35 | 36 | ## 特徴 37 | 38 | | | | 39 | | ---------------- | --------------------------------------------- | 40 | | 画面サイズ | 縦横可変 256px~1024px（目安） | 41 | | 背景色 | 140色（HTML名前付きカラー ） | 42 | | 素材 | Unicode Emoji v13.0 （Single code pointのみ） | 43 | | コントローラ | 8ボタン（上下左右×2） | 44 | | マップ | 絵文字のマップ | 45 | | サウンド | 絵文字のサウンド | 46 | | 開発言語 | PureScript | 47 | | 出力ファイル容量 | ~1MB（目安） | 48 | | フレームレート | 約60FPS（requestAnimationFrame） | 49 | | 動作環境 | Webブラウザ | 50 | 51 | ## コントローラ 52 | 53 | ### キーボード入力 54 | 55 | ``` 56 | /¯¯¯\_/¯¯¯\ 57 | | W | ↑ | 58 | | A D | ← → | 59 | | S | ↓ | 60 | \___/¯\___/ 61 | ``` 62 | 63 | ### スクリーンスワイプ 64 | 65 | ``` 66 | |¯¯¯¯¯¯¯¯|¯¯¯¯¯¯¯¯| 67 | | 👆 | 👆 | 68 | | 👈 👉 | 👈 👉 | 69 | | 👇 | 👇 | 70 | |________|________| 71 | ``` 72 | 73 | ## 素材の編集 74 | 75 | ### マップ 76 | 77 | ``` 78 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳 79 | 🈳⛅🈳🈳🎌🈳🈳🌧🈳 80 | 🈳🈳🈳🌳🗻🌳🈳🈳🈳 81 | 🈳🈳🌳🗻🗻🗻🌳🈳🈳 82 | 🈳🌳🗻🗻🗻🗻🗻🌳🈳 83 | 🌳🗻🗻🗻🗻🗻🗻🗻🌳 84 | ``` 85 | 86 | ### サウンド 87 | 88 | ``` 89 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 90 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 91 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 92 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 93 | ``` 94 | 95 | ## マニュアル 96 | 97 | - [Usage Overview](doc/usage.md) 98 | - [Module documentation on Pursuit](https://pursuit.purescript.org/packages/purescript-emo8) 99 | 100 | ## サンプルプログラム 101 | 102 | 実装例は [example](example) を見てください。 103 | 104 | ``` 105 | yarn 106 | ``` 107 | 108 | ### ファイル出力 109 | 110 | ``` 111 | yarn bundle:example 112 | ``` 113 | 114 | ``` 115 | open dist/example/hello/index.html 116 | open dist/example/basic/index.html 117 | open dist/example/emodius/index.html 118 | ``` 119 | 120 | ### 開発 121 | 122 | ``` 123 | yarn build 124 | ``` 125 | 126 | ``` 127 | yarn dev 128 | ``` 129 | 130 | ## 既知の問題 131 | 132 | - canvasの絵文字の回転 (45°, 135°, 225°, 315°) 表示の問題 [Why won't emojis render when rotated to 45 (or 315) degrees?](https://stackoverflow.com/questions/39749540/why-wont-emojis-render-when-rotated-to-45-or-315-degrees) 133 | 134 | ## ライセンス 135 | 136 | [MIT](LICENSE) 137 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Emo8 2 | 3 | [![Build status](https://travis-ci.org/opyapeus/purescript-emo8.svg?branch=master)](https://travis-ci.org/opyapeus/purescript-emo8) 4 | [![purescript-emo8 on Pursuit](https://pursuit.purescript.org/packages/purescript-emo8/badge)](https://pursuit.purescript.org/packages/purescript-emo8) 5 | 6 | An unique functional 2D game engine that can create games with only emoji. 7 | 8 | [ [日本語](README.ja.md) ] 9 | 10 | ![emo8](emo8.jpg) 11 | ![emodius](https://opyapeus.github.io/emo8/img/emodius-half.gif) 12 | 13 | ## This Library Is For Someone Who... 14 | 15 | - Thinks only emoji is interesting! 16 | - Wants to share the game easily 17 | - Wants to write a clear program using PureScript 18 | 19 | ### Why Emoji? 20 | 21 | - Familiar materials that can be used anywhere 22 | - Create games like assembling LEGO blocks 23 | - Interesting that there are restrictions like [PICO-8](https://www.lexaloffle.com/pico-8.php) 24 | 25 | ### Why PureScript? 26 | 27 | | | Language abstraction | Distributability | 28 | | ---------- | -------------------- | ---------------- | 29 | | PureScript | ○ | ○ | 30 | | Haskell | ○ | △ ※1 | 31 | | Elm | △ ※2 | ○ | 32 | 33 | - ※1: Hard to convert into JavaScript 34 | - ※2: No type classes 35 | 36 | ## Feature 37 | 38 | | | | 39 | | --------------------- | ---------------------------------------------- | 40 | | Screen Size | Variable 256px~1024px（reasonable） | 41 | | Background Color | 140 colors（HTML named colors） | 42 | | Material | Unicode Emoji v13.0 （Single code point only） | 43 | | Controller | 8 buttons（up down left bottom ×2） | 44 | | Map | Map made of Emoji | 45 | | Sound | Sound made of Emoji | 46 | | Language | PureScript | 47 | | Output File Volume | ~1MB（reasonable） | 48 | | Frame Rate | About 60 FPS（requestAnimationFrame） | 49 | | Operating Environment | Web browser | 50 | 51 | ## Controller 52 | 53 | ### Keyboard Input 54 | 55 | ``` 56 | /¯¯¯\_/¯¯¯\ 57 | | W | ↑ | 58 | | A D | ← → | 59 | | S | ↓ | 60 | \___/¯\___/ 61 | ``` 62 | 63 | ### Screen Swipe 64 | 65 | ``` 66 | |¯¯¯¯¯¯¯¯|¯¯¯¯¯¯¯¯| 67 | | 👆 | 👆 | 68 | | 👈 👉 | 👈 👉 | 69 | | 👇 | 👇 | 70 | |________|________| 71 | ``` 72 | 73 | ## Resource Editor 74 | 75 | ### Map 76 | 77 | ``` 78 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳 79 | 🈳⛅🈳🈳🎌🈳🈳🌧🈳 80 | 🈳🈳🈳🌳🗻🌳🈳🈳🈳 81 | 🈳🈳🌳🗻🗻🗻🌳🈳🈳 82 | 🈳🌳🗻🗻🗻🗻🗻🌳🈳 83 | 🌳🗻🗻🗻🗻🗻🗻🗻🌳 84 | ``` 85 | 86 | ### Sound 87 | 88 | 89 | ``` 90 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 91 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 92 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 93 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 94 | ``` 95 | 96 | ## Manual 97 | 98 | - [Usage Overview](doc/usage.md) 99 | - [Module documentation on Pursuit](https://pursuit.purescript.org/packages/purescript-emo8) 100 | 101 | ## Sample Program 102 | 103 | See [example](example) for the implementation. 104 | 105 | ``` 106 | yarn 107 | ``` 108 | 109 | ### Output File 110 | 111 | ``` 112 | yarn bundle:example 113 | ``` 114 | 115 | ``` 116 | open dist/example/hello/index.html 117 | open dist/example/basic/index.html 118 | open dist/example/emodius/index.html 119 | ``` 120 | 121 | ### Development 122 | 123 | ``` 124 | yarn build 125 | ``` 126 | 127 | ``` 128 | yarn dev 129 | ``` 130 | 131 | ## Known Issue 132 | 133 | - emoji rotate (45°, 135°, 225°, 315°) problem on canvas [Why won't emojis render when rotated to 45 (or 315) degrees?](https://stackoverflow.com/questions/39749540/why-wont-emojis-render-when-rotated-to-45-or-315-degrees) 134 | 135 | ## License 136 | 137 | [MIT](LICENSE) 138 | -------------------------------------------------------------------------------- /asset/index.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: #000000; 3 | overflow: hidden; 4 | touch-action: none; 5 | } 6 | 7 | #emo8 { 8 | position: absolute; 9 | top: 50%; 10 | left: 50%; 11 | transform: translate(-50%,-50%); 12 | max-width: 100%; 13 | max-height: 100%; 14 | } 15 | -------------------------------------------------------------------------------- /asset/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | EMO8 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /asset/index.js: -------------------------------------------------------------------------------- 1 | require("../output/Main").main(); 2 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-emo8", 3 | "license": [ 4 | "MIT" 5 | ], 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/opyapeus/purescript-emo8" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "node_modules", 13 | "bower_components", 14 | "output" 15 | ], 16 | "dependencies": { 17 | "purescript-canvas": "^v4.0.0", 18 | "purescript-console": "^v4.4.0", 19 | "purescript-effect": "^v2.0.1", 20 | "purescript-foreign-generic": "^v10.0.0", 21 | "purescript-lists": "^v5.4.1", 22 | "purescript-record": "^v2.0.2", 23 | "purescript-record-extra": "^v3.0.1", 24 | "purescript-refs": "^v4.1.0", 25 | "purescript-signal": "^v10.1.0", 26 | "purescript-transformers": "^v4.2.0", 27 | "purescript-typelevel-prelude": "^v5.0.2", 28 | "purescript-webaudio": "^v0.2.1", 29 | "purescript-web-events": "^2.0.1" 30 | } 31 | } -------------------------------------------------------------------------------- /doc/usage.md: -------------------------------------------------------------------------------- 1 | # Usage Overview 2 | 3 | see [example](../example) for concrete implementation. 4 | 5 | ## Game Class 6 | 7 | ```purescript 8 | class Game s where 9 | update :: Input -> s -> Update s 10 | draw :: s -> Draw Unit 11 | sound :: s -> Sound Unit 12 | ``` 13 | 14 | `s` is a game state type which you can flexibly define. 15 | 16 | Each functions are executed in order update, draw, sound at every frame. 17 | 18 | ## Update Action 19 | 20 | ### Input 21 | 22 | ```purescript 23 | type Input 24 | = { isUp :: Boolean 25 | , isLeft :: Boolean 26 | , isDown :: Boolean 27 | , isRight :: Boolean 28 | , isW :: Boolean 29 | , isA :: Boolean 30 | , isS :: Boolean 31 | , isD :: Boolean 32 | } 33 | ``` 34 | 35 | ### Canvas Frame Collision (e.g.) 36 | 37 | ```purescript 38 | isCollideCanvas :: Size -> X -> Y -> Update Boolean 39 | ``` 40 | 41 | Arguments 42 | 43 | - `Size`: object size (length of one side of square) 44 | - `X`: square's left position 45 | - `Y`: square's bottom position 46 | 47 | Return 48 | 49 | - Boolean: whether there is a collision 50 | 51 | After describing some actions, return next `s` at the end of update function. 52 | 53 | ## Draw Action 54 | 55 | ### Draw Emoji (e.g.) 56 | 57 | ```purescript 58 | emo :: Emoji -> Size -> X -> Y -> Draw Unit 59 | ``` 60 | 61 | Arguments 62 | 63 | - `Emoji`: specify one of supported emoji 64 | - `Size`: emoji size (length of one side of square) 65 | - `X`: square's left position 66 | - `Y`: square's bottom position 67 | 68 | ※ Origin is based on left bottom. (not left top) 69 | 70 | ※ All emojis are treated as square. 71 | Because these appearances depend on running device or browser. 72 | 73 | ### Draw Map (e.g.) 74 | 75 | ```purescript 76 | emap :: EmojiMap -> Size -> X -> Y -> Draw Unit 77 | ``` 78 | 79 | Arguments 80 | 81 | - `EmojiMap`: emoji map that you can edit. 82 | - `Size`: map element (emoji) size. (not whole map size) 83 | - `X`: map's left position 84 | - `Y`: map's bottom position 85 | 86 | ## Sound Action 87 | 88 | ### Play Sound (e.g.) 89 | 90 | ```purescript 91 | play :: Score -> Tone -> Tempo -> Sound Unit 92 | ``` 93 | 94 | ※ The action is ignored until the score ends. 95 | 96 | Arguments 97 | 98 | - `Score`: score that you can edit. 99 | - `Tone`: oscillation type (select one of [Sine, Square, Sawtooth, Triangle]) 100 | - `Tempo`: tempo (beat per minute) 101 | 102 | ## Map Edit 103 | 104 | The type checker will tell you which emojis you can use! 105 | 106 | ```purescript 107 | mountFuji :: EmojiMap 108 | mountFuji = parse (SProxy :: SProxy Fuji) 109 | 110 | type Fuji 111 | = """ 112 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳 113 | 🈳⛅🈳🈳🎌🈳🈳🌧🈳 114 | 🈳🈳🈳🌳🗻🌳🈳🈳🈳 115 | 🈳🈳🌳🗻🗻🗻🌳🈳🈳 116 | 🈳🌳🗻🗻🗻🗻🗻🌳🈳 117 | 🌳🗻🗻🗻🗻🗻🗻🗻🌳 118 | """ 119 | ``` 120 | 121 | ※ 🈳 is the special emoji that represents vacant space. 122 | 123 | ## Sound Edit 124 | 125 | The type checker will tell you which patterns you can use! 126 | 127 | ```purescript 128 | beep :: Score 129 | beep = parse (SProxy :: SProxy NHK) 130 | 131 | type NHK 132 | = """ 133 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 134 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 135 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 136 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 137 | """ 138 | ``` 139 | 140 | - 🎹: note 141 | - 🈳: vacancy 142 | 143 | ``` 144 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳: means A4 (440 Hz) 145 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹: means A5 (880 Hz) 146 | ``` 147 | 148 | ## Run 149 | 150 | ### Production 151 | 152 | Main game loop function. 153 | 154 | ```purescript 155 | emo8 :: forall s. Game s => s -> Config -> Effect Unit 156 | ``` 157 | 158 | ### Development 159 | 160 | Main game loop function for development. 161 | 162 | ```purescript 163 | emo8Dev :: forall s. GameDev s => s -> Config -> Effect Unit 164 | ``` 165 | 166 | ### GameDev Class 167 | 168 | ```purescript 169 | class (Game s, Encode s, Decode s) <= GameDev s where 170 | saveLocal :: s -> Array LocalKey 171 | ``` 172 | 173 | saveLocal function is executed after Game class's functions at every frame. 174 | It saves state json text to localstorage with the given LocalKey array (for multiple savepoints). 175 | 176 | ### Load Saved State 177 | 178 | ```purescript 179 | loadStateWithDefault :: forall s. GameDev s => s -> LocalKey -> Effect s 180 | ``` 181 | 182 | Arguments 183 | 184 | - `s`: fallback state which is used when localstorage key is not found. 185 | - `LocalKey`: localstorage key which you saved with saveLocal function. 186 | -------------------------------------------------------------------------------- /emo8.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/opyapeus/purescript-emo8/2cc4589057444367d17a8c10cdecbcc0bbac2ebc/emo8.jpg -------------------------------------------------------------------------------- /example/basic/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | import Data.Generic.Rep (class Generic) 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Monoid (guard) 7 | import Data.Symbol (SProxy(..)) 8 | import Effect (Effect) 9 | import Emo8 (emo8Dev) 10 | import Emo8.Data.Color as C 11 | import Emo8.Data.Emoji as E 12 | import Emo8.Data.Input (Input) 13 | import Emo8.Data.Tone (Tone(..)) 14 | import Emo8.FFI.LocalStorage (LocalKey(..)) 15 | import Emo8.Game (class Game) 16 | import Emo8.Game.Draw (cls, emap, emo, emo') 17 | import Emo8.Game.Sound (play') 18 | import Emo8.Game.Update (Update, getCanvasSize) 19 | import Emo8.GameDev (class GameDev, loadStateWithDefault) 20 | import Emo8.Parser (parse) 21 | import Emo8.Parser.Type (EmojiMap, Score) 22 | import Emo8.Type (Size) 23 | import Emo8.Util.Collide (sinkCanvas, sinkMapXY) 24 | import Emo8.Util.Input (catchInput, noInput) 25 | import Emo8.Util.State (defaultDecode, defaultEncode) 26 | import Foreign.Generic (class Decode, class Encode) 27 | 28 | data State 29 | = State 30 | { player :: Player 31 | , prevInput :: Input 32 | , frame :: Int 33 | } 34 | 35 | type Player 36 | = { x :: Int 37 | , y :: Int 38 | , dy :: Int 39 | , appear :: Appear 40 | , catchJump :: Boolean 41 | } 42 | 43 | data Appear 44 | = LeftWalk 45 | | RightWalk 46 | | LeftRun 47 | | RightRun 48 | 49 | derive instance genericState :: Generic State _ 50 | 51 | instance encodeState :: Encode State where 52 | encode = defaultEncode 53 | 54 | instance decodeState :: Decode State where 55 | decode = defaultDecode 56 | 57 | derive instance genericAppear :: Generic Appear _ 58 | 59 | instance encodeAppear :: Encode Appear where 60 | encode = defaultEncode 61 | 62 | instance decodeAppear :: Decode Appear where 63 | decode = defaultDecode 64 | 65 | instance gameState :: 66 | Game State where 67 | update input (State state) = do 68 | newPlayer <- system state.player 69 | pure 70 | $ State 71 | { player: newPlayer 72 | , prevInput: input 73 | , frame: state.frame + 1 74 | } 75 | where 76 | system = 77 | canvasCollision 78 | <<< mapCollision 79 | <<< appearance 80 | <<< gravity 81 | <<< jumping 82 | <<< movement 83 | 84 | catch = catchInput state.prevInput input 85 | 86 | movement :: Player -> Player 87 | movement p = case input.isLeft, input.isRight of 88 | true, false -> p { x = p.x - 5 } 89 | false, true -> p { x = p.x + 5 } 90 | _, _ -> p 91 | 92 | jumping :: Player -> Player 93 | jumping p 94 | | catch.isW, p.dy == 0 = p { dy = p.dy + 26, catchJump = true } 95 | | otherwise = p { catchJump = false } 96 | 97 | gravity :: Player -> Player 98 | gravity p = np { y = p.y + np.dy } 99 | where 100 | np = p { dy = p.dy - 2 } 101 | 102 | appearance :: Player -> Player 103 | appearance p = p { appear = newAppear } 104 | where 105 | newAppear = case input.isLeft, input.isRight of 106 | true, false 107 | | isAppearRun -> LeftRun 108 | | otherwise -> LeftWalk 109 | false, true 110 | | isAppearRun -> RightRun 111 | | otherwise -> RightWalk 112 | _, _ -> case p.appear of 113 | LeftRun -> LeftWalk 114 | RightRun -> RightWalk 115 | _ -> p.appear 116 | 117 | isAppearRun = mod state.frame 8 < 4 118 | 119 | mapCollision :: Player -> Player 120 | mapCollision p = do 121 | case sinkMapXY stage mapSize walls state.player.x state.player.y emoSize p.x p.y of 122 | Just s 123 | | s.y /= 0 -> p { x = p.x - s.x, y = p.y - s.y, dy = 0 } 124 | | otherwise -> p { x = p.x - s.x } 125 | Nothing -> p 126 | 127 | canvasCollision :: Player -> Update Player 128 | canvasCollision p = do 129 | r <- getCanvasSize 130 | pure case sinkCanvas r emoSize p.x p.y of 131 | Just s 132 | | s.y /= 0 -> p { x = p.x - s.x, y = p.y - s.y, dy = 0 } 133 | | otherwise -> p { x = p.x - s.x } 134 | Nothing -> p 135 | draw (State state) = do 136 | cls C.silver 137 | emap stage mapSize 0 0 138 | emoF emoSize state.player.x state.player.y 139 | where 140 | emoF = case state.player.appear of 141 | LeftWalk -> emo E.personWalking 142 | RightWalk -> emo' E.personWalking 143 | LeftRun -> emo E.personRunning 144 | RightRun -> emo' E.personRunning 145 | sound (State state) = do 146 | when state.player.catchJump 147 | $ play' jump Sawtooth 64 148 | 149 | instance gameDevState :: GameDev State where 150 | saveLocal (State s) = 151 | guard (mod s.frame 60 == 0) [ localKeys.per60frame ] 152 | <> guard s.player.catchJump [ localKeys.jumped ] 153 | 154 | localKeys :: 155 | { jumped :: LocalKey 156 | , per60frame :: LocalKey 157 | } 158 | localKeys = 159 | { jumped: LocalKey "jumped" 160 | , per60frame: LocalKey "per60frame" 161 | } 162 | 163 | emoSize :: Size 164 | emoSize = 32 165 | 166 | mapSize :: Size 167 | mapSize = 32 168 | 169 | main :: Effect Unit 170 | main = do 171 | s <- loadStateWithDefault initialState localKeys.jumped 172 | emo8Dev s conf 173 | where 174 | initialState = 175 | State 176 | { player: 177 | { x: 256 178 | , y: mapSize 179 | , dy: 0 180 | , catchJump: false 181 | , appear: LeftWalk 182 | } 183 | , prevInput: noInput 184 | , frame: 0 185 | } 186 | 187 | conf = 188 | { canvasSize: 189 | { width: 512 190 | , height: 512 191 | } 192 | , retina: true 193 | } 194 | 195 | stage :: EmojiMap 196 | stage = parse (SProxy :: SProxy Stage) 197 | 198 | jump :: Score 199 | jump = parse (SProxy :: SProxy Jump) 200 | 201 | walls :: Array E.Emoji 202 | walls = [ E.japaneseNoVacancyButton ] -- 🈵 203 | 204 | type Stage 205 | = """ 206 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 207 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 208 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 209 | 🈳🈳🈳🈳🈳🈳🈳🈚🈚🈳🈳🈳🈳🈳🈳🈳 210 | 🈳🈳🈳🈳🈳🈳🈳🈚🈚🈳🈳🈳🈳🈳🈳🈳 211 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 212 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 213 | 🈵🈵🈵🈵🈳🈳🈳🈳🈳🈳🈳🈳🈵🈵🈵🈵 214 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 215 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 216 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 217 | 🈳🈳🈳🈳🈵🈵🈵🈵🈵🈵🈵🈵🈳🈳🈳🈳 218 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 219 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 220 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 221 | 🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵🈵 222 | """ 223 | 224 | type Jump 225 | = """ 226 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 227 | 🈳🈳🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 228 | 🈳🈳🈳🈳🎹🈳🈳🈳🈳🈳🈳🈳🈳 229 | 🈳🈳🈳🈳🈳🎹🈳🈳🈳🈳🈳🈳🈳 230 | 🈳🈳🈳🈳🈳🈳🈳🎹🈳🈳🈳🈳🈳 231 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹🈳🈳🈳 232 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹🈳 233 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 234 | """ 235 | -------------------------------------------------------------------------------- /example/emodius/Asset.purs: -------------------------------------------------------------------------------- 1 | module Asset where 2 | 3 | import Prelude 4 | import Data.Symbol (SProxy(..)) 5 | import Emo8.Data.Emoji as E 6 | import Emo8.Parser (parse) 7 | import Emo8.Parser.Type (EmojiMap) 8 | import Emo8.Type (Walls) 9 | import Emo8.Util.List ((<<>>)) 10 | 11 | walls :: Walls 12 | walls = 13 | [ E.waterWave -- 🌊 14 | , E.evergreenTree -- 🌲 15 | , E.deciduousTree -- 🌳 16 | , E.mountain -- ⛰ 17 | , E.mountFuji -- 🗻 18 | , E.cloudWithLightning -- 🌩 19 | , E.tornado -- 🌪 20 | , E.fire -- 🔥 21 | ] 22 | 23 | stage1 :: EmojiMap 24 | stage1 = parse (SProxy :: SProxy M1) 25 | 26 | stage2 :: EmojiMap 27 | stage2 = parse (SProxy :: SProxy M2) 28 | 29 | stage3 :: EmojiMap 30 | stage3 = parse (SProxy :: SProxy M3A) <<>> parse (SProxy :: SProxy M3B) 31 | 32 | stage4 :: EmojiMap 33 | stage4 = 34 | parse (SProxy :: SProxy M40) 35 | <> parse (SProxy :: SProxy M41) 36 | 37 | type M1 38 | = """ 39 | 🈳 40 | 🈳 41 | 🈳 42 | 🈳 43 | 🈳🈳🈳🈳🔰🈳🈳🈳🔰 44 | 🈳🈳🈳🈳🔰🔰🔰🔰🔰 45 | 🈳🈳🈳🈳🔰🔰🔰🔰🔰 46 | 🈳🈳🈳🈳🈳🔰🔰🔰 47 | 🈳🈳🈳🈳🈳🈳🔰 48 | 🈳 49 | 🈳 50 | 🈳 51 | 🈳 52 | 🈳 53 | 🈳 54 | 🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊🌊 55 | """ 56 | 57 | type M2 58 | = """ 59 | 🈳 60 | 🈳 61 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🍄🍄🍄🍄🍄🍄 62 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌧🌧🌧🌧🌧🌧🌧🌧 63 | 🈳 64 | 🈳🈳🈳🈳🆗👀 65 | 🈳🈳🈳🈳🆗👀🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🍄🍄🍄🍄🍄🍄🍄 66 | 🈳🈳🈳🈳🆗👀🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌧🌧🌧🌧🌧🌧🌧🌧🌧 67 | 🈳🈳🈳🈳🆗👀 68 | 🈳 69 | 🈳 70 | 🈳 71 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🈳🈳🈳🈳🈳🈳🈳🈳🌲 72 | 🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🈳🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🈳🈳🈳🈳🈳🈳🈳🌲🌲 73 | 🈳🈳🈳🈳🈳🈳🈳🌲🌲🌲🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🌲🈳🈳🈳🈳🈳🈳🈳🌲🌲🌲🈳🈳🈳🈳🈳🈳🈳🈳🌲🌲🌲🈳🈳🈳🈳🈳🈳🈳🌲🌲🌲🈳🈳🈳🈳🈳🈳🌲🌲🌲 74 | 🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳🌳 75 | """ 76 | 77 | type M3A 78 | = """ 79 | 🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩 80 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 81 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 82 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 83 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 84 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎌 85 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🔜🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻 86 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🔜🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻 87 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🔜🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻 88 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🔜🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻🗻 89 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻🗻🗻 90 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻🗻🗻🗻 91 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻🗻🗻🗻🗻 92 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻🗻🗻🗻🗻🗻 93 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🗻🗻🗻🗻🗻🗻🗻🗻🗻 94 | ⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰ 95 | """ 96 | 97 | type M3B 98 | = """ 99 | 🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩🌩 100 | 🈳 101 | 🈳 102 | 🈳 103 | 🈳 104 | 🈳 105 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳⏩ 106 | 🗻🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳⏩ 107 | 🗻🗻🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳⏩ 108 | 🗻🗻🗻🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳⏩ 109 | 🗻🗻🗻🗻 110 | 🗻🗻🗻🗻🗻 111 | 🗻🗻🗻🗻🗻🗻 112 | 🗻🗻🗻🗻🗻🗻🗻 113 | 🗻🗻🗻🗻🗻🗻🗻🗻 114 | ⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰⛰ 115 | """ 116 | 117 | type M40 118 | = """ 119 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 120 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 121 | 🈳🈳🈳🈳🈳🌪🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💯 122 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 123 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💮 124 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💮 125 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 126 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💯 127 | """ 128 | 129 | type M41 130 | = """ 131 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 132 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💮 133 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💮 134 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 135 | 🈳🈳🈳🈳🌪🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳💯 136 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🌪 137 | 🈳 138 | 🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥🔥 139 | """ 140 | -------------------------------------------------------------------------------- /example/emodius/Class/Object.purs: -------------------------------------------------------------------------------- 1 | module Class.Object where 2 | 3 | import Prelude 4 | import Emo8.Game.Draw (Draw) 5 | import Types (Pos) 6 | 7 | class Object s where 8 | size :: s -> Int 9 | position :: s -> Pos 10 | 11 | class 12 | Object s <= ObjectDraw s where 13 | draw :: s -> Draw Unit 14 | -------------------------------------------------------------------------------- /example/emodius/Collision.purs: -------------------------------------------------------------------------------- 1 | module Collision where 2 | 3 | import Class.Object (class Object, position, size) 4 | import Control.Monad.Gen (Size) 5 | import Emo8.Game.Update (Update, isOutOfCanvas) 6 | import Emo8.Util.Collide (isCollide) 7 | import Types (Pos) 8 | 9 | isOutOfWorld :: forall a. Object a => a -> Update Boolean 10 | isOutOfWorld o = isOut (size o) (position o) 11 | 12 | isOut :: Size -> Pos -> Update Boolean 13 | isOut size { x, y } = isOutOfCanvas size x y 14 | 15 | isCollideObjects :: forall a b. Object a => Object b => a -> b -> Boolean 16 | isCollideObjects a b = isColl (size a) (position a) (size b) (position b) 17 | 18 | isColl :: Size -> Pos -> Size -> Pos -> Boolean 19 | isColl sizeA pA sizeB pB = isCollide sizeA pA.x pA.y sizeB pB.x pB.y 20 | -------------------------------------------------------------------------------- /example/emodius/Constants.purs: -------------------------------------------------------------------------------- 1 | module Constants where 2 | 3 | import Emo8.Type (Rect) 4 | 5 | speed :: Int 6 | speed = 2 7 | 8 | emoSize :: Int 9 | emoSize = 32 10 | 11 | mapSize :: Int 12 | mapSize = 32 13 | 14 | canvasSize :: Rect 15 | canvasSize = 16 | { width: 512 17 | , height: 512 18 | } 19 | -------------------------------------------------------------------------------- /example/emodius/Data/Bullet.purs: -------------------------------------------------------------------------------- 1 | module Data.Bullet where 2 | 3 | import Prelude 4 | import Class.Object (class ObjectDraw, class Object, position, size) 5 | import Constants (emoSize) 6 | import Emo8.Data.Emoji as E 7 | import Emo8.Game.Draw (emo, emor) 8 | import Types (Pos) 9 | 10 | data Bullet 11 | = Normal { pos :: Pos } 12 | | Upper { pos :: Pos } 13 | | Downer { pos :: Pos } 14 | 15 | instance objectBullet :: Object Bullet where 16 | size _ = emoSize 17 | position (Normal s) = s.pos 18 | position (Upper s) = s.pos 19 | position (Downer s) = s.pos 20 | 21 | instance objectDrawBullet :: ObjectDraw Bullet where 22 | draw o = emoF E.spiderWeb (size o) (position o).x (position o).y 23 | where 24 | emoF = case o of 25 | Normal _ -> emo 26 | Upper _ -> (emor 30) 27 | Downer _ -> (emor (-30)) 28 | 29 | updateBullet :: Bullet -> Bullet 30 | updateBullet (Normal s) = Normal $ s { pos { x = s.pos.x + 5 } } 31 | 32 | updateBullet (Upper s) = Upper $ s { pos { x = s.pos.x + 5, y = s.pos.y + 5 } } 33 | 34 | updateBullet (Downer s) = Downer $ s { pos { x = s.pos.x + 5, y = s.pos.y - 5 } } 35 | -------------------------------------------------------------------------------- /example/emodius/Data/Enemy.purs: -------------------------------------------------------------------------------- 1 | module Data.Enemy where 2 | 3 | import Prelude 4 | import Class.Object (class ObjectDraw, class Object, position, size) 5 | import Constants (canvasSize, emoSize, speed) 6 | import Data.EnemyBullet (EnemyBullet(..)) 7 | import Data.Player (Player(..)) 8 | import Emo8.Data.Emoji as E 9 | import Emo8.Game.Draw (emo) 10 | import Types (Pos) 11 | 12 | data Enemy 13 | = Invader { pos :: Pos } 14 | | Bee { pos :: Pos } 15 | | Rex { pos :: Pos, cnt :: Int } 16 | | Moi { pos :: Pos, cnt :: Int } 17 | | Oct { pos :: Pos } 18 | 19 | instance objectEnemy :: Object Enemy where 20 | size _ = emoSize 21 | position (Invader s) = s.pos 22 | position (Moi s) = s.pos 23 | position (Bee s) = s.pos 24 | position (Rex s) = s.pos 25 | position (Oct s) = s.pos 26 | 27 | instance objectDrawEnemy :: ObjectDraw Enemy where 28 | draw o@(Invader _) = emo E.alienMonster (size o) (position o).x (position o).y 29 | draw o@(Moi _) = emo E.moai (size o) (position o).x (position o).y 30 | draw o@(Bee _) = emo E.honeybee (size o) (position o).x (position o).y 31 | draw o@(Rex _) = emo E.tRex (size o) (position o).x (position o).y 32 | draw o@(Oct _) = emo E.octopus (size o) (position o).x (position o).y 33 | 34 | updateEnemy :: Player -> Enemy -> Enemy 35 | updateEnemy p@(Player _) e@(Invader s) = switch 36 | where 37 | switch 38 | | v.y > 0 = Invader $ s { pos { x = s.pos.x - 3, y = s.pos.y - 1 } } 39 | | v.y < 0 = Invader $ s { pos { x = s.pos.x - 3, y = s.pos.y + 1 } } 40 | | otherwise = Invader $ s { pos { x = s.pos.x - 3 } } 41 | 42 | v = diffVec e p 43 | 44 | updateEnemy _ (Moi s) 45 | | mod s.cnt 32 < 16 = Moi $ s { pos { x = s.pos.x - 2, y = s.pos.y - 2 }, cnt = s.cnt + 1 } 46 | | otherwise = Moi $ s { pos { x = s.pos.x - 4, y = s.pos.y + 2 }, cnt = s.cnt + 1 } 47 | 48 | updateEnemy _ (Bee s) = Bee $ s { pos { x = s.pos.x - 6 } } 49 | 50 | updateEnemy (Player p) (Rex s) 51 | | mod s.cnt 32 < 16 = Rex $ s { pos { x = s.pos.x - speed, y = s.pos.y + 4 }, cnt = s.cnt + 1 } 52 | | otherwise = Rex $ s { pos { x = s.pos.x - speed, y = s.pos.y - 4 }, cnt = s.cnt + 1 } 53 | 54 | updateEnemy _ o@(Oct s) 55 | | s.pos.x > canvasSize.width / 2 = Oct $ s { pos { x = s.pos.x - speed } } 56 | | otherwise = o 57 | 58 | addEnemyBullet :: Player -> Enemy -> Array EnemyBullet 59 | addEnemyBullet _ (Moi s) 60 | | mod s.cnt 16 == 0 = [ NormalBull { pos: s.pos } ] 61 | | otherwise = [] 62 | 63 | addEnemyBullet p e@(Rex s) 64 | | mod s.cnt 32 == 16 = [ ParseBull { pos: s.pos, vec: v', t: 0 } ] 65 | where 66 | v = diffVec p e 67 | 68 | v' = { x: v.x / 128, y: v.y / 128 } 69 | | otherwise = [] 70 | 71 | addEnemyBullet _ _ = [] 72 | 73 | diffVec :: forall a b. Object a => Object b => a -> b -> Pos 74 | diffVec a b = { x: (position a).x - (position b).x, y: (position a).y - (position b).y } 75 | 76 | emergeTable :: Int -> Array Enemy 77 | emergeTable = case _ of 78 | 200 -> [ Invader { pos: { x: canvasSize.width, y: 250 } } ] 79 | 250 -> 80 | [ Invader { pos: { x: canvasSize.width, y: 400 } } 81 | , Invader { pos: { x: canvasSize.width, y: 150 } } 82 | ] 83 | 700 -> [ Invader { pos: { x: canvasSize.width, y: 250 } } ] 84 | 750 -> 85 | [ Invader { pos: { x: canvasSize.width, y: 400 } } 86 | , Invader { pos: { x: canvasSize.width, y: 150 } } 87 | ] 88 | 1250 -> 89 | [ Invader { pos: { x: canvasSize.width, y: 250 } } 90 | , Invader { pos: { x: canvasSize.width, y: 350 } } 91 | , Invader { pos: { x: canvasSize.width, y: 450 } } 92 | , Invader { pos: { x: canvasSize.width, y: 150 } } 93 | , Invader { pos: { x: canvasSize.width, y: 50 } } 94 | ] 95 | -- second: 2048 96 | 2000 -> [ Bee { pos: { x: canvasSize.width, y: 400 } } ] 97 | 2250 -> [ Bee { pos: { x: canvasSize.width, y: 250 } } ] 98 | 2500 -> [ Bee { pos: { x: canvasSize.width, y: 100 } } ] 99 | 3000 -> 100 | [ Bee { pos: { x: canvasSize.width, y: 400 } } 101 | , Bee { pos: { x: canvasSize.width, y: 250 } } 102 | , Bee { pos: { x: canvasSize.width, y: 100 } } 103 | ] 104 | 3250 -> 105 | [ Bee { pos: { x: canvasSize.width, y: 450 } } 106 | , Bee { pos: { x: canvasSize.width, y: 300 } } 107 | , Bee { pos: { x: canvasSize.width, y: 150 } } 108 | ] 109 | -- third: 4096 110 | 4000 -> [ Rex { pos: { x: canvasSize.width, y: emoSize }, cnt: 0 } ] 111 | 4250 -> [ Rex { pos: { x: canvasSize.width, y: emoSize }, cnt: 0 } ] 112 | 5000 -> [ Rex { pos: { x: canvasSize.width, y: emoSize }, cnt: 0 } ] 113 | 5250 -> [ Rex { pos: { x: canvasSize.width, y: emoSize }, cnt: 0 } ] 114 | -- forth: 6144 115 | 6000 -> [ Moi { pos: { x: canvasSize.width, y: 250 }, cnt: 0 } ] 116 | 6250 -> [ Moi { pos: { x: canvasSize.width, y: 400 }, cnt: 0 } ] 117 | 6500 -> [ Moi { pos: { x: canvasSize.width, y: 100 }, cnt: 0 } ] 118 | 7000 -> 119 | [ Moi { pos: { x: canvasSize.width, y: 250 }, cnt: 0 } 120 | , Moi { pos: { x: canvasSize.width, y: 400 }, cnt: 0 } 121 | , Moi { pos: { x: canvasSize.width, y: 100 }, cnt: 0 } 122 | ] 123 | -- fifth: 8192 124 | 8000 -> [ Oct { pos: { x: canvasSize.width, y: 250 } } ] 125 | _ -> [] 126 | -------------------------------------------------------------------------------- /example/emodius/Data/EnemyBullet.purs: -------------------------------------------------------------------------------- 1 | module Data.EnemyBullet where 2 | 3 | import Prelude 4 | import Class.Object (class ObjectDraw, class Object, position, size) 5 | import Constants (emoSize) 6 | import Emo8.Data.Emoji as E 7 | import Emo8.Game.Draw (emor) 8 | import Types (Pos) 9 | 10 | data EnemyBullet 11 | = NormalBull { pos :: Pos } 12 | | ParseBull { pos :: Pos, vec :: Pos, t :: Int } 13 | 14 | instance objectEnemyBullet :: Object EnemyBullet where 15 | size _ = emoSize / 2 16 | position (NormalBull s) = s.pos 17 | position (ParseBull s) = s.pos 18 | 19 | instance objectDrawEnemyBullet :: ObjectDraw EnemyBullet where 20 | draw o@(NormalBull _) = emor (-40) E.pushpin (size o) (position o).x (position o).y 21 | draw o@(ParseBull s) = emor (10 * s.t) E.hammer (size o) (position o).x (position o).y 22 | 23 | updateEnemyBullet :: EnemyBullet -> EnemyBullet 24 | updateEnemyBullet (NormalBull s) = NormalBull $ s { pos { x = s.pos.x - 6 } } 25 | 26 | updateEnemyBullet (ParseBull s) = ParseBull $ s { pos { x = s.pos.x + s.vec.x, y = s.pos.y + s.vec.y }, t = s.t + 1 } 27 | -------------------------------------------------------------------------------- /example/emodius/Data/Particle.purs: -------------------------------------------------------------------------------- 1 | module Data.Particle where 2 | 3 | import Prelude 4 | import Class.Object (class ObjectDraw, class Object, position, size) 5 | import Constants (emoSize) 6 | import Emo8.Data.Emoji as E 7 | import Emo8.Game.Draw (emo) 8 | import Types (Pos) 9 | 10 | data Particle 11 | = Normal 12 | { pos :: Pos 13 | } 14 | 15 | instance objectParticle :: Object Particle where 16 | size _ = emoSize 17 | position (Normal s) = s.pos 18 | 19 | instance objectDrawParticle :: ObjectDraw Particle where 20 | draw o = emo E.globeWithMeridians (size o) (position o).x (position o).y 21 | 22 | updateParticle :: Particle -> Particle 23 | updateParticle (Normal s) = Normal $ s { pos { y = s.pos.y - 2 } } 24 | 25 | initParticle :: Pos -> Particle 26 | initParticle pos = Normal { pos: pos } 27 | -------------------------------------------------------------------------------- /example/emodius/Data/Player.purs: -------------------------------------------------------------------------------- 1 | module Data.Player where 2 | 3 | import Prelude 4 | import Class.Object (class Object, class ObjectDraw, position, size) 5 | import Constants (canvasSize, emoSize) 6 | import Data.Bullet (Bullet(..)) 7 | import Emo8.Data.Emoji as E 8 | import Emo8.Data.Input (Input) 9 | import Emo8.Game.Draw (emo', emor') 10 | import Types (Pos) 11 | 12 | data Player 13 | = Player 14 | { pos :: Pos 15 | , energy :: Int 16 | , appear :: Appear 17 | } 18 | 19 | data Appear 20 | = Stable 21 | | Forword 22 | | Backword 23 | 24 | instance objectPlayer :: Object Player where 25 | size _ = emoSize 26 | position (Player s) = s.pos 27 | 28 | instance objectDrawPlayer :: ObjectDraw Player where 29 | draw o@(Player p) = emoF E.helicopter (size o) (position o).x (position o).y 30 | where 31 | emoF = case p.appear of 32 | Stable -> emo' 33 | Forword -> emor' (-30) 34 | Backword -> emor' 30 35 | 36 | updatePlayer :: Input -> Player -> Player 37 | updatePlayer i (Player s) = 38 | Player 39 | $ s 40 | { pos = newPos 41 | , energy = newEnergy 42 | , appear = newAppear 43 | } 44 | where 45 | newPos = updatePos i s.pos 46 | 47 | newEnergy = case canEmit s.energy, i.isW || i.isS || i.isD of 48 | true, true -> 0 49 | true, false -> s.energy 50 | false, _ -> s.energy + 1 51 | 52 | newAppear = case i.isLeft, i.isRight of 53 | true, false -> Backword 54 | false, true -> Forword 55 | _, _ -> Stable 56 | 57 | updatePos :: Input -> Pos -> Pos 58 | updatePos i p = { x: nx, y: ny } 59 | where 60 | nx = case i.isLeft, i.isRight of 61 | true, false -> p.x - 4 62 | false, true -> p.x + 4 63 | _, _ -> p.x 64 | 65 | ny = case i.isUp, i.isDown of 66 | true, false -> p.y + 4 67 | false, true -> p.y - 4 68 | _, _ -> p.y 69 | 70 | addBullet :: Input -> Player -> Array Bullet 71 | addBullet i (Player p) = case canEmit p.energy of 72 | true 73 | | i.isW -> [ Upper { pos: p.pos } ] 74 | | i.isS -> [ Downer { pos: p.pos } ] 75 | | i.isD -> [ Normal { pos: p.pos } ] 76 | _ -> [] 77 | 78 | initialPlayer :: Player 79 | initialPlayer = 80 | Player 81 | { pos: 82 | { x: 0 83 | , y: canvasSize.height / 2 84 | } 85 | , energy: 30 86 | , appear: Stable 87 | } 88 | 89 | canEmit :: Int -> Boolean 90 | canEmit e = e > 29 91 | -------------------------------------------------------------------------------- /example/emodius/Helper.purs: -------------------------------------------------------------------------------- 1 | module Helper where 2 | 3 | import Prelude 4 | import Asset (stage1, stage2, stage3, stage4, walls) 5 | import Class.Object (class Object, position, size) 6 | import Constants (canvasSize, mapSize) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Player (Player(..)) 9 | import Emo8.Game.Draw (Draw, emap) 10 | import Emo8.Game.Update (Update, getCanvasSize) 11 | import Emo8.Util.Collide (isCollideMap, sinkCanvas) 12 | 13 | beInMonitor :: Player -> Update Player 14 | beInMonitor player@(Player p) = do 15 | r <- getCanvasSize 16 | pure case sinkCanvas r psize ppos.x ppos.y of 17 | Just sink -> Player $ p { pos { x = ppos.x - sink.x, y = ppos.y - sink.y } } 18 | Nothing -> player 19 | where 20 | ppos = position player 21 | 22 | psize = size player 23 | 24 | -- TODO: readable 25 | drawScrollMap :: Int -> Draw Unit 26 | drawScrollMap d = do 27 | when (mapCond.s1 d) 28 | $ emapF stage1 0 29 | when (mapCond.s2 d) 30 | $ emapF stage2 2048 31 | when (mapCond.s3 d) 32 | $ emapF stage3 4096 33 | when (mapCond.s4 d) 34 | $ emapF stage4 6144 35 | where 36 | emapF a bias = 37 | emap 38 | a 39 | mapSize 40 | (bias - d) 41 | 0 42 | 43 | -- TODO: readable 44 | isCollideScrollMap :: forall a. Object a => Int -> a -> Boolean 45 | isCollideScrollMap d o = 46 | let 47 | s1 = 48 | (mapCond.s1 d) 49 | && (isCollF stage1 0) 50 | 51 | s2 = 52 | (mapCond.s2 d) 53 | && (isCollF stage2 2048) 54 | 55 | s3 = 56 | (mapCond.s3 d) 57 | && (isCollF stage3 4096) 58 | 59 | s4 = 60 | (mapCond.s4 d) 61 | && (isCollF stage4 6144) 62 | in 63 | s1 || s2 || s3 || s4 64 | where 65 | isCollF a bias = 66 | isCollideMap 67 | a 68 | mapSize 69 | walls 70 | (size o) 71 | ((position o).x + (d - bias)) 72 | (position o).y 73 | 74 | mapCond :: 75 | { s1 :: Int -> Boolean 76 | , s2 :: Int -> Boolean 77 | , s3 :: Int -> Boolean 78 | , s4 :: Int -> Boolean 79 | } 80 | mapCond = 81 | { s1: \d -> d < 2048 82 | , s2: \d -> 2048 - canvasSize.width <= d && d < 4096 83 | , s3: \d -> 4096 - canvasSize.width <= d && d < 6144 84 | , s4: \d -> 6144 - canvasSize.width <= d && d < 8192 85 | } 86 | -------------------------------------------------------------------------------- /example/emodius/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | import Class.Object (class Object, draw, position) 5 | import Collision (isCollideObjects, isOutOfWorld) 6 | import Constants (canvasSize, speed) 7 | import Data.Array (any, filter, filterA, partition) 8 | import Data.Bullet (Bullet, updateBullet) 9 | import Data.Enemy (Enemy(..), addEnemyBullet, emergeTable, updateEnemy) 10 | import Data.EnemyBullet (EnemyBullet, updateEnemyBullet) 11 | import Data.Foldable (traverse_) 12 | import Data.Particle (Particle, initParticle, updateParticle) 13 | import Data.Player (Player, addBullet, initialPlayer, updatePlayer) 14 | import Effect (Effect) 15 | import Emo8 (emo8) 16 | import Emo8.Data.Color as C 17 | import Emo8.Data.Emoji as E 18 | import Emo8.Data.Input (Input) 19 | import Emo8.Game (class Game) 20 | import Emo8.Game.Draw (cls, emo, emor, emor') 21 | import Emo8.Game.Update (Update) 22 | import Emo8.Util.Input (anyInput, catchInput, everyInput) 23 | import Helper (beInMonitor, drawScrollMap, isCollideScrollMap) 24 | 25 | data State 26 | = TitleState 27 | { prevInput :: Input } 28 | | OverState 29 | { prevInput :: Input } 30 | | ClearState 31 | { prevInput :: Input } 32 | | PlayState 33 | { distance :: Int 34 | , player :: Player 35 | , bullets :: Array Bullet 36 | , enemies :: Array Enemy 37 | , particles :: Array Particle 38 | , enemyBullets :: Array EnemyBullet 39 | , trans :: Trans 40 | } 41 | 42 | data Trans 43 | = Continue 44 | | GameClear 45 | | GameOver 46 | 47 | instance gameState :: Game State where 48 | update input = case _ of 49 | TitleState s 50 | | catchAny s -> pure initialPlayState 51 | | otherwise -> pure $ TitleState { prevInput: input } 52 | OverState s 53 | | catchAny s -> pure initialState 54 | | otherwise -> pure $ OverState { prevInput: input } 55 | ClearState s 56 | | catchAny s -> pure initialState 57 | | otherwise -> pure $ ClearState { prevInput: input } 58 | PlayState s -> do 59 | ns <- system s 60 | pure case ns.trans of 61 | GameClear -> ClearState { prevInput: input } 62 | GameOver -> OverState { prevInput: input } 63 | Continue -> PlayState ns 64 | where 65 | system = 66 | deleteOutObjects 67 | <=< playerInCanvas 68 | <<< addDistance 69 | <<< shootEnemy 70 | <<< gameClear 71 | <<< gameOver 72 | <<< movement 73 | <<< newPlayerBullet 74 | <<< newEnemyBullet 75 | <<< newEnemies 76 | 77 | newEnemies d = d { enemies = d.enemies <> emergeTable d.distance } 78 | 79 | newEnemyBullet d = d { enemyBullets = d.enemyBullets <> (addEnemyBullet s.player =<< d.enemies) } 80 | 81 | newPlayerBullet d = d { bullets = d.bullets <> addBullet input s.player } 82 | 83 | movement d = 84 | d 85 | { player = updatePlayer input d.player 86 | , bullets = updateBullet <$> d.bullets 87 | , enemies = updateEnemy s.player <$> d.enemies 88 | , particles = updateParticle <$> d.particles 89 | , enemyBullets = updateEnemyBullet <$> d.enemyBullets 90 | } 91 | 92 | gameOver d = check 93 | where 94 | check 95 | | isMapColl || isEnemyColl || isEnemyBulletColl = d { trans = GameOver } 96 | | otherwise = d 97 | 98 | isMapColl = isCollideScrollMap s.distance d.player 99 | 100 | isEnemyColl = anyColl d.player d.enemies 101 | 102 | isEnemyBulletColl = anyColl d.player d.enemyBullets 103 | 104 | gameClear d = check 105 | where 106 | check 107 | | any isCatchBoss collidedEnemies = d { trans = GameClear } 108 | | otherwise = d 109 | 110 | collidedEnemies = filter (anyCollFlip d.bullets) d.enemies 111 | 112 | isCatchBoss (Oct _) = true 113 | 114 | isCatchBoss _ = false 115 | 116 | shootEnemy d = 117 | d 118 | { enemies = notCollidedEnemies 119 | , particles = d.particles <> map (initParticle <<< position) collidedEnemies 120 | , bullets = notCollidedBullets 121 | } 122 | where 123 | { yes: collidedEnemies, no: notCollidedEnemies } = partition (anyCollFlip d.bullets) d.enemies 124 | 125 | { yes: _, no: notCollidedBullets } = partition (anyCollFlip d.enemies) d.bullets 126 | 127 | addDistance d = d { distance = d.distance + speed } 128 | 129 | playerInCanvas d = do 130 | player' <- beInMonitor d.player 131 | pure d { player = player' } 132 | 133 | deleteOutObjects d = do 134 | enemies' <- f d.enemies 135 | particles' <- f d.particles 136 | bullets' <- f d.bullets 137 | enemyBullets' <- f d.enemyBullets 138 | pure 139 | d 140 | { enemies = enemies' 141 | , particles = particles' 142 | , bullets = bullets' 143 | , enemyBullets = enemyBullets' 144 | } 145 | where 146 | f :: forall a. Object a => Array a -> Update (Array a) 147 | f = filterA (pure <<< not <=< isOutOfWorld) 148 | 149 | anyColl :: forall a b. Object a => Object b => a -> Array b -> Boolean 150 | anyColl = any <<< isCollideObjects 151 | 152 | anyCollFlip :: forall a b. Object a => Object b => Array b -> a -> Boolean 153 | anyCollFlip = flip anyColl 154 | where 155 | catchAny s = anyInput $ catchInput s.prevInput input 156 | draw (TitleState _) = do 157 | cls C.aqua 158 | emor' 30 E.helicopter 192 50 50 159 | emo E.spiderWeb 256 200 200 160 | emor (-15) E.octopus 128 300 300 161 | emo E.pill 64 150 400 162 | emor 75 E.pill 64 100 300 163 | emo E.fastForwardButton 64 350 100 164 | draw (OverState _) = do 165 | cls C.maroon 166 | emo E.hole 256 125 150 167 | emor 160 E.helicopter 128 175 200 168 | emo E.recyclingSymbol 128 185 350 169 | draw (ClearState _) = do 170 | cls C.lime 171 | emor 15 E.helicopter 64 350 400 172 | emor (-15) E.octopus 128 175 175 173 | emo E.globeWithMeridians 256 75 75 174 | emo E.thumbsUp 64 100 400 175 | draw (PlayState s) = do 176 | cls C.aqua 177 | drawScrollMap s.distance 178 | draw s.player 179 | traverse_ draw s.bullets 180 | traverse_ draw s.enemies 181 | traverse_ draw s.particles 182 | traverse_ draw s.enemyBullets 183 | sound _ = pure unit 184 | 185 | initialPlayState :: State 186 | initialPlayState = 187 | PlayState 188 | { distance: 0 189 | , player: initialPlayer 190 | , bullets: [] 191 | , enemies: [] 192 | , particles: [] 193 | , enemyBullets: [] 194 | , trans: Continue 195 | } 196 | 197 | initialState :: State 198 | initialState = TitleState { prevInput: everyInput } 199 | 200 | main :: Effect Unit 201 | main = do 202 | emo8 initialState conf 203 | where 204 | conf = 205 | { canvasSize: canvasSize 206 | , retina: true 207 | } 208 | -------------------------------------------------------------------------------- /example/emodius/Types.purs: -------------------------------------------------------------------------------- 1 | module Types where 2 | 3 | type Pos 4 | = { x :: Int 5 | , y :: Int 6 | } 7 | -------------------------------------------------------------------------------- /example/hello/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | import Effect (Effect) 5 | import Emo8 (emo8) 6 | import Emo8.Data.Color as C 7 | import Emo8.Data.Emoji as E 8 | import Emo8.Game (class Game) 9 | import Emo8.Game.Draw (cls, emo) 10 | import Emo8.Util.Config (defaultConfig) 11 | 12 | data State 13 | = Void 14 | 15 | instance gameState :: Game State where 16 | update _ = pure 17 | draw _ = do 18 | cls C.maroon 19 | emo E.hatchingChick 128 192 192 20 | sound _ = pure unit 21 | 22 | main :: Effect Unit 23 | main = emo8 Void defaultConfig 24 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "name": "purescript-emo8", 4 | "license": "MIT", 5 | "scripts": { 6 | "clean": "rimraf dist output generated-docs .spago .cache .psci_modules", 7 | "build:lib": "spago build", 8 | "build:example:hello": "spago build --path example/hello/Main.purs", 9 | "build:example:basic": "spago build --path example/basic/Main.purs", 10 | "build:example:emodius": "spago build --path \"example/emodius/**/*.purs\"", 11 | "build:example": "run-s build:example:*", 12 | "build": "run-s build:*", 13 | "bundle:example:hello:js": "spago bundle-app --path example/hello/Main.purs --to dist/example/hello/index.js", 14 | "bundle:example:hello:css": "cpx asset/index.css dist/example/hello", 15 | "bundle:example:hello:html": "cpx asset/index.html dist/example/hello", 16 | "bundle:example:hello": "run-s bundle:example:hello:*", 17 | "bundle:example:basic:js": "spago bundle-app --path example/basic/Main.purs --to dist/example/basic/index.js", 18 | "bundle:example:basic:css": "cpx asset/index.css dist/example/basic", 19 | "bundle:example:basic:html": "cpx asset/index.html dist/example/basic", 20 | "bundle:example:basic": "run-s bundle:example:basic:*", 21 | "bundle:example:emodius:js": "spago bundle-app --path \"example/emodius/**/*.purs\" --to dist/example/emodius/index.js", 22 | "bundle:example:emodius:css": "cpx asset/index.css dist/example/emodius", 23 | "bundle:example:emodius:html": "cpx asset/index.html dist/example/emodius", 24 | "bundle:example:emodius": "run-s bundle:example:emodius:*", 25 | "bundle:example": "run-s bundle:example:*", 26 | "dev": "parcel serve asset/index.html" 27 | }, 28 | "devDependencies": { 29 | "cpx": "^1.5.0", 30 | "npm-run-all": "^4.1.5", 31 | "parcel": "^1.12.4", 32 | "purescript": "^0.13.6", 33 | "rimraf": "^3.0.2", 34 | "spago": "^0.15.2" 35 | } 36 | } -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200404/packages.dhall sha256:f239f2e215d0cbd5c203307701748581938f74c4c78f4aeffa32c11c131ef7b6 3 | 4 | let overrides = {=} 5 | 6 | let additions = 7 | { webaudio = 8 | { dependencies = 9 | ["arraybuffer", "web-html"] 10 | , repo = "https://github.com/adkelley/purescript-webaudio" 11 | , version = "v0.2.1" 12 | } 13 | } 14 | 15 | in upstream // overrides // additions 16 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "emo8" 2 | , dependencies = 3 | [ "canvas" 4 | , "console" 5 | , "effect" 6 | , "foreign-generic" 7 | , "lists" 8 | , "record" 9 | , "record-extra" 10 | , "refs" 11 | , "signal" 12 | , "transformers" 13 | , "typelevel-prelude" 14 | , "webaudio" 15 | ] 16 | , packages = ./packages.dhall 17 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 18 | } 19 | -------------------------------------------------------------------------------- /src/Emo8.purs: -------------------------------------------------------------------------------- 1 | module Emo8 2 | ( emo8 3 | , emo8Dev 4 | ) where 5 | 6 | import Prelude 7 | import Audio.WebAudio.BaseAudioContext (newAudioContext) 8 | import Audio.WebAudio.Types (AudioContext, OscillatorNode) 9 | import Data.Int (toNumber) 10 | import Data.List as L 11 | import Data.Map as Map 12 | import Data.Maybe (Maybe(..)) 13 | import Effect (Effect) 14 | import Effect.Class.Console (error) 15 | import Effect.Ref (Ref) 16 | import Effect.Ref as Ref 17 | import Emo8.Data.Draw (runDrawR) 18 | import Emo8.Data.Input (Input) 19 | import Emo8.Data.Sound (runSoundR) 20 | import Emo8.Data.Update (runUpdateR) 21 | import Emo8.FFI.Emo8Retina (emo8Retina) 22 | import Emo8.Game (class Game, draw, sound, update) 23 | import Emo8.GameBoot as B 24 | import Emo8.GameDev (class GameDev, saveState) 25 | import Emo8.GameWithBoot (GameWithBoot(..), switchFoldOp, switchOp) 26 | import Emo8.Input (poll) 27 | import Emo8.Input.Merged (mkInput) 28 | import Emo8.Parser.Type (Score) 29 | import Emo8.Type (Config, Rect) 30 | import Graphics.Canvas (CanvasElement, Context2D, getCanvasElementById, getContext2D, scale, setCanvasHeight, setCanvasWidth) 31 | import Signal (foldp, runSignal, sampleOn) 32 | import Signal.DOM (animationFrame) 33 | 34 | -- | Run the emo8 game. 35 | emo8 :: 36 | forall s. 37 | Game s => 38 | s -> Config -> Effect Unit 39 | emo8 = emo8F run 40 | 41 | -- | Run the emo8 game in development mode. 42 | emo8Dev :: 43 | forall s. 44 | GameDev s => 45 | s -> Config -> Effect Unit 46 | emo8Dev = emo8F runDev 47 | 48 | emo8F :: 49 | forall s. 50 | Game s => 51 | (CanvasElement -> s -> Config -> Effect Unit) -> 52 | s -> Config -> Effect Unit 53 | emo8F f s conf = do 54 | mc <- getCanvasElementById canvasId 55 | case mc of 56 | Nothing -> error "no canvas" 57 | Just c -> do 58 | when conf.retina $ emo8Retina c conf.canvasSize 59 | setCanvasWidth c (scl * toNumber conf.canvasSize.width) 60 | setCanvasHeight c (scl * toNumber conf.canvasSize.height) 61 | f c s conf 62 | where 63 | canvasId = "emo8" 64 | 65 | scl 66 | | conf.retina = 2.0 67 | | otherwise = 1.0 68 | 69 | run :: 70 | forall s. 71 | Game s => 72 | CanvasElement -> s -> Config -> Effect Unit 73 | run c state conf = do 74 | dctx <- getContext2D c 75 | when conf.retina $ scale dctx { scaleX: 2.0, scaleY: 2.0 } 76 | sctx <- newAudioContext 77 | ref <- Ref.new Map.empty 78 | frame <- animationFrame 79 | keySig <- poll 80 | dirSig <- poll 81 | let 82 | inSig = mkInput <$> keySig <*> dirSig 83 | 84 | sig = sampleOn frame inSig 85 | 86 | init = state 87 | 88 | bootInit = B.initialBootState conf.canvasSize 89 | 90 | biState = GameWithBoot init bootInit 91 | 92 | biStateSig = 93 | foldp 94 | ( switchFoldOp 95 | (updateF conf.canvasSize) 96 | (updateF conf.canvasSize) 97 | ) 98 | biState 99 | sig 100 | runSignal 101 | $ switchOp 102 | (drawF dctx conf.canvasSize) 103 | (drawF dctx conf.canvasSize) 104 | <$> biStateSig 105 | runSignal 106 | $ switchOp 107 | (soundF sctx ref) 108 | (soundF sctx ref) 109 | <$> biStateSig 110 | 111 | runDev :: 112 | forall s. 113 | GameDev s => 114 | CanvasElement -> s -> Config -> Effect Unit 115 | runDev c state conf = do 116 | dctx <- getContext2D c 117 | when conf.retina $ scale dctx { scaleX: 2.0, scaleY: 2.0 } 118 | sctx <- newAudioContext 119 | ref <- Ref.new Map.empty 120 | frame <- animationFrame 121 | keySig <- poll 122 | dirSig <- poll 123 | let 124 | inSig = mkInput <$> keySig <*> dirSig 125 | 126 | sig = sampleOn frame inSig 127 | 128 | init = state 129 | 130 | stSig = foldp (updateF conf.canvasSize) init sig 131 | runSignal $ drawF dctx conf.canvasSize <$> stSig 132 | runSignal $ soundF sctx ref <$> stSig 133 | runSignal $ saveState <$> stSig 134 | 135 | updateF :: 136 | forall s. 137 | Game s => 138 | Rect -> Input -> s -> s 139 | updateF rect i s = runUpdateR (update i s) { canvasSize: rect } 140 | 141 | drawF :: 142 | forall s. 143 | Game s => 144 | Context2D -> Rect -> s -> Effect Unit 145 | drawF ctx rect s = runDrawR (draw s) { ctx: ctx, canvasSize: rect } 146 | 147 | soundF :: 148 | forall s. 149 | Game s => 150 | AudioContext -> Ref (Map.Map Score (L.List OscillatorNode)) -> s -> Effect Unit 151 | soundF ctx ref s = runSoundR (sound s) { ctx: ctx, ref: ref } 152 | -------------------------------------------------------------------------------- /src/Emo8/Data/Color.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Color 2 | ( Color 3 | , aliceBlue 4 | , antiqueWhite 5 | , aqua 6 | , aquamarine 7 | , azure 8 | , beige 9 | , bisque 10 | , black 11 | , blanchedAlmond 12 | , blue 13 | , blueViolet 14 | , brown 15 | , burlyWood 16 | , cadetBlue 17 | , chartreuse 18 | , chocolate 19 | , coral 20 | , cornflowerBlue 21 | , cornsilk 22 | , crimson 23 | , cyan 24 | , darkBlue 25 | , darkCyan 26 | , darkGoldenRod 27 | , darkGray 28 | , darkGreen 29 | , darkKhaki 30 | , darkMagenta 31 | , darkOliveGreen 32 | , darkOrange 33 | , darkOrchid 34 | , darkRed 35 | , darkSalmon 36 | , darkSeaGreen 37 | , darkSlateBlue 38 | , darkSlateGray 39 | , darkTurquoise 40 | , darkViolet 41 | , deepPink 42 | , deepSkyBlue 43 | , dimGray 44 | , dodgerBlue 45 | , fireBrick 46 | , floralWhite 47 | , forestGreen 48 | , fuchsia 49 | , gainsboro 50 | , ghostWhite 51 | , gold 52 | , goldenRod 53 | , gray 54 | , green 55 | , greenYellow 56 | , honeyDew 57 | , hotPink 58 | , indianRed 59 | , indigo 60 | , ivory 61 | , khaki 62 | , lavender 63 | , lavenderBlush 64 | , lawnGreen 65 | , lemonChiffon 66 | , lightBlue 67 | , lightCoral 68 | , lightCyan 69 | , lightGoldenRodYellow 70 | , lightGray 71 | , lightGreen 72 | , lightPink 73 | , lightSalmon 74 | , lightSeaGreen 75 | , lightSkyBlue 76 | , lightSlateGray 77 | , lightSteelBlue 78 | , lightYellow 79 | , lime 80 | , limeGreen 81 | , linen 82 | , magenta 83 | , maroon 84 | , mediumAquaMarine 85 | , mediumBlue 86 | , mediumOrchid 87 | , mediumPurple 88 | , mediumSeaGreen 89 | , mediumSlateBlue 90 | , mediumSpringGreen 91 | , mediumTurquoise 92 | , mediumVioletRed 93 | , midnightBlue 94 | , mintCream 95 | , mistyRose 96 | , moccasin 97 | , navajoWhite 98 | , navy 99 | , oldLace 100 | , olive 101 | , oliveDrab 102 | , orange 103 | , orangeRed 104 | , orchid 105 | , paleGoldenRod 106 | , paleGreen 107 | , paleTurquoise 108 | , paleVioletRed 109 | , papayaWhip 110 | , peachPuff 111 | , peru 112 | , pink 113 | , plum 114 | , powderBlue 115 | , purple 116 | , rebeccaPurple 117 | , red 118 | , rosyBrown 119 | , royalBlue 120 | , saddleBrown 121 | , salmon 122 | , sandyBrown 123 | , seaGreen 124 | , seaShell 125 | , sienna 126 | , silver 127 | , skyBlue 128 | , slateBlue 129 | , slateGray 130 | , snow 131 | , springGreen 132 | , steelBlue 133 | , tan 134 | , teal 135 | , thistle 136 | , tomato 137 | , turquoise 138 | , violet 139 | , wheat 140 | , white 141 | , whiteSmoke 142 | , yellow 143 | , yellowGreen 144 | ) where 145 | 146 | import Prelude 147 | 148 | -- | Emo8 color type which supports 140 HTML named colors. 149 | newtype Color 150 | = Color String 151 | 152 | instance showColor :: Show Color where 153 | show (Color s) = s 154 | 155 | -- | #F0F8FF 156 | aliceBlue :: Color 157 | aliceBlue = Color "#F0F8FF" 158 | 159 | -- | #FAEBD7 160 | antiqueWhite :: Color 161 | antiqueWhite = Color "#FAEBD7" 162 | 163 | -- | #00FFFF 164 | aqua :: Color 165 | aqua = Color "#00FFFF" 166 | 167 | -- | #7FFFD4 168 | aquamarine :: Color 169 | aquamarine = Color "#7FFFD4" 170 | 171 | -- | #F0FFFF 172 | azure :: Color 173 | azure = Color "#F0FFFF" 174 | 175 | -- | #F5F5DC 176 | beige :: Color 177 | beige = Color "#F5F5DC" 178 | 179 | -- | #FFE4C4 180 | bisque :: Color 181 | bisque = Color "#FFE4C4" 182 | 183 | -- | #000000 184 | black :: Color 185 | black = Color "#000000" 186 | 187 | -- | #FFEBCD 188 | blanchedAlmond :: Color 189 | blanchedAlmond = Color "#FFEBCD" 190 | 191 | -- | #0000FF 192 | blue :: Color 193 | blue = Color "#0000FF" 194 | 195 | -- | #8A2BE2 196 | blueViolet :: Color 197 | blueViolet = Color "#8A2BE2" 198 | 199 | -- | #A52A2A 200 | brown :: Color 201 | brown = Color "#A52A2A" 202 | 203 | -- | #DEB887 204 | burlyWood :: Color 205 | burlyWood = Color "#DEB887" 206 | 207 | -- | #5F9EA0 208 | cadetBlue :: Color 209 | cadetBlue = Color "#5F9EA0" 210 | 211 | -- | #7FFF00 212 | chartreuse :: Color 213 | chartreuse = Color "#7FFF00" 214 | 215 | -- | #D2691E 216 | chocolate :: Color 217 | chocolate = Color "#D2691E" 218 | 219 | -- | #FF7F50 220 | coral :: Color 221 | coral = Color "#FF7F50" 222 | 223 | -- | #6495ED 224 | cornflowerBlue :: Color 225 | cornflowerBlue = Color "#6495ED" 226 | 227 | -- | #FFF8DC 228 | cornsilk :: Color 229 | cornsilk = Color "#FFF8DC" 230 | 231 | -- | #DC143C 232 | crimson :: Color 233 | crimson = Color "#DC143C" 234 | 235 | -- | #00FFFF 236 | cyan :: Color 237 | cyan = Color "#00FFFF" 238 | 239 | -- | #00008B 240 | darkBlue :: Color 241 | darkBlue = Color "#00008B" 242 | 243 | -- | #008B8B 244 | darkCyan :: Color 245 | darkCyan = Color "#008B8B" 246 | 247 | -- | #B8860B 248 | darkGoldenRod :: Color 249 | darkGoldenRod = Color "#B8860B" 250 | 251 | -- | #A9A9A9 252 | darkGray :: Color 253 | darkGray = Color "#A9A9A9" 254 | 255 | -- | #006400 256 | darkGreen :: Color 257 | darkGreen = Color "#006400" 258 | 259 | -- | #BDB76B 260 | darkKhaki :: Color 261 | darkKhaki = Color "#BDB76B" 262 | 263 | -- | #8B008B 264 | darkMagenta :: Color 265 | darkMagenta = Color "#8B008B" 266 | 267 | -- | #556B2F 268 | darkOliveGreen :: Color 269 | darkOliveGreen = Color "#556B2F" 270 | 271 | -- | #FF8C00 272 | darkOrange :: Color 273 | darkOrange = Color "#FF8C00" 274 | 275 | -- | #9932CC 276 | darkOrchid :: Color 277 | darkOrchid = Color "#9932CC" 278 | 279 | -- | #8B0000 280 | darkRed :: Color 281 | darkRed = Color "#8B0000" 282 | 283 | -- | #E9967A 284 | darkSalmon :: Color 285 | darkSalmon = Color "#E9967A" 286 | 287 | -- | #8FBC8F 288 | darkSeaGreen :: Color 289 | darkSeaGreen = Color "#8FBC8F" 290 | 291 | -- | #483D8B 292 | darkSlateBlue :: Color 293 | darkSlateBlue = Color "#483D8B" 294 | 295 | -- | #2F4F4F 296 | darkSlateGray :: Color 297 | darkSlateGray = Color "#2F4F4F" 298 | 299 | -- | #00CED1 300 | darkTurquoise :: Color 301 | darkTurquoise = Color "#00CED1" 302 | 303 | -- | #9400D3 304 | darkViolet :: Color 305 | darkViolet = Color "#9400D3" 306 | 307 | -- | #FF1493 308 | deepPink :: Color 309 | deepPink = Color "#FF1493" 310 | 311 | -- | #00BFFF 312 | deepSkyBlue :: Color 313 | deepSkyBlue = Color "#00BFFF" 314 | 315 | -- | #696969 316 | dimGray :: Color 317 | dimGray = Color "#696969" 318 | 319 | -- | #1E90FF 320 | dodgerBlue :: Color 321 | dodgerBlue = Color "#1E90FF" 322 | 323 | -- | #B22222 324 | fireBrick :: Color 325 | fireBrick = Color "#B22222" 326 | 327 | -- | #FFFAF0 328 | floralWhite :: Color 329 | floralWhite = Color "#FFFAF0" 330 | 331 | -- | #228B22 332 | forestGreen :: Color 333 | forestGreen = Color "#228B22" 334 | 335 | -- | #FF00FF 336 | fuchsia :: Color 337 | fuchsia = Color "#FF00FF" 338 | 339 | -- | #DCDCDC 340 | gainsboro :: Color 341 | gainsboro = Color "#DCDCDC" 342 | 343 | -- | #F8F8FF 344 | ghostWhite :: Color 345 | ghostWhite = Color "#F8F8FF" 346 | 347 | -- | #FFD700 348 | gold :: Color 349 | gold = Color "#FFD700" 350 | 351 | -- | #DAA520 352 | goldenRod :: Color 353 | goldenRod = Color "#DAA520" 354 | 355 | -- | #808080 356 | gray :: Color 357 | gray = Color "#808080" 358 | 359 | -- | #008000 360 | green :: Color 361 | green = Color "#008000" 362 | 363 | -- | #ADFF2F 364 | greenYellow :: Color 365 | greenYellow = Color "#ADFF2F" 366 | 367 | -- | #F0FFF0 368 | honeyDew :: Color 369 | honeyDew = Color "#F0FFF0" 370 | 371 | -- | #FF69B4 372 | hotPink :: Color 373 | hotPink = Color "#FF69B4" 374 | 375 | -- | #CD5C5C 376 | indianRed :: Color 377 | indianRed = Color "#CD5C5C" 378 | 379 | -- | #4B0082 380 | indigo :: Color 381 | indigo = Color "#4B0082" 382 | 383 | -- | #FFFFF0 384 | ivory :: Color 385 | ivory = Color "#FFFFF0" 386 | 387 | -- | #F0E68C 388 | khaki :: Color 389 | khaki = Color "#F0E68C" 390 | 391 | -- | #E6E6FA 392 | lavender :: Color 393 | lavender = Color "#E6E6FA" 394 | 395 | -- | #FFF0F5 396 | lavenderBlush :: Color 397 | lavenderBlush = Color "#FFF0F5" 398 | 399 | -- | #7CFC00 400 | lawnGreen :: Color 401 | lawnGreen = Color "#7CFC00" 402 | 403 | -- | #FFFACD 404 | lemonChiffon :: Color 405 | lemonChiffon = Color "#FFFACD" 406 | 407 | -- | #ADD8E6 408 | lightBlue :: Color 409 | lightBlue = Color "#ADD8E6" 410 | 411 | -- | #F08080 412 | lightCoral :: Color 413 | lightCoral = Color "#F08080" 414 | 415 | -- | #E0FFFF 416 | lightCyan :: Color 417 | lightCyan = Color "#E0FFFF" 418 | 419 | -- | #FAFAD2 420 | lightGoldenRodYellow :: Color 421 | lightGoldenRodYellow = Color "#FAFAD2" 422 | 423 | -- | #D3D3D3 424 | lightGray :: Color 425 | lightGray = Color "#D3D3D3" 426 | 427 | -- | #90EE90 428 | lightGreen :: Color 429 | lightGreen = Color "#90EE90" 430 | 431 | -- | #FFB6C1 432 | lightPink :: Color 433 | lightPink = Color "#FFB6C1" 434 | 435 | -- | #FFA07A 436 | lightSalmon :: Color 437 | lightSalmon = Color "#FFA07A" 438 | 439 | -- | #20B2AA 440 | lightSeaGreen :: Color 441 | lightSeaGreen = Color "#20B2AA" 442 | 443 | -- | #87CEFA 444 | lightSkyBlue :: Color 445 | lightSkyBlue = Color "#87CEFA" 446 | 447 | -- | #778899 448 | lightSlateGray :: Color 449 | lightSlateGray = Color "#778899" 450 | 451 | -- | #B0C4DE 452 | lightSteelBlue :: Color 453 | lightSteelBlue = Color "#B0C4DE" 454 | 455 | -- | #FFFFE0 456 | lightYellow :: Color 457 | lightYellow = Color "#FFFFE0" 458 | 459 | -- | #00FF00 460 | lime :: Color 461 | lime = Color "#00FF00" 462 | 463 | -- | #32CD32 464 | limeGreen :: Color 465 | limeGreen = Color "#32CD32" 466 | 467 | -- | #FAF0E6 468 | linen :: Color 469 | linen = Color "#FAF0E6" 470 | 471 | -- | #FF00FF 472 | magenta :: Color 473 | magenta = Color "#FF00FF" 474 | 475 | -- | #800000 476 | maroon :: Color 477 | maroon = Color "#800000" 478 | 479 | -- | #66CDAA 480 | mediumAquaMarine :: Color 481 | mediumAquaMarine = Color "#66CDAA" 482 | 483 | -- | #0000CD 484 | mediumBlue :: Color 485 | mediumBlue = Color "#0000CD" 486 | 487 | -- | #BA55D3 488 | mediumOrchid :: Color 489 | mediumOrchid = Color "#BA55D3" 490 | 491 | -- | #9370DB 492 | mediumPurple :: Color 493 | mediumPurple = Color "#9370DB" 494 | 495 | -- | #3CB371 496 | mediumSeaGreen :: Color 497 | mediumSeaGreen = Color "#3CB371" 498 | 499 | -- | #7B68EE 500 | mediumSlateBlue :: Color 501 | mediumSlateBlue = Color "#7B68EE" 502 | 503 | -- | #00FA9A 504 | mediumSpringGreen :: Color 505 | mediumSpringGreen = Color "#00FA9A" 506 | 507 | -- | #48D1CC 508 | mediumTurquoise :: Color 509 | mediumTurquoise = Color "#48D1CC" 510 | 511 | -- | #C71585 512 | mediumVioletRed :: Color 513 | mediumVioletRed = Color "#C71585" 514 | 515 | -- | #191970 516 | midnightBlue :: Color 517 | midnightBlue = Color "#191970" 518 | 519 | -- | #F5FFFA 520 | mintCream :: Color 521 | mintCream = Color "#F5FFFA" 522 | 523 | -- | #FFE4E1 524 | mistyRose :: Color 525 | mistyRose = Color "#FFE4E1" 526 | 527 | -- | #FFE4B5 528 | moccasin :: Color 529 | moccasin = Color "#FFE4B5" 530 | 531 | -- | #FFDEAD 532 | navajoWhite :: Color 533 | navajoWhite = Color "#FFDEAD" 534 | 535 | -- | #000080 536 | navy :: Color 537 | navy = Color "#000080" 538 | 539 | -- | #FDF5E6 540 | oldLace :: Color 541 | oldLace = Color "#FDF5E6" 542 | 543 | -- | #808000 544 | olive :: Color 545 | olive = Color "#808000" 546 | 547 | -- | #6B8E23 548 | oliveDrab :: Color 549 | oliveDrab = Color "#6B8E23" 550 | 551 | -- | #FFA500 552 | orange :: Color 553 | orange = Color "#FFA500" 554 | 555 | -- | #FF4500 556 | orangeRed :: Color 557 | orangeRed = Color "#FF4500" 558 | 559 | -- | #DA70D6 560 | orchid :: Color 561 | orchid = Color "#DA70D6" 562 | 563 | -- | #EEE8AA 564 | paleGoldenRod :: Color 565 | paleGoldenRod = Color "#EEE8AA" 566 | 567 | -- | #98FB98 568 | paleGreen :: Color 569 | paleGreen = Color "#98FB98" 570 | 571 | -- | #AFEEEE 572 | paleTurquoise :: Color 573 | paleTurquoise = Color "#AFEEEE" 574 | 575 | -- | #DB7093 576 | paleVioletRed :: Color 577 | paleVioletRed = Color "#DB7093" 578 | 579 | -- | #FFEFD5 580 | papayaWhip :: Color 581 | papayaWhip = Color "#FFEFD5" 582 | 583 | -- | #FFDAB9 584 | peachPuff :: Color 585 | peachPuff = Color "#FFDAB9" 586 | 587 | -- | #CD853F 588 | peru :: Color 589 | peru = Color "#CD853F" 590 | 591 | -- | #FFC0CB 592 | pink :: Color 593 | pink = Color "#FFC0CB" 594 | 595 | -- | #DDA0DD 596 | plum :: Color 597 | plum = Color "#DDA0DD" 598 | 599 | -- | #B0E0E6 600 | powderBlue :: Color 601 | powderBlue = Color "#B0E0E6" 602 | 603 | -- | #800080 604 | purple :: Color 605 | purple = Color "#800080" 606 | 607 | -- | #663399 608 | rebeccaPurple :: Color 609 | rebeccaPurple = Color "#663399" 610 | 611 | -- | #FF0000 612 | red :: Color 613 | red = Color "#FF0000" 614 | 615 | -- | #BC8F8F 616 | rosyBrown :: Color 617 | rosyBrown = Color "#BC8F8F" 618 | 619 | -- | #4169E1 620 | royalBlue :: Color 621 | royalBlue = Color "#4169E1" 622 | 623 | -- | #8B4513 624 | saddleBrown :: Color 625 | saddleBrown = Color "#8B4513" 626 | 627 | -- | #FA8072 628 | salmon :: Color 629 | salmon = Color "#FA8072" 630 | 631 | -- | #F4A460 632 | sandyBrown :: Color 633 | sandyBrown = Color "#F4A460" 634 | 635 | -- | #2E8B57 636 | seaGreen :: Color 637 | seaGreen = Color "#2E8B57" 638 | 639 | -- | #FFF5EE 640 | seaShell :: Color 641 | seaShell = Color "#FFF5EE" 642 | 643 | -- | #A0522D 644 | sienna :: Color 645 | sienna = Color "#A0522D" 646 | 647 | -- | #C0C0C0 648 | silver :: Color 649 | silver = Color "#C0C0C0" 650 | 651 | -- | #87CEEB 652 | skyBlue :: Color 653 | skyBlue = Color "#87CEEB" 654 | 655 | -- | #6A5ACD 656 | slateBlue :: Color 657 | slateBlue = Color "#6A5ACD" 658 | 659 | -- | #708090 660 | slateGray :: Color 661 | slateGray = Color "#708090" 662 | 663 | -- | #FFFAFA 664 | snow :: Color 665 | snow = Color "#FFFAFA" 666 | 667 | -- | #00FF7F 668 | springGreen :: Color 669 | springGreen = Color "#00FF7F" 670 | 671 | -- | #4682B4 672 | steelBlue :: Color 673 | steelBlue = Color "#4682B4" 674 | 675 | -- | #D2B48C 676 | tan :: Color 677 | tan = Color "#D2B48C" 678 | 679 | -- | #008080 680 | teal :: Color 681 | teal = Color "#008080" 682 | 683 | -- | #D8BFD8 684 | thistle :: Color 685 | thistle = Color "#D8BFD8" 686 | 687 | -- | #FF6347 688 | tomato :: Color 689 | tomato = Color "#FF6347" 690 | 691 | -- | #40E0D0 692 | turquoise :: Color 693 | turquoise = Color "#40E0D0" 694 | 695 | -- | #EE82EE 696 | violet :: Color 697 | violet = Color "#EE82EE" 698 | 699 | -- | #F5DEB3 700 | wheat :: Color 701 | wheat = Color "#F5DEB3" 702 | 703 | -- | #FFFFFF 704 | white :: Color 705 | white = Color "#FFFFFF" 706 | 707 | -- | #F5F5F5 708 | whiteSmoke :: Color 709 | whiteSmoke = Color "#F5F5F5" 710 | 711 | -- | #FFFF00 712 | yellow :: Color 713 | yellow = Color "#FFFF00" 714 | 715 | -- | #9ACD32 716 | yellowGreen :: Color 717 | yellowGreen = Color "#9ACD32" 718 | -------------------------------------------------------------------------------- /src/Emo8/Data/Dir.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Dir 2 | ( Dir(..) 3 | , arounds 4 | ) where 5 | 6 | import Prelude 7 | 8 | data Dir 9 | = Northwest 10 | | North 11 | | Northeast 12 | | West 13 | | NoDirection 14 | | East 15 | | Southwest 16 | | South 17 | | Southeast 18 | 19 | derive instance eqDir :: Eq Dir 20 | 21 | arounds :: 22 | { north :: Array Dir 23 | , west :: Array Dir 24 | , south :: Array Dir 25 | , east :: Array Dir 26 | } 27 | arounds = 28 | { north: [ Northwest, North, Northeast ] 29 | , west: [ Northwest, West, Southwest ] 30 | , south: [ Southwest, South, Southeast ] 31 | , east: [ Southeast, East, Northeast ] 32 | } 33 | -------------------------------------------------------------------------------- /src/Emo8/Data/Draw.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Draw 2 | ( DrawR 3 | , runDrawR 4 | ) where 5 | 6 | import Prelude 7 | import Control.Monad.Reader (class MonadAsk, ReaderT, runReaderT) 8 | import Data.Newtype (class Newtype, unwrap) 9 | import Effect (Effect) 10 | import Effect.Class (class MonadEffect) 11 | 12 | newtype DrawR dt a 13 | = DrawR (ReaderT dt Effect a) 14 | 15 | derive instance newtypeDrawR :: Newtype (DrawR dt a) _ 16 | 17 | derive newtype instance functorDrawR :: Functor (DrawR dt) 18 | 19 | derive newtype instance applyDrawR :: Apply (DrawR dt) 20 | 21 | derive newtype instance applicativeDrawR :: Applicative (DrawR dt) 22 | 23 | derive newtype instance bindDrawR :: Bind (DrawR dt) 24 | 25 | derive newtype instance monadDrawR :: Monad (DrawR dt) 26 | 27 | derive newtype instance monadAskDrawR :: MonadAsk dt (DrawR dt) 28 | 29 | derive newtype instance monadEffectDrawR :: MonadEffect (DrawR dt) 30 | 31 | runDrawR :: forall dt a. DrawR dt a -> dt -> Effect a 32 | runDrawR = runReaderT <<< unwrap 33 | -------------------------------------------------------------------------------- /src/Emo8/Data/Input.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Input 2 | ( Input 3 | ) where 4 | 5 | -- | Emo8 input type. 6 | -- | - Keyboard 7 | -- | ``` 8 | -- | /¯¯¯\_/¯¯¯\ 9 | -- | | W | ↑ | 10 | -- | | A D | ← → | 11 | -- | | S | ↓ | 12 | -- | \___/¯\___/ 13 | -- | ``` 14 | -- | - Swipe Screen 15 | -- | ``` 16 | -- | |¯¯¯¯¯¯¯¯|¯¯¯¯¯¯¯¯| 17 | -- | | 👆 | 👆 | 18 | -- | | 👈 👉 | 👈 👉 | 19 | -- | | 👇 | 👇 | 20 | -- | |________|________| 21 | -- | ``` 22 | type Input 23 | = { isUp :: Boolean 24 | , isLeft :: Boolean 25 | , isDown :: Boolean 26 | , isRight :: Boolean 27 | , isW :: Boolean 28 | , isA :: Boolean 29 | , isS :: Boolean 30 | , isD :: Boolean 31 | } 32 | -------------------------------------------------------------------------------- /src/Emo8/Data/Key.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Key 2 | ( Key(..) 3 | , keyToCodeNum 4 | ) where 5 | 6 | data Key 7 | = Up 8 | | Left 9 | | Down 10 | | Right 11 | | W 12 | | A 13 | | S 14 | | D 15 | 16 | keyToCodeNum :: Key -> Int 17 | keyToCodeNum Up = 38 18 | 19 | keyToCodeNum Left = 37 20 | 21 | keyToCodeNum Down = 40 22 | 23 | keyToCodeNum Right = 39 24 | 25 | keyToCodeNum W = 87 26 | 27 | keyToCodeNum A = 65 28 | 29 | keyToCodeNum S = 83 30 | 31 | keyToCodeNum D = 68 32 | -------------------------------------------------------------------------------- /src/Emo8/Data/Note.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Note 2 | ( Note(..) 3 | , toFreq 4 | , notes 5 | ) where 6 | 7 | import Prelude 8 | import Data.List (List, fromFoldable) 9 | 10 | -- | Emo8 note type which supports the scales from A4 (440Hz) to A5 (880Hz). 11 | data Note 12 | = A4 13 | | AS4 14 | | B4 15 | | C5 16 | | CS5 17 | | D5 18 | | DS5 19 | | E5 20 | | F5 21 | | FS5 22 | | G5 23 | | GS5 24 | | A5 25 | 26 | derive instance eqNote :: Eq Note 27 | 28 | derive instance ordNote :: Ord Note 29 | 30 | toFreq :: Note -> Number 31 | toFreq A4 = 440.000 32 | 33 | toFreq AS4 = 466.164 34 | 35 | toFreq B4 = 493.883 36 | 37 | toFreq C5 = 523.251 38 | 39 | toFreq CS5 = 554.365 40 | 41 | toFreq D5 = 587.330 42 | 43 | toFreq DS5 = 622.254 44 | 45 | toFreq E5 = 659.255 46 | 47 | toFreq F5 = 698.456 48 | 49 | toFreq FS5 = 739.989 50 | 51 | toFreq G5 = 783.991 52 | 53 | toFreq GS5 = 830.609 54 | 55 | toFreq A5 = 880.000 56 | 57 | notes :: List Note 58 | notes = 59 | fromFoldable 60 | [ A4 61 | , AS4 62 | , B4 63 | , C5 64 | , CS5 65 | , D5 66 | , DS5 67 | , E5 68 | , F5 69 | , FS5 70 | , G5 71 | , GS5 72 | , A5 73 | ] 74 | -------------------------------------------------------------------------------- /src/Emo8/Data/Sound.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Sound 2 | ( SoundR 3 | , runSoundR 4 | ) where 5 | 6 | import Prelude 7 | import Control.Monad.Reader (class MonadAsk, ReaderT, runReaderT) 8 | import Data.Newtype (class Newtype, unwrap) 9 | import Effect (Effect) 10 | import Effect.Class (class MonadEffect) 11 | 12 | newtype SoundR st a 13 | = SoundR (ReaderT st Effect a) 14 | 15 | derive instance newtypeSoundR :: Newtype (SoundR st a) _ 16 | 17 | derive newtype instance functorSoundR :: Functor (SoundR st) 18 | 19 | derive newtype instance applySoundR :: Apply (SoundR st) 20 | 21 | derive newtype instance applicativeSoundR :: Applicative (SoundR st) 22 | 23 | derive newtype instance bindSoundR :: Bind (SoundR st) 24 | 25 | derive newtype instance monadSoundR :: Monad (SoundR st) 26 | 27 | derive newtype instance monadAskSoundR :: MonadAsk st (SoundR st) 28 | 29 | derive newtype instance monadEffectSoundR :: MonadEffect (SoundR st) 30 | 31 | runSoundR :: forall st a. SoundR st a -> st -> Effect a 32 | runSoundR = runReaderT <<< unwrap 33 | -------------------------------------------------------------------------------- /src/Emo8/Data/Tone.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Tone 2 | ( Tone(..) 3 | , toOscType 4 | , defaultGain 5 | ) where 6 | 7 | import Audio.WebAudio.Oscillator as O 8 | 9 | -- | Emo8 tone type which supports OscillatorNode's basic wave types (WebAudioAPI). 10 | data Tone 11 | = Sine 12 | | Square 13 | | Sawtooth 14 | | Triangle 15 | 16 | toOscType :: Tone -> O.OscillatorType 17 | toOscType Sine = O.Sine 18 | 19 | toOscType Square = O.Square 20 | 21 | toOscType Sawtooth = O.Sawtooth 22 | 23 | toOscType Triangle = O.Triangle 24 | 25 | defaultGain :: Tone -> Number 26 | defaultGain Sine = 1.0 27 | 28 | defaultGain Square = 0.25 29 | 30 | defaultGain Sawtooth = 0.25 31 | 32 | defaultGain Triangle = 1.0 33 | -------------------------------------------------------------------------------- /src/Emo8/Data/Update.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Data.Update 2 | ( UpdateR 3 | , runUpdateR 4 | ) where 5 | 6 | import Prelude 7 | import Control.Monad.Reader (class MonadAsk, Reader, runReader) 8 | import Data.Newtype (class Newtype, unwrap) 9 | 10 | newtype UpdateR st a 11 | = UpdateR (Reader st a) 12 | 13 | derive instance newtypeUpdateR :: Newtype (UpdateR st a) _ 14 | 15 | derive newtype instance functorUpdateR :: Functor (UpdateR st) 16 | 17 | derive newtype instance applyUpdateR :: Apply (UpdateR st) 18 | 19 | derive newtype instance applicativeUpdateR :: Applicative (UpdateR st) 20 | 21 | derive newtype instance bindUpdateR :: Bind (UpdateR st) 22 | 23 | derive newtype instance monadUpdateR :: Monad (UpdateR st) 24 | 25 | derive newtype instance monadAskUpdateR :: MonadAsk st (UpdateR st) 26 | 27 | runUpdateR :: forall st s. UpdateR st s -> st -> s 28 | runUpdateR = runReader <<< unwrap 29 | -------------------------------------------------------------------------------- /src/Emo8/FFI/Emo8Retina.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | exports.emo8RetinaImpl = function (elem) { 4 | return function (rect) { 5 | return function () { 6 | var wrapper = document.createElement('div'); 7 | wrapper.style.position = 'absolute'; 8 | wrapper.style.top = '50%'; 9 | wrapper.style.left = '50%'; 10 | wrapper.style.transform = 'translate(-50%,-50%)'; 11 | wrapper.style.maxWidth = '100%'; 12 | wrapper.style.maxHeight = '100%'; 13 | wrapper.style.width = rect.width.toString() + 'px'; 14 | wrapper.style.height = rect.height.toString() + 'px'; 15 | elem.parentNode.insertBefore(wrapper, elem); 16 | wrapper.appendChild(elem); 17 | } 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /src/Emo8/FFI/Emo8Retina.purs: -------------------------------------------------------------------------------- 1 | module Emo8.FFI.Emo8Retina 2 | ( emo8Retina 3 | ) where 4 | 5 | import Prelude 6 | import Effect (Effect) 7 | import Emo8.Type (Rect) 8 | import Graphics.Canvas (CanvasElement) 9 | 10 | foreign import emo8RetinaImpl :: CanvasElement -> Rect -> Effect Unit 11 | 12 | emo8Retina :: CanvasElement -> Rect -> Effect Unit 13 | emo8Retina = emo8RetinaImpl 14 | -------------------------------------------------------------------------------- /src/Emo8/FFI/LocalStorage.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | exports.setItemImpl = function (key) { 4 | return function (value) { 5 | return function () { 6 | localStorage.setItem(key, value); 7 | } 8 | } 9 | } 10 | 11 | exports.removeItemImpl = function (key) { 12 | return function () { 13 | localStorage.removeItem(key); 14 | } 15 | } 16 | 17 | exports.getItemImpl = function (nothing) { 18 | return function (just) { 19 | return function (key) { 20 | return function () { 21 | const m = localStorage.getItem(key); 22 | return m == null ? nothing : just(m); 23 | } 24 | } 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /src/Emo8/FFI/LocalStorage.purs: -------------------------------------------------------------------------------- 1 | module Emo8.FFI.LocalStorage 2 | ( LocalKey(..) 3 | , setItem 4 | , removeItem 5 | , getItem 6 | ) where 7 | 8 | import Prelude 9 | import Data.Maybe (Maybe(..)) 10 | import Effect (Effect) 11 | 12 | -- | Local storage key type to save the game state for emo8 development mode. 13 | newtype LocalKey 14 | = LocalKey String 15 | 16 | foreign import setItemImpl :: String -> String -> Effect Unit 17 | 18 | foreign import removeItemImpl :: String -> Effect Unit 19 | 20 | -- HACK: return Maybe type 21 | foreign import getItemImpl :: Maybe String -> (String -> Maybe String) -> String -> Effect (Maybe String) 22 | 23 | setItem :: LocalKey -> String -> Effect Unit 24 | setItem (LocalKey k) = setItemImpl k 25 | 26 | removeItem :: LocalKey -> Effect Unit 27 | removeItem (LocalKey k) = removeItemImpl k 28 | 29 | getItem :: LocalKey -> Effect (Maybe String) 30 | getItem (LocalKey k) = getItemImpl Nothing Just k 31 | -------------------------------------------------------------------------------- /src/Emo8/FFI/TextBaseline.js: -------------------------------------------------------------------------------- 1 | /* global exports */ 2 | "use strict"; 3 | 4 | exports.textBaselineImpl = function (ctx) { 5 | return function () { 6 | return ctx.textBaseline; 7 | } 8 | }; 9 | 10 | exports.setTextBaselineImpl = function (ctx) { 11 | return function (textBaseline) { 12 | return function () { 13 | ctx.textBaseline = textBaseline; 14 | } 15 | } 16 | }; -------------------------------------------------------------------------------- /src/Emo8/FFI/TextBaseline.purs: -------------------------------------------------------------------------------- 1 | module Emo8.FFI.TextBaseline where 2 | 3 | 4 | -- | Enumerates types of text alignment. 5 | import Prelude 6 | 7 | import Effect (Effect) 8 | import Effect.Exception.Unsafe (unsafeThrow) 9 | import Graphics.Canvas (Context2D) 10 | 11 | 12 | -- | Enumerates types of text alignment. 13 | data TextBaseline 14 | = BaselineTop 15 | | BaselineHanging 16 | | BaselineMiddle 17 | | BaselineAlphabetic 18 | | BaselineIdeographic 19 | | BaselineBottom 20 | 21 | instance showTextBaseline :: Show TextBaseline where 22 | show BaselineTop = "BaselineTop" 23 | show BaselineHanging = "BaselineHanging" 24 | show BaselineMiddle = "BaselineMiddle" 25 | show BaselineAlphabetic = "BaselineAlphabetic" 26 | show BaselineIdeographic = "BaselineIdeographic" 27 | show BaselineBottom = "BaselineBottom" 28 | 29 | foreign import textBaselineImpl :: Context2D -> Effect String 30 | 31 | -- | Get the current text alignment. 32 | textBaseline :: Context2D -> Effect TextBaseline 33 | textBaseline ctx = unsafeParseTextBaseline <$> textBaselineImpl ctx 34 | where 35 | unsafeParseTextBaseline :: String -> TextBaseline 36 | unsafeParseTextBaseline "top" = BaselineTop 37 | unsafeParseTextBaseline "hanging" = BaselineHanging 38 | unsafeParseTextBaseline "middle" = BaselineMiddle 39 | unsafeParseTextBaseline "alphabetic" = BaselineAlphabetic 40 | unsafeParseTextBaseline "ideographic" = BaselineIdeographic 41 | unsafeParseTextBaseline "bottom" = BaselineBottom 42 | unsafeParseTextBaseline align = unsafeThrow $ "invalid TextBaseline: " <> align 43 | -- ^ dummy to silence compiler warnings 44 | 45 | foreign import setTextBaselineImpl :: Context2D -> String -> Effect Unit 46 | 47 | -- | Set the current text alignment. 48 | setTextBaseline :: Context2D -> TextBaseline -> Effect Unit 49 | setTextBaseline ctx textbaseline = 50 | setTextBaselineImpl ctx (toString textbaseline) 51 | where 52 | toString BaselineTop = "top" 53 | toString BaselineHanging = "hanging" 54 | toString BaselineMiddle = "middle" 55 | toString BaselineAlphabetic = "alphabetic" 56 | toString BaselineIdeographic = "ideographic" 57 | toString BaselineBottom = "bottom" 58 | -------------------------------------------------------------------------------- /src/Emo8/Game.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Game 2 | ( class Game 3 | , update 4 | , draw 5 | , sound 6 | ) where 7 | 8 | import Prelude 9 | import Emo8.Data.Input (Input) 10 | import Emo8.Game.Draw (Draw) 11 | import Emo8.Game.Sound (Sound) 12 | import Emo8.Game.Update (Update) 13 | 14 | -- | Emo8 basic game class. 15 | -- | 16 | -- | Update, draw, sound functions are called in order each frames. 17 | -- | 18 | -- | - `s` is a game state type 19 | class Game s where 20 | -- | It takes input and current state and should return next state. 21 | update :: Input -> s -> Update s 22 | -- | It takes next state and runs some draw operations. 23 | draw :: s -> Draw Unit 24 | -- | It takes next state and runs some sound operations. 25 | sound :: s -> Sound Unit 26 | -------------------------------------------------------------------------------- /src/Emo8/Game/Draw.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Game.Draw 2 | ( Draw 3 | , DrawContext 4 | , cls 5 | , emo 6 | , emo' 7 | , emor 8 | , emor' 9 | , emap 10 | ) where 11 | 12 | import Prelude 13 | import Control.Monad.Reader as Reader 14 | import Data.FoldableWithIndex (traverseWithIndex_) 15 | import Data.Int (toNumber) 16 | import Data.List as L 17 | import Data.String (joinWith) 18 | import Effect (Effect) 19 | import Effect.Class (liftEffect) 20 | import Emo8.Data.Color (Color) 21 | import Emo8.Data.Draw (DrawR) 22 | import Emo8.Data.Emoji (Emoji, japaneseVacancyButton) 23 | import Emo8.FFI.TextBaseline (TextBaseline(..), setTextBaseline) 24 | import Emo8.Parser.Type (EmojiMap) 25 | import Emo8.Type (Rect, Size, X, Y, Angle) 26 | import Graphics.Canvas (Context2D, fillRect, fillText, restore, rotate, save, scale, setFillStyle, setFont, translate) 27 | import Math (pi) 28 | 29 | -- | Emo8 draw monad which runs some draw operations. 30 | type Draw 31 | = DrawR DrawContext 32 | 33 | type DrawContext 34 | = { ctx :: Context2D 35 | , canvasSize :: Rect 36 | } 37 | 38 | -- | Fill the entire canvas with the specified color. 39 | cls :: Color -> Draw Unit 40 | cls c = do 41 | r <- Reader.ask 42 | localDraw r.ctx \ctx -> do 43 | setFillStyle ctx (show c) 44 | fillRect ctx 45 | { x: 0.0 46 | , y: 0.0 47 | , width: toNumber r.canvasSize.width 48 | , height: toNumber r.canvasSize.height 49 | } 50 | 51 | -- | Draw the emoji with the specified emoji, size, x and y. 52 | -- | 53 | -- | The origin of x and y is the bottom left. 54 | emo :: Emoji -> Size -> X -> Y -> Draw Unit 55 | emo e size x y = do 56 | r <- Reader.ask 57 | let 58 | y' = toNumber $ r.canvasSize.height - y 59 | localDraw r.ctx \c -> do 60 | setFont c (sizeToFont size') 61 | fillText c (show e) x' y' 62 | where 63 | size' = toNumber size 64 | 65 | x' = toNumber x 66 | 67 | -- | The mirror version of `emo`. 68 | emo' :: Emoji -> Size -> X -> Y -> Draw Unit 69 | emo' e size x y = do 70 | r <- Reader.ask 71 | let 72 | y' = toNumber $ r.canvasSize.height - y 73 | localDraw r.ctx \c -> do 74 | setFont c (sizeToFont size') 75 | translate c { translateX: x' + half, translateY: y' - half } 76 | scale c { scaleX: -1.0, scaleY: 1.0 } 77 | fillText c (show e) (-half) half 78 | where 79 | size' = toNumber size 80 | 81 | half = size' / 2.0 82 | 83 | x' = toNumber x 84 | 85 | -- | The rotation version of `emo`. 86 | emor :: Angle -> Emoji -> Size -> X -> Y -> Draw Unit 87 | emor deg e size x y = do 88 | r <- Reader.ask 89 | let 90 | y' = toNumber $ r.canvasSize.height - y 91 | localDraw r.ctx \c -> do 92 | setFont c (sizeToFont size') 93 | translate c { translateX: x' + half, translateY: y' - half } 94 | rotate c (-rad) 95 | fillText c (show e) (-half) half 96 | where 97 | size' = toNumber size 98 | 99 | half = size' / 2.0 100 | 101 | x' = toNumber x 102 | 103 | rad = 2.0 * pi * toNumber deg / 360.0 104 | 105 | -- | The mirror version of `emor`. 106 | emor' :: Angle -> Emoji -> Size -> X -> Y -> Draw Unit 107 | emor' deg e size x y = do 108 | r <- Reader.ask 109 | let 110 | y' = toNumber $ r.canvasSize.height - y 111 | localDraw r.ctx \c -> do 112 | setFont c (sizeToFont size') 113 | translate c { translateX: x' + half, translateY: y' - half } 114 | rotate c (-rad) 115 | scale c { scaleX: -1.0, scaleY: 1.0 } 116 | fillText c (show e) (-half) half 117 | where 118 | size' = toNumber size 119 | 120 | half = size' / 2.0 121 | 122 | x' = toNumber x 123 | 124 | rad = 2.0 * pi * toNumber deg / 360.0 125 | 126 | -- | Draw the emoji map with the specified emoji map, size, x and y. 127 | -- | 128 | -- | The size is one of the emojis'. 129 | emap :: EmojiMap -> Size -> X -> Y -> Draw Unit 130 | emap em size x y = do 131 | r <- Reader.ask 132 | let 133 | y' = toNumber $ r.canvasSize.height - y 134 | 135 | posY i = y' - toNumber i * size' 136 | 137 | ess = L.reverse em 138 | localDraw r.ctx \c -> do 139 | setFont c (sizeToFont size') 140 | traverseWithIndex_ 141 | ( \row es -> 142 | traverseWithIndex_ 143 | ( \col e -> 144 | when (e /= japaneseVacancyButton) 145 | $ fillText c (show e) (posX col) (posY row) 146 | ) 147 | es 148 | ) 149 | ess 150 | where 151 | size' = toNumber size 152 | 153 | x' = toNumber x 154 | 155 | posX i = x' + toNumber i * size' 156 | 157 | localDraw :: Context2D -> (Context2D -> Effect Unit) -> Draw Unit 158 | localDraw ctx op = 159 | liftEffect do 160 | save ctx 161 | setTextBaseline ctx BaselineIdeographic 162 | op ctx 163 | restore ctx 164 | 165 | sizeToFont :: Number -> String 166 | sizeToFont px = joinWith " " [ fontSize, fontFamily ] 167 | where 168 | fontSize = show px <> "px" 169 | 170 | fontFamily :: String 171 | fontFamily = "sans-serif" 172 | -------------------------------------------------------------------------------- /src/Emo8/Game/Sound.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Game.Sound 2 | ( Sound 3 | , SoundContext 4 | , play 5 | , play' 6 | , stop 7 | ) where 8 | 9 | import Prelude 10 | import Audio.WebAudio.AudioParam (setValueAtTime) 11 | import Audio.WebAudio.BaseAudioContext (createGain, createOscillator, currentTime, destination) 12 | import Audio.WebAudio.GainNode (gain) 13 | import Audio.WebAudio.Oscillator (frequency, setOscillatorType, startOscillator, stopOscillator) 14 | import Audio.WebAudio.Types (AudioContext, OscillatorNode, connect) 15 | import Control.Monad.Reader as Reader 16 | import Data.Foldable (maximum, traverse_) 17 | import Data.FoldableWithIndex (forWithIndex_) 18 | import Data.Int (toNumber) 19 | import Data.List as L 20 | import Data.Map as Map 21 | import Data.Maybe (Maybe(..), fromMaybe) 22 | import Data.Traversable (traverse) 23 | import Effect.Class (liftEffect) 24 | import Effect.Class.Console (error) 25 | import Effect.Ref as Ref 26 | import Emo8.Data.Note (toFreq) 27 | import Emo8.Data.Sound (SoundR) 28 | import Emo8.Data.Tone (Tone, defaultGain, toOscType) 29 | import Emo8.Parser.Type (Score) 30 | import Emo8.Type (Tempo) 31 | import Emo8.Util.List (zipWithMaybeA) 32 | 33 | -- | Emo8 sound monad which runs some sound operations. 34 | type Sound 35 | = SoundR SoundContext 36 | 37 | -- REVIEW: State instead of Ref? 38 | type SoundContext 39 | = { ctx :: AudioContext 40 | , ref :: Ref.Ref (Map.Map Score (L.List OscillatorNode)) 41 | } 42 | 43 | -- TODO: Map key type 44 | -- | Play the score with the specified the score, tone and tempo. 45 | -- | 46 | -- | The operation is ignored until the score being stopped. 47 | play :: Score -> Tone -> Tempo -> Sound Unit 48 | play score tone tempo = do 49 | r <- Reader.ask 50 | liftEffect do 51 | m <- Ref.read r.ref 52 | case Map.lookup score m of 53 | -- resume 54 | Just _ -> pure unit 55 | -- create new 56 | Nothing -> do 57 | now <- currentTime r.ctx 58 | g <- createGain r.ctx 59 | dest <- destination r.ctx 60 | connect g dest 61 | gainP <- gain g 62 | void $ setValueAtTime (defaultGain tone) now gainP 63 | oscs <- prepareOscillators r.ctx g score 64 | freqParams <- traverse frequency oscs 65 | forWithIndex_ score \i -> 66 | zipWithMaybeA 67 | ( case _, _ of 68 | Just freqP, Just note -> void $ setValueAtTime (toFreq note) (startTime now i) freqP 69 | Just freqP, Nothing -> void $ setValueAtTime 0.0 (startTime now i) freqP 70 | Nothing, _ -> error "unreachable" 71 | ) 72 | freqParams 73 | -- NOTE: set end to terminate score 74 | let 75 | len = L.length score 76 | void $ setValueAtTime 0.0 (startTime now len) gainP 77 | -- start sound 78 | traverse_ (startOscillator now) oscs 79 | -- save ref 80 | Ref.write (Map.singleton score oscs) r.ref 81 | where 82 | pitch = 1.0 / toNumber tempo 83 | 84 | startTime now num = now + pitch * toNumber num 85 | 86 | prepareOscillators ctx g = traverse (const (prep ctx g)) <<< maxNotes 87 | 88 | prep ctx g = do 89 | osc <- createOscillator ctx 90 | connect osc g 91 | setOscillatorType (toOscType tone) osc 92 | pure osc 93 | 94 | maxNotes = fromMaybe L.Nil <<< maximum 95 | 96 | -- | `play` the score after `stop`. 97 | play' :: Score -> Tone -> Tempo -> Sound Unit 98 | play' score tone tempo = do 99 | stop score 100 | play score tone tempo 101 | 102 | -- | Stop playing with the specified score. 103 | stop :: Score -> Sound Unit 104 | stop score = do 105 | r <- Reader.ask 106 | liftEffect do 107 | m <- Ref.read r.ref 108 | case Map.lookup score m of 109 | -- delete existing 110 | Just oscs -> do 111 | now <- currentTime r.ctx 112 | -- stop sound 113 | traverse_ (stopOscillator now) oscs 114 | let 115 | nm = Map.delete score m 116 | -- save ref 117 | Ref.write nm r.ref 118 | -- nothing to delete 119 | Nothing -> pure unit 120 | -------------------------------------------------------------------------------- /src/Emo8/Game/Update.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Game.Update 2 | ( Update 3 | , UpdateContext 4 | , getCanvasSize 5 | , isOutOfCanvas 6 | , isCollideCanvas 7 | ) where 8 | 9 | import Prelude 10 | import Control.Monad.Reader as Reader 11 | import Emo8.Data.Update (UpdateR) 12 | import Emo8.Type (Rect, Size, X, Y) 13 | import Emo8.Util.Collide as C 14 | 15 | -- | Emo8 update monad which can access canvas size. 16 | type Update 17 | = UpdateR UpdateContext 18 | 19 | type UpdateContext 20 | = { canvasSize :: Rect 21 | } 22 | 23 | -- | Get the canvas size given by the `emo8` function. 24 | getCanvasSize :: Update Rect 25 | getCanvasSize = pure <<< _.canvasSize =<< Reader.ask 26 | 27 | -- | Check if the object is outside the canvas. 28 | -- | 29 | -- | The origin of x and y is the bottom left. 30 | isOutOfCanvas :: Size -> X -> Y -> Update Boolean 31 | isOutOfCanvas size x y = do 32 | r <- Reader.ask 33 | pure $ C.isOutOfCanvas r.canvasSize size x y 34 | 35 | -- | Check if the object collides the frame of the canvas. 36 | isCollideCanvas :: Size -> X -> Y -> Update Boolean 37 | isCollideCanvas size x y = do 38 | r <- Reader.ask 39 | pure $ C.isCollideCanvas r.canvasSize size x y 40 | -------------------------------------------------------------------------------- /src/Emo8/GameBoot.purs: -------------------------------------------------------------------------------- 1 | module Emo8.GameBoot 2 | ( class GameBoot 3 | , finished 4 | , BootState 5 | , initialBootState 6 | ) where 7 | 8 | import Prelude 9 | import Data.Array ((..)) 10 | import Data.Foldable (for_) 11 | import Data.Int (floor, toNumber) 12 | import Data.Symbol (SProxy(..)) 13 | import Emo8.Data.Color as C 14 | import Emo8.Data.Emoji as E 15 | import Emo8.Data.Input (Input) 16 | import Emo8.Data.Tone (Tone(..)) 17 | import Emo8.Game (class Game) 18 | import Emo8.Game.Draw (cls, emo) 19 | import Emo8.Game.Sound (play') 20 | import Emo8.Parser (parse) 21 | import Emo8.Parser.Type (Score) 22 | import Emo8.Type (Rect) 23 | import Emo8.Util.Input (anyInput, catchInput, noInput) 24 | import Math (cos, pi, sin) 25 | 26 | class 27 | Game s <= GameBoot s where 28 | finished :: s -> Boolean 29 | 30 | data BootState 31 | = BootState 32 | { infSize :: Int 33 | , infPos :: Position 34 | , infEmoji :: E.Emoji 35 | , emoSize :: Int 36 | , emoPos :: Position 37 | , bgColor :: C.Color 38 | , timeToFinish :: Int 39 | , rotation :: Number 40 | , isReverse :: Boolean 41 | , prevInput :: Input 42 | , frame :: Int 43 | } 44 | 45 | type Position 46 | = { x :: Int, y :: Int } 47 | 48 | type Polar 49 | = { radius :: Number 50 | , theta :: Number 51 | } 52 | 53 | instance gameBootState :: Game BootState where 54 | update i st@(BootState s) 55 | | finished st = pure st 56 | | anyInput (catchInput s.prevInput i) = 57 | pure <<< BootState 58 | $ s 59 | { timeToFinish = initialTime 60 | , bgColor = pickedColor 61 | , infEmoji = pickedEmoji 62 | , isReverse = not s.isReverse 63 | , prevInput = i 64 | , frame = s.frame + 1 65 | } 66 | where 67 | pickedColor = case mod s.frame 5 of 68 | 0 -> C.aliceBlue 69 | 1 -> C.antiqueWhite 70 | 2 -> C.aqua 71 | 3 -> C.aquamarine 72 | _ -> C.azure 73 | 74 | pickedEmoji 75 | | mod s.frame 20 == 0 = E.zanyFace 76 | | otherwise = E.infinity 77 | | otherwise = 78 | pure <<< BootState 79 | $ s 80 | { timeToFinish = s.timeToFinish - 1 81 | , rotation = nextRot 82 | , prevInput = i 83 | , frame = s.frame + 1 84 | } 85 | where 86 | nextRot = 87 | if s.isReverse then 88 | s.rotation - 1.0 89 | else 90 | s.rotation + 1.0 91 | draw (BootState s) = do 92 | cls s.bgColor 93 | emo s.infEmoji s.infSize s.infPos.x s.infPos.y 94 | for_ moves \move -> 95 | emo E.roastedSweetPotato s.emoSize (s.emoPos.x + move.x) (s.emoPos.y + move.y) 96 | where 97 | rotations = (+) s.rotation <<< toNumber <<< (*) 45 <$> 0 .. 7 98 | 99 | moves = map polToPos <<< map { radius: toNumber s.infSize, theta: _ } $ rotations 100 | sound (BootState s) = do 101 | when (s.timeToFinish == initialTime) 102 | $ play' beepScore Sawtooth 20 103 | 104 | instance gameBootBootState :: GameBoot BootState where 105 | finished (BootState s) = s.timeToFinish <= 0 106 | 107 | initialBootState :: Rect -> BootState 108 | initialBootState r = 109 | BootState 110 | { infSize: infSize 111 | , infPos: basePos infSize 112 | , infEmoji: E.infinity 113 | , emoSize: emoSize 114 | , emoPos: basePos emoSize 115 | , bgColor: C.black 116 | , timeToFinish: initialTime 117 | , rotation: 0.0 118 | , isReverse: false 119 | , prevInput: noInput 120 | , frame: 0 121 | } 122 | where 123 | minLength 124 | | r.width < r.height = r.width 125 | | otherwise = r.height 126 | 127 | infSize = floor <<< (*) 0.25 <<< toNumber $ minLength 128 | 129 | emoSize = infSize / 4 130 | 131 | basePos size = 132 | { x: (r.width - size) / 2 133 | , y: (r.height - size) / 2 134 | } 135 | 136 | polToPos :: Polar -> Position 137 | polToPos pol = 138 | { x: floor $ pol.radius * cos (toRadian pol.theta) 139 | , y: floor $ pol.radius * sin (toRadian pol.theta) 140 | } 141 | where 142 | toRadian = (*) pi <<< flip (/) 180.0 143 | 144 | initialTime :: Int 145 | initialTime = 120 146 | 147 | beepScore :: Score 148 | beepScore = parse (SProxy :: SProxy Beep) 149 | 150 | type Beep 151 | = """ 152 | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 153 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 154 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 155 | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 156 | """ 157 | -------------------------------------------------------------------------------- /src/Emo8/GameDev.purs: -------------------------------------------------------------------------------- 1 | module Emo8.GameDev 2 | ( class GameDev 3 | , loadStateWithDefault 4 | , saveLocal 5 | , saveState 6 | ) where 7 | 8 | import Prelude 9 | import Control.Monad.Except (runExcept) 10 | import Data.Bifunctor (lmap) 11 | import Data.Either (Either(..)) 12 | import Data.Foldable (for_) 13 | import Data.Maybe (Maybe(..)) 14 | import Effect (Effect) 15 | import Effect.Class.Console (log) 16 | import Emo8.FFI.LocalStorage (LocalKey, getItem, setItem) 17 | import Emo8.Game (class Game) 18 | import Foreign (MultipleErrors) 19 | import Foreign.Generic (class Decode, class Encode, decodeJSON, encodeJSON) 20 | 21 | -- | Emo8 game develepment mode class. 22 | -- | 23 | -- | You can save the state to localstrage and visualize it by defining `Encode` and `Decode` instance of the state type. 24 | class 25 | ( Game s 26 | , Encode s 27 | , Decode s 28 | ) <= GameDev s where 29 | saveLocal :: s -> Array LocalKey 30 | 31 | data LoadError 32 | = DecodeError MultipleErrors 33 | | KeyNotFoundError String 34 | 35 | instance showLoadError :: Show LoadError where 36 | show (DecodeError es) = show es 37 | show (KeyNotFoundError s) = show s 38 | 39 | loadStateWithDefault :: forall s. GameDev s => s -> LocalKey -> Effect s 40 | loadStateWithDefault s key = do 41 | es <- loadState key 42 | case es of 43 | Right s' -> do 44 | log "state loaded" 45 | pure s' 46 | Left err -> do 47 | case err of 48 | DecodeError me -> log $ show me 49 | KeyNotFoundError e -> log e 50 | pure s 51 | 52 | saveState :: forall s. GameDev s => s -> Effect Unit 53 | saveState s = for_ keys \k -> setItem k json 54 | where 55 | keys = saveLocal s 56 | 57 | json = encodeJSON s 58 | 59 | loadState :: forall s. GameDev s => LocalKey -> Effect (Either LoadError s) 60 | loadState key = do 61 | mJson <- getItem key 62 | pure 63 | $ case mJson of 64 | Just json -> lmap DecodeError <<< runExcept <<< decodeJSON $ json 65 | Nothing -> Left $ KeyNotFoundError "key not found" 66 | -------------------------------------------------------------------------------- /src/Emo8/GameWithBoot.purs: -------------------------------------------------------------------------------- 1 | module Emo8.GameWithBoot 2 | ( GameWithBoot(..) 3 | , switchOp 4 | , switchFoldOp 5 | ) where 6 | 7 | import Prelude 8 | import Data.Bifunctor (class Bifunctor, lmap, rmap) 9 | import Effect (Effect) 10 | import Emo8.Data.Input (Input) 11 | import Emo8.Game (class Game) 12 | import Emo8.GameBoot (class GameBoot, finished) 13 | 14 | data GameWithBoot a b 15 | = GameWithBoot a b 16 | 17 | instance bifunctorGameWithBoot :: Bifunctor GameWithBoot where 18 | bimap f g (GameWithBoot a b) = GameWithBoot (f a) (g b) 19 | 20 | switchOp :: 21 | forall s s'. 22 | Game s => 23 | GameBoot s' => 24 | (s -> Effect Unit) -> 25 | (s' -> Effect Unit) -> 26 | GameWithBoot s s' -> Effect Unit 27 | switchOp op op' gwb@(GameWithBoot s s') 28 | | finished s' = op s 29 | | otherwise = op' s' 30 | 31 | switchFoldOp :: 32 | forall s s'. 33 | Game s => 34 | GameBoot s' => 35 | (Input -> s -> s) -> 36 | (Input -> s' -> s') -> 37 | Input -> GameWithBoot s s' -> GameWithBoot s s' 38 | switchFoldOp op op' i gwb@(GameWithBoot _ s') 39 | | finished s' = lmap (op i) gwb 40 | | otherwise = rmap (op' i) gwb 41 | -------------------------------------------------------------------------------- /src/Emo8/Input.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Input 2 | ( class Input 3 | , poll 4 | ) where 5 | 6 | import Effect (Effect) 7 | import Signal (Signal) 8 | 9 | class Input a where 10 | poll :: Effect (Signal a) 11 | -------------------------------------------------------------------------------- /src/Emo8/Input/Direction.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Input.Direction 2 | ( Direction(..) 3 | ) where 4 | 5 | import Prelude 6 | import Data.Int (toNumber) 7 | import Data.Maybe (Maybe) 8 | import Data.Newtype (class Newtype, unwrap, wrap) 9 | import Emo8.Data.Dir (Dir(..)) 10 | import Emo8.Input (class Input, poll) 11 | import Emo8.Input.Swipe (Swipe, Vector) 12 | import Math (atan2, pi) 13 | import Record.Extra (sequenceRecord) 14 | import Signal (Signal) 15 | 16 | newtype Direction 17 | = Direction 18 | { leftDir :: Maybe Dir 19 | , rightDir :: Maybe Dir 20 | } 21 | 22 | derive instance newtypeDirection :: Newtype Direction _ 23 | 24 | instance inputDirection :: Input Direction where 25 | poll = do 26 | sw :: Signal Swipe <- poll 27 | let 28 | usw = unwrap <$> sw 29 | pure $ map wrap 30 | $ sequenceRecord 31 | { leftDir: map (map vecToDir) <<< map _.leftVec $ usw 32 | , rightDir: map (map vecToDir) <<< map _.rightVec $ usw 33 | } 34 | 35 | vecToDir :: Vector -> Dir 36 | vecToDir { vx, vy } = f arg 37 | where 38 | vy' = -vy 39 | 40 | arg = atan2 (toNumber vy') (toNumber vx) -- NOTE: atan2 0.0 0.0 = 0.0 41 | 42 | f rad 43 | | rad == 0.0 = NoDirection 44 | | rad < pi * -7.0 / 8.0 = West 45 | | rad < pi * -5.0 / 8.0 = Southwest 46 | | rad < pi * -3.0 / 8.0 = South 47 | | rad < pi * -1.0 / 8.0 = Southeast 48 | | rad < pi * 1.0 / 8.0 = East 49 | | rad < pi * 3.0 / 8.0 = Northeast 50 | | rad < pi * 5.0 / 8.0 = North 51 | | rad < pi * 7.0 / 8.0 = Northwest 52 | | otherwise = West 53 | -------------------------------------------------------------------------------- /src/Emo8/Input/Keyboard.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Input.Keyboard 2 | ( Keyboard(..) 3 | ) where 4 | 5 | import Prelude 6 | import Data.Newtype (class Newtype) 7 | import Emo8.Data.Input as T 8 | import Emo8.Data.Key (Key(..), keyToCodeNum) 9 | import Emo8.Input (class Input) 10 | import Record.Extra (mapRecord, sequenceRecord) 11 | import Signal.DOM (keyPressed) 12 | 13 | newtype Keyboard 14 | = Keyboard T.Input 15 | 16 | derive instance newtypeKeyboard :: Newtype Keyboard _ 17 | 18 | instance inputKeyboard :: Input Keyboard where 19 | poll = 20 | h <<< g <<< mapRecord f 21 | $ { isUp: Up 22 | , isLeft: Left 23 | , isDown: Down 24 | , isRight: Right 25 | , isW: W 26 | , isA: A 27 | , isS: S 28 | , isD: D 29 | } 30 | where 31 | f = keyPressed <<< keyToCodeNum 32 | 33 | g = map sequenceRecord <<< sequenceRecord 34 | 35 | h = map (map Keyboard) 36 | -------------------------------------------------------------------------------- /src/Emo8/Input/Merged.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Input.Merged 2 | ( mkInput 3 | ) where 4 | 5 | import Prelude 6 | import Data.Foldable (elem) 7 | import Data.Maybe (Maybe(..)) 8 | import Emo8.Data.Dir (arounds) 9 | import Emo8.Data.Input (Input) 10 | import Emo8.Input.Direction (Direction(..)) 11 | import Emo8.Input.Keyboard (Keyboard(..)) 12 | 13 | mkInput :: Keyboard -> Direction -> Input 14 | mkInput (Keyboard k) dir = 15 | { isUp: k.isUp || d.isUp 16 | , isLeft: k.isLeft || d.isLeft 17 | , isDown: k.isDown || d.isDown 18 | , isRight: k.isRight || d.isRight 19 | , isW: k.isW || d.isW 20 | , isA: k.isA || d.isA 21 | , isS: k.isS || d.isS 22 | , isD: k.isD || d.isD 23 | } 24 | where 25 | d = dirToInput dir 26 | 27 | dirToInput :: Direction -> Input 28 | dirToInput (Direction d) = 29 | { isUp: melem d.rightDir arounds.north 30 | , isLeft: melem d.rightDir arounds.west 31 | , isDown: melem d.rightDir arounds.south 32 | , isRight: melem d.rightDir arounds.east 33 | , isW: melem d.leftDir arounds.north 34 | , isA: melem d.leftDir arounds.west 35 | , isS: melem d.leftDir arounds.south 36 | , isD: melem d.leftDir arounds.east 37 | } 38 | where 39 | melem Nothing = const false 40 | 41 | melem (Just e) = elem e 42 | -------------------------------------------------------------------------------- /src/Emo8/Input/Swipe.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Input.Swipe 2 | ( Swipe(..) 3 | , Vector 4 | ) where 5 | 6 | import Prelude 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Newtype (class Newtype, unwrap, wrap) 9 | import Data.Tuple (Tuple(..), snd) 10 | import Emo8.Input (class Input, poll) 11 | import Emo8.Input.Touch (Position, Touch) 12 | import Record.Extra (sequenceRecord) 13 | import Signal (Signal, foldp) 14 | 15 | type Vector 16 | = { vx :: Int, vy :: Int } 17 | 18 | newtype Swipe 19 | = Swipe 20 | { leftVec :: Maybe Vector 21 | , rightVec :: Maybe Vector 22 | } 23 | 24 | derive instance newtypeSwipe :: Newtype Swipe _ 25 | 26 | instance inputSwipe :: Input Swipe where 27 | poll = do 28 | t :: Signal Touch <- poll 29 | let 30 | ut = unwrap <$> t 31 | 32 | init = Tuple Nothing Nothing :: Tuple (Maybe Position) (Maybe Vector) 33 | pure $ map wrap 34 | $ sequenceRecord 35 | { leftVec: foldF init <<< map _.leftPos $ ut 36 | , rightVec: foldF init <<< map _.rightPos $ ut 37 | } 38 | where 39 | foldF init = map snd <<< foldp (\mtp (Tuple mbp _) -> update mtp mbp) init 40 | 41 | update :: Maybe Position -> Maybe Position -> Tuple (Maybe Position) (Maybe Vector) 42 | update mtp mbp = case mtp, mbp of 43 | Just tp, Just bp -> Tuple mbp (Just $ mkVec bp tp) 44 | Just _, Nothing -> Tuple mtp (Just zeroVec) 45 | Nothing, _ -> Tuple Nothing Nothing 46 | 47 | mkVec :: Position -> Position -> Vector 48 | mkVec f t = { vx: t.x - f.x, vy: t.y - f.y } 49 | 50 | zeroVec :: Vector 51 | zeroVec = { vx: 0, vy: 0 } 52 | -------------------------------------------------------------------------------- /src/Emo8/Input/Touch.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Input.Touch 2 | ( Touch(..) 3 | , Position 4 | ) where 5 | 6 | import Prelude 7 | import Data.Array as A 8 | import Data.Maybe (Maybe) 9 | import Data.Newtype (class Newtype, wrap) 10 | import Emo8.Input (class Input) 11 | import Record.Extra (sequenceRecord) 12 | import Signal.DOM (touch, windowDimensions) 13 | 14 | type Position 15 | = { x :: Int, y :: Int } 16 | 17 | newtype Touch 18 | = Touch 19 | { leftPos :: Maybe Position 20 | , rightPos :: Maybe Position 21 | } 22 | 23 | derive instance newtypeTouch :: Newtype Touch _ 24 | 25 | instance inputTouch :: Input Touch where 26 | poll = do 27 | ts <- touch 28 | dim <- windowDimensions 29 | pure <<< map wrap 30 | $ sequenceRecord 31 | { leftPos: oneLeft <$> dim <*> ts 32 | , rightPos: oneRight <$> dim <*> ts 33 | } 34 | where 35 | oneLeft dim = oneF dim.w (<) 36 | 37 | oneRight dim = oneF dim.w (>) 38 | 39 | oneF w comp = 40 | map 41 | ( \t -> 42 | { x: t.screenX, y: t.screenY } 43 | ) 44 | <<< A.head 45 | <<< A.filter 46 | ( \t -> t.screenX `comp` (w / 2) 47 | ) 48 | -------------------------------------------------------------------------------- /src/Emo8/Parser.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Parser 2 | ( class Parser 3 | , parse 4 | ) where 5 | 6 | import Prelude 7 | import Data.Either (Either(..)) 8 | import Data.List as L 9 | import Data.Symbol (SProxy(..)) 10 | import Data.Tuple (Tuple(..), fst) 11 | import Emo8.Data.Emoji as E 12 | import Emo8.Data.Note as N 13 | import Emo8.Parser.EConvert (class EConvert, econvert) 14 | import Emo8.Parser.NConstraint (class NConstraint) 15 | import Emo8.Parser.NConvert (class NConvert, nconvert) 16 | import Emo8.Parser.Type (IsNote(..), NoEmoji(..), Result) 17 | 18 | -- | Emo8 emoji parser class. 19 | class Parser (s :: Symbol) a where 20 | -- | It parse `Symbol` type as `EmojiMap` or `Score` value. 21 | parse :: SProxy s -> L.List (L.List a) 22 | 23 | -- | Example 24 | -- | ``` 25 | -- | mountFuji :: EmojiMap 26 | -- | mountFuji = parse (SProxy :: SProxy Fuji) 27 | -- | 28 | -- | type Fuji 29 | -- | = """ 30 | -- | 🈳🈳🈳🈳🈳🈳🈳🈳🈳 31 | -- | 🈳⛅🈳🈳🎌🈳🈳🌧🈳 32 | -- | 🈳🈳🈳🌳🗻🌳🈳🈳🈳 33 | -- | 🈳🈳🌳🗻🗻🗻🌳🈳🈳 34 | -- | 🈳🌳🗻🗻🗻🗻🗻🌳🈳 35 | -- | 🌳🗻🗻🗻🗻🗻🗻🗻🌳 36 | -- | """ 37 | -- | ``` 38 | instance parseEmojiMap :: 39 | EConvert s => 40 | Parser s E.Emoji where 41 | parse _ = 42 | map L.reverse 43 | <<< L.filter (notEq L.Nil) 44 | $ go res L.Nil 45 | where 46 | res = econvert (SProxy :: SProxy s) 47 | 48 | -- | Example 49 | -- | ``` 50 | -- | beep :: Score 51 | -- | beep = parse (SProxy :: SProxy NHK) 52 | -- | 53 | -- | type NHK 54 | -- | = """ 55 | -- | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 56 | -- | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 57 | -- | 🎹🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳 58 | -- | 🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🈳🎹 59 | -- | """ 60 | -- | ``` 61 | instance parseScore :: 62 | ( NConvert s 63 | , NConstraint s 64 | ) => 65 | Parser s N.Note where 66 | parse _ = 67 | map pickIsNote 68 | <<< map L.reverse 69 | <<< L.filter (notEq L.Nil) 70 | $ go res L.Nil 71 | where 72 | res = nconvert (SProxy :: SProxy s) 73 | 74 | -- NOTE: it supposed to be the same length of notes as UpToElevenLength 75 | pickIsNote :: L.List IsNote -> L.List N.Note 76 | pickIsNote = map fst <<< L.filter pick <<< L.zip N.notes 77 | where 78 | pick (Tuple _ N) = true 79 | 80 | pick (Tuple _ V) = false 81 | 82 | go :: forall a. L.List (Result a) -> L.List a -> L.List (L.List a) 83 | go L.Nil acc = pure acc 84 | 85 | go (L.Cons head tail) acc = case head of 86 | Left Space -> go tail acc 87 | Left Return -> L.Cons acc $ go tail L.Nil 88 | Right e -> go tail $ L.Cons e acc 89 | -------------------------------------------------------------------------------- /src/Emo8/Parser/NConstraint.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Parser.NConstraint 2 | ( class NConstraint 3 | , class ToNList 4 | , class MatchNote 5 | , class ExtractNR 6 | , class UpToThreeNote 7 | , class ExtractNVR 8 | , class UpTo13Length 9 | , kind SpecChar 10 | , Space 11 | , Return 12 | , kind Note 13 | , Rest 14 | , Note 15 | , Vacancy 16 | , kind NList 17 | , NNil 18 | , NCons 19 | , kind Label 20 | , S 21 | , N 22 | , kind LList 23 | , LNil 24 | , LCons 25 | ) where 26 | 27 | import Prim.Symbol as S 28 | import Prim.TypeError as TE 29 | 30 | class NConstraint (s :: Symbol) 31 | 32 | instance nConstraint :: 33 | ( ToNList s nl 34 | , ExtractNR nl ll 35 | , UpToThreeNote ll 36 | , ExtractNVR nl ll' 37 | , UpTo13Length ll' 38 | ) => 39 | NConstraint s 40 | 41 | foreign import kind SpecChar 42 | 43 | foreign import data Space :: SpecChar 44 | 45 | foreign import data Return :: SpecChar 46 | 47 | foreign import kind Note 48 | 49 | foreign import data Rest :: SpecChar -> Note 50 | 51 | foreign import data Note :: Note 52 | 53 | foreign import data Vacancy :: Note 54 | 55 | foreign import kind NList 56 | 57 | foreign import data NNil :: NList 58 | 59 | foreign import data NCons :: Note -> NList -> NList 60 | 61 | class ToNList (s :: Symbol) (nl :: NList) | s -> nl 62 | 63 | instance toNListNil :: ToNList "" NNil 64 | else instance toNListCons :: 65 | ( S.Cons head tail union 66 | , ToNList tail nl 67 | , MatchNote head out 68 | ) => 69 | ToNList union (NCons out nl) 70 | 71 | class MatchNote (s :: Symbol) (n :: Note) | s -> n 72 | 73 | instance matchNoteNote :: MatchNote "🎹" Note 74 | 75 | instance matchNoteVacancy :: MatchNote "🈳" Vacancy 76 | 77 | instance matchNoteSpace :: MatchNote " " (Rest Space) 78 | 79 | instance matchNoteReturn :: MatchNote "\n" (Rest Return) 80 | 81 | foreign import kind Label 82 | 83 | foreign import data S :: Label 84 | 85 | foreign import data N :: Label 86 | 87 | foreign import kind LList 88 | 89 | foreign import data LNil :: LList 90 | 91 | foreign import data LCons :: Label -> LList -> LList 92 | 93 | infixr 6 type LCons as : 94 | 95 | class ExtractNR (nl :: NList) (ll :: LList) | nl -> ll 96 | 97 | instance extractNRNil :: ExtractNR NNil LNil 98 | 99 | instance extractNRConsNote :: ExtractNR nl ll => ExtractNR (NCons Note nl) (LCons S ll) 100 | 101 | instance extractNRConsVacancy :: ExtractNR nl ll => ExtractNR (NCons Vacancy nl) ll 102 | 103 | instance extractNRConsSpace :: ExtractNR nl ll => ExtractNR (NCons (Rest Space) nl) ll 104 | 105 | instance extractNRConsReturn :: ExtractNR nl ll => ExtractNR (NCons (Rest Return) nl) (LCons N ll) 106 | 107 | class UpToThreeNote (ll :: LList) 108 | 109 | instance upToThreeNoteNil :: UpToThreeNote LNil 110 | 111 | instance upToThreeNoteConsN :: 112 | UpToThreeNote ll => 113 | UpToThreeNote (N : ll) 114 | 115 | instance upToThreeNoteCons1 :: 116 | UpToThreeNote ll => 117 | UpToThreeNote (S : N : ll) 118 | 119 | instance upToThreeNoteCons2 :: 120 | UpToThreeNote ll => 121 | UpToThreeNote (S : S : N : ll) 122 | 123 | instance upToThreeNoteCons3 :: 124 | UpToThreeNote ll => 125 | UpToThreeNote (S : S : S : N : ll) 126 | 127 | instance upToThreeNoteConsMore :: 128 | ( UpToThreeNote ll 129 | , TE.Fail (TE.Text "The maximum note count is 3 per line.") 130 | ) => 131 | UpToThreeNote (S : S : S : S : ll) 132 | 133 | class ExtractNVR (nl :: NList) (ll :: LList) | nl -> ll 134 | 135 | instance extractNVRNil :: ExtractNVR NNil LNil 136 | 137 | instance extractNVRConsNote :: ExtractNVR nl ll => ExtractNVR (NCons Note nl) (LCons S ll) 138 | 139 | instance extractNVRConsVacancy :: ExtractNVR nl ll => ExtractNVR (NCons Vacancy nl) (LCons S ll) 140 | 141 | instance extractNVRConsSpace :: ExtractNVR nl ll => ExtractNVR (NCons (Rest Space) nl) ll 142 | 143 | instance extractNVRConsReturn :: ExtractNVR nl ll => ExtractNVR (NCons (Rest Return) nl) (LCons N ll) 144 | 145 | class UpTo13Length (ll :: LList) 146 | 147 | instance upTo13LengthNil :: UpTo13Length LNil 148 | 149 | instance upTo13LengthConsN :: 150 | UpTo13Length ll => 151 | UpTo13Length (N : ll) 152 | 153 | instance upTo13LengthCons1 :: 154 | UpTo13Length ll => 155 | UpTo13Length (S : N : ll) 156 | 157 | instance upTo13LengthCons2 :: 158 | UpTo13Length ll => 159 | UpTo13Length (S : S : N : ll) 160 | 161 | instance upTo13LengthCons3 :: 162 | UpTo13Length ll => 163 | UpTo13Length (S : S : S : N : ll) 164 | 165 | instance upTo13LengthCons4 :: 166 | UpTo13Length ll => 167 | UpTo13Length (S : S : S : S : N : ll) 168 | 169 | instance upTo13LengthCons5 :: 170 | UpTo13Length ll => 171 | UpTo13Length (S : S : S : S : S : N : ll) 172 | 173 | instance upTo13LengthCons6 :: 174 | UpTo13Length ll => 175 | UpTo13Length (S : S : S : S : S : S : N : ll) 176 | 177 | instance upTo13LengthCons7 :: 178 | UpTo13Length ll => 179 | UpTo13Length (S : S : S : S : S : S : S : N : ll) 180 | 181 | instance upTo13LengthCons8 :: 182 | UpTo13Length ll => 183 | UpTo13Length (S : S : S : S : S : S : S : S : N : ll) 184 | 185 | instance upTo13LengthCons9 :: 186 | UpTo13Length ll => 187 | UpTo13Length (S : S : S : S : S : S : S : S : S : N : ll) 188 | 189 | instance upTo13LengthCons10 :: 190 | UpTo13Length ll => 191 | UpTo13Length (S : S : S : S : S : S : S : S : S : S : N : ll) 192 | 193 | instance upTo13LengthCons11 :: 194 | UpTo13Length ll => 195 | UpTo13Length (S : S : S : S : S : S : S : S : S : S : S : N : ll) 196 | 197 | instance upTo13LengthCons12 :: 198 | UpTo13Length ll => 199 | UpTo13Length (S : S : S : S : S : S : S : S : S : S : S : S : N : ll) 200 | 201 | instance upTo13LengthCons13 :: 202 | UpTo13Length ll => 203 | UpTo13Length (S : S : S : S : S : S : S : S : S : S : S : S : S : N : ll) 204 | 205 | instance upTo13LengthConsMore :: 206 | ( UpTo13Length ll 207 | , TE.Fail (TE.Text "The maximum score length is 13 per line.") 208 | ) => 209 | UpTo13Length (S : S : S : S : S : S : S : S : S : S : S : S : S : S : ll) 210 | -------------------------------------------------------------------------------- /src/Emo8/Parser/NConvert.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Parser.NConvert 2 | ( class NConvert 3 | , nconvert 4 | , class NMatch 5 | , nmatch 6 | ) where 7 | 8 | import Prelude (($)) 9 | import Data.Either (Either(..)) 10 | import Data.List as L 11 | import Data.Symbol (SProxy(..)) 12 | import Emo8.Parser.Type (IsNote(..), NoEmoji(..), Result) 13 | import Prim.Symbol as S 14 | 15 | class NConvert (s :: Symbol) where 16 | nconvert :: SProxy s -> L.List (Result IsNote) 17 | 18 | instance nConvertNil :: NConvert "" where 19 | nconvert _ = L.Nil 20 | else instance nConvertCons :: 21 | ( S.Cons head tail union 22 | , NConvert tail 23 | , NMatch head 24 | ) => 25 | NConvert union where 26 | nconvert _ = L.Cons (nmatch headP) $ nconvert tailP 27 | where 28 | headP = SProxy :: SProxy head 29 | 30 | tailP = SProxy :: SProxy tail 31 | 32 | class NMatch (s :: Symbol) where 33 | nmatch :: SProxy s -> Result IsNote 34 | 35 | instance nmatchSpace :: NMatch " " where 36 | nmatch _ = Left Space 37 | 38 | instance nmatchReturn :: NMatch "\n" where 39 | nmatch _ = Left Return 40 | 41 | instance nmatchN :: NMatch "🎹" where 42 | nmatch _ = Right N 43 | 44 | instance nmatchV :: NMatch "🈳" where 45 | nmatch _ = Right V 46 | -------------------------------------------------------------------------------- /src/Emo8/Parser/Type.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Parser.Type where 2 | 3 | import Prelude 4 | import Data.Either (Either) 5 | import Data.List as L 6 | import Emo8.Data.Emoji as E 7 | import Emo8.Data.Note as N 8 | 9 | type Result a 10 | = Either NoEmoji a 11 | 12 | data NoEmoji 13 | = Space 14 | | Return 15 | 16 | derive instance eqNoEmoji :: Eq NoEmoji 17 | 18 | data IsNote 19 | = N 20 | | V 21 | 22 | derive instance eqIsNote :: Eq IsNote 23 | 24 | type EmojiMap 25 | = L.List (L.List E.Emoji) 26 | 27 | type Score 28 | = L.List (L.List N.Note) 29 | -------------------------------------------------------------------------------- /src/Emo8/Type.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Type 2 | ( Tempo 3 | , Angle 4 | , X 5 | , Y 6 | , Size 7 | , Config 8 | , Rect 9 | , Walls 10 | ) where 11 | 12 | import Emo8.Data.Emoji (Emoji) 13 | 14 | type Tempo 15 | = Int 16 | 17 | type Angle 18 | = Int 19 | 20 | type X 21 | = Int 22 | 23 | type Y 24 | = Int 25 | 26 | type Size 27 | = Int 28 | 29 | type Config 30 | = { canvasSize :: Rect 31 | , retina :: Boolean 32 | } 33 | 34 | type Rect 35 | = { width :: Int 36 | , height :: Int 37 | } 38 | 39 | type Walls 40 | = Array Emoji 41 | -------------------------------------------------------------------------------- /src/Emo8/Util/Collide.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Util.Collide 2 | ( isOutOfCanvas 3 | , isCollideCanvas 4 | , isCollideMap 5 | , isCollide 6 | , Sink 7 | , sinkCanvas 8 | , sinkMapXY 9 | ) where 10 | 11 | import Prelude 12 | import Data.List as L 13 | import Data.Maybe (Maybe(..)) 14 | import Data.Ord (abs) 15 | import Emo8.Data.Emoji (Emoji) 16 | import Emo8.Parser.Type (EmojiMap) 17 | import Emo8.Type (Rect, Size, X, Y, Walls) 18 | 19 | isOutOfCanvas :: Rect -> Size -> X -> Y -> Boolean 20 | isOutOfCanvas r size x y 21 | | x >= r.width = true 22 | | y >= r.height = true 23 | | x + size <= 0 = true 24 | | y + size <= 0 = true 25 | | otherwise = false 26 | 27 | -- NOTE: collision means overlap, not touch 28 | isCollideCanvas :: Rect -> Size -> X -> Y -> Boolean 29 | isCollideCanvas r size x y 30 | | x < 0 = true 31 | | y < 0 = true 32 | | x + size > r.width = true 33 | | y + size > r.height = true 34 | | otherwise = false 35 | 36 | -- | Check if the object collides the emoji map with the specified map size, walls, object size, x and y. 37 | -- | 38 | -- | The walls are emojis collidable in a certain map. 39 | isCollideMap :: EmojiMap -> Size -> Walls -> Size -> X -> Y -> Boolean 40 | isCollideMap em ms walls size x y = f 41 | where 42 | f 43 | | coll leftId topId = true 44 | | coll leftId bottomId = true 45 | | coll rightId topId = true 46 | | coll rightId bottomId = true 47 | | otherwise = false 48 | 49 | -- NOTE: division is rounded down 50 | leftId = x / ms 51 | 52 | rightId = (x + size - 1) / ms 53 | 54 | bottomId = y / ms 55 | 56 | topId = (y + size - 1) / ms 57 | 58 | coll = isWall em walls 59 | 60 | -- | Check if the two objects collide. 61 | isCollide :: Size -> X -> Y -> Size -> X -> Y -> Boolean 62 | isCollide sizeA xA yA sizeB xB yB 63 | | xA < xB + sizeB 64 | , xB < xA + sizeA 65 | , yA < yB + sizeB 66 | , yB < yA + sizeA = true 67 | | otherwise = false 68 | 69 | type Sink 70 | = { x :: Int 71 | , y :: Int 72 | } 73 | 74 | -- | Calculate how deep the object is sunk outside the canvas. 75 | sinkCanvas :: Rect -> Size -> X -> Y -> Maybe Sink 76 | sinkCanvas r size x y = case xF, yF of 77 | Just sx, Just sy -> Just { x: sx, y: sy } 78 | Just sx, Nothing -> Just { x: sx, y: 0 } 79 | Nothing, Just sy -> Just { x: 0, y: sy } 80 | Nothing, Nothing -> Nothing 81 | where 82 | xF 83 | | x < 0 = Just x 84 | | x + size > r.width = Just $ x + size - r.width 85 | | otherwise = Nothing 86 | 87 | yF 88 | | y < 0 = Just y 89 | | y + size > r.height = Just $ y + size - r.height 90 | | otherwise = Nothing 91 | 92 | -- NOTE: judge separately x -> y or y -> x, using previous x, y. 93 | -- | Calculate how deep the object is sunk in the walls. 94 | -- | It takes emoji map, map size, walls, previous x, previous y, emoji size, x and y. 95 | -- | ※ This function only checks 4-edges of the object and treats 1-map-cell for each the edges. 96 | sinkMapXY :: EmojiMap -> Size -> Walls -> X -> Y -> Size -> X -> Y -> Maybe Sink 97 | sinkMapXY em ms walls px py size x y = 98 | if abs (x - px) > abs (y - py) then case sinkMapXF x py of 99 | Nothing -> case sinkMapYF x y of 100 | Nothing -> Nothing 101 | Just sy -> Just { x: 0, y: sy } 102 | Just sx -> case sinkMapYF (x - sx) y of 103 | Nothing -> Just { x: sx, y: 0 } 104 | Just sy -> Just { x: sx, y: sy } 105 | else case sinkMapYF px y of 106 | Nothing -> case sinkMapXF x y of 107 | Nothing -> Nothing 108 | Just sx -> Just { x: sx, y: 0 } 109 | Just sy -> case sinkMapXF x (y - sy) of 110 | Nothing -> Just { x: 0, y: sy } 111 | Just sx -> Just { x: sx, y: sy } 112 | where 113 | sinkMapXF = sinkMapX em ms walls size 114 | 115 | sinkMapYF = sinkMapY em ms walls size 116 | 117 | sinkMapX :: EmojiMap -> Size -> Walls -> Size -> X -> Y -> Maybe Int 118 | sinkMapX em ms walls size x y = case coll id.left id.bottom 119 | , coll id.right id.bottom 120 | , coll id.left id.top 121 | , coll id.right id.top of 122 | -- zero 123 | false, false, false, false -> Nothing 124 | -- left 125 | true, false, true, false -> Just sink.left 126 | true, false, false, false -> Just sink.left 127 | false, false, true, false -> Just sink.left 128 | -- right 129 | false, true, false, true -> Just sink.right 130 | false, true, false, false -> Just sink.right 131 | false, false, false, true -> Just sink.right 132 | -- other 133 | _, _, _, _ -> Just 0 134 | where 135 | coll = isWall em walls 136 | 137 | id = mapId ms size x y 138 | 139 | sink = 140 | { left: mod x ms - ms 141 | , right: mod x ms 142 | } 143 | 144 | sinkMapY :: EmojiMap -> Size -> Walls -> Size -> X -> Y -> Maybe Int 145 | sinkMapY em ms walls size x y = case coll id.left id.bottom 146 | , coll id.right id.bottom 147 | , coll id.left id.top 148 | , coll id.right id.top of 149 | -- zero 150 | false, false, false, false -> Nothing 151 | -- bottom 152 | true, true, false, false -> Just sink.bottom 153 | true, false, false, false -> Just sink.bottom 154 | false, true, false, false -> Just sink.bottom 155 | -- top 156 | false, false, true, true -> Just sink.top 157 | false, false, true, false -> Just sink.top 158 | false, false, false, true -> Just sink.top 159 | -- other 160 | _, _, _, _ -> Just 0 161 | where 162 | coll = isWall em walls 163 | 164 | id = mapId ms size x y 165 | 166 | sink = 167 | { bottom: mod y ms - ms 168 | , top: mod y ms 169 | } 170 | 171 | mapId :: 172 | Size -> 173 | Size -> 174 | X -> 175 | Y -> 176 | { bottom :: Int 177 | , left :: Int 178 | , right :: Int 179 | , top :: Int 180 | } 181 | mapId ms size x y = 182 | { left: x / ms 183 | , right: (x + size - 1) / ms 184 | , bottom: y / ms 185 | , top: (y + size - 1) / ms 186 | } 187 | 188 | isWall :: EmojiMap -> Walls -> Int -> Int -> Boolean 189 | isWall em walls xId yId = case getEmoji of 190 | Just e 191 | | L.elem e walls -> true 192 | _ -> false 193 | where 194 | getEmoji :: Maybe Emoji 195 | getEmoji = flip L.index xId =<< L.index (L.reverse em) yId 196 | -------------------------------------------------------------------------------- /src/Emo8/Util/Config.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Util.Config 2 | ( defaultConfig 3 | ) where 4 | 5 | import Emo8.Type (Config) 6 | 7 | defaultConfig :: Config 8 | defaultConfig = 9 | { canvasSize: 10 | { width: 512 11 | , height: 512 12 | } 13 | , retina: true 14 | } 15 | -------------------------------------------------------------------------------- /src/Emo8/Util/Input.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Util.Input 2 | ( noInput 3 | , everyInput 4 | , catchInput 5 | , releaseInput 6 | , anyInput 7 | ) where 8 | 9 | import Prelude 10 | import Emo8.Data.Input (Input) 11 | 12 | noInput :: Input 13 | noInput = 14 | { isUp: false 15 | , isLeft: false 16 | , isDown: false 17 | , isRight: false 18 | , isW: false 19 | , isA: false 20 | , isS: false 21 | , isD: false 22 | } 23 | 24 | everyInput :: Input 25 | everyInput = 26 | { isUp: true 27 | , isLeft: true 28 | , isDown: true 29 | , isRight: true 30 | , isW: true 31 | , isA: true 32 | , isS: true 33 | , isD: true 34 | } 35 | 36 | catchInput :: Input -> Input -> Input 37 | catchInput pi i = 38 | { isUp: not pi.isUp && i.isUp 39 | , isLeft: not pi.isLeft && i.isLeft 40 | , isDown: not pi.isDown && i.isDown 41 | , isRight: not pi.isRight && i.isRight 42 | , isW: not pi.isW && i.isW 43 | , isA: not pi.isA && i.isA 44 | , isS: not pi.isS && i.isS 45 | , isD: not pi.isD && i.isD 46 | } 47 | 48 | releaseInput :: Input -> Input -> Input 49 | releaseInput = flip catchInput 50 | 51 | anyInput :: Input -> Boolean 52 | anyInput i = 53 | i.isUp 54 | || i.isLeft 55 | || i.isDown 56 | || i.isRight 57 | || i.isW 58 | || i.isA 59 | || i.isS 60 | || i.isD 61 | -------------------------------------------------------------------------------- /src/Emo8/Util/List.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Util.List 2 | ( zipWithMaybe 3 | , zipWithMaybeA 4 | , append' 5 | , (<<>>) 6 | ) where 7 | 8 | import Prelude 9 | import Data.List (List(..), reverse, zipWith, (:)) 10 | import Data.Maybe (Maybe(..)) 11 | import Data.Traversable (sequence) 12 | 13 | zipWithMaybe :: forall a b c. (Maybe a -> Maybe b -> c) -> List a -> List b -> List c 14 | zipWithMaybe f xs ys = reverse $ go xs ys Nil 15 | where 16 | go Nil Nil acc = acc 17 | 18 | go Nil (b : bs) acc = go Nil bs $ f Nothing (Just b) : acc 19 | 20 | go (a : as) Nil acc = go as Nil $ f (Just a) Nothing : acc 21 | 22 | go (a : as) (b : bs) acc = go as bs $ f (Just a) (Just b) : acc 23 | 24 | zipWithMaybeA :: forall m a b c. Applicative m => (Maybe a -> Maybe b -> m c) -> List a -> List b -> m (List c) 25 | zipWithMaybeA f xs ys = sequence (zipWithMaybe f xs ys) 26 | 27 | append' :: forall a. Semigroup a => List a -> List a -> List a 28 | append' = zipWith (<>) 29 | 30 | infixr 5 append' as <<>> 31 | -------------------------------------------------------------------------------- /src/Emo8/Util/State.purs: -------------------------------------------------------------------------------- 1 | module Emo8.Util.State 2 | ( defaultEncode 3 | , defaultDecode 4 | ) where 5 | 6 | import Control.Monad.Except (ExceptT) 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Identity (Identity) 9 | import Data.List.Types (NonEmptyList) 10 | import Foreign.Generic (class GenericDecode, class GenericEncode, Foreign, ForeignError, defaultOptions, genericDecode, genericEncode) 11 | 12 | defaultEncode :: 13 | forall a b. 14 | Generic a b => 15 | GenericEncode b => 16 | a -> Foreign 17 | defaultEncode = genericEncode defaultOptions 18 | 19 | defaultDecode :: 20 | forall a b. 21 | Generic a b => 22 | GenericDecode b => 23 | Foreign -> ExceptT (NonEmptyList ForeignError) Identity a 24 | defaultDecode = genericDecode defaultOptions 25 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Class.Console (log) 7 | 8 | main :: Effect Unit 9 | main = do 10 | log "🍝" 11 | log "You should add some tests." 12 | --------------------------------------------------------------------------------