A Cretan Maze using Haskell Diagrams
My first stab at using Haskell Diagrams
Published on February 17, 2014
Hypnotic, isnt’t it? A Cretan maze is built using an initial drawing (in red in the following animation) and a seed (the first arc drawn). Once the seed is chosen, the labyrinth can be mechanically drawn: you just have to link the free points at the right and left of the seed, recursively.
Let’s go though the program used to generate this labyrinth. As said before, it is created using the Diagrams library. This was my toy project to help me learning the library. I’ve put it together into a nice little tool that you can find here. Mastering the library took me quite an effort, since it has a lot of abstractions, but it is very powerful (for the same reason!). Fortunately Diagrams comes with a very complete documentation and several very good tutorials.
Let’s begin with the preliminaries (as usual, this blog post is literate Haskell, you can compile and run it):
First we have to draw the initial diagram (in red in the animation). We can notice it has a rotation symmetry, so we need to define only a quarter of it. It consists of a segment, an arc and a point.
We assemble everything and rotate it 4 times to obtain the complete figure:
Here comes our first arc. We decide to draw it linking two points on the edge of the figure.
We can then remark that each arc is an “offset” (a parallel line) of the previous arc:
An simple offset of the curve is sometime not enough to join the next point: in some cases, we need to add an additional “cap” on one of the ends. That’s the role of capStart and capEnd, which take a curve, a rotation point and a final point, and draw the necessary cap at the end of the curve.
capStart :: Located (Trail R2) -> P2 -> P2 -> Trail R2 capStart lt startPt center = if (close 0.0001 startPt (atStart lt)) then mempty else capArc 1 center startPt (atStart lt) capEnd :: Located (Trail R2) -> P2 -> P2 -> Trail R2 capEnd lt endPt center = if (close 0.0001 endPt (atEnd lt)) then mempty else capArc 1 center (atEnd lt) endPt -- arcWithCaps is the concatenation of an offset with its start and end caps arcWithCaps :: Located (Trail R2) -> P2 -> P2 -> P2 -> P2 -> Located (Trail R2) arcWithCaps arcP startP startR endP endR = mconcat [capStart offs startP startR, unLoc $ offsetArc arcP, capEnd offs endP endR] `at` startP where offs = offsetArc arcP
Finally, we are able to write the recursive function that draw the arc number n, based on the previous arc. We pass as argument the list of points that we want as a start point respectively for each arc.
We can now put together all the arcs (8 arcs in total)!
Following is some helper functions.
shiftList :: Int -> [a] -> [a] shiftList n as = (drop n as) ++ (take n as) close eps a b = a `distanceSq` b <= eps*eps -- | Builds an arc to fit with a given radius, center, start, and end points. -- -- A Negative r means a counter-clockwise arc capArc :: Double -> P2 -> P2 -> P2 -> Trail R2 capArc r c a b = trailLike . moveTo c $ fs where fs | r < 0 = scale (-r) $ arcVCW (a .-. c) (b .-. c) | otherwise = scale r $ arcV (a .-. c) (b .-. c) -- Arc helpers arcV :: (TrailLike t, V t ~ R2) => R2 -> R2 -> t arcV u v = arc (direction u) (direction v) arcVCW :: (TrailLike t, V t ~ R2) => R2 -> R2 -> t arcVCW u v = arcCW (direction u) (direction v) arcWithCaps' arcP (p1:p2:_) (r1:r2:_) = arcWithCaps arcP r2 r1 p2 p1 arcCWithCaps' _ _ _ = error "lists must contain at least 2 points each"
Now we have the program, let’s play with it! The full program with command line arguments can be found here. First thing we can do is to try a different seed (in blue):
There is only 2 different interesting seeds, due to the symmetries of the initial figure. We can then change the style of the maze very easily, only by changing some parameters of our program! Here are some results:
For the next post, we will explore Chartre style labyrinth!