Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Clyde on July 26, 2008
-
Hi all :)
Im trying to make a program that displays boxes as formations and using types to keep tabs on them, and that should move backwards in 3D; this will later form a basis for a text routine I hope to be able to achieve with this.
I am and wish to still do so, keep it simple with using the transformation method of the x and y postions divided by z and half the screen width / height.
TX=(x/z)+(XRES2) : TY=(y/z)+(YRES2)
But I am having a spot of bother from it, as you'll notice when running it, and have outlined below. If you havent got the tinyptc extension, the change the include to #include Once "tinyptc.bi" and comment out the SetDialog in initializeBoxes.
a) Is the 3D Calculation working correctly? As the displaying with size might be making it look as if it is.
b) It still only displays the first formation
c) The positioning is all wrong, and also makes the boxes go off at a funny angle towards 0.
Here's the code that I've tried to keep as simple as possible, and hopefully its understandable.
'
' 3Din2D Box Formations.
'
Option Static
Option Explicit
#Include Once "tinyptc_ext.bi"
#Include Once "Windows.bi"
Const XRES=640
Const YRES=480
Const XRES2=XRES/2
Const YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared ScreenBuffer(ARES)
Type Boxes
As Single x,y,z,sizex,sizey,alpha
As Integer tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum
Const MAXFORMATIONS=3
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal W As Integer, ByVal H As Integer, ByVal PosX As Integer, ByVal PosY As Integer, ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
Dim Create, NewBoxes, CenterX, PosX, Spacer
NewBoxes=NewBoxes+BoxFormations( FormationNum )
Spacer=2
CenterX=(XRES2)-((BoxFormations( FormationNum )*Spacer)/2)
PosX=CenterX
'
' Create A Box
'
For Create=0 to NewBoxes-1
'If Box( Create ).ID=1 Then
Box( Create ).x =PosX
Box( Create ).y =0
Box( Create ).z =130
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
TotalBoxes=TotalBoxes+1
PosX=PosX+Spacer
'End If
Next
'
' Increment BoxFormation Number.
'
FormationNum=FormationNum+1
If FormationNum>MAXFORMATIONS-1 Then FormationNum=0
End Sub
Sub DrawBox( ByVal W As Integer, ByVal H As Integer, ByVal PosX As Integer, ByVal PosY As Integer, ByVal Col As Integer=&HFFFFFF)
Dim x,y
For Y=0 to H-1
For X=0 to W-1
ScreenBuffer( (y+PosY)*XRES+(x+PosX))=Col
Next
Next
End Sub
Sub InitializeBoxes()
PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
BoxFormations(0)=5
BoxFormations(1)=2
BoxFormations(2)=3
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
Erase ScreenBuffer
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim Update,tx,ty,size
For Update=0 to TotalBoxes-1
If Box( Update ).ID=1 then
'
' Transform 3D into 2D Screen positions.
'
tx=( Box( Update ).x / Box( Update ).z)+XRES2
ty=( Box( Update ).y / Box( Update ).z)+YRES2
If tx>0 and tx<XRES-1 And ty>0 And ty<YRES-1 then
'
' Workout size of box.
'
Size=Cint( Box( Update ).z )
'
' Drawbox at tx and ty.
'
DrawBox( Size,Size,tx,ty, Box( Update ).Col )
'
' Update z speed.
'
Box( Update ).z=Box( Update ).z-.25
'If Box( Update ).z<=0 Then Box( Update ).z=130
'
' Create Next set of Box Formations.
'
If Box( Update ).z<10 Then
CreateBox()
End if
Else
'
' Destroy Box Formation.
'
Box( Update ).ID=0
TotalBoxes=TotalBoxes-1
EndIf
End If
Next
End Sub
Your help is very much appreciated, and thankyou in advance.
Cheers and many many thanks,
Clyde.
-
is this close to what you wanted? as im unsure what the final effect was that you were after you will have to mess around with positioning as i only spent five mins tinkering.
'
' 3Din2D Box Formations.
'
Option Static
Option Explicit
#Include Once "tinyptc.bi"
#Include Once "Windows.bi"
Const XRES=640
Const YRES=480
Const XRES2=XRES/2
Const YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared ScreenBuffer(ARES)
Type Boxes
As Double x,y,z,sizex,sizey,alpha
As Double tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum = 0
Const MAXFORMATIONS=3
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal W As Integer, ByVal H As Integer, ByVal PosX As Integer, ByVal PosY As Integer, ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
Dim as double Create, NewBoxes, CenterX, PosX, Spacer ,x
NewBoxes=BoxFormations( FormationNum )
totalboxes = 0
'
' Create A Box
'
For Create=0 to NewBoxes-1
Box( Create ).x =PosX-190
Box( Create ).y =0
Box( Create ).z =130
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
TotalBoxes=TotalBoxes+1
PosX+=100
Next
'
' Increment BoxFormation Number.
'
FormationNum=FormationNum+1
If FormationNum>MAXFORMATIONS-1 Then FormationNum=0
End Sub
Sub DrawBox( ByVal W As Integer, ByVal H As Integer, ByVal PosX As Integer, ByVal PosY As Integer, ByVal Col As Integer=&HFFFFFF)
Dim x,y
For Y=posy-h to posy+H-1
For X=posx-w to posx+W-1
ScreenBuffer( (y*XRES)+x)=Col
Next
Next
End Sub
Sub InitializeBoxes()
'PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
BoxFormations(0)=5
BoxFormations(1)=2
BoxFormations(2)=3
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
Erase ScreenBuffer
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim as double Update,tx,ty,size
update = 0
For Update=0 to TotalBoxes-1
If Box( Update ).ID=1 then
'
' Workout size of box.
'
Size=( Box( Update ).z )
DrawBox( Size,Size,xres2+box(update).x,yres2, Box( Update ).Col )
'
' Update z speed.
'
Box( Update ).z=Box( Update ).z-.25
'
' Create Next set of Box Formations.
'
If Box( Update ).z<10 Then
CreateBox()
End if
End If
Next
End Sub
-
Hiya, thanks for the quick tinkering dude.
What Im after achieving as this will form the basis for a Superman style scoller - im using boxes to test this all out with. where the boxes move through 3Din2D simple starfield math of TX=x/z+(XRES/2) And TY=y/z+(YRES/2). So when the boxes get to a certain position then the next lot of formations come on screen, with the ones allready there still moving until there unviewable ( and are destroyed ) once all the formations are finished it resets to the first one, and continues.
Cheers,
Clyde
-
right dude i fixed the formations for you.
'
' 3Din2D Box Formations.
'
Option Static
Option Explicit
#Include Once "tinyptc.bi"
#Include Once "Windows.bi"
Const XRES=640
Const YRES=480
Const XRES2=XRES/2
Const YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared ScreenBuffer(ARES)
Type Boxes
As Double x,y,z,sizex,sizey,alpha
As Double tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum = 0
Dim Shared As Integer NewBoxes
Const MAXFORMATIONS=3
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal W As Integer, ByVal H As Integer, ByVal PosX As Integer, ByVal PosY As Integer, ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
Dim as double Create, CenterX, PosX, Spacer ,x , OldTab
'If FormationNum > 0 Then
OldTab = NewBoxes'BoxFormations( FormationNum-1 )
'EndIf
NewBoxes+=BoxFormations( FormationNum )
'totalboxes = 0
'
' Create A Box
'
TotalBoxes = NewBoxes
For Create=OldTab to NewBoxes-1
Box( Create ).x =PosX-190
Box( Create ).y =TotalBoxes*10
Box( Create ).z =130
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
PosX+=100
Next
'
' Increment BoxFormation Number.
'
FormationNum += 1
If FormationNum>MAXFORMATIONS Then
FormationNum = 0
NewBoxes = 0
TotalBoxes = 0
EndIf
End Sub
Sub DrawBox( ByVal W As Integer, ByVal H As Integer, ByVal PosX As Integer, ByVal PosY As Integer, ByVal Col As Integer=&HFFFFFF)
Dim x,y
For Y=posy-h to posy+H-1
For X=posx-w to posx+W-1
ScreenBuffer( (y*XRES)+x)=Col
Next
Next
End Sub
Sub InitializeBoxes()
'PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
BoxFormations(0)=5
BoxFormations(1)=2
BoxFormations(2)=3
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
Erase ScreenBuffer
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim as double Update,tx,ty,size , flag = 0
update = 0
For Update=0 to TotalBoxes-1
If Box( Update ).ID=1 then
'
' Workout size of box.
'
Size=( Box( Update ).z )
DrawBox( Size,Size,xres2+box(update).x,yres2+Box(update).y, Box( Update ).Col )
'
' Update z speed.
'
Box( Update ).z=Box( Update ).z-.25
'
' Create Next set of Box Formations.
'
If Box( NewBoxes-1 ).z<30 Then
flag = 1
End if
End If
Next
if flag = 1 then CreateBox()
End Sub
im just working on the perspective if i have this right in my head you want the letters to scroll into the screen using a 3d perspective so they keep an even spacing as they move away from the eye.
-
Yeah that'll be terrific thankyou dude.
Just got in, and am trying out the new code.
Karma++
[edit] The formations need to wrap around back to the begining too.
Cheers,
Clyde :)
-
phew i think ive pretty much cracked it the reason the perspective looked weird was that the standard starfeild perspective works with stars coming towards the eye not away from it so i had to flip the sign on the z part of the perspective adding to it.while subtracting from the cube size i really hope this helps, the code is a bit of a jumble as i just dug around in what was already there.
'
' 3Din2D Box Formations.
'
Option Static
Option Explicit
#Include Once "tinyptc.bi"
#Include Once "Windows.bi"
Const XRES=640
Const YRES=480
Dim Shared As Double XRES2=XRES/2
Dim Shared As Double YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared ScreenBuffer(ARES)
Type Boxes
As Double x,y,z,size,alpha
As Double tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum = 0
Dim Shared As Integer NewBoxes
Const MAXFORMATIONS=3
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal PosZ , ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
Dim as double Create, CenterX, PosX, Spacer ,x , OldTab
'If FormationNum > 0 Then
OldTab = NewBoxes'BoxFormations( FormationNum-1 )
'EndIf
NewBoxes+=BoxFormations( FormationNum )
'totalboxes = 0
'
' Create A Box
'
TotalBoxes = NewBoxes
For Create=OldTab to NewBoxes-1
Box( Create ).x =-8000.0 + PosX
Box( Create ).y = 3500.0
Box( Create ).z = 25.0
Box( Create ).Size = 100.0
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
PosX+=6000
Next
'
' Increment BoxFormation Number.
'
FormationNum += 1
If FormationNum>MAXFORMATIONS Then
FormationNum = 0
NewBoxes = 0
EndIf
End Sub
Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal PosZ ,ByVal Col As Integer=&HFFFFFF)
Dim x,y
For Y=PosY to PosY+PosZ-1
For X=posx to posx+(PosZ/1.5)-1
if (x-4<0 or x+4>xres) or (y+4<0 or y-4>yres) then
else
ScreenBuffer( (y*XRES)+x)=Col
endif
Next
Next
End Sub
Sub InitializeBoxes()
'PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
BoxFormations(0)=5
BoxFormations(1)=2
BoxFormations(2)=3
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
Erase ScreenBuffer
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim as integer Update,X,Y,Z, flag = 0
For Update=0 to TotalBoxes-1
If Box( Update ).ID=1 then
if ( Box( Update ).Z > 1.0 ) then
X = ( Box( Update ).X \ Box( Update ).Z ) + XRES2
Y = ( Box( Update ).Y \ Box( Update ).Z ) + YRES2
DrawBox( X,Y,Box(Update).Size, Box( Update ).Col )
Endif
' Update z speed.
'
Box( Update ).z += .25
Box( Update ).Size -= .25
'
' Create Next set of Box Formations.
'
If Box( NewBoxes-1 ).Size<30 Then
flag = 1
End if
End If
Next
if flag = 1 then CreateBox()
End Sub
-
sorry clyde i wasnt transforming the size of the box to get fully a sense of 3d this is by far better looking ive also changed it to handle 100 formations which looks quite cool.
'
' 3Din2D Box Formations.
'
Option Static
Option Explicit
#Include Once "tinyptc.bi"
#Include Once "Windows.bi"
Const XRES=640
Const YRES=480
Dim Shared As Double XRES2=XRES/2
Dim Shared As Double YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared ScreenBuffer(ARES)
Type Boxes
As Double x,y,z,SizeX,SizeY,alpha
As Double tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum = 0
Dim Shared As Integer NewBoxes
Const MAXFORMATIONS=100
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal SizeX As Integer , ByVal SizeY As Integer , ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
Dim as double Create, CenterX, PosX, Spacer ,x , OldTab
If FormationNum>MAXFORMATIONS-1 Then
FormationNum = 0
NewBoxes = 0
EndIf
OldTab = NewBoxes
NewBoxes+=BoxFormations( FormationNum )
TotalBoxes = NewBoxes
For Create=OldTab to NewBoxes-1
Box( Create ).x =-8000.0 + PosX
Box( Create ).y = 3500.0
Box( Create ).z = 25.0
Box( Create ).SizeX = Box( Create ).X + 2500.0
Box( Create ).SizeY = Box( Create ).Y + 2500.0
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
PosX+=4000
Next
'
' Increment BoxFormation Number.
'
FormationNum += 1
End Sub
Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal SizeX As Integer , ByVal SizeY As Integer ,ByVal Col As Integer=&HFFFFFF)
Dim x,y
For Y=PosY to SizeY-1
For X=posx to SizeX-1
if (x-4<0 or x+4>xres) or (y+4<0 or y-4>yres) then
else
ScreenBuffer( (y*XRES)+x)=Col
endif
Next
Next
End Sub
Sub InitializeBoxes()
Dim X
'PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
For X = 0 To MAXFORMATIONS-1
BoxFormations(X)=1+(rnd(1)*4)
Next
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
Erase ScreenBuffer
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim as integer Update,X,Y,Lx,Ly, flag = 0
For Update=0 to TotalBoxes-1
If Box( Update ).ID=1 then
X = ( Box( Update ).X \ Box( Update ).Z ) + XRES2
Y = ( Box( Update ).Y \ Box( Update ).Z ) + YRES2
Lx = ( Box( Update ).SizeX \ Box( Update ).Z ) + XRES2
Ly = ( Box( Update ).SizeY \ Box( Update ).Z ) + YRES2
DrawBox( X,Y,Lx,Ly, Box( Update ).Col )
Box( Update ).Z += .9
If Box( NewBoxes-1 ).Z>200 Then
flag = 1
End if
End If
Next
if flag = 1 then CreateBox()
End Sub
-
Thanks dude thats ace, all I need do now is work out how to center the boxes as they come on. At the moment I think it's centering is based upon 5 boxes; however Im looking at having say about 12 or more boxes. Wonder if you could have a tinker with all that? Also it would look cool if larger formations were off screen.
Cheers and thanks a million,
Clyde.
-
yep no problem ill make it center no matter what size the formation is, when you say you think it would look cool if the bigger formations were off screen, you mean in the x dir dont you? where it takes a bit of z movement before the whole word becomes clear.
listen how are you for a texture routine cause if you would like i can create this whole text writer for you as an include and you could simply do a 3dprint "blah" call in your main part of your code? if that would be me taking over a bit though just say.
-
It'll be fun for me to do the text writter, as youve helped me considerably. Which I really appreciate dude.
If I get stuck with it, I'll ask you if it's possible for your texture routine etc?
Cheers,
Clyde.
-
cool im really happy your sticking with it mate!
so hows about my code are you comfortable with it or would you like me to slam some comments in there.
-
if you could make it center on any size of formations, and have longer ones on the x off screen, that would be cool. And yes please, add in some comments on the not so obvious ones. Also I dont know if that code makes the formations wrap / go back to the first one.
Cheers and thankyou dude,
Clyde.
-
nps dude,
that code does indeed make it go back to the first one or at least it should just change MAXFORMATIONS to 5 as quick test
-
Yeah mate it does reset back to the first, but it also resets all the other previous boxes on screen.
Looking forward to the next installment, cheers dude.
Thanks,
Clyde
-
right clyde is this what you were after mate.
'
' 3Din2D Box Formations.
'
Option Static
Option Explicit
#Include Once "tinyptc.bi"
#Include Once "Windows.bi"
Const XRES=640
Const YRES=480
Dim Shared As Double XRES2=XRES/2
Dim Shared As Double YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared ScreenBuffer(ARES)
Type Boxes
As Double x,y,z,SizeX,SizeY,alpha
As Double tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum = 0
Dim Shared As Integer NewBoxes
Const MAXFORMATIONS=5
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal SizeX As Integer , ByVal SizeY As Integer , ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
Dim as double Create, CenterX, PosX, Spacer ,x , OldTab , h
If FormationNum>MAXFORMATIONS-1 Then
FormationNum = 0
NewBoxes = 0
EndIf
OldTab = NewBoxes
NewBoxes+=BoxFormations( FormationNum )
TotalBoxes = NewBoxes
For Create=OldTab to NewBoxes-1
H = BoxFormations( FormationNum )/2
Box( Create ).x = PosX - (H*3000)
Box( Create ).y = 3000.0
Box( Create ).z = 25.0
Box( Create ).SizeX = Box( Create ).X + 2500.0
Box( Create ).SizeY = Box( Create ).Y + 2500.0
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
PosX+=3000
Next
'
' Increment BoxFormation Number.
'
FormationNum += 1
End Sub
Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal SizeX As Integer , ByVal SizeY As Integer ,ByVal Col As Integer=&HFFFFFF)
Dim x,y
For Y=PosY to SizeY-1
For X=posx to SizeX-1
if (x-4<0 or x+4>xres) or (y-4<0 or y+4>yres) then
else
ScreenBuffer( (y*XRES)+x)=Col
endif
Next
Next
End Sub
Sub InitializeBoxes()
Dim X
'PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
For X = 0 To MAXFORMATIONS-1
BoxFormations(X)=1+(rnd(1)*14)
Next
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
Erase ScreenBuffer
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim as Integer Update,X,Y,Lx,Ly, flag = 0
Dim As Double ReciP
For Update=0 to TotalBoxes-1
If Box( Update ).Z<1000 Then
Recip=1.0/(Box(Update).z/3.0)
X = ( Box( Update ).X * Recip ) + XRES2
Y = ( Box( Update ).Y * Recip ) + YRES2
Lx = ( Box( Update ).SizeX * Recip ) + XRES2
Ly = ( Box( Update ).SizeY * Recip ) + YRES2
DrawBox( X,Y,Lx,Ly, Box( Update ).Col )
EndIf
Box( Update ).Z += .9
If ( FormationNum < MAXFORMATIONS ) Then
If Box( NewBoxes-1 ).Z>400 Then
flag = 1
Endif
Else
If Box( NewBoxes-1 ).Z>1200 Then
flag = 1
Endif
EndIf
Next
if flag = 1 then CreateBox()
End Sub
ive still to put comments in i just thought id get it working right for you first though.
try it with a large number of formations like 100
-
Thats awesome of you mate, thankyou.
Cheers and all the very best,
Clyde.
-
great!
right here is the code with a load of comments and ive done quite a bit of optimizing so it runs a lot quicker.
'
' 3Din2D Box Formations.
'
' right clyde most of the top half of this code is yours so you should pretty much
' know whats its aboout ill comment where i think its needed
Option Static
Option Explicit
#Include Once "tinyptc.bi"
#Include Once "Windows.bi"
#Include Once "Crt.bi"
Const XRES=640
Const YRES=480
Dim Shared As Double XRES2=XRES/2
Dim Shared As Double YRES2=YRES/2
Const PI = 3.141593
Const D2R=(PI/180.00)
Const ARES=XRES*YRES
Dim Shared As Integer ScreenBuffer(ARES)
Type Boxes
' right this is pretty much the same but the variables now have slighty diffrent meaning
' x,y,z are pretty much as you would expect although z is purely used for perspective
'sizex and sizey are simply the outer two points on the box ie if x =100 sizex might be 150
As Double x,y,z,SizeX,SizeY,alpha
As Double tx,ty,ID,col
End Type
Const MAXBOXES=1000
Dim Shared Box( MAXBOXES ) As Boxes
Dim Shared TotalBoxes, FormationNum = 0
Dim Shared As Integer NewBoxes
Const MAXFORMATIONS=25
Dim Shared BoxFormations( MAXFORMATIONS )
Declare Sub CreateBox()
Declare Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal SizeX As Integer , ByVal SizeY As Integer , ByVal Col As Integer=&HFFFFFF)
Declare Sub InitializeBoxes()
Declare Sub RunBoxes()
Declare Sub UpdateBoxes()
' this is a new function i will explain further down but for now all it does is clip and cull the boxes
Declare Function AdjustBounderies( X As Integer , Y As Integer , Lx As Integer , Ly As Integer ) As Short
InitializeBoxes()
RunBoxes()
Ptc_Close()
Sub CreateBox()
' right mate ive changed this function quite a lot so ill try to explain as
' much as possible
Dim as double Create, CenterX, PosX, Spacer ,x , OldTab , h
' this simply flushes out the old formations when the last one is done
' it needs to be up here though so that the first formation can happen
' again
If FormationNum>MAXFORMATIONS-1 Then
FormationNum = 0
NewBoxes = 0
EndIf
' the oldtab variable always holds the top position of the last formation
' so that the old boxes dont get flushed when new ones are created
OldTab = NewBoxes
NewBoxes+=BoxFormations( FormationNum )
TotalBoxes = NewBoxes
' again the for loop will now go from the old formation number to the new one
' so that only the new ones will have new values
For Create=OldTab to NewBoxes-1
' the numbers here may look rather strange but there just scaled up
' dependent on the z value ie -3000 for x divided be a z value of 25 = -120
' now if you add half screenx res on you have 200 so what im saying is that
' you have to work in a certin rang dependent on the z that will keep you in
' screen space
' this h variable holds half the formation for centering
H = BoxFormations( FormationNum )/2
' now the on the x i take away half the formation amount and scale it
' by a proportionate factor to the spacing
Box( Create ).x = PosX - (H*3000)
Box( Create ).y = 3000.0
Box( Create ).z = 25.0
' now i just add a sclaed factor on to the x and y for size
Box( Create ).SizeX = Box( Create ).X + 2500.0
Box( Create ).SizeY = Box( Create ).Y + 2500.0
Box( Create ).ID =1
Box( Create ).Col =&HFFFFFF
PosX+=3000
Next
'
' Increment BoxFormation Number.
'
FormationNum += 1
End Sub
Sub DrawBox( ByVal PosX As Integer, ByVal PosY As Integer, ByVal SizeX As Integer , ByVal SizeY As Integer ,ByVal Col As Integer=&HFFFFFF)
' now ive totally rewriten this for speed so ill go through it
Dim x,y
Dim As Integer Ptr ScreenPt, ScreenPt2
' youse ptr1 as a ptr to the screenbuffer but
' also as a place holder to the starting position of the drawing
ScreenPt = @ScreenBuffer( (PosY*XRES)+PosX )
' now we want to go from 0 to box height so i have to do ((SizeY-1)-PosY) to bring it down
For Y=0 to ((SizeY-1)-PosY)
' i use ptr2 as ptr to the position on ptr1 and add on the current height each loop
ScreenPt2 = ScreenPt + Y*XRES
' now we want to go from 0 to box width so i have to do ((SizeX-1)-PosX) to bring it down
For X=0 to ((SizeX-1)-PosX)
' now in the tightest part of the loop instead of doing y*xres+x each time its just
' a simple ptr2+=1
*ScreenPt2=Col
ScreenPt2+=1
Next
Next
' im not very good at explaining things so if this doesnt make sense just fire some questions
' at me mate. but trust me this is a much quicker way of drawing.
End Sub
Sub InitializeBoxes()
Dim X
'PTC_SetDialog(0,"",0,0)
PTC_Open("Box Formations",XRES,YRES)
'
' Box Formations.
'
For X = 0 To MAXFORMATIONS-1
BoxFormations(X)=1+(rnd(1)*14)
Next
'
' Create A Box.
'
CreateBox()
End Sub
Sub RunBoxes()
Dim Key As String
While Key<>Chr(27)
UpdateBoxes()
PTC_Update @ScreenBuffer(0)
' ive replaced your erase buffer command with memset
' i see a lot of people use erase buffer but please please please use memset instead
MemSet(@ScreenBuffer(0),0,ARes*SizeOf(Integer))
Key=Inkey
Wend
End Sub
Sub UpdateBoxes()
Dim as Integer Update,X,Y,Lx,Ly, flag = 0
Dim As Double ReciP
For Update=0 to TotalBoxes-1
' the far clip distance
' change the 2000 to a higher value to have the boxes disapear
' further away or a lower value for closer
If ( Box( Update ).Z < 2000 ) Then
' use a reciprocal here to avoid for divides
' for each box which is much quicker the * 0.3 is another reciprocal
' which just makes the z smaller to increase the size of the boxes for asthetics
ReciP = 1.0 / ( Box( Update ).z * 0.3 )
' right here i do the normal starfeild perspective on x,y
X = ( Box( Update ).X * ReciP ) + XRES2
Y = ( Box( Update ).Y * ReciP ) + YRES2
' but it must also be done on the outer points of the box for the
' box to keep its shape and resize properly
Lx = ( Box( Update ).SizeX * ReciP ) + XRES2
Ly = ( Box( Update ).SizeY * ReciP ) + YRES2
' here i run my function before drawing the box
' my function either clips or culs the box depending on its position
' doing this before the draw routine is masivly quicker as only one
' test needs done for each box instead of one test per pixel drawn
If AdjustBounderies( X , Y , Lx , Ly ) Then
DrawBox( X , Y , Lx , Ly , Box( Update ).Col )
EndIf
EndIf
' update the z position by adding to it
Box( Update ).Z += 2
' here is a series of test to determin if and when a new formation
' gets created
If ( FormationNum < MAXFORMATIONS ) Then
' change the 700 to a lower value to have new formations
' created sooner or a higher value to have them later
If Box( NewBoxes-1 ).Z > 700 Then
' the flag variable gets set to signal that after this
' current for loop a new formation should be set
Flag = 1
Endif
Else
' change the 2300 to a higher value to have the reset in formations
' a little longer of lower for a little sooner
' i generaly would set this slightly higher than the far
' clip distance for a slight pause before the formations
' restart
If Box( NewBoxes-1 ).Z > 2300 Then
' the flag variable gets set to signal that after this
' current for loop a new formation should be set
Flag = 1
Endif
EndIf
Next
If Flag = 1 Then CreateBox()
End Sub
Function AdjustBounderies( ByRef X As Integer , ByRef Y As Integer , ByRef Lx As Integer , ByRef Ly As Integer ) As Short
' these are quite self explanitory
' they are just a series of test to determin
' if the box needs cliped to the left or right top or bottom
' or culled
If ( X > XRES ) Then
Return 0
EndIf
If ( Y > YRES ) Then
Return 0
EndIf
If ( Lx < 0 ) Then
Return 0
EndIf
If ( Ly < 0 ) Then
Return 0
EndIf
If ( X < 0 ) Then
X = 0
EndIf
If ( Lx > XRES ) Then
Lx = XRES
EndIf
If ( Y < 0 ) Then
Y = 0
EndIf
If ( Ly > YRES ) Then
Ly = YRES
EndIf
Return 1
End Function
-
Cheers dude! thanks so much for that.
More Karma and huge thanks,
Clyde.
-
cheers dude! im glad your happy with it,
listen i just noticed the last two functions in the code can be changed around a bit. mainly the formations test didnt have to be inside the for loop so i was burning up a bit of speed there.
Sub UpdateBoxes()
Dim as Integer Update,X,Y,Lx,Ly
Dim As Double ReciP
For Update=0 to TotalBoxes-1
' the far clip distance
' change the 2000 to a higher value to have the boxes disapear
' further away or a lower value for closer
If ( Box( Update ).Z < 2000 ) Then
' use a reciprocal here to avoid for divides
' for each box which is much quicker the * 0.3 is another reciprocal
' which just makes the z smaller to increase the size of the boxes for asthetics
ReciP = 1.0 / ( Box( Update ).z * 0.3 )
' right here i do the normal starfeild perspective on x,y
X = ( Box( Update ).X * ReciP ) + XRES2
Y = ( Box( Update ).Y * ReciP ) + YRES2
' but it must also be done on the outer points of the box for the
' box to keep its shape and resize properly
Lx = ( Box( Update ).SizeX * ReciP ) + XRES2
Ly = ( Box( Update ).SizeY * ReciP ) + YRES2
' here i run my function before drawing the box
' my function either clips or culs the box depending on its position
' doing this before the draw routine is masivly quicker as only one
' test needs done for each box instead of one test per pixel drawn
If AdjustBounderies( X , Y , Lx , Ly ) Then
DrawBox( X , Y , Lx , Ly , Box( Update ).Col )
EndIf
EndIf
' update the z position by adding to it
Box( Update ).Z += 2
Next
' here is a series of test to determin if and when a new formation
' gets created
If ( FormationNum < MAXFORMATIONS ) Then
' change the 700 to a lower value to have new formations
' created sooner or a higher value to have them later
If Box( NewBoxes-1 ).Z > 700 Then
' the CreateBox Function Gets called So new formation should be set
CreateBox()
Endif
Else
' change the 2300 to a higher value to have the reset in formations
' a little longer of lower for a little sooner
' i generaly would set this slightly higher than the far
' clip distance for a slight pause before the formations
' restart
If Box( NewBoxes-1 ).Z > 2300 Then
' the CreateBox Function Gets called So new formation should be set
CreateBox()
Endif
EndIf
End Sub
Function AdjustBounderies( ByRef X As Integer , ByRef Y As Integer , ByRef Lx As Integer , ByRef Ly As Integer ) As Short
' these are quite self explanitory
' they are just a series of test to determin
' if the box needs cliped to the left or right top or bottom
' or culled
If ( X > XRES ) Or ( Lx < 0 ) Then
Return 0
EndIf
If ( Y > YRES ) Or ( Ly < 0 ) Then
Return 0
EndIf
If ( X < 0 ) Then
X = 0
EndIf
If ( Lx > XRES ) Then
Lx = XRES
EndIf
If ( Y < 0 ) Then
Y = 0
EndIf
If ( Ly > YRES ) Then
Ly = YRES
EndIf
Return 1
End Function
-
Cheers again mate :)