fudgets-0.18.3: Demos/Tiles/DesignF.hs
module DesignF(designF) where
import AllFudgets
import DrawingF
import MyUtils
import Tiles
data DesignState = Init | Start Point
designSize = 250
gridNo = 10
designF :: F Tile Tile
designF = marginHVAlignF 0 aCenter aCenter (loopLeftF ((throRight padF) >==< designControlF))
padF = (drawDisplayCKF (Point designSize designSize) gridlines,Above)
>#+< updateBF
updateBF = buttonF "finished design -> current tile"
designControlF :: F (Either (Either Event Click) Tile) (Either (Either ChangeTile a) Tile)
designControlF =
let startstate = ([], Init)
step (c, s) m =
let grid = gridlines
grow = magT dtRatio
toDesign = Left. Left. changeToT
toChoice = Right
in case m of
-- from the grid
(Left (Left (ButtonEvent _ ap _ _ Pressed (Button b)))) -> (
let p = snap ap
in case s of
Init -> ((c, Start p), [toDesign ((mark p)++(grow c))])
Start f -> ((newDraw, Init), [toDesign (grow newDraw)])
where newDraw = case b of
3 -> delLine x1 y1 x2 y2 c
otherwise -> (line x1 y1 x2 y2) ++ c
Point x1 y1 = scalePoint tdRatio f
Point x2 y2 = scalePoint tdRatio p )
-- from the update button
(Left (Right Click)) -> ((c, s), [toChoice c])
-- from Choice
(Right t) -> ((t, Init), [toDesign (grow t)])
in absF (mapstateSP step startstate)
snap :: Point -> Point
snap p = sp
where sp = Point sx sy
sx = ((px+halfGridSize) `div` gridSize) * gridSize
sy = ((py+halfGridSize) `div` gridSize) * gridSize
Point px py = p
delLine _ _ _ _ [] = []
delLine x1 y1 x2 y2 (c:cs) =
let rest = delLine x1 y1 x2 y2 cs
in case c of
DrawLine (Line (Point x3 y3) (Point x4 y4)) ->
if ((x1==x3) && (y1==y3) && (x2==x4) && (y2==y4)) ||
((x1==x4) && (y1==y4) && (x2==x3) && (y2==y3))
then rest else c:rest
otherwise -> c:rest
mark p = circle x y (designSize `div` 50)
where Point x y = p
gridlines = concat [(line (l*gridSize) 0 (l*gridSize) designSize) ++
(line 0 (l*gridSize) designSize (l*gridSize)) |
l <- [1..(gridNo-1)]]
gridSize = designSize `div` gridNo
halfGridSize = gridSize `div` 2
tdRatio = (fromIntegral tileSize) / (fromIntegral designSize)
dtRatio = designSize `div` tileSize