Skip to content

Instantly share code, notes, and snippets.

@AleXoundOS

AleXoundOS/patchwork4.hs

Last active April 6, 2023 13:28
Show Gist options
  • Save AleXoundOS/db9385a088e5946b11a9bc30c2e4c2db to your computer and use it in GitHub Desktop.
Save AleXoundOS/db9385a088e5946b11a9bc30c2e4c2db to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. AleXoundOS revised this gist Nov 6, 2021. 1 changed file with 1 addition and 4 deletions.
    5 changes: 1 addition & 4 deletions patchwork4.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -17,13 +17,10 @@ triangleRect = polygon ( with
    [ 2 , 2 * sqrt 2 ]
    )

    triangleW = triangleRect # rotateBy (1/2) # fc white # lc white # lw none
    triangleL = triangleRect # fc white # lc black # lw 3
    triangleG = triangleRect # rotateBy (1/4) # fc black # lc black # lw none
    triangleB = triangleRect # fc gray # lc gray # lw none

    diag2 = beside (r2 (1,-1)) (triangleW # align (r2 (1, -1))) triangleL
    # align (r2 (0, 1)) # centerXY
    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
  2. AleXoundOS created this gist Nov 6, 2021.
    59 changes: 59 additions & 0 deletions patchwork4.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,59 @@
    #! /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 ]
    )

    triangleW = triangleRect # rotateBy (1/2) # fc white # lc white # lw none
    triangleL = triangleRect # fc white # lc black # lw 3
    triangleG = triangleRect # rotateBy (1/4) # fc black # lc black # lw none
    triangleB = triangleRect # fc gray # lc gray # lw none

    diag2 = beside (r2 (1,-1)) (triangleW # align (r2 (1, -1))) triangleL
    # align (r2 (0, 1)) # centerXY
    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