Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I am trying to extract some graphics stored in PICT format from a Mathematica notebook, using a platform that doesn't support PICT. If I look at the .nb file in a plain text editor, or if I use FullForm, then I can see that the picture is stored as a GraphicsData head with a text string encoding the picture. It doesn't appear that the GraphicsData head uses Base64 or any other binary-to-text encoding that I know of off the top of my head, but I would like to be able to copy-and-paste the GraphicsData string and decode it manually. Is this possible? Does GraphicsData use a well-known encoding scheme?

share|improve this question
    
Do you have an example notebook? –  ragfield May 15 '12 at 1:17
    
@ragfield: Unfortunately, I don't have a good test case I can share. I've only encountered this problem with notebooks created on other people's computers. I can try to create a test case next time I have access, though. –  Chris Granade May 15 '12 at 3:57
    
Some additional information about GraphicsData formats: mathematica.stackexchange.com/a/32886/280 –  Alexey Popkov Nov 8 '13 at 7:21
add comment

2 Answers

up vote 11 down vote accepted

I found an example on the web. Here is code that will convert the PICT data from the format stored in the notebook file into a .pict file that can be opened by an image viewer (e.g. Photoshop).

DecodePICT[data_String] := Module[
    {slash, backslash, zero, LF, CR, decode, codes, len, i},
    {slash, backslash, zero, LF, CR} = ToCharacterCode["/\\0\n\r"];
    decode[char_] := If[char == slash, backslash-zero, char-zero];
    len = Length[codes = ToCharacterCode[data]];
    i = 1;
    Join[Table[0,{512}], Last@Last@Reap@While[i <= len-1,
        Which[
            codes[[i]] == LF || codes[[i]] == CR,
            i++,
            codes[[i]] == backslash,
            i += 4,
            True,
            Sow@BitAnd[BitOr[
                BitShiftLeft[decode[codes[[i]]], 2],
                BitShiftRight[decode[codes[[i+1]]], 4]
            ], 255];
            i++;
            If[i <= len-1,
                Sow@BitAnd[BitOr[
                    BitShiftLeft[decode[codes[[i]]], 4],
                    BitShiftRight[decode[codes[[i+1]]], 2]
                ], 255]
            ];
            i++;
            If[i <= len-1,
                Sow@BitAnd[BitOr[
                    BitShiftLeft[decode[codes[[i]]], 6],
                    BitShiftRight[decode[codes[[i+1]]], 0]
                ], 255]
            ];
            i += 2;
        ]
    ]]
];

str = "0N801`0]05815@0A0_l<0?ooool0;@0000L0004E0000DP000000002Q0O@0hd=U
  K6aK8U`lG0eSKgEbHVEKM5mM83Xm80eLM51QLV5]IGAbJF=@K6md<dAKN`eLM2Pb
  :b1d84=_Le]fGBU3Kg=K<WIM;0eLM2Pb:b1d84=_Le]fGBUCJFiK<WIM;0eLM7@P
  DfU^FgIMOBakMR`P<2`P<R1@JGeM83]L3E`n8R`P8TU^L7Ed8R`=8219KF5WIE=Y
  NVD]?W/b<c8/83LeOB`=8219KF5WIDeQLVMYKW<]?W]k<2`P<7d/87/`;20`OGd/
  3B0PBFeQIfEBIFMYKfh]?W]k<2`P<Gd/87/`;20aOGeM000N01[oooooool00@0:
  00L0;@1B0AD0<@0602d0DP9203401`920582@P0J0000000002`01@R^0Te30003
  2:h0104000d0300^00@0o`0002/]4PiSKgEbHVEKM5mM83Xm8000:b0?4U1QLV5]
  IGAbJF=@K6md<dAKN`00:PlE:38[87@P@fmcFgIM:D=_Le/bMUd/000Z3aDX<R/P
  M213Kg=KMUdYDfU^Fc9fGB`002X?6G@PDfU^FgIMOBakMR`P<2`P<R1@JGeM83/0
  0?l";

Export["~/Desktop/foo.pict", DecodePICT[str], "Binary"]
share|improve this answer
    
Very cool. Just for reference, what's str a picture of? I'm trying to use imagemagick to convert ~/Desktop/foo.pict to something else, and it's showing up as a 232x75px black box. Is that correct? –  Ian Hincks Mar 19 at 22:24
add comment

This is data compressed using Compress. You can uncompress it using Uncompress.

Demonstration:

Rasterize["x", ImageSize -> 25]

Mathematica graphics

Open this cell with Cell>Show Expression (ctrlshift-E):

Cell[BoxData[
 GraphicsBox[RasterBox[CompressedData["
1:eJxTTMoPSmJmYGDQA2IpIAax/4+CUTAKhgbYlsaAHaRtI0MhdU1DVWo1gRT/
YJpDsoFEGEWsgROsiDQKVT02A/FIkWogeUZh1UuJUWgmUG4UioHUMArFNKIj
EQdApBZSUwVOo2AGUGAg9sROdBYgVhOJBhJWTnImJaQQET238crjL7aIU0Vt
00bBKBgFo2DgAQD6B2Cc
   "], {{0, 0}, {7.284046692607004, 12.88715953307393}}, {0, 255},
   ColorFunction->RGBColor],
  ImageSize->25,
  PlotRange->{{0, 7.284046692607004}, {0, 12.88715953307393}}]], "Output",
 CellChangeTimes->{{3.546020312347924*^9, 3.546020338348411*^9}}]

Copy the compressed string and uncompress:

Uncompress["
  1:eJxTTMoPSmJmYGDQA2IpIAax/4+CUTAKhgbYlsaAHaRtI0MhdU1DVWo1gRT/
  YJpDsoFEGEWsgROsiDQKVT02A/FIkWogeUZh1UuJUWgmUG4UioHUMArFNKIj
  EQdApBZSUwVOo2AGUGAg9sROdBYgVhOJBhJWTnImJaQQET238crjL7aIU0Vt
  00bBKBgFo2DgAQD6B2Cc
     "] // Image

Mathematica graphics

share|improve this answer
    
I tried doing that, and got the error Uncompress::corrupt. Thanks for the advice, though. I wouldn't have thought of trying Uncompress. –  Chris Granade May 14 '12 at 21:40
    
Ah, I see what you mean now. Unfortunately, the head CompressedData doesn't appear in the notebook I'm trying to extract from. Instead, it has the an expression like GraphicsData["PICT", <long string>]. I tried copying that string into Uncompress and didn't get anything useful. –  Chris Granade May 14 '12 at 21:46
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.