[hoc-cvs] hoc/Bindings/AdditionalCode/Foundation NSRange.hs,NONE,1.1

[Wolfgang T. <wth...@us...>]

Update of /cvsroot/hoc/hoc/Bindings/AdditionalCode/Foundation
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23176/AdditionalCode/Foundation

Added Files:
	NSRange.hs 
Log Message:
Add support for NSRange.
Contributed by Matthew Morgan <mat...@gm...>


--- NEW FILE: NSRange.hs ---
-- above NSRange
-- CUT HERE
-- below NSRange
-- CUT HERE
-- above NSRange.Forward
--X NSRange(..)
--X nsMaxRange
--X nsLocationInRange
--X nsNotFound

import HOC.FFICallInterface
import HOC.Arguments
import Foreign
import Foreign.C.Types
-- CUT HERE
-- below NSRange.Forward

data NSRange = NSRange CUInt CUInt  deriving(Read, Show, Eq)

nsMaxRange (NSRange loc len) = loc + len
nsLocationInRange x (NSRange loc len) = x >= loc && x < loc+len
nsNotFound = 0x7fffffff :: CUInt

instance Storable NSRange where
    alignment _ = alignment (undefined :: CUInt)
    sizeOf _ = 2 * sizeOf (undefined :: CUInt)
    peek p = do loc <- peekElemOff (castPtr p) 0
                len <- peekElemOff (castPtr p) 1
                return (NSRange loc len)
    poke p (NSRange loc len) = do pokeElemOff (castPtr p) 0 loc
                                  pokeElemOff (castPtr p) 1 len


instance FFITypeable NSRange where
    makeFFIType _ = do cuint <- makeFFIType (undefined :: CUInt)
                       makeStructType [cuint, cuint]
    isStructType _ = True

$(declareStorableObjCArgument [t| NSRange |] "{_NSRange=II}")