JuicyPixels 3.3 → 3.3.1
raw patch · 15 files changed
+1615/−1594 lines, 15 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- JuicyPixels.cabal +2/−2
- README.md +3/−1
- changelog +6/−0
- docimages/pixelgraph.svg +264/−264
- src/Codec/Picture/BitWriter.hs +14/−0
- src/Codec/Picture/ConvGraph.hs +10/−10
- src/Codec/Picture/Gif.hs +1/−2
- src/Codec/Picture/Gif/LZW.hs +194/−194
- src/Codec/Picture/Gif/LZWEncoding.hs +101/−101
- 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/Metadata.hs +135/−135
- src/Codec/Picture/VectorByteConversion.hs +45/−45
JuicyPixels.cabal view
@@ -1,5 +1,5 @@ Name: JuicyPixels -Version: 3.3 +Version: 3.3.1 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 + Tag: v3.3.1 Flag Mmap Description: Enable the file loading via mmap (memory map)
README.md view
@@ -99,7 +99,9 @@ - Tiff * Reading - - 2, 4, 8, 16 bit depth reading (planar and contiguous for each) + - 2, 4, 8, 16 int bit depth reading (planar and contiguous for each) + - 32 bit floating point reading + - CMYK, YCbCr, RGB, RGBA, Paletted, Greyscale - Uncompressed, PackBits, LZW
changelog view
@@ -1,6 +1,12 @@ Change log ========== +v3.3.1 August 2018 +------------------ + + * Fix: gif decoding of 1bit palette (fix Ornedan) + * Fix: end of stream handling for gif's lzw encoding (fix Ornedan) + v3.3 July 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/BitWriter.hs view
@@ -19,6 +19,7 @@ , BoolWriteStateRef , newWriteStateRef , finalizeBoolWriter + , finalizeBoolWriterGif , writeBits' , writeBitsGif @@ -339,6 +340,19 @@ where cleanMask = (1 `unsafeShiftL` bitCount) - 1 :: Word32 cleanData = bitData .&. cleanMask :: Word32 + +finalizeBoolWriterGif :: BoolWriteStateRef s -> ST s L.ByteString +finalizeBoolWriterGif st = do + flushLeftBitsGif st + forceBufferFlushing' st + L.fromChunks <$> readSTRef (bwsBufferList st) + +flushLeftBitsGif :: BoolWriteStateRef s -> ST s () +flushLeftBitsGif st = do + currCount <- readSTRef $ bwsBitReaded st + when (currCount > 0) $ do + currWord <- readSTRef $ bwsBitAcc st + pushByte' st currWord {-# ANN module "HLint: ignore Reduce duplication" #-}
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
@@ -399,7 +399,6 @@ imgWidth <- getWord16le imgHeight <- getWord16le packedFields <- getWord8 - let tableSize = packedFields .&. 0x7 return ImageDescriptor { gDescPixelsFromLeft = imgLeftPos , gDescPixelsFromTop = imgTopPos @@ -408,7 +407,7 @@ , gDescHasLocalMap = packedFields `testBit` 7 , gDescIsInterlaced = packedFields `testBit` 6 , gDescIsImgDescriptorSorted = packedFields `testBit` 5 - , gDescLocalColorTableSize = if tableSize > 0 then tableSize + 1 else 0 + , gDescLocalColorTableSize = (packedFields .&. 0x7) + 1 }
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/Gif/LZWEncoding.hs view
@@ -1,101 +1,101 @@-{-# LANGUAGE BangPatterns, CPP #-}-module Codec.Picture.Gif.LZWEncoding( lzwEncode ) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative( (<$>) )-import Data.Monoid( mempty )-#endif--import Control.Monad.ST( runST )-import qualified Data.ByteString.Lazy as L-import Data.Maybe( fromMaybe )-import Data.Word( Word8 )--#if MIN_VERSION_containers(0,5,0)-import qualified Data.IntMap.Strict as I-#else-import qualified Data.IntMap as I-#endif-import qualified Data.Vector.Storable as V--import Codec.Picture.BitWriter--type Trie = I.IntMap TrieNode--data TrieNode = TrieNode- { trieIndex :: {-# UNPACK #-} !Int- , trieSub :: !Trie- }--emptyNode :: TrieNode-emptyNode = TrieNode- { trieIndex = -1- , trieSub = mempty- }--initialTrie :: Trie-initialTrie = I.fromList- [(i, emptyNode { trieIndex = i }) | i <- [0 .. 255]]--lookupUpdate :: V.Vector Word8 -> Int -> Int -> Trie -> (Int, Int, Trie)-lookupUpdate vector freeIndex firstIndex trie =- matchUpdate $ go trie 0 firstIndex - where- matchUpdate (lzwOutputIndex, nextReadIndex, sub) =- (lzwOutputIndex, nextReadIndex, fromMaybe trie sub)-- maxi = V.length vector- go !currentTrie !prevIndex !index- | index >= maxi = (prevIndex, index, Nothing)- | otherwise = case I.lookup val currentTrie of- Just (TrieNode ix subTable) ->- let (lzwOutputIndex, nextReadIndex, newTable) =- go subTable ix $ index + 1- tableUpdater t =- I.insert val (TrieNode ix t) currentTrie- in- (lzwOutputIndex, nextReadIndex, tableUpdater <$> newTable)-- Nothing | index == maxi -> (prevIndex, index, Nothing)- | otherwise -> (prevIndex, index, Just $ I.insert val newNode currentTrie)-- where val = fromIntegral $ vector `V.unsafeIndex` index- newNode = emptyNode { trieIndex = freeIndex }--lzwEncode :: Int -> V.Vector Word8 -> L.ByteString-lzwEncode initialKeySize vec = runST $ do- bitWriter <- newWriteStateRef -- let updateCodeSize 12 writeIdx _- | writeIdx == 2 ^ (12 :: Int) - 1 = do- writeBitsGif bitWriter (fromIntegral clearCode) 12- return (startCodeSize, firstFreeIndex, initialTrie)-- updateCodeSize codeSize writeIdx trie- | writeIdx == 2 ^ codeSize =- return (codeSize + 1, writeIdx + 1, trie)- | otherwise = return (codeSize, writeIdx + 1, trie)-- go readIndex (codeSize, _, _) | readIndex >= maxi =- writeBitsGif bitWriter (fromIntegral endOfInfo) codeSize- go !readIndex (!codeSize, !writeIndex, !trie) = do- let (indexToWrite, endIndex, trie') =- lookuper writeIndex readIndex trie- writeBitsGif bitWriter (fromIntegral indexToWrite) codeSize- updateCodeSize codeSize writeIndex trie'- >>= go endIndex -- writeBitsGif bitWriter (fromIntegral clearCode) startCodeSize- go 0 (startCodeSize, firstFreeIndex, initialTrie)-- finalizeBoolWriter bitWriter- where- maxi = V.length vec-- startCodeSize = initialKeySize + 1-- clearCode = 2 ^ initialKeySize :: Int- endOfInfo = clearCode + 1- firstFreeIndex = endOfInfo + 1- - lookuper = lookupUpdate vec+{-# LANGUAGE BangPatterns, CPP #-} +module Codec.Picture.Gif.LZWEncoding( lzwEncode ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative( (<$>) ) +import Data.Monoid( mempty ) +#endif + +import Control.Monad.ST( runST ) +import qualified Data.ByteString.Lazy as L +import Data.Maybe( fromMaybe ) +import Data.Word( Word8 ) + +#if MIN_VERSION_containers(0,5,0) +import qualified Data.IntMap.Strict as I +#else +import qualified Data.IntMap as I +#endif +import qualified Data.Vector.Storable as V + +import Codec.Picture.BitWriter + +type Trie = I.IntMap TrieNode + +data TrieNode = TrieNode + { trieIndex :: {-# UNPACK #-} !Int + , trieSub :: !Trie + } + +emptyNode :: TrieNode +emptyNode = TrieNode + { trieIndex = -1 + , trieSub = mempty + } + +initialTrie :: Trie +initialTrie = I.fromList + [(i, emptyNode { trieIndex = i }) | i <- [0 .. 255]] + +lookupUpdate :: V.Vector Word8 -> Int -> Int -> Trie -> (Int, Int, Trie) +lookupUpdate vector freeIndex firstIndex trie = + matchUpdate $ go trie 0 firstIndex + where + matchUpdate (lzwOutputIndex, nextReadIndex, sub) = + (lzwOutputIndex, nextReadIndex, fromMaybe trie sub) + + maxi = V.length vector + go !currentTrie !prevIndex !index + | index >= maxi = (prevIndex, index, Nothing) + | otherwise = case I.lookup val currentTrie of + Just (TrieNode ix subTable) -> + let (lzwOutputIndex, nextReadIndex, newTable) = + go subTable ix $ index + 1 + tableUpdater t = + I.insert val (TrieNode ix t) currentTrie + in + (lzwOutputIndex, nextReadIndex, tableUpdater <$> newTable) + + Nothing | index == maxi -> (prevIndex, index, Nothing) + | otherwise -> (prevIndex, index, Just $ I.insert val newNode currentTrie) + + where val = fromIntegral $ vector `V.unsafeIndex` index + newNode = emptyNode { trieIndex = freeIndex } + +lzwEncode :: Int -> V.Vector Word8 -> L.ByteString +lzwEncode initialKeySize vec = runST $ do + bitWriter <- newWriteStateRef + + let updateCodeSize 12 writeIdx _ + | writeIdx == 2 ^ (12 :: Int) - 1 = do + writeBitsGif bitWriter (fromIntegral clearCode) 12 + return (startCodeSize, firstFreeIndex, initialTrie) + + updateCodeSize codeSize writeIdx trie + | writeIdx == 2 ^ codeSize = + return (codeSize + 1, writeIdx + 1, trie) + | otherwise = return (codeSize, writeIdx + 1, trie) + + go readIndex (codeSize, _, _) | readIndex >= maxi = + writeBitsGif bitWriter (fromIntegral endOfInfo) codeSize + go !readIndex (!codeSize, !writeIndex, !trie) = do + let (indexToWrite, endIndex, trie') = + lookuper writeIndex readIndex trie + writeBitsGif bitWriter (fromIntegral indexToWrite) codeSize + updateCodeSize codeSize writeIndex trie' + >>= go endIndex + + writeBitsGif bitWriter (fromIntegral clearCode) startCodeSize + go 0 (startCodeSize, firstFreeIndex, initialTrie) + + finalizeBoolWriterGif bitWriter + where + maxi = V.length vec + + startCodeSize = initialKeySize + 1 + + clearCode = 2 ^ initialKeySize :: Int + endOfInfo = clearCode + 1 + firstFreeIndex = endOfInfo + 1 + + lookuper = lookupUpdate vec
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/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 +