content: {-# language TemplateHaskell #-}
  {-# language OverloadedStrings #-}
  {-# language FlexibleContexts #-}
  {-# language CPP #-}
  
  module Main where
  
  import "base" Data.Functor ( void )
  import "base" Data.Foldable ( for_ )
  import "base" Data.Int
  import "base" Data.Monoid ( (<>) )
  import "base" Data.Proxy
  import "base" Data.Traversable
  import "base" Data.Word
  import "base" Foreign.C.Types ( CFloat, CDouble )
  import "base" GHC.TypeLits
  import "base" System.IO.Unsafe ( unsafePerformIO )
  import "data-default" Data.Default
  import qualified "bytestring" Data.ByteString as B
  import qualified "JuicyPixels" Codec.Picture
  import qualified "linear" Linear.Metric as Linear ( norm )
  import "linear" Linear ( M33 )
  import "linear" Linear.Vector ( (^+^), (^-^) )
  import "linear" Linear.V2 ( V2(..) )
  import "linear" Linear.V3 ( V3(..) )
  import "linear" Linear.V4 ( V4(..) )
  import "opencv" OpenCV
  import qualified "opencv" OpenCV.Juicy
  import "opencv" OpenCV.Unsafe
  #ifdef HAVE_OPENCV_EXTRA
  import "opencv-extra" OpenCV.Extra
  #endif
  import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState )
  import qualified "text" Data.Text as T
  import qualified "vector" Data.Vector as V
  import qualified "vector" Data.Vector.Storable as VS
  import "transformers" Control.Monad.Trans.Class ( lift )
  
  import "this" ExampleExtractor
  
  --------------------------------------------------------------------------------
  
  transparent, white, black, blue, green, red :: Scalar
  transparent = toScalar (V4 255 255 255   0 :: V4 Double)
  white       = toScalar (V4 255 255 255 255 :: V4 Double)
  black       = toScalar (V4   0   0   0 255 :: V4 Double)
  blue        = toScalar (V4 255   0   0 255 :: V4 Double)
  green       = toScalar (V4   0 255   0 255 :: V4 Double)
  red         = toScalar (V4   0   0 255 255 :: V4 Double)
  
  type Kodak_768x512    = Mat (ShapeT [ 512,  768]) ('S 3) ('S Word8)
  type Kodak_512x341    = Mat (ShapeT [ 341,  512]) ('S 3) ('S Word8)
  type Frog             = Mat (ShapeT [ 390,  500]) ('S 3) ('S Word8)
  type Lambda           = Mat (ShapeT [ 256,  256]) ('S 1) ('S Word8)
  type Circles_1000x625 = Mat (ShapeT [ 625, 1000]) ('S 3) ('S Word8)
  type Building_868x600 = Mat (ShapeT [ 600,  868]) ('S 3) ('S Word8)
  type DamageMask       = Mat (ShapeT [ 341,  512]) ('S 1) ('S Word8)
  type Lenna_512x512    = Mat (ShapeT [ 512,  512]) ('S 3) ('S Word8)
  type Arnold           = Mat (ShapeT [3504, 2336]) ('S 3) ('S Word8)
  type Arnold_small     = Mat (ShapeT [ 900,  600]) ('S 3) ('S Word8)
  type Hand             = Mat (ShapeT [ 543,  400]) ('S 3) ('S Word8)
  type Compass          = Mat (ShapeT [ 497,  500]) ('S 3) ('S Word8)
  type CodexLeicester   = Mat (ShapeT [ 416,  500]) ('S 3) ('S Word8)
  
  birds_768x512 :: Kodak_768x512
  birds_768x512 = exceptError $ coerceMat $ unsafePerformIO $
                    imdecode ImreadUnchanged <$> B.readFile "data/kodim23.png"
  
  flower_768x512 :: Kodak_768x512
  flower_768x512 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/kodim07.png"
  
  sailboat_768x512 :: Kodak_768x512
  sailboat_768x512 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/kodim06.png"
  
  bikes_768x512 :: Kodak_768x512
  bikes_768x512 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/kodim05.png"
  
  barn_768x512 :: Kodak_768x512
  barn_768x512 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/kodim22.png"
  
  damageMask :: DamageMask
  damageMask =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/damage_mask.png"
  
  smallerKodakImg :: Kodak_768x512 -> Kodak_512x341
  smallerKodakImg img =
      exceptError $ coerceMat =<<
        resize (ResizeAbs $ toSize (V2 512 341 :: V2 Int32))
               InterArea
               img
  
  birds_512x341 :: Kodak_512x341
  birds_512x341 = smallerKodakImg birds_768x512
  
  flower_512x341 :: Kodak_512x341
  flower_512x341 = smallerKodakImg flower_768x512
  
  sailboat_512x341 :: Kodak_512x341
  sailboat_512x341 = smallerKodakImg sailboat_768x512
  
  barn_512x341 :: Kodak_512x341
  barn_512x341 = smallerKodakImg barn_768x512
  
  bikes_512x341 :: Kodak_512x341
  bikes_512x341 = smallerKodakImg bikes_768x512
  
  frog :: Frog
  frog =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/kikker.jpg"
  
  lambda :: Lambda
  lambda =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadGrayscale <$> B.readFile "data/lambda.png"
  
  circles_1000x625 :: Circles_1000x625
  circles_1000x625 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/circles.png"
  
  building_868x600 :: Building_868x600
  building_868x600 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/building.jpg"
  
  lenna_512x512 :: Lenna_512x512
  lenna_512x512 =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/Lenna.png"
  
  arnold :: Arnold
  arnold =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/arnold-schwarzenegger.jpg"
  
  arnold_small :: Arnold_small
  arnold_small =
      exceptError $ coerceMat =<<
        resize (ResizeAbs $ toSize (V2 600 900 :: V2 Int32))
               InterArea
               arnold
  
  hand :: Hand
  hand =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/hand.jpg"
  
  compass :: Compass
  compass =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/compass.jpg"
  
  codexLeicester :: CodexLeicester
  codexLeicester =
      exceptError $ coerceMat $ unsafePerformIO $
        imdecode ImreadUnchanged <$> B.readFile "data/codex_leicester.jpg"
  
  --------------------------------------------------------------------------------
  
  type CarOverhead = Animation (ShapeT [240, 320]) ('S 3) ('S Word8)
  
  carOverhead :: CarOverhead
  carOverhead = unsafePerformIO $ loadAnimation 4 "data/car-overhead-3.mp4"
  
  --------------------------------------------------------------------------------
  
  loadAnimation
      :: (ToNatDS (Proxy h), ToNatDS (Proxy w))
      => Int
      -> FilePath
      -> IO (Animation ('S [h, w]) ('S 3) ('S Word8))
  loadAnimation delay fp = do
      cap <- newVideoCapture
      exceptErrorIO $ videoCaptureOpen cap (VideoFileSource fp Nothing)
      frames <- grabFrames cap []
      exceptErrorIO $ videoCaptureRelease cap
      pure $ map (delay, ) frames
    where
      grabFrames cap frames = do
          ok <- videoCaptureGrab cap
          if ok
          then do
            mbFrameRaw <- videoCaptureRetrieve cap
            case mbFrameRaw of
              Nothing -> pure $ reverse frames
              Just frameRaw -> do
                frame <- exceptErrorIO $ coerceMat frameRaw
                grabFrames cap (frame : frames)
          else pure $ reverse frames
  
  --------------------------------------------------------------------------------
  
  -- We use some padding around the small image in which we draw the
  -- lines. This is because antialiasing doesn't seem to work near the
  -- edges of an image.
  lineTypeImg :: LineType -> Mat ('S ['D, 'D]) ('S 4) ('S Word8)
  lineTypeImg lineType = exceptError $ do
      img <- withMatM (h + 2 * p ::: w + 2 * p ::: Z)
                      (Proxy :: Proxy 4)
                      (Proxy :: Proxy Word8)
                      transparent $ \imgM -> do
               lift $ line imgM (pure p + V2 0 h) (pure p + V2 w 0) black 1 lineType 0
      resize (ResizeRel $ pure zoom) InterNearest
             =<< matSubRect img (toRect $ HRect (pure p) (V2 w h))
    where
      w, h, p :: Int32
      w = h * 3
      h = 5
      p = 20
      zoom = 8
  
  fontImg :: Font -> Mat ('S ['D, 'D]) ('S 4) ('S Word8)
  fontImg font = exceptError $
      withMatM (th * 3 ::: tw ::: Z)
               (Proxy :: Proxy 4)
               (Proxy :: Proxy Word8)
               transparent $ \imgM -> do
        putText
          imgM
          txt
          (V2 0 (th * 2 - baseLine) :: V2 Int32)
          font
          black
          thickness
          LineType_AA False
    where
      txt = "The quick brown fox jumps over the lazy dog"
      (size2i, baseLine) = getTextSize txt font thickness
      tw, th :: Int32
      V2 tw th = fromSize size2i
      thickness = 1
  
  vennCircleA
      :: (PrimMonad m, ToScalar color)
      => Mut (Mat ('S [height, width]) channels depth) (PrimState m)
      -> color
      -> Int32
      -> m ()
  vennCircleA imgM color thickness =
      circle imgM (V2 100 100 :: V2 Int32) 90 color thickness LineType_AA 0
  
  vennCircleB
      :: (PrimMonad m, ToScalar color)
      => Mut (Mat ('S [height, width]) channels depth) (PrimState m)
      -> color
      -> Int32
      -> m ()
  vennCircleB imgM color thickness =
      circle imgM (V2 220 100 :: V2 Int32) 90 color thickness LineType_AA 0
  
  --------------------------------------------------------------------------------
  
  extractExampleImages "src"
  
  --------------------------------------------------------------------------------
  
  main :: IO ()
  main = do
      renderExampleImages
      renderImage "birds_512x341.png"    birds_512x341
      renderImage "flower_512x341.png"   flower_512x341
      renderImage "sailboat_512x341.png" sailboat_512x341
      renderImage "bikes_512x341.png"    bikes_512x341
      for_ [minBound .. maxBound] $ \lineType ->
        renderImage (show lineType <> ".png") (lineTypeImg lineType)
      for_ [minBound .. maxBound] $ \fontFace -> do
        renderImage (show fontFace <> ".png")         (fontImg $ Font fontFace NotSlanted 1)
        renderImage (show fontFace <> "_slanted.png") (fontImg $ Font fontFace Slanted    1)
  
  --------------------------------------------------------------------------------
  