haskell-diagrams simple patchwork 4

patchwork4.hs

#! /usr/bin/env nix-shell
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ diagrams-cairo (diagrams.overrideAttrs (def: { buildInputs = def.buildInputs ++ [ diagrams-cairo ]; configureFlags = def.configureFlags ++ [ \"-f cairo\" ]; })) ])"

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE TypeFamilies              #-}

-- import Diagrams.Backend.SVG.CmdLine
import Diagrams.Backend.Cairo.CmdLine
import Diagrams.Prelude
import Diagrams.TwoD.Offset

triangleRect :: Diagram B
triangleRect = polygon ( with
  & polyType .~ PolySides
     [ 135 @@ deg, 90 @@ deg ]
     [ 2        , 2 * sqrt 2 ]
  )

triangleG = triangleRect # rotateBy (1/4) # fc black # lc black # lw none
triangleB = triangleRect # fc gray # lc gray # lw none

diag2 = p2 (-1, -1) ~~ p2 (1, 1)
smth = rot 3 $ (triangleG # centerXY) <> (triangleB # centerXY)
middle = rotate (45 @@ deg) (square $ sqrt 2) # fc gray
         <> square 2 # fc white # lw none

rot x = rotate (x*90 @@ deg)

grid :: Diagram B
grid = (rot 0 diag2 ||| rot 0 smth ||| rot 3 diag2)
       ===
       (rot 1 smth  ||| middle     ||| rot 3 smth)
       ===
       (rot 1 diag2 ||| rot 2 smth ||| rot 2 diag2)

triagGrid :: Diagram B
triagGrid =
  (rot 0 diag2 ||| strut 2 ||| rot 3 diag2)
  ===
  (strut 2     ||| strut 2 ||| strut 2)
  ===
  (rot 1 diag2 ||| strut 2 ||| rot 2 diag2)

otherGrid :: Diagram B
otherGrid =
  (strut 2    ||| rot 0 smth ||| strut 2)
  ===
  (rot 1 smth ||| middle     ||| rot 3 smth)
  ===
  (strut 2    ||| rot 2 smth ||| strut 2)

drawBigSquare x = square 6 # lw 3 <> x # centerXY <> square 6 # fc white
-- `atop`

main = mainWith $ drawBigSquare $ otherGrid <> triagGrid