Sources PureBasic
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
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()
EndProcedureCréé 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 :
Créé le 28 octobre 2008 par Octavius
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
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) & 32768Créé 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
EndProcedureCréé 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 )
EndCréé 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
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_CloseWindowCréé 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()
EndCréé 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
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:
EndDataSectionCréé 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).
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"
EndDataSectionCréé le 16 mars 2011 par kelebrindae