{-# LANGUAGE OverloadedLists #-} module MXNet.NN.Utils.Render where import Codec.Picture.Types import Data.Array.Repa ((:.) (..), Array, DIM3, U, Z (..), extent, toUnboxed) import qualified Graphics.Rasterific as G import qualified Graphics.Rasterific.Texture as G (uniformTexture) import Graphics.Text.TrueType (Font) import RIO import qualified RIO.Text as T import qualified RIO.Vector.Storable as V import MXNet.Base render :: (G.RenderablePixel px, ColorConvertible Pixel8 px) => Int -> Int -> G.Drawing px () -> Image px render width height = G.renderDrawing width height (promotePixel (0 :: Pixel8)) drawImage :: Image px -> G.Drawing px () drawImage img = G.drawImage img 0 (G.V2 0 0) drawBox :: px -> Float -> Float -> Float -> Float -> Float -> Maybe (Text, Font, Float, px) -> G.Drawing px () drawBox color stroke_width x0 y0 x1 y1 label = do G.withTexture (G.uniformTexture color) $ G.stroke stroke_width G.JoinRound (G.CapRound, G.CapRound) $ G.rectangle (G.V2 x0 y0) (x1 - x0) (y1 - y0) case label of Nothing -> return () Just (text, font, size, text_color) -> G.withTexture (G.uniformTexture text_color) $ let text_str = T.unpack text in G.printTextAt font (G.PointSize size) (G.V2 (x0+2) (y0+size+2)) text_str data NotConvertible = NotConvertible (NonEmpty Int) deriving Show instance Exception NotConvertible imageFromNDArray :: (ColorConvertible PixelRGB8 px, HasCallStack) => NDArray Float -> IO (Image px) imageFromNDArray array = do shape <- ndshape array case shape of [height, width, 3] -> do vec <- toVector array let img = Image width height (V.map floor vec) :: Image PixelRGB8 return $ promoteImage img _ -> throwM $ NotConvertible shape imageFromRepa :: (ColorConvertible PixelRGB8 px, HasCallStack) => Array U DIM3 Float -> Image px imageFromRepa array | c == 3 = promoted | otherwise = impureThrow (NotConvertible shape) where Z :. h :. w :. c = extent array shape = [h, w, c] vec = V.convert $ toUnboxed array image = Image w h (V.map floor vec) :: Image PixelRGB8 promoted = promoteImage image