module Codec.Game.Puz.Internal where
import Foreign
import Foreign.Ptr
import Foreign.C
import Text.ParserCombinators.Parsec
newtype PuzHead = PuzHead (ForeignPtr (PuzHead))
withPuzHead (PuzHead fptr) = withForeignPtr fptr
newtype Puz = Puz (ForeignPtr (Puz))
withPuz (Puz fptr) = withForeignPtr fptr
data PuzType = PuzTypeBinary
| PuzTypeText
| PuzTypeUnknown
deriving (Eq,Show)
instance Enum PuzType where
fromEnum PuzTypeBinary = 1
fromEnum PuzTypeText = 2
fromEnum PuzTypeUnknown = 4
toEnum 1 = PuzTypeBinary
toEnum 2 = PuzTypeText
toEnum 4 = PuzTypeUnknown
toEnum unmatched = error ("PuzType.toEnum: Cannot match " ++ show unmatched)
marshallPuzMaybe :: Ptr Puz -> IO (Maybe Puz)
marshallPuzMaybe pp =
if pp == nullPtr
then return Nothing
else do fp <- newForeignPtr finalizerFree pp
return $ Just $ Puz fp
marshallPuz :: Ptr Puz -> IO Puz
marshallPuz pp = do fp <- newForeignPtr finalizerFree pp
return $ Puz fp
boolToCInt :: Bool -> CInt
boolToCInt True = 1
boolToCInt False = 0
alwaysUseIn :: a -> (a -> b) -> b
alwaysUseIn a f = f a
nullIn :: (Ptr a -> IO b) -> IO b
nullIn = alwaysUseIn nullPtr
puzTypeIn :: (CInt -> IO b) -> IO b
puzTypeIn = alwaysUseIn $ cIntConv $ fromEnum PuzTypeBinary
zeroShortIn :: (CUShort -> IO b) -> IO b
zeroShortIn = alwaysUseIn $ fromIntegral 0x0000
puzIn :: Puz -> (Ptr Puz -> IO b) -> IO b
puzIn (Puz fp) = withForeignPtr fp
stringIn :: String -> (Ptr CUChar -> IO b) -> IO b
stringIn str =
let cuchars = map ((toEnum :: Int -> CUChar) . fromEnum) str in
withArray0 0 cuchars
rtblIn :: [(String,Int)] -> (Ptr CUChar -> IO b) -> IO b
rtblIn tbl =
let chars = concatMap (\(s,i) -> let pad = if i < 10 then " " else "" in
pad ++ show i ++ ":" ++ s ++ ";")
tbl
in
stringIn chars
cerrToBool :: CInt -> Bool
cerrToBool = (0 ==)
cintToBool :: CInt -> Bool
cintToBool = (0 /=)
saveIntToBool :: CInt -> Bool
saveIntToBool = (1 /=)
stringOut :: Ptr CUChar -> IO String
stringOut ptr =
do cuchars <- peekArray0 (0 :: CUChar) ptr
return $ map (toEnum . (fromIntegral :: CUChar -> Int)) cuchars
rtblParser :: Parser [(Int,String)]
rtblParser =
sepEndBy (do spaces
ds <- many1 digit
char ':'
reb <- many1 alphaNum
return ((read ds) + 1, reb))
(char ';')
rtblOut :: Ptr CUChar -> IO [(Int,String)]
rtblOut ptr =
do str <- stringOut ptr
case parse rtblParser "rebus table" str of
Left err -> error ("Ill-formed puzzle file: " ++ show err)
Right tbl -> return tbl
puzCreate :: IO (Puz)
puzCreate =
nullIn $ \a1' ->
puzCreate'_ a1' >>= \res ->
marshallPuz res >>= \res' ->
return (res')
puzLoad :: Ptr CUChar -> Int -> IO (Maybe Puz)
puzLoad a3 a4 =
nullIn $ \a1' ->
puzTypeIn $ \a2' ->
let {a3' = id a3} in
let {a4' = cIntConv a4} in
puzLoad'_ a1' a2' a3' a4' >>= \res ->
marshallPuzMaybe res >>= \res' ->
return (res')
puzSave :: Puz -> Ptr CUChar -> Int -> IO (Bool)
puzSave a1 a3 a4 =
puzIn a1 $ \a1' ->
puzTypeIn $ \a2' ->
let {a3' = id a3} in
let {a4' = cIntConv a4} in
puzSave'_ a1' a2' a3' a4' >>= \res ->
let {res' = saveIntToBool res} in
return (res')
puzSize :: Puz -> IO (Int)
puzSize a1 =
puzIn a1 $ \a1' ->
puzSize'_ a1' >>= \res ->
let {res' = cIntConv res} in
return (res')
puzCksumsCalc :: Puz -> IO ()
puzCksumsCalc a1 =
puzIn a1 $ \a1' ->
puzCksumsCalc'_ a1' >>= \res ->
return ()
puzCksumsCheck :: Puz -> IO (Bool)
puzCksumsCheck a1 =
puzIn a1 $ \a1' ->
puzCksumsCheck'_ a1' >>= \res ->
let {res' = cerrToBool res} in
return (res')
puzCksumsCommit :: Puz -> IO ()
puzCksumsCommit a1 =
puzIn a1 $ \a1' ->
puzCksumsCommit'_ a1' >>= \res ->
return ()
puzGetWidth :: Puz -> IO (Int)
puzGetWidth a1 =
puzIn a1 $ \a1' ->
puzGetWidth'_ a1' >>= \res ->
let {res' = cIntConv res} in
return (res')
puzSetWidth :: Puz -> Int -> IO ()
puzSetWidth a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
puzSetWidth'_ a1' a2' >>= \res ->
return ()
puzGetHeight :: Puz -> IO (Int)
puzGetHeight a1 =
puzIn a1 $ \a1' ->
puzGetHeight'_ a1' >>= \res ->
let {res' = cIntConv res} in
return (res')
puzSetHeight :: Puz -> Int -> IO ()
puzSetHeight a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
puzSetHeight'_ a1' a2' >>= \res ->
return ()
puzGetSolution :: Puz -> IO (Ptr CUChar)
puzGetSolution a1 =
puzIn a1 $ \a1' ->
puzGetSolution'_ a1' >>= \res ->
let {res' = id res} in
return (res')
puzSetSolution :: Puz -> Ptr CUChar -> IO ()
puzSetSolution a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = id a2} in
puzSetSolution'_ a1' a2' >>= \res ->
return ()
puzGetGrid :: Puz -> IO (Ptr CUChar)
puzGetGrid a1 =
puzIn a1 $ \a1' ->
puzGetGrid'_ a1' >>= \res ->
let {res' = id res} in
return (res')
puzSetGrid :: Puz -> Ptr CUChar -> IO ()
puzSetGrid a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = id a2} in
puzSetGrid'_ a1' a2' >>= \res ->
return ()
puzGetTitle :: Puz -> IO (String)
puzGetTitle a1 =
puzIn a1 $ \a1' ->
puzGetTitle'_ a1' >>= \res ->
stringOut res >>= \res' ->
return (res')
puzSetTitle :: Puz -> String -> IO ()
puzSetTitle a1 a2 =
puzIn a1 $ \a1' ->
stringIn a2 $ \a2' ->
puzSetTitle'_ a1' a2' >>= \res ->
return ()
puzGetAuthor :: Puz -> IO (String)
puzGetAuthor a1 =
puzIn a1 $ \a1' ->
puzGetAuthor'_ a1' >>= \res ->
stringOut res >>= \res' ->
return (res')
puzSetAuthor :: Puz -> String -> IO ()
puzSetAuthor a1 a2 =
puzIn a1 $ \a1' ->
stringIn a2 $ \a2' ->
puzSetAuthor'_ a1' a2' >>= \res ->
return ()
puzGetCopyright :: Puz -> IO (String)
puzGetCopyright a1 =
puzIn a1 $ \a1' ->
puzGetCopyright'_ a1' >>= \res ->
stringOut res >>= \res' ->
return (res')
puzSetCopyright :: Puz -> String -> IO ()
puzSetCopyright a1 a2 =
puzIn a1 $ \a1' ->
stringIn a2 $ \a2' ->
puzSetCopyright'_ a1' a2' >>= \res ->
return ()
puzGetClueCount :: Puz -> IO (Int)
puzGetClueCount a1 =
puzIn a1 $ \a1' ->
puzGetClueCount'_ a1' >>= \res ->
let {res' = cIntConv res} in
return (res')
puzSetClueCount :: Puz -> Int -> IO ()
puzSetClueCount a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
puzSetClueCount'_ a1' a2' >>= \res ->
return ()
puzGetClue :: Puz -> Int -> IO (String)
puzGetClue a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
puzGetClue'_ a1' a2' >>= \res ->
stringOut res >>= \res' ->
return (res')
puzSetClue :: Puz -> Int -> String -> IO ()
puzSetClue a1 a2 a3 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
stringIn a3 $ \a3' ->
puzSetClue'_ a1' a2' a3' >>= \res ->
return ()
puzGetNotes :: Puz -> IO (String)
puzGetNotes a1 =
puzIn a1 $ \a1' ->
puzGetNotes'_ a1' >>= \res ->
stringOut res >>= \res' ->
return (res')
puzSetNotes :: Puz -> String -> IO ()
puzSetNotes a1 a2 =
puzIn a1 $ \a1' ->
stringIn a2 $ \a2' ->
puzSetNotes'_ a1' a2' >>= \res ->
return ()
puzHasRebus :: Puz -> IO (Bool)
puzHasRebus a1 =
puzIn a1 $ \a1' ->
puzHasRebus'_ a1' >>= \res ->
let {res' = cintToBool res} in
return (res')
puzGetRebus :: Puz -> IO (Ptr CUChar)
puzGetRebus a1 =
puzIn a1 $ \a1' ->
puzGetRebus'_ a1' >>= \res ->
let {res' = id res} in
return (res')
puzSetRebus :: Puz -> Ptr CUChar -> IO ()
puzSetRebus a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = id a2} in
puzSetRebus'_ a1' a2' >>= \res ->
return ()
puzGetRebusCount :: Puz -> IO (Int)
puzGetRebusCount a1 =
puzIn a1 $ \a1' ->
puzGetRebusCount'_ a1' >>= \res ->
let {res' = cIntConv res} in
return (res')
puzSetRebusCount :: Puz -> Int -> IO ()
puzSetRebusCount a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
puzSetRebusCount'_ a1' a2' >>= \res ->
return ()
puzGetRtbl :: Puz -> IO ([(Int,String)])
puzGetRtbl a1 =
puzIn a1 $ \a1' ->
puzGetRtbl'_ a1' >>= \res ->
rtblOut res >>= \res' ->
return (res')
puzSetRtbl :: Puz -> [(String,Int)] -> IO ()
puzSetRtbl a1 a2 =
puzIn a1 $ \a1' ->
rtblIn a2 $ \a2' ->
puzSetRtbl'_ a1' a2' >>= \res ->
return ()
puzHasTimer :: Puz -> IO (Bool)
puzHasTimer a1 =
puzIn a1 $ \a1' ->
puzHasTimer'_ a1' >>= \res ->
let {res' = cintToBool res} in
return (res')
puzGetTimerElapsed :: Puz -> IO (Int)
puzGetTimerElapsed a1 =
puzIn a1 $ \a1' ->
puzGetTimerElapsed'_ a1' >>= \res ->
let {res' = cIntConv res} in
return (res')
puzGetTimerStopped :: Puz -> IO (Bool)
puzGetTimerStopped a1 =
puzIn a1 $ \a1' ->
puzGetTimerStopped'_ a1' >>= \res ->
let {res' = cintToBool res} in
return (res')
puzSetTimer :: Puz -> Int -> Bool -> IO ()
puzSetTimer a1 a2 a3 =
puzIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
let {a3' = boolToCInt a3} in
puzSetTimer'_ a1' a2' a3' >>= \res ->
return ()
puzHasExtras :: Puz -> IO (Bool)
puzHasExtras a1 =
puzIn a1 $ \a1' ->
puzHasExtras'_ a1' >>= \res ->
let {res' = cintToBool res} in
return (res')
puzGetExtras :: Puz -> IO (Ptr CUChar)
puzGetExtras a1 =
puzIn a1 $ \a1' ->
puzGetExtras'_ a1' >>= \res ->
let {res' = id res} in
return (res')
puzSetExtras :: Puz -> Ptr CUChar -> IO ()
puzSetExtras a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = id a2} in
puzSetExtras'_ a1' a2' >>= \res ->
return ()
puzIsLockedGet :: Puz -> IO (Bool)
puzIsLockedGet a1 =
puzIn a1 $ \a1' ->
puzIsLockedGet'_ a1' >>= \res ->
let {res' = cintToBool res} in
return (res')
puzLockedCksumGet :: Puz -> IO (CUShort)
puzLockedCksumGet a1 =
puzIn a1 $ \a1' ->
puzLockedCksumGet'_ a1' >>= \res ->
let {res' = id res} in
return (res')
puzLockSet :: Puz -> CUShort -> IO ()
puzLockSet a1 a2 =
puzIn a1 $ \a1' ->
let {a2' = id a2} in
puzLockSet'_ a1' a2' >>= \res ->
return ()
puzCksumString :: String -> Int -> IO (CUShort)
puzCksumString a1 a2 =
stringIn a1 $ \a1' ->
let {a2' = cIntConv a2} in
zeroShortIn $ \a3' ->
puzCksumString'_ a1' a2' a3' >>= \res ->
let {res' = id res} in
return (res')
cIntConv :: (Integral a, Integral b) => a -> b
cIntConv = fromIntegral
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_init"
puzCreate'_ :: ((Ptr (Puz)) -> (IO (Ptr (Puz))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_load"
puzLoad'_ :: ((Ptr (Puz)) -> (CInt -> ((Ptr CUChar) -> (CInt -> (IO (Ptr (Puz)))))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_save"
puzSave'_ :: ((Ptr (Puz)) -> (CInt -> ((Ptr CUChar) -> (CInt -> (IO CInt)))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_size"
puzSize'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_cksums_calc"
puzCksumsCalc'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_cksums_check"
puzCksumsCheck'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_cksums_commit"
puzCksumsCommit'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_width_get"
puzGetWidth'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_width_set"
puzSetWidth'_ :: ((Ptr (Puz)) -> (CUChar -> (IO CInt)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_height_get"
puzGetHeight'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_height_set"
puzSetHeight'_ :: ((Ptr (Puz)) -> (CUChar -> (IO CInt)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_solution_get"
puzGetSolution'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_solution_set"
puzSetSolution'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_grid_get"
puzGetGrid'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_grid_set"
puzSetGrid'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_title_get"
puzGetTitle'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_title_set"
puzSetTitle'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_author_get"
puzGetAuthor'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_author_set"
puzSetAuthor'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_copyright_get"
puzGetCopyright'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_copyright_set"
puzSetCopyright'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_clue_count_get"
puzGetClueCount'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_clue_count_set"
puzSetClueCount'_ :: ((Ptr (Puz)) -> (CInt -> (IO CInt)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_clue_get"
puzGetClue'_ :: ((Ptr (Puz)) -> (CInt -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_clue_set"
puzSetClue'_ :: ((Ptr (Puz)) -> (CInt -> ((Ptr CUChar) -> (IO (Ptr CUChar)))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_notes_get"
puzGetNotes'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_notes_set"
puzSetNotes'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_has_rebus"
puzHasRebus'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_rebus_get"
puzGetRebus'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_rebus_set"
puzSetRebus'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_rebus_count_get"
puzGetRebusCount'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_rebus_count_set"
puzSetRebusCount'_ :: ((Ptr (Puz)) -> (CInt -> (IO CInt)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_rtblstr_get"
puzGetRtbl'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_rtblstr_set"
puzSetRtbl'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr (Ptr CUChar)))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_has_timer"
puzHasTimer'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_timer_elapsed_get"
puzGetTimerElapsed'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_timer_stopped_get"
puzGetTimerStopped'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_timer_set"
puzSetTimer'_ :: ((Ptr (Puz)) -> (CInt -> (CInt -> (IO (Ptr CUChar)))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_has_extras"
puzHasExtras'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_extras_get"
puzGetExtras'_ :: ((Ptr (Puz)) -> (IO (Ptr CUChar)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_extras_set"
puzSetExtras'_ :: ((Ptr (Puz)) -> ((Ptr CUChar) -> (IO (Ptr CUChar))))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_is_locked_get"
puzIsLockedGet'_ :: ((Ptr (Puz)) -> (IO CInt))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_locked_cksum_get"
puzLockedCksumGet'_ :: ((Ptr (Puz)) -> (IO CUShort))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_lock_set"
puzLockSet'_ :: ((Ptr (Puz)) -> (CUShort -> (IO CUShort)))
foreign import ccall safe "Codec/Game/Puz/Internal.chs.h puz_cksum_region"
puzCksumString'_ :: ((Ptr CUChar) -> (CInt -> (CUShort -> (IO CUShort))))