un début de code que j'ai la flemme de continuer :)
Publié : dim. 25/janv./2004 21:09
Je voulais le simplifier avant de le poster , mais ça fait deux week-end que je remets .Alors plutôt que de le laisser dormir sur mon disque dur , autant le mettre ici .
Si j'ai du courage , je le reprendrai pour le commenter et le simplifier.Et surtout améliorer l'affichage pour que ça ne rame pas quand il y a bcp de segments ( en clair éviter d'afficher tous les segments à chaque fois , seulement ceux qui sont utiles )
L'objectif c'était de me faire un petit éditeur pour différentes choses :
par exemple pour tracer des plans d'un batiment , et ensuite calculer les objets pour construire ce batiment en 3D. ( Je l'ai déjà fait dans un autre langage ( l'éditeur était différent , mais le principe de la construction 3D sera la même ), donc c'est possible , faut juste que je m'y mette
Et puis cet éditeur me permet de tracer des chemins sur une map , en construisant un maillage , j'ai déjà fait l'algo de recherche du chemin le plus court sur un maillage .Je ferai une démo à l'occasion ( elle est presque faite , manque plus qu'un truc qui se balade d'un point à un autre , pour l'instant je trace les segments du chemin le plus court en rouge pour le visualiser ).
L'éditeur peut aussi servir à tracer le chemin d'une voiture sur un circuit , etc ...
Les touches
[F1] Sans/Avec l'affichage des points
[F5] Sauvegarde le tracé en cours
[F6] Charge le dernier tracé
[Suppr] Supprime le point sélectionné ( en rouge )
Clic droit de la souris = annule le dernier tracé
Clic droit de la souris maintenu pour déplacer un point
Clic gauche de la souris pour ajouter un point
Si j'ai du courage , je le reprendrai pour le commenter et le simplifier.Et surtout améliorer l'affichage pour que ça ne rame pas quand il y a bcp de segments ( en clair éviter d'afficher tous les segments à chaque fois , seulement ceux qui sont utiles )
L'objectif c'était de me faire un petit éditeur pour différentes choses :
par exemple pour tracer des plans d'un batiment , et ensuite calculer les objets pour construire ce batiment en 3D. ( Je l'ai déjà fait dans un autre langage ( l'éditeur était différent , mais le principe de la construction 3D sera la même ), donc c'est possible , faut juste que je m'y mette

Et puis cet éditeur me permet de tracer des chemins sur une map , en construisant un maillage , j'ai déjà fait l'algo de recherche du chemin le plus court sur un maillage .Je ferai une démo à l'occasion ( elle est presque faite , manque plus qu'un truc qui se balade d'un point à un autre , pour l'instant je trace les segments du chemin le plus court en rouge pour le visualiser ).
L'éditeur peut aussi servir à tracer le chemin d'une voiture sur un circuit , etc ...
Les touches
[F1] Sans/Avec l'affichage des points
[F5] Sauvegarde le tracé en cours
[F6] Charge le dernier tracé
[Suppr] Supprime le point sélectionné ( en rouge )
Clic droit de la souris = annule le dernier tracé
Clic droit de la souris maintenu pour déplacer un point
Clic gauche de la souris pour ajouter un point
Code : Tout sélectionner
;- variables globales
Global NbSommet.b
Global Mode.b
Global SommetMove.l
Global MemMouse.b
Global Affpoint.b
NbSommet = 0
; Mode = 0 > Tracé , Mode = 1 > Sélection
Mode = 0
Affpoint = 1
SommetMove = -1
MemMouse = 0
Dim SommetEnCours(2)
;- Les constantes
#ScreenWidth = 800
#ScreenHeight = 600
#ScreenDepth = 32
#Rayon = 3
#RayonSelect = 7
;/Sprites
#Souris = 0
#Fond = 1
;- Les structures
Structure Sommet
No.l
x.l
y.l
EndStructure
;Je pourrais me contenter du No des sommets et chercher les valeurs x et y dans la liste sommet
Structure Segment
Sommet1.l
X1.l
Y1.l
Sommet2.l
X2.l
Y2.l
Long.l ; Longueur d'un segment ( pour le calcul du chemin le plus court d'un sommet à un autre )
EndStructure
NewList Sommet.Sommet()
NewList Segment.Segment()
;-Fonts
;-Declare procédures
;-Initialisation
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or InitSound() = 0 Or InitSprite3D() = 0
MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
End
ElseIf OpenScreen( #ScreenWidth , #ScreenHeight , #ScreenDepth , "PureSokoban3D" ) = 0
MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 )
End
EndIf
;/Les formes de la souris
;Fleche
CreateSprite(0,32,32)
StartDrawing(SpriteOutput(0))
Box(0,0,5,5,RGB(255,255,255))
LineXY(0,0,SpriteWidth(0),SpriteHeight(0),RGB(255,255,255))
StopDrawing()
;-Procedures
Procedure.l Distance(x.l,y.l)
Sommet.l = -1
ForEach Sommet()
Distance.l = Sqr(Pow(x-Sommet()\x,2)+Pow(y-Sommet()\y,2))
; #Rayon * 2 pour une sélection plus aisée d'un sommet
If Distance <= #Rayon * 2
Sommet = Sommet()\No
Break
EndIf
Next
ProcedureReturn Sommet
EndProcedure
Procedure AddSommet(x.l,y.l)
AddElement(Sommet())
; No unique selon la position sur l'écran
Sommet()\No = x + #ScreenWidth * y
Sommet()\x = x
Sommet()\y = y
EndProcedure
Procedure AddSegment()
AddElement(Segment())
Segment()\Sommet1 = SommetEnCours(1)
Segment()\Sommet2 = SommetEnCours(2)
ForEach Sommet()
If Sommet()\No = SommetEnCours(1)
Segment()\X1 = Sommet()\x
Segment()\Y1 = Sommet()\y
Trouve + 1
EndIf
If Sommet()\No = SommetEnCours(2)
Segment()\X2 = Sommet()\x
Segment()\Y2 = Sommet()\y
Trouve + 1
EndIf
If Trouve = 2
Break
EndIf
Next
EndProcedure
Procedure TestSommet()
Sommet = Distance(MouseX(),MouseY())
If Sommet < 0
If SegmentEnCours = #True
AddSegment()
EndIf
AddSommet(MouseX(),MouseY())
Else
SegmentEnCours = #True
SommetEnCours = Sommet
EndIf
EndProcedure
Procedure AffSommet()
ForEach Sommet()
StartDrawing(ScreenOutput())
Circle(Sommet()\x,Sommet()\y,#Rayon,RGB(255,255,55))
StopDrawing()
Next
EndProcedure
Procedure AffSegment()
ForEach Segment()
StartDrawing(ScreenOutput())
LineXY(Segment()\X1,Segment()\Y1,Segment()\X2,Segment()\Y2,RGB(255,255,255))
StopDrawing()
Next
EndProcedure
Procedure AffSegmentEnCours()
ForEach Sommet()
If Sommet()\No = SommetEnCours(NbSommet)
x = Sommet()\x
y = Sommet()\y
Break
EndIf
Next
StartDrawing(ScreenOutput())
LineXY(x,y,MouseX(),MouseY(),RGB(255,255,255))
StopDrawing()
EndProcedure
Procedure Sauvegarde()
CreateFile(0,"Sommets.hd")
ForEach Sommet()
WriteLong(Sommet()\No)
WriteLong(Sommet()\x)
WriteLong(Sommet()\y)
Next
CloseFile(0)
CreateFile(0,"Segment.hd")
ForEach Segment()
WriteLong(Segment()\Sommet1)
WriteLong(Segment()\X1)
WriteLong(Segment()\Y1)
WriteLong(Segment()\Sommet2)
WriteLong(Segment()\X2)
WriteLong(Segment()\Y2)
;WriteLong(Segment()\Long)
Next
CloseFile(0)
ForEach Segment()
Debug Segment()\Sommet1
Debug Segment()\Sommet2
Next
EndProcedure
Procedure Charge()
If OpenFile(0,"Sommets.hd")
ClearList(Sommet())
While Eof(0)=0
AddElement(Sommet())
Sommet()\No = ReadLong()
Sommet()\x = ReadLong()
Sommet()\y = ReadLong()
Wend
CloseFile(0)
If OpenFile(0,"Segment.hd")
ClearList(Segment())
While Eof(0)=0
AddElement(Segment())
Segment()\Sommet1 = ReadLong()
Segment()\X1 = ReadLong()
Segment()\Y1 = ReadLong()
Segment()\Sommet2 = ReadLong()
Segment()\X2 = ReadLong()
Segment()\Y2 = ReadLong()
;Segment()\Long = ReadLong()
Wend
CloseFile(0)
EndIf
EndIf
EndProcedure
;/
;-Boucle principale
;/
Repeat
ClearScreen(0,0,0)
ExamineMouse()
ExamineKeyboard()
;/Affiche le dessin
If Affpoint
AffSommet()
EndIf
AffSegment()
;/Affiche Sans/Avec Points
If KeyboardReleased(#PB_Key_F1)
Affpoint = 1 - Affpoint
EndIf
;/Sauvegarde
If KeyboardReleased(#PB_Key_F5)
Sauvegarde()
EndIf
;/Charge
If KeyboardReleased(#PB_Key_F6)
Charge()
EndIf
;/Ajoute un sommet
If MouseButton(1) And Mode = 0 And MemMouse = 0
Sommet = Distance(MouseX(),MouseY())
If Sommet < 0
AddSommet(MouseX(),MouseY())
Sommet = Sommet()\No
EndIf
NbSommet + 1
SommetEnCours(NbSommet) = Sommet
If NbSommet = 2
AddSegment()
NbSommet = 1
SommetEnCours(NbSommet) = Sommet
EndIf
MemMouse = 1
EndIf
If MouseButton(1) = 0
MemMouse = 0
EndIf
;Affiche le sommet sélectionné
If CountList(Sommet())>0
SommetSelect = -1
SommetSelect = Distance(MouseX(),MouseY())
If SommetSelect >=0
StartDrawing(ScreenOutput())
DrawingMode(4)
Circle(Sommet()\x,Sommet()\y,#RayonSelect,RGB(255,55,55))
StopDrawing()
;/Change mode
If MouseButton(2)
Mode = 1
Else
Mode = 0
EndIf
;/Supprime le sommet
If KeyboardReleased(#PB_Key_Delete)
ForEach Segment()
If Segment()\Sommet1 = SommetSelect Or Segment()\Sommet2 = SommetSelect
DeleteElement(Segment())
EndIf
Next
ForEach Sommet()
If Sommet()\No = SommetSelect
DeleteElement(Sommet())
Break
EndIf
Next
EndIf
EndIf
EndIf
;/Déplace un sommet
If MouseButton(2) And Mode = 1
If SommetMove = -1
SommetMove = Distance(MouseX(),MouseY())
If SommetMove >= 0
ForEach Segment()
If Sommet()\No = SommetMove
SommetMove = ListIndex(Sommet())
Break
EndIf
Next
EndIf
EndIf
If SommetMove>=0
SelectElement(Sommet(),SommetMove)
Sommet()\x = MouseX()
Sommet()\y = MouseY()
ForEach Segment()
If Segment()\Sommet1 = Sommet()\No
Segment()\X1 = Sommet()\x
Segment()\Y1 = Sommet()\y
EndIf
If Segment()\Sommet2 = Sommet()\No
Segment()\X2 = Sommet()\x
Segment()\Y2 = Sommet()\y
EndIf
Next
EndIf
Else
SommetMove = -1
EndIf
;/Supprime un sommet
If MouseButton(2)
If NbSommet = 1
NbSommet = 0
;Cherche si sommet en cours
Trouve = #False
ForEach Segment()
If Segment()\Sommet1 = SommetEnCours(1) Or Segment()\Sommet2 = SommetEnCours(1)
Trouve = #True
Break
EndIf
Next
If Trouve = #False
ForEach Sommet()
If Sommet()\No = SommetEnCours(1)
DeleteElement(Sommet())
Break
EndIf
Next
EndIf
EndIf
EndIf
;/Segment en cours
If NbSommet
AffSegmentEnCours()
EndIf
;/Souris
DisplayTransparentSprite(#Souris,MouseX(),MouseY())
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)