"
 COPYRIGHT (c) 1995 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

ImageReader subclass:#XWDReader
	 instanceVariableNames:''
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Graphics-Images support'
!

XWDReader comment:'
COPYRIGHT (c) 1995 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libview2/XWDReader.st,v 1.5 1995-03-18 05:13:10 claus Exp $
'!

!XWDReader class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1995 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libview2/XWDReader.st,v 1.5 1995-03-18 05:13:10 claus Exp $
"
!

documentation
"
    this class provides methods for loading x-window dump (xwd) images.
    Image save is not supported.
"
! !

!XWDReader methodsFor:'image reading'!

fromStream: aStream 
    "read an image in XWD (X Window Dump) format."

    |header nColors palette res pad 
     srcRowByteSize bytesPerRow bitsPerPixel mask colormapSize depth 
     dstIndex|

    aStream binary.

    header := (1 to: 25) collect: [:i | aStream nextLong].

    "skip ..."
    101 to:(header at: 1) do: [:i | aStream next].

    depth := header at: 4.
    width := header at: 5.
    height := header at: 6.
    pad := header at: 11.

    bitsPerPixel := header at: 12.
    bitsPerPixel == 24 ifTrue:[
	bitsPerSample := #(8 8 8).
	samplesPerPixel := 3.
	photometric := #rgb
    ] ifFalse:[
	bitsPerSample := Array with:bitsPerPixel.
	samplesPerPixel := 1.
	photometric := #palette
    ].
"/  depth ~~ bitsPerPixel ifTrue:[self halt].

    colormapSize := header at: 19.
    nColors := header at: 20.

    colorMap := Array new:colormapSize.

    1 to:nColors do:[:i |
	|clr r g b|

	aStream nextLong.
	r := aStream nextUnsignedShortMSB:true.
	g := aStream nextUnsignedShortMSB:true.
	b := aStream nextUnsignedShortMSB:true.
	clr := ColorValue scaledRed: (r bitShift: -3)
			scaledGreen: (g bitShift: -3)
			 scaledBlue: (b bitShift: -3).
	colorMap at:i put:clr.
	aStream nextWord.
    ].

    nColors+1 to:colormapSize do: [:i | colorMap at:i put:Color black].

    bytesPerRow := width * bitsPerPixel // 8.
    ((width * bitsPerPixel \\ 8) ~~ 0) ifTrue:[
	bytesPerRow := bytesPerRow + 1
    ].
    srcRowByteSize := width * bitsPerPixel + pad - 1 // pad * (pad / 8).

    data := ByteArray uninitializedNew: srcRowByteSize * height.
    srcRowByteSize == bytesPerRow ifTrue:[
	aStream nextBytes:srcRowByteSize * height into:data.
    ] ifFalse:[
	dstIndex := 1.
	1 to:height do:[:y |
	    aStream nextBytes:bytesPerRow into:data startingAt:dstIndex.
	    aStream next:(srcRowByteSize - bytesPerRow).
	    dstIndex := dstIndex + bytesPerRow.
	].
    ]
    "
     XWDReader fromFile:'testfile.xwd'
    "
    "
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
     (Image fromFile: '/tmp/st.xwd') inspect 
    "
! !

!XWDReader methodsFor:'image writing'!

save:image onFile:fileName
    "Save as a version 7 color X11 window dump file (xwd) to the file fileName.
     This produces a mapped color table with 16 bit color.  The xwd file can be 
     viewed by the xwud program and printed with xpr.  There is no compression 
     encoding performed on the scanlines.

     See the file ...include/X11/XWDFile.h for a definition of the format.

     Notice:
	this method was adapted from a goody in the uiuc archive 
	(Prime time freeware).
	The original files header is:
	    NAME            imageToXWD
	    AUTHOR          Brad Schoening <brad@boole.com>
	    FUNCTION        Writes a Smalltalk image to an X11 xwd file
	    ST-VERSION      PPST 4.0 or 4.1
	    DISTRIBUTION    world
	    VERSION         1.0
	    DATE            July 1993
    "

    | aStream rgbColor paletteColors ncolors cindex dumpName headerSize |

    image bitsPerPixel ~~ 8 ifTrue:[
	self error:'XWD format only supports 8bit images'.
	^ nil
    ].
    image photometric ~~ #palette ifTrue:[
	self error:'XWD format only supports palette images'.
	^ nil
    ].

    dumpName := 'stdin'.
    headerSize := 4 * (25 + (dumpName size / 4) ceiling).
    paletteColors := image palette "colors".
    ncolors := paletteColors size.

    "create the header (each item is 32 bits long)"
    aStream := fileName asFilename writeStream.
    aStream binary.
    aStream nextLongPut: headerSize.                                "total header size in bytes"
    aStream nextLongPut: 7.                                         "XWD file version"
    aStream nextLongPut: 2.                                         "pixmap format : ZPixmap"
    aStream nextLongPut: 8.                                         "pixmap depth"
    aStream nextLongPut: image width.                               "pixmap cols"
    aStream nextLongPut: image height.                              "pixmap rows"
    aStream nextLongPut: 0.                                         "bitmap x offset"
    aStream nextLongPut: 1.                                         "byte order: MSBFirst"
    aStream nextLongPut: 8.                                         "bitmap unit"
    aStream nextLongPut: 1.                                         "bitmap bit order: MSBFirst"
    aStream nextLongPut: 8.                                         "bitmap scanline pad"
    aStream nextLongPut: 8.                                         "bits per pixel"
    aStream nextLongPut: image width.                               "bytes per scanline"
    aStream nextLongPut: 3.                                         "colormap class : PseudoColor"
    aStream nextLongPut: 0.                                         "Z red mask"
    aStream nextLongPut: 0.                                         "Z green mask"
    aStream nextLongPut: 0.                                         "Z blue mask"
    aStream nextLongPut: 8.                                         "bits per rgb"
    aStream nextLongPut: 256.                                       "number of color map entries"
    aStream nextLongPut: ncolors.                                   "number of color structures"
    aStream nextLongPut: image width.                               "window width"
    aStream nextLongPut: image height.                              "window height"
    aStream nextLongPut: 0.                                         "window upper left x coordinate"
    aStream nextLongPut: 0.                                         "window upper left y coordinate"
    aStream nextLongPut: 0.                                         "window border width"
    aStream nextPutAll: dumpName asByteArray.       "name of dump"
    "Pad the string to the next 32-bit boundary"
    aStream nextPut: 0. "/ 6
    aStream nextPut: 0. "/ 7
    aStream nextPut: 0. "/ 8

"/    [(aStream position rem: 4) == 0] whileFalse: [ aStream nextPut: 0 ].

    "Write out the color table.  Each color table entry is 12 bytes long composed of:
		    an index                (4 bytes)
		    red color value         (2 bytes)
		    green color value       (2 bytes)
		    blue color value        (2 bytes)
		    flag values             (1 byte)
		    pad                     (1 byte)
    "
    0 to: ncolors-1 do: [ :index |
	|r g b|

	aStream nextLongPut: index.
	rgbColor := paletteColors at: (1+index).
	(rgbColor isNil) ifTrue: [ rgbColor := ColorValue white ].
	r := (rgbColor red / 100.0 * 65535) rounded.
	g := (rgbColor green / 100.0 * 65535) rounded.
	b := (rgbColor blue / 100.0 * 65535) rounded.

	aStream nextWordPut:r.
	aStream nextWordPut:g.
	aStream nextWordPut:b.
	aStream nextPut: 7.                     "flags"
	aStream nextPut: 0.                     "pad"
    ].

    "Write out the pixels as index color values"
"/    Cursor write showWhile: [ 
"/            1 to: (image height) do: [ :row |
"/                    1 to: (image width) do: [ :col |
"/                            cindex := image atPoint: (col-1)@(row-1).
"/                            aStream nextPut: cindex.]]
"/    ].
    aStream nextPutAll:image bits.

    aStream close

    "
     XWDReader save:(Image fromUser) onFile: '/tmp/st.xwd' 
     (Image fromFile: '/tmp/st.xwd') inspect 
    "
! !