PureBasic
https://www.purebasic.fr/french/

mini jeu : 4x4
https://www.purebasic.fr/french/viewtopic.php?f=13&t=15498
Page 1 sur 1

Auteur:  Guillot [ Mar 22/Sep/2015 21:11 ]
Sujet du message:  mini jeu : 4x4

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

Auteur:  G-Rom [ Mar 22/Sep/2015 21:29 ]
Sujet du message:  Re: mini jeu : 4x4

Excellent ^^
Merci du partage.

Auteur:  falsam [ Mar 22/Sep/2015 21:40 ]
Sujet du message:  Re: mini jeu : 4x4

Vraiment excellent. Merci Guillot.

Auteur:  venom [ Mar 22/Sep/2015 22:46 ]
Sujet du message:  Re: mini jeu : 4x4

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





@++

Auteur:  Huitbit [ Mar 22/Sep/2015 23:51 ]
Sujet du message:  Re: mini jeu : 4x4

8O
Bravo !
C'est un concentré de bonnes choses !

Auteur:  TazNormand [ Mer 23/Sep/2015 6:46 ]
Sujet du message:  Re: mini jeu : 4x4

Extra Guillot, il ne te reste plus qu'à compresser le nombre de lignes pour pouvoir participer au Birthday PurePunch :D

Auteur:  comtois [ Mer 23/Sep/2015 9:53 ]
Sujet du message:  Re: mini jeu : 4x4

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.

Auteur:  Cool Dji [ Mer 23/Sep/2015 10:14 ]
Sujet du message:  Re: mini jeu : 4x4

Yeah !

Auteur:  Kwai chang caine [ Mer 23/Sep/2015 16:54 ]
Sujet du message:  Re: mini jeu : 4x4

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)

Auteur:  Guillot [ Mer 23/Sep/2015 19:44 ]
Sujet du message:  Re: mini jeu : 4x4

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 !

Auteur:  Mesa [ Jeu 24/Sep/2015 8:07 ]
Sujet du message:  Re: mini jeu : 4x4

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.

Auteur:  Fred [ Jeu 24/Sep/2015 8:20 ]
Sujet du message:  Re: mini jeu : 4x4

J'ai passé EntityPhysicBody() en deprecated au lieu de l'avoir supprimé pour eviter l'arret de la compilation.

Auteur:  vurvur [ Dim 06/Déc/2015 19:37 ]
Sujet du message:  Re: mini jeu : 4x4

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

Page 1 sur 1 Heures au format UTC + 1 heure
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/