[Date Index] [Thread Index] [Author Index]

16bit image writing

• To: mathgroup at smc.vnet.net
• Subject: [mg72613] 16bit image writing
• From: bltzrou at yahoo.com
• Date: Fri, 12 Jan 2007 05:37:42 -0500 (EST)

I am trying to write a 16-bit image (whatever common format is fine). I
checked an old message by Jens-Peer Kuska who wrote a package of PNG
image for Mathematica 4.x.

http://groups.google.com/group/comp.soft-sys.math.mathematica/browse_thread/thread/2a63e9217bb62398/35bd3a9cc61b18bc?lnk=st&q=mathematica+export+16+bit+image&rnum=2&hl=en#35bd3a9cc61b18bc

I suppose that this should work on Version 5.2. But I could not have it
work using its example (I attached below).

Do anyone have the latest way to write a 16bit image? Thanks.




Notebook[{
Cell[BoxData[
    \(\(gr =
        DensityPlot[
          Sin[x*y]/\((1 + x\^2 +
                y\^2)\), {x, \(-\[Pi]\), \[Pi]}, {y, \(-\[Pi]\), \
\[Pi]}, PlotPoints \[Rule] 45, ColorFunction \[Rule] Hue,
          DisplayFunction \[Rule] Identity];\)\)], "Input",
  CellTags->"16BitImages"],

Cell[BoxData[
    \(\({h\_0, h\_1} = \({Min[#], Max[#]}\  &\)[
          Flatten[
            gr\[LeftDoubleBracket]1\[RightDoubleBracket]]];\)\)], \
"Input",
  CellTags->"16BitImages"],

Cell[CellGroupData[{

Cell[BoxData[
    \(bm16 =
      Graphics[
        Raster[Map[
            Round[\((2^16 -
                      1)\)*\((# - h\_0)\)/\((h\_1 - h\_0)\)]\  &,
            gr\[LeftDoubleBracket]1\[RightDoubleBracket], {2}], {{0,
              0}, Reverse[
              Dimensions[
                gr\[LeftDoubleBracket]1\[RightDoubleBracket]]]}, {0,
            2^16 - 1}, ColorFunction \[Rule] GrayLevel],
        AspectRatio \[Rule] Automatic]\)], "Input",
  CellTags->"16BitImages"],

Cell[BoxData[
    TagBox[\(\[SkeletonIndicator]  Graphics  \[SkeletonIndicator]\),
      False,
      Editable->False]], "Output",
  CellTags->"16BitImages"]
}, Open  ]],

Cell[BoxData[
    \(\(Show[bm16];\)\)], "Input",
  CellTags->"16BitImages"],

Cell["Now we write the 16 bit image as a pure raster image", "Text",
  CellTags->"16BitImages"],

Cell[BoxData[
    \(Export[$TempPath <> "\<test16.png\>",
      bm16, "\<ExportRaster\>" \[Rule] True]\)], "Input",
  CellTags->"16BitImages"]
},
FrontEndVersion->"5.2 for Microsoft Windows",
ScreenRectangle->{{0, 1152}, {0, 781}},
WindowSize->{1144, 747},
WindowMargins->{{0, Automatic}, {Automatic, 0}}
]