3Din2D Box Formations

[Clyde]

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.

Code: [Select]

'
' 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.

[ninogenio]

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.

Code: [Select]

'
' 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


[Clyde]

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

[ninogenio]

right dude i fixed the formations for you.

Code: [Select]

'
' 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.

[Clyde]

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

[ninogenio]

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.

Code: [Select]

'
' 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


[ninogenio]

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.

Code: [Select]

'
' 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


[Clyde]

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.

[ninogenio]

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.

[Clyde]

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.

[ninogenio]

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.

[Clyde]

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.

[ninogenio]

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

[Clyde]

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

[ninogenio]

right clyde is this what you were after mate.

Code: [Select]

'
' 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

[Clyde]

Thats awesome of you mate, thankyou.

Cheers and all the very best,
Clyde.

[ninogenio]

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.

Code: [Select]

'
' 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


[Clyde]

Cheers dude! thanks so much for that.

More Karma and huge thanks,
Clyde.

[ninogenio]

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.

Code: [Select]

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


[Clyde]

Cheers again mate