58 lines
1.9 KiB
Haskell
58 lines
1.9 KiB
Haskell
module Main where
|
|
|
|
import Lib
|
|
import qualified Figs
|
|
import qualified Graphics.Gloss as G
|
|
|
|
main :: IO ()
|
|
main = solve Figs.owlcation
|
|
|
|
solve figure =
|
|
print figure
|
|
>> print (centroid figure)
|
|
>> G.display (G.InWindow "Centroid Visualization" (200, 200) (10, 10)) G.black (toPicture figure)
|
|
|
|
-- the 'figure' value here shadows that global one
|
|
toPicture :: Compound -> G.Picture
|
|
toPicture figure@(Compound figures) = G.pictures $ map toPicture' figures ++ [centroid']
|
|
where toPicture' (Figure geometry (Location dx dy) axis swapped negation) =
|
|
color negation
|
|
. G.translate (realToFrac dx) (realToFrac dy)
|
|
. swap swapped
|
|
. mirror axis
|
|
. shape $ geometry
|
|
|
|
where swap NS = id
|
|
swap S = G.rotate 90
|
|
|
|
mirror N = G.scale 1 1
|
|
mirror X = G.scale 1 (-1)
|
|
mirror Y = G.scale (-1) 1
|
|
mirror XY = G.scale (-1) (-1)
|
|
|
|
color Positive = G.color G.blue
|
|
color Negative = G.color G.red
|
|
|
|
centroid' = let dx = getX $ centroid figure
|
|
dy = getY $ centroid figure
|
|
in G.translate dx dy . G.color G.red $ G.circleSolid 5
|
|
|
|
where getX (Location x _) = realToFrac x
|
|
getY (Location _ y) = realToFrac y
|
|
|
|
shape :: Geometry -> G.Picture
|
|
shape (Rectangle w h) = rectangle (realToFrac w) (realToFrac h)
|
|
shape (Triangle b h) = rightTriangle (realToFrac b) (realToFrac h)
|
|
shape (Semicircle r) = semicircle (realToFrac r)
|
|
|
|
rightTriangle :: Float -> Float -> G.Picture
|
|
rightTriangle b h = G.polygon [(0, 0), (b, 0), (0, h)]
|
|
|
|
-- defining our own rectangle so that the global origin is on the lower right
|
|
-- the gloss builtin rectangle is centered on the global origin
|
|
rectangle :: Float -> Float -> G.Picture
|
|
rectangle w h = G.polygon [(0, 0), (w, 0), (w, h), (0, h)]
|
|
|
|
semicircle :: Float -> G.Picture
|
|
semicircle r = G.arcSolid 0 180 r
|