{-# LANGUAGE RecordWildCards #-}
module Files where
import Elem3D ( RGB(..) )

import qualified Data.ByteString as BS
import Data.Word (Word8)
import Data.Bits  ((.&.), shiftR)
import Data.Maybe (isNothing)
import qualified Data.ByteString.Char8 as BS8

import Data.Binary ( Word8, decodeFile, encode, Binary )
import qualified Data.ByteString.Lazy as B
import qualified Data.DList as DL

-- |Función básica, dado un objeto que instancie la clase Binary, escribe este en formato binario a un archivo en disco.
writeObject :: Binary a => FilePath -> DL.DList a -> IO ()
writeObject :: forall a. Binary a => FilePath -> DList a -> IO ()
writeObject FilePath
path DList a
obj = FilePath -> ByteString -> IO ()
B.writeFile FilePath
path ([a] -> ByteString
forall a. Binary a => a -> ByteString
encode (DList a -> [a]
forall a. DList a -> [a]
DL.toList DList a
obj))

-- |Función básica, dado un fichero binario, recupera el objeto que haya almacenado en este y lo devuelve.
readObject :: Binary a => FilePath -> IO a
readObject :: forall a. Binary a => FilePath -> IO a
readObject = FilePath -> IO a
forall a. Binary a => FilePath -> IO a
decodeFile

-- |Función auxiliar, para leer un archivo .ppm y almacenar los píxeles en una lista.
leerPPM :: FilePath -> IO ([RGB], (Float, Float, Float, Float))
leerPPM :: FilePath -> IO ([RGB], (Float, Float, Float, Float))
leerPPM FilePath
archivo = do
    ByteString
contenido <- FilePath -> IO ByteString
BS8.readFile FilePath
archivo
    let lineas :: [ByteString]
lineas = ByteString -> [ByteString]
BS8.lines ByteString
contenido
        ppMax :: Float
ppMax = [ByteString] -> Float
findMaxPPM [ByteString]
lineas
        sizeLine :: (Float, Float)
sizeLine = [ByteString] -> (Float, Float)
findSizePPM [ByteString]
lineas
        valueMax :: Float
valueMax = FilePath -> Float
forall a. Read a => FilePath -> a
read (FilePath -> Float)
-> (ByteString -> FilePath) -> ByteString -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
BS8.unpack (ByteString -> Float) -> ByteString -> Float
forall a b. (a -> b) -> a -> b
$ [ByteString]
lineas [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int
4
        pixelLines :: [ByteString]
pixelLines = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
5 [ByteString]
lineas
        pixelesParseados :: [RGB]
pixelesParseados = (ByteString -> [RGB]) -> [ByteString] -> [RGB]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([ByteString] -> [RGB]
parsePixels ([ByteString] -> [RGB])
-> (ByteString -> [ByteString]) -> ByteString -> [RGB]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS8.words) [ByteString]
pixelLines
    ([RGB], (Float, Float, Float, Float))
-> IO ([RGB], (Float, Float, Float, Float))
forall (m :: * -> *) a. Monad m => a -> m a
return ([RGB]
pixelesParseados, ((Float, Float) -> Float
forall a b. (a, b) -> a
fst (Float, Float)
sizeLine, (Float, Float) -> Float
forall a b. (a, b) -> b
snd (Float, Float)
sizeLine, Float
valueMax, Float
ppMax))

-- |Función auxiliar, para extraer el MAX dentro de un ppm.
findMaxPPM :: [BS8.ByteString] -> Float
findMaxPPM :: [ByteString] -> Float
findMaxPPM [] = Float
0.0
findMaxPPM (ByteString
linea:[ByteString]
resto)
    | ByteString -> ByteString -> Bool
BS8.isPrefixOf (FilePath -> ByteString
BS8.pack FilePath
"#MAX=") ByteString
linea = FilePath -> Float
forall a. Read a => FilePath -> a
read (ByteString -> FilePath
BS8.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS8.drop Int
5 ByteString
linea)
    | Bool
otherwise = [ByteString] -> Float
findMaxPPM [ByteString]
resto

-- |Función auxiliar, extrae el tamaño de un ppm.
findSizePPM :: [BS8.ByteString] -> (Float, Float)
findSizePPM :: [ByteString] -> (Float, Float)
findSizePPM [] = (Float
0,Float
0)
findSizePPM (ByteString
linea:[ByteString]
resto)
    | ByteString -> ByteString -> Bool
BS8.isPrefixOf (FilePath -> ByteString
BS8.pack FilePath
"#") ByteString
linea = [ByteString] -> (Float, Float)
findSizePPM [ByteString]
resto
    | Bool
otherwise = case ByteString -> [ByteString]
BS8.words ByteString
linea of
        [ByteString
num1, ByteString
num2] -> (FilePath -> Float
forall a. Read a => FilePath -> a
read (FilePath -> Float) -> FilePath -> Float
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BS8.unpack ByteString
num1, FilePath -> Float
forall a. Read a => FilePath -> a
read (FilePath -> Float) -> FilePath -> Float
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BS8.unpack ByteString
num2)
        [ByteString]
_ -> [ByteString] -> (Float, Float)
findSizePPM [ByteString]
resto


-- |Función auxiliar, para analizar una línea de píxeles y convertirla en una lista de RGB.
parsePixels :: [BS8.ByteString] -> [RGB]
parsePixels :: [ByteString] -> [RGB]
parsePixels [] = []
parsePixels (ByteString
r:ByteString
g:ByteString
b:[ByteString]
resto) =
    let rgb :: RGB
rgb = Float -> Float -> Float -> RGB
RGB (FilePath -> Float
forall a. Read a => FilePath -> a
read (FilePath -> Float) -> FilePath -> Float
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BS8.unpack ByteString
r) (FilePath -> Float
forall a. Read a => FilePath -> a
read (FilePath -> Float) -> FilePath -> Float
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BS8.unpack ByteString
g) (FilePath -> Float
forall a. Read a => FilePath -> a
read (FilePath -> Float) -> FilePath -> Float
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BS8.unpack ByteString
b)
    in RGB
rgb RGB -> [RGB] -> [RGB]
forall a. a -> [a] -> [a]
: [ByteString] -> [RGB]
parsePixels [ByteString]
resto
parsePixels [ByteString]
_ = FilePath -> [RGB]
forall a. HasCallStack => FilePath -> a
error FilePath
"Formato incorrecto"

-- |Función auxiliar, convierte una lista de RGBs en un string de pixeles.
parsePixels' :: [RGB] -> String
parsePixels' :: [RGB] -> FilePath
parsePixels' [RGB]
pixels = [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (RGB -> FilePath) -> [RGB] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map RGB -> FilePath
rgbToString [RGB]
pixels

{-# INLINE rgbToString #-}
-- |Función auxiliar, convierte un RGB a string.
rgbToString :: RGB -> String
rgbToString :: RGB -> FilePath
rgbToString (RGB {Float
blue :: RGB -> Float
green :: RGB -> Float
red :: RGB -> Float
blue :: Float
green :: Float
red :: Float
..}) = Integer -> FilePath
forall a. Show a => a -> FilePath
show (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
red Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
255) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round(Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$  Float
green Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
255) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Integer) -> Float -> Integer
forall a b. (a -> b) -> a -> b
$ Float
blue Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
255) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "


-- |Función auxiliar, escribe un 32-bit BMP file
writeBMP :: FilePath -> Int -> Int -> BS.ByteString -> IO ()
writeBMP :: FilePath -> Int -> Int -> ByteString -> IO ()
writeBMP FilePath
filename Int
width Int
height ByteString
customPixelData = do
    let fileSize :: Int
fileSize = Int
54 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height
    let pixelDataOffset :: Int
pixelDataOffset = Int
54
    let dibHeaderSize :: Int
dibHeaderSize = Int
40
    let bitsPerPixel :: Int
bitsPerPixel = Int
32
    let compressionMethod :: Int
compressionMethod = Int
0
    let imageSize :: Int
imageSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
height
    let xPixelsPerMeter :: Int
xPixelsPerMeter = Int
2835 -- 72 DPI
    let yPixelsPerMeter :: Int
yPixelsPerMeter = Int
2835 -- 72 DPI

    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
filename (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat
        [ [Word8] -> ByteString
BS.pack [Word8
66, Word8
77]                      -- Signature ("BM")
        , Int -> ByteString
intTo4Bytes Int
fileSize                 -- File size
        , Int -> ByteString
intTo4Bytes Int
0                        -- Reserved
        , Int -> ByteString
intTo4Bytes Int
pixelDataOffset           -- Pixel data offset
        , Int -> ByteString
intTo4Bytes Int
dibHeaderSize             -- DIB header size
        , Int -> ByteString
intTo4Bytes Int
width                    -- Image width
        , Int -> ByteString
intTo4Bytes Int
height                   -- Image height
        , Int -> ByteString
intTo2Bytes Int
1                        -- Number of color planes
        , Int -> ByteString
intTo2Bytes Int
bitsPerPixel             -- Bits per pixel
        , Int -> ByteString
intTo4Bytes Int
compressionMethod        -- Compression method
        , Int -> ByteString
intTo4Bytes Int
imageSize                -- Image size
        , Int -> ByteString
intTo4Bytes Int
xPixelsPerMeter          -- Horizontal resolution (pixels per meter)
        , Int -> ByteString
intTo4Bytes Int
yPixelsPerMeter          -- Vertical resolution (pixels per meter)
        , Int -> Word8 -> ByteString
BS.replicate Int
8 Word8
0                     -- Reserved
        , ByteString
customPixelData  -- White pixel data
        ]

-- |Función principal, escibre en un archivo PPM la información de los pixels en formato P3.
writePPM :: FilePath -> Int -> Int -> String -> IO ()
writePPM :: FilePath -> Int -> Int -> FilePath -> IO ()
writePPM FilePath
filename Int
width Int
height FilePath
customPixelData = do
    let maxColorValue :: Integer
maxColorValue = Integer
255
    let header :: FilePath
header = [FilePath] -> FilePath
unlines
            [ FilePath
"P3"
            , FilePath
"#MAX=255"
            , FilePath
"# " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
filename
            , Int -> FilePath
forall a. Show a => a -> FilePath
show Int
width FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
height
            , Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
maxColorValue
            ]
    FilePath -> ByteString -> IO ()
BS8.writeFile FilePath
filename (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS8.unlines
        [ FilePath -> ByteString
BS8.pack FilePath
header
        , FilePath -> ByteString
BS8.pack FilePath
customPixelData
        ]

-- |Función auxiliar, convierte un entero a un ByteString de 4 Bytes.
intTo4Bytes :: Int -> BS.ByteString
intTo4Bytes :: Int -> ByteString
intTo4Bytes Int
n = [Word8] -> ByteString
BS.pack [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF)]

-- |Función auxiliar, convierte un entero a un ByteString de 2 Bytes.
intTo2Bytes :: Int -> BS.ByteString
intTo2Bytes :: Int -> ByteString
intTo2Bytes Int
n = [Word8] -> ByteString
BS.pack [Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF), Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xFF)]

-- |Función auxiliar, convierte una lista ordenada de RGBs a BytseString.
pixels2BMP :: [RGB] -> BS.ByteString
pixels2BMP :: [RGB] -> ByteString
pixels2BMP [RGB]
rgbList = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (RGB -> [Word8]) -> [RGB] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RGB -> [Word8]
rgbToWord8 ([RGB] -> [Word8]) -> [RGB] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [RGB] -> [RGB]
forall a. [a] -> [a]
reverse [RGB]
rgbList
  where
    -- |Función auxiliar, convierte un RGB a una lista de Word8.
    rgbToWord8 :: RGB -> [Word8]
    rgbToWord8 :: RGB -> [Word8]
rgbToWord8 (RGB Float
r Float
g Float
b) = (Float -> Word8) -> [Float] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral(Integer -> Word8) -> (Float -> Integer) -> Float -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Float -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round) [Float
r, Float
g, Float
b, Float
255]