JuicyPixels 3.3.1 → 3.3.2
raw patch · 13 files changed
+1732/−1582 lines, 13 filesdep −mmapdep ~containersPVP ok
version bump matches the API change (PVP)
Dependencies removed: mmap
Dependency ranges changed: containers
API changes (from Hackage documentation)
+ Codec.Picture.Gif: DisposalAny :: GifDisposalMethod
+ Codec.Picture.Gif: DisposalDoNot :: GifDisposalMethod
+ Codec.Picture.Gif: DisposalRestoreBackground :: GifDisposalMethod
+ Codec.Picture.Gif: DisposalRestorePrevious :: GifDisposalMethod
+ Codec.Picture.Gif: DisposalUnknown :: Word8 -> GifDisposalMethod
+ Codec.Picture.Gif: GifEncode :: Int -> Int -> Maybe Palette -> Maybe Int -> GifLooping -> [GifFrame] -> GifEncode
+ Codec.Picture.Gif: GifFrame :: Int -> Int -> Maybe Palette -> Maybe Int -> GifDelay -> GifDisposalMethod -> Image Pixel8 -> GifFrame
+ Codec.Picture.Gif: [geBackground] :: GifEncode -> Maybe Int
+ Codec.Picture.Gif: [geFrames] :: GifEncode -> [GifFrame]
+ Codec.Picture.Gif: [geHeight] :: GifEncode -> Int
+ Codec.Picture.Gif: [geLooping] :: GifEncode -> GifLooping
+ Codec.Picture.Gif: [gePalette] :: GifEncode -> Maybe Palette
+ Codec.Picture.Gif: [geWidth] :: GifEncode -> Int
+ Codec.Picture.Gif: [gfDelay] :: GifFrame -> GifDelay
+ Codec.Picture.Gif: [gfDisposal] :: GifFrame -> GifDisposalMethod
+ Codec.Picture.Gif: [gfPalette] :: GifFrame -> Maybe Palette
+ Codec.Picture.Gif: [gfPixels] :: GifFrame -> Image Pixel8
+ Codec.Picture.Gif: [gfTransparent] :: GifFrame -> Maybe Int
+ Codec.Picture.Gif: [gfXOffset] :: GifFrame -> Int
+ Codec.Picture.Gif: [gfYOffset] :: GifFrame -> Int
+ Codec.Picture.Gif: data GifDisposalMethod
+ Codec.Picture.Gif: data GifEncode
+ Codec.Picture.Gif: data GifFrame
+ Codec.Picture.Gif: encodeComplexGifImage :: GifEncode -> Either String ByteString
+ Codec.Picture.Gif: writeComplexGifImage :: FilePath -> GifEncode -> Either String (IO ())
Files
- JuicyPixels.cabal +4/−8
- changelog +8/−0
- docimages/pixelgraph.svg +264/−264
- src/Codec/Picture/ConvGraph.hs +10/−10
- src/Codec/Picture/Gif.hs +232/−84
- src/Codec/Picture/Gif/LZW.hs +194/−194
- src/Codec/Picture/HDR.hs +530/−530
- src/Codec/Picture/InternalHelper.hs +51/−51
- src/Codec/Picture/Jpg/FastDct.hs +218/−218
- src/Codec/Picture/Jpg/Metadata.hs +41/−41
- src/Codec/Picture/Png.hs +0/−2
- src/Codec/Picture/Png/Metadata.hs +135/−135
- src/Codec/Picture/VectorByteConversion.hs +45/−45
JuicyPixels.cabal view
@@ -1,5 +1,5 @@ Name: JuicyPixels -Version: 3.3.1 +Version: 3.3.2 Synopsis: Picture loading/serialization (in png, jpeg, bitmap, gif, tga, tiff and radiance) Description: <<data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAMAAAADABAMAAACg8nE0AAAAElBMVEUAAABJqDSTWEL/qyb///8AAABH/1GTAAAAAXRSTlMAQObYZgAAAN5JREFUeF7s1sEJgFAQxFBbsAV72v5bEVYWPwT/XDxmCsi7zvHXavYREBDI3XP2GgICqBBYuwIC+/rVayPUAyAg0HvIXBcQoDFDGnUBgWQQ2Bx3AYFaRoBpAQHWb3bt2ARgGAiCYFFuwf3X5HA/McgGJWI2FdykCv4aBYzmKwDwvl6NVmUAAK2vlwEALK7fo88GANB6HQsAAAAAAAAA7P94AQCzswEAAAAAAAAAAAAAAAAAAICzh4UAO4zWAYBfRutHA4Bn5C69JhowAMGoBaMWDG0wCkbBKBgFo2AUAACPmegUST/IJAAAAABJRU5ErkJggg==>> @@ -28,7 +28,7 @@ Source-Repository this Type: git Location: git://github.com/Twinside/Juicy.Pixels.git - Tag: v3.3.1 + Tag: v3.3.2 Flag Mmap Description: Enable the file loading via mmap (memory map) @@ -52,7 +52,7 @@ Codec.Picture.ColorQuant Ghc-options: -O3 -Wall - Build-depends: base >= 4.8 && < 5, + Build-depends: base >= 4.8 && < 6, bytestring >= 0.9 && < 0.11, mtl >= 1.1 && < 2.3, binary >= 0.5 && < 0.9, @@ -61,11 +61,7 @@ vector >= 0.10 && < 0.13, primitive >= 0.4 && < 0.7, deepseq >= 1.1 && < 1.5, - containers >= 0.4.2 && < 0.6 - - if flag(Mmap) - Build-depends: mmap - CC-Options: "-DWITH_MMAP_BYTESTRING" + containers >= 0.4.2 && < 0.7 -- Modules not exported by this package. Other-modules: Codec.Picture.Jpg.DefaultTable,
changelog view
@@ -1,6 +1,14 @@ Change log ========== +v3.3.2 October 2018 +------------------- + + * Fix: GHC-8.6 compilation fix (no upper bound on base) + * Fix: upper bound on containers (pull request phadej) + * Fix: palette validation for gifs (pull request omedan) + * New: More complete gif creation API (pull request omedan) + v3.3.1 August 2018 ------------------
docimages/pixelgraph.svg view
@@ -1,264 +1,264 @@-<?xml version="1.0" encoding="UTF-8" standalone="no"?> -<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" - "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> -<!-- Generated by graphviz version 2.22.2 (20090313.1817) - --> -<!-- Title: pixelGraphic Pages: 1 --> -<svg width="620pt" height="464pt" - viewBox="0.00 0.00 620.00 464.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink"> -<g id="graph1" class="graph" transform="scale(1 1) rotate(0) translate(4 460)"> -<title>pixelGraphic</title> -<polygon fill="white" stroke="white" points="-4,5 -4,-460 617,-460 617,5 -4,5"/> -<!-- PixelRGB8 --> -<g id="node1" class="node"><title>PixelRGB8</title> -<ellipse fill="none" stroke="black" cx="246" cy="-438" rx="31.7878" ry="18"/> -<text text-anchor="middle" x="246" y="-436.3" font-family="sans-serif" font-size="8.00">PixelRGB8</text> -</g> -<!-- PixelRGBA8 --> -<g id="node6" class="node"><title>PixelRGBA8</title> -<ellipse fill="none" stroke="black" cx="441" cy="-354" rx="34.8223" ry="18"/> -<text text-anchor="middle" x="441" y="-352.3" font-family="sans-serif" font-size="8.00">PixelRGBA8</text> -</g> -<!-- PixelRGB8->PixelRGBA8 --> -<g id="edge4" class="edge"><title>PixelRGB8->PixelRGBA8</title> -<path fill="none" stroke="black" d="M274.25,-429.506C295.421,-422.833 324.934,-412.874 350,-402 351.523,-401.339 381.994,-385.244 407.261,-371.871"/> -<polygon fill="black" stroke="black" points="409.071,-374.874 416.272,-367.102 405.796,-368.687 409.071,-374.874"/> -<text text-anchor="middle" x="393" y="-394.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- PixelRGBF --> -<g id="node8" class="node"><title>PixelRGBF</title> -<ellipse fill="none" stroke="black" cx="33" cy="-102" rx="31.7878" ry="18"/> -<text text-anchor="middle" x="33" y="-100.3" font-family="sans-serif" font-size="8.00">PixelRGBF</text> -</g> -<!-- PixelRGB8->PixelRGBF --> -<g id="edge6" class="edge"><title>PixelRGB8->PixelRGBF</title> -<path fill="none" stroke="black" d="M214.594,-434.005C148.276,-424.689 0,-398.847 0,-354 0,-354 0,-354 0,-186 0,-165.437 8.67323,-143.88 17.1268,-127.753"/> -<polygon fill="black" stroke="black" points="20.228,-129.378 22.0115,-118.934 14.1045,-125.986 20.228,-129.378"/> -<text text-anchor="middle" x="23" y="-268.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel8 --> -<g id="node20" class="node"><title>Pixel8</title> -<ellipse fill="none" stroke="black" cx="308" cy="-270" rx="27" ry="18"/> -<text text-anchor="middle" x="308" y="-268.3" font-family="sans-serif" font-size="8.00">Pixel8</text> -</g> -<!-- PixelRGB8->Pixel8 --> -<g id="edge60" class="edge"><title>PixelRGB8->Pixel8</title> -<path fill="none" stroke="black" d="M214.516,-433.811C149.341,-423.852 9.37863,-395.049 55,-336 81.2893,-301.973 207.23,-282.163 270.929,-274.163"/> -<polygon fill="black" stroke="black" points="271.46,-277.624 280.961,-272.936 270.61,-270.676 271.46,-277.624"/> -<text text-anchor="middle" x="80" y="-352.3" font-family="sans-serif" font-size="8.00">computeLuma</text> -</g> -<!-- PixelCMYK8 --> -<g id="node28" class="node"><title>PixelCMYK8</title> -<ellipse fill="none" stroke="black" cx="253" cy="-354" rx="34.8223" ry="18"/> -<text text-anchor="middle" x="253" y="-352.3" font-family="sans-serif" font-size="8.00">PixelCMYK8</text> -</g> -<!-- PixelRGB8->PixelCMYK8 --> -<g id="edge40" class="edge"><title>PixelRGB8->PixelCMYK8</title> -<path fill="none" stroke="black" d="M224.748,-423.894C213.935,-414.831 204.182,-402.459 210,-390 212.758,-384.095 217.013,-378.817 221.794,-374.241"/> -<polygon fill="black" stroke="black" points="224.225,-376.77 229.601,-367.64 219.705,-371.424 224.225,-376.77"/> -<text text-anchor="middle" x="232" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text> -</g> -<!-- PixelYCbCr8 --> -<g id="node30" class="node"><title>PixelYCbCr8</title> -<ellipse fill="none" stroke="black" cx="150" cy="-354" rx="35.9084" ry="18"/> -<text text-anchor="middle" x="150" y="-352.3" font-family="sans-serif" font-size="8.00">PixelYCbCr8</text> -</g> -<!-- PixelRGB8->PixelYCbCr8 --> -<g id="edge42" class="edge"><title>PixelRGB8->PixelYCbCr8</title> -<path fill="none" stroke="black" d="M214.399,-434.415C177.053,-429.451 118.29,-419.109 105,-402 97.106,-391.837 104.874,-381.324 116.049,-372.736"/> -<polygon fill="black" stroke="black" points="118.35,-375.401 124.612,-366.856 114.387,-369.631 118.35,-375.401"/> -<text text-anchor="middle" x="127" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text> -</g> -<!-- PixelRGB16 --> -<g id="node2" class="node"><title>PixelRGB16</title> -<ellipse fill="none" stroke="black" cx="429" cy="-102" rx="34.1425" ry="18"/> -<text text-anchor="middle" x="429" y="-100.3" font-family="sans-serif" font-size="8.00">PixelRGB16</text> -</g> -<!-- PixelRGBA16 --> -<g id="node4" class="node"><title>PixelRGBA16</title> -<ellipse fill="none" stroke="black" cx="343" cy="-18" rx="37.1721" ry="18"/> -<text text-anchor="middle" x="343" y="-16.3" font-family="sans-serif" font-size="8.00">PixelRGBA16</text> -</g> -<!-- PixelRGB16->PixelRGBA16 --> -<g id="edge2" class="edge"><title>PixelRGB16->PixelRGBA16</title> -<path fill="none" stroke="black" d="M400.098,-92.2134C386.67,-86.4097 371.409,-77.8363 361,-66 355.909,-60.2106 352.202,-52.8433 349.526,-45.6287"/> -<polygon fill="black" stroke="black" points="352.846,-44.5187 346.482,-36.0479 346.174,-46.6383 352.846,-44.5187"/> -<text text-anchor="middle" x="384" y="-58.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel16 --> -<g id="node16" class="node"><title>Pixel16</title> -<ellipse fill="none" stroke="black" cx="296" cy="-186" rx="27" ry="18"/> -<text text-anchor="middle" x="296" y="-184.3" font-family="sans-serif" font-size="8.00">Pixel16</text> -</g> -<!-- PixelRGB16->Pixel16 --> -<g id="edge58" class="edge"><title>PixelRGB16->Pixel16</title> -<path fill="none" stroke="black" d="M424.573,-120.149C421.265,-130.199 415.765,-142.199 407,-150 386.436,-168.304 356.427,-177.32 332.795,-181.75"/> -<polygon fill="black" stroke="black" points="332.056,-178.325 322.773,-183.431 333.214,-185.228 332.056,-178.325"/> -<text text-anchor="middle" x="441" y="-142.3" font-family="sans-serif" font-size="8.00">computeLuma</text> -</g> -<!-- PixelCMYK16 --> -<g id="node26" class="node"><title>PixelCMYK16</title> -<ellipse fill="none" stroke="black" cx="553" cy="-18" rx="37.1721" ry="18"/> -<text text-anchor="middle" x="553" y="-16.3" font-family="sans-serif" font-size="8.00">PixelCMYK16</text> -</g> -<!-- PixelRGB16->PixelCMYK16 --> -<g id="edge38" class="edge"><title>PixelRGB16->PixelCMYK16</title> -<path fill="none" stroke="black" d="M451.832,-88.3606C462.615,-81.7841 475.593,-73.6731 487,-66 499.46,-57.6189 512.915,-47.9503 524.406,-39.4968"/> -<polygon fill="black" stroke="black" points="526.807,-42.074 532.761,-33.3106 522.641,-36.4482 526.807,-42.074"/> -<text text-anchor="middle" x="525" y="-58.3" font-family="sans-serif" font-size="8.00">convertPixel</text> -</g> -<!-- PixelRGBA16->PixelRGB16 --> -<g id="edge44" class="edge"><title>PixelRGBA16->PixelRGB16</title> -<path fill="none" stroke="black" d="M371.789,-29.3863C383.871,-35.2918 397.329,-43.4955 407,-54 412.378,-59.8422 416.636,-67.2266 419.915,-74.4406"/> -<polygon fill="black" stroke="black" points="416.794,-76.0584 423.794,-84.0115 423.282,-73.4291 416.794,-76.0584"/> -<text text-anchor="middle" x="449" y="-58.3" font-family="sans-serif" font-size="8.00">dropTransparency</text> -</g> -<!-- PixelRGBA8->PixelRGB8 --> -<g id="edge46" class="edge"><title>PixelRGBA8->PixelRGB8</title> -<path fill="none" stroke="black" d="M437.029,-372.038C433.845,-382.309 428.318,-394.571 419,-402 399.083,-417.88 332.208,-428.306 287.678,-433.672"/> -<polygon fill="black" stroke="black" points="287.239,-430.2 277.712,-434.834 288.05,-437.153 287.239,-430.2"/> -<text text-anchor="middle" x="463" y="-394.3" font-family="sans-serif" font-size="8.00">dropTransparency</text> -</g> -<!-- PixelRGBA8->Pixel8 --> -<g id="edge52" class="edge"><title>PixelRGBA8->Pixel8</title> -<path fill="none" stroke="black" d="M413.829,-342.599C399.476,-336.131 381.815,-327.451 367,-318 354.878,-310.267 342.394,-300.428 332.048,-291.673"/> -<polygon fill="black" stroke="black" points="334.114,-288.833 324.258,-284.946 329.539,-294.131 334.114,-288.833"/> -<text text-anchor="middle" x="392" y="-310.3" font-family="sans-serif" font-size="8.00">computeLuma</text> -</g> -<!-- PixelF --> -<g id="node14" class="node"><title>PixelF</title> -<ellipse fill="none" stroke="black" cx="106" cy="-186" rx="27" ry="18"/> -<text text-anchor="middle" x="106" y="-184.3" font-family="sans-serif" font-size="8.00">PixelF</text> -</g> -<!-- PixelRGBF->PixelF --> -<g id="edge56" class="edge"><title>PixelRGBF->PixelF</title> -<path fill="none" stroke="black" d="M27.0137,-120.147C24.9943,-129.716 24.4635,-141.251 30,-150 38.9021,-164.067 54.9514,-172.745 70.015,-178.044"/> -<polygon fill="black" stroke="black" points="69.0981,-181.424 79.6867,-181.06 71.1825,-174.741 69.0981,-181.424"/> -<text text-anchor="middle" x="55" y="-142.3" font-family="sans-serif" font-size="8.00">computeLuma</text> -</g> -<!-- PixelYA16 --> -<g id="node9" class="node"><title>PixelYA16</title> -<ellipse fill="none" stroke="black" cx="259" cy="-102" rx="31.7878" ry="18"/> -<text text-anchor="middle" x="259" y="-100.3" font-family="sans-serif" font-size="8.00">PixelYA16</text> -</g> -<!-- PixelYA16->PixelRGBA16 --> -<g id="edge8" class="edge"><title>PixelYA16->PixelRGBA16</title> -<path fill="none" stroke="black" d="M258.152,-83.5434C258.613,-73.883 260.687,-62.36 267,-54 275.273,-43.0444 287.722,-35.28 300.163,-29.8405"/> -<polygon fill="black" stroke="black" points="301.586,-33.0421 309.607,-26.1198 299.02,-26.5294 301.586,-33.0421"/> -<text text-anchor="middle" x="290" y="-58.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- PixelYA16->Pixel16 --> -<g id="edge48" class="edge"><title>PixelYA16->Pixel16</title> -<path fill="none" stroke="black" d="M229.98,-109.854C206.015,-117.845 177.897,-131.656 191,-150 199.293,-161.611 233.125,-171.835 260.175,-178.391"/> -<polygon fill="black" stroke="black" points="259.609,-181.853 270.143,-180.72 261.201,-175.037 259.609,-181.853"/> -<text text-anchor="middle" x="225" y="-142.3" font-family="sans-serif" font-size="8.00">dropTransparency</text> -</g> -<!-- PixelYA8 --> -<g id="node11" class="node"><title>PixelYA8</title> -<ellipse fill="none" stroke="black" cx="439" cy="-186" rx="28.8445" ry="18"/> -<text text-anchor="middle" x="439" y="-184.3" font-family="sans-serif" font-size="8.00">PixelYA8</text> -</g> -<!-- PixelYA8->PixelRGB8 --> -<g id="edge12" class="edge"><title>PixelYA8->PixelRGB8</title> -<path fill="none" stroke="black" d="M464.762,-194.278C489.627,-203.81 525.815,-222.121 542,-252 574.918,-312.769 554.613,-358.387 501,-402 484.752,-415.217 355.671,-428.373 287.639,-434.476"/> -<polygon fill="black" stroke="black" points="287.321,-430.99 277.669,-435.359 287.938,-437.963 287.321,-430.99"/> -<text text-anchor="middle" x="580" y="-310.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- PixelYA8->PixelRGBA8 --> -<g id="edge10" class="edge"><title>PixelYA8->PixelRGBA8</title> -<path fill="none" stroke="black" d="M460.035,-198.84C467.824,-204.817 475.781,-212.68 480,-222 497.598,-260.871 496.093,-278.904 479,-318 476.725,-323.204 473.295,-328.013 469.411,-332.309"/> -<polygon fill="black" stroke="black" points="466.792,-329.975 462.079,-339.464 471.681,-334.985 466.792,-329.975"/> -<text text-anchor="middle" x="515" y="-268.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- PixelYA8->Pixel8 --> -<g id="edge50" class="edge"><title>PixelYA8->Pixel8</title> -<path fill="none" stroke="black" d="M412.102,-193.018C393.267,-198.789 368.145,-208.269 349,-222 340.05,-228.419 331.808,-237.196 325.098,-245.49"/> -<polygon fill="black" stroke="black" points="322.247,-243.456 318.929,-253.518 327.797,-247.721 322.247,-243.456"/> -<text text-anchor="middle" x="383" y="-226.3" font-family="sans-serif" font-size="8.00">dropTransparency</text> -</g> -<!-- PixelYA8->Pixel8 --> -<g id="edge62" class="edge"><title>PixelYA8->Pixel8</title> -<path fill="none" stroke="black" d="M434.558,-204.131C431.244,-214.175 425.744,-226.175 417,-234 397.039,-251.864 367.99,-260.893 344.899,-265.441"/> -<polygon fill="black" stroke="black" points="344.002,-262.045 334.763,-267.23 345.219,-268.938 344.002,-262.045"/> -<text text-anchor="middle" x="451" y="-226.3" font-family="sans-serif" font-size="8.00">computeLuma</text> -</g> -<!-- PixelF->PixelRGBF --> -<g id="edge14" class="edge"><title>PixelF->PixelRGBF</title> -<path fill="none" stroke="black" d="M100.45,-168.312C96.8232,-158.653 91.3784,-146.886 84,-138 78.5966,-131.492 71.7476,-125.606 64.8367,-120.568"/> -<polygon fill="black" stroke="black" points="66.3898,-117.392 56.1539,-114.657 62.4504,-123.178 66.3898,-117.392"/> -<text text-anchor="middle" x="115" y="-142.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel16->PixelRGB16 --> -<g id="edge18" class="edge"><title>Pixel16->PixelRGB16</title> -<path fill="none" stroke="black" d="M313.43,-172.019C326.239,-162.023 344.257,-148.532 361,-138 371.689,-131.277 383.756,-124.61 394.725,-118.875"/> -<polygon fill="black" stroke="black" points="396.336,-121.982 403.628,-114.295 393.134,-115.757 396.336,-121.982"/> -<text text-anchor="middle" x="384" y="-142.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel16->PixelRGBA16 --> -<g id="edge16" class="edge"><title>Pixel16->PixelRGBA16</title> -<path fill="none" stroke="black" d="M305.084,-168.741C307.903,-162.903 310.835,-156.272 313,-150 325.048,-115.091 333.609,-73.3023 338.424,-46.2333"/> -<polygon fill="black" stroke="black" points="341.89,-46.732 340.143,-36.2822 334.992,-45.5405 341.89,-46.732"/> -<text text-anchor="middle" x="353" y="-100.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel16->PixelYA16 --> -<g id="edge20" class="edge"><title>Pixel16->PixelYA16</title> -<path fill="none" stroke="black" d="M280.78,-170.7C275.635,-164.701 270.35,-157.469 267,-150 264.277,-143.93 262.473,-137.052 261.279,-130.438"/> -<polygon fill="black" stroke="black" points="264.727,-129.827 259.862,-120.415 257.796,-130.807 264.727,-129.827"/> -<text text-anchor="middle" x="290" y="-142.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel8->PixelRGB8 --> -<g id="edge24" class="edge"><title>Pixel8->PixelRGB8</title> -<path fill="none" stroke="black" d="M312.919,-288.095C319.136,-314.953 326.712,-366.057 306,-402 300.622,-411.332 291.773,-418.518 282.501,-423.926"/> -<polygon fill="black" stroke="black" points="280.83,-420.85 273.581,-428.577 284.067,-427.057 280.83,-420.85"/> -<text text-anchor="middle" x="342" y="-352.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel8->PixelRGBA8 --> -<g id="edge22" class="edge"><title>Pixel8->PixelRGBA8</title> -<path fill="none" stroke="black" d="M334.939,-272.185C360.073,-275.561 397.177,-284.15 421,-306 426.855,-311.37 431.048,-318.72 434.03,-326.054"/> -<polygon fill="black" stroke="black" points="430.836,-327.531 437.387,-335.858 437.458,-325.263 430.836,-327.531"/> -<text text-anchor="middle" x="452" y="-310.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel8->PixelYA8 --> -<g id="edge26" class="edge"><title>Pixel8->PixelYA8</title> -<path fill="none" stroke="black" d="M290.77,-255.865C280.734,-245.919 271.57,-232.553 280,-222 287.559,-212.538 356.092,-199.635 400.682,-192.122"/> -<polygon fill="black" stroke="black" points="401.335,-195.562 410.626,-190.469 400.187,-188.657 401.335,-195.562"/> -<text text-anchor="middle" x="303" y="-226.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel8->PixelF --> -<g id="edge28" class="edge"><title>Pixel8->PixelF</title> -<path fill="none" stroke="black" d="M281.145,-267.812C249.741,-264.331 196.969,-255.554 157,-234 145.577,-227.84 134.814,-218.473 126.146,-209.643"/> -<polygon fill="black" stroke="black" points="128.492,-207.028 119.104,-202.117 123.381,-211.81 128.492,-207.028"/> -<text text-anchor="middle" x="180" y="-226.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- Pixel8->Pixel16 --> -<g id="edge30" class="edge"><title>Pixel8->Pixel16</title> -<path fill="none" stroke="black" d="M282.206,-263.957C256.398,-257.327 219.359,-246.018 211,-234 196.025,-212.469 230.216,-199.429 259.604,-192.482"/> -<polygon fill="black" stroke="black" points="260.687,-195.828 269.71,-190.275 259.193,-188.989 260.687,-195.828"/> -<text text-anchor="middle" x="234" y="-226.3" font-family="sans-serif" font-size="8.00">promotePixel</text> -</g> -<!-- PixelCMYK16->PixelRGB16 --> -<g id="edge32" class="edge"><title>PixelCMYK16->PixelRGB16</title> -<path fill="none" stroke="black" d="M564.03,-35.4654C568.707,-45.2873 571.707,-57.2873 565,-66 553.678,-80.7091 507.858,-90.6423 472.496,-96.2857"/> -<polygon fill="black" stroke="black" points="471.73,-92.862 462.373,-97.8319 472.787,-99.7817 471.73,-92.862"/> -<text text-anchor="middle" x="590" y="-58.3" font-family="sans-serif" font-size="8.00">convertPixel</text> -</g> -<!-- PixelCMYK8->PixelRGB8 --> -<g id="edge34" class="edge"><title>PixelCMYK8->PixelRGB8</title> -<path fill="none" stroke="black" d="M257.173,-372.299C258.645,-381.28 259.584,-392.241 258,-402 257.535,-404.865 256.875,-407.811 256.1,-410.724"/> -<polygon fill="black" stroke="black" points="252.737,-409.753 253.143,-420.34 259.427,-411.811 252.737,-409.753"/> -<text text-anchor="middle" x="280" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text> -</g> -<!-- PixelYCbCr8->PixelRGB8 --> -<g id="edge36" class="edge"><title>PixelYCbCr8->PixelRGB8</title> -<path fill="none" stroke="black" d="M149.836,-372.162C150.645,-381.97 153.174,-393.727 160,-402 171.431,-415.854 189.112,-424.462 205.475,-429.768"/> -<polygon fill="black" stroke="black" points="204.847,-433.23 215.426,-432.663 206.802,-426.509 204.847,-433.23"/> -<text text-anchor="middle" x="182" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text> -</g> -<!-- PixelYCbCr8->Pixel8 --> -<g id="edge54" class="edge"><title>PixelYCbCr8->Pixel8</title> -<path fill="none" stroke="black" d="M174.688,-340.875C202.411,-326.136 247.432,-302.201 277.376,-286.281"/> -<polygon fill="black" stroke="black" points="279.34,-289.201 286.527,-281.416 276.054,-283.02 279.34,-289.201"/> -<text text-anchor="middle" x="263" y="-310.3" font-family="sans-serif" font-size="8.00">computeLuma</text> -</g> -</g> -</svg> +<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+ "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">+<!-- Generated by graphviz version 2.22.2 (20090313.1817)+ -->+<!-- Title: pixelGraphic Pages: 1 -->+<svg width="620pt" height="464pt"+ viewBox="0.00 0.00 620.00 464.00" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink">+<g id="graph1" class="graph" transform="scale(1 1) rotate(0) translate(4 460)">+<title>pixelGraphic</title>+<polygon fill="white" stroke="white" points="-4,5 -4,-460 617,-460 617,5 -4,5"/>+<!-- PixelRGB8 -->+<g id="node1" class="node"><title>PixelRGB8</title>+<ellipse fill="none" stroke="black" cx="246" cy="-438" rx="31.7878" ry="18"/>+<text text-anchor="middle" x="246" y="-436.3" font-family="sans-serif" font-size="8.00">PixelRGB8</text>+</g>+<!-- PixelRGBA8 -->+<g id="node6" class="node"><title>PixelRGBA8</title>+<ellipse fill="none" stroke="black" cx="441" cy="-354" rx="34.8223" ry="18"/>+<text text-anchor="middle" x="441" y="-352.3" font-family="sans-serif" font-size="8.00">PixelRGBA8</text>+</g>+<!-- PixelRGB8->PixelRGBA8 -->+<g id="edge4" class="edge"><title>PixelRGB8->PixelRGBA8</title>+<path fill="none" stroke="black" d="M274.25,-429.506C295.421,-422.833 324.934,-412.874 350,-402 351.523,-401.339 381.994,-385.244 407.261,-371.871"/>+<polygon fill="black" stroke="black" points="409.071,-374.874 416.272,-367.102 405.796,-368.687 409.071,-374.874"/>+<text text-anchor="middle" x="393" y="-394.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- PixelRGBF -->+<g id="node8" class="node"><title>PixelRGBF</title>+<ellipse fill="none" stroke="black" cx="33" cy="-102" rx="31.7878" ry="18"/>+<text text-anchor="middle" x="33" y="-100.3" font-family="sans-serif" font-size="8.00">PixelRGBF</text>+</g>+<!-- PixelRGB8->PixelRGBF -->+<g id="edge6" class="edge"><title>PixelRGB8->PixelRGBF</title>+<path fill="none" stroke="black" d="M214.594,-434.005C148.276,-424.689 0,-398.847 0,-354 0,-354 0,-354 0,-186 0,-165.437 8.67323,-143.88 17.1268,-127.753"/>+<polygon fill="black" stroke="black" points="20.228,-129.378 22.0115,-118.934 14.1045,-125.986 20.228,-129.378"/>+<text text-anchor="middle" x="23" y="-268.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel8 -->+<g id="node20" class="node"><title>Pixel8</title>+<ellipse fill="none" stroke="black" cx="308" cy="-270" rx="27" ry="18"/>+<text text-anchor="middle" x="308" y="-268.3" font-family="sans-serif" font-size="8.00">Pixel8</text>+</g>+<!-- PixelRGB8->Pixel8 -->+<g id="edge60" class="edge"><title>PixelRGB8->Pixel8</title>+<path fill="none" stroke="black" d="M214.516,-433.811C149.341,-423.852 9.37863,-395.049 55,-336 81.2893,-301.973 207.23,-282.163 270.929,-274.163"/>+<polygon fill="black" stroke="black" points="271.46,-277.624 280.961,-272.936 270.61,-270.676 271.46,-277.624"/>+<text text-anchor="middle" x="80" y="-352.3" font-family="sans-serif" font-size="8.00">computeLuma</text>+</g>+<!-- PixelCMYK8 -->+<g id="node28" class="node"><title>PixelCMYK8</title>+<ellipse fill="none" stroke="black" cx="253" cy="-354" rx="34.8223" ry="18"/>+<text text-anchor="middle" x="253" y="-352.3" font-family="sans-serif" font-size="8.00">PixelCMYK8</text>+</g>+<!-- PixelRGB8->PixelCMYK8 -->+<g id="edge40" class="edge"><title>PixelRGB8->PixelCMYK8</title>+<path fill="none" stroke="black" d="M224.748,-423.894C213.935,-414.831 204.182,-402.459 210,-390 212.758,-384.095 217.013,-378.817 221.794,-374.241"/>+<polygon fill="black" stroke="black" points="224.225,-376.77 229.601,-367.64 219.705,-371.424 224.225,-376.77"/>+<text text-anchor="middle" x="232" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text>+</g>+<!-- PixelYCbCr8 -->+<g id="node30" class="node"><title>PixelYCbCr8</title>+<ellipse fill="none" stroke="black" cx="150" cy="-354" rx="35.9084" ry="18"/>+<text text-anchor="middle" x="150" y="-352.3" font-family="sans-serif" font-size="8.00">PixelYCbCr8</text>+</g>+<!-- PixelRGB8->PixelYCbCr8 -->+<g id="edge42" class="edge"><title>PixelRGB8->PixelYCbCr8</title>+<path fill="none" stroke="black" d="M214.399,-434.415C177.053,-429.451 118.29,-419.109 105,-402 97.106,-391.837 104.874,-381.324 116.049,-372.736"/>+<polygon fill="black" stroke="black" points="118.35,-375.401 124.612,-366.856 114.387,-369.631 118.35,-375.401"/>+<text text-anchor="middle" x="127" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text>+</g>+<!-- PixelRGB16 -->+<g id="node2" class="node"><title>PixelRGB16</title>+<ellipse fill="none" stroke="black" cx="429" cy="-102" rx="34.1425" ry="18"/>+<text text-anchor="middle" x="429" y="-100.3" font-family="sans-serif" font-size="8.00">PixelRGB16</text>+</g>+<!-- PixelRGBA16 -->+<g id="node4" class="node"><title>PixelRGBA16</title>+<ellipse fill="none" stroke="black" cx="343" cy="-18" rx="37.1721" ry="18"/>+<text text-anchor="middle" x="343" y="-16.3" font-family="sans-serif" font-size="8.00">PixelRGBA16</text>+</g>+<!-- PixelRGB16->PixelRGBA16 -->+<g id="edge2" class="edge"><title>PixelRGB16->PixelRGBA16</title>+<path fill="none" stroke="black" d="M400.098,-92.2134C386.67,-86.4097 371.409,-77.8363 361,-66 355.909,-60.2106 352.202,-52.8433 349.526,-45.6287"/>+<polygon fill="black" stroke="black" points="352.846,-44.5187 346.482,-36.0479 346.174,-46.6383 352.846,-44.5187"/>+<text text-anchor="middle" x="384" y="-58.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel16 -->+<g id="node16" class="node"><title>Pixel16</title>+<ellipse fill="none" stroke="black" cx="296" cy="-186" rx="27" ry="18"/>+<text text-anchor="middle" x="296" y="-184.3" font-family="sans-serif" font-size="8.00">Pixel16</text>+</g>+<!-- PixelRGB16->Pixel16 -->+<g id="edge58" class="edge"><title>PixelRGB16->Pixel16</title>+<path fill="none" stroke="black" d="M424.573,-120.149C421.265,-130.199 415.765,-142.199 407,-150 386.436,-168.304 356.427,-177.32 332.795,-181.75"/>+<polygon fill="black" stroke="black" points="332.056,-178.325 322.773,-183.431 333.214,-185.228 332.056,-178.325"/>+<text text-anchor="middle" x="441" y="-142.3" font-family="sans-serif" font-size="8.00">computeLuma</text>+</g>+<!-- PixelCMYK16 -->+<g id="node26" class="node"><title>PixelCMYK16</title>+<ellipse fill="none" stroke="black" cx="553" cy="-18" rx="37.1721" ry="18"/>+<text text-anchor="middle" x="553" y="-16.3" font-family="sans-serif" font-size="8.00">PixelCMYK16</text>+</g>+<!-- PixelRGB16->PixelCMYK16 -->+<g id="edge38" class="edge"><title>PixelRGB16->PixelCMYK16</title>+<path fill="none" stroke="black" d="M451.832,-88.3606C462.615,-81.7841 475.593,-73.6731 487,-66 499.46,-57.6189 512.915,-47.9503 524.406,-39.4968"/>+<polygon fill="black" stroke="black" points="526.807,-42.074 532.761,-33.3106 522.641,-36.4482 526.807,-42.074"/>+<text text-anchor="middle" x="525" y="-58.3" font-family="sans-serif" font-size="8.00">convertPixel</text>+</g>+<!-- PixelRGBA16->PixelRGB16 -->+<g id="edge44" class="edge"><title>PixelRGBA16->PixelRGB16</title>+<path fill="none" stroke="black" d="M371.789,-29.3863C383.871,-35.2918 397.329,-43.4955 407,-54 412.378,-59.8422 416.636,-67.2266 419.915,-74.4406"/>+<polygon fill="black" stroke="black" points="416.794,-76.0584 423.794,-84.0115 423.282,-73.4291 416.794,-76.0584"/>+<text text-anchor="middle" x="449" y="-58.3" font-family="sans-serif" font-size="8.00">dropTransparency</text>+</g>+<!-- PixelRGBA8->PixelRGB8 -->+<g id="edge46" class="edge"><title>PixelRGBA8->PixelRGB8</title>+<path fill="none" stroke="black" d="M437.029,-372.038C433.845,-382.309 428.318,-394.571 419,-402 399.083,-417.88 332.208,-428.306 287.678,-433.672"/>+<polygon fill="black" stroke="black" points="287.239,-430.2 277.712,-434.834 288.05,-437.153 287.239,-430.2"/>+<text text-anchor="middle" x="463" y="-394.3" font-family="sans-serif" font-size="8.00">dropTransparency</text>+</g>+<!-- PixelRGBA8->Pixel8 -->+<g id="edge52" class="edge"><title>PixelRGBA8->Pixel8</title>+<path fill="none" stroke="black" d="M413.829,-342.599C399.476,-336.131 381.815,-327.451 367,-318 354.878,-310.267 342.394,-300.428 332.048,-291.673"/>+<polygon fill="black" stroke="black" points="334.114,-288.833 324.258,-284.946 329.539,-294.131 334.114,-288.833"/>+<text text-anchor="middle" x="392" y="-310.3" font-family="sans-serif" font-size="8.00">computeLuma</text>+</g>+<!-- PixelF -->+<g id="node14" class="node"><title>PixelF</title>+<ellipse fill="none" stroke="black" cx="106" cy="-186" rx="27" ry="18"/>+<text text-anchor="middle" x="106" y="-184.3" font-family="sans-serif" font-size="8.00">PixelF</text>+</g>+<!-- PixelRGBF->PixelF -->+<g id="edge56" class="edge"><title>PixelRGBF->PixelF</title>+<path fill="none" stroke="black" d="M27.0137,-120.147C24.9943,-129.716 24.4635,-141.251 30,-150 38.9021,-164.067 54.9514,-172.745 70.015,-178.044"/>+<polygon fill="black" stroke="black" points="69.0981,-181.424 79.6867,-181.06 71.1825,-174.741 69.0981,-181.424"/>+<text text-anchor="middle" x="55" y="-142.3" font-family="sans-serif" font-size="8.00">computeLuma</text>+</g>+<!-- PixelYA16 -->+<g id="node9" class="node"><title>PixelYA16</title>+<ellipse fill="none" stroke="black" cx="259" cy="-102" rx="31.7878" ry="18"/>+<text text-anchor="middle" x="259" y="-100.3" font-family="sans-serif" font-size="8.00">PixelYA16</text>+</g>+<!-- PixelYA16->PixelRGBA16 -->+<g id="edge8" class="edge"><title>PixelYA16->PixelRGBA16</title>+<path fill="none" stroke="black" d="M258.152,-83.5434C258.613,-73.883 260.687,-62.36 267,-54 275.273,-43.0444 287.722,-35.28 300.163,-29.8405"/>+<polygon fill="black" stroke="black" points="301.586,-33.0421 309.607,-26.1198 299.02,-26.5294 301.586,-33.0421"/>+<text text-anchor="middle" x="290" y="-58.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- PixelYA16->Pixel16 -->+<g id="edge48" class="edge"><title>PixelYA16->Pixel16</title>+<path fill="none" stroke="black" d="M229.98,-109.854C206.015,-117.845 177.897,-131.656 191,-150 199.293,-161.611 233.125,-171.835 260.175,-178.391"/>+<polygon fill="black" stroke="black" points="259.609,-181.853 270.143,-180.72 261.201,-175.037 259.609,-181.853"/>+<text text-anchor="middle" x="225" y="-142.3" font-family="sans-serif" font-size="8.00">dropTransparency</text>+</g>+<!-- PixelYA8 -->+<g id="node11" class="node"><title>PixelYA8</title>+<ellipse fill="none" stroke="black" cx="439" cy="-186" rx="28.8445" ry="18"/>+<text text-anchor="middle" x="439" y="-184.3" font-family="sans-serif" font-size="8.00">PixelYA8</text>+</g>+<!-- PixelYA8->PixelRGB8 -->+<g id="edge12" class="edge"><title>PixelYA8->PixelRGB8</title>+<path fill="none" stroke="black" d="M464.762,-194.278C489.627,-203.81 525.815,-222.121 542,-252 574.918,-312.769 554.613,-358.387 501,-402 484.752,-415.217 355.671,-428.373 287.639,-434.476"/>+<polygon fill="black" stroke="black" points="287.321,-430.99 277.669,-435.359 287.938,-437.963 287.321,-430.99"/>+<text text-anchor="middle" x="580" y="-310.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- PixelYA8->PixelRGBA8 -->+<g id="edge10" class="edge"><title>PixelYA8->PixelRGBA8</title>+<path fill="none" stroke="black" d="M460.035,-198.84C467.824,-204.817 475.781,-212.68 480,-222 497.598,-260.871 496.093,-278.904 479,-318 476.725,-323.204 473.295,-328.013 469.411,-332.309"/>+<polygon fill="black" stroke="black" points="466.792,-329.975 462.079,-339.464 471.681,-334.985 466.792,-329.975"/>+<text text-anchor="middle" x="515" y="-268.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- PixelYA8->Pixel8 -->+<g id="edge50" class="edge"><title>PixelYA8->Pixel8</title>+<path fill="none" stroke="black" d="M412.102,-193.018C393.267,-198.789 368.145,-208.269 349,-222 340.05,-228.419 331.808,-237.196 325.098,-245.49"/>+<polygon fill="black" stroke="black" points="322.247,-243.456 318.929,-253.518 327.797,-247.721 322.247,-243.456"/>+<text text-anchor="middle" x="383" y="-226.3" font-family="sans-serif" font-size="8.00">dropTransparency</text>+</g>+<!-- PixelYA8->Pixel8 -->+<g id="edge62" class="edge"><title>PixelYA8->Pixel8</title>+<path fill="none" stroke="black" d="M434.558,-204.131C431.244,-214.175 425.744,-226.175 417,-234 397.039,-251.864 367.99,-260.893 344.899,-265.441"/>+<polygon fill="black" stroke="black" points="344.002,-262.045 334.763,-267.23 345.219,-268.938 344.002,-262.045"/>+<text text-anchor="middle" x="451" y="-226.3" font-family="sans-serif" font-size="8.00">computeLuma</text>+</g>+<!-- PixelF->PixelRGBF -->+<g id="edge14" class="edge"><title>PixelF->PixelRGBF</title>+<path fill="none" stroke="black" d="M100.45,-168.312C96.8232,-158.653 91.3784,-146.886 84,-138 78.5966,-131.492 71.7476,-125.606 64.8367,-120.568"/>+<polygon fill="black" stroke="black" points="66.3898,-117.392 56.1539,-114.657 62.4504,-123.178 66.3898,-117.392"/>+<text text-anchor="middle" x="115" y="-142.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel16->PixelRGB16 -->+<g id="edge18" class="edge"><title>Pixel16->PixelRGB16</title>+<path fill="none" stroke="black" d="M313.43,-172.019C326.239,-162.023 344.257,-148.532 361,-138 371.689,-131.277 383.756,-124.61 394.725,-118.875"/>+<polygon fill="black" stroke="black" points="396.336,-121.982 403.628,-114.295 393.134,-115.757 396.336,-121.982"/>+<text text-anchor="middle" x="384" y="-142.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel16->PixelRGBA16 -->+<g id="edge16" class="edge"><title>Pixel16->PixelRGBA16</title>+<path fill="none" stroke="black" d="M305.084,-168.741C307.903,-162.903 310.835,-156.272 313,-150 325.048,-115.091 333.609,-73.3023 338.424,-46.2333"/>+<polygon fill="black" stroke="black" points="341.89,-46.732 340.143,-36.2822 334.992,-45.5405 341.89,-46.732"/>+<text text-anchor="middle" x="353" y="-100.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel16->PixelYA16 -->+<g id="edge20" class="edge"><title>Pixel16->PixelYA16</title>+<path fill="none" stroke="black" d="M280.78,-170.7C275.635,-164.701 270.35,-157.469 267,-150 264.277,-143.93 262.473,-137.052 261.279,-130.438"/>+<polygon fill="black" stroke="black" points="264.727,-129.827 259.862,-120.415 257.796,-130.807 264.727,-129.827"/>+<text text-anchor="middle" x="290" y="-142.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel8->PixelRGB8 -->+<g id="edge24" class="edge"><title>Pixel8->PixelRGB8</title>+<path fill="none" stroke="black" d="M312.919,-288.095C319.136,-314.953 326.712,-366.057 306,-402 300.622,-411.332 291.773,-418.518 282.501,-423.926"/>+<polygon fill="black" stroke="black" points="280.83,-420.85 273.581,-428.577 284.067,-427.057 280.83,-420.85"/>+<text text-anchor="middle" x="342" y="-352.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel8->PixelRGBA8 -->+<g id="edge22" class="edge"><title>Pixel8->PixelRGBA8</title>+<path fill="none" stroke="black" d="M334.939,-272.185C360.073,-275.561 397.177,-284.15 421,-306 426.855,-311.37 431.048,-318.72 434.03,-326.054"/>+<polygon fill="black" stroke="black" points="430.836,-327.531 437.387,-335.858 437.458,-325.263 430.836,-327.531"/>+<text text-anchor="middle" x="452" y="-310.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel8->PixelYA8 -->+<g id="edge26" class="edge"><title>Pixel8->PixelYA8</title>+<path fill="none" stroke="black" d="M290.77,-255.865C280.734,-245.919 271.57,-232.553 280,-222 287.559,-212.538 356.092,-199.635 400.682,-192.122"/>+<polygon fill="black" stroke="black" points="401.335,-195.562 410.626,-190.469 400.187,-188.657 401.335,-195.562"/>+<text text-anchor="middle" x="303" y="-226.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel8->PixelF -->+<g id="edge28" class="edge"><title>Pixel8->PixelF</title>+<path fill="none" stroke="black" d="M281.145,-267.812C249.741,-264.331 196.969,-255.554 157,-234 145.577,-227.84 134.814,-218.473 126.146,-209.643"/>+<polygon fill="black" stroke="black" points="128.492,-207.028 119.104,-202.117 123.381,-211.81 128.492,-207.028"/>+<text text-anchor="middle" x="180" y="-226.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- Pixel8->Pixel16 -->+<g id="edge30" class="edge"><title>Pixel8->Pixel16</title>+<path fill="none" stroke="black" d="M282.206,-263.957C256.398,-257.327 219.359,-246.018 211,-234 196.025,-212.469 230.216,-199.429 259.604,-192.482"/>+<polygon fill="black" stroke="black" points="260.687,-195.828 269.71,-190.275 259.193,-188.989 260.687,-195.828"/>+<text text-anchor="middle" x="234" y="-226.3" font-family="sans-serif" font-size="8.00">promotePixel</text>+</g>+<!-- PixelCMYK16->PixelRGB16 -->+<g id="edge32" class="edge"><title>PixelCMYK16->PixelRGB16</title>+<path fill="none" stroke="black" d="M564.03,-35.4654C568.707,-45.2873 571.707,-57.2873 565,-66 553.678,-80.7091 507.858,-90.6423 472.496,-96.2857"/>+<polygon fill="black" stroke="black" points="471.73,-92.862 462.373,-97.8319 472.787,-99.7817 471.73,-92.862"/>+<text text-anchor="middle" x="590" y="-58.3" font-family="sans-serif" font-size="8.00">convertPixel</text>+</g>+<!-- PixelCMYK8->PixelRGB8 -->+<g id="edge34" class="edge"><title>PixelCMYK8->PixelRGB8</title>+<path fill="none" stroke="black" d="M257.173,-372.299C258.645,-381.28 259.584,-392.241 258,-402 257.535,-404.865 256.875,-407.811 256.1,-410.724"/>+<polygon fill="black" stroke="black" points="252.737,-409.753 253.143,-420.34 259.427,-411.811 252.737,-409.753"/>+<text text-anchor="middle" x="280" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text>+</g>+<!-- PixelYCbCr8->PixelRGB8 -->+<g id="edge36" class="edge"><title>PixelYCbCr8->PixelRGB8</title>+<path fill="none" stroke="black" d="M149.836,-372.162C150.645,-381.97 153.174,-393.727 160,-402 171.431,-415.854 189.112,-424.462 205.475,-429.768"/>+<polygon fill="black" stroke="black" points="204.847,-433.23 215.426,-432.663 206.802,-426.509 204.847,-433.23"/>+<text text-anchor="middle" x="182" y="-394.3" font-family="sans-serif" font-size="8.00">convertPixel</text>+</g>+<!-- PixelYCbCr8->Pixel8 -->+<g id="edge54" class="edge"><title>PixelYCbCr8->Pixel8</title>+<path fill="none" stroke="black" d="M174.688,-340.875C202.411,-326.136 247.432,-302.201 277.376,-286.281"/>+<polygon fill="black" stroke="black" points="279.34,-289.201 286.527,-281.416 276.054,-283.02 279.34,-289.201"/>+<text text-anchor="middle" x="263" y="-310.3" font-family="sans-serif" font-size="8.00">computeLuma</text>+</g>+</g>+</svg>
src/Codec/Picture/ConvGraph.hs view
@@ -1,10 +1,10 @@--- $graph --- --- The following graph describe the differents way to convert between pixel types, --- --- * Nodes describe pixel type --- --- * Arrows describe functions --- --- <<docimages/pixelgraph.svg>> --- +-- $graph+--+-- The following graph describe the differents way to convert between pixel types,+--+-- * Nodes describe pixel type+--+-- * Arrows describe functions+--+-- <<docimages/pixelgraph.svg>>+--
src/Codec/Picture/Gif.hs view
@@ -12,14 +12,19 @@ -- * Writing , GifDelay + , GifDisposalMethod( .. ) + , GifEncode( .. ) + , GifFrame( .. ) , GifLooping( .. ) , encodeGifImage , encodeGifImageWithPalette , encodeGifImages + , encodeComplexGifImage , writeGifImage , writeGifImageWithPalette , writeGifImages + , writeComplexGifImage , greyPalette ) where @@ -28,7 +33,7 @@ #endif import Control.Arrow( first ) -import Control.Monad( replicateM, replicateM_, unless ) +import Control.Monad( replicateM, replicateM_, unless, when ) import Control.Monad.ST( runST ) import Control.Monad.Trans.Class( lift ) @@ -81,6 +86,42 @@ -- | The animation will repeat n times before stoping | LoopingRepeat Word16 + +-- | GIF image definition for encoding +data GifEncode = GifEncode + { -- | Screen width + geWidth :: Int + , -- | Screen height + geHeight :: Int + , -- | Global palette, optional + gePalette :: Maybe Palette + , -- | Background color index, optional. If given, a global palette is also required + geBackground :: Maybe Int + , -- | Looping behaviour + geLooping :: GifLooping + , -- | Image frames + geFrames :: [GifFrame] + } + +-- | An individual image frame in a GIF image +data GifFrame = GifFrame + { -- | Image X offset in GIF canvas + gfXOffset :: Int + , -- | Image Y offset in GIF canvas + gfYOffset :: Int + , -- | Image local palette, optional if a global palette is given + gfPalette :: Maybe Palette + , -- | Transparent color index, optional + gfTransparent :: Maybe Int + , -- | Frame transition delay, in 1/100ths of a second + gfDelay :: GifDelay + , -- | Frame disposal method + gfDisposal :: GifDisposalMethod + , -- | Image pixels + gfPixels :: Image Pixel8 + } + + {- <GIF Data Stream> ::= Header <Logical Screen> <Data>* Trailer @@ -227,14 +268,14 @@ putSlices str = putWord8 (fromIntegral $ B.length str) >> putByteString str -data DisposalMethod +data GifDisposalMethod = DisposalAny | DisposalDoNot | DisposalRestoreBackground | DisposalRestorePrevious | DisposalUnknown Word8 -disposalMethodOfCode :: Word8 -> DisposalMethod +disposalMethodOfCode :: Word8 -> GifDisposalMethod disposalMethodOfCode v = case v of 0 -> DisposalAny 1 -> DisposalDoNot @@ -242,7 +283,7 @@ 3 -> DisposalRestorePrevious n -> DisposalUnknown n -codeOfDisposalMethod :: DisposalMethod -> Word8 +codeOfDisposalMethod :: GifDisposalMethod -> Word8 codeOfDisposalMethod v = case v of DisposalAny -> 0 DisposalDoNot -> 1 @@ -251,7 +292,7 @@ DisposalUnknown n -> n data GraphicControlExtension = GraphicControlExtension - { gceDisposalMethod :: !DisposalMethod -- ^ Stored on 3 bits + { gceDisposalMethod :: !GifDisposalMethod -- ^ Stored on 3 bits , gceUserInputFlag :: !Bool , gceTransparentFlag :: !Bool , gceDelay :: !Word16 @@ -432,7 +473,7 @@ data GifHeader = GifHeader { gifVersion :: GifVersion , gifScreenDescriptor :: LogicalScreenDescriptor - , gifGlobalMap :: !Palette + , gifGlobalMap :: Maybe Palette } instance Binary GifHeader where @@ -440,7 +481,9 @@ put $ gifVersion v let descr = gifScreenDescriptor v put descr - putPalette (fromIntegral $ colorTableSize descr) $ gifGlobalMap v + case gifGlobalMap v of + Just palette -> putPalette (fromIntegral $ colorTableSize descr) palette + Nothing -> return () get = do version <- get @@ -448,9 +491,9 @@ palette <- if hasGlobalMap screenDesc then - getPalette $ colorTableSize screenDesc + return <$> getPalette (colorTableSize screenDesc) else - return greyPalette + return Nothing return GifHeader { gifVersion = version @@ -579,7 +622,7 @@ | not (hasTransparency firstControl) = let backImage = generateImage (\_ _ -> backgroundColor) globalWidth globalHeight - thisPalette = paletteOf palette firstImage + thisPalette = paletteOf globalPalette firstImage baseImage = decodeImage firstImage initState = (thisPalette, firstControl, substituteColors thisPalette baseImage) @@ -598,7 +641,7 @@ generateImage (\_ _ -> transparentBackground) globalWidth globalHeight thisPalette :: Image PixelRGBA8 - thisPalette = paletteOf (promoteImage palette) firstImage + thisPalette = paletteOf (promoteImage globalPalette) firstImage transparentCode = transparentColorOf firstControl decoded = @@ -610,16 +653,17 @@ gifAnimationApplyer (globalWidth, globalHeight) thisPalette backImage in [TrueColorImage $ ImageRGBA8 img | (_, _, img) <- scanl scanner initState rest] - where + where globalWidth = fromIntegral $ screenWidth wholeDescriptor globalHeight = fromIntegral $ screenHeight wholeDescriptor + globalPalette = maybe greyPalette id palette transparentBackground = PixelRGBA8 r g b 0 where PixelRGB8 r g b = backgroundColor backgroundColor | hasGlobalMap wholeDescriptor = - pixelAt palette (fromIntegral $ backgroundIndex wholeDescriptor) 0 + pixelAt globalPalette (fromIntegral $ backgroundIndex wholeDescriptor) 0 | otherwise = PixelRGB8 0 0 0 gifAnimationApplyer :: forall px. (ColorConvertible PixelRGB8 px) @@ -720,6 +764,67 @@ where toGrey x _ = PixelRGB8 ix ix ix where ix = fromIntegral x +checkImageSizes :: GifEncode -> Either String () +checkImageSizes GifEncode { geWidth = width, geHeight = height, geFrames = frames } + | not $ isInBounds width && isInBounds height = Left "Invalid screen bounds" + | not $ null outOfBounds = Left $ "GIF frames with invalid bounds: " ++ show (map snd outOfBounds) + | otherwise = Right () + where isInBounds dim = dim > 0 && dim <= 0xffff + outOfBounds = filter (not . isFrameInBounds . fst) $ zip frames [0 :: Int ..] + isFrameInBounds GifFrame { gfPixels = img } = isInBounds (imageWidth img) && isInBounds (imageHeight img) + +checkImagesInBounds :: GifEncode -> Either String () +checkImagesInBounds GifEncode { geWidth = width, geHeight = height, geFrames = frames } = + if null outOfBounds + then Right () + else Left $ "GIF frames out of screen bounds: " ++ show (map snd outOfBounds) + where outOfBounds = filter (not . isInBounds . fst) $ zip frames [0 :: Int ..] + isInBounds GifFrame { gfXOffset = xOff, gfYOffset = yOff, gfPixels = img } = + xOff >= 0 && yOff >= 0 && + xOff + imageWidth img <= width && yOff + imageHeight img <= height + +checkPaletteValidity :: GifEncode -> Either String () +checkPaletteValidity spec + | not $ isPaletteValid $ gePalette spec = Left "Invalid global palette size" + | not $ null invalidPalettes = Left $ "Invalid palette size in GIF frames: " ++ show (map snd invalidPalettes) + | otherwise = Right () + where invalidPalettes = filter (not . isPaletteValid . gfPalette . fst) $ zip (geFrames spec) [0 :: Int ..] + isPaletteValid Nothing = True + isPaletteValid (Just p) = let w = imageWidth p + h = imageHeight p + in h == 1 && w > 0 && w <= 256 + +checkIndexAbsentFromPalette :: GifEncode -> Either String () +checkIndexAbsentFromPalette GifEncode { gePalette = global, geFrames = frames } = + if null missingPalette + then Right () + else Left $ "GIF image frames with color indexes missing from palette: " ++ show (map snd missingPalette) + where missingPalette = filter (not . checkFrame . fst) $ zip frames [0 :: Int ..] + checkFrame frame = V.all (checkIndexInPalette global (gfPalette frame) . fromIntegral) $ + imageData $ gfPixels frame + +checkBackground :: GifEncode -> Either String () +checkBackground GifEncode { geBackground = Nothing } = Right () +checkBackground GifEncode { gePalette = global, geBackground = Just background } = + if checkIndexInPalette global Nothing background + then Right () + else Left "GIF background index absent from global palette" + +checkTransparencies :: GifEncode -> Either String () +checkTransparencies GifEncode { gePalette = global, geFrames = frames } = + if null missingTransparency + then Right () + else Left $ "GIF transparent index absent from palettes for frames: " ++ show (map snd missingTransparency) + where missingTransparency = filter (not . transparencyOK . fst) $ zip frames [0 :: Int ..] + transparencyOK GifFrame { gfTransparent = Nothing } = True + transparencyOK GifFrame { gfPalette = local, gfTransparent = Just transparent } = + checkIndexInPalette global local transparent + +checkIndexInPalette :: Maybe Palette -> Maybe Palette -> Int -> Bool +checkIndexInPalette Nothing Nothing _ = False +checkIndexInPalette _ (Just local) ix = ix < imageWidth local +checkIndexInPalette (Just global) _ ix = ix < imageWidth global + checkGifImageSizes :: [(a, b, Image px)] -> Bool checkGifImageSizes [] = False checkGifImageSizes ((_, _, img) : rest) = all checkDimension rest @@ -729,95 +834,136 @@ checkDimension (_,_,Image { imageWidth = w, imageHeight = h }) = w == width && h == height -checkPaletteValidity :: [(Palette, a, b)] -> Bool -checkPaletteValidity [] = False -checkPaletteValidity lst = - and [h == 1 && w > 0 && w <= 256 | (p, _, _) <- lst - , let w = imageWidth p - h = imageHeight p ] - -areIndexAbsentFromPalette :: (Palette, a, Image Pixel8) -> Bool -areIndexAbsentFromPalette (palette, _, img) = V.any isTooBig $ imageData img - where paletteElemCount = imageWidth palette - isTooBig v = fromIntegral v >= paletteElemCount - -computeMinimumLzwKeySize :: Palette -> Int -computeMinimumLzwKeySize Image { imageWidth = itemCount } = go 2 +computeColorTableSize :: Palette -> Int +computeColorTableSize Image { imageWidth = itemCount } = go 1 where go k | 2 ^ k >= itemCount = k | otherwise = go $ k + 1 --- | Encode a gif animation to a bytestring. +-- | Encode a complex gif to a bytestring. -- --- * Every image must have the same size +-- * There must be at least one image. -- +-- * The screen and every frame dimensions must be between 1 and 65535. +-- +-- * Every frame image must fit within the screen bounds. +-- -- * Every palette must have between one and 256 colors. -- -encodeGifImages :: GifLooping -> [(Palette, GifDelay, Image Pixel8)] - -> Either String L.ByteString -encodeGifImages _ [] = Left "No image in list" -encodeGifImages _ imageList - | not $ checkGifImageSizes imageList = Left "Gif images have different size" - | not $ checkPaletteValidity imageList = - Left $ "Invalid palette size " ++ concat [show (imageWidth pal) ++ " "| (pal, _, _) <- imageList ] - | any areIndexAbsentFromPalette imageList = Left "Image contains indexes absent from the palette" -encodeGifImages looping imageList@((firstPalette, _,firstImage):_) = Right $ encode allFile +-- * There must be a global palette or every image must have a local palette. +-- +-- * The background color index must be present in the global palette. +-- +-- * Every frame's transparent color index, if set, must be present in the palette used by that frame. +-- +-- * Every color index used in an image must be present in the palette used by that frame. +-- +encodeComplexGifImage :: GifEncode -> Either String L.ByteString +encodeComplexGifImage spec = do + when (null $ geFrames spec) $ Left "No GIF frames" + checkImageSizes spec + checkImagesInBounds spec + checkPaletteValidity spec + checkBackground spec + checkTransparencies spec + checkIndexAbsentFromPalette spec + + Right $ encode allFile where - version = case imageList of + GifEncode { geWidth = width + , geHeight = height + , gePalette = globalPalette + , geBackground = background + , geLooping = looping + , geFrames = frames + } = spec + allFile = GifFile + { gifHeader = GifHeader + { gifVersion = version + , gifScreenDescriptor = logicalScreen + , gifGlobalMap = globalPalette + } + , gifImages = toSerialize + , gifLoopingBehaviour = looping + } + + version = case frames of [] -> GIF87a [_] -> GIF87a _:_:_ -> GIF89a - allFile = GifFile - { gifHeader = GifHeader - { gifVersion = version - , gifScreenDescriptor = logicalScreen - , gifGlobalMap = firstPalette - } - , gifImages = toSerialize - , gifLoopingBehaviour = looping - } - logicalScreen = LogicalScreenDescriptor - { screenWidth = fromIntegral $ imageWidth firstImage - , screenHeight = fromIntegral $ imageHeight firstImage - , backgroundIndex = 0 - , hasGlobalMap = True - , colorResolution = 8 - , isColorTableSorted = False - , colorTableSize = 8 - } + { screenWidth = fromIntegral width + , screenHeight = fromIntegral height + , backgroundIndex = maybe 0 fromIntegral background + , hasGlobalMap = maybe False (const True) globalPalette + , colorResolution = 8 + , isColorTableSorted = False + -- Imply a 8 bit global palette size if there's no explicit global palette. + , colorTableSize = maybe 8 (fromIntegral . computeColorTableSize) globalPalette + } - paletteEqual p = imageData firstPalette == imageData p + toSerialize = [(controlExtension delay transparent disposal, GifImage + { imgDescriptor = imageDescriptor left top localPalette img + , imgLocalPalette = localPalette + , imgLzwRootSize = fromIntegral lzwKeySize + , imgData = B.concat . L.toChunks . lzwEncode lzwKeySize $ imageData img + }) + | GifFrame { gfXOffset = left + , gfYOffset = top + , gfPalette = localPalette + , gfTransparent = transparent + , gfDelay = delay + , gfDisposal = disposal + , gfPixels = img } <- frames + , let palette = case (globalPalette, localPalette) of + (_, Just local) -> local + (Just global, Nothing) -> global + (Nothing, Nothing) -> error "No palette for image" -- redundant, we guard for this + -- Some decoders (looking at you, GIMP) don't handle initial LZW key size of 1 correctly. + -- We'll waste some space for the sake of interoperability + , let lzwKeySize = max 2 $ computeColorTableSize palette + ] - controlExtension 0 = Nothing - controlExtension delay = Just GraphicControlExtension - { gceDisposalMethod = DisposalAny - , gceUserInputFlag = False - , gceTransparentFlag = False - , gceDelay = fromIntegral delay - , gceTransparentColorIndex = 0 - } + controlExtension 0 Nothing DisposalAny = Nothing + controlExtension delay transparent disposal = Just GraphicControlExtension + { gceDisposalMethod = disposal + , gceUserInputFlag = False + , gceTransparentFlag = maybe False (const True) transparent + , gceDelay = fromIntegral delay + , gceTransparentColorIndex = maybe 0 fromIntegral transparent + } - toSerialize = [(controlExtension delay, GifImage - { imgDescriptor = imageDescriptor lzwKeySize (paletteEqual palette) img - , imgLocalPalette = Just palette - , imgLzwRootSize = fromIntegral lzwKeySize - , imgData = B.concat . L.toChunks . lzwEncode lzwKeySize $ imageData img - }) | (palette, delay, img) <- imageList - , let lzwKeySize = computeMinimumLzwKeySize palette - ] + imageDescriptor left top localPalette img = ImageDescriptor + { gDescPixelsFromLeft = fromIntegral left + , gDescPixelsFromTop = fromIntegral top + , gDescImageWidth = fromIntegral $ imageWidth img + , gDescImageHeight = fromIntegral $ imageHeight img + , gDescHasLocalMap = maybe False (const True) localPalette + , gDescIsInterlaced = False + , gDescIsImgDescriptorSorted = False + , gDescLocalColorTableSize = maybe 0 (fromIntegral . computeColorTableSize) localPalette + } - imageDescriptor paletteSize palEqual img = ImageDescriptor - { gDescPixelsFromLeft = 0 - , gDescPixelsFromTop = 0 - , gDescImageWidth = fromIntegral $ imageWidth img - , gDescImageHeight = fromIntegral $ imageHeight img - , gDescHasLocalMap = paletteSize > 0 && not palEqual - , gDescIsInterlaced = False - , gDescIsImgDescriptorSorted = False - , gDescLocalColorTableSize = if palEqual then 0 else fromIntegral paletteSize - } +-- | Encode a gif animation to a bytestring. +-- +-- * Every image must have the same size +-- +-- * Every palette must have between one and 256 colors. +-- +encodeGifImages :: GifLooping -> [(Palette, GifDelay, Image Pixel8)] + -> Either String L.ByteString +encodeGifImages _ [] = Left "No image in list" +encodeGifImages _ imageList + | not $ checkGifImageSizes imageList = Left "Gif images have different size" +encodeGifImages looping imageList@((firstPalette, _,firstImage):_) = + encodeComplexGifImage $ GifEncode (imageWidth firstImage) (imageHeight firstImage) (Just firstPalette) Nothing looping frames + where + frames = [ GifFrame 0 0 localPalette Nothing delay DisposalAny image + | (palette, delay, image) <- imageList + , let localPalette = if paletteEqual palette then Nothing else Just palette ] + paletteEqual p = imageData firstPalette == imageData p + -- | Encode a greyscale image to a bytestring. encodeGifImage :: Image Pixel8 -> L.ByteString encodeGifImage img = case encodeGifImages LoopingNever [(greyPalette, 0, img)] of @@ -856,3 +1002,5 @@ writeGifImageWithPalette file img palette = L.writeFile file <$> encodeGifImageWithPalette img palette +writeComplexGifImage :: FilePath -> GifEncode -> Either String (IO ()) +writeComplexGifImage file spec = L.writeFile file <$> encodeComplexGifImage spec
src/Codec/Picture/Gif/LZW.hs view
@@ -1,194 +1,194 @@-{-# LANGUAGE CPP #-} -module Codec.Picture.Gif.LZW( decodeLzw, decodeLzwTiff ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative( (<$>) ) -#endif - -import Data.Word( Word8 ) -import Control.Monad( when, unless ) - -import Data.Bits( (.&.) ) - -import Control.Monad.ST( ST ) -import Control.Monad.Trans.Class( MonadTrans, lift ) - -import Foreign.Storable ( Storable ) - -import qualified Data.ByteString as B -import qualified Data.Vector.Storable.Mutable as M - -import Codec.Picture.BitWriter - -{-# INLINE (.!!!.) #-} -(.!!!.) :: (Storable a) => M.STVector s a -> Int -> ST s a -(.!!!.) = M.unsafeRead - {-M.read-} - -{-# INLINE (..!!!..) #-} -(..!!!..) :: (MonadTrans t, Storable a) - => M.STVector s a -> Int -> t (ST s) a -(..!!!..) v idx = lift $ v .!!!. idx - -{-# INLINE (.<-.) #-} -(.<-.) :: (Storable a) => M.STVector s a -> Int -> a -> ST s () -(.<-.) = M.unsafeWrite - {-M.write-} - -{-# INLINE (..<-..) #-} -(..<-..) :: (MonadTrans t, Storable a) - => M.STVector s a -> Int -> a -> t (ST s) () -(..<-..) v idx = lift . (v .<-. idx) - - -duplicateData :: (MonadTrans t, Storable a) - => M.STVector s a -> M.STVector s a - -> Int -> Int -> Int -> t (ST s) () -duplicateData src dest sourceIndex size destIndex = lift $ aux sourceIndex destIndex - where endIndex = sourceIndex + size - aux i _ | i == endIndex = return () - aux i j = do - src .!!!. i >>= (dest .<-. j) - aux (i + 1) (j + 1) - -rangeSetter :: (Storable a, Num a) - => Int -> M.STVector s a - -> ST s (M.STVector s a) -rangeSetter count vec = aux 0 - where aux n | n == count = return vec - aux n = (vec .<-. n) (fromIntegral n) >> aux (n + 1) - -decodeLzw :: B.ByteString -> Int -> Int -> M.STVector s Word8 - -> BoolReader s () -decodeLzw str maxBitKey initialKey outVec = do - setDecodedString str - lzw GifVariant maxBitKey initialKey 0 outVec - -isOldTiffLZW :: B.ByteString -> Bool -isOldTiffLZW str = firstByte == 0 && secondByte == 1 - where firstByte = str `B.index` 0 - secondByte = (str `B.index` 1) .&. 1 - -decodeLzwTiff :: B.ByteString -> M.STVector s Word8 -> Int - -> BoolReader s() -decodeLzwTiff str outVec initialWriteIdx = do - if isOldTiffLZW str then - setDecodedString str - else - setDecodedStringMSB str - let variant | isOldTiffLZW str = OldTiffVariant - | otherwise = TiffVariant - lzw variant 12 9 initialWriteIdx outVec - -data TiffVariant = - GifVariant - | TiffVariant - | OldTiffVariant - deriving Eq - --- | Gif image constraint from spec-gif89a, code size max : 12 bits. -lzw :: TiffVariant -> Int -> Int -> Int -> M.STVector s Word8 - -> BoolReader s () -lzw variant nMaxBitKeySize initialKeySize initialWriteIdx outVec = do - -- Allocate buffer of maximum size. - lzwData <- lift (M.replicate maxDataSize 0) >>= resetArray - lzwOffsetTable <- lift (M.replicate tableEntryCount 0) >>= resetArray - lzwSizeTable <- lift $ M.replicate tableEntryCount 0 - lift $ lzwSizeTable `M.set` 1 - - let firstVal code = do - dataOffset <- lzwOffsetTable ..!!!.. code - lzwData ..!!!.. dataOffset - - writeString at code = do - dataOffset <- lzwOffsetTable ..!!!.. code - dataSize <- lzwSizeTable ..!!!.. code - - when (at + dataSize <= maxWrite) $ - duplicateData lzwData outVec dataOffset dataSize at - - return dataSize - - addString pos at code val = do - dataOffset <- lzwOffsetTable ..!!!.. code - dataSize <- lzwSizeTable ..!!!.. code - - when (pos < tableEntryCount) $ do - (lzwOffsetTable ..<-.. pos) at - (lzwSizeTable ..<-.. pos) $ dataSize + 1 - - when (at + dataSize + 1 <= maxDataSize) $ do - duplicateData lzwData lzwData dataOffset dataSize at - (lzwData ..<-.. (at + dataSize)) val - - return $ dataSize + 1 - - maxWrite = M.length outVec - loop outWriteIdx writeIdx dicWriteIdx codeSize oldCode code - | outWriteIdx >= maxWrite = return () - | code == endOfInfo = return () - | code == clearCode = do - toOutput <- getNextCode startCodeSize - unless (toOutput == endOfInfo) $ do - dataSize <- writeString outWriteIdx toOutput - getNextCode startCodeSize >>= - loop (outWriteIdx + dataSize) - firstFreeIndex firstFreeIndex startCodeSize toOutput - - | otherwise = do - (written, dicAdd) <- - if code >= writeIdx then do - c <- firstVal oldCode - wroteSize <- writeString outWriteIdx oldCode - (outVec ..<-.. (outWriteIdx + wroteSize)) c - addedSize <- addString writeIdx dicWriteIdx oldCode c - return (wroteSize + 1, addedSize) - else do - wroteSize <- writeString outWriteIdx code - c <- firstVal code - addedSize <- addString writeIdx dicWriteIdx oldCode c - return (wroteSize, addedSize) - - let new_code_size = updateCodeSize codeSize $ writeIdx + 1 - getNextCode new_code_size >>= - loop (outWriteIdx + written) - (writeIdx + 1) - (dicWriteIdx + dicAdd) - new_code_size - code - - getNextCode startCodeSize >>= - loop initialWriteIdx firstFreeIndex firstFreeIndex startCodeSize 0 - - where tableEntryCount = 2 ^ min 12 nMaxBitKeySize - maxDataSize = tableEntryCount `div` 2 * (1 + tableEntryCount) + 1 - - isNewTiff = variant == TiffVariant - (switchOffset, isTiffVariant) = case variant of - GifVariant -> (0, False) - TiffVariant -> (1, True) - OldTiffVariant -> (0, True) - - initialElementCount = 2 ^ initialKeySize :: Int - clearCode | isTiffVariant = 256 - | otherwise = initialElementCount - - endOfInfo | isTiffVariant = 257 - | otherwise = clearCode + 1 - - startCodeSize - | isTiffVariant = initialKeySize - | otherwise = initialKeySize + 1 - - firstFreeIndex = endOfInfo + 1 - - resetArray a = lift $ rangeSetter initialElementCount a - - updateCodeSize codeSize writeIdx - | writeIdx == 2 ^ codeSize - switchOffset = min 12 $ codeSize + 1 - | otherwise = codeSize - - getNextCode s - | isNewTiff = fromIntegral <$> getNextBitsMSBFirst s - | otherwise = fromIntegral <$> getNextBitsLSBFirst s - +{-# LANGUAGE CPP #-}+module Codec.Picture.Gif.LZW( decodeLzw, decodeLzwTiff ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative( (<$>) )+#endif++import Data.Word( Word8 )+import Control.Monad( when, unless )++import Data.Bits( (.&.) )++import Control.Monad.ST( ST )+import Control.Monad.Trans.Class( MonadTrans, lift )++import Foreign.Storable ( Storable )++import qualified Data.ByteString as B+import qualified Data.Vector.Storable.Mutable as M++import Codec.Picture.BitWriter++{-# INLINE (.!!!.) #-}+(.!!!.) :: (Storable a) => M.STVector s a -> Int -> ST s a+(.!!!.) = M.unsafeRead + {-M.read-}++{-# INLINE (..!!!..) #-}+(..!!!..) :: (MonadTrans t, Storable a)+ => M.STVector s a -> Int -> t (ST s) a+(..!!!..) v idx = lift $ v .!!!. idx++{-# INLINE (.<-.) #-}+(.<-.) :: (Storable a) => M.STVector s a -> Int -> a -> ST s ()+(.<-.) = M.unsafeWrite + {-M.write-}++{-# INLINE (..<-..) #-}+(..<-..) :: (MonadTrans t, Storable a)+ => M.STVector s a -> Int -> a -> t (ST s) ()+(..<-..) v idx = lift . (v .<-. idx)+++duplicateData :: (MonadTrans t, Storable a)+ => M.STVector s a -> M.STVector s a+ -> Int -> Int -> Int -> t (ST s) ()+duplicateData src dest sourceIndex size destIndex = lift $ aux sourceIndex destIndex+ where endIndex = sourceIndex + size+ aux i _ | i == endIndex = return ()+ aux i j = do+ src .!!!. i >>= (dest .<-. j)+ aux (i + 1) (j + 1)++rangeSetter :: (Storable a, Num a)+ => Int -> M.STVector s a+ -> ST s (M.STVector s a)+rangeSetter count vec = aux 0+ where aux n | n == count = return vec+ aux n = (vec .<-. n) (fromIntegral n) >> aux (n + 1)++decodeLzw :: B.ByteString -> Int -> Int -> M.STVector s Word8+ -> BoolReader s ()+decodeLzw str maxBitKey initialKey outVec = do+ setDecodedString str+ lzw GifVariant maxBitKey initialKey 0 outVec++isOldTiffLZW :: B.ByteString -> Bool+isOldTiffLZW str = firstByte == 0 && secondByte == 1+ where firstByte = str `B.index` 0+ secondByte = (str `B.index` 1) .&. 1++decodeLzwTiff :: B.ByteString -> M.STVector s Word8 -> Int+ -> BoolReader s()+decodeLzwTiff str outVec initialWriteIdx = do+ if isOldTiffLZW str then+ setDecodedString str+ else+ setDecodedStringMSB str+ let variant | isOldTiffLZW str = OldTiffVariant+ | otherwise = TiffVariant+ lzw variant 12 9 initialWriteIdx outVec++data TiffVariant =+ GifVariant+ | TiffVariant+ | OldTiffVariant+ deriving Eq++-- | Gif image constraint from spec-gif89a, code size max : 12 bits.+lzw :: TiffVariant -> Int -> Int -> Int -> M.STVector s Word8+ -> BoolReader s ()+lzw variant nMaxBitKeySize initialKeySize initialWriteIdx outVec = do+ -- Allocate buffer of maximum size.+ lzwData <- lift (M.replicate maxDataSize 0) >>= resetArray+ lzwOffsetTable <- lift (M.replicate tableEntryCount 0) >>= resetArray+ lzwSizeTable <- lift $ M.replicate tableEntryCount 0+ lift $ lzwSizeTable `M.set` 1++ let firstVal code = do+ dataOffset <- lzwOffsetTable ..!!!.. code+ lzwData ..!!!.. dataOffset++ writeString at code = do+ dataOffset <- lzwOffsetTable ..!!!.. code+ dataSize <- lzwSizeTable ..!!!.. code++ when (at + dataSize <= maxWrite) $+ duplicateData lzwData outVec dataOffset dataSize at++ return dataSize++ addString pos at code val = do+ dataOffset <- lzwOffsetTable ..!!!.. code+ dataSize <- lzwSizeTable ..!!!.. code++ when (pos < tableEntryCount) $ do+ (lzwOffsetTable ..<-.. pos) at+ (lzwSizeTable ..<-.. pos) $ dataSize + 1++ when (at + dataSize + 1 <= maxDataSize) $ do+ duplicateData lzwData lzwData dataOffset dataSize at+ (lzwData ..<-.. (at + dataSize)) val++ return $ dataSize + 1++ maxWrite = M.length outVec+ loop outWriteIdx writeIdx dicWriteIdx codeSize oldCode code+ | outWriteIdx >= maxWrite = return ()+ | code == endOfInfo = return ()+ | code == clearCode = do+ toOutput <- getNextCode startCodeSize+ unless (toOutput == endOfInfo) $ do+ dataSize <- writeString outWriteIdx toOutput+ getNextCode startCodeSize >>=+ loop (outWriteIdx + dataSize)+ firstFreeIndex firstFreeIndex startCodeSize toOutput++ | otherwise = do+ (written, dicAdd) <-+ if code >= writeIdx then do+ c <- firstVal oldCode+ wroteSize <- writeString outWriteIdx oldCode+ (outVec ..<-.. (outWriteIdx + wroteSize)) c+ addedSize <- addString writeIdx dicWriteIdx oldCode c+ return (wroteSize + 1, addedSize)+ else do+ wroteSize <- writeString outWriteIdx code+ c <- firstVal code+ addedSize <- addString writeIdx dicWriteIdx oldCode c+ return (wroteSize, addedSize)++ let new_code_size = updateCodeSize codeSize $ writeIdx + 1+ getNextCode new_code_size >>=+ loop (outWriteIdx + written)+ (writeIdx + 1)+ (dicWriteIdx + dicAdd)+ new_code_size+ code++ getNextCode startCodeSize >>=+ loop initialWriteIdx firstFreeIndex firstFreeIndex startCodeSize 0++ where tableEntryCount = 2 ^ min 12 nMaxBitKeySize+ maxDataSize = tableEntryCount `div` 2 * (1 + tableEntryCount) + 1++ isNewTiff = variant == TiffVariant+ (switchOffset, isTiffVariant) = case variant of+ GifVariant -> (0, False)+ TiffVariant -> (1, True)+ OldTiffVariant -> (0, True)++ initialElementCount = 2 ^ initialKeySize :: Int+ clearCode | isTiffVariant = 256+ | otherwise = initialElementCount++ endOfInfo | isTiffVariant = 257+ | otherwise = clearCode + 1++ startCodeSize + | isTiffVariant = initialKeySize+ | otherwise = initialKeySize + 1++ firstFreeIndex = endOfInfo + 1++ resetArray a = lift $ rangeSetter initialElementCount a++ updateCodeSize codeSize writeIdx+ | writeIdx == 2 ^ codeSize - switchOffset = min 12 $ codeSize + 1+ | otherwise = codeSize++ getNextCode s + | isNewTiff = fromIntegral <$> getNextBitsMSBFirst s+ | otherwise = fromIntegral <$> getNextBitsLSBFirst s+
src/Codec/Picture/HDR.hs view
@@ -1,530 +1,530 @@-{-# LANGUAGE CPP #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TupleSections #-} --- | Module dedicated of Radiance file decompression (.hdr or .pic) file. --- Radiance file format is used for High dynamic range imaging. -module Codec.Picture.HDR( decodeHDR - , decodeHDRWithMetadata - , encodeHDR - , encodeRawHDR - , encodeRLENewStyleHDR - , writeHDR - , writeRLENewStyleHDR - ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative( pure, (<*>), (<$>) ) -#endif - -import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR ) -import Data.Char( ord, chr, isDigit ) -import Data.Word( Word8 ) -import Data.Monoid( (<>) ) -import Control.Monad( when, foldM, foldM_, forM, forM_, unless ) -import Control.Monad.Trans.Class( lift ) -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Char8 as BC - -import Data.List( partition ) -import Data.Binary( Binary( .. ), encode ) -import Data.Binary.Get( Get, getByteString, getWord8 ) -import Data.Binary.Put( putByteString, putLazyByteString ) - -import Control.Monad.ST( ST, runST ) -import Foreign.Storable ( Storable ) -import Control.Monad.Primitive ( PrimState, PrimMonad ) -import qualified Data.Vector.Storable as V -import qualified Data.Vector.Storable.Mutable as M - -import Codec.Picture.Metadata( Metadatas - , SourceFormat( SourceHDR ) - , basicMetadata ) -import Codec.Picture.InternalHelper -import Codec.Picture.Types -import Codec.Picture.VectorByteConversion - -#if MIN_VERSION_transformers(0, 4, 0) -import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT ) -#else --- Transfomers 0.3 compat -import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT ) - -type ExceptT = ErrorT - -throwE :: (Monad m, Error e) => e -> ErrorT e m a -throwE = throwError - -runExceptT :: ErrorT e m a -> m (Either e a) -runExceptT = runErrorT -#endif - -{-# INLINE (.<<.) #-} -(.<<.), (.>>.) :: (Bits a) => a -> Int -> a -(.<<.) = unsafeShiftL -(.>>.) = unsafeShiftR - -{-# INLINE (.<-.) #-} -(.<-.) :: (PrimMonad m, Storable a) - => M.STVector (PrimState m) a -> Int -> a -> m () -(.<-.) = M.write - {-M.unsafeWrite-} - -type HDRReader s a = ExceptT String (ST s) a - -data RGBE = RGBE !Word8 !Word8 !Word8 !Word8 - -instance Binary RGBE where - put (RGBE r g b e) = put r >> put g >> put b >> put e - get = RGBE <$> get <*> get <*> get <*> get - -checkLineLength :: RGBE -> Int -checkLineLength (RGBE _ _ a b) = - (fromIntegral a .<<. 8) .|. fromIntegral b - -isNewRunLengthMarker :: RGBE -> Bool -isNewRunLengthMarker (RGBE 2 2 _ _) = True -isNewRunLengthMarker _ = False - -data RadianceFormat = - FormatRGBE - | FormatXYZE - -radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString -radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe" -radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze" - -instance Binary RadianceFormat where - put FormatRGBE = putByteString radiance32bitRleRGBEFormat - put FormatXYZE = putByteString radiance32bitRleXYZEFromat - - get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format - where format sig - | sig == radiance32bitRleRGBEFormat = pure FormatRGBE - | sig == radiance32bitRleXYZEFromat = pure FormatXYZE - | otherwise = fail "Unrecognized Radiance format" - -toRGBE :: PixelRGBF -> RGBE -toRGBE (PixelRGBF r g b) - | d <= 1e-32 = RGBE 0 0 0 0 - | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128) - where d = maximum [r, g, b] - e = exponent d - coeff = significand d * 255.9999 / d - fix v = truncate $ v * coeff - - -dropUntil :: Word8 -> Get () -dropUntil c = getWord8 >>= inner - where inner val | val == c = pure () - inner _ = getWord8 >>= inner - -getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString -getUntil f initialAcc = getWord8 >>= inner initialAcc - where inner acc c | f c = pure acc - inner acc c = getWord8 >>= inner (B.snoc acc c) - -data RadianceHeader = RadianceHeader - { radianceInfos :: [(B.ByteString, B.ByteString)] - , radianceFormat :: RadianceFormat - , radianceHeight :: !Int - , radianceWidth :: !Int - , radianceData :: L.ByteString - } - -radianceFileSignature :: B.ByteString -radianceFileSignature = BC.pack "#?RADIANCE\n" - -unpackColor :: L.ByteString -> Int -> RGBE -unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3) - where at n = L.index str . fromIntegral $ idx + n - -storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s () -storeColor vec idx (RGBE r g b e) = do - (vec .<-. (idx + 0)) r - (vec .<-. (idx + 1)) g - (vec .<-. (idx + 2)) b - (vec .<-. (idx + 3)) e - -parsePair :: Char -> Get (B.ByteString, B.ByteString) -parsePair firstChar = do - let eol c = c == fromIntegral (ord '\n') - line <- getUntil eol B.empty - case BC.split '=' line of - [] -> pure (BC.singleton firstChar, B.empty) - [val] -> pure (BC.singleton firstChar, val) - [key, val] -> pure (BC.singleton firstChar <> key, val) - (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals) - -decodeInfos :: Get [(B.ByteString, B.ByteString)] -decodeInfos = do - char <- getChar8 - case char of - -- comment - '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos - -- end of header, no more information - '\n' -> pure [] - -- Classical parsing - c -> (:) <$> parsePair c <*> decodeInfos - - --- | Decode an HDR (radiance) image, the resulting image can be: --- --- * 'ImageRGBF' --- -decodeHDR :: B.ByteString -> Either String DynamicImage -decodeHDR = fmap fst . decodeHDRWithMetadata - --- | Equivalent to decodeHDR but with aditional metadatas. -decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas) -decodeHDRWithMetadata str = runST $ runExceptT $ - case runGet decodeHeader $ L.fromChunks [str] of - Left err -> throwE err - Right rez -> - let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in - (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage) - -getChar8 :: Get Char -getChar8 = chr . fromIntegral <$> getWord8 - -isSign :: Char -> Bool -isSign c = c == '+' || c == '-' - -isAxisLetter :: Char -> Bool -isAxisLetter c = c == 'X' || c == 'Y' - -decodeNum :: Get Int -decodeNum = do - sign <- getChar8 - letter <- getChar8 - space <- getChar8 - - unless (isSign sign && isAxisLetter letter && space == ' ') - (fail "Invalid radiance size declaration") - - let numDec acc c | isDigit c = - getChar8 >>= numDec (acc * 10 + ord c - ord '0') - numDec acc _ - | sign == '-' = pure $ negate acc - | otherwise = pure acc - - getChar8 >>= numDec 0 - -copyPrevColor :: M.STVector s Word8 -> Int -> ST s () -copyPrevColor scanLine idx = do - r <- scanLine `M.unsafeRead` (idx - 4) - g <- scanLine `M.unsafeRead` (idx - 3) - b <- scanLine `M.unsafeRead` (idx - 2) - e <- scanLine `M.unsafeRead` (idx - 1) - - (scanLine `M.unsafeWrite` (idx + 0)) r - (scanLine `M.unsafeWrite` (idx + 1)) g - (scanLine `M.unsafeWrite` (idx + 2)) b - (scanLine `M.unsafeWrite` (idx + 3)) e - -oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 - -> HDRReader s Int -oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0 - where maxOutput = M.length scanLine - maxInput = fromIntegral $ L.length inputData - - inner readIdx writeIdx _ - | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx - inner readIdx writeIdx shift = do - let color@(RGBE r g b e) = unpackColor inputData readIdx - isRun = r == 1 && g == 1 && b == 1 - - if not isRun - then do - lift $ storeColor scanLine writeIdx color - inner (readIdx + 4) (writeIdx + 4) 0 - - else do - let count = fromIntegral e .<<. shift - lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i) - inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8) - -newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8 - -> HDRReader s Int -newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3] - where dataAt idx - | fromIntegral idx >= maxInput = throwE $ "Read index out of bound (" ++ show idx ++ ")" - | otherwise = pure $ L.index inputData (fromIntegral idx) - - maxOutput = M.length scanline - maxInput = fromIntegral $ L.length inputData - stride = 4 - - - strideSet count destIndex _ | endIndex > maxOutput + stride = - throwE $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")" - where endIndex = destIndex + count * stride - strideSet count destIndex val = aux destIndex count - where aux i 0 = pure i - aux i c = do - lift $ (scanline .<-. i) val - aux (i + stride) (c - 1) - - - strideCopy _ count destIndex - | writeEndBound > maxOutput + stride = throwE "Out of bound HDR scanline" - where writeEndBound = destIndex + count * stride - strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count - where aux _ j 0 = pure j - aux i j c = do - val <- dataAt i - lift $ (scanline .<-. j) val - aux (i + 1) (j + stride) (c - 1) - - inner readIdx writeIdx - | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx - inner readIdx writeIdx = do - code <- dataAt readIdx - if code > 128 - then do - let repeatCount = fromIntegral code .&. 0x7F - newVal <- dataAt $ readIdx + 1 - endIndex <- strideSet repeatCount writeIdx newVal - inner (readIdx + 2) endIndex - - else do - let iCode = fromIntegral code - endIndex <- strideCopy (readIdx + 1) iCode writeIdx - inner (readIdx + iCode + 1) endIndex - -instance Binary RadianceHeader where - get = decodeHeader - put hdr = do - putByteString radianceFileSignature - putByteString $ BC.pack "FORMAT=" - put $ radianceFormat hdr - let sizeString = - BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr) - ++ " +X " ++ show (radianceWidth hdr) ++ "\n" - putByteString sizeString - putLazyByteString $ radianceData hdr - - -decodeHeader :: Get RadianceHeader -decodeHeader = do - sig <- getByteString $ B.length radianceFileSignature - when (sig /= radianceFileSignature) - (fail "Invalid radiance file signature") - - infos <- decodeInfos - let formatKey = BC.pack "FORMAT" - case partition (\(k,_) -> k /= formatKey) infos of - (_, []) -> fail "No radiance format specified" - (info, [(_, formatString)]) -> - case runGet get $ L.fromChunks [formatString] of - Left err -> fail err - Right format -> do - (n1, n2, b) <- (,,) <$> decodeNum - <*> decodeNum - <*> getRemainingBytes - return . RadianceHeader info format n1 n2 $ L.fromChunks [b] - - _ -> fail "Multiple radiance format specified" - -toFloat :: RGBE -> PixelRGBF -toFloat (RGBE r g b e) = PixelRGBF rf gf bf - where f = encodeFloat 1 $ fromIntegral e - (128 + 8) - rf = (fromIntegral r + 0.0) * f - gf = (fromIntegral g + 0.0) * f - bf = (fromIntegral b + 0.0) * f - -encodeScanlineColor :: M.STVector s Word8 - -> M.STVector s Word8 - -> Int - -> ST s Int -encodeScanlineColor vec outVec outIdx = do - val <- vec `M.unsafeRead` 0 - runLength 1 0 val 1 outIdx - where maxIndex = M.length vec - - pushRun len val at = do - (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80 - (outVec `M.unsafeWrite` (at + 1)) val - return $ at + 2 - - pushData start len at = do - (outVec `M.unsafeWrite` at) $ fromIntegral len - let first = start - len - end = start - 1 - offset = at - first + 1 - forM_ [first .. end] $ \i -> do - v <- vec `M.unsafeRead` i - (outVec `M.unsafeWrite` (offset + i)) v - - return $ at + len + 1 - - -- End of scanline, empty the thing - runLength run cpy prev idx at | idx >= maxIndex = - case (run, cpy) of - (0, 0) -> pure at - (0, n) -> pushData idx n at - (n, 0) -> pushRun n prev at - (_, _) -> error "HDR - Run length algorithm is wrong" - - -- full runlength, we must write the packet - runLength r@127 _ prev idx at = do - val <- vec `M.unsafeRead` idx - pushRun r prev at >>= - runLength 1 0 val (idx + 1) - - -- full copy, we must write the packet - runLength _ c@127 _ idx at = do - val <- vec `M.unsafeRead` idx - pushData idx c at >>= - runLength 1 0 val (idx + 1) - - runLength n 0 prev idx at = do - val <- vec `M.unsafeRead` idx - case val == prev of - True -> runLength (n + 1) 0 prev (idx + 1) at - False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at - False -> - pushRun n prev at >>= - runLength 1 0 val (idx + 1) - - runLength 0 n prev idx at = do - val <- vec `M.unsafeRead` idx - if val /= prev - then runLength 0 (n + 1) val (idx + 1) at - else - pushData (idx - 1) (n - 1) at >>= - runLength (2 :: Int) 0 val (idx + 1) - - runLength _ _ _ _ _ = - error "HDR RLE inconsistent state" - --- | Write an High dynamic range image into a radiance --- image file on disk. -writeHDR :: FilePath -> Image PixelRGBF -> IO () -writeHDR filename img = L.writeFile filename $ encodeHDR img - --- | Write a RLE encoded High dynamic range image into a radiance --- image file on disk. -writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO () -writeRLENewStyleHDR filename img = - L.writeFile filename $ encodeRLENewStyleHDR img - --- | Encode an High dynamic range image into a radiance image --- file format. --- Alias for encodeRawHDR -encodeHDR :: Image PixelRGBF -> L.ByteString -encodeHDR = encodeRawHDR - --- | Encode an High dynamic range image into a radiance image --- file format. without compression -encodeRawHDR :: Image PixelRGBF -> L.ByteString -encodeRawHDR pic = encode descriptor - where - newImage = pixelMap rgbeInRgba pic - -- we are cheating to death here, the layout we want - -- correspond to the layout of pixelRGBA8, so we - -- convert - rgbeInRgba pixel = PixelRGBA8 r g b e - where RGBE r g b e = toRGBE pixel - - descriptor = RadianceHeader - { radianceInfos = [] - , radianceFormat = FormatRGBE - , radianceHeight = imageHeight pic - , radianceWidth = imageWidth pic - , radianceData = L.fromChunks [toByteString $ imageData newImage] - } - - --- | Encode an High dynamic range image into a radiance image --- file format using a light RLE compression. Some problems --- seem to arise with some image viewer. -encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString -encodeRLENewStyleHDR pic = encode $ runST $ do - let w = imageWidth pic - h = imageHeight pic - - scanLineR <- M.new w :: ST s (M.STVector s Word8) - scanLineG <- M.new w - scanLineB <- M.new w - scanLineE <- M.new w - - encoded <- - forM [0 .. h - 1] $ \line -> do - buff <- M.new $ w * 4 + w `div` 127 + 2 - let columner col | col >= w = return () - columner col = do - let RGBE r g b e = toRGBE $ pixelAt pic col line - (scanLineR `M.unsafeWrite` col) r - (scanLineG `M.unsafeWrite` col) g - (scanLineB `M.unsafeWrite` col) b - (scanLineE `M.unsafeWrite` col) e - - columner (col + 1) - - columner 0 - - (buff `M.unsafeWrite` 0) 2 - (buff `M.unsafeWrite` 1) 2 - (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF) - (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF) - - i1 <- encodeScanlineColor scanLineR buff 4 - i2 <- encodeScanlineColor scanLineG buff i1 - i3 <- encodeScanlineColor scanLineB buff i2 - endIndex <- encodeScanlineColor scanLineE buff i3 - - (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff - - pure RadianceHeader - { radianceInfos = [] - , radianceFormat = FormatRGBE - , radianceHeight = h - , radianceWidth = w - , radianceData = L.fromChunks encoded - } - - -decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF) -decodeRadiancePicture hdr = do - let width = abs $ radianceWidth hdr - height = abs $ radianceHeight hdr - packedData = radianceData hdr - - scanLine <- lift $ M.new $ width * 4 - resultBuffer <- lift $ M.new $ width * height * 3 - - let scanLineImage = MutableImage - { mutableImageWidth = width - , mutableImageHeight = 1 - , mutableImageData = scanLine - } - - finalImage = MutableImage - { mutableImageWidth = width - , mutableImageHeight = height - , mutableImageData = resultBuffer - } - - let scanLineExtractor readIdx line = do - let color = unpackColor packedData readIdx - inner | isNewRunLengthMarker color = do - let calcSize = checkLineLength color - when (calcSize /= width) - (throwE "Invalid sanline size") - pure $ \idx -> newStyleRLE packedData (idx + 4) - | otherwise = pure $ oldStyleRLE packedData - f <- inner - newRead <- f readIdx scanLine - forM_ [0 .. width - 1] $ \i -> do - -- mokay, it's a hack, but I don't want to define a - -- pixel instance of RGBE... - PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0 - lift $ writePixel finalImage i line . toFloat $ RGBE r g b e - - return newRead - - foldM_ scanLineExtractor 0 [0 .. height - 1] - - return finalImage - +{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TupleSections #-}+-- | Module dedicated of Radiance file decompression (.hdr or .pic) file.+-- Radiance file format is used for High dynamic range imaging.+module Codec.Picture.HDR( decodeHDR+ , decodeHDRWithMetadata+ , encodeHDR+ , encodeRawHDR+ , encodeRLENewStyleHDR+ , writeHDR+ , writeRLENewStyleHDR+ ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative( pure, (<*>), (<$>) )+#endif++import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR )+import Data.Char( ord, chr, isDigit )+import Data.Word( Word8 )+import Data.Monoid( (<>) )+import Control.Monad( when, foldM, foldM_, forM, forM_, unless )+import Control.Monad.Trans.Class( lift )+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Char8 as BC++import Data.List( partition )+import Data.Binary( Binary( .. ), encode )+import Data.Binary.Get( Get, getByteString, getWord8 )+import Data.Binary.Put( putByteString, putLazyByteString )++import Control.Monad.ST( ST, runST )+import Foreign.Storable ( Storable )+import Control.Monad.Primitive ( PrimState, PrimMonad )+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as M++import Codec.Picture.Metadata( Metadatas+ , SourceFormat( SourceHDR )+ , basicMetadata )+import Codec.Picture.InternalHelper+import Codec.Picture.Types+import Codec.Picture.VectorByteConversion++#if MIN_VERSION_transformers(0, 4, 0)+import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT )+#else+-- Transfomers 0.3 compat+import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT )++type ExceptT = ErrorT++throwE :: (Monad m, Error e) => e -> ErrorT e m a+throwE = throwError++runExceptT :: ErrorT e m a -> m (Either e a)+runExceptT = runErrorT+#endif++{-# INLINE (.<<.) #-}+(.<<.), (.>>.) :: (Bits a) => a -> Int -> a+(.<<.) = unsafeShiftL+(.>>.) = unsafeShiftR++{-# INLINE (.<-.) #-}+(.<-.) :: (PrimMonad m, Storable a)+ => M.STVector (PrimState m) a -> Int -> a -> m ()+(.<-.) = M.write + {-M.unsafeWrite-}++type HDRReader s a = ExceptT String (ST s) a++data RGBE = RGBE !Word8 !Word8 !Word8 !Word8++instance Binary RGBE where+ put (RGBE r g b e) = put r >> put g >> put b >> put e+ get = RGBE <$> get <*> get <*> get <*> get++checkLineLength :: RGBE -> Int+checkLineLength (RGBE _ _ a b) =+ (fromIntegral a .<<. 8) .|. fromIntegral b++isNewRunLengthMarker :: RGBE -> Bool+isNewRunLengthMarker (RGBE 2 2 _ _) = True+isNewRunLengthMarker _ = False++data RadianceFormat =+ FormatRGBE+ | FormatXYZE++radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString+radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe"+radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze"++instance Binary RadianceFormat where+ put FormatRGBE = putByteString radiance32bitRleRGBEFormat+ put FormatXYZE = putByteString radiance32bitRleXYZEFromat++ get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format+ where format sig+ | sig == radiance32bitRleRGBEFormat = pure FormatRGBE+ | sig == radiance32bitRleXYZEFromat = pure FormatXYZE+ | otherwise = fail "Unrecognized Radiance format"++toRGBE :: PixelRGBF -> RGBE+toRGBE (PixelRGBF r g b)+ | d <= 1e-32 = RGBE 0 0 0 0+ | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128)+ where d = maximum [r, g, b]+ e = exponent d+ coeff = significand d * 255.9999 / d+ fix v = truncate $ v * coeff+++dropUntil :: Word8 -> Get ()+dropUntil c = getWord8 >>= inner+ where inner val | val == c = pure ()+ inner _ = getWord8 >>= inner++getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString+getUntil f initialAcc = getWord8 >>= inner initialAcc+ where inner acc c | f c = pure acc+ inner acc c = getWord8 >>= inner (B.snoc acc c)++data RadianceHeader = RadianceHeader+ { radianceInfos :: [(B.ByteString, B.ByteString)]+ , radianceFormat :: RadianceFormat+ , radianceHeight :: !Int+ , radianceWidth :: !Int+ , radianceData :: L.ByteString+ }++radianceFileSignature :: B.ByteString+radianceFileSignature = BC.pack "#?RADIANCE\n"++unpackColor :: L.ByteString -> Int -> RGBE+unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3)+ where at n = L.index str . fromIntegral $ idx + n++storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s ()+storeColor vec idx (RGBE r g b e) = do+ (vec .<-. (idx + 0)) r+ (vec .<-. (idx + 1)) g+ (vec .<-. (idx + 2)) b+ (vec .<-. (idx + 3)) e++parsePair :: Char -> Get (B.ByteString, B.ByteString)+parsePair firstChar = do+ let eol c = c == fromIntegral (ord '\n')+ line <- getUntil eol B.empty+ case BC.split '=' line of+ [] -> pure (BC.singleton firstChar, B.empty)+ [val] -> pure (BC.singleton firstChar, val)+ [key, val] -> pure (BC.singleton firstChar <> key, val)+ (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals)++decodeInfos :: Get [(B.ByteString, B.ByteString)]+decodeInfos = do+ char <- getChar8+ case char of+ -- comment+ '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos+ -- end of header, no more information+ '\n' -> pure []+ -- Classical parsing+ c -> (:) <$> parsePair c <*> decodeInfos+++-- | Decode an HDR (radiance) image, the resulting image can be:+--+-- * 'ImageRGBF'+--+decodeHDR :: B.ByteString -> Either String DynamicImage+decodeHDR = fmap fst . decodeHDRWithMetadata++-- | Equivalent to decodeHDR but with aditional metadatas.+decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)+decodeHDRWithMetadata str = runST $ runExceptT $+ case runGet decodeHeader $ L.fromChunks [str] of+ Left err -> throwE err+ Right rez ->+ let meta = basicMetadata SourceHDR (abs $ radianceWidth rez) (abs $ radianceHeight rez) in+ (, meta) . ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage)++getChar8 :: Get Char+getChar8 = chr . fromIntegral <$> getWord8++isSign :: Char -> Bool+isSign c = c == '+' || c == '-'++isAxisLetter :: Char -> Bool+isAxisLetter c = c == 'X' || c == 'Y'++decodeNum :: Get Int+decodeNum = do+ sign <- getChar8+ letter <- getChar8+ space <- getChar8++ unless (isSign sign && isAxisLetter letter && space == ' ')+ (fail "Invalid radiance size declaration")++ let numDec acc c | isDigit c =+ getChar8 >>= numDec (acc * 10 + ord c - ord '0')+ numDec acc _+ | sign == '-' = pure $ negate acc+ | otherwise = pure acc++ getChar8 >>= numDec 0++copyPrevColor :: M.STVector s Word8 -> Int -> ST s ()+copyPrevColor scanLine idx = do+ r <- scanLine `M.unsafeRead` (idx - 4)+ g <- scanLine `M.unsafeRead` (idx - 3)+ b <- scanLine `M.unsafeRead` (idx - 2)+ e <- scanLine `M.unsafeRead` (idx - 1)++ (scanLine `M.unsafeWrite` (idx + 0)) r+ (scanLine `M.unsafeWrite` (idx + 1)) g+ (scanLine `M.unsafeWrite` (idx + 2)) b+ (scanLine `M.unsafeWrite` (idx + 3)) e++oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8+ -> HDRReader s Int+oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0+ where maxOutput = M.length scanLine+ maxInput = fromIntegral $ L.length inputData++ inner readIdx writeIdx _+ | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx+ inner readIdx writeIdx shift = do+ let color@(RGBE r g b e) = unpackColor inputData readIdx+ isRun = r == 1 && g == 1 && b == 1++ if not isRun+ then do+ lift $ storeColor scanLine writeIdx color+ inner (readIdx + 4) (writeIdx + 4) 0+ + else do+ let count = fromIntegral e .<<. shift+ lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i)+ inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8)++newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8+ -> HDRReader s Int+newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3]+ where dataAt idx+ | fromIntegral idx >= maxInput = throwE $ "Read index out of bound (" ++ show idx ++ ")"+ | otherwise = pure $ L.index inputData (fromIntegral idx)++ maxOutput = M.length scanline+ maxInput = fromIntegral $ L.length inputData+ stride = 4+++ strideSet count destIndex _ | endIndex > maxOutput + stride =+ throwE $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")"+ where endIndex = destIndex + count * stride+ strideSet count destIndex val = aux destIndex count+ where aux i 0 = pure i+ aux i c = do+ lift $ (scanline .<-. i) val+ aux (i + stride) (c - 1)+++ strideCopy _ count destIndex+ | writeEndBound > maxOutput + stride = throwE "Out of bound HDR scanline"+ where writeEndBound = destIndex + count * stride+ strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count+ where aux _ j 0 = pure j+ aux i j c = do+ val <- dataAt i+ lift $ (scanline .<-. j) val+ aux (i + 1) (j + stride) (c - 1)++ inner readIdx writeIdx+ | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx+ inner readIdx writeIdx = do+ code <- dataAt readIdx+ if code > 128+ then do+ let repeatCount = fromIntegral code .&. 0x7F+ newVal <- dataAt $ readIdx + 1+ endIndex <- strideSet repeatCount writeIdx newVal+ inner (readIdx + 2) endIndex ++ else do+ let iCode = fromIntegral code+ endIndex <- strideCopy (readIdx + 1) iCode writeIdx+ inner (readIdx + iCode + 1) endIndex++instance Binary RadianceHeader where+ get = decodeHeader+ put hdr = do+ putByteString radianceFileSignature+ putByteString $ BC.pack "FORMAT="+ put $ radianceFormat hdr+ let sizeString =+ BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr)+ ++ " +X " ++ show (radianceWidth hdr) ++ "\n"+ putByteString sizeString+ putLazyByteString $ radianceData hdr+++decodeHeader :: Get RadianceHeader+decodeHeader = do+ sig <- getByteString $ B.length radianceFileSignature+ when (sig /= radianceFileSignature)+ (fail "Invalid radiance file signature")++ infos <- decodeInfos+ let formatKey = BC.pack "FORMAT"+ case partition (\(k,_) -> k /= formatKey) infos of+ (_, []) -> fail "No radiance format specified"+ (info, [(_, formatString)]) ->+ case runGet get $ L.fromChunks [formatString] of+ Left err -> fail err+ Right format -> do+ (n1, n2, b) <- (,,) <$> decodeNum+ <*> decodeNum+ <*> getRemainingBytes+ return . RadianceHeader info format n1 n2 $ L.fromChunks [b]++ _ -> fail "Multiple radiance format specified"++toFloat :: RGBE -> PixelRGBF+toFloat (RGBE r g b e) = PixelRGBF rf gf bf+ where f = encodeFloat 1 $ fromIntegral e - (128 + 8)+ rf = (fromIntegral r + 0.0) * f+ gf = (fromIntegral g + 0.0) * f+ bf = (fromIntegral b + 0.0) * f++encodeScanlineColor :: M.STVector s Word8+ -> M.STVector s Word8+ -> Int+ -> ST s Int+encodeScanlineColor vec outVec outIdx = do+ val <- vec `M.unsafeRead` 0+ runLength 1 0 val 1 outIdx+ where maxIndex = M.length vec++ pushRun len val at = do+ (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80+ (outVec `M.unsafeWrite` (at + 1)) val+ return $ at + 2++ pushData start len at = do+ (outVec `M.unsafeWrite` at) $ fromIntegral len+ let first = start - len+ end = start - 1+ offset = at - first + 1+ forM_ [first .. end] $ \i -> do+ v <- vec `M.unsafeRead` i+ (outVec `M.unsafeWrite` (offset + i)) v++ return $ at + len + 1++ -- End of scanline, empty the thing+ runLength run cpy prev idx at | idx >= maxIndex =+ case (run, cpy) of+ (0, 0) -> pure at+ (0, n) -> pushData idx n at+ (n, 0) -> pushRun n prev at+ (_, _) -> error "HDR - Run length algorithm is wrong"++ -- full runlength, we must write the packet+ runLength r@127 _ prev idx at = do+ val <- vec `M.unsafeRead` idx+ pushRun r prev at >>=+ runLength 1 0 val (idx + 1)++ -- full copy, we must write the packet+ runLength _ c@127 _ idx at = do+ val <- vec `M.unsafeRead` idx+ pushData idx c at >>=+ runLength 1 0 val (idx + 1)++ runLength n 0 prev idx at = do+ val <- vec `M.unsafeRead` idx+ case val == prev of+ True -> runLength (n + 1) 0 prev (idx + 1) at+ False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at+ False ->+ pushRun n prev at >>=+ runLength 1 0 val (idx + 1)++ runLength 0 n prev idx at = do+ val <- vec `M.unsafeRead` idx+ if val /= prev+ then runLength 0 (n + 1) val (idx + 1) at+ else+ pushData (idx - 1) (n - 1) at >>=+ runLength (2 :: Int) 0 val (idx + 1)++ runLength _ _ _ _ _ =+ error "HDR RLE inconsistent state"++-- | Write an High dynamic range image into a radiance+-- image file on disk.+writeHDR :: FilePath -> Image PixelRGBF -> IO ()+writeHDR filename img = L.writeFile filename $ encodeHDR img++-- | Write a RLE encoded High dynamic range image into a radiance+-- image file on disk.+writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO ()+writeRLENewStyleHDR filename img =+ L.writeFile filename $ encodeRLENewStyleHDR img++-- | Encode an High dynamic range image into a radiance image+-- file format.+-- Alias for encodeRawHDR+encodeHDR :: Image PixelRGBF -> L.ByteString+encodeHDR = encodeRawHDR++-- | Encode an High dynamic range image into a radiance image+-- file format. without compression+encodeRawHDR :: Image PixelRGBF -> L.ByteString+encodeRawHDR pic = encode descriptor+ where+ newImage = pixelMap rgbeInRgba pic+ -- we are cheating to death here, the layout we want+ -- correspond to the layout of pixelRGBA8, so we+ -- convert+ rgbeInRgba pixel = PixelRGBA8 r g b e+ where RGBE r g b e = toRGBE pixel++ descriptor = RadianceHeader+ { radianceInfos = []+ , radianceFormat = FormatRGBE+ , radianceHeight = imageHeight pic+ , radianceWidth = imageWidth pic+ , radianceData = L.fromChunks [toByteString $ imageData newImage]+ }+++-- | Encode an High dynamic range image into a radiance image+-- file format using a light RLE compression. Some problems+-- seem to arise with some image viewer.+encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString+encodeRLENewStyleHDR pic = encode $ runST $ do+ let w = imageWidth pic+ h = imageHeight pic++ scanLineR <- M.new w :: ST s (M.STVector s Word8)+ scanLineG <- M.new w+ scanLineB <- M.new w+ scanLineE <- M.new w++ encoded <-+ forM [0 .. h - 1] $ \line -> do+ buff <- M.new $ w * 4 + w `div` 127 + 2+ let columner col | col >= w = return ()+ columner col = do+ let RGBE r g b e = toRGBE $ pixelAt pic col line+ (scanLineR `M.unsafeWrite` col) r+ (scanLineG `M.unsafeWrite` col) g+ (scanLineB `M.unsafeWrite` col) b+ (scanLineE `M.unsafeWrite` col) e++ columner (col + 1)++ columner 0++ (buff `M.unsafeWrite` 0) 2+ (buff `M.unsafeWrite` 1) 2+ (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF)+ (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF)++ i1 <- encodeScanlineColor scanLineR buff 4 + i2 <- encodeScanlineColor scanLineG buff i1+ i3 <- encodeScanlineColor scanLineB buff i2+ endIndex <- encodeScanlineColor scanLineE buff i3++ (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff++ pure RadianceHeader+ { radianceInfos = []+ , radianceFormat = FormatRGBE+ , radianceHeight = h+ , radianceWidth = w+ , radianceData = L.fromChunks encoded + }+ ++decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)+decodeRadiancePicture hdr = do+ let width = abs $ radianceWidth hdr+ height = abs $ radianceHeight hdr+ packedData = radianceData hdr++ scanLine <- lift $ M.new $ width * 4+ resultBuffer <- lift $ M.new $ width * height * 3++ let scanLineImage = MutableImage+ { mutableImageWidth = width+ , mutableImageHeight = 1+ , mutableImageData = scanLine+ }++ finalImage = MutableImage+ { mutableImageWidth = width+ , mutableImageHeight = height+ , mutableImageData = resultBuffer+ }++ let scanLineExtractor readIdx line = do+ let color = unpackColor packedData readIdx+ inner | isNewRunLengthMarker color = do+ let calcSize = checkLineLength color+ when (calcSize /= width)+ (throwE "Invalid sanline size")+ pure $ \idx -> newStyleRLE packedData (idx + 4)+ | otherwise = pure $ oldStyleRLE packedData+ f <- inner+ newRead <- f readIdx scanLine+ forM_ [0 .. width - 1] $ \i -> do+ -- mokay, it's a hack, but I don't want to define a+ -- pixel instance of RGBE...+ PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0+ lift $ writePixel finalImage i line . toFloat $ RGBE r g b e++ return newRead++ foldM_ scanLineExtractor 0 [0 .. height - 1]++ return finalImage+
src/Codec/Picture/InternalHelper.hs view
@@ -1,51 +1,51 @@-{-# LANGUAGE CPP #-} -module Codec.Picture.InternalHelper ( runGet - , runGetStrict - , decode - , getRemainingBytes - , getRemainingLazyBytes ) where - -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import Data.Binary( Binary( get ) ) -import Data.Binary.Get( Get - , getRemainingLazyByteString - ) -import qualified Data.Binary.Get as G - -#if MIN_VERSION_binary(0,6,4) -#else -import Control.Applicative( (<$>) ) -import qualified Control.Exception as E --- I feel so dirty. :( -import System.IO.Unsafe( unsafePerformIO ) -#endif - -decode :: (Binary a) => B.ByteString -> Either String a -decode = runGetStrict get - -runGet :: Get a -> L.ByteString -> Either String a -#if MIN_VERSION_binary(0,6,4) -runGet act = unpack . G.runGetOrFail act - where unpack (Left (_, _, str)) = Left str - unpack (Right (_, _, element)) = Right element -#else -runGet act str = unsafePerformIO $ E.catch - (Right <$> E.evaluate (G.runGet act str)) - (\msg -> return . Left $ show (msg :: E.SomeException)) -#endif - -runGetStrict :: Get a -> B.ByteString -> Either String a -runGetStrict act buffer = runGet act $ L.fromChunks [buffer] - -getRemainingBytes :: Get B.ByteString -getRemainingBytes = do - rest <- getRemainingLazyByteString - return $ case L.toChunks rest of - [] -> B.empty - [a] -> a - lst -> B.concat lst - -getRemainingLazyBytes :: Get L.ByteString -getRemainingLazyBytes = getRemainingLazyByteString - +{-# LANGUAGE CPP #-}+module Codec.Picture.InternalHelper ( runGet+ , runGetStrict+ , decode+ , getRemainingBytes+ , getRemainingLazyBytes ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Binary( Binary( get ) )+import Data.Binary.Get( Get+ , getRemainingLazyByteString+ )+import qualified Data.Binary.Get as G++#if MIN_VERSION_binary(0,6,4)+#else+import Control.Applicative( (<$>) )+import qualified Control.Exception as E+-- I feel so dirty. :(+import System.IO.Unsafe( unsafePerformIO )+#endif++decode :: (Binary a) => B.ByteString -> Either String a+decode = runGetStrict get++runGet :: Get a -> L.ByteString -> Either String a+#if MIN_VERSION_binary(0,6,4)+runGet act = unpack . G.runGetOrFail act+ where unpack (Left (_, _, str)) = Left str+ unpack (Right (_, _, element)) = Right element+#else+runGet act str = unsafePerformIO $ E.catch+ (Right <$> E.evaluate (G.runGet act str))+ (\msg -> return . Left $ show (msg :: E.SomeException))+#endif++runGetStrict :: Get a -> B.ByteString -> Either String a+runGetStrict act buffer = runGet act $ L.fromChunks [buffer]++getRemainingBytes :: Get B.ByteString+getRemainingBytes = do+ rest <- getRemainingLazyByteString + return $ case L.toChunks rest of+ [] -> B.empty+ [a] -> a+ lst -> B.concat lst++getRemainingLazyBytes :: Get L.ByteString+getRemainingLazyBytes = getRemainingLazyByteString +
src/Codec/Picture/Jpg/FastDct.hs view
@@ -1,218 +1,218 @@-{-# LANGUAGE CPP #-} -{-# LANGUAGE TypeFamilies #-} -module Codec.Picture.Jpg.FastDct( referenceDct, fastDctLibJpeg ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative( (<$>) ) -#endif - -import Data.Int( Int16, Int32 ) -import Data.Bits( unsafeShiftR, unsafeShiftL ) -import Control.Monad.ST( ST ) - -import qualified Data.Vector.Storable.Mutable as M - -import Codec.Picture.Jpg.Types -import Control.Monad( forM, forM_ ) - --- | Reference implementation of the DCT, directly implementing the formula --- of ITU-81. It's slow as hell, perform to many operations, but is accurate --- and a good reference point. -referenceDct :: MutableMacroBlock s Int32 - -> MutableMacroBlock s Int16 - -> ST s (MutableMacroBlock s Int32) -referenceDct workData block = do - forM_ [(u, v) | u <- [0 :: Int .. dctBlockSize - 1], v <- [0..dctBlockSize - 1]] $ \(u,v) -> do - val <- at (u,v) - (workData `M.unsafeWrite` (v * dctBlockSize + u)) . truncate $ (1 / 4) * c u * c v * val - - return workData - where -- at :: (Int, Int) -> ST s Float - at (u,v) = do - toSum <- - forM [(x,y) | x <- [0..dctBlockSize - 1], y <- [0..dctBlockSize - 1 :: Int]] $ \(x,y) -> do - sample <- fromIntegral <$> (block `M.unsafeRead` (y * dctBlockSize + x)) - return $ sample * cos ((2 * fromIntegral x + 1) * fromIntegral u * (pi :: Float)/ 16) - * cos ((2 * fromIntegral y + 1) * fromIntegral v * pi / 16) - return $ sum toSum - - c 0 = 1 / sqrt 2 - c _ = 1 - -pASS1_BITS, cONST_BITS :: Int -cONST_BITS = 13 -pASS1_BITS = 2 - - -fIX_0_298631336, fIX_0_390180644, fIX_0_541196100, - fIX_0_765366865, fIX_0_899976223, fIX_1_175875602, - fIX_1_501321110, fIX_1_847759065, fIX_1_961570560, - fIX_2_053119869, fIX_2_562915447, fIX_3_072711026 :: Int32 -fIX_0_298631336 = 2446 -- FIX(0.298631336) */ -fIX_0_390180644 = 3196 -- FIX(0.390180644) */ -fIX_0_541196100 = 4433 -- FIX(0.541196100) */ -fIX_0_765366865 = 6270 -- FIX(0.765366865) */ -fIX_0_899976223 = 7373 -- FIX(0.899976223) */ -fIX_1_175875602 = 9633 -- FIX(1.175875602) */ -fIX_1_501321110 = 12299 -- FIX(1.501321110) */ -fIX_1_847759065 = 15137 -- FIX(1.847759065) */ -fIX_1_961570560 = 16069 -- FIX(1.961570560) */ -fIX_2_053119869 = 16819 -- FIX(2.053119869) */ -fIX_2_562915447 = 20995 -- FIX(2.562915447) */ -fIX_3_072711026 = 25172 -- FIX(3.072711026) */ - -cENTERJSAMPLE :: Int32 -cENTERJSAMPLE = 128 - --- | Fast DCT extracted from libjpeg -fastDctLibJpeg :: MutableMacroBlock s Int32 - -> MutableMacroBlock s Int16 - -> ST s (MutableMacroBlock s Int32) -fastDctLibJpeg workData sample_block = do - firstPass workData 0 - secondPass workData 7 - {-_ <- mutate (\_ a -> a `quot` 8) workData-} - return workData - where -- Pass 1: process rows. - -- Note results are scaled up by sqrt(8) compared to a true DCT; - -- furthermore, we scale the results by 2**PASS1_BITS. - firstPass _ i | i == dctBlockSize = return () - firstPass dataBlock i = do - let baseIdx = i * dctBlockSize - readAt idx = fromIntegral <$> sample_block `M.unsafeRead` (baseIdx + idx) - mult = (*) - writeAt idx = dataBlock `M.unsafeWrite` (baseIdx + idx) - writeAtPos idx n = (dataBlock `M.unsafeWrite` (baseIdx + idx)) - (n `unsafeShiftR` (cONST_BITS - pASS1_BITS)) - - blk0 <- readAt 0 - blk1 <- readAt 1 - blk2 <- readAt 2 - blk3 <- readAt 3 - blk4 <- readAt 4 - blk5 <- readAt 5 - blk6 <- readAt 6 - blk7 <- readAt 7 - - let tmp0 = blk0 + blk7 - tmp1 = blk1 + blk6 - tmp2 = blk2 + blk5 - tmp3 = blk3 + blk4 - - tmp10 = tmp0 + tmp3 - tmp12 = tmp0 - tmp3 - tmp11 = tmp1 + tmp2 - tmp13 = tmp1 - tmp2 - - tmp0' = blk0 - blk7 - tmp1' = blk1 - blk6 - tmp2' = blk2 - blk5 - tmp3' = blk3 - blk4 - - -- Stage 4 and output - writeAt 0 $ (tmp10 + tmp11 - dctBlockSize * cENTERJSAMPLE) `unsafeShiftL` pASS1_BITS - writeAt 4 $ (tmp10 - tmp11) `unsafeShiftL` pASS1_BITS - - let z1 = mult (tmp12 + tmp13) fIX_0_541196100 - + (1 `unsafeShiftL` (cONST_BITS - pASS1_BITS - 1)) - - writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865 - writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065 - - let tmp10' = tmp0' + tmp3' - tmp11' = tmp1' + tmp2' - tmp12' = tmp0' + tmp2' - tmp13' = tmp1' + tmp3' - z1' = mult (tmp12' + tmp13') fIX_1_175875602 -- c3 */ - -- Add fudge factor here for final descale. */ - + (1 `unsafeShiftL` (cONST_BITS - pASS1_BITS-1)) - tmp0'' = mult tmp0' fIX_1_501321110 - tmp1'' = mult tmp1' fIX_3_072711026 - tmp2'' = mult tmp2' fIX_2_053119869 - tmp3'' = mult tmp3' fIX_0_298631336 - - tmp10'' = mult tmp10' (- fIX_0_899976223) - tmp11'' = mult tmp11' (- fIX_2_562915447) - tmp12'' = mult tmp12' (- fIX_0_390180644) + z1' - tmp13'' = mult tmp13' (- fIX_1_961570560) + z1' - - writeAtPos 1 $ tmp0'' + tmp10'' + tmp12'' - writeAtPos 3 $ tmp1'' + tmp11'' + tmp13'' - writeAtPos 5 $ tmp2'' + tmp11'' + tmp12'' - writeAtPos 7 $ tmp3'' + tmp10'' + tmp13'' - - firstPass dataBlock $ i + 1 - - -- Pass 2: process columns. - -- We remove the PASS1_BITS scaling, but leave the results scaled up - -- by an overall factor of 8. - secondPass :: M.STVector s Int32 -> Int -> ST s () - secondPass _ (-1) = return () - secondPass block i = do - let readAt idx = block `M.unsafeRead` ((7 - i) + idx * dctBlockSize) - mult = (*) - writeAt idx = block `M.unsafeWrite` (dctBlockSize * idx + (7 - i)) - writeAtPos idx n = (block `M.unsafeWrite` (dctBlockSize * idx + (7 - i))) $ n `unsafeShiftR` (cONST_BITS + pASS1_BITS + 3) - blk0 <- readAt 0 - blk1 <- readAt 1 - blk2 <- readAt 2 - blk3 <- readAt 3 - blk4 <- readAt 4 - blk5 <- readAt 5 - blk6 <- readAt 6 - blk7 <- readAt 7 - - let tmp0 = blk0 + blk7 - tmp1 = blk1 + blk6 - tmp2 = blk2 + blk5 - tmp3 = blk3 + blk4 - - -- Add fudge factor here for final descale. */ - tmp10 = tmp0 + tmp3 + (1 `unsafeShiftL` (pASS1_BITS-1)) - tmp12 = tmp0 - tmp3 - tmp11 = tmp1 + tmp2 - tmp13 = tmp1 - tmp2 - - tmp0' = blk0 - blk7 - tmp1' = blk1 - blk6 - tmp2' = blk2 - blk5 - tmp3' = blk3 - blk4 - - writeAt 0 $ (tmp10 + tmp11) `unsafeShiftR` (pASS1_BITS + 3) - writeAt 4 $ (tmp10 - tmp11) `unsafeShiftR` (pASS1_BITS + 3) - - let z1 = mult (tmp12 + tmp13) fIX_0_541196100 - + (1 `unsafeShiftL` (cONST_BITS + pASS1_BITS - 1)) - - writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865 - writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065 - - let tmp10' = tmp0' + tmp3' - tmp11' = tmp1' + tmp2' - tmp12' = tmp0' + tmp2' - tmp13' = tmp1' + tmp3' - - z1' = mult (tmp12' + tmp13') fIX_1_175875602 - -- Add fudge factor here for final descale. */ - + 1 `unsafeShiftL` (cONST_BITS+pASS1_BITS-1); - - tmp0'' = mult tmp0' fIX_1_501321110 - tmp1'' = mult tmp1' fIX_3_072711026 - tmp2'' = mult tmp2' fIX_2_053119869 - tmp3'' = mult tmp3' fIX_0_298631336 - tmp10'' = mult tmp10' (- fIX_0_899976223) - tmp11'' = mult tmp11' (- fIX_2_562915447) - tmp12'' = mult tmp12' (- fIX_0_390180644) - + z1' - tmp13'' = mult tmp13' (- fIX_1_961570560) - + z1' - writeAtPos 1 $ tmp0'' + tmp10'' + tmp12'' - writeAtPos 3 $ tmp1'' + tmp11'' + tmp13'' - writeAtPos 5 $ tmp2'' + tmp11'' + tmp12'' - writeAtPos 7 $ tmp3'' + tmp10'' + tmp13'' - - secondPass block (i - 1) - -{-# ANN module "HLint: ignore Use camelCase" #-} -{-# ANN module "HLint: ignore Reduce duplication" #-} - +{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+module Codec.Picture.Jpg.FastDct( referenceDct, fastDctLibJpeg ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative( (<$>) )+#endif++import Data.Int( Int16, Int32 )+import Data.Bits( unsafeShiftR, unsafeShiftL )+import Control.Monad.ST( ST )++import qualified Data.Vector.Storable.Mutable as M++import Codec.Picture.Jpg.Types+import Control.Monad( forM, forM_ )++-- | Reference implementation of the DCT, directly implementing the formula+-- of ITU-81. It's slow as hell, perform to many operations, but is accurate+-- and a good reference point.+referenceDct :: MutableMacroBlock s Int32+ -> MutableMacroBlock s Int16+ -> ST s (MutableMacroBlock s Int32)+referenceDct workData block = do+ forM_ [(u, v) | u <- [0 :: Int .. dctBlockSize - 1], v <- [0..dctBlockSize - 1]] $ \(u,v) -> do+ val <- at (u,v)+ (workData `M.unsafeWrite` (v * dctBlockSize + u)) . truncate $ (1 / 4) * c u * c v * val++ return workData+ where -- at :: (Int, Int) -> ST s Float+ at (u,v) = do+ toSum <-+ forM [(x,y) | x <- [0..dctBlockSize - 1], y <- [0..dctBlockSize - 1 :: Int]] $ \(x,y) -> do+ sample <- fromIntegral <$> (block `M.unsafeRead` (y * dctBlockSize + x))+ return $ sample * cos ((2 * fromIntegral x + 1) * fromIntegral u * (pi :: Float)/ 16) + * cos ((2 * fromIntegral y + 1) * fromIntegral v * pi / 16)+ return $ sum toSum++ c 0 = 1 / sqrt 2+ c _ = 1++pASS1_BITS, cONST_BITS :: Int+cONST_BITS = 13+pASS1_BITS = 2+++fIX_0_298631336, fIX_0_390180644, fIX_0_541196100,+ fIX_0_765366865, fIX_0_899976223, fIX_1_175875602,+ fIX_1_501321110, fIX_1_847759065, fIX_1_961570560,+ fIX_2_053119869, fIX_2_562915447, fIX_3_072711026 :: Int32+fIX_0_298631336 = 2446 -- FIX(0.298631336) */+fIX_0_390180644 = 3196 -- FIX(0.390180644) */+fIX_0_541196100 = 4433 -- FIX(0.541196100) */+fIX_0_765366865 = 6270 -- FIX(0.765366865) */+fIX_0_899976223 = 7373 -- FIX(0.899976223) */+fIX_1_175875602 = 9633 -- FIX(1.175875602) */+fIX_1_501321110 = 12299 -- FIX(1.501321110) */+fIX_1_847759065 = 15137 -- FIX(1.847759065) */+fIX_1_961570560 = 16069 -- FIX(1.961570560) */+fIX_2_053119869 = 16819 -- FIX(2.053119869) */+fIX_2_562915447 = 20995 -- FIX(2.562915447) */+fIX_3_072711026 = 25172 -- FIX(3.072711026) */++cENTERJSAMPLE :: Int32+cENTERJSAMPLE = 128++-- | Fast DCT extracted from libjpeg+fastDctLibJpeg :: MutableMacroBlock s Int32+ -> MutableMacroBlock s Int16+ -> ST s (MutableMacroBlock s Int32)+fastDctLibJpeg workData sample_block = do+ firstPass workData 0+ secondPass workData 7+ {-_ <- mutate (\_ a -> a `quot` 8) workData-}+ return workData+ where -- Pass 1: process rows.+ -- Note results are scaled up by sqrt(8) compared to a true DCT;+ -- furthermore, we scale the results by 2**PASS1_BITS.+ firstPass _ i | i == dctBlockSize = return ()+ firstPass dataBlock i = do+ let baseIdx = i * dctBlockSize+ readAt idx = fromIntegral <$> sample_block `M.unsafeRead` (baseIdx + idx)+ mult = (*)+ writeAt idx = dataBlock `M.unsafeWrite` (baseIdx + idx)+ writeAtPos idx n = (dataBlock `M.unsafeWrite` (baseIdx + idx))+ (n `unsafeShiftR` (cONST_BITS - pASS1_BITS))++ blk0 <- readAt 0+ blk1 <- readAt 1+ blk2 <- readAt 2+ blk3 <- readAt 3+ blk4 <- readAt 4+ blk5 <- readAt 5+ blk6 <- readAt 6+ blk7 <- readAt 7++ let tmp0 = blk0 + blk7+ tmp1 = blk1 + blk6+ tmp2 = blk2 + blk5+ tmp3 = blk3 + blk4++ tmp10 = tmp0 + tmp3+ tmp12 = tmp0 - tmp3+ tmp11 = tmp1 + tmp2+ tmp13 = tmp1 - tmp2++ tmp0' = blk0 - blk7+ tmp1' = blk1 - blk6+ tmp2' = blk2 - blk5+ tmp3' = blk3 - blk4++ -- Stage 4 and output+ writeAt 0 $ (tmp10 + tmp11 - dctBlockSize * cENTERJSAMPLE) `unsafeShiftL` pASS1_BITS+ writeAt 4 $ (tmp10 - tmp11) `unsafeShiftL` pASS1_BITS++ let z1 = mult (tmp12 + tmp13) fIX_0_541196100+ + (1 `unsafeShiftL` (cONST_BITS - pASS1_BITS - 1))++ writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865+ writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065++ let tmp10' = tmp0' + tmp3'+ tmp11' = tmp1' + tmp2'+ tmp12' = tmp0' + tmp2'+ tmp13' = tmp1' + tmp3'+ z1' = mult (tmp12' + tmp13') fIX_1_175875602 -- c3 */+ -- Add fudge factor here for final descale. */+ + (1 `unsafeShiftL` (cONST_BITS - pASS1_BITS-1))+ tmp0'' = mult tmp0' fIX_1_501321110+ tmp1'' = mult tmp1' fIX_3_072711026+ tmp2'' = mult tmp2' fIX_2_053119869+ tmp3'' = mult tmp3' fIX_0_298631336++ tmp10'' = mult tmp10' (- fIX_0_899976223)+ tmp11'' = mult tmp11' (- fIX_2_562915447)+ tmp12'' = mult tmp12' (- fIX_0_390180644) + z1'+ tmp13'' = mult tmp13' (- fIX_1_961570560) + z1'++ writeAtPos 1 $ tmp0'' + tmp10'' + tmp12''+ writeAtPos 3 $ tmp1'' + tmp11'' + tmp13''+ writeAtPos 5 $ tmp2'' + tmp11'' + tmp12''+ writeAtPos 7 $ tmp3'' + tmp10'' + tmp13''++ firstPass dataBlock $ i + 1++ -- Pass 2: process columns.+ -- We remove the PASS1_BITS scaling, but leave the results scaled up+ -- by an overall factor of 8.+ secondPass :: M.STVector s Int32 -> Int -> ST s ()+ secondPass _ (-1) = return ()+ secondPass block i = do+ let readAt idx = block `M.unsafeRead` ((7 - i) + idx * dctBlockSize)+ mult = (*)+ writeAt idx = block `M.unsafeWrite` (dctBlockSize * idx + (7 - i))+ writeAtPos idx n = (block `M.unsafeWrite` (dctBlockSize * idx + (7 - i))) $ n `unsafeShiftR` (cONST_BITS + pASS1_BITS + 3)+ blk0 <- readAt 0+ blk1 <- readAt 1+ blk2 <- readAt 2+ blk3 <- readAt 3+ blk4 <- readAt 4+ blk5 <- readAt 5+ blk6 <- readAt 6+ blk7 <- readAt 7++ let tmp0 = blk0 + blk7+ tmp1 = blk1 + blk6+ tmp2 = blk2 + blk5+ tmp3 = blk3 + blk4++ -- Add fudge factor here for final descale. */+ tmp10 = tmp0 + tmp3 + (1 `unsafeShiftL` (pASS1_BITS-1))+ tmp12 = tmp0 - tmp3+ tmp11 = tmp1 + tmp2+ tmp13 = tmp1 - tmp2++ tmp0' = blk0 - blk7+ tmp1' = blk1 - blk6+ tmp2' = blk2 - blk5+ tmp3' = blk3 - blk4++ writeAt 0 $ (tmp10 + tmp11) `unsafeShiftR` (pASS1_BITS + 3)+ writeAt 4 $ (tmp10 - tmp11) `unsafeShiftR` (pASS1_BITS + 3)++ let z1 = mult (tmp12 + tmp13) fIX_0_541196100+ + (1 `unsafeShiftL` (cONST_BITS + pASS1_BITS - 1))++ writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865+ writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065++ let tmp10' = tmp0' + tmp3'+ tmp11' = tmp1' + tmp2'+ tmp12' = tmp0' + tmp2'+ tmp13' = tmp1' + tmp3'++ z1' = mult (tmp12' + tmp13') fIX_1_175875602+ -- Add fudge factor here for final descale. */+ + 1 `unsafeShiftL` (cONST_BITS+pASS1_BITS-1);++ tmp0'' = mult tmp0' fIX_1_501321110+ tmp1'' = mult tmp1' fIX_3_072711026+ tmp2'' = mult tmp2' fIX_2_053119869+ tmp3'' = mult tmp3' fIX_0_298631336+ tmp10'' = mult tmp10' (- fIX_0_899976223)+ tmp11'' = mult tmp11' (- fIX_2_562915447)+ tmp12'' = mult tmp12' (- fIX_0_390180644)+ + z1'+ tmp13'' = mult tmp13' (- fIX_1_961570560)+ + z1'+ writeAtPos 1 $ tmp0'' + tmp10'' + tmp12''+ writeAtPos 3 $ tmp1'' + tmp11'' + tmp13''+ writeAtPos 5 $ tmp2'' + tmp11'' + tmp12''+ writeAtPos 7 $ tmp3'' + tmp10'' + tmp13''++ secondPass block (i - 1)++{-# ANN module "HLint: ignore Use camelCase" #-}+{-# ANN module "HLint: ignore Reduce duplication" #-}+
src/Codec/Picture/Jpg/Metadata.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE CPP #-} -module Codec.Picture.Jpg.Metadata ( extractMetadatas, encodeMetadatas ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative( pure ) -import Data.Monoid( mempty ) -import Data.Word( Word ) -#endif - -import Data.Word( Word16 ) -import Data.Maybe( fromMaybe ) -import qualified Codec.Picture.Metadata as Met -import Codec.Picture.Metadata( Metadatas ) -import Codec.Picture.Jpg.Types - -scalerOfUnit :: JFifUnit -> Met.Keys Word -> Word16 -> Metadatas -> Metadatas -scalerOfUnit unit k v = case unit of - JFifUnitUnknown -> id - JFifPixelsPerInch -> Met.insert k (fromIntegral v) - JFifPixelsPerCentimeter -> - Met.insert k (Met.dotsPerCentiMeterToDotPerInch $ fromIntegral v) - -extractMetadatas :: JpgJFIFApp0 -> Metadatas -extractMetadatas jfif = - inserter Met.DpiX (_jfifDpiX jfif) - $ inserter Met.DpiY (_jfifDpiY jfif) mempty - where - inserter = scalerOfUnit $ _jfifUnit jfif - - -encodeMetadatas :: Metadatas -> [JpgFrame] -encodeMetadatas metas = fromMaybe [] $ do - dpiX <- Met.lookup Met.DpiX metas - dpiY <- Met.lookup Met.DpiY metas - pure . pure . JpgJFIF $ JpgJFIFApp0 - { _jfifUnit = JFifPixelsPerInch - , _jfifDpiX = fromIntegral dpiX - , _jfifDpiY = fromIntegral dpiY - , _jfifThumbnail = Nothing - } - +{-# LANGUAGE CPP #-}+module Codec.Picture.Jpg.Metadata ( extractMetadatas, encodeMetadatas ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative( pure )+import Data.Monoid( mempty )+import Data.Word( Word )+#endif++import Data.Word( Word16 )+import Data.Maybe( fromMaybe )+import qualified Codec.Picture.Metadata as Met+import Codec.Picture.Metadata( Metadatas )+import Codec.Picture.Jpg.Types++scalerOfUnit :: JFifUnit -> Met.Keys Word -> Word16 -> Metadatas -> Metadatas+scalerOfUnit unit k v = case unit of+ JFifUnitUnknown -> id+ JFifPixelsPerInch -> Met.insert k (fromIntegral v)+ JFifPixelsPerCentimeter ->+ Met.insert k (Met.dotsPerCentiMeterToDotPerInch $ fromIntegral v)++extractMetadatas :: JpgJFIFApp0 -> Metadatas+extractMetadatas jfif = + inserter Met.DpiX (_jfifDpiX jfif)+ $ inserter Met.DpiY (_jfifDpiY jfif) mempty+ where+ inserter = scalerOfUnit $ _jfifUnit jfif+++encodeMetadatas :: Metadatas -> [JpgFrame]+encodeMetadatas metas = fromMaybe [] $ do+ dpiX <- Met.lookup Met.DpiX metas+ dpiY <- Met.lookup Met.DpiY metas+ pure . pure . JpgJFIF $ JpgJFIFApp0+ { _jfifUnit = JFifPixelsPerInch+ , _jfifDpiX = fromIntegral dpiX+ , _jfifDpiY = fromIntegral dpiY+ , _jfifThumbnail = Nothing+ }+
src/Codec/Picture/Png.hs view
@@ -26,8 +26,6 @@ , writePng , encodeDynamicPng - , encodePalettedPng - , encodePalettedPngWithMetadata , writeDynamicPng ) where
src/Codec/Picture/Png/Metadata.hs view
@@ -1,135 +1,135 @@-{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -module Codec.Picture.Png.Metadata( extractMetadatas - , encodeMetadatas - ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative( (<$>), (<*>), pure ) -import Data.Monoid( Monoid, mempty ) -import Data.Foldable( foldMap ) -#endif - -import Data.Maybe( fromMaybe ) -import Data.Binary( Binary( get, put ), encode ) -import Data.Binary.Get( getLazyByteStringNul ) -import Data.Binary.Put( putLazyByteString, putWord8 ) -import qualified Data.ByteString.Lazy.Char8 as L -import Data.Monoid( (<>) ) - -import Codec.Picture.InternalHelper -import qualified Codec.Picture.Metadata as Met -import Codec.Picture.Metadata ( Metadatas - , dotsPerMeterToDotPerInch - , Elem( (:=>) ) ) -import Codec.Picture.Png.Type - -#if !MIN_VERSION_base(4,7,0) -eitherFoldMap :: Monoid m => (a -> m) -> Either e a -> m -eitherFoldMap f v = case v of - Left _ -> mempty - Right a -> f a -#else -eitherFoldMap :: Monoid m => (a -> m) -> Either e a -> m -eitherFoldMap = foldMap -#endif - -getGamma :: [L.ByteString] -> Metadatas -getGamma [] = mempty -getGamma (g:_) = eitherFoldMap unpackGamma $ runGet get g - where - unpackGamma gamma = Met.singleton Met.Gamma (getPngGamma gamma) - -getDpis :: [L.ByteString] -> Metadatas -getDpis [] = mempty -getDpis (b:_) = eitherFoldMap unpackPhys $ runGet get b - where - unpackPhys PngPhysicalDimension { pngUnit = PngUnitUnknown } = - Met.insert Met.DpiX 72 $ Met.singleton Met.DpiY 72 - unpackPhys phy@PngPhysicalDimension { pngUnit = PngUnitMeter } = - Met.insert Met.DpiX dpx $ Met.singleton Met.DpiY dpy - where - dpx = dotsPerMeterToDotPerInch . fromIntegral $ pngDpiX phy - dpy = dotsPerMeterToDotPerInch . fromIntegral $ pngDpiY phy - -data PngText = PngText - { pngKeyword :: !L.ByteString - , pngData :: !L.ByteString - } - deriving Show - -instance Binary PngText where - get = PngText <$> getLazyByteStringNul <*> getRemainingLazyBytes - put (PngText kw pdata) = do - putLazyByteString kw - putWord8 0 - putLazyByteString pdata - -textToMetadata :: PngText -> Metadatas -textToMetadata ptext = case pngKeyword ptext of - "Title" -> strValue Met.Title - "Author" -> strValue Met.Author - "Description" -> strValue Met.Description - "Copyright" -> strValue Met.Copyright - {-"Creation Time" -> strValue Creation-} - "Software" -> strValue Met.Software - "Disclaimer" -> strValue Met.Disclaimer - "Warning" -> strValue Met.Warning - "Source" -> strValue Met.Source - "Comment" -> strValue Met.Comment - other -> - Met.singleton - (Met.Unknown $ L.unpack other) - (Met.String . L.unpack $ pngData ptext) - where - strValue k = Met.singleton k . L.unpack $ pngData ptext - -getTexts :: [L.ByteString] -> Metadatas -getTexts = foldMap (eitherFoldMap textToMetadata . runGet get) where - - -extractMetadatas :: PngRawImage -> Metadatas -extractMetadatas img = getDpis (chunksOf pHYsSignature) - <> getGamma (chunksOf gammaSignature) - <> getTexts (chunksOf tEXtSignature) - where - chunksOf = chunksWithSig img - -encodePhysicalMetadata :: Metadatas -> [PngRawChunk] -encodePhysicalMetadata metas = fromMaybe [] $ do - dx <- Met.lookup Met.DpiX metas - dy <- Met.lookup Met.DpiY metas - let to = fromIntegral . Met.dotPerInchToDotsPerMeter - dim = PngPhysicalDimension (to dx) (to dy) PngUnitMeter - pure [mkRawChunk pHYsSignature $ encode dim] - -encodeSingleMetadata :: Metadatas -> [PngRawChunk] -encodeSingleMetadata = Met.foldMap go where - go :: Elem Met.Keys -> [PngRawChunk] - go v = case v of - Met.Exif _ :=> _ -> mempty - Met.DpiX :=> _ -> mempty - Met.DpiY :=> _ -> mempty - Met.Width :=> _ -> mempty - Met.Height :=> _ -> mempty - Met.Format :=> _ -> mempty - Met.Gamma :=> g -> - pure $ mkRawChunk gammaSignature . encode $ PngGamma g - Met.Title :=> tx -> txt "Title" (L.pack tx) - Met.Description :=> tx -> txt "Description" (L.pack tx) - Met.Author :=> tx -> txt "Author" (L.pack tx) - Met.Copyright :=> tx -> txt "Copyright" (L.pack tx) - Met.Software :=> tx -> txt "Software" (L.pack tx) - Met.Comment :=> tx -> txt "Comment" (L.pack tx) - Met.Disclaimer :=> tx -> txt "Disclaimer" (L.pack tx) - Met.Source :=> tx -> txt "Source" (L.pack tx) - Met.Warning :=> tx -> txt "Warning" (L.pack tx) - Met.Unknown k :=> Met.String tx -> txt (L.pack k) (L.pack tx) - Met.Unknown _ :=> _ -> mempty - - txt k c = pure . mkRawChunk tEXtSignature . encode $ PngText k c - -encodeMetadatas :: Metadatas -> [PngRawChunk] -encodeMetadatas m = encodePhysicalMetadata m <> encodeSingleMetadata m - +{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+module Codec.Picture.Png.Metadata( extractMetadatas+ , encodeMetadatas+ ) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative( (<$>), (<*>), pure )+import Data.Monoid( Monoid, mempty )+import Data.Foldable( foldMap )+#endif++import Data.Maybe( fromMaybe )+import Data.Binary( Binary( get, put ), encode )+import Data.Binary.Get( getLazyByteStringNul )+import Data.Binary.Put( putLazyByteString, putWord8 )+import qualified Data.ByteString.Lazy.Char8 as L+import Data.Monoid( (<>) )++import Codec.Picture.InternalHelper+import qualified Codec.Picture.Metadata as Met+import Codec.Picture.Metadata ( Metadatas+ , dotsPerMeterToDotPerInch+ , Elem( (:=>) ) )+import Codec.Picture.Png.Type++#if !MIN_VERSION_base(4,7,0)+eitherFoldMap :: Monoid m => (a -> m) -> Either e a -> m+eitherFoldMap f v = case v of+ Left _ -> mempty+ Right a -> f a+#else+eitherFoldMap :: Monoid m => (a -> m) -> Either e a -> m+eitherFoldMap = foldMap+#endif++getGamma :: [L.ByteString] -> Metadatas+getGamma [] = mempty+getGamma (g:_) = eitherFoldMap unpackGamma $ runGet get g+ where+ unpackGamma gamma = Met.singleton Met.Gamma (getPngGamma gamma)++getDpis :: [L.ByteString] -> Metadatas+getDpis [] = mempty+getDpis (b:_) = eitherFoldMap unpackPhys $ runGet get b+ where+ unpackPhys PngPhysicalDimension { pngUnit = PngUnitUnknown } =+ Met.insert Met.DpiX 72 $ Met.singleton Met.DpiY 72+ unpackPhys phy@PngPhysicalDimension { pngUnit = PngUnitMeter } =+ Met.insert Met.DpiX dpx $ Met.singleton Met.DpiY dpy+ where+ dpx = dotsPerMeterToDotPerInch . fromIntegral $ pngDpiX phy+ dpy = dotsPerMeterToDotPerInch . fromIntegral $ pngDpiY phy++data PngText = PngText+ { pngKeyword :: !L.ByteString+ , pngData :: !L.ByteString+ }+ deriving Show++instance Binary PngText where+ get = PngText <$> getLazyByteStringNul <*> getRemainingLazyBytes+ put (PngText kw pdata) = do+ putLazyByteString kw+ putWord8 0+ putLazyByteString pdata++textToMetadata :: PngText -> Metadatas+textToMetadata ptext = case pngKeyword ptext of+ "Title" -> strValue Met.Title+ "Author" -> strValue Met.Author+ "Description" -> strValue Met.Description+ "Copyright" -> strValue Met.Copyright+ {-"Creation Time" -> strValue Creation-}+ "Software" -> strValue Met.Software+ "Disclaimer" -> strValue Met.Disclaimer+ "Warning" -> strValue Met.Warning+ "Source" -> strValue Met.Source+ "Comment" -> strValue Met.Comment+ other -> + Met.singleton+ (Met.Unknown $ L.unpack other)+ (Met.String . L.unpack $ pngData ptext)+ where+ strValue k = Met.singleton k . L.unpack $ pngData ptext++getTexts :: [L.ByteString] -> Metadatas+getTexts = foldMap (eitherFoldMap textToMetadata . runGet get) where+ ++extractMetadatas :: PngRawImage -> Metadatas+extractMetadatas img = getDpis (chunksOf pHYsSignature)+ <> getGamma (chunksOf gammaSignature)+ <> getTexts (chunksOf tEXtSignature)+ where+ chunksOf = chunksWithSig img++encodePhysicalMetadata :: Metadatas -> [PngRawChunk]+encodePhysicalMetadata metas = fromMaybe [] $ do+ dx <- Met.lookup Met.DpiX metas+ dy <- Met.lookup Met.DpiY metas+ let to = fromIntegral . Met.dotPerInchToDotsPerMeter+ dim = PngPhysicalDimension (to dx) (to dy) PngUnitMeter+ pure [mkRawChunk pHYsSignature $ encode dim]++encodeSingleMetadata :: Metadatas -> [PngRawChunk]+encodeSingleMetadata = Met.foldMap go where+ go :: Elem Met.Keys -> [PngRawChunk]+ go v = case v of+ Met.Exif _ :=> _ -> mempty+ Met.DpiX :=> _ -> mempty+ Met.DpiY :=> _ -> mempty+ Met.Width :=> _ -> mempty+ Met.Height :=> _ -> mempty+ Met.Format :=> _ -> mempty+ Met.Gamma :=> g ->+ pure $ mkRawChunk gammaSignature . encode $ PngGamma g+ Met.Title :=> tx -> txt "Title" (L.pack tx)+ Met.Description :=> tx -> txt "Description" (L.pack tx)+ Met.Author :=> tx -> txt "Author" (L.pack tx)+ Met.Copyright :=> tx -> txt "Copyright" (L.pack tx)+ Met.Software :=> tx -> txt "Software" (L.pack tx)+ Met.Comment :=> tx -> txt "Comment" (L.pack tx)+ Met.Disclaimer :=> tx -> txt "Disclaimer" (L.pack tx)+ Met.Source :=> tx -> txt "Source" (L.pack tx)+ Met.Warning :=> tx -> txt "Warning" (L.pack tx)+ Met.Unknown k :=> Met.String tx -> txt (L.pack k) (L.pack tx)+ Met.Unknown _ :=> _ -> mempty++ txt k c = pure . mkRawChunk tEXtSignature . encode $ PngText k c++encodeMetadatas :: Metadatas -> [PngRawChunk]+encodeMetadatas m = encodePhysicalMetadata m <> encodeSingleMetadata m+
src/Codec/Picture/VectorByteConversion.hs view
@@ -1,45 +1,45 @@-{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE CPP #-} -module Codec.Picture.VectorByteConversion( blitVector - , toByteString - , imageFromUnsafePtr ) where - -import Data.Word( Word8 ) -import Data.Vector.Storable( Vector, unsafeToForeignPtr, unsafeFromForeignPtr0 ) -import Foreign.Storable( Storable, sizeOf ) - -#if !MIN_VERSION_base(4,8,0) -import Foreign.ForeignPtr.Safe( ForeignPtr, castForeignPtr ) -#else -import Foreign.ForeignPtr( ForeignPtr, castForeignPtr ) -#endif - - -import qualified Data.ByteString as B -import qualified Data.ByteString.Internal as S - -import Codec.Picture.Types - -blitVector :: Vector Word8 -> Int -> Int -> B.ByteString -blitVector vec atIndex = S.PS ptr (offset + atIndex) - where (ptr, offset, _length) = unsafeToForeignPtr vec - -toByteString :: forall a. (Storable a) => Vector a -> B.ByteString -toByteString vec = S.PS (castForeignPtr ptr) offset (len * size) - where (ptr, offset, len) = unsafeToForeignPtr vec - size = sizeOf (undefined :: a) - --- | Import a image from an unsafe pointer --- The pointer must have a size of width * height * componentCount px -imageFromUnsafePtr :: forall px - . (Pixel px, (PixelBaseComponent px) ~ Word8) - => Int -- ^ Width in pixels - -> Int -- ^ Height in pixels - -> ForeignPtr Word8 -- ^ Pointer to the raw data - -> Image px -imageFromUnsafePtr width height ptr = - Image width height $ unsafeFromForeignPtr0 ptr size - where compCount = componentCount (undefined :: px) - size = width * height * compCount - +{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+module Codec.Picture.VectorByteConversion( blitVector+ , toByteString+ , imageFromUnsafePtr ) where++import Data.Word( Word8 )+import Data.Vector.Storable( Vector, unsafeToForeignPtr, unsafeFromForeignPtr0 )+import Foreign.Storable( Storable, sizeOf )++#if !MIN_VERSION_base(4,8,0)+import Foreign.ForeignPtr.Safe( ForeignPtr, castForeignPtr )+#else+import Foreign.ForeignPtr( ForeignPtr, castForeignPtr )+#endif+++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as S++import Codec.Picture.Types++blitVector :: Vector Word8 -> Int -> Int -> B.ByteString+blitVector vec atIndex = S.PS ptr (offset + atIndex)+ where (ptr, offset, _length) = unsafeToForeignPtr vec++toByteString :: forall a. (Storable a) => Vector a -> B.ByteString+toByteString vec = S.PS (castForeignPtr ptr) offset (len * size)+ where (ptr, offset, len) = unsafeToForeignPtr vec+ size = sizeOf (undefined :: a)++-- | Import a image from an unsafe pointer+-- The pointer must have a size of width * height * componentCount px+imageFromUnsafePtr :: forall px+ . (Pixel px, (PixelBaseComponent px) ~ Word8)+ => Int -- ^ Width in pixels+ -> Int -- ^ Height in pixels+ -> ForeignPtr Word8 -- ^ Pointer to the raw data+ -> Image px+imageFromUnsafePtr width height ptr =+ Image width height $ unsafeFromForeignPtr0 ptr size+ where compCount = componentCount (undefined :: px)+ size = width * height * compCount+