210 lines
6.5 KiB
Elm
210 lines
6.5 KiB
Elm
module Main where
|
|
-- import Data.HashMap as Dict -- cabal install HashMap
|
|
-- import Data.Hashable
|
|
-- import Data.Maybe as Maybe
|
|
-- import Data.Word (Word8)
|
|
-- -- I need to write picture files
|
|
-- -- I also prefer to declare my own Pixel data type
|
|
-- import Codec.Picture hiding (Pixel) -- cabal install juicyPixels FTW
|
|
-- import Control.Monad
|
|
-- import System.Environment (getArgs)
|
|
-- -- Data types
|
|
|
|
-- Real Points
|
|
data Point = P Float Float
|
|
|
|
data Pixel = Pixel Int Int
|
|
|
|
data Color = Color Int Int Int Int
|
|
|
|
neg x = 0-x
|
|
|
|
-- instance Hashable Pixel where
|
|
-- hashWithSalt n (Pixel x y) = hashWithSalt n (x,y)
|
|
type YMap = Dict Pixel Color
|
|
addColor (Color r g b n) (Color r' g' b' n') =
|
|
Color (r+r') (g+g') (b+b') (n+n')
|
|
|
|
fromIntegral x = x
|
|
|
|
-- colorFromExt :: Color -> PixelRGB8
|
|
colorFromExt (Color r g b n) = rgb (fromIntegral $ div r n)
|
|
(fromIntegral $ div g n)
|
|
(fromIntegral $ div b n)
|
|
-- Colors from the theme solarized
|
|
-- rgb :: Int -> Int -> Int -> Color
|
|
rgb r g b = Color r g b 1
|
|
black = rgb 0 0 0
|
|
base03 = rgb 0 43 54
|
|
base02 = rgb 7 54 66
|
|
base01 = rgb 88 110 117
|
|
base00 = rgb 101 123 131
|
|
base0 = rgb 131 148 150
|
|
base1 = rgb 147 161 161
|
|
base2 = rgb 238 232 213
|
|
base3 = rgb 253 246 227
|
|
yellow = rgb 181 137 0
|
|
orange = rgb 203 75 22
|
|
red = rgb 220 50 47
|
|
magenta = rgb 211 54 130
|
|
violet = rgb 108 113 196
|
|
blue = rgb 38 139 210
|
|
cyan = rgb 42 161 152
|
|
green = rgb 133 153 0
|
|
-- very basic change of representation between point and pixel
|
|
pixelFromPoint (P x y) = Pixel (round x) (round y)
|
|
-- PSEUDO RANDOM NUMBER GENERATION
|
|
-- !!!!!!!! DONT WORK ON 32 BITS Architecture !!!!!!!
|
|
nextint n =
|
|
let
|
|
a = 22695477
|
|
c = 1
|
|
m = 2^32
|
|
in
|
|
(a*n + c) `rem` m
|
|
-- generate a random sequence of length k starting with some seed
|
|
randlist seed k = let ns = nextint seed
|
|
in if (k==0)
|
|
then []
|
|
else ns:randlist ns (k-1)
|
|
-- END OF PSEUDO RANDOM NUMBER GENERATION
|
|
-- Some variations
|
|
-- vs :: [Point -> Point]
|
|
vs = [ \ (P x y) -> P x y
|
|
, \ (P x y) -> P (sin x) (sin y)
|
|
, \ (P x y) -> let r2 = x*x+y*y in P (x/r2) (y/r2)
|
|
, \ (P x y) -> let r2 = x*x+y*y in P (x*(sin r2) - y*(cos r2)) (x*(cos r2) + y * (sin r2))
|
|
, \ (P x y) -> let r = sqrt (x^2+y^2) in P ((x - y)*(x + y)/r) (2*x*y/r)
|
|
]
|
|
data Matrice = M Float Float Float Float Float Float
|
|
-- aff :: Matrice -> Point -> Point
|
|
aff (M a b c d e f) (P x y) = P (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 :: [ Point -> Point ]
|
|
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
|
|
]
|
|
-- fern :: [ Point -> Point ]
|
|
fern = [ aff $ M
|
|
0.0 0.0 0.0
|
|
0.0 0.16 0.0
|
|
, aff $ M
|
|
0.85 0.04 0.0
|
|
(neg 0.04) 0.85 1.6
|
|
, aff $ M
|
|
0.2 (neg 0.26) 0.0
|
|
0.23 0.22 1.6
|
|
, aff $ M
|
|
(neg 0.15) 0.28 0.0
|
|
0.26 0.24 0.44
|
|
]
|
|
-- Transformation functions
|
|
-- translate
|
|
-- trans :: (Float,Float) -> Point -> Point
|
|
trans (tx,ty) = aff $ M 1 0 tx 0 1 ty
|
|
-- rotate
|
|
-- rot :: Float -> Point -> Point
|
|
rot phi = aff $ M (cos phi) (sin phi) 0.0 (neg (sin phi)) (cos phi) 0.0
|
|
-- zoom
|
|
-- zoom :: Float -> Point -> Point
|
|
zoom z = aff $ M z 0 0 0 z 0
|
|
-- The final transformation to transform the final result (zoom,rotate,translate)
|
|
-- final :: Int -> Point -> Point
|
|
final width = let w = fromIntegral width
|
|
in trans (w/2,w) . zoom (w/10) . rot (neg pi)
|
|
|
|
l !! i = if (i==0) then head l else (tail l) !! (i-1)
|
|
|
|
-- F_i
|
|
-- fs :: [((Int, Color), Point -> Point)]
|
|
fs = [ (( 1, red), (vs !! 0) . (fern !! 0))
|
|
, (( 86, green), (vs !! 0) . (fern !! 1))
|
|
, (( 95, blue), (vs !! 0) . (fern !! 2))
|
|
, ((100,yellow), (vs !! 0) . (fern !! 3))
|
|
]
|
|
|
|
-- dropWhile :: (a -> Bool) -> [a] -> [a]
|
|
|
|
dropWhile f l = if l == []
|
|
then []
|
|
else if f (head l)
|
|
then dropWhile f (tail l)
|
|
else l
|
|
|
|
-- flameset :: Int -> Point -> [Int] -> YMap -> YMap
|
|
flameset w startpoint rands tmpres =
|
|
if rands == []
|
|
then tmpres
|
|
else
|
|
let
|
|
-- take a pseudo random value
|
|
randval = (head rands) `rem` 100
|
|
searchfunc = (\x -> x < randval) . fst . fst
|
|
selected = head $ dropWhile searchfunc fs
|
|
f = snd selected
|
|
col = snd . fst $ selected
|
|
-- compute the new point using a random F
|
|
newpoint = f startpoint
|
|
-- Now apply a final transformation and save the pixel
|
|
savepoint = pixelFromPoint ( final w newpoint )
|
|
-- Search the old color
|
|
oldvalue = Dict.lookup savepoint tmpres
|
|
-- Set the new color.
|
|
newvalue = addColor col (Maybe.fromMaybe black oldvalue)
|
|
-- update the dict
|
|
newtmpres = Dict.insert savepoint newvalue tmpres
|
|
in
|
|
flameset w newpoint (tail rands) newtmpres
|
|
-- flame :: Int -> Int -> YMap
|
|
flame w n = flameset w (P 0.13 0.47) (randlist 0 n) Dict.empty
|
|
|
|
-- imageFromDict :: YMap -> Int -> Int -> Image PixelRGB8
|
|
-- imageFromDict dict width height = generateImage colorOfPoint width height
|
|
-- where
|
|
-- colorOfPoint :: Int -> Int -> PixelRGB8
|
|
-- colorOfPoint x y = colorFromExt $
|
|
-- fromMaybe base03 -- background color
|
|
-- (Dict.lookup (Pixel x y) dict)
|
|
|
|
-- writeImage :: String -> Int -> Int -> Int -> YMap -> IO ()
|
|
-- writeImage filename w h n dict = writePng filename $ imageFromDict dict w h
|
|
|
|
point = filled mybase . rect 1 1
|
|
|
|
colorpoint ((x,y),c) = filled (colorFromExt c) . rect 1 1 $ (x,y)
|
|
|
|
background w h = collage w h
|
|
[filled base03 $ rect w h (div w 2,div h 2)]
|
|
scene (x,y) (w,h) =
|
|
layers
|
|
[ background w h
|
|
, collage w h $
|
|
map colorpoint $
|
|
-- filter inpoint $
|
|
Dict.toList $ flame w h
|
|
]
|
|
|
|
main = scene (0,0) (500,500)
|
|
-- main :: IO ()
|
|
-- main = do
|
|
-- args <- getArgs
|
|
-- if (length args<4)
|
|
-- then print $ "Usage flame ficname w h n"
|
|
-- else do
|
|
-- env <- return (initGlobalParams args)
|
|
-- fic <- return (filename env)
|
|
-- w <- return (imgWidth env)
|
|
-- h <- return (imgHeight env)
|
|
-- n <- return (nbPoints env)
|
|
-- writeImage fic w h n (flame w n)
|