[DBP] Cool screensaver - GameCreators Forum

Author

Message

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 28th Sep 2007 11:58

Link

OK, this is my last try of posting this. If it dissappears again I give up!

A while back I made some code which generated a normal map in real-time of a water simulation which could then be used within a shader and was quite effective.

This is a little screensaver I made whilst messing around with the code from that water simulation.

hide mouse

set normalization on

get image 1,0,0,128,128
make memblock from image 1,1

make object plain 1,50,50
make mesh from object 1,1
for l=1 to 34
   add limb 1,l,1
   rotate limb 1,l,l*5,0,0
next l
delete mesh 1
position object 1,1000,1000,1000
texture object 1,1
set object ambient 1,0
set object light 1,0
set object cull 1,0
disable object zwrite 1
ghost object on 1
clone object 2,1
rotate object 2,0,90,0
set object ambient 2,0
set object light 2,0
set object cull 2,0
disable object zwrite 2

position camera 1000,1025,950
rotate camera 20,0,0

type Vertices
   Height as float
   Fixed as integer
   Velocity as float
endtype
dim Grid(2,129,129) as Vertices

point camera 1000,1000,1000

color backdrop 0

sync on
sync rate 30

do

m=scancode()+mouseclick()+mousemovex()+mousemovey()+mousemovez()
   if m>0
      end
   endif

turn object left 1,5
   turn object left 2,5
   pitch object up 1,2
   pitch object up 2,2

inc t,1
   RedTint#=abs(sin(t/2))*768.0
   GreenTint#=abs(cos(t/2))*768.0
   BlueTint#=abs(sin((t/2)+45))*768.0
   for x=0 to 128
      for y=0 to 128
         Grid(0,x,y).Height=Grid(1,x,y).Height
         a#=abs(Grid(0,x,y).Height)/5.0
         r#=a#*RedTint#
         g#=a#*GreenTint#
         b#=a#*BlueTint#
         if r#>255.0
            r#=255.0
         endif
         if g#>255.0
            g#=255.0
         endif
         if b#>255.0
            b#=255.0
         endif
         r=r#
         g=g#
         b=b#
         WriteToImageMemblock(1,128,128,x,y,r,g,b)
      next y
   next x
   make image from memblock 1,1

if rnd(10)=1
      for d=0 to rnd(2)
         X=rnd(128)
         Y=rnd(128)
         Z#=(rnd(10))*-0.5
         Grid(0,X,Y).Height=Z#
         Grid(0,X,Y).Fixed=1
      next d
   endif
   for x=1 to 127
      for y=1 to 127
         if Grid(0,x,y).Fixed=0
            a#=Grid(0,x-1,y-1).Height
            b#=Grid(0,x-1,y).Height
            c#=Grid(0,x,y-1).Height
            d#=(Grid(0,x,y).Height+(Grid(0,x,y).Velocity*3.0))*3.0
            e#=Grid(0,x-1,y+1).Height
            f#=Grid(0,x+1,y-1).Height
            g#=Grid(0,x,y+1).Height
            h#=Grid(0,x+1,y).Height
            i#=Grid(0,x+1,y+1).Height
            Grid(1,x,y).Height=(a#+b#+c#+d#+e#+f#+g#+h#+i#)/11.0
            Grid(0,x,y).Velocity=(Grid(1,x,y).Height-Grid(0,x,y).Height)+(Grid(0,x,y).Velocity*0.18)
            if Grid(1,x,y).Height<-5.0
               inc Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=-5.0
            endif
            if Grid(1,x,y).Height>5.0
               dec Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=5.0
            endif
         else
            Grid(1,x,y).Height=Grid(0,x,y).Height
            dec Grid(0,x,y).Fixed,1
         endif
      next y
   next x

sync

loop

rem ============================================================================================
rem === WriteToImageMemblock()                                                               ===
rem ============================================================================================
function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

rem Adjust the memblock accordingly
      write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)

endif
endif

rem End the function
endfunction

rem ============================================================================================
rem === ReadFromImageMemblock()                                                              ===
rem ============================================================================================
function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

rem Adjust the memblock accordingly
      ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))

endif
endif

rem End the function
endfunction ColorValue

+ Code Snippet

hide mouse

set normalization on

get image 1,0,0,128,128
make memblock from image 1,1

make object plain 1,50,50
make mesh from object 1,1
for l=1 to 34
   add limb 1,l,1
   rotate limb 1,l,l*5,0,0
next l
delete mesh 1
position object 1,1000,1000,1000
texture object 1,1
set object ambient 1,0
set object light 1,0
set object cull 1,0
disable object zwrite 1
ghost object on 1
clone object 2,1
rotate object 2,0,90,0
set object ambient 2,0
set object light 2,0
set object cull 2,0
disable object zwrite 2

position camera 1000,1025,950
rotate camera 20,0,0

type Vertices
   Height as float
   Fixed as integer
   Velocity as float
endtype
dim Grid(2,129,129) as Vertices

point camera 1000,1000,1000

color backdrop 0

sync on
sync rate 30

do

   m=scancode()+mouseclick()+mousemovex()+mousemovey()+mousemovez()
   if m>0
      end
   endif

   turn object left 1,5
   turn object left 2,5
   pitch object up 1,2
   pitch object up 2,2

   inc t,1
   RedTint#=abs(sin(t/2))*768.0
   GreenTint#=abs(cos(t/2))*768.0
   BlueTint#=abs(sin((t/2)+45))*768.0
   for x=0 to 128
      for y=0 to 128
         Grid(0,x,y).Height=Grid(1,x,y).Height
         a#=abs(Grid(0,x,y).Height)/5.0
         r#=a#*RedTint#
         g#=a#*GreenTint#
         b#=a#*BlueTint#
         if r#>255.0
            r#=255.0
         endif
         if g#>255.0
            g#=255.0
         endif
         if b#>255.0
            b#=255.0
         endif
         r=r#
         g=g#
         b=b#
         WriteToImageMemblock(1,128,128,x,y,r,g,b)
      next y
   next x
   make image from memblock 1,1

   if rnd(10)=1
      for d=0 to rnd(2)
         X=rnd(128)
         Y=rnd(128)
         Z#=(rnd(10))*-0.5
         Grid(0,X,Y).Height=Z#
         Grid(0,X,Y).Fixed=1
      next d
   endif
   for x=1 to 127
      for y=1 to 127
         if Grid(0,x,y).Fixed=0
            a#=Grid(0,x-1,y-1).Height
            b#=Grid(0,x-1,y).Height
            c#=Grid(0,x,y-1).Height
            d#=(Grid(0,x,y).Height+(Grid(0,x,y).Velocity*3.0))*3.0
            e#=Grid(0,x-1,y+1).Height
            f#=Grid(0,x+1,y-1).Height
            g#=Grid(0,x,y+1).Height
            h#=Grid(0,x+1,y).Height
            i#=Grid(0,x+1,y+1).Height
            Grid(1,x,y).Height=(a#+b#+c#+d#+e#+f#+g#+h#+i#)/11.0
            Grid(0,x,y).Velocity=(Grid(1,x,y).Height-Grid(0,x,y).Height)+(Grid(0,x,y).Velocity*0.18)
            if Grid(1,x,y).Height<-5.0
               inc Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=-5.0
            endif
            if Grid(1,x,y).Height>5.0
               dec Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=5.0
            endif
         else
            Grid(1,x,y).Height=Grid(0,x,y).Height
            dec Grid(0,x,y).Fixed,1
         endif
      next y
   next x

   sync

loop

rem ============================================================================================
rem === WriteToImageMemblock()                                                               ===
rem ============================================================================================
function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

      rem Adjust the memblock accordingly
      write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)

   endif
endif

rem End the function
endfunction

rem ============================================================================================
rem === ReadFromImageMemblock()                                                              ===
rem ============================================================================================
function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

      rem Adjust the memblock accordingly
      ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))

   endif
endif

rem End the function
endfunction ColorValue

I then made this slightly altered, more colourful, version.

hide mouse

get image 1,0,0,128,128
make memblock from image 1,1

make object plain 1,50,50
make mesh from object 1,1
for l=1 to 34
   add limb 1,l,1
   rotate limb 1,l,l*5,0,0
next l
delete mesh 1
position object 1,1000,1000,1000
texture object 1,1
set object ambient 1,0
set object light 1,0
set object cull 1,0
disable object zwrite 1
ghost object on 1
clone object 2,1
rotate object 2,0,90,0
set object ambient 2,0
set object light 2,0
set object cull 2,0
disable object zwrite 2

position camera 1000,1025,950
rotate camera 20,0,0

type Vertices
   Height as float
   Fixed as integer
   Velocity as float
endtype
dim Grid(2,129,129) as Vertices

point camera 1000,1000,1000

color backdrop 0

sync on
sync rate 30

do

m=scancode()+mouseclick()+mousemovex()+mousemovey()+mousemovez()
   if m>0
      end
   endif

turn object left 1,5
   turn object left 2,5
   pitch object up 1,2
   pitch object up 2,2

inc t,1
   for x=0 to 128
      for y=0 to 128
         RedTint#=abs(sin((t/2)+(cos(x*y*0.1)*45.0)))*768.0
         GreenTint#=abs(cos((t/2)+(sin((x*y*0.1)+45.0)*45.0)))*768.0
         BlueTint#=abs(sin(((t/2)+(sin(x*y*0.1)*45.0))+45.0))*768.0
         Grid(0,x,y).Height=Grid(1,x,y).Height
         a#=abs(Grid(0,x,y).Height)/5.0
         r#=a#*RedTint#
         g#=a#*GreenTint#
         b#=a#*BlueTint#
         if r#>255.0
            r#=255.0
         endif
         if g#>255.0
            g#=255.0
         endif
         if b#>255.0
            b#=255.0
         endif
         r=r#
         g=g#
         b=b#
         WriteToImageMemblock(1,128,128,x,y,r,g,b)
      next y
   next x
   make image from memblock 1,1

if rnd(10)=1
      for d=0 to rnd(2)
         X=rnd(128)
         Y=rnd(128)
         Z#=(rnd(10))*-1.0
         Grid(0,X,Y).Height=Z#
         Grid(0,X,Y).Fixed=1
      next d
   endif
   for x=1 to 127
      for y=1 to 127
         if Grid(0,x,y).Fixed=0
            a#=Grid(0,x-1,y-1).Height
            b#=Grid(0,x-1,y).Height
            c#=Grid(0,x,y-1).Height
            d#=(Grid(0,x,y).Height+(Grid(0,x,y).Velocity*3.0))*3.0
            e#=Grid(0,x-1,y+1).Height
            f#=Grid(0,x+1,y-1).Height
            g#=Grid(0,x,y+1).Height
            h#=Grid(0,x+1,y).Height
            i#=Grid(0,x+1,y+1).Height
            Grid(1,x,y).Height=(a#+b#+c#+d#+e#+f#+g#+h#+i#)/11.0
            Grid(0,x,y).Velocity=(Grid(1,x,y).Height-Grid(0,x,y).Height)+(Grid(0,x,y).Velocity*0.18)
            if Grid(1,x,y).Height<-5.0
               inc Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=-5.0
            endif
            if Grid(1,x,y).Height>5.0
               dec Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=5.0
            endif
         else
            Grid(1,x,y).Height=Grid(0,x,y).Height
            dec Grid(0,x,y).Fixed,1
         endif
      next y
   next x

sync

loop

rem ============================================================================================
rem === WriteToImageMemblock()                                                               ===
rem ============================================================================================
function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

rem Adjust the memblock accordingly
      write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)

endif
endif

rem End the function
endfunction

rem ============================================================================================
rem === ReadFromImageMemblock()                                                              ===
rem ============================================================================================
function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

rem Adjust the memblock accordingly
      ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))

endif
endif

rem End the function
endfunction ColorValue

+ Code Snippet

hide mouse

get image 1,0,0,128,128
make memblock from image 1,1

make object plain 1,50,50
make mesh from object 1,1
for l=1 to 34
   add limb 1,l,1
   rotate limb 1,l,l*5,0,0
next l
delete mesh 1
position object 1,1000,1000,1000
texture object 1,1
set object ambient 1,0
set object light 1,0
set object cull 1,0
disable object zwrite 1
ghost object on 1
clone object 2,1
rotate object 2,0,90,0
set object ambient 2,0
set object light 2,0
set object cull 2,0
disable object zwrite 2

position camera 1000,1025,950
rotate camera 20,0,0

type Vertices
   Height as float
   Fixed as integer
   Velocity as float
endtype
dim Grid(2,129,129) as Vertices

point camera 1000,1000,1000

color backdrop 0

sync on
sync rate 30

do

   m=scancode()+mouseclick()+mousemovex()+mousemovey()+mousemovez()
   if m>0
      end
   endif

   turn object left 1,5
   turn object left 2,5
   pitch object up 1,2
   pitch object up 2,2

   inc t,1
   for x=0 to 128
      for y=0 to 128
         RedTint#=abs(sin((t/2)+(cos(x*y*0.1)*45.0)))*768.0
         GreenTint#=abs(cos((t/2)+(sin((x*y*0.1)+45.0)*45.0)))*768.0
         BlueTint#=abs(sin(((t/2)+(sin(x*y*0.1)*45.0))+45.0))*768.0
         Grid(0,x,y).Height=Grid(1,x,y).Height
         a#=abs(Grid(0,x,y).Height)/5.0
         r#=a#*RedTint#
         g#=a#*GreenTint#
         b#=a#*BlueTint#
         if r#>255.0
            r#=255.0
         endif
         if g#>255.0
            g#=255.0
         endif
         if b#>255.0
            b#=255.0
         endif
         r=r#
         g=g#
         b=b#
         WriteToImageMemblock(1,128,128,x,y,r,g,b)
      next y
   next x
   make image from memblock 1,1

   if rnd(10)=1
      for d=0 to rnd(2)
         X=rnd(128)
         Y=rnd(128)
         Z#=(rnd(10))*-1.0
         Grid(0,X,Y).Height=Z#
         Grid(0,X,Y).Fixed=1
      next d
   endif
   for x=1 to 127
      for y=1 to 127
         if Grid(0,x,y).Fixed=0
            a#=Grid(0,x-1,y-1).Height
            b#=Grid(0,x-1,y).Height
            c#=Grid(0,x,y-1).Height
            d#=(Grid(0,x,y).Height+(Grid(0,x,y).Velocity*3.0))*3.0
            e#=Grid(0,x-1,y+1).Height
            f#=Grid(0,x+1,y-1).Height
            g#=Grid(0,x,y+1).Height
            h#=Grid(0,x+1,y).Height
            i#=Grid(0,x+1,y+1).Height
            Grid(1,x,y).Height=(a#+b#+c#+d#+e#+f#+g#+h#+i#)/11.0
            Grid(0,x,y).Velocity=(Grid(1,x,y).Height-Grid(0,x,y).Height)+(Grid(0,x,y).Velocity*0.18)
            if Grid(1,x,y).Height<-5.0
               inc Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=-5.0
            endif
            if Grid(1,x,y).Height>5.0
               dec Grid(0,x,y).Velocity,0.125
               Grid(1,x,y).Height=5.0
            endif
         else
            Grid(1,x,y).Height=Grid(0,x,y).Height
            dec Grid(0,x,y).Fixed,1
         endif
      next y
   next x

   sync

loop

rem ============================================================================================
rem === WriteToImageMemblock()                                                               ===
rem ============================================================================================
function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

      rem Adjust the memblock accordingly
      write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)

   endif
endif

rem End the function
endfunction

rem ============================================================================================
rem === ReadFromImageMemblock()                                                              ===
rem ============================================================================================
function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

      rem Adjust the memblock accordingly
      ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))

   endif
endif

rem End the function
endfunction ColorValue

Back to top

Profile PM Email

Pyramid Games Ltd

17

Years of Service

User Offline

Joined: 23rd Aug 2007

Location: Line 21, DBP

Posted: 28th Sep 2007 15:08

Link

Woah! This is awesome.

Back to top

Profile PM Website

CrayZXP

17

Years of Service

User Offline

Joined: 1st Dec 2006

Location: Obviously not behind you...

Posted: 28th Sep 2007 22:53

Link

It looks like a special effect for an attack in an RPG!

(I just wish I knew how to set a DBPro app as a screen saver

)

No Common Sense for the Common Things!!!

Back to top

Profile PM Email Website

Aralox

17

Years of Service

User Offline

Joined: 16th Jan 2007

Location: Melbourne

Posted: 29th Sep 2007 03:26

Link

That is Incredible! I could just keep staring at it!

RobOrb

Back to top

Profile PM Website

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 29th Sep 2007 20:26

Link

Thanks everyone!

@CrayZXP - In the Project Manager window go to EXE Filname and type "whatever.scr". Now copy the SCR file into your C:\WINDOWS\system32 folder. Right click on your Desktop and click on Properties and then Screen Saver and it should be in the drop down list.

Back to top

Profile PM Email

Ankillito

17

Years of Service

User Offline

Joined: 10th Dec 2006

Location: Litigious California

Posted: 30th Sep 2007 21:39

Link

Cool! I finally get memblocks now! Thx.

http://forum.thegamecreators.com/xt/xt_apollo_pic.php?i=1234759

Back to top

Profile PM

Ankillito

17

Years of Service

User Offline

Joined: 10th Dec 2006

Location: Litigious California

Posted: 6th Oct 2007 05:24 Edited at: 6th Oct 2007 05:24

Link

Well, I was trying to show up Teh Coder, but I knew it wouldn't happen. Here's my version, using his functions. It's slower, and doesn't look as complicated...

I'm just glad I got something working.

sync on

hide mouse

get image 1,0,0,128,128
get image 3,0,0,128,128
get image 4,0,0,128,128
make memblock from image 1,1
make memblock from image 2,1
make memblock from image 3,3
make memblock from image 4,4
   inc t,1
   for x=0 to 128
      for y=0 to 128
         c  = 64  `center
         r# = 32
         f# = 10
         d# = sqrt( (x-c)^2 + (y-c)^2 )   `distance from center
         v# = sqrt( (f#)^2 - (r# - d#)^2 )
         v# = (255/f#) * v#
         if v# < 0 then v# = 0
         WriteToImageMemblock(2,128,128,X,Y,v#,0,0)
      next y
   next x

type particle
   d# `degree
   z# `depth (10 in back)
   r#
EndType
space# = 5
Type spot
   d#
   r#
   z#
EndType
dim   start(6) as spot
for a = 1 to 6
   start(a).d# = (360/3) * a
   start(a).r# = 20
   if a > 3 then start(z).r# = 25
   start(a).z# = 0
next a

dim ring(6,10) as particle

for b = 1 to 10
      for a = 1 to 6
      i = 10*(a-1) + b
         make object plain i,0.2,0.2
         texture object i,1
         if a > 3 then texture object i,3
         set object ambient i,0
         disable object zwrite i
         ghost object on i

ring(a,b).d# = start(a).d#
         ring(a,b).z# = b*space#
         ring(a,b).r# = start(a).r#

position object i, cos(ring(a,b).d#)*ring(a,b).r#, sin(ring(a,b).d#)*ring(a,b).r#,ring(a,b).z#
      next a

next b

dim back#(110) as float
for i = 100 to 110
make object plain i,20,20
texture object i,4
ghost object on i
disable object zwrite i
`scale object i, (back(i-100) * 50) + 100, (back(i-100) * 50) + 100, (back(i-100) * 50) + 100
back#(i-100) = i-100
next i

R# = 0
G# = 0
B# = 0
dR# = 0.125
dG# = 0.25
dB# = 0.5

position camera 0,0,-30
point camera 0,0,0
backdrop on
color backdrop 0
do

if inkey$() <> "" or mousemovex() <> 0 or mousemovey() <> 0 or mouseclick() <> 0 then end

inc r#, dR#
inc g#, dG#
inc b#, dB#
if r# >= 255 then r# = 255: dr# = -1 * abs(dr#)
if g# >= 255 then g# = 255: dg# = -1 * dg#
if b# >= 255 then b# = 255: db# = -1 * db#
if r# <= 0 then r# = 0: dr# = -1 * dr#
if g# <= 0 then g# = 0: dg# = -1 * dg#
if b# <= 150 then b# = 150: db# = -1 * db#
   for i = 100 to 110
      back#(i-100) = back#(i-100) + 0.01
      if back#(i-100) >= 11 then back#(i-100) = 0
      s# = (back#(i-100) * 60) + 100
      scale object i, s#,s#,s#
      f# = (back#(i-100) /10) *800
      if f# > 100 then f# = 100
      fade object i,  f#
   next i
   for a = 1 to 6
      if a < 4 then inc start(a).d#, 0.25
      if a > 3 then dec start(a).d#, 0.125

for b = 1 to 10
      i = 10*(a-1) + b
         inc ring(a,b).z#, 0.1
         dec ring(a,b).r#, 0.02
         if ring(a,b).z# > space# * 10
            ring(a,b).d# = start(a).d#
            ring(a,b).z# = start(a).z#
            ring(a,b).r# = start(a).r#
         ENdIF
         s# = 100+(ring(a,b).z# * 300)
         f# = 100 - (ring(a,b).z# / (10 * space#)) * 100
         fade object i, f#
         scale object i,s#,s#,s#
         position object i, cos(ring(a,b).d#)*ring(a,b).r#, sin(ring(a,b).d#)*ring(a,b).r#,ring(a,b).z#
      next b
   next a

inc t,1
   for x=0 to 128
      for y=0 to 128
         v# = ReadFromImageMemblock(2,128,128,X,Y)
         v# = RGBR(v#)
          `WriteToImageMemblock(1,128,128,X,Y,0,0,0)`g# * v#,b# * v#)
         WriteToImageMemblock(1,128,128,X,Y,r# * (v#/255),b# * (v#/255),g# * (v#/255))
         WriteToImageMemblock(3,128,128,X,Y,g# * (v#/255),b# * (v#/255),r# * (v#/255))
         WriteToImageMemblock(4,128,128,X,Y,r# * (v#/255) * 0.5,g# * (v#/255) * 0.5,b# * (v#/255))
      next y
   next x

make image from memblock 1,1
make image from memblock 3,3
make image from memblock 4,4
text 0,0,str$(screen fps())
sync
loop

function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

rem Adjust the memblock accordingly
      write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)

endif
endif

rem End the function
endfunction

function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

rem Adjust the memblock accordingly
      ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))

endif
endif

rem End the function
endfunction ColorValue

+ Code Snippet

sync on

hide mouse

get image 1,0,0,128,128
get image 3,0,0,128,128
get image 4,0,0,128,128
make memblock from image 1,1
make memblock from image 2,1
make memblock from image 3,3
make memblock from image 4,4
   inc t,1
   for x=0 to 128
      for y=0 to 128
         c  = 64  `center
         r# = 32
         f# = 10
         d# = sqrt( (x-c)^2 + (y-c)^2 )   `distance from center
         v# = sqrt( (f#)^2 - (r# - d#)^2 )
         v# = (255/f#) * v#
         if v# < 0 then v# = 0
         WriteToImageMemblock(2,128,128,X,Y,v#,0,0)
      next y
   next x


type particle
   d# `degree
   z# `depth (10 in back)
   r#
EndType
space# = 5
Type spot
   d#
   r#
   z#
EndType
dim   start(6) as spot
for a = 1 to 6
   start(a).d# = (360/3) * a
   start(a).r# = 20
   if a > 3 then start(z).r# = 25
   start(a).z# = 0
next a


dim ring(6,10) as particle



   for b = 1 to 10
      for a = 1 to 6
      i = 10*(a-1) + b
         make object plain i,0.2,0.2
         texture object i,1
         if a > 3 then texture object i,3
         set object ambient i,0
         disable object zwrite i
         ghost object on i

         ring(a,b).d# = start(a).d#
         ring(a,b).z# = b*space#
         ring(a,b).r# = start(a).r#

         position object i, cos(ring(a,b).d#)*ring(a,b).r#, sin(ring(a,b).d#)*ring(a,b).r#,ring(a,b).z#
      next a


   next b

dim back#(110) as float
for i = 100 to 110
make object plain i,20,20
texture object i,4
ghost object on i
disable object zwrite i
`scale object i, (back(i-100) * 50) + 100, (back(i-100) * 50) + 100, (back(i-100) * 50) + 100
back#(i-100) = i-100
next i


R# = 0
G# = 0
B# = 0
dR# = 0.125
dG# = 0.25
dB# = 0.5


position camera 0,0,-30
point camera 0,0,0
backdrop on
color backdrop 0
do

if inkey$() <> "" or mousemovex() <> 0 or mousemovey() <> 0 or mouseclick() <> 0 then end

inc r#, dR#
inc g#, dG#
inc b#, dB#
if r# >= 255 then r# = 255: dr# = -1 * abs(dr#)
if g# >= 255 then g# = 255: dg# = -1 * dg#
if b# >= 255 then b# = 255: db# = -1 * db#
if r# <= 0 then r# = 0: dr# = -1 * dr#
if g# <= 0 then g# = 0: dg# = -1 * dg#
if b# <= 150 then b# = 150: db# = -1 * db#
   for i = 100 to 110
      back#(i-100) = back#(i-100) + 0.01
      if back#(i-100) >= 11 then back#(i-100) = 0
      s# = (back#(i-100) * 60) + 100
      scale object i, s#,s#,s#
      f# = (back#(i-100) /10) *800
      if f# > 100 then f# = 100
      fade object i,  f#
   next i
   for a = 1 to 6
      if a < 4 then inc start(a).d#, 0.25
      if a > 3 then dec start(a).d#, 0.125

      for b = 1 to 10
      i = 10*(a-1) + b
         inc ring(a,b).z#, 0.1
         dec ring(a,b).r#, 0.02
         if ring(a,b).z# > space# * 10
            ring(a,b).d# = start(a).d#
            ring(a,b).z# = start(a).z#
            ring(a,b).r# = start(a).r#
         ENdIF
         s# = 100+(ring(a,b).z# * 300)
         f# = 100 - (ring(a,b).z# / (10 * space#)) * 100
         fade object i, f#
         scale object i,s#,s#,s#
         position object i, cos(ring(a,b).d#)*ring(a,b).r#, sin(ring(a,b).d#)*ring(a,b).r#,ring(a,b).z#
      next b
   next a



   inc t,1
   for x=0 to 128
      for y=0 to 128
         v# = ReadFromImageMemblock(2,128,128,X,Y)
         v# = RGBR(v#)
          `WriteToImageMemblock(1,128,128,X,Y,0,0,0)`g# * v#,b# * v#)
         WriteToImageMemblock(1,128,128,X,Y,r# * (v#/255),b# * (v#/255),g# * (v#/255))
         WriteToImageMemblock(3,128,128,X,Y,g# * (v#/255),b# * (v#/255),r# * (v#/255))
         WriteToImageMemblock(4,128,128,X,Y,r# * (v#/255) * 0.5,g# * (v#/255) * 0.5,b# * (v#/255))
      next y
   next x

make image from memblock 1,1
make image from memblock 3,3
make image from memblock 4,4
text 0,0,str$(screen fps())
sync
loop

function WriteToImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y,RedValue,GreenValue,BlueValue)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

      rem Adjust the memblock accordingly
      write memblock dword MemblockID,12+(MemblockPosition*4),rgb(RedValue,GreenValue,BlueValue)

   endif
endif

rem End the function
endfunction



function ReadFromImageMemblock(MemblockID,ImageWidth,ImageHeight,X,Y)

rem Find relative position in memblock
MemblockPosition=X+(Y*ImageWidth)

rem Check the position is in the memblock range
if MemblockPosition>=0
   if MemblockPosition<(ImageWidth*ImageHeight)

      rem Adjust the memblock accordingly
      ColorValue=memblock dword(MemblockID,12+(MemblockPosition*4))

   endif
endif

rem End the function
endfunction ColorValue

http://forum.thegamecreators.com/xt/xt_apollo_pic.php?i=1234759

Back to top

Profile PM

Aralox

17

Years of Service

User Offline

Joined: 16th Jan 2007

Location: Melbourne

Posted: 7th Oct 2007 10:57

Link

Thats pretty nice, i like it.

RobOrb

Back to top

Profile PM Website

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 7th Oct 2007 15:05

Link

@Ankillito - I'm glad someone found the code useful and thought it worth showing me up! Thats a pretty cool effect you made too.

Back to top

Profile PM Email

Ankillito

17

Years of Service

User Offline

Joined: 10th Dec 2006

Location: Litigious California

Posted: 8th Oct 2007 00:52

Link

Thx. If you run your code again though, mine looks really bland. But hey, I learned something, so I don't care. Right now, I'm trying to apply the memblock/image/texture technique to make a fire effect...

http://forum.thegamecreators.com/xt/xt_apollo_pic.php?i=1234759

Back to top

Profile PM

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 8th Oct 2007 01:31

Link

Cool. Good luck! If you need any help then let me know.

Back to top

Profile PM Email

Keo C

17

Years of Service

User Offline

Joined: 3rd Aug 2007

Location: Somewhere between here and there.

Posted: 8th Oct 2007 06:30

Link

Can you post a screen shot?

Uhhhhhhh.... I forgot

Back to top

Profile PM Website

Ankillito

17

Years of Service

User Offline

Joined: 10th Dec 2006

Location: Litigious California

Posted: 8th Oct 2007 07:25 Edited at: 9th Oct 2007 02:03

Link

of the fire? eh?

http://forum.thegamecreators.com/xt/xt_apollo_pic.php?i=1234759

Attachments

Login to view attachments

Back to top

Profile PM

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 8th Oct 2007 12:49

Link

If you meant a screen shot of my screen saver then here you go but you really can't get much idea of what it is like when it isn't moving.

Back to top

Profile PM Email

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 8th Oct 2007 16:25

Link

This is pretty bad-ass. Well done

"It's like floating a boat on a liquid that I don't know, but I'm quite happy to drink it if I'm thirsty enough" - Me being a good programmer but sucking at computers

Back to top

Profile PM Email

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 8th Oct 2007 17:26

Link

Thanks!

Back to top

Profile PM Email

TinTin

18

Years of Service

User Offline

Joined: 16th May 2006

Location: BORG Drone Ship - Being Assimilated near Roda Beta (28)

Posted: 9th Oct 2007 17:05

Link

That looks cool

Well done.
I can think of several uses for this...

1).. A majic reveal, using object transparency to display a character in the middle of this effect.

2).. A cool 3D cloud or smoke effect with a little modification.

3).. A cool backdrop to a menu screen.

Keep up the good work.

Go Create...

Cyberspace was becoming overcrowded and slummy so I decided to move. These nice chaps gave me a lift.

Back to top

Profile PM

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 10th Oct 2007 10:36

Link

Thanks! Memblocks are just so incredibly useful that you could alter this in so many ways to create a different effect.

Back to top

Profile PM Email

Silicon Zombie

17

Years of Service

User Offline

Joined: 7th Oct 2007

Location: UK

Posted: 10th Oct 2007 15:52

Link

Thats a really nice effect you have there (Ive learnt alot of new things by looking at your code)

Thanks for sharing it with us.

Back to top

Profile PM

Xlaydos

20

Years of Service

User Offline

Joined: 26th Mar 2004

Location:

Posted: 10th Oct 2007 21:28

Link

That is the coolest thing i have ever seen in DB

Good work!

Back to top

Profile PM

Benjamin

21

Years of Service

User Offline

Joined: 24th Nov 2002

Location: France

Posted: 11th Oct 2007 02:33

Link

Wow, that is absolutely amazing! Well done.

Tempest (DBP/DBCe)
Multisync V1 (DBP/DBCe)

Back to top

Profile PM Email

Ankillito

17

Years of Service

User Offline

Joined: 10th Dec 2006

Location: Litigious California

Posted: 11th Oct 2007 02:48

Link

Wow. Every time I look at it again, I feel unworthy...

http://forum.thegamecreators.com/xt/xt_apollo_pic.php?i=1234759

Back to top

Profile PM

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 11th Oct 2007 11:20

Link

Wow! Thanks! You are all incredibly kind worded!

@Silicon Zombie - Glad someone else could learn something from it.

Back to top

Profile PM Email

dark coder

22

Years of Service

User Offline

Joined: 6th Oct 2002

Location: Japan

Posted: 11th Oct 2007 13:14

Link

Agreed, looks really cool; hard to believe it's a bunch of plains

.

Back to top

Profile PM Email

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 11th Oct 2007 19:06

Link

Thanks, I must admit I was quite suprised it worked as effectively as it did.

Back to top

Profile PM Email

Binary Coder

17

Years of Service

User Offline

Joined: 26th Feb 2007

Location: Queensland, Australia

Posted: 13th Oct 2007 10:42

Link

The screenshots look great, but im getting a runtime error
(memblock outside of range)

Back to top

Profile PM Email

TEH_CODERER

21

Years of Service

User Offline

Joined: 12th Nov 2003

Location: Right behind you!

Posted: 13th Oct 2007 12:37

Link

Watch version of DarkBASIC are you using?

Back to top

Profile PM Email

Binary Coder

17

Years of Service

User Offline

Joined: 26th Feb 2007

Location: Queensland, Australia

Posted: 14th Oct 2007 02:12

Link

Pro, but i think it is because i changed the display mode from 32 to 16 because my hardware cannot run it.

Back to top

Profile PM Email

Benjamin

21

Years of Service

User Offline

Joined: 24th Nov 2002

Location: France

Posted: 14th Oct 2007 03:52 Edited at: 14th Oct 2007 03:52

Link

Quote: "Pro, but i think it is because i changed the display mode from 32 to 16 because my hardware cannot run it."

That's the problem then; when you make a memblock from an image the depth will match the resolution you're using (a 16bit memblock is half the size of a 32bit one, hence the error).

Tempest (DBP/DBCe)
Multisync V1 (DBP/DBCe)

Back to top

Profile PM Email

Binary Coder

17

Years of Service

User Offline

Joined: 26th Feb 2007

Location: Queensland, Australia

Posted: 14th Oct 2007 07:05

Link

Thanks Benjamin, any idea on how to fix it?

Back to top

Profile PM Email

Sorry your browser is not supported!

Code Snippets / [DBP] Cool screensaver

Attachments