Cubic Beziers, was RE: [Q] Exact WarpBlt...

Duane Maxwell dmaxwell at entrypoint.com
Wed Jan 5 19:56:49 UTC 2000


>Henrik,
>
>> And Andreas, btw, regarding using PostScript (cubic) font
>> outlines, you wrote that they would be slow to convert to
>> squared ones.
>
>I probably didn't write this exactly (or if I did then it wasn't accurate).
>Converting cubic into squared curves isn't a big problem (though it'll be
>inaccurate of course). What I was (probably) referring to is an extension of
>the Balloon engine to handle cubic curves directly.
>
>> But you only do this once, ie. on import, right?
>
>Hm ... not necessarily. It's usually not a good idea to throw away accurate
>information ;-) So I guess I'd rather keep the cubic curves and convert them
>on demand (and who knows, some future Balloon version might be able to
>handle cubics directly).
>
>> So is there any other problem?
>
>There has never be a 'problem' ;-) It's just work.
>
>  A.

And, just in case you all missed it when I posted it in October, here's
some code for (approximate) conversion of cubic to quadratic beziers.  You
may either convert on demand (using new methods in BalloonCanvas), or
convert and save the results, and the level of accuracy can be controlled
if desired.  The conversion technique is similar to the one Apple's
QuickDraw GX (R.I.P.) used.

Regards -

Duane

'From Squeak 2.5 of August 6, 1999 on 15 October 1999 at 9:55:54 pm'!
"Change Set:		Bezier3Segment
Date:			15 October 1999
Author:			Duane Maxwell

Adds cubic bezier curve support to Balloon, approximating with one or more
quadratic beziers depending upon the cubic's complexity.  This may someday
lead to basic Adobe Illustrator import and simplistic Type 1 font support"!

LineSegment subclass: #Bezier3Segment
	instanceVariableNames: 'via1 via2 '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Balloon-Geometry'!
Bezier3Segment class
	instanceVariableNames: ''!

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'DSM 10/15/1999 15:14'!
drawBezier3Shape: vertices color: c borderWidth: borderWidth borderColor:
borderColor
	self drawBezierShape: (Bezier3Segment convertBezier3ToBezier2:
vertices) color: c borderWidth: borderWidth borderColor: borderColor! !

!BalloonCanvas methodsFor: 'balloon drawing' stamp: 'DSM 10/15/1999 15:18'!
drawGeneralBezier3Shape: contours color: c borderWidth: borderWidth
borderColor: borderColor
	| b2 |
	b2 _ contours collect: [:b3 | Bezier3Segment
convertBezier3ToBezier2: b3 ].
	self drawGeneralBezierShape: b2 color: c borderWidth: borderWidth
borderColor: borderColor! !


!Bezier3Segment commentStamp: '<historical>' prior: 0!
This class represents a cubic bezier segment between two points

Instance variables:
	via1, via2	<Point>	The additional control points (OFF the curve)!

!Bezier3Segment reorganize!
('initialization' from:to: from:via:and:to:)
('accessing' bounds valueAt: via1: via2:)
('converting' asBezierShape asPointArray)
('private' bezier2SegmentCount bezier2SegmentCount:)
!


!Bezier3Segment methodsFor: 'initialization' stamp: 'DSM 10/15/1999 21:55'!
from: p1 to: p2
	^ self from: p1 via: (p1 interpolateTo: p2 at: 0.3333) and: (p1
interpolateTo: p2 at: 0.66667) to: p2! !

!Bezier3Segment methodsFor: 'initialization' stamp: 'DSM 10/14/1999 15:33'!
from: aPoint1 via: aPoint2 and: aPoint3 to: aPoint4
	start _ aPoint1.
	via1 _ aPoint2.
	via2 _ aPoint3.
	end _ aPoint4! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/15/1999 15:20'!
bounds
	^ ((super bounds encompassing: via1) encompassing: via2)! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/15/1999 15:01'!
valueAt: t
	| a b c d |

	"| p1 p2 p3 |
	p1 _ start interpolateTo: via1 at: t.
	p2 _ via1 interpolateTo: via2 at: t.
	p3 _ via2 interpolateTo: end at: t.
	p1 _ p1 interpolateTo: p2 at: t.
	p2 _ p2 interpolateTo: p3 at: t.
	^ p1 interpolateTo: p2 at: t"

	a _ (start negated) + (3 * via1) - (3 * via2) + (end).
	b _ (3 * start) - (6 * via1) + (3 * via2).
	c _ (3 * start negated) + (3 * via1).
	d _ start.
	^ ((a * t + b) * t + c) * t + d

! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/14/1999 15:31'!
via1: aPoint
	via1 _ aPoint! !

!Bezier3Segment methodsFor: 'accessing' stamp: 'DSM 10/14/1999 15:31'!
via2: aPoint
	via2 _ aPoint! !

!Bezier3Segment methodsFor: 'converting' stamp: 'DSM 10/15/1999 15:55'!
asBezierShape
	"Demote a cubic bezier to a set of approximating quadratic beziers.
	Should convert to forward differencing someday"

	| curves pts step prev index a b f |
	curves _ self bezier2SegmentCount: 0.5.
	pts _ PointArray new: curves * 3.
	step _ 1.0 / (curves * 2).
	prev _ start.
	1 to: curves do: [ :c |
		index _ 3*c.
		a _ pts at: index-2 put: prev.
		b _ (self valueAt: (c*2-1)*step).
		f _ pts at: index put: (self valueAt: (c*2)*step).
		pts at: index-1 put: (4 * b - a - f) / 2.
		prev _ pts at: index.
		].
	^ pts.
	! !

!Bezier3Segment methodsFor: 'converting' stamp: 'DSM 10/15/1999 15:45'!
asPointArray
	| p |
	p _ PointArray new: 4.
	p at: 1 put: start.
	p at: 2 put: via1.
	p at: 3 put: via2.
	p at: 4 put: end.
	^ p! !

!Bezier3Segment methodsFor: 'private' stamp: 'DSM 10/14/1999 16:25'!
bezier2SegmentCount
	"Compute the number of quadratic bezier segments needed to approximate
	this cubic with less than a 1-pixel error"
	^ self bezier2SegmentCount: 1.0! !

!Bezier3Segment methodsFor: 'private' stamp: 'DSM 10/15/1999 21:54'!
bezier2SegmentCount: pixelError
	"Compute the number of quadratic bezier segments needed to approximate
	this cubic with no more than a specified error"
	| a |
	a _ (start negated) + (3 * via1) - (3 * via2) + (end).
	^ ((a r / (20.0 * pixelError)) raisedTo: 0.333333) ceiling.

! !


!Bezier3Segment class reorganize!
('instance creation' from:to: from:via:and:to:)
('utilities' convertBezier3ToBezier2:)
('examples' example1 example2)
!


!Bezier3Segment class methodsFor: 'instance creation' stamp: 'DSM
10/15/1999 21:55'!
from: p1 to: p2
	^ self new from: p1 to: p2! !

!Bezier3Segment class methodsFor: 'instance creation' stamp: 'DSM
10/15/1999 15:24'!
from: p1 via: p2 and: p3 to: p4
	^ self new from: p1 via: p2 and: p3 to: p4! !

!Bezier3Segment class methodsFor: 'utilities' stamp: 'DSM 10/15/1999 16:06'!
convertBezier3ToBezier2: vertices
	| pa pts index c |
	pts _ OrderedCollection new.
	1 to: vertices size // 4 do:
		[:i |
		index _ i * 4 - 3.
		c _ Bezier3Segment new
					from: (vertices at: index)
					via: (vertices at: index + 1)
					and: (vertices at: index + 2)
					to: (vertices at: index + 3).
		pts addAll: c asBezierShape].
	pa _ PointArray new: pts size.
	pts withIndexDo: [:p :i | pa at: i put: p ].
	^ pa! !

!Bezier3Segment class methodsFor: 'examples' stamp: 'DSM 10/15/1999 15:49'!
example1
	| c |
	c _ Bezier3Segment new from: 0 at 0 via: 0 at 100 and: 100 at 0 to: 100 at 100.
	^ c asBezierShape! !

!Bezier3Segment class methodsFor: 'examples' stamp: 'DSM 10/15/1999 16:00'!
example2
	"draws a cubic bezier on the screen"
	| c canvas |
	c _ Bezier3Segment new
				from: 0 @ 0
				via: 0 @ 100
				and: 100 @ 0
				to: 100 @ 100.
	canvas _ BalloonCanvas on: Display.
	canvas aaLevel: 4.
	canvas
		drawBezier3Shape: c asPointArray
		color: Color transparent
		borderWidth: 1
		borderColor: Color black! !









More information about the Squeak-dev mailing list