Tête inversible

'                        TETE INVERSIBLE
'  Auteur: parpaiun
'  Date-version: 10/04/2016
'
' Pour PANORAMIC, il existe deux types d'arcs:
' EXTARC = arc à tracé externe au centre de rotation pouvant être visible. Pas de suivi.
' INTARC = arc à centre de rotation calculé, externe et pouvant être invisible.
'                Le point de départ est intégré au tracé et le suivi est assuré.
'
width 0,425 : height 0,700
label calcul1,calcul2
dim ang,B,cx,cy,dd,G,ln,R,rad,x,y
rad=0.01745
cx=200 : cy=310
'
' Ovale-tête
2d_pen_width 2
ellipse(cx,cy,100,150)
'
' Yeux
dim mx(4),my(4)
ln=36
mx(1)=30 : my(1)=10
droite(mx(1),my(1),225,ln,0)
mx(2)=x : my(2)=y
droite(x,y,315,ln,0)
mx(3)=x : my(3)=y
' Oeil gauche
extarc(mx(1)+120,my(1)+275,ln,225,315,1)
extarc(mx(3)+120,my(3)+275,ln,45,135,1)
2d_circle 151,cy+1,10
2d_circle 151,cy+1,2
' Oeil droit
extarc(mx(1)+220,my(1)+275,ln,225,315,1)
extarc(mx(3)+220,my(3)+275,ln,45,135,1)
2d_circle 251,cy+1,10
2d_circle 251,cy+1,2
'
' Bouche du bas
extarc(cx,cy+30,70,243,297,1)
droite(cx-30,cy+89,225,10,1)
droite(cx+30,cy+89,310,10,1)
'
' Extrémités nez du bas
extarc(cx+3,cy+45,20,153,207,1)
extarc(cx-3,cy+45,20,333,27,1)
'
' Extrémités nez du haut
extarc(cx+5,cy-40,20,153,207,1)
extarc(cx-5,cy-40,20,333,27,1)
'
' Bouche du haut
extarc(cx,cy-55,40,54,126,1)
droite(cx+22,cy-84,45,10,1)
droite(cx-20,cy-85,135,10,1)
'
' Oreille gauche
intarc(cx-98,cy-30,30,108,252,1)
2d_flood cx-108,cy,255,207,169
'
' Oreille droite
intarc(cx+98,cy+26,30,288,72,1)
2d_flood cx+108,cy,255,207,169
'
' Coloration du visage
2d_flood cx,cy,255,207,169
'
' 1/2 cravate papillon gauche
2d_circle cx,cy+190,30
2d_circle cx,cy+190,15

intarc(cx-40,cy+139,40,185,240,1)
droite(x,y,160,120,1)
droite(x,y,270,135,1)
droite(x,y,25,125,1)
'
' 1/2 cravate papillon droit
intarc(cx+42,cy+139,41,355,300,-1)
droite(x,y,23,120,1)
droite(x,y,270,135,1)
droite(x,y,158,125,1)
'
' Coloration de la cravate papillon
dd=12
2d_circle cx-60,cy+190,dd
2d_flood cx-60,cy+190,255,255,0
2d_circle cx-110,cy+165,dd
2d_circle cx-110,cy+225,dd
'
2d_circle cx+60,cy+190,dd
2d_circle cx+110,cy+165,dd
2d_circle cx+110,cy+220,dd
'
2d_flood cx,cy+190,0,255,255
2d_flood cx-80,cy+190,0,255,255
2d_flood cx+80,cy+190,0,255,255
'
' Béret de marin à pompon
intarc(cx+70,cy-155,50,140,180,1)
intarc(cx-60,cy-120,50,0,44,1)
2d_line cx,cy-157,cx+100,cy-157
intarc(cx+100,cy-157,15,270,90,1)
2d_line x,y,cx-105,y
intarc(cx-100,y,15,90,270,1)
2d_line x,y,cx,cy-157
2d_circle cx,cy-213,25
2d_flood cx,cy-213,255,0,0


END
' ==========================================================================
sub ellipse(elx,ely,rx,ry)
dim_local pi,t
pi=acos(-1) : rad=pi/180
2d_poly_from elx+rx,ely
for t=0 to 2*pi step rad
x=elx+rx*cos(t) : y=ely+ry*sin(t)
2d_poly_to x,y
next t
END_SUB

SUB droite(dx,dy,da,dl,dt)
dim_local i
for i=1 to dl
R=0 : G=0 : B=0
if dt=0 then R=255 : G=255 : B=255
2d_pen_color R,G,B
if i=1
 2d_poly_from dx,dy
else
 2d_poly_to dx,dy
end_if
dx=dx+cos(da*rad) : dy=dy+sin(-1*da*rad)
next i
x=dx : y=dy
END_SUB

SUB extarc(ex,ey,er,ed,ea,et)
ang=ed
calcul1:
x=ex+er*cos(ang*rad)
y=ey+er*sin(-1*ang*rad)
R=0 : G=0 : B=0
if et=0 then R=255 : G=255 : B=255
2d_pen_color R,G,B
if ang=ed
 2d_poly_from x,y
else
 2d_poly_to x,y
end_if
if ang=ea then exit_sub
if et=1
 ang=ang+1 : if ang=360 then ang=0
else
 if ang=0 then ang=360
 ang=ang-1
 end_if
goto calcul1
END_SUB

SUB intarc(ix,iy,ir,id,ia,it)
dim_local icx,icy
icx=int(ix-(ir*cos(id*rad)))
icy=int(iy-(ir*sin(-1*id*rad)))
ang=id
calcul2:
x=int(icx+ir*cos(ang*rad))
y=int(icy+ir*sin(-1*ang*rad))
R=0 : G=0 : B=0
if it=0 then R=255 : G=255 : B=255
2d_pen_color R,G,B
if ang=id
 2d_poly_from x,y
 else
 2d_poly_to x,y
end_if
if ang=ia then EXIT_SUB
if it=1
 ang=ang+1: if ang=360 then ang=0
else
 if ang=0 then ang=360
  ang=ang-1
end_if
goto calcul2
END_SUB