module Amiga where

import qualified System.IO as IO

import qualified Foreign.Marshal.Alloc as Alloc
import Foreign.Storable (Storable, peekByteOff)
import Foreign.Ptr (Ptr)

import Control.Monad (when)
import Control.Applicative ((<$>))

import qualified Data.List.Reverse.StrictSpine as ListRev
import Data.List.HT (sliceVertical)
import Data.Storable.Endian (HasBigEndian, getBigEndian)
import Data.Word (Word8, Word16, Word32)
import Data.Int (Int8, Int16, Int32)

type MEM   = Ptr ()
type PTR   = Word32
type LONG  = Int32
type ULONG = Word32
type WORD  = Int16
type UWORD = Word16
type BYTE  = Int8
type UBYTE = Word8

type Peek a = MEM -> PTR -> IO a

peekOffset :: (Storable a) => Peek a
peekOffset mem ptr = peekByteOff mem (fromIntegral ptr)

peekBig :: (Storable a, HasBigEndian a) => Peek a
peekBig mem ptr = getBigEndian <$> peekOffset mem ptr

peekPTR   :: Peek PTR   ; peekPTR   = peekBig
peekLONG  :: Peek LONG  ; peekLONG  = peekBig
peekULONG :: Peek ULONG ; peekULONG = peekBig
peekWORD  :: Peek WORD  ; peekWORD  = peekBig
peekUWORD :: Peek UWORD ; peekUWORD = peekBig
peekBYTE  :: Peek BYTE  ; peekBYTE  = peekOffset
peekUBYTE :: Peek UBYTE ; peekUBYTE = peekOffset

infixr 0 $?

($?) :: (PTR -> IO a) -> PTR -> IO (Maybe a)
f $? ptr = skipIf (ptr == 0) (f ptr)

skipIf :: Bool -> IO a -> IO (Maybe a)
skipIf cond act =
  if cond
    then return Nothing
    else Just <$> act

loadMEM :: String -> IO MEM
loadMEM s =
  IO.withBinaryFile s IO.ReadMode $ \h -> do
    size <- fromInteger <$> IO.hFileSize h
    ptr <- Alloc.mallocBytes size
    readSize <- IO.hGetBuf h ptr size
    when (readSize<size) $
      ioError $ userError $ "loadMEM: incomplete load of " ++ s
    return ptr

freeMEM :: MEM -> IO ()
freeMEM = Alloc.free


pointerRange :: PTR -> ULONG -> Int -> [PTR]
pointerRange start step len =
  take len $ iterate (fromIntegral step +) start

pointerRangeGen :: (Integral i) => PTR -> ULONG -> i -> [PTR]
pointerRangeGen start step len = pointerRange start step (fromIntegral len)

{- |
Return empty list if start pointer is zero.
-}
pointerRangeGenCheck :: (Integral i) => PTR -> ULONG -> i -> [PTR]
pointerRangeGenCheck start step len =
  if start == 0 then [] else pointerRangeGen start step len

pointerRangeGen2 :: (Integral i, Integral j) => PTR -> ULONG -> i -> j -> [PTR]
pointerRangeGen2 start step len0 len1 =
  pointerRange start step (fromIntegral len0 * fromIntegral len1)


chunk :: (Integral i) => i -> [a] -> [[a]]
chunk k = sliceVertical (fromIntegral k)

-- | Strings tend to be fixed width fields with trailing zeros.
stringFromBytes :: [UBYTE] -> String
stringFromBytes = map (toEnum . fromEnum) . ListRev.dropWhile (==0)