├── .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 | [](https://travis-ci.org/opyapeus/purescript-emo8)
4 | [](https://pursuit.purescript.org/packages/purescript-emo8)
5 |
6 | 絵文字だけでゲームが作れるユニークな関数型2Dゲームエンジン
7 |
8 | [ [English](README.md) ]
9 |
10 | 
11 | 
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 | [](https://travis-ci.org/opyapeus/purescript-emo8)
4 | [](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 | 
11 | 
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 |
--------------------------------------------------------------------------------