Black Hole effect using sprites / 5.20 beta required

[em_uk]

Great work wilbert - excellent code!

I read about super formulas after a post from applePi, but had no idea how to implement it.

How would you start with a tweening function? Would it rely on a vector?

[Olliv]

Physically, it seems like spirograph draw.

1) Draw a circle manually (with trigo function, sinus and cosinus)
Radius is a constant
Angle is a variable depending of the loop status.

for i
angle = i * drawprecisionconstantfloat1
radius = constantfloat2
x = cos( angle ) * radius
y = sin( angle ) * radius
plot(x, y, color)
next

2) Now, you have your circle, change the type of radius. Instead of a constant, change it to a function. So, inside the loop you add a sinus function:

radius = constantfloat2 * sin(angle * constantfloat3) + constantfloat4

You have now 2D formula for spirograph. You can replace this function by the superformula to implement this one.



For the 3D formula, same as (1) but with z param. The 3 functions x, y and z are indicated to gether in the article. You can use SetMeshData or other to implement it in 3D rendering.

But all this things, it's not really what we can see in the sky I think...

[netmaestro]

PS. To make a screen saver, you can just change the extension to .scr and dump it in your Windows folder

This will more or less work but it won't be a proper well-behaved screensaver. Here's how I would do it, compile as "BlackHole.scr" and remember to save as "All files" so PB won't stick an ".exe" on the end of it. To install it into Windows properly, rightclick the .scr file in Windows Explorer and choose "Install":

Code: Select all

; Declarations 
Declare PreviewCallback(hWnd, Msg, wParam, lParam) ; Destroys the preview window when OS requests it

Declare DoPresentation(runmode) ; Runs in either preview mode (autostretch windowed screen) or screensave mode (fullscreen)
                                ; Note: The presentation should be sized for the full display and it will 
                                ; show correctly in fullscreen or in the small preview window because the 
                                ; the preview windowedscreen is set to autostretch. What we do is create 
                                ; a child window for the preview parent that the OS provides and size it
                                ; to the client area of the parent. The windowed screen opened on this
                                ; child should be sized to the full display and autostretch set on.
                                
Declare DoPreview() ; Runs when the OS requests your presentation to run in the small preview window
                                
Declare DoConfig()  ; Runs when the OS or the user requests configuration of the screensaver

; Inits
InitSprite():InitKeyboard():InitMouse():ExamineDesktops()

; Globals
Global display_cx.i=DesktopWidth(0), display_cy.i=DesktopHeight(0), preview_cx.i
Global preview_cy.i, PreviewParent.i, ConfigHandle.i, runmode.i

; The OS will start the screensaver multiple times so if an instance
; is already running we must let it finish and exit here. The OS will
; try again as soon as the existing instance closes.
; This is an important component of all screensavers, without it the
; screensaver would be quite badly behaved.
result = CreateMutex_(#Null, #True, "MyScreenSaverIsAlreadyRunningMutex")
If GetLastError_() = #ERROR_ALREADY_EXISTS 
  CloseHandle_(result)
  End
EndIf

parametercount = CountProgramParameters()

If parametercount = 0
  DoConfig()
ElseIf parametercount=2 ; In preview mode we receive two parameters:
  runmode = 0       ; "/p" comes in ProgramParameter(0), the preview window hwnd comes in (1)
  DoPreview()
Else
  If FindString(UCase(ProgramParameter(0)), "S")
    runmode = 1 ; Screensave mode, fullscreen - no hwnd given by OS, we must create our own
    OpenScreen(display_cx,display_cy,32,"MyScreenSaver",#PB_Screen_SmartSynchronization)
    Repeat
      DoPresentation(runmode)
      ExamineKeyboard():ExamineMouse() ; After each flip of the buffers we check for key or mouse activity
      If KeyboardPushed(#PB_Key_All) Or MouseDeltaX()>2 Or MouseDeltaY()>2
        End
      EndIf
    ForEver
  ElseIf FindString(UCase(ProgramParameter(0)), "C")
    runmode = 2 ; Config mode, "/c" and the config hwnd come together in (0) in the form "/c:9999999999"
                ; You can use the supplied hwnd if desired or create your own config window
                ; Here there is nothing to configure so we just show a message box saying so
    DoConfig()
  EndIf
EndIf

; Procedures

Procedure PreviewCallback(hWnd, Msg, wParam, lParam) 
  Select Msg
    Case #WM_CLOSE 
      UnregisterClass_("PreviewWindowClass", GetModuleHandle_(#Null)) 
      DestroyWindow_(hWnd) 
      End 
      
  EndSelect 
  
  Result = DefWindowProc_(hWnd, Msg, wParam, lParam) 
  ProcedureReturn Result 
EndProcedure 

Procedure DoPreview()
  PreviewParent = Val(ProgramParameter(1))
  GetClientRect_(PreviewParent, @pp.RECT)
  preview_cx = pp\right-pp\left
  preview_cy = pp\bottom-pp\top
  PreviewWindowClass.WNDCLASS 
  Classname.s = "BlackHole Preview Class" 
  PreviewWindowClass\style = #CS_HREDRAW | #CS_VREDRAW 
  PreviewWindowClass\lpfnWndProc = @PreviewCallback() 
  PreviewWindowClass\cbClsExtra = 0 
  PreviewWindowClass\cbWndExtra = 0 
  PreviewWindowClass\hInstance = GetModuleHandle_(#Null) 
  PreviewWindowClass\hIcon = 0 
  PreviewWindowClass\hCursor = 0 
  PreviewWindowClass\hbrBackground = 0
  PreviewWindowClass\lpszMenuName = 0 
  PreviewWindowClass\lpszClassName = @Classname 
  RegisterClass_(PreviewWindowClass) 
  ratio.d = display_cy/display_cx
  preview_cy = ratio*preview_cx
  MyhWnd.l = CreateWindowEx_(0, Classname, "", #WS_CHILD | #WS_VISIBLE, 0, ((pp\bottom-pp\top-preview_cy)/2), preview_cx, preview_cy, PreviewParent, 0, GetModuleHandle_(#Null), 0) 
  OpenWindowedScreen(MyhWnd, 0, 0, display_cx, display_cy, 1, 0, 0)
  Repeat
    PeekMessage_(@message.msg, myhwnd, 0, 0, #PM_NOREMOVE)
    TranslateMessage_(message.msg)
    DispatchMessage_(message.msg)
    DoPresentation(runmode)
    Delay(1)
    ; Each call of DoPresentation() should draw one screen, flip the buffers and return
  ForEver
EndProcedure

Procedure DoPresentation(mode)
  
  ; BlackHole - BasicallyPure
  ; 7.5.2013
  ; PureBasic 5.20 beta <--- YOU NEED THIS
  
  Static firstrun=1
  #PIx2  = #PI * 2
  #Stars = 250
  #BlackHoleSpeed = 12 ; larger = slower
  
  If firstrun
    firstrun=0
    ExamineDesktops()
    Static dw   : dw = DesktopWidth(0)
    Static xMid : xMid = dw / 2
    Static dh   : dh = DesktopHeight(0)
    Static yMid : yMid = dh / 2
    Static dd   : dd = DesktopDepth(0)
    Static a, r, g, b, z, sprite, spriteColor, frameCount
    Static angle.f, BH_angle.f = #PI
    Static xRadius : xRadius = dw / 3
    Static yRadius : yRadius = dh / 3
    
    Structure starType
      x.f
      y.f
      speed.f
      nSprite.i
    EndStructure
    
    Static Dim star.starType(#Stars)
    For a = 0 To #Stars
      star(a)\x = Random(dw - 1)
      star(a)\y = Random(dh - 1)
      star(a)\nSprite = Random(13)
      star(a)\speed = star(a)\nSprite / 2.0 + 1
    Next
    
    For sprite = 0 To 13
      r = Random(255) : b = Random(255) : g = 255 - (r + b) >> 1
      spriteColor = RGB(r, g, b)
      CreateSprite(sprite, 16, 16)
      StartDrawing(SpriteOutput(sprite))
        Circle(7, 7, 3, spriteColor)
        LineXY(0, 7, 14, 7, spriteColor)
        LineXY(7, 0, 7, 14, spriteColor)
      StopDrawing()
      z = 6 + sprite * 2
      ZoomSprite(sprite, z, z) 
    Next sprite
    
    Static blackHole.Point
    blackHole\x = xMid - xRadius
    blackHole\y = yMid
  EndIf
  
  ClearScreen(#Black)
  
  For a = 0 To #Stars
    angle = ATan2(blackHole\x - star(a)\x, blackHole\y - star(a)\y)
    star(a)\x + star(a)\speed * Cos(angle)
    star(a)\y + star(a)\speed * Sin(angle)
    
    If Abs(star(a)\x - blackHole\x) < 5 And Abs(star(a)\y - blackHole\y) < 5
      Select Random(4, 1)
        Case 1 : star(a)\x = Random(dw - 1) : star(a)\y = 0
        Case 2 : star(a)\x = Random(dw - 1) : star(a)\y = dh - 1
        Case 3 : star(a)\x = 0 : star(a)\y = Random(dh - 1)
        Case 4 : star(a)\x = dw - 1 : star(a)\y = Random(dh - 1)
      EndSelect
    EndIf
    
    DisplayTransparentSprite(star(a)\nSprite,star(a)\x,star(a)\y)
    
  Next
  
  If frameCount < #BlackHoleSpeed : frameCount + 1
  Else : frameCount = 0
    BH_angle + Radian(1)
    If BH_angle > #PIx2 : BH_angle - #PIx2 : EndIf
    blackHole\x = Cos(BH_angle) * xRadius + xMid
    blackHole\y = Sin(BH_angle) * yRadius + yMid
  EndIf
  
  FlipBuffers()
EndProcedure

Procedure DoConfig()
  MessageRequester("BlackHole Screensaver Configuration","There are no user-configurable settings for this screensaver.",#MB_SYSTEMMODAL)
EndProcedure