PureBasic

Code : Tout sélectionner

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; PICASSO v2.0
; Createur de tableau
; SPH(2008)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

InitSprite() 
InitKeyboard() 
InitMouse()

#dw=1280
#dh=1024
#dc=32

If OpenScreen(#dw,#dh,#dc,"SCR_Bezier")=0
MessageRequester("Erreur", "Screen Open impossible a ouvrir", 0) : End
EndIf

dw2=#dw*2
dh2=#dh*2
#cmb=50
#nombre=10
#precision=450
; pourcentage alpha
pcentage=50

Global Dim p(dh2-1,dw2-1)
Global Dim rr.b(#cmb)
Global Dim vv.b(#cmb)
Global Dim bb.b(#cmb)

;p(dh2/2,dw2/2)=RGB(255,255,255)

Dim x.f(#cmb,#nombre)
Dim y.f(#cmb,#nombre)
Dim xx.f(#cmb,#nombre)
Dim yy.f(#cmb,#nombre)

; afficher l'image si elle existe
Filename$="c:\scr.jpg"
If FileSize(Filename$)>4000
UseJPEGImageDecoder()
LoadImage(0, Filename$)
ResizeImage(0,#dw,#dh,#PB_Image_Smooth)
ClearScreen(0)
StartDrawing(ScreenOutput())
DrawImage(ImageID(0),0,0)
StopDrawing()
FlipBuffers() 
;StopDrawing()
StartDrawing(ScreenOutput())
DrawImage(ImageID(0),0,0)
For u=0 To #dh -1
For i=0 To #dw -1
color=Point(i,u)
p(u+#dh/2,i+#dw/2)=RGB(Blue(color),Green(color),Red(color))
Next
Next
StopDrawing()
; pourcentage alpha
;pcentage=50
EndIf
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Gosub reset


Procedure bspline(x0,y0,x1,y1,x2,y2,x3,y3,ki) 

For i = 0 To #precision

    t1.f = i/#precision
    t2.f = t1*t1
    t3.f = t1*t1*t1

  	k1.f = 1 - 3*t1 + 3*t2 - t3
    k2.f = 4 - 6*t2 + 3*t3
  	k3.f = 1 + 3*t1 + 3*t2 - 3*t3

    xfinal.f = (x0 * k1 + x1 * k2 + x2 * k3 + x3 * t3) / 6
		yfinal.f = (y0 * k1 + y1 * k2 + y2 * k3 + y3 * t3) / 6
yfinal2.l=yfinal
xfinal2.l=xfinal

p=p(yfinal2,xfinal2)
r.l=Red(p)+rr(ki)
v.l=Green(p)+vv(ki)
b.l=Blue(p)+bb(ki)

If r<0
r=0
Else
If r>255
r=255
EndIf
EndIf
If v<0
v=0
Else
If v>255
v=255
EndIf
EndIf
If b<0
b=0
Else
If b>255
b=255
EndIf
EndIf

P(yfinal2,xfinal2)=RGB(r,v,b)
;Plot (xfinal,yfinal,RGB(r,g,b))   
;rr+1
;vv+1
;bb+1
Next I


EndProcedure 

Repeat 

For u=0 To #cmb
For i=0 To #nombre
x(u,i)+xx(u,i)
If x(u,i)<0 Or x(u,i)>dw2-2
xx(u,i)*-1
x(u,i)+xx(u,i)
EndIf
y(u,i)+yy(u,i)
If y(u,i)<0 Or y(u,i)>dh2-2
yy(u,i)*-1
y(u,i)+yy(u,i)
EndIf
Next  
Next  


For u=0 To #cmb
For n=0 To #nombre-4
  bspline(x(u,n),y(u,n),x(u,n+1),y(u,n+1),x(u,n+2),y(u,n+2),x(u,n+3),y(u,n+3),u)
Next
Next

;;;;; tracage
StartDrawing(ScreenOutput())
MemVideo = DrawingBuffer() 
For u=0 To #dh-1
;CopyMemory(@p(u,0), MemVideo+DrawingBufferPitch()*u,#dw*4)
CopyMemory(@p(u+#dh/2,0+#dw/2), MemVideo+DrawingBufferPitch()*u,#dw*4)
Next

StopDrawing() 
FlipBuffers() 

ExamineMouse()

If MouseButton(#PB_MouseButton_Left) Or Random(5000)=1; reset parametres
Gosub reset
Repeat
ExamineMouse()
Delay(100)
Until MouseButton(#PB_MouseButton_Left)=0
Delay(100)
EndIf

If MouseButton(#PB_MouseButton_Right) ; clear screen
Dim p(dh2-1,dw2-1)
EndIf

ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End
;;;;;;;;;;;;;;;

reset:
For u=0 To #cmb
For i=0 To #nombre
x(u,i)=Random(dw2-2)
y(u,i)=Random(dh2-2)
Next  
Next  

For u=0 To #cmb
vitesse=15
For i=0 To #nombre
xx(u,i)=(Random(100)-50)/vitesse
yy(u,i)=(Random(100)-50)/vitesse
Next  
Next  

For u=0 To #cmb
If Random(100)<=pcentage
;Repeat
Repeat
rr(u)=Random(12)-3
vv(u)=Random(12)-3
bb(u)=Random(12)-3
Until rr(u)+vv(u)+bb(u)<20
;Until vv(u)+3<rr(u)+bb(u) Or Random(2)=0
Else
Repeat
rr(u)=2-Random(9)
vv(u)=2-Random(9)
bb(u)=2-Random(9)
Until rr(u)+vv(u)+bb(u)<-10
EndIf
Next
Return

Code : Tout sélectionner

If MouseButton(#PB_MouseButton_Left) Or Random(5000)=1; reset parametres 

If MouseButton(#PB_MouseButton_Right) ; clear screen 
Dim p(dh2-1,dw2-1)