{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module RiskWeaver.Draw where

import Codec.Picture qualified as I
import Control.Monad
  ( forM_,
    when,
  )
import Data.Int
import Data.Vector.Storable qualified as V
import Foreign.ForeignPtr qualified as F
import Foreign.Ptr qualified as F
import GHC.ForeignPtr qualified as GF
import Language.C.Inline qualified as C
import System.IO.Unsafe
import Prelude hiding (max, min)
import Prelude qualified as P

C.include "<stdint.h>"

data PixelFormat
  = Y8
  | YF
  | YA8
  | RGB8
  | RGBF
  | RGBA8
  | YCbCr8
  | CMYK8
  | CMYK16
  | RGBA16
  | RGB16
  | Y16
  | YA16
  | Y32
  deriving (Int -> PixelFormat -> ShowS
[PixelFormat] -> ShowS
PixelFormat -> String
(Int -> PixelFormat -> ShowS)
-> (PixelFormat -> String)
-> ([PixelFormat] -> ShowS)
-> Show PixelFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PixelFormat -> ShowS
showsPrec :: Int -> PixelFormat -> ShowS
$cshow :: PixelFormat -> String
show :: PixelFormat -> String
$cshowList :: [PixelFormat] -> ShowS
showList :: [PixelFormat] -> ShowS
Show, PixelFormat -> PixelFormat -> Bool
(PixelFormat -> PixelFormat -> Bool)
-> (PixelFormat -> PixelFormat -> Bool) -> Eq PixelFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PixelFormat -> PixelFormat -> Bool
== :: PixelFormat -> PixelFormat -> Bool
$c/= :: PixelFormat -> PixelFormat -> Bool
/= :: PixelFormat -> PixelFormat -> Bool
Eq)

centerCrop :: Int -> Int -> I.Image I.PixelRGB8 -> I.Image I.PixelRGB8
centerCrop :: Int -> Int -> Image PixelRGB8 -> Image PixelRGB8
centerCrop Int
width Int
height Image PixelRGB8
input = IO (Image PixelRGB8) -> Image PixelRGB8
forall a. IO a -> a
unsafePerformIO (IO (Image PixelRGB8) -> Image PixelRGB8)
-> IO (Image PixelRGB8) -> Image PixelRGB8
forall a b. (a -> b) -> a -> b
$ do
  let channel :: Int
channel = Int
3 :: Int
      (I.Image Int
org_w Int
org_h Vector (PixelBaseComponent PixelRGB8)
org_vec) = Image PixelRGB8
input
      img :: Image PixelRGB8
img@(I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = (Int -> Int -> PixelRGB8) -> Int -> Int -> Image PixelRGB8
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
I.generateImage (\Int
_ Int
_ -> (Word8 -> Word8 -> Word8 -> PixelRGB8
I.PixelRGB8 Word8
0 Word8
0 Word8
0)) Int
width Int
height :: I.Image I.PixelRGB8
      (ForeignPtr Word8
org_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
org_vec
      (ForeignPtr Word8
fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
vec
  ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
org_fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr1 -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
    let src :: Ptr b
src = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr1
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr2
        iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        iorg_w :: CInt
iorg_w = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
org_w
        iorg_h :: CInt
iorg_h = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
org_h
        ichannel :: CInt
ichannel = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channel
    [C.block| void {
        uint8_t* src = $(uint8_t* src);
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int channel = $(int ichannel);
        int ow = $(int iorg_w);
        int oh = $(int iorg_h);
        int offsetx = (ow - w)/2;
        int offsety = (oh - h)/2;
        for(int y=0;y<h;y++){
          for(int x=0;x<w;x++){
            for(int c=0;c<channel;c++){
              int sy = y + offsety;
              int sx = x + offsetx;
              if(sx >= 0 && sx < ow &&
                 sy >= 0 && sy < oh){
                 dst[(y*w+x)*channel+c] = src[(sy*ow+sx)*channel+c];
              }
            }
          }
        }
    } |]
    Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
img

drawLine :: Int -> Int -> Int -> Int -> (Int, Int, Int) -> I.Image I.PixelRGB8 -> IO ()
drawLine :: Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawLine Int
x0 Int
y0 Int
x1 Int
y1 (Int
r, Int
g, Int
b) Image PixelRGB8
input = do
  let (I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = Image PixelRGB8
input
      (ForeignPtr Word8
fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
vec
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
    let iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        ix0 :: CInt
ix0 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x0
        iy0 :: CInt
iy0 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y0
        ix1 :: CInt
ix1 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x1
        iy1 :: CInt
iy1 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y1
        ir :: CInt
ir = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r
        ig :: CInt
ig = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g
        ib :: CInt
ib = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr2
    [C.block| void {
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int x0 = $(int ix0);
        int y0 = $(int iy0);
        int x1 = $(int ix1);
        int y1 = $(int iy1);
        int r = $(int ir);
        int g = $(int ig);
        int b = $(int ib);
        int channel = 3;
        int sign_x =  x1 - x0 >= 0 ? 1 : -1;
        int sign_y =  y1 - y0 >= 0 ? 1 : -1;
        int abs_x =  x1 - x0 >= 0 ? x1 - x0 : x0 - x1;
        int abs_y =  y1 - y0 >= 0 ? y1 - y0 : y0 - y1;
        if(abs_x>=abs_y){
          for(int x=x0;x!=x1;x+=sign_x){
            int y = (x-x0) * (y1-y0) / (x1-x0) + y0;
            if(y >=0 && y < h &&
               x >=0 && x < w) {
              dst[(y*w+x)*channel+0] = r;
              dst[(y*w+x)*channel+1] = g;
              dst[(y*w+x)*channel+2] = b;
            }
          }
        } else {
          for(int y=y0;y!=y1;y+=sign_y){
            int x = (y-y0) * (x1-x0) / (y1-y0) + x0;
            if(y >=0 && y < h &&
               x >=0 && x < w) {
              dst[(y*w+x)*channel+0] = r;
              dst[(y*w+x)*channel+1] = g;
              dst[(y*w+x)*channel+2] = b;
            }
          }
        }
    } |]

drawRect :: Int -> Int -> Int -> Int -> (Int, Int, Int) -> I.Image I.PixelRGB8 -> IO ()
drawRect :: Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawRect Int
x0 Int
y0 Int
x1 Int
y1 (Int
r, Int
g, Int
b) Image PixelRGB8
input = do
  Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawLine Int
x0 Int
y0 (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y0 (Int
r, Int
g, Int
b) Image PixelRGB8
input
  Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawLine Int
x0 Int
y0 Int
x0 (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
r, Int
g, Int
b) Image PixelRGB8
input
  Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawLine Int
x0 Int
y1 (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
y1 (Int
r, Int
g, Int
b) Image PixelRGB8
input
  Int
-> Int -> Int -> Int -> (Int, Int, Int) -> Image PixelRGB8 -> IO ()
drawLine Int
x1 Int
y0 Int
x1 (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
r, Int
g, Int
b) Image PixelRGB8
input

drawString :: String -> Int -> Int -> (Int, Int, Int) -> (Int, Int, Int) -> I.Image I.PixelRGB8 -> IO ()
drawString :: String
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawString String
text Int
x0 Int
y0 (Int
r, Int
g, Int
b) (Int
br, Int
bg, Int
bb) Image PixelRGB8
input = do
  [(Int, Char)] -> ((Int, Char) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] String
text) (((Int, Char) -> IO ()) -> IO ())
-> ((Int, Char) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, Char
ch) -> do
    Int
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawChar (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
ch) (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Int
y0 (Int
r, Int
g, Int
b) (Int
br, Int
bg, Int
bb) Image PixelRGB8
input

drawChar :: Int -> Int -> Int -> (Int, Int, Int) -> (Int, Int, Int) -> I.Image I.PixelRGB8 -> IO ()
drawChar :: Int
-> Int
-> Int
-> (Int, Int, Int)
-> (Int, Int, Int)
-> Image PixelRGB8
-> IO ()
drawChar Int
ascii_code Int
x0 Int
y0 (Int
r, Int
g, Int
b) (Int
br, Int
bg, Int
bb) Image PixelRGB8
input = do
  let (I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = Image PixelRGB8
input
      (ForeignPtr Word8
fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
vec
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
    let iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        ix0 :: CInt
ix0 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x0
        iy0 :: CInt
iy0 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y0
        ir :: CInt
ir = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r
        ig :: CInt
ig = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g
        ib :: CInt
ib = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b
        ibr :: CInt
ibr = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
br
        ibg :: CInt
ibg = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bg
        ibb :: CInt
ibb = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bb
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr2
        iascii_code :: CInt
iascii_code = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ascii_code
    [C.block| void {
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int x0 = $(int ix0);
        int y0 = $(int iy0);
        int r = $(int ir);
        int g = $(int ig);
        int b = $(int ib);
        int br = $(int ibr);
        int bg = $(int ibg);
        int bb = $(int ibb);
        int ascii_code = $(int iascii_code);
        int channel = 3;
        int char_width = 8;
        int char_height = 8;
        char fonts[95][8] = { // 0x20 to 0x7e
            { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00},
            { 0x18, 0x3C, 0x3C, 0x18, 0x18, 0x00, 0x18, 0x00},
            { 0x36, 0x36, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00},
            { 0x36, 0x36, 0x7F, 0x36, 0x7F, 0x36, 0x36, 0x00},
            { 0x0C, 0x3E, 0x03, 0x1E, 0x30, 0x1F, 0x0C, 0x00},
            { 0x00, 0x63, 0x33, 0x18, 0x0C, 0x66, 0x63, 0x00},
            { 0x1C, 0x36, 0x1C, 0x6E, 0x3B, 0x33, 0x6E, 0x00},
            { 0x06, 0x06, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00},
            { 0x18, 0x0C, 0x06, 0x06, 0x06, 0x0C, 0x18, 0x00},
            { 0x06, 0x0C, 0x18, 0x18, 0x18, 0x0C, 0x06, 0x00},
            { 0x00, 0x66, 0x3C, 0xFF, 0x3C, 0x66, 0x00, 0x00},
            { 0x00, 0x0C, 0x0C, 0x3F, 0x0C, 0x0C, 0x00, 0x00},
            { 0x00, 0x00, 0x00, 0x00, 0x00, 0x0C, 0x0C, 0x06},
            { 0x00, 0x00, 0x00, 0x3F, 0x00, 0x00, 0x00, 0x00},
            { 0x00, 0x00, 0x00, 0x00, 0x00, 0x0C, 0x0C, 0x00},
            { 0x60, 0x30, 0x18, 0x0C, 0x06, 0x03, 0x01, 0x00},
            { 0x3E, 0x63, 0x73, 0x7B, 0x6F, 0x67, 0x3E, 0x00},
            { 0x0C, 0x0E, 0x0C, 0x0C, 0x0C, 0x0C, 0x3F, 0x00},
            { 0x1E, 0x33, 0x30, 0x1C, 0x06, 0x33, 0x3F, 0x00},
            { 0x1E, 0x33, 0x30, 0x1C, 0x30, 0x33, 0x1E, 0x00},
            { 0x38, 0x3C, 0x36, 0x33, 0x7F, 0x30, 0x78, 0x00},
            { 0x3F, 0x03, 0x1F, 0x30, 0x30, 0x33, 0x1E, 0x00},
            { 0x1C, 0x06, 0x03, 0x1F, 0x33, 0x33, 0x1E, 0x00},
            { 0x3F, 0x33, 0x30, 0x18, 0x0C, 0x0C, 0x0C, 0x00},
            { 0x1E, 0x33, 0x33, 0x1E, 0x33, 0x33, 0x1E, 0x00},
            { 0x1E, 0x33, 0x33, 0x3E, 0x30, 0x18, 0x0E, 0x00},
            { 0x00, 0x0C, 0x0C, 0x00, 0x00, 0x0C, 0x0C, 0x00},
            { 0x00, 0x0C, 0x0C, 0x00, 0x00, 0x0C, 0x0C, 0x06},
            { 0x18, 0x0C, 0x06, 0x03, 0x06, 0x0C, 0x18, 0x00},
            { 0x00, 0x00, 0x3F, 0x00, 0x00, 0x3F, 0x00, 0x00},
            { 0x06, 0x0C, 0x18, 0x30, 0x18, 0x0C, 0x06, 0x00},
            { 0x1E, 0x33, 0x30, 0x18, 0x0C, 0x00, 0x0C, 0x00},
            { 0x3E, 0x63, 0x7B, 0x7B, 0x7B, 0x03, 0x1E, 0x00},
            { 0x0C, 0x1E, 0x33, 0x33, 0x3F, 0x33, 0x33, 0x00},
            { 0x3F, 0x66, 0x66, 0x3E, 0x66, 0x66, 0x3F, 0x00},
            { 0x3C, 0x66, 0x03, 0x03, 0x03, 0x66, 0x3C, 0x00},
            { 0x1F, 0x36, 0x66, 0x66, 0x66, 0x36, 0x1F, 0x00},
            { 0x7F, 0x46, 0x16, 0x1E, 0x16, 0x46, 0x7F, 0x00},
            { 0x7F, 0x46, 0x16, 0x1E, 0x16, 0x06, 0x0F, 0x00},
            { 0x3C, 0x66, 0x03, 0x03, 0x73, 0x66, 0x7C, 0x00},
            { 0x33, 0x33, 0x33, 0x3F, 0x33, 0x33, 0x33, 0x00},
            { 0x1E, 0x0C, 0x0C, 0x0C, 0x0C, 0x0C, 0x1E, 0x00},
            { 0x78, 0x30, 0x30, 0x30, 0x33, 0x33, 0x1E, 0x00},
            { 0x67, 0x66, 0x36, 0x1E, 0x36, 0x66, 0x67, 0x00},
            { 0x0F, 0x06, 0x06, 0x06, 0x46, 0x66, 0x7F, 0x00},
            { 0x63, 0x77, 0x7F, 0x7F, 0x6B, 0x63, 0x63, 0x00},
            { 0x63, 0x67, 0x6F, 0x7B, 0x73, 0x63, 0x63, 0x00},
            { 0x1C, 0x36, 0x63, 0x63, 0x63, 0x36, 0x1C, 0x00},
            { 0x3F, 0x66, 0x66, 0x3E, 0x06, 0x06, 0x0F, 0x00},
            { 0x1E, 0x33, 0x33, 0x33, 0x3B, 0x1E, 0x38, 0x00},
            { 0x3F, 0x66, 0x66, 0x3E, 0x36, 0x66, 0x67, 0x00},
            { 0x1E, 0x33, 0x07, 0x0E, 0x38, 0x33, 0x1E, 0x00},
            { 0x3F, 0x2D, 0x0C, 0x0C, 0x0C, 0x0C, 0x1E, 0x00},
            { 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x3F, 0x00},
            { 0x33, 0x33, 0x33, 0x33, 0x33, 0x1E, 0x0C, 0x00},
            { 0x63, 0x63, 0x63, 0x6B, 0x7F, 0x77, 0x63, 0x00},
            { 0x63, 0x63, 0x36, 0x1C, 0x1C, 0x36, 0x63, 0x00},
            { 0x33, 0x33, 0x33, 0x1E, 0x0C, 0x0C, 0x1E, 0x00},
            { 0x7F, 0x63, 0x31, 0x18, 0x4C, 0x66, 0x7F, 0x00},
            { 0x1E, 0x06, 0x06, 0x06, 0x06, 0x06, 0x1E, 0x00},
            { 0x03, 0x06, 0x0C, 0x18, 0x30, 0x60, 0x40, 0x00},
            { 0x1E, 0x18, 0x18, 0x18, 0x18, 0x18, 0x1E, 0x00},
            { 0x08, 0x1C, 0x36, 0x63, 0x00, 0x00, 0x00, 0x00},
            { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xFF},
            { 0x0C, 0x0C, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00},
            { 0x00, 0x00, 0x1E, 0x30, 0x3E, 0x33, 0x6E, 0x00},
            { 0x07, 0x06, 0x06, 0x3E, 0x66, 0x66, 0x3B, 0x00},
            { 0x00, 0x00, 0x1E, 0x33, 0x03, 0x33, 0x1E, 0x00},
            { 0x38, 0x30, 0x30, 0x3e, 0x33, 0x33, 0x6E, 0x00},
            { 0x00, 0x00, 0x1E, 0x33, 0x3f, 0x03, 0x1E, 0x00},
            { 0x1C, 0x36, 0x06, 0x0f, 0x06, 0x06, 0x0F, 0x00},
            { 0x00, 0x00, 0x6E, 0x33, 0x33, 0x3E, 0x30, 0x1F},
            { 0x07, 0x06, 0x36, 0x6E, 0x66, 0x66, 0x67, 0x00},
            { 0x0C, 0x00, 0x0E, 0x0C, 0x0C, 0x0C, 0x1E, 0x00},
            { 0x30, 0x00, 0x30, 0x30, 0x30, 0x33, 0x33, 0x1E},
            { 0x07, 0x06, 0x66, 0x36, 0x1E, 0x36, 0x67, 0x00},
            { 0x0E, 0x0C, 0x0C, 0x0C, 0x0C, 0x0C, 0x1E, 0x00},
            { 0x00, 0x00, 0x33, 0x7F, 0x7F, 0x6B, 0x63, 0x00},
            { 0x00, 0x00, 0x1F, 0x33, 0x33, 0x33, 0x33, 0x00},
            { 0x00, 0x00, 0x1E, 0x33, 0x33, 0x33, 0x1E, 0x00},
            { 0x00, 0x00, 0x3B, 0x66, 0x66, 0x3E, 0x06, 0x0F},
            { 0x00, 0x00, 0x6E, 0x33, 0x33, 0x3E, 0x30, 0x78},
            { 0x00, 0x00, 0x3B, 0x6E, 0x66, 0x06, 0x0F, 0x00},
            { 0x00, 0x00, 0x3E, 0x03, 0x1E, 0x30, 0x1F, 0x00},
            { 0x08, 0x0C, 0x3E, 0x0C, 0x0C, 0x2C, 0x18, 0x00},
            { 0x00, 0x00, 0x33, 0x33, 0x33, 0x33, 0x6E, 0x00},
            { 0x00, 0x00, 0x33, 0x33, 0x33, 0x1E, 0x0C, 0x00},
            { 0x00, 0x00, 0x63, 0x6B, 0x7F, 0x7F, 0x36, 0x00},
            { 0x00, 0x00, 0x63, 0x36, 0x1C, 0x36, 0x63, 0x00},
            { 0x00, 0x00, 0x33, 0x33, 0x33, 0x3E, 0x30, 0x1F},
            { 0x00, 0x00, 0x3F, 0x19, 0x0C, 0x26, 0x3F, 0x00},
            { 0x38, 0x0C, 0x0C, 0x07, 0x0C, 0x0C, 0x38, 0x00},
            { 0x18, 0x18, 0x18, 0x00, 0x18, 0x18, 0x18, 0x00},
            { 0x07, 0x0C, 0x0C, 0x38, 0x0C, 0x0C, 0x07, 0x00},
            { 0x6E, 0x3B, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00} 
          };
        for(int y=y0;y<y0+char_height;y++){
          for(int x=x0;x<x0+char_width;x++){
            if(y >=0 && y < h &&
               x >=0 && x < w) {
              int dx = x-x0;
              int dy = y-y0;
              int bit = 
                ascii_code > 0x20 && ascii_code < 0x7f ?
                fonts[ascii_code-0x20][dy] & (0x1 << dx) :
                0;
              if (bit) {
                dst[(y*w+x)*channel+0] = r;
                dst[(y*w+x)*channel+1] = g;
                dst[(y*w+x)*channel+2] = b;
              } else {
                dst[(y*w+x)*channel+0] = br;
                dst[(y*w+x)*channel+1] = bg;
                dst[(y*w+x)*channel+2] = bb;
              }
            }
          }
        }
    } |]

resizeRGB8 :: Int -> Int -> Bool -> I.Image I.PixelRGB8 -> I.Image I.PixelRGB8
resizeRGB8 :: Int -> Int -> Bool -> Image PixelRGB8 -> Image PixelRGB8
resizeRGB8 Int
width Int
height Bool
keepAspectRatio Image PixelRGB8
input = IO (Image PixelRGB8) -> Image PixelRGB8
forall a. IO a -> a
unsafePerformIO (IO (Image PixelRGB8) -> Image PixelRGB8)
-> IO (Image PixelRGB8) -> Image PixelRGB8
forall a b. (a -> b) -> a -> b
$ do
  let channel :: Int
channel = Int
3 :: Int
      (I.Image Int
org_w Int
org_h Vector (PixelBaseComponent PixelRGB8)
org_vec) = Image PixelRGB8
input
      img :: Image PixelRGB8
img@(I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = (Int -> Int -> PixelRGB8) -> Int -> Int -> Image PixelRGB8
forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
I.generateImage (\Int
_ Int
_ -> (Word8 -> Word8 -> Word8 -> PixelRGB8
I.PixelRGB8 Word8
0 Word8
0 Word8
0)) Int
width Int
height :: I.Image I.PixelRGB8
      (ForeignPtr Word8
org_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
org_vec
      (ForeignPtr Word8
fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
vec
  ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
org_fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr1 -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
    let src :: Ptr b
src = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr1
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr2
        iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        iorg_w :: CInt
iorg_w = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
org_w
        iorg_h :: CInt
iorg_h = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
org_h
        ichannel :: CInt
ichannel = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channel
        ckeepAspectRatio :: CInt
ckeepAspectRatio = if Bool
keepAspectRatio then CInt
1 else CInt
0
    [C.block| void {
        uint8_t* src = $(uint8_t* src);
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int channel = $(int ichannel);
        int ow = $(int iorg_w);
        int oh = $(int iorg_h);
        int keepAspectRatio = $(int ckeepAspectRatio);
        if(keepAspectRatio){
          int t0h = h;
          int t0w = ow * h / oh;
          int t1h = oh * w / ow;
          int t1w = w;
          if (t0w > w) {
            int offset = (h - (oh * w / ow))/2;
            for(int y=offset;y<h-offset;y++){
              for(int x=0;x<w;x++){
                for(int c=0;c<channel;c++){
                  int sy = (y-offset) * ow / w;
                  int sx = x * ow / w;
                  if(sy >= 0 && sy < oh){
                    dst[(y*w+x)*channel+c] = src[(sy*ow+sx)*channel+c];
                  }
                }
              }
            }
          } else {
            int offset = (w - (ow * h / oh))/2;
            for(int y=0;y<h;y++){
              for(int x=offset;x<w-offset;x++){
                for(int c=0;c<channel;c++){
                  int sy = y * oh / h;
                  int sx = (x-offset) * oh / h;
                  if(sx >= 0 && sx < ow){
                    dst[(y*w+x)*channel+c] = src[(sy*ow+sx)*channel+c];
                  }
                }
              }
            }
          }
        } else {
          for(int y=0;y<h;y++){
            for(int x=0;x<w;x++){
              for(int c=0;c<channel;c++){
                int sy = y * oh / h;
                int sx = x * ow / w;
                dst[(y*w+x)*channel+c] = src[(sy*ow+sx)*channel+c];
              }
            }
          }
        }
    } |]
    Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
img

pixelFormat :: I.DynamicImage -> PixelFormat
pixelFormat :: DynamicImage -> PixelFormat
pixelFormat DynamicImage
image = case DynamicImage
image of
  I.ImageY8 Image Word8
_ -> PixelFormat
Y8
  I.ImageYF Image PixelF
_ -> PixelFormat
YF
  I.ImageYA8 Image PixelYA8
_ -> PixelFormat
YA8
  I.ImageRGB8 Image PixelRGB8
_ -> PixelFormat
RGB8
  I.ImageRGBF Image PixelRGBF
_ -> PixelFormat
RGBF
  I.ImageRGBA8 Image PixelRGBA8
_ -> PixelFormat
RGBA8
  I.ImageYCbCr8 Image PixelYCbCr8
_ -> PixelFormat
YCbCr8
  I.ImageCMYK8 Image PixelCMYK8
_ -> PixelFormat
CMYK8
  I.ImageCMYK16 Image PixelCMYK16
_ -> PixelFormat
CMYK16
  I.ImageRGBA16 Image PixelRGBA16
_ -> PixelFormat
RGBA16
  I.ImageRGB16 Image PixelRGB16
_ -> PixelFormat
RGB16
  I.ImageY16 Image Pixel16
_ -> PixelFormat
Y16
  I.ImageYA16 Image PixelYA16
_ -> PixelFormat
YA16
  I.ImageY32 Image Pixel32
_ -> PixelFormat
Y32

-- allocates memory for a new image
createImage :: Int -> Int -> IO (I.Image I.PixelRGB8)
createImage :: Int -> Int -> IO (Image PixelRGB8)
createImage Int
w Int
h = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String
"trying to createImage of negative dim: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String
"trying to createImage of negative dim: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h)
  ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
GF.mallocPlainForeignPtrBytes Int
size
  Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Image PixelRGB8 -> IO (Image PixelRGB8))
-> Image PixelRGB8 -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> Vector (PixelBaseComponent PixelRGB8) -> Image PixelRGB8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
I.Image Int
w Int
h (ForeignPtr Word8 -> Int -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
V.unsafeFromForeignPtr ForeignPtr Word8
fp Int
0 Int
size)
  where
    size :: Int
size = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3

cloneImage :: I.Image I.PixelRGB8 -> IO (I.Image I.PixelRGB8)
cloneImage :: Image PixelRGB8 -> IO (Image PixelRGB8)
cloneImage Image PixelRGB8
input = do
  let (I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = Image PixelRGB8
input
      (ForeignPtr Word8
org_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
vec
  Image PixelRGB8
newImage <- Int -> Int -> IO (Image PixelRGB8)
createImage Int
w Int
h
  let (I.Image Int
_ Int
_ Vector (PixelBaseComponent PixelRGB8)
dst_vec) = Image PixelRGB8
newImage
      (ForeignPtr Word8
dst_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
dst_vec
  ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
org_fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr1 -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
dst_fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
    let src :: Ptr b
src = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr1
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr2
        iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        ichannel :: CInt
ichannel = CInt
3
    [C.block| void {
        uint8_t* src = $(uint8_t* src);
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int channel = $(int ichannel);
        for(int y=0;y<h;y++){
          for(int x=0;x<w;x++){
            for(int c=0;c<channel;c++){
              dst[(y*w+x)*channel+c] = src[(y*w+x)*channel+c];
            }
          }
        }
    } |]
    Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
newImage

pasteImage :: I.Image I.PixelRGB8 -> Int -> Int -> I.Image I.PixelRGB8 -> IO ()
pasteImage :: Image PixelRGB8 -> Int -> Int -> Image PixelRGB8 -> IO ()
pasteImage Image PixelRGB8
input Int
offsetx Int
offsety Image PixelRGB8
destination = do
  let (I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
vec) = Image PixelRGB8
input
      (ForeignPtr Word8
org_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
vec
      (I.Image Int
dst_w Int
dst_h Vector (PixelBaseComponent PixelRGB8)
dst_vec) = Image PixelRGB8
destination
      (ForeignPtr Word8
dst_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
dst_vec
  ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
org_fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr1 -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
dst_fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
    let src :: Ptr b
src = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr1
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
ptr2
        iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        iorg_w :: CInt
iorg_w = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dst_w
        iorg_h :: CInt
iorg_h = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dst_h
        ichannel :: CInt
ichannel = CInt
3
        ioffsetx :: CInt
ioffsetx = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsetx
        ioffsety :: CInt
ioffsety = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offsety
    [C.block| void {
        uint8_t* src = $(uint8_t* src);
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int ow = $(int iorg_w);
        int oh = $(int iorg_h);
        int channel = $(int ichannel);
        int offsetx = $(int ioffsetx);
        int offsety = $(int ioffsety);
        for(int y=0;y<h;y++){
          for(int x=0;x<w;x++){
            for(int c=0;c<channel;c++){
              int sy = y + offsety;
              int sx = x + offsetx;
              if(sx >= 0 && sx < ow &&
                 sy >= 0 && sy < oh){
                 dst[(sy*ow+sx)*channel+c] = src[(y*w+x)*channel+c];
              }
            }
          }
        }
    } |]

concatImagesH :: [I.Image I.PixelRGB8] -> IO (I.Image I.PixelRGB8)
concatImagesH :: [Image PixelRGB8] -> IO (Image PixelRGB8)
concatImagesH [] = String -> IO (Image PixelRGB8)
forall a. HasCallStack => String -> a
error String
"concatImagesH: empty list"
concatImagesH (Image PixelRGB8
x : []) = Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
x
concatImagesH (Image PixelRGB8
x : Image PixelRGB8
y : [Image PixelRGB8]
xs) = do
  Image PixelRGB8
newImage <- Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByHorizontal Image PixelRGB8
x Image PixelRGB8
y
  [Image PixelRGB8] -> IO (Image PixelRGB8)
concatImagesH (Image PixelRGB8
newImage Image PixelRGB8 -> [Image PixelRGB8] -> [Image PixelRGB8]
forall a. a -> [a] -> [a]
: [Image PixelRGB8]
xs)

concatImagesV :: [I.Image I.PixelRGB8] -> IO (I.Image I.PixelRGB8)
concatImagesV :: [Image PixelRGB8] -> IO (Image PixelRGB8)
concatImagesV [] = String -> IO (Image PixelRGB8)
forall a. HasCallStack => String -> a
error String
"concatImagesH: empty list"
concatImagesV (Image PixelRGB8
x : []) = Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
x
concatImagesV (Image PixelRGB8
x : Image PixelRGB8
y : [Image PixelRGB8]
xs) = do
  Image PixelRGB8
newImage <- Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByVertical Image PixelRGB8
x Image PixelRGB8
y
  [Image PixelRGB8] -> IO (Image PixelRGB8)
concatImagesH (Image PixelRGB8
newImage Image PixelRGB8 -> [Image PixelRGB8] -> [Image PixelRGB8]
forall a. a -> [a] -> [a]
: [Image PixelRGB8]
xs)

concatImageByHorizontal :: I.Image I.PixelRGB8 -> I.Image I.PixelRGB8 -> IO (I.Image I.PixelRGB8)
concatImageByHorizontal :: Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByHorizontal Image PixelRGB8
left Image PixelRGB8
right = do
  let (I.Image Int
lw Int
lh Vector (PixelBaseComponent PixelRGB8)
lvec) = Image PixelRGB8
left
      (ForeignPtr Word8
lfptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
lvec
      (I.Image Int
rw Int
rh Vector (PixelBaseComponent PixelRGB8)
rvec) = Image PixelRGB8
right
      (ForeignPtr Word8
rfptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
rvec
  Image PixelRGB8
newImage <- Int -> Int -> IO (Image PixelRGB8)
createImage (Int
lw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rw) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
P.max Int
lh Int
rh)
  let (I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
dst_vec) = Image PixelRGB8
newImage
      (ForeignPtr Word8
dst_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
dst_vec
  ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
lfptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
lptr -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
rfptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
rptr -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
dst_fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr -> do
    let lsrc :: Ptr b
lsrc = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
lptr
        rsrc :: Ptr b
rsrc = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
rptr
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
dptr
        iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        ilw :: CInt
ilw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lw
        ilh :: CInt
ilh = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lh
        irw :: CInt
irw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rw
        irh :: CInt
irh = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rh
        ichannel :: CInt
ichannel = CInt
3
    [C.block| void {
        uint8_t* lsrc = $(uint8_t* lsrc);
        uint8_t* rsrc = $(uint8_t* rsrc);
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int lw = $(int ilw);
        int lh = $(int ilh);
        int rw = $(int irw);
        int rh = $(int irh);
        int channel = $(int ichannel);
        for(int y=0;y<h;y++){
          for(int x=0;x<w;x++){
            for(int c=0;c<channel;c++){
              if(x < lw){
                dst[(y*w+x)*channel+c] = lsrc[(y*lw+x)*channel+c];
              } else {
                dst[(y*w+x)*channel+c] = rsrc[(y*rw+(x-lw))*channel+c];
              }
            }
          }
        }
    } |]
    Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
newImage

concatImageByVertical :: I.Image I.PixelRGB8 -> I.Image I.PixelRGB8 -> IO (I.Image I.PixelRGB8)
concatImageByVertical :: Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByVertical Image PixelRGB8
top Image PixelRGB8
bottom = do
  let (I.Image Int
tw Int
th Vector (PixelBaseComponent PixelRGB8)
tvec) = Image PixelRGB8
top
      (ForeignPtr Word8
tfptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
tvec
      (I.Image Int
bw Int
bh Vector (PixelBaseComponent PixelRGB8)
bvec) = Image PixelRGB8
bottom
      (ForeignPtr Word8
bfptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
bvec
  Image PixelRGB8
newImage <- Int -> Int -> IO (Image PixelRGB8)
createImage (Int -> Int -> Int
forall a. Ord a => a -> a -> a
P.max Int
tw Int
bw) (Int
th Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bh)
  let (I.Image Int
w Int
h Vector (PixelBaseComponent PixelRGB8)
dst_vec) = Image PixelRGB8
newImage
      (ForeignPtr Word8
dst_fptr, Int
_) = Vector Word8 -> (ForeignPtr Word8, Int)
forall a. Vector a -> (ForeignPtr a, Int)
V.unsafeToForeignPtr0 Vector Word8
dst_vec
  ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
tfptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
tptr -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
bfptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
bptr -> ForeignPtr Word8
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
F.withForeignPtr ForeignPtr Word8
dst_fptr ((Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8))
-> (Ptr Word8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dptr -> do
    let tsrc :: Ptr b
tsrc = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
tptr
        bsrc :: Ptr b
bsrc = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
bptr
        dst :: Ptr b
dst = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr Ptr Word8
dptr
        iw :: CInt
iw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w
        ih :: CInt
ih = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h
        itw :: CInt
itw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tw
        ith :: CInt
ith = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
th
        ibw :: CInt
ibw = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bw
        ibh :: CInt
ibh = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bh
        ichannel :: CInt
ichannel = CInt
3
    [C.block| void {
        uint8_t* tsrc = $(uint8_t* tsrc);
        uint8_t* bsrc = $(uint8_t* bsrc);
        uint8_t* dst = $(uint8_t* dst);
        int w = $(int iw);
        int h = $(int ih);
        int tw = $(int itw);
        int th = $(int ith);
        int bw = $(int ibw);
        int bh = $(int ibh);
        int channel = $(int ichannel);
        for(int y=0;y<h;y++){
          for(int x=0;x<w;x++){
            for(int c=0;c<channel;c++){
              if(y < th){
                dst[(y*w+x)*channel+c] = tsrc[(y*tw+x)*channel+c];
              } else {
                dst[(y*w+x)*channel+c] = bsrc[((y-th)*bw+x)*channel+c];
              }
            }
          }
        }
    } |]
    Image PixelRGB8 -> IO (Image PixelRGB8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Image PixelRGB8
newImage

concatImages2x2 :: I.Image I.PixelRGB8 -> I.Image I.PixelRGB8 -> I.Image I.PixelRGB8 -> I.Image I.PixelRGB8 -> IO (I.Image I.PixelRGB8)
concatImages2x2 :: Image PixelRGB8
-> Image PixelRGB8
-> Image PixelRGB8
-> Image PixelRGB8
-> IO (Image PixelRGB8)
concatImages2x2 Image PixelRGB8
topLeft Image PixelRGB8
topRight Image PixelRGB8
bottomLeft Image PixelRGB8
bottomRight = do
  Image PixelRGB8
top <- Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByHorizontal Image PixelRGB8
topLeft Image PixelRGB8
topRight
  Image PixelRGB8
bottom <- Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByHorizontal Image PixelRGB8
bottomLeft Image PixelRGB8
bottomRight
  Image PixelRGB8 -> Image PixelRGB8 -> IO (Image PixelRGB8)
concatImageByVertical Image PixelRGB8
top Image PixelRGB8
bottom