[DBP] Fire Altar - GameCreators Forum

Author

Message

Azrael

19

Years of Service

User Offline

Joined: 2nd Mar 2005

Location: Germany

Posted: 19th Oct 2007 17:05

Link

Hi there!

I wrote this code for the endless competition in the german boards. I actually missed the topic "Candles" but I think this is showable though.

This little Demo does not need any external media. The Fire ( someone may remembers already

) and the scene have been calculated completely internally.

Sync on : Sync rate 0 : Sync
Set display mode 1024, 768, 32
Set text font "Tahoma"
Set camera range 1, 1000000
Color backdrop Rgb(104, 51, 016)
Autocam off : Position camera 0, 0, 50, 0

Type TVector3D
    X     As Float
    Y     As Float
    Z     As Float
Endtype

Type TVertex
    Pos   As TVector3D
    Nor   As TVector3D
    U     As Float
    V     As Float
Endtype

Gosub BuildScene
Gosub BuildFire

Make light 1
Color light 1, Rgb(255, 102, 032)
Position light 1, 0, 100, 0
Set ambient light 10
Color light 0, 0x111111

dist# = 840
xang# = 20

Do
    rem Textausgabe
    
    Ink 0, 0
    Box 0, 0, Screen width(), 30
    Box 0, screen height() - 30, Screen width(), screen height()
    Ink -1, -1
    
    Set cursor 0, 0
    Print "Polysgons: ", Statistic( 1 )
    Print "fps: ", Screen fps()
    Print dist#
    Print xang#
    Center text screen width()/2, Screen height() - 20, "Mesh & Fire Demonstration - no extarnal media needed"
    Text screen width() - 90, Screen height() - 20, "by Azrael 2007"
    Control camera using arrowkeys 0, 1, 1
    
    
    
    rem Animate Plane
    
    t = timer()
    Lock vertexdata for limb 14, 0
        For i = 0 To Get vertexdata vertex count()
            x# = Get vertexdata position x( i )
            y# = Get vertexdata position y( i )
            z# = Get vertexdata position z( i )
            Set vertexdata position i, x# + Sin( y#*5 + t*0.1)*0.03 , y#, z# + Sin( y#*5 + t*0.1)*0.03
        Next
    Unlock vertexdata
    
    
    Inc j : If j > 1000 Then j = 600
    Texture object 14, j
    
    rem Camera
    
    Inc yang#, mousemovex()
    Inc xang#, mousemovey()
    Inc dist#, mousemovez()
    Position camera 0, 0, 0
    Rotate camera xang#, yang#, 0
    Move camera -dist#
    
    
    
    Sync
Loop

BuildScene:
    
    Print "start to build objects.."
    Fastsync
    
    For o = 1 To 3
        
        Pyramide( o, 50, 70, 30, 10 )
        Lock vertexdata for limb o, 0
        For i = 0 To Get vertexdata vertex count()
            Set vertexdata position i, Cos(Get vertexdata position y( i )*10)*10 + Get vertexdata position x(i), Get vertexdata position y( i ), Sin(Get vertexdata position y( i )*10)*10 + Get vertexdata position z(i)
        Next blah
        Unlock vertexdata
        NormalizeObject( o )
        Yrotate object o, 120*o
    Next
    
    For o = 4 To 6
        
        Pyramide( o, 360, 10, 60, 10 )
        Lock vertexdata for limb o, 0
            For i = 0 To Get vertexdata vertex count()
                x# = Get vertexdata position x( i )
                y# = Get vertexdata position y( i )
                z# = Get vertexdata position z( i )
                Set vertexdata position i, (Cos(y#)*70 + x#)*Cos(y#*.25), y#, (Sin(y#)*70 + z#)*Cos(y#*.25)
        Next blah
        Unlock vertexdata
        NormalizeObject( o )
        Yrotate object o, 120*o
    Next
    
    For o = 7 To 9
        
        Pyramide( o, 360, 10, 60, 10 )
        Lock vertexdata for limb o, 0
            For i = 0 To Get vertexdata vertex count()
                x# = Get vertexdata position x( i )
                y# = Get vertexdata position y( i )
                z# = Get vertexdata position z( i )
                Set vertexdata position i, (Cos(y#)*70 + x#)*Cos(y#*.25), y#, (Sin(y#)*70 + z#)*Cos(y#*.25)
            Next blah
            Unlock vertexdata
        NormalizeObject( o )
        Yrotate object o, 120*o
        Xrotate object o, 180
    Next
    
    Make object box 10, 20, 2, 500 : Move object 10, 250
    Make object box 11, 20, 2, 500 : Yrotate object 11, 120 : Move object 11, 250
    Make object box 12, 20, 2, 500 : Yrotate object 12, 240 : Move object 12, 250
    
    
    Make object plain 13, 5000, 5000
    
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    
    Xrotate object 13, 90 : Fix object pivot 13
    Lock vertexdata for limb 13, 0
        For i = 0 To Get vertexdata vertex count()
            x# = Get vertexdata position x( i )
            y# = Get vertexdata position y( i )
            z# = Get vertexdata position z( i )
            If Sqrt(x#*x# + y#*y#) < 500
                z# = 0.0125*(Sqrt(x#*x# + y#*y#)-500)*(Sqrt(x#*x# + y#*y#)-500)
            Endif
            Set vertexdata position i, x#, y#, z#
        Next blah
    Unlock vertexdata
    
    NormalizeObject( 13 )
    
    Make object plain 14, 140, 200
        Make mesh from object 1, 14
        Add limb 14, 1, 1
        Rotate limb 14, 1, 0, 90, 0
        DivideObjectPolys( 14 )
        DivideObjectPolys( 14 )
        DivideObjectPolys( 14 )
        DivideObjectPolys( 14 )
        Set object light  14, 0
        Ghost object on   14, 2
        Disable object zwrite 14
        Set object cull   14, 0
        Position object 14, 0, 130, 0
        Delete mesh 1
    
    Cls
    Print "done"
    Fastsync
Return

BuildFire:
    Cls
    Print "calculate fire .."
    Fastsync
    
    
    #constant CDetail   1000
    
    Dim Palette( CDetail )                As dword
    Dim fbuffer( 256, 256 )               As dword
    
    Memblock As integer
    
    For y = 0 To 256
        For x = 0 To 256
            fbuffer( x, y ) = 0
        Next blah
    Next blah
    
    
    ptr = Make memory( 4 + 5*4 )
    
    *ptr = 5
    Inc ptr, 4 : *ptr = Rgb(000, 000, 000)
    Inc ptr, 4 : *ptr = Rgb(128, 000, 000)
    Inc ptr, 4 : *ptr = Rgb(255, 128, 000)
    Inc ptr, 4 : *ptr = Rgb(255, 128, 000)
    Inc ptr, 4 : *ptr = Rgb(255, 255, 128)
    
    CreateGradient( ptr - 5*4 )
    
    Memblock = FreeMemblock( )
    
    Make memblock Memblock, 64*256*4 + 12
    Write memblock dword Memblock, 0, 64
    Write memblock dword Memblock, 4, 256
    Write memblock dword Memblock, 8, 32
    
    k = 0
    
    
    For j = 0 To 100
        For i = 1 To 10
            
            For x = 24 To 40
                fbuffer( x, 250 ) = CDetail
            Next
            
            For y = 2 To 255
                For x = 2 To 63
                    fbuffer( x, y ) = (fbuffer( x + Rnd(1), y ) + fbuffer( x - Rnd(1), y ) + fbuffer( x, y + 1))*.33333
                    Write memblock dword Memblock, (y*64 + x)*4 + 12, Palette( fbuffer( x, y ))
                Next
            Next
            Inc k
            Make image from memblock k, Memblock
        Next
        
        If j mod 10 = 0
            Cls
            Print "calculate fire .."
            Print "progress: ", Int(j/1.0), "%"
            Fastsync
        Endif
        
    Next
    Cls
    Print "done"
    Fastsync
    
    
Return

Function Pyramide(o As Integer, Height As Float, Radius As Float, Rows As Integer, Columns As Integer)
    FVFSize    As Dword  = 32
    FVFFormat  As Dword  = 274
    ptr        As Dword  = 12
    
    StepValueRow As Float
    StepValueCol As Float
    StepValueRad As Float
    StepValueRow = 360.0/Columns
    StepValueCol = Height/Rows
    StepValueRad = Radius/Rows
    
    Make memblock 1, (Columns + Columns*Rows*2)*3*FVFSize + 12
    
    rem Erstelle Spitze
    
    For i = 0 To Columns - 1
        Write memblock float 1, ptr, 0
        Write memblock float 1, ptr + 4, Height
        Write memblock float 1, ptr + 8, 0
        Inc ptr, FVFSize
        Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad
        Write memblock float 1, ptr + 4, Height - StepValueCol
        Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad
        Inc ptr, FVFSize
        Write memblock float 1, ptr, Cos(StepValueRow*i)*StepValueRad
        Write memblock float 1, ptr + 4, Height - StepValueCol
        Write memblock float 1, ptr + 8, Sin(StepValueRow*i)*StepValueRad
        Inc ptr, FVFSize
    Next
    
    For j = 1 To Rows - 1
        For i = 0 To Columns - 1
            Write memblock float 1, ptr, Cos(StepValueRow*i)*StepValueRad*j
            Write memblock float 1, ptr + 4, Height - StepValueCol*j
            Write memblock float 1, ptr + 8, Sin(StepValueRow*i)*StepValueRad*j
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Write memblock float 1, ptr + 4, Height - StepValueCol*(j + 1)
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*i)*StepValueRad*(j + 1)
            Write memblock float 1, ptr + 4, Height - StepValueCol*(j + 1)
            Write memblock float 1, ptr + 8, Sin(StepValueRow*i)*StepValueRad*(j + 1)
            Inc ptr, FVFSize
            
            Write memblock float 1, ptr, Cos(StepValueRow*(i))*StepValueRad*j
            Write memblock float 1, ptr + 4, Height - StepValueCol*j
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i))*StepValueRad*j
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad*j
            Write memblock float 1, ptr + 4, Height - StepValueCol*j
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad*j
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Write memblock float 1, ptr + 4, Height - StepValueCol*(j + 1)
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Inc ptr, FVFSize
        Next
    Next
    
    
    Write memblock dword 1, 0, FVFFormat
    Write memblock dword 1, 4, FVFSize
    Write memblock dword 1, 8, (Columns + Columns*Rows*2)*3
    
    Make mesh from memblock 1, 1
    Make object o, 1, 0
    
    Delete memblock 1
    Delete mesh 1
    
Endfunction

Function NormalizeObject(o As Integer)
    
    x0 As Float
    y0 As Float
    z0 As Float
    
    x1 As Float
    y1 As Float
    z1 As Float
    
    x2 As Float
    y2 As Float
    z2 As Float
    
    j As Integer = 0
    
    
    Lock vertexdata for limb o, 0
        
        null = Make vector3(1)
        null = Make vector3(2)
        
        For i = 0 To Get vertexdata vertex count()/3 - 1
            x0 = Get vertexdata position x(j)
            y0 = Get vertexdata position y(j)
            z0 = Get vertexdata position z(j)
            Inc j
            x1 = Get vertexdata position x(j)
            y1 = Get vertexdata position y(j)
            z1 = Get vertexdata position z(j)
            Inc j
            x2 = Get vertexdata position x(j)
            y2 = Get vertexdata position y(j)
            z2 = Get vertexdata position z(j)
            Inc j
            
            Set vector3 1, x0 - x1, y0 - y1, z0 - z1
            Set vector3 2, x0 - x2, y0 - y2, z0 - z2
            Cross product vector3 1, 1, 2
            Normalize vector3 1, 1
            
            Set vertexdata normals j - 3, X vector3(1), Y vector3(1), Z vector3(1)
            Set vertexdata normals j - 2, X vector3(1), Y vector3(1), Z vector3(1)
            Set vertexdata normals j - 1, X vector3(1), Y vector3(1), Z vector3(1)
            
        Next
        
        null = Delete vector3(1)
        null = Delete vector3(2)
        
        Unlock vertexdata
    Endfunction

Function DivideObjectPolys( o As Integer )
    
    FVFFormat   As DWord
    FVFSize     As DWord
    Vertices    As DWord
    Polys       As DWord
    
    A           As TVertex
    B           As TVertex
    C           As TVertex
    
    AB          As TVector3D
    BC          As TVector3D
    AC          As TVector3D
    
    
    Mesh        As DWord
    MemblockS   As DWord
    MemblockD   As DWord
    
    Pos         As Integer = 12
    Pos2        As Integer = 12
    
    
    Mesh = FreeMesh( )
    MemblockS = FreeMemblock( )
    
    Make mesh from object Mesh, o : Make memblock from mesh MemblockS, Mesh : Delete mesh Mesh : Delete object o
    
    
    FVFFormat   = Memblock dword(MemblockS, 0)
    FVFSize     = Memblock dword(MemblockS, 4)
    Vertices    = Memblock dword(MemblockS, 8)
    Polys       = Vertices/3.0
    
    MemblockD = FreeMemblock( )
    
    Make memblock MemblockD, 12 + ( Get memblock size( MemblockS ) - 12 )*4
    Write memblock dword MemblockD, 0, FVFFormat
    Write memblock dword MemblockD, 4, FVFSize
    Write memblock dword MemblockD, 8, Vertices*4
    
    For i = 0 To Polys - 1
        
        
        A.Pos.X  = Memblock float(MemBlockS, Pos +  0)
        A.Pos.Y  = Memblock float(MemBlockS, Pos +  4)
        A.Pos.Z  = Memblock float(MemBlockS, Pos +  8)
        A.Nor.X  = Memblock float(MemBlockS, Pos + 12)
        A.Nor.Y  = Memblock float(MemBlockS, Pos + 16)
        A.Nor.Z  = Memblock float(MemBlockS, Pos + 20)
        A.U      = Memblock float(MemBlockS, Pos + FVFSize - 8)
        A.V      = Memblock float(MemBlockS, Pos + FVFSize - 4)
        Inc Pos, FVFSize
        B.Pos.X  = Memblock float(MemBlockS, Pos +  0)
        B.Pos.Y  = Memblock float(MemBlockS, Pos +  4)
        B.Pos.Z  = Memblock float(MemBlockS, Pos +  8)
        B.Nor.X  = Memblock float(MemBlockS, Pos + 12)
        B.Nor.Y  = Memblock float(MemBlockS, Pos + 16)
        B.Nor.Z  = Memblock float(MemBlockS, Pos + 20)
        B.U      = Memblock float(MemBlockS, Pos + FVFSize - 8)
        B.V      = Memblock float(MemBlockS, Pos + FVFSize - 4)
        Inc Pos, FVFSize
        C.Pos.X  = Memblock float(MemBlockS, Pos +  0)
        C.Pos.Y  = Memblock float(MemBlockS, Pos +  4)
        C.Pos.Z  = Memblock float(MemBlockS, Pos +  8)
        C.Nor.X  = Memblock float(MemBlockS, Pos + 12)
        C.Nor.Y  = Memblock float(MemBlockS, Pos + 16)
        C.Nor.Z  = Memblock float(MemBlockS, Pos + 20)
        C.U      = Memblock float(MemBlockS, Pos + FVFSize - 8)
        C.V      = Memblock float(MemBlockS, Pos + FVFSize - 4)
        Inc Pos, FVFSize
        
        AB.x = B.Pos.x - A.Pos.x : AB.y = B.Pos.y - A.Pos.y : AB.z = B.Pos.z - A.Pos.z
        BC.x = C.Pos.x - B.Pos.x : BC.y = C.Pos.y - B.Pos.y : BC.z = C.Pos.z - B.Pos.z
        AC.x = C.Pos.x - A.Pos.x : AC.y = C.Pos.y - A.Pos.y : AC.z = C.Pos.z - A.Pos.z
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, A.U
        Write memblock float MemblockD, Pos2 + FVFSize - 4, A.V
        Inc Pos2, FVFSize
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AC.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AB.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AB.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AB.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + B.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + B.V)*0.5
        Inc Pos2, FVFSize
        
        
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AB.x*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AB.y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AB.z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + B.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + B.V)*0.5
        Inc Pos2, FVFSize
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AC.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X + BC.X*.5
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y + BC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z + BC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (B.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (B.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, B.U
        Write memblock float MemblockD, Pos2 + FVFSize - 4, B.V
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AB.x*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AB.y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AB.z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + B.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + B.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X + BC.X*.5
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y + BC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z + BC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (B.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (B.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X + BC.X*.5
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y + BC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z + BC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (B.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (B.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AC.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, C.Pos.X
        Write memblock float MemblockD, Pos2 +  4, C.Pos.Y
        Write memblock float MemblockD, Pos2 +  8, C.Pos.Z
        Write memblock float MemblockD, Pos2 + 12, C.Nor.X
        Write memblock float MemblockD, Pos2 + 16, C.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, C.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, C.U
        Write memblock float MemblockD, Pos2 + FVFSize - 4, C.V
        Inc Pos2, FVFSize
        
        
    Next i
    
    Make mesh from memblock Mesh, MemblockD
    Make object o, Mesh, 0
    Delete mesh Mesh : Delete memblock MemblockS : Delete memblock MemblockD
    
Endfunction 1

Function CreateGradient( ptr As dword )
    
    dr As float
    dg As float
    db As float
    
    Cr As float
    Cg As float
    Cb As float
    
    pcr As float
    pcg As float
    pcb As float
    
    i As integer
    j As integer = 0
    
    Colors As Integer
    Colors = *ptr
    
    Inc ptr, 4
    
    For i = 1 To Colors - 1
        
        Cr = Rgbr( *ptr )
        Cg = Rgbg( *ptr )
        Cb = Rgbb( *ptr )
        
        Inc ptr, 4
        
        dr = Rgbr( *ptr ) - Cr
        dg = Rgbg( *ptr ) - Cg
        db = Rgbb( *ptr ) - Cb
        
        pcr = dr/CDetail*(Colors - 1)
        pcg = dg/CDetail*(Colors - 1)
        pcb = db/CDetail*(Colors - 1)
        
        Repeat
            
            Inc j
            
            Inc Cr, pcr
            Inc Cg, pcg
            Inc Cb, pcb
            
            Palette( j ) = Rgb( Int( Cr ), Int( Cg ), Int( Cb ))
            
        Until j >= CDetail/(Colors - 1)*i
        
    Next
Endfunction

Function FreeMesh( )
    mesh As integer
    Repeat
        mesh = Rnd( 32 ) + 1
    Until Not Mesh exist( mesh )
    Exitfunction  mesh
Endfunction 1

Function FreeMemblock( )
    mmblck As integer
    Repeat
        mmblck = Rnd( 32 ) + 1
    Until Not Memblock exist( mmblck )
    Exitfunction mmblck
Endfunction 1

+ Code Snippet

Sync on : Sync rate 0 : Sync
Set display mode 1024, 768, 32
Set text font "Tahoma"
Set camera range 1, 1000000
Color backdrop Rgb(104, 51, 016)
Autocam off : Position camera 0, 0, 50, 0


Type TVector3D
    X     As Float
    Y     As Float
    Z     As Float
Endtype

Type TVertex
    Pos   As TVector3D
    Nor   As TVector3D
    U     As Float
    V     As Float
Endtype

Gosub BuildScene
Gosub BuildFire

Make light 1
Color light 1, Rgb(255, 102, 032)
Position light 1, 0, 100, 0
Set ambient light 10
Color light 0, 0x111111

dist# = 840
xang# = 20

Do
    rem Textausgabe
    
    Ink 0, 0
    Box 0, 0, Screen width(), 30
    Box 0, screen height() - 30, Screen width(), screen height()
    Ink -1, -1
    
    Set cursor 0, 0
    Print "Polysgons: ", Statistic( 1 )
    Print "fps: ", Screen fps()
    Print dist#
    Print xang#
    Center text screen width()/2, Screen height() - 20, "Mesh & Fire Demonstration - no extarnal media needed"
    Text screen width() - 90, Screen height() - 20, "by Azrael 2007"
    Control camera using arrowkeys 0, 1, 1
    
    
    
    rem Animate Plane
    
    t = timer()
    Lock vertexdata for limb 14, 0
        For i = 0 To Get vertexdata vertex count()
            x# = Get vertexdata position x( i )
            y# = Get vertexdata position y( i )
            z# = Get vertexdata position z( i )
            Set vertexdata position i, x# + Sin( y#*5 + t*0.1)*0.03 , y#, z# + Sin( y#*5 + t*0.1)*0.03
        Next
    Unlock vertexdata
    
    
    Inc j : If j > 1000 Then j = 600
    Texture object 14, j
    
    rem Camera
    
    Inc yang#, mousemovex()
    Inc xang#, mousemovey()
    Inc dist#, mousemovez()
    Position camera 0, 0, 0
    Rotate camera xang#, yang#, 0
    Move camera -dist#
    
    
    
    Sync
Loop


BuildScene:
    
    Print "start to build objects.."
    Fastsync
    
    For o = 1 To 3
        
        Pyramide( o, 50, 70, 30, 10 )
        Lock vertexdata for limb o, 0
        For i = 0 To Get vertexdata vertex count()
            Set vertexdata position i, Cos(Get vertexdata position y( i )*10)*10 + Get vertexdata position x(i), Get vertexdata position y( i ), Sin(Get vertexdata position y( i )*10)*10 + Get vertexdata position z(i)
        Next blah
        Unlock vertexdata
        NormalizeObject( o )
        Yrotate object o, 120*o
    Next
    
    For o = 4 To 6
        
        Pyramide( o, 360, 10, 60, 10 )
        Lock vertexdata for limb o, 0
            For i = 0 To Get vertexdata vertex count()
                x# = Get vertexdata position x( i )
                y# = Get vertexdata position y( i )
                z# = Get vertexdata position z( i )
                Set vertexdata position i, (Cos(y#)*70 + x#)*Cos(y#*.25), y#, (Sin(y#)*70 + z#)*Cos(y#*.25)
        Next blah
        Unlock vertexdata
        NormalizeObject( o )
        Yrotate object o, 120*o
    Next
    
    For o = 7 To 9
        
        Pyramide( o, 360, 10, 60, 10 )
        Lock vertexdata for limb o, 0
            For i = 0 To Get vertexdata vertex count()
                x# = Get vertexdata position x( i )
                y# = Get vertexdata position y( i )
                z# = Get vertexdata position z( i )
                Set vertexdata position i, (Cos(y#)*70 + x#)*Cos(y#*.25), y#, (Sin(y#)*70 + z#)*Cos(y#*.25)
            Next blah
            Unlock vertexdata
        NormalizeObject( o )
        Yrotate object o, 120*o
        Xrotate object o, 180
    Next
    
    Make object box 10, 20, 2, 500 : Move object 10, 250
    Make object box 11, 20, 2, 500 : Yrotate object 11, 120 : Move object 11, 250
    Make object box 12, 20, 2, 500 : Yrotate object 12, 240 : Move object 12, 250
    
    
    Make object plain 13, 5000, 5000
    
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    DivideObjectPolys( 13 )
    
    Xrotate object 13, 90 : Fix object pivot 13
    Lock vertexdata for limb 13, 0
        For i = 0 To Get vertexdata vertex count()
            x# = Get vertexdata position x( i )
            y# = Get vertexdata position y( i )
            z# = Get vertexdata position z( i )
            If Sqrt(x#*x# + y#*y#) < 500
                z# = 0.0125*(Sqrt(x#*x# + y#*y#)-500)*(Sqrt(x#*x# + y#*y#)-500)
            Endif
            Set vertexdata position i, x#, y#, z#
        Next blah
    Unlock vertexdata
    
    NormalizeObject( 13 )
    
    Make object plain 14, 140, 200
        Make mesh from object 1, 14
        Add limb 14, 1, 1
        Rotate limb 14, 1, 0, 90, 0
        DivideObjectPolys( 14 )
        DivideObjectPolys( 14 )
        DivideObjectPolys( 14 )
        DivideObjectPolys( 14 )
        Set object light  14, 0
        Ghost object on   14, 2
        Disable object zwrite 14
        Set object cull   14, 0
        Position object 14, 0, 130, 0
        Delete mesh 1
    
    Cls
    Print "done"
    Fastsync
Return

BuildFire:
    Cls
    Print "calculate fire .."
    Fastsync
    
    
    #constant CDetail   1000
    
    Dim Palette( CDetail )                As dword
    Dim fbuffer( 256, 256 )               As dword
    
    Memblock As integer
    
    For y = 0 To 256
        For x = 0 To 256
            fbuffer( x, y ) = 0
        Next blah
    Next blah
    
    
    ptr = Make memory( 4 + 5*4 )
    
    *ptr = 5
    Inc ptr, 4 : *ptr = Rgb(000, 000, 000)
    Inc ptr, 4 : *ptr = Rgb(128, 000, 000)
    Inc ptr, 4 : *ptr = Rgb(255, 128, 000)
    Inc ptr, 4 : *ptr = Rgb(255, 128, 000)
    Inc ptr, 4 : *ptr = Rgb(255, 255, 128)
    
    CreateGradient( ptr - 5*4 )
    
    Memblock = FreeMemblock( )
    
    Make memblock Memblock, 64*256*4 + 12
    Write memblock dword Memblock, 0, 64
    Write memblock dword Memblock, 4, 256
    Write memblock dword Memblock, 8, 32
    
    k = 0
    
    
    For j = 0 To 100
        For i = 1 To 10
            
            For x = 24 To 40
                fbuffer( x, 250 ) = CDetail
            Next
            
            For y = 2 To 255
                For x = 2 To 63
                    fbuffer( x, y ) = (fbuffer( x + Rnd(1), y ) + fbuffer( x - Rnd(1), y ) + fbuffer( x, y + 1))*.33333
                    Write memblock dword Memblock, (y*64 + x)*4 + 12, Palette( fbuffer( x, y ))
                Next
            Next
            Inc k
            Make image from memblock k, Memblock
        Next
        
        If j mod 10 = 0
            Cls
            Print "calculate fire .."
            Print "progress: ", Int(j/1.0), "%"
            Fastsync
        Endif
        
    Next
    Cls
    Print "done"
    Fastsync
    
    
Return



Function Pyramide(o As Integer, Height As Float, Radius As Float, Rows As Integer, Columns As Integer)
    FVFSize    As Dword  = 32
    FVFFormat  As Dword  = 274
    ptr        As Dword  = 12
    
    StepValueRow As Float
    StepValueCol As Float
    StepValueRad As Float
    StepValueRow = 360.0/Columns
    StepValueCol = Height/Rows
    StepValueRad = Radius/Rows
    
    Make memblock 1, (Columns + Columns*Rows*2)*3*FVFSize + 12
    
    rem Erstelle Spitze
    
    For i = 0 To Columns - 1
        Write memblock float 1, ptr, 0
        Write memblock float 1, ptr + 4, Height
        Write memblock float 1, ptr + 8, 0
        Inc ptr, FVFSize
        Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad
        Write memblock float 1, ptr + 4, Height - StepValueCol
        Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad
        Inc ptr, FVFSize
        Write memblock float 1, ptr, Cos(StepValueRow*i)*StepValueRad
        Write memblock float 1, ptr + 4, Height - StepValueCol
        Write memblock float 1, ptr + 8, Sin(StepValueRow*i)*StepValueRad
        Inc ptr, FVFSize
    Next
    
    For j = 1 To Rows - 1
        For i = 0 To Columns - 1
            Write memblock float 1, ptr, Cos(StepValueRow*i)*StepValueRad*j
            Write memblock float 1, ptr + 4, Height - StepValueCol*j
            Write memblock float 1, ptr + 8, Sin(StepValueRow*i)*StepValueRad*j
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Write memblock float 1, ptr + 4, Height - StepValueCol*(j + 1)
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*i)*StepValueRad*(j + 1)
            Write memblock float 1, ptr + 4, Height - StepValueCol*(j + 1)
            Write memblock float 1, ptr + 8, Sin(StepValueRow*i)*StepValueRad*(j + 1)
            Inc ptr, FVFSize
            
            Write memblock float 1, ptr, Cos(StepValueRow*(i))*StepValueRad*j
            Write memblock float 1, ptr + 4, Height - StepValueCol*j
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i))*StepValueRad*j
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad*j
            Write memblock float 1, ptr + 4, Height - StepValueCol*j
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad*j
            Inc ptr, FVFSize
            Write memblock float 1, ptr, Cos(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Write memblock float 1, ptr + 4, Height - StepValueCol*(j + 1)
            Write memblock float 1, ptr + 8, Sin(StepValueRow*(i + 1))*StepValueRad*(j + 1)
            Inc ptr, FVFSize
        Next
    Next
    
    
    Write memblock dword 1, 0, FVFFormat
    Write memblock dword 1, 4, FVFSize
    Write memblock dword 1, 8, (Columns + Columns*Rows*2)*3
    
    Make mesh from memblock 1, 1
    Make object o, 1, 0
    
    Delete memblock 1
    Delete mesh 1
    
Endfunction


Function NormalizeObject(o As Integer)
    
    x0 As Float
    y0 As Float
    z0 As Float
    
    x1 As Float
    y1 As Float
    z1 As Float
    
    x2 As Float
    y2 As Float
    z2 As Float
    
    j As Integer = 0
    
    
    Lock vertexdata for limb o, 0
        
        null = Make vector3(1)
        null = Make vector3(2)
        
        For i = 0 To Get vertexdata vertex count()/3 - 1
            x0 = Get vertexdata position x(j)
            y0 = Get vertexdata position y(j)
            z0 = Get vertexdata position z(j)
            Inc j
            x1 = Get vertexdata position x(j)
            y1 = Get vertexdata position y(j)
            z1 = Get vertexdata position z(j)
            Inc j
            x2 = Get vertexdata position x(j)
            y2 = Get vertexdata position y(j)
            z2 = Get vertexdata position z(j)
            Inc j
            
            Set vector3 1, x0 - x1, y0 - y1, z0 - z1
            Set vector3 2, x0 - x2, y0 - y2, z0 - z2
            Cross product vector3 1, 1, 2
            Normalize vector3 1, 1
            
            Set vertexdata normals j - 3, X vector3(1), Y vector3(1), Z vector3(1)
            Set vertexdata normals j - 2, X vector3(1), Y vector3(1), Z vector3(1)
            Set vertexdata normals j - 1, X vector3(1), Y vector3(1), Z vector3(1)
            
        Next
        
        null = Delete vector3(1)
        null = Delete vector3(2)
        
        Unlock vertexdata
    Endfunction

Function DivideObjectPolys( o As Integer )
    
    FVFFormat   As DWord
    FVFSize     As DWord
    Vertices    As DWord
    Polys       As DWord
    
    A           As TVertex
    B           As TVertex
    C           As TVertex
    
    AB          As TVector3D
    BC          As TVector3D
    AC          As TVector3D
    
    
    Mesh        As DWord
    MemblockS   As DWord
    MemblockD   As DWord
    
    Pos         As Integer = 12
    Pos2        As Integer = 12
    
    
    Mesh = FreeMesh( )
    MemblockS = FreeMemblock( )
    
    Make mesh from object Mesh, o : Make memblock from mesh MemblockS, Mesh : Delete mesh Mesh : Delete object o
    
    
    FVFFormat   = Memblock dword(MemblockS, 0)
    FVFSize     = Memblock dword(MemblockS, 4)
    Vertices    = Memblock dword(MemblockS, 8)
    Polys       = Vertices/3.0
    
    MemblockD = FreeMemblock( )
    
    Make memblock MemblockD, 12 + ( Get memblock size( MemblockS ) - 12 )*4
    Write memblock dword MemblockD, 0, FVFFormat
    Write memblock dword MemblockD, 4, FVFSize
    Write memblock dword MemblockD, 8, Vertices*4
    
    For i = 0 To Polys - 1
        
        
        A.Pos.X  = Memblock float(MemBlockS, Pos +  0)
        A.Pos.Y  = Memblock float(MemBlockS, Pos +  4)
        A.Pos.Z  = Memblock float(MemBlockS, Pos +  8)
        A.Nor.X  = Memblock float(MemBlockS, Pos + 12)
        A.Nor.Y  = Memblock float(MemBlockS, Pos + 16)
        A.Nor.Z  = Memblock float(MemBlockS, Pos + 20)
        A.U      = Memblock float(MemBlockS, Pos + FVFSize - 8)
        A.V      = Memblock float(MemBlockS, Pos + FVFSize - 4)
        Inc Pos, FVFSize
        B.Pos.X  = Memblock float(MemBlockS, Pos +  0)
        B.Pos.Y  = Memblock float(MemBlockS, Pos +  4)
        B.Pos.Z  = Memblock float(MemBlockS, Pos +  8)
        B.Nor.X  = Memblock float(MemBlockS, Pos + 12)
        B.Nor.Y  = Memblock float(MemBlockS, Pos + 16)
        B.Nor.Z  = Memblock float(MemBlockS, Pos + 20)
        B.U      = Memblock float(MemBlockS, Pos + FVFSize - 8)
        B.V      = Memblock float(MemBlockS, Pos + FVFSize - 4)
        Inc Pos, FVFSize
        C.Pos.X  = Memblock float(MemBlockS, Pos +  0)
        C.Pos.Y  = Memblock float(MemBlockS, Pos +  4)
        C.Pos.Z  = Memblock float(MemBlockS, Pos +  8)
        C.Nor.X  = Memblock float(MemBlockS, Pos + 12)
        C.Nor.Y  = Memblock float(MemBlockS, Pos + 16)
        C.Nor.Z  = Memblock float(MemBlockS, Pos + 20)
        C.U      = Memblock float(MemBlockS, Pos + FVFSize - 8)
        C.V      = Memblock float(MemBlockS, Pos + FVFSize - 4)
        Inc Pos, FVFSize
        
        AB.x = B.Pos.x - A.Pos.x : AB.y = B.Pos.y - A.Pos.y : AB.z = B.Pos.z - A.Pos.z
        BC.x = C.Pos.x - B.Pos.x : BC.y = C.Pos.y - B.Pos.y : BC.z = C.Pos.z - B.Pos.z
        AC.x = C.Pos.x - A.Pos.x : AC.y = C.Pos.y - A.Pos.y : AC.z = C.Pos.z - A.Pos.z
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, A.U
        Write memblock float MemblockD, Pos2 + FVFSize - 4, A.V
        Inc Pos2, FVFSize
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AC.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AB.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AB.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AB.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + B.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + B.V)*0.5
        Inc Pos2, FVFSize
        
        
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AB.x*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AB.y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AB.z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + B.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + B.V)*0.5
        Inc Pos2, FVFSize
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AC.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X + BC.X*.5
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y + BC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z + BC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (B.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (B.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, B.U
        Write memblock float MemblockD, Pos2 + FVFSize - 4, B.V
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AB.x*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AB.y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AB.z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + B.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + B.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X + BC.X*.5
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y + BC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z + BC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (B.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (B.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        
        
        
        Write memblock float MemblockD, Pos2 +  0, B.Pos.X + BC.X*.5
        Write memblock float MemblockD, Pos2 +  4, B.Pos.Y + BC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, B.Pos.Z + BC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, B.Nor.X
        Write memblock float MemblockD, Pos2 + 16, B.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, B.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (B.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (B.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, A.Pos.X + AC.X*.5
        Write memblock float MemblockD, Pos2 +  4, A.Pos.Y + AC.Y*.5
        Write memblock float MemblockD, Pos2 +  8, A.Pos.Z + AC.Z*.5
        Write memblock float MemblockD, Pos2 + 12, A.Nor.X
        Write memblock float MemblockD, Pos2 + 16, A.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, A.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, (A.U + C.U)*0.5
        Write memblock float MemblockD, Pos2 + FVFSize - 4, (A.V + C.V)*0.5
        Inc Pos2, FVFSize
        
        
        Write memblock float MemblockD, Pos2 +  0, C.Pos.X
        Write memblock float MemblockD, Pos2 +  4, C.Pos.Y
        Write memblock float MemblockD, Pos2 +  8, C.Pos.Z
        Write memblock float MemblockD, Pos2 + 12, C.Nor.X
        Write memblock float MemblockD, Pos2 + 16, C.Nor.Y
        Write memblock float MemblockD, Pos2 + 20, C.Nor.Z
        Write memblock float MemblockD, Pos2 + FVFSize - 8, C.U
        Write memblock float MemblockD, Pos2 + FVFSize - 4, C.V
        Inc Pos2, FVFSize
        
        
    Next i
    
    Make mesh from memblock Mesh, MemblockD
    Make object o, Mesh, 0
    Delete mesh Mesh : Delete memblock MemblockS : Delete memblock MemblockD
    
Endfunction 1

Function CreateGradient( ptr As dword )
    
    dr As float
    dg As float
    db As float
    
    Cr As float
    Cg As float
    Cb As float
    
    pcr As float
    pcg As float
    pcb As float
    
    i As integer
    j As integer = 0
    
    Colors As Integer
    Colors = *ptr
    
    Inc ptr, 4
    
    For i = 1 To Colors - 1
        
        Cr = Rgbr( *ptr )
        Cg = Rgbg( *ptr )
        Cb = Rgbb( *ptr )
        
        Inc ptr, 4
        
        dr = Rgbr( *ptr ) - Cr
        dg = Rgbg( *ptr ) - Cg
        db = Rgbb( *ptr ) - Cb
        
        pcr = dr/CDetail*(Colors - 1)
        pcg = dg/CDetail*(Colors - 1)
        pcb = db/CDetail*(Colors - 1)
        
        Repeat
            
            Inc j
            
            Inc Cr, pcr
            Inc Cg, pcg
            Inc Cb, pcb
            
            Palette( j ) = Rgb( Int( Cr ), Int( Cg ), Int( Cb ))
            
        Until j >= CDetail/(Colors - 1)*i
        
    Next
Endfunction

Function FreeMesh( )
    mesh As integer
    Repeat
        mesh = Rnd( 32 ) + 1
    Until Not Mesh exist( mesh )
    Exitfunction  mesh
Endfunction 1

Function FreeMemblock( )
    mmblck As integer
    Repeat
        mmblck = Rnd( 32 ) + 1
    Until Not Memblock exist( mmblck )
    Exitfunction mmblck
Endfunction 1

Here' a screenshot:
http://xbasix.xb.ohost.de/codes.php?code=firealtar&img=yes

Have fun.

Back to top

Profile PM Email Website

Silicon Zombie

17

Years of Service

User Offline

Joined: 7th Oct 2007

Location: UK

Posted: 20th Oct 2007 12:45

Link

Really nice effect youve made, thanks for sharing it with us, Ive learnt abit from your code too!

Thanks again.

Back to top

Profile PM

Azrael

19

Years of Service

User Offline

Joined: 2nd Mar 2005

Location: Germany

Posted: 20th Oct 2007 21:42

Link

>>Really nice effect youve made, thanks for sharing it with us, Ive learnt abit from your code too!<<

Thank you

I'm happy to see that people can learn from it and may use it in their own projects.

I hope there are no compiling issues.

Any other comments?

xbasix - fb & db

Back to top

Profile PM Email Website

calcyman

17

Years of Service

User Offline

Joined: 31st Aug 2007

Location: The Uncertainty Principle

Posted: 27th Oct 2007 23:03

Link

I'm amazed that you can do it with no media - There's a very high poly count though!

Your signature has been erased by a hyper-intelligent pan-dimensional being (a mod)

Back to top

Profile PM Email

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 27th Oct 2007 23:55

Link

I'm very impressed by your effects, meshes, and coding style! Well done mate

"It's like floating a boat on a liquid that I don't know, but I'm quite happy to drink it if I'm thirsty enough" - Me being a good programmer but sucking at computers

Back to top

Profile PM Email

Sorry your browser is not supported!

Code Snippets / [DBP] Fire Altar