[futurebasic] Re: [FB] pixel peeking and poking

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : September 2004 : Group Archive : Group : All Groups

From: Dick <dtrudell@...>
Date: Thu, 30 Sep 2004 10:24:15 -0400
>
>If you can find a way to speed up this routine via pixel peeking and
>poking, instead of the moveto and lineto and region stuff I do, I
>sure would like to know about it.
>
>Many thanks for your review.
>
>tedd

Tedd, I've enclosed an example program I did for my own insight into
various methods of displaying/plotting curves. It is a compilation of
various methods presented here by  members of this group and was very
informative to me in deciding how to display curves. GWorlds are not
used here, but PIXEL plotting methods from RP and RC are included and
may help you get a handle on the techniques used.

Code follows and be sure to read the directions at the top of the program.

Dick


'~'A
'                             Runtime : Rntm Appearance.Incl
'                            Debugger : Off
'                                 CPU : Carbon
'                          CALL Req'd : Off
'                    No Re-DIM'd Vars : On
'                     DIM'd Vars Only : On
'                        Debug Labels : Off
'                           QB Labels : Off
'                       Optimize STR# : On
'                 Ary Bounds Checking : On
'                       Show Warnings : Off
'                       Register Vars : On
'               Make Line Start Table : Off
'~'B
'+------------------------------------------------------------------------------+
'| PROGRAM: Ken's Cubic Spline
|
'|
|
'| This program demonstrates Ken's Cubic Spline (FB List, 24 Apr
2003) plotted  |
'| in various ways to highlight drawing speed and resulting curve
resolution    |
'| for the various methods.
|
'|
|
'| Start the program, and after the first curve is displayed, press
the RETURN  |
'| key repeatedly to step through the rest of the display methods.
|
'|
|
'| Set calcVal = 0.4: plotVal = 2.5 results in 1903 pts in the
'splined' array. |
'|     The large number of points produces the 'smooth", continuous
appearing   |
'|     curves that use the pixel plotting method but which severely
penalizes   |
'|     the PLOT TO drawing methods.
|
'|
|
'| Set calcVal = 8.0: plotVal = 1.0 results in 99 pts in the
'splined' array.   |
'|     The small number of points produces the 'smooth", continuous
appearing   |
'|     curves that use the PLOT TO drawing method but which severely
penalizes  |
'|     the pixel plotting methods.
|
'|
|
'| By: Dick Trudell with significant help from all those cited below!
|
'| Feb 05, 2004
|
'+--------------------------------------------------+---------------------------+
#if (CarbonLib == 0) or ndef _appearanceRuntime
compile shutdown "Must be Carbon compile with Appearance runtime"
#endif

if (system(_sysVers) < 1000) then shutdown "This demo requires OS X"

// These will probably be defined in the headers eventually.
// If you get a Duplicate definition error here, just remove these:
toolbox fn LockPortBits(  CGrafPtr port) = OSErr
toolbox fn UnlockPortBits(CGrafPtr port) = OSErr
toolbox fn GetPortPixMap( CGrafPtr port) = PixMapHandle
toolbox fn GetPortVisibleRegion(CGrafPtr, RgnHandle visRgn) = RgnHandle
toolbox fn QDAddRectToDirtyRegion(CGrafPtr inPort, const Rect
*inBounds) = OSStatus

_nPoints = 6

dim as double       x(_nPoints), y(_nPoints)
dim as double       p(_nPoints), u(_nPoints)
dim as double       xc(2000), yc(2000)
dim as UnsignedWide t1, t2'for timing
dim as rect         gwinRect
dim as int          pts
dim as double       calcVal'step rate for calc'ing curve pts
dim as double       plotVal'step rate for plotting curve pts

//calcVal = 0.4: plotVal = 2.5
calcVal = 8.0: plotVal = 1.0

toolbox Microseconds(UnsignedWide * microTickCount)
end globals

goto "start"'jump around Fn's
'+-------------------------------------------------------------------------------+
'| FN: Set_P_and_U
|
'|
|
'| Date:    Thu, 24 Apr 2003 06:39:56 -0400
|
'| From:    Ken Shmidheiser <kshmidheiser@...>
|
'| Subject: [FB] Re: [XFB] Recursive FN Questions
|
'|
|
'| Function to compute the parameters for a cubic spline. Each
segment must be a |
'| cubic polynomial. Curve segments must have equal first and second
derivatives |
'| at knots they share. We're essentially trying to find the values
of the first |
'| and second derivative of each polynomial at each knot within the
curve.       |
'| That's why there's only N-2 p's (where N is # points). Later, we
use the p's  |
'| and u's to calculate curve points...
|
'+-------------------------------------------------------------------------------+
local
dim as double  d(_nPoints), w(_nPoints)
local fn Set_P_and_U
dim as integer i

for i = 2 to _nPoints-1
d(i) = 2 * (x(i+1) -x(i-1))
next i

for i = 1 to _nPoints-1
u(i) = x(i+1) -x(i)
next i

for i = 2 to _nPoints - 1
w(i) = 6.0 * ((y(i+1) -y(i))/u(i) -(y(i) -y(i-1))/u(i-1))
next i

for i = 2 to _nPoints - 2
w(i+1) = w(i+1) -w(i) * u(i)/d(i)
d(i+1) = d(i+1) -u(i) * u(i)/d(i)
next i

p(1) = 0.0
for i = _nPoints - 1 to 2 step -1
p(i) = (w(i) -u(i) * p(i+1))/d(i)
next i

p(_nPoints) = 0.0
end fn

'+-------------------------------------------------------------------------------+
'| FN: F#(x as double)
|
'|
|
'| Date:    Thu, 24 Apr 2003 06:39:56 -0400
|
'| From:    Ken Shmidheiser <kshmidheiser@...>
|
'| Subject: [FB] Re: [XFB] Recursive FN Questions
|
'+-------------------------------------------------------------------------------+
local
dim as double F
local fn F#(x as double)
F = x * x * x -x
end fn = F

'+-------------------------------------------------------------------------------+
'| FN: GetCurvePoint#(i as integer, v as double)
|
'|
|
'| Date:    Thu, 24 Apr 2003 06:39:56 -0400
|
'| From:    Ken Shmidheiser <kshmidheiser@...>
|
'| Subject: [FB] Re: [XFB] Recursive FN Questions
|
'|
|
'| Derived curve equation (which uses p's and u's for coefficients)
|
'+-------------------------------------------------------------------------------+
local
dim as double t, curvePt
local fn GetCurvePoint#(i as integer, v as double)
t       = (v -x(i))/u(i)
curvePt = t * y(i+1) +(1-t) * y(i) +u(i) * u(i) * (fn F#(t) * p(i+1)¬
             +fn F#(1-t) * p(i))/6.0
end fn = curvePt

'+-------------------------------------------------------------------------------+
'| FN: fillCurveArray
|
'|
|
'| Fill the GLOBAL curve array with calculated points.
|
'+-------------------------------------------------------------------------------+
local
dim as double xPos, yPos, stepRate
local fn fillCurveArray
dim as integer  piece

Microseconds(t1)
fn Set_P_and_U

pts = 0
for piece = 1 to _nPoints-1
for xPos = x(piece) to x(piece+1) step calcVal
pts++
xc(pts) = xPos
yc(pts) = fn GetCurvePoint#(piece, xPos)
next xPos
next piece
Microseconds(t2)'elapsed time in microsecs
print @(1,2) pts;" points were calculated in";str$((t2.lo -t1.lo)) +" µs"
end fn

'+-------------------------------------------------------------------------------+
'| FN: KenDoCurve
|
'|
|
'| Ken's original version to plot the curve.
|
'+-------------------------------------------------------------------------------+
local fn KenDoCurve(foreRGB as ^rgbcolor)
dim as int      i

for i = 1 to pts-1
SetCPixel(xc(i), yc(i), #foreRGB)
next i
end fn

'+-------------------------------------------------------------------------------+
'| FN: AlainDoCurve
|
'|
|
'| Date:    Thu, 24 Apr 2003 14:26:09 +0200
|
'| From:    Alain Pastor <apastor@...>
|
'| Subject: Re: [FB] Re: [XFB] Recursive FN Questions
|
'+-------------------------------------------------------------------------------+
local fn AlainDoCurve'(foreRGB as ^rgbcolor)
dim as int      i
dim as boolean  notFirstDot

notFirstDot = _false
for i = 1 to pts-1 step plotVal
long if notFirstDot
plot to xc(i), yc(i)
Xelse
plot xc(i), yc(i)
notFirstDot = not(notFirstDot)
end if
next i
end fn

'+-------------------------------------------------------------------------------+
'| FN: DrawLine(x0, y0, x1, y1, c)
|
'|
|
'| Date:    Tue, 8 Jan 2002 18:37:17 -0500
|
'| From:    Robert Covington <artlythere@...>
|
'| Subject: Re: recording points in a plotted polygon
|
'+-------------------------------------------------------------------------------+
Local FN DrawLine(x0, y0, x1, y1, c)
DIM as int i, dx, ix, dy, iy, m, cx, cy

color c
if (x0 < x1) Then dx = x1-x0: ix = 1 else dx = x0-x1: ix = -1
if (y0 < y1) Then dy = y1-y0: iy = 1 else dy = y0-y1: iy = -1
if (dx > dy) Then m = dx else m = dy
cy = m >> 1
cx = m >> 1
for i  =  0 To m // m-1 if no endpoint desired.
Plot x0, y0// Color c
cx     += dx
cy     += dy
if cx > =  m Then cx -=  m: x0 += ix
if cy > =  m THEN cy -=  m: y0 += iy
Next i
END FN

'+-------------------------------------------------------------------------------+
'| FN: RCV1DoCurve
|
'|
|
'| Plot curve using RC's Fn Drawline.
|
'+-------------------------------------------------------------------------------+
local fn RCV1DoCurve
dim as int i

for i = 1 to pts-1 step plotVal
fn DrawLine(xc(i), yc(i), xc(i+1), yc(i+1), _zWhite)
next i
end fn

'+-------------------------------------------------------------------------------+
'| FN: CustomSetCPixel(,,,,,)
|
'|
|
'| Date:    28 June 2002
|
'| From:    Robert Purves <robert.purves@...>
|
'| Subject: ?
|
'|
|
'| Draw pixel directly in a PixMap belonging to a GWorld or OS X
window buffer   |
'| Works for 8,16,32 bit depths.
|
'+-------------------------------------------------------------------------------+
local mode
local fn CustomSetCPixel(x as long, y as long, pixelValue as long,
rowBytes as long, baseAddr as ptr, depth as long)
dim as ptr pixelAddress

pixelAddress = baseAddr +y * rowBytes
select depth
case 32
pixelAddress     += (x << 2)
pixelAddress.nil& = pixelValue '4-byte value for 32-bit deep
case 16
pixelAddress     += (x << 1)
pixelAddress.nil% = pixelValue '2-byte value for 16-bit deep
case 8
pixelAddress     += x
pixelAddress.nil` = pixelValue '1-byte value for 8-bit deep
end select
end fn

'+-------------------------------------------------------------------------------+
'| FN: Plotline(,,,,,,,)
|
'|
|
'| Date:    Tue, 8 Jan 2002 18:37:17 -0500
|
'| From:    Robert Covington <artlythere@...>
|
'| Subject: Re: recording points in a plotted polygon
|
'|
|
'| RC's Fn was modified to employ RP's CustomSetCPixel in lieu of the
Toolbox    |
'| SETCPIXEL routine.
|
'+-------------------------------------------------------------------------------+
LOCAL FN Plotline(X1 as long,Y1 as long, X2 as long, Y2 as long,¬
                 pixelValue as long, rowBytes as long, baseAddr as
ptr, depth as long)
DIM as long r
DIM as long xx, yy, xi, yi

' make x <= x1
LONG IF (X1 < X2)
xx = X1
x1 = X2
yy = Y1
y1 = Y2
XELSE
xx = X2
x1 = X1
yy = Y2
y1 = Y1
END IF
LONG IF (y1 > yy) 'positive line
LONG IF (x1-xx > y1-yy) ' x longer
r  = 2 * (y1-yy) -(x1-xx)
yi = yy
FOR xi = xx TO x1
LONG IF (xi < gwinRect.right AND xi >= 0 AND yi < gwinRect.bottom AND yi >= 0)
FN CustomSetCPixel(xi,yi, pixelValue, rowBytes, baseAddr, depth) //
OR Store The Point
END IF
LONG IF (r >= 0)
yi = yi+1
r  = r -(2 * (x1-xx) -2 * (y1-yy))
XELSE
r  = r +(2 * (y1-yy))
END IF
NEXT xi
XELSE ' y longer
r  = 2 * (x1-xx) -(y1-yy)
xi = xx
FOR yi=yy TO y1
LONG IF (xi < gwinRect.right AND xi >= 0 AND yi < gwinRect.bottom AND yi >= 0)
FN CustomSetCPixel(xi,yi, pixelValue, rowBytes, baseAddr, depth) //
OR Store The Point
END IF
LONG IF (r >= 0)
xi = xi+1
r  = r -(2 * (y1-yy) -2 * (x1-xx))
XELSE
r  = r +(2 * (x1-xx))
END IF
NEXT yi
END IF
XELSE 'negative line
LONG IF (x1-xx > yy-y1) ' x longer
r  = 2 * (yy-y1) -(x1-xx)
yi = yy
for xi = xx TO x1
LONG IF (xi < gwinRect.right AND xi >= 0 AND yi < gwinRect.bottom AND yi >= 0)
FN CustomSetCPixel(xi,yi, pixelValue, rowBytes, baseAddr, depth) //
OR Store The Point
END IF
LONG IF (r >= 0)
yi = yi-1
r  = r -(2 * (x1-xx) -2 * (yy-y1))
XELSE
r  = r +(2 * (yy-y1))
END IF
NEXT xi
XELSE ' y longer
r  = 2 * (x1-xx) -(yy-y1)
xi = x1
FOR yi = y1 TO yy
LONG IF (xi < gwinRect.right AND xi >= 0 AND yi < gwinRect.bottom AND yi >= 0)
FN CustomSetCPixel(xi,yi, pixelValue, rowBytes, baseAddr, depth) //
OR Store The Point
END IF
LONG IF (r >= 0)
xi = xi-1
r  = r -(2 * (yy-y1) -2 * (x1-xx))
XELSE
r  = r +(2 * (x1-xx))
END IF
NEXT yi
END IF
END IF
END FN

'+-------------------------------------------------------------------------------+
'| FN: RCV2DoCurve(port as CGrafPtr, vertOffSet as long)
|
'|
|
'| Dick Trudell's version using a modified version of Robert
Covingtons PLOTLINE |
'| function.
|
'+-------------------------------------------------------------------------------+
local fn RCV2DoCurve(vertOffSet as long, pixelValue as long,¬
                    rowBytes as long, baseAddr as ptr, depth as long)
dim as int i

for i = 1 to pts-1 step plotVal
FN Plotline(xc(i), yc(i)+vertOffSet, xc(i+1), yc(i+1)+vertOffSet,¬
             pixelValue, rowBytes, baseAddr, depth)
next i
end fn

'+-------------------------------------------------------------------------------+
'| FN: RPDoCurve(port as CGrafPtr, vertOffSet as long)
|
'|
|
'| Dick Trudell's version incorporating the methods presented by
Robert Purves   |
'| in his FB list posting: "OS X Draw speed tests", 11 Jan 2002 which
provided   |
'| methods to draw directly to the screen in OS X.
|
'+-------------------------------------------------------------------------------+
local fn RPDoCurve(vertOffSet as long, pixelValue as long,¬
                  rowBytes as long, baseAddr as ptr, depth as long)
dim as int i

for i = 1 to pts-1
fn CustomSetCPixel(xc(i), yc(i)+vertOffSet, pixelValue, rowBytes,
baseAddr, depth)
next i
end fn

'+-------------------------------------------------------------------------------+
'| FN: BuildWindow
|
'|
|
'| Draw pixel directly in a PixMap belonging to a GWorld or OS X
window buffer   |
'| Works for 8,16,32 bit depths.
|
'+-------------------------------------------------------------------------------+
local fn BuildWindow
dim as rect     r
dim as rgbcolor backRGB

setrect(gwinRect, 0, 0, 800, 600)
appearance Window -1, "CUBIC Spline Plot", @gwinRect,
_kDocumentWindowClass, _kWindowStandardFloatingAttributes
text _Monaco, 9

backRGB.red   = 0'\
backRGB.green = 0' > BLACK
backRGB.blue  = 0'/
DEF SETWINDOWBACKGROUND(backRGB, _true)

window 1
end fn

'+-------------------------------------------------------------------------------+
'| FN: PlotPoints
|
'|
|
'| Display the control polygon points.
|
'+-------------------------------------------------------------------------------+
LOCAL FN PlotPoints
dim as rgbcolor foreRGB
dim as int      i

foreRGB.red   = 62535'\
foreRGB.green = 62535' > WHITE
foreRGB.blue  = 62535'/
rgbForeColor(foreRGB)

for i = 1 to _nPoints
circle x(i), y(i), 5
next i
end fn

'+-------------------------------------------------------------------------------+
'| FN: LoadPoints
|
'|
|
'| A few points for testing.
|
'+-------------------------------------------------------------------------------+
local fn LoadPoints
x(1) =   20:     y(1) = 150
x(2) =  100:     y(2) = 450
x(3) =  250:     y(3) = 300
x(4) =  450:     y(4) = 150
x(5) =  580:     y(5) = 340
x(6) =  780:     y(6) = 450

FN PlotPoints
end fn

'+-------------------------------------------------------------------------------+
'| FN: DoDialog
|
'+-------------------------------------------------------------------------------+
local fn DoDialog
dim as long evnt, id

evnt = dialog(0)
id   = dialog(evnt)

select case(evnt)
case _wndClose
select(id)
case 1:  gFBQuit = _zTrue
end select
end select
end fn

'+-------------------------------------------------------------------------------+
'| FN: PlotDiffVers
|
'+-------------------------------------------------------------------------------+
local fn PlotDiffVers
dim as long      pixelValue, rowBytes, dummy
dim as ptr       baseAddr
dim as rect      bounds
dim pmHandle     as ^^PixMap
dim as CGrafPtr  @ port
dim as long      titleBarHt
dim as long      depth
dim as OSStatus  status
dim as rgbColor  foreRGB
dim as OSErr     err
dim a$

print @(1,1) "Press any key to step to the next method"
'~Plot Ken's original using SETCPIXEL
foreRGB.red   = 62535'\
foreRGB.green = 62535' > YELLOW
foreRGB.blue  = 0'/
rgbForeColor(foreRGB)

Microseconds(t1)
fn KenDoCurve(foreRGB)
Microseconds(t2)'elapsed time in microsecs
print @(1,4) str$((t2.lo -t1.lo)) +" µs": print @(13,4) "Ken's
SETCPIXEL method"

'~Plot Alain's version using PLOT TO
input a$
setrect(gwinRect, 0, gwinRect.top +125, 800, 600)'re-dim winRect for erasing
eraserect(gwinRect)'Clear screen
fn PlotPoints're-display control polygon

color _zRed

Microseconds(t1)
fn AlainDoCurve
Microseconds(t2)'elapsed time in microsecs
print @(1,5) str$((t2.lo -t1.lo)) +" µs": print @(13,5) "Alain's PLOT
TO method"

'~Plot RC's DRAWLINE version which also uses PLOT TO
input a$
eraserect(gwinRect)'Clear screen
fn PlotPoints're-display control polygon

Microseconds(t1)
fn RCV1DoCurve
Microseconds(t2)'elapsed time in microsecs
print @(1,6) str$((t2.lo -t1.lo)) +" µs": print @(13,6) "RC's DRAWLINE method"

'~Plot RC's PLOTLINE version which use's RP's CUSTOMSETCPIXEL Fn
// find title bar height from difference between structure top and content top
titleBarHt    = window(_kFBcontentTop) -window(_kFBstructureTop)

// draw directly into the window's port
port          = fn GetWindowPort(window(_wndPointer))
dummy         = fn GetPortBounds(port, bounds)
err           = fn LockPortBits(port)

// values for CustomSetCPixel
pmHandle      = fn GetPortPixMap(port)
rowBytes      = pmHandle..rowBytes and 0x3fff
depth         = pmHandle..pixelSize
baseAddr      = fn GetPixBaseAddr(pmHandle) 'address of pixel at top
left of window
  'structure (not top left of content)
input a$
eraserect(gwinRect)
fn PlotPoints

foreRGB.red   = 62535'\
foreRGB.green = 0' > MAGENTA
foreRGB.blue  = 62535'/
pixelValue    = fn Color2Index(foreRGB) 'works at 8,16,32 bit depths
rgbForeColor(foreRGB)

Microseconds(t1)'for TIME Display
fn RCV2DoCurve(titleBarHt, pixelValue, rowBytes, baseAddr, depth)
status = fn QDAddRectToDirtyRegion(port, #fn GetPortBounds(port, bounds))
Microseconds(t2)'elapsed time in microsecs
print @(1,7) str$((t2.lo -t1.lo)) +" µs": print @(13,7) "RC's PLOTLINE method"

'~Plot using RP's Fn CUSTOMSETCPIXEL
input a$
eraserect(gwinRect)
fn PlotPoints

foreRGB.red   = 0'\
foreRGB.green = 62535' > CYAN
foreRGB.blue  = 62535'/
pixelValue    = fn Color2Index(foreRGB) 'works at 8,16,32 bit depths
rgbForeColor(foreRGB)'for TIME Display

Microseconds(t1)
fn RPDoCurve(titleBarHt, pixelValue, rowBytes, baseAddr, depth)
status = fn QDAddRectToDirtyRegion(port, #fn GetPortBounds(port, bounds))
Microseconds(t2)'elapsed time in microsecs
print @(1,8) str$((t2.lo -t1.lo)) +" µs": print @(13,8) "RP's
CUSTOMSETCPIXEL method"
err    = fn UnlockPortBits(port)
end fn

"start"
'+-------------------------------------------------------------------------------+
'| Program Main
|
'+-------------------------------------------------------------------------------+
on dialog fn DoDialog

fn BuildWindow

fn LoadPoints
fn fillCurveArray

delay 1000'<-- give user time to see point calc time
fn PlotDiffVers

do
handleevents
until gFBQuit
end