Comme ça faisait longtemps que je n'avais rien posté, j'ai codé un bidule rapide pour nourrir le forums pendant l'été (je les trouve un peu calmes, ces temps-ci).
Mon but était à l'origine de tester les Billboards, que je n'avais encore jamais utilisés. Résultat: me voilà une fois de plus impressionné.
Ce programme génère, ou essaye de générer, des attracteurs étranges. Les attracteurs étranges sont des sortes de bizarreries mathématiques issues du chaos et dont l'étude passionnent de nombreux chercheurs depuis leur découverte.
Moi, je n'y comprends pas grand-chose, mais il y a un truc que je sais: ils sont jolis à regarder.
Donc voilà: ce code calcule les premières dizaines de milliers de valeurs X,Y,Z d'un attracteur, puis crée un billboard pour chacun de ces points. Sur mon PC de bureau avec une carte graphique moyenne (Radeon HD 3400), j'ai pu aller jusqu'à 40000 points avant de passer sous les 60 Fps.

A vous de tester:
- Espace pour changer les paramètres et donc la forme de l'attracteur
- C pour choisir de nouvelles couleurs
- flèche haut pour ajouter 5000 points au dessin
- flèche bas pour en ôter 5000
- F1 pour afficher les FPS
- Esc pour quitter
Bonnes vacances!

Code : Tout sélectionner
; Author: Kelebrindae
; Date: july, 16, 2010
; PB version: v4.41
; OS: Windows XP
; ---------------------------------------------------------------------------------------------------------------
; Description:
; ---------------------------------------------------------------------------------------------------------------
; This program is a very basic Strange Attractors generator.
; It computes a cloud of points using a variation of the Pickover formula. Then it displays the points using the distance from
; one point to the next to color them.
; Initially conceived to test the Billboards performances.
;
; Controls:
; - [Space] : compute a new cloud from random values
; - C : change colors
; - F1 : display FPS
; - Up : add 5000 points to the cloud
; - Down : remove 5000 points to the cloud
; ---------------------------------------------------------------------------------------------------------------
#COLORTABLERANGE = 63 ; Number of steps between color 1 and color 2 (there's one billboard group for each step)
; These, you shouldn't change
#MAXIMUMXRANGE = 1023
#MAXIMUMYRANGE = 1023
#MAXIMUMZRANGE = 1023
;- Structures and globals
Structure coord3D
x.f
y.f
z.f
EndStructure
Structure cloudpoint_struct
x.f
y.f
z.f
distance.f
angle.f
EndStructure
Global NewList pickoverpoint.cloudpoint_struct()
Structure currentConfig_struct
param.f[6]
color1.i
color2.i
EndStructure
Global currentConfig.currentConfig_struct
currentConfig\color1 = $3F7FFF
currentConfig\color2 = $FF7F7F
Global width.i = 800, height.i = 600 ; Window dimension
Global maxNbPoints.i = 20000 ; change this value to adjust speed/quality (it's the actual number of billboards displayed on screen)
EnableExplicit
;************************************************************************************
;- ---- Procedures ----
;************************************************************************************
Procedure createColorTable(numstep.i)
Protected i.i,redval.i,greenval.i,blueval.i
SetWindowTitle(0,"Generating new color table...")
; If it's not the first call, delete old materials and ask for new colors
If IsMaterial(1)
For i = 1 To numstep
FreeMaterial(i)
Next i
currentConfig\color1 = ColorRequester(currentConfig\color1)
currentConfig\color2 = ColorRequester(currentConfig\color2)
EndIf
SetWindowTitle(0,"Generating new color table... Please Wait...")
CreateImage(1,256,256)
For i = 1 To numstep
SetWindowTitle(0,"Generating new color table... Please Wait" + ReplaceString(Space(i % 8)," ",".") )
StartDrawing(ImageOutput(1))
DrawingMode(#PB_2DDrawing_Default)
Box(0,0,255,255,$000000)
redval = Red(currentConfig\color1) + ( (Red(currentConfig\color2) - Red(currentConfig\color1))/numstep )*i
greenval = Green(currentConfig\color1) + ( (Green(currentConfig\color2) - Green(currentConfig\color1))/numstep )*i
blueval = Blue(currentConfig\color1) + ( (Blue(currentConfig\color2) - Blue(currentConfig\color1))/numstep )*i
DrawingMode(#PB_2DDrawing_Gradient)
BackColor( RGB(redval,greenval,blueval) )
FrontColor($000000)
CircularGradient(127, 127, 127)
Circle(127, 127, 127)
StopDrawing()
SaveImage(1,"temp"+Str(i)+".bmp")
LoadTexture(i,"temp"+Str(i)+".bmp")
DeleteFile("temp"+Str(i)+".bmp")
CreateMaterial(i, TextureID(i))
DisableMaterialLighting(i, #True)
MaterialBlendingMode (i, 2)
Next i
FreeImage(1)
SetWindowTitle(0,"Nebula")
EndProcedure
Procedure computeCloud(nbpoints.i,resetParams.b)
Protected i.i,j.i
Protected ok.b
; initialize min-max values (used For drawing only)
Protected minpos.cloudpoint_struct
Protected maxpos.cloudpoint_struct
minpos\x = 999999999
minpos\y=999999999
minpos\z=999999999
minpos\distance=999999999
minpos\angle=999999999
maxpos\x=-999999999
maxpos\y=-999999999
maxpos\z=-999999999
maxpos\distance=-999999999
maxpos\angle=-999999999
; oldPos stores the coord of the previous point
Protected oldPos.Coord3D
Repeat
; If all params = 0, then randomize
If resetParams = #True
RandomSeed(ElapsedMilliseconds())
For i=1 To 5
currentConfig\param[i] = (Random(60000)-30000)/10000.0
Next i
EndIf
ok=#True
ClearList(pickoverpoint())
For i = 1 To nbpoints
; Pickover' formula
AddElement(pickoverpoint())
pickoverpoint()\x = Sin(currentConfig\param[1] * oldPos\y) - oldPos\z * Cos(currentConfig\param[2] * oldPos\x)
pickoverpoint()\y = oldPos\z * Sin(currentConfig\param[3] * oldPos\x) - Cos(currentConfig\param[4] * oldPos\y)
pickoverpoint()\z = currentConfig\param[5] * Sin(oldPos\x)
; Stores min-max coords
If pickoverpoint()\x<minpos\x
minpos\x=pickoverpoint()\x
ElseIf pickoverpoint()\x>maxpos\x
maxpos\x=pickoverpoint()\x
EndIf
If pickoverpoint()\y<minpos\y
minpos\y=pickoverpoint()\y
ElseIf pickoverpoint()\y>maxpos\y
maxpos\y=pickoverpoint()\y
EndIf
If pickoverpoint()\z<minpos\z
minpos\z=pickoverpoint()\z
ElseIf pickoverpoint()\z>maxpos\z
maxpos\z=pickoverpoint()\z
EndIf
; Assign distance and angle (well, for now, angle isn't used; maybe later...)
; Distance from previous point (no SQR, to speed up the process)
pickoverpoint()\distance = (pickoverpoint()\x-oldPos\x)*(pickoverpoint()\x-oldPos\x) + (pickoverpoint()\y-oldPos\y)*(pickoverpoint()\y-oldPos\y) + (pickoverpoint()\z-oldPos\z)*(pickoverpoint()\z-oldPos\z)
If pickoverpoint()\distance<minpos\distance
minpos\distance=pickoverpoint()\distance
ElseIf pickoverpoint()\distance>maxpos\distance
maxpos\distance=pickoverpoint()\distance
EndIf
; Detect regularity
If oldpos\x=pickoverpoint()\x And oldpos\y=pickoverpoint()\y And oldpos\z=pickoverpoint()\z
ok = #False
resetParams = #True
EndIf
; Current position become oldPos
oldpos\x=pickoverpoint()\x
oldpos\y=pickoverpoint()\y
oldpos\z=pickoverpoint()\z
Next i
If maxpos\distance-minpos\distance = 0
ok = #False
resetParams = #True
EndIf
Until ok=#True
; "Normalize", so coords, distances and angle values are spread between 0 and N (makes drawing easier and faster)
; Normalizing distance and angle from 0 To COLORTABLERANGE can seem strange, but
; it's because they're drawn using color within a 0->COLORTABLERANGE range
ForEach pickoverpoint()
pickoverpoint()\x = (pickoverpoint()\x-minpos\x) * (#MAXIMUMXRANGE/(maxpos\x-minpos\x))
pickoverpoint()\y = (pickoverpoint()\y-minpos\y) * (#MAXIMUMYRANGE/(maxpos\y-minpos\y))
pickoverpoint()\z = (pickoverpoint()\z-minpos\z) * (#MAXIMUMZRANGE/(maxpos\z-minpos\z))
pickoverpoint()\distance = (pickoverpoint()\distance-minpos\distance) * (#COLORTABLERANGE/(maxpos\distance-minpos\distance))
; pickoverpoint()\angle = (pickoverpoint()\angle-minpos\angle) * (#COLORTABLERANGE/(maxpos\angle-minpos\angle))
Next pickoverpoint()
EndProcedure
Procedure drawCloud(nummat.i)
Protected i.i, numBillboard.i
; Create one billboard group for each color
For i= 1 To numMat
If IsBillboardGroup(i)
FreeBillboardGroup(i)
EndIf
CreateBillboardGroup(i,MaterialID(i),10,10, #MAXIMUMXRANGE/-2, #MAXIMUMYRANGE/-2, #MAXIMUMZRANGE/-2)
Next i
ForEach pickoverpoint()
; The point color is determined by its distance
numBillboard = Int(pickoverpoint()\distance) + 1
If numBillboard > nummat
numBillboard = nummat
ElseIf numBillboard < 1
numBillboard = 1
EndIf
; Add the point to the billboard
AddBillboard(i,numBillboard,pickoverpoint()\x,pickoverpoint()\y,pickoverpoint()\z)
Next pickoverpoint()
EndProcedure
DisableExplicit
;************************************************************************************
;- ---- Main program ----
;************************************************************************************
;- Init Engine 3D, keyboard, mouse...
If InitEngine3D() = 0
MessageRequester( "Error" , "Can't initialize 3D, check if engine3D.dll is available" , 0 )
End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
MessageRequester( "Error" , "Can't find DirectX 7.0 or above" , 0 )
End
EndIf
Add3DArchive(".", #PB_3DArchive_FileSystem)
;- Open a windowed screen
OpenWindow(0,0, 0, width, height ,"Nebula")
OpenWindowedScreen(WindowID(0),0,0, width , height,0,0,0,#PB_Screen_SmartSynchronization)
;- Create camera
CreateCamera(1,0,0,100,100)
RenderWorld()
anglecam.f = 0
;- Create the materials for the billboards
createColorTable(#COLORTABLERANGE+1)
;- Compute and draw cloud
computeCloud(maxNbPoints,#True)
drawcloud(#COLORTABLERANGE+1)
;- Main loop
Repeat
While WindowEvent() : Wend
Delay(1)
;- Keyboard management
If ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
quit = #True
EndIf
; Compute a new cloud
If KeyboardReleased(#PB_Key_Space)
computeCloud(maxNbPoints,#True)
drawcloud(#COLORTABLERANGE+1)
EndIf
; Choose new colors
If KeyboardReleased(#PB_Key_C)
createColorTable(#COLORTABLERANGE+1)
drawcloud(#COLORTABLERANGE+1)
EndIf
; Add 5000 points
If KeyboardReleased(#PB_Key_Up)
maxNbPoints+5000
computeCloud(maxNbPoints,#False)
drawcloud(#COLORTABLERANGE+1)
EndIf
; Remove 5000 points
If KeyboardReleased(#PB_Key_Down) And maxNbPoints > 5000
maxNbPoints-5000
computeCloud(maxNbPoints,#False)
drawcloud(#COLORTABLERANGE+1)
EndIf
; Display performances info
If KeyboardReleased(#PB_Key_F1)
MessageRequester("Statistics",Str(CountRenderedTriangles()) + " polygons, " + Str(Engine3DFrameRate(#PB_Engine3D_Average)) + " Fps")
EndIf
EndIf
;- Rotate camera
anglecam+0.01
If anglecam>#PI
anglecam = -#PI
EndIf
CameraLocate(1,#MAXIMUMXRANGE * 1.5 * Cos(angleCam),0, #MAXIMUMZRANGE * 1.5 * Sin(angleCam))
CameraLookAt(1,0,0,0)
; Show it all
RenderWorld()
FlipBuffers()
Until quit = #True