module ExamplesDraw where

import Draw
import Data.Complex
import Control.Monad(sequence_)

midway :: Point-> Point-> Point
midway p q = 0.5 `smult` (p+ q)

-- Sierpinksi Triangles   
spTri :: Double-> Int-> Draw ()
spTri sz limit = sp3 a b c 0 where
  h = sz* sqrt 3/4 
  a = Pt 0 (-h); b = Pt (-sz/2) h; c= Pt (sz/2) h
  sp3 :: Point-> Point-> Point-> Int-> Draw ()
  sp3 a b c n
    | n >= limit = drawTriangle a b c
    | otherwise  = do
        let ab = midway a b; bc = midway b c; ca = midway c a
        sp3 a ab ca (n+1); sp3 ab b bc (n+1); sp3 ca bc c (n+1)

drawTriangle :: Point-> Point-> Point-> Draw ()
drawTriangle p q r = do polygon [p, q, r]; nextColour
  
ex1 = draw 500 500 "ex1.svg" (spTri 1000 7)


-- Hexagons
drawHex :: Point-> Double-> Draw ()
drawHex p0 r = do
  let b = sqrt 3/2*r
      p1= p0 + pt(r/2, b)
      p2= p0 + pt(3/2*r, b)
      p3= p0 + pt(2*r, 0)
      p4= p0 + pt(3/2*r, -b)
      p5= p0 + pt(r/2, -b)
  nextColour
  polygon [p0, p1, p2, p3, p4, p5]

-- Sierpinski Hexagons
spHex :: Point-> Double-> Int-> Draw ()
spHex p0 r limit = sp6 p0 r 0 where
  sp6 :: Point-> Double-> Int-> Draw ()
  sp6 p0 r n 
    | n >= limit = drawHex p0 r
    | otherwise = 
       let r' = r/3
           b' = sqrt(3)/2* r'
           x1 = p0+ pt(r', 2*b')
           x2 = p0+ pt(r, 2*b')
           x3 = p0+ pt(4/3*r, 0)
           x4 = p0+ pt(r, -2*b')
           x5 = p0+ pt(r', -2*b')
           -- x6 = p0+ pt(2*r', 0) -- 
       in mapM_ (\p-> sp6 p r' (n+1)) [p0, x1, x2, x3, x4, x5]

ex2 =  draw 500 500 "ex2.svg" (spHex (Pt (-500) 0) 500 4)


-- A colourful ball
colBall :: Point-> Double-> Integer-> Draw ()
colBall c r limit = slices (360/fromInteger(limit)) 0 where
  slices :: Double-> Integer-> Draw ()
  slices alpha cnt 
    | cnt == limit = return ()
    | otherwise = do
      slice c r (alpha*fromInteger cnt) (alpha*(fromInteger cnt+1)) 
      nextColour
      slices alpha (cnt+1)

ex3 = draw 200 200 "ex3.svg" (colBall (Pt 0 0) 190 257)

-- Stars!
drawStar :: Point-> Double-> Draw ()
drawStar p0 r =
  let p n = p0 + fromPolar r (2*n*(2*pi/5)-(pi/2))
  in  polygon $ map p [0..4]

inCircle :: Integer-> Double-> Draw()-> Draw ()
inCircle n r d = sequence_ (map crcl [0.. n-1]) where
  crcl :: Integer-> Draw ()
  crcl cnt =
    let s = fromInteger cnt/ fromInteger n
    in  translate (fromPolar r (s*2*pi)) $ d

-- ex4 = draw 500 500 "ex4.svg" (descent (Pt 0 0) 200 1 (drawStar (Pt 0 0) 30))

ex4 = draw 500 300 "ex4.svg" $ do
  setColour 0 0 255
  rect (Pt (-500) (-300)) (Pt 500 300)
  setColour 255 255 0 
  inCircle 12 200 (drawStar (Pt 0 0) 30)

descent :: Double-> Integer-> Draw()-> Draw ()
descent r n d = sequence_ (map desc [0 .. n-1]) where
  desc cnt = do
    let s  = fromInteger cnt/ fromInteger n
        s1 = 1- s
    translate (fromPolar (s1*r) (s*6*pi))
      (scale s1 $ (rotate (Pt 0 0) (s*3*360) d))
    nextColour  

ex5 = draw 250 250 "ex5.svg" $ descent 200 35 (do drawStar (Pt 0 0) 20) 

ex6 = draw 500 500 "ex6.svg" $ descent 400 37 (spTri 200 5)

main :: IO ()
main = do { ex1; ex2; ex3; ex4; ex5; ex6 }
