Forum de Programmation en langage PANORAMIC
Rechercher
 
 

Résultats par :
 


Rechercher Recherche avancée

Mots-clés

Moiré  Panoramic  esthetique  fougère  

Derniers sujets
»  Exemple de menu
Lun 26 Juin - 22:36 par Admin

» Utilisation du caractère Ampersand (&) dans un caption
Lun 26 Juin - 22:32 par Admin

» TRIGONOMETRIE CIRCULAIRE ET HYPERBOLIQUE
Ven 23 Juin - 0:59 par Admin

» RECHERCHE DICHOTOMIQUE DANS UN TABLEAU TRIE
Ven 23 Juin - 0:46 par Admin

» Table de multiplication
Ven 23 Juin - 0:44 par Admin

» Quelle heure est-il ?
Mar 20 Juin - 3:32 par Admin

» Fonctions de la user32.dll
Dim 18 Juin - 14:56 par Admin

»  Biomorphes de PICKOVER
Dim 18 Juin - 0:35 par Admin

» En moins de 10 lignes de code : Effet spectaculaire !
Ven 16 Juin - 2:13 par Admin

Juin 2017
LunMarMerJeuVenSamDim
   1234
567891011
12131415161718
19202122232425
2627282930  

Calendrier Calendrier


Démonstration de Draw_polygone

Voir le sujet précédent Voir le sujet suivant Aller en bas

Démonstration de Draw_polygone

Message par Admin le Jeu 13 Oct - 14:52

Code:

rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
rem        Démonstration de Draw_polygone
rem               Par Papydall
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================

Init()
Engine()
Fermer_La_Boutique()
terminate
end
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Initialisation et déclarations des variables globales
SUB Init()
    dim result%, n_poly%, pnt(1),deg2rad ,newx,newy
    dim poly(200,1)
    dim rod$,piston$,cylinder$,cross$
    width 0,800 : height 0,400
    caption 0,"<CLICK> pour arrêter .............."
    picture 10 : full_space 10 : 2d_target_is 10 : hide 10 : 2d_fill_on
    image 20
    deg2rad = pi/180

    rod$ = "2,1,2,-1,1,-2,-13,-2,-14,-1,-14,1,-13,2,1,2,2,1"
    piston$ = "-1,1,-1,-1,0,-2,5,-2,6,-3,13,-3,13,3,6,3,5,2,0,2,-1,1"
    cylinder$ = "-3,3,10,3,10,-3,-3,-3,-3,-4,11,-4,13,0,11,4,-3,4,-3,3"
    cross$ = "-1,4,1,4,1,1,4,1,4,-1,1,-1,1,-4,-1,-4,-1,-1,-4,-1,-4,1,-1,1,-1,4"

END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================

SUB Engine()
    dim_local x
    repeat
        color 10,128,128,0

        Draw_Polygone(rod$,9,480+35*cos(x),150,10,(sin(x)/4)/deg2rad,80,80,80)
        2d_fill_color 20,20,20 : 2d_circle 360,150,50
        Draw_Polygone(cross$,13,360,150,10,0-x/deg2rad,120,120,120)
        Draw_Polygone(rod$,9,240+35*(0-cos(x)),150,10,(0-sin(0-x)/4+pi)/deg2rad,80,80,80)

        Draw_Polygone(piston$,11,480+35*cos(x),150,10,0,120,120,120)
        Draw_Polygone(piston$,11,240+35*(0-cos(x)),150,10,180,120,120,120)

        Draw_Polygone(cylinder$,10,560,150,10,0,20,20,20)
        Draw_Polygone(cylinder$,10,160,150,10,180,20,20,20)
        
        2d_fill_color 120*(sin(x))+125,127,120*(sin(x+pi))+125
        2d_rectangle 61,121,61+35*(0-cos(x))+49,121+59
        2d_rectangle 611-35*(0-cos(x)),121,611-35*(0-cos(x))+35*(0-cos(x))+52,121+59

        2d_flood 45,148,255,255,0  : 2d_flood 670,148,255,255,0
        copy_image()
        x = x + .5
    until scancode <> 0 or x > 10000
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
SUB Fermer_La_Boutique()
    dim_local i
    for i = height(0) to 0 step -1 : height 0,i : next i
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Tracer le polygone dont les sommets sont donnés par des coordonnées x,y stockés
' à la suite les unes des autres dans la chaîne P$.
' Le coin supérieur gauche sera positionné aux coordonnées xo,yo.

' Paramètres:
' P$      : chaine contenant les différentes coordonnées des sommets du polygone
' n       : nombre de sommets du polygone
' xo,yo   : coordonnées du coin supérieur gauche du tracé (origine)
' echelle : facteur d'agrandissement / rapetissement du polygone
'           Si echelle > 1 alors c'est un agrandissement
'           Si echelle < 1 alors c'est un rapetissement
'           Si echelle = 1 alors on conserve la taille
' angle   : valeur en degré de rotation du polygone à partir de l'origine dans
'           le sens des aiguilles d'une montre si angle est positif, et dans
'           le sens trigonométrique si angle est négatif
' r,g,b   : couleur du remplissage du polygone
rem ============================================================================
SUB Draw_Polygone(p$,n,xo,yo,echelle,angle,r,g,b)
    dim_local a$,l,virgule,p,i,x,y
    a$ = p$ + "," : l = len(a$) : virgule = instr(a$,",")
    x = val(left$(a$,virgule - 1)) : ' abscisse de l'origine du polygone
    a$ = right$(a$,l-virgule) : l = len(a$) : virgule = instr(a$,",")
    y = val(left$(a$,virgule - 1)) : ' ordonnée de l'origine du polygone
    poly(0,0) = x : poly(0,1) = y
' On calcule les nouvelles coordonnées de l'origine du tracé pour la rotation
    Rotation_Point(x,y,angle) : 2d_poly_from xo + newx*echelle,yo + newy*echelle
' Poly to
    a$ = right$(a$,l-virgule) : l = len(a$) : virgule = instr(a$,",")
    p = 1
' On détermine les coordonnées des differents sommets du polygones
    while  l > 0
        p = p + 1
        x = val(left$(a$,virgule - 1))
        a$ = right$(a$,l-virgule) : l = len(a$) : virgule = instr(a$,",")
        y = val(left$(a$,virgule - 1))
        poly(p,0) = x : poly(p,1) = y : ' coordonnées du sommet numéro P
' On calcule de même les nouvelles coordonnées de tous les sommets pour la rotation
        Rotation_Point(x,y,angle) : 2d_poly_to xo + newx*echelle,yo + newy*echelle
        a$ = right$(a$,l-virgule) : l = len(a$) : virgule = instr(a$,",")
    end_while
' On remplit la surface du polygone avec la couleur R,G,B
    flooder(n,xo,yo,echelle,angle,r,g,b)

END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Calculer les nouvelles coordonnées dans la rotation tetha
' Le paramètre tetha est transmis en degrés.
' Rappel :
' La matrice de rotion d'angle tetha est :
' (  cos(tetha)   -sin(tetha) )
' |                           |
' (  sin(tetha)    cos(tetha) )
SUB Rotation_Point(x,y,tetha)
    dim_local t
    t = deg2rad * tetha : ' conversion de degrés en radians
    newx =  x * cos(t) - y * sin(t) : newy =  x * sin(t) + y * cos(t)
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Remplissage du polygone par la couleur R,G,B
SUB flooder(n,xo,yo,echelle,angle,r,g,b)
    dim_local x,y,coin%
    for coin% = 0 to n - 1
        pnt(0) = poly(coin%,0) + 2/echelle : pnt(1) = poly(coin%,1) + 2/echelle
        PointInPolygon(n) : ' Déterminer un point à l'intérieur du polygone
        if result%=1
           x = pnt(0) : y = pnt(1) : Rotation_Point(x,y,angle)
' Faire le remplissage de la figure
           2d_flood xo + newx*echelle,yo + newy*echelle ,r,g,b
           exit_sub
        end_if
    next coin%

END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Merci à Klaus pour cette SUB
' Déterminer les coordonnées d'un point à l'intérieur du polygone pour servir
' à la commande 2D_FLOOD
SUB  PointInPolygon(n_poly%)
     dim_local aDroite%, aGauche%, np%, XIntersection, lg1%, lg2%
     result% = 0 : aDroite% = 0 : aGauche% = 0
     if n_poly% < 3 then exit_sub
     for np% = 1 to n_poly% - 1
         lg1% = 0 : lg2% = 0
         if (Poly(np%-1,1) <= pnt(1)) and (Poly(np%,1) >  pnt(1)) then lg1% = 1
         if (Poly(np%-1,1) >  pnt(1)) and (Poly(np%,1) <= pnt(1)) then lg2% = 1
         if (lg1% = 1) or (lg2% = 1)
' calculer les coordonnées x de l'intersection
            XIntersection = Poly(np%-1,0) + ((Poly(np%,0)-Poly(np%-1,0)) / (Poly(np%,1)-Poly(np%-1,1))) * (pnt(1)-Poly(np%-1,1))
' adapter l'indicateur approprié
            if XIntersection < pnt(0) then aGauche% = 1 - aGauche%
            if XIntersection > pnt(0) then aDroite% = 1 - aDroite%
        end_if
   next np%
   if (aDroite% = 1) and (aGauche% = 1) then Result% = 1
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================

' Pour éviter le clignotement dans le PICTURE du travail
' Merci à Silverman pour cette astuce
SUB Copy_Image()
    2d_image_copy 20,left(10),top(10),width(10),height(10)
    2d_target_is 0: 2d_image_paste 20,left(10),top(10) : 2d_target_is 10
END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================

_________________
Invité, merci d'être passé par ici.
avatar
Admin
Admin

Messages : 58
Date d'inscription : 08/09/2015
Age : 66
Localisation : MOKNINE (Tunisie)

Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com

Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum