[futurebasic] Selection Demo

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

From: Robert Covington <artlythere@...>
Date: Fri, 28 Sep 2001 20:09:13 -0400
Greetings EarthlingsŠ As part of our continued seeding of the human fe, we
mean species, we have selected you, you have been selected, to receive this
demo of an unnatural selection. Please select the below text and then paste
into your FB 3 development environs, and then paste, unselect, select, and
copy, paste, wherever needed, if needed, until you have a resource file
called pats.rsrc. In fact, for a truly spastic functionality you can even
ignore that. Don't.

You may then select Run Program, and begin selecting whatever you select,
as long as it is seeding properly, you will be selected for continued
selection. Working? Great.

Yes, you have just seed a UFO* .  Proper use of this code-inary confection
will no doubt leave you with a raging selection. Luckily, relief is but a
click away**. And that is all we aliens have to say.  G'day.

Cordially,
Robert Bob Covington
Selection du Jour and Naturalization Corp.
Area 51, near Las Vegas, De Nada

//--------- Begin FB3 program ---------

/*

"Seeded Ants"

Another in the continuing "Give Away The Store" series.
Compositor R&D Dept.

Alteration of Robert Purves's original Seedfill with pattern demo.
Changed to create a marching ants selection from the seedfill mask
using non-statistical System Wide Region Differential Analysis and
Fill. (FrameRgn)

Robert Covington,2001 <artlythere@...>

Patterns resource, save as text file, as pats.hqx, then unstuff.
Patterns are from a less involved AOL Marching Ants demo,circa 1996.

// Beware the Email Line Wrap.

// begin resource
// Eudora may auto decode, this was an inline text resource binhex, 504 bytes.

(This file must be converted with BinHex 4.0)
:$A"KG(-ZFR0bBbjcDA3!8dP84&0*9#%!N!3"A`#3"-298dP8)3!"!!!"Ah*-BA8
#Q3#3!aDCQ3d!#A"KG(-ZFR0bBbr3!kJh)!!i$hS!N!1!!*!%!l!"AJaL#BB!N"M
rN!4bFh*M8P0&4!%!V[e0)EID4CB!!!&i!*!(f3#3"+@T!*!)LiF4!!JF$$J%8B'
B1JrHAZIjjjpA5Z9lf(%XE[EJJh@D2H3BAVVK)3AH+*'C2T%T8RKdD)hQZ'[Vc)4
Se*G*L8a-kTT*2+#pS@"5SY2Vlb#rdf$mII"YIpPXK3`"Z!G80CJqAF-#jDLS[`5
J`G3IeISc'KDSYfIUcdc@m2fU)pmfZTRrrEG(9RhlEG"pM2Gpme!hhkMr8D0(G$l
6S4AN,P#kkC!!UBpF[Y0-QMf6qQE5&62T`%akI#EpmNckqr1[L$ppieI+lHJSe,N
S##5%bMZDk(52k'AiddZeXc94!!!:

// end resource
*/

resources "pats.rsrc"

_useCustomSeedCFillMatchProc = _zTrue //  _zTrue or _false

end globals

#if _useCustomSeedCFillMatchProc
begin record MatchRec
dim as UInt16  red, green, blue
dim as long    matchData
end record

goto "SkipMatchProc"
// procedure to test colour match for every pixel
"MatchProc"
enterproc fn MatchProc( testRGB as ^RGBColor, resultPtr as ptr ) = boolean
dim gdH    as ^^GDevice
dim matchPtr as ^MatchRec
// access to RGB of the start point
// matchPtr = [[[_theGDevice]] + _gdRefCon]// not Carbon compatible
gdH      = fn GetGDevice
matchPtr = gdH..gdRefCon
// At some pixel depths, SeedCFill screws up the low order bits of
// the RGB colour components (at least in OS8.6)
// We mask off these bits before testing equality.
// A mask of 0xFF00 enforces exact RGB match. 0xF000 gives looser matching.
resultPtr.nil& = 1 // don't fill this pixel
_myMask = 0xFF00
long if (testRGB.red and _myMask) = (matchPtr.red and _myMask)
long if (testRGB.green and _myMask) = (matchPtr.green and _myMask)
long if (testRGB.blue and _myMask) = (matchPtr.blue and _myMask)
resultPtr.nil& = 0 // do fill this pixel
end if
end if
end if
end fn = _zTrue // always
"SkipMatchProc"
#endif

'~'2
local fn NewBitMap( bitMap as ^BitMap, r as ^rect )
bitMap.rowBytes = ((r.right - r.left + 15) >> 4) << 1
bitMap.baseAddr = fn NewPtr(bitMap.rowBytes*(r.bottom - r.top))
bitMap.bounds   = r
end fn
'~'2
local fn SeedFillToAnts( x, y)
DIM rgnHand as Handle // region handle
// x, y are starting coordinates for fill in current window.
dim @ maskBM     as BitMap
dim @ windGW     as ^GrafPort
dim @ currDevice as handle
dim r            as rect
DIM @id,err

GetGWorld( windGW, currDevice )
r = windGW.portRect
fn NewBitMap( maskBM, r )// SeedCFill's output bitmap
if maskBM == 0 then stop "NewBitMap error"

#if _useCustomSeedCFillMatchProc
SeedCFill( #windGW+2, maskBM, r, r, x, y, proc "MatchProc", 0)
#else
// use default colour match procedure, which does not work
// at all depths of the source GWorld's pixmap (in OS 8.6):
SeedCFill( #windGW+2, maskBM, r, r, x, y, 0, 0 )
#endif


'~'2
// Robert Covington Alterations/deletions from original
'~'2

rgnHand = FN NewRgn // region for animating

long if rgnHand // got it
// enable CLS to clear colors and see just the ants
// cls
err =FN BitMapToRegion(rgnHand,@maskBM) // convert mask to region
Print %(4,24) "Region is" + STR$(FN Gethandlesize(rgnHand)) + " bytes"

// frameRgn(rgnHand) // pure region frame
// delay 200  // to see a bit first

id = 0 // init base pattern

// cycle patterns

DO
pen ,,,, id
inc(id)
if id > 7 then id = 0
DELAY 20// insert Timer routine
frameRgn(rgnHand)
UNTIL FN Button or Len(Inkey$)

disposeRGn(rgnHand)

End If
'~'2
// End RC alterations.
'~'2

DisposePtr( maskBM.baseAddr ) // dispose bitmap bits memory

end fn

Local FN FillWindow
Pennormal
Text _geneva,9
print "Click an area to select."
color = _zRed
circle fill 200, 180, 120
circle fill 350, 180, 120
color = _zGreen
circle fill 275, 290, 120
color = _zCyan
circle fill 275, 200, 80
color = _zBlack
End FN

Local FN doDialog
if dialog(0) = _Wndclose then END
IF dialog(0) = _WndRefresh then FN FillWindow
End FN

dim wRect    as rect

SetRect( wRect, 0, 0, 600, 450 )
window 1, "Seed Fill Selection Demo", @wRect, _docNoGrow

Menu 1,0,1,"File"
Menu 1,1,1,"Quit"

on dialog FN doDialog

DO
cls

FN FillWindow

do
handleevents
until fn button

fn SeedFillToAnts( mouse(_horz), mouse (_vert) )

do
handleevents
until fn button

while fn button
wend

until gFBQuit

//------------ End  FB3 program ------------

// * (Unidentified FrameRgn'ed Object)
// **(On our ships, relief is but a chick away. However, this requires
marching pants, not ants. Do not confuse the two.)