[Haskell-cafe] Review request for my encoding function

C K Kashyap ckkashyap at gmail.com
Sat Jan 8 07:27:05 CET 2011


Hi,
I've written a function to encode a color value of type (Int,Int,Int)
into 8,16 or 32 byte ByteString depending on the value of bits per
pixel. This is for my VNC server implementation.
I'd appreciate some feedback on the Haskellism of the implementation.

import Data.Bits
import Data.ByteString.Lazy
import Data.Binary.Put
import Data.Word

type Red = Int
type Green = Int
type Blue = Int
type Color = (Red,Green,Blue)



encode :: Color -> Int-> Int-> Int-> Int-> Int-> Int-> Int -> ByteString
encode (r,g,b) bitsPerPixel redMax greenMax blueMax redShift
greenShift blueShift = runPut $ do
	case bitsPerPixel of
		8	-> putWord8 z8
		16	-> putWord16be z16
		32	-> putWord32be z32
	where
		z8  = (fromIntegral $ nr + ng + nb) :: Word8
		z16 = (fromIntegral $ nr + ng + nb) :: Word16
		z32 = (fromIntegral $ nr + ng + nb) :: Word32
		nr = scale r redMax redShift
		ng = scale g greenMax greenShift
		nb = scale b blueMax blueShift
		scale c cm cs = (c * cm `div` 255) `shift` cs



Regards,
Kashyap



More information about the Haskell-Cafe mailing list