PureBasic

Forums PureBasic
Nous sommes le Mer 19/Juin/2019 6:07

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 56 messages ]  Aller à la page Précédente  1, 2, 3, 4  Suivante
Auteur Message
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 17:03 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3413
Parce que tout est déjà là depuis bien longtemps...
Code:
;*************************************************************************************************************************************************************************
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

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 17:17 
Hors ligne

Inscription: Lun 30/Aoû/2004 21:03
Messages: 88
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.

_________________
http://crisot.com/odyssey
http://crisot.com/dev


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 17:32 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3413
SPH a écrit:
pourquoi tu ne ponds pas un code complet ?


Alors ? Y'a pas un rond troué ptêt ?
La routine ouais...

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 17:39 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3413
Et pis tu peux aller vérifier sur une vieille version 5.22 ça marche aussi !

Que du TransformSprite()...

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 21:06 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3959
Version antialiasing plutot raté :

Code:
;
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

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 21:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 255
houla !
tres jolie effet
( Xc = Pow(Pow(255.0, Alpha) - Pow(255 - X, Alpha), 1.0 / Alpha) )


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 21:21 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3413
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.

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 21:31 
Hors ligne

Inscription: Ven 29/Juin/2007 17:50
Messages: 3413
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:
ClearScreen(0)
par
Code:
ClearScreen(RGB(32,64,128)
Tu verras alors des poils apparaître.

_________________
Juste la 4G pour Smartphone


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Lun 22/Avr/2019 21:38 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3959
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)

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Mar 23/Avr/2019 9:37 
Hors ligne

Inscription: Lun 30/Aoû/2004 21:03
Messages: 88
Bah go faire ton effet au lieu de coder des cercles :mrgreen:

_________________
http://crisot.com/odyssey
http://crisot.com/dev


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Mar 23/Avr/2019 12:24 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 255
tiens un petit effet tunnel
sans circle et sans cosinus
(equation d'un cercle: x²+y²=rayon² )

!!! Enlever le déboguer !!!

Code:
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)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Mar 23/Avr/2019 12:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3959
on peux dire que c'est un tunnel pèpère :mrgreen:

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Mar 23/Avr/2019 18:21 
Hors ligne

Inscription: Mer 13/Sep/2017 14:35
Messages: 60
Localisation: Picardie (Somme)
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:


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Mar 23/Avr/2019 23:01 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8670
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:
; *************************************************************************************
; *   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)

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

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Des cercles a dessiner sans "circle"
MessagePosté: Mar 23/Avr/2019 23:10 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3959
Haaa, ouaiiiii, pas mal :idea:

_________________
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 56 messages ]  Aller à la page Précédente  1, 2, 3, 4  Suivante

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 2 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye