module BMP where

-- import Codec.Utils (Octet)
-- import Codec.Binary.Base64 (encode)
import Data.Word
import FunctionalImage
import Fran

toOctets x = fromIntegral (x `mod` 0x100) : toOctets (x `div` 0x100)

bmpHead :: (Int, Int) -> [Word8]
bmpHead (w, h) = map (toEnum . fromEnum) "BM"
              ++ take 4 (toOctets (w*h*4 + 0x7a))
              ++ [0, 0, 0, 0
                , 0x7a, 0, 0, 0
                , 0x6c, 0, 0, 0]                   -- BITMAPV4HEADER
              ++ take 4 (toOctets w) 
              ++ take 4 (toOctets h)
              ++ [0x01, 0
                , 0x20, 0
                , 0x03, 0, 0, 0]
              ++ take 4 (toOctets (w*h*4))
              ++ [0x13, 0x0B, 0x00, 0x00
                , 0x13, 0x0B, 0x00, 0x00
                , 0, 0, 0, 0
                , 0, 0, 0, 0
                , 0, 0, 0xff, 0
                , 0, 0xff, 0, 0
                , 0xff, 0, 0, 0
                , 0, 0, 0, 0xff ]
              ++ map (toEnum . fromEnum) "BGRs"
              ++ take 36 (repeat 0)
              ++ [0x01, 0, 0, 0
                , 0x01, 0, 0, 0
                , 0x01, 0, 0, 0
             {- , 0xff, 0, 0, 0
                , 0, 0xff, 0, 0
                , 0, 0, 0xff, 0 -} ]

mychop72 :: String -> String
mychop72 str =  let (bgn,end) = splitAt 70 str
                in if null end then bgn else bgn ++ "\r\n" ++ mychop72 end

type BMP = [Word8]

colors2BMP :: (Int,Int) -> [Colour] -> BMP
colors2BMP (w,h) cs = bmpHead (w,h) ++ body
    where
        bgra2octet :: Colour -> [Word8]
        bgra2octet (b,g,r,a) = [round (255*b), round (255*g), round (255*r), round (255*a)]
        cs2os :: [Colour] -> [Word8]
        cs2os im = concatMap bgra2octet im
        body = cs2os cs
        
raw2BMP :: (Int,Int) -> [[(Integer, Integer, Integer, Integer)]]-> BMP
raw2BMP (w,h) dss = bmpHead (w,h) ++ body
  where 
    bgra2octet :: (Integer,Integer,Integer,Integer) -> [Word8]
    bgra2octet (b,g,r,a) = [fromIntegral b, fromIntegral g, fromIntegral r, fromIntegral a]
    body = concatMap bgra2octet $ concat dss

image2BMP :: (Double, Double) -> (Int, Int) -> ImageC -> BMP
image2BMP (xmax,ymax) (w,h) im = colors2BMP (w, h) cs
    where 
        image :: (Double, Double) -> (Int, Int) -> Image t -> [t]
        image (xmax, ymax) (width, height) img =
            let xstep = 2*xmax/fromIntegral width; ystep = 2*ymax/fromIntegral  height
              in [img (-xmax+(fromIntegral i+0.5)*xstep, -ymax+(fromIntegral j+0.5)*ystep)
                  | j <- [height-1,height-2..0], i <- [0..width-1] ]
        cs = image (xmax,ymax) (w,h) im  

{-
image2HTML :: (Double, Double) -> (Int, Int) -> ImageC -> String
image2HTML (xmax,ymax) (w,h) im =
    "<img src=\"data:image/bmp;base64,"
   ++ encode (image2BMP (xmax,ymax) (w,h) im)
   ++ "\" alt=\"?\" />\n"

image2DataScheme (xmax,ymax) (w,h) im =
    "<a href=\"data:image/bmp;base64,"
   ++ encode (image2BMP (xmax,ymax) (w,h) im)
   ++ "\">\n"
   ++ "image bmp (" ++ show w ++ "&times;" ++ show h ++" pixels)"
   ++ "</a>\n"
-}