PureBasic

Forums PureBasic
Nous sommes le Sam 07/Déc/2019 7:28

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 13 messages ] 
Auteur Message
 Sujet du message: mini jeu : 4x4
MessagePosté: Mar 22/Sep/2015 21:11 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 270
Image

salut à tous,
j'ai fais un petit jeu de bagnole
le but est simple, finir le circuit (sans se retrouver sur le toit) pour passer au circuit suivant
(mais on peut aussi utiliser les touche "+" et "-" pour changer de circuit)
y'a encore pas mal de boulot (decors, ponts, tunnel, concurrents), mais là c'est déja jouable
j’espère que vous pourrez y puiser quelque fonctions intéressantes
(PS : y'a un bug : si vous laisser la bagnole immobile trop longtemps, elle se fige (faut changer de circuit pour la ranimer...))

tout est dans le code

Code:
;minijeux - 4x4 - Pf shadoko - 2015

EnableExplicit

Structure float3
  x.f
  y.f
  z.f
EndStructure

Global ex,ey,nsol=128*2,nsol1=nsol-1,action,niveau=1,departPos.float3,departsens.float3,ChkPtnum
Global Dim t.w(nsol1,nsol1)
Global Dim c.l(nsol1,nsol1)
Global Dim chs.float3(0)

Procedure.f POM(v.f)
  ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

Procedure.f M3Dlongueur(*v.float3)
  ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure

Procedure M3DNorme(*V.float3,l.f=1)
  Protected.f lm
  lm = l / M3Dlongueur(*v)
  *V\x * lm
  *V\y * lm
  *V\z * lm 
EndProcedure

Macro M3Dsub(p1,p2)
  p1\x-p2\x
  p1\y-p2\y
  p1\z-p2\z
EndMacro

Procedure.f maxi(v1.f,v2.f)
  If v1>v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure

Procedure.f mini(v1.f,v2.f)
  If v1<v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure

Procedure limite(V, i, s)
  If V < i :ProcedureReturn i:EndIf
  If V > s :ProcedureReturn s:EndIf
  ProcedureReturn V
EndProcedure

Procedure Tlimite(Array T(1), max, marge)
  Protected i
  Dim T(max + 2*marge): For i = 0 To max + marge: T(i+marge) = limite(i, 0, max): Next
EndProcedure

Procedure t2norme(Array t.w(2),dmin.w,dmax.w)
  Protected smin.w,smax.w,dx1,dy1,i,j,sr,dr
  dy1 = ArraySize(t(), 1)
  dx1 = ArraySize(t(), 2)
  smax = -32768
  smin =  32767
  For j=0 To dy1
    For i=0 To dx1
      If t(j,i)>smax : smax=t(j,i): EndIf
      If t(j,i)<smin : smin=t(j,i): EndIf
    Next
  Next
  sr=smax-smin
  dr=dmax-dmin
  Protected Dim conv(sr)
  For i=0 To sr:conv(i)=i*dr/sr+dmin:Next
  For j=0 To dy1
    For i=0 To dx1
      t(j,i)=conv(t(j,i)-smin)
    Next
  Next
EndProcedure

Procedure carte(Array t.w(2), dx.w, dy.w, Re.w,min=0,max=1000)
  Protected i,j,ii,jj,im,jm,ip,jp,n,d,dd,dx1=dx-1,dy1=dy-1,l,ap,ap2,R, rr
  Macro calcij(v)
    im=(i - v) & dx1
    jm=(j - v) & dy1
    ip=(i + v) & dx1
    jp=(j + v) & dy1
  EndMacro
  n = 1<<re
  dd=mini(dx,dy) / n: If dd<1:dd=1:EndIf
  Dim t.w(dy1, dx1)
  ap = $1fff:ap2=ap>>1
  For jj = 0 To dy/dd - 1:j=jj*dd: For ii = 0 To dx/dd - 1:i=ii*dd: t(j,i) = Random(ap)-ap2: Next: Next
  l = dd
  While dd > 1
    d = dd / 2
    rr = ap * Sqr(2): R = rr / 2
    For jj = 0 To dy/dd - 1  :j=jj*dd+d
      For ii = 0 To dx/dd - 1:i=ii*dd+d
        calcij(d)
        t(j,i) = (t(jm,im) + t(jm,ip) + t(jp,ip) + t(jp,im)) / 4 + Random(rr) - R
      Next
    Next
    rr = ap: R = rr / 2
    For jj = 0 To dy/dd - 1  :j=jj*dd
      For ii = 0 To dx/dd - 1:i=ii*dd+d
        calcij(d)
        t(j,i) = (t(j,im) + t(j,ip) + t(jm,i) + t(jp,i)) / 4 + Random(rr) - R
      Next
    Next
    For jj = 0 To dy/dd - 1  :j=jj*dd+d
      For ii = 0 To dx/dd - 1:i=ii*dd
        calcij(d)
        t(j,i) = (t(j,im) + t(j,ip) + t(jm,i) + t(jp,i)) / 4 + Random(rr) - R
      Next
    Next
    l >> 1
    dd>>1
    ap >> 1
  Wend
  t2norme(t(),min,max)
EndProcedure

Procedure lisser2D(Array s.w(2),di.w, dj.w)
  Protected i,j,dx,dy,dij,tx
  dy = ArraySize(s(), 1)
  dx = ArraySize(s(), 2)
  Dim d.w(dy,dx)
  Dim ty.l(dx)
  dij = (di * 2 + 1) * (dj * 2 + 1)
  Dim lx(0): Tlimite (lx(), dx, di + 1)
  Dim ly(0): Tlimite (ly(), dy, dj + 1) 
  For i = 0 To dx: ty(i) = s(0,i) * (dj + 1): Next
  For j = 0 To dj - 1: For i = 0 To dx: ty(i) = ty(i) + s(j,i): Next: Next
  For j = 0 To dy
    For i = 0 To dx: ty(i) = ty(i) + s(ly(dj+1+j + dj),i) - s(ly(dj+1+j - dj - 1),i): Next
    tx = ty(0) * (di + 1): For i = 0 To di - 1: tx = tx + ty(i): Next
    For i = 0 To dx: tx = tx + ty(lx(di+1+i + di)) - ty(lx(di+1+i - di - 1) ): d(j,i) = tx / dij: Next
  Next
  CopyArray(d(),s())
EndProcedure

Procedure lisser(Array s.f(1),l)
  Protected i,j,n,s.f
  n=ArraySize(s())
  Dim d.f(n)
  For i=0 To n
    s=0:For j=-l To l:s+s((i+j+n)%n):Next:d(i)=s/(2*l+1)
  Next
  CopyArray(d(),s())
EndProcedure

Procedure Bspline(Array pe.float3(1), Array PS.float3(1),nd.w)
  Protected.f t,tt
  Protected np,i,j,jj,k,c
  Protected Dim m.w(4, 4)
  Protected Dim ttt.f(4)
  np = ArraySize(pe())
  Protected Dim PS((np - 2) * nd)
  m(0, 0) = -1: m(1, 0) =  3: m(2, 0) = -3: m(3, 0) =  1
  m(0, 1) =  2: m(1, 1) = -5: m(2, 1) =  4: m(3, 1) = -1
  m(0, 2) = -1: m(1, 2) =  0: m(2, 2) =  1: m(3, 2) =  0
  m(0, 3) =  0: m(1, 3) =  2: m(2, 3) =  0: m(3, 3) =  0
  If pe(np - 1)\X = pe(1)\X And pe(np - 1)\Y = pe(1)\Y
    pe(0) = pe(np - 2): pe(np) = pe(2)
  Else
    pe(0) = pe(1):pe(np) = pe(np - 1)
  EndIf
 
  For jj = 0 To np - 3
    For i = 0 To nd - 1
      t = i / nd
      For j = 0 To 3
        ttt(j) = 0: tt = 0.5
        For k = 3 To 0 Step -1: ttt(j) + tt * m(j, k) : tt * t: Next
        PS(c)\X + ttt(j) * pe(j + jj)\X
        PS(c)\Y + ttt(j) * pe(j + jj)\Y
      Next
      c + 1
    Next
  Next
  PS(c) = pe(np - 1)
EndProcedure

Procedure CoMelange(c1.l, c2.l, m.f)
  Define r.w,g.w,b.w,a.w
  r=  Red(c1) + (Red(c2)     - Red(c1)) * m
  g=Green(c1) + (Green(c2) - Green(c1)) * m
  b= Blue(c1) + (Blue(c2) -   Blue(c1)) * m
  a=Alpha(c1) + (Alpha(c2) - Alpha(c1)) * m
  ProcedureReturn  RGBA(r,g,b,a)
EndProcedure

Procedure AddMesh(mesho,Mesh,mat.l, NewX.f=0 , NewY.f=0, NewZ.f=0, ScaleX.f=1, ScaleY.f=1, ScaleZ.f=1, RotateX.f=0, RotateY.f=0, RotateZ.f=0)
  Protected Dim MeshDataV.PB_MeshVertex(0)
  Protected Dim MeshDataF.PB_MeshFace(0)
  Protected i,meshc=1111
  CopyMesh(mesh,meshc)
  TransformMesh(Meshc, NewX,NewY,NewZ, ScaleX,ScaleY,ScaleZ, RotateX,RotateY,RotateZ)
  GetMeshData(Meshc,0, MeshDataV(), #PB_Mesh_Vertex | #PB_Mesh_UVCoordinate| #PB_Mesh_Normal, 0, MeshVertexCount(Mesh, 0)-1)
  GetMeshData(Meshc,0, MeshDataF(), #PB_Mesh_Face, 0, MeshIndexCount(Mesh, 0)-1)
 
  For i=0 To ArraySize(MeshDataV())   
    MeshVertexPosition(MeshDataV(i)\x,MeshDataV(i)\y,MeshDataV(i)\z)
    MeshVertexNormal(MeshDataV(i)\NormalX,MeshDataV(i)\NormalY,MeshDataV(i)\NormalZ)
    MeshVertexTextureCoordinate(MeshDataV(i)\u, MeshDataV(i)\v)       
  Next     
  For i=0 To ArraySize(MeshDataF()) Step 3
    MeshFace(MeshDataF(i)\Index, MeshDataF(i+1)\Index,MeshDataF(i+2)\Index)
  Next
  FreeMesh(meshc)
  AddSubMesh(#PB_Mesh_TriangleList)
  SetMeshMaterial(mesho, MaterialID(mat), SubMeshCount(mesho)-2)
  NormalizeMesh(mesh)
EndProcedure

Procedure degrade(Array pal.l(1),l,p1.f,c1.l,p2.f,c2.l,p3.f=-1,c3.l=0,p4.f=-1,c4.l=0)
  Protected i
  Dim pal(l-1)
  CreateImage(0,l,1,32)
  StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_Gradient |#PB_2DDrawing_AllChannels)
  If p1>-1:GradientColor(p1,c1):EndIf
  If p2>-1:GradientColor(p2,c2):EndIf
  If p3>-1:GradientColor(p3,c3):EndIf
  If p4>-1:GradientColor(p4,c4):EndIf
  LinearGradient(0,0,l-1,0)
  Box(0,0,l,1)
  For i=0 To l-1:pal(i)=Point(i,0):Next
  StopDrawing()
  FreeImage(0)
EndProcedure

Procedure generematiere(num,dx,dy,c1,c2)
  Protected i,j,y
  Protected Dim pal.l(0):degrade(pal(),256,0,c1,1,c2)
  CreateTexture(num,dx,dy)
  StartDrawing(TextureOutput(num))
  DrawingMode(#PB_2DDrawing_AllChannels  )
  For j=0 To dy-1:For i=0 To dx-1:Plot(i,j,pal(Random(255))):Next:Next
  StopDrawing()
  CreateMaterial(num, TextureID(num))
EndProcedure

Procedure CreatePlanex(me,lx.f,ly.f,ntx,nty,Array t.w(2),Array c.l(2))
  Protected px.f,py.f,dx.f,dy.f,p,i,j,nme,nx=ArraySize(t(),1),ny=ArraySize(t(),2)
  nme=CreateMesh(me)
  dx=lx/nx
  dy=ly/ny
  For j=0 To ny
    For i=0 To nx
      px=-lx/2+i*dx
      py=-ly/2+j*dy
      MeshVertexPosition(px,t(j,i)/100,py)
      MeshVertexTextureCoordinate(i*ntx/nx,j*nty/ny)
      MeshVertexNormal(0,0,0)
      MeshVertexColor(c(j,i))
    Next
  Next 
  For j=0 To ny-1
    For i=0 To nx-1
      p=j*(nx+1)+i
      If Abs(t(j,i)-t(j+1,i+1))>Abs(t(j+1,i)-t(j,i+1))
        MeshFace(p,p+nx+1,p+1): MeshFace(p+nx+2,p+1,p+nx+1)
      Else
        MeshFace(p+nx+1,p+nx+2,p): MeshFace(p+1,p,p+nx+2)
      EndIf
    Next
  Next
  FinishMesh(1)
  NormalizeMesh(2)
  ProcedureReturn nme
EndProcedure

Procedure.f Tinterpol(Array T.w(2),x.f,y.f)
  Protected b00, b10.w, b01, b11, i0, j0,i1,j1,dx.f, dy.f
  i0 = Int(X):i1=(i0+1): dx = X - Int(x)
  j0 = Int(Y):j1=(j0+1): dy = Y - Int(y)
  b00 = t(j0,i0)
  b01 = t(j1,i0)
  b10 = t(j0,i1)
  b11 = t(j1,i1)
  ProcedureReturn (((1 - dx) * b00 + dx * b10) * (1 - dy) + ((1 - dx) * b01 + dx * b11) * dy)/100
EndProcedure

Procedure cooxz(*v.float3,x.f,z.f,dy.f=0)
  *v\x=x
  *v\z=z
  *v\y=Tinterpol(t(),x,z)+dy
EndProcedure

Procedure DT(x,y,txt.s,font,col=$ffffffff)
  DrawingFont(FontID(font))
  If x=-1:x=OutputWidth()/2-TextWidth(txt)/2:EndIf
  DrawText(x,y,txt,col)
EndProcedure

Procedure menu()
  Protected mes.s,dx,dy,cx
  StartDrawing(SpriteOutput(0))
  dx=OutputWidth()
  dy=OutputHeight()
  cx=dx/2-128
  DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Gradient)
  GradientColor(0.00,$77000000)
  GradientColor(0.90,$77000000)
  GradientColor(1.00,$00000000)
  EllipticalGradient(dx/2,dy/2,dx/2,dy/2)
  Box(0,0,dx,dy)
  DrawingMode(#PB_2DDrawing_AlphaBlend |#PB_2DDrawing_Transparent)
  Select action
    Case 0:mes="GAME OVER"
    Case-1 :mes="PAUSE"
    Case 2:mes="Niveau "+Str(niveau)
  EndSelect
  dt(-1,20,"4x4",3,$ff0000ff)
  dt(-1,155,mes,2,$ff00ffff)
  dt(-1,220,"Presser une touche",1,$ff00ffff)
  dt(-1,255,"Commandes:",1)
  dt(cx,280,"[Left] , [Right] , [Up] , [Down]",1)
  dt(cx,300,"[Esc]      Abondonner/quitter",1)
  dt(cx,320,"[Space]  Pause",1)
  dt(cx,340,"[F2]        Changer de camera",1)
  dt(cx,360,"[+]  [-]     Changer de circuit",1)
  StopDrawing()
  Repeat:ExamineKeyboard(): Until KeyboardPushed(#PB_Key_All)=0
EndProcedure

Procedure score()
  StartDrawing(SpriteOutput(1))
  DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Transparent)
  Box(0,0,200,60,$00000000)
  RoundBox(0, 0,200,60,8,8,$44000000)
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  BackColor($ff)
  DrawingFont(FontID(1))
  DrawText(10,4,"Circuit :      "+Str(niveau),$ffffffff)
  DrawText(10,34,"Checkpt : "+Str(ChkPtnum)+"/16",$ffffffff)
  StopDrawing()
EndProcedure

Procedure Initdecor()
  ;######################################## cameras /  lumieres / ...
  CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,nsol/2,80,nsol/2,0):CameraBackColor(0,$ff8888)
  CreateLight(0,$777777, 7000, 5000, 2000)
  AmbientColor($aaaaaa)
  WorldGravity(-20)
  Fog($ff8888,100,10,400)
  ;WorldDebug(#PB_World_DebugBody)
 
  ;######################################## textures  /  matieres
  generematiere(2,256,256,$446666,$669999):SetMaterialColor(2, #PB_Material_AmbientColor,#PB_Material_AmbientColors)
  generematiere(3,1,1,$ffffff,$ffffff)
  generematiere(4,256,256,$aa444422,$aa222200):MaterialBlendingMode(4,#PB_Material_AlphaBlend):MaterialCullingMode(4,#PB_Material_NoCulling)
  generematiere(10,256,256,$445555,$66aaaa)
  generematiere(11,256,64,$224444,$112222)
  generematiere(12,1,512,$880000,$880000):MaterialShadingMode(12,1)
  generematiere(13,1,1,$88000000,$88000000):MaterialBlendingMode(13, #PB_Material_AlphaBlend):MaterialCullingMode(13,#PB_Material_NoCulling)
  generematiere(14,256,4,$333333,$000000)
  generematiere(20,16,16,$0000aa,$000088)
EndProcedure

Procedure chemin(Array lp.float3(1),Array h.f(1),la,action,param.l=0)
  Static Aaction
  Global hi,hmax
  If action<>aaction:hi=0:EndIf:aaction=action
  Protected nps=ArraySize(lp()),i,j,k,la2=la/2
  Protected.f p1.float3,p2.float3,dx,dy,d,x,y
  For k=0 To nps-1
    p1=lp(k)
    p2=lp(k+1)
    dx=p2\x-p1\x
    dy=p2\y-p1\y
    d=Sqr(dx*dx+dy*dy):If d=0:ProcedureReturn:EndIf
    For i=-0 To 2*d-1
      x=p1\x+i*dx/(d*2)
      y=p1\y+i*dy/(d*2)
      Select action
        Case 1:h(hi)=Tinterpol(t(),x,y)*100
          Case 2:For j=-la-2 To la+2:t(Int(y+j*dx/d/2+0.5),Int(x-j*dy/d/2+0.5))=h(hi)+param:Next
          Case 3:For j=-la   To la  :c(Int(y+j*dx/d/2+0.5),Int(x-j*dy/d/2+0.5))=param  :Next
      EndSelect
      hi+1
    Next
  Next
EndProcedure

Procedure InitCourse()
  Protected i
  For i=0 To 4
    MoveEntity(i,departPos\x,departPos\y,departPos\z,0)
    RotateEntity(i,0,Degree(ATan(departsens\x/departsens\z)),0)
  Next
  ChkPtnum=0
EndProcedure

Procedure CreerDecors(rnd,c1,c2,c3,cp,hmax=0,heau=2000,routeLa=10,routeHa=0,routeLi=10,routeCo=$888888)
  Protected i,j,k,c,dx,dy,nbs=8,nbf=6,col,np,nps
  Protected p.float3,coo.float3,a.f,r.f,h.f,l.f,x.f,y.f,z.f
  Protected Dim pal.l(0)
  FreeEntity(#PB_All)
  ;---------- terrain
  ; relief
  RandomSeed(rnd)
  carte(t(),nsol,nsol,2,0,hmax)
  lisser2D(t(),1,1)
  ; route
  np=16
  Protected Dim ch.float3(np+2)
  Protected Dim h.f(10000)
  For i=1 To np
    a=i*2*#PI/np
    r=0.30+pom(0.15)
    ch(i)\x=nsol*(0.5+Cos(a)*r)
    ch(i)\y=nsol*(0.5+Sin(a)*r) 
  Next
  ch(np+1)=ch(1)
  bspline(ch(),chs(),16)
  nps=ArraySize(chs())
  chemin(chs(),h(),routeLa,1):ReDim h(hi-1):lisser(h(),routeLi):For i=0 To hi-1:h(i)=limite(h(i),heau-routeHa+40,hmax):Next
  chemin(chs(),h(),routeLa,2,routeHa)
  cooxz(departPos ,chs(0)\x,chs(0)\y,0.5)
  cooxz(departsens,chs(1)\x,chs(1)\y,0.5):M3Dsub(departsens,departPos)
 
  ; couleur
  degrade(pal(),hmax,0,c1,0.5,c2,1,c3)
  For j=0 To nsol1
    For i=0 To nsol1
      col=pal(limite(t(j,i)+pom(500),0,hmax-1))
      dx=t(j,(i+1) & nsol1)-t(j,(i-1) & nsol1)
      dy=t((j+1) & nsol1,i)-t((j-1) & nsol1,i)
      If Abs(dx)+Abs(dy)>200+Random(100):col=cp:EndIf
      If t(j,i)<heau+50:col=CoMelange(cp,0,0.5):EndIf
      c(j,i)=col
    Next
  Next
  ; (route)
  chemin(chs(),h(),routeLa,3,routeCo)
 
  CreatePlanex(2,nsol1,nsol1,64,64,t(),c())
  CreateEntity(100, MeshID(2), MaterialID(2),nsol1/2,0,nsol1/2)
  EntityPhysicBody(100,#PB_Entity_StaticBody ,10,0.0,1)

  ; eau
  CreatePlane(3,nsol1*3,nsol1*3,16,16,32,32)
  CreateEntity(101, MeshID(3), MaterialID(4))
  MoveEntity(101,nsol1/2,heau/100,nsol1/2,#PB_Absolute)
 
  ; voiture
   CreateMesh(0)
   AddMesh(0,CreateSphere(-1,0.3),13,0,0.12,-0.20,1.0,0.6,1.2)
   AddMesh(0,CreateCylinder(-1,0.25,0.15,64,1,0),12,0,0,0,1.6,1.0,3.0)
   FinishMesh(1)
  CreateEntity(0, MeshID(0), #PB_Material_None)
  EntityPhysicBody(0, #PB_Entity_ConvexHullBody , 10, 0.2,0.3)
  CreateCylinder(2, 0.2, 0.2)
  c=0
  For j=-1 To 1 Step 2:For i=-1 To 1 Step 2:c+1
      CreateEntity(c, MeshID(2), MaterialID(14),0.8*i, -0.4, -1.5*j)
      EntityPhysicBody(c, #PB_Entity_CylinderBody, 1, 0.0,2)
      HingeJoint(c, EntityID(0),   0.4*i, -0.2, -0.8*j,    -i, 0, 0,   EntityID(c),   0, 0, 0,   0, 1, 0)
  Next :Next
  CreateNode(0,0,0.0,-1):AttachEntityObject(0,"",NodeID(0))
  CreateNode(1,0,0.4,0) :AttachEntityObject(0,"",NodeID(1))
  InitCourse()
 
  ; arbres
  CreateMesh(10)
  addmesh(10,CreateCylinder(-1,0.2,2,16,0,0),11,0,0.4,0)
  addmesh(10,CreateSphere(-1,1),10,0,3,0,1,2,1)
  FinishMesh(1)
  SetMaterialColor(10, #PB_Material_AmbientColor,c1)
  For k=1 To 500
    Repeat
      i=Random(nsol-2)
      j=Random(nsol-2)
    Until c(j,i)<>routeCo And t(j,i)>heau
    cooxz(coo,i,j)
    CreateEntity(1000+k, MeshID(10), #PB_Material_None,coo\x,coo\y,coo\z):h=1+pom(0.5):l=1+pom(0.5):ScaleEntity(1000+k,l,h,l)
  Next
 
  ; plots/poteaux
  CreateCylinder(5,0.1,10,8,0,0)
  CreateSphere(6,0.1,4,4)
  For i=0 To nps-1 Step 1
    p=chs(i)
    m3dsub(p,chs(i+1))
    M3DNorme(p,routeLa/2+0.5)
    For k=-1 To 1 Step 2:c+1
      x=chs(i)\x+k*p\y
      y=chs(i)\y-k*p\x
      CreateEntity(10000+c,MeshID(6-Bool(i & 15=0)),MaterialID(20),x,Tinterpol(t(),x,y),y)
    Next
  Next
EndProcedure

Procedure creerniveau()
  Protected rnd,type
  rnd=niveau+40
  type=(niveau+99) % 5
  Select type
    Case 0:CreerDecors(rnd,$006600,$00aa22,$00ffaa,$004466,4000,1300,3,  00,20,$444444);verdure
    Case 1:CreerDecors(rnd,$008822,$0088ff,$00ff88,$006688,4000,0800,2,-100,0 ,$446666);desert
    Case 2:CreerDecors(rnd,$00aaff,$008800,$00aaaa,$004488,3000,0500,3, 100,10,$aaaaaa);automne
    Case 3:CreerDecors(rnd,$004444,$ffcccc,$ffffff,$ff8888,4000,0000,3,-100,1,$444444);neige
    Case 4:CreerDecors(rnd,$00ffff,$0044ff,$ff4400,$ffff88,2000,0600,1, 400,5 ,$008800);psyché
  EndSelect
  menu()
  score()
EndProcedure

Define.f dx,dz,px,pz,x,y,z,angle,anglec,sens.f,dtenvers,dt,ChkPtdis.float3
Define i,ii,j,c,p,r,l,pb=50,em,ek,dis=0,vdis=1

InitEngine3D():InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, 0,0, "4 X 4",#PB_Window_Maximize)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)

CreateSprite(0,ex/2,ey/2,#PB_Sprite_AlphaBlending)
CreateSprite(1,200,60,#PB_Sprite_AlphaBlending)
LoadFont (1, "Arial", 16)
LoadFont (2, "Arial", 50,#PB_Font_Bold)
LoadFont (3, "Arial",100,#PB_Font_Bold)
Initdecor()
creerniveau()

Repeat     
  WindowEvent()
  ExamineMouse()
  ExamineKeyboard()
  Select action
    Case -1,0,2
      If KeyboardReleased(#PB_Key_Escape):End:EndIf
      Select action
        Case -1,2;pause / niveau suivant
          If KeyboardReleased(#PB_Key_All):action=1:EndIf
        Case 0 ;gameover
          If KeyboardReleased(#PB_Key_Add): niveau+1:creerniveau()
          ElseIf KeyboardReleased(#PB_Key_Subtract): niveau-1:creerniveau()
          ElseIf KeyboardReleased(#PB_Key_All):action=1:InitCourse()
          EndIf
      EndSelect     
      CameraFollow(0, EntityID(0),anglec, EntityY(0)+50, 100, 0.01, 0.01):anglec+0.2
      RenderWorld(0)
      DisplayTransparentSprite(0, ex/4,ey*0.1)
    Case 1       
      If KeyboardReleased(#PB_Key_Escape):sens=0:angle=0:action=0:menu():EndIf
      If KeyboardReleased(#PB_Key_Space) :action=-1:menu():EndIf
      If KeyboardReleased(#PB_Key_F2):dis=(dis+1)%3:vdis=1<<dis:EndIf
      angle+(Bool(KeyboardPushed(#PB_Key_Left)<>0)-Bool(KeyboardPushed(#PB_Key_Right)<>0))*-0.02:angle*0.98
      sens+(Bool(KeyboardPushed(#PB_Key_Up)<>0)-Bool(KeyboardPushed(#PB_Key_Down)<>0))*0.3:sens*0.994
      HingeJoint(1, EntityID(0),    -0.4, -0.2, 0.8,    1, 0,  angle,   EntityID(1),   0,  0, 0,    0,  1, 0)
      HingeJoint(2, EntityID(0),     0.4, -0.2, 0.8,   -1, 0, -angle,   EntityID(2),   0,  0, 0,    0,  1, 0)
      For i=1 To 4:sens=-sens:EnableHingeJointAngularMotor (i,1,sens,0.5):Next   
      CameraFollow(0, NodeID(1), -180,NodeY(0)+vdis, 2*vdis, 0.1, 0.05)
      ;tonneau
      If EntityY(0)>NodeY(1):dtenvers+dt:Else:dtenvers=0:EndIf
      If dtenvers>3000:sens=0:angle=0:action=0:menu():EndIf
      ;checkpoint
      ChkPtdis\x=EntityX(0)
      ChkPtdis\y=EntityZ(0)
      m3dsub(ChkPtdis,chs((ChkPtnum+1)*16))
      If M3Dlongueur(ChkPtdis)<3:ChkPtnum+1:score():If ChkPtnum>15 :sens=0:angle=0:action=2:menu():niveau+1:creerniveau():EndIf:EndIf
      dt=RenderWorld()
  EndSelect
  DisplayTransparentSprite(1,8,8,255)
  FlipBuffers()
ForEver


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mar 22/Sep/2015 21:29 
Hors ligne

Inscription: Dim 10/Jan/2010 5:29
Messages: 3426
Excellent ^^
Merci du partage.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mar 22/Sep/2015 21:40 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6860
Localisation: IDF (Yvelines)
Vraiment excellent. Merci Guillot.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mar 22/Sep/2015 22:46 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2801
Localisation: Klyntar
Excellent, bon travail. Pas facile de ne pas se retourner :wink: :P
Bonne continuation





@++

_________________
Windows 10 x64, PureBasic 5.71 Beta 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mar 22/Sep/2015 23:51 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 08/Déc/2005 5:19
Messages: 936
Localisation: Guadeloupe
8O
Bravo !
C'est un concentré de bonnes choses !

_________________
Elevé au MSX !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mer 23/Sep/2015 6:46 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 27/Oct/2006 12:19
Messages: 1224
Localisation: Calvados (14)
Extra Guillot, il ne te reste plus qu'à compresser le nombre de lignes pour pouvoir participer au Birthday PurePunch :D

_________________
Image

Image


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mer 23/Sep/2015 9:53 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 5162
Wow ! C'est excellent.

Citation:
(PS : y'a un bug : si vous laisser la bagnole immobile trop longtemps, elle se fige (faut changer de circuit pour la ranimer...))


Essaye la fonction DisableEntityBody(Entity, #False). Je vérifierai ce soir chez moi, mais de mémoire ça doit rendre actif le body en permanence . Ou tu peux aussi jouer sur SetEntityAttribute(#Entity, Attribute, Value)
Avec #PB_Entity_LinearSleeping et #PB_Entity_AngularSleeping à zéro pour éviter de mettre en veille ton Body.

_________________
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mer 23/Sep/2015 10:14 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 05/Sep/2008 11:42
Messages: 1120
Localisation: Besançon
Yeah !

_________________
Only PureBasic makes it possible


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mer 23/Sep/2015 16:54 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6659
Localisation: Isere
EMMERVEILLEMENT !!!

C'est le premier post que je lis de toi, te souhaite par la même occasion la bienvenue dans la communauté, et j'en prend plein le groin 8O
C'est superbe, j'arrive toujours pas à comprendre comment vous faites pour faire des trucs de dingues comme ça avec PB en "si peu" de lignes (si je puis dire)..
On s'y croirait....j'en ai le mal de mer...

Bravo d'un non connaisseur, mais bravo quand même !!
Et evidemment merci du partage 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Mer 23/Sep/2015 19:44 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 270
merci pour les compliments

à comtois : avec #PB_Entity_LinearSleeping ça fonctionne ! merci
(j'avais essayé avec #PB_Entity_DeactivationTime (et DisableEntityBody) sans succes...)

vous pouvez donc rajouter sous la ligne 454 :
SetEntityAttribute(0,#PB_Entity_LinearSleeping,0)

à TazNormand : ouai, j'ai regarder, avec le cruncher (qui termine pas tout à fait le boulot!) j'arrive à 220 ligne,ça doit etre jouable !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Jeu 24/Sep/2015 8:07 
Hors ligne

Inscription: Mer 14/Sep/2011 16:59
Messages: 915
C'est génial ! 8O

Bizarrement, la version 5.40b7 ne reconnait plus EntityPhysicBody() et ne compile pas.
Mais tout est ok avec le compilateur 5.31.

M.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Jeu 24/Sep/2015 8:20 
Hors ligne
Site Admin

Inscription: Mer 21/Jan/2004 11:03
Messages: 2565
J'ai passé EntityPhysicBody() en deprecated au lieu de l'avoir supprimé pour eviter l'arret de la compilation.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: mini jeu : 4x4
MessagePosté: Dim 06/Déc/2015 19:37 
Hors ligne

Inscription: Ven 29/Aoû/2014 19:52
Messages: 35
Magnifique!!! Et addictif en plus!
Mais j'ai eu vraiment du mal a passer le 2e circuit...


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 13 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye