j'espère que je ne l'ai pas buggée en la punchant. Il n'y a que 125 lignes et pas de fichier image (à part un screenshot). Pour ceux qui connaissent, la musique, c'est "Crosstown traffic" de Jimi Hendrix.
Code : Tout sélectionner
;*****************************************************************************
;*
;* Birthday Punch : PureBasic 15 years of happiness
;* PureBasic 5.24
;* 192 lines of 80 chars of code or data as you want
;*
;* Name : Crossplatform traffic
;* Author : Huitbit
;* Date : october~november 2015
;* Notes : Try to make 15 laps (use arrow keys)!
;*
;*
;*****************************************************************************
Macro _:Structure:EndMacro:Macro e:EndIf:EndMacro:Macro w:Sprite:EndMacro;;;
Macro u:DisplayTransparent:EndMacro:Macro c:Create:EndMacro:Macro d:StartDrawing
EndMacro:Macro h:StopDrawing:EndMacro:Macro j:DrawText:EndMacro:Macro r:Random;;
EndMacro:Macro i:Window:EndMacro:Macro k:Next:EndMacro:Macro g:KeyboardPushed;;;
EndMacro:Macro t:RoundBox:EndMacro:Macro n:Circle:EndMacro:Macro q:Display;;;;;;
EndMacro:Macro x(ii,ff):LoadFont(ii,"Impact",ff,512):EndMacro:Macro z:Box;;;;;;;
EndMacro:_ PT:x.l:y.l:s.l:a.f:az.f:b.f:o.f:ve.b:ar.f:End#_:_ ec:x.f:y.f:pl.l;;;;
cs.f:ss.f:ar.f:ad.f:End#_:lt=3180:ht=1900:dm.l=60:ns.l=3:nl.l=13:uu.f=180/#PI;;;
vv.f=1/uu:rv.f=0.25:lk.l:cs.f:ss.f:ar.f:aeC.f:aej.f:aez.f:ab.f:bt.f:bl.f:cd.f;;;
sb.l:ea.f:xC.f:yC.f:xj.f:yj.f:xPb.f:yPb.f:xz.f:yz.f:xB.f:yB.f:xrb.f:yrb.f:xeb.f;
yeb.f:xrc.f:yrc.f:xrj.f:yrj.f:xrz.f:yrz.f:xev.f:yev.f:xec.f:yec.f:xej.f:yej.f;;;
xez.f:yez.f:dr.f:dx.f:dy.f:drt.f:cc.l:ct.l:poussiere.f:lC.l:lj.l:lPb.l:lz.l:lb.l
Dim P.PT(nl):Restore cq:For i=0 To nl:Read.l P(i)\x:P(i)\x=P(i)\x+566;;;;;;;;;;;
Read.l P(i)\y:P(i)\y=P(i)\y+566:k i:Procedure.l subdv(Array pP.PT(1),pNptCtrl,;;
pNbrSubdv,pr.f):Dim Ptemp.PT(pNptCtrl):CopyArray(pP(),Ptemp());;;;;;;;;;;;;;;;;;
For nSubdv=1 To pNbrSubdv:ReDim pP(2*pNptCtrl+1):For n=0 To pNptCtrl-1;;;;;;;;;;
pP(2*n)\x=Ptemp(n)\x+pr*(Ptemp(n+1)\x-Ptemp(n)\x):pP(2*n)\y=Ptemp(n)\y+;;;;;;;;;
pr*(Ptemp(n+1)\y-Ptemp(n)\y):pP(2*n+1)\x=Ptemp(n)\x+(1-pr)*(Ptemp(n+;;;;;;;;;;;;
1)\x-Ptemp(n)\x):pP(2*n+1)\y=Ptemp(n)\y+(1-pr)*(Ptemp(n+1)\y-Ptemp(n)\y):k n;;;;
n=pNptCtrl:pP(2*n)\x=Ptemp(n)\x+pr*(Ptemp(0)\x-Ptemp(n)\x):pP(2*n)\y=Ptemp(n)\y+
pr*(Ptemp(0)\y-Ptemp(n)\y):pP(2*n+1)\x=Ptemp(n)\x+(1-pr)*(Ptemp(0)\x-Ptemp(n)\x)
pP(2*n+1)\y=Ptemp(n)\y+(1-pr)*(Ptemp(0)\y-Ptemp(n)\y):pNptCtrl=2*pNptCtrl+1;;;;;
ReDim Ptemp.PT(pNptCtrl):CopyArray(pP(),Ptemp()):k nSubdv;;;;;;;;;;;;;;;;;;;;;;;
ProcedureReturn pNptCtrl:EndProcedure:Macro af(a,az,b,xA,yA,xB,yB):If xA<>xB;;;;
If xA<xB:a=(yB-yA)/(xB-xA):Else:a=(yB-yA)/(xA-xB):e:az=(yB-yA)/(xB-xA);;;;;;;;;;
b=yB-az*xB:e:EndMacro:Macro a(nom,couleur):c#W(nom,48,30):d(W#Output(nom)):t(33,
0,9,30,2,2,$222222):t(6,0,9,30,2,2,$222222):t(0,3,48,24,4,6,couleur):t(6,6,9,18,
3,3,$400000):Ellipse(24,15,6,9,$400000):t(12,6,12,18,3,3,couleur):For i=0 To 20;
n(r(46,2),r(24,4),1,$13458B):k i:h():EndMacro:Macro ac(nom,lConc,xConc,yConc,;;;
xRot,yRot,xEcran,yEcran):Rotate#W(nom,s(lConc)\ad+_a,0);;;;;;;;;;;;;;;;;;;;;;;;;
xRot=(xConc-xv)*Cos(_a*vv)-(yConc-yv)*Sin(_a*vv)+xv:yRot=(xConc-xv)*Sin(_a*vv)+;
(yConc-yv)*Cos(_a*vv)+yv:xEcran=(xRot-xv)+tc*0.5-24:yEcran=(yRot-yv)+tc*0.5+2;;;
If (xRot<tc*0.5+xv) And (yRot<tc*0.5+yv):u#W(nom,xEcran,yEcran):e:EndMacro;;;;;;
Macro v(nom,x,y,xEcran,yEcran,l):If W#Collision(3,xv,yv,nom,x,y):If yev<yEcran;;
l=l-10:e:If yev>=yEcran:l=l+10:e:If l<0:l=l+lk:e:If l>lk:l=l-lk:e:If bl<192:bl+8
Else:sc():e:e:EndMacro:Macro sc():MessageRequester("GAME OVER",Str(ct)+" TOUR("+
"S)"+Chr(13)+"SCORE :"+Str(lk*ct+_l)):Goto jeu:EndMacro:nl=subdv(P(),nl,ns,rv);;
For n=0 To nl-1:If P(n)\x<>P(n+1)\x:af(P(n)\a,P(n)\az,P(n)\b,P(n)\x,P(n)\y,P(n+;
1)\x,P(n+1)\y):P(n)\o=Sqr(1+P(n)\a*P(n)\a):Else:P(n)\ve=1:e:k n:n=nl;;;;;;;;;;;;
If P(n)\x<>P(0)\x:af(P(n)\a,P(n)\az,P(n)\b,P(n)\x,P(n)\y,P(0)\x,P(0)\y);;;;;;;;;
P(n)\o=Sqr(1+P(n)\a*P(n)\a):Else:P(n)\ve=1:e:P(0)\s=0:lk=0:For n=0 To nl-1;;;;;;
If P(n)\ve<>0:lk=lk+Abs(P(n+1)\y-P(n)\y):Else:lk=lk+P(n)\o*Abs(P(n+1)\x-P(n)\x);
e:P(n+1)\s=lk:k n:n=nl:If P(n)\ve<>0:lk=lk+Abs(P(0)\y-P(n)\y):Else:lk=lk+;;;;;;;
P(n)\o*Abs(P(0)\x-P(n)\x):e:Dim s.ec(lk):s(0)\x=P(0)\x:s(0)\y=P(0)\y:s(0)\pl=0;;
If P(0)\ve<>1:s(0)\cs=Sign(P(1)\x-P(0)\x)/P(0)\o:s(0)\ss=P(0)\a/P(0)\o;;;;;;;;;;
s(0)\ar=ATan2(s(0)\cs,s(0)\ss):Else:s(0)\cs=0:s(0)\ss=Sign(P(1)\y-P(0)\y);;;;;;;
s(0)\ar=ATan2(s(0)\cs,s(0)\ss):e:l=1:For n=0 To nl-1:If P(n)\ve<>1:cs=Sign(P(n+;
1)\x-P(n)\x)/P(n)\o:ss=P(n)\a/P(n)\o:ar=ATan2(cs,ss):P(n)\ar=ar:Else:cs=0;;;;;;;
ss=Sign(P(n+1)\y-P(n)\y):ar=ATan2(cs,ss):P(n)\ar=ar:e:If n<>0;;;;;;;;;;;;;;;;;;;
If (P(n)\ar-P(n-1)\ar)>=#PI:P(n)\ar=P(n)\ar-2*#PI:e:If (P(n)\ar-P(n-1)\ar)<=-#PI
P(n)\ar=P(n)\ar+2*#PI:e:e:While l<P(n+1)\s:s(l)\x=s(l-1)\x+cs:s(l)\y=s(l-1)\y+ss
s(l)\pl=n:s(l)\cs=cs:s(l)\ss=ss:s(l)\ar=P(n)\ar:l=l+1:Wend:If l=P(n+1)\s;;;;;;;;
s(l)\x=P(n+1)\x:s(l)\y=P(n+1)\y:s(l)\ar=P(n)\ar:s(l)\pl=n+1:l=l+1:e:k n:n=nl;;;;
If P(n)\ve<>1:cs=Sign(P(0)\x-P(n)\x)/P(n)\o:ss=P(n)\a/P(n)\o:ar=ATan2(cs,ss);;;;
P(n)\ar=ar:Else:cs=0:ss=Sign(P(0)\y-P(n)\y):ar=ATan2(cs,ss):P(n)\ar=ar:e;;;;;;;;
If (P(n)\ar-P(n-1)\ar)>=#PI:P(n)\ar=P(n)\ar-2*#PI:e:If (P(n)\ar-P(n-1)\ar)<=-#PI
P(n)\ar=P(n)\ar+2*#PI:e:While l<=lk:s(l)\x=s(l-1)\x+cs:s(l)\y=s(l-1)\y+ss;;;;;;;
s(l)\pl=n:s(l)\cs=cs:s(l)\ss=ss:s(l)\ar=P(n)\ar:l=l+1:Wend:ix=16:For l=0 To lk;;
If l>ix And (l<lk-ix):indice=0:For i=-ix To ix:indice=l+i:angle=s(indice)\ar*uu;
s(l)\ad=s(l)\ad+angle:k i:s(l)\ad=s(l)\ad/(2*ix+1):Else:s(l)\ad=s(l)\ar*uu:e:k l
Init#W():InitKeyboard():InitSound():Open#i(0,0,0,800,600,"Le survivant",;;;;;;;;
13107200):Open#i#edScreen(i#ID(0),0,0,800,600,1,0,0,2):x(1,440):x(2,20):x(3,30);
UseOGGSoundDecoder():LoadSound(0,"m.ogg"):c#W(12,48,48):d(W#Output(12));;;;;;;;;
For i=0 To 20:rnd=r(128,64):n(r(36,12),r(36,12),r(12,1),RGB(rnd,rnd,rnd)):k i;;;
h():c#W(8,16,16):d(W#Output(8)):t(0,0,16,16,2,2,RGB(184,134,11)):j(4,0,"X",;;;;;
RGB(92,60,11),$0B86B8):h():c#W(7,16,16):d(W#Output(7)):t(0,0,16,16,2,2,$FFFFFF);
j(4,0,"+",$0000FF,$FFFFFF):h():c#W(0,lt,ht):d(W#Output(0)):z(0,0,lt,ht,;;;;;;;;;
($408000)):For i=0 To 999:r=r(48):n(r(lt),r(ht),r(8,2),RGB(r,128+r,64+r)):k i;;;
DrawingFont(FontID(1)):j(744,570,"15 ans",$FFFFFF,$408000):For l=1 To lk-1;;;;;;
If Abs(s(l+1)\ar-s(l-1)\ar)>#PI/15 And l<>lk-1:n(s(l)\x,s(l)\y,dm+2,$0000FF);;;;
Else:n(s(l)\x,s(l)\y,dm,$FFFFFF):e:k l:For l=0 To lk-1:r=r(8):n(s(l)\x,s(l)\y,;;
dm-4,RGB(128+r,128+r,255)):k l:z(s(0)\x,s(0)\y-dm,16,118,$010000):For i=0 To 1;;
For j=0 To 14:If (i+j)%2=0:z(s(0)\x+i*8,s(0)\y+j*8-dm,8,8,$FFFFFF):e:k j:k i:h()
jeu: :a(1,$FF5320):a(2,$FFFFDB):a(3,$1011ED):a(4,$109606):c#W(5,11,11);;;;;;;;;;
d(W#Output(5)):n(5,5,5,($004080)):h():c#W(6,800,600):d(W#Output(6)):z(0,0,800,;;
600,$010000):n(283,283+17,282,0):BackColor($010000):j(566+17,200,"COMPILATION "+
"SPEED"):j(566+17,266,"BUG LEVEL"):j(566+17,322,"BATTERY"):j (566+17+64,400,"C"+
"++"):j (566+17+64,450,"JAVA"):j (566+17+64,500,"PureBasic"):j (566+17+64,550,;;
"Python"):DrawingFont(FontID(3)):j(612,38,"15 ans"):For i=0 To nl-1;;;;;;;;;;;;;
LineXY(P(i)\x/15+566,P(i)\y/15,P(i+1)\x/15+566,P(i+1)\y/15,$FFFFFF):k i;;;;;;;;;
LineXY(P(nl)\x/15+566,P(nl)\y/15,P(0)\x/15+566,P(0)\y/15,$0000FF):h():c#W(9,192,
8):d(W#Output(9)):z(0,0,192,8,$00FF00):For i=1 To 47:Line(i*4,0,1,8,$00FFFF):k i
h():c#W(11,512,32):d(W#Output(11)):DrawingFont(FontID(2)):For i=0 To 15:j(i*32,;
0,Hex(i),$FFFFFF,$010000):k i:h():PlaySound(0,1):xv.f=s(0)\x:yv.f=s(0)\y;;;;;;;;
av.f=s(0)\ar:_n=1:lC=180:lj=100:lz=40:_l=0:lb=200:bt=192:bl=0:cd=0:dr=0:drt=0;;;
v=0:sb=7:cc=0:ct=0:ClearScreen(RGB(0,0,1)):Display#W(1,0,0):Display#W(2,0,50);;;
Display#W(3,0,100):Display#W(4,0,150):Grab#W(10,0,0,48,150+48):Repeat:v(1,xC,yC,
xec,yec,lC):v(2,xj,yj,xej,yej,lj):v(4,xz,yz,xez,yez,lz):If W#Collision(3,xv,yv,;
sb,xB,yB):If sb=7:bl=bl-48:If bl<0:bl=0:e:e:If sb=8:bt=bt+48:If bt>192:bt=192:e;
e:lb=lb+lk*0.4:sb=sb+1:If sb>8:sb=7:e:e:ExamineKeyboard():If g(200):If dr<6.6;;;
drt=0.08:e:ElseIf g(208):If dr>0:drt=-0.1:e:Else:If dr>0:drt=-0.01:e:e:If g(203)
If _n<>0:ea.f=(av-P(_n-1)\ar):Else:ea=(av-P(nl)\ar):e:If ea>#PI:ea=ea-2*#PI:e;;;
If ea<-#PI:ea=ea+2*#PI:e:If ea>-#PI/4:av=av-#PI/60:e:If av>#PI:av=av-2*#PI:e;;;;
If av<-#PI:av=av+2*#PI:e:e:If g(205):If _n<>0:ea=(av-P(_n-1)\ar):Else;;;;;;;;;;;
ea=(av-P(nl)\ar):e:If ea>#PI:ea=ea-2*#PI:e:If ea<-#PI:ea=ea+2*#PI:e:If ea<#PI/4;
av=av+#PI/60:e:If av>#PI:av=av-2*#PI:e:If av<-#PI:av=av+2*#PI:e:e:If _n<>0;;;;;;
If P(_n-1)\ve<>1:de=(Abs(P(_n-1)\az*xv-yv+P(_n-1)\b)/P(_n-1)\o):Else;;;;;;;;;;;;
de=(Abs(P(_n-1)\x-xv)):e:Else:If P(nl)\ve<>1:de=(Abs(P(nl)\az*xv-yv+;;;;;;;;;;;;
P(nl)\b)/P(nl)\o):Else:de=(Abs(P(nl)\x-xv)):e:e:If de>dm+6:If dr>1:drt=-1:e;;;;;
bl=bl+0.1:poussiere=1:Else:poussiere=0:e:If de>dm+24:sc():e:dr=dr+drt:If dr>6.5;
dr=6.5:e:If dr<0:dr=0:e:cd=dr*30:dx=dr*Cos(av):dy=dr*Sin(av):If (xv-P(_n)\x)*dx+
(yv-P(_n)\y)*dy>0:_n=_n+1:If _n>nl:_n=0:_l=0:ct=ct+1:If ct>cc And lC<lk-30;;;;;;
bt=192:e:e:e:If ct=15 And _l>20:MessageRequester ("CONGRATULATIONS !","SCORE :"+
Str(lk*ct+_l)):Goto jeu:e:If ElapsedMilliseconds()-co>2:co=ElapsedMilliseconds()
lC=lC+5:lj=lj+3:lz=lz+2:lb=lb+1:If lC>=lk:cc=cc+1:lC=0:e:If lj>=lk:lj=0:e;;;;;;;
If lz>=lk:lz=0:e:If lb>=lk:lb=0:e:If dr<>0:bt=bt-0.1:e:xv=xv+dx:yv=yv+dy:e;;;;;;
aeC=lC*2*#PI/lk:aej=lj*2*#PI/lk:aez=lz*2*#PI/lk:ab=lb*2*#PI/lk:If bt<0:sc():e;;;
xC=s(lC)\x+35*Cos(4*aeC):yC=s(lC)\y+35*Sin(4*aeC):xj=s(lj)\x+35*Cos(8*aej+#PI/4)
yj=s(lj)\y+35*Sin(8*aej+#PI/4):xz=s(lz)\x+35*Cos(4*aez+#PI/2):yz=s(lz)\y+;;;;;;;
35*Sin(4*aez+#PI/2):xB=s(lb)\x+50*Cos(16*ab):yB=s(lb)\y+50*Sin(16*ab):_l=_l+dr;;
If _l>lk:_l=0:e:If s(_l)\pl>_n And _l<>0:_l=_l-2:ElseIf s(_l)\pl<_n:_l=_l+1:e;;;
tc=566:Clip#W(0,xv-tc*0.5,yv-tc*0.5,tc,tc):_a=-90-s(_l)\ad:Rotate#W(0,_a,0);;;;;
q#W(0,0,17):Rotate#W(3,av*uu+_a,0):xev=(tc*0.5-24):yev=tc*0.5+2:u#W(3,xev,yev);;
ac(1,lC,xC,yC,xrc,yrc,xec,yec):ac(2,lj,xj,yj,xrj,yrj,xej,yej):ac(4,lz,xz,yz,xrz,
yrz,xez,yez):xrb=(xB-xv)*Cos(_a*vv)-(yB-yv)*Sin(_a*vv)+xv;;;;;;;;;;;;;;;;;;;;;;;
yrb=(xB-xv)*Sin(_a*vv)+(yB-yv)*Cos(_a*vv)+yv:xeb=(xrb-xv)+tc*0.5-5:yeb=(yrb-yv)+
tc*0.5+12:If (xrb<tc*0.5+xv) And (yrb<tc*0.5+yv):u#W(sb,xeb,yeb):e:u#W(6,0,0);;;
u#W(5,xv/15+561,yv/15-5,255,$0000FF):u#W(5,xC/15+561,yC/15-5):u#W(5,xj/15+561,;;
yj/15-5):u#W(5,xz/15+561,yz/15-5):Clip#W(9,0,0,cd,8):q#W(9,583,225):Clip#W(9,0,;
0,bl,8):u#W(9,583,291,255,$0000FF):Clip#W(9,0,0,bt,8):q#W(9,583,347):q#W(10,583,
384):Clip#W(11,ct*32,0,32,32):q#W(11,768,118):If poussiere=1:u#W(12,xev+r(2,0),;
yev+r(2,0),128):e:FlipBuffers():Until i#Event()=13116
DataSection
cq:
Data.l 443,61,861,61,1083,145,1661,141,1985,121
Data.l 1953,423,1943,679,1499,711,1053,681,689,659
Data.l 65,695,145,333,99,145,253,115
Data.l 803,135,1225,135,1531,391,1475,707,1041,759
EndDataSection
!
