'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 27 April 2003 at 6:13:08 pm'!
"Change Set:		xpm support
Date:			4 March 2003
Author:			Stephan B. Wessels
SM Name:		XPM Support

Re-implements the XPMReadWriter from Duane Maxwell.
Does the right thing and registers as a service for FileList.

Date		Update
-------------	-----------------------------------------------------------------------
08-apr-2003	Map 24 bit XPM forms to 32 bit when found.

08-apr-2003	Greater tolerance for content of xpm image file parameters.

04-Mar-2003	Initial release of updated code."
!

ImageReadWriter subclass: #XPMReadWriter
	instanceVariableNames: ''
	classVariableNames: 'CharTable '
	poolDictionaries: ''
	category: 'Graphics-Files'!

!XPMReadWriter commentStamp: 'DSM 3/22/2000 23:33' prior: 0!
I am a subclass of ImageReadWriter that encodes and decodes XPM (X PixMap)
images (Le Hors, 1989).

Basically, XPM images are really just blocks of strictly formatted C source
code, much like the related 1-bit format XBM.  I don't yet actually support
all possible XPM files, since they can contain fairly complex image
information, as well as symbolic color names. Even though I can decode
images with a small number of colors, I only emit 16 and 32-bit images.

The format of an XPM file is:

/* XPM */

static char* <variable_name>[] = {
<values>
<colors>
<pixels>
<extensions>
};

where:

<values> = "<width> <height> <num_colors> <chars_per_pixel> [<xhotspot>
<yhotspot>] [XPMEXT]"
<colors> = <num_colors> strings of "<chars> [<key> <color>]+"
<key> = m | s | g4 | g | c
<color> = None | #<RR><GG><BB> | %<HH><SS><VV>
<pixels> = <height> strings of length <width>*<chars_per_pixel>
<extensions> = "XPMEXT <extension_name> <extension_data>"

At the moment, I only understand the "c" (color visual) key and RGB/None
colors, and ignore hotspots and extensions.

Submitted by Duane Maxwell.
!


!Color methodsFor: 'conversions' stamp: 'DSM 3/22/2000 11:25'!
asHex
	^ (self scaledPixelValue32 radix: 16) copyFrom: 6 to: 11
! !


!Color class methodsFor: 'instance creation' stamp: 'sbw 3/11/2003 20:20'!
fromHex: s 
	"handle colors of form RRGGBB encoded as hex digits 00..FF"
	| val |
	val _ Integer
				readFrom: (ReadStream on: s asUppercase)
				base: 16.
	^ self
		r: (val bitShift: -16)
				/ 255
		g: ((val bitShift: -8)
				bitAnd: 255)
				/ 255
		b: (val bitAnd: 255)
				/ 255!
]style[(9 1 3 59 3 4 4 3 3 7 16 10 5 13 12 2 5 4 7 3 11 3 8 3 8 3 11 2 14 3 8 3 7 3 9 3 8 3)f1b,f1cblue;b,f1,f1c144042000i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c000180023,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c000180023,f1,f1c000180023,f1,f1cblue;i,f1,f1c000180023,f1,f1c000180023,f1,f1c000180023,f1,f1cblue;i,f1,f1c000180023,f1,f1c000180023! !


!ImageReadWriter class methodsFor: 'image reading/writing' stamp: 'sbw 3/8/2003 13:11'!
formFromStream: aBinaryStream 
	"Answer a ColorForm stored on the given stream. closes the stream"
	| reader readerClass form |
	readerClass _ self withAllSubclasses
				detect: [:subclass | subclass understandsImageFormat: aBinaryStream]
				ifNone: [(aBinaryStream respondsTo: #close)
						ifTrue: [aBinaryStream close].
					^ self error: 'image format not recognized'].
	reader _ readerClass on: aBinaryStream reset.
	Cursor read
		showWhile: [form _ reader nextImage.
			reader close].
	^ form!
]style[(16 13 3 66 3 24 4 11 3 4 32 10 2 8 25 13 16 13 13 6 17 13 16 4 8 29 4 6 3 11 5 13 9 6 20 4 3 6 15 6 12 4)f1b,f1cblue;b,f1,f1c144042000i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cred;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000180023,f1,f1cblue;i,f1,f1cmagenta;,f1,f1c000180023,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i! !


!XPMReadWriter methodsFor: 'accessing' stamp: 'sbw 4/8/2003 18:38'!
nextImage
	"This guy wants a stream over a String."
	| values numColors image index color width height cpp colors readStream contents tgtDepth |
	contents _ stream contentsOfEntireFile.
	readStream _ contents isString
				ifTrue: [stream]
				ifFalse: [contents _ contents asString.
					ReadStream on: contents].
	readStream reset.
	readStream skipTo: $".
	"sbw - sometimes there are embedded tabs in the values string."
	values _ (readStream upTo: $") asString withSeparatorsCompacted findTokens: ' '.
	readStream skip: 1.
	"skip the trailing quote"
	width _ (values at: 1) asNumber.
	height _ (values at: 2) asNumber.
	numColors _ (values at: 3) asNumber.
	cpp _ (values at: 4) asNumber.
	tgtDepth _ cpp * 8 max: 16.
	tgtDepth = 24 ifTrue: [tgtDepth _ 32].
	image _ Form
				extent: width @ height
				depth: tgtDepth.
	colors _ Dictionary new.
	numColors
		timesRepeat: [readStream skipTo: $".
			index _ readStream next: cpp.
			readStream skip: 1.
			"key _"
			readStream upTo: $ .
			color _ (readStream upTo: $") asString.
			(color at: 1)
					= $#
				ifTrue: [color _ Color
								fromHex: (color
										copyFrom: 2
										to: (7 min: color size))
					"sbw - more tolerant here too."]
				ifFalse: [color _ Color transparent].
			readStream skip: 1.
			colors at: index asSymbol put: color].
	0
		to: height - 1
		do: [:y | 
			readStream skipTo: $".
			0
				to: width - 1
				do: [:x | 
					index _ readStream next: cpp.
					image
						colorAt: x @ y
						put: (colors at: index asSymbol)].
			readStream skip: 1].
	^ image!
]style[(9 2 40 3 79 13 8 3 6 24 10 3 8 23 6 16 8 3 8 16 10 5 8 4 10 9 10 9 2 3 63 2 6 4 10 7 2 47 3 3 10 7 1 3 25 2 5 4 6 5 1 13 6 4 6 5 1 13 9 4 6 5 1 13 3 4 6 5 1 24 3 3 1 6 43 2 5 3 4 13 5 3 6 12 8 3 6 3 10 7 9 17 10 9 2 5 5 3 10 7 3 5 10 7 1 5 7 4 10 7 2 5 5 4 10 7 2 16 5 5 1 9 2 14 5 3 5 19 5 21 1 16 1 6 5 13 31 16 5 3 5 18 10 7 1 5 6 5 5 15 5 4 1 7 6 3 1 8 3 6 10 9 2 5 1 9 5 3 1 10 3 8 5 3 10 7 3 7 5 16 1 3 1 13 6 5 5 16 10 7 1 6 5)f1b,f1,f1c146044000i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1c146044000i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1c000144000,f1,f1cblue;i,f1,f1c000144000,f1,f1c146044000i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1c000144000,f1,f1c000144000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1c146044000i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1c000144000,f1,f1c000144000,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c000144000,f1,f1c000144000,f1,f1cblue;i,f1,f1c146044000i,f1,f1cblue;i,f1,f1cmagenta;,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i,f1,f1c000144000,f1,f1cred;,f1,f1cblue;i,f1,f1c000144000,f1,f1c000144000,f1,f1cblue;i,f1,f1c000144000,f1,f1cred;,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1cblue;i,f1,f1c000144000,f1,f1cblue;i! !

!XPMReadWriter methodsFor: 'accessing' stamp: 'sbw 3/4/2003 12:10'!
nextPutImage: aForm
	| f lf colors cpp tempColor tempIndex |
	aForm unhibernate.
	f _ aForm colorReduced.
	lf _ Character lf asString.
	stream nextPutAll: '/* XPM */', lf, lf,'static char* image[]={', lf.
	colors _ f colorsUsed.
	cpp _ (colors size highBit - 1)//6 + 1.
	stream nextPutAll: '"',f width asString,' ',f height asString,' '.
	stream nextPutAll: colors size asString,' ', cpp asString,'",', lf.
	colors withIndexDo: [ :color :index |
		stream nextPut: $".
		0 to: cpp-1 do: [ :byte |
			stream nextPut: (CharTable at: ((index-1 bitShift: 0-(byte*6)) bitAnd: 63)+1)
			].
		stream nextPutAll: ' c '.
		color isTransparent
			ifTrue: [ stream nextPutAll: 'None']
			ifFalse: [ stream nextPutAll: '#',color asHex].
		stream nextPutAll: '",',lf
		].
	0 to: f height-1 do: [ :y |
		stream nextPut: $".
		0 to: f width-1 do: [ :x |
			tempColor _ f colorAt: x@y.
			tempIndex _ (colors findFirst: [ :ac | ac = tempColor ]).
			0 to: cpp-1 do: [ :byte |
				stream nextPut: (CharTable at: ((tempIndex-1
bitShift: 0-(byte*6)) bitAnd: 63)+1).
				]
			].
		stream nextPutAll: '",',lf
		].
	stream nextPutAll: '};',lf! !

!XPMReadWriter methodsFor: 'private' stamp: 'DSM 3/20/2000 15:43'!
understandsImageFormat
	| first |
	first _ (stream next: 9) asString.
	^ first = '/* XPM */'
! !


!XPMReadWriter class methodsFor: 'class initialization' stamp: 'sbw 3/4/2003 12:37'!
initialize
	"XPMReadWriter initialize"
	CharTable _ Array new: 64.
	#($  $. )
		, ($A to: $Z)
		, ($a to: $z)
		, ($0 to: $9)
		doWithIndex: [:char :index | CharTable at: index put: char].
	self load! !

!XPMReadWriter class methodsFor: 'examples' stamp: 'DSM 3/22/2000 23:29'!
example
	"
	XPMReadWriter example
	"
	| s |
	(self on: (s _ ReadWriteStream on: '')) nextPutImage: (Form
dotOfSize: 20).
	(self on: (ReadStream on: s contents)) nextImage displayAt: 20@20.
! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 12:36'!
fileReaderServicesForFile: fullName suffix: suffix 
	^ suffix = 'xpm' | (suffix = 'XPM')
		ifTrue: [self services]
		ifFalse: [#()]! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 14:37'!
importFile: aPath 
	| fStream myStream image contents fileName key |
	fileName _ FileDirectory splitName: aPath to: [:d :f | f].
	key _ fileName sansPeriodSuffix.
	fStream _ StandardFileStream readOnlyFileNamed: aPath.
	[contents _ fStream contentsOfEntireFile]
		ensure: [fStream close].
	myStream _ self
				on: (ReadStream on: contents).
	image _ myStream nextImage.
	Smalltalk imageImports at: key put: image! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 12:36'!
load
	"XPMReadWriter load"
		FileList registerFileReader: self! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 12:56'!
openFile: aPath 
	| fStream myStream image contents |
	fStream _ StandardFileStream readOnlyFileNamed: aPath.
	[contents _ fStream contentsOfEntireFile]
		ensure: [fStream close].
	myStream _ self on: (ReadStream on: contents).
	image _ myStream nextImage.
	Smalltalk isMorphic
		ifTrue: [(SketchMorph withForm: image) openInWorld]
		ifFalse: [FormView open: image named: aPath]! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 14:30'!
serviceImportXPMFile
	^ SimpleServiceEntry
		provider: self
		label: 'import XPM file'
		selector: #importFile:
		description: 'import XPM image'
		buttonLabel: 'import'! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 12:30'!
serviceOpenXPMFile
	^ SimpleServiceEntry
		provider: self
		label: 'open XPM file'
		selector: #openFile:
		description: 'open XPM image'
		buttonLabel: 'open'! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 14:30'!
services
	^ Array with: self serviceOpenXPMFile with: self serviceImportXPMFile! !

!XPMReadWriter class methodsFor: 'services' stamp: 'sbw 3/4/2003 12:17'!
unload
	"XPMReadWriter unload"
	FileList unregisterFileReader: self! !

XPMReadWriter initialize!

!XPMReadWriter class reorganize!
('class initialization' initialize)
('examples' example)
('services' fileReaderServicesForFile:suffix: importFile: load openFile: serviceImportXPMFile serviceOpenXPMFile services unload)
!


!XPMReadWriter reorganize!
('accessing' nextImage nextPutImage:)
('private' understandsImageFormat)
!

"Postscript:
Initialize and register ourselves as a FileList service."
XPMReadWriter initialize.
!