Path: utzoo!attcan!uunet!mcsun!ukc!acorn!abccam!phil
From: phil@abccam.abcl.co.uk (Phillip Yelland)
Newsgroups: comp.lang.smalltalk
Subject: Re: Opaque Form hacks, better shape:fill *wanted*
Message-ID: <162@server.abccam.abcl.co.uk>
Date: 12 Apr 90 13:26:56 GMT
References: <17170@well.sf.ca.us>
Reply-To: phil@jamie.UUCP (Phillip Yelland)
Distribution: comp
Organization: Active Book Co, Cambridge, UK
Lines: 93

From: frobozz@well.sf.ca.us (Jordan Bortz)
>	A Better shape:fil (sic.) routine....

Well, here's something that might be of interest:
`Fraid I put it together late one night after a party (what, pose?--me, pose?),
so I can't attest to its quality---you should be able to improve it
significantly....

--Phil

P.S. The valueAt: hack is fairly specific to the monochrome, 32-bit Smalltalk
that we use.

---Cut---

!Form methodsFor: 'image manipulation'!

fillFrom: seed rule: rule mask: mask

	"Fill a bounded region encompassing seed with the rule and mask
	given"
	"Try: 
		Form exampleSketch. 
		Display 
			fillFrom: Sensor waitClickButton 
			rule: Form over 
			mask: Form gray"
	| copy stack x y rightX lastTop lastBottom top bottom fillBitBlt blackBitBlt | 

	copy _ self deepCopy.					"To track filled regions"
	stack _ OrderedCollection new: 100.	"For seeds"
	stack addLast: seed.
	fillBitBlt _ BitBlt 
		destForm: self
		sourceForm: nil
		halftoneForm: mask
		combinationRule: rule
		destOrigin: 0@0
		sourceOrigin: 0@0
		extent: 0@0
		clipRect: self boundingBox.
	blackBitBlt _ BitBlt 
		destForm: copy
		sourceForm: nil
		halftoneForm: Form black
		combinationRule: Form over
		destOrigin: 0@0
		sourceOrigin: 0@0
		extent: 0@0
		clipRect: self boundingBox.

	[stack isEmpty] whileFalse: [			"While lines still to be filled"
		x _ stack last x.
		y _ stack last y.
		stack removeLast.

		"Find the right-hand end of the scan-line"
		[x < self width and: [(copy valueAt: x@y) = 0]] whileTrue: [
			x _ x+1].

		rightX _ x.						"Save the right-hand end"
		x _ x-1.

		"Go left; seed rightmost pixels of scan-lines above and below"
		lastTop _ lastBottom _ 1.
		[x >= 0 and: [(copy valueAt: x@y) = 0]] whileTrue: [
			top _ y < 0 ifTrue: [1] ifFalse: [self valueAt: x@(y-1)].
			bottom _ y > self height ifTrue: [1] ifFalse: [
							self valueAt: x@(y+1)].

			"Check for unfilled scan-lines top and bottom"
			(lastTop = 1 and: [top = 0]) ifTrue: [
				stack addLast: x@(y-1)].
			(lastBottom = 1 and: [bottom = 0]) ifTrue: [
				stack addLast: x@(y+1)].

			lastBottom _ bottom.
			lastTop _ top.
			x _ x-1].

		"Fill this scan-line"
		x _ x+1.
		fillBitBlt destRect: (x@y corner: rightX@(y+1)); copyBits.
		blackBitBlt destRect: (x@y corner: rightX@(y+1)); copyBits]! !

!Form methodsFor: 'pattern'!

valueAt: aPoint

	"Query whether a bit is on or off.... answer with 1 if the color at coordinate aPoint 
	is black in the receiver and 0 if the color is white at coordinate aPoint"

	^((bits at: aPoint y*(width + 31 // 32 * 2)+(aPoint x//16+1)) 
		bitShift: 0-(aPoint x\\16)) bitAnd: 1! !