The "Flower Tunnel"

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

The "Flower Tunnel"

Postby relsoft » Apr 05, 2006 14:45

Enjoy!

Code: Select all

'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


Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Apr 05, 2006 15:06

WHOA!!!!!!!!

*his heart collapses*
blahboybang
Posts: 385
Joined: Oct 16, 2005 0:15
Location: USA
Contact:

Postby blahboybang » Apr 05, 2006 15:12

Doesn't work for me. :(

It just brings up a command console, then closes.
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Postby maddogg6 » Apr 05, 2006 16:23

While Im a complete dum bass - I think you need to have this lib installed for it to work..
edit: fixed link.
http://sourceforge.net/projects/tinyptc/

Notice the include near the top of the code:

Code: Select all

'$include: 'tinyptc.bi'


Get the D/L package, and if you simply want to run code that inludes TPTC - find the dll's in the zip file you D/L and put them in your windows system/system32 folder.(or in any folder that has its path in your environment) - or in the same folder as the compiled example code posted in this thread..
Last edited by maddogg6 on Apr 05, 2006 19:36, edited 1 time in total.
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Postby maddogg6 » Apr 05, 2006 16:32

Oh - and - That is a pretty cool demo btw.
Stormy
Posts: 198
Joined: May 28, 2005 17:57
Location: Germany
Contact:

Postby Stormy » Apr 05, 2006 18:03

Very nice.. runs smoothly on my linux box! Good job ! *thumbs up*
Stonemonkey
Posts: 549
Joined: Jun 09, 2005 0:08

Postby Stonemonkey » Apr 05, 2006 18:05

Very nice that is.
blahboybang
Posts: 385
Joined: Oct 16, 2005 0:15
Location: USA
Contact:

Postby blahboybang » Apr 05, 2006 18:17

no, that link goes to ptc, not tinyptc.
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:

Postby maddogg6 » Apr 05, 2006 19:32

blahboybang wrote:no, that link goes to ptc, not tinyptc.


Hmm - its the link I followed in the FB forum links thread...

It worked for me, but I may have installed TPTC before??

If its wrong, my appologies.

edit:

My bad - I must have followed the FB link - then hit the homepage of the developer... it seems TPTC doesnt have much in the line of docs from the developer... ??

Correct link:
http://sourceforge.net/projects/tinyptc/
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » Apr 05, 2006 19:53

TinyPtc is a static lib that's linked with the program at compile time. No dll's to download from developers. It used to come with the FB package, don't know if it was included with V0.15...I have it, can put it somewhere if needed.

Great job, Rel!
Are the flowers related with some entropy? ;D
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario
Contact:

Postby axipher » Apr 05, 2006 21:25

I know it worked for me and I never dled tinyptc sepearetly, I think* it came with 0.14 and when I downloaded that one, installed is, then installed .015 and 0.16 to the same directory, so it probably remained in it's folder. But very nice job
Dr_D
Posts: 2389
Joined: May 27, 2005 4:59
Contact:

Postby Dr_D » Apr 05, 2006 22:16

Yeah... it's beautiful. The last one could make people puke. What was it called, Ascaris? lol!
DrV
Site Admin
Posts: 2116
Joined: May 27, 2005 18:39
Location: Midwestern USA
Contact:

Postby DrV » Apr 06, 2006 0:04

TinyPTC is in the 0.15 distribution - just make sure to pick it in the list of libraries at install time.
Voltage
Posts: 110
Joined: Nov 19, 2005 7:36
Location: Sydney, Australia
Contact:

Postby Voltage » Apr 06, 2006 0:14

Nice effect Rel :-) Funky stuff.

I'm suprised that it runs as fast as i does with a Sqr, Atan2 a few mults and div for each pixel.

Nice one.
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

Postby relsoft » Apr 06, 2006 0:24

And I haven't slept the whole night because of this. I had to finish a 100 item chemistry exam (we'll it was due yesterday but our admin gave me 1 day more). So, instead of writing the test I made this:

Code: Select all

cls
screen 13

const PI as single = atn(1) * 4
const TWOPI as single = PI 'atn(1) * 4
const MRADIUS as integer = 50

const XCENTER as INTEGER = 160
const YCENTER as INTEGER = 100

dim as single foldoff = 0.02
dim as single fold_scale = 0.07' * sin(timer / 512.0)
dim as single fold_num = 16
dim as single rad_factor = 0
dim as integer frame = 0
do
    SCREENSET 1, 0        'set work page for double buffering
    line (0,0)-(319,199), 0, bf
    frame += 1
    foldoff += 0.02
    fold_scale = 0.3 * sin(frame / 40)
    for i = 0 to 359       
        rad_factor = (sin(foldoff + fold_num * i * TWOPI / 360) * fold_scale)+1
        x = cos(i * PI /180) * MRADIUS * rad_factor
        y = sin(i * PI /180) * MRADIUS * rad_factor
        pset (XCENTER + x, YCENTER + y) , 15
    next i
    screensync
    SCREENCOPY            'flip

Loop until inkey$<>""


S I said, damn, why not apply this on a 2d tunnel? So I applied it in my old FB tunnel. Which mean't I got to start writing the test in the wee hors of the morning. I just finish the test but I haven't slept. And I'm still not sleeping because I'll convert this to ASM for kicks. :*)

rel: Procastinator extraordinaire. :*)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest