import Data.Binary

-- image size
data Size = Size { width :: Int, height :: Int }
    deriving (Eq, Ord, Show, Read)

-- RGB components for an image pixel
data Pixel = Pixel { r :: Int, g :: Int, b :: Int }
    deriving (Eq, Ord, Show, Read)

-- helper functions for saving bytes
writeByte byte = putWord8 (fromIntegral byte)
writeBytes bytes = mapM_ putWord8 bytes

-- binary instance for saving Pixels
instance Binary Pixel where
    put (Pixel r g b) = do
        writeByte b
        writeByte g
        writeByte r
    get = error "Pixel get not supported"

-- Image definition
data Image = Image { size :: Size, pixels :: [[Pixel]] }
    deriving (Eq, Ord, Read)

-- images are saved in TGA format
instance Binary Image where
    put (Image (Size width height) pixels) = do
        writeBytes [0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0]
        writeByte $ mod width 256
        writeByte $ div width 256
        writeByte $ mod height 256
        writeByte $ div height 256
        writeBytes [24, 0]
        mapM_ (mapM_ put) pixels
    get = error "Image get not supported"

-- for debugging. Don't show all pixels
instance Show Image where
    show (Image size pixels) = "Image {" ++ show size ++ ", pixels = ...}"

-- unit circle
circle (x, y) = sqrt(x*x + y*y) < 1

-- scale
scale factor f (x, y) = f (x/factor, y/factor)

-- translate
translate (deltaX, deltaY) f (x, y) = f (x-deltaX, y-deltaY)

-- combine two functions with an operator to a new function
makeCombinator op f1 f2 p = op (f1 p) (f2 p)

-- a ring and an example for "inline" usage of makeCombinator for xor
ring innerRadius outerRadius = makeCombinator (/=) innerCircle outerCircle
    where innerCircle = scale innerRadius circle
          outerCircle = scale outerRadius circle

-- makeCombinator can be used for defining a function as well
maskOr f1 f2 = makeCombinator (||) f1 f2

-- fill the specified color on the background where the mask returns true
fillMask mask color background p = if mask p then color else background p

-- blit the image on the background where the mask returns true
maskedAnd mask image background p = if mask p then image p else background p

-- ring dimensions
ringRadius = 0.1
ringLineWidth = 0.015
ringOutlineLineWidth = 0.02

-- ring center mask for the colored part of a circle
ringCenter = ring innerRadius outerRadius
    where innerRadius = ringRadius - ringLineWidth
          outerRadius = ringRadius + ringLineWidth

-- ring outline mask for the white outline of a circle
ringOutline = ring innerRadius outerRadius
    where innerRadius = ringRadius - ringOutlineLineWidth
          outerRadius = ringRadius + ringOutlineLineWidth

-- ring positions
positions = [(0.5 - 2*dx, y1),
             (0.5 - dx,   y2),
             (0.5,        y1),
             (0.5 + dx,   y2),
             (0.5 + 2*dx, y1)]
    where dx = 0.125
          y1 = 0.15
          y2 = 0.25

-- RGB color definitions
white = Pixel 0xff 0xff 0xff
blue = Pixel 0x00 0x85 0xc7
yellow = Pixel 0xf4 0xc3 0x00
black = Pixel 0x00 0x00 0x00
green = Pixel 0x00 0x9f 0x3d
red = Pixel 0xdf 0x00 0x24

-- background image
backgroundImage p = white

-- ring colors
colors = [blue, yellow, black, green, red]

-- all olympic rings, with outline
circles = map circle (zip positions colors)
    where circle (p, c) background = fillMask (translate p ringCenter) c
            $ fillMask (translate p ringOutline) white background

-- interleave calculation
maskedCrosses = map cross circles
    where cross circle x = maskedAnd bottomHalfMask x (circle x)
          bottomHalfMask (x, y) = 0.2 < y

-- olympic rings, with interleave corrections
olympicRings = foldr (.) id (maskedCrosses ++ (reverse circles)) backgroundImage

-- calculate 800x300 size image
main = encodeFile "/tmp/test.tga" image
    where image = Image (Size width height) pixels
          pixels = [[pixel x y | x <- [0..(width-1)]] | y <- [0..(height-1)]]
          pixel x y = olympicRings (scaledX x, scaledY y)
          scaledX x = fromIntegral x / fromIntegral width
          scaledY y = fromIntegral (height-y-1) / fromIntegral width
          width = 800
          height = 300