Dot Tunnel

[boogop]

Dot tunnels gave me fits trying to figure out. So here's one for the lulz, maybe it will help (or hinder) someone else!

Code: [Select]

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DOT TUNNEL
' by boogop
' The c# logic from my entry for the Amiga
' demo a year or so ago
' - now in glorious lo-res!
'
' For me, dot tunnels were the hardest effect
' to figure out. There didn't seem to be many
' examples (before I found dbfinteractive, on
' which there are several) and the ones I could
' find on the intarnets or hornet archive were
' frequently not very good. Some of them
' weren't tunnels at all, they were tubes with the
' rings fixed in place. The best one I ever saw
' was Crystal2 BBS addy by Xography but they never
' released the source, and I haven't been able to
' figure out how they were handling the movement path
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

#include "tinyptc_ext.bi"

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' screen dimensions & put_pixel routine
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
const screenWidth = 320
const screenHeight = 200
const SCR_SIZE as integer = screenWidth*screenHeight

dim shared buffer( 0 to SCR_SIZE-1 ) as integer
dim shared as uinteger ptr pntr
dim shared as integer ptr p

declare sub put_pixel(buffer() as integer, byval x as integer, byval y as integer, byval col as integer)

' this may be Shockwave's routine!
sub put_pixel(buffer() as integer, byval x as integer, byval y as integer, byval col as integer)

    if(y < screenHeight -1 and y > 1) then
        if( x < screenWidth-1 and x > 1 ) then
           
            PNTR = @buffer(y * screenWidth + x)   
         
            asm
                mov eax, dword ptr[col]
                mov edi, [pntr]               
                stosd
            end asm           
     
        end if
    end if

end sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' declare variables
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
type colors
    dim as integer r,g,b
end type

dim shared as colors colArray(256)

const _pointsPerCircle = 20
const _numCircles = 35
dim shared as double zDistance = 8

' named star because I lifted it from my 3d starfield code :)
type star
    dim as double xpos, ypos, speed, zpos
    dim as double origX, origY, origZ
    dim as integer oldx,oldy
end type

dim shared as star circles(_numCircles, _pointsPerCircle)

dim shared as double maxZ = 0
dim shared as double diam = 50
dim shared as double xp,yp,zp,increment, px, py, skew, skewCount
dim shared as integer angle = 0
dim shared as double zPos = 1
dim shared as integer angleAdder = int(360 / _pointsPerCircle)     
dim shared as double zPosAdder
dim shared as double midWidth = screenWidth / 2
dim shared as double midHeight = screenHeight / 2
dim as integer i,j, xpathcount
dim as double rad = 3.1416 / 180.0

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' set initial values
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
skewCount = .0001
zPosAdder = zDistance / _numCircles

for  j = 0 to  _numCircles
   
    for  i = 0 to _pointsPerCircle
   
      dim as double Y =  diam * Sin(angle * rad)
      dim as double X = 2 * diam * Cos(angle * rad) ' make it oval shaped for the lulz
      circles(j, i).xpos = X
      circles(j, i).ypos = Y
   
      circles(j, i).speed = .0025
      circles(j, i).zpos = zPos
      circles(j, i).origX = X
      circles(j, i).origY = Y     
      circles(j, i).oldx = 0
      circles(j, i).oldy = 0
   
      angle += angleAdder
   
    next i
zPos += zPosAdder
next j
     

maxZ = 0

' figure out the largest z value
for  j = 0 to _numCircles
    for i = 0 to _pointsPerCircle     
        if circles(j, i).zpos > maxZ then
            maxZ = circles(j, i).zpos
        end if   
    next i
next j

increment = 0

' fill color array     
i = 0
while i < 256     
    dim as single red = 1 + Cos(i * 3.14 / 128)
    dim as single grn = 1 + Cos((i - 85) * 3.14 / 128)
    dim as single blu = 1 + Cos((i + 85) * 3.14 / 128)
    colArray(i).r = int(red * 127) mod 256
    colArray(i).g = int(grn * 127) mod 256
    colArray(i).b = int(blu * 127) mod 256
    i = i+1
wend

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' run the thing
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'ptc_setdialog(1,"FullScreen?",0,0)
if( ptc_open( "freeBASIC - tinyPTC Dot Tunnel", screenWidth, screenHeight ) = 0 ) then
    end -1
end if

while inkey() <> chr(27)   
 
    if skew <= 1 then
        skew = skew + skewcount
    end if
   
    for  i = 0 to _numCircles
       
        for  j = 0 to _pointsPerCircle
           
           ' erase the last point
            put_pixel Buffer(),circles(i, j).oldx,circles(i, j).oldy,0
            put_pixel Buffer(),circles(i, j).oldx+1,circles(i, j).oldy,0
           
            ' bring each circle towards the viewer
            circles(i, j).zpos -= circles(i, j).speed
           
            ' if a circle is close enough to the viewer, send it to the back
            ' using the maximum z value
            if circles(i, j).zpos < 2 then           
                circles(i, j).xpos = circles(i, j).origX
                circles(i, j).ypos = circles(i, j).origY
                circles(i, j).zpos = maxZ
            end if
           
            ' most compilers will perform some kind of bounds checks, and those
            ' will really bog an app down. Cast the array to vars so any bounds
            ' checking only has to happen once
            xp = circles(i, j).xpos
            yp = circles(i, j).ypos
            zp = circles(i, j).zpos
           
            ' kludgey color fader lol
            dim as double cc = 1 - Abs(zp / (maxZ * .8))
            if (cc < 0) then
                cc = 0
            end if
            if (cc > 1) then
                cc = 1
            end if
            dim as integer c = int(300 * cc)
            if c > 255 then
                c = 255
            end if
            dim as integer co = rgb(colArray(c).b,colArray(c).r,colArray(c).g)
            if zp > int(maxZ * .6) then
                co = rgb(colArray(c).b/2,c,c)
            end if       
       
           ' zpos isn't quite right and doesn't bring the circles as close
           ' as it should but I don't feel like fixing it!
            dim as double z = zp - 1.5
           
            ' path of the tunnel
            px = 50 * Sin(z * skew * sin(increment))
            py = 40 * Cos(z * skew * cos(increment))           
           
            ' calculate perspective, add path, align to center screen
            dim as double sx = (xp / z) + px + midWidth
            dim as double sy = (yp / z) - py + midHeight
           
            dim as integer ix = int(sx)
            dim as integer iy = int(sy)
                     
            put_pixel Buffer(),ix,iy,co
            put_pixel Buffer(),ix+1,iy,co           
           
            ' save the current pos so we can erase it in the next iteration
            circles(i, j).oldx = ix
            circles(i, j).oldy = iy
           
        next j
    next i   
   
   
    increment +=.0005   
       
    ptc_update @buffer(0)


  wend




[Stonemonkey]

cool stuff, not quite sure about the put pixel routine you have there, just do

buffer(y * screenWidth + x) =col

inside the bounds checking but without the pointer and asm stuff.

The buffer array (and all other variables for storing colours) should be ulong type, when it's signed funny things can happen with some colour processing, and ulong instead of uinteger to keep them 64 bit users happy.

[boogop]

 lol thanks! Freebasic is a new experience but I'm liking it a lot

[Stonemonkey]

Pointers in freebasic are useful, but when plotting arbitrary pixels there's no point in getting the pointer then writing in that way. If you're plotting a row of consecutive pixels then it is much faster to get the pointer to the first pixel then to move the pointer to the next pixel just by adding 1 to it (the compiler knows that ulong (or uinteger on 32bit FB) is 4 bytes and adds 4 on to the pointer even though you've added 1. It does that for all data types:

dim as ubyte ptr b=some address
b+=1 'adds 1 on to the pointer

dim as ushort ptr s=some address
s+=1 'adds 2 on to the pointer

dim as ulong ptr l=some address
l+=1 'adds 4 on to the pointer

and it does it for UDTs too so it can speed up going through arrays in critical parts of code so your program isnt having to re-calculate addresses over and over.

Don't worry too much about making use of that though, get your stuff working well first then think about optimising with ideas like that later.

[boogop]

Yep, that works! Thanks!

But there's a basic design problem with the way I do tunnels. I've modified the algorithm from 3D stars, where each point in the circle is divided by Z in the processing loop, so each point moves towards the screen boundaries. Doing that I can never be outside the tunnel looking at it. See the attached screenshot below from Xography; treating each point on the circle like a 3D star, that view will never happen

[Stonemonkey]

Here's a quick example of the sort of way I would do it, it's maybe not exactly the sort of dot tunnel you're after but it should be easy to modify although everyone's got different styles of coding.

Code: [Select]

const pi2=3.141592*2.0

type star
    as single x,y,z
    as single radius
    as single num_points
end type

type starfield
    as integer num_stars
    as star ptr star_list
    as single max_z,min_z,z_speed
end type

function create_starfield(byval num_stars as integer,_
                            byval radius as single,_
                            byval num_points as single,_
                            byval max_z as single,_
                            byval min_z as single,_
                            byval z_speed as single)as starfield ptr
    dim as starfield ptr starfield=new starfield
    starfield->star_list=new star[num_stars]
    for star as integer=0 to num_stars-1
        starfield->star_list[star].radius=radius
        starfield->star_list[star].num_points=num_points
        starfield->star_list[star].z=min_z+((max_z-min_z)/num_stars)*star
    next
    starfield->max_z=max_z
    starfield->min_z=min_z
    starfield->z_speed=z_speed
    starfield->num_stars=num_stars
    return starfield
end function

sub process_starfield(byval starfield as starfield ptr)
    static as single angle=0
    static as single amplitude_angle=0
    static as single horizontal_angle=0
    static as single vertical_angle=0
    for star_count as integer=0 to starfield->num_stars-1
        dim as star pointer star=@starfield->star_list[star_count]
        star->z-=starfield->z_speed
        if star->z<starfield->min_z then
            star->z+=starfield->max_z-starfield->min_z
            star->x=(100+300*sin(amplitude_angle))*sin(angle)+300*sin(horizontal_angle)
            star->y=(100+300*sin(amplitude_angle))*cos(angle)+300*sin(vertical_angle)
        end if
    next
    angle+=0.1
    amplitude_angle+=.086
    horizontal_angle+=.03
    vertical_angle+=0.043
end sub

sub draw_starfield(byval starfield as starfield pointer)
    dim as integer w=any,h=any
    screeninfo (w,h)
    for star_count as integer=0 to starfield->num_stars-1
        dim as star pointer star=@starfield->star_list[star_count]
        for p as single=0 to star->num_points-1
            dim as single x=(w shr 1)+w*(star->x+star->radius*sin(p*pi2/star->num_points))/star->z
            dim as single y=(h shr 1)-w*(star->y+star->radius*cos(p*pi2/star->num_points))/star->z
            pset (x,y),&hffffff
        next
    next
end sub

sub main
    screenres 640,480,32,2
    screenset 0,1
    dim as starfield ptr starfield=create_starfield(800,200,50,100000,10,100)
'dim as starfield ptr starfield=create_starfield(400,200,50,2000,10,60)
    for i as integer=0 to 1000
        process_starfield(starfield)
    next
    while inkey<>chr(27)
        process_starfield(starfield)
        draw_starfield(starfield)
        flip
        cls
    wend
end sub

main


[boogop]

Well,  tomorrow I can either fix a shop floor data collection app or mess around with this...wat do? lol the joys of 'padding the schedule'

[boogop]

Liking this a lot! What's this all about?

Code: [Select]

dim as integer w=any,h=any

[Stonemonkey]

The'any' thing just means the value in memory isnt set at the declaration.

When you declare variables in a function, the compiler writes the function to take enough memory off the stack to store all the variables within a function, that part takes the same amount of time regardless of how many variables/arrays there are.  So there's no advantage to declaring global variables over local variables in a function.

But when there's something like this in a function

Dim as integer a,b

Then the function initialises them to 0 which has to be written into the memory the variable occupies.
However, using

Dim as integer a=any,b=any

When you dont care what the value is (in the code above, screeninfo writes the screen dimensions into the variables) you can use'any' and it just leaves whatever garbage is in the memory location.

The compiler also shares memory locations between variables in different scopes (inside FOR/NEXT WHILE/WEND IF/THEN/ENDIF etc.) and you can see what's where using any, I wouldn't recommend relying on such a thing to share data between scopes though.

Code: [Select]

sub test
    scope
        dim as integer a=123,b=456
    end scope
   
    scope
        dim as integer x=any,y=any
        print "any:  "x;":";y
    end scope
   
    scope
        dim as integer s,t
        print s;":";t
    end scope
end sub

test
sleep
end

my use of it there won't have much impact but there are times with declaring arrays or allocating memory where it could have a larger impact but you have to be sure that you're not relying on any element within an array or chunk of memory being zero initially.

[boogop]

This is a surprisingly low level language for all its VB trappings. I used to make my living in vb6 but this sure ain't that

[Stonemonkey]

It's based on qbasic and I think you can still run qbasic code with some settings. It might depend how you code but I find it translates to c++ quite easily and writing in some assembly is pretty easy too.

[va!n]

any exceutebale / compiled version available?