PureBasic

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

Code : Tout sélectionner

http://www.gamedev.net/community/forums/topic.asp?topic_id=410954