SHort intro challenge Textured Lava blob

[Shockwave]

This is definately my last attempt at this.
Hope you like it. By the way, it can be further condensed but I left it as it is because I like the effect and didn't want to ruin it by purely optimising for size as the effect fits easily in 20 lines anyway

Code Select Expand


#DEFINE PTC_WIN
#Include Once "tinyptc.bi"
If( ptc_open( "TEXTURED BLOB LAVA LAMP BY SHOCKWAVE ^ DBF 18 LINES.", 640, 480 ) = 1 ) Then dim shared buffer(640*480) as integer, buffer2(640*480) as integer, colours (320) as integer, strt as double,intr as double,buffer3(640*480) as integer, fact as double
for a=-300 to 640*480
    if a<0 then colours(a+300)=rgb( 0,0,(a+300) *.35  ) else if a>=0 then buffer2(a) = rgb(0,0,((int(a/640)) xor (int(a mod 640))))
    if a>=0 then buffer3(a) = rgb(0,((int(a/640)) xor (int(a mod 640))),0) next
do     
    for y=0 to 479
        leng=250+(199*cos((y-timer*214)/63))*sin((y+(timer * 263))/(150+150*sin(timer*.00002)))
        intr = (640/leng)
        strt = 0
        fact=0.001
        if intr <=0 then intr=1
        for x=0 to 640
            if x>=320- (leng/2) and x<= 320 + (leng/2) then buffer((y*640)+x) = ((buffer2((y*640)+int(strt)))*fact) else buffer((y*640)+x)=buffer3((y*640)+x)+colours( y shr 1 )
            if x>=320- (leng/2) and x<= 320 + (leng/2) then strt=strt+intr
            if x>=320- (leng/2) and x<= 320 + (leng/2) then if x<320 then fact=fact+.002 else if x>320 then fact=fact-.002 end if next next
ptc_update@buffer(0)  loop until inkey$<>""


[Shockwave]

Same code, different background..

Code Select Expand


#Include Once "tinyptc.bi"
If( ptc_open( "TEXTURED BLOB LAVA LAMP BY SHOCKWAVE ^ DBF 18 LINES.", 640, 480 ) = 1 ) Then dim shared buffer(640*480) as integer, buffer2(640*480) as integer, colours (320) as integer, strt as double,intr as double,buffer3(640*480) as integer, fact as double
for a=-300 to 640*480
    if a<0 then colours(a+300)=rgb( (a+300) *.15 ,(a+300) *.25 ,(a+300) *.35  ) else if a>=0 then buffer2(a) = rgb(0,0,((int(a/640)) xor (int(a mod 640))))
    if a>=0 then buffer3(a) = rgb(0,((int(a/640)) xor (int(a mod 640))),0) next
do     
    for y=0 to 479
        leng=300+(199*cos((y-timer*214)/63))*sin((y+(timer * 263))/(150+150*sin(timer*.00002)))
        intr = (640/leng)
        strt = 0
        fact=0.001
        if intr <=0 then intr=1
        for x=0 to 640
            if x>=320- (leng/2) and x<= 320 + (leng/2) then buffer((y*640)+x) = ((buffer2((y*640)+int(strt)))*fact) else buffer((y*640)+x)=colours(y shr 2)
            if x>=320- (leng/2) and x<= 320 + (leng/2) then strt=strt+intr
            if x>=320- (leng/2) and x<= 320 + (leng/2) then if x<320 then fact=fact+.002 else if x>320 then fact=fact-.002 end if next next
ptc_update@buffer(0)  loop until inkey$<>""


[Clyde]

Well smart, nice one dude.

[Rattrapmax6]

Pretty cool.. 

[Tetra]

quite nice, looks like sound waves

[benny!]

Indeed, looks pretty cool !!!

[Shockwave]

I think that the second version of this technique was my favourite one to program out of all that I made. I'd always wanted to code the effect but never had a reason to do it

[Clyde]

Nifty Shockie, welldone/

[Optimus]

Heh, I really like this one!

[Shockwave]

It's similar to yours Optimus, sorry for borrowing the texture generation idea but that xor texture is handy as it takes only a few instructions to make it. I've never used it in a prod of any kind before , normally I just use it for testing texture mapping routines when I can't be bothered to load a texture.

[Optimus]

Yep, XOR texture is what you do (why do I call it a XOR texture when I usually use AND for it? ) when you want something fast with few instruction or simply don't have inspiration for an alternative texture generation algorithm. I have overused it in all my tiny intro codes ;P

[relsoft]

Cool!!!! Looks like an intestine!

[Shockwave]

Ewww! I hope my intestines look different