PureBasic

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  
;* Author : 
;* Date   : 
;* Notes  :
;*
;*****************************************************************************

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Automatic Pong
;* Author : Cpl.Bator
;* Date   : 1/06/2009
;* Notes  : Press any key to quit ( not tested on windows but linux )
;*
;***************************************************************************** 
InitSprite():InitKeyboard():OpenScreen(640,480,32,""):Bx.d=320:By.d=240:Bd.b=4
Macro M:Macro:EndMacro:M I:If:EndMacro:M EI:EndIf:EndMacro:M A:And:EndMacro:
M clsw:W=255:EndMacro:M C:Case:EndMacro:H=$FFFFFF:Dy=240:Gy=240:Repeat:Gy=By
ExamineKeyboard():W-1:I W<0:W=0:EI:Select Bd:C 1:Bx+0.5:By+0.5:C 2:Bx-0.5:
By+0.5:C 3:Bx-0.5:By-0.5:C 4:Bx+0.5:By-0.5:EndSelect:I By>476 A Bd=1:Bd=4:
clsw:EI:I By<4 A Bd=4:Bd=1:clsw:EI:I By>476 A Bd=2:Bd=3:clsw:EI:I By<4 A Bd=3:
Bd=2:clsw:EI:I Bx<20 A Bd=2:Bd=1:clsw:EI:I Bx<20 A Bd=3:Bd=4:clsw:EI:Dy=By
I Bx>610 A Bd=1:Bd=2:clsw:EI:I Bx>610 A Bd=4:Bd=3:clsw:EI:O=ScreenOutput()
StartDrawing(O):Circle(Bx,By,4,H):Box(10,Gy-32,10,64,H):Box(610,Dy-32,10,64,H)
StopDrawing():FlipBuffers(2):ClearScreen(RGB(W,W,W)):Until KeyboardInkey()

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Black Hole
;* Author : Cpl.Bator
;* Date   : 1/06/2009
;* Notes  : Press any key to quit , tested on Linux
;*
;***************************************************************************** 
InitSprite():InitKeyboard():OpenScreen(1024,768,32,"")
Repeat:ExamineKeyboard():StartDrawing(ScreenOutput())
TM = ElapsedMilliseconds():L.d=1024+512*Cos(TM/500):For S = 1 To 20
T.d=(1024+L)/S : C = (S*255)/20: X.d=(S*2)*Cos(TM/1250): Y.d=(S*4)*Sin(TM/550)
Circle((512+X),(384+Y),T,RGB(0,0,255-C)):Next :StopDrawing():FlipBuffers(2)
Until KeyboardInkey()

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* nom   : Pompage
;* Auteur : Tonton 
;* Date   : 1/06/2009 
;* commentaire  : bouges la souris
;* 
;*********************************************************************
#CameraSpeed=15:IncludeFile "Screen3DRequester.pb":Define.f KeyX,KeyY,MouseX
Define.f MouseY:InitEngine3D():Add3DArchive("Data\",#PB_3DArchive_FileSystem)
Add3DArchive("Data\Skybox.zip", #PB_3DArchive_Zip):InitSprite():InitKeyboard()
InitMouse():Screen3DRequester():CreateMaterial(0,LoadTexture(0,"r2skin.jpg"))
CreateEntity(0,LoadMesh(0,"Robot.mesh"),MaterialID(0)):SkyBox("desert07.jpg")
CreateCamera(0,0,0,100,100):CameraLocate(0,0,0,100):Repeat:Screen3DEvents()
ExamineMouse():MouseX =-(MouseDeltaX()/10)*#CameraSpeed/2
MouseY =-(MouseDeltaY()/10)*#CameraSpeed/2:RotateCamera(0,MouseX,MouseY, RollZ)
MoveCamera(0,KeyX,0,KeyY):RenderWorld():Screen3DStats():FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape):End

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Crazy waves
;* Author : Ollivier
;* Date   : 02/06/09
;* Notes  : Cf http://www.purebasic.fr/french/viewtopic.php?t=9437 
;*
;***************************************************************************** 
Q=600:Dim SX.F(Q):Dim SY.F(Q):Dim SA.F(Q):Dim SR.F(Q):#Z=4:Dim SV.F(Q)
InitSprite():#N=3:InitMouse():#B=2:ExamineDesktops():DW=DesktopWidth(0)
DH=DesktopHeight(0):OpenScreen(DW,DH,DesktopDepth(0),""):CreateSprite(0,DW,DH)
CreateSprite(1,#Z,#Z):StartDrawing(SpriteOutput(1)):Box(0, 0, #Z, #Z,#White)
StopDrawing():X.F=SX(0):Y.F=SY(0):For CA=0 To Q:SX(CA)=DW/2:SY(CA)=DH/2
SA(CA)=Random(628)/100:SV(CA)=Random(800)/100:Next CA:Repeat:Delay(1)
ExamineMouse():FlipBuffers():DisplaySprite(0,0,0):For I=0 To Q:X=SX(I):Y=SY(I)
DisplaySprite(1,X,Y):DX.F=(4999*X+DW/2)/5000:DY.F=(4999*Y+DH/2)/5000 
V.F=Sqr(DX*DX+DY*DY):VS.F=SV(I)*(100/V):SX(I)=DX+(Cos(SA(I))*VS):SR(I)+0.0001
SY(I)=DY-(Sin(SA(I))*VS):SA(I)+Sin(SR(I))*(10/V):Next:Until MouseButton(2)

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Bump-Mapping 640x480
;* Author : Cpl.Bator
;* Date   : 2/06/2009
;* Notes  : Tested on linux , program quit automatically
;*
;***************************************************************************** 
Macro R:For:EndMacro:Macro T:Next:EndMacro:S=512:W=640:H=480:W2=320:H2=240
Macro N:EndIf:EndMacro:InitSprite():OpenScreen(W,H,32,""):Dim L(S,S):g=64
R y=0 To S:R x=0 To S:Nxl.f=(x-(S/2))/(S/4):Nyl.f=(y-(S/2))/(S/4):Nzl.f:v.f
Nzl=1-Sqr((Nxl*Nxl)+(Nyl*Nyl)):If Nzl<=0:Nzl=0:N:L(x,y)=(200 * NZl):T x:T y
Dim B(1000,1000):R i = 0 To 79:R y= 0 To 63:R x= 0 To 63:C=(x*256/g)!(y*256/g)
B(x+dx,y+dy)=RGB(C,C,C):T:T:dx+g:If dx=W:dx=0:dy+g:N:T:Repeat:ClearScreen(0)
v+0.1:LX.f=W2+160*Cos(v):LY.f=H2+120*Sin(v/2):StartDrawing(ScreenOutput())
R y=1 To 479:R x=1 To 639:NX=(B(x+1,y)-B(x-1,y)):NY=(B(x,y+1)-B(x,y-1))
NLX.f=X-LX:NLY.f=Y-LY:NX=(NX+NLX)+(S/2):NY=(NY+NLY)+(S/2):NX%512:NY%512
C=L(NX,NY)<<8:Plot(x,y,C):T x:T y:StopDrawing():FlipBuffers(2):Until v>50

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* Nom   : lancé de rayons
;* Auteur : Tonton 
;* Date   : 02/06/2009 
;* Notes  : En deux lignes
;* 
;***************************************************************************** 
s.s="http://www.vincentlefort.com/projets/raytrace/raytrace_1.png"
#Http :ShellExecute_(GetDesktopWindow_(),"open",s.s,0,0,#SW_SHOWNORMAL) 

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : RayCasting 640x480
;* Author : Cpl.Bator
;* Date   : 3/06/2009
;* Notes  : Tested on linux , program quit automatically
;*
;***************************************************************************** 
w=1024:x=360:px=9*w:py=11*w:st=5:he=0:tr=1:Fc=$FFFFFF:Macro rnd(v):Random(v);##
EndMacro:Macro ef:EndIf:EndMacro:Dim L(20,20):For c=0 To 11:L(C,12)=rnd(Fc);###
b=540:L(C,0)=rnd(Fc):L(12,C)=rnd(Fc):L(0,C)=rnd(Fc):L(rnd(11),rnd(11))=rnd(Fc);
Next:Dim t(b):For i=0 To b:t(i) = (Cos((i*0.0174))*w)/10:Next:InitSprite():u=91
OpenScreen(640,480,32,""):Repeat:x1=0:y1=0:x2=0:y2=0:tm+1:q=100:If t<tm:t=tm+10
he=(he+tr)%x:ef:StartDrawing(ScreenOutput()):gl=he-44%x:If gl<0:gl=gl+x:ef;####
For a=gl To gl+89:xx=px:yy=py:tx=t(a+u):ty=t(a+1):l=0:While 1:xx=xx-tx:yy=yy-ty
l=l+1:O=(xx/w)%12:Li=(yy/w)%12:If L(Li,O)!0:Break:ef:Wend:h=900/l:y1=q-h:y2=q+h
x2=x1+3:Box(x1*2,y1*2,12,h*6,L(Li,O)):x1 = x2+1:Next:StopDrawing();############
FlipBuffers(2):ClearScreen(0):Until tm>10000;##################################

Code : Tout sélectionner

w=1024:x=360:px=9*w:py=11*w:st=5:he=0:tr=1:Fc=$FFFFFF:Macro rnd(v):Random(v);##
EndMacro:Macro ef:EndIf:EndMacro:Dim L(20,20):For c=0 To 11:L(C,12)=rnd(Fc);###
b=540:L(C,0)=rnd(Fc):L(12,C)=rnd(Fc):L(0,C)=rnd(Fc):L(rnd(11),rnd(11))=rnd(Fc);
Next:Dim t(b):For i=0 To b:t(i) = (Cos((i*0.0174))*w)/10:Next:InitSprite():u=91
OpenScreen(320,240,32,""):Repeat:x1=0:y1=0:x2=0:y2=0:tm+1:q=100:If t<tm:t=tm+10
he=(he+tr)%x:ef:StartDrawing(ScreenOutput()):gl=he-44%x:If gl<0:gl=gl+x:ef;####
For a=gl To gl+89:xx=px:yy=py:tx=t(a+u):ty=t(a+1):l=0:While 1:xx=xx-tx:yy=yy-ty
l=l+1:O=(xx/w)%12:Li=(yy/w)%12:If L(Li,O)!0:Break:ef:Wend:h=900/l:y1=q-h:y2=q+h
x2=x1+3:Box(x1,y1,6,h*3,L(Li,O)):x1 = x2+1:Next:StopDrawing();############
FlipBuffers(2):ClearScreen(0):Until tm>5000;###################################

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name : Pure Punch Pink Ghost
;* Author : Ollivier
;* Date : 05.06.09
;* Notes : Add DIRECTX9 option in compiler options if problem
;*
;*****************************************************************************
a.F:Macro P(C):Particle#C:EndMacro:UsePNGImageEncoder():InitEngine3D():v.F
InitSprite():InitKeyboard():Add3DArchive("\",0):OpenScreen(1024,768,32,"")
CreateImage(1,256,256):StartDrawing(ImageOutput(1)):For i=0 To 127:c=i*i*i/7850
Circle(128,128,127-i,RGB(c,c,c)):Next:StopDrawing():SaveImage(1,"PP",$474E50)
LoadTexture(0,"PP"):CreateMaterial(0,TextureID(0)):DisableMaterialLighting(0,1)
MaterialBlendingMode(0,1):Create#P(Emitter)(0,10,1,1,0):P(EmissionRate)(0,100);
P(Size)(0,256,256):P(Material)(0,MaterialID(0)):P(TimeToLive)(0,2,8)
P(Velocity)(0,1,300):F=100:P(ColorRange)(0,$FF0000,$FF):CreateCamera(0,0,0,F,F)
CameraLocate(0,0,0,2000):Repeat:P(EmitterDirection)(0,Cos(a),Sin(a),0):a+1.246
FlipBuffers():ExamineKeyboard():RenderWorld():Until KeyboardPushed(1)

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  Screen Wave
;* Author : TazNormand
;* Date   : 05 June 2009
;* Notes  :
;*
;***************************************************************************** 

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite():y=-256
InitKeyboard():i=CreateImage(0,w,h) :hDC=StartDrawing(ImageOutput(0))
Ddc=GetDC_(GetDesktopWindow_()):BitBlt_(hDC,0,0,w,h,DDC,0,0,#SRCCOPY)
StopDrawing() :ReleaseDC_(GetDesktopWindow_(),DDC):OpenScreen(w,h,32,"")
CreateSprite(0,w,h):StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h)
StopDrawing():Repeat:ExamineKeyboard():x=(Sin((y)/w*#PI*4)*128)+10
ClipSprite(0,0,y,w,256):DisplaySprite(0,x,y):FlipBuffers():ClearScreen(0):y=y+4
If y=h+32:y=-256:EndIf:Until KeyboardPushed(#PB_Key_Escape):End

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  Agitated Desktop
;* Author : TazNormand
;* Date   : 05 June 2009
;* Notes  : Appel d'API, ne devrait pas marcher sur Mac/linux/Amiga et Version Démo
;*
;*****************************************************************************


ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite()
InitSprite3D():InitKeyboard():i=CreateImage(0,w,h):sy=4:x=0:y=0:sx=8
hdc=StartDrawing(ImageOutput(0)):Ddc=GetDC_(GetDesktopWindow_())
BitBlt_(hdc,0,0,w,h,Ddc,0,0,#SRCCOPY):StopDrawing()
ReleaseDC_(GetDesktopWindow_(),Ddc):OpenScreen(w,h,32,""):CreateSprite(0,w,h,4)
StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h):StopDrawing()
CreateSprite3D(0,0):ZoomSprite3D(0,w/1.2,h/1.2):Repeat:ExamineKeyboard()
If x<0 Or x>w-(w/1.2):sx*-1:EndIf:If y<0 Or y>h-(h/1.2):sy*-1:EndIf:x+sx:y+sy
Start3D():DisplaySprite3D(0,x,y):Stop3D():FlipBuffers():ClearScreen(0)
Until KeyboardPushed(#PB_Key_Escape):End

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* Name   :Fractale
;* Author : Z@ph0d
;* Date   : 07/06/09
;* Notes  : 
;* 
;***************************************************************************** 

Procedure f(x.f,y.f,l.f,a.f)
 Protected ll.f, aa.f, l4.f , s.f, c.f
If l>1:f(x,y,l/4,a):aa=a:l4=l/4:s=Sin(a):c=Cos(a):x+s*l4:y+c*l4:a-#PI/2
f(x,y,l4,a):x+Sin(a)*l4:y+Cos(a)*l4:a+#PI/2+#PI/4:ll=l/2*Sqr(2)
f(x,y,ll,a):x+Sin(a)*ll:y+Cos(a)*ll
f(x,y,l4,a-#PI/1.33):f(x + Sin(a-#PI/1.33)*l4,y+Cos(a-#PI/1.33)*l4,l4,aa)
Else:StartDrawing(WindowOutput(0)):Plot(x,y,#Blue):StopDrawing():EndIf
EndProcedure
If OpenWindow(0,10,10,800,500,"Fractale",13107200|1|12582912)
f(10,250,750,#PI/2):Repeat:EventID=WaitWindowEvent():Until EventID=16:EndIf

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  Ouch !!!
;* Author : TazNormand
;* Date   : 07 June 2009
;* Notes  : Appel d'API, ne devrait pas marcher sur Mac/linux/Amiga et Version Démo
;*
;*****************************************************************************

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite():sx=0:p=8
InitSprite3D():InitKeyboard():i=CreateImage(0,w,h):sy=0:r=32:x=(w-(w/r))/2
hc=StartDrawing(ImageOutput(0)):d=GetDC_(GetDesktopWindow_()):y=(h-(h/r))/2
BitBlt_(hc,0,0,w,h,d,0,0,#SRCCOPY):StopDrawing():
ReleaseDC_(GetDesktopWindow_(),d):OpenScreen(w,h,32,""):CreateSprite(0,w,h,4)
StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h):StopDrawing()
CreateSprite3D(0,0):ZoomSprite3D(0,w/r,h/r):Repeat:ExamineKeyboard():Start3D()
DisplaySprite3D(0,x,y):Stop3D():r-1:If r>1:x=(w-(w/r))/2:y=(h-(h/r))/2
ZoomSprite3D(0,w/r,h/r):sy=y:sx=x:EndIf:If r<1:y=sy:sy+4:x=sx+p:p*-1:EndIf
FlipBuffers():ClearScreen(0):Until KeyboardPushed(#PB_Key_Escape) Or sy>w:End

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* Name   :  Punch Blitz 
;* Author : Huitbit 
;* Date   : 10 June 2009 
;* Notes  : Old MSX code translated  ;) 
;* 
;***************************************************************************** 
Macro c(a,b):ConsoleLocate(a,b):EndMacro:*z=AllocateMemory(1920):OpenConsole() 
w=v:n.s="   ":EnableGraphicalConsole(1):a.s=" "+Chr(200)+Chr(205)+Chr(206) 
For i=12 To 28:For j=23 To Random(5)+14 Step -1:PokeC(*z+i+j*40,1):c(i,j) 
Print(Chr(178)):Next j:Next i:For y=0 To 23:For x=0 To 38:c(x,y):Print(a) 
If x<37:If Inkey()<>"" And v=0:u=x+1:v=y+1:EndIf:EndIf:If PeekC(*z+x+4+y*40) 
s=40*y+x:For i=y To 22:c(x+1,i):Print(n):c(x+1,i+1):Print(Right(a,3)) 
Delay(99):Next i:c(3,0):Print("SCORE : "+Str(s)):Input():End:EndIf:If v<>0 
If v>23:v=0:EndIf:PokeC(*z+u+w*40,0):c(u,v-1):Print(" "):w=v:If v:c(u,v) 
Print("*"):v=v+1:EndIf:EndIf:Delay(50):Next x:c(39,y):Print(n):Next y
c(3,0):Print("**MISSION ACCOMPLIE !**"):Input():End