Black Hole effect using sprites / 5.20 beta required

[bobobo]

cool demo
couldn't resist and made a BeagleVersion

Code: Select all

; BlackHole - BasicallyPure
; 7.5.2013
; PureBasic 5.20 beta <--- YOU NEED THIS
; BeagleVersion
EnableExplicit

#PIx2  = #PI * 2
#Stars = 250
#BlackHoleSpeed = 24 ; larger = slower

Declare Error(message$)

ExamineDesktops()
Define.i dw = DesktopWidth(0), xMid = dw / 2
Define.i dh = DesktopHeight(0), yMid = dh / 2
Define.i dd = DesktopDepth(0)
Define.i a, r, g, b, z, sprite, spriteColor, frameCount
Define.f angle, BH_angle = #PI
Define.i xRadius = dw / 3
Define.i yRadius = dh / 3
Define.i myBeagle
Structure starType
   x.f
   y.f
   speed.f
   nSprite.i
EndStructure

Define blackHole.Point
blackHole\x = xMid - xRadius
blackHole\y = yMid

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

If InitSprite() And InitKeyboard() And OpenScreen(dw, dh, dd, "Black Hole")
Else : Error("Failed To 'InitSprite/InitKeyboard/OpenScreen'")
EndIf

For sprite = 0 To 13
   r = Random(255) : b = Random(255) : g = 255 - (r + b) >> 1
   spriteColor = RGB(r, g, b)
   If CreateSprite(sprite, 16, 16) = 0 : Error("CreateSprite") : EndIf
   StartDrawing(SpriteOutput(sprite))
   Ellipse(7,7,6,3,$75CFFF)
   Ellipse(7,7,7,1,$003E65)
   
   StopDrawing()
   z = 6 + sprite * 2
   ZoomSprite(sprite, z, z) ; <-- does not belong inside start/stop drawing block!
Next sprite

myBeagle=CreateSprite(#PB_Any,20,20)
StartDrawing(SpriteOutput(myBeagle))
Ellipse(10,10,5,9,$75CFFF)
Ellipse(10,4,7,2,$75CFFF)
Ellipse(2,10,2,6,$003D66)
Ellipse(18,10,2,6,$003D66)
Circle(10,7,2,#Black);nose
Line(6,6,4,-3,#Black);Eye
Line(14,6,-4,-3,#Black);Eye
Ellipse(10,14,2,4,#Black);Mouth

StopDrawing()
ZoomSprite(myBEagle,50,50)


Repeat ; animation loop
   
  ClearScreen(#Black)
  DisplayTransparentSprite(mybeagle,blackHole\x-10,blackhole\y-20)
   ;StartDrawing(ScreenOutput()) ; <--- don't need this!
      For a = 0 To #Stars
         With star(a)
            angle = ATan2(blackHole\x - \x, blackHole\y - \y)
            \x + \speed * Cos(angle)
            \y + \speed * Sin(angle)
            
            If Abs(\x - blackHole\x) < 5 And Abs(\y - blackHole\y) < 5
               Select Random(4, 1)
                  Case 1 : \x = Random(dw - 1) : \y = 0
                  Case 2 : \x = Random(dw - 1) : \y = dh - 1
                  Case 3 : \x = 0 : \y = Random(dh - 1)
                  Case 4 : \x = dw - 1 : \y = Random(dh - 1)
               EndSelect
            EndIf
            
            DisplayTransparentSprite(\nSprite,\x,\y)
         EndWith
      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
      
   ;StopDrawing()
   FlipBuffers()
   ExamineKeyboard()
   
   If KeyboardPushed(#PB_Key_Escape) : End : EndIf
   
ForEver

Procedure Error(message$)
   MessageRequester("Fatal Error!", message$) : End
EndProcedure

[em_uk]

Haha! Nice work!

Glad I inspired you Sort of...

[em_uk]

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

[flaith]

...@flaith, @davido, @rsts

What kind of graphic cards do you have ? Can be nice to know for future reference since yours swallowed the code above without blinking an eye.

@luis & @BasicallyPure

Card name: Intel(R) HD Graphics Family with 1024MB mem
Computer (office) : LENOVO Win XP-SP3

[BasicallyPure]

@bobobo, nice beagle.

@em_uk, thanks for the screen saver tip.

Here is a version with new, nicer stars and coded with a screen saver in mind.
Pressing any key or moving the mouse will end the program.
I have tested it as a screen saver and it seems to work.
I just built an executable then renamed the extension to .scr as em_uk suggested.
Then using Windows 7, I placed the program in C:\Windows\System32 folder.

7/9/2013
Edit: now behaves better when selecting as a screen saver.

Code: Select all

; BlackHole - BasicallyPure 7/9/2013
;
; this can be used as a screen saver.
; create executable then rename to "BlackHole.scr"
; copy to C:\Windows\System32 folder
; 
; PureBasic 5.20 beta <--- YOU NEED THIS

EnableExplicit

Select LCase(Left(ReplaceString(ProgramParameter(), "-", "/"), 2))
   Case "/p", "/c" : End
EndSelect 

UsePNGImageDecoder()

#PIx2  = #PI * 2
#Stars = 250
#BlackHoleSpeed = 24 ; larger = slower

Declare Colorize_Sprite(nSprite.i, rm.f, gm.f, bm.f)

ExamineDesktops()
Define.i dw = DesktopWidth(0),  xMid = dw / 2
Define.i dh = DesktopHeight(0), yMid = dh / 2
Define.i dd = DesktopDepth(0)
Define.i a, n, frameCount
Define.f angle, BH_angle = #PI
Define.i xRadius = dw / 3
Define.i yRadius = dh / 3
Define.i sprite, spriteColor, z

Structure starType
   x.f
   y.f
   sof.i ; sprite offset
   speed.f
   nSprite.i
EndStructure

Dim star.starType(#Stars)

Define blackHole.Point
blackHole\x = xMid - xRadius
blackHole\y = yMid

If InitSprite() And InitKeyboard() And InitMouse() And OpenScreen(dw, dh, dd, "Black Hole")
Else : End
EndIf

CatchSprite(4, ?StarWhite)        ; type A star  (White)
Colorize_Sprite(0, 0.8, 0.2, 0.1) ; type M star  (Red)
Colorize_Sprite(1, 0.9, 0.5, 0.1) ; type K star  (Orange)
Colorize_Sprite(2, 1.0, 1.0, 0.2) ; type G star  (Yellow)
Colorize_Sprite(3, 1.0, 1.0, 0.7) ; type F star  (Yellow White)
Colorize_Sprite(5, 0.3, 0.9, 1.0) ; type B star  (Blue White)
Colorize_Sprite(6, 0.3, 0.6, 1.0) ; type O star  (Blue)
Colorize_Sprite(7, 0.1, 0.9, 0.1) ; type GG star (Green Giant)

Dim StarType(15)
For a = 0 To 14 Step 2
   StarType(a) = n : StarType(a + 1) = n
   n + 1
Next a
RandomizeArray(StarType())

For sprite = 0 To 15
   CopySprite(StarType(sprite), sprite + 8)
   z = sprite * 8 + 14
   ZoomSprite(sprite + 8, z, z)
Next sprite

For a = 0 To #Stars
   star(a)\x = Random(dw - 1)
   star(a)\y = Random(dh - 1)
   star(a)\nSprite = a / 16 + 8
   star(a)\speed = (star(a)\nSprite - 7) / 4.0 + 1
   star(a)\sof = SpriteWidth(star(a)\nSprite) >> 1
Next

Delay(500)
ExamineMouse() : MouseDeltaX() : MouseDeltaY()

Repeat ; animation loop
   
   ClearScreen(#Black)
   
   For a = 0 To #Stars
      With star(a)
         angle = ATan2(blackHole\x - \x, blackHole\y - \y)
         \x + \speed * Cos(angle)
         \y + \speed * Sin(angle)
         
         If Abs(\x - blackHole\x) < 5 And Abs(\y - blackHole\y) < 5
            Select Random(4, 1)
               Case 1 : \x = Random(dw - 1) : \y = -142
               Case 2 : \x = Random(dw - 1) : \y = dh + 141
               Case 3 : \y = Random(dh - 1) : \x = -142
               Case 4 : \y = Random(dh - 1) : \x = dw + 141
            EndSelect
         EndIf
         
         DisplayTransparentSprite(\nSprite, \x - \sof, \y - \sof)
      EndWith
   Next
   
   FlipBuffers()
   
   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
   
   ExamineKeyboard() : ExamineMouse()
   If KeyboardPushed(#PB_Key_All) Or MouseDeltaX() > 2 Or MouseDeltaY() > 2 : End : EndIf
ForEver

Procedure Colorize_Sprite(nSprite.i, rm.f, gm.f, bm.f)
   Protected.i x, y, p, i
   
   CopySprite(4, nSprite)
   StartDrawing(SpriteOutput(nSprite))
      For x = 0 To OutputWidth() - 1
         For y = 0 To OutputHeight() - 1
            p = Point(x, y)
            If p
               i = ( Red(p)*2 + Green(p)*4 + Blue(p) ) / 7
               Plot(x, y, RGB(i * rm, i * gm, i * bm))
            EndIf
         Next y
      Next x
   StopDrawing()
   
EndProcedure

DataSection
  StarWhite:
    ; size : 1943 bytes
    Data.q $0A1A0A0D474E5089,$524448490D000000,$8E0000008E000000,$6F96C20000000008,$59487009000000D4
    Data.q $1F0000381F000073,$0000F5273F930138,$DA78544144494907,$80165514706B9CED,$6779EEFDBEEEDEFB
    Data.q $E40C9324CCC99326,$C9089B8989300905,$8B2B8B5371640C98,$56B0285343C96A02,$52A5B0BA1FC5AD44
    Data.q $1595AD113E0AAEE5,$A28965151100B72C,$B55212091E44163C,$80F2640848080549,$CA5704076E1E64C9
    Data.q $39CAA733B55BB1FD,$39BE7BAABBAABA3F,$536E7D39EE7B9CF7,$949292524A494A88,$470A030C24E7E4A4
    Data.q $C48799A362854152,$2182B23848123663,$1C7470A0B2AA960D,$66C8E121A15E1C24,$0270E1401923B650
    Data.q $506870A0889959A8,$A50E6470B0094E7E,$1DB2C08B3D9FF3B4,$22A0D3501160D601,$D4E2D60D832C1A81
    Data.q $71C2807349C243C6,$4D414B726CCA83E5,$07EB19DA504ADE3C,$6A78E1416BB22515,$92112A9CF76B4825
    Data.q $55B9C525412BB8F1,$DD115024CF2CF2A0,$4859BBD1E241CF94,$A83D10EFAAC123B6,$2F329921E931019A
    Data.q $56690F1706120A81,$B829C201342E4C76,$DCBADEC2A4A80DD3,$1CCDD786E478C808,$19E4B67BC6474F18
    Data.q $A4B0A5168FD6492D,$2BCFA69CDEE974EA,$4259A1C5C90C2BCA,$3DA7DBF2A2ACAE6C,$D5524372CCEF7AD7
    Data.q $B2F298E76E190D83,$D8F93FADE607ACC0,$42E05E4C454CE2DC,$8EFFB1697D4D6E62,$679E83EE7E9ECBF9
    Data.q $7349AB712E29A89F,$CFF7C58696EB2677,$FEF5BCAF8FF4BC5F,$A6F5399EACEF8B81,$FD59509524B4FCA2
    Data.q $F1B5BD57C79CC0D8,$B031D3DCEE9F8DD5,$2BE17ED3C5EAEB6B,$071731343F452730,$EF76FB47DAF93C16
    Data.q $DC1DB509E96F696A,$BA1C4AEACBCFE1BB,$BF9FA9CE608FD864,$9C75778F7B87DD7C,$F4FA7DD23FDB39E9
    Data.q $ED791754E7EB5DE1,$B329F8CF62A65F89,$E7B3CFF2DCDB5D1F,$4BFED1C34BC182FA,$E0D19E1EDB2DDD43
    Data.q $FC4B503E5E1359F7,$C5D4F876D85F1A73,$58D123C343BD0BFE,$8AED67B9D0323A24,$17625A4273BC2DDF
    Data.q $F65BCD561775581B,$783CBC1DBE2797F6,$58F1E3C589122061,$313CEFEDFED742F8,$B75F025288A1CF23
    Data.q $D99E47DA9CA2F6F1,$143850A1DE8E8FF4,$478F177DDFE2C68A,$A6B4B7BC0EBBFB87,$09BFFFCBB76695CC
    Data.q $AC68A6985111EAEF,$97A6B4C95E6B391D,$448E14BBEEE9BF9B,$AFA868B13C68D0AE,$D2B3B2060F2BC77D
    Data.q $BA34507768960E9D,$5FE1EBB7746EDD1A,$234C1850AFFE267B,$644534D14B30A246,$9EBB94E70E6C1255
    Data.q $239782676D17CBFC,$6743C2794669EFD1,$9DCE3B545A5F9B5B,$8B1188886584C461,$988F476298C6CB34
    Data.q $3DAB34B3C5FFB5A1,$2C6FA196294ED695,$A13425DFB5576A2B,$1E8E109A64118644,$61D98AF322186685
    Data.q $CD8B6C9EB93D3AB7,$EE76B0BD8288B46C,$FCEBB5BCFDDF1792,$F1A346BB162470E0,$FBED8FBB072E4744
    Data.q $6577743C57D7DDF8,$F2BCAEEC506ACDA6,$36595FCEBFB57F4A,$49595261D63D97CE,$339364E934595862
    Data.q $B087A83789D7A0DD,$B20C32512C8B232C,$28E1810648A194C1,$7A559F4BAB78E39A,$3FD536DDD7372DF3
    Data.q $AE75EBB365C0A8B5,$F8FBB6DDAD568B29,$1F9E51A1C3430BC9,$5B3DCEC191916270,$1DABEFEFF4FCBE37
    Data.q $C8C86ABD783870E7,$284FE5E76516E574,$19E4493496745870,$AA2A2F0CB135348C,$4221CD160E37F1C4
    Data.q $4F1CB0C33CB308D3,$84C20CD108D02F30,$2C58B46EC1934467,$145820AC70A2B366,$B75F1F0B99B4F96F
    Data.q $A18BDEF9CF74E5BD,$F760A5E89A75D8E1,$B2E05356DC0F75C1,$184F32322CBD555A,$8C2A92092264E18E
    Data.q $B58B01D9AF842062,$E2DEF90B09FA140B,$87F66303BFEE19AE,$AC4E67B2497EED33,$9C8F3BDBF96BBCAA
    Data.q $AFC68A103DD538E8,$CD6CFB1F4E8644D1,$B5E25915D263D57D,$AE846CF2BA30A791,$59E6FFD047CA7E1C
    Data.q $AD2A2ECB8118CFD7,$6F1E8EBBCD99E7BF,$744F2AE0797F38EF,$1596D5FB381A1C24,$318CF4D749CCA9BF
    Data.q $7FD37D3925F0A095,$B5B68FFBED8DF4BD,$63C5891E1C18BA9F,$FB9DB7EF5F60E8B1,$34262193CFADF85E
    Data.q $63D67CA0596B616E,$BABA6FD6ABF2FB7F,$F0E191E2450FF54E,$B87F1DB1E7476740,$C765D51C1250E3D5
    Data.q $BCDEFEEB8D1DDF44,$A1826723A1C4EDBF,$FCDCDE3C1837B878,$9D12D8C76A9BE7D7,$F2B05815DF3960E3
    Data.q $D1F7607238BEF7CD,$CF279D3D22FAE733,$985FD9359A6A6FB5,$5564F78792F84A6B,$F7D6C366B4D798CE
    Data.q $763E13D9D1D0393F,$3DE3D996F0F3B5B8,$3D122009F1313A85,$53E8F25C2DD53745,$F0AEEBE87BDCDF2B
    Data.q $DCEAF1DC1C774FEE,$CD30954A4F919B4C,$8FFDEA65349BEF95,$6E0D0ECFE6C9FF3C,$321A87FAC37AB35A
    Data.q $959C8C2B2A7242AD,$8AC961BDBE2CCF6F,$F783E567B9B4FF87,$AC9F558272FE3636,$9365E9E9DDEB0FDC
    Data.q $DDD5582FA605D7C7,$24AECCA935503D38,$D93D79D444C5132F,$2A05B497AB4B6325,$0C65A93E161D7926
    Data.q $672335A66F7A2B4C,$A4E61CD9655FC1F6,$74D2DBD3AC206277,$E801272ADC2B3BD5,$BDEB65AAAF2C4465
    Data.q $A26EB50844E60A19,$20428E15B2AB3CE8,$E19916D896604BDE,$C0A9DEB182308534,$3732A0273A0A9C29
    Data.q $044CB400EF5012C3,$4D98384806220E12,$19870A02C7A940A7,$A7DA90899DB283C7,$0ABE2C1A40A35711
    Data.q $58D66586A4054E16,$094540F89A7FAA0B,$A41F38E094520CA6,$8A9D3540F82472EE,$56D400B960E12113
    Data.q $6A8371870A03D600,$9031E470A0BCE4F2,$016B0E141EA141A6,$0E33A902610D7BB5,$B506862918BAA0D1
    Data.q $18129CF541568013,$20E121B922EB9DA5,$2DF280CC565419A7,$A7B5858A23B5016C,$9CB5418A73D58298
    Data.q $DAC225835853AB6A,$AB0883D4FAC02B36,$A071D20ED24323BE,$A0459B6D61E23A22,$E4A494B0F5F53D1C
    Data.q $AC971256242FF247,$4900000000AE0A31
    Data.b $45,$4E,$44,$AE,$42,$60,$82
EndDataSection

[em_uk]

Great work!

[Olliv]

@bp

(first code page 1)
Works fine on VIA Chrome9 HC3 IGP
(was very hi tech in... 2002)

But... You wondered Isaac Newton to eat his apple! There is no acceleration depending of the distance (Accel = Mass / Pow(Distance, 2) )

Else the effect is joli.

Thanks for the comments too. It allows to see language has changed.

Olliv

[wilbert]

An experiment with the Superformula to draw sprites
http://en.wikipedia.org/wiki/Superformula
http://www.procato.com/superformula/

SuperSprite.pbi

Code: Select all

Procedure CreateSuperSprite(SpriteNr, Size, LineColor, FillColor, a.d, b.d, m.d, n1.d, n2.d, n3.d, p=1024, t=0, r.d=0)
  Dim SFPoint.d(1023)
  Protected.i Result, Image, x1, y1, x2, y2, i
  Protected.d r0, t0, t1 = 0.5*#PI*m/p, t2, t3=2*#PI/p 
  
  For i = 0 To 1023
    t0 = i*t1
    t0 = Pow((Pow(Abs(Cos(t0)/a),n2)+Pow(Abs(Sin(t0)/b),n3)),-1/n1); Super-formula
    t2 = i*t3
    Select t
      Case 1
        t0 * t2
      Case 2
        t0 * Sin(t2)
      Case 3
        t0 * Cos(t2)
      Case 4
        t0 * Sqr(t2)
    EndSelect
    SFPoint(i) = t0
    t0 = Abs(t0)
    If t0 > r0 : r0 = t0 : EndIf
  Next
    
  LineColor & $ffffff : FillColor & $ffffff
  If LineColor = 0 : LineColor = $010101 : EndIf
  If FillColor = 0 : FillColor = $010101 : EndIf
  If LineColor = FillColor : LineColor ! 1 : EndIf
  
  Image = CreateImage(#PB_Any, Size << 1 + 4, Size << 1 + 4, 24)
  StartDrawing(ImageOutput(Image))
  Box(0, 0, ImageWidth(Image), ImageHeight(Image), FillColor)
  r0 = Size / r0
  r = Radian(r)
  x1 = 2 + Size + SFPoint(0) * Cos(r) * r0
  y1 = 2 + Size + SFPoint(0) * Sin(r) * r0
  For i = 1 To 1023
    x2 = 2 + Size + SFPoint(i) * Cos(i*t3+r) * r0
    y2 = 2 + Size + SFPoint(i) * Sin(i*t3+r) * r0
    LineXY(x1, y1, x2, y2, LineColor)
    x1 = x2
    y1 = y2
  Next
  FillArea(0, 0, LineColor, 0)
  StopDrawing()
  ResizeImage(Image, Size + 2, Size + 2)
  
  Result = CreateSprite(SpriteNr, Size, Size)
  If SpriteNr = #PB_Any : SpriteNr = Result : EndIf
  StartDrawing(SpriteOutput(SpriteNr))
  DrawImage(ImageID(Image), -1, -1)
  StopDrawing()
  FreeImage(Image)
  
  ProcedureReturn Result
EndProcedure

Code: Select all

EnableExplicit

IncludeFile "SuperSprite.pbi"

#PIx2  = #PI * 2
#Stars = 250
#BlackHoleSpeed = 24 ; larger = slower

ExamineDesktops()
Define.i dw = DesktopWidth(0),  xMid = dw / 2
Define.i dh = DesktopHeight(0), yMid = dh / 2
Define.i dd = DesktopDepth(0)
Define.i a, n, frameCount
Define.f angle, BH_angle = #PI
Define.i xRadius = dw / 3
Define.i yRadius = dh / 3
Define.i sprite, spriteColor, z

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  If dd = 24 : dd = 32 : EndIf
  Structure Point
    x.i
    y.i
  EndStructure
CompilerEndIf

Structure starType
  x.f
  y.f
  sof.i ; sprite offset
  speed.f
  nSprite.i
EndStructure

Dim star.starType(#Stars)

Define blackHole.Point
blackHole\x = xMid - xRadius
blackHole\y = yMid

If InitSprite() And InitKeyboard() And InitMouse() And OpenScreen(dw, dh, dd, "Black Hole")
Else : End
EndIf

CreateSuperSprite(0, 64, $c0ffff, $000000, 1, 1, 2, 0.5, 0.5, 0.5, 384, 1, 155); nebula 1
CreateSuperSprite(1, 16, $00ffff, $00c0f0, 1, 1, 7, 3, 6, 6); star 1
CreateSuperSprite(2, 64, $00e0ff, $000000, 1, 1, 80, 12, 8, 8, 512, 1, 45); nebula 2
CreateSuperSprite(3, 32, $c0ffff, $000000, 1, 1, 5, 3, 6, 6, 128, 1, 90); star 2
CreateSuperSprite(4, 24, $00e0ff, $ffffff, 1, 1,  12, 1, 2, 50); star 3
CreateSuperSprite(5, 20, $00ffff, $c0e0ff, 1, 1, 10, 1, 0.5, 2); star 4
CreateSuperSprite(6, 16, $ff8080, $ffffff, 1, 1, 7, 3, 4, 17); star 5
CreateSuperSprite(7, 24, $c0ffff, $f0c0c0, 1, 1, 7, 2, 8, 4); star 6

For a = 0 To #Stars
  star(a)\x = Random(dw - 1)
  star(a)\y = Random(dh - 1)
  star(a)\nSprite = a % 8
  star(a)\speed = (star(a)\nSprite - 7) / 4.0 + 1
  star(a)\sof = SpriteWidth(star(a)\nSprite) >> 1
Next

Delay(500)
ExamineMouse() : MouseDeltaX() : MouseDeltaY()

Repeat ; animation loop
  
  ClearScreen(0)
  
  For a = 0 To #Stars
    With star(a)
      angle = ATan2(blackHole\x - \x, blackHole\y - \y)
      \x + \speed * Cos(angle)
      \y + \speed * Sin(angle)
      
      If Abs(\x - blackHole\x) < 5 And Abs(\y - blackHole\y) < 5
        Select Random(4, 1)
          Case 1 : \x = Random(dw - 1) : \y = -142
          Case 2 : \x = Random(dw - 1) : \y = dh + 141
          Case 3 : \y = Random(dh - 1) : \x = -142
          Case 4 : \y = Random(dh - 1) : \x = dw + 141
        EndSelect
      EndIf
      
      DisplayTransparentSprite(\nSprite, \x - \sof, \y - \sof)
    EndWith
  Next
  
  FlipBuffers()
  
  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
  
  ExamineKeyboard() : ExamineMouse()
  If KeyboardPushed(#PB_Key_All) Or MouseDeltaX() > 2 Or MouseDeltaY() > 2 : End : EndIf
ForEver

[luis]

An experiment with the Superformula to draw sprites
http://en.wikipedia.org/wiki/Superformula
http://www.procato.com/superformula/

NAAAAAAAAAAAAH!

I'm absolutely stealing this.

Thanks!

edit: my graphics card is ATI Radeon / msi R5450.
1GB DDR3
supports directX 11
purchased 10/31/2012

driver by ATI Technologies Inc.
driver date: 1/26/2011
driver version: 8.821.0.0

Thank you

[davido]

@luis,

Apologies for my tardiness.

My computer uses an I3 processor and has no graphics card!

[BasicallyPure]

Wilbert you never cease to amaze me.

I don't know if it was intentional but with your code I see some objects moving away from the black hole,
some don't move at all, and some move too slowly to catch it.
If you want to restore the original movement you can change line 58 (this line):

Code: Select all

star(a)\speed = (star(a)\nSprite - 7) / 4.0 + 1

to this:

Code: Select all

star(a)\speed = (star(a)\nSprite ) / 4.0 + 1

BP

[luis]

@flaith, @davido

Thanks for the info.

So we have one ATI card and two Intel HD, VS two nVidia were the "bad code" actually behaved badly.

Good to know (maybe).

[wilbert]

I don't know if it was intentional but with your code I see some objects moving away from the black hole,
some don't move at all, and some move too slowly to catch it.
If you want to restore the original movement you can change line 58 (this line):

Code: Select all

star(a)\speed = (star(a)\nSprite - 7) / 4.0 + 1

to this:

Code: Select all

star(a)\speed = (star(a)\nSprite ) / 4.0 + 1

BP

Thanks, it wasn't intentional.
I didn't mind the changed behavior but also didn't know what caused it

One thing I didn't explore but also would be possible using the super formula is shape morphing.
If you calculate the polygon for each shape with the same amount of points (1024 currently), you could morph two of them using a tween function.
Might also be nice.

[davido]

@BasicallyPure,

Many thanks

I, too, noticed the 'problem' you mentioned, but did not understand how I might change it.
With both wilbert and luis apparently being happy with it I wanted to be certain before mentioning it!
With this change the galaxies get engulfed, too. A rather voracious black hole, perhaps!

[luis]

I noticed something different too but honestly I forgot about it the instant I start looking at the links wilbert posted.