PureBasic

Hello ,
Sous XP, c'est la première fois que je touche à cette basic pureté

Ne soyez pas trop sévères

Comment afficher les écrans successifs après chaque calcul ?
J'ai bien vu qu'il faut utiliser OpenScreen(640,480,32,t$), FlipBuffers() ...enfin peut-être

Mais la syntaxe reste rétive

(j'ai bien vu les ";" dans le prog ils sont en attente pour les fonctions considérées

Le petit prog suivant montre le petit "hic"

(quelle est la meilleure façon d'envoyer un programme "source" sur le forum ? (copier/coller, Zip, format pb, quote...
car là j'ai perdu toute ma velle indentation

Merci d'avance des corrections, conseils et directives

Code : Tout sélectionner

; Demo Pure basic
 Dim ecran(639,479)

 For x = 0 To 639   ; un écran de couleurs aléatoires
   For y = 0 To 479
    r=Random(255)
    g=Random(255)
    b=Random(255)
    c=RGB(r,g,b)  
  ecran(x,y)= c
   Next y
  Next x

If OpenWindow(0, 400,400, 640, 480, #PB_Window_SystemMenu, "2D Drawing Test")

  Repeat
    Repeat
      EventID.l = WaitWindowEvent()
    Until EventID <> 0

    If EventID = #PB_EventRepaint   ; If the user has resized the window or anything, we will repaint our graphic
      Gosub SomeGraphics
    EndIf
  Until EventID = #PB_EventCloseWindow  ; If the user has pressed on the close button
  
EndIf

End   ; All the opened windows are closed automatically by PureBasic

SomeGraphics:
  StartDrawing(WindowOutput()) 
;OpenScreen(640,480,32,t$)
 ;FlipBuffers()
 For z= 1 To 200            ;on fait 100 fois
  For x = 1 To 638
   For y = 1 To 478         ;genre de moyenne de couleur autour du pixel considéré
     c=ecran(x-1,y) +  ecran(x+1,y) + ecran(x,y-1) + ecran(x,y+1)
     c=c/5
     If c<1 
      c = RGB(255,255,255)   ; on tempère les petits chiffres
     EndIf 
     ecran(x,y)=c
     Plot(x,y,c)          ; on affiche les pixels avec la nouvelle couleur
   Next y
  Next x
;FlipBuffers()
 Next z 

  StopDrawing() ; This is absolutely needed when the drawing operations are finished !!! Never forget it !

Return

tout d'abord lorsque tu veux afficher du code dans le forum
utilise le bouton Code puis colle le listing et reapuis sur le bouton code

ton listing apparaitra comme ceci

Code : Tout sélectionner

; Demo Pure basic
Dim ecran(639,479)

For x = 0 To 639 ; un écran de couleurs aléatoires
  For y = 0 To 479
    r=Random(255)
    g=Random(255)
    b=Random(255)
    c=RGB(r,g,b)
    ecran(x,y)= c
  Next y
Next x

If OpenWindow(0, 400,400, 640, 480, #PB_Window_SystemMenu, "2D Drawing Test")
  
  Repeat
    Repeat
      EventID.l = WaitWindowEvent()
    Until EventID <> 0
    
    If EventID = #PB_EventRepaint ; If the user has resized the window or anything, we will repaint our graphic
      Gosub SomeGraphics
    EndIf
  Until EventID = #PB_EventCloseWindow ; If the user has pressed on the close button
  
EndIf

End ; All the opened windows are closed automatically by PureBasic

SomeGraphics:
StartDrawing(WindowOutput())
;OpenScreen(640,480,32,t$)
;FlipBuffers()
For z= 1 To 200 ;on fait 100 fois
  For x = 1 To 638
    For y = 1 To 478 ;genre de moyenne de couleur autour du pixel considéré
      c=ecran(x-1,y) + ecran(x+1,y) + ecran(x,y-1) + ecran(x,y+1)
      c=c/5
      If c<1
        c = RGB(255,255,255)
      EndIf
      ecran(x,y)=c
      Plot(x,y,c) ; on affiche les pixels avec la nouvelle couleur
    Next y
  Next x
  ;FlipBuffers()
Next z

StopDrawing() ; This is absolutely needed when the drawing operations are finished !!! Never forget it !

Return

ensuite tu veux faire quoi exactement en parlant le plus simplement et clairement possible ?

la le listing que tu donne affiche des points de couleur aleatoire
de façon successive
c'est pas ce que tu veux faire ?

C'est juste le premier écran qui est aléatoire

Ensuite, Je calcule tout un écran, et malgrè la pure vitesse, on voit l'avancement du calcul

Donc comment "geler" le premier écran, et n'afficher le suivant que on le lui demande pour avoir une suavité dans l'affichage

Code : Tout sélectionner

Dim ecran(639,479) 

For X = 0 To 639 ; un écran de couleurs aléatoires 
  For y = 0 To 479 
    r=Random(255) 
    g=Random(255) 
    b=Random(255) 
    c=RGB(r,g,b) 
    ecran(X,y)= c 
  Next y 
Next X 


If CreateImage(0, 639, 479)
  If StartDrawing(ImageOutput())
    
    For X = 1 To 638 
      For y = 1 To 478 ;genre de moyenne de couleur autour du pixel considéré 
        c=ecran(X-1,y) + ecran(X+1,y) + ecran(X,y-1) + ecran(X,y+1) 
        c=c/5 
        If c<1 
          c = RGB(255,255,255) 
        EndIf 
        ecran(X,y)=c 
        Plot(X,y,c) ; on affiche les pixels avec la nouvelle couleur 
      Next y 
    Next X 
    
    StopDrawing()
  EndIf
EndIf
  
Procedure ProcedureCallback(WindowID, Message, wParam, lParam)
  #BN_DBLCLK=5
  Resultat = #PB_ProcessPureBasicEvents
  Select Message
    Case #WM_PAINT
      StartDrawing(WindowOutput())
      DrawImage(ImageID(), 0, 0) 
      StopDrawing()
  EndSelect 
  ProcedureReturn Resultat 
EndProcedure 
  
If OpenWindow(0, 100, 200, 300, 200, #PB_Window_SystemMenu, "2D Drawing Test")
  SetWindowCallback(@ProcedureCallback())
  
  Repeat
    EventID=WaitWindowEvent()  
  Until EventID = #PB_EventCloseWindow  
EndIf
End

Pour les réponses aux questions, désolé mais je vais me coucher, bonsoir.

Belle réactivité

, mais on obtient
ligne 37 Constant not found #WM_PAINT

Je n'ai que la démo, ai-je droit à tous ces tests? aux procedures?

Ps le calcul de l'image est purement fantaisiste, c'est juste pour calculer un fond et voir comment on se sert des "bascules écran"

bon ce que tu voulais faire c'est des taches de Martin !

je vais te mettre un autre exemple qui utilise l'assembleur en ligne mais malheuresement tu pourra sans doute pas essayer avec la Demo

voici le code que tu voulais faire
l'emploi de sprites active la rapidité car en faite on precalcul dans ce cas !!
click bouton droit pour quitter !!!!
ce code marche sur ta version de demo ! (en principe)

attention mode Turbo on !! accroche toi ça va decoiffer

Code : Tout sélectionner

#dobro=1
#Police=1
#Sprite=1

spr=1
Dim ecran(640,400)
For x = 0 To 640 ; un écran de couleurs aléatoires
  For y = 0 To 400
    r=Random(255)
    g=Random(255)
    b=Random(255)
    c=RGB(r,g,b)
    ecran(x,y)= c
  Next y
Next x

; ***********************************
Resultat = InitSprite()
FontID = LoadFont(#Police, "arial", 18, #PB_Font_Bold )
EcranX = GetSystemMetrics_(#SM_CXSCREEN):;=largeur de l'ecran
EcranY = GetSystemMetrics_(#SM_CYSCREEN):;=hauteur de l'ecran
  WindowID = OpenWindow(1, 0, 0, 640, 400,  #PB_Window_SystemMenu|#PB_Window_BorderLess |#PB_Window_ScreenCentered , "hello")
  
  WindowID = WindowID(1)
  Result = OpenWindowedScreen(WindowID,0,0, 640, 400, 1, 0,0)
  CreateSprite(1, 640, 400)  ; cree 1 sprites qui sert d'ecran 1
  CreateSprite(2, 640, 400)  ;  cree 1 sprites qui sert d'ecran 2
   
  
  Resultat = InitMouse()
  
  Repeat
    ExamineMouse()
    Event=WindowEvent()
    
    While MouseButton(1)
      mouse_event_(#MOUSEEVENTF_LEFTUP,xm,ym,0,1) ; appuis
      mouse_event_(#MOUSEEVENTF_LEFTDOWN,xm,ym,0,1) ; relache
    Wend
    
    If MouseButton(2)
      End 
    EndIf
     
      StartDrawing(SpriteOutput(spr) ) ; on dessine dedans
      For x = 1 To 640
        For y = 1 To 400 ;genre de moyenne de couleur autour du pixel considéré
          c=ecran(x-1,y) + ecran(x+1,y) + ecran(x,y-1) + ecran(x,y+1)
          c=c/5
          If c<1
            c = RGB(255,255,255)
          EndIf
          ecran(x,y)=c
          Plot(x,y,c) ; on affiche les pixels avec la nouvelle couleur
        Next y
      Next x 
    StopDrawing()  
    spr=spr+1
    If spr>2
      spr=1
    EndIf
    
    
    DisplaySprite(spr, 0, 0)
    
    
    
    
    
    FlipBuffers():; affiche l'ecran
    ClearScreen(0, 0, 0) :;efface l'ecran
    
  Until Event=#PB_Event_CloseWindow

voici ce qui avais ete fait avec l'assembleur integré !!
(ça te prouve que le pure marche avec les 2 languages !

marchera pas sur ta demo !! dommage t'aurai pu voir la difference de vitesse

Code : Tout sélectionner

Global _virtuscr.l

#largeur=640 : #hauteur=480   ;dimensions de l'écran
!largeur=640                  ;les mêmes pour Fasm
!hauteur=480


Enumeration
    #rougebleujaune
    #nivgris
    #defaut
EndEnumeration

;#modepalette=#rougebleujaune
#modepalette=#rougebleujaune
;#modepalette=#defaut

CompilerIf #modepalette=#defaut
   
Procedure palettiser()
EndProcedure
   
CompilerElse
   
Procedure palettiser()
    
    InitPalette()
    
    CreatePalette(0)
    
    CompilerSelect #modepalette
    
    CompilerCase #rougebleujaune
    
    For t=0 To 63
        SetPaletteColor(t,RGB(t*4,0,0))
        SetPaletteColor(t+64,RGB((63-t)*4,0,t*4))
        SetPaletteColor(t+128,RGB(t*4,t*4,(63-t)*4))
        SetPaletteColor(t+192,RGB(255,255,t*4))
    Next
    
    CompilerCase #nivgris
    
    For t=0 To 255
        SetPaletteColor(t,RGB(t,t,t))
    Next
    
    CompilerEndSelect
    
    DisplayPalette(0)
    
EndProcedure
   
CompilerEndIf




Procedure onattend()
    
    Repeat
        Delay(80)
        FlipBuffers()
    Until IsScreenActive()
    
EndProcedure



Procedure rendu()
    
    scraoutpout=ScreenOutput()
    If scraoutpout : If StartDrawing(scraoutpout)
            
            dbuff=DrawingBuffer()
            pitch=DrawingBufferPitch()
            
            If pitch=#largeur
                
                CopyMemory(_virtuscr,dbuff,#largeur*#hauteur)
                
            Else
                
                For ligne=0 To #hauteur-1
                    CopyMemory(_virtuscr+ligne*#largeur,dbuff+ligne*pitch,#largeur)
                Next
                
            EndIf
            
    StopDrawing() : EndIf : EndIf
    
EndProcedure




Enumeration
    #bordsnoirs
    #bordsjoints
EndEnumeration

#modedesbords=#bordsnoirs
;#modedesbords=#bordsjoints

Procedure martinet()
    
    DisableDebugger   ;le débogueur fout le bordel dans les "LOOP"
    
    CompilerSelect #modedesbords
    
    CompilerCase #bordsjoints
    
    MOV Edi,_virtuscr
    XOR Ebx,Ebx
    CLD
    MOVZX ax,byte[Edi+largeur*(hauteur-1)]
    MOV bl,[Edi+largeur*hauteur-1]
    ADD ax,bx
    MOV bl,[Edi+1]
    ADD ax,bx
    MOV bl,[Edi+largeur]
    ADD ax,bx
    SHR ax,2
    INC al
    !stosb
    MOV Ecx,largeur-1
    lign0:
    MOVZX ax,byte[Edi+largeur*(hauteur-1)]
    MOV bl,[Edi-1]
    ADD ax,bx
    MOV bl,[Edi+1]
    ADD ax,bx
    MOV bl,[Edi+largeur]
    ADD ax,bx
    SHR ax,2
    INC al
    !stosb
    LOOP l_lign0
    MOV Ecx,largeur*(hauteur-2)
    centrecr:
    MOVZX ax,byte[Edi-largeur]
    MOV bl,[Edi-1]
    ADD ax,bx
    MOV bl,[Edi+1]
    ADD ax,bx
    MOV bl,[Edi+largeur]
    ADD ax,bx
    SHR ax,2
    INC al
    !stosb
    LOOP l_centrecr
    MOV Ecx,largeur-1
    derlign:
    MOVZX ax,byte[Edi-largeur]
    MOV bl,[Edi-1]
    ADD ax,bx
    MOV bl,[Edi+1]
    ADD ax,bx
    MOV bl,[Edi-largeur*(hauteur-1)]
    ADD ax,bx
    SHR ax,2
    INC al
    !stosb
    LOOP l_derlign
    MOVZX ax,byte[Edi-largeur]
    MOV bl,[Edi-1]
    ADD ax,bx
    MOV bl,[Edi+1-largeur*hauteur]
    ADD ax,bx
    MOV bl,[Edi-largeur*(hauteur-1)]
    ADD ax,bx
    SHR ax,2
    INC al
    !stosb
    
    CompilerCase #bordsnoirs
    
    MOV Edi,_virtuscr
    ADD Edi,largeur+1
    MOV Edx,hauteur-2   
    XOR Ebx,Ebx
    CLD
    bclecr:
    MOV ecx,largeur-2
    bcllign:
    MOVZX ax,byte[edi-largeur]
    MOV bl,[edi-1]
    ADD ax,bx
    MOV bl,[edi+1]
    ADD ax,bx
    MOV bl,[edi+largeur]
    ADD ax,bx
    SHR ax,2
    INC al
    !stosb
    LOOP l_bcllign
    ADD edi,2
    DEC edx
    JNZ l_bclecr
    
    CompilerEndSelect
    
    EnableDebugger
    
EndProcedure



;-ZHE PROG



If InitKeyboard() And InitSprite() And OpenScreen(#largeur,#hauteur,8,"Taches de Martin")
    
    palettiser()
    
    _virtuscr=AllocateMemory(#largeur*#hauteur)
    
    SetFrameRate(25)
    
    Repeat
        
        martinet()
        
        rendu()
        
        ExamineKeyboard()
        
        FlipBuffers()
        
        If IsScreenActive()=0
            onattend()
        EndIf
        
    Until KeyboardReleased(#PB_Key_Escape)
    
    
Else
    
    MessageRequester("Ah ben ça marche pas.","Impossible d'initialiser DirectX7")
    
  EndIf

alors tu l'achete la license ??

@ Dobro
Grand merci
Hé hé
Je ne savais pas que mes élucubrations avaient un nom

Sinon le GetSystem métric ne marche pas avec la démo ainsi que les tests de la souris Pas grave j'ai tout "shinté"
Et cela marche impec

(je stoppe sauvagement le programme en fermant la "fenêtre"

La manip des "sprites" est tout à fait ce que je voulais, vitesse totalement suffisante

Je vais juste fignoler pour avoir des bords propres et faire des tests "torique" ainsi qu'un tableau intermédiaire car là je change les pixels "à la volée"

Et après, les délices de la recherche pour trouver des coéficients qui donnent des images et transformations délectables pour l'oeil

ps
Le code en assembleur ne marche pas pour moi mais c'était prévisible

Pss Sans doute une petite licence pour bientôt

Je garde donc le code assembleur sous le coude:)

@Dobro
Mais je pense à quelque chose, ce programme en "assembleur", on ne peut pas en faire un "exe" pour que je puisse le voir comme n'importe quel programme indépendant

si ! moi je peux !!

puisque j'ai la license

je te fais ça je le zip et je te le met a dispo !!

ici : http://michel.dobro.free.fr/bidouilles/tache.zip

pour sortir du programme c'est "escape" !!

il est en plein ecran en 800x600 !

C'est bien ce qui me semblait

Le seul truc c'est que mon programme n'était pas"terrible" du point de vue du process visuel, mais bon... pour un essai

Par exemple si l'on divise par 4 au lieu de 5, il se passe des trucs rigolos quand on laisse touner le prog

Cela se met à "grouiller" sévère

voila c'est fait : regarde le message au dessus !

Voui cela marche

Ha! Les mystères de l'assembleur me resteront, hélas à jamais intouchables, mais bon... faut se faire une raison

J'ai vu qu'il y avait un très bon tut sur le forum par Denis+, mais hélas on n'a qu'une vie pour l'instant!
Prochaine étape, charger une "photo" comme point de départ à ce tachisme sauvage

c'est DENIS !!

mais t'inquiete il s'en occupe , faut lui laisser le temps , il fait pas que ça !

Pardon pour le Denis, j'avais lu trop vite

C'est rectifié

Existe t-il une fonction spécifique qui remplit un tableau B par un tableau A?
Les 2 tableaux étant de même tailles et de même nature et ayant le même nombre d'éléments (mais pas les mêmes éléments

non mais c'est tres simple a faire !!

Code : Tout sélectionner

Dim tab(10,10) ; on cree 2 tableaux
Dim tab2(10,10)


For x= 0 To 10
  For y=0 To 10 
    tab (x,y)=Random(50) ; on rempli le premier avec des chiffre au hazard
Next y
Next x

;on copie le tableau 1  dans le 2

For x= 0 To 10
  For y=0 To 10 
    tab2 (x,y)= tab(x,y)
  Next y
Next x



; on verifie 

For x= 0 To 10
  For y=0 To 10 
     Debug "tableau 1 "+ Str(tab (x,y))
    Debug "tableau 2 "+ Str(tab2 (x,y))
    
  Next y
Next x
  
 ; le transfere a bien eu lieu !!

ya surement d'autre possibillité

passage par les pointeurs
ou utilisation de peek et poke !! (comme avant

)

PureBasic

Comment afficher...

Comment afficher...