--------------------------------------------------------------------------------
-- Inf1A programming competition 2007
-- Jussi Maatta (0784810)
--------------------------------------------------------------------------------
-- How to run:   display 2.0 (rgbToTurtle pic)
-- (it takes a few minutes - the code really could use some optimization)
--------------------------------------------------------------------------------

import LSystem

type RGB = (Float,Float,Float)

screenW, screenH, screenArea :: Int
screenW = 256
screenH = 256
screenArea = screenW * screenH

pic :: [RGB]
pic = addLens (addLambda gradient)

-- this is the "base" bitmap
gradient :: [RGB]
gradient = foldl1 (++) [ gradient' (x/256.0) | x <- [1..256] ]
           where
           gradient' x = [ (x, y/256.0, 0) | y <- [1..256] ]

--------------------------------------------------------------------------------
-- Lambda --
------------

lambdaSize :: Int
lambdaSize = 16

lambdaData :: [Bool]
lambdaData = map (=='#') ( "................"
                        ++ "................"
                        ++ "....###........."
                        ++ ".....###........"
                        ++ "......###......."
                        ++ ".......###......"
                        ++ ".......###......"
                        ++ "......#####....."
                        ++ ".....###.###...."
                        ++ "....###..###...."
                        ++ "...###....###..."
                        ++ "...###....###..."
                        ++ "..###......###.."
                        ++ "..###......###.."
                        ++ "................"
                        ++ "................" )

addLambda :: [RGB] -> [RGB]
addLambda xs = [ if (isLambda x y) then (lcol x y) else (xs!!(y*screenW+x))
               | y <- [0..screenH-1], x <- [0..screenW-1] ]
             where
             isLambda x y = lambdaData !! ( (y `div` lambdaSize)*lambdaSize +
                                            (x `div` lambdaSize) )
             lcol x y = (0.0, (lcolSin x)*0.3+0.5, (lcolCos (y+x))*0.7+0.3)
             lcolSin x = (sin (fromIntegral (x `div` blockdiv)) + 1.0) / 2.0
             lcolCos x = (cos (fromIntegral (x `div` blockdiv)) + 1.0) / 2.0
             blockdiv = 8

--------------------------------------------------------------------------------
-- Lens --
----------

lensR, lensD :: Float
lensR = 181.0 -- radius of the sphere
lensD = 150.0 -- distance from the plane to the centre of the sphere

addLens :: [RGB] -> [RGB]
addLens xs = [ xs !! (shift x y) | y <- [0..screenH-1], x <- [0..screenW-1] ]

shift :: Int -> Int -> Int
shift x y = fy * screenW + fx
          where
          halfW = screenW `div` 2
          halfH = screenH `div` 2
          (tx,ty) = shift' (x-halfW) (y-halfH)
          fx = tx + halfW
          fy = ty + halfH

shift' :: Int -> Int -> (Int,Int)
shift' x y
    | (fromIntegral (x*x + y*y)) < (lensR*lensR)  =  (nx,ny)
    | otherwise                                   =  (x,y)
    where
    root = sqrt (lensD*lensD + lensR*lensR - fromIntegral (x*x + y*y))
    z = round (-lensD + root)
    ratio = lensD / root
    nx = round (ratio * (fromIntegral x))
    ny = round (ratio * (fromIntegral y))

--------------------------------------------------------------------------------
-- RGB to Turtle conversion --
------------------------------

pixelWidth, lineSpacing :: Float
pixelWidth = (1.0/3.0)
lineSpacing = 0.5

join :: [Command] -> Command
join xs = foldl1 (:#:) xs

-- adjusted for scale=2.0, imgsize=256*256
turtleInit :: Command
turtleInit = GrabPen Inkless :#: Go (fromIntegral (div screenH 3)) :#:
             Turn 90 :#: Go (fromIntegral (div screenW 3)) :#: Turn (-180)

rgbToTurtle :: [RGB] -> Command
rgbToTurtle xs = turtleInit :#: (rowByRow xs)

rowByRow :: [RGB] -> Command
rowByRow [] = Sit
rowByRow xs = Branch (rowToTurtle (take screenW xs)) :#: GrabPen Inkless :#:
              Turn (-90) :#: Go lineSpacing :#: Turn 90 :#:
              (rowByRow (drop screenW xs))

rowToTurtle :: [RGB] -> Command
rowToTurtle xs = join [ GrabPen (Colour r g b) :#: Go pixelWidth
                      | (r,g,b) <- xs ]