PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Des cercles a dessiner sans "circle"

http://forums.purebasic.com/french/viewtopic.php?t=17660

Page 2 sur 4

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 17:03
par Ollivier
Parce que tout est déjà là depuis bien longtemps...

Code : Tout sélectionner

;*************************************************************************************************************************************************************************
InitSprite()
ExamineDesktops()
Define.S MainTitle = "None"
Define.I Flags = #PB_Window_SizeGadget | #PB_Window_SystemMenu | #PB_Window_ScreenCentered
Define.I Flip = #PB_Screen_SmartSynchronization
Define.I Freq = DesktopFrequency(0)
Define.I Delta = 1000 / Freq
OpenWindowedScreen(WindowID(OpenWindow(#PB_Any, 0, 100, 1024, 768, MainTitle, Flags) ), 0, 0, 1024, 768, 1, 0, 0, Flip)
Macro _DispCircCalc()
                x = Cos(Angle) * Radius * Cos(AngleY)
                y = Sin(Angle) * Radius
                x1 = Cos(AngleZ) * x + Sin(AngleZ) * y
                y1 = Cos(AngleZ2) * x + Sin(AngleZ2) * y
EndMacro
Procedure DisplayCircle(cx, cy, Radius.D, SpriteN, AngleY.D = 0.0, AngleZ.D = 0.0)
        Define.D Angle, X, Y, AngleZ2 = AngleZ + (#PI / 2.0)
        _DispCircCalc()
        Repeat
                Angle + 0.12566
                x0 = x1
                y0 = y1
                _DispCircCalc()
                If x0 * y1 - x1 * y0 > 0
                        TransformSprite(SpriteN, x1, y1, 0, 0, 0, 0, x0, y0)
                Else
                        TransformSprite(SpriteN, x0, y0, 0, 0, 0, 0, x1, y1)
                EndIf
                DisplayTransparentSprite(SpriteN, cx, cy)
        Until Angle > 6.283 - 0.12564
EndProcedure
Define.D Alpha = 8.0
Define QuadI
Dim Quad.I(255)
Define Xc.D
CreateSprite(0, 256, 16, #PB_Sprite_AlphaBlending)
If StartDrawing(SpriteOutput(0) )
        DrawingMode(#PB_2DDrawing_AllChannels)
        W = OutputWidth()
        H = OutputHeight()
        Box(0, 0, W, H, RGBA(0, 0, 0, 0) )
        Box(0, 0, W, H, RGBA(255, 255, 255, 255) )
        StopDrawing()
EndIf
Quad(QuadI) = CreateSprite(#PB_Any, 256, 16, #PB_Sprite_AlphaBlending)
If StartDrawing(SpriteOutput(Quad(QuadI) ) )
        DrawingMode(#PB_2DDrawing_AllChannels)
        W = OutputWidth()
        H = OutputHeight()
        Box(0, 0, W, H, RGBA(0, 0, 0, 0) )
        For X = 0 To W - 1
                Xc = 255 - Pow(Pow(255, Alpha) - Pow(254 - X, Alpha), 1 / Alpha)
                If Xc > 255
                        Xc = 255
                EndIf
                If Xc < 0
                        Xc = 0
                EndIf
                Cr = 255
                Cg = 255
                Cb = 255
                If X < (W - 1)
                        Ca = Xc
                Else
                        Ca = Xc / 2
                EndIf
                Line(X, 0, 1, H, RGBA(Cr, Cg, Cb, Ca) )
        Next
        StopDrawing()
EndIf
QuadI + 1
Quad(QuadI) = CreateSprite(#PB_Any, 256, 16, #PB_Sprite_AlphaBlending)
If StartDrawing(SpriteOutput(Quad(QuadI) ) )
        Alpha = 2
        DrawingMode(#PB_2DDrawing_AllChannels)
        W = OutputWidth()
        H = OutputHeight()
        Box(0, 0, W, H, RGBA(0, 0, 0, 0) )
        For X = 0 To W - 1
                Xc = Pow(Pow(255.0, Alpha) - Pow(255 - X, Alpha), 1.0 / Alpha)
                If Xc > 255
                        Xc = 255
                EndIf
                If Xc < 0
                        Xc = 0
                EndIf
                Cr = 255
                Cg = 255
                Cb = 255
                If X < (W - 1)
                        Ca = Xc
                Else
                        Ca = Xc / 2
                EndIf
                Line(X, 0, 1, H, RGBA(Cr, Cg, Cb, Ca) )
        Next
        StopDrawing()
EndIf
QuadI + 1
Quad(QuadI) = CreateSprite(#PB_Any, 256, 1, #PB_Sprite_AlphaBlending)
If StartDrawing(SpriteOutput(Quad(QuadI) ) )
        DrawingMode(#PB_2DDrawing_AllChannels)
        W = OutputWidth()
        H = OutputHeight()
        Box(0, 0, W, H, RGBA(0, 0, 0, 0) )
        For I = 0 To W / 2 - 1
                Box(I, 0, 1, H, RGBA(255 - Random(63), 255 - Random(127), 255 - Random(255), Random(255) ) )
        Next
        StopDrawing()
EndIf
QuadI + 1
Quad(QuadI) = CreateSprite(#PB_Any, 256, 16, #PB_Sprite_AlphaBlending)
If StartDrawing(SpriteOutput(Quad(QuadI) ) )
        DrawingMode(#PB_2DDrawing_AllChannels)
        W = OutputWidth()
        H = OutputHeight()
        Box(0, 0, W, H, RGBA(0, 0, 0, 0) )
        For X = 0 To W - 1
                Xc = 255 - Pow(Pow(255, Alpha) - Pow(X, Alpha), 1 / Alpha)
                If Xc > 255
                        Xc = 255
                EndIf
                If Xc < 0
                        Xc = 0
                EndIf
                Cr = 0
                Cg = 0
                Cb = 0
                If X < (W - 1)
                        Ca = Xc
                Else
                        Ca = Xc / 2
                EndIf
                Line(X, 0, 1, H, RGBA(Cr, Cg, Cb, Ca) )
        Next
        StopDrawing()
EndIf
W = ScreenWidth()
H = ScreenHeight()
cx = W / 2
cy = H / 2
Define.D Angle0, Angle1, Angle2, AngleMi, Angle, Radius = 32, AngZ, AngY = 3.0 * #PI / 8.0
#Nb = 511
Dim rho.D(#Nb)
Dim teta.D(#Nb)
Dim cx.D(#Nb)
Dim cy.D(#Nb)
Dim Radius.D(#Nb)
Dim AngY.D(#Nb)
Dim AngZ.D(#Nb)
For J = 0 To #Nb
        teta(J) = Random(628) / 100.0
        rho.D = Cos((Random(157.0) / 100.0) * 0.9)
        rho(J) = rho
        cx(J) = rho * Cos(teta(J) )
        cy(J) = rho * Sin(teta(J) )
        Radius(J) = (450 + Random(50) ) / 5000
        AngY(J) = -ATan2(Sqr(1 - (rho*rho) ), rho)
        AngZ(J) = -teta(J)
Next
Repeat
        ClearScreen(0)
        TscI = 0
        DisplayCircle(cx + 180, cy - 50, Radius / 3, Quad(1) )
        For J = 0 To #Nb
                teta(J) + ((1.0 - rho(J)*rho(J) ) / 10.0)
                cjx.D = rho(J) * Cos(teta(J) )
                cjy.D = rho(J) * Sin(teta(J) )
                DisplayCircle(cx + 180 + (cjx * (radius / 3)), cy - 50 + (cjy * (radius/3)), Radius * Radius(J), Quad(3), AngY(J), AngZ(J) )
        Next
        DisplayCircle(cx + 100, cy + 100, Radius / 2, Quad(0) )
        DisplayCircle(cx, cy, Radius, Quad(2), AngY, AngZ)
        Radius * 1.02
        AngZ + (#PI / 100.0)
        AngY + (#PI / 10.0)
        TscI = 1
        FlipBuffers()
Until WaitWindowEvent(Delta) = #PB_Event_CloseWindow

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 17:17
par crisot
SPH a écrit :Beaucoup moins beaux ?

Il n'y a pas plus rond qu'un cercle tracé point par point avec un cos et un sin.

Peut etre as tu vu ma vieille routine ou j'interpolais les points séparé par des line. La, c'etait moche :idea:
Fais une capture d'écran et zoom sur ton cercle et tu verra le problème.

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 17:32
par Ollivier
SPH a écrit :pourquoi tu ne ponds pas un code complet ?
Alors ? Y'a pas un rond troué ptêt ?
La routine ouais...

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 17:39
par Ollivier
Et pis tu peux aller vérifier sur une vieille version 5.22 ça marche aussi !

Que du TransformSprite()...

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 21:06
par SPH
Version antialiasing plutot raté :

Code : Tout sélectionner

;
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Error", "Can't open the sprite system", 0)
  End
EndIf

If OpenWindow(0, 0, 0, 600, 600, "Cercle",#PB_Window_ScreenCentered)
  
  If OpenWindowedScreen(WindowID(0), 10, 10, 580, 580, 0, 0, 0)
    
    
    TempsDepart.q = ElapsedMilliseconds()  ; Récupère la valeur actuelle
    
    StartDrawing(ScreenOutput())
    
    For r= 10 To 260 Step 10
      ;r=260
      rr.f=2*r*3.1416
      
      ;z.f=360*8/rr
      z.f=360/rr
      u.f=0
      
      ok=0
      
      Repeat
        
        
        x.f=Cos(Radian(u))*r
        y.f=Sin(Radian(u))*r
        aa.l=x
        bb.l=y
        xx.f=x-aa
        yy.f=y-bb
        aa=xx*500
        If aa<0
          aa*-1
        EndIf
        bb=yy*500
        If bb<0
          bb*-1
        EndIf
        
        
        couleur=RGB(255-(aa+bb)/2,255-(aa+bb)/2,255-(aa+bb)/2)
        
        Plot(290+x,290+y,couleur)
        Plot(290-x,290+y,couleur)
        Plot(290+x,290-y,couleur)
        Plot(290-x,290-y,couleur)
        
        
        u+z
        If u>91
          ok=1
        EndIf
        
      Until ok=1
      
    Next
    
    StopDrawing()
    FlipBuffers()
    
    TempsEcoule.q = ElapsedMilliseconds()-TempsDepart
    MessageRequester("timer",Str(TempsEcoule))   
    
    Repeat
      ExamineKeyboard()
    Until KeyboardPushed(#PB_Key_Escape)
    
  Else
    MessageRequester("Error", "Can't open windowed screen!", 0)
  EndIf
EndIf

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 21:15
par Guillot
houla !
tres jolie effet
( Xc = Pow(Pow(255.0, Alpha) - Pow(255 - X, Alpha), 1.0 / Alpha) )

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 21:21
par Ollivier
Fais une recherche << aaline >> et, logiquement, tu tomberas sur les codes source de LSI il y a 9 ans.

Et je crois bien que ça fonctionne encore.

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 21:31
par Ollivier
Guillot a écrit :houla !
tres jolie effet
( Xc = Pow(Pow(255.0, Alpha) - Pow(255 - X, Alpha), 1.0 / Alpha) )
Bonjour professeur Shadoko,

désolé de faire le dinosaure avec les sprites et de snober les bijoux que tu postes avec la dernière version. Mais j'ai toujours un train de retard.

Oui le Alpha permet de généraliser la fonction de distance (quand Alpha = 2)

La fonction de distance (Pythagore) c'est comme une chambre à air dans une boîte cubique : plus on met la pression, et plus la forme de la chambre à air prend la forme du cube, donc une forme carrée.

Le Alpha, c'est la pression. Plus c'est grand, plus c'est carré.

C'est pareil avec les sinus : la fonction sinus puissance infini, c'est un signal en créneau. C'est un peu normal, puisque le sinus se calcule à partir des racines carrées.

Merci pour le retour. C'est cool. C'est très rare que je pianote.

N'hésite pas à remplacer

Code : Tout sélectionner

ClearScreen(0)
par

Code : Tout sélectionner

ClearScreen(RGB(32,64,128)
Tu verras alors des poils apparaître.

Re: Des cercles a dessiner sans "circle"

Publié : lun. 22/avr./2019 21:38
par SPH
Merci Guillot,

je n'arrive pas a voir si mon effet est raté ou pas. Mais qu'importe.
Pourquoi je fait des cercles en points : pour faire un effet tunnel en cercles comme dans les vieilles démos.

Merci aux participants de ce topic 8)

Re: Des cercles a dessiner sans "circle"

Publié : mar. 23/avr./2019 9:37
par crisot
Bah go faire ton effet au lieu de coder des cercles :mrgreen:

Re: Des cercles a dessiner sans "circle"

Publié : mar. 23/avr./2019 12:24
par Guillot
tiens un petit effet tunnel
sans circle et sans cosinus
(equation d'un cercle: x²+y²=rayon² )

!!! Enlever le déboguer !!!

Code : Tout sélectionner

InitSprite():InitKeyboard():InitMouse()
ex=1280
ey=800
OpenWindow(0, 0, 0, ex,ey, "",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)

Dim couleur.l(1023)
For i=0 To 1023:couleur(i)=Random($ffffff):Next

Dim bmp.l(ey-1,ex-1)
cx=ex/2
cy=ey/2
Repeat 
  WindowEvent()
  ExamineMouse()
  ExamineKeyboard()
  cpt+10
  For j=0 To ey-1
    For i=0 To ex-1
      x=i-cx
      y=j-cy
      n=(100000000/(x*x+y*y+1000)+cpt)*0.01
      bmp(j,i)=couleur(n & 1023)
    Next
  Next
  
  StartDrawing(ScreenOutput()):CopyMemory(@bmp(0,0),DrawingBuffer(),ex*ey*4):StopDrawing()
  FlipBuffers()  
Until KeyboardPushed(#PB_Key_Escape)

Re: Des cercles a dessiner sans "circle"

Publié : mar. 23/avr./2019 12:29
par SPH
on peux dire que c'est un tunnel pèpère :mrgreen:

Re: Des cercles a dessiner sans "circle"

Publié : mar. 23/avr./2019 18:21
par Mouillard
Bonjour à tous... :o
Merci Pf Shadoko pour ce superbe tunnel . B Si j'étais PDG , je t'embaucherais tout de suite... :P et je blague pas... :!: :!: :idea:
Ollivier : tu as raison, les codes "Avancés" de LSI sont toujours efficaces malgré le temps passé :!: :roll:

Re: Des cercles a dessiner sans "circle"

Publié : mar. 23/avr./2019 23:01
par Ar-S
SPH a écrit :pour faire un effet tunnel en cercles comme dans les vieilles démos.
Voilà un code de Thorsten Will aka va!n que j'ai un poil remis au gout du jour (code de 2007) permettant de créer un tunel via une texture.
Si tu veux je pourrai te faire le détails de son code. à la base il a fait des étapes avant de poster ce code.

Code : Tout sélectionner

; *************************************************************************************
; *   P r o j e c t :    T u n n e l - F x
; *************************************************************************************
; *
; *   Part7: Moving Tunnel:
; *   ---------------------
; *   This is the last turorial part, where we will try to get the tunnel fx more 
; *   interesting while moving the tunnel, by using SIN().
; * 
; *   Source and Tutorial (c) by Thorsten Will aka va!n
; *   All rights reserved.
; *
; *************************************************************************************

; Procedure.d ATan2(y.d, x.d)
;   !FLD qword[p.v_y]
;   !FLD qword[p.v_x]
;   !FPATAN
;   ProcedureReturn 
; EndProcedure

DisableDebugger

; -------- Init Code --------

lTextureSize.l  = 256
lScreenWidth.l  = 640
lScreenHeight.l = 480

Dim aTexture  (lTextureSize  , lTextureSize   )
Dim aDistance (lScreenWidth*2, lScreenHeight*2)
Dim aAngle    (lScreenWidth*2, lScreenHeight*2)
Dim aBuffer   (lScreenWidth  , lScreenHeight  )

; -------- Generating Mapping Texture --------

For x.l = 0 To lTextureSize -1
  For y.l = 0 To lTextureSize -1
    aTexture(x,y) = (x * 256 / lTextureSize) ! (y * 256 / lTextureSize) 
  Next 
Next

; -------- Generating Distance and Angle Table --------

dDistance.d = 32.0
dParts.d    =  0.5 
          
For x = 0 To lScreenWidth*2 -1      
  For y = 0 To lScreenHeight*2 -1
    aDistance(x,y) = Int(dDistance * lTextureSize / Sqr( (x-lScreenWidth) * (x-lScreenWidth) + (y-lScreenHeight) * (y-lScreenHeight) )) % lTextureSize
    dAngle.d = (dParts * lTextureSize * ATan2(y-lScreenHeight, x-lScreenWidth) / #PI)
    aAngle(x,y) = Int (256 - dAngle) & 255
  Next
Next

; *************************************************************************************

InitSprite() 

OpenWindow(0,0,0,lScreenWidth,lScreenHeight,"",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,lScreenWidth, lScreenHeight,0,0,0,#PB_Screen_WaitSynchronization )

dSpeedX.d = 1.0
dSpeedY.d = 1.0

Repeat
  ; ------- Stuff for doing the animation -------
  
  dAnimation.d = dAnimation.d + 0.005
  
  lShiftX.l = Int(lTextureSize * dSpeedX.d * dAnimation.d)
  lShiftY.l = Int(lTextureSize * dSpeedY.d * dAnimation.d)

  lLookX = lScreenWidth /2 + Int(lScreenWidth /2 * Sin(dAnimation * 4.0 ))
  lLookY = lScreenHeight/2 + Int(lScreenHeight/2 * Sin(dAnimation * 6.0 ))

  ; -------- Calculate Texture coordinates and draw Tunnel -------

  StartDrawing(ScreenOutput())
    For y = 0 To lScreenHeight-1
      For x = 0 To lScreenWidth -1
        lCoordinateX.l = (aDistance(x+lLookX, y+lLookY) + lShiftX) % lTextureSize     
        lCoordinateY.l = (aAngle   (x+lLookX, y+lLookY) + lShiftY) % lTextureSize     
        aBuffer(x,y) = aTexture (lCoordinateX.l , lCoordinateY.l) 
        Plot(x, y, RGB(0, 0, aBuffer(x,y) ))
      Next 
    Next
  StopDrawing()

  FlipBuffers()
Until GetAsyncKeyState_(#VK_ESCAPE)

; *************************************************************************************

Re: Des cercles a dessiner sans "circle"

Publié : mar. 23/avr./2019 23:10
par SPH
Haaa, ouaiiiii, pas mal :idea:
Fuseau horaire sur UTC+01:00
Page 2 sur 4

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru