+ Répondre à la discussion Actualité déjà publiée
  1. #1
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut Compétition PurePunch été 2010

    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!
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  2. #2
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  3. #3
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  4. #4
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    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.
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  5. #5
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  6. #6
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

Discussions similaires

  1. Compétition PurePunch Juillet-Août 2014
    Par djes dans le forum PureBasic
    Réponses: 13
    Dernier message: 15/09/2014, 20h26
  2. Réponses: 12
    Dernier message: 29/01/2013, 10h45
  3. génération des matchs d'une compétition
    Par parsy dans le forum Mathématiques
    Réponses: 7
    Dernier message: 15/10/2010, 10h47
  4. Obligatoire : lisez les règles du forum : MAJ 06/08/2010
    Par Anomaly dans le forum Mode d'emploi & aide aux nouveaux
    Réponses: 0
    Dernier message: 03/07/2008, 14h46
  5. gestion des calendriers jusqu'en 2010
    Par splash1 dans le forum SAP
    Réponses: 2
    Dernier message: 20/03/2008, 16h03

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo