Season's Greetings PurePunch contest

[Fangbeast]

Excellent electrochrisso.

I pointed this at a file of 49.560 recipes and it only took 3 seconds to load here.

Now I need to analyse what you did as there are many variations on the recipe structures and I have no idea how to dump them to database till I figure out where the variant data has to go.

Impressive stuff from you.

[electrochrisso]

Excellent electrochrisso.

I pointed this at a file of 49.560 recipes and it only took 3 seconds to load here.

Now I need to analyse what you did as there are many variations on the recipe structures and I have no idea how to dump them to database till I figure out where the variant data has to go.

Impressive stuff from you.

Yep! PB is real fast, lets see a C++ coder do that in half an hour.

[djes]

Some news from the french forum :

Space invaders by graph100 : http://www.purebasic.fr/french/viewtopi ... 12#p149412
Magic Ruban by Ar-S : http://www.purebasic.fr/french/viewtopi ... 14#p149414
PanelGadget Color Toolbar by kernadec : http://www.purebasic.fr/french/viewtopi ... 22#p149422

And a line counter by falsam (thanks!) : http://www.purebasic.fr/french/viewtopi ... 29#p149329

[einander]

3
1) Is allowed API?
2) Is allowed PB 5.10?

Possibility to add a sound file (and only one) maximum size 1Mb

3) Is allowed a MIDIfile? or a MP3 file?

[djes]

1) Is allowed API?

Yes

2) Is allowed PB 5.10?

Yes, PB minimum 5.00, just notice it in the header

3) Is allowed a MIDIfile? or a MP3 file?

A sound file, whatever is accepted by PureBasic as a sound file, MP3, OGG, midifile, mod. .xm module...

[djes]

A message to remind you that you only 7 days (+/- some hours) to finish your PurePunch !

Here's some new ones on the french forum :

Mine game by Kernadec & Graph100 : http://www.purebasic.fr/french/viewtopi ... 24#p149624
Hano towers by Wood51 : http://www.purebasic.fr/french/viewtopi ... 54#p149654
Pict2AsciiArt by lepiaf31 : http://www.purebasic.fr/french/viewtopi ... 75#p149675

[infratec]

Hi,

my yearly try to bring a network related soft to highscore

It's a forum online checker with an alarm which raise if a searched person comes online.
(Sometimes that's helpful )
As alarm sound for here I use the word 'online' for a dog forum I use a barking

Btw. it's a systray program.

Have fun:

Code: Select all

;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : Forum online checker with alarm
;* Author   : infratec (Bernd)
;* Date     : 25.12.2012
;* Notes    : With PB everything is easy :)
;*
;*****************************************************************************
Procedure OnlineUsers(Host$,Page$,List UserList.s())
 Result=#False
 ConnectionID=OpenNetworkConnection(Host$,80)
 If ConnectionID
  *Buffer=AllocateMemory($10000)
  If *Buffer
   Send$="GET "+Page$+" HTTP/1.1"+#CRLF$+"Pragma: no-cache"+#CRLF$
   Send$+"Host: "+Host$+#CRLF$
   Send$+#CRLF$
   SendNetworkString(ConnectionID, Send$):Delay(500)
   If NetworkClientEvent(ConnectionID)=#PB_NetworkEvent_Data
    Length=ReceiveNetworkData(ConnectionID,*Buffer,$FFFF)
    If Length>0
     String$=PeekS(*Buffer,Length,#PB_UTF8)
     If FindString(String$,"</html>",1)<>0
      StartPos=FindString(String$,"Registered users:", 1)
      If StartPos:StartPos+18
       EndPos=FindString(String$,"Legend",StartPos)
       If EndPos
        Result=#True:ClearList(UserList())
        String$=Mid(String$,StartPos,EndPos-StartPos):StartPos=1
        Repeat
         StartPos=FindString(String$,">",StartPos)
         If StartPos:EndPos=FindString(String$,"<",StartPos)
          If EndPos:Name$=Mid(String$,StartPos+1,EndPos-StartPos-1)
           If Len(Name$)>0 And Asc(Left(Name$,1))>47
            If FindString(Name$,"[",1)=0
             Name$=ReplaceString(Name$,"&","&")
             AddElement(UserList()):UserList()=LTrim(Name$)
            EndIf:EndIf
           StartPos=EndPos
          Else:StartPos=0:EndIf:EndIf
        Until StartPos=0:EndIf:EndIf:EndIf:EndIf:EndIf
   FreeMemory(*Buffer)
  EndIf
  CloseNetworkConnection(ConnectionID)
 EndIf
 ProcedureReturn Result
EndProcedure

NewList UserList.s():InitNetwork():InitSound():CatchSound(0,?Sound):Exit=#False
WindowFlags=#PB_Window_SystemMenu|#PB_Window_Invisible
If OpenWindow(0,100,150,200,300,"Forum Online Checker",WindowFlags)
 StickyWindow(0,#True):FirstRun=#True:AddWindowTimer(0,1,1)
 AddSysTrayIcon(1,WindowID(0),CatchImage(0,?Icon,?Sound-?Icon))
 SysTrayIconToolTip(1,"Forum Online Checker")
 CreatePopupMenu(0):MenuItem(1,"Open"):MenuBar():MenuItem(2,"Exit")
 ListViewGadget(0,10,10,180,210):TextGadget(1,10,230,100,20,"Watch for:")
 StringGadget(3,10,250,180,20,"")
 CreateStatusBar(0,WindowID(0)):AddStatusBarField(100):AddStatusBarField(100)
 Repeat:Event=WaitWindowEvent()
  Select Event
   Case #PB_Event_Timer
    If EventTimer()=1
     If OnlineUsers("www.purebasic.fr","/english/index.php",UserList())
      Counter=0:ClearGadgetItems(0)
      ForEach UserList()
       If UserList()=GetGadgetText(3):PlaySound(0):EndIf
       AddGadgetItem(0,-1,UserList()):Counter+1
       If Left(UserList(),1)="0":Counter=0:EndIf
      Next UserList()
      StatusBarText(0,0,FormatDate("%hh:%ii:%ss",Date()),#PB_StatusBar_Center)
      StatusBarText(0,1,Str(Counter)+" online",#PB_StatusBar_Center)
      If FirstRun:RemoveWindowTimer(0,1):AddWindowTimer(0,1,5000)
       FirstRun=#False:EndIf:EndIf:EndIf
   Case #PB_Event_SysTray
    Select EventType()
     Case #PB_EventType_RightClick:DisplayPopupMenu(0,WindowID(0))
     Case #PB_EventType_LeftClick:HideWindow(0,#False)
    EndSelect
   Case #PB_Event_Menu
    Select EventMenu():Case 1:HideWindow(0,#False):Case 2:Exit=#True:EndSelect
   Case #PB_Event_CloseWindow:HideWindow(0,#True)
  EndSelect
 Until Exit
EndIf
DataSection
  Icon:IncludeBinary "ForumOnlineChecker.ico"
  Sound:IncludeBinary "Online.wav"
EndDataSection

The complete file with sound and icon:
ForumOnlineChecker.zip

Bernd

[electrochrisso]

Code: Select all

;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : PurePunch Clock
;* Author   : electrochrisso
;* Date     : 27/12/2012
;* Notes    : As Basic as it gets
;*
;*****************************************************************************
#MX=120:#MY=120:#SC=2*3.14159265/360:If CreateImage(0,#MX*2,#MY*2)
F=LoadFont(0,"Tahoma",12):CreateImage(1,#MX*2,#MY*2)
StartDrawing(ImageOutput(1)):DrawingFont(FontID(0))
Box(0,0,#MX*2,#MY*2,$606060):Circle(#MX,#MY,#MX-2,$32CD9A)
Circle(120,5,3,$0000FF):Circle(178,20,3,$FF0000):Circle(219,62,3,$FF0000)
Circle(235,120,3,$0000FF):Circle(219,178,3,$FF0000):Circle(178,219,3,$FF0000)
Circle(120,235,3,$0000FF):Circle(62,219,3,$FF0000):Circle(21,178,3,$FF0000)
Circle(5,120,3,$0000FF):Circle(62,20,3,$FF0000):Circle(21,62,3,$FF0000)
DrawingMode(#PB_2DDrawing_Gradient):BackColor($008CFF):FrontColor($FFF598)
CircularGradient(#MX,#MY,#MX+80):Circle(#MX,#MY,#MX-10)
DrawingMode(#PB_2DDrawing_Transparent):DrawText(82,159,"PurePunch",0)
DrawText(83,160,"PurePunch",$EE687B):DrawText(102,177,"2012",0)
DrawText(103,178,"2012",$EE687B):DrawingMode(#PB_2DDrawing_Default)
Box(83,48,74,18,0):StopDrawing()
#Flags=#PB_Window_SystemMenu|#PB_Window_MinimizeGadget
If OpenWindow(0,10,10,#MX*2,#MY*2,"",#Flags)
ImageGadget(0,0,0,#MX*2,#MY*2,ImageID(0)):Repeat
Ev=WaitWindowEvent(50):StartDrawing(ImageOutput(0)):DrawImage(ImageID(1),0,0)
DrawText(85,50,FormatDate("%dd-%mm-%yyyy",Date()),0,$B4CDCD)
LineXY(#MX,#MY,#MX+Sin(gh*(#SC))*90,#MY+Cos(gh*(#SC))*90,0)
LineXY(#MX,#MY,#MX+Sin(gm*(#SC))*107,#MY+Cos(gm*(#SC))*107,0)
LineXY(#MX,#MY,#MX+Sin(gs*(#SC))*109,#MY+Cos(gs*(#SC))*109,$0000FF)
Circle(#MX,#MY,4,$FF0000):StopDrawing():SetGadgetState(0,ImageID(0))
SetWindowTitle(0,FormatDate("%hh-%ii-%ss",Date()))
gs=360-(Second(Date())*6)+180:gm=360-(Minute(Date())*6)+180
RealHour=Hour(Date()):gh=360-((RealHour*30)+180)-(Minute(Date())/2)
Until Ev=#PB_Event_CloseWindow:EndIf:EndIf:End

[BasicallyPure]

Here is my submission for the contest.

You will need the IncludeBinary audio file and also you get a couple of demo sequence files.
download Music_Sequencer.zip here: http://www.mediafire.com/?hg1djaaxdtxj28n

Code: Select all

;*******************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : Music_Sequencer.pb
;* Author   : BasicallyPure
;* Date     : 12/31/2012
;* Notes    : Windows only
;*
;*******************************************************************************
; Cursor (black square), move with arrow keys, Backspace or mouse click.
; Voice (1 to 5 color coded), select with Page Up and Page Down keys.
; Tempo (set playback speed), use + and - keys.
; Note duration (1/16 to 1/1), select with Home and End keys, displayed below.
; Note (4 octaves), select by vertical position of the cursor, displayed below.
; Place note at cursor, use Insert key or Enter key.
; Remove note, place cursor over note to remove and press Delete key.
; Time signature (3/4 or 4/4), click button to toggle grid.
; Play, starts playback at the cursor location, move to left column to play all.
; Note: cannot play same note same time in different octaves using same voice.
; Compositions may be saved and loaded using the File menu.
;.......10........20........30........40........50........60........70........80
Global w=960,h=570,BM=12,cx,cy=23, gc=$A0C58D, LT, s.s="Music Sequencer", gs, bg
i=OpenWindow(0,0,0,w,h,s,$CA0001):Dim Ov(4):DataSection :D :IncludeBinary"S.wav"
EndDataSection:SetWindowColor(0,$567649) :InitSprite() :InitSound() :InitMouse()
OpenWindowedScreen(i,0,0,w,481,0,0,0) :e=48 :CreateMenu(0,i) : MenuTitle("File")
MenuItem(1,"Load"):MenuItem(2, "Save"):MenuItem(3,"Exit"):D$="1 2 4 8 16":A=8820
T=PeekL(?D+40)/A :*A=?D+44 :C=44+A :u=$FF00 :For n=1 To T : *S=AllocateMemory(C)
CopyMemory(?D,*S,44):PokeL(*S+4,C-8):PokeL(*S+40,A) :CopyMemory(*A,*S+44,A):*A+A
CatchSound(n,*S):Next:Dim VC(4):VC(3)=$FF00FF :Ov(1)=11025 :VC(0)=#Blue :VC(2)=u
VC(1)=$FF:VC(4)=#Cyan:Ov(2)=22050:Ov(3)=44100:Ov(4)=88200:N$="A A#B C C#D D#E F"
N$+" F#G G#" :P$="MusicSequence (*.seq)|*.seq" : Structure nx:u.i:ov.i:st.i:lg.i
EndStructure :Structure tk :List Nt.nx() : EndStructure : Dim J.tk(LT) :Macro SL
J(cx+gs)\Nt() :  EndMacro  :  Macro SS : StartDrawing(ScreenOutput()) : EndMacro
Macro WL : WriteLong(0,J(n)\Nt() : EndMacro : Macro FB : FlipBuffers() :EndMacro
Macro SD : StopDrawing() :EndMacro :Macro SC :SetGadgetColor :EndMacro :Macro SG
SetGadgetText :EndMacro :Macro DN :SG(4,Mid(N$,(12-Mod(cy,12))*2-1,2)) :EndMacro
Macro DV:SG(0,"Voice "+Str(V+1)) :SC(0,2,VC(V)) :SC(0,1,$FFFF00!VC(V)) :EndMacro
Macro DD : SG(5, "1/"+Mid(D$, (Dr +1)*2-1, 2)) : EndMacro : Macro AN(T, N, O, A)
AddElement(J(T)\Nt())  :  J(T)\Nt()\u = N :  J(T)\Nt()\ov = O : J(T)\Nt()\st = A
J(T)\Nt()\lg  = Int((16/Pow(2, Dr)))  :  If  A = 0  :  MoveElement(J(T)\Nt(), 1)
LastElement(J(T)\Nt()) :  EndIf : EndMacro : Macro WT : AddWindowTimer(0, 0, Tp)
SG(9, "Tempo = "+Str(15000 / Tp)) : EndMacro:Procedure DrN(L, C) : L + cx-1 : SS
For cx=cx To L:Box(cx*BM+1,cy*10+1,BM-1,9,C):Next:SD:EndProcedure:Procedure Gd()
n=BM:ClearScreen(gc):SS:Repeat:Select n :Case 192,384,576,768 :Lc=$FFFF :Default
If n%(BM*4)=0:Lc=$80FF:Else:Lc=$4080:EndIf:EndSelect :LineXY(n,0,n,480,Lc) :n+BM
Until n>948 : u=#Gray :For n=0 To 480 Step 10 :Select n : Case 0,120,240,360,480
LineXY(0,n,w,n,0):Default:LineXY(0,n,w,n,u):EndSelect:Next :SD :FB :EndProcedure
Procedure Rf():Shared VC(),J():d=79:If BM=16 :d=59 :EndIf :e=gs+d :If e>LT :e=LT
EndIf :For n=gs To e :ForEach J(n)\Nt() :If J(n)\Nt()\st :cx=n-gs :v=(SL\u-1)/12
cy=48-12*SL\ov-(SL\u-12*v):DrN(SL\lg,VC(v)) :EndIf :Next :Next :FB :EndProcedure
Procedure DC(x):If x>5*(28-BM)-1:x=5*(28-BM)-1:EndIf:SS:bg=Point(1+x*BM,1+cy*10)
Box(1+x*BM,1+cy*10,BM-1,9,0) : SD : FB : SS : Box(1+x*BM,1+cy*10,BM-1,9,bg) : SD
EndProcedure:TextGadget(4,485,520,25,20,"A",1) :TextGadget(9,250,520,70,20,"",1)
ButtonGadget(1, 10, 520, 50, 20, "Play") : ButtonGadget(02,70,520,50,20, "Stop")
ButtonGadget(03,520,520,50,20,"Test") : StringGadget(0,390,520,050,020,"", 2048)
TextGadget(05,450,520,025,20,"1/4",01) : ButtonGadget(06,w-60,520,50,20,"Clear")
ScrollBarGadget(7,0,485,w,25,0,47,1) :ButtonGadget(8,180,520,60,20,"Time = 4/4")
SC(0,1,#White):SC(4,2,gc):SC(5,2,gc):SC(9,2,gc):V=0:DV:Dr=2:DD :Tp=150 :WT :Gd()
Repeat : Select WindowEvent() : Case 513 : x=WindowMouseX(0) : y=WindowMouseY(0)
If x>0 And y>0 And x<w And y<481 : cx = x/BM : cy=y/10 : DN : EndIf : Case 13101
s  =  GetPathPart(ProgramFilename())  +  "\"  :  Select   EventMenu()  :  Case 1
F$=OpenFileRequester("",s,P$,0) :If F$ :If ReadFile(0,F$) :LT=ReadLong(0) :Tc=LT
Dim J.tk(LT) :SetGadgetState(7,0) :gs=0 :While Eof(0)=0 : d=ReadLong(0) : If d<0
n=-d-1 :Else :AddElement(J(n)\Nt()) : J(n)\Nt()\u=d : J(n)\Nt()\ov = ReadLong(0)
J(n)\Nt()\st=ReadLong(0):J(n)\Nt()\lg=ReadLong(0):EndIf:Wend :CloseFile(0) :Gd()
Rf() : cx  =  0  :  EndIf  :  EndIf  :  Case 2  : c = ArraySize(J()) : If LT > 0
F$=SaveFileRequester("",s,P$,0) :If F$ :If Right(F$,4)<>".seq" :F$+".seq" :EndIf
Delay(0100) : While WindowEvent() : Wend : If CreateFile(0, F$) : WriteLong(0,c)
For n=0 To c:If ListSize(J(n)\Nt()):WriteLong(0,-(n+1)):ForEach J(n)\Nt() :WL\u)
WL\ov) :WL\st) :WL\lg) :Next :EndIf : Next : CloseFile(0) : EndIf : EndIf : Else
MessageRequester("","Nothing to save!"):EndIf:Case 3 :Q=1 :EndSelect :Case 13100
Select EventGadget():Case 1:Tc=cx+gs-1 :cy=23 :DN :Case 2 :cx=Tc-(Tc/e)*e :Tc=LT
StopSound(-1):Case 3 : sN=12-Mod(cy,12) + 12*V : SoundFrequency(sN, Ov(4-cy/12))
PlaySound(sN, 1 ) : Delay( Pow( 2, 4 - Dr ) * Tp )  :  StopSound(-1 )  :  Case 6
If MessageRequester("Caution!", "Erase All?",4) = 6 :LT = 0 :ReDim J.tk(0) :Gd()
ClearList(J(0)\Nt()) : cx=0 : cy=23 : DN : SetGadgetState(7, 0) : EndIf : Case 7
gs=GetGadgetState(7)*e :Gd():Rf():Case 8 : BM=28-BM :s="Time = 4/4" : If BM = 16
s="Time = 3/4":EndIf:e=4*(28-BM):SG(8,s):Gd() :Rf() :cx=0 :EndSelect :Case 13110
If Tc<LT:Tc+1:If Tc>e*(GetGadgetState(7)+1):gs+e:SetGadgetState(7,gs/e):cy=23:DN
Gd():Rf():cy=23:EndIf:With J(Tc)\Nt();40........50........60........70........80
ForEach J(Tc)\Nt() : If \st : SoundFrequency(\u, Ov(\ov + 1)) : PlaySound(\u, 1)
DC(Tc-(Tc/e)*e):Else:StopSound(\u):EndIf:Next:EndWith:Else:DC(cx):EndIf :Case 16
Q=1:Case 257:Select EventwParam():Case 37,8:If cx>0:cx-1:EndIf:Case 38 : If cy>0
cy-1:DN:EndIf:Case 39:If cx<w/BM-1:cx+1:EndIf:Case 40 :If cy<47 :cy+1 :DN :EndIf
Case 45,13:If bg=gc:sE=gs+cx+Int((16/Pow(2,Dr))):sN=12-Mod(cy,12)+12*V:O=3-cy/12
If sE>LT :LT=sE :Tc=LT : ReDim J.tk(LT) : EndIf : For n=1 To 1 : If ListSize(SL)
ForEach SL:If SL\u=sN:If SL\st:Break 2:EndIf:EndIf:Next :EndIf :AN(cx+gs,sN,O,1)
AN(sE,sN,O,0):DrN(J(cx+gs)\Nt()\lg,VC(V)):Next:EndIf:Case 33:If V<4:V+1:DV:EndIf
Case 34:If V>0:V-1:DV:EndIf:Case 35:If Dr<4:Dr+1:DD:EndIf:Case 36 :If Dr>0 :Dr-1
DD:EndIf :Case 46 : If bg<>gc : For n=0 To 4 : If bg=VC(n) : Vx=n : EndIf : Next
nt=12-Mod(cy,12):O=3-cy/12:sN=nt+12*Vx:n=0:Repeat:While ListSize(SL)=0:cx-1:Wend
ForEach SL:If SL\u=sN And SL\st=1 And SL\ov=O:Lg=SL\lg:DeleteElement(SL,1):cx+Lg
ForEach SL :If SL\u=sN And SL\st=0 And SL\ov=O :DeleteElement(SL,1) :EndIf :Next
cx-Lg:SS:For n=cx To cx+Lg-1:Box(1+n*BM,1+cy*10,BM-1,9,gc):Next:SD:FB:EndIf:Next
If n=0:cx-1:EndIf :Until n :For n=LT To 1 Step -1 :If ListSize(J(n)\Nt()) :Break
EndIf:Next :LT=n :ReDim J.tk(n) :EndIf :Case 107,187 :If Tp>70 :Tp-10 :WT :EndIf
Case 109,189 : If Tp<300 : Tp +10 : WT : EndIf : EndSelect : EndSelect : Until Q
;.......10........20........30........40........50........60........70........80

[einander]

Code: Select all

;*****************************************************************************
;*
;* Season's Greetings PurePunch Demo contest
;* PureBasic 5.00 +
;* 80 lines of 80 chars, 1 month delay
;*
;* Name     : "Eine Kleine PBmusik - Experiment in recombinatorial music
;* Author   : einander
;* Date     : 31.12.2012
;* Notes    : A indigest macro soup for windows only :)
;*
;*****************************************************************************
Macro M(P,T):Macro P:T:EndMacr:EndMacro:M(E:EndIf)o:M(Mu:Midiout)o:M(Nx:Next)o;;
M(Mo:Mu#ShortMsg_)o:M(Dr:Drawing)o:M(PY:Play)o:M(TR:Thread)o:M(CP:Caps)o:T.S;;;;
M(G:Gadget)o:M(Sga:Set#G#Attribute)o:M(Im:Image)o:M(Wn:Window)o:M(Dk:Desktop)o;;
M(D:Delay)o:M(GS:Get#G#State)o:M(P:Procedure)o:M(EP:End#P)o:M(C:Case)o:
M(Ca:Canvas)o:M(SG:Set#G#State)o:M(AR:Array)o:M(SD:StopDrawing())o:M(RN:Random)o
M(R:ProcedureReturn)o:M(ES:Else)o:M(B:Beat)o:M(SL:Select)o:M(GL:Global)o
M(ST:Structure)o:M(PN:Py#Nt)o:M(O:Output)o:M(H:Height)o:M(Wi:Width)o:M(An:AND)o;
M(F:For I=0 To)o:M(MX:Mutex)o:M(LX:LOCK#Mx(_M))o:M(UX:Un#Lx)o:M(TX:Try#Lx)o
M(SAG:Set#G#Attribute)o:m(SGC:set#g#color)o
M(MC:Macro)o:St Th:Mo.I:Ro.I:Tpo.I:V.I:I.I:Pl.I:C.I[6]:K.I[6]:End#St
GL _M=Create#Mx(),TP,Mo,CG,TQ,Th1,CK,_Q:Dim TB.I(5)
Gl Dim _N.A(0),Dim SF(5),Dim HR(5),_L,QS,Th.Th,XS,YS
MC C3:_L=Len(T)-1:Dim _N(_L):F(_L):_N(I)=PeekA(@T+I)-32:Nx:Mo(Mo,$78B0):EndMacro
Mc C0:T="FYa M RY U^ Y T\ Y R[ K U [ ^ Uc ^ Ua K DW` K PW T\ W R[ W DPY I` PY U"
T+"^ Y Y\ UY Y IU OY[ R U IRY U[ IPY U OX H R T X R[ T X HT[` M^ T]a T MY\` HT "
T+"RX[^  TY\ H MQY[ T HTX\ MW] T HW MTY ":C3:EndMacro:MC C1:T="BNZ^a  Z^a B N U"
T+" Z \ BZa U Z N U Za B U J^b Y > ^e Y > ^b J >^e  Y > J^e b J^ W KZ^   K ? W "
T+"Zc Z^c ? W Z ? Zc ^ Z KW =IUZ^  UZ^  = U Z^ I^ = a ^ = Za ^ IZ UU BNX^a   B "
T+"N U X^ UX^ B U X a B ^ X B GWZ_  WZ_ G GWZ_ a _ a GWZc a _ Z^a FR ^ Z K DPW\"
T+"_   K D    8 D W _ P\ SW \ DW IZ_    = W Z =_ IUZ_  UZ_ = IZa _ Z = "
_L=Len(T)-1:C3:EndMacro:Mc C2:T="Kgjv   R Wg  e ^g K  W c o l ^j ^bgj F  R be  "
T+"Y R ^ JY^e R Y ^ V Y e Mg AW\ch  W COW^cj  W DPW^cj `l W  Wc P RW\`co Fn Wl "
T+"Rj KW[^c  W K W[^c  W S GX]ad  X G S \_dht iu Gkw L  S hkpt P X \f _h L  X d"
T+" p m _k _ck G  S i  Z S _ KZ_ S Z _ W Z f h BX]di  X DPX_dk  X EQX_dk am X  "
T+"Xd Q SX]adp Gr m S_dp LX\  X L X^ad  X L FW\^c  W F R [^co{ `lx Rjv "
_L=Len(T)-1:C3:EndMacro:C0:CopyMemory(?Rs,@SF(),24):CopyMemory(?Rh,@HR(),24)
P PN(Nt,Ch=0,V=100,Z=-1):If Ch=0:Mo(Mo,$B0|Ch|$A00|Nt<<16):E
Mo(Mo,$90|Ch|Nt<<8|V<<16):If Ch=0 And Z>-1:Tx:Start#Dr(Ca#O(CG))
Box((Nt-20)*Xs,O#H()-Ys-Z*Ys,Xs,Xs,Th\K[Z]):Stop#Dr():Ux:E:EP
P RS(Ar A(1),Ar Tb(1)):F(5):A=A(I):SG(Tb(I),A):If I:Th\C[I]=A:Es
Th\C[0]=200-A+100:E:NX:EP:P TA(Nt,Tr):Ov=Nt/12:R(Nt+Tr)%12+Ov*12:EP:P Th(Void);;
With Th.Th
Repeat:If \Mo:\Ro+(Rn(4)+1):\Ro%12:E:B=0:If TX:SAG(CG,1,Im#ID(\I)):UX:E:F(_L);
Nt=_N(I):If Nt:Lx:If \Ro:Nt=Ta(Nt,\Ro):E:If Tp:Nt=Ta(Nt,Tp):E:N1=Nt:Nt+12*RN(2);
\V=60+RN(30):If \C[5]=0 Or RN(\C[5]):If \C[3]>35 And N1<\C[3]  And Nt>30
PN(Nt-12,0,\V,3):E:If \C[4]>35 And N1<\C[4] And Nt<90:PN(Nt+12,0,\V,4):E
PN(Nt,0,\V+10,0):If \C[1]>36 And N1<\C[1]:PN(Nt+12,0,\V,1):E
If \C[2]>36 And N1<\C[2]:PN(Nt-12,0,\V,2):E:Es:If RN(1):PN(Nt-1,0,\V-10,5)
PN(Nt+11,0,\V-10,5):OA=Nt:Es:PN(Nt,0,\V+20,5):N2=Nt:E:E:Ux:Es:If Gs(CK) And B=0
PN(76,9,100):E:B+1:If OA:D(\C[0]/2):Lx:PN(OA,0,\V+20,5):PN(OA+12,0,\V+20,5)
OA=0:Ux:D(\C[0]/2):Es#If N2:D(\C[0]/2):Lx:PN(N2-1,0,\V-10,5):D(\C[0]/2)
PN(N2,0,\V+10,5):N2=0:Ux:Es:If QS:QS=0:Break:E:If TQ:Break 2:E:D(\C[0]):If B%4=0
SAG(CG,1,Im#ID(\I)):E:E:E:If B=8:Mo(Mo,$78B0):B=0:E:NX:Until _Q Or TQ:EndWith:Ep
Examine#Dk#s():DWi=Dk#Wi(0):a$="Experiment in recombinatorial music"
Open#Wn(0,100,100,DWi/2.4,Desktop#H(0)/2.2,"Eine Kleine PBmusik - "+a$,$Cf0001) 
Wi=Wn#Wi(0):He=Wn#H(0):SP=DWi/16:Set#Wn#Color(0,$22):X=10:Y=10
With Th
Restore TBS:F(5):Read A:Read B:Tb(I)=TrackBar#g(-1,X+16,Y,22,He/2,A,B,2):X+SP:NX
RS(SF(),Tb()):X=10:A=SP*0.8:F(5):Read$ A$:Read$ B$
Tg=Text#G(-1,X,Y+He/1.85,A,16,A$,1):X+SP:SGC(Tg,1,0):Th\K[I]=Val("$"+B$)
SGC(Tg,2,Th\K[I]):NX:X=G#X(Tb(5))+A/2:CM=CheckBox#G(-1,X,10,A,20,"Modulate")
OS=Option#G(-1,X, 35,A,20,"Soft"):OH=Option#G(-1,X,60,A,20,"Hard")
CK=CheckBox#G(-1,X,85,A,20," Click"):SPT=SpinGadget(-1,X,110,30,20,0,11,2)
Op0=Option#g(-1,X,135,70,20,"Seed 1"):Op1=Option#g(-1,X,160,70,20,"Seed 2")
Op2=Option#g(-1,X,185,70,20,"Seed 3"):CH#Py=CheckBox#g(-1,X,230,A,20," Play")
tg=TextGadget(-1,x+32,110,80,20,"Transpose"):sgc(tg,1,#White):sgc(tg,2,$22)
SG(SPT,0):CG=Ca#G(-1,10,He*0.66,Wi-20,He*0.32):\I=Create#Im(-1,Wi-20,He*0.32)
Start#Dr(Im#O(\I)):Box(0,0,O#Wi(),O#H(),22):XS=O#Wi()/90:YS=O#H()/7:Stop#Dr()
SAG(CG,1,Im#ID(\I)):F(Mu#GetNumDevs_()-1)
If Mu#GetDevCaps_(I,@MD.Mu#Caps,SizeOf(Mu#CAPS))=0:If MD\WVoices
Mu#Open_(@Mo,I,0,0,0):Break:E:E:NX:Repeat:Ev=WAIT#Wn#Event(1)
If GetAsyncKeyState_(27)&$8000:_Q=1:Break:E:If Ev=13100:Sl Event#G():C Ch#Py
\PL=GS(Ch#Py):If \PL:If Is#Tr(Th1)=0:TQ=0:Th1=Create#Tr(@Th(),Ev):E:Es
Pause#Tr(Th1):WAIT#Tr(Th1,500):If Is#Tr(Th1):Kill#Tr(Th1):E:Mo(Mo,$78B0)
SAG(CG,1,Im#ID(\I)):E:C CM:\Mo=GS(CM):If \Mo:\Ro+7:E:C OS: RS(SF(),Tb()):C OH
RS(HR(),Tb()):C SPT:TP=GS(SPT):C Tb(0):\C[0]=200-GS(Tb(0))+100:C Tb(1)
\C[1]=GS(Tb(1)):C Tb(2):\C[2]=GS(Tb(2)):C Tb(3):\C[3]=GS(Tb(3)):C Tb(4)
\C[4]=GS(Tb(4)):C Tb(5):\C[5]=GS(Tb(5)):If \C[5]:\C[5]=49-\C[5]:E:C Op0:C0:QS=1
C Op1:C1:QS=1:C Op2:C2:QS=1:End#Sl:E:Until EV=16:_Q=1:EndWith:If Is#Tr(Th1)
Pause#Tr(Th1):WAIT#Tr(Th1,500):If Is#Tr(Th1):Kill#Tr(Th1):E:E:End
DataSection:Tbs:Data.I 0,200,36,67,36,67,35,68,35,68,0,48
  Data.S "Tempo","ffffff","High 8","ffff","Low 8","ff00","Bass","336688","Treble","ff00ff","Fill","ff"
  RS:Data.I 80,0,35,35,35,0:RH:Data.I 120,67,36,68,40,38   
EndDataSection

[djes]

Thanks everybody ! Just a quick note to say that I'll prepare the archive, and the vote system.

[djes]

Thank you to go to vote there : http://www.purebasic.fr/english/viewtop ... 14&t=52694