Attracteurs étranges

Sujets variés concernant le développement en PureBasic
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Attracteurs étranges

Message par kelebrindae »

Bonjour!

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. 8O

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! :P

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
Les idées sont le souvenir de choses qui ne se sont pas encore produites.
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Attracteurs étranges

Message par G-Rom »

Superbe ! chapo l'artiste ! 8O

Pour linux , penser à rajouté cette commande pour l'utilisation des touches fléchées :
KeyboardMode(#PB_Keyboard_International)
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Attracteurs étranges

Message par G-Rom »

Ton code me fait pensé à une discussion que j'ai vu sur gamedev :

Code : Tout sélectionner

http://www.gamedev.net/community/forums/topic.asp?topic_id=410954
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Re: Attracteurs étranges

Message par kelebrindae »

Tout à fait! C'est là que j'ai trouvé l'algo de base (mais mes résultats sont bien moins jolis). C'est d'ailleurs pour ça que la fenêtre du programme porte le nom de "Nebula".

Et merci pour "KeyboardMode", je ne connaissais pas.
Les idées sont le souvenir de choses qui ne se sont pas encore produites.
Avatar de l’utilisateur
SPH
Messages : 4947
Inscription : mer. 09/nov./2005 9:53

Re: Attracteurs étranges

Message par SPH »

E X T R A :|

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
lepiaf31
Messages : 510
Inscription : dim. 25/mars/2007 13:44
Localisation : Toulouse, France
Contact :

Re: Attracteurs étranges

Message par lepiaf31 »

tout simplement bluffant oO
Le Soldat Inconnu
Messages : 4312
Inscription : mer. 28/janv./2004 20:58
Localisation : Clermont ferrand OU Olsztyn
Contact :

Re: Attracteurs étranges

Message par Le Soldat Inconnu »

Oui, c'est super zoli :D
Je ne suis pas à moitié Polonais mais ma moitié est polonaise ... Vous avez suivi ?

[Intel quad core Q9400 2.66mhz, ATI 4870, 4Go Ram, XP (x86) / 7 (x64)]
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: Attracteurs étranges

Message par djes »

Bien sympa :)
Avatar de l’utilisateur
GallyHC
Messages : 1708
Inscription : lun. 17/déc./2007 12:44

Re: Attracteurs étranges

Message par GallyHC »

Belle effet qui rend bien, une seul chose a dire bravo :)

Cordialement,
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Re: Attracteurs étranges

Message par Frenchy Pilou »

dans le même genre ce gratoche là
Chaoscope 8)
Est beau ce qui plaît sans concept :)
Speedy Galerie
Avatar de l’utilisateur
SPH
Messages : 4947
Inscription : mer. 09/nov./2005 9:53

Re: Attracteurs étranges

Message par SPH »

Frenchy Pilou a écrit :dans le même genre ce gratoche là
Chaoscope 8)
Waouw, merci pour ce lien. C'est la premiere fois que je reussi un rendu !

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
Avatar de l’utilisateur
flaith
Messages : 1487
Inscription : jeu. 07/avr./2005 1:06
Localisation : Rennes
Contact :

Re: Attracteurs étranges

Message par flaith »

8O c'est booo :D
kelebrindae
Messages : 579
Inscription : ven. 11/mai/2007 15:21

Re: Attracteurs étranges

Message par kelebrindae »

:D Merci à tous !

@Frenchy Pilou:
Oui, j'étais tombé sur Chaoscope aussi et c'est vrai que c'est assez génial. En plus, dans les pages "tutorial" du site, ils donnent les différents types d'équation qu'ils utilisent; Pratique, si on veut les implémenter soi-même.
Les idées sont le souvenir de choses qui ne se sont pas encore produites.
dayvid
Messages : 1242
Inscription : mer. 11/nov./2009 18:17
Localisation : Poitiers (Vienne)

Re: Attracteurs étranges

Message par dayvid »

waou pas mal même si je pige rien au code :D
La vie, C'est comme, Une boitte, De startis, On en voie, De toutes, Les couleurs !

Mon forum http://purebasic.forumphp3.com/index.php
Frenchy Pilou
Messages : 2194
Inscription : jeu. 27/janv./2005 19:07

Re: Attracteurs étranges

Message par Frenchy Pilou »

Le seul manque de Chaoscope c'est qu'il ne donne pas le fichier 3D généré! :roll:
(genre formats OBJ STL ou 3DM)
Seul un artiste a l'air d'en avoir profité! :?

Un objectif louable pour un petit programme PB? :wink:
Est beau ce qui plaît sans concept :)
Speedy Galerie
Répondre