[futurebasic] Re: [FB] Dissolve effect

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : October 1999 : Group Archive : Group : All Groups

From: Robert Purves <robert.purves@...>
Date: Sun, 10 Oct 1999 01:09:14 +1300
>I'm looking for a nice dissolve effect to blit a GWorld on the screen.
>I suppose this is something that must be done in assem. ?

Plain old FB2 is up to the task. The program below uses an ingenious random
number generator in a way that guarantees that every pixel will be copied.
I must apologise for the length of the posting, but it _is_ a complete
copy-and-paste program, which I have also found useful in reminding me how
to do GWorld stuff for a window. It runs in FB^3 if you remove the COMPILE
statement and replace by REGISTER OFF.

Robert Purves

'*********************************************************
'*         A random-pixels dissolve effect               *
'*      adapted for Future Basic by Robert Purves        *
'*  from "dissBits" by Mike Morton, MacTech vol 1 (13)   *
'*********************************************************
COMPILE 0, _dimmedVarsOnly
DIM gMask&,gScrnRect.8,gBaseAddr&,gRowBytes
END GLOBALS

LOCAL FN GetScreenParameters
DIM pixMapHand&
pixMapHand&=[[FN GETMAINDEVICE]+22]
gScrnRect;8=@pixMapHand&..pmBounds%
gRowBytes=pixMapHand&..pmRowBytes% AND &3FFF
gBaseAddr&=FN GETPIXBASEADDR(pixMapHand&)
END FN

LOCAL FN SetMask(log2Num)
SELECT CASE log2Num
CASE 2: gMask&=&03'1-3
CASE 3: gMask&=&06'1-7
CASE 4: gMask&=&0C'1-15
CASE 5: gMask&=&14'1-31
CASE 6: gMask&=&30'1-63
CASE 7: gMask&=&60'and so on
CASE 8: gMask&=&B8
CASE 9: gMask&=&0110
CASE 10: gMask&=&0240
CASE 11: gMask&=&0500
CASE 12: gMask&=&0CA0
CASE 13: gMask&=&1B00
CASE 14: gMask&=&3500
CASE 15: gMask&=&6000
CASE 16: gMask&=&B400
CASE 17: gMask&=&12000
CASE 18: gMask&=&20400
CASE 19: gMask&=&72000
CASE 20: gMask&=&90000
CASE 21: gMask&=&140000
CASE 22: gMask&=&300000
CASE 23: gMask&=&400000
CASE 24: gMask&=&D80000
CASE ELSE: STOP
END SELECT
END FN

LOCAL FN NextRndNum(num&)
LONG IF (num& AND 1)
num&=(num&>>1) XOR gMask&
XELSE
num&=num&>>1
END IF
END FN=num&

LOCAL FN log2Num(n&)
DIM log2Num
log2Num=1
WHILE n&>1
n&=n&>>1:  INC(log2Num)
WEND
END FN=log2Num

LOCAL FN CurrentScreenDepth
END FN={[[[FN GETMAINDEVICE]+22]]+_pmPixelSize}

LOCAL FN SetUpGW&(wRectPtr&)
DIM myGW&
LONG IF FN NEWGWORLD(myGW&,FN
CurrentScreenDepth,#wRectPtr&,_nil,_nil,0)<>_noErr
myGW&=_nil' error
END IF
END FN=myGW&

LOCAL FN DrawSomethingInGWorld(myGW&)
DIM currGW&,currDevice&
CALL GETGWORLD(currGW&,currDevice&)
CALL SETGWORLD(myGW&,0)
LONG IF FN LOCKPIXELS(FN GETGWORLDPIXMAP(myGW&))
CALL BACKCOLOR(_yellowColor): CLS
CALL TEXTSIZE(72): PRINT %(200,200)"Hello"
CALL UNLOCKPIXELS(FN GETGWORLDPIXMAP(myGW&))
END IF
CALL SETGWORLD(currGW&,currDevice&)
END FN

LOCAL FN CopyPixel(shift,x,y,sPixPtr&,sRowBytes,dPixPtr&,dRowBytes,xoff,yoff)
LONG IF (xoff>=0) AND (xoff<gScrnRect.right%)' on screen
LONG IF (yoff>=0) AND (yoff<gScrnRect.bottom%)' on screen
% yoff*dRowBytes+dPixPtr&+(xoff<<shift),{(y*sRowBytes+sPixPtr&+(x<<shift))}
END IF
END IF
END FN

LOCAL FN CopyBitsDissolve(wndNum,srcGW&)
'copy src GWorld to dest GWorld, random pixel by pixel
DIM sPixMapH&,sRowBytes,sPixPtr&,depthOfSGW
DIM dPixMapH&,dRowBytes,dPixPtr&,depthOfDGW
DIM wdth,hite,npixels&,num&,x,y,wPtr&,shift
DIM aPoint.0, yOff,xOff
DIM rect.8
DIM destGW&,currDevice&
CALL GETGWORLD(destGW&,currDevice&)
GET WINDOW wndNum,wPtr&
rect;8=wPtr&+_portRect
CALL SETPT(aPoint,0,0)
CALL LOCALTOGLOBAL(aPoint)' window origin offset
FN GetScreenParameters

sPixMapH&=FN GETGWORLDPIXMAP(srcGW&)
IF FN LOCKPIXELS(sPixMapH&)=_false THEN STOP
sRowBytes={[sPixMapH&]+_pmrowBytes} AND &3FFF
sPixPtr&=FN GETPIXBASEADDR(sPixMapH&)
depthOfSGW={[sPixMapH&]+_Pmpixelsize}
dPixMapH&=FN GETGWORLDPIXMAP(destGW&)
IF FN LOCKPIXELS(dPixMapH&)=_false THEN STOP
dRowBytes={[dPixMapH&]+_pmRowBytes} AND &3FFF
dPixPtr&=FN GETPIXBASEADDR(dPixMapH&)
depthOfDGW={[dPixMapH&]+_Pmpixelsize}

IF depthOfSGW<8 OR (depthOfSGW<>depthOfDGW) THEN STOP

wdth=rect.right%-rect.left%:  hite=rect.bottom%-rect.top%
npixels&=wdth*hite
FN SetMask(FN log2Num(npixels&))' for rand num generator
num&=1'initialise sequence
SELECT CASE depthOfDGW
CASE 8: shift=0
CASE 16: shift=1
CASE 32: shift=2
END SELECT
DO
num&=FN NextRndNum(num&)
LONG IF num&<=npixels&
y=num&/wdth:  x=num&-y*wdth
FN CopyPixel(shift,x,y,sPixPtr&,sRowBytes,dPixPtr&,dRowBytes,x+xOff,y+yOff)
END IF
UNTIL num&=1
' do one more, since FN NextRndNum never returns 0
FN CopyPixel(shift,0,0,sPixPtr&,sRowBytes,dPixPtr&,dRowBytes,xOff,yOff)
CALL UNLOCKPIXELS(sPixMapH&): CALL UNLOCKPIXELS(dPixMapH&)
END FN

DIM wPtr&,myGW&
WINDOW 1,,(0,0)-(600,400) ,_docNoGrow
CALL BACKCOLOR(_magentaColor): CLS
GET WINDOW 1,wPtr&
myGW&=FN SetUpGW&(wPtr&+_portRect)' use window's portRect to size GWorld
IF myGW&=_nil THEN STOP
FN DrawSomethingInGWorld(myGW&)
FN CopyBitsDissolve(1,myGW&)
DO: UNTIL FN BUTTON
IF myGW& THEN CALL DISPOSEGWORLD(myGW&)
'---------------------------------------------