gistfile1.hs

module ZSCII
  ( decode
  , encode
  ) where

import           Control.Applicative  ((<$>), (<*>))
import           Control.Monad        ((<=<))
import           Data.Binary.Put
import           Data.Bits
import qualified Data.ByteString.Lazy as BL
import           Data.List.Split      (chunksOf)
import           Data.Word

(.<<.), (.>>.) :: Bits a => a -> Int -> a
(.<<.) = unsafeShiftL
(.>>.) = unsafeShiftR

decode :: BL.ByteString -> [Word8]
decode = decodeZchars <=< decodeWord16

decodeZchars :: Word16 -> [Word8]
decodeZchars w = fromIntegral . mask <$> [w .>>. 10, w .>>. 5, w]
  where mask = (.&. 0x1f)

decodeWord16 :: BL.ByteString -> [Word16]
decodeWord16 = takeUntil (`testBit` 15) . unpackWord16
  where
    unpackWord16 = BL.zipWith go <*> BL.tail where
      go a b = fromIntegral a .<<. 8 .|. fromIntegral b

encode :: [Word8] -> BL.ByteString
encode = runPut . putZSCII

putZSCII :: [Word8] -> Put
putZSCII zstring = do
  mapM_
    (putWord16be . encodeZchar)
    (chunksOf 3 zstring)
  putWord16be (bit 15)

encodeZchar :: [Word8] -> Word16
encodeZchar = go . fmap fromIntegral
  where
    go [w1, w2, w3] = w1 .<<. 10 .|. w2 .<<. 5 .|. w3
    go [w1, w2]     = go [w1, w2, 5]
    go [w1]         = go [w1, 5,  5]

takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = takeWhile (not . p)