Data commit

Task/Sierpinski-carpet/Haskell/sierpinski-carpet-1.hs

@@ -0,0 +1,16 @@
+inCarpet :: Int -> Int -> Bool
+inCarpet 0 _ = True
+inCarpet _ 0 = True
+inCarpet x y = not ((xr == 1) && (yr == 1)) && inCarpet xq yq
+  where ((xq, xr), (yq, yr)) = (x `divMod` 3, y `divMod` 3)
+
+carpet :: Int -> [String]
+carpet n = map
+            (zipWith
+              (\x y -> if inCarpet x y then '#' else ' ')
+              [0..3^n-1]
+             . repeat)
+            [0..3^n-1]
+
+printCarpet :: Int -> IO ()
+printCarpet = mapM_ putStrLn . carpet

Task/Sierpinski-carpet/Haskell/sierpinski-carpet-2.hs

@@ -0,0 +1,10 @@
+nextCarpet :: [String] -> [String]
+nextCarpet carpet = border ++ map f carpet ++ border
+  where border = map (concat . replicate 3) carpet
+        f x = x ++ map (const ' ') x ++ x
+
+sierpinskiCarpet :: Int -> [String]
+sierpinskiCarpet n = iterate nextCarpet ["#"] !! n
+
+main :: IO ()
+main = mapM_ putStrLn $ sierpinskiCarpet 3

Task/Sierpinski-carpet/Haskell/sierpinski-carpet-3.hs

@@ -0,0 +1,13 @@
+main :: IO ()
+main = putStr . unlines . (!!3) $ iterate next ["#"]
+
+next :: [String] -> [String]
+next block =
+    block ! block  ! block
+              ++
+    block ! center ! block
+              ++
+    block ! block  ! block
+    where
+      (!)    = zipWith (++)
+      center = map (map $ const ' ') block

Task/Sierpinski-carpet/Haskell/sierpinski-carpet-4.hs

@@ -0,0 +1,16 @@
+carpet :: Int -> String
+carpet = unlines . (iterate weave ["██"] !!)
+
+weave :: [String] -> [String]
+weave xs =
+  let f = zipWith (<>)
+      g = flip f
+   in concatMap
+        (g xs . f xs)
+        [ xs,
+          fmap (const ' ') <$> xs,
+          xs
+        ]
+
+main :: IO ()
+main = mapM_ (putStrLn . carpet) [0 .. 2]

Task/Sierpinski-carpet/Haskell/sierpinski-carpet-5.hs

@@ -0,0 +1,17 @@
+carpet :: Int -> String
+carpet = unlines . (iterate weave ["██"] !!)
+
+weave :: [String] -> [String]
+weave =
+  let thread = zipWith (<>)
+   in ( (>>=)
+          . ( (:)
+                <*> ( ((:) . fmap (fmap (const ' ')))
+                        <*> return
+                    )
+            )
+      )
+        <*> ((.) <$> flip thread <*> thread)
+
+main :: IO ()
+main = mapM_ (putStrLn . carpet) [0 .. 2]

Task/Sierpinski-carpet/Haskell/sierpinski-carpet-6.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE DoRec #-}
+import Control.Monad.Trans (lift)
+import Data.Colour (Colour)
+
+import Diagrams.Prelude hiding (after)
+import Diagrams.Backend.Cairo (Cairo)
+import Diagrams.Backend.Cairo.Gtk (defaultRender)
+
+import Graphics.Rendering.Diagrams.Points ()
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Gdk.GC (gcNew)
+
+
+main :: IO ()
+main = do
+  _ <- initGUI
+  window <- windowNew
+  _ <- window `onDestroy` mainQuit
+  window `windowSetResizable` False
+
+  area <- drawingAreaNew
+  _ <- area `on` sizeRequest $ return (Requisition 500 500)
+  _ <- window `containerAdd` area
+  widgetShowAll window
+
+  rec con <- area `on` exposeEvent $ do
+                lift $ signalDisconnect con
+                lift $ area `defaultRender` carpet 5
+                switchToPixBuf area
+  mainGUI
+
+
+-- just workaround for slow redrawing
+switchToPixBuf :: DrawingArea -> EventM EExpose Bool
+switchToPixBuf area =
+    eventArea >>= \ea -> lift $ do
+        dw      <- widgetGetDrawWindow area
+        (w,h)   <- drawableGetSize dw
+        Just pb <- pixbufGetFromDrawable dw ea
+        gc      <- gcNew dw
+        _ <- area `on` exposeEvent $ lift $
+              False <$ drawPixbuf dw gc pb 0 0 0 0 w h RgbDitherNone 0 0
+        return False
+
+
+carpet :: Int -> Diagram Cairo R2
+carpet = (iterate next (cell white) !!)
+
+-- of course, one can use hcat / vcat - combinators
+next :: Diagram Cairo R2 -> Diagram Cairo R2
+next block =
+    scale (1/3) . centerXY  $
+
+	(block ||| block ||| block)
+    	            ===
+    	(block ||| centr ||| block)
+    	            ===
+    	(block ||| block ||| block)
+    where
+      centr = cell black
+
+cell :: Colour Float -> Diagram Cairo R2
+cell color = square 1 # lineWidth 0 # fillColor color