{-# 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.Exception.Safe ( SomeException (..), throwIO, try, ) import Control.Monad ( MonadPlus, forM_, when, ) import Data.ByteString qualified as BS import Data.ByteString.Internal qualified as BSI import Data.Int import Data.Vector.Storable qualified as V import Data.Word import Foreign.ForeignPtr qualified as F import Foreign.Ptr qualified as F import GHC.Exts (IsList (fromList)) 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 _ -> (Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8 I.PixelRGB8 Pixel8 0 Pixel8 0 Pixel8 0)) Int width Int height :: I.Image I.PixelRGB8 (ForeignPtr Pixel8 org_fptr, Int org_len) = Vector Pixel8 -> (ForeignPtr Pixel8, Int) forall a. Vector a -> (ForeignPtr a, Int) V.unsafeToForeignPtr0 Vector Pixel8 org_vec org_whc :: Integer org_whc = Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Integer) -> Int -> Integer forall a b. (a -> b) -> a -> b $ Int org_w Int -> Int -> Int forall a. Num a => a -> a -> a * Int org_h Int -> Int -> Int forall a. Num a => a -> a -> a * Int channel (ForeignPtr Pixel8 fptr, Int len) = Vector Pixel8 -> (ForeignPtr Pixel8, Int) forall a. Vector a -> (ForeignPtr a, Int) V.unsafeToForeignPtr0 Vector Pixel8 vec whc :: Integer whc = Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Integer) -> Int -> Integer forall a b. (a -> b) -> a -> b $ 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 channel ForeignPtr Pixel8 -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b F.withForeignPtr ForeignPtr Pixel8 org_fptr ((Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)) -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. (a -> b) -> a -> b $ \Ptr Pixel8 ptr1 -> ForeignPtr Pixel8 -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b F.withForeignPtr ForeignPtr Pixel8 fptr ((Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)) -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. (a -> b) -> a -> b $ \Ptr Pixel8 ptr2 -> do let src :: Ptr b src = Ptr Pixel8 -> Ptr b forall a b. Ptr a -> Ptr b F.castPtr Ptr Pixel8 ptr1 dst :: Ptr b dst = Ptr Pixel8 -> Ptr b forall a b. Ptr a -> Ptr b F.castPtr Ptr Pixel8 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 img :: Image PixelRGB8 img@(I.Image Int w Int h Vector (PixelBaseComponent PixelRGB8) vec) = Image PixelRGB8 input (ForeignPtr Pixel8 fptr, Int len) = Vector Pixel8 -> (ForeignPtr Pixel8, Int) forall a. Vector a -> (ForeignPtr a, Int) V.unsafeToForeignPtr0 Vector Pixel8 vec ForeignPtr Pixel8 -> (Ptr Pixel8 -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b F.withForeignPtr ForeignPtr Pixel8 fptr ((Ptr Pixel8 -> IO ()) -> IO ()) -> (Ptr Pixel8 -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Ptr Pixel8 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 Pixel8 -> Ptr b forall a b. Ptr a -> Ptr b F.castPtr Ptr Pixel8 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 img :: Image PixelRGB8 img@(I.Image Int w Int h Vector (PixelBaseComponent PixelRGB8) vec) = Image PixelRGB8 input (ForeignPtr Pixel8 fptr, Int len) = Vector Pixel8 -> (ForeignPtr Pixel8, Int) forall a. Vector a -> (ForeignPtr a, Int) V.unsafeToForeignPtr0 Vector Pixel8 vec ForeignPtr Pixel8 -> (Ptr Pixel8 -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b F.withForeignPtr ForeignPtr Pixel8 fptr ((Ptr Pixel8 -> IO ()) -> IO ()) -> (Ptr Pixel8 -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Ptr Pixel8 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 Pixel8 -> Ptr b forall a b. Ptr a -> Ptr b F.castPtr Ptr Pixel8 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 _ -> (Pixel8 -> Pixel8 -> Pixel8 -> PixelRGB8 I.PixelRGB8 Pixel8 0 Pixel8 0 Pixel8 0)) Int width Int height :: I.Image I.PixelRGB8 (ForeignPtr Pixel8 org_fptr, Int org_len) = Vector Pixel8 -> (ForeignPtr Pixel8, Int) forall a. Vector a -> (ForeignPtr a, Int) V.unsafeToForeignPtr0 Vector Pixel8 org_vec org_whc :: Integer org_whc = Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Integer) -> Int -> Integer forall a b. (a -> b) -> a -> b $ Int org_w Int -> Int -> Int forall a. Num a => a -> a -> a * Int org_h Int -> Int -> Int forall a. Num a => a -> a -> a * Int channel (ForeignPtr Pixel8 fptr, Int len) = Vector Pixel8 -> (ForeignPtr Pixel8, Int) forall a. Vector a -> (ForeignPtr a, Int) V.unsafeToForeignPtr0 Vector Pixel8 vec whc :: Integer whc = Int -> Integer forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Integer) -> Int -> Integer forall a b. (a -> b) -> a -> b $ 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 channel ForeignPtr Pixel8 -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b F.withForeignPtr ForeignPtr Pixel8 org_fptr ((Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)) -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. (a -> b) -> a -> b $ \Ptr Pixel8 ptr1 -> ForeignPtr Pixel8 -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b F.withForeignPtr ForeignPtr Pixel8 fptr ((Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8)) -> (Ptr Pixel8 -> IO (Image PixelRGB8)) -> IO (Image PixelRGB8) forall a b. (a -> b) -> a -> b $ \Ptr Pixel8 ptr2 -> do let src :: Ptr b src = Ptr Pixel8 -> Ptr b forall a b. Ptr a -> Ptr b F.castPtr Ptr Pixel8 ptr1 dst :: Ptr b dst = Ptr Pixel8 -> Ptr b forall a b. Ptr a -> Ptr b F.castPtr Ptr Pixel8 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 Pixel8 _ -> 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