Rotation Algorithm

REM ===================================================================
REM
REM                    ROTATION ALGORITHM
REM
REM ===================================================================
REM  Auteur: Parpaiun
REM  Date-version: 21/06/2015
REM ===================================================================
LABEL retour
DIM a,cx,cy,f,i,j,l,rn,sw,u,x,y,z
DIM c(20),e(30,2),mx(24),my(24),n(40)
f=3  :' Ecart entre droites
l=3
a=0.6
FONT_SIZE 0,14

REM ===================================================================
' Paramètres de POLY
' p1 = Nombre de sommets du polygone
' p2 = Inclinaison du 1er côté en degrés
' p3 = Longueur de chaque côté
' p4 = Coordonnée en x du premier sommet
' p5 = Coordonnée en y du premier sommet
REM ===================================================================
height 0,980 : width 0,980
cx=480 : cy=475
REm  Pour centrer exactement le polygone et préciser son centre
' 2D_CIRCLE cx,cy,420
' 2D_CIRCLE cx,cy,3
' 2D_line cx,50,cx,500
REM ===================================================================
  sw=1  :' Aiguillage vers un traitement
SELECT sw
 CASE 1
  POLY(3,240,726,480,56)
  MID(1,2)
  MID(2,3)
  MID(3,1)
  CENTRE()
  ROTATE6(1,4,7,1,6,7)
  ROTATE6(2,5,7,2,4,7)
  ROTATE6(3,5,7,3,6,7)
  JOIN12(1,7,4,7,2,7,5,7,3,7,6,7)
  Print: Print " IMAGE n°1"
END_SELECT

END
REM ===================================================================

SUB POLY(p1,p2,p3,p4,p5)
dim_local b,PI,RAD
PI=acos(-1): rad=PI/180 : p2=p2*RAD
x=p4 : y=p5
2D_POLY_FROM x,y  :' Coordonnées du premier sommet
u=u+1: mx(u)=x: my(u)=y
i=i+1: c(i)=u
b=2*PI/p1
for i=2 to p1
 x=x+p3*COS(p2): y=y+p3*SIN(p2)*-1
 2D_POLY_TO x,y
 u=u+1: mx(u)=x: my(u)=y
 c(i)=u
 p2=p2+b
next i
2D_POLY_TO mx(1),my(1)

END_SUB
'
SUB MID(m1,m2)
 u=u+1
 mx(u)=(mx(m1)+mx(m2))/2
 my(u)=(my(m1)+my(m2))/2
'  2D_CIRCLE mx(u),my(u),3
 i=i+1: c(i)=u
END_SUB
rem ============================
SUB CENTRE()
 2D_CIRCLE cx,cy,2
 u=u+1: mx(u)=cx: my(u)=cy
 i=i+1: c(i)=u
END_SUB
rem ============================
SUB ROTATE3(r1,r2,r3)
for j=1 to 3
 SELECT j
  CASE 1
  z=r1
  CASE 2
  z=r2
  CASE 3
  z=r3
 END_SELECT
 c(j)=z
next j
 ROTATE_ALL(3)

END_SUB
rem ==============================
SUB ROTATE4(r1,r2,r3,r4)
 for j=1 to 4
  SELECT j
  CASE 1
    z=r1
  CASE 2
    z=r2
  CASE 3
    z=r3
  CASE 4
  z=r4
  END_SELECT
  c(j)=z
next j
ROTATE_ALL(4)

END_SUB
rem =============================
SUB ROTATE5(r1,r2,r3,r4,r5)
 for j=1 to 5
  SELECT j
  CASE 1
    z=r1
  CASE 2
    z=r2
  CASE 3
    z=r3
  CASE 4
  z=r4
  CASE 5
  z=r5
  END_SELECT
  c(j)=z
next j
ROTATE_ALL(5)

END_SUB
rem =============================

SUB ROTATE6(r1,r2,r3,r4,r5,r6)
 for j=1 to 6
  SELECT j
  CASE 1
    z=r1
  CASE 2
    z=r2
  CASE 3
    z=r3
  CASE 4
  z=r4
  CASE 5
  z=r5
  CASE 6
  z=r6
  END_SELECT
  c(j)=z
next j
ROTATE_ALL(6)
END_SUB
rem ============================

SUB ROTATE_ALL(rn)
 DIM_LOCAL s$,x1,x2
 for j=1 to rn
  e(j,1)=mx(c(j))
  e(j,2)=my(c(j))
 next j
 e(j,1)=e(1,1)
 e(j,2)=e(1,2)
'
 retour:
  for j=1 to rn
  x1=(e(j+1,1)-e(j,1))*(e(j+1,1)-e(j,1))
  x2=(e(j+1,2)-e(j,2))*(e(j+1,2)-e(j,2))
  n(j)=(f*l)/sqr(x1+x2)
  if n(j)>a then EXIT_SUB
  next j
'
 for j=1 to rn
  e(j,1)=e(j,1)+n(j)*(e(j+1,1)-e(j,1))
  e(j,2)=e(j,2)+n(j)*(e(j+1,2)-e(j,2))
  if j=1
  2D_POLY_FROM e(j,1),e(j,2)
    Else
  2D_POLY_TO e(j,1),e(j,2)
  END_IF
 next j
 e(j,1)=e(1,1)
 e(j,2)=e(1,2)
  2D_POLY_TO e(j,1),e(j,2)
 s$=inkey$ : if s$<>"" then EXIT_PROC
GOTO retour
END_SUB
rem ==================================

SUB JOIN12(j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12)
 2D_LINE mx(j1),my(j1),mx(j2),my(j2)
 2D_LINE mx(j3),my(j3),mx(j4),my(j4)
 2D_LINE mx(j5),my(j5),mx(j6),my(j6)
 2D_LINE mx(j7),my(j7),mx(j8),my(j8)
 2D_LINE mx(j9),my(j9),mx(j10),my(j10)
 2D_LINE mx(j11),my(j11),mx(j12),my(j12)
END_SUB