Re: PURE BASIC - Le Topic officiel

[Dobro]

voici les bases d'un "Tron


nous sommes le trait violet , on ne touche qu'au sens de déplacement
avec les touches Flechées horizontales (droite/gauche) , ça fait tourner le Tron
le but etant bien sur d'eviter de toucher son propre mur , et le Mur Adverse , le mur se creer au deplacement

sur le bord de la carte vous y trouverez des sens indiqué par des fleches
ils montrent que si on laisse notre Tron cogner contre le mur jaune, il tournera tout seul en automatique , j'ai ajouté cette possibilité, car c'est deja pas evident de jouer avec cette avantage ...  

c'est le genre de petit jeux con , qui l'air de rien peut nous faire passer 5 minutes ...
voici le code :  (il y a meme des Goto pour les Fans du Old-school    )

Code:



; Version Purebasic V5.70
; Tron  creé Par Dobro  V3.5.2 avec score (non sauvegardé)
; pour le sens j'ai choisi

;le sens des aiguilles d'une montre en commencant par midi

;sens=1  : monte ver midi
;sens=2  : va a droite vers 3 heures
;sens=3 : descend vers 6 heures
;sens=4 : va a gauche vers 9 heures
;(c'est le langage utilise dans l'aviation)
; "fait gaffe a tes 6 heures"
; veut dire qu vous avez quelqu'un derriere vous !!

; la variable pos c'est pareil mais pour le joueur
;pos=1 en haut ect..

Declare tir(sens)
Global xordi,yordi,ymissille,tir
#dobro=1
#Police=1
#ordi=1
#joueur=2
#test=3
#missordih=4
#missordiv=5
#missordihoff=6
#missordivoff=7
missordi=3
InitKeyboard() :; j'espere qu'il y a un clavier au moins !!
vitesse=10
vitessejoueur=10

Declare test_coul(x)
; ***********************************
Resultat = InitSprite()
FontID = LoadFont(#Police, "arial", 9 ,#PB_Font_Bold )
EcranX = GetSystemMetrics_(#SM_CXSCREEN):;=largeur de l'ecran
EcranY = GetSystemMetrics_(#SM_CYSCREEN):;=hauteur de l'ecran
WindowID = OpenWindow(1, 0, 0, 800, 600, "TRON Par Dobro", #PB_Window_SystemMenu|#PB_Window_BorderLess |#PB_Window_ScreenCentered )
WindowID = WindowID(1)
Result = OpenWindowedScreen(WindowID,0,0, 800, 600, 1, 0,0)
SetFrameRate(60)

CreateSprite(#ordi, 10,10 )
CreateSprite(#joueur, 10,10)
CreateSprite(#test, 10,10)

CreateSprite(#missordih, 10,10)
StartDrawing(SpriteOutput(#missordih) )
 Box(0, 4, 10,8, RGB(0,255, 0))
StopDrawing()
CreateSprite(#missordihoff, 12,12)
StartDrawing(SpriteOutput(#missordihoff) )
 Box(0, 0, 12,12, RGB(0,0,0))  :;            METTRE RGB(255,0,255)
StopDrawing()


CreateSprite(#missordiv, 10,10)
StartDrawing(SpriteOutput(#missordiv) )
 Box(4,0,8,10, RGB(0,255, 0))
StopDrawing()

CreateSprite(#missordivoff, 12,12)
StartDrawing(SpriteOutput(#missordivoff) )
 Box(0,0,12,12, RGB(0,0, 0))
StopDrawing()

CreateSprite(#test, 10,10)
StartDrawing(SpriteOutput(#test) )
 Box(0,0,10,10, RGB(255,255, 255))
StopDrawing()
;CreateSprite(#missillejoueurh, 10,10)
;CreateSprite(#missillejoueurv, 10,10)




StartDrawing(SpriteOutput(#ordi) )
 Box(0, 0, 10,10 , RGB(255,0, 0))
StopDrawing()
StartDrawing(SpriteOutput(#joueur) )
 Box(0, 0, 10, 10 , RGB(0,0, 255))
StopDrawing()

debut:
rouge=50
vert=50
Bleu=50
score$="HUMAN="+Str(scorehuman)+" TRON ="+Str(scoretron)
SetWindowTitle(1, score$)

;- dessin du cadre exterieur
StartDrawing(ScreenOutput())
 Box(0, 0, 800,600 , RGB(255,255,0))
StopDrawing()
StartDrawing(ScreenOutput())
 Box(20, 20, 760,560 , RGB(0,0,0))
 FrontColor(RGB(255,255, 0))
 BackColor(RGB(0,0,0))
 DrawingFont(FontID)
 
 
 DrawText(350,-5,"<------------")
 DrawText(350,585,"<------------")  
 DrawText(4,280,"|")
 DrawText(4,290,"|")
 DrawText(4,300,"|")
 DrawText(4,310,"|")
 DrawText(3,320,"v")  
 DrawText(790,280,"^")
 DrawText(792,290,"|")
 DrawText(792,300,"|")
 DrawText(792,310,"|")
 DrawText(792,320,"|")
StopDrawing()
Couleurjoueur=0
xordi=450:; placement du sprite reserve a l'ordi
yordi=200 :; pareil en y
xjoueur=300 :; placement du sprite reserve au joueur
yjoueur=300 :; pareil en y
de=Random(1000):; ceci va determiner un depart aleatoire,vers le haut,le bas,a droite,a gauche)
RandomSeed(de)
pos=Random(3)+1
de=Random(1000)
RandomSeed(de)
sens=Random(3)+1 :; pareil mais pour l'ordi
;sens=4
Repeat
 Delay(50)
 Event=WindowEvent()
 ExamineKeyboard()
 ; If KeyboardPushed( #PB_Key_Up )  
 If  pos=1:; monte
 yjoueur-vitessejoueur
 StartDrawing( ScreenOutput())
 Couleurjoueur = Point(xjoueur, yjoueur)
 Couleurjoueurg = Point(xjoueur-4, yjoueur)
 Couleurjoueurd = Point(xjoueur+14, yjoueur)
 
 StopDrawing()
 touche=test_coul(Couleurjoueur)
 If touche=2
 Goto su
 EndIf
 EndIf
 If pos=2:;droite
 xjoueur+vitessejoueur
 StartDrawing( ScreenOutput())
 Couleurjoueur = Point(xjoueur, yjoueur)
 Couleurjoueurg = Point(xjoueur, yjoueur-4)
 Couleurjoueurd = Point(xjoueur, yjoueur+14)
 StopDrawing()
 touche=test_coul(Couleurjoueur)
 If touche=2
 Goto su
 EndIf
 EndIf
 If pos=3:;bas
 yjoueur+vitessejoueur
 StartDrawing( ScreenOutput())
 Couleurjoueur = Point(xjoueur, yjoueur)
 Couleurjoueurg = Point(xjoueur-2, yjoueur)
 Couleurjoueurd = Point(xjoueur+14, yjoueur)
 StopDrawing()
 touche=test_coul(Couleurjoueur)
 If touche=2
 Goto su
 EndIf
 EndIf
 If  pos=4:;gauche
 xjoueur-vitessejoueur
 StartDrawing( ScreenOutput())
 Couleurjoueur = Point(xjoueur, yjoueur)
 Couleurjoueurg = Point(xjoueur, yjoueur+14)
 Couleurjoueurd = Point(xjoueur, yjoueur-4)
 StopDrawing()
 touche=test_coul(Couleurjoueur)
 If touche=2
 Goto su
 EndIf
 EndIf
 ;EndIf
 
 ;***************ASSISTANCE POUR LES PAROIS EXTERIEURs *****************
 Gosub assistance_mur
 
 ;********************************
 
 If KeyboardReleased( #PB_Key_Left  )
 touche=test_coul(Couleurjoueur)
 If touche=2
 Goto su
 EndIf
 pos-1:dob=1
 If pos<1
 pos=4
 EndIf
 EndIf
 If KeyboardReleased(  #PB_Key_Right  )
 touche=test_coul(Couleurjoueur)
 If touche=2
 Goto su
 EndIf
 pos+1:dob=1
 If pos>4
 pos=1
 EndIf
 EndIf
 ; EndIf
 ; ******************** ordi avance *******************************
 ;-Ordi Avance
 ;sens=Random(4)+1
 Select sens
 Case 1 :
 ;-  il monte
 StartDrawing( ScreenOutput())
 Couleur1 = Point(xordi, yordi-4) :;test en haut
 Couleur2 = Point(xordi-4, yordi) :;test a gauche
 Couleur3 = Point(xordi+14, yordi) :;test a droite
 StopDrawing()
 ;DisplaySprite(#test, xordi, yordi-12)
 
 If Couleur1>0 And Couleur2>0 And Couleur3>0 :; tout autour c'es colore , donc c'est perdu
 toucheordi=1
 Goto su
 EndIf
 ; detection d'une couleur devant mais test si ordi peut passer a droite ou a gauche
 If Couleur1>0 :; ya une couleur devant (donc un mur)
 If Couleur3=0 And Couleur2=0 :; a droite et a gauche on peut passer
 dede=Random(2)+1:; on tire a hazard droite ou gauche
 If dede=1
 sens=4:; on part a gauche
 Goto su
 EndIf
 If dede=2
 sens=2:; on part a droite
 Goto su
 EndIf
 EndIf
 If Couleur3=0 :; il n'y a qu'a droite que c'est libre
 sens=2:; alors on y va
 Goto su
 EndIf
 If Couleur2=0:;si a gauche ya pas de couleur (c'est libre)
 sens=4 :;on va a gauche
 Goto su
 EndIf
 EndIf
 
 If  yordi>25 :; inverse la coordonee pour inverser le sens de deplacement
 yordi-vitesse
 Else
 sens=2
 EndIf
 Case 2:
 ;- il va a droite
 StartDrawing( ScreenOutput())
 Couleur1 = Point(xordi+13, yordi) :;test a droite
 Couleur2 = Point(xordi, yordi-4) :;test en haut
 Couleur3 = Point(xordi, yordi+14) :;test en bas
 StopDrawing()
 
 If Couleur1>0 And Couleur2>0 And Couleur3>0
 toucheordi=1
 Goto su
 EndIf
 If Couleur1>0
 If Couleur2=0 And Couleur3=0
 dede=Random(2)+1
 If dede=1
 sens=3
 Goto su
 EndIf
 If dede=2
 sens=1
 Goto su
 EndIf
 
 EndIf
 If Couleur2=0
 sens=1
 Goto su
 EndIf
 If Couleur3=0
 sens=3
 Goto su
 EndIf
 
 EndIf
 If xordi<=760
 xordi+vitesse
 Else
 sens=3
 EndIf
 Case 3:
 ;- il descend
 StartDrawing( ScreenOutput())
 Couleur1 = Point(xordi, yordi+14) :;test en bas
 Couleur2 = Point(xordi+14, yordi) :;test a droite
 Couleur3 = Point(xordi-4, yordi) :;test a gauche
 StopDrawing()
 If Couleur1>0 And Couleur2>0 And Couleur3>0
 toucheordi=1
 Goto su
 EndIf
 If Couleur1>0
 If Couleur3=0 And Couleur2=0
 dede=Random(2)+1
 If dede=1
 sens=2
 Goto su
 EndIf
 If dede=2
 sens=4
 Goto su
 EndIf
 
 EndIf
 If Couleur3=0
 sens=4
 Goto su
 EndIf
 If Couleur2=0
 sens=2
 Goto su
 EndIf
 
 EndIf
 
 If  yordi<570
 yordi+vitesse
 Else
 sens=4
 EndIf
 Case 4:
 ;- il va a gauche
 
 StartDrawing( ScreenOutput())
 Couleur1 = Point(xordi-4, yordi) :;test a gauche
 Couleur2 = Point(xordi, yordi-4) :;test en haut
 Couleur3 = Point(xordi, yordi+14) :;test en bas
 StopDrawing()
 
 If Couleur1>0 And Couleur2>0 And Couleur3>0
 toucheordi=1
 Goto su
 EndIf
 If Couleur1>0
 If Couleur2=0 And Couleur3=0
 dede=Random(2)+1
 If dede=1
 sens=3
 Goto su
 EndIf
 If dede=2
 sens=1
 Goto su
 EndIf
 
 EndIf
 If Couleur2=0
 sens=1
 Goto su
 EndIf
 If Couleur3=0
 sens=3
 Goto su
 EndIf
 EndIf
 If xordi>20
 xordi-vitesse
 Else
 sens=1
 EndIf
 EndSelect
 ; Couleur = Point(xordi, yordi)
 ; rouge =255
 ; bleu = 16711680
 ;vert = 65280
 su:
 Gosub message_gagne_perdu
 
 
 ;********* tir missille
 ;If yordi=yjoueur Or xordi=xjoueur
 ;sens=2
 ;If sens=2
 ;tir=1
 ;EndIf
 
 ;If cont<20
 ;   cont+1
 ; tir=0
 ;Else
 ;   cont=0
 ;  tir=1
 ; sens=4
 ;EndIf
 
 
 
 
 
 
 ; If tir=1 And sens=4
 ;  
 ;   ThreadID = CreateThread(@tir(),4)
 ;WaitThread(ThreadID)
 ;  ; tir(1)
 ;EndIf
 
 
 
 DisplaySprite(#ordi, xordi , yordi )
 DisplaySprite(#joueur, xjoueur , yjoueur )
 
 
 
 FlipBuffers():; affiche l'ecran
 ;ClearScreen(0, 0, 0) :;efface l'ecran
 
 
 
 rouge+1
 ;************** couleur *************
 StartDrawing(SpriteOutput(#ordi) )
 ;If Rouge>255:Bleu+1:EndIf
 ;If Bleu>255:Vert+1:EndIf
 ;If Vert>255:Rouge+1:EndIf
 rouge=Random(55)+200
 coul= RGB(rouge, 100, 50)
 Box(0, 0, 10,10 , coul)
 StopDrawing()
 StartDrawing(SpriteOutput(#joueur) )
 ;If Rouge>255:Bleu+1:EndIf
 ;If Bleu>255:Vert+1:EndIf
 ;If Vert>255:Rouge+1:EndIf
 Bleu=Random(55)+200
 coul= RGB(150, 0, Bleu)
 Box(0, 0, 10,10 , coul)
 StopDrawing()
 ;************************************
 
 
Until Event=#PB_Event_CloseWindow
End

Procedure test_coul(Couleurjoueur)
 ;255=rouge
 ;16711680=bleu
 ;65280 =vert
 If Couleurjoueur>0 Or Couleurjoueur>0 Or Couleurjoueur>0
 touche=2
 Else
 touche=0
 EndIf
 ProcedureReturn touche
 
EndProcedure


Procedure tir(valeur)
 Shared yordi,xordi,ymissille
 If valeur=1
 While yordi-ymissille>40
 ymissille+5
 DisplaySprite(#missordiv,xordi, yordi-20-ymissille):; affiche le missile
 DisplaySprite(#missordivoff,xordi, yordi-10-ymissille):; affiche le missile
 
 
 FlipBuffers():; affiche l'ecran
 Wend
 tir=0
 DisplaySprite(#missordivoff,xordi, yordi-10-ymissille)
 FlipBuffers():; affiche l'ecran
 
 EndIf
 If valeur=3
 While yordi+ymissille<560
 ymissille+5
 DisplaySprite(#missordiv,xordi, yordi+20+ymissille):; affiche le missile
 DisplaySprite(#missordivoff,xordi, yordi+10+ymissille):; affiche le missile
 
 FlipBuffers():; affiche l'ecran
 Wend
 DisplaySprite(#missordivoff,xordi, yordi+10+ymissille)
 FlipBuffers():; affiche l'ecran
 tir=0
 EndIf
 ;
 
 If valeur=4
 copiy=yordi
 While xordi-xmissille>30
 xmissille+10
 DisplaySprite(#missordih,xordi-20-xmissille,copiy ):; affiche le missile
 DisplaySprite(#missordihoff,xordi-1-xmissille,copiy ):; efface le missile
 
 FlipBuffers():; affiche l'ecran
 Wend
 ;DisplaySprite(#missordihoff,xordi-xmissille,copiy )
 ;DisplaySprite(#missordihoff,xordi-xmissille-10,copiy )
 DisplaySprite(#missordihoff,xordi-xmissille-20,copiy )
 FlipBuffers():; affiche l'ecran
 tir=0
 EndIf
 
 
 If valeur=2
 copiy=yordi
 While xordi+xmissille<760
 xmissille+10
 DisplaySprite(#missordih,xordi+20+xmissille,copiy ):; affiche le missile
 DisplaySprite(#missordihoff,xordi+1+xmissille,copiy ):; efface le missile
 
 FlipBuffers():; affiche l'ecran
 Wend
 ;DisplaySprite(#missordihoff,xordi+xmissille,copiy )
 ; DisplaySprite(#missordihoff,xordi+xmissille+10,copiy )
 DisplaySprite(#missordihoff,xordi+xmissille+20,copiy )
 FlipBuffers():; affiche l'ecran
 tir=0
 EndIf
EndProcedure

;{message_gagne_perdu
message_gagne_perdu:
If toucheordi=1
 toucheordi=0
 
 MessageRequester("Tron", "Tron a perdu", #PB_MessageRequester_Ok )
 ClearScreen(RGB(0, 0, 0)) :;efface l'ecran
 scorehuman+1
 Goto debut
EndIf
If touche=2
 touche=0
 MessageRequester("Tron", "Tron a Gagné", #PB_MessageRequester_Ok )
 ClearScreen(RGB(0, 0, 0)) :;efface l'ecran
 scoretron+1
 Goto debut
EndIf
Return
;}

;{ assistance_mur :
assistance_mur:
If xjoueur-vitessejoueur<15 And Couleurjoueurg=0 And pos=4
 pos=3
EndIf
If xjoueur-vitessejoueur<15 And Couleurjoueurd=0 And pos=4
 pos=1
EndIf
If xjoueur-vitessejoueur>750 And Couleurjoueurg=0 And pos=2
 pos=1
EndIf
If xjoueur-vitessejoueur>750 And Couleurjoueurd=0 And pos=2
 pos=3
EndIf
;
If yjoueur-vitessejoueur<20 And Couleurjoueurg=0 And pos=1
 pos=4
EndIf
If yjoueur-vitessejoueur<20 And Couleurjoueurd=0 And pos=1
 pos=2
EndIf
If yjoueur-vitessejoueur>550 And Couleurjoueurg=0 And pos=3
 pos=4
EndIf
If yjoueur-vitessejoueur>550 And Couleurjoueurd=0 And pos=3
 pos=2
EndIf
Return
;}
; Epb
;



[Tryphon]

Un truc super sympa que j'avais vu sur ce jeu, c'est de faire jouer l'ordi de façon correcte...

[Dobro]

Un truc super sympa que j'avais vu sur ce jeu, c'est de faire jouer l'ordi de façon correcte...

ben ici l'ordi joue contre nous

[Tryphon]

Correctement ?

[Dobro]

Correctement ?

crois moi, c'est deja bien assez difficile comme ça .. on ne gagne pas toujours
le but c'est de pouvoir gagner aussi

[drfloyd]

Un truc super sympa que j'avais vu sur ce jeu, c'est de faire jouer l'ordi de façon correcte...

Oui tout le challenge est là, et c'est passionnant de réfléchir sur ce type de problème qui parait simple mais qui ne l'est pas du tout.

[drfloyd]

j'ai quasi terminé ma premiere démo en PURE

Je vais maintenant tenter de faire une super compilation du tout en suivant les conseils du professeur Dobro.

[Dobro]

voici encore un autre exemple que je vous ai concocté
ici c'est une clone de Candy Crush  , le but etant de faire alligner en horizontale
ou en vertical 3 elements idendiques pour les faire disparaitre ...
UTILISATION :
on clique sur l'un des deux sprites a permuter , et on clique sur le lieu d'arrivée (case adjacente horizontale ou verticale.. (un beep a lieu a chaque fois qu'un clique est effectué , j'utilise l'API BEEP_() si vous avez une version demo de Purebasic
ça va pas le faire , alors mettez cette fonction en Rem ex :  ;BEEP_()
vous n'aurez plus le son du click mais le jeux marchera ...

le jeux type "Passe-temp" par excellence , pour les gens qui vraiment doivent s'emmerder dans l’existence , pour n'avoir que ça a faire  

bon voici un screen histoire de vous mettre l'eau a la bouche du jeux de l'année


et voici le code en Purebasic , notez que vous pourrez lancer le code
alors que vous ne disposez pas des graphique des sprites
parceque j'utilise la possibilité de Purebasic d'allez chercher les images sur mon site
ça evite d'avoir a distribuer tout un tas de fichiers...  

le code :

Code:



;***********************************************
;Titre  :*candy_crush_test
;Auteur  : Dobro
;Date  :09/11/2016
;Heure  :19:52:40
;Version Purebasic :  PureBasic 5.50 (Windows - x64)
;Version de l'editeur :EPB V2.64
; Libairies necessaire : Aucune
;***********************************************
; ToDo
; verifier le compteur de points ......(un peu moins severe au clique)
; voir le click pour depart, et clique pour arrivée !!
;

UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
Declare open_window()
Declare creation_map()
Declare echange_vertical(lx,ly)
Declare renvoi_numero_image(lx,ly)
Declare echange_horizontal(lx,ly)
Declare dessin()
Declare supr_horizontal()
Declare supr_vertical()
Declare supr_noirs()
Declare generation_premiere_ligne()
Declare anime_vertical_noir(lx,ly)
Declare anime_vertical(lx,ly)
Declare anime_horizontal(lx,ly)
Declare windowcallback(windowid, message, wparam, lparam)
Declare.l loadimage_net(num,adr$,nom_fichier$)


Enumeration
 #Win ; numero de la fenetre
 #Button_init ; numero du bouton
 #Titre
 #fonte_titre
 #Auteur
 #Score
 #T_Score
 #titre_up
 #Vert
 #Horiz
 #Container
EndEnumeration
Enumeration
 #image_noir
 #image_rouge
 #image_vert
 #image_bleu
 #image_jaune
 #image_veraune
EndEnumeration
Enumeration
 #Sprite_noir
 #Sprite_rouge
 #Sprite_vert
 #Sprite_bleu
 #Sprite_jaune
 #sprite_veraune
EndEnumeration
InitMouse()
if InitSprite()=0
 MessageRequester("erreur","pas pu initialiser les sprites")
 End
Endif
Global x_larg=640
Global y_haut=384
Global Flag=#False
GLobal Score.i =250
Global Flag_start
Global flag_touche=1
Global dim colonne$(20)
Global Flag_click=0,mem_x,mem_x2,mem_y,mem_y2
Open_Window() ; appel de la procedure qui ouvre la fenetre
; ****** creation des sprites *********
; couleurs
; noir=rgb(0,0,0);0
; rouge=rgb(255,0,0) ;1
; vert=rgb(0,255,0);2
; bleu=rgb(0,0,255);3
; jaune=rgb(255,255,0);4
;
; Createimage(#image_noir,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_noir)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,noir)
; StopDrawing()

; Createimage(#image_rouge,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_rouge)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,rouge)
; StopDrawing()
; Createimage(#image_vert,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_vert)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,vert)
; StopDrawing()
; Createimage(#image_bleu,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_bleu)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,bleu)
; StopDrawing()
; Createimage(#image_jaune,32,32) ; creation d'une cellule vide (un sprite)
; StartDrawing( imageOutput(#image_jaune)) ; on va dessiner dans notre sprite un carre coloré
; Box(1,1,32,32,jaune)
; StopDrawing()
; random
Global Dim Ligne$(15)
;***********************Mode Local ***************
;LoadImage(#image_noir,"Picture0.png") :ResizeImage(#image_noir,32,32)
;LoadImage(#image_rouge,"Picture1.png") :ResizeImage(#image_rouge,32,32)
;LoadImage(#image_rouge,"Picture1.png") :ResizeImage(#image_rouge,32,32)
;LoadImage(#image_vert,"Picture2.png"):ResizeImage(#image_vert,32,32)
;LoadImage(#image_bleu,"Picture3.png"):ResizeImage(#image_bleu,32,32)
;LoadImage(#image_jaune,"Picture4.png"):ResizeImage(#image_jaune,32,32)
;
; ******************************* Mode Internet ***********************************

loadimage_net(#image_noir,"http://michel.dobro.free.fr/Bank_images/Candy_cruch/","Picture0.png")
loadimage_net(#image_rouge,"http://michel.dobro.free.fr/Bank_images/Candy_cruch/","Picture1.png")
loadimage_net(#image_vert,"http://michel.dobro.free.fr/Bank_images/Candy_cruch/","Picture2.png")
loadimage_net(#image_bleu,"http://michel.dobro.free.fr/Bank_images/Candy_cruch/","Picture3.png")
loadimage_net(#image_jaune,"http://michel.dobro.free.fr/Bank_images/Candy_cruch/","Picture4.png")
loadimage_net(#image_veraune,"http://michel.dobro.free.fr/Bank_images/Candy_cruch/","Picture5.png")
;
ResizeImage(#image_noir,32,32)
ResizeImage(#image_rouge,32,32)
ResizeImage(#image_vert,32,32)
ResizeImage(#image_bleu,32,32)
ResizeImage(#image_jaune,32,32)
ResizeImage(#image_veraune,32,32)
;
; *********************************************************************
; Createsprite(#Sprite_noir,64,64)
; StartDrawing(SpriteOutput(#Sprite_noir))
; DrawImage(ImageId(#image_noir),1,1)
; StopDrawing()
Createsprite(#Sprite_rouge,32,32)
StartDrawing(SpriteOutput(#Sprite_rouge))
 DrawImage(ImageId(#image_rouge),1,1)
StopDrawing()
Createsprite(#Sprite_vert,32,32)
StartDrawing(SpriteOutput(#Sprite_vert))
 DrawImage(ImageId(#image_vert),1,1)
StopDrawing()
Createsprite(#Sprite_bleu,32,32)
StartDrawing(SpriteOutput(#Sprite_bleu))
 DrawImage(ImageId(#image_bleu),1,1)
StopDrawing()
Createsprite(#Sprite_jaune,32,32)
StartDrawing(SpriteOutput(#Sprite_jaune))
 DrawImage(ImageId(#image_jaune),1,1)
StopDrawing()
Createsprite(#sprite_veraune,32,32)
StartDrawing(SpriteOutput(#sprite_veraune))
 DrawImage(ImageId(#image_veraune),1,1)
StopDrawing()

Creation_map()

Repeat ; boucle principale , qui gere les affichages dans l'ecran graphique et les evenement de la fenetre
 event=WaitWindowEvent(5) ; attends de recevoir un evenements de la fenetre
 WindowID = EventWindow() ;
 EventType = EventType() ;
 select  event
 ; ********************************* regarde les evenements de gadget ***************************
 Case #PB_Event_Gadget
 Select EventGadget()
 Case #Button_init ; on a appuyé sur le bouton..!!
 Creation_map()
 Case #vert
 Case #horiz
 EndSelect
 Case  #PB_Event_CloseWindow
 End
 Endselect
 ; ****************************************************************************
 supr_horizontal()
 supr_vertical()
 supr_noirs()
 generation_premiere_ligne()
 ;***************************************
 ; *****************************************
Forever
End
;
;- Zone Procedures
Procedure Open_Window()
 ;-Open_Window()
 If OpenWindow(#Win, 20, 50, 640,  600, "Fish",  #PB_Window_SystemMenu |  #PB_Window_TitleBar ) ; on ouvre une fenetre
 SmartWindowRefresh(#Win, #true)
 TextGadget(#Titre, 250, 10, 100, 40, "Fish",#PB_Text_Center)
 If LoadFont(#fonte_titre, "Arial", 24)
 SetGadgetFont(#Titre, FontID(#fonte_titre))   ; la police par défaut est remplacée par celle chargée (Arial 16)
 EndIf
 TextGadget(#Auteur, 350, 30, 100, 20, "By Zorro",#PB_Text_Center)
 TextGadget(#T_Score, 10, 50, 50, 20, "Score :",#PB_Text_Center)
 TextGadget(#Score, 60, 50, 100, 20, "0000",#PB_Text_Center)
 OpenWindowedScreen(windowID(#Win), 1, 100, x_larg, y_haut, 0, 1, 1) ; on creer un ecran graphique dedans
 ButtonGadget(#Button_init, 30, 500, 100, 30, "Reinitialisation")  ; on suprime les series de 3 horizontal et on compress
 ; ContainerGadget(#Container, 160, 500,170, 50,#PB_Container_Single)
 ; OptionGadget(#Vert, 1, 1, 160, 20, "^ echange vertical")
 ; OptionGadget(#Horiz, 1, 30, 160, 20, "<> echange horizontal")
 ; SetGadgetState(#Vert, #true)
 ; CloseGadgetList()
 
 SetWindowCallback(@WindowCallback())
 EndIf
EndProcedure
;
Procedure Creation_map()
 ;- creaton tableau()
 Flag_start=#true
 RandomSeed(ElapsedMilliseconds())
 For y=1 to 12
 ligne$(y)=""
 Next y
 For y=1 to  12
 For x=1 to 20
 de=random(5,1)
 ligne$(y)=ligne$(y)+str(de)
 Next x
 Next y
 dessin() ; dessin du tableau
EndProcedure
;
Procedure echange_vertical(Lx,Ly)
 ;- echange Vertical de dalle()
 If Ly>1
 car_bas$=mid(ligne$(Ly),Lx,1)
 car_haut$=mid(ligne$(Ly-1),Lx,1)
 replacestring( ligne$(ly),car_bas$,car_haut$ ,#PB_String_InPlace,Lx,1)
 replacestring( ligne$(ly-1),car_haut$,car_bas$ ,#PB_String_InPlace,Lx,1)
 Endif
EndProcedure
;
Procedure renvoi_numero_image(Lx,Ly)
 If Ly>1 and Ly<13 and Lx>0 and Lx<21
 car$=mid(ligne$(Ly),Lx,1)
 Endif
 ProcedureReturn Val(car$)
EndProcedure
;
Procedure echange_Horizontal(Lx,Ly)
 ;- echange Horizontal de dalle()
 If Lx<20
 car_bas$=mid(ligne$(Ly),Lx,1)
 car_droit$=mid(ligne$(Ly),Lx+1,1)
 replacestring( ligne$(ly),car_bas$,car_droit$ ,#PB_String_InPlace,Lx,1)
 replacestring( ligne$(ly),car_droit$,car_bas$ ,#PB_String_InPlace,Lx+1,1)
 Endif
EndProcedure
;
Procedure dessin()
 ;-Dessin()
 StartDrawing(ScreenOutput())
 For y=1 to  12
 For x=1 to 20
 nbr$=Mid(ligne$(y),x,1)
 DrawImage(imageId(val(nbr$)),xj,yj)
 xj=xj+32
 Next x
 xj=0
 yj=yj+32
 Next y
 StopDrawing()
 FlipBuffers() ; execute l'affichage
 If Flag_start=#false
 SetGadgetText(#Score, str(score.i))
 Endif
EndProcedure
;
Procedure supr_horizontal()
 ;- supr_horizontal
 ; test horizontale verifie si 3 images ou plus (jusqu'a 20 ) semblable se suivent
 ; si c'est le cas on remplace par des case noires (0)
 For car=1 to 5
 ref$=LSet("", 20, str(car)) ; 20 caracteres possible
 For i=1 to 12 ; pour chaque lignes
 For nb=20 to 3 step -1  ; on va rechercher les caracteres par groupe de 20 a 3 mini
 ref2$=left(ref$,nb)
 If FindString(ligne$(i),ref2$)
 ReplaceString(ligne$(i),ref2$,LSet("", nb, "0"),#PB_String_InPlace)
 If Flag_start=#false
 Score.i=Score.i+len(ref2$)
 Endif
 Endif
 Next nb
 Next i
 Next car
 dessin()
EndProcedure
;
Procedure supr_vertical()
 ;- supr_Vertical
 ; test vertical verifie si 3 images ou plus (jusqu'a 12 ) semblable se suivent
 ; si c'est le cas on remplace par des case noires (0)
 dim colonne$(20)
 For x=1 to 20
 For y=1 to 12
 colonne$(x)=colonne$(x)+mid(ligne$(y),x,1) ; on capture tout les caracteres de la colonne
 Next y
 Next x
 For x=1 to 20 ; pour chaque colonne
 For car=1 to 5
 ref$=LSet("", 12, str(car)) ; 12 caracteres possible en vertical(forme "111111111111" -- 12 cars )
 For nb=12 to 3 step-1  ; on va rechercher les caracteres par groupe de 12 a 3 mini
 ref2$=left(ref$,nb)
 If FindString(colonne$(x),ref2$)
 ReplaceString(colonne$(x),ref2$,LSet("", nb, "0"),#PB_String_InPlace)
 If Flag_start=#false
 Score.i=Score.i+len(ref2$)
 Endif ;<
 Endif ;<
 Next nb
 Next car
 Next x
 For y=1 to 12
 Ligne$(y)=""
 For x=1 to 20
 Ligne$(y)=Ligne$(y)+mid(colonne$(x),y,1);mid(colonne$,y,1)
 Next x
 Next y
 dessin()
Endprocedure
;
Procedure supr_noirs()
 ;-Supr_noirs
 ; ; descente si noire dessous
 For y=12 to 2 step -1 ; pour chaque lignes (on part du bas)
 For x=1 to 20 ; pour chaque colonne
 car_bas$=mid(ligne$(y),x,1)
 car_haut$=mid(ligne$(y-1),x,1)
 if car_bas$="0" ;  image noire
 ;Swap car_haut$,car_bas$
 mem_car_haut$=car_haut$
 Anime_vertical_noir(x,y)
 replacestring( ligne$(y-1),car_haut$,car_bas$,#PB_String_InPlace,x,1); on echange le car de la ligne du haut
 replacestring( ligne$(y),car_bas$,mem_car_haut$ ,#PB_String_InPlace,x,1); avec celle du bas
 Endif
 Next x
 Next y
 dessin()
EndProcedure
;
Procedure generation_premiere_ligne()
 ;-generation_1er_ligne
 ; remplacement des noirs de la premiere ligne suite a la descente
 For x=1 to 20
 de=random(5,1)
 if mid(ligne$(1),x,1)="0"
 replacestring( ligne$(1),"0",str(de) ,#PB_String_InPlace,x,1); on remplce le noirs de la premiere ligne
 Endif
 Next x
 dessin()
EndProcedure
;
Procedure Anime_vertical_noir(Lx,Ly)
 ;- Animation verticale
 bas=renvoi_numero_image(Lx,Ly)
 haut=renvoi_numero_image(Lx,Ly-1)
 if bas=0 and haut>0 and Ly>0
 x_bas=(Lx*32)-32
 y_bas=(Ly*32)-32
 x_haut=x_bas
 y_haut=y_bas-32
 y2=y_haut
 For y= y_haut to y_bas
 DisplaySprite(haut,x_haut,y);descend
 Next y
 Endif
EndProcedure
;
Procedure Anime_vertical(Lx,Ly)
 ;- Animation verticale
 bas=renvoi_numero_image(Lx,Ly)
 haut=renvoi_numero_image(Lx,Ly-1)
 if bas>0 and haut>0 and Ly>1
 x_bas=(Lx*32)-32
 y_bas=(Ly*32)-32
 x_haut=x_bas
 y_haut=y_bas-32
 y2=y_haut
 For y=y_bas to y_haut step -1
 y2=y2+1
 DisplaySprite(bas,x_bas,y)
 DisplaySprite(haut,x_bas,y2)
 FlipBuffers()
 Next y
 delay(200)
 DisplaySprite(haut,-1000,y)
 DisplaySprite(bas,-1000,y)
 Endif
EndProcedure
;
Procedure Anime_Horizontal(Lx,Ly)
 ;- Animation_Horizontal
 gauche=renvoi_numero_image(Lx,Ly)
 droit=renvoi_numero_image(Lx+1,Ly)
 if gauche>0 and Lx<20
 y_gauche=(Ly*32)-32
 y_droit=y_gauche
 x_gauche=(Lx*32)-32
 x_droit=x_gauche+32
 x2=x_gauche
 For x=x_droit to x_gauche step -1
 x2=x2+1
 DisplaySprite(gauche,x2,y_gauche)
 DisplaySprite(droit,x,y_droit)
 FlipBuffers()
 Next x
 delay(200)
 DisplaySprite(droit,-1000,y_gauche)
 DisplaySprite(gauche,-1000,y_gauche)
 Endif
EndProcedure
;
Procedure WindowCallback(WindowID, Message, wParam, lParam)
 ;-CallBack
 Result = #PB_ProcessPureBasicEvents
 Select Message
 Case #WM_LBUTTONDOWN
 Flag_start=#false
 xm=(WindowMouseX(#win)  )
 ym=(WindowMouseY(#win) )
 xx$="x="+str(((xm/32*20)/20+1/10)+1)
 yy$="y="+str((((ym-100)/32*12)/12+1/10)+1)
 ;SetWindowTitle(#Win,xx$+" "+yy$)
 SetWindowTitle(#Win,"By Zorro")
 lx=((xm/32*20)/20+1/10)+1
 ly=(((ym-100)/32*12)/12+1/10)+1
 if Flag_click=0
 Flag_click=1
 mem_x=lx
 mem_y=ly
 beep_(440,100)
 ProcedureReturn Result
 Endif
 if Flag_click=1
 beep_(880,100)
 mem_x2=lx
 mem_y2=ly
 Flag_click=0
 ; Action
 eccartx=mem_x-mem_x2:if eccartx<0:eccartx=-eccartx:Endif
 eccarty=mem_y-mem_y2:if eccarty<0:eccarty=-eccarty:Endif
 if eccartx=1
 if mem_x<mem_x2
 Anime_Horizontal(mem_x,Ly)
 echange_Horizontal(mem_x,Ly)
 Else
 Anime_Horizontal(mem_x2,Ly)
 echange_Horizontal(mem_x2,Ly)
 Endif
 Score.i=Score.i-5
 Endif;|
 If  eccarty=1
 if mem_y<mem_y2
 Anime_vertical(Lx,mem_y2)
 echange_vertical(Lx,mem_y2)
 Else
 Anime_vertical(Lx,mem_y)
 echange_vertical(Lx,mem_y)
 Endif
 Score.i=Score.i-5
 Endif
 ProcedureReturn Result
 Endif;<
 
 ; if GetGadgetState(#Vert)=#True
 ; Anime_vertical(Lx,Ly)
 ; echange_vertical(Lx,Ly)
 ; Else
 ; Anime_Horizontal(Lx,Ly)
 ; echange_Horizontal(Lx,Ly)
 ;
 ; Endif
 
 if Score.i<=0
 Score.i=0
 MessageRequester("alerte","Vous avez perdu")
 Score.i =250 ; on reinitialise pour pouvoir continer a jouer
 Endif
 Case #WM_RBUTTONDOWN
 Case #WM_KEYDOWN
 ; if  wParam =16 ; Shift gauche
; flag_touche=-flag_touche
; If flag_touche>0
; SetGadgetState(#Vert, #true)
; SetGadgetState(#Horiz, #False)
; Else
; SetGadgetState(#Horiz, #true)
; SetGadgetState(#Vert, #False)
; Endif
; Endif

 EndSelect
 ProcedureReturn Result
EndProcedure;]
;
Procedure.l Loadimage_net(num,Adr$,nom_fichier$)
 ; By Dobro
 ;num = numero d'image qu'on desire
 ;Adr$=adresse du fichier image a charger
 ;nom_image$ = nom qu'on donne a cette image
 Protected image
 if InitNetwork()
 path$=GetTemporaryDirectory()
 If ReceiveHTTPFile(Adr$+nom_fichier$,path$+nom_fichier$)
 LoadImage(num,path$+nom_fichier$)
 DeleteFile(path$+nom_fichier$)
 Else
 ProcedureReturn #false
 EndIf
 Else
 ProcedureReturn #false
 Endif
EndProcedure ;]

; Epb


[drfloyd]

Prof, mon premier programme, qui est une petite démo :

https://www.gamopat-forum.com/t105889-thunder-doc-iv-la-demo#3106844

[Dobro]

Rappel : un prg compilé en 64 bits NE PEUX FONCTIONNER QUE sur des windows 64bits !

un prg compilé en 32 bits , PEUT FONCTIONNER sur des Windows 32 bits ET 64 bits !

Prof Dobro, je n'ai pas d'option pour compiler en 32bit, je ne la trouve pas dans les options du compilateur ?

il faut comprendre que le Purebasic propose 2 compilateurs
1 pour les 32bits et un autre pour les 64bits ...

les deux version du Purebasic sont a telecharger sur le site
l'installation ideal devrai etre de cet ordre

un Dossier Marqué de la version de ton Purebasic
genre :  d:\Purebasic_5_71

et dedans un dossier  "x86\" pour y mettre l’installation du Purebasic 32 bits
et un dossier "x64\" pour la version 64bits ... je pari que tu n'as téléchargé que la version 64 bits LOL
alors que tant qu'a faire il eu mieux valut que tu ne télécharge QUE la Version 32 bits :)

au Récapitulatif une fois tout fini , tu devrai avoir Purebasic 5.71 installé de la sorte :

D:\Purebasic_5.71\X86 \ et dedans les dossiers du langage 32 bits
D:\Purebasic_5_71\X64\ et dedans les dossier du langage 64 bits

ce qui te permettrai ensuite lorsque tu lance l’éditeur de la version 32 bits
de choisir par le menu "Fichier\Préférences \  a gauche "Compilateur" ajouter puis allez choisir le prg \compilers\PBcompiler.exe de la version 32bits et 64 bits ...

ce qui te permettra a la fin dans les "options de compilation" , de pouvoir choisir le compilateur que tu veux ...

pour ton problème de souris .. si ça plante lorsque tu click c'est probablement un problème lié aux événements de la fenêtre

j’espère que dans ta boucle principal Repeat-until  tu as au moins un truc du genre :

Code:


event= WaitWindowEvent (2)


histoire de vider la listes des events qui va se remplir a la vitesse de la lumiere ...

pour la disparition du pointeur de la souris, c'est normal que tu le vois puisque tu es en mode fenetré :)
heureusement qu'on voit le pointeur ....     sinon comment on pourrai cliquer sur la fenetre  

bon bien sur qu'on peut le faire disparaitre ... mais seulement avec les fonctions de l'API windows !
ce qui oblige a mettre la main dans l'oursin pour se payer une version complète du Purebasic  
(et toute les mises a jour A VIE !  profite en avant que ça change)
(et oui lorsqu'on achete on a acces au deux versions... et meme a quasi toutes les anciennes versions 32 et 64 bits)

ensuite il te suffirai d'utiliser :

Code:



  ShowCursor_(1) ; montre le curseur
  ShowCursor_(0) ; cache le curseur !!


[drfloyd]

oui j'avais oublié  WaitWindowEvent  !

Merci pour showcursor, bordel je l'ai pas trouvé dans la section Mouse de la doc !

J'ai reposté une nouvelle version... 64bit, fullscreen definition virtuelle

[Dobro]

Merci pour showcursor, bordel je l'ai pas trouvé dans la section Mouse de la doc !

normal il n"y est pas !!
c'est une API WIndows !!  

les fonctions (Procedures) ayant un underscore dans leur nom sont des APIS windows !!!

Exemple :  BEEP_(440,100)  est une API windows !
la doc se trouve ici :
DOC Microsoft sur la fonction BEEP()

Purebasic parle l'api windows quasi couramment !
et s'ecrit comme des fonctions Purebasic, seul le "_" permet de reconnaitre que c'est une API Windows .... :)

[drfloyd]

OK!

Bon bah je pense que je suis "stabilisé" en Pure concernant l'affichage... mais purée... j'en ai chié un peu (et je t'en ai fait profiter LOL)

C'est là que je comprends Tryphon qui dit que ce n'est plus du basic... il y a trop de paramètres... Ca se défend. Mais bon on a a deja débattu

[Dobro]

C'est là que je comprends Tryphon qui dit que ce n'est plus du basic... il y a trop de paramètres... Ca se défend. Mais bon on a a deja débattu

en realité c'est pas le langage qui change vraiment, mais le system d'exploitation , (plutot son environement) sur lequel il tourne

comme je te l'ai dit Purebasic n'est pas un Basic qui tourne dans un environement clos (borné, sécurisé )
c'est un Basic qui tourne dans l'environement Windows

du coup il faut qu'il puisse s'en sortir dans le multitache du system, les evenements du system , l'api du systems etc...

c'est sur qu'un basic qui tourne dans un environnement clos (borné) , c'est plus simple , moins de chose a prendre en compte
puisqu'on se trouve alors, dans un cocon ...

il y a bien 2 sortes de langages

ceux qui sont dans un environement pré-etablis , un univers , je pense a Python justement ... ou javaScript , ou AGK2 , ou DarkBasic etc...
et ceux qui ont comme environement le Systeme ! comme l'assembleur, le C, le C++ , et ... le Purebasic !... et dans le temps, le "Turbo Basic"

la seule différence ce n'est pas la syntaxe, mais la façon dont le langage converse avec le systeme d'exploitation
soit en direct (véritable compilateur) , soit en passant par un univers clos et protégé (les interpreteurs ) ...

note qu'on peut trouver des "compilateurs" pour les interpréteurs , mais ce ne sont pas de "vrais" compilateur
ce sont des fabricateurs d'executables qui gardent l'univers (le cocon) pour le langage ...et rajoutent ce qui manque pour en faire un executable ...

je pourrai t'en faire la Demo , mais ça risque d'etre un peut hors sujet... (je dispose d'un exemple de "faux" compilateur en Purebasic si vraiment ça te branche) 

par exemple en Natif, tu ne pourra pas creer de DLL en Python,  (tu pourra probablement trouver un outils qui permette de convertir un prg python en DLL car la force du python se trouve dans ses librairies (ecrites dans un autre langage que python)  disponibles ...) , mais ce sera un outils tiers ... ce n'est pas natif du python ...

alors qu'en Purebasic, tu pourra te creer une DLL pour python, pour AGK2  pour C++ ,pour le C , et meme pour le Purebasic lui-meme , car son compilateur le permet
pareil ces langages (C,c++...) pourront creer des DLL, grace a leur compilateurs, que tu pourra utiliser avec Purebasic ...

voila l'explication de l’apparente complexité du Purebasic

[Dobro]

Pour etre Compatible avec tout les DPI des ordinateurs (ceux reglé en 125% ou en 100% par exemple
voici ce qu'il faut faire :

debug DesktopScaledX(100) ; ceci renvoi  '125' sur un ecran a 125% ,  cela signifie que la position 100 sur un ecran a 125% c'est en fait 125 !  
; il faut se servir de cette fonction pour avoir une position x correcte quelque soit l'ecran
; si nous voulions positionner un texte a la colonne   50 ligne 100  quelques soit l'ecran
;  il faudrai faire  ceci :

Code:



; ATTENTION NE PAS OUBLIER DE COCHER LA CASE DPI dans les options de compilation
initsprite()

If OpenWindow(0, 0, 0, 200, 200, "DrawText Exemple", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    OpenWindowedScreen(windowID(0),1,1,200,200,1,0,0)
 
 StartDrawing(ScreenOutput())
      DrawingMode(#PB_2DDrawing_Transparent)    
        DrawText( DesktopScaledX(50),  DesktopScaledY(100), "Hello World!", RGB(255, 255, 0))    
      StopDrawing()
FlipBuffers()
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf


****************************************************************************************************************
sinon ceci teste en quel pourcentage est l'ecran

Code:



if  DesktopResolutionX() = 1.25 ; on test si l'ecran est en 125%
 MessageRequester("Attention" , "le jeux ne supporte pas trop le zoom a 125% de votre bureau"+chr(10)+"preferez remettre a 100% dans les option d'affichage de Windows")
Endif


le fait de mettre un message peut etre une solution de repli Strategique, c'est au gars de voir s'il veux changer ses parametres  :lol:  :lol:  

****************************************************************************************************************

ou encore  utiliser ce que renvoi la fonction DesktopResolutionX()  
comme offset multiplicateur
si on est en 100% ça renvoi 1 donc on multiplie X et y par 1 ça ne changera donc rien
Si on est en 120%  ça renvoi 1.25  ,on multiplie X et Y par 1.25 ce qui sera bon pour ce type de resolution :)

Code:




 offsetX = DesktopResolutionX()  ; on recupere le decalage qui sera de 1 pour 100% et de 1.25 pour 125%
  offsetY = DesktopResolutionY()
 ; et on multiplie nos X et y par ce decalage
 ; pour afficher le Text en  50 , 100   on fera donc :

initsprite()

If OpenWindow(0, 0, 0, 200, 200, "DrawText Exemple", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    OpenWindowedScreen(windowID(0),1,1,200,200,1,0,0)
 
 StartDrawing(ScreenOutput())
      DrawingMode(#PB_2DDrawing_Transparent)    
        DrawText( 50 * offsetX,  100 * offsetY, "Hello World!", RGB(255, 255, 0))    
      StopDrawing()
FlipBuffers()
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf



****************************************************************************************************************
derniere solution .... plus Lazy (JOKE)

vous passez votre ordinateur en 125%
vous coder votre truc sous cette resolution ..
forcement sur les ordis a 100% ça va rentrer ....
alors que l'inverse n'est pas vrais  

[Dobro]

l'un des problemes souvent soulevé c'est dans nos jeux d'etre obligé de fournir tout un
tas de fichiers "media"
media, qu'on a pas forcement envie de partager en tant que tel ...

une solution conciste a mettre nos sprites en planche .. et a les decouper juste avant de jouer ....

et cette planche de sprite,on la met a l’abri tranquille sur notre site ...
(ou bien on pique la planche de sprites sur un site quelque part , comme pour cette exemple  )
le prg se connectera a l'adresse ou se trouve la planche de sprites
et la téléchargera en RAM ... on peut ainsi en faire ce qu'on veux :)

si vous lancez ce code , vous verrez que j'affiche les sprites individuellement a l'ecran
Sprites, que j'ai donc découpé sur une planche de sprite se trouvant a l'adresse
Planche de sprite

vous remarquerez qu'a l'origine ces sprites sont sur fond Gris (RGB(160,160,164))
j'ai utilisé la fonction TransparentSpriteColor(spr(t)\id, Rgb(160,160,164))

pour dire a Purebasic, que je voulais que cette couleur soit considérée comme Transparente    

c'est la raison pour laquel les sprites apparaissent seul, sur le fond noir de mon test

Code:



;***********************************************
;Titre  :recup_planche_sprite_internet
;Auteur  : Dobro
;Date  :30/10/2019
;Heure  :10:30:19
;Version Purebasic :  PureBasic 5.71 LTS (Windows - x86)
;Version de l'editeur :EPB PHOENIX V2.68
; Libairies necessaire : Aucune
;***********************************************

Declare Loadimage_net2(Adr$)



UsePngImageDecoder() ; l'image est une Png
; l'adresse de l'image (planche de sprites)


InitSprite()
InitNetwork()
InitKeyboard()
#win=1
global planche_image

adresse.s="https://4.bp.blogspot.com/-OqMaLhrLE_E/XOOnABVofUI/AAAAAAAACgs/Zl5JuXx_nyAJJ7O78B9eY0jVELtj_r2-ACLcBGAs/s1600/Furio%2BSprite%2BSheet%2B01.png"
planche_image=Loadimage_net2(adresse.s)  ; on va recuperer la planche de sprite sur un site internet, (ça peut etre le notre hein ..... )

if Planche_image=0
 MessageRequester("erreur", "pas pu recuperer la planche de sprite")
Endif

ExamineDesktops()
EcranX=DesktopWidth(0)
EcranY=DesktopWidth(0)


Structure Spr
 id.i
 x.i
 y.i
EndStructure
dim spr.spr(12*20)


Openwindow(#win,1,1,EcranX,EcranY,"",#PB_Window_BorderLess     )

OpenwindowedScreen(windowID(#win),1,1,EcranX,Ecrany,1,0,0) ; creer l'ecran

Startdrawing(ScreenOutput())   ; dessine la planche de sprite qu'on a recup sur internet
 Drawimage(imageid(planche_image),1,1)
StopDrawing()

; maintenant on va graber nos sprites en utilisant la planche
for y=0 to 11
 for x=0 to 19
 
 spr(nbr)\id=GrabSprite(#pb_Any,x*32,y*32,32,32,#PB_Sprite_AlphaBlending |#PB_Sprite_PixelCollision) ; on recupere l'id du sprite (on a creer un sprite a partir de l'image quk est sur l'ecran)
 Spr(nbr)\x.i=x*32 ; je pose la coordoné dans la structure pour pouvoir te la présenter ensuite
 Spr(nbr)\y.i=y*32
 nbr=nbr+1
 Next x
Next y
; maintenant on vire la planche de sprite de l'ecran  on en a plus besoin
FreeImage(planche_image)
ClearScreen($0) ; on efface l'ecran

; ici normalement on a creer tout nos sprites
; on va les afficher


;Affichage du sprite 0

for t= 0 to  nbr-1  ; <---- nbr= nombre de sprites voir boucle ci dessus on a compter nos Sprite avec la variable 'nbr'
 TransparentSpriteColor(spr(t)\id, Rgb(160,160,164))
 DisplayTransparentSprite(spr(t)\id, Spr(t)\x*2, Spr(t)\y*2)  ; ici on affiche le sprite recupé ré avec GrabSprite en utilisant les coordonnées qu'on a posé dans la structure...
Next t

Repeat  ; boucle d'attente
 
 FlipBuffers()
 
 ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)


; ************* Zone Procedure ***********************




Procedure Loadimage_net2(Adr$)
 ;Ar-s
 ; UseJPEGImageDecoder()
 ; UseJPEGImageEncoder()
 Protected Image
 
 Telechargement = ReceiveHTTPMemory(Adr$, #PB_HTTP_Asynchronous)
 If Telechargement
 Repeat
 Progression = HTTPProgress(Telechargement)
 Select Progression
 Case #PB_HTTP_Success
 *Memoire = FinishHTTP(Telechargement)
 Image = CatchImage(#PB_Any,*memoire,MemorySize(*Memoire))
 ;; SaveImage(Image,GetTemporaryDirectory() + NomDestination$)
 
 Debug "Téléchargement terminé (Taille: " + MemorySize(*Memoire) + ")"
 FreeMemory(*Memoire)
 ;;    FreeImage(Image)
 ProcedureReturn image
 Break
 
 Case #PB_HTTP_Failed,#PB_HTTP_Aborted
 Debug "Erreur au téléchargement"
 Break
 
 Default
 Debug "Téléchargement en cours: " + Progression + "octets reçus"
 
 EndSelect
 
 Delay(500) ; Libérer le CPU
 ForEver
 Else
 Debug "Erreur de téléchargement"
 EndIf
 
EndProcedure




; Epb



[Urbinou]

le prg se connectera a l'adresse ou se trouve la planche de sprites
et la téléchargera en RAM ... on peut ainsi en faire ce qu'on veux :)

Connexion obligatoire pour jouer ? Le Doc va adorer

[Dobro]

par connexion, j'entends que le prg va recuperer le fichier en arriere plan
tu n'as pas de login a entrer ...

lorsque tu utilises ton navigateur, il fait la meme chose ...
la plupart des programmes de nos jours demande une connexion internet pour pouvoir
fonctionner , c'est pas nouveau.....
rien que pour les systemes de mise a jours, la plupart des programmes se connectent
sans te demander ton avis ...
prg :antivirus,graphisme (blender,AffinityPhoto ) ,Musique ,utilitaire (CCleaner,Glary utility..) , bureautique (suite Libre Office) , Windows lui meme ... bref..

rien n’empêche d'utiliser des sprites de base (de simple carré) pour laisser en interne
qui seront remplacés des qu'une connexion sera active ...
ça peut meme faire l'objet d'un control de licence ... genre t'as pas payé, tu as des sprites carrés
t'as payé, tu as des jolie sprites ...


apres, c'est seulement une solution que je propose
il en existe d'autres

-utilisation d'un fichier compressé joint au programme , (il peut etre éventuellement crypté)
-incorporation dans le code (mais ça peut etre lourd si beaucoup de fichiers )
l'avantage de la connexion , c'est qu'une mise a jours des graphiques se répercute instantanément ...
faut vivre en 2019  LOL  
....

[Urbinou]

Par connexion (avec un x en français !), j'entends connexion internet : )
Tu oublies qu'ici c'est un repère de barbus nourris à la cartouche et où la connexion internet obligatoire est une hérésie, surtout quand, comme le Doc, on ne dispose toujours que d'un modem 56K

[Dobro]

[drfloyd]

tss tss maintenant j'ai un boitier 4G+ en rab....

je carbure entre 40 et 80mg (selon cable ou WIFI) contre 1,2 avant...

je ne vous raconte pas le changement pour la MAJ des jeux.... WRECKFEST patch de 3Go en 2 minutes... avant c'etait 6 heures facile.

Seul truc, je n'ai que 200giga/mois... mais bon ca me suffit

[drfloyd]

je suis en train de me créer un petit moteur 2D de jeu de plateforme sur Pure. Ca m'amuse.

[Dobro]

tain, je vais bientot m'abonner pour tes cours de Prog en Purebasic 

[drfloyd]

héhé

Ca y est j'ai attaqué cet aprem mon jeu de plateforme (tout en regardant le foot) :

https://www.gamopat-forum.com/t105958-doc-floyder-s-dracula

[basiclove]

Tu vas passer Dr toi 


Bah j'ai 2 premieres question :

1. Rendu visuel

j'ai commencé 2 tests découverte en 320x240 et 640x400, mais le rendu visuel est un peu lissé/flou...  comme avec BLITZ 3D d'ailleurs...

Avec d'autres langages j'ai un rendu pixel perfect qui est très beau, quelque soit la définition que j'utilise (des definitions virtuelles)

Tu as un conseil sur cet aspect ?

Si ça peut servir... 2 exemples de petits jeux retro codés en pure où le rendu me semble aussi parfait quelle que soit la résolution.

1. Chompston https://www.contralogic.com/games/chompston/
2. Warehouse http://www.nightloversgamestudio.net/core/games/warehouse.html

Le code source n'est pas dispo malheureusement, mais ca montre en tout cas que c'est possible d'y arriver.

[drfloyd]

merci pour l'info

[Dobro]

Lethal Judgment etait un shootempup codé en Purebasic
il est un incontournable ...


pour info , les createurs ont laissés tombé Purebasic pour faire du jeux
ils sont passé a Unity  https://www.lethal-ex.com/

[drfloyd]

Pas mal du tout 

[grostonton]

Je vais faire un léger déterrage (mais pourquoi pas après tout ^^), et sans vouloir faire de l'ombre à Dobro, il y a aussi un fin connaisseur sur le net dont je ne sais pas si vous connaissez l'existence, malheureusement assez discret sur les réseaux, voire plus très actif.
https://blendman.blogspot.com/?fbclid=IwAR3Fbf7jYBNrZmL6WJ58WLzIGNidDAii99HzqT8b_QJuUuQw3DuP8ySS87w

[drfloyd]

il a dev pas mal de trucs en Pure et AGK. Impressionnant.

[rendomizer]

non bah c'etait moi... on m'a expliqué

je ne savais pas qu'en mode fenetre il fallait gerer tout un tas de parametre...

(en BLITZ tout etait facile...)


je voudrais faire COSMOS II en mode 100% souris, façon Dungeon Master

Oui blitz3d c'est mon seul basic qui en vaille la peine. surtout que maintenant il n'éxiste plus ! heureusement que je l'ai gardé dans mon cloud et sur dissque dur avec une library pour commander un clavier midi usb pour faire de la musique. J'ai trouvé cette library sur un forum allemand. Si c'est aussi galere pure basic je ne vais même pas regarder drfloyd.