import SOE

{-- Einige Definitionen aus der 
    SOE ("School of Expression"-Buch von Paul Hudak) 
    Graphik Bibliothek 



type Title   =  String
-- Fenstergroesse in Pixeln
type Size    =  (Int,Int)

-- Durchfuehrung einer Graphikausgabe
runGraphics  :: IO () -> IO ()

-- Oeffnen und Schliessen von Fenstern 
openWindow   :: Title -> Size -> IO Window
closeWindow  :: Window -> IO ()

-- Ausgabe einer Graphik in einem Fenster
drawInWindow :: Window -> Graphic -> IO ()

-- Tastatureingabe in einem Fenster
getKey       :: Window -> IO Char

-----------------------------------------------------------}


-- Öffnen und Schließen eines Fensters 
openCloseWindow :: IO ()
openCloseWindow =  runGraphics (
                    do  w <- openWindow "My Window" (300,300)
                        k <- getKey w  -- warte auf Tastatureingabe
                        closeWindow w
                   )
                   
{-- Vordefinierte Graphiken --------------------------------
                   
-- Pixelkoordinaten 
type Point   =  (Int,Int)

-- Definition einfacher Graphiken
text         :: Point -> String -> Graphic
line         :: Point -> Point  -> Graphic
polyline     :: [Point]         -> Graphic
polygon      :: [Point]         -> Graphic
ellipse      :: Point -> Point  -> Graphic

-- Faerben von Graphiken
data Color   =  Black  | Blue    | Green  | Cyan
              | Red    | Magenta | Yellow | White

withColor    :: Color -> Graphic -> Graphic 

-------------------------------------------------------------}                   

bild :: IO () 
bild =  runGraphics (
         do  w <- openWindow "Bild" (400,400)
             drawInWindow w (withColor Yellow 
              (polygon [(100,100),(100,300),(300,300),(300,100)]))
             drawInWindow w (withColor Red 
              (ellipse (150,150) (250,250)))
             drawInWindow w (withColor Red 
              (text (140,50) " Kreis im Rechteck "))
             spaceClose w
                    )


-- Schließen eines Fensters durch Leertaste 
spaceClose   :: Window -> IO ()
spaceClose w =  do  k <- getKey w
                    if k == ' ' then closeWindow w
                                else spaceClose w                    
                                
                                

{-----------------------------------------------------------------                                

	Sierpinski Dreiecke 
	
------------------------------------------------------------------}	

triangle :: Window -> Point -> Int -> Color -> IO ()
triangle w (x,y) size color 
    = drawInWindow w (withColor color
     --       (text (x,y) "X"))
     --       (ellipse (x,y) (x+size,y-size)))
            (polygon [(x,y),(x+size,y),(x,y-size)]))


minSize :: Int 
minSize =  8   -- minimale Dreieckgroesse

-- Definition eines Sierpinski Dreiecks
sierpinski :: Window -> Point -> Int -> Color -> IO ()
sierpinski w p size c 
    = if size <= minSize then triangle w p size c
      else let size2 = size `div` 2
               (x,y) = p
           in  do   sierpinski w p size2 c
                    sierpinski w (x,y-size2) size2 c
                    sierpinski w (x+size2,y) size2 c

-- Bildschirmausgabe 
sierpinski1 = runGraphics (
    do  w <- openWindow "Sierpinski Dreieck" (600,600)
        sierpinski w (50,550) 512 Yellow
        spaceClose w
    )
    

triangle2 :: Window -> Point -> Int -> Color -> IO ()
triangle2 w (x,y) size color 
    = do drawInWindow w (withColor color
            (polygon [(x+size,y-size),(x,y-size), (x+size,y)]))
        -- drawInWindow w (withColor Red
        --    (ellipse  (x+size,y-size) (x+sizeg,y-sizeg)))
   where size2 = size `div` 2
         sizeg = size * 2

-- Bildschirmausgabe 
sierpinski2 = runGraphics (
    do  w <- openWindow "Sierpinski Dreieck" (600,600)
        sierpinskiR w (550 + minSize `div` 2,
                       50  - minSize `div` 2) 512 Yellow
        sierpinski w (50,550) 512 Yellow
        spaceClose w
    )


sierpinskiR :: Window -> Point -> Int -> Color -> IO ()
sierpinskiR w p size c 
    = if size <= minSize then triangle2 w p size c
      else let size2 = size `div` 2
               (x,y) = p
           in  do   sierpinskiR w p size2 c
                    sierpinskiR w (x,y+size2) size2 c
                    sierpinskiR w (x-size2,y) size2 c


{---------------------------------------------------------------------

	Schneeflocke 
	
---------------------------------------------------------------------}	    
    

m = 81  :: Int -- multiple of 3 for triangle size
x = 250 :: Int -- x and y coordinates of
y = 250 :: Int --         center of snowflake
colors = [ White, Yellow, Red, Cyan, Green ]
noColors = repeat White

snowflake :: Window -> IO ()
snowflake w = do
  drawTri w x y m 0 False -- draw first triangle w/flat top
  flake   w x y m 0 True  -- begin recursion to complete job

flake :: Window -> Int -> Int -> Int -> Int -> Bool -> IO ()
flake w x y m c o = do
   drawTri w x y m c o  -- draw second triangle
   let c1 = (c+1)`mod`5 -- get next color
   if (m<=3) then return ()  -- if too small, we're done
      else do
        flake w (x-2*m) (y-m) (m`div`3) c1 True  -- NW
        flake w (x+2*m) (y-m) (m`div`3) c1 True  -- NE
        flake w  x    (y+2*m) (m`div`3) c1 True  -- S
        flake w (x-2*m) (y+m) (m`div`3) c1 False -- SW
        flake w (x+2*m) (y+m) (m`div`3) c1 False -- SE
        flake w  x    (y-2*m) (m`div`3) c1 False -- N

drawTri :: Window -> Int -> Int -> Int -> Int -> Bool -> IO ()
drawTri w x y m c o =
   let d =  (3*m) `div` 2
       ps = if o
            then [(x,y-3*m), (x-3*m,y+d), (x+3*m,y+d)] -- side at bottom
            else [(x,y+3*m), (x-3*m,y-d), (x+3*m,y-d)] -- side at top
   in drawInWindow w
        (withColor (noColors !! c) 
                   -- (colors !! c)
           (polygon ps))
main
  = runGraphics (
     do w <- openWindow "Snowflake Fractal" (500,500)
        drawInWindow w (withColor Blue
          (polygon [(0,0),(500,0),(500,500),(0,500)]) )
        snowflake w
        spaceClose w
     )