gloss: 動かして遊んで学ぶHaskell

## 自己紹介

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/16b455e8-690e-7b4e-3bde-be4c953cd0fd.jpeg" width="100" />

趣味はHaskellと人工知能
普段は半蔵門で働くエンジニア

Twitter: [@lotz84_](https://twitter.com/lotz84_)（質問があればこちらまで）
GitHub: [@lotz84](https://github.com/lotz84)
Qiita: @lotz 

----

# Haskell入門のあとにありがちなパターン

----

![image.png](https://qiita-image-store.s3.amazonaws.com/0/17134/a9af5a0b-a70d-bb3c-16bc-3b46b4403068.png)

by [Twitterを巡回していてわかったHaskell初心者が躓きやすいポイント8つ](https://qiita.com/lotz/items/5cbaca19d90cd168ab43)

(lotz調べ)

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/62e3fcbc-2a39-6b7e-5eb9-9da0a8163939.png" width="200" />

----

# もっと想像力を刺激するような<br />実装例が必要なのでは？

----

## gloss: Painless 2D vector graphics, animations and simulations.
<img src="https://camo.qiitausercontent.com/b0b76fba748d350b78b7040a3cb29fc890c101f6/68747470733a2f2f71696974612d696d6167652d73746f72652e73332e616d617a6f6e6177732e636f6d2f302f31373133342f61393334623931652d643265652d373032352d356461342d6439303034623131346364342e706e67" width="600" />

出展: [glossではじめるグラフィック描画 :: Haskell入門の次に読む記事](https://qiita.com/lotz/items/eb73e62a64bc208c2dd6)

----

## gloss
2Dグラフィックを簡単に描画できるライブラリ

* アニメーション
* シミュレーション
* マウスやキーボードのイベント処理

にも対応

**目に見えるものがすぐに作れるので楽しい！✌('ω'✌ )三✌('ω')✌三( ✌'ω')✌**

----

# 今回の目標<br />Twitterで「glossで作ってみた」報告が<br />たくさん投稿される

----

# Hello World

----

## gloss: Hello World

```hs
import Graphics.Gloss

main :: IO ()
main = display inWindow white message
  where
    inWindow = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    message = text "Hello World"
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/e55bf65f-e7d0-5b68-67cd-c1c033130ee5.png" width=400 />

----

## display
与えられた図形を単純に描画する関数

```hs
display :: Display -- 描画モード
        -> Color   -- 背景色
        -> Picture -- 描画する図形
        -> IO ()

-- ウィンドウの表示モードを表す型
data Display = InWindow String (Int, Int) (Int, Int)
             | FullScreen

-- 色を表す型
data Color = ...

-- 図形を表す型
data Picture = ...
```

----

## glossにおける重要な４つの関数

```hs
-- 与えられた図形を単純に描画する関数
display :: Display -- 描画モード
        -> Color   -- 背景色
        -> Picture -- 描画する図形
        -> IO ()


-- 時間変化を伴う図形（アニメーション）を描画する関数
animate :: Display            -- 描画モード
        -> Color              -- 背景色
        -> (Float -> Picture) -- 経過時間を受け取って図形を返す関数
        -> IO ()


-- モデルの時間発展をシミュレーションして描画する関数
simulate :: Display            -- 描画モード
         -> Color              -- 背景色
         -> Int	               -- 1秒あたりのステップ数
         -> model              -- モデルの初期値
         -> (model -> Picture) -- モデルから図形に変換する関数
         -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
         -> (ViewPort -> Float -> model -> model)
         -> IO ()


-- キーボードやマウスなどの入力イベントを処理してゲームを描画する関数
play :: Display	-- 描画モード
     -> Color   -- 背景色
     -> Int     -- 1秒あたりのステップ数
     -> world   -- ワールドの初期値
     -> (world -> Picture)        -- ワールドから図形に変換する関数
     -> (Event -> world -> world) -- イベントを元にワールドを更新する関数
     -> (Float -> world -> world) -- 1ステップの経過時間を受け取ってワールドを発展させる関数
     -> IO ()
```

----

# Picture

----

## Line
線分

```hs
line :: [(Float, Float)] -> Picture
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/83a8205e-381d-f7b5-9542-701a8faeca11.png" width=400 />

----

## Circle
円

```hs
circle :: Float -> Picture

circleSolid :: Float -> Picture
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/c7173295-098e-0d1b-6bd8-1844af83f9e2.png" width=400 />

----

## Rectangle
長方形

```hs
rectangleWire :: Float -> Float -> Picture

rectangleSolid :: Float -> Float -> Picture
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/a904c39a-7861-666d-f6da-db8938a130a0.png" width=400 />

----

## Text
文字列

```hs
text :: String -> Picture
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/b483c43f-7dc9-5b49-8ac2-407ae53f9f74.png" width=400 />

ただし、フォントの指定や日本語の表示ができない

----

# Pictureを変形する

----

## Translate
図形を移動する

```hs
translate :: Float   -- x座標の移動量
          -> Float   -- y座標の移動量
          -> Picture -- 移動させたい図形
          -> Picture
```

glossの座標系

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/c513a608-35c7-7452-b1cd-684d929ac553.png" width=400 />

----

## Scale

拡大縮小させる

```hs
scale :: Float -> Float -> Picture -> Picture
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/28622373-efc5-53b1-9782-4a5109f91ae7.gif" width=400 />

----

## Hello World 2
「Hello World」の文字列全体を表示する


```hs
import Graphics.Gloss

main :: IO ()
main = display inWindow white message
  where
    inWindow = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    message = translate (-160) 0 . scale 0.5 0.5 $ text "Hello World"
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/cfff855b-2e0b-ac15-d007-e2ca0346574c.png" width=400 />

----

## Rotate
図形を時計回りに回転させる。角度は度数法で指定する

```hs
rotate :: Float -> Picture -> Picture
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/c7106fdd-f0ec-05d5-5026-03cc548d3ba5.gif" width=400 />

----

## Color
図形の色を変える

```hs
color :: Color -> Picture -> Picture

black, white, red, green, blue  :: Color

makeColor :: Float -- Red
          -> Float -- Green
          -> Float -- Blue
          -> Float -- Alpha
          -> Color
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/55a190a3-3377-0483-92ad-54d78256ca1c.png" width=400 />

----

## Monoid

`Picture`はMonoidのインスタンスとなっている
図形を合成するときはモノイドの演算を用いる

```hs
circle 50 <> rectangleWire 50 50
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/ae12bf3a-e79f-750e-49de-ad49da7a4619.png" width=400 />

----

# 物理シミュレーション

----

## 二重振り子のシミュレーション

<img src="https://i.gyazo.com/fc1532c35c7f3e9ea5c703dd3d222d7d.gif" width=400 />

[tweet](https://twitter.com/lotz84_/status/866661941279834112)

----

## simulateの考え方

```hs
-- モデルの時間発展をシミュレーションして描画する関数
simulate :: Display            -- 描画モード
         -> Color              -- 背景色
         -> Int	               -- 1秒あたりのステップ数
         -> model              -- モデルの初期値
         -> (model -> Picture) -- モデルから図形に変換する関数
         -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
         -> (ViewPort -> Float -> model -> model)
         -> IO ()
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/955678ac-e122-756e-0b91-c3c030dbb029.png" width=500 />
以下の3つの設計が重要

* 状態を表す抽象的なモデル
* モデルの時間発展を記述する関数
* モデルを視覚的な情報に変換する関数

----

## モデルと時間発展

二重振り子における状態

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/d32f8eb0-84da-625b-3ed1-b61eb1176d3d.png" width=250 />

運動方程式

```math
(m_1 + m_2)l_1\frac{d^2\theta_1}{dt^2} + m_2l_2\frac{d^2\theta_2}{dt^2}\cos(\theta_1 - \theta_2) + m_2l_2\left(\frac{d\theta_2}{dt}\right)^2\sin(\theta_1 - \theta_2) + (m_1 + m_2)g\sin\theta_1 = 0
```
```math
l_1l_2\frac{d^2\theta_1}{dt^2}\cos(\theta_1 - \theta_2) + l^2_2\frac{d^2\theta_2}{dt^2} - l_1l_2\left(\frac{d\theta_1}{dt}\right)^2\sin(\theta_1 - \theta_2) + gl_2\sin\theta_2 = 0
```

この連立方程式を二つの加速度について解けば良い…

参考: [二重振り子 - Wikipedia](https://ja.wikipedia.org/wiki/%E4%BA%8C%E9%87%8D%E6%8C%AF%E3%82%8A%E5%AD%90)

----

## hamilton

![image.png](https://qiita-image-store.s3.amazonaws.com/0/17134/606a88c6-0fe2-3f01-6786-d8ca5ed8a152.png)

ハミルトン力学と自動微分を利用して一般化座標系における物理をシミュレーションしてくれるライブラリ

```hs
-- m次元のデカルト座標、n次元の一般化座標を持つ系
data System m n = ...

-- 系を作成する関数
mkSystem' :: (KnownNat m, KnownNat n)	 
          => R m                        -- 各デカルト座標系における慣性（質量）
          -> (Vector n a -> Vector m a) -- 一般化座標系からデカルト座標系への変換
          -> (Vector m a -> a)          -- デカルト座標系における位置エネルギー
          -> System m n

-- 相空間の状態を系に従って発展させる関数
stepHam :: (KnownNat m, KnownNat n)
        => Double     -- 微小時間
        -> System m n -- 物理系
        -> Phase n    -- 相空間の状態
        -> Phase n

data Phase n = Phs
  { phsPositions :: R n -- 一般化座標
  , phsMomenta   :: R n -- 一般化運動量
  }
```

----

## 二重振り子におけるSystem

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/d32f8eb0-84da-625b-3ed1-b61eb1176d3d.png" width=250 />

```hs
pendulum :: System 4 2
pendulum = mkSystem' mass transform potential
  where
    mass = vec4 1 1 1 1                                     -- 慣性
    transform (V.toList -> [t1, t2]) =                      -- 角度から重りのデカルト座標への変換
      let (x1, y1) = (sin t1, -cos t1)
          (x2, y2) = (sin t1 + sin t2, -(cos t1 + cos t2))
       in fromJust $ V.fromList [x1, y1, x2, y2]
    potential (V.toList -> [_, y1, _, y2]) = y1 + y2        -- 位置エネルギー（y座標の値の合計）
```

----

## 二重振り子の描画

```hs
type Model = Phase 2

draw :: Model -> Picture
draw (Phs qs _) =
  let radian   = 180 / pi
      t1       = realToFrac $ qs <.> vec2 1 0
      t2       = realToFrac $ qs <.> vec2 0 1
      l        = 100                                    -- 振り子の見た目の長さ
      stick  = translate 0 (-l/2)  $ rectangleSolid 1 l -- 棒
      weight = translate 0 (-l)    $ circleSolid 10     -- 重り
      (x1, y1) = (l * sin t1, l * (-cos t1))            -- １つ目の振り子の先端位置
      pendulum1 =                   rotate (-t1 * radian) $ stick <> weight
      pendulum2 = translate x1 y1 . rotate (-t2 * radian) $ stick <> weight
   in pendulum1 <> pendulum2
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/60bc967c-6d14-0de3-10fb-42bf4fb23a89.png" width=400 />

----

## 二重振り子のシミュレーション

```hs
main :: IO ()
main = simulate inWindow white 24 initModel draw (\_ -> step)
  where
    inWindow  = InWindow "Haskell Day 2018" (640, 480) (100, 100)
    initModel = Phs (vec2 2 2) (vec2 0 0)
    step dt = stepHam (realToFrac dt) pendulum
```

<img src="https://i.gyazo.com/75700d56f538dc2e58a7e553737aa8c4.gif" width=400 />

<https://gist.github.com/lotz84/7c784e2fc3c4016960dbe323ae53b4d2>

* 初期値をずらした振り子を50本用意すれば冒頭の動画が作れる
* 同じ方法でn重振り子も簡単に作れる

----

# コモナドで作るライフゲーム

----

## コモナド
自己関手の圏におけるコモノイド対象
Haskellでは単なる型クラス

```hs
class Functor w     => Comonad w where
  extract   :: w a -> a
  duplicate :: w a -> w (w a)

  extend    :: (w b -> a) -> w b -> w a
  extend f = fmap f . duplicate
```

* 包まれた値から中身を取り出す `extract`
* 包まれた値をさらに包む `duplicate`

----

## モナド
自己関手の圏におけるモノイド対象
Haskellでは単なる型クラス

```hs
class Applicative m => Monad m   where
  pure      :: a -> m a
  join      :: m (m a) -> m a

  (>>=)     :: (a -> m b) -> m a -> m b
  k >>= m = join $ fmap k m
```

* 値を包む `return`
* 二重に包まれた値を一重にする `join`

----

## コモナドにまつわる話

* [コモナドはモナドの圏論的双対](https://bartoszmilewski.com/2017/01/02/comonads/)
    * 有名なモナドの双対
        * Reader ↔ Env
        * Writer ↔ Traced
        * State ↔ Store
* [Zipperもコモナド](https://stackoverflow.com/questions/25554062/zipper-comonads-generically?lq=1)
* [Lensは余状態余モナドの余代数](https://patternsinfp.wordpress.com/2011/01/31/lenses-are-the-coalgebras-for-the-costate-comonad/)
    * つまりStoreコモナドの余代数
* [画像のフィルタ処理をコモナドで実装できる](https://jaspervdj.be/posts/2014-11-27-comonads-image-processing.html)
    * ガウシアンフィルタとか微分フィルタとか

今日はコモナドの詳しい話は割愛します

----

## ライフゲーム
<img src="https://i.gyazo.com/0ae6b8ac72b8f646d86c2f342b922ab8.gif" width=200 />

ライフゲームは1970年にイギリスの数学者コンウェイによって考案された
**生命の誕生・進化・淘汰のプロセスを再現した簡易的なモデル**

平面上に生存セル■と死亡セル□が升目上に並べられており、決められたルールにより時間発展していく

----

## ライフゲームの4つのルール

### 生

* 誕生
    * 死亡セルに隣接する生存セルがちょうど3つあれば、生存セルとなる
    * <img src="https://qiita-image-store.s3.amazonaws.com/0/17134/b8fa7009-7a94-ed5f-7485-7547fc2cca98.png" width=80 />
* 生存
    * 生存セルに隣接する生存セルが2つか3つならば、生存セルとなる
    * <img src="https://qiita-image-store.s3.amazonaws.com/0/17134/8356f86a-702f-70ff-2435-e46aa446b218.png" width=80 />

### 死

* 過疎
    * 生存セルに隣接する生存セルが1つ以下ならば、死亡セルとなる
    * <img src="https://qiita-image-store.s3.amazonaws.com/0/17134/6ba056c9-3f66-f6d6-33fa-dac3aff1b384.png" width=80 />
* 過密
    * 生存セルに隣接する生存セルが4つ以上ならば、死亡セルとなる
    * <img src="https://qiita-image-store.s3.amazonaws.com/0/17134/dd1ed656-4f69-648a-958b-1ea1be8732e1.png" width=80 />

----

## 例: ブロック・ブリンカー・グライダー

<img src="https://i.gyazo.com/b09aedca5caa0cd58d6e291b98162679.gif" width=400 />

----

## ライフゲームのデータ構造

```hs
-- | 1点に注目した無限リスト
data Z a = Z [a] a [a]

left, right :: Z a -> Z a
left  (Z (l:ls) c rs    ) = Z ls     l (c:rs)
right (Z ls     c (r:rs)) = Z (c:ls) r rs
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/2f1ba86d-f552-56fe-7136-522ef2fc2545.png" width=250 />

----

## ライフゲームのデータ構造

```hs
iterate1 :: (a -> a) -> a -> [a]
iterate1 f = tail . iterate f

instance Functor Z where
  fmap f (Z ls c rs) = Z (fmap f ls) (f c) (fmap f rs)

instance Comonad Z where
  -- extract   :: Z a -> a
  extract (Z _ a _) = a

  -- duplicate :: Z a -> Z (Z a)
  duplicate z = Z (iterate1 left z) z (iterate1 right z)
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/1ed79b34-e7d3-f7c3-5ee3-bb89807f3896.jpeg" width=400 />

----

## ライフゲームのデータ構造

```hs
-- | 1点に注目した無限平面（2重リスト）
newtype Z2 a = Z2 (Z (Z a))

instance Functor Z2 where
  fmap f (Z2 zz) = Z2 (fmap (fmap f) zz)

instance Comonad Z2 where
  -- extract   :: Z2 a -> a
  extract (Z2 zz) = extract (extract zz)

  -- duplicate :: Z2 a -> Z2 (Z2 a)
  duplicate (Z2 zz) = fmap Z2 . Z2 . roll $ roll zz
    where
      roll :: Z (Z a) -> Z (Z (Z a))
      roll zz = Z (iterate1 (fmap left) zz) zz (iterate1 (fmap right) zz)
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/6029c2af-b6f7-3176-f97f-adb577faaaca.jpeg" width=400 />

----

## ライフゲームのデータ構造

True: 生存セル
False: 死亡セル

```hs
-- | 注目している点の周りのTrueの数を数える
neighbours :: Z2 Bool -> Int
neighbours (Z2 (Z
  (Z (n0:_) n1 (n2: _):_)
  (Z (n3:_) _  (n4:_))
  (Z (n5:_) n6 (n7: _):_))) =
    length $ filter id [n0, n1, n2, n3, n4, n5, n6, n7]

-- | 注目している点が次のステップで生存するかを判定する
life :: Z2 Bool -> Bool
life z = (a && (n == 2 || n == 3)) || (not a && n == 3)
  where
    a = extract z
    n = neighbours z
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/ea5747d6-0560-bfad-9a40-d0717aa6e929.jpeg" width=200 />

```hs
-- ライフゲームを時間発展させる
extend life :: Z2 Bool -> Z2 Bool
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/432909bf-a139-b39f-b244-e4585c261d65.jpeg" width=400 />

----

## ライフゲームの描画

```hs
wWidth, wHeight :: Num a => a
wWidth  = 640
wHeight = 480

type Model = Z2 Bool

draw :: Model -> Picture
draw (Z2 (Z _ _ rows)) =
  let cSize   = 20 -- セルの大きさ
      -- 基本となるセルの四角形。右下に原点がくる
      cell    = translate (-cSize / 2) (cSize / 2) $ rectangleSolid cSize cSize
      b2c b   = if b then black else white -- Boolから色への変換
      nWidth  = ceiling $ wWidth  / cSize  -- 横方向のセルの個数
      nHeight = ceiling $ wHeight / cSize  -- 縦方向のセルの個数
      cells   = do
        ((Z _ _ row), h) <- zip rows [1..nHeight] -- 縦方向に盤面を走査する
        (b,           w) <- zip row  [1..nWidth]  -- 横方向に行を走査する
        let x = fromIntegral w * cSize - wWidth / 2   -- セルのx座標
            y = wHeight / 2 - fromIntegral h * cSize  -- セルのy座標
            transform = color (b2c b) . translate x y -- セルに施す変形
        pure $ transform cell
   in mconcat cells -- 計算した全てのセルを結合して1つのPictureにする
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/080524ee-55d5-9b29-e8da-4adcd4935374.jpeg" width=200>

----

## ライフゲームの実装

```hs
toZ :: a -> [a] -> Z a
toZ a xs = Z (repeat a) a (xs ++ repeat a)

toZ2 :: a -> [[a]] -> Z2 a
toZ2 a xss = Z2 $ toZ (toZ a []) (map (toZ a) xss)


main :: IO ()
main = simulate inWindow white 3 initModel draw (\_ _ -> extend life)
  where
    inWindow  = InWindow "Haskell Day 2018" (wWidth, wHeight) (100, 100)
    field = [ " # "
            , "  #"
            , "###"
            ]
    initModel = toZ2 False $ map (map (== '#')) field
```

<img src="https://i.gyazo.com/8d6e41d5ca4dd393f16191b3ad304922.gif" width=400 />

<https://gist.github.com/lotz84/435630be7ee21cc9b4dfbd004a7cb7fd>

* 遅延評価により描画に必要なデータだけ評価されるのでちゃんと動く
* しかし時間がたつにつれ計算量が増えていくのが難点
* Z2を平面ではなくトーラス上に実装することはできる？

----

## Graphics.Gloss.Interface.IO

----

## glossの中でIOを使いたい

* 乱数
* ネットワーク通信
* セーブデータのファイル出力
* FRPライブラリと組み合わせて使いたい
* （などなど）

glossのモジュールを眺めてみると…

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/cf71a0ee-e757-f8b7-465f-6d9839790624.png" width=400>

----

## Graphics.Gloss.Interface.IO

```hs
-- モデルの時間発展をシミュレーションして描画する関数
simulateIO :: Display            -- 描画モード
           -> Color              -- 背景色
           -> Int                -- 1秒あたりのステップ数
           -> model              -- モデルの初期値
           -> (model -> IO Picture) -- モデルから図形に変換する関数
           -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
           -> (ViewPort -> Float -> model -> IO model)
           -> IO ()

-- キーボードやマウスなどの入力イベントを処理してゲームを描画する関数
playIO :: Display -- 描画モード
       -> Color   -- 背景色
       -> Int     -- 1秒あたりのステップ数
       -> world   -- ワールドの初期値
       -> (world -> IO Picture)        -- ワールドから図形に変換する関数
       -> (Event -> world -> IO world) -- イベントを元にワールドを更新する関数
       -> (Float -> world -> IO world) -- 1ステップの経過時間を受け取ってワールドを発展させる関数
       -> IO ()
```

----

## Graphics.Gloss.Interface.Pure（比較用）

```hs
-- モデルの時間発展をシミュレーションして描画する関数
simulate   :: Display            -- 描画モード
           -> Color              -- 背景色
           -> Int                -- 1秒あたりのステップ数
           -> model              -- モデルの初期値
           -> (model ->    Picture) -- モデルから図形に変換する関数
           -- ビューポートと前ステップからの経過時間を受け取ってモデルを発展させる関数
           -> (ViewPort -> Float -> model ->    model)
           -> IO ()

-- キーボードやマウスなどの入力イベントを処理してゲームを描画する関数
play   :: Display -- 描画モード
       -> Color   -- 背景色
       -> Int     -- 1秒あたりのステップ数
       -> world   -- ワールドの初期値
       -> (world ->    Picture)        -- ワールドから図形に変換する関数
       -> (Event -> world ->    world) -- イベントを元にワールドを更新する関数
       -> (Float -> world ->    world) -- 1ステップの経過時間を受け取ってワールドを発展させる関数
       -> IO ()
```

----

## 例: カオスゲーム

適当な点から始めて多角形の頂点をランダムに選び内分点を取っていくとフラクタル図形ができる（[反復関数系](https://ja.wikipedia.org/wiki/%E5%8F%8D%E5%BE%A9%E9%96%A2%E6%95%B0%E7%B3%BB)）

例えば三角形と中点で内分点を取る操作を繰り返すと **シェルピンスキーのギャスケット** になる

```hs
vertexes :: [Point]
vertexes = [(0, 120), (-160, -120), (160, -120)]
```

<img src="https://qiita-image-store.s3.amazonaws.com/0/17134/62e86c68-d615-4760-b564-814de12e295a.png" width=400>

次の点を計算する関数

```hs
type Model = [Point]

step :: Model -> IO Model
step [] = pure []                          -- まだ点が無ければ何もしない
step ps@((x, y):_) = do
  gen <- createSystemRandom                -- 乱数のジェネレータを生成
  i   <- uniformR (0, 2) gen               -- ランダムなインデックスを生成
  let (vx, vy) = vertexes !! i             -- ランダムな頂点の座標
  pure $ ((x + vx) / 2, (y + vy) / 2) : ps -- 内分点を計算して追加する
```

イベントハンドラ

```hs
handler :: Event -> Model -> IO Model
-- 最初に左クリックされた点を開始点とする
handler (EventKey (MouseButton LeftButton) Down _ (x, y)) [] = pure $ [(x, y)] 
handler _ model = pure model -- それ以外の時は何もしない
```

描画処理

```hs
draw :: Model -> IO Picture
draw ps =
  let vCircles = map (\(x, y) -> translate x y $ circleSolid 5) $ vertexes
      pCircles = map (\(x, y) -> translate x y $ circleSolid 2) $ ps
   in pure $ mconcat vCircles <> mconcat pCircles
```

main関数

```hs
main :: IO ()
main = playIO inWindow white 24 [] draw handler (\_ -> step)
  where
    inWindow  = InWindow "Haskell Day 2018" (640, 480) (100, 100)
```

<img src="https://i.gyazo.com/cd3eb507c1d7fde367ea36a6d0b5e9c7.gif" width=400 />

<https://gist.github.com/lotz84/492f260bf75588f0eab88b99ee9276d4>

----

## まとめ

* glossを使えば簡単に2Dグラフィックを扱える
* hamiltonを使えば運動方程式も簡単に扱える
* コモナドを使えばライフゲームが簡単に作れる
* glossにはIOを伴うインターフェースも用意されている

----

# さぁglossで遊びましょう！

----

# ご清聴ありがとうございました