{-# LANGUAGE CPP #-}
module Data.Bitmap.Internal where
import Control.Monad
import Data.Word
import Foreign
import Foreign.C
data PixelComponentType
= PctWord8
| PctWord16
| PctWord32
| PctFloat
deriving (Int -> PixelComponentType -> ShowS
[PixelComponentType] -> ShowS
PixelComponentType -> String
(Int -> PixelComponentType -> ShowS)
-> (PixelComponentType -> String)
-> ([PixelComponentType] -> ShowS)
-> Show PixelComponentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PixelComponentType] -> ShowS
$cshowList :: [PixelComponentType] -> ShowS
show :: PixelComponentType -> String
$cshow :: PixelComponentType -> String
showsPrec :: Int -> PixelComponentType -> ShowS
$cshowsPrec :: Int -> PixelComponentType -> ShowS
Show,PixelComponentType -> PixelComponentType -> Bool
(PixelComponentType -> PixelComponentType -> Bool)
-> (PixelComponentType -> PixelComponentType -> Bool)
-> Eq PixelComponentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixelComponentType -> PixelComponentType -> Bool
$c/= :: PixelComponentType -> PixelComponentType -> Bool
== :: PixelComponentType -> PixelComponentType -> Bool
$c== :: PixelComponentType -> PixelComponentType -> Bool
Eq)
pixelComponentSize :: PixelComponentType -> Int
pixelComponentSize :: PixelComponentType -> Int
pixelComponentSize PixelComponentType
pct = case PixelComponentType
pct of
PixelComponentType
PctWord8 -> Int
1
PixelComponentType
PctWord16 -> Int
2
PixelComponentType
PctWord32 -> Int
4
PixelComponentType
PctFloat -> Int
4
prettyPrintPixelComponentType :: PixelComponentType -> String
prettyPrintPixelComponentType :: PixelComponentType -> String
prettyPrintPixelComponentType PixelComponentType
t = case PixelComponentType
t of
PixelComponentType
PctWord8 -> String
"Word8"
PixelComponentType
PctWord16 -> String
"Word16"
PixelComponentType
PctWord32 -> String
"Word32"
PixelComponentType
PctFloat -> String
"Float"
class (Num t, Storable t) => PixelComponent t where
c_type :: t -> CInt
toFloat :: t -> Float
fromFloat :: Float -> t
pixelComponentType :: PixelComponent t => t -> PixelComponentType
pixelComponentType :: t -> PixelComponentType
pixelComponentType t
t = CInt -> PixelComponentType
decodeCType (t -> CInt
forall t. PixelComponent t => t -> CInt
c_type t
t)
decodeCType :: CInt -> PixelComponentType
decodeCType :: CInt -> PixelComponentType
decodeCType CInt
k = case CInt
k of
CInt
1 -> PixelComponentType
PctWord8
CInt
2 -> PixelComponentType
PctWord16
CInt
3 -> PixelComponentType
PctWord32
CInt
4 -> PixelComponentType
PctFloat
{-# INLINE clamp #-}
clamp :: Float -> Float
clamp :: Float -> Float
clamp = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0
instance PixelComponent Word8 where
{-# SPECIALIZE instance PixelComponent Word8 #-}
c_type :: Word8 -> CInt
c_type Word8
_ = CInt
1
fromFloat :: Float -> Word8
fromFloat = Float -> Word8
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Word8) -> (Float -> Float) -> Float -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
+Float
0.5) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
255) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0
toFloat :: Word8 -> Float
toFloat = (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
3.92156862745098e-3) (Float -> Float) -> (Word8 -> Float) -> Word8 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance PixelComponent Word16 where
{-# SPECIALIZE instance PixelComponent Word16 #-}
c_type :: Word16 -> CInt
c_type Word16
_ = CInt
2
fromFloat :: Float -> Word16
fromFloat = Float -> Word16
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Word16) -> (Float -> Float) -> Float -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
+Float
0.5) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
65535) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0
toFloat :: Word16 -> Float
toFloat = (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
1.5259021896696422e-5) (Float -> Float) -> (Word16 -> Float) -> Word16 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance PixelComponent Word32 where
{-# SPECIALIZE instance PixelComponent Word32 #-}
c_type :: Word32 -> CInt
c_type Word32
_ = CInt
3
fromFloat :: Float -> Word32
fromFloat = Float -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Word32) -> (Float -> Float) -> Float -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
+Float
0.5) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
4294967295) (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 (Float -> Float) -> (Float -> Float) -> Float -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0
toFloat :: Word32 -> Float
toFloat = (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
2.3283064370807974e-10) (Float -> Float) -> (Word32 -> Float) -> Word32 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance PixelComponent Float where
{-# SPECIALIZE instance PixelComponent Float #-}
c_type :: Float -> CInt
c_type Float
_ = CInt
4
fromFloat :: Float -> Float
fromFloat = Float -> Float
forall a. a -> a
id
toFloat :: Float -> Float
toFloat = Float -> Float
forall a. a -> a
id
bitmapUndefined :: BitmapClass bitmap => bitmap t -> t
bitmapUndefined :: bitmap t -> t
bitmapUndefined bitmap t
_ = t
forall a. HasCallStack => a
undefined
bitmapCType :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> CInt
bitmapCType :: bitmap t -> CInt
bitmapCType = t -> CInt
forall t. PixelComponent t => t -> CInt
c_type (t -> CInt) -> (bitmap t -> t) -> bitmap t -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined
class BitmapClass b where
underlyingBitmap :: b t -> Bitmap t
instance BitmapClass Bitmap where
underlyingBitmap :: Bitmap t -> Bitmap t
underlyingBitmap = Bitmap t -> Bitmap t
forall a. a -> a
id
data BitmapChannel t = BmChn (Bitmap t) Int
data IOBitmapChannel t = IOBmChn (IOBitmap t) Int
data STBitmapChannel t = STBmChn (STBitmap t) Int
type Size = (Int,Int)
type Offset = (Int,Int)
type NChn = Int
type Padding = Int
type Alignment = Int
data Bitmap t = Bitmap
{ Bitmap t -> Size
_bitmapSize :: Size
, Bitmap t -> Int
_bitmapNChannels :: NChn
, Bitmap t -> ForeignPtr t
_bitmapPtr :: ForeignPtr t
, Bitmap t -> Int
_bitmapRowPadding :: Padding
, Bitmap t -> Int
_bitmapRowAlignment :: Alignment
}
newtype IOBitmap t = IOBitmap { IOBitmap t -> Bitmap t
unIOBitmap :: Bitmap t }
newtype STBitmap t = STBitmap { STBitmap t -> Bitmap t
unSTBitmap :: Bitmap t }
instance BitmapClass IOBitmap where underlyingBitmap :: IOBitmap t -> Bitmap t
underlyingBitmap = IOBitmap t -> Bitmap t
forall t. IOBitmap t -> Bitmap t
unIOBitmap
instance BitmapClass STBitmap where underlyingBitmap :: STBitmap t -> Bitmap t
underlyingBitmap = STBitmap t -> Bitmap t
forall t. STBitmap t -> Bitmap t
unSTBitmap
bitmapSize :: BitmapClass bitmap => bitmap t -> Size
bitmapSize :: bitmap t -> Size
bitmapSize = Bitmap t -> Size
forall t. Bitmap t -> Size
_bitmapSize (Bitmap t -> Size) -> (bitmap t -> Bitmap t) -> bitmap t -> Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bitmap t -> Bitmap t
forall (b :: * -> *) t. BitmapClass b => b t -> Bitmap t
underlyingBitmap
bitmapNChannels :: BitmapClass bitmap => bitmap t -> NChn
bitmapNChannels :: bitmap t -> Int
bitmapNChannels = Bitmap t -> Int
forall t. Bitmap t -> Int
_bitmapNChannels (Bitmap t -> Int) -> (bitmap t -> Bitmap t) -> bitmap t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bitmap t -> Bitmap t
forall (b :: * -> *) t. BitmapClass b => b t -> Bitmap t
underlyingBitmap
bitmapPtr :: BitmapClass bitmap => bitmap t -> ForeignPtr t
bitmapPtr :: bitmap t -> ForeignPtr t
bitmapPtr = Bitmap t -> ForeignPtr t
forall t. Bitmap t -> ForeignPtr t
_bitmapPtr (Bitmap t -> ForeignPtr t)
-> (bitmap t -> Bitmap t) -> bitmap t -> ForeignPtr t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bitmap t -> Bitmap t
forall (b :: * -> *) t. BitmapClass b => b t -> Bitmap t
underlyingBitmap
bitmapRowPadding :: BitmapClass bitmap => bitmap t -> Padding
bitmapRowPadding :: bitmap t -> Int
bitmapRowPadding = Bitmap t -> Int
forall t. Bitmap t -> Int
_bitmapRowPadding (Bitmap t -> Int) -> (bitmap t -> Bitmap t) -> bitmap t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bitmap t -> Bitmap t
forall (b :: * -> *) t. BitmapClass b => b t -> Bitmap t
underlyingBitmap
bitmapRowAlignment :: BitmapClass bitmap => bitmap t -> Alignment
bitmapRowAlignment :: bitmap t -> Int
bitmapRowAlignment = Bitmap t -> Int
forall t. Bitmap t -> Int
_bitmapRowAlignment (Bitmap t -> Int) -> (bitmap t -> Bitmap t) -> bitmap t -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bitmap t -> Bitmap t
forall (b :: * -> *) t. BitmapClass b => b t -> Bitmap t
underlyingBitmap
bitmapComponentType :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> PixelComponentType
bitmapComponentType :: bitmap t -> PixelComponentType
bitmapComponentType bitmap t
bm = t -> PixelComponentType
forall t. PixelComponent t => t -> PixelComponentType
pixelComponentType (bitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined bitmap t
bm)
bitmapComponentSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int
bitmapComponentSizeInBytes :: bitmap t -> Int
bitmapComponentSizeInBytes bitmap t
bm = t -> Int
forall a. Storable a => a -> Int
sizeOf (bitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined bitmap t
bm)
bitmapPixelSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int
bitmapPixelSizeInBytes :: bitmap t -> Int
bitmapPixelSizeInBytes bitmap t
bm = bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels bitmap t
bm Int -> Int -> Int
forall a. Num a => a -> a -> a
* bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapComponentSizeInBytes bitmap t
bm
bitmapUnpaddedRowSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int
bitmapUnpaddedRowSizeInBytes :: bitmap t -> Int
bitmapUnpaddedRowSizeInBytes bitmap t
bm = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* t -> Int
forall a. Storable a => a -> Int
sizeOf (bitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined bitmap t
bm) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nchn where
(Int
w,Int
h) = bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize bitmap t
bm
nchn :: Int
nchn = bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels bitmap t
bm
bitmapPaddedRowSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int
bitmapPaddedRowSizeInBytes :: bitmap t -> Int
bitmapPaddedRowSizeInBytes bitmap t
bm = bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapUnpaddedRowSizeInBytes bitmap t
bm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding bitmap t
bm
bitmapSizeInBytes :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int
bitmapSizeInBytes :: bitmap t -> Int
bitmapSizeInBytes bitmap t
bm = Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
x where
x :: Int
x = bitmap t -> Int
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> Int
bitmapPaddedRowSizeInBytes bitmap t
bm
(Int
_,Int
h) = bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize bitmap t
bm
bitmapAspect :: (Fractional a, BitmapClass bitmap) => bitmap t -> a
bitmapAspect :: bitmap t -> a
bitmapAspect bitmap t
bm = (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) where
(Int
x,Int
y) = bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize bitmap t
bm
prettyPrintBitmap :: (BitmapClass bitmap, PixelComponent t) => String -> bitmap t -> String
prettyPrintBitmap :: String -> bitmap t -> String
prettyPrintBitmap String
prefix bitmap t
bm = String
text where
text :: String
text = String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typ String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
xres String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
yres String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nchn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" channels>" where
(Int
xres,Int
yres) = bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize bitmap t
bm
typ :: String
typ = PixelComponentType -> String
prettyPrintPixelComponentType (bitmap t -> PixelComponentType
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
bitmap t -> PixelComponentType
bitmapComponentType bitmap t
bm)
nchn :: Int
nchn = bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels bitmap t
bm
instance PixelComponent t => Show (Bitmap t) where
show :: Bitmap t -> String
show = String -> Bitmap t -> String
forall (bitmap :: * -> *) t.
(BitmapClass bitmap, PixelComponent t) =>
String -> bitmap t -> String
prettyPrintBitmap String
"Bitmap"
withBitmap :: PixelComponent t => Bitmap t -> (Size -> NChn -> Padding -> Ptr t -> IO a) -> IO a
withBitmap :: Bitmap t -> (Size -> Int -> Int -> Ptr t -> IO a) -> IO a
withBitmap Bitmap t
bm Size -> Int -> Int -> Ptr t -> IO a
action =
ForeignPtr t -> (Ptr t -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Bitmap t -> ForeignPtr t
forall (bitmap :: * -> *) t.
BitmapClass bitmap =>
bitmap t -> ForeignPtr t
bitmapPtr Bitmap t
bm) ((Ptr t -> IO a) -> IO a) -> (Ptr t -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr t
p ->
Size -> Int -> Int -> Ptr t -> IO a
action (Bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize Bitmap t
bm) (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels Bitmap t
bm) (Bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowPadding Bitmap t
bm) Ptr t
p
bitmapFromForeignPtrUnsafe
:: PixelComponent t
=> Size -> NChn -> Alignment -> Padding -> ForeignPtr t -> Bitmap t
bitmapFromForeignPtrUnsafe :: Size -> Int -> Int -> Int -> ForeignPtr t -> Bitmap t
bitmapFromForeignPtrUnsafe Size
siz Int
nchn Int
align Int
pad ForeignPtr t
fptr = Bitmap :: forall t. Size -> Int -> ForeignPtr t -> Int -> Int -> Bitmap t
Bitmap
{ _bitmapSize :: Size
_bitmapSize = Size
siz
, _bitmapNChannels :: Int
_bitmapNChannels = Int
nchn
, _bitmapPtr :: ForeignPtr t
_bitmapPtr = ForeignPtr t
fptr
, _bitmapRowPadding :: Int
_bitmapRowPadding = Int
pad
, _bitmapRowAlignment :: Int
_bitmapRowAlignment = Int
align
}
{-# SPECIALIZE isValidAlignment :: Int -> Bool #-}
isValidAlignment :: Integral a => a -> Bool
isValidAlignment :: a -> Bool
isValidAlignment a
a = a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
a [a
1,a
2,a
4,a
8,a
16]
recommendedPadding :: (BitmapClass bitmap, PixelComponent t) => bitmap t -> Int
recommendedPadding :: bitmap t -> Int
recommendedPadding bitmap t
bm = Int
pad where
(Int
w,Int
_) = bitmap t -> Size
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Size
bitmapSize bitmap t
bm
n :: Int
n = bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapNChannels bitmap t
bm
b :: Int
b = bitmap t -> Int
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> Int
bitmapRowAlignment bitmap t
bm
s :: Int
s = t -> Int
forall a. Storable a => a -> Int
sizeOf (bitmap t -> t
forall (bitmap :: * -> *) t. BitmapClass bitmap => bitmap t -> t
bitmapUndefined bitmap t
bm)
a :: Int
a = if Int
bInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
s then Int
s else Int
b
k :: Int
k = case Int -> Int -> Size
forall a. Integral a => a -> a -> (a, a)
divMod Int
a Int
s of (Int
q,Int
r) -> if Int
rInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0 then Int
q else String -> Int
forall a. HasCallStack => String -> a
error String
"recommendedPadding: should not happen"
pad :: Int
pad = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* ( Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
w )