Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: boogop on November 17, 2016
-
Dot tunnels gave me fits trying to figure out. So here's one for the lulz, maybe it will help (or hinder) someone else!
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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
-
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.
-
lol thanks! Freebasic is a new experience but I'm liking it a lot
-
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.
-
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
-
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.
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
-
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'
-
Liking this a lot! What's this all about?
dim as integer w=any,h=any
-
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.
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.
-
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
-
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.
-
any exceutebale / compiled version available?