SHOW:
|
|
- or go back to the newest paste.
| 1 | module Main where | |
| 2 | import SOE | |
| 3 | ||
| 4 | spaceClose :: Window -> IO () | |
| 5 | spaceClose w = do | |
| 6 | k <- getKeyEx w True | |
| 7 | if k == ' ' | |
| 8 | then closeWindow w | |
| 9 | else spaceClose w | |
| 10 | ||
| 11 | --dir: 1 - Up, -1 - down | |
| 12 | equiTriCorners :: (Int, Int) -> Int -> Int -> ((Int, Int), (Int, Int), (Int, Int)) | |
| 13 | equiTriCorners (x, y) r dir = | |
| 14 | (a, b, c) | |
| 15 | where | |
| 16 | a = (x, y + dir * r) | |
| 17 | b = (x - xshift, y - dir * halfr) | |
| 18 | c = (x + xshift, y - dir * halfr) | |
| 19 | xshift = round $ 0.5 * rr * (sqrt 3) :: Int | |
| 20 | halfr = round $ rr / 2 | |
| 21 | rr = (fromIntegral r :: Double) | |
| 22 | ||
| 23 | equiTri :: Window -> (Int, Int) -> Int -> Int -> IO () | |
| 24 | equiTri w cent r dir = | |
| 25 | drawInWindow w (polyline [a, b, c, a]) | |
| 26 | where | |
| 27 | (a, b, c) = equiTriCorners cent r dir | |
| 28 | ||
| 29 | decRate :: Int | |
| 30 | decRate = 3 | |
| 31 | minSize :: Int | |
| 32 | minSize = 9 | |
| 33 | ||
| 34 | snowFlakeFract :: Window -> (Int, Int) -> Int -> IO () | |
| 35 | snowFlakeFract w c r = do | |
| 36 | equiTri w c r 1 | |
| 37 | equiTri w c r (-1) | |
| 38 | if r >= minSize | |
| 39 | then do | |
| 40 | snowFlakeFract w a (r `div` decRate) | |
| 41 | snowFlakeFract w b (r `div` decRate) | |
| 42 | snowFlakeFract w g (r `div` decRate) | |
| 43 | snowFlakeFract w d (r `div` decRate) | |
| 44 | snowFlakeFract w e (r `div` decRate) | |
| 45 | snowFlakeFract w f (r `div` decRate) | |
| 46 | else | |
| 47 | return () | |
| 48 | where | |
| 49 | (a, b, g) = equiTriCorners c r 1 | |
| 50 | (d, e, f) = equiTriCorners c r (-1) | |
| 51 | ||
| 52 | main = runGraphics $ do | |
| 53 | - | w <- openWindow "Snowflake Fractal" (600,600) |
| 53 | + | w <- openWindow "Avtor - Petuh!" (600,600) |
| 54 | snowFlakeFract w (300, 300) 180 | |
| 55 | spaceClose w |
