AppTitle "Procedural Saturn 3.0"

Graphics3D 800,600,32,2

Dim P%(512),GRAYD#(512),HeightMap#(0,0),NoiseMap#(0,0)
Global minh#=2^16,Maxh#

Global density%[1024],ringcolor%[1024]

Global quadparticles%,spritetex%,spritebuf%,pixelparticles%

Type star
    
    Field col%
    Field scale#
    Field x#,y#,z#
    Field visible%
    
End Type

Const SCALEX#        = 2.00    ; starfield scale X
Const SCALEY#        = 0.25    ; starfield scale Y
Const SCALEZ#        = 2.00    ; starfield scale Z
Const MAXSTARS%        = 50000 ; maximum asteroids
Const TurnSpeed#    = 4.00    ; cam turn speed
Const RollSpeed#    = 0.50    ; cam roll speed
Const CameraSpeed#    = 0.01    ; cam move speed
Const SEED_PLANET1%    = 8        ; seed for procedural planet texture
Const SEED_PLANET2%    = 8        ; seed for procedural planet texture
Const SEED_RING1%    = 6        ; seed for procedural ring texture
Const SEED_RING2%    = 6        ; seed for procedural ring texture
Const SCALE#        = 100.0    ; planet scale
Const SEGMENTS%        = 32    ; sphere detail
Const RINGDETAIL%    = 360    ; ring segments
Const GLOWSEGMENTS%    = 360    ; glow segments
Const MINRINGRAD#    = 0.7    ; minimum ring radius
Const MAXRINGRAD#    = 3.0    ; maximum ring radius
Const PR%            = 255    ; planet colors RED
Const PG%            = 192    ; planet colors GREEN
Const PB%            = 128    ; planet colors BLUE

Global WIDTH%=GraphicsWidth()
Global HEIGHT%=GraphicsHeight()
Global TIMER%=CreateTimer(60)

Global CAM%,PLANET%,PLANETTEX%,RING%,LIGHT,GLOW%,SHADER%
Global RINGTEX%,ICETEX1%,ICETEX2%,ICETEX3%,SHADOWTEX%

InitNoise(1.0)

; Planet
PLANET=CreateSphere(SEGMENTS)
ScaleEntity PLANET,SCALE,SCALE,SCALE
EntityShininess PLANET,0.1
EntityFX PLANET,2
UpdateVertexColors(PLANET,PR,PG,PB,1)
PLANETTEX=CreateRingTexture(256,SEED_PLANET1,SEED_PLANET2,1,False,"soft",1.0,1.0)
TextureBlend PLANETTEX,2
RotateTexture PLANETTEX,90
EntityTexture PLANET,PLANETTEX

; Planet Atmosphere
GLOW=CreateGlow(0.99*SCALE,1.1*SCALE,GLOWSEGMENTS,1+2+32,3,PR,PG,PB,0.5,0,0,0,0)

; Planet Fake Shader
SHADER=CreateFakeShader(SEGMENTS,SCALE,PR,PG,PB,0.6)

; Ring System
CreateSaturnRing(512,50000,1+8,"normal","normal",0.95,0.75,"perlin")

; Light source
LIGHT=CreateLight(1)
RotateEntity LIGHT,0,-90,0
AmbientLight 0,0,0

; Camera
CAM=CreateCamera()
CameraRange CAM,0.0001*SCALE,1000*SCALE
MoveEntity CAM,-1*SCALE,1.0/64*SCALE,-2*SCALE
PointEntity CAM,PLANET

; star quad
Global star=CreateQuad()
HideEntity star

; starfield mesh
Global starfield=CreateMesh()
Global surf=CreateSurface(starfield)
EntityTexture starfield,CreateStarTexture(256,4)
EntityFX starfield,1+2+32
EntityBlend starfield,3
EntityOrder starfield,-1

; fill star field
AddStars(MAXSTARS,0.005,0.01)

; static camera sprite (far away particles)
Global sprite=CreateSprite(CAM)
ScaleSprite sprite,WIDTH,HEIGHT
PositionEntity sprite,0,0,WIDTH
EntityColor sprite,255,255,255
EntityBlend sprite,3
EntityOrder sprite,-1

; Milkyway background
;Include "milkyway.bb" : Global MILKYWAY%=InitMilkyway(5000,0.5,5,90,1,0,0,0,1,255,192,255,1,0,0,0,1)

MoveMouse WIDTH/2,HEIGHT/2

;===========================================================================
; main loop
;===========================================================================
While Not KeyHit(1)
    
    Local multi%=1,l#=5.0,wf%,sl1%,sl2%,sl3%,sl4%,zoom#=1.0,d#,tmp%,ds%,dc%
    
    ; SHIFT or RMB = 50x faster cam flight
    If KeyDown(42) Or KeyDown(54) Or MouseDown(2) Then multi=50
    
    ; SPACE = Wireframe
    If KeyHit(57) Then wf=1-wf : WireFrame wf
    
    ; KEYS 1-4 = show/hide special planet FX
    If KeyHit(2) Then sl1=1-sl1 : If sl1=1 Then HideEntity RING Else ShowEntity RING
    If KeyHit(3) Then sl2=1-sl2 : If sl2=1 Then HideEntity GLOW Else ShowEntity GLOW
    If KeyHit(4) Then sl3=1-sl3 : If sl3=1 Then HideEntity SHADER Else ShowEntity SHADER
    If KeyHit(5) Then sl4=1-sl4 : If sl4=1 Then HideEntity sprite Else ShowEntity sprite
    
    ; LMB = Ultra Zoom 100x
    If MouseDown(1) Then zoom=100.0 : l=500.0
    
    ; camera movement
    Movement(CAM)
    CameraZoom CAM,zoom
    
    If MILKYWAY Then PositionEntity MILKYWAY,EntityX(CAM),EntityY(CAM),EntityZ(CAM)
    
    ; update atmosphere glow according to camera
    UpdateGlow(GLOW,CAM)
    
    ; calc ring density
    d#=EntityDistance(CAM,PLANET)
    If d>SCALE*MINRINGRAD And d<SCALE*MAXRINGRAD Then
        tmp=Normalize(d,SCALE*MINRINGRAD,SCALE*MAXRINGRAD,0,512)
        ds=Int(density[tmp])
        dc=Int(ringcolor[tmp])
    EndIf
    
    ; update asteroids
    UpdateStarfield(CAM,2,1,ds,dc)
    
    ; Update Saturn Ring Alpha
    UpdateVertexColors(RING,255,255,255,1.0-(1.0/Exp(Abs(EntityY(CAM)*0.5))))
    
    RenderWorld
    
    WaitTimer TIMER
    
    ; show some stats in the app title
    AppTitle quadparticles+" Quads [and "+pixelparticles+" Pixel Particles] | " + (ds/2.55)+"% RING density | "+TrisRendered()+" Tris"
    
    Flip 0
    
Wend

End


; -----------------------------------------------------------------------------
; simple spaceship freeflight
; -----------------------------------------------------------------------------
Function Movement(cam%,sensitivity#=1.0)
    
    Local roll#,cz#,tx#,ty#,multi%=1
    
    cz=(KeyDown(200)-KeyDown(208))*CameraSpeed
    roll=(KeyDown(203)-KeyDown(205))*RollSpeed
    If KeyDown(42) Or KeyDown(54) Or MouseDown(2) Then multi=25
    
    tx=Normalize(MouseX(),0,WIDTH , 1,-1)
    ty=Normalize(MouseY(),0,HEIGHT,-1, 1)
    
    If ty<0 Then ty=(Abs(ty)^sensitivity)*-1 Else ty=ty^sensitivity
    If tx<0 Then tx=(Abs(tx)^sensitivity)*-1 Else tx=tx^sensitivity
    
    TurnEntity cam,ty*TurnSpeed,tx*TurnSpeed,roll*TurnSpeed
    MoveEntity cam,0,0,cz*multi
    
End Function


; -----------------------------------------------------------------------------
; create a quad
; -----------------------------------------------------------------------------
Function CreateQuad(r%=255,g%=255,b%=255,a#=1.0)
    
    Local mesh%,surf%,v1%,v2%,v3%,v4%
    
    mesh=CreateMesh()
    surf=CreateSurface(mesh)
    
    v1=AddVertex(surf,-1,1,0,1,0)
    v2=AddVertex(surf,1,1,0,0,0)
    v3=AddVertex(surf,-1,-1,0,1,1)
    v4=AddVertex(surf,1,-1,0,0,1)
    
    VertexColor surf,v1,r,g,b,a
    VertexColor surf,v3,r,g,b,a
    VertexColor surf,v2,r,g,b,a
    VertexColor surf,v4,r,g,b,a
    
    AddTriangle(surf,0,1,2)
    AddTriangle(surf,3,2,1)
    
    FlipMesh mesh
    
    Return mesh
    
End Function


; -----------------------------------------------------------------------------
; rebuild starfield mesh
; -----------------------------------------------------------------------------
Function UpdateStarfield(parent%,maxdist#=2.0,fader%=False,ds%,dc%)
    
    Local s.star,px#,py#,pz#,d#,a#,rgb%,col%,x%,y%,movecheck%
    
    Local cx#=EntityX(parent)
    Local cy#=EntityY(parent)
    Local cz#=EntityZ(parent)
    
    Local density%=Int(ds/2.55)
    
    ClearSurface(surf)
    
    quadparticles=0
    pixelparticles=0
    
    ; delete and create a new texture, acutally faster than clearing it
    If spritetex Then FreeTexture spritetex
    spritetex=CreateTexture(512,512,1)
    spritebuf=TextureBuffer(spritetex)
    EntityTexture sprite,spritetex
    
    LockBuffer spritebuf
    
    For s.star = Each star
        
        movecheck=False
        
        ; calc star position
        px=cx-s\x
        py=cy-s\y
        pz=cz-s\z
        
        ; check if star must be moved
        If px<-SCALEX Then s\x=s\x-(SCALEX Shl 1) : movecheck=True
        If px>+SCALEX Then s\x=s\x+(SCALEX Shl 1) : movecheck=True
        If pz<-SCALEZ Then s\z=s\z-(SCALEZ Shl 1) : movecheck=True
        If pz>+SCALEZ Then s\z=s\z+(SCALEZ Shl 1) : movecheck=True
        
        If movecheck Then s\visible=(Rand(100)<density)
        
        If s\visible Then
            
            ; reposition star
            PositionEntity star,s\x,s\y,s\z
            
            ; get distance
            d=Distance3D(cx,cy,cz,s\x,s\y,s\z)
            
            ; check if not to far away
            If d<maxdist
                
                TFormPoint s\x,s\y,s\z,0,CAM
                
                ; star is visible (in front of cam)?
                If TFormedZ()>0 Then
                    
                    ; fade pixel particles
                    col=255
                    If fader Then
                        col=Int(Normalize(d,0,maxdist,dc,0))
                        If col<0 Then col=0 Else If col>dc Then col=dc
                    EndIf
                    rgb=col*$10000+col*$100+col
                    
                    ; calculate pixel particle 2D position
                    CameraProject CAM,s\x,s\y,s\z
                    x=Normalize(ProjectedX(),0,WIDTH-1,0,511)
                    y=Normalize(ProjectedY(),0,HEIGHT-1,0,511)
                    
                    ; pixel inside texture range? draw to texture!
                    If x>0 And x<511 And y>0 And y<511 Then
                        WritePixelFast x,y,rgb,spritebuf
                        pixelparticles=pixelparticles+1
                    EndIf
                    
                    ; distance close enough to cam? spawn quad particle and add it to mesh
                    If d<maxdist*0.25 Then
                        
                        ; align star to cam
                        PointEntity star,CAM
                        
                        ScaleEntity star,s\scale,s\scale,s\scale
                        
                        ; add alpha
                        a=1.0 : If fader Then a=Normalize(d,0,maxdist*0.25,1,0)
                        
                        ; add star To starfield again
                        AddMeshToSurface(star,surf,starfield,s\col,s\col,s\col,a)
                        
                        quadparticles=quadparticles+1
                        
                    EndIf
                    
                EndIf
                
            EndIf
            
        EndIf
        
    Next
    
    UnlockBuffer spritebuf
    
    Return density
    
End Function


; -----------------------------------------------------------------------------
; add a mesh to another mesh
; -----------------------------------------------------------------------------
Function AddMeshToSurface(mesh,surf,singlesurfaceentity,r%,g%,b%,a#)
    
    Local vert%[2],vr%[2],vg%[2],vb%[2],va#[2],nx#[2],ny#[2],nz#[2]
    Local surface%,oldvert%,i%,i2%
    
    surface = GetSurface(mesh,1)
    
    For i = 0 To CountTriangles(surface)-1
        
        For i2 = 0 To 2
            
            oldvert = TriangleVertex(surface,i,i2)
            
            vr[i2]=r
            vg[i2]=g
            vb[i2]=b
            va[i2]=a
            nx[i2]=VertexNX(surface,oldvert)
            ny[i2]=VertexNY(surface,oldvert)
            nz[i2]=VertexNZ(surface,oldvert)
            
            TFormPoint VertexX(surface,oldvert),VertexY(surface,oldvert) , VertexZ(surface,oldvert), mesh,singlesurfaceentity
            vert[i2] = AddVertex(surf,TFormedX(),TFormedY(),TFormedZ() , VertexU(surface,oldvert),VertexV(surface,oldvert))
            VertexNormal surf,vert[i2],nx[i2],ny[i2],nz[i2]
            VertexColor surf,vert[i2],r,g,b,a
            
        Next
        
        AddTriangle(surf,vert[0],vert[1],vert[2])
        
    Next
    
End Function


; -----------------------------------------------------------------------------
; add stars to starfield mesh
; -----------------------------------------------------------------------------
Function AddStars(amount%=1,min#=0.01,max#=0.02,addx#=0.0,addy#=0.0,addz#=0.0)
    
    Local i%,s.star
    Local density%=Normalize(Perlin3D(0,0,0,16,1,0,3),-1,1,0,100)
    If density<0 Then density=0 Else If density>100 Then density=100
    
    For i=1 To amount
        
        s.star = New star
        
        s\col=Rand(64,255)
        s\x=addx+Rnd(-SCALEX,SCALEX)
        s\y=addy+Rnd(Rnd(Rnd(Rnd(-SCALEY))),Rnd(Rnd(Rnd(SCALEY))))
        s\z=addz+Rnd(-SCALEZ,SCALEZ)
        s\scale=Rnd(min,max)
        
        If Rand(100)<density Then s\visible=True
        
    Next
    
End Function


; -----------------------------------------------------------------------------
; simple 3D distance calculation
; -----------------------------------------------------------------------------
Function Distance3D#(x1#,y1#,z1#,x2#,y2#,z2#)
    
    Local x#=x1-x2
    Local y#=y1-y2
    Local z#=z1-z2
    
    Return Sqr((x*x)+(y*y)+(z*z))
    
End Function


; -----------------------------------------------------------------------------
; create a simple star texture
; -----------------------------------------------------------------------------
Function CreateStarTexture(size%=256,flags%=3)
    
    Local tex%=CreateTexture(size,size,flags)
    Local tb%=TextureBuffer(tex)
    
    Local i#,j%,col%,rgb%
    
    SetBuffer tb
    LockBuffer tb
    
    For j=0 To 255
        
        col=255-j
        If col>255 Then col=255
        rgb=col*$1000000+col*$10000+col*$100+col
        
        For i=0 To 360 Step 0.1
            
            WritePixelFast (size/2)+(Sin(i)*(j*size/512)),(size/2)+(Cos(i)*(j*size/512)),rgb,tb
            
        Next
        
    Next
    
    UnlockBuffer tb
    SetBuffer BackBuffer()
    
    Return tex
    
End Function


;===========================================================================
; create procedural ring detail textures using perlin functions
;===========================================================================
Function CreateProceduralRingTextures(brightness1%=192,brightness2%=160 , brightness3%=128,size%,detail%,flags%,noisetype$="perlin")
    
    Local buffer1%,buffer2%,buffer3%
    Local x%,y%,rgb%,rgb1%,rgb2%,col%,r%,i%
    
    If noisetype="fast" Then
        Dim HeightMap(size,size)
        Dim NoiseMap(size+1,size+1)
        FastNoise(size,8,1.2,1)
    EndIf
    
    ICETEX1=CreateTexture(size,size,flags)
    ICETEX2=CreateTexture(size,size,flags)
    ICETEX3=CreateTexture(size,size,flags)
    
    buffer1=TextureBuffer(ICETEX1)
    buffer2=TextureBuffer(ICETEX2)
    buffer3=TextureBuffer(ICETEX3)
    
    LockBuffer buffer1
    LockBuffer buffer2
    LockBuffer buffer3
    
    For x=0 To size-1
        For y=0 To size-1
            rgb1=brightness1*$10000+brightness1*$100+brightness1
            rgb2=brightness2*$10000+brightness2*$100+brightness2
            WritePixelFast x,y,rgb1,buffer1
            WritePixelFast x,y,rgb2,buffer2
        Next
    Next
    
    For i=1 To detail
        
        ; random position
        x=Rand(0,size-1)
        y=Rand(0,size-1)
        
        ; random randomized randomizer
        r=Rand(0,Rand(0,Rand(0,255)))
        
        ; perlin or fast noise
        If noisetype="fast" Then
            col=Normalize(HeightMap(x,0),minh,Maxh,brightness1,255)
        Else
            col=Normalize(Perlin3D(x,0,y,4,1,0,15),-1,1,brightness1,255)
        EndIf
        col=Normalize(col+r,brightness1,511,brightness2,255)
        
        ; layer 1+2: identical perlin noise mixed with random
        rgb=col*$10000+col*$100+col
        WritePixelFast x,y,rgb,buffer1
        WritePixelFast x,y,rgb,buffer2
        
        ; layer 3: starfield like
        If noisetype="fast" Then
            col=Normalize(HeightMap(y,x),minh,Maxh,0,128)
        Else
            col=Normalize(Perlin3D(x,y,0,16,1,0,7),-1,1,0,128)
        EndIf
        col=Normalize(col+r,0,511,brightness3,255)
        If col<brightness3 Then col=brightness3
        rgb=col*$10000+col*$100+col
        WritePixelFast x,y,rgb,buffer3
        
    Next
    
    UnlockBuffer buffer3
    UnlockBuffer buffer2
    UnlockBuffer buffer1
    
End Function


;===========================================================================
; main call to create the saturn ring system
;===========================================================================
Function CreateSaturnRing(size%=512,detail%=50000,flags%=1+8,mode$="normal" , style$="cassini",fading#=0.85,range#=0.7,noisetype$="perlin")
    
    Local v%,surf%
    
    ; create procedural ring textures (ICETEX1-3)
    CreateProceduralRingTextures(160,192,0,size,detail,flags,noisetype)
    
    ; create shadow texture
    If style="cassini" Then
        SHADOWTEX=CreateSaturnShadow(size,3.3,180,2,64,24,8)
    Else If style="linear" Then
        SHADOWTEX=CreateSaturnShadow(size,3.3,180,2,64,0,100)
    Else
        SHADOWTEX=CreateSaturnShadow(size,3.3,180,2,64,24,16)
    EndIf
    
    ; create main ring texture
    RINGTEX=CreateRingTexture(size,SEED_RING1,SEED_RING2,3,True,mode,fading,range)
    
    ; create planetary ring
    RING=CreateMesh(PLANET)
    EntityFX RING,1+2+16+32
    ;EntityBlend RING,3
    surf=CreateSurface(RING)
    UpdateSaturnRing(RING,surf,MINRINGRAD,MAXRINGRAD,RINGDETAIL,255,255,255,255,255,255,1.0,1.0)
    
    ; init second UV set
    For v=0 To CountVertices(surf)-1
        VertexTexCoords surf,v,VertexX(surf,v),VertexY(surf,v),0,1
    Next
    
    ; reposition shadow texture
    PositionTexture SHADOWTEX,0.5,0.5
    
    ; user second UV set
    TextureCoords ICETEX1,1
    TextureCoords ICETEX2,1
    TextureCoords ICETEX3,1
    TextureCoords SHADOWTEX,1
    
    ; scale textures
    ScaleTexture ICETEX1,1.0/128,1.0/128
    ScaleTexture ICETEX2,1.0/64,1.0/64
    ScaleTexture ICETEX3,1.0/32,1.0/32
    ScaleTexture SHADOWTEX,6,6
    
    ; apply to mesh
    EntityTexture RING,RINGTEX,0,1
    EntityTexture RING,ICETEX1,0,2
    EntityTexture RING,ICETEX2,0,3
    EntityTexture RING,ICETEX3,0,4
    EntityTexture RING,SHADOWTEX,0,5
    
    ; blend details
    TextureBlend ICETEX1,3
    TextureBlend ICETEX3,3
    
    ; rotate ring
    RotateMesh RING,-90,90,0
    
End Function


;===========================================================================
; create planetary ring mesh
;===========================================================================
Function UpdateSaturnRing(FMesh%,FFace%=1,FRadius1#=1.0,FRadius2#=3.0 , FSegments%=120,FR1%=255,FG1%=255,FB1%=255,FR2%=255,FG2%=255,FB2%=255,FAlpha1#=1.0,FAlpha2#=1.0)
    
    If FSegments>360 Then FSegments=360
    
    Local Angle%
    Local RV0%,RV1%,RV2%,RV3%
    Local RX0#,RX1#,RX2#,RX3#
    Local RY0#,RY1#,RY2#,RY3#
    Local SX0#,SX1#,SX2#,SX3#
    Local SY0#,SY1#,SY2#,SY3#
    Local U01#,U23#
    
    For Angle=1 To FSegments Step 1
        
        RX0=Sin(Angle*360.0/FSegments)*FRadius1
        RY0=Cos(Angle*360.0/FSegments)*FRadius1
        RX1=Sin(Angle*360.0/FSegments -180.0/FSegments)*FRadius2
        RY1=Cos(Angle*360.0/FSegments -180.0/FSegments)*FRadius2
        RX2=Sin(Angle*360.0/FSegments +180.0/FSegments)*FRadius2
        RY2=Cos(Angle*360.0/FSegments +180.0/FSegments)*FRadius2
        RX3=Sin(Angle*360.0/FSegments +360.0/FSegments)*FRadius1
        RY3=Cos(Angle*360.0/FSegments +360.0/FSegments)*FRadius1
        SX0=RX0: SY0=RY0
        SX1=RX0: SY1=RY0
        SX2=RX3: SY2=RY3
        SX3=RX3: SY3=RY3
        U01=0
        U23=0
        
        RV0=AddVertex(FFace,RX0,RY0,0, U01,0)
        RV1=AddVertex(FFace,RX1,RY1,0, 1,0)
        RV2=AddVertex(FFace,RX2,RY2,0, 1,0)
        RV3=AddVertex(FFace,RX3,RY3,0, U23,0)
        
        VertexColor FFace,RV0,FR1,FG1,FB1,FAlpha1
        VertexColor FFace,RV1,FR2,FG2,FB2,FAlpha2
        VertexColor FFace,RV2,FR2,FG2,FB2,FAlpha2
        VertexColor FFace,RV3,FR1,FG1,FB1,FAlpha1
        
        AddTriangle FFace,RV0,RV1,RV2
        AddTriangle FFace,RV2,RV3,RV0
        
    Next
    
    Return FMesh
    
End Function


;===========================================================================
; creates the saturn shadow texture using two spheres, simple math and a cam
;===========================================================================
Function CreateSaturnShadow(size%=512,scale#=3.5,angle#=180.0,blur%=2,col%=64,width#=20.0,length#=9.0)
    
    Local sphere1%,sphere2%,tmp%,surf1%,surf2%
    Local v%,x#,y#,z#,tex%,add#
    
    sphere1=CreateSphere(32)
    EntityFX sphere1,1+2
    
    sphere2=CreateSphere(32)
    EntityFX sphere2,1+2
    
    surf1=GetSurface(sphere1,1)
    surf2=GetSurface(sphere2,1)
    
    For v=0 To CountVertices(surf1)-1
        
        x#=VertexX(surf1,v)
        y#=VertexY(surf1,v)
        z#=VertexZ(surf1,v)
        
        If z>0 Then add=Sqr(z*length) Else add=1
        
        VertexCoords surf1,v,x,y,z*Cos(width)*add
        VertexColor surf1,v,col,col,col
        VertexColor surf2,v,col,col,col
        
    Next
    
    tex=CreateTexture(size,size)
    
    tmp=CreateCamera()
    PositionEntity tmp,0,scale,0
    CameraClsColor tmp,255,255,255
    CameraViewport tmp,0,0,size,size
    PointEntity tmp,sphere1
    
    RenderWorld
    
    FreeEntity sphere1
    FreeEntity sphere2
    FreeEntity tmp
    
    CopyRect 0,0,size,size,0,0,BackBuffer(),TextureBuffer(tex)
    
    If blur Then BlurTexture(tex,blur,blur)
    
    RotateTexture tex,angle
    
    Return tex
    
End Function


;===========================================================================
; blurs the saturn shadow texture for soft transitions
;===========================================================================
Function BlurTexture(Texture, Blur_Quality, Blur_Radius#)
    
    Local BlurMesh[16*4]
    Local Loop
    Local Blur_Cam
    Local BlurRadius#,BlurAngleStep#,BlurShade%,BlurAngle#,Xoff#,Yoff#
    
    Local BLUR_CAM_X# = 65536.0
    Local BLUR_CAM_Y# = 65536.0
    Local BLUR_CAM_Z# = 0.0
    
    If Blur_Quality > 0
        
        Blur_Cam = CreateCamera()
        CameraViewport Blur_Cam, 0, 0, TextureWidth(Texture), TextureHeight(Texture)
        CameraClsColor Blur_Cam, 0, 0, 0
        CameraClsMode  Blur_Cam, True, True                       
        CameraRange Blur_Cam, 0.1, 100
        CameraZoom Blur_Cam, 16.0
        RotateEntity Blur_Cam, 90, 0, 0, True
        PositionEntity Blur_Cam, BLUR_CAM_X#, BLUR_CAM_Y#, BLUR_CAM_Z#
        For Loop = 0 To (Blur_Quality*4)-1
            BlurMesh[Loop] = CreateSprite()
        Next
        TextureBlend Texture, 2
        ScaleTexture    Texture, 0.5, 0.5
        PositionTexture Texture, 0.5, 0.5
        
        BlurRadius = Blur_Radius# * (1.0 / 256.0)
        BlurAngleStep = 360.0 / Float(Blur_Quality*4)
        BlurShade = Ceil(255.0 / Float(Blur_Quality*4))
        
        For Loop = 0 To (Blur_Quality*4)-1
            
            EntityTexture BlurMesh[Loop], Texture
            EntityFX BlurMesh[Loop], 1+8
            EntityAlpha BlurMesh[Loop], 1.0 / Float(Loop+1)
            ScaleSprite BlurMesh[Loop], 2, 2
            
            BlurAngle# = BlurAngleStep# * Float(Loop) + 180.0*(Loop Mod 2)
            
            Xoff# = BlurRadius# * Cos(BlurAngle#)
            Yoff# = BlurRadius# * Sin(BlurAngle#)
            
            PositionEntity BlurMesh[Loop], BLUR_CAM_X# + Xoff#, BLUR_CAM_Y# - 16.0 , BLUR_CAM_Z# + Yoff#, True
            
        Next
        
        RenderWorld
        
        CopyRect 0, 0, TextureWidth(Texture), TextureHeight(Texture), 0, 0, BackBuffer() , TextureBuffer(Texture)
        
        For Loop = 0 To (Blur_Quality*4)-1
            FreeEntity BlurMesh[Loop]
        Next
        
        FreeEntity Blur_Cam
        
    EndIf
    
    ScaleTexture Texture,1,1
    PositionTexture Texture,0,0
    
End Function


;===========================================================================
; updates the vertex colors of a mesh
;===========================================================================
Function UpdateVertexColors(mesh%,r%,g%,b%,a#)
    
    Local s%,surf%,v%
    
    For s=1 To CountSurfaces(mesh)
        
        surf=GetSurface(mesh,s)
        
        For v=0 To CountVertices(surf)-1
            
            VertexColor surf,v,r,g,b,a
            
        Next
        
    Next
    
End Function


;===========================================================================
; creates a fake shader (spherical glow effect), should match planet size
;===========================================================================
Function CreateFakeShader(segments%=64,size#=1.0,r%=255,g%=224,b%=192,a#=0.5)
    
    Local shader%=CreateSphere(segments)
    Local tex%=CreateFakeShaderTexture()
    
    ScaleEntity shader,size,size,size
    EntityBlend shader,3
    EntityFX shader,2
    EntityOrder shader,-1
    UpdateVertexColors(shader,r,g,b,a)
    
    TextureBlend tex,2
    EntityTexture shader,tex,0,1
    
    Return shader%
    
End Function


;===========================================================================
; creates fake shader texture
;===========================================================================
Function CreateFakeShaderTexture()
    
    Local tex%=CreateTexture(512,512,64)
    Local tb%=TextureBuffer(tex)
    
    Local x%,y%,i#,j%,col%,rgb%
    
    SetBuffer tb
    LockBuffer tb
    
    For x=0 To 511
        
        For y=0 To 511
            
            rgb=255*$1000000+255*$10000+255*$100+255
            WritePixelFast x,y,rgb,tb
            
        Next
        
    Next
    
    For j=0 To 255
        
        col=j*1.0/Exp((255-j)*0.02)
        
        If col>255 Then col=255
        If col<0 Then col=0
        
        rgb=col*$1000000+col*$10000+col*$100+col
        
        For i=0 To 360 Step 0.1
            
            WritePixelFast 256+(Sin(i)*j),256+(Cos(i)*j),rgb,tb
            
        Next
        
    Next
    
    UnlockBuffer tb
    SetBuffer BackBuffer()
    
    Return tex
    
End Function


;===========================================================================
; create planet atmosphere
;===========================================================================
Function CreateGlow(radius1#=1.0,radius2#=2.0,segments%=360,fx%=0,blend%=0 , r1%=255,g1%=255,b1%=255,al1#=0.0,r2%=0,g2%=0,b2%=0,al2#=1.0)
    
    Local a1#,a2#,a3#,a4#,angle%,v0%,v1%,v2%,v3%
    Local mesh=CreateMesh()
    Local surf=CreateSurface(mesh)
    
    If segments>360 Then segments=360
    
    For angle=1 To segments
        
        a1=angle*360.0/segments
        a2=angle*360.0/segments +360.0/segments
        a3=angle*360.0/segments +180.0/segments
        a4=angle*360.0/segments -180.0/segments
        
        v0=AddVertex(surf,radius1*Cos(a1),radius1*Sin(a1),0,0,0)
        v1=AddVertex(surf,radius1*Cos(a2),radius1*Sin(a2),0,0,0)
        v2=AddVertex(surf,radius2*Cos(a3),radius2*Sin(a3),0,1,1)
        v3=AddVertex(surf,radius2*Cos(a4),radius2*Sin(a4),0,0,1)
        
        VertexColor surf,v0,r1,g1,b1,al1
        VertexColor surf,v1,r1,g1,b1,al1
        VertexColor surf,v2,r2,g2,b2,al2
        VertexColor surf,v3,r2,g2,b2,al2
        
        AddTriangle surf,v2,v1,v0
        AddTriangle surf,v0,v3,v2
        
    Next
    
    If fx>0 Then EntityFX mesh,fx
    If blend>0 Then EntityBlend mesh,blend
    
    
    Return mesh
    
End Function


;===========================================================================
; update planet atmosphere
;===========================================================================
Function UpdateGlow(mesh%,cam%)
    
    Local radius#,distance#
    Local c1#,a1#,q1#,p1#,h1#,alpha1#,beta1#,gamma1#,alpha2#,b2#,c2#
    
    PointEntity mesh,cam
    
    radius=SCALE
    distance=EntityDistance(cam,PLANET)
    
    ; First triangle
    c1=distance
    a1=radius
    q1=a1^2/c1
    p1=c1-q1
    h1=Sqr(p1*q1)
    gamma1=90
    alpha1=ATan(h1/p1)
    beta1=gamma1-alpha1
    
    ; Second Triangle
    alpha2=90-(90-beta1)
    b2=a1/Tan(alpha2)
    c2=(Sqr(a1^2+b2^2))/radius
    
    ScaleEntity mesh,c2,c2,c2
    
End Function


;===========================================================================
; create planetary ring texture
;===========================================================================
Function CreateRingTexture(size%=1024,seed1%=1,seed2%=2,flags%=0,usealpha%=False , method$="normal",fading#=1.0,range#=0.7)
    
    Local tex%=CreateTexture(size,1,flags)
    Local buffer%=TextureBuffer(tex)
    
    Local x%,h1#,h2#,h3#,col%,alpha%,rgb%,value#
    
    LockBuffer buffer
    
    For x=0 To size-1
        
        h1=Perlin3D(x*(2048/size),0,0,1024,seed1,0,15)
        h2=Perlin3D(0,x*(2048/size),0,512,seed2,0,7)
        
        col=Int(Normalize(h1,-range,range,0,255)) : If col<0 Then col=0 Else If col>255 Then col=255
        
        If usealpha Then
            
            If method="soft" Then
                
                ; soft rings
                alpha=(Int(Normalize(h2,-range,range,0,1.5)*col)+Int(Normalize(h3,-1,1,0,1.5)*col))/2.0
                
            Else If method="sharp" Then
                
                ; sharp rings
                alpha=Int(Normalize(h1,-range,range,0,1.0)*col)*Rnd(0.98,1.02)
                
            Else
                ; normal rings
                alpha=Int(Normalize(h2,-range,range,0,1.0)*col)
            EndIf
            
            If alpha<0 Then alpha=0 Else If alpha>255 Then alpha=255
            
        Else
            
            alpha=255
            
        EndIf
        
        ; soft fading to the outer rings
        If x>(size*fading) Then
            
            value=Normalize(x,size*fading,size,1,0)
            
            alpha=alpha*value
            col=col*value
            
        EndIf
        
        density[x]=alpha;(col+alpha)/2
        ringcolor[x]=col
        
        rgb=alpha*$1000000+col*$10000+col*$100+col
        
        WritePixelFast x,0,rgb,buffer
        
    Next
    
    UnlockBuffer buffer
    
    Return tex
    
End Function


;===========================================================================
; normalize value
;===========================================================================
Function Normalize#(value#=128.0,value_min#=0.0,value_max#=255.0,norm_min#=0.0,norm_max#=1.0)
    
    Return ((value#-value_min#)/(value_max#-value_min#))*(norm_max#-norm_min#)+norm_min#
    
End Function


;===========================================================================
; fast perlin noise functions
;===========================================================================
Function InitNoise(range#=0.7)
    
    Local i%,perm%
    
    Restore permutation
    
    For i=0 To 256-1
        
        Read perm
        
        P(i)=perm
        P(256+i)=perm
        
        GRAYD#(i)=Rnd(-range,range)
        GRAYD#(256+i)=Rnd(-range,range)
        
    Next
    
End Function

Function Perlin3D#(x#,y#,z#,size#=64,seed%=0,MinOctaves=0,MaxOctaves=9999)
    
    Local value#,initialSize#,i%
    
    If seed=0 Then seed=MilliSecs()
    
    x=x+seed
    y=y+seed
    z=z+seed
    
    value=0.0
    initialSize=size
    
    For i = 1 To MinOctaves : size=size/2 : Next
    
    While(size>=1.0) And MaxOctaves>MinOctaves
        
        value=value+SmoothNoise(x/size,y/size,z/size,seed)*size
        size=size/2.0
        MaxOctaves=MaxOctaves-1
        
    Wend
    
    Return (value/Float(initialSize))
    
End Function

Function SmoothNoise#(x#,y#,z#,seed%=0)
    
    Local x1#,y1#,z1#,u#,v#,w#,a#,aa#,ab#,b#,ba#,bb#
    Local g1#,g2#,g3#,g4#,g5#,g6#,g7#,g8#
    Local l1#,l2#,l3#,l4#,l5#,l6#,l7#
    
    x=x+seed
    y=y+seed
    z=z+seed
    
    x1=(Floor(x) And 255)
    y1=(Floor(y) And 255)
    z1=(Floor(z) And 255)
    
    x=x-Floor(x)
    y=y-Floor(y)
    z=z-Floor(z)
    
    u=Fade(x)
    v=Fade(y)
    w=Fade(z)
    
    a=P(x1)+y1
    aa=P(a)+z1
    ab=P(a+1)+z1
    
    b=P(x1+1)+y1
    ba=P(b)+z1
    bb=P(b+1)+z1
    
    g1=GRAYD(bb+1)
    g2=GRAYD(ab+1)
    g3=GRAYD(ba+1)
    g4=GRAYD(aa+1)
    g5=GRAYD(bb)
    g6=GRAYD(ab)
    g7=GRAYD(ba)
    g8=GRAYD(aa)
    
    l1=Lerp(u,g2,g1)
    l2=Lerp(u,g4,g3)
    l3=Lerp(v,l2,l1)
    l4=Lerp(u,g6,g5)
    l5=Lerp(u,g8,g7)
    l6=Lerp(v,l5,l4)
    l7=Lerp(w,l6,l3)
    
    Return l7
    
End Function

Function Fade#(t#)
    
    Return t*t*t*(t*(t*6-15)+10)
    
End Function

Function Lerp#(t#,a#,b#)
    
    Return a+t*(b-a)
    
End Function

Function FastNoise(size%,Scale#,Multiplier#,wrap%=False)
    
    Local Max_Height#,NoiseMapSize%,ScaleDifference#,StepSize#
    Local N1#,N2#,N3#,N4#,HX#,HY#,IX#,IY#,ICX#,ICY#,NA#,NB#,NC#,ND#
    Local i%,x%,y%,xx%,yy%
    Local v#
    
    Max_Height=Scale
    
    For y=0 To size Step 1
        
        For x=0 To size Step 1
            
            HeightMap(x,y)=Rnd(0,1)
            
        Next
        
    Next
    
    NoiseMapSize=size/2
    Max_Height=Max_Height*Multiplier
    
    Repeat
        
        For y=0 To NoiseMapSize
            
            For x=0 To NoiseMapSize
                
                NoiseMap(x,y)=Rnd(0,Max_Height#)
                
            Next
            
        Next
        
        If wrap Then
            
            For i=0 To NoiseMapSize : NoiseMap(i,0)=NoiseMap(i,NoiseMapSize) : Next
            For i=0 To NoiseMapSize : NoiseMap(0,i)=NoiseMap(NoiseMapSize,i) : Next
            
        EndIf
        
        ScaleDifference=size*1.0/NoiseMapSize
        StepSize=1.0/Float(ScaleDifference)
        
        For y=0 To NoiseMapSize-1
            
            For x=0 To NoiseMapSize-1
                
                N1=NoiseMap(x,  y  )
                N2=NoiseMap(x+1,y  )
                N3=NoiseMap(x,  y+1)
                N4=NoiseMap(x+1,y+1)
                
                HX=x*ScaleDifference
                HY=y*ScaleDifference
                
                IY=0
                
                For yy=0 To ScaleDifference-1
                    
                    ICY=1.0-((Cos(IY*180.0)+1.0)/2.0)
                    
                    IX=0   
                    
                    For xx=0 To ScaleDifference-1
                        
                        ICX=1.0-((Cos(IX*180.0)+1.0)/2.0)
                        
                        NA=N1*(1.0-ICX)
                        NB=N2*ICX
                        NC=N3*(1.0-ICX)
                        ND=N4*ICX
                        
                        v=HeightMap(HX+xx,HY+yy)+(NA+NB)*(1.0-ICY)+(NC+ND)*ICY
                        
                        If v>Maxh Then Maxh=v
                        If v<minh Then minh=v
                        
                        HeightMap(HX+xx,HY+yy)=v
                        
                        IX=IX+StepSize
                        
                    Next
                    
                    IY=IY+StepSize   
                    
                Next
                
            Next
            
        Next
        
        NoiseMapSize=NoiseMapSize/2
        
        Max_Height=Max_Height*Multiplier
        
    Until NoiseMapSize<=2
    
End Function


.permutation
Data 151,160,137,91,90,15
Data 131,13,201,95,96,53,194,233,7,225,140,36,103,30,69,142,8,99,37,240,21,10,23
Data 190, 6,148,247,120,234,75,0,26,197,62,94,252,219,203,117,35,11,32,57,177,33
Data 88,237,149,56,87,174,20,125,136,171,168, 68,175,74,165,71,134,139,48,27,166
Data 77,146,158,231,83,111,229,122,60,211,133,230,220,105,92,41,55,46,245,40,244
Data 102,143,54, 65,25,63,161, 1,216,80,73,209,76,132,187,208, 89,18,169,200,196
Data 135,130,116,188,159,86,164,100,109,198,173,186, 3,64,52,217,226,250,124,123
Data 5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,16,58,17,182,189,28,42
Data 223,183,170,213,119,248,152, 2,44,154,163, 70,221,153,101,155,167, 43,172,9
Data 129,22,39,253, 19,98,108,110,79,113,224,232,178,185, 112,104,218,246,97,228
Data 251,34,242,193,238,210,144,12,191,179,162,241, 81,51,145,235,249,14,239,107
Data 49,192,214, 31,181,199,106,157,184, 84,204,176,115,121,50,45,127, 4,150,254
Data 138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,180

AppTitle "Infinite Starfield"

Graphics3D 800,600,32,2

Global SCALEX#        = 1.0                ; starfield scale X
Global SCALEY#        = 1.0                ; starfield scale Y
Global SCALEZ#        = 1.0                ; starfield scale Z
Global FARDIST#        = 1.0                ; fade out distance
Global DENSITY#        = 20.0                ; 20% density

Global TurnSpeed#    = 4.0                ; cam turn speed
Global CameraSpeed#    = 0.01                ; cam move speed

Global WIDTH%        = GraphicsWidth()    ; grab screen width
Global HEIGHT%        = GraphicsHeight()    ; grab screen height
Global TIMER%        = CreateTimer(60)    ; timer

Global MAXSTARS%    = 25000

Global visible%,stars%

Global imagesize%=128
Global image=CreateImage(imagesize,imagesize)
Global buff=ImageBuffer(image)

Type star
    
    Field col%
    Field scale#
    Field x#,y#,z#
    Field visible%
    
End Type

; camera
Global cam=CreateCamera()
CameraRange cam,0.01,10
PositionEntity cam,0,0,0

; star quad
Global star=CreateQuad()
HideEntity star

; starfield mesh
Global starfield=CreateMesh()
Global surf=CreateSurface(starfield)
EntityTexture starfield,CreateStarTexture()
EntityFX starfield,1+2+32
EntityBlend starfield,3

; add stars to starfield
AddStars(MAXSTARS,0.0025,0.005)

MoveMouse WIDTH/2,HEIGHT/2

; main loop
While Not KeyHit(1)
    
    ; camera movement
    Movement(cam)
    
    DENSITY=DENSITY+((MouseDown(1)-MouseDown(2))/2.0)
    If DENSITY>100 Then DENSITY=100 Else If DENSITY<0 Then DENSITY=0
    
    ; update stars
    UpdateStarfield(cam,True)
    
    RenderWorld()
    
    WaitTimer TIMER
    
    DrawImage image,0,0
    
    Color 255,255,255
    
    Text 0,imagesize+ 0,"Density:   "+DENSITY+"%"
    Text 0,imagesize+14,"Visible:   "+visible
    Text 0,imagesize+28,"Stars:     "+stars
    
    Flip 0
    
Wend

End

; rebuild starfield mesh
Function UpdateStarfield(parent%,fader%=False)
    
    Local s.star,px#,py#,pz#,d#,a#,rgb%,x%,y%
    
    Local cx#=EntityX(parent)
    Local cy#=EntityY(parent)
    Local cz#=EntityZ(parent)
    
    ClearSurface(surf)
    
    visible=0
    stars=0
    
    SetBuffer buff
    Color 0,0,0
    Rect 0,0,imagesize,imagesize,1
    SetBuffer BackBuffer()
    
    LockBuffer buff
    
    For s.star = Each star
        
        stars=stars+1
        
        ; calc star position
        px=cx-s\x
        py=cy-s\y
        pz=cz-s\z
        
        ; check if star must be moved
        If px<-SCALEX Then s\x=s\x-(SCALEX*2) : s\visible=False : If Rnd(100)<DENSITY Then s\visible=True
        If px>+SCALEX Then s\x=s\x+(SCALEX*2) : s\visible=False : If Rnd(100)<DENSITY Then s\visible=True
        If py<-SCALEY Then s\y=s\y-(SCALEY*2) : s\visible=False : If Rnd(100)<DENSITY Then s\visible=True
        If py>+SCALEY Then s\y=s\y+(SCALEY*2) : s\visible=False : If Rnd(100)<DENSITY Then s\visible=True
        If pz<-SCALEZ Then s\z=s\z-(SCALEZ*2) : s\visible=False : If Rnd(100)<DENSITY Then s\visible=True
        If pz>+SCALEZ Then s\z=s\z+(SCALEZ*2) : s\visible=False : If Rnd(100)<DENSITY Then s\visible=True
        
        If s\visible Then
            
            ; reposition star
            PositionEntity star,s\x,s\y,s\z
            
            x=Int(Normalize(px,-SCALEX,SCALEX,imagesize/2,-imagesize/2))
            y=Int(Normalize(pz,-SCALEZ,SCALEZ,-imagesize/2,imagesize/2))
            
            rgb=64*$10000+64*$100+64
            
            ; get distance
            d=EntityDistance(star,cam)
            
            ; check if not to far away
            If d<FARDIST Then
                
                ; star is visible?
                If EntityInView(star,cam) Then
                    
                    rgb=255*$100
                    
                    ; align star to cam
                    PointEntity star,cam
                    
                    ScaleEntity star,s\scale,s\scale,s\scale
                    
                    ; add alpha
                    a=1.0 : If fader Then a=Normalize(d,FARDIST*0.5,FARDIST,1,0)
                    
                    ; add star To starfield again
                    AddToSurface(star,surf,starfield,s\col,s\col,s\col,a)
                    
                    visible=visible+1
                    
                EndIf
                
            EndIf
            
            WritePixelFast ((imagesize/2)+x) Mod imagesize,((imagesize/2)+y) Mod imagesize,rgb,buff
            
            
        EndIf
        
    Next
    
    UnlockBuffer buff
    
    Return DENSITY
    
End Function

; add stars to starfield mesh
Function AddStars(amount%=1,min#=0.01,max#=0.02)
    
    Local i%,s.star
    
    For i=1 To amount
        
        s.star = New star
        
        s\col=Rand(64,255)
        s\x=Rnd(-SCALEX,SCALEX)
        s\y=Rnd(-SCALEY,SCALEY)
        s\z=Rnd(-SCALEZ,SCALEZ)
        s\scale=Rnd(min,max)
        
        If Distance3D(0,0,0,s\x,s\y,s\z)<=FARDIST Then
            
            If Rand(100)<DENSITY Then s\visible=True
            
        Else
            
            If Rand(100)<DENSITY Then s\visible=True
            
        EndIf
        
    Next
    
End Function

; simple 3D distance calculation
Function Distance3D#(x1#,y1#,z1#,x2#,y2#,z2#)
    
    Local x#=x1-x2
    Local y#=y1-y2
    Local z#=z1-z2
    
    Return Sqr(x*x+y*y+z*z)
    
End Function

; simple spaceship freeflight
Function Movement(cam%,sensitivity#=1.0)
    
    Local cx#,cz#,tx#,ty#,multi%=1
    
    cx=(KeyDown(205)-KeyDown(203))*CameraSpeed
    cz=(KeyDown(200)-KeyDown(208))*CameraSpeed
    If KeyDown(42) Or KeyDown(54) Then multi=3
    
    tx=Normalize(MouseX(),0,WIDTH , 1,-1)
    ty=Normalize(MouseY(),0,HEIGHT,-1, 1)
    
    If ty<0 Then ty=(Abs(ty)^sensitivity)*-1 Else ty=ty^sensitivity
    If tx<0 Then tx=(Abs(tx)^sensitivity)*-1 Else tx=tx^sensitivity
    
    TurnEntity cam,ty*TurnSpeed,tx*TurnSpeed,0
    MoveEntity cam,cx*multi,0,cz*multi
    
End Function

; create a simple star texture
Function CreateStarTexture(size%=256,flags%=3)
    
    Local tex%=CreateTexture(size,size,flags)
    Local tb%=TextureBuffer(tex)
    
    Local i#,j%,col%,rgb%
    
    SetBuffer tb
    LockBuffer tb
    
    For j=0 To 255
        
        col=255-j
        If col>255 Then col=255
        rgb=col*$1000000+col*$10000+col*$100+col
        
        For i=0 To 360 Step 0.1
            
            WritePixelFast (size/2)+(Sin(i)*(j*size/512)),(size/2)+(Cos(i)*(j*size/512)),rgb,tb
            
        Next
        
    Next
    
    UnlockBuffer tb
    SetBuffer BackBuffer()
    
    Return tex
    
End Function

; normalize a value
Function Normalize#(value#=128.0,value_min#=0.0,value_max#=255.0,norm_min#=0.0,norm_max#=1.0)
    
    Return ((value-value_min)/(value_max-value_min))*(norm_max-norm_min)+norm_min
    
End Function

; add a mesh to another mesh's surface
Function AddToSurface(mesh,surf,singlesurfaceentity,r%,g%,b%,a#) 
    
    Local vert%[2],vr%[2],vg%[2],vb%[2],va#[2]
    Local surface%,oldvert%,i%,i2%
    
    surface = GetSurface(mesh,1) 
    
    For i = 0 To CountTriangles(surface)-1
        
        For i2 = 0 To 2 
            
            oldvert = TriangleVertex(surface,i,i2)
            
            vr[i2]=r
            vg[i2]=g
            vb[i2]=b
            va[i2]=a
            
            TFormPoint VertexX(surface,oldvert),VertexY(surface,oldvert),VertexZ(surface,oldvert), mesh,singlesurfaceentity 
            vert[i2] = AddVertex(surf,TFormedX(),TFormedY(),TFormedZ(),VertexU(surface,oldvert),VertexV(surface,oldvert)) 
            VertexColor surf,vert[i2],r,g,b,a
            
        Next 
        
        AddTriangle(surf,vert[0],vert[1],vert[2])
        
    Next 
    
End Function

; create a quad
Function CreateQuad(r%=255,g%=255,b%=255,a#=1.0)
    
    Local mesh%,surf%,v1%,v2%,v3%,v4%
    
    mesh=CreateMesh()
    surf=CreateSurface(mesh)
    
    v1=AddVertex(surf,-1,1,0,1,0)
    v2=AddVertex(surf,1,1,0,0,0)
    v3=AddVertex(surf,-1,-1,0,1,1)
    v4=AddVertex(surf,1,-1,0,0,1)
    
    VertexColor surf,v1,r,g,b,a
    VertexColor surf,v3,r,g,b,a
    VertexColor surf,v2,r,g,b,a
    VertexColor surf,v4,r,g,b,a
    
    AddTriangle(surf,0,1,2)
    AddTriangle(surf,3,2,1)
    
    FlipMesh mesh
    
    Return mesh
    
End Function