[comp.lang.smalltalk] File in for an object oriented picture editor Part1/2

baumeist@exunido.uucp (Hubert Baumeister) (12/05/89)

Here is the promised object-oriented picture editor, that generates output for
\LaTeX's picture environment. It is written in Smalltalk 80 (ParcPlace Version 2.3).
I post it as an shell-archive in two parts. Thanks for all the responses to my posting.

Have fun,
	Hubert Baumeister
(Hubert Baumeister, baumeist@exunido.uucp)

------------------------------ cut here ---------------------------------
# This is a shell archive.  Unpack with "sh <file".
echo x - picmod.st
sed -e 's/^X//' > "picmod.st" << '!Funky!Stuff!'
XDisplayObject subclass: #PictureElement
X	instanceVariableNames: ''
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PictureElement methodsFor: 'accessing'!
X
XboundingBox
X	^self subclassResponsibility!
X
XboundingBoxUnitlength: ul 
X	| box |
X	box _ self boundingBox.
X	^(box origin * ul corner: box corner * ul)
X		"expandBy: 2"!
X
XdefaultViewClass
X	^PictureElementView!
X
XnewBoundingBox: rect
X	self changed: #boundingBox!
X
Xorigin
X	^self subclassResponsibility!
X
Xorigin: aPoint
X	^self subclassResponsibility! !
X
X!PictureElement methodsFor: 'transforming'!
X
XmoveTo: t1 
X	self origin: t1! !
X
X!PictureElement methodsFor: 'copying'!
X
Xcopy
X	^super deepCopy! !
X
X!PictureElement methodsFor: 'printing'!
X
XlatexOn: t1 in: aPicture
X	| newOrigin | 
X	newOrigin _ aPicture translate: self origin.
X	t1 nextPutAll: '\put(' , newOrigin x printString , ' ,' , newOrigin y printString , ') '!
X
XstoreOn: aStream
X	| dep | 
X	dep _ self dependents shallowCopy.
X	dep do: [:d| self removeDependent: d].
X	super storeOn: aStream.
X	dep do: [:d| self addDependent: d].! !
X
XDisplayObject subclass: #Picture
X	instanceVariableNames: 'picElements unitlength extent origin boundingBox '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!Picture methodsFor: 'initialise-release'!
X
Xinitialize
X	picElements _ OrderedCollection new.
X	unitlength _ 1.
X	origin _ 0 @ 0.
X	extent _ 453.543 @ 566.929
X	"These measures are in pt. In cm it is 16cm to 20cm"! !
X
X!Picture methodsFor: 'accessing'!
X
Xextent
X	^extent!
X
Xfirst
X	^picElements first!
X
Xlast
X	^picElements last!
X
Xorigin
X	^origin!
X
XpicElements
X	^picElements!
X
Xunitlength
X	^unitlength! !
X
X!Picture methodsFor: 'modifying'!
X
Xextent: p
X	extent _ p.
X	boundingBox _ nil.
X	self changed: #extent!
X
Xorigin: t1 
X	origin _ t1!
X
Xunitlength: t1 
X	unitlength _ t1! !
X
X!Picture methodsFor: 'testing'!
X
Xincludes: t1 
X	^picElements includes: t1!
X
XisEmpty
X	^picElements isEmpty! !
X
X!Picture methodsFor: 'adding'!
X
Xadd: t1 
X	self addLast: t1!
X
XaddFirst: t1 
X	picElements addFirst: t1.
X	self changed: #addFirst with: t1!
X
XaddLast: t1 
X	picElements addLast: t1.
X	self changed: #addLast with: t1! !
X
X!Picture methodsFor: 'removing'!
X
Xremove: t1 
X	self remove: t1 ifAbsent: [self error: 'No such picture element in picture']!
X
Xremove: t1 ifAbsent: t2 
X	picElements remove: t1 ifAbsent: t2.
X	self changed: #remove with: t1!
X
XremoveFirst
X	| t1 |
X	t1 _ picElements removeFirst.
X	self changed: #removeFirst with: t1!
X
XremoveLast
X	| t1 |
X	t1 _ picElements removeLast.
X	self changed: #removeLast with: t1! !
X
X!Picture methodsFor: 'enumerate'!
X
Xdo: t1 
X	picElements do: t1!
X
XreverseDo: t1 
X	picElements reverseDo: t1! !
X
X!Picture methodsFor: 'transforming'!
X
Xtranslate: aPoint 
X	| np box |
X	box _ self computeBoundingBox.
X	np _ aPoint - box origin.
X	np y: box extent y - np y.
X	^np! !
X
X!Picture methodsFor: 'display box access'!
X
XcomputeBoundingBox
X	| rect |
X	boundingBox isNil ifTrue: [boundingBox _ self origin extent: self extent].
X	^boundingBox! !
X
X!Picture methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| bBox form |
X	bBox _ self boundingBox.
X	form _ Form extent: bBox extent rounded.
X	self picElements do: [:pe | pe
X			displayOn: form
X			at: pe origin - bBox origin
X			clippingBox: (0 @ 0 extent: bBox extent)
X			rule: Form under
X			mask: aForm].
X	form
X		displayOn: aDisplayMedium
X		at: aDisplayPoint + bBox origin
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle align: alignmentPoint with: relativePoint rule: ruleInteger mask: aForm 
X	| bBox form |
X	bBox _ displayTransformation applyTo: self boundingBox.
X	form _ Form extent: bBox extent rounded.
X	self picElements do: [:pe | pe
X			displayOn: aDisplayMedium
X			at: pe origin - bBox origin
X			clippingBox: (0 @ 0 extent: bBox extent)
X			rule: Form under
X			mask: aForm].
X	form
X		displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle align: alignmentPoint with: relativePoint rule: ruleInteger mask: aForm! !
X
X!Picture methodsFor: 'printing'!
X
XlatexOn: aStream 
X	| box |
X	aStream nextPutAll: '\setlength{\unitlength}{' , self unitlength printString , 'pt}'; cr.
X	boundingBox _ nil.
X	box _ self "computeBoundingBox"  origin extent: extent.
X	aStream nextPutAll: '\begin{picture}(' , box extent x asFloat printString , ' ,' , box extent y asFloat printString , ' ) (' , origin x printString , ' ,' , origin y printString , ')'; cr.
X	self do: [:elem | elem latexOn: aStream in: self].
X	aStream nextPutAll: '\end{picture}'; cr!
X
XstoreOn: aStream
X	| dep | 
X	dep _ self dependents shallowCopy.
X	dep do: [:d| self removeDependent: d].
X	boundingBox _ nil.
X	super storeOn: aStream.
X	dep do: [:d| self addDependent: d].! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XPicture class
X	instanceVariableNames: ''!
X
X
X!Picture class methodsFor: 'instance creation'!
X
Xnew
X	^super new initialize! !
X
XPictureElement subclass: #PicElemOval
X	instanceVariableNames: 'rect width parts '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemOval methodsFor: 'accessing'!
X
XaddPart: half
X	self parts add: half!
X
XboundingBox
X	^rect origin" - (0 @ 2)" corner: rect corner" + (0 @ 2)"!
X
XdefaultViewClass
X	^PicElemOvalView!
X
XflushParts
X	parts _ Set new: 4.!
X
XnewBoundingBox: box
X	rect _ box.
X	super newBoundingBox: rect!
X
Xorigin
X	^rect origin" - (0@2)"!
X
Xorigin: p
X	^rect _ (p "+ (0@2)") extent: rect extent!
X
Xparts
X	parts isNil ifTrue: [parts _ Set new: 4].
X	^parts! !
X
X!PicElemOval methodsFor: 'transforming'!
X
XmoveTo: aPoint
X	rect moveTo: aPoint + (0@2)! !
X
X!PicElemOval methodsFor: 'printing'!
X
XlatexOn: aStream in: aPicture
X	| box newCenter |
X	box _ self boundingBox.
X	newCenter _ aPicture translate: box center.
X	aStream nextPutAll: '\put(' , newCenter x printString , ' ,' , newCenter y printString , ') '.
X	aStream nextPutAll: '{ \oval(' , box extent x printString , ', ' , box extent y printString , ')'.
X	self parts size > 0
X		ifTrue: 
X			[aStream nextPutAll: '['.
X			self parts do: [:p | aStream nextPutAll: p].
X			aStream nextPutAll: ']'].
X	aStream nextPut: $}; cr! !
X
X!PicElemOval methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| bBox topLeftQ result dot min box radius tl l arc topRightQ bottomRightQ bottomLeftQ quadrants |
X	bBox _ self boundingBox.
X	topLeftQ _ Form extent: bBox extent rounded.
X	result _ Form extent: bBox extent rounded.
X	dot _ Form dotOfSize: 1.
X	dot black.
X	min _ bBox extent x min: bBox extent y.
X	box _ 0 @ 0 extent: bBox extent.
X	radius _ min / 2.
X	tl _ radius @ radius.
X	l _ Line
X				from: radius @ 0
X				to: box topCenter
X				withForm: dot.
X	l
X		displayOn: topLeftQ
X		at: 0 @ 0
X		clippingBox: (0 @ 0 extent: box extent)
X		rule: Form paint
X		mask: Form black.
X	l _ Line
X				from: 0 @ radius
X				to: box leftCenter
X				withForm: dot.
X	l
X		displayOn: topLeftQ
X		at: 0 @ 0
X		clippingBox: (0 @ 0 extent: bBox extent)
X		rule: Form paint
X		mask: Form black.
X	arc _ Arc new center: tl.
X	arc radius: radius.
X	arc form: dot.
X	arc center: tl.
X	arc quadrant: 2.
X	arc
X		displayOn: topLeftQ
X		at: 0 @ 0
X		clippingBox: (0 @ 0 extent: bBox extent)
X		rule: Form paint
X		mask: Form black.
X	topRightQ _ topLeftQ reflect: 1 @ 0.
X	bottomRightQ _ topRightQ reflect: 0 @ 1.
X	bottomLeftQ _ topLeftQ reflect: 0 @ 1.
X	quadrants _ self computeQuadrantsFrom: self parts.
X	(quadrants includes: 2)
X		ifTrue: [topLeftQ displayOn: result].
X	(quadrants includes: 1)
X		ifTrue: [topRightQ
X				displayOn: result
X				at: 0 @ 0
X				rule: Form under].
X	(quadrants includes: 4)
X		ifTrue: [bottomRightQ
X				displayOn: result
X				at: 0 @ 0
X				rule: Form under].
X	(quadrants includes: 3)
X		ifTrue: [bottomLeftQ
X				displayOn: result
X				at: 0 @ 0
X				rule: Form under].
X	result
X		displayOn: aDisplayMedium
X		at: aDisplayPoint
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| bBox topLeftQ dot min box radius tl l arc topRightQ bottomRightQ bottomLeftQ quadrants result trans |
X	bBox _ self boundingBox.
X	topLeftQ _ Form extent: (bBox extent scaleBy: displayTransformation scale) rounded.
X	result _ Form extent: topLeftQ extent.
X	trans _ WindowingTransformation identity scaleBy: displayTransformation scale.
X	dot _ Form dotOfSize: 1.
X	dot black.
X	min _ bBox extent x min: bBox extent y.
X	box _ 0 @ 0 extent: bBox extent.
X	radius _ min / 2.
X	tl _ radius @ radius.
X	l _ Line
X				from: radius @ 0
X				to: box topCenter
X				withForm: dot.
X	l
X		displayOn: topLeftQ
X		transformation: trans clippingBox: (0@0 extent: topLeftQ extent) rule: Form paint mask: Form black .
X	l _ Line
X				from: 0 @ radius
X				to: box leftCenter
X				withForm: dot.
X	l
X		displayOn: topLeftQ
X		transformation: trans clippingBox: (0@0 extent: topLeftQ extent) rule: Form paint mask: Form black .
X	arc _ Arc new center: tl.
X	arc radius: radius.
X	arc form: dot.
X	arc center: tl.
X	arc quadrant: 2.
X	arc
X		displayOn: topLeftQ
X		transformation: trans clippingBox: (0@0 extent: topLeftQ extent) rule: Form paint mask: Form black .
X	topRightQ _ topLeftQ reflect: 1 @ 0.
X	bottomRightQ _ topRightQ reflect: 0 @ 1.
X	bottomLeftQ _ topLeftQ reflect: 0 @ 1.
X	quadrants _ self computeQuadrantsFrom: self parts.
X	(quadrants includes: 2)
X		ifTrue: [topLeftQ displayOn: result].
X	(quadrants includes: 1)
X		ifTrue: [topRightQ
X				displayOn: result
X				at: 0 @ 0
X				rule: Form under].
X	(quadrants includes: 4)
X		ifTrue: [bottomRightQ
X				displayOn: result
X				at: 0 @ 0
X				rule: Form under].
X	(quadrants includes: 3)
X		ifTrue: [bottomLeftQ
X				displayOn: result
X				at: 0 @ 0
X				rule: Form under].
X	result
X		displayOn: aDisplayMedium 
X		at: (displayTransformation applyTo: 0@0) clippingBox: clipRectangle rule: ruleInteger mask: aForm! !
X
X!PicElemOval methodsFor: 'private'!
X
XcomputeQuadrantsFrom: p 
X	p size = 1
X		ifTrue: 
X			[(p includes: #t)
X				ifTrue: [^#(2 1 )].
X			(p includes: #b)
X				ifTrue: [^#(3 4 )].
X			(p includes: #r)
X				ifTrue: [^#(1 4 )].
X			(p includes: #l)
X				ifTrue: [^#(3 2 )]].
X	(p includes: #t)
X		ifTrue: 
X			[(p includes: #l)
X				ifTrue: [^#(2 )].
X			(p includes: #r)
X				ifTrue: [^#(1 )]].
X	(p includes: #b)
X		ifTrue: 
X			[(p includes: #l)
X				ifTrue: [^#(3 )].
X			(p includes: #r)
X				ifTrue: [^#(4 )]].
X	^#(1 2 3 4)! !
X
XPictureElement subclass: #PicElemLine
X	instanceVariableNames: 'from to width '
X	classVariableNames: 'SlopeTable '
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemLine methodsFor: 'accessing'!
X
XboundingBox
X	^(self origin corner: (from x max: to x)
X			@ (from y max: to y)"+1")
X		"expandBy: self width + 1"!
X
Xfrom
X	^from!
X
Xfrom: start to: stop 
X	"from _ t1. 
X	to _ t2"
X
X	| diff | 
X	diff _ (stop - start).
X	diff _ self computePointFrom: (self computeLatexLineFrom: diff).
X	from _ start.
X	to _ start + diff!
X
XnewBoundingBox: rect 
X	| fromSymbol toSymbol |
X	fromSymbol _ self boundingBox nearestPoint: from to:  #(topLeft topRight bottomLeft bottomRight ).
X	toSymbol _ self boundingBox nearestPoint: to to: #(topLeft topRight bottomLeft bottomRight ).
X	fromSymbol isNil | toSymbol isNil ifTrue: [^self].
X	self from: (rect perform: fromSymbol)
X		to: (rect perform: toSymbol).
X	super newBoundingBox: rect!
X
Xorigin
X	^(from x min: to x)
X		@ (from y min: to y)!
X
Xorigin: t1 
X	| t2 |
X	t2 _ self origin - t1.
X	from _ from - t2.
X	to _ to - t2!
X
Xto
X	^to!
X
Xwidth
X	width isNil ifTrue: [width _ 1].
X	^width!
X
Xwidth: t1 
X	width _ t1! !
X
X!PicElemLine methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| line |
X	line _ Line
X				from: self from
X				to: self to
X				withForm: (Form dotOfSize: 1).
X	line
X		displayOn: aDisplayMedium
X		at: aDisplayPoint - self origin
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| line  |
X	line _ Line
X				from: self from - self origin
X				to: self to - self origin
X				withForm: (Form dotOfSize: 1).
X	line
X		displayOn: aDisplayMedium
X		transformation: displayTransformation
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm! !
X
X!PicElemLine methodsFor: 'printing'!
X
XlatexOn: aStream in: aPicture
X	| diff ar newFrom |
X	newFrom _ aPicture translate: from.
X	diff _ (aPicture translate: to)
X				- newFrom.
X	ar _ self computeLatexLineFrom: diff.
X	aStream nextPutAll: '\put(' , newFrom x printString , ' ,' , newFrom y printString , ') '.
X	aStream nextPutAll: '{ \line(' , (ar at: 1) printString , ' ,' , (ar at: 2) printString , ') {' , (ar at: 3) printString , '}}'; cr! !
X
X!PicElemLine methodsFor: 'private'!
X
XcomputeLatexLineFrom: p 
X	| ideal |
X	p y = 0 ifTrue: [^Array
X			with: 1 * p x sign
X			with: 0
X			with: p x abs].
X	ideal _ self findIdealSlopeFor: p x / p y.
X	ideal = 0 ifTrue: [^Array
X			with: 0
X			with: 1 * p y sign
X			with: p y abs]. 
X	^Array
X		with: ideal numerator abs * p x sign
X		with: ideal denominator abs * p y sign
X		with: p x abs!
X
XcomputePointFrom: array 
X	" array = (h, v, destx)"
X
X	| y | 
X	((array at: 1) = 0) & ((array at: 2) = 0) ifTrue: [^((array at: 3)*(array at: 1) sign)@0].
X	((array at: 1) = 0) & ((array at: 2) ~= 0) ifTrue: [^0@((array at: 3)*(array at: 2) sign)].
X	y _ (array at: 2)
X				* (array at: 3) / (array at: 1).
X	^(array at: 3) * (array at: 1) sign
X		@ (y abs * (array at: 2) sign)!
X
XfindIdealSlopeFor: m 
X	| bestSlope diff |
X	bestSlope _ SlopeTable first.
X	diff _ (m - bestSlope) abs.
X	SlopeTable do: [:tm | (m - tm) abs < diff
X			ifTrue: 
X				[diff _ (m - tm) abs.
X				bestSlope _ tm]].
X	^bestSlope! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XPicElemLine class
X	instanceVariableNames: ''!
X
X
X!PicElemLine class methodsFor: 'instance creation'!
X
Xfrom: t1 to: t2 
X	^self new from: t1 to: t2!
X
XinRectangle: t1 
X	^self from: t1 origin to: t1 corner! !
X
X!PicElemLine class methodsFor: 'initialization'!
X
Xinitialize
X	"PicElemLine initialize"
X
X	SlopeTable _ OrderedCollection new.
X	-6 to: 6 do: [:h | -6 to: 6 do: [:v | v = 0 ifFalse: [SlopeTable add: h / v]]]! !
X
XPicElemLine initialize!
X
X
XPictureElement subclass: #PicElemCircle
X	instanceVariableNames: 'center radius width full '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemCircle methodsFor: 'accessing'!
X
XboundingBox
X	^(center - (radius @ radius) corner: center + (radius"+1" @ (radius"+1")))
X		"expandBy: self width"!
X
Xcenter
X	^center!
X
Xcenter: t1 radius: t2 
X	| max |
X	center _ t1.
X	max _ self full ifTrue: [5] ifFalse: [20].
X	radius _ t2 > max
X				ifTrue: [max]
X				ifFalse: [t2]!
X
XdefaultViewClass
X	^PicElemCircleView!
X
Xfull
X	full isNil ifTrue: [full _ false].
X	^full!
X
Xfull: bool
X	full _ bool.
X	full ifTrue: [self center: center radius: radius].
X	self changed: #boundingBox!
X
XnewBoundingBox: rect 
X	| extent newCenter newRadius |
X	extent _ rect extent.
X	newCenter _ extent x / 2 @ (extent y / 2) + rect origin.
X	newRadius _ (extent x min: extent y)
X				/ 2.
X	self center: newCenter radius: newRadius	.
X	super newBoundingBox: rect!
X
Xorigin
X	^center - (radius @ radius)!
X
Xorigin: t1 
X	center _ t1 + (radius @ radius)!
X
Xradius
X	^radius!
X
Xwidth
X	width isNil ifTrue: [width _ 1].
X	^width!
X
Xwidth: t1 
X	width _ t1! !
X
X!PicElemCircle methodsFor: 'printing'!
X
XlatexOn: aStream in: aPicture
X	| newCenter |
X	newCenter _ aPicture translate: self center.
X	aStream nextPutAll: '\put(' , newCenter x printString , ' ,' , newCenter y printString , ') '.
X	aStream nextPutAll: '{ \circle' , (self full
X				ifTrue: ['*{']
X				ifFalse: ['{']) , (radius * 2) printString , '}}'; cr! !
X
X!PicElemCircle methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| circle |
X	circle _ Circle new.
X	circle center: self center - self origin.
X	circle radius: self radius.
X	circle form: (Form dotOfSize: 1).
X	circle
X		displayOn: aDisplayMedium
X		at: aDisplayPoint
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm	.
X	self full ifTrue: [aDisplayMedium shapeFill: Form black interiorPoint: (self center - self origin + aDisplayPoint) rounded].!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| circle |
X	circle _ Circle new.
X	circle center: self center - self origin.
X	circle radius: self radius.
X	circle form: (Form dotOfSize: 1).
X	circle
X		displayOn: aDisplayMedium
X		transformation: displayTransformation
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm.
X	self full ifTrue: [aDisplayMedium shapeFill: Form black interiorPoint: (displayTransformation applyTo: self center - self origin)]! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XPicElemCircle class
X	instanceVariableNames: ''!
X
X
X!PicElemCircle class methodsFor: 'instance creation'!
X
Xcenter: t1 radius: t2 
X	^self new center: t1 radius: t2!
X
XinRectangle: t1 
X	| t2 t3 t4 |
X	t2 _ t1 extent.
X	t3 _ t2 x / 2 @ (t2 y / 2) + t1 origin.
X	t4 _ (t2 x min: t2 y)
X				/ 2.
X	^self center: t3 radius: t4! !
X
XPicElemLine subclass: #PicElemVector
X	instanceVariableNames: ''
X	classVariableNames: 'VectorSlopeTable '
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemVector methodsFor: 'accessing'!
X
XboundingBox
X	^super boundingBox expandBy: 1@1!
X
Xorigin
X	^super origin" + (1@1)"!
X
Xorigin: p
X	^super origin: p "+ (1@1)"! !
X
X!PicElemVector methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| line arrow pen diff norm newp |
X	pen _ Form dotOfSize: 1.
X	super
X		displayOn: aDisplayMedium
X		at: aDisplayPoint
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm.
X	arrow _ LinearFit new form: pen.
X	arrow add: to rounded.
X	diff _ to - from.
X	norm _ diff normal unitVector.
X	newp _ (to - (diff unitVector * 4)) rounded.
X	arrow add: (newp + (norm * 2)) rounded.
X	arrow add: (newp - (norm * 2)) rounded.
X	arrow add: to rounded.
X	arrow
X		displayOn: aDisplayMedium
X		at: aDisplayPoint - self origin
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| line arrow pen diff norm newp |
X	pen _ Form dotOfSize: 1.
X	super
X		displayOn: aDisplayMedium
X		transformation: displayTransformation
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm.
X	arrow _ LinearFit new form: pen.
X	arrow add: to rounded - self origin.
X	diff _ to - from.
X	norm _ diff normal unitVector.
X	newp _ (to - (diff unitVector * 4)) rounded.
X	arrow add: (newp + (norm * 2)) rounded - self origin.
X	arrow add: (newp - (norm * 2)) rounded - self origin.
X	arrow add: to rounded - self origin. 
X	arrow
X		displayOn: aDisplayMedium
X		transformation: displayTransformation
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm! !
X
X!PicElemVector methodsFor: 'printing'!
X
XlatexOn: aStream in: aPicture
X	| diff ar newFrom |
X	newFrom _ aPicture translate: from.
X	diff _ (aPicture translate: to)
X				- newFrom.
X	ar _ self computeLatexLineFrom: diff.
X	aStream nextPutAll: '\put(' , newFrom x printString , ' ,' , newFrom y printString , ') '.
X	aStream nextPutAll: '{ \vector(' , (ar at: 1) printString , ' ,' , (ar at: 2) printString , ') {' , (ar at: 3) printString , '}}'; cr! !
X
X!PicElemVector methodsFor: 'private'!
X
XfindIdealSlopeFor: m 
X	| bestSlope diff |
X	bestSlope _ VectorSlopeTable first.
X	diff _ (m - bestSlope) abs.
X	VectorSlopeTable do: [:tm | (m - tm) abs < diff
X			ifTrue: 
X				[diff _ (m - tm) abs.
X				bestSlope _ tm]].
X	^bestSlope! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XPicElemVector class
X	instanceVariableNames: ''!
X
X
X!PicElemVector class methodsFor: 'initialization'!
X
Xinitialize
X	"PicElemVector initialize"
X
X	VectorSlopeTable _ OrderedCollection new.
X	-4 to: 4 do: [:h | -4 to: 4 do: [:v | v = 0 ifFalse: [VectorSlopeTable add: h / v]]]! !
X
XPicElemVector initialize!
X
X
XPictureElement subclass: #PicElemForm
X	instanceVariableNames: 'origin form '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemForm methodsFor: 'accessing'!
X
XboundingBox
X	^self form boundingBox translateBy: self origin!
X
XdefaultViewClass
X	^PicElemFormView!
X
Xform
X	^form!
X
Xorigin
X	^origin!
X
Xorigin: aPoint
X	origin _ aPoint! !
X
X!PicElemForm methodsFor: 'printing'!
X
XlatexOn: aStream in: aPicture
X	| x y newOrigin black xstart res ul |
X	newOrigin _ (aPicture translate: origin)
X				- (0 @ (self boundingBox extent y)).
X	ul _ aPicture unitlength.
X	x _ newOrigin x rounded.
X	y _ newOrigin y rounded.
X	form height
X		to: 1
X		by: -1
X		do: 
X			[:i | 
X			xstart _ x. black _ false.
X			1 to: form width do: 
X				[:j | 
X				(form valueAt: ((j-1) @ (i-1)))
X					= 1
X					ifTrue: [black
X							ifFalse: 
X								[xstart _ x.
X								black _ true]]
X					ifFalse: [black
X							ifTrue: 
X								[aStream nextPutAll: '\put(' , xstart printString , ', ' , y printString , '){\rule{' , ((x - xstart) * ul) printString , 'pt}{',ul printString, 'pt}}'; cr.
X								black _ false]].
X				x _ x + 1].
X			black ifTrue: [aStream nextPutAll: '\put(' , xstart printString , ', ' , y printString , '){\rule{' , ((x - xstart) * ul) printString , 'pt}{',ul printString, 'pt}}'; cr.
X								black _ false].
X			y _ y + 1.
X			x _ newOrigin x rounded]! !
X
X!PicElemForm methodsFor: 'private'!
X
Xform: aForm 
X	form _ aForm! !
X
X!PicElemForm methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	self form
X		displayOn: aDisplayMedium
X		at: aDisplayPoint
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	self form
X		displayOn: aDisplayMedium
X		transformation: displayTransformation
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XPicElemForm class
X	instanceVariableNames: ''!
X
X
X!PicElemForm class methodsFor: 'instance creation'!
X
Xform: aForm
X	^self new form: aForm! !
X
XPictureElement subclass: #PicElemText
X	instanceVariableNames: 'origin text '
X	classVariableNames: 'IsCollapsed '
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemText methodsFor: 'accessing'!
X
XboundingBox
X	^self origin extent: text asDisplayText boundingBox extent!
X
XboundingBoxUnitlength: ul 
X	| box |
X	box _ self boundingBox.
X	^(box origin * ul extent: box extent) "expandBy: 2"!
X
XchangeText: aText
X	| oldBox newBox |
X	oldBox _ text asDisplayText boundingBox.
X	self text: aText.
X	newBox _ aText asDisplayText boundingBox.
X	self origin: (newBox align: newBox center with: oldBox center) origin + self origin.
X	self changed: #boundingBox!
X
XdefaultViewClass
X	^PicElemTextView!
X
XisCollapsed
X	^self class isCollapsed!
X
XnewBoundingBox: rect
X	^self!
X
Xorigin
X	^origin!
X
Xorigin: aPoint
X	origin _ aPoint!
X
Xtext
X	^text!
X
Xtext: aText
X	text _ aText! !
X
X!PicElemText methodsFor: 'printing'!
X
XlatexOn: aStream in: aPicture 
X	| newOrigin extent |
X	newOrigin _ (aPicture translate: origin)
X				- (0 @ self boundingBox extent y).
X	extent _ self boundingBox extent.
X	aStream nextPutAll: '\put(' , newOrigin x printString , ' ,' , newOrigin y printString , ') '.
X	aStream nextPutAll: '{\makebox(' , extent x printString , ' , ' , extent y printString , ' ){'.
X	aStream nextPutAll: text.
X	aStream nextPutAll: '}}'; cr! !
X
X!PicElemText methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| oldBox newBox |
X	self isCollapsed
X		ifTrue: 
X			[oldBox _ text asDisplayText boundingBox.
X			newBox _ 0 @ 0 extent: 10 @ 10.
X			((Form extent: newBox extent)
X				borderWidth: 2)
X				displayOn: aDisplayMedium
X				at: aDisplayPoint + (newBox align: newBox center with: oldBox center) origin 
X				clippingBox: clipRectangle
X				rule: ruleInteger
X				mask: aForm]
X		ifFalse: [self text asDisplayText
X				displayOn: aDisplayMedium
X				at: aDisplayPoint
X				clippingBox: clipRectangle
X				rule: ruleInteger
X				mask: aForm]!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| oldBox newBox |
X	self isCollapsed
X		ifTrue: 
X			[oldBox _ text asDisplayText boundingBox.
X			newBox _ 0 @ 0 extent: 10 @ 10.
X			((Form extent: newBox extent)
X				borderWidth: 2)
X				displayOn: aDisplayMedium
X				at: displayTransformation translation + (newBox align: newBox center with: oldBox center) origin 
X				clippingBox: clipRectangle
X				rule: ruleInteger
X				mask: aForm]
X		ifFalse: [self text asDisplayText form
X				displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X]! !
X"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
X
XPicElemText class
X	instanceVariableNames: ''!
X
X
X!PicElemText class methodsFor: 'accesiing'!
X
XisCollapsed
X	IsCollapsed isNil ifTrue: [IsCollapsed _ false].
X	^IsCollapsed!
X
XisCollapsed: bool
X	IsCollapsed _ bool! !
X
XPictureElement subclass: #PicElemGroup
X	instanceVariableNames: 'origin elements '
X	classVariableNames: ''
X	poolDictionaries: ''
X	category: 'Pictures-Model'!
X
X
X!PicElemGroup methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	elements isNil ifTrue: [^self].
X	elements do: [:elem| 
X		elem displayOn: aDisplayMedium
X		at: aDisplayPoint + elem origin
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm]!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	| trans result |
X	result _ Form extent: (self boundingBox extent scaleBy: displayTransformation scale) rounded.
X	trans _ WindowingTransformation identity scaleBy: displayTransformation scale.
X	elements isNil ifTrue: [^self].
X	elements do: [:elem | elem
X			displayOn: result
X			transformation: (trans translateBy: (trans applyTo: elem origin))
X			clippingBox: (0 @ 0 extent: result extent)
X			rule: Form under
X			mask: aForm].
X	result
X		displayOn: aDisplayMedium
X		at: (displayTransformation applyTo: 0 @ 0)
X		clippingBox: clipRectangle
X		rule: ruleInteger
X		mask: aForm! !
X
X!PicElemGroup methodsFor: 'accessing'!
X
Xadd: anElement
X	self elements add: anElement.
X	anElement origin: anElement origin - self origin-(1@1).!
X
XboundingBox
X	| rect |
X	rect _ elements first boundingBox.
X	elements do: [:pe | rect _ rect merge: pe boundingBox].
X	^rect moveTo: self origin!
X
XdefaultViewClass
X	^PicElemGroupView!
X
Xelements
X	elements isNil ifTrue: [elements _ OrderedCollection new].
X	^elements!
X
XnewBoundingBox: rect 
X	| box scale |
X	box _ self boundingBox.
X	scale _ rect extent x / box extent x @ (rect extent y / box extent y).
X	self elements do: [:elem | elem newBoundingBox: (elem boundingBox scaleBy: scale)].
X	super newBoundingBox: rect!
X
Xorigin
X	^origin!
X
Xorigin: p
X	origin _ p! !
X
X!PicElemGroup methodsFor: 'printing'!
X
XlatexOn: stream in: aPicture
X	| oldOrigin |
X	self elements do: 
X		[:elem | 
X		oldOrigin _ elem origin.
X		elem origin: elem origin + self origin.
X		elem
X			latexOn: stream
X			in: aPicture.
!Funky!Stuff!
echo x - changes.st
sed -e 's/^X//' > "changes.st" << '!Funky!Stuff!'
X'From Smalltalk-80, Version 2.3 of 13 June 1988 on 4 December 1989 at 7:49:34 pm'!
X
X
X
X!Rectangle methodsFor: 'accessing'!
X
XbottomCenter: p 
X	"Set the position of the bottom horizontal line of the receiver."
X
X	corner y: p y!
X
XbottomLeft: p
X	"Set the point at the left edge of the bottom horizontal line of the receiver."
X
X	origin x: p x.
X	corner y: p y!
X
XleftCenter: p 
X	"Set the position of the receiver's left vertical line."
X
X	origin x: p x!
X
XnearestPoint: p to: points
X	|  diff newDiff symbol |
X	diff _ self extent r.
X	points do: 
X		[:ps | 
X		newDiff _ ((self perform: ps)
X					- p) r abs.
X		newDiff < diff
X			ifTrue: 
X				[diff _ newDiff.
X				symbol _ ps]].
X	^symbol!
X
XnearestPointTo: p 
X	^self nearestPoint: p to: #(topLeft topCenter topRight leftCenter rightCenter bottomLeft bottomCenter bottomRight )!
X
XrightCenter: p 
X	"Set the position of the receiver's right vertical line."
X
X	corner x: p x!
X
XtopCenter: p 
X	"Set the position of the receiver's top horizontal line."
X
X	origin y: p y!
X
XtopRight: p
X	"Answer the point at the top right corner of the receiver's top horizontal line."
X
X	corner x: p x.
X	origin y: p y! !
X
X
X!Arc methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle align: alignmentPoint with: relativePoint rule: ruleInteger mask: aForm 
X	"Display the receiver on the display medium aDisplayMedium positioned 
X	at aDisplayPoint within  
X	the rectangle clipRectangle and with the rule, ruleInteger, and mask, 
X	aForm. "
X
X	| nSegments line angle sin cos xn yn xn1 yn1 | 
X	nSegments _ 12.0.
X	line _ Line new.
X	line form: self form.
X	angle _ 90.0 / nSegments.
X	sin _ (angle * (2 * Float pi / 360.0)) sin.
X	cos _ (angle * (2 * Float pi / 360.0)) cos.
X	quadrant = 1
X		ifTrue: 
X			[xn _ radius asFloat.
X			yn _ 0.0].
X	quadrant = 2
X		ifTrue: 
X			[xn _ 0.0.
X			yn _ 0.0 - radius asFloat].
X	quadrant = 3
X		ifTrue: 
X			[xn _ 0.0 - radius asFloat.
X			yn _ 0.0].
X	quadrant = 4
X		ifTrue: 
X			[xn _ 0.0.
X			yn _ radius asFloat].
X	nSegments truncated
X		timesRepeat: 
X			[xn1 _ xn * cos + (yn * sin).
X			yn1 _ yn * cos - (xn * sin).
X			line beginPoint: center + (xn truncated @ yn truncated).
X			line endPoint: center + (xn1 truncated @ yn1 truncated).
X			line
X				displayOn: aDisplayMedium
X				transformation: displayTransformation
X				clippingBox: clipRectangle
X				"align: alignmentPoint
X				with: relativePoint"
X				rule: ruleInteger
X				mask: aForm.
X			xn _ xn1.
X			yn _ yn1]!
X
XdisplayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger mask: aForm 
X	"Display the receiver on the display medium aDisplayMedium positioned 
X	at aDisplayPoint within  
X	the rectangle clipRectangle and with the rule, ruleInteger, and mask, 
X	aForm. "
X
X	| nSegments line angle sin cos xn yn xn1 yn1 | 
X	nSegments _ 12.0.
X	line _ Line new.
X	line form: self form.
X	angle _ 90.0 / nSegments.
X	sin _ (angle * (2 * Float pi / 360.0)) sin.
X	cos _ (angle * (2 * Float pi / 360.0)) cos.
X	quadrant = 1
X		ifTrue: 
X			[xn _ radius asFloat.
X			yn _ 0.0].
X	quadrant = 2
X		ifTrue: 
X			[xn _ 0.0.
X			yn _ 0.0 - radius asFloat].
X	quadrant = 3
X		ifTrue: 
X			[xn _ 0.0 - radius asFloat.
X			yn _ 0.0].
X	quadrant = 4
X		ifTrue: 
X			[xn _ 0.0.
X			yn _ radius asFloat].
X	nSegments truncated
X		timesRepeat: 
X			[xn1 _ xn * cos + (yn * sin).
X			yn1 _ yn * cos - (xn * sin).
X			line beginPoint: center + (xn truncated @ yn truncated).
X			line endPoint: center + (xn1 truncated @ yn1 truncated).
X			line
X				displayOn: aDisplayMedium
X				transformation: displayTransformation
X				clippingBox: clipRectangle
X				"align: alignmentPoint
X				with: relativePoint"
X				rule: ruleInteger
X				mask: aForm.
X			xn _ xn1.
X			yn _ yn1]! !
X
X
X!Circle methodsFor: 'displaying'!
X
XdisplayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect align: p1 with: p2 rule: anInteger mask: aForm 
X	"Display the receiver, translated and scaled by aTransformation, 
X	displaying with combination rule ruleInteger, masked by aForm, and 
X	clipped with the rectangle clipRectangle."
X
X	1 to: 4 do: 
X		[:i | 
X		super quadrant: i.
X		super
X			displayOn: aDisplayMedium
X			transformation: aTransformation
X			clippingBox: clipRect
X			align: p1
X			with: p2
X			rule: anInteger
X			mask: aForm]! !
!Funky!Stuff!
echo x - readme
sed -e 's/^X//' > "readme" << '!Funky!Stuff!'
X						Picture editor V1.0
X(C) 89 by Hubert Baumeister (baumeist@exunido.{uucp, bitnet})	
X
XThis is the fileIn for an object-oriented program to draw pictures. The reason I wrote this program is to define more easily pictures in the picture environment of \LaTeX. Therefor it supports the limits \LaTeX{} imposes on the picture, that is limited size of circles and discs and limited slopes of lines and arcs.
X
XThe program is written in Smalltalk 80 (ParcPlace Version 2.3) on an Atari Mega ST 4. It should be easy to port to ParcPlace Smalltalk Version 2.4 and 2.5 and to Tektronix Smalltalk.
X
XThe editor is not a WYSIWYG editor, mainly because I didn't want to reimplement \TeX{} to typeset the text in the pictures.
X
XI wrote this editor to help me create documents with graphics in it. There are a lot of things that could and should be done to make it foolproof and a product but I don't have the time to do it. But nevertheless I hope this program will be a start for others.
X
XFeel free to make changes to the editor and to redistribute it on a non-profit base.
X
XPlease send suggestions, bug reports and fixes to baumeist@exunido.{uucp, bitnet}.
X
XTo open the editor select the following line and 'do it'
X	PictureView openOn: Picture new
X
XTo generate the output for \LaTeX{} select 'latex' in the editor menu.
X
XTo store the picture on disk select 'file out' in the editor menu.
XWith the expression:
X	PictureView openOn: (Picture readFrom: (FileStream oldFileNamed: 'name'))
Xone can get the picture back into the editor.
X
XTo fileIn the editor select the text in curly brackets and 'do it' after changing dir to the directory name the files are in:
X
X{
X| fs dir |
Xdir _ 'picedit'. 
X#(
X	'picmod.st'
X	'picinter.st'
X	'changes.st'
X)
Xdo: [:name| (FileStream oldFileNamed: dir,'/',name) fileIn]
X}
X
XBugs:
XWhen filing out a picture the 'storeOn: aStream' message is used. The problem is, that the methods for storeOn: generate one Smalltalk expression. If the picture contains a lot of elements the generated expression can get to huge for the Smalltalk compiler (at least in Version < 2.3). 
X
XThe generated output for \LaTeX{} is independent of the setting of unitlength except for bitmaps. Therefor it is not possible to change the unitlength in the generated output per hand, when using bitmaps.
X
XFiles:
X	picmod.st contains the code for the picture and its elements.
X	picinter.st contains the user interface code for the models in picmod.st.
X	changes.st contains changes to the system.
X	picture1.xpl, picture2.xpl and picture3.xpl are some sample pictures that can be read into the editor. 
X	picture1.tex, picture2.tex and picture3.tex are the corresponding \LaTeX{} files.
!Funky!Stuff!