tvl-depot/users/aspen/xanthous/test/Xanthous/Util/GraphicsSpec.hs

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

73 lines
3 KiB
Haskell
Raw Normal View History

module Xanthous.Util.GraphicsSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude hiding (head)
--------------------------------------------------------------------------------
import Data.List (nub, head)
import Data.Set (isSubsetOf)
import Linear.V2
--------------------------------------------------------------------------------
import Xanthous.Util.Graphics
import Xanthous.Util
import Xanthous.Orphans ()
--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Util.Graphics"
[ testGroup "circle"
[ testCase "radius 1, origin 2,2"
{-
| | 0 | 1 | 2 | 3 |
|---+---+---+---+---|
| 0 | | | | |
| 1 | | | x | |
| 2 | | x | | x |
| 3 | | | x | |
-}
$ (sort . unique @[] @[_]) (circle @Int (V2 2 2) 1)
@?= [ V2 1 2
, V2 2 1, V2 2 3
, V2 3 2
]
, testCase "radius 12, origin 0"
$ (sort . nub) (circle @Int 0 12)
@?= (sort . nub)
[ V2 (-12) (-4), V2 (-12) (-3), V2 (-12) (-2), V2 (-12) (-1)
, V2 (-12) 0, V2 (-12) 1, V2 (-12) 2, V2 (-12) 3, V2 (-12) 4
, V2 (-11) (-6), V2 (-11) (-5), V2 (-11) 5, V2 (-11) 6, V2 (-10) (-7)
, V2 (-10) 7, V2 (-9) (-9), V2 (-9) (-8), V2 (-9) 8, V2 (-9) 9
, V2 (-8) (-9), V2 (-8) 9, V2 (-7) (-10), V2 (-7) 10, V2 (-6) (-11)
, V2 (-6) 11, V2 (-5) (-11), V2 (-5) 11, V2 (-4) (-12), V2 (-4) 12
, V2 (-3) (-12), V2 (-3) 12, V2 (-2) (-12), V2 (-2) 12, V2 (-1) (-12)
, V2 (-1) 12, V2 0 (-12), V2 0 12, V2 1 (-12), V2 1 12, V2 2 (-12)
, V2 2 12, V2 3 (-12), V2 3 12, V2 4 (-12), V2 4 12, V2 5 (-11)
, V2 5 11, V2 6 (-11), V2 6 11, V2 7 (-10), V2 7 10, V2 8 (-9), V2 8 9
, V2 9 (-9), V2 9 (-8), V2 9 8, V2 9 9, V2 10 (-7), V2 10 7
, V2 11 (-6), V2 11 (-5), V2 11 5, V2 11 6, V2 12 (-4), V2 12 (-3)
, V2 12 (-2), V2 12 (-1), V2 12 0, V2 12 1, V2 12 2, V2 12 3, V2 12 4
]
]
, testGroup "filledCircle"
[ testProperty "is a superset of circle" $ \center radius ->
let circ = circle @Int center radius
filledCirc = filledCircle center radius
in counterexample ( "circle: " <> show circ
<> "\nfilledCircle: " <> show filledCirc)
$ setFromList circ `isSubsetOf` setFromList filledCirc
-- TODO later
-- , testProperty "is always contiguous" $ \center radius ->
-- let filledCirc = filledCircle center radius
-- in counterexample (renderBooleanGraphics filledCirc) $
]
, testGroup "line"
[ testProperty "starts and ends at the start and end points" $ \start end ->
let = line @Int start end
in counterexample ("line: " <> show )
$ length > 2 ==> (head === start) .&&. (head (reverse ) === end)
]
]
--------------------------------------------------------------------------------