module XReadBitmap(xReadBitmapFileData,xReadBitmapData,xReadManyBitmapData)where

xReadBitmapFileData path = xReadBitmapData <$> readFile path

xReadManyBitmapData = rdAll (rdMany rdBitmapData)

xReadBitmapData = rdAll rdBitmapData

rdBitmapData = rdTwo bitmap rdDefines rdBits
  where
    bitmap ds (name,bits) =
        (name,(pair "width" "height",hot,bits))
      where
        pair n1 n2 = (,) <$> lookup n1 ds <*> lookup n2 ds
        hot = cold =<< pair "x_hot" "y_hot"
        cold (-1,-1) = Nothing
        cold p = Just p

rdDefines = rdMany rdDefine

rdDefine :: ReadS (String,Int)
rdDefine s = [((name,value),r) | ((),r0) <- rdLit "#" s,
                                 ((),r1) <- rdLit "define" r0,
                                 (fullname,r2) <- lex r1,
                                 (_,'_':name) <- [break (=='_') fullname],
                                 (value,r) <- reads r2]

rdBits :: ReadS (String,[Int])
rdBits s = [((name,bits),r) | ((),r0) <- rdLit "static" s,
                              ((),r1) <- rdLit "char" r0,
                              (fullname,r2) <- lex r1,
                              let name = takeWhile (/='_') fullname,
                              ((),r3) <- rdLit "[" r2,
                              ((),r4) <- rdLit "]" r3,
                              ((),r5) <- rdLit "=" r4,
                              ((),r6) <- rdLit "{" r5,
                              (bits,r7) <- rdManySep (rdLit ",") reads r6,
                              ((),r8) <- rdLit "}" r7,
                              ((),r) <- rdLit ";" r8]
                       
--------------------------------------------------------------------------------

rdAll :: ReadS a -> String -> Maybe a
rdAll rd s = case rd s of
               [(x,r)] | lex r==[("","")] -> Just x
               _ -> Nothing

rdMany :: ReadS a -> ReadS [a]
rdMany rd = rdMaybe [] (rdTwo (:) rd (rdMany rd))


rdManySep :: ReadS sep -> ReadS item -> ReadS [item]
rdManySep rdSep rdItem =
  rdMaybe [] (rdTwo (:) rdItem (rdMany (rdTwo (const id) rdSep rdItem)))

rdTwo :: (a->b->c) -> ReadS a -> ReadS b -> ReadS c
rdTwo f rdA rdB s = [(f a b,r) | (a,r0) <- rdA s, (b,r) <- rdB r0]

rdMaybe :: a -> ReadS a -> ReadS a
rdMaybe dA rdA s = take 1 $ rdA s ++ [(dA,s)]

rdLit :: String -> ReadS ()
rdLit t s = [((),r)|(l,r)<-lex s,l==t]