Adding all the project files.

Fractals.hs

@@ -0,0 +1,15 @@
+import Codec.Picture
+import GraphicsM
+import GraphicsHelperFunctions
+import PythogorusTree
+import LsystemTree
+import Mountains
+import Grass
+import KochSnowFlakes
+
+-- The simplest looking file which combines all the fractals
+-- note, the order of combination is extremely important as the opacity makes a difference.
+-- You could think of them as layers in an art project/ 2d game.
+
+picture = drawPicture 3 (mountain++mountainReflection++pTree2++pTree++ground++groundTree++groundTree2++flowers++snowFlakes)
+file = writePng "final2.png" $ picture

GraphicsHelperFunctions.hs

@@ -0,0 +1,92 @@
+module GraphicsHelperFunctions(
+  rotate90, rotate270, rotateLine,
+  scaleLine, connectLine, midpoint,
+  rectangle, triangles, polygon,
+  Angle, Scale, Iterations, BleachFactor,
+  bleach
+) where
+
+import Codec.Picture
+import GraphicsM
+
+type Angle = Float
+type RectangleScale = Float
+type Iterations = Int
+type Scale = Float
+type BleachFactor = (Int,Int,Int,Int)
+
+  -- Function that changes the colors based on the values provided.
+bleach :: Colour -> BleachFactor -> Colour
+bleach (Colour r g b o) (r',g',b',o') = Colour (r+r') (g+g') (b+b') (o+o')
+
+  -- Rotation based functions.
+rotateLine :: Line -> Float -> Line
+rotateLine ly@(Line (Point x1 y1) (Point x2 y2)) angle
+  = Line (Point x1 y1) (Point (x' + x1) (y' + y1))
+  where
+    x0 = x2 - x1
+    y0 = y2 - y1
+    x' = x0 * cos angle - y0 * sin angle
+    y' = x0 * sin angle + y0 * cos angle
+
+rotate90 :: Line -> Point
+rotate90 (Line (Point x1 y1) (Point x2 y2))
+  = Point (-1 * ny + x1)
+          (nx + y1)
+  where
+    nx = x2 - x1
+    ny = y2 - y1
+
+rotate270 :: Line -> Point
+rotate270 (Line (Point x1 y1) (Point x2 y2))
+  = Point (ny + x1)
+          (-1 * nx + y1)
+  where
+    nx = x2 - x1
+    ny = y2 - y1
+
+    --Functions to scale lines, connect them and find their mid points.
+
+scaleLine :: Float -> Line -> Line
+scaleLine f (Line (Point x1 y1) (Point x2 y2))
+  = Line  (Point x1 y1)
+          (Point (x1 + (x2 -x1) * f)  (y1 + (y2 - y1) * f))
+
+connectLine :: Line -> Line -> Line
+connectLine l@(Line _ a@(Point lx2 ly2)) q@(Line (Point qx1 qy1) (Point qx2 qy2))
+  = Line a b
+    where
+      diffx = 0-qx1 + lx2
+      diffy = 0-qy1 + ly2
+      b = Point (qx2 + diffx) (qy2 + diffy)
+
+midpoint :: Point -> Point -> Point
+midpoint (Point x1 y1) (Point x2 y2) = Point ((x1+x2)/2) ((y1+y2)/2)
+
+    -- Shape creation functions
+
+rectangle :: Line -> Float -> Colour -> (PictureObject, Line)
+rectangle ly@(Line a b) fact color = (Polygon [a,r1,r2,b] color Solid SolidFill, Line r1 r2)
+  where
+    r1 = rotate270 $ scaleLine fact (Line a b)
+    r2 = rotate90  $ scaleLine fact (Line b a)
+
+rightTri :: Line -> Float -> (PictureObject, Line, Line)
+rightTri ly@(Line a b) angle = (Polygon [a,c,b] red Solid SolidFill, Line a c, Line c b)
+  where
+    mid = midpoint a b
+    rotate@(Line _ c) = rotateLine (Line mid a) angle
+
+triangles :: Line -> Float -> Float -> Colour -> (PictureObject, Line, Line)
+triangles ly@(Line a b) angle scale color= (Polygon [a,c,b] color Solid SolidFill, Line a c, Line c b)
+  where
+    (Line _ po) = scaleLine scale ly
+    rotate@(Line _ c) = rotateLine (Line po a) angle
+
+polygon :: Int -> Line -> [Point]
+polygon n ly@(Line a b)
+  | n<0 = []
+  |otherwise = [b]++(polygon (n-1) nex)
+    where
+      rotationAngle = (2 * pi) / (fromIntegral 3)
+      nex = rotateLine ly rotationAngle

GraphicsM.hs

@@ -0,0 +1,148 @@
+module GraphicsM (
+  drawPicture,
+  Point(..),
+  Vector(..),
+  Line(..),
+  Picture,
+  Colour (..),
+  LineStyle (..),
+  FillStyle (..),
+  PictureObject(..),
+  white, black, blue, red, green, yellow, magenta, orange, darkGreen, brown, darkBrown
+) where
+
+  -- Rasterific
+import Graphics.Rasterific hiding (Point, Vector, Line, Path)
+import Graphics.Rasterific.Texture
+import Graphics.Rasterific.Transformations
+
+
+
+import Codec.Picture
+
+data Colour
+  = Colour
+    { redC      :: Int
+    , greenC    :: Int
+    , blueC     :: Int
+    , opacityC  :: Int
+    }
+  deriving (Show, Eq)
+
+white      = Colour 255  255 255 255
+black      = Colour   0    0   0 255
+blue       = Colour   0    0 255 255
+red        = Colour 255    0   0 255
+brown      = Colour 114   53  14 200
+darkBrown  = Colour  43   17   0 250
+green      = Colour  57  175  24 235
+darkGreen  = Colour  22   89   3 255
+yellow     = Colour 255  255   0 235
+magenta    = Colour 153    0 153 255
+orange     = Colour 254  154  46 255
+
+
+data Point
+  = Point
+    { xPoint :: Float
+    , yPoint :: Float
+    }
+
+data Vector
+  = Vector
+    { xVector :: Float
+    , yVector :: Float
+    }
+
+data Line
+  = Line
+    { startLine :: Point
+    , endLine   :: Point
+    }
+
+
+data LineStyle
+  = Solid
+  | Dashed
+  | Dotted
+
+data FillStyle
+  = NoFill
+  | SolidFill
+   deriving (Eq, Show)
+
+data PictureObject
+  = Path
+    { pointsPO    :: [Point]
+    , colourPO    :: Colour
+    , lineStylePO :: LineStyle
+    }
+  | Circle
+    { centerPO    :: Point
+    , radiusPO    :: Float
+    , colourPO    :: Colour
+    , lineStylePO :: LineStyle
+    , fillStylePO :: FillStyle
+    }
+  | Ellipse
+    { centerPO    :: Point
+    , widthPO     :: Float
+    , heightPO    :: Float
+    , rotationPO  :: Float
+    , colourPO    :: Colour
+    , lineStylePO :: LineStyle
+    , fillStylePO :: FillStyle
+    }
+  | Polygon
+    { pointsPO    :: [Point]
+    , colourPO    :: Colour
+    , lineStylePO :: LineStyle
+    , fillStylePO :: FillStyle
+    }
+
+type Picture = [PictureObject]
+
+
+drawPicture linewidth picture
+  = renderDrawing  1920 1080 (toColour (Colour 255 255 255 150)) $ do
+      { mapM drawObj picture
+      ; return ()
+      }
+  where
+    style SolidFill _ = fill
+    style _ Solid     = stroke linewidth  JoinRound (CapRound, CapRound)
+    style _ Dashed    = dashed linewidth  JoinRound (CapRound, CapRound)
+    style _ Dotted    = dotted linewidth  JoinRound (CapRound, CapRound)
+
+    dotted = dashedStroke [linewidth/12, 2 * linewidth]
+    dashed = dashedStroke [3* linewidth, 6 * linewidth]
+
+    texture colour = withTexture (uniformTexture $ toColour colour)
+    textureG  (x1, y1) (x2, y2)
+      = withTexture (linearGradientTexture
+          [(0, PixelRGBA8 255 0 0 255), (1, PixelRGBA8 255 255 255 255)]
+                (V2 x1 y1)(V2 x2 y2))
+    drawObj (Path points colour lineStyle) =
+      texture colour
+         $ style NoFill lineStyle
+         $ polyline
+         $ map (\((Point x y)) -> V2 x y) points
+    drawObj (Circle (Point px py) radius colour lineStyle fillStyle) =
+      texture colour
+         $ style fillStyle lineStyle
+         $ circle (V2 px py) radius
+    drawObj (Ellipse (Point px py) h w r colour lineStyle fillStyle) =
+      texture colour
+         $ style fillStyle lineStyle
+           . transform (applyTransformation
+                       $ rotateCenter r (V2 px py))
+         $ ellipse (V2 px py) h w
+    drawObj (Polygon points colour lineStyle fillStyle) =
+      texture colour
+         $ style fillStyle lineStyle
+         $ polygon
+         $ map (\((Point x y)) -> V2 x y) points
+
+
+    toColour (Colour a b c d)
+      = PixelRGBA8 (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)

Grass.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Grass (flowers) where
+
+import Codec.Picture
+import GraphicsM
+import GraphicsHelperFunctions
+import PythogorusTree
+import LsystemTree
+import System.Random
+import Data.Text.Unsafe
+
+-- This functions takes a horizontal line. From the line's midpoint it generates a L-system tree. Between the new L-tree and the other two points,
+-- it generates two more L-system base trees, reursively...
+
+grass :: Line -> Float -> Angle -> (Scale, Scale) -> (Colour, Colour) -> (BleachFactor, BleachFactor) -> (Float, Float) -> Iterations -> Iterations -> Picture
+grass ly@(Line a b) stemHeight angle (leftBranchScale, rightBranchScale) (colorL@(Colour rl gl bl ol), colorR@(Colour rr gr br oR)) (bleachL, bleachR) (angleScaleBrLeft, angleScaleBrRight) iter2 iter
+  | iter<=0 = []
+  | otherwise
+     =(grass (Line a mid) (inlinePerformIO stemHeight') (inlinePerformIO angle') (inlinePerformIO leftBranchScale', inlinePerformIO rightBranchScale') (colorL', colorR') (bleachL, bleachR) (angleScaleBrLeft, angleScaleBrRight) (iter2) (iter-1)) ++
+      (lSystemTree midLine (angle) (leftBranchScale, rightBranchScale) (colorL, colorR) (bleachL, bleachR) (angleScaleBrLeft, angleScaleBrRight) iter2) ++
+      (grass (Line mid b) (inlinePerformIO stemHeight') (inlinePerformIO angle') (inlinePerformIO leftBranchScale', inlinePerformIO rightBranchScale') (colorL', colorR') (bleachL, bleachR) (angleScaleBrLeft, angleScaleBrRight) (iter2) (iter-1))
+       where
+        (Line _ mid@(Point xmid ymid)) = scaleLine scaleFactor ly
+        midLine = Line (Point (xmid) (ymid)) (Point (xmid) (ymid-stemHeight))
+
+        -- Some additional parameters, which based on the random function make the plants produced look organic.
+        -- Note, the unwrapping of the IO takes place when the function is called, as we want different random value for both left and right branch of the tree.
+        scaleFactor = inlinePerformIO $ getStdRandom (randomR (0.3,0.7))
+        angle'              =  getStdRandom (randomR (pi*0.05 , pi*0.10))
+        leftBranchScale'    =  getStdRandom (randomR (0.7, 0.9))
+        rightBranchScale'   =  getStdRandom (randomR (0.7, 0.9))
+        stemHeight'         =  getStdRandom (randomR (60 , 100))
+        colorL'             =  Colour rl gl bl (ol-100)
+        colorR'             =  Colour rr gr br (oR-100)
+        -- angleScaleBrLeft'  = getStdRandom (randomR (,))
+        -- angleScaleBrRight' = getStdRandom (randomR (,))
+
+-- Inputs for the function to generate multiple L-trees
+inLine              = Line (Point 0 (1080+90)) (Point 1920 (1080+90))
+inAngle             = pi*0.15
+inLeftBranchScale   = 0.8
+inRightBranchScale  = 0.6
+inColorL            = Colour 82 0 55 255
+inColorR            = Colour 82 0 55 150
+inbleachFactL       = (-3,0,-2,-8)
+inbleachFactR       = (3,0,2,0)
+inAngleScaleBrLeft  = 0.8
+inAngleScaleBrRight = 1.1
+
+-- Output
+flowers = grass inLine 90 inAngle (inLeftBranchScale,inRightBranchScale) (inColorL,inColorR) (inbleachFactL,inbleachFactR) (inAngleScaleBrLeft,inAngleScaleBrRight) 7 5
+
+-- Displaying the output to a file stream.
+picture = drawPicture 3 flowers
+file = writePng "Test1.png" $ picture

KochSnowFlakes.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module KochSnowFlakes(snowFlakes
+) where
+
+import Codec.Picture
+import GraphicsM
+import GraphicsHelperFunctions
+import System.Random
+import Data.Text.Unsafe
+
+
+-- Use t create a Line which is based on the recursion pattern of KochSnowflakes
+kochLine :: Int -> Point -> Point -> [Point]
+kochLine n pS pE
+  | n <= 0 = []
+  | otherwise
+  = [pS] ++ kochLine (n - 1) pS p1
+         ++ kochLine (n - 1) p1 p2
+         ++ kochLine (n - 1) p2 p3
+         ++ kochLine (n - 1) p3 pE
+         ++ [pE]
+  where
+    l1@(Line _ p1) = scaleLine (1 / 3) (Line pS pE)
+    l2@(Line _ p3) = connectLine l1 l1
+    (Line _ p2)    = rotateLine l2 (5 / 3 * pi)
+
+-- This combines multiple KochSnowflake based lines, by forming a polygon out of them.
+kochFlake :: Int -> Line -> [Point]
+kochFlake n line
+  | n<= 0 = []
+  | otherwise = kochLine n p1 p2 ++ kochLine n p2 p3 ++ kochLine n p3 p1
+   where
+     [p1, p2, p3, _] = polygon 3 line
+
+--Function that combines multiple KochFlakes into a picture
+
+flakes :: Int -> Colour -> BleachFactor -> Picture
+flakes n color bleachFact| n<=0 = []
+         | otherwise = [Polygon (kochFlake 7 (Line a b)) (bleach color bleachFact) Solid SolidFill] ++
+                        flakes (n-1) color bleachFact
+         where
+           midx = inlinePerformIO $ getStdRandom (randomR (20, 1900))
+           midy = inlinePerformIO $ getStdRandom (randomR (20, 1060))
+           size = inlinePerformIO $ getStdRandom (randomR (5, 8))
+           orientaion = inlinePerformIO $ getStdRandom (randomR (0, 10))
+           a    = Point (midx - size) (midy+orientaion)
+           b    = Point (midx + size) (midy)
+
+
+
+--These are values used for testing
+x = kochFlake 5 (Line (Point 765 540) (Point 1250 540))
+y = Polygon x blue Solid SolidFill
+
+snowFlakes = flakes 30 inColour inBleachFact
+
+inColour = Colour 85 215 170 200
+inBleachFact = (7, 2, 3, 0)
+
+-- To display the output
+picture = drawPicture 1 [y]
+file = writePng "snowFlake.png" $ picture