module GIFparser(parseGIF,parseGIF',sizeOfGIF) where
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as CS
import Control.Monad(guard)
import GIF
import ParsOps1
import Utils2(bit,bits)

default(Int)

--import Trace
--tr s = trace s $ return ()
tr s = return ()

-- | Parse just enough of a GIF file to obtain the size
-- (width and height in pixels) of the GIF image.
sizeOfGIF = showErr . parseE gifSizeP
  where
    gifSizeP =
      do signatureP
         sd <- screenDescriptorP
	 theRest
	 return (swidth sd,sheight sd)

-- | This function parses a GIF file. It does not decompress the
-- raster data, you should call 'GIFdecompress.decompressGIF' to do that.
parseGIF = parseE gifP

parseGIF' = parseGIF . CS.pack

showErr = id
--showErr = maybe (Left "bad GIF") Right
{-
showErr = either (Left . sh) Right
  where
    sh (msg,s) = msg++": ("++show (length s)++") "++take 80 s
-}
gifP =
   do h <- signatureP
      sd <- screenDescriptorP
      gmap <- optColorMapP (hasGlobalMap sd) (sbitsPerPixel sd)
      ds <- dataBlocksP
      litP ';'
      theRest -- allow trailing garbage
      return (GIF h sd gmap ds)

signatureP = litsP "GIF87a" <|> litsP "GIF89a"

optColorMapP b n =
  if b
  then fmap Just (colorMapP n)
  else tr "no colormap" >> return Nothing

colorMapP size = tr ("colorMapP "++show n) >> repeatP n colorP
  where n = 2^size

colorP = RGB <$> bP <*> bP <*> bP

screenDescriptorP =
  do w <- wordP
     h <- wordP
     opts <- byteP
     bg <- bP
     ar <- bP
     return (SD w h (bit 7 opts) (bitcount 4 opts) (bit 3 opts) (bitcount 0 opts) bg ar)

bitcount p byte = toEnum (1+bits p 3 byte)

dataBlocksP = many dataBlockP

dataBlockP = eitherP extensionBlockP imageP

imageP = 
  do litP ','
     id <- imageDescriptorP 
     lmap <- optColorMapP (hasLocalMap id) (ibitsPerPixel id)
     rd <- rasterDataP
     return (Image id lmap rd)

imageDescriptorP =
  do l<-wordP
     t<-wordP
     w<-wordP
     h<-wordP
     opts<-byteP
     return (ID l t w h (bit 7 opts) (bit 6 opts) (bitcount 0 opts))
  
rasterDataP = compressedBlocksP

compressedBlocksP =
  do c <- byteP
     bs <- blocksP
     return (CB c (map BS.unpack bs))

extensionBlockP =
  do litP '!'
     c <- bP
     bs <- blocksP
     return (EB c (map BS.unpack bs))

blocksP =
  do cnt <- byteP
     if cnt == 0
      then return []
      else do bytes <- bytesP cnt
              blocks <- blocksP
	      return (bytes:blocks)

--bytesP :: Int -> Parser [Byte]
--bytesP n = repeatP n byteP
--bytesP n = fmap (map c2b) (tokens n)
bytesP n = get (splitAt' n)
splitAt' n bs = case BS.splitAt n' bs of
                  p@(bs1,_) | BS.length bs1 == n' -> Just p
                            | otherwise -> Nothing
  where
    n' = fromIntegral n

wordsP n = repeatP n wordP

--c2b = toEnum.fromEnum :: Char->Byte

--byteP = fmap c2b token
byteP = fromEnum <$> bP
bP = get BS.uncons
charP = toEnum <$> byteP

wordP = 
  do lo <- byteP
     hi <- byteP
     return (toEnum (hi*256+lo))

litP c = do c' <- charP; guard (c'==c); return c

litsP pre = mapM litP pre