# Sources PureBasicConsultez toutes les sources

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

Sommaire→Jeux/Démos

- Poursuite d'un point
- Création d'un éditeur de cartes pour le jeu "Medieval II : Total War"
- Morpion solitaire
- Démonstration avec DrawRotatedText et GradientColor
- Collision par la méthode de l'axe séparateur
- Démonstration graphique : Floor Casting
- Démonstration graphique : interférence de cercles
- Jeu : Un autre sokoban (avec le code source très commenté pour les débutants)
- Remplissage de polygones
- Démo sprite3D - Vol libre dans un champ d'étoiles
- Moteur physique 2D basé sur la méthode de "l'intégration de Verlet"
- Rotations 3D absolues et relatives (Pivot)
- Un petit jeu dans une console : ascii hero (jump'n'run)
- Création d'un Blob Monster

Version hors-ligne
Poursuite d'un point
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
Création d'un éditeur de cartes pour le jeu "Medieval II : Total War"

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 :

Editeur de geomod
Créé le 28 octobre 2008 par Octavius

Téléchargez le zip

Morpion solitaire

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

Démonstration avec DrawRotatedText et GradientColor

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
Collision par la méthode de l'axe séparateur

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
Démonstration graphique : Floor Casting
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
Démonstration graphique : interférence de cercles

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
Jeu : Un autre sokoban (avec le code source très commenté pour les débutants)

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

Remplissage de polygones
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
Démo sprite3D - Vol libre dans un champ d'étoiles

[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
Moteur physique 2D basé sur la méthode de "l'intégration de Verlet"

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

Rotations 3D absolues et relatives (Pivot)

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
Un petit jeu dans une console : ascii hero (jump'n'run)
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
Création d'un Blob Monster

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).

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
Version hors-ligne

Les sources présentés sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une œuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2008 Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et 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.