never executed always true always false

    1 {-# language CPP #-}
    2 {-# language OverloadedLists #-}
    3 
    4 #ifndef ENABLE_INTERNAL_DOCUMENTATION
    5 {-# OPTIONS_HADDOCK hide #-}
    6 #endif
    7 
    8 module OpenCV.Internal.ImgCodecs
    9     ( ImreadMode(..)
   10     , marshalImreadMode
   11     , JpegParams(..)
   12     , defaultJpegParams
   13     , marshalJpegParams
   14     , PngStrategy(..)
   15     , marshalPngStrategy
   16     , PngParams(..)
   17     , defaultPngParams
   18     , marshalPngParams
   19     , OutputFormat(..)
   20     , marshalOutputFormat
   21     ) where
   22 
   23 import "base" Data.Int
   24 import "base" Data.Word
   25 import "base" Foreign.C.Types
   26 import "base" Foreign.Marshal.Utils ( fromBool )
   27 import qualified "vector" Data.Vector.Storable as VS
   28 
   29 
   30 #include <stdint.h>
   31 #include <bindings.dsl.h>
   32 #include "opencv2/core.hpp"
   33 #include "opencv2/imgcodecs.hpp"
   34 
   35 #include "namespace.hpp"
   36 
   37 data ImreadMode
   38    = ImreadUnchanged
   39    | ImreadGrayscale
   40    | ImreadColor
   41    | ImreadAnyDepth
   42    | ImreadAnyColor
   43    | ImreadLoadGdal
   44      deriving (Show)
   45 
   46 #num IMREAD_UNCHANGED 
   47 #num IMREAD_GRAYSCALE
   48 #num IMREAD_COLOR
   49 #num IMREAD_ANYDEPTH
   50 #num IMREAD_ANYCOLOR
   51 #num IMREAD_LOAD_GDAL
   52 
   53 marshalImreadMode :: ImreadMode -> Int32
   54 marshalImreadMode = \case
   55     ImreadUnchanged -> c'IMREAD_UNCHANGED
   56     ImreadGrayscale -> c'IMREAD_GRAYSCALE
   57     ImreadColor     -> c'IMREAD_COLOR
   58     ImreadAnyDepth  -> c'IMREAD_ANYDEPTH
   59     ImreadAnyColor  -> c'IMREAD_ANYCOLOR
   60     ImreadLoadGdal  -> c'IMREAD_LOAD_GDAL
   61 
   62 data JpegParams =
   63      JpegParams
   64      { jpegParamQuality         :: Int -- ^ \[0..100\]
   65      , jpegParamProgressive     :: Bool
   66      , jpegParamOptimize        :: Bool
   67      , jpegParamRestartInterval :: Word16
   68      , jpegParamLumaQuality     :: Int
   69      , jpegParamChromaQuality   :: Int
   70      } deriving Show
   71 
   72 defaultJpegParams :: JpegParams
   73 defaultJpegParams =
   74     JpegParams
   75     { jpegParamQuality         = 95
   76     , jpegParamProgressive     = False
   77     , jpegParamOptimize        = False
   78     , jpegParamRestartInterval = 0
   79     , jpegParamLumaQuality     = -1
   80     , jpegParamChromaQuality   = -1
   81     }
   82 
   83 #num IMWRITE_JPEG_QUALITY
   84 #num IMWRITE_JPEG_PROGRESSIVE
   85 #num IMWRITE_JPEG_OPTIMIZE
   86 #num IMWRITE_JPEG_RST_INTERVAL
   87 #num IMWRITE_JPEG_LUMA_QUALITY
   88 #num IMWRITE_JPEG_CHROMA_QUALITY
   89 
   90 marshalJpegParams :: JpegParams -> VS.Vector CInt
   91 marshalJpegParams params =
   92     [ c'IMWRITE_JPEG_QUALITY       , fromIntegral $ jpegParamQuality         params
   93     , c'IMWRITE_JPEG_PROGRESSIVE   , fromBool     $ jpegParamProgressive     params
   94     , c'IMWRITE_JPEG_OPTIMIZE      , fromBool     $ jpegParamOptimize        params
   95     , c'IMWRITE_JPEG_RST_INTERVAL  , fromIntegral $ jpegParamRestartInterval params
   96     , c'IMWRITE_JPEG_LUMA_QUALITY  , fromIntegral $ jpegParamLumaQuality     params
   97     , c'IMWRITE_JPEG_CHROMA_QUALITY, fromIntegral $ jpegParamChromaQuality   params
   98     ]
   99 
  100 data PngStrategy
  101    = PngStrategyDefault
  102    | PngStrategyFiltered
  103    | PngStrategyHuffmanOnly
  104    | PngStrategyRLE
  105    | PngStrategyFixed
  106      deriving Show
  107 
  108 #num IMWRITE_PNG_STRATEGY_DEFAULT
  109 #num IMWRITE_PNG_STRATEGY_FILTERED
  110 #num IMWRITE_PNG_STRATEGY_HUFFMAN_ONLY
  111 #num IMWRITE_PNG_STRATEGY_RLE
  112 #num IMWRITE_PNG_STRATEGY_FIXED
  113 
  114 marshalPngStrategy :: PngStrategy -> CInt
  115 marshalPngStrategy = \case
  116    PngStrategyDefault     -> c'IMWRITE_PNG_STRATEGY_DEFAULT
  117    PngStrategyFiltered    -> c'IMWRITE_PNG_STRATEGY_FILTERED
  118    PngStrategyHuffmanOnly -> c'IMWRITE_PNG_STRATEGY_HUFFMAN_ONLY
  119    PngStrategyRLE         -> c'IMWRITE_PNG_STRATEGY_RLE
  120    PngStrategyFixed       -> c'IMWRITE_PNG_STRATEGY_FIXED
  121 
  122 data PngParams =
  123      PngParams
  124      { pngParamCompression :: Int
  125      , pngParamStrategy    :: PngStrategy
  126      , pngParamBinaryLevel :: Bool
  127      } deriving Show
  128 
  129 defaultPngParams :: PngParams
  130 defaultPngParams =
  131     PngParams
  132     { pngParamCompression = 3
  133     , pngParamStrategy    = PngStrategyDefault
  134     , pngParamBinaryLevel = False
  135     }
  136 
  137 #num IMWRITE_PNG_COMPRESSION 
  138 #num IMWRITE_PNG_STRATEGY 
  139 #num IMWRITE_PNG_BILEVEL 
  140 
  141 marshalPngParams :: PngParams -> VS.Vector CInt
  142 marshalPngParams params =
  143     [ c'IMWRITE_PNG_COMPRESSION, fromIntegral        $ pngParamCompression params
  144     , c'IMWRITE_PNG_STRATEGY   , marshalPngStrategy $ pngParamStrategy    params
  145     , c'IMWRITE_PNG_BILEVEL    , fromBool            $ pngParamBinaryLevel params
  146     ]
  147 
  148 data OutputFormat
  149    = OutputBmp
  150    | OutputExr
  151    | OutputHdr Bool -- ^ Compression (run length encoding)
  152    | OutputJpeg JpegParams
  153    | OutputJpeg2000
  154    | OutputPng PngParams
  155    | OutputPxm Bool -- ^ Binary
  156    | OutputSunras
  157    | OutputTiff
  158    | OutputWebP Int -- ^ Quality [1..100], > 100 == lossless
  159      deriving Show
  160 
  161 #num IMWRITE_PXM_BINARY 
  162 #num IMWRITE_WEBP_QUALITY 
  163 
  164 marshalOutputFormat :: OutputFormat -> (String, VS.Vector CInt)
  165 marshalOutputFormat = \case
  166     OutputBmp          -> (".bmp" , [])
  167     OutputExr          -> (".exr" , [])
  168     OutputHdr comp     -> (".hdr" , [fromBool comp])
  169     OutputJpeg params  -> (".jpeg", marshalJpegParams params)
  170     OutputJpeg2000     -> (".jp2" , [])
  171     OutputPng params   -> (".png" , marshalPngParams params)
  172     OutputPxm binary   -> (".pxm" , [c'IMWRITE_PXM_BINARY, fromBool binary])
  173     OutputSunras       -> (".sr"  , [])
  174     OutputTiff         -> (".tiff", [])
  175     OutputWebP quality -> (".webp", [c'IMWRITE_WEBP_QUALITY, fromIntegral quality])