{-# LANGUAGE NoMonomorphismRestriction #-}
import Diagrams.Prelude
import Diagrams.Backend.Cairo.CmdLine
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
thick = 0.15
grid x y = frame <> lattice
where s = square # lw 0.02 # freeze
frame = square
# scaleX (fromIntegral x)
# scaleY (fromIntegral y)
# lw thick # freeze
lattice = centerXY . vcat . map hcat . replicate y . replicate x $ s
trap s1 s2 = lw 0 . strokeT . close
$ fromOffsets [(0,-s2), (s2,0), (0,s1)]
tri s1 s2 = lw 0 . strokeT . close
$ fromOffsets [(s1,0), (0,s1+s2)]
paradox n drawDiags = sq ||| strutX s2 ||| rect
where f1 = fibs !! n
f2 = fibs !! (n+1)
s1 = fromIntegral f1
s2 = fromIntegral f2
trap1 = trap s1 s2 # fc yellow
trap2 = trap s1 s2 # fc green
# rotateBy (1/2)
tri1 = tri s1 s2 # fc red
tri2 = tri s1 s2 # fc blue
sq = (if drawDiags then sqDiags else mempty)
<> grid (f1+f2) (f1+f2)
<> sqShapes
sqDiags = (fromVertices [P (0,s2), P (s2,s1)] <>
fromVertices [P (s2,0), P (s2,s1+s2)] <>
fromVertices [P (s2,0), P (s1+s2,s1+s2)])
# stroke
# lw thick
# freeze
# centerXY
sqShapes = (traps # centerY ||| tris # centerY)
# centerXY
traps = trap2 # alignL
# translateY (s1 - s2)
<> trap1
tris = tri1 # alignBL
<> tri2 # rotateBy (1/2)
# alignBL
rect = (if drawDiags then rDiags else mempty)
<> grid (2*f2 + f1) f2
<> rShapes
rShapes = (bot # alignTL <> top # alignTL) # centerXY
bot = trap1 # alignB ||| rotateBy (-1/4) tri1 # alignB
top = rotateBy (1/4) tri2 # alignT ||| trap2 # alignT
rDiags = (fromVertices [P (0,s2), P (2*s2+s1, 0)] <>
fromVertices [P (s2,0), P (s2,s1)] <>
fromVertices [P (s1+s2,s2-s1), P (s1+s2,s2)]
)
# stroke
# lw thick
# lineCap LineCapRound
# freeze
# centerXY
dia = paradox 4 True
main = defaultMain (pad 1.1 dia)