aboutsummaryrefslogtreecommitdiff
path: root/src/Chelleport/View.hs
blob: 4956a9fc19d1c16c55fd2a182dac50a0adf12316 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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
98
99
100
101
102
module Chelleport.View (render) where

import Chelleport.Draw
import Chelleport.Types
import Chelleport.Utils (intToCInt, isEmpty, isNotEmpty)
import Control.Monad (forM_, unless, void, when)
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.List (isPrefixOf, (\\))
import Data.Maybe (isJust)
import qualified Data.Text as Text
import Foreign.C (CInt)
import SDL (($=))
import qualified SDL

render :: State -> DrawContext -> IO ()
render state ctx = do
  renderGridLines state ctx

  (SDL.V2 width height) <- windowSize ctx
  let grid = stateGrid state
  let wcell = width `div` intToCInt (length $ head grid)
  let hcell = height `div` intToCInt (length grid)

  forM_ (zip [0 ..] grid) $ \(rowIndex, row) -> do
    forM_ (zip [0 ..] row) $ \(colIndex, cell) -> do
      let py = rowIndex * hcell + 10
      let px = colIndex * wcell + wcell `div` 2 - 20
      visible <- renderKeySequence ctx (stateKeySequence state) cell (px, py)
      when visible $ do
        renderTargetPoints state ctx (rowIndex, colIndex) (wcell, hcell)

renderKeySequence :: DrawContext -> KeySequence -> Cell -> (CInt, CInt) -> IO Bool
renderKeySequence ctx keySequence cell (px, py) = do
  let (matched, remaining)
        | keySequence `isPrefixOf` cell = splitAt (length keySequence) cell
        | otherwise = ("", cell)

  let textColor
        | isEmpty keySequence = Just colorWhite
        | isNotEmpty matched = Just colorHighlight
        | otherwise = Nothing

  widthRef <- newIORef 0
  unless (isEmpty matched) $ do
    (textWidth, _h) <- drawText ctx (SDL.V2 px py) colorLightGray $ Text.pack matched
    modifyIORef' widthRef (const textWidth)

  unless (isEmpty remaining) $ do
    case textColor of
      Just color -> do
        prevTextWidth <- readIORef widthRef
        let pos = px + prevTextWidth
        void $ drawText ctx (SDL.V2 pos py) color $ Text.pack remaining
      Nothing -> pure ()

  pure (isJust textColor)

renderGridLines :: State -> DrawContext -> IO ()
renderGridLines state ctx@(DrawContext {ctxRenderer = renderer}) = do
  (SDL.V2 width height) <- windowSize ctx
  let grid = stateGrid state
  let wcell = width `div` intToCInt (length $ head grid)
  let hcell = height `div` intToCInt (length grid)

  let rows = intToCInt $ length grid
  let columns = intToCInt $ length $ head grid
  forM_ [0 .. rows] $ \rowIndex -> do
    SDL.rendererDrawColor renderer $= colorFocusLines
    drawHorizontalLine ctx (rowIndex * hcell + hcell `div` 2)
    SDL.rendererDrawColor renderer $= colorGridLines
    drawHorizontalLine ctx $ rowIndex * hcell
  forM_ [0 .. columns] $ \colIndex -> do
    SDL.rendererDrawColor renderer $= colorFocusLines
    drawVerticalLine ctx (colIndex * wcell + wcell `div` 2)
    SDL.rendererDrawColor renderer $= colorGridLines
    drawVerticalLine ctx $ colIndex * wcell

  SDL.rendererDrawColor renderer $= colorAxisLines
  drawHorizontalLine ctx (rows * hcell `div` 2)
  drawVerticalLine ctx (columns * wcell `div` 2)

renderTargetPoints :: State -> DrawContext -> (CInt, CInt) -> (CInt, CInt) -> IO ()
renderTargetPoints state ctx@(DrawContext {ctxRenderer = renderer}) (row, col) (wcell, hcell) = do
  let (x, y) = (col * wcell + wcell `div` 2, row * hcell + hcell `div` 2)
  SDL.rendererDrawColor renderer $= colorWhite
  drawCircle ctx 2 (x, y)
  when (stateIsMatched state) $ do
    SDL.rendererDrawColor renderer $= colorFineGrainGrid
    forM_ ([-8 .. 8] \\ [0]) $ \n -> do
      let px = x + n * wcell `div` 16
      SDL.drawLine renderer (SDL.P $ SDL.V2 px (y - hcell `div` 2)) (SDL.P $ SDL.V2 px (y + hcell `div` 2))
    forM_ ([-8 .. 8] \\ [0]) $ \n -> do
      let py = y + n * hcell `div` 16
      SDL.drawLine renderer (SDL.P $ SDL.V2 (x - wcell `div` 2) py) (SDL.P $ SDL.V2 (x + wcell `div` 2) py)

    SDL.rendererDrawColor renderer $= colorLightGray
    let lenx = wcell `div` 4
    let leny = hcell `div` 4
    SDL.drawLine renderer (SDL.P $ SDL.V2 (x - wcell `div` 4) (y - leny)) (SDL.P $ SDL.V2 (x - wcell `div` 4) (y + leny))
    SDL.drawLine renderer (SDL.P $ SDL.V2 (x + wcell `div` 4) (y - leny)) (SDL.P $ SDL.V2 (x + wcell `div` 4) (y + leny))
    SDL.drawLine renderer (SDL.P $ SDL.V2 (x - lenx) (y - hcell `div` 4)) (SDL.P $ SDL.V2 (x + lenx) (y - hcell `div` 4))
    SDL.drawLine renderer (SDL.P $ SDL.V2 (x - lenx) (y + hcell `div` 4)) (SDL.P $ SDL.V2 (x + lenx) (y + hcell `div` 4))