starting to look really like a flame fractal
This commit is contained in:
parent
7dbf9cca10
commit
b877f09d9e
1 changed files with 77 additions and 26 deletions
103
flame.elm
103
flame.elm
|
@ -2,7 +2,14 @@ module Flame where
|
|||
|
||||
import Random
|
||||
|
||||
-- Solarized colors
|
||||
-- Basic functions
|
||||
|
||||
-- nth element of a list
|
||||
l !! n = if n == 0 then head l else (tail l) !! (n-1)
|
||||
-- negative of a number (I don't like writing 0-x).
|
||||
neg x = 0-x
|
||||
|
||||
-- Colors (theme is solarized)
|
||||
base03 = rgb 0 43 54
|
||||
base02 = rgb 7 54 66
|
||||
base01 = rgb 88 110 117
|
||||
|
@ -20,13 +27,16 @@ blue = rgb 38 139 210
|
|||
cyan = rgb 42 161 152
|
||||
green = rgb 133 153 0
|
||||
|
||||
-- mybase = rgba 147 161 161 (2/3)
|
||||
-- Default text color
|
||||
mybase = rgba 108 113 196 (2/3)
|
||||
|
||||
-- draw a point at position (x,y)
|
||||
point = filled mybase . rect 1 1
|
||||
|
||||
-- fill the background with color base3
|
||||
background w h = filled base3 ( rect w h (div w 2,div h 2))
|
||||
|
||||
-- RANDOM PART
|
||||
nextint n =
|
||||
let
|
||||
a = 22695477
|
||||
|
@ -35,20 +45,52 @@ nextint n =
|
|||
in
|
||||
(a*n + c) `rem` m
|
||||
|
||||
-- generate a random sequence of length k starting with some seed
|
||||
randlist seed k = if (k<0) then [] else (nextint seed):randlist (nextint seed) (k-1)
|
||||
|
||||
-- generate a random sequence of points of length k starting with some seed
|
||||
randcouples seed k = if (k<0) then []
|
||||
else
|
||||
let ns = nextint seed
|
||||
nns = nextint ns
|
||||
in (ns,nns):randcouples nns (k-1)
|
||||
|
||||
scene (x,y) (w,h) points =
|
||||
let modpoint (x,y) = (rem x w,rem y h)
|
||||
in collage w h $
|
||||
background w h:
|
||||
map (point . modpoint) points
|
||||
-- END OF PSEUDO RANDOM NUMBER GENERATION
|
||||
|
||||
|
||||
{-
|
||||
- Flame Set
|
||||
-
|
||||
- S = U_{i} F_i(S)
|
||||
-
|
||||
- F_i being transformations
|
||||
- General form:
|
||||
- F = affine . linearcomp [variation] . affine
|
||||
- affine is a linear function (x,y) -> (ax+by+c,dx+ey+f)
|
||||
- variation is some kind of function with some contraction properties
|
||||
ex: (x,y) -> (x,y), (sin x, sin y), etc...
|
||||
- linearcomp [f] is a linear composition of functions: (x,y) -> Sum vi*f(x,y)
|
||||
-}
|
||||
|
||||
data Matrice = M Float Float Float Float Float Float
|
||||
aff (M a b c d e f) (x,y) = (a*x + b*y + c, d*x + e*y +f)
|
||||
|
||||
-- Some affine functions to generate the sierpinsky set
|
||||
-- Equivalent to
|
||||
-- sierp = [ \(x,y)->(x/2,y/2)
|
||||
-- , \(x,y)->((x+1)/2,y/2)
|
||||
-- , \(x,y)->(x/2,(y+1)/2) ]
|
||||
sierp = [ aff $ M
|
||||
0.5 0.0 0.0
|
||||
0.0 0.5 0.0
|
||||
, aff $ M
|
||||
0.5 0.0 0.5
|
||||
0.0 0.5 0.0
|
||||
, aff $ M
|
||||
0.5 0.0 0.0
|
||||
0.0 0.5 0.5
|
||||
]
|
||||
|
||||
-- Some variations
|
||||
vs = [ \(x,y) -> (x,y)
|
||||
, \(x,y) -> (sin x, sin y)
|
||||
, \(x,y) -> let r2 = x*x+y*y in (x/r2,y/r2)
|
||||
|
@ -56,32 +98,41 @@ vs = [ \(x,y) -> (x,y)
|
|||
, \(x,y) -> let r = sqrt (x^2+y^2) in ((x - y)*(x + y)/r,2*x*y/r)
|
||||
]
|
||||
|
||||
aff a b c d e f (x,y) = (a*x + b*y + c, d*x + e*y +f)
|
||||
-- Some final functions
|
||||
fs = [ (vs !! 3) . (sierp !! 0)
|
||||
, (vs !! 3) . (sierp !! 1)
|
||||
, (vs !! 3) . (sierp !! 2)]
|
||||
|
||||
sierp = [ aff
|
||||
0.5 0.0 0.0
|
||||
0.0 0.5 0.0
|
||||
, aff
|
||||
0.5 0.0 0.5
|
||||
0.0 0.5 0.0
|
||||
, aff
|
||||
0.5 0.0 0.0
|
||||
0.0 0.5 0.5
|
||||
]
|
||||
-- Transformation functions
|
||||
-- translate
|
||||
trans (tx,ty) = aff $ M 1 0 tx 0 1 ty
|
||||
-- rotate
|
||||
rot phi = aff $ M (cos phi) (sin phi) 0.0 (neg (sin phi)) (cos phi) 0.0
|
||||
-- zoom
|
||||
zoom z = aff $ M z 0 0 0 z 0
|
||||
|
||||
-- (!!) :: [a] -> Int -> [a]
|
||||
l !! n = if n == 0 then head l else (tail l) !! (n-1)
|
||||
-- The final transformation to transform the final result (zoom,rotate,translate)
|
||||
final = trans (480,300) . zoom 500 . rot (neg 0.747)
|
||||
|
||||
sierpset startpoint rands =
|
||||
if rands == []
|
||||
then []
|
||||
else
|
||||
let
|
||||
randval=(head rands) `rem` (length sierp)
|
||||
newpoint = (sierp !! randval) startpoint
|
||||
randval=(head rands) `rem` (length fs)
|
||||
newpoint = (fs !! randval) startpoint
|
||||
savepoint = final newpoint
|
||||
in
|
||||
newpoint:(sierpset newpoint (tail rands))
|
||||
savepoint:(sierpset newpoint (tail rands))
|
||||
|
||||
sierpinsky = map (\(x,y) -> (x*300,y*300)) $ drop 20 $ sierpset (0.132,0.432) (randlist 0 10000)
|
||||
concatmap f l = concat (map f l)
|
||||
sierpinsky = drop 30 $ concatmap (\s -> sierpset (0.0,0.0) (randlist s 4000)) [1..5]
|
||||
|
||||
main = lift3 scene Mouse.position Window.dimensions (constant sierpinsky)
|
||||
scene (x,y) (w,h) =
|
||||
let
|
||||
inpoint (x,y) = x>=0 && x<=w && y>=0 && y<=h
|
||||
in collage w h $
|
||||
background w h:
|
||||
map point (filter inpoint sierpinsky)
|
||||
|
||||
main = scene <~ Mouse.position ~ Window.dimensions
|
||||
|
|
Loading…
Reference in a new issue