FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

DRAWING

Apply a dissolve effect


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.
'*********************************************************
'*		 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=0) AND (yoffdepthOfDGW) 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&)
'---------------------------------------------
Robert Purves