Flowers and tunnel = ?

[relsoft]

Flower Tunnel!

Code:

'Flower tunnel
'relsoft 2006
'http://rel.betterwebber.com
defint a-z


'$include: 'tinyptc.bi'

declare sub DrawTunnel( Buffer() as integer, Texture() as integer,_
                       Tangle() as integer, Tdepth() as integer,_
                       byval addx as integer, byval addy as integer)
declare FUNCTION dist! (byval x!,byval  y!, xc!(), yc!())


const SCR_WIDTH = 320  * 1
const SCR_HEIGHT = 240 * 1
const SCR_SIZE = SCR_WIDTH * SCR_HEIGHT

const TWID = SCR_WIDTH
const THEI = SCR_HEIGHT
const TWIDM1 = TWID - 1
const THEIM1 = THEI - 1

const MAXPOINTS = 32

const XMID = SCR_WIDTH \ 2
const YMID = SCR_HEIGHT \ 2



const PI = 3.141593
const TWOPI = (2 * PI)


    dim shared Buffer( 0 to SCR_SIZE-1 ) as integer
    dim shared Tangle( TWID, THEI) as integer
    dim shared Tdepth( TWID, THEI) as integer
    dim shared Texture( 255, 255) as integer
    dim shared Distbuffer!( 255, 255)
    dim shared xcoords!(maxpoints)
    dim shared ycoords!(maxpoints)


    if( ptc_open( "freeBASIC v0.01 - Blob demo(Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
        end -1
    end if

    randomize timer

    dim  x, y, i, r, g, b as integer

    FOR i = 0 TO maxpoints
        xcoords!(i) = rnd * SCR_WIDTH
        ycoords!(i) = rnd * SCR_HEIGHT
    NEXT i



    mindist! = 1D+16
    maxdist! = 0

    FOR y = 0 TO 255
       FOR x = 0 TO 255
              tx! = abs(x - 128)
              ty! = abs(y - 128)
              distance! = dist!(tx!, ty!, xcoords!(), ycoords!())
              distbuffer!(x, y) = distance!
              IF distance! < mindist! THEN mindist! = distance!
              IF distance! > maxdist! THEN maxdist! = distance!
       NEXT x
    NEXT y



    FOR y = 0 TO 255
       FOR x = 0 TO 255
              c! =(distbuffer!(x, y) - mindist!) / (maxdist! - mindist!)
              r = cint(c! * 55)
              g = cint(c! * 155)
              b = cint(c! * 255)
              texture(x, y) = r shl 16 or g shl 8 or b
       NEXT x
    NEXT y



    dim t as single

    do
        t = timer
        DrawTunnel Buffer(), Texture(), Tangle(), Tdepth(), (TWID shr 1)* sin(t * .5),_
                   (t *.8)* (THEI shr 1)

        ptc_update @buffer(0)

    loop until inkey$<>""


    ptc_close

end


private sub DrawTunnel(Buffer() as integer, Texture() as integer,_
                       Tangle() as integer, Tdepth() as integer,_
                       byval addx as integer, byval addy as integer)

    dim pbuff, ptext as integer ptr
    dim x, y, tx, ty  as integer
    
    static as integer cx= 160, cy =120
    dim xdist as single
    dim cxmx, cymy, diamxscale as integer
    static frame as short
    static  as single fold_off = 0.02
    static  as single fold_scale = 0.07' * sin(timer / 512.0)
    static  as single fold_num = 8
    static  as single rad_factor = 0

    frame +=1
    diameter = 128
    diamxscale = 64 * diameter
    cx = (TWID\2)+ sin(addx/80)*70
    cy = (THEI\2)+ sin(addy/90)*70
    dim temp as short
    temp = 512/pi
    dim angle as single
    fold_off += 0.2    
    fold_scale = 0.3 * sin(frame / 40)    
    
    for y = 0 to THEIM1
        cymy = cy - y
        for x = 0 to TWIDM1
            cxmx = cx -x            
            angle = atan2(cymy,cxmx)            
            tx = int(angle * temp) + addx            
            xdist = sqr((cxmx*cxmx) + (cymy*cymy))
            xdist = xdist * ((sin(fold_off + fold_num * angle) * fold_scale)+1)            
            ty =  (diamxscale / xdist) + addy            
            tx = tx and 255
            ty = ty and 255
            buffer( y * SCR_WIDTH + x) = texture(tx, ty)            
        next x
        
    next y


end sub

private FUNCTION dist! (byval x!,byval  y!, xc!(), yc!())
    mindist! = 1D+16
    max = UBOUND(xc!)
    FOR i = 0 TO max
        a! = (xc!(i) - x!) * (xc!(i) - x!)
        b! = (yc!(i) - y!) * (yc!(i) - y!)
        d! = SQR(a! + b!)
        IF d! < mindist! THEN mindist! = d!
    NEXT i
    dist! = mindist!
END FUNCTION

[Deleter]

*runs away and hides*

jk

pretty cool

[Agamemnus]

Man. You are just awesome at spatial stuff. Ppl need to check out your brain and see if anything is superhuman.

[relsoft]

Man. You are just awesome at spatial stuff. Ppl need to check out your brain and see if anything is superhuman.

Right now I'm feeling sub-human because it took me 5 minutes in front fo the whole freaking class to solve my own chemistry problem.

Damn. Lack of sleep is not really that good. :*(

[anarky]

Nothing? Screen goes fullscren, then exits, no error no message...
Freebasic 0.15.

[KiZ]

Rel, you crazy ;D

cool as usual :)

[relsoft]

Thanks!!!