mini jeu : 4x4

Généralités sur la programmation 3D
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

mini jeu : 4x4

Message par Guillot »

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 : Tout sélectionner

;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
G-Rom
Messages : 3626
Inscription : dim. 10/janv./2010 5:29

Re: mini jeu : 4x4

Message par G-Rom »

Excellent ^^
Merci du partage.
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: mini jeu : 4x4

Message par falsam »

Vraiment excellent. Merci Guillot.
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: mini jeu : 4x4

Message par venom »

Excellent, bon travail. Pas facile de ne pas se retourner :wink: :P
Bonne continuation





@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Avatar de l’utilisateur
Huitbit
Messages : 939
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Re: mini jeu : 4x4

Message par Huitbit »

8O
Bravo !
C'est un concentré de bonnes choses !
Elevé au MSX !
Avatar de l’utilisateur
TazNormand
Messages : 1294
Inscription : ven. 27/oct./2006 12:19
Localisation : Calvados (14)

Re: mini jeu : 4x4

Message par TazNormand »

Extra Guillot, il ne te reste plus qu'à compresser le nombre de lignes pour pouvoir participer au Birthday PurePunch :D
Image
Image
comtois
Messages : 5172
Inscription : mer. 21/janv./2004 17:48
Contact :

Re: mini jeu : 4x4

Message par comtois »

Wow ! C'est excellent.
(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.
Avatar de l’utilisateur
Cool Dji
Messages : 1126
Inscription : ven. 05/sept./2008 11:42
Localisation : Besançon
Contact :

Re: mini jeu : 4x4

Message par Cool Dji »

Yeah !
Only PureBasic makes it possible
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: mini jeu : 4x4

Message par Kwai chang caine »

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
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

Re: mini jeu : 4x4

Message par Guillot »

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 !
Mesa
Messages : 1093
Inscription : mer. 14/sept./2011 16:59

Re: mini jeu : 4x4

Message par Mesa »

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.
Fred
Site Admin
Messages : 2648
Inscription : mer. 21/janv./2004 11:03

Re: mini jeu : 4x4

Message par Fred »

J'ai passé EntityPhysicBody() en deprecated au lieu de l'avoir supprimé pour eviter l'arret de la compilation.
vurvur
Messages : 60
Inscription : ven. 29/août/2014 19:52

Re: mini jeu : 4x4

Message par vurvur »

Magnifique!!! Et addictif en plus!
Mais j'ai eu vraiment du mal a passer le 2e circuit...
Répondre