[comp.lang.smalltalk] Additional DisplayObject I/O routines

eliot@cs.qmw.ac.uk (Eliot Miranda) (03/15/91)

I realised that the chess package expects OpaqueForms to be readable & writeable
using the same scheme as Form file storage.  This isn't standard so I'm posting
what we use here.  This goodie also includes code for reading X11 bitmap files
and sun raster files (the sun method was writen by Edwin Blake).

Share & Enjoy!
---- Cut Here and unpack ----
#!/bin/sh
# xshar:	Shell Archiver  (v1.22)
#
#	Remove the header and type "sh filename" to create:
#	  COPYING
#	  DisplayObjectIO.changes
#
echo "x - extracting COPYING (Text)"
sed 's/^X//' << 'SHAR_EOF' > COPYING &&
X	Additional bitmap I/O routines for Smalltalk-80
X		OpaqueForms	(reading & writing)
X		X11 bitmaps	(reading)
X		sun raster files	(reading)
X	Copyright (C) 1991  Eliot E. Miranda, Edwin Blake
X
X	This program is free software; you can redistribute it and/or modify
X	it under the terms of the GNU General Public License as published by
X	the Free Software Foundation; either version 1, or (at your option)
X	any later version.
X
X	This program is distributed in the hope that it will be useful,
X	but WITHOUT ANY WARRANTY; without even the implied warranty of
X	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
X	GNU General Public License for more details.
X
X	You should have received a copy of the GNU General Public License
X	along with this program; if not, write to the Free Software
X	Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
X
X
X	Eliot Miranda					email:  eliot@cs.qmw.ac.uk
X	Dept of Computer Science		Tel:    071 975 5229 (+44 71 975 5229)
X	Queen Mary Westfield College	ARPA:   eliot%cs.qmw.ac.uk@nsf.ac.uk    
X	Mile End Road					UUCP:   eliot@qmw-cs.uucp
X	LONDON E1 4NS
X	U.K.
X
SHAR_EOF
chmod 0644 COPYING || echo "restore of COPYING fails"
set `wc -c COPYING`;Sum=$1
if test "$Sum" != "1096"
then echo original size 1096, current size $Sum;fi
echo "x - extracting DisplayObjectIO.changes (Text)"
sed 's/^X//' << 'SHAR_EOF' > DisplayObjectIO.changes &&
X'From BrouHaHa Smalltalk-80, Version 2.3.2t of 27 February 1990 on 15 March 1991 3:19:59 pm'!
X
X!DisplayObject class methodsFor: 'instance creation'!
X
XreadFrom: fileName
X	"Answer an instance of the receiver with bitmap initialized from 
X	the external file named fileName.  Answer nil if the file does not
X	contain a kind of DisplayObject."
X
X	| file code code2 result |
X	file _ FileStream oldFileNamed: fileName.
X	file readOnly; binary.
X	code _ file nextWord.	"reads fileCode"
X	code2 _ file nextWord.
X	file skip: -4.
X	code = 1 ifTrue: [result _ Form readFormFile: file].
X	code = 2 ifTrue: [result _ OpaqueForm readFormFile: file].
X	(code = 22950 and: [code2 = 27285])
X		ifTrue: [result _ Form readSunStream: file].
X	((code = 9060 and: [code2 = 25958]) "#def from #define"
X	or: [code = 2595 and: [code2 = 25701]]) "<cr>#de from <cr>#define"
X		ifTrue: [
X			"Bug in ParcPlace's V2.3 FileStream means that files switching mode
X			 between text & binary screw up cr<->lf conversion."
X			file close; readOnly; text.
X			result _ Form readX11TextFormFile: file].
X	file close.
X	^result! !
X
X
X!DisplayObject methodsFor: 'fileIn/Out'!
X
XappendTo: aStream
X	"Subclasses should define this method to provide relevant storage.
X	 See DisplayObject class>>readFrom:"
X	self subclassResponsibility!
X
XwriteOn: fileName
X	"Saves the receiver on the file fileName in the format--fileCode, extent, offset, bits."
X
X	Cursor write
X		showWhile: [
X			| fileStream |
X			fileStream _ FileStream fileNamed: fileName.
X			self appendTo: fileStream.
X			fileStream close]! !
X
X
X!Form methodsFor: 'fileIn/Out'!
X
XappendTo: fileStream
X	"Saves the receiver, appending it to the stream fileStream in the format--fileCode, extent, offset, bits."
X
X	| fileCode bitsIndex internalRaster fileRaster |
X	fileCode _ 1.
X	"This indicates that the instance is a Form.  Should probably be changed 
X	when better methods for permanent storage are devised."
X
X	fileStream binary.
X	fileStream nextWordPut: fileCode.
X	fileStream nextWordPut: width.
X	fileStream nextWordPut: height.
X	fileStream nextWordPut: offset x.
X	fileStream nextWordPut: offset y.
X	bitsIndex _ 0.
X	internalRaster _ self class rasterOf: width withDepth: 1.
X	fileRaster _ width + 15 // 16.
X	height timesRepeat: [
X		fileRaster timesRepeat: [
X			fileStream nextWordPut: (bits at: (bitsIndex _ bitsIndex + 1))].
X		fileRaster ~= internalRaster ifTrue: [bitsIndex _ bitsIndex + 1]].! !
XForm removeSelector: #writeOn:!
X
X
X!OpaqueForm methodsFor: 'fileIn/Out'!
X
XappendTo: fileStream
X	"Saves the receiver on the file fileName in the format--fileCode, extent, offset, bits."
X
X	fileStream
X		binary;
X		reset;
X		nextWordPut: 2. "fileCode for OpaqueForms"
X	figure appendTo: fileStream.
X	shape appendTo: fileStream! !
X
X
X
X!OpaqueForm class methodsFor: 'instance creation'!
X
XreadFormFile: fileStream
X	fileStream readOnly; binary.
X	fileStream nextWord = 2 ifFalse: [self error: 'bad file code'].	"check file code"
X	^self
X		figure: (Form readFormFile: fileStream)
X		shape: (Form readFormFile: fileStream)! !
X
X
X
X!Form class methodsFor: 'instance creation'!
X
XreadX11TextFormFile: file
X	"Answer an instance of the receiver with bitmap initialized from the external file.  
X	The file format is:  fileCode(1), extent, offset, bits."
X
X	| form bits byteIndex word height width wordIndex formByteRaster fileByteRaster |
X	file readOnly; text.
X	2 timesRepeat: [
X		| line |
X		(file skipToAll: '#define') == nil ifTrue: [^self error: 'couldn''t find #define'].
X		line _ (file upTo: Character cr) readStream.
X		(line skipToAll: 'height') ~~ nil ifTrue: [
X			line skip: 6 "'height' size'"; skipSeparators.
X			height _ Integer readFrom: line. file skip: -1].
X		line reset.
X		(line skipToAll: 'width') ~~ nil ifTrue: [
X			line skip: 5 "'width' size'"; skipSeparators.
X			width _ Integer readFrom: line. file skip: -1]].
X	(file skipToAll: 'bits[]') == nil ifTrue: [^self error: 'couldn''t find bits[]'].
X	file skipTo: ${; skip: 1.
X	form _ self extent: width@height.
X	bits _ form bits.
X	formByteRaster _ form raster * 2 "bytes per scanline".
X	fileByteRaster _ width + 7 // 8 "bytes per scanline (pixels rounded up to 8 pixel boundary)".
X	byteIndex _ 0.
X	wordIndex _ 0.
X	[file skipSeparators; atEnd] whileFalse: [
X		| radix byte |
X		file next = $0
X			ifTrue: [
X				file next = $x
X					ifTrue: [radix _ 16]
X					ifFalse: [file skip: -1. radix _ 8]]
X			ifFalse: [file skip: -1. radix _ 10].
X		byte _ Integer readFrom: file radix: radix.
X		file skip: 1. "skip comma"
X		(byteIndex _ byteIndex + 1) even
X			ifTrue: [
X				word _ word + (byte bitShift: 8).
X				bits at: (wordIndex _ wordIndex + 1) put: word wordReversed]
X			ifFalse: [
X				word _ byte].
X		byteIndex >= fileByteRaster ifTrue: [
X			byteIndex odd
X				ifTrue: [
X					bits at: (wordIndex _ wordIndex + 1) put: word wordReversed.
X					wordIndex _ wordIndex + ((formByteRaster - fileByteRaster // 2 - 1) max: 0)]
X				ifFalse: [
X					wordIndex _ wordIndex + (formByteRaster - fileByteRaster / 2)].
X			byteIndex _ 0]].
X	file close.
X	^form! !
X
X
X
X!Form class methodsFor: 'instance creation'!
X
XreadSunStream: file
X	"Answer an instance of me with bitmap initialized from the
X	external SUN standard raster file. The file format is:
X	/*
X	 * Description of header for files containing raster images
X	 */
X	struct rasterfile {
X		int		ras_magic;		/* magic number */
X		int		ras_width;			/* width (pixels) of image */
X		int		ras_height;		/* height (pixels) of image */
X		int		ras_depth;		/* depth (1, 8, or 24 bits) of pixel */
X		int		ras_length;		/* length (bytes) of image */
X		int		ras_type;			/* type of file; see RT_* below */
X		int		ras_maptype;		/* type of colormap; see RMT_* below */
X		int		ras_maplength;	/* length (bytes) of following map */
X	/* color map follows for ras_maplength bytes, followed by image */
X	};
X	#define RAS_MAGIC       0x59a66a95
X
X	/* Sun supported ras_type''s */
X	#define RT_OLD					0		/* Raw pixrect image in 68000 byte order */
X	#define RT_STANDARD			1		/* Raw pixrect image in 68000 byte order */
X	#define RT_BYTE_ENCODED	2		/* Run-length compression of bytes */
X
X	/* Sun registered ras_maptype''s */
X	#define RMT_RAW			2		/* Sun supported ras_maptype''s */
X	#define RMT_NONE			0		/* ras_maplength is expected to be 0 */
X	#define RMT_EQUAL_RGB	1		 /* red[ras_maplength/3],green[],blue[] */
X
X	/*
X	 * NOTES:
X	 *	Each line of the image is rounded out to a multiple of 16  bits.
X	 *   This corresponds to the rounding convention used  by the memory pixrect
X	 *   package (/usr/include/pixrect/memvar.h) of the SunWindows system.
X	 *	The ras_encoding field (always set to 0 by Sun''s supported software)
X	 *   was renamed to ras_length in release 2.0.  As a result, rasterfiles
X	 *   of type 0 generated by the old software claim to have 0 length; for
X	 *   compatibility, code reading rasterfiles must be prepared to compute the
X	 *   true length from the width, height, and depth fields.
X	 */
X	"
X	| form width height depth length formLineBytes fileLineBytes offset bits "redMap greenMap blueMap" |
X	file readOnly; binary.
X	(file nextNumber: 4) ~= 1504078485 ifTrue: [
X		^(Form new extent: 8 @ 8) black].
X
X	width _ file nextNumber: 4.
X	height _ file nextNumber: 4.
X	depth _ file nextNumber: 4.
X	length _ (file nextNumber: 4).
X	"Length of image in words"
X	(file nextNumber: 4) ~= 1 ifTrue: [
X		self error: 'Can only read standard sun format.'.
X		^(Form new extent: 8 @ 8) black].
X	file skip: 4.		"(file nextNumber: 4) ~= 1 ifTrue: [
X						self error: 'Can only read RGB colour maps.'.
X						^(Form new extent: 8 @ 8) black]."
X	file skip: (file nextNumber: 4).		"(file nextNumber: 4) ~= 768 ifTrue: [
X											self error: 'The colour map is the wrong length.'.
X											^(Form new extent: 8 @ 8) black]."
X										"redMap _ file next: 256.
X										greenMap _ file next: 256.
X										blueMap _ file next: 256."
X	form _ self new.
X	form extent: width @ height depth: depth offset: 0 @ 0.
X	form createBitmap.
X	formLineBytes _ form bits size * 2 / height.
X	"Sun round up scan lines to 16 bits"
X	fileLineBytes _ width * depth + 15 // 16 * 2.
X	fileLineBytes = formLineBytes
X		ifTrue: [
X			form bits replaceFrom: 1 to: form bits size withBytes: (file next: length) startingAt: 1]
X		ifFalse: [
X			1 to: height do: [:n|
X				| startIndex |
X				startIndex _ n - 1 * (formLineBytes / 2) + 1.
X				form bits
X					replaceFrom: startIndex to: startIndex + (formLineBytes / 2 - 2)
X					withBytes: (file next: fileLineBytes) startingAt: 1]].
X	^form
X
X
X	"(FileDirectory filesMatching: '/usr/NeWS/smi/*.im8') do: [:fn|
X		(SystemCall default canReadFile: fn) ifTrue: [
X			Transcript cr; show: fn.
X			(DisplayObject readFrom: fn) displayAt: 200@250]].
X	Display restoreBlackAndWhite"! !SHAR_EOF
chmod 0644 DisplayObjectIO.changes || echo "restore of DisplayObjectIO.changes fails"
set `wc -c DisplayObjectIO.changes`;Sum=$1
if test "$Sum" != "8605"
then echo original size 8605, current size $Sum;fi
exit 0
-- 
Eliot Miranda			email:	eliot@cs.qmw.ac.uk
Dept of Computer Science	Tel:	071 975 5229 (+44 71 975 5229)
Queen Mary Westfield College	ARPA:	eliot%cs.qmw.ac.uk@nsf.ac.uk	
Mile End Road			UUCP:	eliot@qmw-cs.uucp
LONDON E1 4NS