Code Snippets->Shatter Wipe Effect (dbpro)
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 3rd Jan 2003 7:17
OK, be kind, what do you think of my ShatterWipe effect?


sync on : sync rate 60
randomize timer()
set text opaque

bw = bitmap width(0)
bh = bitmap height(0)

rem --- make a sample image on bitmap 0
DrawSomething(0,0)
sync

create bitmap 1, bw, bh

t = 1
do
rem --- make a sample image in bitmap 1
DrawSomething(1,t)
inc t, 1 : if t = 3 then t = 0

set current bitmap 0
ink 16777215,0
center text bw / 2, 32, " Press any key! "
sync
wait key

ShatterWipe(1,10,8,10)
sync
loop

end

function DrawSomething(bmp,t)
set current bitmap bmp : cls 0
bw = bitmap width(bmp) : bh = bitmap height(bmp)
for i = 1 to 1000
ink rgb(rnd(255),rnd(255),rnd(255)),0
select t
case 0 : dot rnd(bw),rnd(bh) : endcase
case 1 : line rnd(bw),rnd(bh),rnd(bw),rnd(bh) : endcase
case 2 : r = rnd(40) + 10 : ellipse rnd(bw),rnd(bh),r,r : endcase
endselect
next i
endfunction


function ShatterWipe(bmp,gridwidth,gridheight,speed)
remstart
bmp = source bitmap to be displayed (size must equal to bitmap 0)

gridwidth, gridheight = number of divisions in bitmap. It's best to use values
that can easily divide into width and height of bitmap (min 4, max 20)

speed = how fast you want the blocks to fly

NOTE: function will use DRAW SPRITES LAST in order to work properly
remend

if bitmap exist(bmp) and bmp > 0
bw = bitmap width(0) : bh = bitmap height(0)

if bw = bitmap width(bmp) and bh = bitmap height(bmp)
if gridwidth 20 then gridwidth = 20
if gridheight 20 then gridheight = 20
if speed = bw
x = 0
inc y, spriteheight
endif

rem --- set direction speed of sprite
repeat : xd(i) = (rnd(speed*2) - speed) : until abs(xd(i)) > speed / 2
repeat : yd(i) = (rnd(speed*2) - speed) : until abs(yd(i)) > speed / 2
next i

draw sprites last
copy bitmap bmp,0
spritesoffscreen = 0

rem bw or sx bh or sy
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 3rd Jan 2003 7:18
DAMN! That did'nt work! Lets try again....
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 3rd Jan 2003 7:19
+ Code Snippet
sync on : sync rate 60
randomize timer()
set text opaque

bw = bitmap width(0)
bh = bitmap height(0)

rem --- make a sample image on bitmap 0
DrawSomething(0,0)
sync

create bitmap 1, bw, bh

t = 1
do
  rem --- make a sample image in bitmap 1
  DrawSomething(1,t)
  inc t, 1 : if t = 3 then t = 0

  set current bitmap 0
  ink 16777215,0
  center text bw / 2, 32, " Press any key! "
  sync
  wait key

  ShatterWipe(1,10,8,10)
  sync
loop

end

function DrawSomething(bmp,t)
  set current bitmap bmp : cls 0
  bw = bitmap width(bmp) : bh = bitmap height(bmp)
  for i = 1 to 1000
    ink rgb(rnd(255),rnd(255),rnd(255)),0
    select t
      case 0 : dot rnd(bw),rnd(bh) : endcase
      case 1 : line rnd(bw),rnd(bh),rnd(bw),rnd(bh) : endcase
      case 2 : r = rnd(40) + 10 : ellipse rnd(bw),rnd(bh),r,r : endcase
    endselect
  next i
endfunction


function ShatterWipe(bmp,gridwidth,gridheight,speed)
  remstart
    bmp = source bitmap to be displayed (size must equal to bitmap 0)

    gridwidth, gridheight = number of divisions in bitmap. It's best to use values
    that can easily divide into width and height of bitmap (min 4, max 20)

    speed = how fast you want the blocks to fly

    NOTE: function will use DRAW SPRITES LAST in order to work properly
  remend

  if bitmap exist(bmp) and bmp > 0
    bw = bitmap width(0) : bh = bitmap height(0)

    if bw = bitmap width(bmp) and bh = bitmap height(bmp)
      if gridwidth < 4 then gridwidth = 4
      if gridwidth > 20 then gridwidth = 20
      if gridheight < 4 then gridheight = 4
      if gridheight > 20 then gridheight = 20
      if speed < 1 then speed = 1

      spritetotal = gridwidth * gridheight
      spritewidth = bw / gridwidth
      spriteheight = bh / gridheight
      dim xd(spritetotal)
      dim yd(spritetotal)

      x = 0 : y = 0
      for i = 1 to spritetotal
        s = 65536 - i

        rem --- set sprite
        get image s, x, y, x + spritewidth, y + spriteheight, 1
        sprite s, x, y, s : set sprite s, 1, 0

        inc x, spritewidth
        if x >= bw
          x = 0
          inc y, spriteheight
        endif

        rem --- set direction speed of sprite
        repeat : xd(i) = (rnd(speed*2) - speed) : until abs(xd(i)) > speed / 2
        repeat : yd(i) = (rnd(speed*2) - speed) : until abs(yd(i)) > speed / 2
      next i

      draw sprites last
      copy bitmap bmp,0
      spritesoffscreen = 0

      rem <--- Insert sound here

      rem --- Ok, here we go! Loops until all blocks are off screen
      repeat
        for i = 1 to spritetotal
          s = 65536-i

          if sprite visible(s)
            sx = sprite x(s) + xd(i)
            sy = sprite y(s) + yd(i)
            sprite s, sx, sy, s

            if sx > bw or sx < -spritewidth or sy > bh or sy < -spriteheight
              hide sprite s
              inc spritesoffscreen, 1
            endif

          endif
        next i

        sync
      until spritesoffscreen = spritetotal

      rem --- clean up and exit
      undim yd() : undim xd()
      for i = 1 to spritetotal
        s = 65536 - i
        delete sprite s
        delete image s
      next i

    endif
  endif

endfunction
M
MrTAToad Joined: 26th Aug 2002
Location: United Kingdom
Posted: 3rd Jan 2003 7:27
Shame it takes a while to display the effect when you press any key. And side from the blocks not rotating, its very clever...
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 3rd Jan 2003 7:37
hmmm, I'm not the only one having a late night in the UK then

Some of that delay is caused by the drawing function I shoved in there, and as for rotating the blocks, ahem!... did'nt think of that
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 3rd Jan 2003 8:53
Taking MrTAToad`s suggestion, here is an updated version that has spinning blocks.

+ Code Snippet
sync on : sync rate 60
randomize timer()
set text opaque

bw = bitmap width(0)
bh = bitmap height(0)

rem --- make a sample image on bitmap 0
DrawSomething(0,0)
sync

create bitmap 1, bw, bh

t = 1
do
  rem --- make a sample image in bitmap 1
  DrawSomething(1,t)
  inc t, 1 : if t = 3 then t = 0

  set current bitmap 0
  ink 16777215,0
  center text bw / 2, 32, " Press any key! "
  sync
  wait key

  ShatterWipe(1,10,8,8)
  sync
loop

end

function DrawSomething(bmp,t)
  set current bitmap bmp : cls 0
  bw = bitmap width(bmp) : bh = bitmap height(bmp)
  for i = 1 to 1000
    ink rgb(rnd(255),rnd(255),rnd(255)),0
    select t
      case 0 : dot rnd(bw),rnd(bh) : endcase
      case 1 : line rnd(bw),rnd(bh),rnd(bw),rnd(bh) : endcase
      case 2 : r = rnd(40) + 10 : ellipse rnd(bw),rnd(bh),r,r : endcase
    endselect
  next i
endfunction


function ShatterWipe(bmp,gridwidth,gridheight,speed)
  remstart
    bmp = source bitmap to be displayed (size must equal to bitmap 0)

    gridwidth, gridheight = number of divisions in bitmap. It's best to use values
    that can easily divide into width and height of bitmap (min 4, max 20)

    speed = how fast you want the blocks to fly

    NOTE: function will use DRAW SPRITES LAST in order to work properly
  remend

  if bitmap exist(bmp) and bmp > 0
    bw = bitmap width(0) : bh = bitmap height(0)

    if bw = bitmap width(bmp) and bh = bitmap height(bmp)
      if gridwidth < 4 then gridwidth = 4
      if gridwidth > 20 then gridwidth = 20
      if gridheight < 4 then gridheight = 4
      if gridheight > 20 then gridheight = 20
      if speed < 1 then speed = 1

      spritetotal = gridwidth * gridheight
      spritewidth = bw / gridwidth
      spriteheight = bh / gridheight
      offsetx = spritewidth / 2
      offsety = spriteheight / 2
      dim xd(spritetotal)
      dim yd(spritetotal)
      dim an(spritetotal)

      x = 0 : y = 0
      for i = 1 to spritetotal
        s = 65536 - i

        rem --- set sprite
        get image s, x, y, x + spritewidth, y + spriteheight, 1
        sprite s, x+offsetx, y+offsety, s : offset sprite s, offsetx, offsety
        set sprite s, 1, 0

        inc x, spritewidth
        if x >= bw
          x = 0
          inc y, spriteheight
        endif

        rem --- set direction speed of sprite
        repeat : xd(i) = (rnd(speed*2) - speed) : until abs(xd(i)) > speed / 2
        repeat : yd(i) = (rnd(speed*2) - speed) : until abs(yd(i)) > speed / 2
        repeat : an(i) = (rnd(speed*2) - speed) : until abs(an(i)) > speed / 2
      next i

      draw sprites last
      copy bitmap bmp,0
      spritesoffscreen = 0

      rem <--- Insert sound here

      rem --- Ok, here we go! Loops until all blocks are off screen
      repeat
        for i = 1 to spritetotal
          s = 65536-i

          if sprite visible(s)
            sx = sprite x(s) + xd(i)
            sy = sprite y(s) + yd(i)
            sprite s, sx, sy, s
            rotate sprite s,wrapvalue(sprite angle(s) + an(i))

            if sx > (bw + offsetx) or sx < -offsetx or sy > (bh + offsety) or sy < -offsety
              hide sprite s
              inc spritesoffscreen, 1
            endif

          endif
        next i

        sync
      until spritesoffscreen = spritetotal

      rem --- clean up and exit
      undim yd() : undim xd()
      for i = 1 to spritetotal
        s = 65536 - i
        delete sprite s
        delete image s
      next i

    endif
  endif

endfunction
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 3rd Jan 2003 9:00
hmmm, forgot to change:

undim yd() : undim xd()

to:

undim an() : undim yd() : undim xd()
M
MrTAToad Joined: 26th Aug 2002
Location: United Kingdom
Posted: 3rd Jan 2003 14:13
Yes, been very late nights all through the Christmas period. Can't know I back at work though... shame...

I'll try it again later.
M
MrTAToad Joined: 26th Aug 2002
Location: United Kingdom
Posted: 3rd Jan 2003 22:57
Not bad at all, now you just need to get it to rotate around the X,Y,Z axis...
K
KamaKase Joined: 29th Oct 2002
Location:
Posted: 4th Jan 2003 1:10
It said that the "Get Image" functions had one too many numbers after.
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 4th Jan 2003 1:46
Hmmm, that error should'nt be showing if your using DBPro, patched with 3.1, strange...

...rotate around X,Y,Z axis...
I don't want to go too mad, after all this is only meant to be a snippet
Anyway I've made another revision, you wont see any difference when you run it, all I've done is tidied up the function a bit.

+ Code Snippet
sync on : sync rate 60
randomize timer()
set text opaque

bw = bitmap width(0)
bh = bitmap height(0)

rem --- make a sample image on bitmap 0
DrawSomething(0,0)
sync

create bitmap 1, bw, bh

t = 1
do
  rem --- make a sample image in bitmap 1
  DrawSomething(1,t)
  inc t, 1 : if t = 3 then t = 0

  set current bitmap 0
  ink 16777215,0
  center text bw / 2, bh - 32, " Press any key! "
  sync
  wait key

  ShatterWipe(1,10,8,8)
  sync
loop

end

function DrawSomething(bmp,t)
  set current bitmap bmp : cls 0
  bw = bitmap width(bmp) : bh = bitmap height(bmp)
  for i = 1 to 1000
    ink rgb(rnd(255),rnd(255),rnd(255)),0
    select t
      case 0 : dot rnd(bw),rnd(bh) : endcase
      case 1 : line rnd(bw),rnd(bh),rnd(bw),rnd(bh) : endcase
      case 2 : r = rnd(40) + 10 : ellipse rnd(bw),rnd(bh),r,r : endcase
    endselect
  next i
endfunction


function ShatterWipe(bmp,columns,rows,speed)
  remstart
    bmp = source bitmap to be displayed in bitmap 0 (size must equal to bitmap 0)

    columns, rows = number of divisions in bitmap. It's best to use values
    that can easily divide into width and height of bitmap (min 4, max 20)

    speed = how fast you want the blocks to fly

    NOTE: uses DRAW SPRITES LAST in order to work properly
  remend

  if bitmap exist(bmp) and bmp > 0
    bw = bitmap width(0) : bh = bitmap height(0)

    if bw = bitmap width(bmp) and bh = bitmap height(bmp)
      if columns < 4 then columns = 4
      if columns > 20 then columns = 20
      if rows < 4 then rows = 4
      if rows > 20 then rows = 20
      if speed < 1 then speed = 1

      spritetotal = columns * rows
      spritewidth = bw / columns
      spriteheight = bh / rows
      offsetx = spritewidth / 2
      offsety = spriteheight / 2
      dim xd(spritetotal) : dim yd(spritetotal) : dim an(spritetotal)

      sx = 0 : sy = 0
      for i = 1 to spritetotal
        s = 65536 - i

        rem --- set sprite
        get image s, sx, sy, sx + spritewidth, sy + spriteheight, 1
        sprite s, sx+offsetx, sy+offsety, s : offset sprite s, offsetx, offsety
        set sprite s, 1, 0

        inc sx, spritewidth
        if sx >= bw
          sx = 0
          inc sy, spriteheight
        endif

        rem --- set direction speed and rotation speed of sprite
        repeat : xd(i) = (rnd(speed*2) - speed) : until abs(xd(i)) > speed / 2
        repeat : yd(i) = (rnd(speed*2) - speed) : until abs(yd(i)) > speed / 2
        repeat : an(i) = (rnd(speed*2) - speed) : until abs(an(i)) > speed / 2
      next i

      draw sprites last
      copy bitmap bmp,0
      spritesoffscreen = 0

      rem <-- Play sound here

      rem --- Ok, here we go! Loops until all blocks are off screen
      repeat
        for i = 1 to spritetotal
          s = 65536-i

          if sprite exist(s)
            rem --- update sprite position and rotation
            sx = sprite x(s) + xd(i)
            sy = sprite y(s) + yd(i)
            sprite s, sx, sy, s
            rotate sprite s,wrapvalue(sprite angle(s) + an(i))

            rem --- if sprite off screen then delete it
            if sx > (bw + offsetx) or sx < -offsetx or sy > (bh + offsety) or sy < -offsety
              delete sprite s
              delete image s
              inc spritesoffscreen, 1
            endif

          endif
        next i

        sync
      until spritesoffscreen = spritetotal

      rem --- clean up and exit
      undim an() : undim yd() : undim xd()

    endif
  endif

endfunction
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 4th Jan 2003 2:02
For KamaKase.

OK, if your using DBPro, remove the extra "1" off the end of the GetImage, It should still work, the blocks my look a bit blury, but as they are spinning and moving about it may not matter.
M
MrTAToad Joined: 26th Aug 2002
Location: United Kingdom
Posted: 4th Jan 2003 2:03
Is it possible to grab a screen (which just happens to have 3D objects on it) ? If so, it would then be fairly easy to do a 3D version, consiting of x many planes...
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 4th Jan 2003 2:54
Using planes in that way, is a tad above my head, something I'll have think about.

However, by modifying the ShatterWipe function slightly, I think I can produce something like what you suggest. The advantage with this version is it does'nt need an extra bitmap.

+ Code Snippet
sync on : sync rate 60 : autocam off
randomize timer()

make matrix 1,1000,1000,20,20
make object cube 1,100 : position object 1,400,50,400 : color object 1,rgb(255,0,0)
make object sphere 2,100,16,8 : position object 2,500,50,500 : color object 2,rgb(0,255,0)
make object cone 3,100 : position object 3,600,50,600 : color object 3,rgb(0,0,255)

dist# = 300
an# = 0
gosub updatecamera

do
  if leftkey()
    an# = an# + 2
    gosub updatecamera
  endif

  if rightkey()
    an# = an# - 2
    gosub updatecamera
  endif

  if spacekey()
    rem --- create new view, but does not update until next sync (within ShatterWipe)
    an# = an# + rnd(180) + 90
    gosub updatecamera

    ShatterWipe(1,10,8,8)
  endif

  text 0,0,"Use left/right keys to move"
  text 0,16,"Press space to shatter"

  sync
loop

updatecamera:
  position camera newxvalue(500,an#,dist#),150,newzvalue(500,an#,dist#)
  point camera 500,50,500
return


function ShatterWipe(bmp,columns,rows,speed)
  remstart
    bmp = source bitmap to be displayed in bitmap 0 (size must equal to bitmap 0)

    columns, rows = number of divisions in bitmap. It's best to use values
    that can easily divide into width and height of bitmap (min 4, max 20)

    speed = how fast you want the blocks to fly

    NOTE: uses DRAW SPRITES LAST in order to work properly
  remend

    bw = bitmap width(0) : bh = bitmap height(0)
    if columns < 4 then columns = 4
    if columns > 20 then columns = 20
    if rows < 4 then rows = 4
    if rows > 20 then rows = 20
    if speed < 1 then speed = 1

    spritetotal = columns * rows
    spritewidth = bw / columns
    spriteheight = bh / rows
    offsetx = spritewidth / 2
    offsety = spriteheight / 2
    dim xd(spritetotal) : dim yd(spritetotal) : dim an(spritetotal)

    sx = 0 : sy = 0
    for i = 1 to spritetotal
      s = 65536 - i

      rem --- set sprite
      get image s, sx, sy, sx + spritewidth, sy + spriteheight, 1
      sprite s, sx+offsetx, sy+offsety, s : offset sprite s, offsetx, offsety
      set sprite s, 0, 0

      inc sx, spritewidth
      if sx >= bw
        sx = 0
        inc sy, spriteheight
      endif

      rem --- set direction speed and rotation speed of sprite
      repeat : xd(i) = (rnd(speed*2) - speed) : until abs(xd(i)) > speed / 2
      repeat : yd(i) = (rnd(speed*2) - speed) : until abs(yd(i)) > speed / 2
      repeat : an(i) = (rnd(speed*2) - speed) : until abs(an(i)) > speed / 2
    next i

    draw sprites last
    spritesoffscreen = 0

    rem <-- Play sound here

    rem --- Ok, here we go! Loops until all blocks are off screen
    repeat
      for i = 1 to spritetotal
        s = 65536-i

        if sprite exist(s)
          rem --- update sprite position and rotation
          sx = sprite x(s) + xd(i)
          sy = sprite y(s) + yd(i)
          sprite s, sx, sy, s
          rotate sprite s,wrapvalue(sprite angle(s) + an(i))

          rem --- if sprite off screen then delete it
          if sx > (bw + offsetx) or sx < -offsetx or sy > (bh + offsety) or sy < -offsety
            delete sprite s
            delete image s
            inc spritesoffscreen, 1
          endif

        endif
      next i

      sync
    until spritesoffscreen = spritetotal

    rem --- clean up and exit
    undim an() : undim yd() : undim xd()

endfunction
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 4th Jan 2003 3:08
...Ahem! whoops, of course all references to the bmp parameter should've been removed first.

the line:
function ShatterWipe(bmp,columns,rows,speed)

should be:
function ShatterWipe(columns,rows,speed)

therefore:
ShatterWipe(1,10,8,8)

should be:
ShatterWipe(10,8,8)

...I must be getting tired. (yawn!)
M
MrTAToad Joined: 26th Aug 2002
Location: United Kingdom
Posted: 4th Jan 2003 3:19
Better than being pickled...
D
David T Joined: 27th Aug 2002
Location: England
Posted: 4th Jan 2003 18:02
Interesting
L
Lampton Worm Joined: 4th Sep 2002
Location: United Kingdom
Posted: 5th Jan 2003 16:02
Hey that's cool !
V
vivi Joined: 28th Nov 2002
Location: United Kingdom
Posted: 9th Jan 2003 0:17
This code could be used in a RPG turn base as a zoom in to battle.....or as a magic attack. Like ice as you may want it to break up.......you dont mind if i hang on to this do you ?
E
Easily Confused Joined: 22nd Oct 2002
Location: U.K. Earth. (turn right at Venus)
Posted: 9th Jan 2003 4:37
Be my guest