-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Chiphunk/Low/Shape.chs" #-}
-- | Description: Shapes manipulations
-- Module provides access to the shapes which define collisions of rigid bodies.
module Chiphunk.Low.Shape
  ( Shape
  , shapeBody
  , shapeBB
  , shapeSensor
  , shapeElasticity
  , shapeFriction
  , shapeSurfaceVelocity
  , shapeCollisionType
  , ShapeFilter (..)
  , ShapeFilterPtr
  , shapeFilter
  , shapeSpace
  , shapeUserData
  , shapeFree
  , shapeCacheBB
  , shapeUpdate
  , circleShapeNew
  , segmentShapeNew
  , segmentShapeNeighbors
  , polyShapeNew
  , polyShapeNewRaw
  , boxShapeNew
  , boxShapeNew2
  ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Foreign

import Chiphunk.Low.Internal
import Data.StateVar

import Chiphunk.Low.Types
{-# LINE 34 "src/Chiphunk/Low/Shape.chs" #-}





cpShapeGetBody :: (Shape) -> IO ((Body))
cpShapeGetBody a1 =
  let {a1' = id a1} in
  cpShapeGetBody'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 39 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetBody :: (Shape) -> (Body) -> IO ()
cpShapeSetBody a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  cpShapeSetBody'_ a1' a2' >>
  return ()

{-# LINE 41 "src/Chiphunk/Low/Shape.chs" #-}


-- | The rigid body the shape is attached to.
-- Can only be set when the shape is not added to a space.
shapeBody :: Shape -> StateVar Body
shapeBody = mkStateVar cpShapeGetBody cpShapeSetBody

w_cpShapeGetBB :: (Shape) -> IO ((BB))
w_cpShapeGetBB a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpShapeGetBB'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 48 "src/Chiphunk/Low/Shape.chs" #-}


-- | The bounding box of the shape.
-- Only guaranteed to be valid after 'shapeCacheBB' or 'spaceStep' is called.
-- Moving a body that a shape is connected to does not update its bounding box.
-- For shapes used for queries that aren’t attached to bodies, you can also use 'shapeUpdate'.
shapeBB :: Shape -> GettableStateVar BB
shapeBB = makeGettableStateVar . w_cpShapeGetBB

cpShapeGetSensor :: (Shape) -> IO ((Bool))
cpShapeGetSensor a1 =
  let {a1' = id a1} in
  cpShapeGetSensor'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 57 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetSensor :: (Shape) -> (Bool) -> IO ()
cpShapeSetSensor a1 a2 =
  let {a1' = id a1} in
  let {a2' = C2HSImp.fromBool a2} in
  cpShapeSetSensor'_ a1' a2' >>
  return ()

{-# LINE 59 "src/Chiphunk/Low/Shape.chs" #-}


-- | A boolean value if this shape is a sensor or not.
-- Sensors only call collision callbacks, and never generate real collisions.
shapeSensor :: Shape -> StateVar Bool
shapeSensor = mkStateVar cpShapeGetSensor cpShapeSetSensor

cpShapeGetElasticity :: (Shape) -> IO ((Double))
cpShapeGetElasticity a1 =
  let {a1' = id a1} in
  cpShapeGetElasticity'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 66 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetElasticity :: (Shape) -> (Double) -> IO ()
cpShapeSetElasticity a1 a2 =
  let {a1' = id a1} in
  let {a2' = realToFrac a2} in
  cpShapeSetElasticity'_ a1' a2' >>
  return ()

{-# LINE 68 "src/Chiphunk/Low/Shape.chs" #-}


-- | Elasticity of the shape.
-- A value of 0.0 gives no bounce, while a value of 1.0 will give a “perfect” bounce.
-- However due to inaccuracies in the simulation using 1.0 or greater is not recommended however.
--
-- The elasticity for a collision is found by multiplying the elasticity of the individual shapes together.
shapeElasticity :: Shape -> StateVar Double
shapeElasticity = mkStateVar cpShapeGetElasticity cpShapeSetElasticity

cpShapeGetFriction :: (Shape) -> IO ((Double))
cpShapeGetFriction a1 =
  let {a1' = id a1} in
  cpShapeGetFriction'_ a1' >>= \res ->
  let {res' = realToFrac res} in
  return (res')

{-# LINE 78 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetFriction :: (Shape) -> (Double) -> IO ()
cpShapeSetFriction a1 a2 =
  let {a1' = id a1} in
  let {a2' = realToFrac a2} in
  cpShapeSetFriction'_ a1' a2' >>
  return ()

{-# LINE 80 "src/Chiphunk/Low/Shape.chs" #-}


-- | Friction coefficient.
-- Chipmunk uses the Coulomb friction model, a value of 0.0 is frictionless.
--
-- The friction for a collision is found by multiplying the friction of the individual shapes together.
-- <http://www.roymech.co.uk/Useful_Tables/Tribology/co_of_frict.htm Table of friction coefficients.>
shapeFriction :: Shape -> StateVar Double
shapeFriction = mkStateVar cpShapeGetFriction cpShapeSetFriction

w_cpShapeGetSurfaceVelocity :: (Shape) -> IO ((Vect))
w_cpShapeGetSurfaceVelocity a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpShapeGetSurfaceVelocity'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 90 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetSurfaceVelocity :: (Shape) -> (Vect) -> IO ()
cpShapeSetSurfaceVelocity a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  cpShapeSetSurfaceVelocity'_ a1' a2' >>
  return ()

{-# LINE 92 "src/Chiphunk/Low/Shape.chs" #-}


-- | The surface velocity of the object.
-- Useful for creating conveyor belts or players that move around.
-- This value is only used when calculating friction, not resolving the collision.
shapeSurfaceVelocity :: Shape -> StateVar Vect
shapeSurfaceVelocity = mkStateVar w_cpShapeGetSurfaceVelocity cpShapeSetSurfaceVelocity

cpShapeGetCollisionType :: (Shape) -> IO ((CollisionType))
cpShapeGetCollisionType a1 =
  let {a1' = id a1} in
  cpShapeGetCollisionType'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 100 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetCollisionType :: (Shape) -> (CollisionType) -> IO ()
cpShapeSetCollisionType a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  cpShapeSetCollisionType'_ a1' a2' >>
  return ()

{-# LINE 102 "src/Chiphunk/Low/Shape.chs" #-}


-- | Collision type of this shape.
-- | You can assign types to Chipmunk collision shapes
-- that trigger callbacks when objects of certain types touch.
-- See the callbacks section for more information.
shapeCollisionType :: Shape -> StateVar CollisionType
shapeCollisionType = mkStateVar cpShapeGetCollisionType cpShapeSetCollisionType

-- | Fast collision filtering type that is used to determine if two objects collide
-- before calling collision or query callbacks.
data ShapeFilter = ShapeFilter
  { sfGroup :: !WordPtr
  , sfCategories :: !Word32
  , sfMask :: !Word32
  } deriving Show

instance Storable ShapeFilter where
  sizeOf _    = 16
{-# LINE 120 "src/Chiphunk/Low/Shape.chs" #-}

  alignment _ = 8
{-# LINE 121 "src/Chiphunk/Low/Shape.chs" #-}

  poke p (ShapeFilter g c m) = do
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CULong)}) p      $ fromIntegral g
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CUInt)}) p $ fromIntegral c
    (\ptr val -> do {C2HSImp.pokeByteOff ptr 12 (val :: C2HSImp.CUInt)}) p       $ fromIntegral m
  peek p = ShapeFilter <$> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CULong}) p)
                       <*> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CUInt}) p)
                       <*> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 12 :: IO C2HSImp.CUInt}) p)

-- | Pointer to 'ShapeFilter'
type ShapeFilterPtr = C2HSImp.Ptr (ShapeFilter)
{-# LINE 131 "src/Chiphunk/Low/Shape.chs" #-}


w_cpShapeGetFilter :: (Shape) -> IO ((ShapeFilter))
w_cpShapeGetFilter a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  w_cpShapeGetFilter'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 133 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetFilter :: (Shape) -> (ShapeFilter) -> IO ()
cpShapeSetFilter a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  cpShapeSetFilter'_ a1' a2' >>
  return ()

{-# LINE 135 "src/Chiphunk/Low/Shape.chs" #-}


-- | The collision filter for this shape. See Filtering Collisions for more information.
shapeFilter :: Shape -> StateVar ShapeFilter
shapeFilter = mkStateVar w_cpShapeGetFilter cpShapeSetFilter

cpShapeGetSpace :: (Shape) -> IO ((Space))
cpShapeGetSpace a1 =
  let {a1' = id a1} in
  cpShapeGetSpace'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 141 "src/Chiphunk/Low/Shape.chs" #-}


-- | The 'Space' that @shape@ has been added to.
shapeSpace :: Shape -> GettableStateVar Space
shapeSpace = makeGettableStateVar . cpShapeGetSpace

cpShapeGetUserData :: (Shape) -> IO ((DataPtr))
cpShapeGetUserData a1 =
  let {a1' = id a1} in
  cpShapeGetUserData'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 147 "src/Chiphunk/Low/Shape.chs" #-}


cpShapeSetUserData :: (Shape) -> (DataPtr) -> IO ()
cpShapeSetUserData a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  cpShapeSetUserData'_ a1' a2' >>
  return ()

{-# LINE 149 "src/Chiphunk/Low/Shape.chs" #-}


-- | A user definable data pointer.
-- If you set this to point at the game object the shapes is for,
-- then you can access your game object from Chipmunk callbacks.
shapeUserData :: Shape -> StateVar DataPtr
shapeUserData = mkStateVar cpShapeGetUserData cpShapeSetUserData

-- | Deallocates shape.
shapeFree :: (Shape) -> IO ()
shapeFree a1 =
  let {a1' = id a1} in
  shapeFree'_ a1' >>
  return ()

{-# LINE 158 "src/Chiphunk/Low/Shape.chs" #-}

-- no "unsafe" qualifier because I think it may trigger separte callbacks

-- | Synchronizes @shape@ with the body its attached to.
shapeCacheBB :: (Shape) -- ^ shape
 -> IO ((BB))
shapeCacheBB a1 =
  let {a1' = id a1} in
  alloca $ \a2' ->
  shapeCacheBB'_ a1' a2' >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 165 "src/Chiphunk/Low/Shape.chs" #-}


-- | Sets the position and rotation of the shape
shapeUpdate :: (Shape) -- ^ @shape@
 -> (Transform) -> IO ((BB))
shapeUpdate a1 a2 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  alloca $ \a3' ->
  shapeUpdate'_ a1' a2' a3' >>
  peek  a3'>>= \a3'' ->
  return (a3'')

{-# LINE 172 "src/Chiphunk/Low/Shape.chs" #-}


-- | Create new circle-like shape.
circleShapeNew :: (Body) -- ^ The body to attach the circle to.
 -> (Double) -- ^ Radius of the circle.
 -> (Vect) -- ^ Offset from the body's center of gravity in body local coordinates.
 -> IO ((Shape))
circleShapeNew a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = realToFrac a2} in
  with a3 $ \a3' ->
  circleShapeNew'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 179 "src/Chiphunk/Low/Shape.chs" #-}


-- | Create new segment-shaped shape.
segmentShapeNew :: (Body) -- ^ The body to attach the segment to.
 -> (Vect) -- ^ One endpoint.
 -> (Vect) -- ^ Another endpoint.
 -> (Double) -- ^ The thickness of the segment.
 -> IO ((Shape))
segmentShapeNew a1 a2 a3 a4 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  with a3 $ \a3' ->
  let {a4' = realToFrac a4} in
  segmentShapeNew'_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 187 "src/Chiphunk/Low/Shape.chs" #-}


cpSegmentShapeSetNeighbors :: (Shape) -> (Vect) -> (Vect) -> IO ()
cpSegmentShapeSetNeighbors a1 a2 a3 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  with a3 $ \a3' ->
  cpSegmentShapeSetNeighbors'_ a1' a2' a3' >>
  return ()

{-# LINE 189 "src/Chiphunk/Low/Shape.chs" #-}


-- | When you have a number of segment shapes that are all joined together,
-- things can still collide with the “cracks” between the segments.
-- By setting the neighbor segment endpoints
-- you can tell Chipmunk to avoid colliding with the inner parts of the crack.
segmentShapeNeighbors :: Shape -> SettableStateVar (Vect, Vect)
segmentShapeNeighbors shape =
  makeSettableStateVar $ \(v1, v2) ->
    cpSegmentShapeSetNeighbors shape v1 v2

-- | A convex hull will be calculated from the vertexes automatically.
-- The polygon shape will be created with a radius, increasing the size of the shape.
polyShapeNew :: (Body) -- ^ The body to attach the poly to.
 -> ([Vect]) -- ^ The array of 'Vect' structs.
 -> (Transform) -- ^ The transform that will be applied to every vertex.
 -> (Double) -- ^ Radius.
 -> IO ((Shape))
polyShapeNew a1 a2 a3 a4 =
  let {a1' = id a1} in
  withList a2 $ \(a2'1, a2'2) ->
  with a3 $ \a3' ->
  let {a4' = realToFrac a4} in
  polyShapeNew'_ a1' a2'1  a2'2 a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 207 "src/Chiphunk/Low/Shape.chs" #-}


-- | Alternate constructors for poly shapes. This version does not apply a transform nor does it create a convex hull.
-- Verticies must be provided with a counter-clockwise winding.
polyShapeNewRaw :: (Body) -> ([Vect]) -> (Double) -> IO ((Shape))
polyShapeNewRaw a1 a2 a3 =
  let {a1' = id a1} in
  withList a2 $ \(a2'1, a2'2) ->
  let {a3' = realToFrac a3} in
  polyShapeNewRaw'_ a1' a2'1  a2'2 a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 211 "src/Chiphunk/Low/Shape.chs" #-}


-- | Createa box shape from dimensions.
boxShapeNew :: (Body) -- ^ The body to attach to
 -> (Double) -- ^ Box width
 -> (Double) -- ^ Box height
 -> (Double) -- ^ Radius
 -> IO ((Shape))
boxShapeNew a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = realToFrac a2} in
  let {a3' = realToFrac a3} in
  let {a4' = realToFrac a4} in
  boxShapeNew'_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 219 "src/Chiphunk/Low/Shape.chs" #-}


-- | Alternative to 'boxShapeNew' using 'BB' to set size.
boxShapeNew2 :: (Body) -- ^ The body to attach to
 -> (BB) -- ^ Shape size
 -> (Double) -- ^ Radius
 -> IO ((Shape))
boxShapeNew2 a1 a2 a3 =
  let {a1' = id a1} in
  with a2 $ \a2' ->
  let {a3' = realToFrac a3} in
  boxShapeNew2'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 226 "src/Chiphunk/Low/Shape.chs" #-}


foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetBody"
  cpShapeGetBody'_ :: ((Shape) -> (IO (Body)))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeSetBody"
  cpShapeSetBody'_ :: ((Shape) -> ((Body) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h w_cpShapeGetBB"
  w_cpShapeGetBB'_ :: ((Shape) -> ((BBPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetSensor"
  cpShapeGetSensor'_ :: ((Shape) -> (IO C2HSImp.CUChar))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeSetSensor"
  cpShapeSetSensor'_ :: ((Shape) -> (C2HSImp.CUChar -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetElasticity"
  cpShapeGetElasticity'_ :: ((Shape) -> (IO C2HSImp.CDouble))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeSetElasticity"
  cpShapeSetElasticity'_ :: ((Shape) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetFriction"
  cpShapeGetFriction'_ :: ((Shape) -> (IO C2HSImp.CDouble))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeSetFriction"
  cpShapeSetFriction'_ :: ((Shape) -> (C2HSImp.CDouble -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h w_cpShapeGetSurfaceVelocity"
  w_cpShapeGetSurfaceVelocity'_ :: ((Shape) -> ((VectPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpShapeSetSurfaceVelocity"
  cpShapeSetSurfaceVelocity'_ :: ((Shape) -> ((VectPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetCollisionType"
  cpShapeGetCollisionType'_ :: ((Shape) -> (IO C2HSImp.CULong))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeSetCollisionType"
  cpShapeSetCollisionType'_ :: ((Shape) -> (C2HSImp.CULong -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h w_cpShapeGetFilter"
  w_cpShapeGetFilter'_ :: ((Shape) -> ((ShapeFilterPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpShapeSetFilter"
  cpShapeSetFilter'_ :: ((Shape) -> ((ShapeFilterPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetSpace"
  cpShapeGetSpace'_ :: ((Shape) -> (IO (Space)))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeGetUserData"
  cpShapeGetUserData'_ :: ((Shape) -> (IO (DataPtr)))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpShapeSetUserData"
  cpShapeSetUserData'_ :: ((Shape) -> ((DataPtr) -> (IO ())))

foreign import ccall safe "Chiphunk/Low/Shape.chs.h cpShapeFree"
  shapeFree'_ :: ((Shape) -> (IO ()))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h w_cpShapeCacheBB"
  shapeCacheBB'_ :: ((Shape) -> ((BBPtr) -> (IO ())))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__w_cpShapeUpdate"
  shapeUpdate'_ :: ((Shape) -> ((TransformPtr) -> ((BBPtr) -> (IO ()))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpCircleShapeNew"
  circleShapeNew'_ :: ((Body) -> (C2HSImp.CDouble -> ((VectPtr) -> (IO (Shape)))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpSegmentShapeNew"
  segmentShapeNew'_ :: ((Body) -> ((VectPtr) -> ((VectPtr) -> (C2HSImp.CDouble -> (IO (Shape))))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpSegmentShapeSetNeighbors"
  cpSegmentShapeSetNeighbors'_ :: ((Shape) -> ((VectPtr) -> ((VectPtr) -> (IO ()))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpPolyShapeNew"
  polyShapeNew'_ :: ((Body) -> (C2HSImp.CInt -> ((VectPtr) -> ((TransformPtr) -> (C2HSImp.CDouble -> (IO (Shape)))))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpPolyShapeNewRaw"
  polyShapeNewRaw'_ :: ((Body) -> (C2HSImp.CInt -> ((VectPtr) -> (C2HSImp.CDouble -> (IO (Shape))))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h cpBoxShapeNew"
  boxShapeNew'_ :: ((Body) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (IO (Shape))))))

foreign import ccall unsafe "Chiphunk/Low/Shape.chs.h __c2hs_wrapped__cpBoxShapeNew2"
  boxShapeNew2'_ :: ((Body) -> ((BBPtr) -> (C2HSImp.CDouble -> (IO (Shape)))))