74 lines
2.6 KiB
Haskell
74 lines
2.6 KiB
Haskell
module Main where
|
|
|
|
import Control.Monad (join)
|
|
import Test.QuickCheck (Arbitrary (arbitrary))
|
|
|
|
-- | One point of a path, consisting of its \(x\) and \(y\) coordinates.
|
|
newtype Vertex = Point (Double, Double) deriving (Eq)
|
|
|
|
instance Show Vertex where
|
|
show (Point (x, y)) = show x ++ " " ++ show y
|
|
|
|
instance Arbitrary Vertex where
|
|
arbitrary = do
|
|
x <- arbitrary
|
|
y <- arbitrary
|
|
return (Point (x, y))
|
|
|
|
-- | 'vertexDistance' @p@
|
|
-- returns the distance of a vertex to the origin
|
|
vertexDistance :: Vertex -> Double
|
|
vertexDistance (Point (x, y)) = sqrt (x ** 2 + y ** 2)
|
|
|
|
-- | 'fromAngle' @angle@
|
|
-- creates a point on the unit circle at the specified angle
|
|
-- (specified in radians).
|
|
fromAngle angle = Point (sin angle, cos angle)
|
|
|
|
-- | 'scale' @s@ @p@ scales the vector to @p@ by the factor @s@.
|
|
scale :: Double -> Vertex -> Vertex
|
|
scale s (Point (x, y)) = Point (s * x, s * y)
|
|
|
|
-- | 'move' @p1@ @p2@ adds the coordinates of @p1@ and @p2@,
|
|
-- effectively moving @p1@ by @p2@ (or vice-versa).
|
|
move :: Vertex -> Vertex -> Vertex
|
|
move (Point (x1, y1)) (Point (x2, y2)) = Point (x1 + x2, y1 + y2)
|
|
|
|
-- | Points \(p_0, p_2, \dots, p_{n-1}\)
|
|
-- that should be connected,
|
|
-- so that \(p_{i \bmod n}\) is connected to \(p_{i+1 \bmod n}\).
|
|
newtype PolygonPath = PolygonPath [Vertex]
|
|
|
|
instance Show PolygonPath where
|
|
show (PolygonPath (v : vs)) = "<path d=\"M " ++ show v ++ join (map (\v -> " L " ++ show v) vs) ++ " Z\"/>\n"
|
|
show (PolygonPath []) = ""
|
|
|
|
-- | 'regularPolygonMod' @n@ @rf@ @pos@
|
|
-- creates a regular @n@-gon (@n@ must be greater than or equal to 3)
|
|
-- with the centre at @pos@
|
|
-- that is modified in the sense that it takes @rf@,
|
|
-- which is used to set the radius for each individual point.
|
|
regularPolygonMod :: Integer -> (Integer -> Double) -> Vertex -> Maybe PolygonPath
|
|
regularPolygonMod n rf pos
|
|
| n < 3 = Nothing
|
|
| otherwise = Just (PolygonPath (map (\step -> move pos $ scale (rf step) $ fromAngle (fromInteger step * 2 * pi / fromInteger n)) [0 .. (n - 1)]))
|
|
|
|
-- | 'regularPolygon' @n@ @r@ @pos@
|
|
-- creates a regular polygon
|
|
-- with the radius @r@
|
|
-- and the centre at @pos@.
|
|
regularPolygon :: Integer -> Double -> Vertex -> Maybe PolygonPath
|
|
regularPolygon n r = regularPolygonMod n (const r)
|
|
|
|
-- | 'star' @n@ @r1@ @r2@ @pos@
|
|
-- creates a star
|
|
-- with @n@ spikes,
|
|
-- the inner radius @r1@,
|
|
-- the outer radius @r2@
|
|
-- and the centre @pos@.
|
|
star :: Integer -> Double -> Double -> Vertex -> Maybe PolygonPath
|
|
star n r1 r2 = regularPolygonMod (n * 2) ((take (fromInteger n * 2) (cycle [r1, r2]) !!) . fromInteger)
|
|
|
|
main :: IO ()
|
|
main = putStr $ join $ map (\n -> show n ++ "-gon: " ++ show (regularPolygon n 100 (Point (100, 100)))) [5, 8, 10, 15, 18, 30]
|