Compétition PurePunch été 2010

**comtois** · 18/07/2010, 22h33

djes lance un nouveau PurePunch, voir le détail ci-dessous. La limite de 200 lignes de code permet d'utiliser la version démo de PureBasic pour ceux qui seraient tenter de présenter une démo sans pour autant acheter la licence pour la version complète.

C'est un concours lancé par un utilisateur de PureBasic pour s'amuser.

Juillet-Août 2010

Voici la Compétition PurePunch de l'été 2010

Une seule catégorie : DEMO !
Montrez ce que vous savez faire, par une savante combinaison de code, de musique et d'infographie. Une démo peut aussi contenir des mini-jeux, ou être n'importe quoi qui montre les possibilités de l'ordinateur, en repoussant les limites ! Que le meilleur gagne !

Les lots :
Taznormand offre une carte FireWire PCI 3 ports externes+1 port interne au vainqueur (livraison limitée)
Gildev offre :

une souris optique USB (en OEM donc sans boîte)
un tapis souris
un stylo

Merci à eux!
Si quelqu'un veut sponsoriser cette compétition, qu'il le fasse savoir. Je mettrai ici les prix et les informations correspondantes, ainsi que dans l'archive finale.

Les règles :

1° Le programme sera fait en Purebasic (quelque version que ce soit) sans l'ajout de bibliothèque utilisateur (userlib).
2° Le source du programme ne devra comporter que 200 lignes de 80 caractères par ligne. Inutile de tergiverser, ça ne changera pas!
3° Etre original, c'est à dire soit être une création complète, soit apporter quelque chose de nouveau à un code existant.
4° Ne pas être néfaste.
5° Possibilité de joindre une (et une seule) image d'une taille maximale de 512 pixels de large sur 512 pixels de haut, en 32 bits. La poster sur le forum ou sur un site accessible durant toute la durée de la compétition, ou la joindre à l'archive complète du projet liée dans le post sur le forum.
6° Possibilité de joindre un fichier sonore (et un seul) d'une taille maximale de 1Mo. Le poster sur un site accessible durant toute la durée de la compétition, ou le joindre à l'archive complète du projet liée dans le post sur le forum.
7° Il sera possible d'ajouter une ligne de code (non comptée) en début de source avertissant l'utilisateur d'une spécificité du programme (comme par exemple une attente ou la nécessité d'utiliser un subsystem particulier). Celle-ci devra être de la forme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MessageRequester("Information","txt",#PB_MessageRequester_Ok)

8° Un délai de deux mois pour créer le meilleur PurePunch!

A la fin de la période (du 1er au 15 septembre), un fil pour le vote sera mis en place afin d'élire le meilleur programme. Seules les personnes inscrites avant le 1er juillet pourront voter (3 points pour le 1er, 2 points pour le second, 1 point pour le troisième).

Comment poster :
Postez le code dans le forum après y avoir ajouté et complété l'entête suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
;*****************************************************************************
;*
;* Summer 2010 PurePunch Demo contest
;* 200 lines of 80 chars, two months delay
;*
;* Name     : 
;* Author   :
;* Date     :
;* Purebasic Version :
;* Notes    :
;*
;*****************************************************************************

Bonne chance à tous les compétiteurs!

**comtois** · 18/07/2010, 22h39

quelques démos sont déjà sorties, ici celles de G-Rom
(les archives comportent le code source et des exécutables pour windows et Linux pour tester sans PureBasic)

invade-demo

Invade-Demo-2

**comtois** · 18/07/2010, 22h39

Une démo de SPH

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Zoom
; SPH(2010)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
InitSprite()
InitKeyboard()
InitMouse()
UseJPEGImageDecoder()
 
#dw=1024
#dh=768
#dc=32
 
If OpenScreen(#dw,#dh,#dc,"zoom")=0
MessageRequester("Erreur", "Screen Open impossible a ouvrir", 0) : End
EndIf
 
CreateImage(0,#dw,#dh)
ImageID0 = ImageID(0)
 
i=8
 
Repeat
 
StartDrawing(ScreenOutput())
DrawImage(ImageID0,-i,-i,#dw+i*2,#dh+i*2)
StopDrawing()
 
For u=5 To 60 Step 8
LoadFont(0, "Arial", u)
StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(FontID(0))
DrawText(Random(#dw-u),Random(#dh-u),Chr(Random(222)+33), RGB(Random(255),Random(255),Random(255)),0)
StopDrawing()
Next
 
StartDrawing(ScreenOutput())
GrabDrawingImage(0,0,0,#dw,#dh)
ImageID0 = ImageID(0)
StopDrawing()
FlipBuffers()
;Delay(3)
 
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End

**comtois** · 21/07/2010, 22h27

Une démo d'Infratec (un participant allemand) :

PBSlider.zip

L'archive contient le code source et les médias.

It's a demo of the possibilities of PB

A small game called PBSlider.

With some specialties at the commandline.
Per default the picture which is shown is the PB Box in square, and the puzzle is
4 by 4.

If you have more time, simply pass a number between 4 and 7 as parameter.
If you want an other picture as puzzle, simply give the name of a jpg file as parameter.
(It should be square

)

And if you have enough, you can exit the game. The current state is saved in an ini file.

**comtois** · 27/07/2010, 19h10

Voici une démo d'un anglais (moogle) bien sympa qui montre comment agir sur les sprite3D , ce code ne participe pas au concours, bien qu'il pourrait , ça en jette !
C'est un exemple pour ceux qui seraient tenté de participer. Et surtout il montre comment modifier un sprite3D.

Vous pouvez aussi télécharger l'exécutable pour tester sans PureBasic

http://www.mediafire.com/?d6aw79b9fam29i9

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
Structure Timer
   currentTick.l
   lastTick.l
   elapsedTicks.l
EndStructure
 
Procedure.a initTimer(*sTimer.Timer)
   If *sTimer.Timer
      *sTimer.Timer\currentTick=timeGetTime_()
      *sTimer.Timer\lastTick=*sTimer.Timer\currentTick
      ProcedureReturn 1
   Else
      ProcedureReturn 0
   EndIf
EndProcedure
 
Procedure.l updateTimer(*sTimer.Timer)
   *sTimer.Timer\currentTick=timeGetTime_()
   *sTimer.Timer\elapsedTicks=*sTimer.Timer\currentTick-*sTimer.Timer\lastTick
   *sTimer.Timer\lastTick=*sTimer.Timer\currentTick
   ProcedureReturn *sTimer.Timer\elapsedTicks
EndProcedure
 
Procedure.l checkTimer(*sTimer.Timer)
   *sTimer.Timer\currentTick=timeGetTime_()
   *sTimer.Timer\elapsedTicks=*sTimer.Timer\currentTick-*sTimer.Timer\lastTick
   ProcedureReturn *sTimer.Timer\elapsedTicks
EndProcedure
 
Procedure.l getTimer(*sTimer.Timer)
   ProcedureReturn *sTimer.Timer\elapsedTicks
EndProcedure
 
Macro RandomFloat()
   Random(2147483647)/2147483647.0
EndMacro
 
Macro DrawTextShadow(x, y, z, Text, FColor, BColor)
   DrawText(x  , y  , Text, BColor)
   DrawText(x-z, y-z, Text, FColor)
EndMacro
 
;-DirectX Constants
#D3DBLEND_ZERO            = 1
#D3DBLEND_ONE             = 2
#D3DBLEND_SRCCOLOR        = 3
#D3DBLEND_INVSRCCOLOR     = 4
#D3DBLEND_SRCALPHA        = 5
#D3DBLEND_INVSRCALPHA     = 6
#D3DBLEND_DESTALPHA       = 7
#D3DBLEND_INVDESTALPHA    = 8
#D3DBLEND_DESTCOLOR       = 9
#D3DBLEND_INVDESTCOLOR    = 10
#D3DBLEND_SRCALPHASAT     = 11
#D3DBLEND_BOTHSRCALPHA    = 12
#D3DBLEND_BOTHINVSRCALPHA = 13
 
; DirectX9
Structure D3DTLVERTEX
   x.f:y.f:z.f
   rhw.f:Color.l
   tu.f:tv.f
EndStructure
 
Structure PB_DX9Sprite3D
   TexRes.l                    ; TexRes
   Vertice.D3DTLVERTEX[4]      ; The 4 vertices for the rectangle sprite
   TmpVertice.D3DTLVERTEX[4]   ; The 4 vertices for the rectangle sprite
   Width.l                     ; width set with ZoomSprite3D()
   Height.l                    ; height set with ZoomSprite3D()
   RealWidth.l
   RealHeight.l
   Angle.f
   Transformed.l
EndStructure
 
Structure SFlame
   x.f
   y.f
   r.a
   g.a
   b.a
   xv.f
   yv.f
   life.l
   alife.b
EndStructure
 
NewList flameList.SFlame()
Global pWnd
 
Procedure CFade(sColor.l, eColor.l, cStep.f)
   Define.f fR, fG, fB
   Static run.l
   b1=sColor >> 16
   g1=sColor >> 8 - (b1 << 8)
   r1=sColor - (b1 << 16 + g1 << 8)
 
   b2=eColor >> 16
   g2=eColor >> 8 - (b2 << 8)
   r2=eColor - (b2 << 16 + g2 << 8)
 
   d1=r2-r1
   If d1
   s1=d1/d1
   d1*Sign(d1)
   EndIf
 
   d2=g2-g1
   If d2
   s2=d2/d2
   d2*Sign(d2)
   EndIf
 
   d3=b2-b1
   If d3
   s3=d3/d3
   d3*Sign(d3)
   EndIf
 
 
   d1*s1
   d2*s2
   d3*s3
 
   percent.f=cStep*run
   fR.f=d1*percent
   fG.f=d2*percent
   fB.f=d3*percent
 
   tr1.f=r1-fR
   tg1.f=g1-fG
   tb1.f=b1-fB
   r1=Int(tr1)
   b1=Int(tg1)
   g1=Int(tb1)
 
   If r1 > 255 : r1 = 255 : EndIf
   If g1 > 255 : g1 = 255 : EndIf
   If b1 > 255 : b1 = 255 : EndIf
 
   If r1 < 0 : r1 = 0 : EndIf
   If g1 < 0 : g1 = 0 : EndIf
   If b1 < 0 : b1 = 0 : EndIf
 
   color=RGB(r1,g1,b1)
   run+1
   If r1=r2 And g1=g2 And b1=b2
      run=0
   EndIf
   ProcedureReturn color
EndProcedure
 
Procedure SetColor(Sprite3D, Color.l)
   Protected *Sprite3D.PB_DX9Sprite3D = IsSprite3D(Sprite3D)
   With *Sprite3D
      \Vertice[0]\Color = Color.l
      \Vertice[1]\Color = Color.l
      \Vertice[2]\Color = Color.l
      \Vertice[3]\Color = Color.l
   EndWith
EndProcedure
 
Procedure CreateFlame(x.f, y.f, xv.f, yv.f,   life)
   Shared flameList()
   AddElement(flameList())
   flameList()\x=x-(32*1.2)
   flameList()\y=y-(32*1.2)
   flameList()\r=255
   flameList()\g=255
   flameList()\b=255
   flameList()\xv=xv
   flameList()\yv=yv
   flameList()\life=life
   flameList()\alife=-1
EndProcedure
 
Procedure UpdateFlame()
   Shared flameList()
   Start3D()
   ForEach flameList()
      flameList()\yv+RandomFloat()
      flameList()\x+flameList()\xv
      flameList()\y+flameList()\yv
      flameList()\r=255
      flameList()\g=105
      flameList()\b=65
      SetColor(0, RGB(flameList()\b, flameList()\g, flameList()\r)) ; B,G,R
      flameList()\life+flameList()\alife
 
      If (flameList()\x > -(64*1.2) And flameList()\x < 640+(64*1.2)) And (flameList()\y > -(64*1.2) And flameList()\y < 480+(64*1.2))
         DisplaySprite3D(0, flameList()\x, flameList()\y)
      EndIf
      flameList()\life+flameList()\alife
 
      If flameList()\life <= 0 Or flameList()\y > 480
         DeleteElement(flameList())
      EndIf
   Next
   Stop3D()
EndProcedure
 
If InitSprite()
   If InitSprite3D() = 0
      MessageRequester("Error", "Can't open DirectX", 0)
      End
   EndIf
Else
   MessageRequester("Error", "Can't open DirectX", 0)
   End
EndIf
 
pWnd=OpenWindow(#PB_Any, 0, 0, 640, 480, "Flame Test", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_BorderLess)
If pWnd
   ;SetWindowColor(pWnd, #Black) <--- Doesn't seem to work
   If Not OpenWindowedScreen(WindowID(pWnd), 0, 0, 640, 480, 1, 0, 0, #PB_Screen_SmartSynchronization)
      MessageRequester("Error", "Can't open windowed screen!", 0)
      End
   EndIf
Else
   MessageRequester("Error", "Can't open window!", 0)
EndIf
 
UsePNGImageDecoder()
CatchSprite(0, ?Spark, #PB_Sprite_Texture)
CreateSprite3D(0, 0)
LoadFont(0, "Verdana", 8, #PB_Font_Bold)
Start3D()
Sprite3DBlendingMode(#D3DBLEND_SRCALPHA, #D3DBLEND_ONE)
; Comment the Next line if it runs slow
Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)
ZoomSprite3D(0, 1.2*SpriteWidth(0), 1.2*SpriteHeight(0))
Stop3D()
 
 
ExamineDesktops()
f = DesktopFrequency(0)
If f = 0
  targetFps.a=50
Else
  targetFps.a=f
EndIf
frameTime=1000/targetFps
SetFrameRate(targetFps)
 
clsColor=#White
fps.Timer
flip.Timer
 
initTimer(fps):initTimer(flip)
 
Define.f fpsAccurate
Repeat
   Event = WindowEvent()
   Select Event
      Case #PB_Event_CloseWindow
         Quit = 1
   EndSelect
   If GetActiveWindow() = pWnd
            updateTimer(flip)
            If clsColor <> #Black
               clsColor=CFade(#White, #Black, 0.0225)
            EndIf
            ClearScreen(clsColor)
            If (GetKeyState_(#VK_LBUTTON)&%10000000 And GetActiveWindow() = pWnd)
               yv.f=-10
               For lx = 1 To 10 Step 2
                  yv-RandomFloat()
                  CreateFlame(DesktopMouseX()-WindowX(pWnd), DesktopMouseY()-WindowY(pWnd)-5,  lx/10, 1.1*yv, 240)
                  CreateFlame(DesktopMouseX()-WindowX(pWnd), DesktopMouseY()-WindowY(pWnd)-5, -lx/10, 1.1*yv, 240)
               Next
            EndIf
            UpdateFlame()
            StartDrawing(ScreenOutput())
            DrawingMode(#PB_2DDrawing_Transparent)
            DrawingFont(FontID(0))
            DrawTextShadow(10, 10    , 1, Str(ListSize(flameList()) )+" Particles", RGB(255,255,255), RGB(0,0,0))
            DrawTextShadow(10, 480-20, 1, StrF(fpsAccurate,1)+" FPS"              , RGB(255,255,255), RGB(0,0,0))
            StopDrawing()
 
            FlipBuffers()
 
            fpsFrameCount+1
            fpsTimer=checkTimer(fps)
            If fpsTimer >= 1000
               fpsAccurate=(fpsFrameCount/fpsTimer)*1000
               fpsFrameCount=0
               updateTimer(fps)
            EndIf
 
            ;Delay Until near the Next flip
            dTime=frameTime-checkTimer(flip)
            If dTime >= 1
               Delay(dTime)
            EndIf
         Else
            Delay(50)
         EndIf
Until  Quit Or (GetKeyState_(#VK_ESCAPE)&%10000000 And GetActiveWindow() = pWnd)
CloseScreen()
End
 
DataSection
   Spark:
   Data.q $A1A0A0D474E5089, $524448490D000000, $4000000040000000, $7169AA0000000608, $59487009000000DE, $B0000130B000073, $189C9A000113, $414D41670400
   Data.q $9351FB7C8EB1, $4D5248632000, $83800000257A, $E9800000FFF9, $60EA00003075, $5F926F170000983A, $44494E15000046C5, $60606462DA785441
   Data.q $B10040018230CFF8, $C4C110464612C3D0, $8408CD181CC0A600, $890FFEC8006291FF, $FFFFC581FFFFFF92, $C95A00400FC6DA7, $3FECA8104180006E, $F10F0DA0DD803633
   Data.q $5021808009BE1779, $6C7636EE821E8BB8, $7818482B1DEEFEEC, $F60F9E722A9FA089, $830000DC192AC008, $8D4171BFEE9AB020, $BB8E3DF0907C09C5, $FE1FE32DD81ADA6B
   Data.q $921AEA775B817774, $1E0B81213D4E31CF, $19ED60E350F18CC0, $279071E5A8588021, $A86C41F624233131, $21480ACA47CC1C7, $FC0B3834C70070B0, $EFF7FE901FF67887
   Data.q $6040241FE99C582F, $64E9002002034A7C, $FFA540C20800038C, $89C5718A02C1327F, $80C8027F28EED94, $7100251984302450, $FEA02911A33114F9, $761E074D58029FF
   Data.q $816CCEC558408BD4, $587AE8CAEEE114BA, $2080003905527002, $CDA22EB1FFFF4648, $5BF100E2E549DAEA, $B6693720C997680, $115E33DC4D06C20, $FD76FF3BFC4E0BFD
   Data.q $A9F269B26955FD3E, $97D418D89112C29D, $1949C00A6150FAF0, $FFCCD030C10000ED, $69223C23574571FF, $49A012F9D6EEDE22, $9D84A7C05AE13807, $BF05D5252729E010
   Data.q $8701FD742B2C1D6, $A54C1FD678100490, $1BE7401A01240704, $19CBC36CC14A66EF, $3083002946565002, $3032F0BFF7A6AD0C, $8AD487DCBEDB0AA9, $8B3B0037E6917908
   Data.q $CEB322B3616E129E, $685CD78030BE3D53, $B428AC203FA21D3B, $A25AEEEFEFC4B1E3, $D50419697F6B3EED, $5F7536F5AA1CC637, $B28010C5A71F7830, $946861040001C772
   Data.q $E09F8A44D6C2FFDE, $F8A56D7B618903A6, $B03614171D36743A, $47F0DEF4BB5803C3, $11A96AFD116F3908, $75A1D0D7F15FFF52, $494D815F5D70C9F9, $725D2CB155D64060
   Data.q $F030A622B9A5A086, $394656300218349, $3FF701850C20830, $62DAFB2488B5B24B, $89FFD428FB1A5F8C, $EC11E16C8966A997, $BD00BC0031E118F5, $C60F745BA45F02DB
   Data.q $41CC76B7A8798003, $F4FF69E54C21163C, $85934EC330807B6D, $34192F7C5AF2093, $E77520B9CA52DDF1, $14972D18011E252B, $DFFBD45288106180, $C85DD34E38ED0AB7
   Data.q $7EA33F3C86164242, $3E8D82D413514F02, $20262004C7B86643, $7FC711F33F1B0CAC, $52452D7B980F482A, $9E4B0FF0D7B19FF, $F095A01D3E64301E, $5E6937E97550EA2F
   Data.q $4FAB9FBBD9F837DC, $20057876FB26D155, $3A18418400760CB4, $307380AF7FFFDD83, $FA481D92278C5E60, $9CFD122800BF0B58, $63AD1D1221CA6A22, $F170087565BE4041
   Data.q $17504DD5000C1B3B, $6F85F6FFD200D8E1, $4FDF4D00B3100385, $5DB1C46E7D3642F1, $CAF1CC05725EF60E, $8F8C1DFAA2CD8D6, $638166679E821620, $6CC7093C42B36C70
   Data.q $50F3D804048798A0, $C214F0CCF3D82B3E, $E211812960072B04, $A3523056F0FFC679, $16283AF281E05107, $DFEFF7FA7881FF7F, $26136B417F183310, $965A90532F025944
   Data.q $1000362664059AD0, $C564C0F2DBB82C40, $99383D2541DBA902, $A3C81B28F2043D43, $110F890D9A406CAC, $9015204B2C040703, $21D6007B78250DC8, $5FDFFF12E002CA42
   Data.q $F81CB0333083EC78, $A602FE4070798A03, $A23164EE0FC94802, $7DAC3FFEF9C127B6, $D029F707CE0FF1, $10000520ABBA0040, $39116FFFFF891184, $4DC0A089074461A7
   Data.q $496E1A8F167E536B, $83A8072A50490807, $19E40402201EAE57, $473405D98483BB51, $23492B40418B21, $603A07C0601257C, $C2736ADBF4446FAA, $173BE928E5B28EAC
   Data.q $E7AE62FE1EA93C55, $39465DB002D837, $D7FEEE88250C20C2, $84B896322D650F95, $1402DF816BC025DF, $136D468651FEE8AA, $A31646311E27ABFB, $8DF741F2817CB151
   Data.q $114C3F875F7550E3, $68EE2467FA27F339, $D167F8A529DF8B82, $E6C47D28FBA26523, $BA0A16DE5534615E, $720AC3A0057BFA, $DDFFFE4EA2584106, $A4EC3B82A5A36625
   Data.q $C67F1D69482C4307, $97106FD663DDCC86, $6E0758381B667FFA, $E7960ED8D58FB4D3, $990EA909C1E8099, $CD49FC624BCBE7A8, $604BF540FEAC0121, $C474B514B5ECBBB5
   Data.q $4925030EB3889376, $1F9F3D7269CDD88D, $71DCBB6005788, $581FFBD162A18410, $838860E2623E188D, $71EF8CFFC2CF2D0B, $335F025980F14A16, $BB5109A5DFAA9BB5
   Data.q $40449C9379E280D6, $D47A7003A185011A, $51E3EA61FD62C395, $975B14763268273E, $C2CEB801C9E985D7, $2005B0AFCFAF72AA, $3A20410400928CC3, $22C6466E3FF7A185
   Data.q $EC31FE8E1F4D90, $52E29DE78FCB3CB, $7CB99B7B33880748, $673DF9A010D6A15A, $D97A2597D82101C2, $2CC807E209C5F61, $71CC4F831BAE02B5, $DA35F37A7597D9FA
   Data.q $19B68D2682211B85, $3F02270496F0531A, $3101F8C81F814C18, $1C82B0B8011E0AA2, $FFFB6EB466104180, $B81D91095D1CC77B, $6717FFC56814D0DA, $CA7EBC27012DAC44
   Data.q $9CA33808D8E3CD99, $3ECB321200A4B88, $4D18807E43A10D7C, $FCDCBD8ABF315E52, $5EA21E91E671824E, $E5B663A38E27968E, $260BC3FA5DBAC706, $3D50306F8C024907
   Data.q $CC2A005782A15EC2, $624AA1841060076D, $E528C94DDCFFFFB2, $5FE2D39402FBBDB2, $80294806C393F101, $BD0824073DC92393, $170783C9F2E284C0, $2F88C00718468014
   Data.q $AEB6C227505910, $DB8CFB78DEFEF860, $39969E92746797C0, $3AB15D5664645AE2, $4E453EC11AF7856A, $C7B2B39C82E2B5AD, $84003625615002B, $CC15D7FDB92144C2
   Data.q $5A5B169813086F1, $EC9F5F720024F827, $22995E53A6E558F8, $7E19B900F87F3B52, $41B2A0274837052A, $D5CF5BB0066F28CA, $C797B9E868033DFF, $14D3779EC60BDFD7
   Data.q $837B66067448A3C9, $EB7028372DE4D917, $FA75F6A89F62960E, $2FFA468C53E3025B, $C208300490661500, $9D56F7FFFB185AC0, $9B21005EEF14240A, $E9AD02C625680DFC
   Data.q $EDFC16A01D01AE7D, $8BE283FB12558A3C, $200D040B7823803A, $7A7871F035FDA407, $B02F32B6261A2D53, $F1786286638A41B7, $3A474CD303BDBFBA, $239128F461EC84
   Data.q $9854009F05BDAFC5, $33A3430820C00EDB, $D917AEA70EFFFFFE, $8FDA7B60928189DE, $26B232ABF57A16E2, $4BE8C81797EE51E5, $FBC35D10A5BD7B7, $E45A8B431F1457E3
   Data.q $5776427C43D5B0E2, $6C47CD930A60A8FD, $C072D8D0E0E45F00, $9C30F64E3F78DEA9, $877959DCC5783321, $118CC26004B00B29, $FFF2AD5818410600, $59C9D824356D2AFF
   Data.q $31C2FECCB477304, $EE5510277A2D959C, $13D21D8663D95400, $4DF5A2DD4429607C, $1FE81B9131C0E9, $FE08CEBE80053308, $84FE2FB4A29BDE45, $73C981E9F17AE1D
   Data.q $6CDA418645DD5BF5, $855BA6B079271AF0, $EB298013EB3A2BF5, $FE8AB46184000148, $C79395D31415BDFF, $7108B8FECE59894A, $4955F6505132F2A1, $7706A1D4032B8615
   Data.q $1163B9FE0F915A50, $FE76F731D99821E9, $3209A5EC39969037, $4EA53F70044F0D65, $70B36D34E4AA1F75, $8013D45C29E1451B, $6841040001D83309, $D22243AE0FFFFAD9
   Data.q $E3C6CCA26D7838, $1F8E25542CF59086, $59FD8955F19C1776, $D06CC09C88A0DB13, $3D46FC92E02B80C3, $F8968D8C18E8D14, $7C1480F0017244A6, $C32411014FB5F769
   Data.q $A74EBBF53C9C1BCF, $F6A725A71C68B6BF, $830038256530027, $659783FFFB6328C2, $2597B41301F22D0A, $F50B5ED06B6C6CCC, $5BA240947E7B3F8, $6A0EEA1E0FA8CF26
   Data.q $41CF88E6D950B4F8, $EE4ADB1CB8B3CD41, $F7F7AE8C8787F3AF, $CD19BF3612EBF610, $619FC75D25A49353, $DCBAA17BC5F2F1AF, $655002FC044E6924, $F4CC082080004906
   Data.q $F4786848D0EE2FFF, $B3F50189B45A4314, $2AC8AA3C10493AC3, $4A60347FEB3A980B, $FD1E943C273A98B4, $7BB81D7BC6E14931, $2E03C8EED5F3379F, $F4331BA29DFBC13C
   Data.q $C0DB177563213A90, $55002BEB3BF18BF1, $4050C20830039466, $CC2D01B896627FEE, $73A952CF0C4C3F4F, $AB42B620800D0D38, $627474CF7CC8A9FD, $1C463A0106778523
   Data.q $48FD057651D227E9, $78FF4EA8BF3AF881, $34BB744C4D22E2FD, $680A34ADAA679692, $B0A30B9918033ECF, $657002BADF10E6B2, $E5351010C000392E, $8AE9D30CDA6E67FE
   Data.q $29BCE8CA782FC495, $DE0EF67C21A647A, $B6A46E5D36D7C58, $4F9CB17266848BC2, $3F986583DCD69AA0, $51280C9A246C276D, $6209E40B879C49D, $C8016CA8B942F4BC
   Data.q $2606204200149332, $BC16760CAB3FFFF3, $6CFAAD06E84280B9, $EFEB01D12150D8E5, $ACB745D093F916A9, $A83863CD68062510, $84FEB7E3B21C4521, $C2AF6CAA9601075B
   Data.q $6856F2EBE7DA81E4, $2926657002DD33F8, $9FFFE8540C20C000, $11422C7216EB4A6C, $32FF64E54733A0F5, $255F5EC03CABCD74, $64F4004E6E442D31, $79FD246CAB453C
   Data.q $D796109D12AAA3F7, $B0B9F78A09E5A390, $5DD4C9D36377741D, $32B8015D9C859BC7, $E262061040001C63, $49C6852A482C7FFF, $25FFDBB94BA34C5D, $A6E2284FDC1C0C6
   Data.q $5EB864E18E90ED86, $BB883A2DD8D2DDD9, $E5F7DF6591B2F7E0, $3B2001E51F100170, $FD13AA1377E74C4F, $2884DEFCCA288480, $CB90576A7963E4F9, $61001CA334A8015
   Data.q $8A5D607FEF50E861, $3F4196580781D2B2, $D508A7377576F79A, $8DE09987EAB65E1, $8F901670D38B6CC, $D1D13CB0CDC11B96, $6DBB4CC87C3AF8F, $3E3499EC385EC64E
   Data.q $AC5903941B4C122, $13EBF740EE910BE8, $B54BC35069C5B785, $2A0057C8315A84EF, $42A18410000560CD, $3A539B869717FFFD, $7D6DD3E644D40A79, $B569497FF0395094
   Data.q $BD03AECC3220E1A9, $B5857D0561CA4EDE, $AD21433356D601F7, $292104A109374740, $FDE2D1ED4102936D, $3512D540AEE402A1, $F9AC0521D00F0F06, $FFD0F041C04F8254
   Data.q $80071DCD32004FE, $82AC0FFDE16A2041, $1124B0B135CF20EB, $916FB5CB58F9921C, $E27A57DB01081FC9, $2F3CDFFAA2874DB5, $C1E2EB2912E66618, $201A177D314893C5
   Data.q $8B7CD48421B31A3D, $446FACC8C2400D7A, $2BF9D81B93936D8C, $B2126964C9E57AC0, $9F916571105282, $6A0821400E515A54, $9226F7AC981FFBAB, $AA384991080787D9
   Data.q $F5A4AD9DF7D765AA, $7D75F4525CB626F7, $CB30F8FD1739CBC2, $A35C774989C70320, $B1E81219AFDE8CC8, $480802F068783BE7, $C3F898D141046154, $22457AE4D3310E4D
   Data.q $5E842084DAE5DA2D, $83003946695002FC, $BB3A647FEECD0830, $689FE31344BA280D, $EA92C6B013AAF2B5, $EFA88DEB8FF5E7E3, $604C0D96BC67D658, $E6A4A6F88449F263
   Data.q $8C097D4A62F8B9A7, $44407CF9D0E7F64E, $2B814C6839A18900, $E3D34926886404D0, $17C48AB373093708, $4B8011EDBF46F2E9, $FEB541040001C82B, $75D432A5AB2E0FF
   Data.q $B4641A5316A5D0E, $A48C4EF64BAA96DC, $B870CAE8AB88C6E4, $486BE5F08770B7A5, $4461BA8724CA1199, $DBD7248E52F661D1, $1151215398AB2FC0, $E6C4EA6BA0520DAE
   Data.q $3D7C88A8A027FA37, $14B6B488013C1EAA, $6BEFFDD506104000, $7C88BFA0CE9AD585, $34E241002FD5362D, $3A8B504C1AF78ED6, $8B8F5405DF74C71E, $521F128D6EFD4EAF
   Data.q $4DA21078C37466F6, $707619C51442DB1A, $BA88DDC2528DB55C, $E6CDB786CC6E184D, $338022B104664C77, $474CA02E11E2695B, $57002BAC1BD1AF1C, $41D0C2083004AC66
   Data.q $23CD9EAE5B7FFFFE, $3012102E2E2EAF16, $68E6152C142C0274, $80F4F5B62C736E7F, $2EBEF0DC89185C90, $128B3BBC17FA737E, $F615C585F519181A, $4074CBB57AFBA39F
   Data.q $282E12ABC85DFC94, $798A9B8EF246A691, $7AF3804D4270B181, $4B3A11CC70FA1E7D, $410600B60AD2A00, $16AD9D7FFFFECF6D, $4795048ADD8EDA4A, $CC596625E2F2532B
   Data.q $D722052461145023, $B910D4A5B3437CC, $AEE9AB730B7241F3, $1B5361BD3A6E73B1, $B87327A448A7043D, $C69F800234FB471A, $F27D040281557583, $14E8C1C12B06A06C
   Data.q $E9F894DCC0300747, $AD2A004FC3391D9, $1FFF22D84106006C, $2601D945A138093C, $7DA30A4FCA94A05A, $CC5A31C1DCE243EC, $D9CD68F9F2E2AE81, $4A441B7A36BCC87C
   Data.q $9AD14ECC2403AE76, $79669F67D71609E3, $1FD92734440F43B9, $3327BC39402C8824, $C30284C894411022, $34E5DB8397A15FF2, $C9334C8013E03A6F, $FFFFC46061040001
   Data.q $4F55E30685298898, $469718517940CB22, $2A0C13823ECE595, $894BB7B66569605E, $62EA5812CD3E74AE, $DEB52EA598C2192, $84A204AC821432BF, $AFBF81433892EA2
   Data.q $3C4F2578A7A73C89, $6705261BDE251B1E, $2A0057E4C87165D1, $CCC5841060072DAD, $152D6E253AEBFF78, $CD2168F293F3FC5, $3FB73F7165FF2EC0, $149A14B6E9D84A60
   Data.q $D645FEF24B7AB670, $C10D0320845B7745, $8DA3D0BF72BE73D4, $9D6A2E5A25CC6B8F, $25A3D05540DB101E, $871E90C08404EFF0, $133190149A21E9CB, $56990027DE3F972C
   Data.q $FFD6E68208000390, $1FAB74054A879C1F, $D3C551C2FC414C90, $582E112A244A4CF, $90B5EFE9D5D1F7D, $E71A31B5B91202EC, $F7A3332982D30B6D, $6DD1AC5D3ED4112
   Data.q $C0344816DC601260, $15A9F526C47F7EAC, $123F814A74BA11B2, $1C82B4D8015DF348, $C3FFFD5B54104000, $24BBA1D5B854A966, $15AB1F800B9E330C, $BC54012C0702CE8
   Data.q $60E810B72A9CAE16, $B80DF74210F3D6F2, $10CC372376F76F7F, $F675E3496704A657, $2DF943BFB0824E75, $908C16023B032B85, $12F5909FA08EBC1, $8610400014A334D8
   Data.q $6CE6293C2FFDD042, $BC7D36902747D1FA, $EA197DA430A120AF, $2CC87C2710FA7074, $1D1C5C3FAE69C379, $347D39BD8447C849, $861C945A54035C3B, $7008D7B10ACE3798
   Data.q $A817BD0C3A157620, $8EEA20DF511F980D, $5ADB600573228F89, $1FFFF8E040800074, $8B00F8F294EA5636, $39B1916FE76BB95C, $448F0949BA85917D, $30D4262C18F107A8
   Data.q $A318C8BBB822713B, $D4B8F44F7FD44332, $61ED6E8122603BF8, $A02357104017504E, $FDB625838DE8340E, $D209A93E5E2D0062, $9A7400A751CFF5D2, $EA09430820000A51
   Data.q $8FD4CC9525B5F7FE, $42FBC9CD8D14100E, $70128FD1D71BF652, $6B3BE0A7AB113A2F, $3DB76B0930E16087, $8F29DFDD97E678FE, $154440E59E594196, $277110E3F80B78F8
   Data.q $5C28C10625993E34, $802DB1297E8BFAF, $88BF9A7AC83932EF, $3C360D9C75018E2A, $A159393581FD1B05, $CC79B82FF9859FF9, $6A750989945AB482, $1063C858C3A019C
   Data.q $A05B40278F8318B, $FFBFDFDF4DA1DBAE, $2B08E7BC37F879A0, $B8A893A1FF9C03B, $D6909285C1100400, $66FC15302A92C19, $D212131744171194, $9EBE183901009A0
   Data.q $DACF8263F3D2058, $490D5C3602B27C23, $76802A581D11D099, $5FF1ACE80F7D20C6, $2F1A409E2F06DE48, $E52C39EED022C940, $4401000209245BE0, $7FE485028E400030
   Data.q $1F62C12B391AD2A4, $341980292158CC9C, $AF98C0D49902CF3F, $B9A36045A9446463, $AE823678747DA1FF, $D0FCDB4289ED41F1, $D48154B0B3D81246, $982E097F7D544604
   Data.q $9D834B16A2200806, $6681D11FF524A06, $B4058FF0C2CF9D78, $D0EFCA0D7536070E, $9D0CC3E3A2332FA6, $562033F98D806776, $41428F8716ACA277, $FE5F06217D0E84ED
   Data.q $50543DA07F7154A2, $AD2D80171D07FF9E, $BD11004004FF6627, $FF27901FD8641E5C, $E87FC32FE8C41FC, $ACBBC900FFA813D, $A900985E03FDF11E, $2396B03F1BC0FFF3
   Data.q $FEB0F9B214D4D213, $FF6D43119546C08, $F9017808A5203B29, $47FFF6D60654BA07, $C36D22008007FEF4, $190E1C3102D07404, $6B741FF99A39003B, $B417F6740675780B
   Data.q $B1BE199E4CBE0150, $C28D4A3FEE7DB101, $B60DCCBE0A61B480, $1D45FDFE0A9A0A08, $2927D6D0C141A0, $581E0332DAC88020, $E0FFD70178DA8FF8, $E8661E9EF0660331
   Data.q $3B94F238756C1E7C, $8FFC12DC0D3A7403, $D60FF970348F7234, $F008F23FEC790777, $62258C1E40AA445F, $948C40100036006F, $8D04C413DE4444EE, $7B82666792582669
   Data.q $3E099C7A83FADE1E, $C24736C2A55A85E5, $585FDBC6A014FA, $6517FE04348BFBFF, $8A200800DEB91917, $8F897041BEEF0003, $6FB9845A3E003FB4, $C27D562030C35E10
   Data.q $47F97C9B61FFF8C7, $95440100940D95, $99056C5B025DDD40, $A94D8027AF0067B7, $D118CC86C3775623, $C3FF86FBE1FF623A, $D0BFB6A9A43FC453, $8051CED2A060A79
   Data.q $A4639AEA0006AA20, $19EF23A54C426718, $8A39DA44669E6C44, $6CE1B0F4C3480814, $600059A20080036A, $33484C7D558641AC, $BB69A47FC5BEF0CF, $25A440AC25DEF0FF
   Data.q $CE7FB29A00300800, $EDA0A4A4, $826042AE444E4549
EndDataSection

**comtois** · 07/08/2010, 10h30

Voici la démo d'un autre participant (un néo zélandais).

Faudra que je suggère à djes de proposer de joindre la version longue du listing avec la version courte pour le concours, ça permettrait d'avoir un code commenté avec des noms de variables explicites, et aéré

Windows only sorry!
Re-Nova Attractor Media Player & Visualizer
You need to set you recording source to "waveout mix or Stereo mix"

edit: v1.3 play queue fix

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
 
;*****************************************************************************
;*
;* Summer 2010 PurePunch Demo contest
;* 200 lines of 80 chars, two months delay
;*
;* Name     : IdleArts Re-Nova Attractor Media Player) v1.3 
;* Author   : Idle
;* Date     : 28/7/10
;* Purebasic  Version :4.50
;*
;* Notes    : Windows only
;*           
;*            Compile ThreadSafe
;*            Set Recording source to "Wave out" or "Stereo Mix" (vista/windows7 you may need to dig around to enable it) 
;*
;             Drag And drop Folder With Mp3 Or Wma To Queue music
;*                         
;*            Left Click on screen to pop up the Nova Controls
;*            Right Click to Toggle Full Screen mode
;*            Space bar for random nova
;*           
;*            Retro led Panel visual
;*            visualize=on, blend=off, mode=6, size=Right, zoom=Right, gain=move up from left till screen fills   
;*
;*            Nova Attractor algorthim Copyright Andrew Ferguson 2009
;*****************************************************************************
Procedure ATS(v):Static ltm,pt.point:While 1:mouse_event_(1,1,0,0,0)
Delay(100):mouse_event_(1,-1,0,0,0):Delay(60000):Wend:EndProcedure
Structure con:hWindow.i:size.i:buffer.i:wave.i:fm.WAVEFORMATEX:lBuf.i               
nBuf.i:nDev.i:nBit.i:nHertz.i:nChannel.i:EndStructure:Global con.con
Global Dim inHdr.WAVEHDR(16):Global mxv,akn:Global Dim rex.f(1025)
Global Dim imx.f(1025):Global Dim FFTOUT.f(2,1025):Global FFTWnd
Global FMUT = CreateMutex():con\fm\wFormatTag = #WAVE_FORMAT_PCM
Structure window:style.i:left.i:top.i:width.i:height.i:window.i:fg.i
title.s:EndStructure:Structure star:speed.f:x.f:y.f:EndStructure
Global Dim stars.Star(3000):Global gr.f=1.0,gg.f=0.6,gb.f=0.2,ss=32,gRedo,aaa
Global gbl,gain.f=1.0,gvis,gReset,vGain.f=0.0021,fwd,fhd,scx,scy,mode,bbb,ccc
Global Width,Height,bFsc,Thread,Screen,wnd.window,WID,hwnd,screen,ddd,msf=64
Global fg,cflags,cWin,Controlthread,controlLoop,cflags=13107202,gsf.f=1.0
Global NewList que.s(),ts1,splay,spu,lbk,gPlay=1
Global bcl,bpause,sg,sg3,nx,gwidth,WID:Procedure.s dirlist(dir.s,bRec=0)
Static strFiles.s,ct1:mDir=ExamineDirectory(-1,dir,"*.*"):If mDir:
While NextDirectoryEntry(mDir):If DirectoryEntryType(mDir)=1
FN.s=DirectoryEntryName(mDir):
If FindString(FN,".mp3",1) Or FindString(FN,".wma",1):FFN.s=dir+"\"+FN
AddElement(que()):que()=FFN:Debug(ffn):ct1+1:EndIf:Else
td$=DirectoryEntryName(mDir):If td$<>"." And td$<>"..":If bRec=0
dirlist(Dir+"\"+td$):EndIf:EndIf:EndIf:Wend:FinishDirectory(mDir):EndIf
EndProcedure:Procedure Requeue(*pt.s):t$=*pt
If FindString(t$,".mp3",1) Or FindString(t$,".wma",1):t$=GetPathPart(t$):r=1
EndIf:If t$<>"":If ListSize(que()):*p=@que():LastElement(que()):EndIf
dirlist(t$,r):If *p:ChangeCurrentElement(que(),*p):Else:ResetList(que())
EndIf:EndIf:EndProcedure:Procedure playm():ww=WindowWidth(WID)
PlayMovie(0,hwnd):Delay(100):If IsSprite(sg):FreeSprite(sg):FreeSprite3D(sg3)
EndIf:If ww=0:ww=width:EndIf:sg=CreateSprite(-1,ww,30,4|8)
sg3=CreateSprite3D(-1,sg):t$=GetFilePart(que()):t$=Left(t$,Len(t$)-4)
StartDrawing(SpriteOutput(sg)):DrawText(0,5,t$,RGB(0,255,0)):StopDrawing()
nx=ww:EndProcedure:Procedure mxy(*pt.point):GetCursorPos_(*pt):
C=GetSystemMetrics_(4):Y=GetSystemMetrics_(6):X=GetSystemMetrics_(5)
*pt\y-(WindowY(WID)+c+Y):*pt\x-(WindowX(WID)+X):EndProcedure:
Procedure drawcontrols(ww,hh):Protected pt.point,rc.rect,j=66:mxy(@pt)
If gvis And gbl:ap=100:Else:ap=255:EndIf:If (gbl And gvis) Or gbl=0:Stop3D()
sxx=(ww*0.5)-160:If pt\y<100:dx=pt\x-sxx:If dx>0 And dx<64:
StartDrawing(ScreenOutput()):Circle(sxx+32,39,29,RGB(0,ap,0)):StopDrawing():
If bcl:FreeMovie(0):If Not PreviousElement(que()):LastElement(que()):EndIf
If LoadMovie(0,que()):PlayM():EndIf:EndIf:ElseIf dx>64 And dx<128
StartDrawing(ScreenOutput()):Circle(sxx+64+31,10+29,29,RGB(0,ap,0))
StopDrawing():If bcl And bPause:ResumeMovie(0):gPlay=1:ElseIf bcl
PlayMovie(0,WindowID(WID)):gPlay=1:EndIf:ElseIf dx>128 And dx<192
StartDrawing(ScreenOutput()):Circle(sxx+128+32,10+29,29,RGB(0,ap,0))
StopDrawing():If bcl:PauseMovie(0):bPause=1:EndIf:ElseIf dx>192 And dx<256
StartDrawing(ScreenOutput()):Circle(sxx+192+32,10+29,29,RGB(0,ap,0))
StopDrawing():If bcl:StopMovie(0):gplay=0:EndIf:ElseIf dx>256 And dx<320 
StartDrawing(ScreenOutput()):Circle(sxx+256+32,10+29,29,RGB(0,ap,0))
StopDrawing():If bcl:FreeMovie(0):If Not NextElement(que()):FirstElement(que())
EndIf:If LoadMovie(0,que()):PlayM():EndIf:EndIf:EndIf:EndIf:
Start3D():Sprite3DBlendingMode(5,2):DisplaySprite3D(splay,sxx,10,ap)
Sprite3DBlendingMode(3,2):If IsSprite(sg):DisplaySprite3D(sg3,nx,hh-40,255)
nx-2:If Abs(nx)>(2*ww):nx=ww:EndIf:EndIf:EndIf:bcl=0:EndProcedure 
Procedure nxt(b,cw,ch):ls=ListSize(que()):If ls>0:If gplay:If Not IsMovie(0)
If Not NextElement(que()):ResetList(que()):EndIf:If LoadMovie(0,que()):playm()
Else:DeleteElement(que()):EndIf:ElseIf Not MovieStatus(0):DeleteElement(que())
FreeMovie(0):EndIf:EndIf:If b:Drawcontrols(cw,ch):EndIf:EndIf:EndProcedure 
Procedure RecS():con\fm\nChannels=1:con\fm\wBitsPerSample=16
con\fm\nSamplesPerSec=22500:con\lBuf=1024:con\nBuf=8:con\nBit=1
con\fm\nBlockAlign=(con\fm\nChannels*Con\fm\wBitsPerSample)/8
con\fm\nAvgBytesPerSec=con\fm\nSamplesPerSec*Con\fm\nBlockAlign
If 0=waveInOpen_(@Con\wave,-1+con\nDev,@Con\fm,con\hWindow,#Null,65544)
For i=0 To con\nBuf-1:inHdr(i)\lpData=AllocateMemory(con\lBuf)
inHdr(i)\dwBufferLength=con\lBuf
waveInPrepareHeader_(con\wave,inHdr(i),SizeOf(WAVEHDR))
waveInAddBuffer_(con\wave,inHdr(i),SizeOf(WAVEHDR)):Next:
If 0=waveInStart_(con\wave):SetTimer_(con\hWindow,0,1,0):EndIf:EndIf:
EndProcedure:Procedure RecR(hWaveIn.l,lpWaveHdr.l):*hWave.WAVEHDR=lpWaveHdr
con\buffer=*hWave\lpData:con\size=*hWave\dwBytesRecorded:
waveInAddBuffer_(hWaveIn,lpWaveHdr,SizeOf(WAVEHDR)):EndProcedure:
Procedure recF():Protected N.w,M.w,NM1.i,J.i,ND2.i,MM.i:If con\buffer=0
ProcedureReturn:EndIf:For pos=0 To 1024:rex(pos)=0:imx(pos)=0:Next:pos=0:
For i=0 To con\size Step 2:value=PeekW(con\buffer+i):rex(pos)=value/32767
imx(pos)=0:pos+1:Next:N=1024:NM1=N-1:ND2=N/2:MM=Int(Log(N)/0.69314718055994529)
J=ND2:For ii=1 To N-2:If ii<J:TR.f=REX(J):TI.f=IMX(J):REX(J)=REX(ii)
IMX(J)=IMX(ii):REX(ii)=TR:IMX(ii)=TI:EndIf:K=ND2:While K<=J:J-K:K/2:Wend:J+K
Next:For L=1 To MM:LE=Int(Pow(2, L)):LE2=LE>>1:UR.f=1:UI.f=0:SR.f=Cos(#PI/LE2)
SI.f=-Sin(#PI/LE2):For J=1 To LE2:JM1=J-1:For i=JM1 To NM1:IP=i+LE2
TR=REX(IP)*UR-IMX(IP)*UI:TI=REX(IP)*UI+IMX(IP)*UR:REX(IP)=REX(i)-TR
IMX(IP)=IMX(i)-TI:REX(i)=REX(i)+TR:IMX(i)=IMX(i)+TI:i+LE-1:Next i:TR=UR
UR=TR*SR-UI*SI:UI=TR*SI+UI*SR:Next J:Next L:LockMutex(FMUT):mxv=1
For cnt=1 To 512:FFTOUT(0,cnt)=(IMX(cnt)*IMX(cnt))+(REX(cnt)*REX(cnt))
FFTOUT(1,cnt)=ATan(IMX(cnt)/REX(cnt)):If (mxv<FFTOUT(0,cnt)):mxv=FFTOUT(0,cnt)
akn=cnt:EndIf:Next cnt:UnlockMutex(FMUT):Delay(0):EndProcedure
Procedure record_CallBack(h.i,M.i,wP.i,lP.i)
R=#PB_ProcessPureBasicEvents:Select M:Case 275:recF():Case 960:RecR(wP,lP)
EndSelect:ProcedureReturn R:EndProcedure:fg=13565953:
Procedure FullScreen():rc.rect:bFsc!1:If IsWindow(WID)
If bFsc=1:wnd\Style=GetWindowLong_(hwnd,-16):GetWindowRect_(hwnd,@rc)
wnd\left=rc\Left:wnd\top=rc\top:wnd\width=rc\right-rc\left
wnd\height=Rc\bottom-rc\top
SetWindowLong_(hwnd,-16,#WS_POPUP):SetWindowPos_(hwnd,0,0,0,0,0,39)
ShowWindow_(hwnd,3):ElseIf bFsc=0:SetWindowLong_(hwnd,-16,wnd\style)
SetWindowPos_(hwnd,-2,wnd\left,wnd\top,wnd\width,wnd\height,32)
ShowWindow_(hwnd,#SW_NORMAL):EndIf:EndIf:EndProcedure:Procedure Controls(void)
cWin=OpenWindow(-1,0,0,220,250,"IdleArts Re-Nova",cflags,hwnd):Static lss
Protected EV.i,EvG.i,EVw.i,bClose.i,slz,slr,slg,slb,slv,chkB,sla,chkV,sm,ssf,si
sm = SpinGadget(-1, 40, 10, 40, 20, 0, 13,3):If Not lss: lss=ss: EndIf
chkB = CheckBoxGadget(-1,90,10,60,20,"Blend")
chkV = CheckBoxGadget(-1,150,10,60,20,"Visualize")
slz=TrackBarGadget(-1,45,40,160,20,2,64)
slr=TrackBarGadget(-1,45,70,160,20,1,255)
slg = TrackBarGadget(-1,45,100,160,20,1,255)
slb = TrackBarGadget(-1,45,130,160,20,1,255)
sla = TrackBarGadget(-1,45,160,160,20,1,255)
slv = TrackBarGadget(-1,45,190,160,20,1,255)
ssf = TrackBarGadget(-1,45,220,160,20,1,10)
TextGadget(-1,10,14, 30, 20,"Mode"):TextGadget(-1,10,215,40,20,"zoom")
TextGadget(-1,10,40,40,20,"Size"):TextGadget(-1,10,65,40,20,"Red")
TextGadget(-1,10,95,40,20,"Green"):TextGadget(-1,10,125,40,20,"Blue")
TextGadget(-1,10,155,40,20,"alpha"):TextGadget(-1,10,185,40,20,"Gain")
SetGadgetState(slz,ss):SetGadgetState(slr,gr*255):SetGadgetState(slg,gg*255)
SetGadgetState(slb,gb*255):SetGadgetState(sla,255-gain):SetGadgetState(sm,mode)
SetGadgetState(chkB,gbl):SetGadgetState(ssf,5):SetGadgetState(chkV,gVis):Repeat
EV=WaitWindowEvent()
EVw=EventWindow():EvG=EventGadget():If EVw=cWin:Select EV:Case #PB_Event_Gadget
Select EvG:Case slz:ss=GetGadgetState(slz):lss=ss:gredo=1:Case slr
gr=GetGadgetState(slr)/255.0:gredo=1:Case slg:gg=GetGadgetState(slg)/255.0
gredo=1:Case slb:gb=GetGadgetState(slb)/255.0:gredo=1:Case chkB
gbl=GetGadgetState(chkB)!0:If Not gbl:ss=lss:gredo=1:EndIf:Case chkV
gVis=GetGadgetState(chkV)!0:gReset=1:If gVis:gbl=1:SetGadgetState(chkB,1)
Else:gbl=GetGadgetState(chkB):EndIf:Case sla:gredo=1
gain=GetGadgetState(sla)*0.0039:Case slv
vgain=GetGadgetState(slv)*0.0001:Case ssf:msf=64:si=GetGadgetState(ssf)-5
If si<0:msf>>-sii:If msf<1:msf=1:EndIf:Else:msf<<si:EndIf:gsf=0.015625*msf
Case sm:mode=GetGadgetState(sm):EndSelect:Case 16:bClose=1:EndSelect:EndIf
Until bClose=1:EndProcedure:Procedure Reset():c=0:While c<3000
stars(c)\x=Random(3000)+1:stars(c)\y=Random(3000)+1
stars(c)\speed=1/Sqr(stars(c)\x*stars(c)\x + stars(c)\y*stars(c)\y):c+1:Wend
bbb=Random(5)+1:ccc=Random(5)+1:ddd=Random(5)+1:aaa=Random(5)+1:EndProcedure
Procedure DrawScene():Static sP1,sPR,sP2,sPR1,ux,uy,uz
Static hc.i,ef.f=65.0,speed.f=3.0,lw,lh,cw,ch,ttt:Protected iy,ix,iyy.f,dr.f
Protected dx.f,dy.f,dz.f,cx,cy,mx.f,px.i,py.i,nt.i,cts:LockMutex(FMUT)
If GetWindowState(WID)=#PB_Window_Minimize:nxt(0,0,0):Else:If con\hwindow=0:
Con\hWindow=Hwnd:SetWindowCallback(@record_CallBack()):RecS():EndIf:
cw=WindowWidth(WID):ch=WindowHeight(WID):nt=akn*2+30:If GetAsyncKeyState_(32)&1
Reset():ef=(Random(1000)+1)-500:EndIf:t=ElapsedMilliseconds()
If gvis And t>ttt:aaa=Random(5)+1:bbb=Random(5)+1:ccc=Random(5)+1
ddd=Random(5)+1:ttt=t+Random(5000)+1000:EndIf
If IsSprite(SP2) And cw<>lw Or ch<>lh:lw=cw:lh=ch:FreeSprite(sP2)
FreeSprite3D(sPR1):EndIf:If Not IsSprite(sP2):sP2=CreateSprite(-1,cw,ch,12)
sPR1=CreateSprite3D(-1,sP2):StartDrawing(SpriteOutput(sP2)):Box(0,0,cw,ch,0)
StopDrawing():EndIf:If Not IsSprite(sP1) Or gRedo Or gbl:gredo=0:If gbl
ux=1<<Random(5)+1:Else:ux=ss:EndIf:uz=ux/2:uy=256/ux:If IsSprite(sP1)
FreeSprite(sP1):FreeSprite3D(sPR):EndIf:sP1=CreateSprite(-1,ux,ux,12 )
sPR=CreateSprite3D(-1,sP1):StartDrawing(SpriteOutput(sP1)):For iy=-uz To uz
iyy=iY*iY:For ix=-uz To uz:dr=Sqr(ix*ix+iyy):If dr<uz:dr=(uz-dr) * uy
Plot(uz+ix,uz+iy,RGB(dr*gr*gain,dr*gg*gain,dr*gb*gain)):EndIf:Next:Next
StopDrawing():EndIf:If Not gbl:ClearScreen(0):EndIf:If Start3D():scx=cw*0.5
Sprite3DQuality(1):scy=ch*0.5:cx=scx-uz:cy=scy-uz:Sprite3DBlendingMode(3,2)
While cts<3000:dx=stars(cts)\x:dy=stars(cts)\y:dz=Sqr(dx*dx+dy*dy):If dz=0:dz=1
EndIf:tv.f=Abs(fftout(1,ct))*vgain:dx+tv:dy-tv:If ct>=500:ct=15:Else:ct+1:EndIf
mx=(stars(cts)\speed*speed*dz):Select mode:Case 0
px=(cx+(Sin(dx)+Cos(dy))*mx):py=(cy+(Cos(dx)-Sin(dy))*mx):Case 1
px=(cx+(Sin(dx/aaa)*Cos(dy/bbb))*mx):py=(cy+(Cos(dx/ccc)*Sin(dy/DDd))*mx)
Case 2:px=Int(cx+Tan((Sin(dx)+Cos(dy)))*mx):py=Int(cy+(Cos(dx)-Sin(dy))*mx)
Case 3:px=cx+(Sin(dx)+Cos(dy))*mx:py=cy+Tan(Cos(dx)-Sin(dy))*mx:Case 4
px=Int(cx+Tan(Sin(dx)+Cos(dy))*mx):py=Int(cy+Tan(Cos(dx)-Sin(dy))*mx):Case 5
px=cx+Tan(Sin(dx)*Sin(dy))*mx:py=cy+Tan(Cos(dx)*Cos(dy))*mx:Case 6
px=Int(cx+Tan(Cos(dx))*mx):py=Int(cy+Tan(Sin(dy))*mx):Case 7
px=Int(cx+Sin(Cos(dx))*mx):py=Int(cy+Tan(Sin(dy))*mx):Case 8
px=Int(cx+(Sin(dx))*mx):py=Int(cy+(Cos(dy))*mx):Case 9
px=cx+(Sin(mx)+Cos(dx))*mx:py=cy+(Cos(dx)-Sin(mx))*mx:Case 10 
px=(cx+(Cos(dx)+Cos(dy))*mx):py=(cy+(Cos(dx)-Cos(dy))*mx):Case 11
px=cx+(Sin(mx)-Cos(dx))*mx:py=cy+(Cos(dx)+Sin(mx))*mx:Case 12   
px=(cx+(Sin(dx*aaa)+Cos(dy*bbb))*mx):py=(cy+(Cos(dx*ccc)-Sin(dy*DDd))*mx)   
Case 13:px=cx+(Sin(dx/aaa)/Cos(dy/bbb)*mx):py=cy+(Cos(dx/bbb)/Sin(dy/DDd)*mx) 
EndSelect:If gVis:ef=nt:speed=((mxv)*vgain)
stars(cts)\x+(px/ef):stars(cts)\y+(py/ef):stars(cts)\speed=1/dz:Else:speed=1.0
stars(cts)\x+(px/ef):stars(cts)\y+(py/ef):stars(cts)\speed+1/dz:EndIf
If gsf<>1:px=(px*gsf)-(cx*gsf)+cx:py=(py*gsf)-(cy*gsf)+cy:EndIf
DisplaySprite3D(sPR,px,py,128):If px>cw*1.5 Or py>ch*1.5
stars(cts)\x=Random(cw)+1:stars(cts)\y=Random(ch)+1
stars(cts)\speed = 1/Sqr(stars(cts)\x*stars(cts)\x+stars(cts)\y*stars(cts)\y)
EndIf:cts+1:Wend:nxt(1,cw,ch):Sprite3DBlendingMode(3,12):If gbl And gVis
DisplaySprite3D(SPR1,0,0,170):ElseIf gbl:DisplaySprite3D(SPR1,0,0,255):EndIf
Stop3D():EndIf:UnlockMutex(FMUT):FlipBuffers():EndIf:Delay(0):EndProcedure
Procedure ScreenX(void):Protected EV.i,EVw.i,bclose.i
title.s = "IdleArts Re-Nova Attractor":pt.point
WID=OpenWindow(-1,0,0,Width,Height,title,fg,0):hwnd=WindowID(WID)
screen=OpenWindowedScreen(hwnd,0,0,fwd,fhd,0,0,0,2):OleInitialize_(0)
EnableWindowDrop(WID,15,4):UsePNGImageDecoder():ts1=LoadSprite(-1,"but.png",4|8)
splay=CreateSprite3D(-1,ts1):If hwnd And screen:Repeat:DrawScene():Repeat
If GetActiveWindow_()=hwnd:If GetAsyncKeyState_(#VK_ESCAPE)&1:gq=1:EndIf:EndIf       
EV=WindowEvent():EVw=EventWindow():If EVw=WID:Select EV:Case #WM_RBUTTONDOWN
FullScreen():Case #WM_LBUTTONDOWN:mxy(@pt)
If pt\y<100 And ElapsedMilliseconds()>lbk:bcl=1:lbk=ElapsedMilliseconds()+250
ElseIf Not IsThread(Controlthread):Controlthread=CreateThread(@Controls(),0)
EndIf:Case 16:screen=0:bclose=1:Case #PB_Event_WindowDrop:ps.s=EventDropFiles()
Requeue(@ps):gvis=1:gbl=1:EndSelect:EndIf:Until EV=0:Delay(20)
Until bclose=1 Or gq:EndIf:CloseScreen():EndProcedure:Procedure run():
If InitSprite() And InitSprite3D() And InitMovie():Protected timeout:
ExamineDesktops():fwd=DesktopWidth(0):fhd=DesktopHeight(0):Width=800:Height=600
CreateThread(@ats(),0):ScreenX(0):EndIf:EndProcedure:
CompilerIf #PB_Compiler_Thread:If FileSize("but.png")=-1:InitNetwork():
ReceiveHTTPFile("http://idlearts.com/but.png","but.png"):EndIf:reset():run()
CompilerElse:MessageRequester("Warning","Please set compiler to threadsafe")
CompilerEndIf

Compétition PurePunch été 2010

PureBasic

Discussions similaires

Partager

Partager