{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
module SDL.Rotozoom
( Angle
, Zoom
, Smooth(..)
, rotozoom
, rotozoomXY
, Size
, rotozoomSize
, rotozoomSizeXY
, zoom
, zoomXY
, zoomSize
, zoomSizeXY
, shrink
, rotate90
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Foreign.C.Types (CInt)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek)
import Linear (V2(..))
import GHC.Generics (Generic)
import SDL (Surface(..))
import qualified SDL.Raw
import qualified SDL.Raw.Rotozoom
type Angle = Double
type Zoom = Double
data Smooth = Smooth | Rough
deriving (Eq, Enum, Ord, Bounded, Generic, Read, Show)
smoothToCInt :: Smooth -> CInt
smoothToCInt = \case
Smooth -> SDL.Raw.Rotozoom.SMOOTHING_ON
Rough -> SDL.Raw.Rotozoom.SMOOTHING_OFF
unmanaged :: Ptr SDL.Raw.Surface -> Surface
unmanaged p = Surface p Nothing
rotozoom :: MonadIO m => Surface -> Angle -> Zoom -> Smooth -> m Surface
rotozoom (Surface p _) a z s =
unmanaged <$>
SDL.Raw.Rotozoom.rotozoom p (realToFrac a) (realToFrac z) (smoothToCInt s)
rotozoomXY :: MonadIO m => Surface -> Angle -> Zoom -> Zoom -> Smooth -> m Surface
rotozoomXY (Surface p _) a zx zy s =
unmanaged <$>
SDL.Raw.Rotozoom.rotozoomXY
p (realToFrac a) (realToFrac zx) (realToFrac zy) (smoothToCInt s)
type Size = V2 CInt
rotozoomSize :: MonadIO m => Size -> Angle -> Zoom -> m Size
rotozoomSize (V2 w h) a z =
liftIO .
alloca $ \w' ->
alloca $ \h' -> do
SDL.Raw.Rotozoom.rotozoomSize w h (realToFrac a) (realToFrac z) w' h'
V2 <$> peek w' <*> peek h'
rotozoomSizeXY :: MonadIO m => Size -> Angle -> Zoom -> Zoom -> m Size
rotozoomSizeXY (V2 w h) a zx zy =
liftIO .
alloca $ \w' ->
alloca $ \h' -> do
SDL.Raw.Rotozoom.rotozoomSizeXY
w h (realToFrac a) (realToFrac zx) (realToFrac zy) w' h'
V2 <$> peek w' <*> peek h'
{-# INLINE zoom #-}
zoom :: MonadIO m => Surface -> Zoom -> Smooth -> m Surface
zoom surface z = zoomXY surface z z
zoomXY :: MonadIO m => Surface -> Zoom -> Zoom -> Smooth -> m Surface
zoomXY (Surface p _) zx zy s =
unmanaged <$>
SDL.Raw.Rotozoom.zoom p (realToFrac zx) (realToFrac zy) (smoothToCInt s)
{-# INLINE zoomSize #-}
zoomSize :: MonadIO m => Size -> Zoom -> m Size
zoomSize size z = zoomSizeXY size z z
zoomSizeXY :: MonadIO m => Size -> Angle -> Zoom -> m Size
zoomSizeXY (V2 w h) zx zy =
liftIO .
alloca $ \w' ->
alloca $ \h' -> do
SDL.Raw.Rotozoom.zoomSize w h (realToFrac zx) (realToFrac zy) w' h'
V2 <$> peek w' <*> peek h'
shrink :: MonadIO m => Surface -> CInt -> CInt -> m Surface
shrink (Surface p _) rx ry = unmanaged <$> SDL.Raw.Rotozoom.shrink p rx ry
rotate90 :: MonadIO m => Surface -> Int -> m Surface
rotate90 (Surface p _) =
fmap unmanaged . SDL.Raw.Rotozoom.rotate90 p . fromIntegral . (`rem` 4)