You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
64 lines
2.0 KiB
64 lines
2.0 KiB
module UI (drawUI) where
|
|
|
|
import State
|
|
import Data.IORef
|
|
import Board
|
|
import Raylib.Core
|
|
import Raylib.Types
|
|
import Raylib.Core.Shapes
|
|
import Raylib.Util.Math
|
|
|
|
drawUI :: IORef AppState -> IO ()
|
|
drawUI r = do
|
|
state <- readIORef r
|
|
winW <- getRenderWidth
|
|
winH <- getRenderHeight
|
|
let act = state'action state
|
|
brd = state'board state
|
|
pth = state'path state
|
|
(Point off) = state'offset state
|
|
zoom = state'zoom state
|
|
(Board ti bg pths) = brd
|
|
drawBG off zoom winW winH bg
|
|
mapM_ (drawPath off zoom) pths
|
|
case act of
|
|
ActionDraw p -> drawPath off zoom p
|
|
_ -> return ()
|
|
drawInterface act pth ti winW winH
|
|
|
|
drawPath :: Vector2 -> Float -> Path -> IO ()
|
|
drawPath offset zoom path =
|
|
let points = path'points path
|
|
segments = zip points (init points)
|
|
col = unBoardColor $ path'color path
|
|
thick = (path'thickness path) * zoom
|
|
in
|
|
mapM_ (\(s, e) ->
|
|
let s' = (offset |+| unPoint s) |* zoom
|
|
e' = (offset |+| unPoint e) |* zoom
|
|
in
|
|
drawLineEx s' e' thick col
|
|
) segments
|
|
|
|
drawBG :: Vector2 -> Float -> Int -> Int -> BackgroundPattern -> IO ()
|
|
drawBG _ _ _ _ (BGPatternPlain (BoardColor col)) = clearBackground col
|
|
drawBG off zoom maxx' maxy' (BGPatternGrid fc' dc' hs' vs' th) =
|
|
let fc = unBoardColor fc'
|
|
dc = unBoardColor dc'
|
|
hs = fromIntegral hs' * zoom
|
|
vs = fromIntegral vs' * zoom
|
|
offx = fromIntegral ((truncate $ vector2'x off) `rem` hs') * zoom
|
|
offy = fromIntegral ((truncate $ vector2'y off) `rem` vs') * zoom
|
|
maxx = fromIntegral maxx'
|
|
maxy = fromIntegral maxy'
|
|
in do
|
|
clearBackground fc
|
|
mapM_ (\x -> drawLineEx (Vector2 x 0) (Vector2 x maxy) th dc)
|
|
[offx, offx+hs .. maxx]
|
|
mapM_ (\y -> drawLineEx (Vector2 0 y) (Vector2 maxx y) th dc)
|
|
[offy, offy+vs .. maxy]
|
|
drawBG _ _ _ _ _ = undefined
|
|
|
|
drawInterface :: Action -> String -> String -> Int -> Int -> IO ()
|
|
drawInterface act pth ti winW winH = do
|
|
return ()
|