Tangram

' Tangram.bas

label click, touche

dim unite% : unite% = 160
dim bord%  : bord%  =  10
dim KGF$   : KGF$ = "C:\Users\klausgunther\Documents\Mes projets\Mes projets Delphi\KGF\KGF.dll"
if file_exists(KGF$)=0 then KGF$ = ""

dim pieces%(7,6)
  ' (n%,d%)  n%=numéro de pièce (1...7)
  '          d%=0 flag "présent" 0/1
  '          d%=1 n%
  '          d%=2 x% dans 101
  '          d%=3 y% dans 101
  '          d%=4 degré de rotation
  '          d%=5 x% dans 1
  '          d%=6 y% dans 1

dim xp%, yp%, base1%, modele%

width  0,4*unite%+2*bord% + 16
height 0,4.5*unite%+2*bord% + 39
caption 0,"Tangram"
on_key_down 0,touche

picture 1 : width 1,4*unite%+2*bord% : height 1,4.5*unite%+2*bord%
            2d_target_is 1
            print_target_is 1

form 100 : top 100,top(0) : left 100,left(0)+width(0)
           height 100,height(0) : width 100,3*unite%
picture 101 : parent 101,100 : full_space 101

button 102 : parent 102,100 : top 102,height(100)-80 : left 102,10
           caption 102,"Initialiser" : on_click 102,click

combo 103 : parent 103,100 : top 103,height(100)-110 : left 103,10 : on_click 103,click
  item_add 103,"Le carré"
  text 103,item_read$(103,1)
  modele% = 1

if KGF$<>"" then dll_on KGF$
initialiser()

end

touche:
  return


click:
  traiter_click(number_click)
  return
  
sub traiter_click(id%)
  dim_local res%
  off_click id%
  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,1+2+4)
  select id%
    case 1:   ' terrain
    case 102: ' initialiser
      initialiser()
      
    case 103: ' choix du modèle
      modele% = item_index(103)
      initialiser()
      
    case 111: ' pièce 1 à gauche
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,1)
    case 121: ' pièce 1 à droite
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,-1)
    case 131: ' déplacement à gauche
      pieces%(1,5) = pieces%(1,5) - unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 141: ' déplacement en haut
      pieces%(1,6) = pieces%(1,6) - unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 151: ' déplacement à droite
      pieces%(1,5) = pieces%(1,5) + unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 161: ' déplacement en bas
      pieces%(1,6) = pieces%(1,6) + unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)

    case 112: ' pièce 2 à gauche
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,1)
    case 122: ' pièce 2 à droite
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,-1)
    case 132: ' déplacement à gauche
      pieces%(2,5) = pieces%(2,5) - unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 142: ' déplacement en haut
      pieces%(2,6) = pieces%(2,6) - unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 152: ' déplacement à droite
      pieces%(2,5) = pieces%(2,5) + unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 162: ' déplacement en bas
      pieces%(2,6) = pieces%(2,6) + unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)

    case 113: ' pièce 3 à gauche
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,1)
    case 123: ' pièce 3 à droite
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,-1)
    case 133: ' déplacement à gauche
      pieces%(3,5) = pieces%(3,5) - unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 143: ' déplacement en haut
      pieces%(3,6) = pieces%(3,6) - unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 153: ' déplacement à droite
      pieces%(3,5) = pieces%(3,5) + unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 163: ' déplacement en bas
      pieces%(3,6) = pieces%(3,6) + unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)

    case 114: ' pièce 4 à gauche
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,1)
    case 124: ' pièce 4 à droite
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,-1)
    case 134: ' déplacement à gauche
      pieces%(4,5) = pieces%(4,5) - unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 144: ' déplacement en haut
      pieces%(4,6) = pieces%(4,6) - unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 154: ' déplacement à droite
      pieces%(4,5) = pieces%(4,5) + unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 164: ' déplacement en bas
      pieces%(4,6) = pieces%(4,6) + unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)

    case 115: ' pièce 5 à gauche
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,1)
    case 125: ' pièce 5 à droite
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,-1)
    case 135: ' déplacement à gauche
      pieces%(5,5) = pieces%(5,5) - unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 145: ' déplacement en haut
      pieces%(5,6) = pieces%(5,6) - unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 155: ' déplacement à droite
      pieces%(5,5) = pieces%(5,5) + unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 165: ' déplacement en bas
      pieces%(5,6) = pieces%(5,6) + unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)

    case 116: ' pièce 6 à gauche
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,1)
    case 126: ' pièce 6 à droite
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,-1)
    case 136: ' déplacement à gauche
      pieces%(6,5) = pieces%(6,5) - unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 146: ' déplacement en haut
      pieces%(6,6) = pieces%(6,6) - unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 156: ' déplacement à droite
      pieces%(6,5) = pieces%(6,5) + unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 166: ' déplacement en bas
      pieces%(6,6) = pieces%(6,6) + unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)

    case 117: ' pièce 7 à gauche
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,1)
    case 127: ' pièce 7 à droite
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,-1)
    case 137: ' déplacement à gauche
      pieces%(7,5) = pieces%(7,5) - unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 147: ' déplacement en haut
      pieces%(7,6) = pieces%(7,6) - unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 157: ' déplacement à droite
      pieces%(7,5) = pieces%(7,5) + unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 167: ' déplacement en bas
      pieces%(7,6) = pieces%(7,6) + unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)


  end_select
  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,0)
  on_click id%,click
end_sub
  
sub initialiser()
  dim_local i%, xbase%, ybase%, xunite%

  if object_exists(131)=1
    active 131 : active 132 : active 133 : active 134 : active 135 : active 136 : active 137
  end_if
  
  xunite% = unite%/2
  color 1,255,127,127
  font_color 1,255,255,255
  font_bold 1
  2d_target_is 1
  2d_pen_color 102,0,0
  2d_pen_width 2
  for i%=1 to 7
    pieces%(i%,0) = 0    : ' pièce absente
    pieces%(i%,1) = i%   : ' numéro de pièce
    pieces%(i%,2) = 0    : ' coordonnée x
    pieces%(i%,3) = 0    : ' coordonnée y
    pieces%(i%,4) = 0    : ' rotation en °
  next i%
  
  ' afficher le modèle
  select modele%
    case 1: ' le carré
      2d_target_is 1
      2d_pen_color 0,0,0
      2d_fill_color 255,127,127
      2d_rectangle bord%+unite%,bord%+unite%,bord%+2*unite%,bord%+2*unite%
      2d_pen_color 102,0,0
  end_select
  
  color 101,255,127,127
  2d_target_is 101
  2d_pen_color 102,0,0
  2d_fill_color 204,0,0
  2d_pen_width 2
  print_target_is 101
  font_bold 101
  
  ' pièce 1: grand triangle isocèle rectangle
  xbase% = bord% + 80
  base1% = bord%
  ybase% = bord%
  dessiner_grand_triangle(101,1,xunite%,xbase%,ybase%,0)
  dessiner_grand_triangle(  1,1,     -1,base1%,    -1,0)
  creer_boutons(1,xbase%,ybase%)

  ' pièce 2: grand triangle isocèle rectangle
  ybase% = ybase% + unite%*1.25
  dessiner_grand_triangle(101,2,xunite%,xbase%,ybase%,0)
  dessiner_grand_triangle(  1,2,     -1,base1%,    -1,0)
  creer_boutons(2,xbase%,ybase%)

  ' pièce 3: parallélogramme
  ybase% = ybase% + unite%*1.25
  dessiner_parallelogramme(101,3,xunite%,xbase%,ybase%,0)
  dessiner_parallelogramme(  1,3,     -1,base1%,    -1,0)
  creer_boutons(3,xbase%,ybase%)

  ' piece 4: petit triangle isocèle
  xbase% = bord% + 80 + unite%*1.5
  base1% = bord% + unite%*3.5
  ybase% = bord%
  dessiner_petit_triangle(101,4,xunite%,xbase%,ybase%,0)
  dessiner_petit_triangle(  1,4,     -1,base1%,    -1,0)
  creer_boutons(4,xbase%,ybase%)

  ' pièce 5: carré
  ybase% = ybase% + unite%*1.25
  dessiner_carre(101,5,xunite%,xbase%,ybase%,0)
  dessiner_carre(  1,5,     -1,base1%,    -1,0)
  creer_boutons(5,xbase%,ybase%)

  ' piece 6: petit triangle isocèle
  ybase% = ybase% + unite%*1.25
  dessiner_petit_triangle(101,6,xunite%,xbase%,ybase%,0)
  dessiner_petit_triangle(  1,6,     -1,base1%,    -1,0)
  creer_boutons(6,xbase%,ybase%)

  ' pièce 7: moyen triangle isocèle
  ybase% = ybase% + unite%*1.25
  dessiner_moyen_triangle(101,7,xunite%,xbase%,ybase%,0)
  dessiner_moyen_triangle(  1,7,     -1,base1%,    -1,0)
  creer_boutons(7,xbase%,ybase%)

end_sub

sub effacer_piece(xid%)

  color 1,255,127,127

  ' afficher le modèle
  select modele%
    case 1: ' le carré
      2d_target_is 1
      2d_pen_color 0,0,0
      2d_fill_color 255,127,127
      2d_rectangle bord%+unite%,bord%+unite%,bord%+2*unite%,bord%+2*unite%
      2d_pen_color 102,0,0
  end_select

  if xid%<>1
    if pieces%(1,0)>0 then dessiner_grand_triangle(1,1,-1,-1,-1,0)
  end_if
  if xid%<>2
    if pieces%(2,0)>0 then dessiner_grand_triangle(1,2,-1,-1,-1,0)
  end_if
  if xid%<>3
    if pieces%(3,0)>0 then dessiner_parallelogramme(1,3,-1,-1,-1,0)
  end_if
  if xid%<>4
    if pieces%(4,0)>0 then dessiner_petit_triangle(1,4,-1,-1,-1,0)
  end_if
  if xid%<>5
    if pieces%(5,0)>0 then dessiner_carre(1,5,-1,-1,-1,0)
  end_if
  if xid%<>6
    if pieces%(6,0)>0 then dessiner_petit_triangle(1,6,-1,-1,-1,0)
  end_if
  if xid%<>7
    if pieces%(7,0)>0 then dessiner_moyen_triangle(1,7,-1,-1,-1,0)
  end_if
end_sub

sub rotation(x0%,y0%,x1%,y1%,pix)
  xp% = (x1%-x0%)*cos(pix) - (y1%-y0%)*sin(pix) + x0%
  yp% = (x1%-x0%)*sin(pix) + (y1%-y0%)*cos(pix) + y0%
end_sub

sub dessiner_grand_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, r%, x0%, y0%, angle%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' + xunite%/2
  y0% = ybase% : ' + xunite%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%*2,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+xunite%/2,ybase%+xunite%,pix)
  2d_flood xp%,yp%,204,0,0
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)
      
  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_parallelogramme(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' + xunite%/4
  y0% = ybase% : ' +delta%+xunite%/4
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+xunite%/4,ybase%+delta%+xunite%/4,pix)
  2d_flood xp%,yp%,204,0,0
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)
  
  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_petit_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase%
  y0% = ybase% : ' +delta%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%/3,ybase%+delta%,pix)
  2d_flood xp%,yp%,204,0,0
  2d_circle xp%,yp%,10
  print_locate xp%-5,yp%-7
  print str$(id%)
    
  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_carre(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' +delta%
  y0% = ybase% : ' +delta%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%,ybase%+delta%,pix)
  2d_flood xp%,yp%,204,0,0
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)

  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_moyen_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' +delta%/2
  y0% = ybase% : ' +delta%/2
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%/2,ybase%+delta%/2,pix)
  2d_flood xp%,yp%,204,0,0
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)

  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub creer_boutons(n%,xbase%,ybase%)
  dim_local b%, b1%, b2%
  
  b% = 110 + n%     : ' rotation à gauche
  if object_exists(b%)=1 then exit_sub
  button b% : parent b%,100 : width b%,30 : left b%,xbase%-80 : top b%,ybase%
    on_click b%,click : caption b%,"<"
    
  b1% = 120 + n%    : ' rotation à droite
  button b1% : parent b1%,100 : width b1%,30 : left b1%,xbase%-40 : top b1%,ybase%
    on_click b1%,click : caption b1%,">"
    
  b% = 130 + n%     : ' déplacement à gauche
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-80 : top b%,ybase%+60
    on_click b%,click : caption b%,"<"
  b% = 140 + n%     : ' déplacement en haut
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-60 : top b%,ybase%+40
    on_click b%,click : caption b%,"^"
  b% = 150 + n%     : ' déplacement à droite
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-40 : top b%,ybase%+60
    on_click b%,click : caption b%,">"
  b% = 160 + n%     : ' déplacement en bas
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-60 : top b%,ybase%+80
    on_click b%,click : caption b%,"v"

end_sub

  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,1+2+4)

' Tangram.bas

label click, touche

dim unite% : unite% = 160
dim bord%  : bord%  =  10
dim KGF$   : KGF$ = "C:\Users\klausgunther\Documents\Mes projets\Mes projets Delphi\KGF\KGF.dll"
if file_exists(KGF$)=0 then KGF$ = ""

dim pieces%(7,6)
  ' (n%,d%)  n%=numéro de pièce (1...7)
  '          d%=0 flag "présent" 0/1
  '          d%=1 n%
  '          d%=2 x% dans 101
  '          d%=3 y% dans 101
  '          d%=4 degré de rotation
  '          d%=5 x% dans 1
  '          d%=6 y% dans 1

dim xp%, yp%, base1%, modele%, act%

width  0,4*unite%+2*bord% + 16
height 0,4.5*unite%+2*bord% + 39
caption 0,"Tangram"
on_key_down 0,touche

picture 1 : width 1,4*unite%+2*bord% : height 1,4.5*unite%+2*bord%
            on_click 1,click
            2d_target_is 1
            print_target_is 1

form 100 : top 100,top(0) : left 100,left(0)+width(0)
           height 100,height(0) : width 100,3*unite%
picture 101 : parent 101,100 : full_space 101

button 102 : parent 102,100 : top 102,height(100)-80 : left 102,10
           caption 102,"Initialiser" : on_click 102,click

combo 103 : parent 103,100 : top 103,height(100)-110 : left 103,10 : on_click 103,click
  item_add 103,"Le carré"
  text 103,item_read$(103,1)
  modele% = 1

if KGF$<>"" then dll_on KGF$
initialiser()

end

touche:
  traiter_touche()
  return


click:
  traiter_click(number_click)
  return
  
sub traiter_touche()
  off_key_down 0
  dim_local scn%
  if act%>0
    scn% = scancode
    select scn%
      case 37: ' flèche gauche
        pieces%(act%,5) = pieces%(act%,5) - unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 38: ' flèche haut
        pieces%(act%,6) = pieces%(act%,6) - unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 39: ' flèche droite
        pieces%(act%,5) = pieces%(act%,5) + unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 40: ' flèche bas
        pieces%(act%,6) = pieces%(act%,6) + unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 32: ' espace (rotation gauche)
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,1)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,1)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,1)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,1)
          case 5: dessiner_carre(1,act%,-1,-1,-1,1)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,1)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,1)
        end_select
    end_select
  end_if
  on_key_down 0,touche
end_sub
  
sub traiter_click(id%)
  off_click id%
  dim_local res%, xpos%, ypos%
  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,1+2+4)
  act% = 0
  if (id%>110) and (id%<170) then act% = id% - int(id%/10)*10
  select id%
    case 1:   ' terrain
      xpos% = mouse_x_position(1)
      ypos% = mouse_y_position(1)
      act% = color_pixel_blue(1,mouse_x_left_down(1),mouse_y_left_down(1))
      if act%>7 then act% = 0
      if act%>0
        if (xpos%<>mouse_x_left_down(1)) or (xpos%<>mouse_y_left_down(1))
          pieces%(act%,5) = pieces%(act%,5) + xpos% - mouse_x_left_down(1)
          pieces%(act%,6) = pieces%(act%,6) + ypos% - mouse_y_left_down(1)
          effacer_piece(act%)
          select act%
            case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
            case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
            case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
            case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
            case 5: dessiner_carre(1,act%,-1,-1,-1,0)
            case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
            case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
          end_select
        end_if
      end_if
      
    case 102: ' initialiser
      initialiser()
      
    case 103: ' choix du modèle
      modele% = item_index(103)
      initialiser()
      
    case 111: ' pièce 1 à gauche
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,1)
    case 121: ' pièce 1 à droite
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,-1)
    case 131: ' déplacement à gauche
      pieces%(1,5) = pieces%(1,5) - unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 141: ' déplacement en haut
      pieces%(1,6) = pieces%(1,6) - unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 151: ' déplacement à droite
      pieces%(1,5) = pieces%(1,5) + unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 161: ' déplacement en bas
      pieces%(1,6) = pieces%(1,6) + unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)

    case 112: ' pièce 2 à gauche
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,1)
    case 122: ' pièce 2 à droite
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,-1)
    case 132: ' déplacement à gauche
      pieces%(2,5) = pieces%(2,5) - unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 142: ' déplacement en haut
      pieces%(2,6) = pieces%(2,6) - unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 152: ' déplacement à droite
      pieces%(2,5) = pieces%(2,5) + unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 162: ' déplacement en bas
      pieces%(2,6) = pieces%(2,6) + unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)

    case 113: ' pièce 3 à gauche
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,1)
    case 123: ' pièce 3 à droite
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,-1)
    case 133: ' déplacement à gauche
      pieces%(3,5) = pieces%(3,5) - unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 143: ' déplacement en haut
      pieces%(3,6) = pieces%(3,6) - unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 153: ' déplacement à droite
      pieces%(3,5) = pieces%(3,5) + unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 163: ' déplacement en bas
      pieces%(3,6) = pieces%(3,6) + unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)

    case 114: ' pièce 4 à gauche
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,1)
    case 124: ' pièce 4 à droite
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,-1)
    case 134: ' déplacement à gauche
      pieces%(4,5) = pieces%(4,5) - unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 144: ' déplacement en haut
      pieces%(4,6) = pieces%(4,6) - unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 154: ' déplacement à droite
      pieces%(4,5) = pieces%(4,5) + unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 164: ' déplacement en bas
      pieces%(4,6) = pieces%(4,6) + unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)

    case 115: ' pièce 5 à gauche
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,1)
    case 125: ' pièce 5 à droite
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,-1)
    case 135: ' déplacement à gauche
      pieces%(5,5) = pieces%(5,5) - unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 145: ' déplacement en haut
      pieces%(5,6) = pieces%(5,6) - unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 155: ' déplacement à droite
      pieces%(5,5) = pieces%(5,5) + unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 165: ' déplacement en bas
      pieces%(5,6) = pieces%(5,6) + unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)

    case 116: ' pièce 6 à gauche
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,1)
    case 126: ' pièce 6 à droite
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,-1)
    case 136: ' déplacement à gauche
      pieces%(6,5) = pieces%(6,5) - unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 146: ' déplacement en haut
      pieces%(6,6) = pieces%(6,6) - unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 156: ' déplacement à droite
      pieces%(6,5) = pieces%(6,5) + unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 166: ' déplacement en bas
      pieces%(6,6) = pieces%(6,6) + unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)

    case 117: ' pièce 7 à gauche
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,1)
    case 127: ' pièce 7 à droite
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,-1)
    case 137: ' déplacement à gauche
      pieces%(7,5) = pieces%(7,5) - unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 147: ' déplacement en haut
      pieces%(7,6) = pieces%(7,6) - unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 157: ' déplacement à droite
      pieces%(7,5) = pieces%(7,5) + unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 167: ' déplacement en bas
      pieces%(7,6) = pieces%(7,6) + unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)


  end_select
  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,0)
  on_click id%,click
end_sub

sub initialiser()
  dim_local i%, xbase%, ybase%, xunite%

  if object_exists(131)=1
    active 131 : active 132 : active 133 : active 134 : active 135 : active 136 : active 137
  end_if
  
  xunite% = unite%/2
  color 1,255,127,127
  font_color 1,255,255,255
  font_bold 1
  2d_target_is 1
  2d_pen_color 102,0,0
  2d_pen_width 2
  for i%=1 to 7
    pieces%(i%,0) = 0    : ' pièce absente
    pieces%(i%,1) = i%   : ' numéro de pièce
    pieces%(i%,2) = 0    : ' coordonnée x
    pieces%(i%,3) = 0    : ' coordonnée y
    pieces%(i%,4) = 0    : ' rotation en °
  next i%
  
  ' afficher le modèle
  select modele%
    case 1: ' le carré
      2d_target_is 1
      2d_pen_color 0,0,0
      2d_fill_color 255,127,127
      2d_rectangle bord%+unite%,bord%+unite%,bord%+2*unite%,bord%+2*unite%
      2d_pen_color 102,0,0
  end_select
  
  color 101,255,127,127
  2d_target_is 101
  2d_pen_color 102,0,0
  2d_fill_color 204,0,0
  2d_pen_width 2
  print_target_is 101
  font_bold 101
  
  ' pièce 1: grand triangle isocèle rectangle
  xbase% = bord% + 80
  base1% = bord%
  ybase% = bord%
  dessiner_grand_triangle(101,1,xunite%,xbase%,ybase%,0)
  dessiner_grand_triangle(  1,1,     -1,base1%,    -1,0)
  creer_boutons(1,xbase%,ybase%)

  ' pièce 2: grand triangle isocèle rectangle
  ybase% = ybase% + unite%*1.25
  dessiner_grand_triangle(101,2,xunite%,xbase%,ybase%,0)
  dessiner_grand_triangle(  1,2,     -1,base1%,    -1,0)
  creer_boutons(2,xbase%,ybase%)

  ' pièce 3: parallélogramme
  ybase% = ybase% + unite%*1.25
  dessiner_parallelogramme(101,3,xunite%,xbase%,ybase%,0)
  dessiner_parallelogramme(  1,3,     -1,base1%,    -1,0)
  creer_boutons(3,xbase%,ybase%)

  ' piece 4: petit triangle isocèle
  xbase% = bord% + 80 + unite%*1.5
  base1% = bord% + unite%*3.5
  ybase% = bord%
  dessiner_petit_triangle(101,4,xunite%,xbase%,ybase%,0)
  dessiner_petit_triangle(  1,4,     -1,base1%,    -1,0)
  creer_boutons(4,xbase%,ybase%)

  ' pièce 5: carré
  ybase% = ybase% + unite%*1.25
  dessiner_carre(101,5,xunite%,xbase%,ybase%,0)
  dessiner_carre(  1,5,     -1,base1%,    -1,0)
  creer_boutons(5,xbase%,ybase%)

  ' piece 6: petit triangle isocèle
  ybase% = ybase% + unite%*1.25
  dessiner_petit_triangle(101,6,xunite%,xbase%,ybase%,0)
  dessiner_petit_triangle(  1,6,     -1,base1%,    -1,0)
  creer_boutons(6,xbase%,ybase%)

  ' pièce 7: moyen triangle isocèle
  ybase% = ybase% + unite%*1.25
  dessiner_moyen_triangle(101,7,xunite%,xbase%,ybase%,0)
  dessiner_moyen_triangle(  1,7,     -1,base1%,    -1,0)
  creer_boutons(7,xbase%,ybase%)

end_sub

sub effacer_piece(xid%)

  color 1,255,127,127

  ' afficher le modèle
  select modele%
    case 1: ' le carré
      2d_target_is 1
      2d_pen_color 0,0,0
      2d_fill_color 255,127,127
      2d_rectangle bord%+unite%,bord%+unite%,bord%+2*unite%,bord%+2*unite%
      2d_pen_color 102,0,0
  end_select

  if xid%<>1
    if pieces%(1,0)>0 then dessiner_grand_triangle(1,1,-1,-1,-1,0)
  end_if
  if xid%<>2
    if pieces%(2,0)>0 then dessiner_grand_triangle(1,2,-1,-1,-1,0)
  end_if
  if xid%<>3
    if pieces%(3,0)>0 then dessiner_parallelogramme(1,3,-1,-1,-1,0)
  end_if
  if xid%<>4
    if pieces%(4,0)>0 then dessiner_petit_triangle(1,4,-1,-1,-1,0)
  end_if
  if xid%<>5
    if pieces%(5,0)>0 then dessiner_carre(1,5,-1,-1,-1,0)
  end_if
  if xid%<>6
    if pieces%(6,0)>0 then dessiner_petit_triangle(1,6,-1,-1,-1,0)
  end_if
  if xid%<>7
    if pieces%(7,0)>0 then dessiner_moyen_triangle(1,7,-1,-1,-1,0)
  end_if
end_sub

sub rotation(x0%,y0%,x1%,y1%,pix)
  xp% = (x1%-x0%)*cos(pix) - (y1%-y0%)*sin(pix) + x0%
  yp% = (x1%-x0%)*sin(pix) + (y1%-y0%)*cos(pix) + y0%
end_sub

sub dessiner_grand_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, r%, x0%, y0%, angle%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' + xunite%/2
  y0% = ybase% : ' + xunite%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%*2,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+xunite%/2,ybase%+xunite%,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)
      
  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_parallelogramme(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' + xunite%/4
  y0% = ybase% : ' +delta%+xunite%/4
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+xunite%/4,ybase%+delta%+xunite%/4,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)
  
  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_petit_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase%
  y0% = ybase% : ' +delta%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%/3,ybase%+delta%,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,10
  print_locate xp%-5,yp%-7
  print str$(id%)
    
  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_carre(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' +delta%
  y0% = ybase% : ' +delta%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%,ybase%+delta%,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)

  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub dessiner_moyen_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' +delta%/2
  y0% = ybase% : ' +delta%/2
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%/2,ybase%+delta%/2,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)

  pieces%(id%,0) = 1       : ' présent
  pieces%(id%,1) = id%     : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale   dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale   dans 1
end_sub

sub creer_boutons(n%,xbase%,ybase%)
  dim_local b%, b1%, b2%
  
  b% = 110 + n%     : ' rotation à gauche
  if object_exists(b%)=1 then exit_sub
  button b% : parent b%,100 : width b%,30 : left b%,xbase%-80 : top b%,ybase%
    on_click b%,click : caption b%,"<"
    
  b1% = 120 + n%    : ' rotation à droite
  button b1% : parent b1%,100 : width b1%,30 : left b1%,xbase%-40 : top b1%,ybase%
    on_click b1%,click : caption b1%,">"
    
  b% = 130 + n%     : ' déplacement à gauche
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-80 : top b%,ybase%+60
    on_click b%,click : caption b%,"<"
  b% = 140 + n%     : ' déplacement en haut
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-60 : top b%,ybase%+40
    on_click b%,click : caption b%,"^"
  b% = 150 + n%     : ' déplacement à droite
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-40 : top b%,ybase%+60
    on_click b%,click : caption b%,">"
  b% = 160 + n%     : ' déplacement en bas
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-60 : top b%,ybase%+80
    on_click b%,click : caption b%,"v"

end_sub

' Tangram.bas

label click, touche

dim unite% : unite% = 160
dim bord%  : bord%  =  10
dim KGF$  : KGF$ = "C:\Users\klausgunther\Documents\Mes projets\Mes projets Delphi\KGF\KGF.dll"
if file_exists(KGF$)=0 then KGF$ = ""

dim pieces%(7,6)
  ' (n%,d%)  n%=numéro de pièce (1...7)
  '          d%=0 flag "présent" 0/1
  '          d%=1 n%
  '          d%=2 x% dans 101
  '          d%=3 y% dans 101
  '          d%=4 degré de rotation
  '          d%=5 x% dans 1
  '          d%=6 y% dans 1

dim xp%, yp%, base1%, modele%, act%

width  0,4*unite%+2*bord% + 16
height 0,4.5*unite%+2*bord% + 39
caption 0,"Tangram"
on_key_down 0,touche

picture 1 : width 1,4*unite%+2*bord% : height 1,4.5*unite%+2*bord%
            on_click 1,click
            2d_target_is 1
            print_target_is 1

form 100 : top 100,top(0) : left 100,left(0)+width(0)
          height 100,height(0) : width 100,3*unite%
picture 101 : parent 101,100 : full_space 101

button 102 : parent 102,100 : top 102,height(100)-80 : left 102,10
          caption 102,"Initialiser" : on_click 102,click

combo 103 : parent 103,100 : top 103,height(100)-110 : left 103,10 : on_click 103,click
  item_add 103,"<aucun>"
  item_add 103,"Le carré"
  item_add 103,"La pyramide"
  item_add 103,"Le chameau"
  modele% = 2
  text 103,item_read$(103,modele%)

if KGF$<>"" then dll_on KGF$
initialiser()

end

touche:
  traiter_touche()
  return


click:
  traiter_click(number_click)
  return
 
sub traiter_touche()
  dim_local res%
  off_key_down 0
  dim_local scn%
  if act%>0
    if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,1+2+4)
    scn% = scancode
    select scn%
      case 37: ' flèche gauche
        pieces%(act%,5) = pieces%(act%,5) - unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 38: ' flèche haut
        pieces%(act%,6) = pieces%(act%,6) - unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 39: ' flèche droite
        pieces%(act%,5) = pieces%(act%,5) + unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 40: ' flèche bas
        pieces%(act%,6) = pieces%(act%,6) + unite%/4
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 5: dessiner_carre(1,act%,-1,-1,-1,0)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
        end_select
      case 32: ' espace (rotation gauche)
        effacer_piece(act%)
        select act%
          case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,1)
          case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,1)
          case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,1)
          case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,1)
          case 5: dessiner_carre(1,act%,-1,-1,-1,1)
          case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,1)
          case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,1)
        end_select
    end_select
    if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,0)
  end_if
  on_key_down 0,touche
end_sub
 
sub traiter_click(id%)
  off_click id%
  dim_local res%, xpos%, ypos%
  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,1+2+4)
  act% = 0
  if (id%>110) and (id%<170) then act% = id% - int(id%/10)*10
  select id%
    case 1:  ' terrain
      xpos% = mouse_x_position(1)
      ypos% = mouse_y_position(1)
      act% = color_pixel_blue(1,mouse_x_left_down(1),mouse_y_left_down(1))
      if act%>7 then act% = 0
      if act%>0
        if (xpos%<>mouse_x_left_down(1)) or (xpos%<>mouse_y_left_down(1))
          pieces%(act%,5) = pieces%(act%,5) + xpos% - mouse_x_left_down(1)
          pieces%(act%,6) = pieces%(act%,6) + ypos% - mouse_y_left_down(1)
          effacer_piece(act%)
          select act%
            case 1: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
            case 2: dessiner_grand_triangle(1,act%,-1,-1,-1,0)
            case 3: dessiner_parallelogramme(1,act%,-1,-1,-1,0)
            case 4: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
            case 5: dessiner_carre(1,act%,-1,-1,-1,0)
            case 6: dessiner_petit_triangle(1,act%,-1,-1,-1,0)
            case 7: dessiner_moyen_triangle(1,act%,-1,-1,-1,0)
          end_select
        end_if
      end_if
     
    case 102: ' initialiser
      initialiser()
     
    case 103: ' choix du modèle
      modele% = item_index(103)
      initialiser()
     
    case 111: ' pièce 1 à gauche
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,1)
    case 121: ' pièce 1 à droite
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,-1)
    case 131: ' déplacement à gauche
      pieces%(1,5) = pieces%(1,5) - unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 141: ' déplacement en haut
      pieces%(1,6) = pieces%(1,6) - unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 151: ' déplacement à droite
      pieces%(1,5) = pieces%(1,5) + unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)
    case 161: ' déplacement en bas
      pieces%(1,6) = pieces%(1,6) + unite%/4
      effacer_piece(1)
      dessiner_grand_triangle(1,1,-1,-1,-1,0)

    case 112: ' pièce 2 à gauche
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,1)
    case 122: ' pièce 2 à droite
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,-1)
    case 132: ' déplacement à gauche
      pieces%(2,5) = pieces%(2,5) - unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 142: ' déplacement en haut
      pieces%(2,6) = pieces%(2,6) - unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 152: ' déplacement à droite
      pieces%(2,5) = pieces%(2,5) + unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)
    case 162: ' déplacement en bas
      pieces%(2,6) = pieces%(2,6) + unite%/4
      effacer_piece(2)
      dessiner_grand_triangle(1,2,-1,-1,-1,0)

    case 113: ' pièce 3 à gauche
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,1)
    case 123: ' pièce 3 à droite
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,-1)
    case 133: ' déplacement à gauche
      pieces%(3,5) = pieces%(3,5) - unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 143: ' déplacement en haut
      pieces%(3,6) = pieces%(3,6) - unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 153: ' déplacement à droite
      pieces%(3,5) = pieces%(3,5) + unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)
    case 163: ' déplacement en bas
      pieces%(3,6) = pieces%(3,6) + unite%/4
      effacer_piece(3)
      dessiner_parallelogramme(1,3,-1,-1,-1,0)

    case 114: ' pièce 4 à gauche
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,1)
    case 124: ' pièce 4 à droite
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,-1)
    case 134: ' déplacement à gauche
      pieces%(4,5) = pieces%(4,5) - unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 144: ' déplacement en haut
      pieces%(4,6) = pieces%(4,6) - unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 154: ' déplacement à droite
      pieces%(4,5) = pieces%(4,5) + unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)
    case 164: ' déplacement en bas
      pieces%(4,6) = pieces%(4,6) + unite%/4
      effacer_piece(4)
      dessiner_petit_triangle(1,4,-1,-1,-1,0)

    case 115: ' pièce 5 à gauche
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,1)
    case 125: ' pièce 5 à droite
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,-1)
    case 135: ' déplacement à gauche
      pieces%(5,5) = pieces%(5,5) - unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 145: ' déplacement en haut
      pieces%(5,6) = pieces%(5,6) - unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 155: ' déplacement à droite
      pieces%(5,5) = pieces%(5,5) + unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)
    case 165: ' déplacement en bas
      pieces%(5,6) = pieces%(5,6) + unite%/4
      effacer_piece(5)
      dessiner_carre(1,5,-1,-1,-1,0)

    case 116: ' pièce 6 à gauche
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,1)
    case 126: ' pièce 6 à droite
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,-1)
    case 136: ' déplacement à gauche
      pieces%(6,5) = pieces%(6,5) - unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 146: ' déplacement en haut
      pieces%(6,6) = pieces%(6,6) - unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 156: ' déplacement à droite
      pieces%(6,5) = pieces%(6,5) + unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)
    case 166: ' déplacement en bas
      pieces%(6,6) = pieces%(6,6) + unite%/4
      effacer_piece(6)
      dessiner_petit_triangle(1,6,-1,-1,-1,0)

    case 117: ' pièce 7 à gauche
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,1)
    case 127: ' pièce 7 à droite
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,-1)
    case 137: ' déplacement à gauche
      pieces%(7,5) = pieces%(7,5) - unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 147: ' déplacement en haut
      pieces%(7,6) = pieces%(7,6) - unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 157: ' déplacement à droite
      pieces%(7,5) = pieces%(7,5) + unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)
    case 167: ' déplacement en bas
      pieces%(7,6) = pieces%(7,6) + unite%/4
      effacer_piece(7)
      dessiner_moyen_triangle(1,7,-1,-1,-1,0)


  end_select
  if KGF$<>"" then res% = dll_call3("SetFormProperties",object_internal(0),1,0)
  on_click id%,click
end_sub

sub modele_carre()
  dim_local xunite%, x0%, y0%, x1%, y1%
  2d_target_is 1
  2d_pen_color 0,0,0
  2d_fill_color 255,127,127
  2d_rectangle bord%+unite%,bord%+unite%,bord%+2*unite%,bord%+2*unite%
  2d_pen_color 102,0,0
end_sub

sub modele_pyramide()
  dim_local xunite%, x0%, y0%, x1%, y1%
  2d_target_is 1
  2d_pen_color 0,0,0
  xunite% = unite%/2
  x0% = bord% + unite%
  y0% = bord% + 3*unite%
  2d_poly_from x0%,y0%
  x1% = x0% + 4*xunite%
  y1% = y0%
  2d_poly_to x1%,y1%
  x0% = x1% - 2*xunite%
  y0% = y1% - 2*xunite%
  2d_poly_to x0%,y0%
  x1% = x0% - 2*xunite%
  y1% = y0% + 2*xunite%
  2d_poly_to x1%,y1%
  2d_pen_color 102,0,0
end_sub

sub modele_chameau()
  dim_local xunite%,x0%,y0%,x1%,y1%
  dim_local x2%,y2%
 
  2d_target_is 1
  2d_pen_color 0,0,0
 
  xunite% = unite%/2
  x1% = bord%+2*unite%
  y1% = bord%+3*unite%
  x2% = x1%
  y2% = y1%

  2d_poly_from x1%,y1%
  x0% = x1%
  y0% = y1% - xunite%
  2d_poly_to x0%,y0%
  x1% = x0% + xunite%/2
  y1% = y0% - xunite%/2
  2d_poly_to x1%,y1%
  x0% = x1%
  y0% = y1% - xunite%
  2d_poly_to x0%,y0%
  x1% = x0% + xunite%/2
  y1% = y0% - xunite%/2
  2d_poly_to x1%,y1%
  x0% = x1% - xunite%
  y0% = y1%
  2d_poly_to x0%,y0%
  x1% = x0%
  y1% = y1% + xunite%
  2d_poly_to x1%,y1%
  x0% = x1% - xunite%/2
  y0% = y1% - xunite%/2
  2d_poly_to x0%,y0%
  x1% = x0% - xunite%/2
  y1% = y0% + xunite%/2
  2d_poly_to x1%,y1%
  x0% = x1% - xunite%*(sqr(2)/2-0.5)
  y0% = y1% - xunite%*(sqr(2)/2-0.5)
  2d_poly_to x0%,y0%
  x1% = x0% - xunite%*sqr(2)/2
  y1% = y0% + xunite%*sqr(2)/2
  2d_poly_to x1%,y1%
  x0% = x1%
  y0% = y1% + xunite%*sqr(2)
  2d_poly_to x0%,y0%
  x1% = x0% + xunite%*0.91
  y1% = y0% - xunite%*0.91
  2d_poly_to x1%,y1%
  x0% = bord%+2*unite%
  y0% = bord%+3*unite%
  2d_poly_to x0%,y0%

  2d_pen_color 102,0,0
 
end_sub

sub initialiser()
  dim_local i%, xbase%, ybase%, xunite%

  if object_exists(131)=1
    active 131 : active 132 : active 133 : active 134 : active 135 : active 136 : active 137
  end_if
 
  xunite% = unite%/2
  for i%=1 to 7
    pieces%(i%,0) = 0    : ' pièce absente
    pieces%(i%,1) = i%  : ' numéro de pièce
    pieces%(i%,2) = 0    : ' coordonnée x
    pieces%(i%,3) = 0    : ' coordonnée y
    pieces%(i%,4) = 0    : ' rotation en °
  next i%
 
  color 1,255,127,127
  font_color 1,255,255,255
  font_bold 1
  2d_pen_width 2

  ' afficher le modèle
  select modele%
    case 1: ' aucun modèle
    case 2: modele_carre()
    case 3: modele_pyramide()
    case 4: modele_chameau()
  end_select
 
  color 101,255,127,127
  2d_target_is 101
  2d_pen_color 102,0,0
  2d_fill_color 204,0,0
  2d_pen_width 2
  print_target_is 101
  font_bold 101
 
  ' pièce 1: grand triangle isocèle rectangle
  xbase% = bord% + 80
  base1% = bord%
  ybase% = bord%
  dessiner_grand_triangle(101,1,xunite%,xbase%,ybase%,0)
  dessiner_grand_triangle(  1,1,    -1,base1%,    -1,0)
  creer_boutons(1,xbase%,ybase%)

  ' pièce 2: grand triangle isocèle rectangle
  ybase% = ybase% + unite%*1.25
  dessiner_grand_triangle(101,2,xunite%,xbase%,ybase%,0)
  dessiner_grand_triangle(  1,2,    -1,base1%,    -1,0)
  creer_boutons(2,xbase%,ybase%)

  ' pièce 3: parallélogramme
  ybase% = ybase% + unite%*1.25
  dessiner_parallelogramme(101,3,xunite%,xbase%,ybase%,0)
  dessiner_parallelogramme(  1,3,    -1,base1%,    -1,0)
  creer_boutons(3,xbase%,ybase%)

  ' piece 4: petit triangle isocèle
  xbase% = bord% + 80 + unite%*1.5
  base1% = bord% + unite%*3.5
  ybase% = bord%
  dessiner_petit_triangle(101,4,xunite%,xbase%,ybase%,0)
  dessiner_petit_triangle(  1,4,    -1,base1%,    -1,0)
  creer_boutons(4,xbase%,ybase%)

  ' pièce 5: carré
  ybase% = ybase% + unite%*1.25
  dessiner_carre(101,5,xunite%,xbase%,ybase%,0)
  dessiner_carre(  1,5,    -1,base1%,    -1,0)
  creer_boutons(5,xbase%,ybase%)

  ' piece 6: petit triangle isocèle
  ybase% = ybase% + unite%*1.25
  dessiner_petit_triangle(101,6,xunite%,xbase%,ybase%,0)
  dessiner_petit_triangle(  1,6,    -1,base1%,    -1,0)
  creer_boutons(6,xbase%,ybase%)

  ' pièce 7: moyen triangle isocèle
  ybase% = ybase% + unite%*1.25
  dessiner_moyen_triangle(101,7,xunite%,xbase%,ybase%,0)
  dessiner_moyen_triangle(  1,7,    -1,base1%,    -1,0)
  creer_boutons(7,xbase%,ybase%)

end_sub

sub effacer_piece(xid%)

  color 1,255,127,127

  ' afficher le modèle
  select modele%
    case 1: ' aucun modèle
    case 2: modele_carre()
    case 3: modele_pyramide()
    case 4: modele_chameau()
  end_select

  if xid%<>1
    if pieces%(1,0)>0 then dessiner_grand_triangle(1,1,-1,-1,-1,0)
  end_if
  if xid%<>2
    if pieces%(2,0)>0 then dessiner_grand_triangle(1,2,-1,-1,-1,0)
  end_if
  if xid%<>3
    if pieces%(3,0)>0 then dessiner_parallelogramme(1,3,-1,-1,-1,0)
  end_if
  if xid%<>4
    if pieces%(4,0)>0 then dessiner_petit_triangle(1,4,-1,-1,-1,0)
  end_if
  if xid%<>5
    if pieces%(5,0)>0 then dessiner_carre(1,5,-1,-1,-1,0)
  end_if
  if xid%<>6
    if pieces%(6,0)>0 then dessiner_petit_triangle(1,6,-1,-1,-1,0)
  end_if
  if xid%<>7
    if pieces%(7,0)>0 then dessiner_moyen_triangle(1,7,-1,-1,-1,0)
  end_if
end_sub

sub rotation(x0%,y0%,x1%,y1%,pix)
  xp% = (x1%-x0%)*cos(pix) - (y1%-y0%)*sin(pix) + x0%
  yp% = (x1%-x0%)*sin(pix) + (y1%-y0%)*cos(pix) + y0%
end_sub

sub dessiner_grand_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, r%, x0%, y0%, angle%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' + xunite%/2
  y0% = ybase% : ' + xunite%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%*2,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+xunite%/2,ybase%+xunite%,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)
     
  pieces%(id%,0) = 1      : ' présent
  pieces%(id%,1) = id%    : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale  dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale  dans 1
end_sub

sub dessiner_parallelogramme(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' + xunite%/4
  y0% = ybase% : ' +delta%+xunite%/4
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+xunite%/4,ybase%+delta%+xunite%/4,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)
 
  pieces%(id%,0) = 1      : ' présent
  pieces%(id%,1) = id%    : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale  dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale  dans 1
end_sub

sub dessiner_petit_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase%
  y0% = ybase% : ' +delta%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%/3,ybase%+delta%,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,10
  print_locate xp%-5,yp%-7
  print str$(id%)
   
  pieces%(id%,0) = 1      : ' présent
  pieces%(id%,1) = id%    : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale  dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale  dans 1
end_sub

sub dessiner_carre(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' +delta%
  y0% = ybase% : ' +delta%
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%+delta%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+delta%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%,ybase%+delta%,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)

  pieces%(id%,0) = 1      : ' présent
  pieces%(id%,1) = id%    : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale  dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale  dans 1
end_sub

sub dessiner_moyen_triangle(target%,id%,pxunite%,pxbase%,pybase%,pxdegre%)
  dim_local delta%, degre%, xunite%,xbase%,ybase%, x0%, y0%
  dim_local pi4 : pi4 = atn(1)
  dim_local pix
  2d_target_is target%
  print_target_is target%
  if pxunite%<0
    xunite% = unite%/2
  else
    xunite% = pxunite%
  end_if
  if pxbase%<0
    xbase% = pieces%(id%,5)
  else
    xbase% = pxbase%
  end_if
  if pybase%<0
    ybase% = pieces%(id%,6)
  else
    ybase% = pybase%
  end_if
  delta% = xunite%/2
  degre% = pieces%(id%,4) + pxdegre%
  if degre%>7 then degre% = 0
  if degre%<0 then degre% = 7

  ' centre de rotation
  pix = pi4*(8 - degre%)
  x0% = xbase% : ' +delta%/2
  y0% = ybase% : ' +delta%/2
  ' points du polygone
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_from xp%,yp%
  rotation(x0%,y0%,xbase%+xunite%,ybase%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%+xunite%,pix)
  2d_poly_to xp%,yp%
  rotation(x0%,y0%,xbase%,ybase%,pix)
  2d_poly_to xp%,yp%
  ' remplissage et étiquette
  rotation(x0%,y0%,xbase%+delta%/2,ybase%+delta%/2,pix)
  2d_flood xp%,yp%,204,0,id%
  2d_circle xp%,yp%,15
  print_locate xp%-5,yp%-7
  print str$(id%)

  pieces%(id%,0) = 1      : ' présent
  pieces%(id%,1) = id%    : ' type de pièce
  pieces%(id%,2) = xbase%  : ' adresse horizontale dans 101
  pieces%(id%,3) = ybase%  : ' adresse verticale  dans 101
  pieces%(id%,4) = degre%  : ' rotation en multiples de 45 degrés
  pieces%(id%,5) = xbase%  : ' adresse horizontale dans 1
  pieces%(id%,6) = ybase%  : ' adresse verticale  dans 1
end_sub

sub creer_boutons(n%,xbase%,ybase%)
  dim_local b%, b1%, b2%
 
  b% = 110 + n%    : ' rotation à gauche
  if object_exists(b%)=1 then exit_sub
  button b% : parent b%,100 : width b%,30 : left b%,xbase%-80 : top b%,ybase%
    on_click b%,click : caption b%,"<"
   
  b1% = 120 + n%    : ' rotation à droite
  button b1% : parent b1%,100 : width b1%,30 : left b1%,xbase%-40 : top b1%,ybase%
    on_click b1%,click : caption b1%,">"
   
  b% = 130 + n%    : ' déplacement à gauche
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-80 : top b%,ybase%+60
    on_click b%,click : caption b%,"<"
  b% = 140 + n%    : ' déplacement en haut
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-60 : top b%,ybase%+40
    on_click b%,click : caption b%,"^"
  b% = 150 + n%    : ' déplacement à droite
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-40 : top b%,ybase%+60
    on_click b%,click : caption b%,">"
  b% = 160 + n%    : ' déplacement en bas
  button b% : parent b%,100 : width b%,20 : height b%,20
    left b%,xbase%-60 : top b%,ybase%+80
    on_click b%,click : caption b%,"v"

end_sub