IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Sources PureBasic

Sources PureBasicConsultez toutes les sources

Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011 

 
OuvrirSommaireJeux/Démos
 
Sélectionnez
; PureBasic 4.20
 
#SW=800
#SH=600
#Deg2Rad = #PI/180 
 
InitSprite() : InitKeyboard() : InitMouse()
OpenScreen(#SW,#SH,32,"")
 
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  Structure point ; Déjà déclarée dans les résidents sous windows
    x.f
    y.f
  EndStructure
CompilerEndIf
  
;-Structures
Structure VECTOR2
  x.f
  y.f
EndStructure
 
Structure ENTITY
  Position.VECTOR2
  Angle.f
EndStructure
  
;-Declarations des fonctions
Declare DrawArrow(Lenght.l , x.f , y.f , Angle.f)
Declare.f curveangle(newangle.f,oldangle.f,increments.f)
Declare.f ReturnDegAngle(x1.f,y1.f,x2.f,y2.f)
Declare track_SmoothPoint(*A.ENTITY,*B.ENTITY, turnspeed.f=1.0)
  
 
; ************************************************************************************
#NB_ARROW = 3
Dim Arrow.ENTITY(#NB_ARROW)
 
For i = 1 To #NB_ARROW
  Arrow(i)\Position\x = Random(#SW)
  Arrow(i)\Position\y = Random(#SH)
  Arrow(i)\Angle      = 0
Next

; Cible des "arrow" , coordonnées de la souris pour la position
Target.ENTITY
 
Repeat
  ClearScreen(0)
  ExamineKeyboard()
  ExamineMouse()
  
  Target\Position\x = MouseX()
  Target\Position\y = MouseY()
 
  StartDrawing(ScreenOutput())
    Circle(Target\Position\x,Target\Position\y,2,255)
  StopDrawing()

  For i = 1 To #NB_ARROW
    DrawArrow(50 , Arrow(i)\Position\x , Arrow(i)\Position\y , Arrow(i)\Angle)
    track_SmoothPoint(Arrow(i),Target,20)
   
    Arrow(i)\Position\x + 1 *Cos(Arrow(i)\Angle*#PI/180)
    Arrow(i)\Position\y + 1 *Sin(Arrow(i)\Angle*#PI/180)
  Next
 
  If KeyboardPushed(#PB_Key_Escape)<>#Null : Quit=1 : EndIf

  FlipBuffers()

Until Quit=1

End
 
Procedure.f curveangle(newangle.f,oldangle.f,increments.f)
  If increments>1
    If (oldangle+360)-newangle<newangle-oldangle
      oldangle=360+oldangle
    EndIf
    If (newangle+360)-oldangle<oldangle-newangle
      newangle=360+newangle
    EndIf
    oldangle=oldangle-(oldangle-newangle)/increments
  EndIf
 
  If increments<=1
    ProcedureReturn newangle
  EndIf
  ProcedureReturn oldangle
EndProcedure
  
Procedure.f ReturnDegAngle(x1.f,y1.f,x2.f,y2.f) ; DEGREE
  A.f = x1-x2
  b.f = y1-y2
  c.f = -Sqr(A*A+b*b)
  Angle.f = ACos(A/c)*180/#PI
  If y1 < y2 : Angle=360-Angle : EndIf
  ProcedureReturn Abs(Angle - 360)
EndProcedure
  
Procedure track_SmoothPoint(*A.ENTITY,*B.ENTITY, turnspeed.f=1.0)
  AngDif = ReturnDegAngle(*A\position\x,*A\position\y,*B\position\x,*B\position\y)
  temp_yaw.f = curveangle(AngDif,*A\Angle,turnspeed)
  *A\Angle = temp_yaw
EndProcedure
 
Procedure DrawArrow(Lenght.l , x.f , y.f , Angle.f)
 
  Protected ArrowA.Point,ArrowB.Point
  Protected ArrowBranchA.Point,ArrowBranchB.Point
   
  ArrowA\x = x + (Lenght/2) * Cos(Angle*#PI/180)
  ArrowA\y = y + (Lenght/2) * Sin(Angle*#PI/180)
  
  ArrowB\x = x - (Lenght/2) * Cos(Angle*#PI/180)
  ArrowB\y = y - (Lenght/2) * Sin(Angle*#PI/180)
   
  ArrowBranchA\x = ArrowA\x - (Lenght/3) * Cos((Angle+45)*#PI/180)
  ArrowBranchA\y = ArrowA\y - (Lenght/3) * Sin((Angle+45)*#PI/180)
  
  ArrowBranchB\x = ArrowA\x - (Lenght/3) * Cos((Angle-45)*#PI/180)
  ArrowBranchB\y = ArrowA\y - (Lenght/3) * Sin((Angle-45)*#PI/180)
   
  StartDrawing(ScreenOutput())
    LineXY(ArrowA\x,ArrowA\y,ArrowB\x,ArrowB\y,255)
    LineXY(ArrowA\x,ArrowA\y,ArrowBranchA\x,ArrowBranchA\y,255)
    LineXY(ArrowA\x,ArrowA\y,ArrowBranchB\x,ArrowBranchB\y,255)
    Circle(x+1,y+1,2,255)
  StopDrawing()
EndProcedure
Créé le 19 juillet 2008  par Cpl.Bator

Il s'agit d'un logiciel dont le but est d'éditer les cartes de campagne d'un jeu vidéo de stratégie qui s'appelle "Medieval II : Total War". En gros ça se passe en Europe pendant le moyen-âge, vous contrôlez une faction (la France par exemple) et le but c'est de gérer son royaume et de gagner de nouvelles provinces.
Mon logiciel permet de modifier ces provinces, d'en rajouter, d'en enlever, d'en modifier certaines caractéristiques, et tout plein d'autres trucs. D'habitude ça prend un temps fou en bidouillant les fichiers manuellement.

La source est dans l'archive, elle est explosée en une dizaine de fichiers pbi et fait environ 6000 lignes de code très denses.

Et pour finir, une copie d'écran :

Image non disponible
Editeur de geomod
Créé le 28 octobre 2008  par Octavius

Téléchargez le zip

L'archive contient un exécutable pour tester sans PureBasic, ainsi que les sources. Tout le monde connait ce jeu, voici tout de même un petit rappel des règles.
Le jeu commence avec 36 points placés en forme de croix grecque. Le but du jeu est de rajouter le plus possible de points, en respectant les règles suivantes :

  • Un point ne peut être ajouté que pour compléter un alignement de 5 points, qui peut être horizontal, vertical, ou diagonal.
  • Un alignement ne peut pas prolonger un alignement dans la même direction, sauf si ils n'ont qu'un seul point en commun.
Créé le 3 mai 2009  par Comtois

Téléchargez le zip

Utilisez [Echap] ou le bouton droit de la souris pour quitter la démonstration.

 
Sélectionnez
; Netmaestro le 27/01/2010
; PB 4.41
Global x=300, y=500, dist=400
Global text$ = "Purebasic"
LoadFont(0,"Courier New", 60, #PB_Font_Bold|#PB_Font_HighQuality)

Procedure PlotCharacter(char$, angle.d, charangle.d, color)
  p1 = x+dist*Cos(angle*#PI/180)
  p2 = y+dist*Sin(angle*#PI/180)
  DrawRotatedText(p1,p2,char$,charangle,color)
EndProcedure

CreateImage(0,600,600)
StartDrawing(ImageOutput(0))
  Box(0,0,600,600,0)
  DrawingFont(FontID(0))   
 
  angle.d = 235 : charangle.d = 31.3
  For i=1 To 9
    PlotCharacter(Mid(text$,i,1), angle, charangle, #Black)
    angle+8 : charangle-8
  Next
  dist+5
  angle.d = 234 : charangle.d = 32.3
 
  DrawingMode(#PB_2DDrawing_Gradient)
  GradientColor(0.0, #Red)
  GradientColor(0.1, #Blue)
  GradientColor(0.9, #Green)   
  GradientColor(1.0, #Red)
  ConicalGradient(x, y, 90)
 
  For i=1 To 9
    PlotCharacter(Mid(text$,i,1), angle, charangle, #Red)
    angle+8 : charangle-8
  Next

  *buffer = DrawingBuffer()
  *loc.RGBQUAD = *buffer
  While *loc <= *buffer + DrawingBufferPitch()*OutputHeight() - SizeOf(RGBQUAD)
    If *loc\rgbBlue = 5 And *loc\rgbGreen = 5 And *loc\rgbRed = 5
      *loc\rgbReserved = 0
    EndIf
    *loc+SizeOf(RGBQUAD)
  Wend

StopDrawing()

OpenWindow(0,0,0,600,600,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess|#PB_Window_Invisible)
SetWindowLongPtr_(WindowID(0),#GWL_EXSTYLE, GetWindowLongPtr_(WindowID(0),#GWL_EXSTYLE)|#WS_EX_LAYERED)
SetLayeredWindowAttributes_(WindowID(0),0,255,#LWA_COLORKEY)

ImageGadget(0,0,0,0,0,ImageID(0))
HideWindow(0,0)

Repeat
  ev=WaitWindowEvent()
  Select ev
    Case #PB_Event_Gadget
      SendMessage_(WindowID(0),#WM_NCLBUTTONDOWN,#HTCAPTION,0)
    Case #WM_RBUTTONDOWN
      End
  EndSelect
   
Until GetAsyncKeyState_(#VK_ESCAPE) & 32768
Créé le 27 janvier 2010  par netmaestro

Cette démo est imcomplète, il manque la gestion de la vitesse pour éviter qu'à grande vitesse le mobile puisse traverser des petits objets. La méthode utilisée dans le code qui suit est très bien expliquée ici.

 
Sélectionnez
; Comtois 4.40 b3 22/09/09
;J'ai largement utilisé le tutoriel d'Olivier renault pour construire ce code.
;Je ne retrouve plus l'adresse dans mes favoris, mais c'était sur gamedev je crois ?

If InitSprite()=0 Or InitMouse()=0 Or InitKeyboard()=0
  MessageRequester("Erreur","Initialisation impossible",0)
  End
EndIf
If OpenScreen(800, 600, 32,"Collision par la méthode de séparation des axes")=0
  MessageRequester("Erreur","Ouverture d'un écran 800x600x32 impossible",0)
  End
EndIf

#Epsilon = 0.00001
#NbSommet = 32              ;Nombre de Sommet maxi pour un polygone
#NbPlan = (#NbSommet*2)-1   ;Un plan par Sommet pour deux polygones
#DeltaAngle = 0.09/#PI
#NbPolygones = 50

Enumeration
  #A
  #B
EndEnumeration

Macro PRODUIT_SCALAIRE(V1, V2)
  (V1\x * V2\x + V1\y * V2\y)
EndMacro

Structure s_Vecteur2D
  x.f
  y.f
EndStructure

Structure s_Polygone
  Position.s_Vecteur2D         
  Vitesse.f
  Angle.f
  NbSommet.l
  Couleur.l
  Sommet.s_Vecteur2D[#NbSommet]
EndStructure

Structure s_Collision
  Detectee.l
  Normale.s_Vecteur2D
  Distance.f
EndStructure

Structure s_Intervalle
  Mini.f
  Maxi.f
EndStructure

;- Declare
Declare InitialiseJeu(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare CollisionReponse(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare GestionClavier(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare ConstructionPolygone(*Polygone.s_Polygone, Rayon.f)
Declare ConstructionMur(*Polygone.s_Polygone)
Declare AffichePolygone(*Voiture.s_Polygone, List Mur.s_Polygone())
Declare CollisionPolygone(*A.s_Polygone, *B.s_Polygone, *Distance.s_Vecteur2D, *Collision.s_Collision)
Declare CalculeProjection(*Polygone.s_Polygone, *Axe.s_Vecteur2D, *Projection.s_Intervalle)
Declare CalculeIntersection(*A.s_Polygone, *B.s_Polygone, *Axe.s_Vecteur2D, *Distance.s_Vecteur2D, *Chevauchement.Float)
Declare ChercheDeplacementMini(Array Axe.s_Vecteur2D(1), Array Chevauchement.f(1), NbAxes.l, *Collision.s_Collision)
Declare.f Normalise(*V.s_Vecteur2D)

Define.s_Polygone Voiture
NewList Mur.s_Polygone()

InitialiseJeu(@Voiture, Mur())
;- Main
Repeat
  ClearScreen(#Black)
  GestionClavier(@Voiture, Mur())
  CollisionReponse(@Voiture, Mur())
  AffichePolygone(@Voiture, Mur())
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Procedure InitialiseJeu(*Voiture.s_Polygone, List Mur.s_Polygone())
  ;Création du jeu
  Define.l i, Rayon

  ;Mouse
  *Voiture\Position\x = x
  *Voiture\Position\y = y
  *Voiture\NbSommet = 12
  *Voiture\Vitesse = 3
  *Voiture\Couleur = #White
  Rayon = 6
  ConstructionPolygone(*Voiture, Rayon)

  ClearList(Mur())
  For i = 0 To #NbPolygones-1
    AddElement(Mur())
    Rayon = Random(20)+16
    Mur()\Position\x = Rayon + Random(800-Rayon*2)
    Mur()\Position\y = Rayon + Random(600-Rayon*2)
    Mur()\NbSommet = Random(10)+3   
    Mur()\Couleur = #Yellow
    ConstructionPolygone(Mur(), Rayon)
  Next i
EndProcedure

Procedure CollisionReponse(*Voiture.s_Polygone, List Mur.s_Polygone())
  ;A reprendre
  ; Il faudrait d'abord chercher le point d'impact le plus proche en testant tous les polygones
  ; Puis calculer la réponse d'une façon récursive, en prenant un vecteur vitesse en compte.
  Define.s_Vecteur2D Distance
  Define.s_Collision Collision
  *Voiture\Couleur = #White
  ForEach Mur()
    Distance\x = *Voiture\Position\x - Mur()\Position\x
    Distance\y = *Voiture\Position\y - Mur()\Position\y
    Collision\Detectee = CollisionPolygone(*Voiture, Mur(), @Distance, @Collision)
    ;Séparation des polygones   
    If Collision\Detectee
      *Voiture\Couleur = #Green
      ;Mur()\Couleur = #Red
      *Voiture\Position\x - (Collision\Normale\x * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
      *Voiture\Position\y - (Collision\Normale\y * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
      MouseLocate(*Voiture\Position\x, *Voiture\Position\y)
      Mur()\Position\x + (Collision\Normale\x * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
      Mur()\Position\y + (Collision\Normale\y * (Collision\Distance * 0.5)) ; ou un peu moins que 1.5
    EndIf
  Next
EndProcedure

Procedure GestionClavier(*Voiture.s_Polygone, List Mur.s_Polygone())
  If ExamineKeyboard()
    If KeyboardReleased(#PB_Key_Space)
      InitialiseJeu(*Voiture, Mur())
    EndIf
    If KeyboardPushed(#PB_Key_Up)
      *Voiture\Position\y - *Voiture\Vitesse
    ElseIf KeyboardPushed(#PB_Key_Down)
      *Voiture\Position\y + *Voiture\Vitesse
    EndIf
    If KeyboardPushed(#PB_Key_Left)
      *Voiture\Position\x - *Voiture\Vitesse
    ElseIf KeyboardPushed(#PB_Key_Right)
      *Voiture\Position\x + *Voiture\Vitesse
    EndIf
  EndIf   

;   If ExamineMouse()
;     *Voiture\Position\x = MouseX()
;     *Voiture\Position\y = MouseY()   
;   EndIf   
EndProcedure

Procedure ConstructionPolygone(*Polygone.s_Polygone, Rayon.f)
  ;Permet de calculer un polygone convexe
  Define.l i
   Define.f Angle, Rayon
   For i = 0 To *Polygone\NbSommet-1
    *Polygone\Sommet[i]\x = Cos(Angle) * Rayon
    *Polygone\Sommet[i]\y = Sin(Angle) * Rayon
    Angle + 2.0 * #PI / *Polygone\NbSommet
   Next i
EndProcedure

Procedure ConstructionMur(*Polygone.s_Polygone)
  Define.l i
   Define.f Angle, Rayon
  Rayon = 22.63
   Angle = #PI/4
   For i = 0 To *Polygone\NbSommet-1
    *Polygone\Sommet[i]\x = Cos(Angle) * Rayon
    *Polygone\Sommet[i]\y = Sin(Angle) * Rayon
    Angle + 2.0 * #PI / *Polygone\NbSommet
   Next i
EndProcedure

Procedure AffichePolygone(*Voiture.s_Polygone, List Mur.s_Polygone())
  StartDrawing(ScreenOutput())
  ;Affiche les murs   
  With Mur()
  ForEach  Mur()
    For i = 0 To \NbSommet-2
      LineXY(\Position\x + \Sommet[i]\x, \Position\y + \Sommet[i]\y, \Position\x + \Sommet[i+1]\x, \Position\y + \Sommet[i+1]\y, \Couleur)
    Next i
    LineXY(\Position\x + \Sommet[\NbSommet-1]\x, \Position\y + \Sommet[\NbSommet-1]\y, \Position\x + \Sommet[0]\x, \Position\y + \Sommet[0]\y, \Couleur)
   Next
   EndWith
  ;Affiche la voiture
  With *Voiture
  For i = 0 To \NbSommet-2
    LineXY(\Position\x + \Sommet[i]\x, \Position\y + \Sommet[i]\y, \Position\x + \Sommet[i+1]\x, \Position\y + \Sommet[i+1]\y, \Couleur)
  Next i
  LineXY(\Position\x + \Sommet[\NbSommet-1]\x, \Position\y + \Sommet[\NbSommet-1]\y, \Position\x + \Sommet[0]\x, \Position\y + \Sommet[0]\y, \Couleur)
  EndWith
  StopDrawing()
EndProcedure   

Procedure CollisionPolygone(*A.s_Polygone, *B.s_Polygone, *Distance.s_Vecteur2D, *Collision.s_Collision)
  Define.l j, i
  Define.s_Vecteur2D Segment
  If *A=0  Or *B=0 : ProcedureReturn #False : EndIf
   
   ; Tous les axes de séparation
   Dim Axe.s_Vecteur2D(#NbPlan)
   Dim Chevauchement.f(#NbPlan)
   Define.l NoAxe

   ;Utilisation de la méthode générale,
   ;pour un rectangle on pourrait se contenter de tester 2 segments(largeur et longueur)
   ;Une autre méthode projette le centre et le rayon du rectangle(à tester).
   
   ; test séparation des axes du polygone A
   j = *A\NbSommet-1
   For i = O To *A\NbSommet-1
     ;Calcule chaque segment du polygone
      Segment\x  = *A\Sommet[i]\x - *A\Sommet[j]\x
      Segment\y  = *A\Sommet[i]\y - *A\Sommet[j]\y
      ;Calcul la normale pour chaque segment du polygone
      Axe(NoAxe)\x = -Segment\y
      Axe(NoAxe)\y =  Segment\x
      If CalculeIntersection(*A, *B, Axe(NoAxe), *Distance, @Chevauchement(NoAxe)) = #False
         ProcedureReturn #False ; dès qu'on trouve un axe de séparation on peut sortir
      EndIf
      NoAxe + 1
      j = i
   Next i
   ; test séparation des axes du polygone B
   j = *B\NbSommet-1
   For i = O To *B\NbSommet-1
     ;Calcule chaque segment du polygone     
      Segment\x  = *B\Sommet[i]\x - *B\Sommet[j]\x ; Le polygone pourrait être stocké avec cette valeur
      Segment\y  = *B\Sommet[i]\y - *B\Sommet[j]\y ; ça éviterait de la calculer à chaque fois
      ;Calcul la normale pour chaque segment du polygone
      Axe(NoAxe)\x = -Segment\y
      Axe(NoAxe)\y =  Segment\x
      If CalculeIntersection(*A, *B, Axe(NoAxe), *Distance, @Chevauchement(NoAxe)) = #False
         ProcedureReturn #False ; dès qu'on trouve un axe de séparation on peut sortir
      EndIf
      NoAxe + 1
      j = i
   Next i
   
   ;Il faudra chercher le point d'impact !
   If ChercheDeplacementMini(Axe(), Chevauchement(), NoAxe, *Collision) = #False
      ProcedureReturn #False
   EndIf   

   ; Inverse la normale si nécessaire pour être sûr que les polygones seront bien séparés.
   If PRODUIT_SCALAIRE(*Collision\Normale, *Distance) < 0.0
      *Collision\Normale\x = -*Collision\Normale\x
      *Collision\Normale\y = -*Collision\Normale\y
   EndIf   

   ProcedureReturn #True
   
EndProcedure

; calcule la projection du polygone sur l'axe en cours de test
Procedure CalculeProjection(*Polygone.s_Polygone, *Axe.s_Vecteur2D, *Projection.s_Intervalle)
  Define.l i
  Define.f Projection
  ;Calcul la projection du Sommet[0] sur la normale du plan en cours de test
   *Projection\mini = *Polygone\Sommet[0]\x * *Axe\x + *Polygone\Sommet[0]\y * *Axe\y
   *Projection\maxi = *Projection\mini

  ;Recherche les projections mini et maxi en testant tous les sommets du polygone
   For i = 1 To *Polygone\NbSommet-1
     Projection = *Polygone\Sommet[i]\x * *Axe\x + *Polygone\Sommet[i]\y * *Axe\y
      If (Projection < *Projection\mini)
        *Projection\mini = Projection
      ElseIf (Projection > *Projection\maxi)
         *Projection\maxi = Projection
      EndIf   
   Next i
EndProcedure

Procedure CalculeIntersection(*A.s_Polygone, *B.s_Polygone, *Axe.s_Vecteur2D, *Distance.s_Vecteur2D, *Chevauchement.Float)
  Define.f h, dist0, dist1
  Define.s_Intervalle A, B
  ;Calcul la projection des sommets du polygone A sur la normale du plan en cours de test
   CalculeProjection(*A, *Axe, @A)
   ;Calcul la projection des sommets du polygone B sur la normale du plan en cours de test
   CalculeProjection(*B, *Axe, @B)

  ;Calcul la projection de l'offset entre les polygones
   h = *Distance\x *  *Axe\x + *Distance\y * *Axe\y
   
   ;Ajoute la projection de l'offset à la projection du polygone A
   A\mini + h
   A\maxi + h

  ;Calcul le chevauchement entre les projections de A et B
   dist0 = A\mini - B\maxi
   dist1 = B\mini - A\maxi


  ;Test le chevauchement
   If dist0 > 0.0 Or dist1 > 0.0
      ProcedureReturn #False
   Else
     If dist0 > dist1
       *Chevauchement\f = dist0
     Else
       *Chevauchement\f = dist1
    EndIf
      ProcedureReturn #True
   EndIf
EndProcedure

Procedure ChercheDeplacementMini(Array Axe.s_Vecteur2D(1), Array Chevauchement.f(1), NbAxes.l, *Collision.s_Collision)
   Define.l mini, i
   Define.f n
   
   ;Initialise les données collision
   mini = -1
   *Collision\distance = 0
   *Collision\Normale\x = 0
   *Collision\Normale\y = 0

  ;On cherche parmi tous les axes de séparation le chevauchement le plus petit
   For i = 0 To NbAxes-1
      n = Normalise(@Axe(i)) ; Normalise l'axe et récupère sa longueur
      Chevauchement(i) / n
   
    ;On retient le plus petit chevauchement pour se dégager de l'autre polygone
      ;les valeurs de chevauchement sont négatives d'où le test > ci dessous
      ;Par la suite il faudra aussi tenir compte du point d'impact !!
      If (Chevauchement(i) > *Collision\distance) Or (mini = -1)
         mini = i
         *Collision\distance  = Chevauchement(i)
         *Collision\Normale\x = Axe(i)\x
         *Collision\Normale\y = Axe(i)\y
      EndIf
   Next i

ProcedureReturn (mini <> -1)
EndProcedure

Procedure.f Normalise(*V.s_Vecteur2D)
  Define.f    Longueur
   Longueur = Sqr(*V\x * *V\x + *V\y * *V\y)   
   If Longueur <> 0.0
     *V\x / Longueur
    *V\y / Longueur
  EndIf
   ProcedureReturn Longueur   
EndProcedure
Créé le 14 février 2010  par Comtois
 
Sélectionnez
; --------------------------------------------------------------
;
; OldSkool DemoEffect: Floor Casting
;
; Converted by: Thorsten Will aka Mr.Vain/Secretly!
; Thanks a lot to "rain storm" for his original source! *thumbs up*
;
; --------------------------------------------------------------

resX = 640
resY = 480
xres = 320
yres = 240

InitSprite ()
InitKeyboard ()
OpenScreen ( resX, resY, 32, "Floor Casting DemoEffect")

Repeat
  ExamineKeyboard ()
  StartDrawing ( ScreenOutput ())

  camY.f = camY + 2 ; change for speed
  camX.f = xres * Sin ( camY * #PI / 180 )
  b.f = 0
  For y = 0 To resY -1
    w.f = -yres / y
    v.f = ( resX * w - camY )
    u.f = ( -xres * w + camX )
    For x = 0 To resX -1
      t = (( Int (u) ! Int (v) ) & 255 )
      c = Int ((t / resY) * y)
      Plot ( x, y, RGB ( c, c, c ))
      u = u + w
    Next
    b = b + resX
  Next

  StopDrawing ()
  FlipBuffers ()
Until KeyboardPushed ( #PB_Key_Escape )
End
Créé le 6 mars 2010  par Va!n

Première démonstration :

 
Sélectionnez
; ---- code by va!n aka 'thorsten will' in 2007 ----

InitSprite ()
InitKeyboard ()

OpenScreen (640,480,32, "Exampe by va!n aka 'Thorsten Will' in 2007" )
CreateSprite (0,800,600)
CreateSprite (1,800,600)

StartDrawing ( SpriteOutput (lSprite))
   For i = 0 To 25
    lColor = -lColor +1
    Circle (400,300, 500-(i*20), RGB (lColor*255, lColor*255, lColor*255))
   Next
StopDrawing ()

Repeat
   ClearScreen (0)
   ExamineKeyboard ()
 
   DisplayTransparentSprite (0, -50+ Cos (vain2.d)*50, -50+ Sin (vain.d)*50)
   DisplayTransparentSprite (0, -50+ Sin (vain.d)*50, -50+ Cos (vain.d)*50)
   vain.d = vain.d + 0.05
   vain2.d = vain2.d + 0.025
   FlipBuffers ()
Until KeyboardPushed ( #PB_Key_Escape )

Seconde démonstration :

 
Sélectionnez
; ---- code by va!n aka 'thorsten will' in 2007 ----

InitSprite ()
InitKeyboard ()

OpenScreen (640,480,32, "Exampe by va!n aka 'Thorsten Will' in 2007" )
CreateSprite (0,800,600)
CreateSprite (1,800,600)

For lSprite = 0 To 1
StartDrawing ( SpriteOutput (lSprite))
For i = 0 To 49
lColor = -lColor +1
If lSprite
Circle (400,300, 500-(i*10), RGB (lColor*255, 0, 0))
Else
Circle (400,300, 500-(i*10), RGB (0, 0, lColor*255))
EndIf
Next
StopDrawing ()
Next

Repeat
ClearScreen (0)
ExamineKeyboard ()

DisplayTransparentSprite (0, -50+ Cos (vain2.d)*50, -50+ Sin (vain.d)*50)
DisplayTransparentSprite (1, -50+ Sin (vain.d)*50, -50+ Cos (vain.d)*50)
vain.d = vain.d + 0.05
vain2.d = vain2.d + 0.025
FlipBuffers ()
Until KeyboardPushed ( #PB_Key_Escape )

Troisième démonstration :

 
Sélectionnez
; ---- code by va!n aka 'thorsten will' in 2007 ----

InitSprite ()
InitSprite3D ()
InitKeyboard ()

OpenScreen (640,480,32, "Exampe by va!n aka 'Thorsten Will' in 2007" )
CreateSprite (0,800,600, #PB_Sprite_Texture )
CreateSprite (1,800,600, #PB_Sprite_Texture )

For lSprite = 0 To 1
StartDrawing ( SpriteOutput (lSprite))
For i = 0 To 49
lColor = -lColor +1
If lSprite
Circle (400,300, 500-(i*10), RGB (lColor*255, 0, 0))
Else
Circle (400,300, 500-(i*10), RGB (0, 0, lColor*255))
EndIf
Next
StopDrawing ()
Next

CreateSprite3D (0,0)
CreateSprite3D (1,1)

Repeat
ClearScreen (0)
ExamineKeyboard ()

Start3D ()
Sprite3DBlendingMode (10,7)
DisplaySprite3D (0, -50+ Cos (vain2.d)*50, -50+ Sin (vain.d)*50)
DisplaySprite3D (1, -50+ Sin (vain.d)*50, -50+ Cos (vain.d)*50)
Stop3D ()

vain.d = vain.d + 0.05
vain2.d = vain2.d + 0.025
FlipBuffers ()
Until KeyboardPushed ( #PB_Key_Escape )

Quatrième démonstration :

 
Sélectionnez
; ---- code by va!n aka 'thorsten will' in 2007 ----

InitSprite ()
InitSprite3D ()
InitKeyboard ()

OpenScreen (640,480,32, "Exampe by va!n aka 'Thorsten Will' in 2007" )
CreateSprite (0,1024,768, #PB_Sprite_Texture )
CreateSprite (1,1024,768, #PB_Sprite_Texture )


For lSprite = 0 To 1
StartDrawing ( SpriteOutput (lSprite))
For i = 0 To 49
lColor = -lColor +1
If lSprite = 0 : Circle (512,384, 500-(i*10), RGB (lColor*(i*5), 0, 0)) : EndIf
If lSprite = 1 : Circle (512,384, 500-(i*10), RGB (0, 0, lColor*(i*5))) : EndIf
Next
StopDrawing ()
Next

CreateSprite3D (0,0)
CreateSprite3D (1,1)

Repeat
ClearScreen (0)
ExamineKeyboard ()

Start3D ()
Sprite3DBlendingMode (4,7)
DisplaySprite3D (0, -100+ Cos (vain2.d)*50, -100+ Sin (vain.d)*50)
DisplaySprite3D (1, -150+ Sin (vain.d)*50, -150+ Cos (vain.d)*50)
DisplaySprite3D (1, -200+ Sin (vain.d/2)*200, -100+ Cos (vain2.d)*100)
DisplaySprite3D (0, -150+ Cos (vain2.d)*150, -150+ Sin (vain.d/2)*150)
Stop3D ()

vain.d = vain.d + 0.05
vain2.d = vain2.d + 0.025
FlipBuffers ()
Until KeyboardPushed ( #PB_Key_Escape )
Créé le 6 mars 2010  par Va!n

Voici un petit code que j'ai dû réaliser pour mes élèves.
Je me suis inspiré du jeu gratuit du site http://www.brothersoft.com/games/soukoban.html
J'ai juste rajouté de l'eau qui coule pour faire joli.
Il y a juste quatre niveaux (j'ai fait le code la veille du cours)

L'objectif est de réaliser un jeu complet (graphisme, son, jouabilité...etc).
La structure du code est assez intuitive. Pour chaque étape, j'ai gardé la première solution qui venait, cela signifie que le code n'est pas du tout optimisé.
D'ailleurs, si vous avez des simplifications à faire ou même des points qui vous semblent trop obscurs, n'hésitez pas à le signaler !

L'archive contient le code source complet ainsi qu'un exécutable en version 32 bits et un exécutable en version 64 bits pour tester le jeu sans PureBasic.


Note : cette version ne comporte pas de son.

Créé le 12 juillet 2010  par Huitbit

Téléchargez le zip

 
Sélectionnez
Structure Pt
  x.i
  y.i
EndStructure

Structure PtPair
  A.Pt
  B.Pt
EndStructure

Structure PtPairSlopeCache Extends PtPair
  yperx.d
EndStructure

Procedure MaxI(A, B)
  If A > B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure MinI(A, B)
  If A < B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

; Return the x of a line for a given y
Macro LineX(y, Line)
  (line\yperx * (y-Line\A\y) + Line\A\x)
EndMacro

; Whether a ray like this crosses a line segment
;  |-------------------->
; *a is the topmost point (smallest y), *b is the lowest point
Procedure XRayCrossesLine(x, y, *Line.PtPairSlopeCache)
  If y <= *line\A\y
    ProcedureReturn 0
  ElseIf y > *line\B\y
    ProcedureReturn 0
  ElseIf LineX(y, *Line) > x
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

; Make sure *a\y < *b\y
Procedure CorrectPointOrder(*a.pt, *b.pt)
  If *a\y > *b\y
    Swap *a\x, *b\x
    Swap *a\y, *b\y
  EndIf
EndProcedure

; Precalc line slope
Procedure.d Slope(*a.pt, *b.pt)
  dx.i = (*b\x-*a\x)
  dy.i = (*b\y-*a\y)
  ProcedureReturn dx/dy
EndProcedure

; Make the lines conform to expectations
Procedure PrepLines(List Lines.PtPairSlopeCache())
  ForEach Lines()
    CorrectPointOrder(Lines()\A, Lines()\B)
    Lines()\yperx = Slope(Lines()\A, Lines()\B)
  Next
EndProcedure

; Convert a list of points into a list of lines
Procedure GetPolyLines(List Poly.pt(), List Lines.PtPairSlopeCache())
  FirstElement(Poly())
  Prev.pt = Poly()
  While NextElement(Poly())
    AddElement(Lines())
    Lines()\A = Prev
    Lines()\B = Poly()
    Prev = Poly()
  Wend
  ; Connect last point to first
  AddElement(lines())
  lines()\A = Prev
  FirstElement(Poly())
  lines()\B = Poly()
  ; Prep lines
  PrepLines(Lines())
EndProcedure

Procedure PtInPoly(x, y, List Lines.PtPairSlopeCache())
  Protected Intersections = 0
  FirstElement(Lines())
  ForEach Lines()
    Intersections + XRayCrossesLine(x, y, @Lines())
  Next
  ProcedureReturn Intersections & 1
EndProcedure

Procedure GetPolyExtents(List Poly.Pt(), *TopLeft.Pt, *BtmRight.Pt)
  ForEach Poly()
    *TopLeft\x = MinI(*TopLeft\x, Poly()\x)
    *TopLeft\y = MinI(*TopLeft\y, Poly()\y)
    *BtmRight\x = MaxI(*BtmRight\x, Poly()\x)
    *BtmRight\y = MaxI(*BtmRight\y, Poly()\y)
  Next
EndProcedure

Procedure FillPolygonWithCache(xoff, yoff, List Poly.Pt(), List Lines.PtPairSlopeCache(), color)
  GetPolyExtents(Poly(), TopLeft.Pt, BtmRight.Pt)
  w = BtmRight\x - TopLeft\x
  h = BtmRight\y - TopLeft\y
  For x = TopLeft\x To w
    For y = TopLeft\y To h
      If PtInPoly(x, y, Lines())
        Plot(x+xoff, y+yoff, color)
      EndIf
    Next
  Next
EndProcedure

Procedure FillPolygon(xoff, yoff, List Poly.Pt(), color=255)
  Protected NewList Lines.PtPairSlopeCache()
  GetPolyLines(Poly(), Lines())
  FillPolygonWithCache(xoff, yoff, Poly(), Lines(), color)
EndProcedure

Procedure OutlinePolygonWithCache(xoff, yoff, List Poly.Pt(), List Lines.PtPairSlopeCache(), color)
  ForEach Lines()
    LineXY(Lines()\A\x + xoff, Lines()\A\y + yoff, Lines()\B\x + xoff, Lines()\B\y + yoff, color)
  Next
EndProcedure

Procedure OutlinePolygon(xoff, yoff, List Poly.Pt(), color=0)
  Protected NewList Lines.PtPairSlopeCache()
  GetPolyLines(Poly(), Lines())
  OutlinePolygonWithCache(xoff, yoff, Poly(), Lines(), color)
EndProcedure

Procedure RenderPolygon(xoff, yoff, List Poly.Pt(), FillColor=255, OutlineColor=0)
  Protected NewList Lines.PtPairSlopeCache()
  GetPolyLines(Poly(), Lines())
  FillPolygonWithCache(xoff, yoff, Poly(), Lines(), FillColor)
  OutlinePolygonWithCache(xoff, yoff, Poly(), Lines(), OutlineColor)
EndProcedure

;- Test code:

Procedure MyPatternPainter(x, y, src, target)
  r = 255-(((x/4)&1) | ((y/4)&1))*255
  ProcedureReturn RGB(r, x*y, r)
EndProcedure

OpenWindow(0, 0, 0, 512, 384, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)

Macro AddPt(l, _x, _y)
  AddElement(l)
  l\x = _x
  l\y = _y
EndMacro

NewList rect.pt()

AddPt(rect(), 10, 10)
AddPt(rect(), 125, 15)
AddPt(rect(), 120, 100)
AddPt(rect(), 15, 90)

NewList Star.Pt()
AddPt(Star(), 0, 13)
AddPt(Star(), 15, 13)
AddPt(Star(), 20, 0)
AddPt(Star(), 25, 13)
AddPt(Star(), 40, 13)
AddPt(Star(), 27, 22)
AddPt(Star(), 32, 35)
AddPt(Star(), 20, 27)
AddPt(Star(), 7, 35)
AddPt(Star(), 12, 22)

ForEach Star()
  Star()\x = Star()\x * 4 + 130
  Star()\y = Star()\y * 4 + 30
Next


w = 512
h = 384
CreateImage(0, w, h, 24)
t = ElapsedMilliseconds()
StartDrawing(ImageOutput(0))
  Box(0, 0, w, h, RGB(255, 255, 255))
 
  ; Show our box
  RenderPolygon(0, 0, rect(), RGB(255, 128, 32), RGB(128, 64, 16))
 
  ; Advanced: gradient fill (of star)
  DrawingMode(#PB_2DDrawing_Gradient)
  CircularGradient(200, 100, 100)
  RandomSeed(63)
  For I = 0 To 20
    GradientColor(I/20, RGB(Random(255), Random(255), Random(255)))
  Next
  FillPolygon(0, 0, star())
  DrawingMode(#PB_2DDrawing_Default)
  OutlinePolygon(0, 0, Star())
 
  ; Advanced: pattern fill (with custom callback)
  DrawingMode(#PB_2DDrawing_CustomFilter)
  CustomFilterCallback(@MyPatternPainter())
  FillPolygon(0, 200, rect())
  DrawingMode(#PB_2DDrawing_Default)
  OutlinePolygon(0, 200, rect(), RGB(0, 255, 0))

 
StopDrawing()
t = ElapsedMilliseconds()-t
; MessageRequester("", Str(t))

ImageGadget(0, 0, 0, 0, 0, ImageID(0))

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
Créé le 29 octobre 2010  par Trond

[Enter] = Accélérer
[BackSpace] = Décélérer

[Tab] = Rotation gauche
[A] = Rotation droite

[Flèche gauche] = Roulis vers la gauche
[Flèche droite] = Roulis vers la droite

[Flèche haut] = Plongeon en avant
[Flèche bas] = Plongeon en arrière

[O] = Zoom +
[P] = Zoom -

 
Sélectionnez
DisableDebugger
#N = 3999
Global.F Dim X(#N), Dim Y(#N), Dim Z(#N), Dim S(#N), H, R, A
Macro Ro(CoA, CoB, CoC) ; Macro d'une procédure de rotation
  Procedure R#CoA(i, Angle.F)
    Protected.F X, Y, Z
    X = X(i)
    Y = Y(i)
    Z = Z(i)
    H = CoA
    R = Sqr((CoB * CoB) + (CoC * CoC) )
    A = ACos(CoC / R): If CoB < 0.0: A = 0.0 - A: EndIf
    CoA#(i) = H
    CoB#(i) = Sin(A + Angle) * R
    CoC#(i) = Cos(A + Angle) * R
  EndProcedure
EndMacro
Ro(x,y,z):Ro(y,z,x):Ro(z,x,y) ;3 procs pour les 3 rotations X, Y et Z
InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()
ExamineDesktops()
Dw = DesktopWidth(0)
Dh = DesktopHeight(0)
Dd = DesktopDepth(0)
Dhw = Dw / 2: Dhh = Dh / 2
OpenScreen(Dw, Dh, Dd, "")
KeyboardMode(#PB_Keyboard_International)
For I = 0 To #N
  S(I) = 0 
  X(I) = Random(1000000) / 10.0 - 50000.0
  Y(I) = Random(1000000) / 10.0 - 50000.0
  Z(I) = Random(1000000) / 10.0 - 50000.0
Next I
Zoom.F = 1.0
Size = 512
CreateImage(0, Size, Size, 32)
StartDrawing(ImageOutput(0) )
  For I = 0 To (Size / 2)
    G = I * 511 / Size
    Circle(Size / 2, Size / 2, (Size - (I * 2) ) / 2, RGBA(G, G, G, 255) )
  Next I
StopDrawing()
CreateSprite(0, Size, Size, #PB_Sprite_Texture | #PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0) )
  DrawAlphaImage(ImageID(0), 0, 0)
  DrawingMode(#PB_2DDrawing_AlphaChannel)
  DrawAlphaImage(ImageID(0), 0, 0)
StopDrawing()
CreateSprite3D(0, 0)
PitchCamera.F = 0.0: PitchCameraAccel.F = 0.001
TurnCamera.F = 0.0: TurnCameraAccel.F = 0.001
RollCamera.F = 0.0: RollCameraAccel.F = 0.001
CameraSpeed.F = 0.0: Size2 = Size / 2
Repeat
  Delay(1)
  ExamineKeyboard()
  ExamineMouse()
  ClearScreen(RGBA(0, 0, 0, 0) )
  Start3D()
  Sprite3DBlendingMode(5, 7)
  If KeyboardPushed(#PB_Key_Left): RollCamera - RollCameraAccel: EndIf
  If KeyboardPushed(#PB_Key_Right): RollCamera + RollCameraAccel: EndIf
  If KeyboardPushed(#PB_Key_Down): PitchCamera + PitchCameraAccel: EndIf
  If KeyboardPushed(#PB_Key_Up): PitchCamera - PitchCameraAccel: EndIf
  If KeyboardPushed(#PB_Key_Tab): TurnCamera + TurnCameraAccel: EndIf
  If KeyboardPushed(#PB_Key_A): TurnCamera - TurnCameraAccel: EndIf
  If KeyboardPushed(#PB_Key_Back): CameraSpeed / 1.1: EndIf
  If KeyboardPushed(#PB_Key_Return): CameraSpeed + 10.0: EndIf
  If KeyboardPushed(#PB_Key_O): Zoom * 1.01: EndIf
  If KeyboardPushed(#PB_Key_P): Zoom / 1.01: EndIf
  For I = 0 To #N
    Z(I) - CameraSpeed: If Z(I) < - 50000.0: Z(I) + 100000.0: EndIf
    Rx(I, PitchCamera)
    Ry(I, TurnCamera)
    Rz(I, RollCamera)
    If Z(i) > 0.0
      Coef.F = 400.0 / Sqr(X(i) * X(i) + Y(i) * Y(i) + Z(i) * Z(i) ) * Zoom
      DisplaySprite3D(S(i), 0, 0)
      sx1 = Dhw + (X(i) - Size2) * Coef
      sy1 = Dhh + (Y(i) - Size2) * Coef
      sx2 = Dhw + (X(i) + Size2) * Coef
      sy2 = Dhh + (Y(i) - Size2) * Coef
      sx3 = Dhw + (X(i) + Size2) * Coef
      sy3 = Dhh + (Y(i) + Size2) * Coef
      sx4 = Dhw + (X(i) - Size2) * Coef
      sy4 = Dhh + (Y(i) + Size2) * Coef
      sz.F = Coef * 100
      TransformSprite3D(S(I), sx1, sy1, sz, sx2, sy2, sz, sx3, sy3, sz, sx4, sy4, sz)
    EndIf
  Next I
  PitchCamera * 0.99
  TurnCamera * 0.99
  RollCamera * 0.99
  CameraSpeed * 0.999
  Stop3D()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
End
Créé le 20 novembre 2010  par Ollivier

Voici un petit moteur physique 2D basé sur la méthode de "l'intégration de Verlet".
Je suis tombé par hasard sur l'article suivant: http://www.gamasutra.com/resource_guide/20030121/jacobson_01.shtml et comme ça me paraissait accessible malgré mes faibles connaissances en maths, j'ai tenté le coup.
Le but n'est pas d'avoir une simulation hyper-précise, mais plutôt un petit truc pas trop lourd utilisable dans un jeu de plateformes (ou autre).

Le code est en trois parties:

  • un include contenant des macros pour gérer les vecteurs 2;
  • un include contenant le moteur physique lui-même (qui fait appel à l'include précédent);
  • un petit programme de démo qui utilise l'include ci-dessus.

Contrôles:

  • F1 à F9 : créer des objets
  • Souris: en laissant le bouton gauche appuyé, on peut déplacer un point à l'écran
  • Suppr: supprime tous les objets (ou seulement un seul si le bouton gauche est appuyé)
  • Ctrl droit: ralenti (il faut laisser la touche enfoncée)
  • Entrée: active/désactive l'affichage (pour les tests de vitesse)

Remarque: à cause de certaines optimisations (pour l'inverse de racine carrée et les pointeurs) je ne suis pas sûr que ça marche en 64 bits, et encore moins sur Mac ou Linux.

Il reste encore deux-trois trucs à terminer, mais comme c'est déjà marrant comme ça, je le poste...

Créé le 17 décembre 2010  par kelebrindae

Téléchargez le zip

2 touches par rotation (sens positif et sens négatif)
2 types de rotation (absolue et relative)
3 axes par rotations (x, y et z)

2 * 2 * 3 = 12 ; Le compte y est.

Rotations absolues:

  • Flèche HAUT/Flèche BAS Selon Axe X
  • Flèche GAUCHE/Flèche DROITE Selon Axe Z
  • Touche TABULATION/Touche A Selon Axe Y

Rotations relatives:

  • Pavé numérique TOUCHE 4/TOUCHE 6 Selon Axe i
  • Pavé numérique TOUCHE 8/TOUCHE 2 Selon Axe j
  • Pavé numérique TOUCHE 9/TOUCHE 3 Selon Axe k

Parmi ces 12 rotations qui te font tourner le trièdre dans tous les sens possibles et inimaginables, aucune rotation ne s'exécute autrement qu'autour d'un axe bien défini, calculable, clairement affiché à l'écran, et tout, et tout...

 
Sélectionnez
;_______________________________________________________
;  Titre : ROTATIONS 3D ABSOLUES ET RELATIVES (PIVOT)
;  Auteur :                                  OLLIVIER
;  Date :                                  08/01/2011
;  Outil numérique utilisé :              MATRICE 2x2
;  Sens de la base :                         INDIRECT
;  Perspective                            ISOMETRIQUE
;  Interface                                  CLAVIER
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
;  Ajout d'un nuage de points relatif à IJK (MAJ#1)
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Structure IJK
  Ix.D: Iy.D: Iz.D
  Jx.D: Jy.D: Jz.D
  Kx.D: Ky.D: Kz.D
EndStructure

Base .IJK: Base \Ix = 1. : Base \Jy = 1. : Base \Kz = 1.
Base0.IJK: Base0\Ix = 1.5: Base0\Jy = 1.5: Base0\Kz = 1.5

Global.I DskW, DskH, DskD, DskF
Global.D OnX, OnY

;{ MAJ#1 }
#PQty = 1024
Structure V3
  x.D: y.D: z.D
EndStructure

Global Dim Cloud.V3(#PQty)

For I = 0 To #PQty
  Cloud(I)\x = Random(200) / 200. - 0.5
  Cloud(I)\y = Random(200) / 200. - 0.5
  Cloud(I)\z = Random(200) / 200. - 0.5
Next

Procedure DrawPoint(x.D, y.D, z.D)
  x1 = DskW / 4
  y1 = DskH / 4
  OnX = x * 100.0
  OnY = y * 100.0
  x2 = x1 + OnX
  y2 = y1 - OnY ; Soustraction dûe à l'opposition du sens de l'axe Y de l'écran par rapport à l'axe Y conventionnel en géométrie
  Circle(x2, y2, 2, RGB(1, 1, 1) )
EndProcedure

Procedure DrawCloud(*Base.IJK)
  Protected.D x, y, z
  For I = 0 To #PQty
    With Cloud(I)
      x = \x * *Base\Ix + \y * *Base\Jx + \z * *Base\Kx
      y = \x * *Base\Iy + \y * *Base\Jy + \z * *Base\Ky
      z = \x * *Base\Iz + \y * *Base\Jz + \z * *Base\Kz
      DrawPoint(x, y, z)
    EndWith
  Next
EndProcedure
;}

Procedure DrawLine(x.D, y.D, z.D, Name.S, Color.I)
  x1 = DskW / 4
  y1 = DskH / 4
  OnX = x * 100.0
  OnY = y * 100.0
  x2 = x1 + OnX
  y2 = y1 - OnY ; Soustraction dûe à l'opposition du sens de l'axe Y de l'écran par rapport à l'axe Y conventionnel en géométrie
  LineXY(x1, y1, x2, y2, Color)
  DrawText(x2 + 4, y2 + 4, Name, Color, RGB(254, 254, 254) )
  x2 = x1 - OnX
  y2 = y1 + OnY
  LineXY(x1, y1, x2, y2, Color)
EndProcedure

Procedure RotationOrtho(*r.DOUBLE, *i.DOUBLE, w.D)
  Protected.D x, y, Cos, Sin
  x = *r\D
  y = *i\D
  Cos = Cos(w)
  Sin = Sin(w)
  *r\D = x * Cos - y * Sin
  *i\D = y * Cos + x * Sin
EndProcedure

Macro Rotation(a, b, c)
  RotationOrtho(@Base\I#a, @Base\I#b, c)
  RotationOrtho(@Base\J#a, @Base\J#b, c)
  RotationOrtho(@Base\K#a, @Base\K#b, c)
EndMacro

Macro Pivot(a, b, c)
  Cos = Cos(c)
  Sin = Sin(c)
  x = Base\a#x
  y = Base\a#y
  z = Base\a#z
  Base\a#x = x * Cos - Base\b#x * Sin
  Base\a#y = y * Cos - Base\b#y * Sin
  Base\a#z = z * Cos - Base\b#z * Sin
  Base\b#x = x * Sin + Base\b#x * Cos
  Base\b#y = y * Sin + Base\b#y * Cos
  Base\b#z = z * Sin + Base\b#z * Cos
EndMacro

Define.D x, y, z, Cos, Sin, v = 0.05
InitSprite()
InitSprite3D()
InitKeyboard()
ExamineDesktops()
DskW = DesktopWidth(0)
DskH = DesktopHeight(0)
DskD = DesktopDepth(0)
DskF = DesktopFrequency(0)
WinN = OpenWindow(#PB_Any, 0, 0, DskW / 2, DskH / 2, "Rotations 3D", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(WinN), 0, 0, DskW / 2, DskH / 2, 0, 0, 0)
KeyboardMode(#PB_Keyboard_International)
Repeat
  Delay(1)
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Up)   : Rotation(y, z, v) : EndIf
  If KeyboardPushed(#PB_Key_Down) : Rotation(y, z, -v): EndIf
  If KeyboardPushed(#PB_Key_Tab)  : Rotation(x, z, v) : EndIf
  If KeyboardPushed(#PB_Key_A)    : Rotation(x, z, -v): EndIf
  If KeyboardPushed(#PB_Key_Left) : Rotation(x, y, v) : EndIf
  If KeyboardPushed(#PB_Key_Right): Rotation(x, y, -v): EndIf
  If KeyboardPushed(#PB_Key_Pad8) : Pivot(J, K, v): EndIf
  If KeyboardPushed(#PB_Key_Pad2) : Pivot(J, K, -v): EndIf
  If KeyboardPushed(#PB_Key_Pad4) : Pivot(I, J, v): EndIf
  If KeyboardPushed(#PB_Key_Pad6) : Pivot(I, J, -v): EndIf
  If KeyboardPushed(#PB_Key_Pad9) : Pivot(K, I, v): EndIf
  If KeyboardPushed(#PB_Key_Pad3) : Pivot(K, I, -v): EndIf
  ClearScreen(RGB(254, 254, 254) )
  StartDrawing(ScreenOutput() )
  DrawLine(Base0\Ix, Base0\Iy, Base0\Iz, "X", RGB(1, 128, 1) )
  DrawLine(Base0\Jx, Base0\Jy, Base0\Jz, "Y", RGB(1, 1, 128) )
  DrawLine(Base0\Kx, Base0\Ky, Base0\Kz, "Z", RGB(128, 1, 1) )
  DrawLine(Base \Ix, Base \Iy, Base \Iz, "i", RGB(1, 254, 1) )
  DrawLine(Base \Jx, Base \Jy, Base \Jz, "j", RGB(1, 1, 254) )
  DrawLine(Base \Kx, Base \Ky, Base \Kz, "k", RGB(254, 1, 1) )
  DrawCloud(Base) ; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< MAJ#1
  StopDrawing()
  FlipBuffers()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
Créé le 9 janvier 2011  par Ollivier
 
Sélectionnez
;i'm making use of the pc-speaker (beep), so if you have one and your boss is 
;around then better set the constant '#no_sound' to 1.

; >>>>>>>  ascii hero  <<<<<<<<
;
; keys:
;          q : quit
;      cntrl : shoot
; left/right : move
;         up : jump
; items:
;   gun         : , (comma)
;   laser rifle : _ (underscore)


EnableExplicit

#no_sound = 0


#jump_init = 0.9
#jump_fall = 0.09

Structure s_hero
  x.f
  y.f
  look.l
  isjumping.l
  jump.f
  weapon.l
  energy.f
  x_prev.l
  y_prev.l
  sprite.s
EndStructure

Structure s_shot
  x.f
  y.f
  dx.f
  dy.f
  c.c
  byhero.l
  x_prev.l
  y_prev.l
EndStructure

Structure s_enemy
  x.f
  y.f
  dx.f
  dy.f
  c.c
  firewait.l
  energy.f
  x_prev.l
  y_prev.l
EndStructure

Global hero.s_hero
Global gun_x_prev
Global gun_y_prev
Global NewList enemy.s_enemy()
Global NewList shot.s_shot()
Global xmax,ymax
Global Dim levelmap.c(0,0)
Global redraw=#True
Global redraw_timer
Global quit

Declare shoot(x.f, y.f, dx.f, dy.f, c.c, byhero)

Macro r(f)
  Int(Round(f,#PB_Round_Nearest))
EndMacro

Procedure drawSprite(*dat, x, y)
  Protected c.c
  ConsoleLocate(x,y)
  Repeat
    c = PeekC(*dat)
    Select c
      Case #LF  ::  Break
      Case 0    ::  y+1 : ConsoleLocate(x,y)
      ;Case 32   ::  x+1 : ConsoleLocate(x,y)
      Default   ::  Print(Chr(c))
    EndSelect
    *dat + SizeOf(Character)
  ForEver
EndProcedure

Procedure loadlevel(*dat)
  Protected c.c
  Protected x
  xmax = Len(PeekS(*dat))-1
  ;Debug xmax
  ;CallDebugger
  ymax = 0
  Dim levelmap(xmax,ymax)
  Repeat
    c.c = PeekC(*dat)
    Select c
      Case #LF
        Break
      Case 0
        x=-1
        ymax+1
        ReDim levelmap(xmax,ymax)
      Case '='
        AddElement(enemy())
        enemy()\x = x
        enemy()\y = ymax
        enemy()\dx = 0.2 - 0.2*2*Random(1)
        enemy()\dy = 0.2 - 0.2*2*Random(1)
        enemy()\c = c
        enemy()\energy = 2
        levelmap(x,ymax) = 32
      Default
        levelmap(x,ymax) = c
    EndSelect
    *dat + SizeOf(Character)
    x + 1
  ForEver
EndProcedure

Procedure drawlevel()
  Protected x,y
  For x=0 To xmax
    For y=1 To ymax
      ConsoleLocate(x,y)
      Print(Chr(levelmap(x,y)))
    Next
  Next
EndProcedure

Procedure drawtxt(x,y,txt.s)
  Protected lines,n
  lines = CountString(txt,#LF$)+1
  For n=1 To lines
    ConsoleLocate(x,y)
    Print(StringField(txt,n,#LF$))
    y+1
  Next
EndProcedure

Procedure drawlevelxy(x,y)
  If x>=0 And x<= xmax And y>=0 And y<=ymax
    drawtxt(x,y,Chr(levelmap(x,y)))
  EndIf
EndProcedure

Procedure issolid(x,y)
  If x>=0 And x<=xmax And y>=0 And y<=ymax
    If Chr(levelmap(x,y)) = "#"
      ProcedureReturn #True
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure jump()
  Protected y_prev
  If hero\isjumping
    If hero\jump > -0.5
      hero\jump - #jump_fall
    EndIf
    If hero\jump>0 And issolid(hero\x, hero\y-hero\jump)
      hero\jump = 0
    ElseIf hero\jump<0 And issolid(hero\x, hero\y+1-hero\jump)
      hero\isjumping = #False
    Else 
      y_prev = hero\y
      hero\y - hero\jump
      If r(hero\y) <> y_prev
        redraw=#True
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure bullets()
  Protected x,y,cont
  ForEach shot()
    ; impacts
    If Not shot()\byhero And r(shot()\x) = r(hero\x) And (r(shot()\y) = r(hero\y) Or r(shot()\y) = r(hero\y)+1)
      Select shot()\c
        Case '.'
          hero\energy - 1
          drawlevelxy(shot()\x_prev,shot()\y_prev)
          drawlevelxy(shot()\x,shot()\y)
          DeleteElement(shot())
          Continue
      EndSelect 
    EndIf
    cont=#False
    ForEach enemy()
      If shot()\byhero And r(shot()\x) = r(enemy()\x) And r(shot()\y) = r(enemy()\y)
        Select shot()\c
          Case '.'
            enemy()\energy - 0.7
            drawlevelxy(shot()\x_prev,shot()\y_prev)
            drawlevelxy(shot()\x,shot()\y)
            DeleteElement(shot())
            cont=#True
            Break
          Case '_'
            enemy()\energy - 2
            drawlevelxy(shot()\x_prev,shot()\y_prev)
            drawlevelxy(shot()\x,shot()\y)
            DeleteElement(shot())
            cont=#True
            Break
        EndSelect 
      EndIf
    Next
    If cont
      Continue
    EndIf
   
    ; move
    x = shot()\x
    y = shot()\y
    shot()\x + shot()\dx
    shot()\y + shot()\dy
    If issolid(shot()\x, shot()\y)
      drawlevelxy(shot()\x_prev,shot()\y_prev)
      drawlevelxy(shot()\x,shot()\y)
      DeleteElement(shot())
      redraw=#True
    ElseIf shot()\x<0 Or shot()\y<0 Or shot()\x>xmax Or shot()\y>ymax
      drawlevelxy(shot()\x_prev,shot()\y_prev)
      drawlevelxy(shot()\x,shot()\y)
      DeleteElement(shot())
      redraw=#True
    ElseIf Not redraw
      If r(shot()\x) <> x  Or  r(shot()\y) <> y
        redraw=#True
      EndIf
    EndIf
    ;redraw=#True
  Next
EndProcedure

Procedure lineofsight(x,x2,y)
  If x>x2
    Swap x,x2
  EndIf
  For x=x To x2
    If issolid(x,y)
      ProcedureReturn #False
    EndIf
  Next
  ProcedureReturn #True
EndProcedure

Procedure enemies()
  Protected x,y,sight
  ForEach enemy()
    ; die
    If enemy()\energy<=0
      drawlevelxy(enemy()\x_prev,enemy()\y_prev)
      drawlevelxy(enemy()\x,enemy()\y)
      DeleteElement(enemy())
      Continue
    EndIf
   
    ; shoot
    If enemy()\firewait<1
      If (r(enemy()\y) = r(hero\y) And lineofsight(enemy()\x,hero\x,hero\y))   Or   (r(enemy()\y) = r(hero\y)+1 And lineofsight(enemy()\x,hero\x,hero\y))
        If enemy()\x > hero\x
          shoot(enemy()\x, enemy()\y, -0.9, 0, Asc("."), #False)
        ElseIf enemy()\x < hero\x
          shoot(enemy()\x, enemy()\y,  0.9, 0, Asc("."), #False)
        EndIf
        enemy()\firewait = 30
      EndIf
    EndIf
    If enemy()\firewait
      enemy()\firewait - 1
    EndIf
   
    ; move
    x = enemy()\x
    y = enemy()\y
    ;enemy()\x -0.5 +Random(100)/100.0
    ;enemy()\y -0.5 +Random(100)/100.0
    If Random(3)=0 : enemy()\x -1 +Random(2) : EndIf
    If Random(3)=0 : enemy()\y -1 +Random(2) : EndIf
   
    If issolid(enemy()\x, enemy()\y)
      enemy()\x = x
      enemy()\y = y
    ElseIf Not redraw
      If r(enemy()\x) <> x  Or  r(enemy()\y) <> y
        redraw=#True
      EndIf
    EndIf
    ;redraw=#True
  Next
EndProcedure

Procedure draw()
  ;ClearConsole()
  ;drawlevel()
  drawtxt(1,0,"HEALTH "+LSet( Left("|||||||||||||||||||||||||||",hero\energy), 10,"."))
 
 
  ; delete
  ForEach enemy()
    drawlevelxy(enemy()\x_prev, enemy()\y_prev)
  Next
  drawlevelxy(hero\x_prev,hero\y_prev)
  drawlevelxy(hero\x_prev,hero\y_prev+1)
  drawlevelxy(gun_x_prev,gun_y_prev)
  ForEach shot()
    drawlevelxy(shot()\x_prev, shot()\y_prev)
  Next
 
 
  ; redraw
  ForEach enemy()
    drawtxt(enemy()\x, enemy()\y, Chr(enemy()\c))
  Next
  drawtxt(hero\x,hero\y,hero\sprite)
 
  If Not issolid(hero\x+hero\look, hero\y)
    If hero\weapon
      drawtxt(hero\x+hero\look, hero\y, "_")
    EndIf
  EndIf
 
  ForEach shot()
    drawtxt(shot()\x, shot()\y, Chr(shot()\c))
  Next
EndProcedure

Procedure sound(nr)
  CompilerIf #no_sound
    ;
  CompilerElse
 
  Protected i.l
 
  Select nr
  Case 0; pick up
    For i=0 To 3
      Beep_(1000+i*200,8)
    Next
  Case 1; shoot rifle
    For i=0 To 8
      Beep_(1000+Random(10)*50-i*80,4)
    Next
  Case 2; shoot laser
    For i=8 To 0 Step -1
      Beep_(1000+i*120,6)
    Next
  Case 99; game over
    Beep_( 234, 200 )
    Beep_( 211, 200 )
    Beep_( 187, 200 )
    Beep_( 176, 200 )
    Beep_( 187, 400 )
    Beep_( 158, 400 )
    Beep_( 79, 400 )
  Case 100; victory
    Beep_( 396, 83 )
    Beep_( 440, 83 )
    Beep_( 469, 83 )
    Beep_( 528, 83 )
    Beep_( 594, 166 )
    Beep_( 792, 166 )
    Beep_( 594, 166 )
    Beep_( 792, 166 )
    Beep_( 1584, 249 )
  EndSelect
 
  CompilerEndIf
EndProcedure

Procedure shoot(x.f, y.f, dx.f, dy.f, c.c, byhero)
  AddElement(shot())
  shot()\x = x
  shot()\y = y
  shot()\dx = dx
  shot()\dy = dy
  shot()\c = c
  shot()\byhero = byhero
  Select Chr(c)
    Case "." :: sound(1)
    Case "_" :: sound(2)
  EndSelect
EndProcedure

Procedure getprevious()
  hero\x_prev = r(hero\x)
  hero\y_prev = r(hero\y)
  gun_x_prev = hero\x + hero\look
  gun_y_prev = hero\y
  ForEach enemy()
    enemy()\x_prev = r(enemy()\x)
    enemy()\y_prev = r(enemy()\y)
  Next
  ForEach shot()
    shot()\x_prev = r(shot()\x)
    shot()\y_prev = r(shot()\y)
  Next
EndProcedure



OpenConsole()
; If 0 ; print ascii table
;   Define i
;   For i=30 To 256 : Print(Chr(i)) : Next
;   For i=0 To 256 : PrintN(Str(i)+" "+Chr(i)) : Next
;   Input()
;   End
; EndIf
EnableGraphicalConsole(1)
ConsoleCursor(0)
loadlevel(?map01)


hero\x=4
hero\y=16
hero\isjumping=#True
hero\look=1
hero\energy=10
hero\sprite = "o"+#LF$
hero\sprite + "A"
;hero\weapon=2

ClearConsole()
drawlevel()

Repeat
 
  Inkey()
  If RawKey()
    Select RawKey()
      Case 37 ;{ left
        hero\look = -1
        If Not issolid(hero\x-1,hero\y) And Not issolid(hero\x-1,hero\y+1)
          hero\x-1
          If Not issolid(hero\x,hero\y+2)
            hero\isjumping = #True
          EndIf
          redraw=#True
        EndIf
        ;}
      Case 39 ;{ right
        hero\look = 1
        If Not issolid(hero\x+1,hero\y) And Not issolid(hero\x+1,hero\y+1)
          hero\x+1
          If Not issolid(hero\x,hero\y+2)
            hero\isjumping = #True
          EndIf
          redraw=#True
        EndIf
        ;}
      Case 38 ;{ up
        If Not hero\isjumping
          hero\isjumping = #True
          hero\jump = #jump_init
        EndIf
        ;}
      Case 17 ;{ shoot
        Select hero\weapon
          Case 1 :: shoot(hero\x+hero\look, hero\y, 0.9 * hero\look, 0, Asc("."), #True)
          Case 2 :: shoot(hero\x+hero\look, hero\y, 0.9 * hero\look, 0, Asc("_"), #True)
        EndSelect
        ;}
      Case Asc("Q") ;quit
        quit = #True
    EndSelect
  EndIf
 
  Select Chr(levelmap(Int(hero\x),Int(hero\y+1)))
    Case ","
      sound(0)
      hero\weapon = 1
      levelmap(Int(hero\x),Int(hero\y+1)) = 32
    Case "_"
      sound(0)
      hero\weapon = 2
      levelmap(Int(hero\x),Int(hero\y+1)) = 32
  EndSelect
  enemies()
  jump()
  bullets()
  draw()
  Delay(50)
  getprevious()
 
  If hero\energy<=0
    drawtxt(32,12," ----------- "+#LF$+"| GAME OVER |"+#LF$+" ----------- ")
    sound(99)
    Delay(1000)
    End
  EndIf
 
  If ListSize(enemy())=0
    drawtxt(32,12," ----------- "+#LF$+"|  VICTORY  |"+#LF$+" ----------- ")
    sound(100)
    Delay(1000)
    End
  EndIf
Until quit




DataSection
  map01:
  Data.s "                                                                                "
  Data.s " ############################################################################## "
  Data.s " #                                                                            # "
  Data.s " #                                   =                                        # "
  Data.s " #    =                                            ##         ##              # "
  Data.s " #     =                                                                      # "
  Data.s " #                                                   ##     ##     =          # "
  Data.s " #                                                    ##   ##                 # "
  Data.s " #                                                                            # "
  Data.s " #                                                       _                    # "
  Data.s " #                                                   ########    =            # "
  Data.s " #                                                                            # "
  Data.s " #                                           ######                           # "
  Data.s " #########    ################    #########                                   # "
  Data.s " #                                                                            # "
  Data.s " # =                           ##                                             # "
  Data.s " #         ##                          =                          =           # "
  Data.s " #                                                                            # "
  Data.s " #                                                                            # "
  Data.s " #                    ,       ####       =                                    # "
  Data.s " #        ####   ##########   ####                                            # "
  Data.s " #        ####                ####                                            # "
  Data.s " #        ####                ####                                            # "
  Data.s " ############################################################################## "
  Data.s #LF$
  map01end:
EndDataSection
Créé le 25 février 2011  par #NULL

J'ai adapté en PureBasic le code proposé dans ce tutoriel:http://www.charliesgames.com/wordpress/?p=441
En gros, il s'agit de créer des bestioles qui ressemblent à des triops phosphorescents (idéal pour les shoot'em up), et ce à partir d'une seule image: un "blob" (cf. image ci-dessous).

Image non disponible


Qu'y a-t-il d'intéressant dans ce code ?

  • c'est plutôt marrant à regarder
  • une petite procédure de mon cru pour coloriser une image (ça peut servir)
  • un macro qui "enrobe" TransformSprite3D afin de faciliter le zoom, la rotation, et surtout le déplacement du point d'origine d'un sprite 3D (par défaut, ce point est en haut à gauche, mais ça peut être utile de le mettre au milieu du sprite, sur un côté, etc..)

Et puis, le dénommé Charlie Knight (l'auteur) invite toute personne ayant converti son code à lui envoyer le résultat; pour l'instant, il y a des conversions en Flash et en GLbasic. Si je lui envoie la mienne, ça fera un peu de pub pour PureBasic !

Allez, je vous laisse tester. Récupérez l'image, le code ci-dessous, et zou !

 
Sélectionnez
;How to make an Irukandji style blob monster.
;By Charlie Knight, 2009/2010
;http://www.charliesgames.com
;
;This code is public domain. Feel free to use as you please.
;If you use the code as a basis for your own blob monsters, let me know! I;d love To
;see what you came up with!
;
;The code is written using the Blitzmax language, but it should be fairly easy to port
;to C++/Java/Whatever with a suitable graphics library.
;
;the image blob.png can be found at http://www.charliesgames.com/wpimages/blob.png
;
;Cheers
;Charlie

; ---------------------------------------------------------------------------------------------------------------
; PureBasic conversion: Kelebrindae
; Date: March, 15, 2011
; PB version: v4.51
; ---------------------------------------------------------------------------------------------------------------
; NB: The original code uses degree angles, and PureBasic uses radian angles.
;    => The calls to the "Radian" function are numerous and unaesthetic, but I've kept them for comparison's sake.
; NB 2: The original code uses images to display the monster. But as PureBasic lacks the needed image deformation
;       commands, I've used 3d sprites instead.
; ---------------------------------------------------------------------------------------------------------------

EnableExplicit

; Window size
#SCREENWIDTH = 800
#SCREENHEIGHT = 500

#BLOBSIZE = 32 ; bigger value = bigger monster

; Rainbow
Enumeration
  #WHITEBLOB
  #REDBLOB
  #YELLOWBLOB
  #CYANBLOB
EndEnumeration 

; Simple class (Structure in Pure Basic) to hold a 2d coordinate
Structure  point_struct ; I always add "_struct" to the structure name, to distinguish the type from the instances (but it's not mandatory)
  x.f
  y.f
EndStructure

; Here's the blob monster type
Structure blobMonster_struct ; I always add "_struct" to the structure name, to distinguish the type from the instances (but it's not mandatory)
  
  ;x and y coords
  x.f
  y.f
  
  ; Speed, try changing it
  speed.f
  
  ; Number of nodes along the body, try changing it to 100
  segments.i
  
  ; Array to hold the points along the body
  tail.point_struct[100]
  
  time.f
  
EndStructure
Global NewList blobMonster.blobMonster_struct()

Global Dim blobSprite.i(4)  ; 4 colours => 4 different sprites
Global *test.blobMonster_struct

; These variables are used in the myTransformSprite3D macro (they're defined here because it can't be done in the macro)
Global TRF3D_angCos.f,TRF3D_angSin.f,TRF3D_x1.f,TRF3D_y1.f,TRF3D_x2.f,TRF3D_y2.f,TRF3D_x3.f,TRF3D_y3.f,TRF3D_x4.f,TRF3D_y4.f


;********************************************************
;- --- Macros ---
;********************************************************

;This macro calculates and returns the angle between two 2d coordinates, in degrees
Macro  calculateAngle(x1,y1,x2,y2)
  Degree(ATan2(x1 - x2,y1 - y2))
EndMacro

; Define the size for a sprite3D, its origin (proportionnal to the size. 0.5,0.5 => center), and its rotation angle (absolute)
; Replace the following BlitzMax commands: "SetScale", "SetImageHandle", and "SetRotation"
Macro myTransformSprite3D(numSprite,sizeX,sizeY,pivotX = 0,pivotY = 0,angle = 0)
  ; In PureBasic, a Sprite3D is used the display 2D sprite with 3D hardware ; it's just a textured plane, actually.
  ; Thus, it's possible to zoom, rotate or deform a 3D sprite simply by moving its 4 vertex.
  ; This is done through the "TransformSprite3D" command.
  
  If angle = 0
    TransformSprite3D(numSprite,-(pivotX),-(pivotY),(sizeX) - (pivotX),-(pivotY),(sizeX) - (pivotX),(sizeY) - (pivotY),-(pivotX),(sizeY) - (pivotY))
  Else
    TRF3D_angCos = Cos(angle)
    TRF3D_angSin = Sin(angle)   
    
    TRF3D_x1 = -(pivotX) * TRF3D_angCos - (-(pivotY) * TRF3D_angSin)
    TRF3D_y1 = -(pivotY) * TRF3D_angCos + (-(pivotX) * TRF3D_angSin)
    
    TRF3D_x2 = ((sizeX) - (pivotX)) * TRF3D_angCos - (-(pivotY) * TRF3D_angSin)
    TRF3D_y2 = -(pivotY) * TRF3D_angCos + ((sizeX) - (pivotX)) * TRF3D_angSin
    
    TRF3D_x3 = ((sizeX) - (pivotX)) * TRF3D_angCos - ((sizeY) - (pivotY)) * TRF3D_angSin
    TRF3D_y3 = ((sizeY) - (pivotY)) * TRF3D_angCos + ((sizeX) - (pivotX)) * TRF3D_angSin
    
    TRF3D_x4 = -(pivotX) * TRF3D_angCos - ((sizeY) - (pivotY)) * TRF3D_angSin
    TRF3D_y4 = ((sizeY) - (pivotY)) * TRF3D_angCos + (-(pivotX) * TRF3D_angSin)
    
    TransformSprite3D(numSprite,TRF3D_x1,TRF3D_y1,TRF3D_x2,TRF3D_y2,TRF3D_x3,TRF3D_y3,TRF3D_x4,TRF3D_y4) 
  EndIf   
  
EndMacro 

;********************************************************
;- --- Procedures ---
;********************************************************
Procedure tintImageFilterCallback(x, y, SourceColor, TargetColor)
  ; Take only the Red component from the Source, do not modify the others
  Protected a.f = Red(TargetColor)/255.0
  ProcedureReturn RGBA(Red(SourceColor)*a, Green(SourceColor)*a, Blue(SourceColor)*a, 255)
EndProcedure

; This procedure use a filter callback (the above procedure) to apply a "tint" effect on a white blob image.
; Then it loads this image as a sprite3D.
Procedure.i createBlobSprite(red.i,green.i,blue.i)
  Protected blobImage.i,tintedImage.i,numSprite.i,numSprite3D.i
  Protected fileName.s = "temp" + Str(red) + "-" + Str(green) + "-" + Str(blue) + ".bmp"
  
  ; Load up the white blob image from the ressources
  blobImage = CatchImage(#PB_Any, ?blob)
  
  ; Create a temporary image
  tintedImage = CreateImage(#PB_Any, ImageWidth(blobIMage),ImageHeight(blobImage))
  
  ; On this image, draw the white blob
  ; (Note: every drawing operation must be done between "StartDrawing" and "StopDrawing")
  StartDrawing(ImageOutput(tintedImage))
  DrawImage(ImageID(blobImage), 0, 0)
  
  ; Then switch to the "tintImage" filter and draw a colored box over the blob.
  ; The color of each pixel is multiplied by the color of the box => we have our colored blob
  DrawingMode(#PB_2DDrawing_CustomFilter)     
  CustomFilterCallback(@tintImageFilterCallback()) 
  Box(0,0,ImageWidth(blobIMage),ImageHeight(blobImage),RGB(red,green,blue))
  
  StopDrawing()
  
  ; Save the tinted image and release the memory
  SaveImage(tintedImage,fileName)
  FreeImage(tintedImage)
  
  ; Reload the image as a sprite and delete the image file
  numSprite = LoadSprite(#PB_Any, fileName, #PB_Sprite_Texture)
  DeleteFile(fileName)
  
  ; Create a sprite3D from the sprite and return its number
  numSprite3D = CreateSprite3D(#PB_Any,numSprite)
  
  ProcedureReturn numSprite3D
  
EndProcedure


; The methods used to create / update / draw a blob monster are here because we can't put them
; in the blobMonster structure (PB isn't object oriented)

; Procedure that returns a pointer to a new blob monster object. Pure Basic equivalent (kind of)
; of a constructor in C++/Java
Procedure blobMonsterCreate(inX.f, inY.f)
  Protected i.i
  Protected *n.blobMonster_struct = AddElement(blobMonster())
  
  ;starting point of the blob monster
  *n\x = inX
  *n\y = iny
  *n\segments = 10
  *n\speed = 1
  
  ;give the tail some coordinates, just make them the same as the main x and y for now
  For i = 0 To *n\segments - 1
    *n\tail[i]\x = inX
    *n\tail[i]\y = iny
  Next i
  
  ProcedureReturn *n
EndProcedure


Procedure blobMonsterUpdate(*ptrMonster.blobMonster_struct)
  Protected i.i
  Protected distX.f,distY.f,dist.f
  
  ;time is a bit misleading, it's used for all sorts of things
  *ptrMonster\time + *ptrMonster\speed
  
  ;here the x and y coordinates are updated.
  ;this uses the following as a basic rule for moving things
  ;around a point in 2d space:
  ;x=radius*cos(angle)+xOrigin
  ;y=raduis*sin(angle)+yOrigin
  ;this basically is the basis for anything that moves in this example
  ;
  ;the 2 lines of code below make the monster move around, but
  ;you can change this to anything you like, try setting x and y to the mouse
  ;coordinates for example
  *ptrMonster\y = (15 * Cos(Radian(*ptrMonster\time * -6))) + (#SCREENHEIGHT / 2 + ((#SCREENHEIGHT / 2 - 60) * Sin(Radian(*ptrMonster\time * 1.3))))
  *ptrMonster\x = (15 * Sin(Radian(*ptrMonster\time * -6))) + (#SCREENWIDTH / 2 + ((#SCREENWIDTH / 2 - 120) * Cos(Radian(*ptrMonster\time / 1.5))))
  
  ; To force the monster to follow the mouse pointer, uncomment these 3 lines:
  ;    ExamineMouse()
  ;    *ptrMonster\x = MouseX()
  ;    *ptrMonster\y = MouseY()
  
  ;put the head of the tail at x,y coords
  *ptrMonster\tail[0]\x = *ptrMonster\x
  *ptrMonster\tail[0]\y = *ptrMonster\y
  
  ;update the tail
  ;basically, the points don't move unless they're further that 7 pixels
  ;from the previous point. this gives the kind of springy effect as the
  ;body stretches
  For i = 1 To *ptrMonster\segments - 1
    
    ;calculate distance between the current point and the previous
    distX = (*ptrMonster\tail[i - 1]\x - *ptrMonster\tail[i]\x)
    distY = (*ptrMonster\tail[i - 1]\y - *ptrMonster\tail[i]\y)
    dist = Sqr(distX * distX + distY * distY)
    
    ;move if too far away
    If dist >= #BLOBSIZE*0.5
      ;the (distX*0.2) bit makes the point move
      ;just 20% of the distance. this makes the
      ;movement smoother, and the point decelerate
      ;as it gets closer to the target point.
      ;try changing it to 1 (i.e 100%) to see what happens
      *ptrMonster\tail[i]\x = *ptrMonster\tail[i]\x + (distX * 0.25)
      *ptrMonster\tail[i]\y = *ptrMonster\tail[i]\y + (distY * 0.25)
    EndIf
    
  Next i
  
EndProcedure


Procedure blobMonsterDraw(*ptrMonster.blobMonster_struct)
  Protected i.i
  Protected ang.f, scale.f
  ;time to draw stuff!
  
  ;this sets the blend mode to LIGHTBLEND, or additive blending, which makes
  ;the images progressively more bright as they overlap
  Sprite3DBlendingMode(5,7)
  
  ;SetColor 0, 200, 150
  
  ;###########
  ;draw the main bit of the body
  ;start by setting the images handle (i.e the origin of the image) to it's center
  ;MidHandleImage blob
  
  ;begin looping through the segments of the body
  For i = 0 To *ptrMonster\segments - 1
    ;set the alpha transparency vaue to 0.15, pretty transparent
    ;SetAlpha 0.15
    
    ;the  (0.5*sin(i*35)) bit basically bulges the size of the images being
    ;drawn as it gets closer to the center of the monsters body, and tapers off in size as it gets
    ;to the end. try changing the 0.5 to a higher number to see the effect.
    ;SetScale 1 + (0.5 * Sin(i * 35)), 1 + (0.5 * Sin(i * 35))
    scale = 1 + (0.5 * Sin(Radian(i * 35)))
    myTransformSprite3D(blobSprite(#CYANBLOB),#BLOBSIZE,#BLOBSIZE,#BLOBSIZE*0.5,#BLOBSIZE*0.5)
    
    ;draw the image
    DisplaySprite3D(blobSprite(#CYANBLOB), *ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, 38.25) ; alpha = 0.15*255.0
    
    ;this next chunk just draws smaller dots in the center of each segment of the body
    ;SetAlpha 0.8
    ;SetScale 0.1, 0.1
    myTransformSprite3D(blobSprite(#CYANBLOB),#BLOBSIZE * 0.1,#BLOBSIZE * 0.1,#BLOBSIZE*0.05,#BLOBSIZE*0.05)
    
    ;draw the image
    DisplaySprite3D(blobSprite(#CYANBLOB), *ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, 204) ; alpha = 0.8*255.0
  Next i
  
  ;#########################
  ;draw little spikes on tail
  ;SetColor 255, 255, 255
  ;note that the x and y scales are different
  ;SetScale 0.6, 0.1
  
  ;move the image handle to halfway down the left edge, this'll make the image
  ;appear to the side of the coordinate it is drawn too, rather than the
  ;center as we had for the body sections
  ;SetImageHandle blob, 0, ImageHeight(blob) / 2
  
  ;rotate the 1st tail image. basically, we're calculating the angle between
  ;the last 2 points of the tail, and then adding an extra wobble (the 10*sin(time*10) bit)
  ;to make the pincer type effect.
  ;SetRotation 10 * Sin(time * 10) + calculateAngle(*ptrMonster\tail[segments - 1]\x, *ptrMonster\tail[segments - 1]\y, *ptrMonster\tail[segments - 5]\x, *ptrMonster\tail[segments - 5]\y) + 90
  myTransformSprite3D(blobSprite(#WHITEBLOB),#BLOBSIZE * 0.6,#BLOBSIZE * 0.1,0,#BLOBSIZE*0.05,Radian(10 * Sin(Radian(*ptrMonster\time * 10)) + calculateAngle(*ptrMonster\tail[*ptrMonster\segments - 1]\x, *ptrMonster\tail[*ptrMonster\segments - 1]\y, *ptrMonster\tail[*ptrMonster\segments - 2]\x, *ptrMonster\tail[*ptrMonster\segments - 2]\y) ))
  DisplaySprite3D(blobSprite(#WHITEBLOB), *ptrMonster\tail[*ptrMonster\segments - 1]\x, *ptrMonster\tail[*ptrMonster\segments - 1]\y, 204) ; alpha = 0.8*255.0
  
  ;second tail image uses negative time to make it move in the opposite direction
  ;SetRotation 10 * Sin(-time * 10) + calculateAngle(*ptrMonster\tail[segments - 1]\x, *ptrMonster\tail[segments - 1]\y, *ptrMonster\tail[segments - 5]\x, *ptrMonster\tail[segments - 5]\y) + 90
  myTransformSprite3D(blobSprite(#WHITEBLOB),#BLOBSIZE * 0.6,#BLOBSIZE * 0.1,0,#BLOBSIZE*0.05,Radian(10 * Sin(Radian(-*ptrMonster\time * 10)) + calculateAngle(*ptrMonster\tail[*ptrMonster\segments - 1]\x, *ptrMonster\tail[*ptrMonster\segments - 1]\y, *ptrMonster\tail[*ptrMonster\segments - 2]\x, *ptrMonster\tail[*ptrMonster\segments - 2]\y) ))
  DisplaySprite3D(blobSprite(#WHITEBLOB), *ptrMonster\tail[*ptrMonster\segments - 1]\x, *ptrMonster\tail[*ptrMonster\segments - 1]\y, 204) ; alpha = 0.8*255.0
  
  
  ;#####################
  ;draw little fins/arms
  ;SetAlpha 1
  
  ;begin looping through the body sections again. Note that we don't want fins
  ;on the first and last section because we want other things at those coords.
  For i = 1 To *ptrMonster\segments - 2
    ;like the bulging body, we want the fins to grow larger in the center, and smaller
    ;at the end, so the same sort of thing is used here.
    ;SetScale 0.1 + (0.6 * Sin(i * 30)), 0.05
    scale = 0.1 + (0.6 * Sin(Radian(i * 30)))
    
    ;rotate the image. We want the fins to stick out sideways from the body (the calculateangle() bit)
    ;and also to move a little on their own. the 33 * Sin(time * 5 + i * 30) makes the
    ;fin rotate based in the i index variable, so that all the fins look like they're moving
    ;one after the other.
    ;SetRotation 33 * Sin(time * 5 + i * 30) + calculateAngle(*ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, *ptrMonster\tail[i - 1]\x, *ptrMonster\tail[i - 1]\y)
    myTransformSprite3D(blobSprite(#WHITEBLOB),#BLOBSIZE * scale,#BLOBSIZE * 0.05,0,#BLOBSIZE*0.025,Radian(33 * Sin(Radian(*ptrMonster\time * 5 + i * 30)) + calculateAngle(*ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, *ptrMonster\tail[i - 1]\x, *ptrMonster\tail[i - 1]\y) - 90))
    DisplaySprite3D(blobSprite(#WHITEBLOB), *ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, 255)
    
    ;rotate the opposte fin, note that the signs have changes (-time and -i*30)
    ;to reflect the rotations of the other fin
    ;SetRotation 33 * Sin(-time * 5 - i * 30) + calculateAngle(*ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, *ptrMonster\tail[i - 1]\x, *ptrMonster\tail[i - 1]\y) + 180
    myTransformSprite3D(blobSprite(#WHITEBLOB),#BLOBSIZE * scale,#BLOBSIZE * 0.05,0,#BLOBSIZE*0.025,Radian(33 * Sin(Radian(-*ptrMonster\time * 5 - i * 30)) + calculateAngle(*ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, *ptrMonster\tail[i - 1]\x, *ptrMonster\tail[i - 1]\y) + 90))
    DisplaySprite3D(blobSprite(#WHITEBLOB), *ptrMonster\tail[i]\x, *ptrMonster\tail[i]\y, 255)
    
  Next i
  
  
  ;###################
  ;center the image handle
  ; MidHandleImage blob
  ;Draw the eyes. These are just at 90 degrees to the head of the tail.
  ; SetColor 255, 0, 0
  ; SetScale 0.6, 0.6
  ; SetAlpha 0.3
  myTransformSprite3D(blobSprite(#REDBLOB),#BLOBSIZE * 0.6,#BLOBSIZE * 0.6,#BLOBSIZE*0.3,#BLOBSIZE*0.3)
  
  ang = calculateangle(*ptrMonster\tail[0]\x, *ptrMonster\tail[0]\y, *ptrMonster\tail[1]\x, *ptrMonster\tail[1]\y)
  DisplaySprite3D(blobSprite(#REDBLOB), *ptrMonster\x + (7 * Cos(Radian(ang - 45))), *ptrMonster\y + (7 * Sin(Radian(ang - 45))),76.5) ; alpha = 0.3*255.0
  DisplaySprite3D(blobSprite(#REDBLOB), *ptrMonster\x + (7 * Cos(Radian(ang + 45))), *ptrMonster\y + (7 * Sin(Radian(ang + 45))),76.5) ; alpha = 0.3*255.0
  
  
  ;   SetColor 255, 255, 255
  ;   SetScale 0.1, 0.1
  ;   SetAlpha 0.5
  myTransformSprite3D(blobSprite(#REDBLOB),#BLOBSIZE * 0.1,#BLOBSIZE * 0.1,#BLOBSIZE*0.05,#BLOBSIZE*0.05)
  
  DisplaySprite3D(blobSprite(#REDBLOB), *ptrMonster\x + (7 * Cos(Radian(ang -45))), *ptrMonster\y + (7 * Sin(Radian(ang - 45))),127.5) ; alpha = 0.5*255.0
  DisplaySprite3D(blobSprite(#REDBLOB), *ptrMonster\x + (7 * Cos(Radian(ang + 45))), *ptrMonster\y + (7 * Sin(Radian(ang + 45))),127.5) ; alpha = 0.5*255.0
  
  ;draw beaky thing
  ;   SetColor 0, 200, 155
  ;   SetScale 0.3, 0.1
  ;   SetAlpha 0.8
  ;   SetImageHandle blob, 0, ImageWidth(blob) / 2
  ;   SetRotation ang + 95
  myTransformSprite3D(blobSprite(#YELLOWBLOB),#BLOBSIZE * 0.3,#BLOBSIZE * 0.1,0,#BLOBSIZE*0.05,Radian(ang))
  DisplaySprite3D(blobSprite(#YELLOWBLOB), *ptrMonster\x, *ptrMonster\y,204) ; alpha = 0.8*255.0
  
  
  ;yellow light
  ;   MidHandleImage blob
  ;   SetColor 255, 255, 0
  ;   SetAlpha 0.2
  ;   SetScale 4, 4
  myTransformSprite3D(blobSprite(#YELLOWBLOB),#BLOBSIZE * 4,#BLOBSIZE * 4,#BLOBSIZE*2,#BLOBSIZE*2)
  DisplaySprite3D(blobSprite(#YELLOWBLOB), *ptrMonster\x, *ptrMonster\y,51) ; alpha = 0.2*255.0
  
  ;Finished!
EndProcedure


;********************************************************
;- --- Main program ---
;********************************************************

;- initialization
InitSprite()
InitSprite3D()
InitKeyboard()
InitMouse()

;- Window
OpenWindow(0, 0, 0, #SCREENWIDTH, #SCREENHEIGHT, "Blob Monster", #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
OpenWindowedScreen(WindowID(0), 0, 0, #SCREENWIDTH,#SCREENHEIGHT, 0, 0, 0,#PB_Screen_SmartSynchronization)

;- Blob image
; As PureBasic can't easily tint a image or a sprite at runtime, we create the needed colored blob sprites here
UsePNGImageDecoder()
blobSprite(#WHITEBLOB) = createBlobSprite(255,255,255)
blobSprite(#REDBLOB) = createBlobSprite(255,0,0)
blobSprite(#YELLOWBLOB) = createBlobSprite(255,255,0)
blobSprite(#CYANBLOB) = createBlobSprite(0,255,255)


; Create a blobMonster object
*test = blobMonsterCreate(10.0, 10.0)

;- Main loop
Repeat
  
  While WindowEvent()
  Wend  
  
  ;update the blobmonster
  blobMonsterUpdate(*test)
  
  ClearScreen(0)
  
  ; Draw the monster
  ; Note: Anything that use Sprite3D must be done between "Start3D()" and "Stop3D()"
  Start3D()
  blobMonsterDraw(*test)
  Stop3D()
  
  ; Display result
  FlipBuffers()
  
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)


End
;Finished!

;- Ressources
; We can insert the blobimage here, so it will be included in the exe when the source is compiled.
DataSection
  blob: IncludeBinary "blob.png"
EndDataSection
Créé le 16 mars 2011  par kelebrindae

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2008 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.