Démonstration de Draw_polygone

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

Init()
Decors()
Fermer_La_Boutique()
terminate
end
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Initialisation et déclarations des variables globales
SUB Init()
    dim result%, n_poly%, pnt(1), pi,deg2rad ,newx,newy
    dim poly(200,1)
    dim plane$,barrel$,obus$
    
    full_space 0  : caption 0,"<CLICK> pour terminer .............."
    picture 10 : full_space 10 : 2d_target_is 10 : print_target_is 10
    font_name 10 ,"tahoma" : font_color 10,255,0,0 : font_size 10,16 : hide 10
    image 20
    pi = acos(-1) : deg2rad = pi/180

' String contenant les coordonnées des sommets du polygone représentant l'avion
    plane$ = plane$ + "000,056, 010,046, 157,046, 197,002, 222,002, 222,027, 177,067,"
    plane$ = plane$ + "177,214, 165,223, 128,116, 092,148, 090,191, 076,207, 069,177,"
    plane$ = plane$ + "062,173, 054,178, 045,178, 046,168, 053,157, 024,149, 021,143,"
    plane$ = plane$ + "032,133, 076,133, 108,097, 002,062, 000,056"
' String contenant les coordonnées des sommets du polygone représentant le canon du char
    barrel$ = "0,-1, 0,1, 20,1, 20,-1, 0,-1"
' String contenant les coordonnées des sommets du polygone représentant un obus
    obus$ = "10,10,30,10,35,15,30,20,10,20,10,10"

END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
' Mise en place et mouvements des types d'objets (avion et char)
SUB Decors()
    dim_local i,x,y,a

    while 1 = 1
       for x = .1 to 8*pi step 0.2
           color 10,80,100,150
           print_locate 20,20 : print "Demonstration de Draw_polygone"
           print_locate width(0)/2-100,20 : print "<CLICK> pour mettre fin à l'ennui !!!"
           y =  sin(x) : a = (cos(x)+ pi/4)/deg2rad
' Les avions évoluent en suivant la pente de la tangente d'une courbe sinusoïdale
           Draw_Polygone(plane$,26,60*x,200+150*y,1/4,a,255,0,255)
           Draw_Polygone(plane$,26,500+80*x,200+100*y,1/5,a,255,255,255)
           Draw_Polygone(plane$,26,800+100*x,200+150*y,1/6,a,10,10,10)
           Draw_Polygone(plane$,26,150+120*x,200+50*y,1/7,a,100,200,0)
          
           Draw_Polygone(plane$,26,250+120*x,200+50*y,1/7,a,10,50,100)
           Draw_Polygone(plane$,26,120*x,200+50*y,1/4,a,10,50,100)

' Mettre en place les chars
           for i = 0 to width(10) step 200
            Char(i,0,45+a)

             next i
           copy_image() : ' Pour éliminer le clignotement
           if scancode <> 0 then exit_while
       next x
    end_while

END_SUB
rem ============================================================================
rem &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
rem ============================================================================
SUB Fermer_La_Boutique()
    dim_local i
     color 10,80,100,150
     print_locate 500,100 : print "Au revoir et à  la prochaine !!!"
     Draw_Polygone(plane$,26,10,300,2,0,255,0,255)
     Draw_Polygone(plane$,26,400,600,2,-45,255,255,255)
     Draw_Polygone(plane$,26,900,700,2,-90,255,255,0)
      copy_image() : pause 2000
    for i = height(0) to 0 step -2 : 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 ============================================================================
' Dessiner un tank
SUB Char(x0,x,a)
    dim_local i
    2d_fill_color 0,0,0 : 2d_pen_color 0,0,0
    2d_circle x0+100+10*x,700,10 : 2d_circle x0+160+10*x,700,10 :2d_circle x0+130+10*x,690,10
    2d_rectangle x0+100+10*x,690,x0+160+10*x,710
    if a > 0 then a = 0-a
    if a < -180 then a = -180
    Draw_Polygone(barrel$,5,x0+130+10*x,678,2,a,0,0,0): ' dessiner le canon selon l'angle a
    2d_fill_color 255,255,0 : 2d_circle x0+130+10*x,678-10*x,10
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 ============================================================================

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), pi,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
    pi = acos(-1) : 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 ============================================================================