2019-09-15 19:00:28 +02:00
|
|
|
|
module Xanthous.Util.GraphicsSpec (main, test) where
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
import Test.Prelude hiding (head)
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
import Xanthous.Util.Graphics
|
|
|
|
|
import Xanthous.Util
|
|
|
|
|
import Data.List (head)
|
2020-05-11 01:44:30 +02:00
|
|
|
|
import Data.Set (isSubsetOf)
|
2019-09-15 19:00:28 +02:00
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
|
main = defaultMain test
|
|
|
|
|
|
|
|
|
|
test :: TestTree
|
|
|
|
|
test = testGroup "Xanthous.Util.Graphics"
|
|
|
|
|
[ testGroup "circle"
|
2020-02-18 00:01:57 +01:00
|
|
|
|
[ testCase "radius 1, origin 2,2"
|
|
|
|
|
{-
|
|
|
|
|
| | 0 | 1 | 2 | 3 |
|
|
|
|
|
|---+---+---+---+---|
|
|
|
|
|
| 0 | | | | |
|
|
|
|
|
| 1 | | | x | |
|
|
|
|
|
| 2 | | x | | x |
|
|
|
|
|
| 3 | | | x | |
|
|
|
|
|
-}
|
|
|
|
|
$ (sort . unique @[] @[_]) (circle @Int (2, 2) 1)
|
|
|
|
|
@?= [ (1, 2)
|
|
|
|
|
, (2, 1), (2, 3)
|
|
|
|
|
, (3, 2)
|
|
|
|
|
]
|
|
|
|
|
, testCase "radius 12, origin 0"
|
2019-09-15 19:00:28 +02:00
|
|
|
|
$ (sort . unique @[] @[_]) (circle @Int (0, 0) 12)
|
2020-02-18 00:01:57 +01:00
|
|
|
|
@?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2)
|
|
|
|
|
, (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7)
|
|
|
|
|
, (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10)
|
|
|
|
|
, (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12)
|
|
|
|
|
, (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12)
|
|
|
|
|
, (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11)
|
|
|
|
|
, (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7)
|
|
|
|
|
, (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1)
|
|
|
|
|
, (12,0), (12,1),(12,2),(12,3),(12,4)
|
2019-12-25 01:40:52 +01:00
|
|
|
|
]
|
2019-09-15 19:00:28 +02:00
|
|
|
|
|
2020-05-11 01:44:30 +02:00
|
|
|
|
]
|
|
|
|
|
, 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) $
|
2020-02-18 00:01:57 +01:00
|
|
|
|
]
|
2019-09-15 19:00:28 +02:00
|
|
|
|
, 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)
|
|
|
|
|
]
|
|
|
|
|
]
|
2020-02-18 00:01:57 +01:00
|
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|