PLANORAMIC

dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,ligne$(1000),seg$(10),typ$(1000),txt$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,retourne
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label selection,cherche_seg,fait_ligne,cherche_num
label aerien,visite,photo
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,aire
label mur,porte,fenetre,texte,cote
label annule,refait,copie,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10:caption 15,"Vues 3D"
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule
sub_menu 31:parent 31,12:caption 31,"Refaire"      :on_click 31,refait
sub_menu 32:parent 32,12:caption 32,"Copier"        :on_click 32,copie
sub_menu 33:parent 33,12:caption 33,"Zoom"          :on_click 33,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime
' sub_menu 56:parent 56,14:caption 56,"Calculer surface":on_click 56,aire  <=== A VOIR ???

' sous-menu Vues 3D
sub_menu 60:parent 60,15:caption 60,"Vue aérienne"    :on_click 60,aerien
sub_menu 61:parent 61,15:caption 61,"Visite virtuelle" :on_click 61,visite
sub_menu 62:parent 62,15:caption 62,"Prendre une photo":on_click 62,photo

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
hide 1:gosub grille:gosub regle:show 1
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

texte:
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j
return

modiftext:
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
For j=11 to 17:active j:next j
return

supprime:
aire:
return

aerien:
visite:
photo:
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

annule:
refait:
copie:
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
ouvre:
enregistre:
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
' width 5,1000:left 5,500:top 5,100:show 5: ' <== POUR VISIONNER LE LIST DES MURS ****** A SUPPRIMER *******
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
  end_if
next i
return

' ******************************************************************************

regle:
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
return

grille:
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
return

form_list:
color 2,180,180,180:width 2,400:height 2,300
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
aide:
return
fin:
terminate

dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,tx$,ligne$(1000),seg$(10),typ$(1000),txt$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,s5,s6,s7,s8
label cliquer,init,grille,regle,refait_plan,motif_mur,retourne,saisir,saisir2
label pos_souris,test_spin,calcul_points
label selection,slectext,cherche_seg,fait_ligne,cherche_num
label aerien,visite,photo
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,aire
label mur,porte,fenetre,texte,cote
label annule,refait,copie,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10:caption 15,"Vues 3D"
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie (ya un bug!!!)
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule
sub_menu 31:parent 31,12:caption 31,"Refaire"      :on_click 31,refait
sub_menu 32:parent 32,12:caption 32,"Copier"        :on_click 32,copie
sub_menu 33:parent 33,12:caption 33,"Zoom"          :on_click 33,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte        :' FAIT
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote          :' FAIT


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext  :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote  :' FAIT
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime    :' FAIT
' sub_menu 56:parent 56,14:caption 56,"Calculer surface":on_click 56,aire  <=== A VOIR ???

' sous-menu Vues 3D
sub_menu 60:parent 60,15:caption 60,"Vue aérienne"    :on_click 60,aerien
sub_menu 61:parent 61,15:caption 61,"Visite virtuelle" :on_click 61,visite
sub_menu 62:parent 62,15:caption 62,"Prendre une photo":on_click 62,photo

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
gosub grille:gosub regle
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

texte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)

saisir:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir
  if tx$="" then goto s8
gosub cherche_num:typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_add 5,ligne$(i)
s8:
2d_image_copy 210,0,0,width(1),height(1)
cursor_arrow 1
for j=11 to 17:active j:next j
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j
return

modiftext:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES TEXTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s5
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub slectext
end_while
gosub slectext
hide 6:off_click 6:clear 6:hide 2

saisir2:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir2
  if len(tx$)=0 then tx$=txt$(i)
typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
color 300+i,240,240,240:left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
s5:
for j=11 to 17:active j:next j
return

slectext:
  color 300+i,240,240,240
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  txt$(i)=seg$(4)
  color 300+i,255,0,0
  mclic=0:j=i
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
for j=11 to 17:active j:next j
return

supprime:
for j=11 to 17:inactive j:next j:caption 111,"ANNULER":show 111
caption 2,"LISTE DES OBJETS":gosub form_list:j=0
for i=1 to count(5)
  if len(ligne$(i))>0 then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s6
show 2:print_target_is 2:font_bold 2
j=0:show 6
s7:
on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if clicked(111)=1 then off_click 6:hide 6:clear 6:hide 2:goto s6
end_while
off_click 6
i=val(left$(item_read$(6,item_index(6)),3))
if mid$(ligne$(i),5,4)="TXTE" : gosub slectext : else : gosub selection : end_if
j=message_warning_yes_no("SUPPRIMER?")
if j=0 or j=2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240
if mid$(ligne$(i),5,4)="COTE" then 2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
if mid$(ligne$(i),5,4)="MURS" or mid$(ligne$(i),5,4)="PORT" or mid$(ligne$(i),5,4)="FENT"
  2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
end_if
goto s7
end_if
hide 6:clear 6:hide 2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240:hide 300+i
if mid$(ligne$(i),5,4)="COTE" then hide 300+i
ligne$(i)="":item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s6:
caption 111,"VALIDER":hide 111:for j=11 to 17:active j:next j
return

aire:
return

aerien:
visite:
photo:
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="TXTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="AIRE"
end_if
return

annule:
refait:
copie:
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
ouvre:
enregistre:
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  if ligne$(i)="*" then ligne$(i)=""
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
      font_name 300+val(seg$(0)),"Terminal":font_bold 300+val(seg$(0))
      font_size 300+val(seg$(0)),(6/z)+6:left 300+val(seg$(0)),xd%:top 300+val(seg$(0)),yd%
      caption 300+val(seg$(0)),seg$(4):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
next i
return

' ******************************************************************************

regle:
hide 1
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
show 1
return

grille:
hide 1
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
show 1
return

form_list:
color 2,180,180,180:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
aide:
return
fin:
terminate

dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,c,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,tx$,img$,msg$,ligne$(1000),seg$(10),typ$(1000),txt$(1000)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,s5,s6,s7,s8
label cliquer,init,grille,regle,refait_plan,motif_mur,retourne,saisir,saisir2
label pos_souris,test_spin,calcul_points
label selection,slectext,cherche_seg,fait_ligne,cherche_num
label aerien,visite,photo
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,aire
label mur,porte,fenetre,texte,cote
label annule,refait,copie,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

if dir_exists ("c:\planoramic") = 0 then dir_make "c:\planoramic"
titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:on_close 0,fin
picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10:caption 15,"Vues 3D"
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau      :' FAIT
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre        :' FAIT
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre    :' FAIT
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie (ya un bug!!!)
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin          :' FAIT
' Réfléchir à la possibilité d'exporter le croquis en jpg, bmp ou pdf

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule
sub_menu 31:parent 31,12:caption 31,"Refaire"      :on_click 31,refait
sub_menu 32:parent 32,12:caption 32,"Copier"        :on_click 32,copie
sub_menu 33:parent 33,12:caption 33,"Zoom"          :on_click 33,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte        :' FAIT
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote          :' FAIT


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT (SAUF BOUTON TEXTURE 3D)
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext  :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote  :' FAIT
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime    :' FAIT
' sub_menu 56:parent 56,14:caption 56,"Calculer surface":on_click 56,aire  <=== A VOIR ???

' sous-menu Vues 3D
sub_menu 60:parent 60,15:caption 60,"Vue aérienne"    :on_click 60,aerien
sub_menu 61:parent 61,15:caption 61,"Visite virtuelle" :on_click 61,visite
sub_menu 62:parent 62,15:caption 62,"Prendre une photo":on_click 62,photo

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0:2d_target_is 1:cls
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
gosub grille:gosub regle
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=1
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=3
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=5
return

texte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)

saisir:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir
  if tx$="" then goto s8
gosub cherche_num:typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_add 5,ligne$(i)
s8:
2d_image_copy 210,0,0,width(1),height(1)
cursor_arrow 1
for j=11 to 17:active j:next j:c=7
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=9
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j:c=2
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j:c=4
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j:c=6
return

modiftext:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES TEXTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s5
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub slectext
end_while
gosub slectext
hide 6:off_click 6:clear 6:hide 2

saisir2:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir2
  if len(tx$)=0 then tx$=txt$(i)
typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
color 300+i,240,240,240:left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
s5:
for j=11 to 17:active j:next j:c=8
return

slectext:
  color 300+i,240,240,240
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  txt$(i)=seg$(4)
  color 300+i,255,0,0
  mclic=0:j=i
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
for j=11 to 17:active j:next j:c=10
return

supprime:
for j=11 to 17:inactive j:next j:caption 111,"ANNULER":show 111
caption 2,"LISTE DES OBJETS":gosub form_list:j=0
for i=1 to count(5)
  if len(ligne$(i))>0 then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s6
show 2:print_target_is 2:font_bold 2
j=0:show 6
s7:
on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if clicked(111)=1 then off_click 6:hide 6:clear 6:hide 2:goto s6
end_while
off_click 6
i=val(left$(item_read$(6,item_index(6)),3))
if mid$(ligne$(i),5,4)="TXTE" : gosub slectext : else : gosub selection : end_if
j=message_warning_yes_no("SUPPRIMER?")
if j=0 or j=2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240
if mid$(ligne$(i),5,4)="COTE" then 2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
if mid$(ligne$(i),5,4)="MURS" or mid$(ligne$(i),5,4)="PORT" or mid$(ligne$(i),5,4)="FENT"
  2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
end_if
goto s7
end_if
hide 6:clear 6:hide 2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240:hide 300+i
if mid$(ligne$(i),5,4)="COTE" then hide 300+i
ligne$(i)="":item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s6:
caption 111,"VALIDER":hide 111:for j=11 to 17:active j:next j:c=20
return

aire:
return

aerien:
visite:
photo:
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="TXTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="AIRE"
end_if
return

annule:
' CAS 1
' si c'est une création de mur ou de porte ou de fenêtre ou de texte ou de cote
' il faut trouver ligne$(i) concerné et passer par ma routine supprime -> la valeur de "c" est impaire
' CAS 2
' si c'est une modif de mur ou de porte ou de fenêtre ou de texte ou de cote
' il faut restituer l'état précédent la modif. -> la valeur de "c" est paire
return

refait:
copie:
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS?")
      if a=0 then return
      if a=1 then gosub enregistre
end_if
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
gosub init:caption 0,titre$
return

ouvre:
if count(5)>1
  msg$="ATTENTION, vous avez un fichier déjà ouvert!"+chr$(10)+chr$(13)
  msg$=msg$+"Si vous continuez ses données seront perdues"+chr$(10)+chr$(13)
  msg$=msg$+"Continuer quand-même?"
  a=message_warning_yes_no(msg$)
  if a<>1 then return
end_if
' initialisation
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
' recherche du fichier à ouvrir
open_dialog 117
dir_dialog 117,"c:\planoramic"
filter 117,"Fichier PLANORAMIC  -  *.p23|*.p23"
img$=file_name$(117)
delete 117
if img$<>"_"
  i=1:clear 5
  file_open_read 118,img$
  while file_eof(118)<>1
      file_readln 118,ligne$(i)
      item_add 5,ligne$(i):i=i+1
  end_while
  file_close 118
  gosub refait_plan
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

enregistre:
save_dialog 115
dir_dialog 115,"c:\PLANORAMIC"
filter 115,"Fichier PLANORAMIC|*.p23"
img$=file_name$(115)
if right$(img$,4)<>".p23" then img$=img$+".p23"
delete 115
if img$="_.p23" then return
if file_exists(img$)=1
  msg$="Le fichier "+img$+" existe déjà dans le répertoire!"+chr$(10)+chr$(13)+"    Désirez-vous le remplacer?"
  a=message_warning_yes_no(msg$)
  if a=1
      file_read_only_off img$:file_delete img$
  else
  img$="_"
  end_if
end_if
if img$<>"_"
  file_open_write 116,img$
  for i=1 to count(5)
      file_writeln 116,ligne$(i)
  next i
  file_close 116
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  if ligne$(i)="*" then ligne$(i)=""
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
      font_name 300+val(seg$(0)),"Terminal":font_bold 300+val(seg$(0))
      font_size 300+val(seg$(0)),(6/z)+6:left 300+val(seg$(0)),xd%:top 300+val(seg$(0)),yd%
      caption 300+val(seg$(0)),seg$(4):show 300+val(seg$(0))
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
next i
return

' ******************************************************************************

regle:
hide 1
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
show 1
return

grille:
hide 1
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
show 1
return

form_list:
color 2,180,180,180:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
aide:
return
fin:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS AVANT DE QUITTER?")
  if a=1 then gosub enregistre
end_if
terminate

dim h,i,j,n,q,p,ii : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl,mclic,v1,v2,v3,v4,v5,va,open
dim xa%,ya%,xb%,yb%,xc%,yc%,xd%,yd%,xe%,ye%,xf%,yf%,xp%,yp%,xv%,yv%
dim lg%,ha%,dh%,a,c,k,pi,nv,mx,my,x1%,y1%,x2%,y2%,axd%,ayd%
dim titre$,num$,tx$,img$,msg$,annul$,refair$
dim ligne$(1000),seg$(10),typ$(1000),txt$(1000)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000),op(1000),xm(1000),ym(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf,form_list,vc1,vc2,vc3,vc4,s1,s2,s3,s4,s5,s6,s7,s8
label cliquer,init,grille,regle,refait_plan,motif_mur,retourne,saisir,saisir2
label pos_souris,test_spin,calcul_points
label selection,slectext,cherche_seg,fait_ligne,cherche_num
label modifmur,modifporte,modifent,modiftext,modifcote,supprime,sup
label mur,porte,fenetre,texte,cote
label annule,refait,zoom
label nouveau,ouvre,enregistre,prefere,fin,propos,aide

if dir_exists ("c:\planoramic") = 0 then dir_make "c:\planoramic"
titre$="*** P L A N O R A M I C ***":caption 0,titre$
full_space 0:hide 0:on_close 0,fin
picture 1:width 1,5000:height 1,5000
form 2:hide 2:on_close 2,retourne
dlist 5

' menu Principal OBJETS RÉSERVÉS DE 10 A 80
main_menu 10
' les sous-menus
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 12:parent 12,10:caption 12,"Edition"
sub_menu 13:parent 13,10:caption 13,"Plan"
sub_menu 14:parent 14,10:caption 14,"Commandes"
sub_menu 15:parent 15,10
sub_menu 16:parent 16,10:caption 16,"A propos"      :on_click 16,propos
sub_menu 17:parent 17,10:caption 17,"Aide"          :on_click 17,aide

' sous-menu Fichier
sub_menu 20:parent 20,11:caption 20,"Nouveau"      :on_click 20,nouveau      :' FAIT
sub_menu 21:parent 21,11:caption 21,"Ouvrir"        :on_click 21,ouvre        :' FAIT
sub_menu 22:parent 22,11:caption 22,"Enregistrer"  :on_click 22,enregistre    :' FAIT
sub_menu 23:parent 23,11:caption 23,"Règlages"      :on_click 23,prefere      :' FAIT en partie (ya un bug!!!)
sub_menu 24:parent 24,11:caption 24,"Quitter"      :on_click 24,fin          :' FAIT

' sous-menu Edition
sub_menu 30:parent 30,12:caption 30,"Annuler"      :on_click 30,annule        :' FAIT
sub_menu 31:parent 31,12:caption 31,"Rétablir"      :on_click 31,refait        :' FAIT
sub_menu 32:parent 32,12:caption 32,"Zoom"          :on_click 32,zoom          :' FAIT

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur          :' FAIT
sub_menu 41:parent 41,13:caption 41,"Créer porte"  :on_click 41,porte        :' FAIT
sub_menu 42:parent 42,13:caption 42,"Créer fenêtre" :on_click 42,fenetre      :' FAIT
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte        :' FAIT
sub_menu 44:parent 44,13:caption 44,"Créer cote"    :on_click 44,cote          :' FAIT


' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"    :on_click 50,modifmur    :' FAIT
sub_menu 51:parent 51,14:caption 51,"Modifier porte"  :on_click 51,modifporte  :' FAIT
sub_menu 52:parent 52,14:caption 52,"Modifier fenêtre":on_click 52,modifent    :' FAIT
sub_menu 53:parent 53,14:caption 53,"Modifier texte"  :on_click 53,modiftext  :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier cote"  :on_click 54,modifcote  :' FAIT
sub_menu 55:parent 55,14:caption 55,"Supprimer"      :on_click 55,supprime    :' FAIT

command_target_is 2
list 6:hide 6:width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 6,(height(2)/2-height(6)/2)
' Pour ZOOM et RÈGLAGES
option 81:hide 81:left 81,20:top 81, 30:caption 81," 25 %"
option 82:hide 82:left 82,20:top 82, 60:caption 82," 50 %"
option 83:hide 83:left 83,20:top 83, 90:caption 83,"100 %"
option 84:hide 84:left 84,20:top 84,120:caption 84,"200 %"
option 85:hide 85:left 85,20:top 85,150:caption 85,"400 %"
button 86:hide 86:left 86,120:top 86,170:width 86,50:caption 86," OK "
spin 87:hide 87:left 87,5:top 87,5:width 87,50:min 87, 4:max 87,100
spin 88:hide 88:left 88,5:top 88,30:width 88,50:min 88,10:max 88,300
check 89:hide 89:left 89,5:top 89,165:caption 89,"Règles visible"
check 90:hide 90:left 90,5:top 90,190:caption 90,"Grille visible"
option 91:hide 91:width 91,17:left 91,5:top 91,80
picture 92:hide 92:width 92,60:height 92,15:left 92,25:top 92,80
2d_target_is 92:2d_fill_solid:2d_flood 1,1,0,0,0
option 93:hide 93:width 93,17:left 93,95:top 93,80
picture 94:hide 94:width 94,60:height 94,15:left 94,115:top 94,80
2d_target_is 94:2d_fill_diagonal_up:2d_flood 1,1,0,0,0
option 95:hide 95:width 95,17:left 95,5:top 95,100
picture 96:hide 96:width 96,60:height 96,15:left 96,25:top 96,100
2d_target_is 96:2d_fill_diagonal_down:2d_flood 1,1,0,0,0
option 97:hide 97:width 97,17:left 97,95:top 97,100
picture 98:hide 98:width 98,60:height 98,15:left 98,115:top 98,100
2d_target_is 98:2d_fill_diagonal_cross:2d_flood 1,1,0,0,0
option 99:hide 99:width 99,17:left 99,5:top 99,120
picture 100:hide 100:width 100,60:height 100,15:left 100,25:top 100,120
2d_target_is 100:2d_fill_cross:2d_flood 1,1,0,0,0
option 101:hide 101:width 101,17:left 101,95:top 101,120
picture 102:hide 102:width 102,60:height 102,15:left 102,115:top 102,120
' POUR MODIFIER LES MURS, LES PORTES ET LES FENÊTRES
spin 103:hide 103:left 103, 20:top 103,25:min 103,-50:max 103,9900:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:min 104,-50:max 104,9900:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:min 105,-50:max 105,9900:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:min 106,-50:max 106,9900:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:min 107,0:max 107,9900:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:min 108,10:max 108,300:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:min 109,4:max 109,100:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,230:width 110,120:' caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,265:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,230:caption 112,"INVERSER"
check 113:hide 113:left 113, 20:top 113,250:caption 113,"MIROIR"

for j=151 to 180:alpha j:hide j:next j

left 151,45 :top 151,60 :caption 151,"  Style des murs  "
left 152,60 :top 152,10 :caption 152," cm. Épaisseur des murs "
left 153,60 :top 153,35 :caption 153," cm.  Hauteur  des murs "
left 154,7  :top 154,10 :caption 154,"DÉBUTE À:"
left 155,7  :top 155,30 :caption 155,"X"
left 156,145:top 156,30 :caption 156,"cm"
left 157,207:top 157,30 :caption 157,"Y"
left 158,345:top 158,30 :caption 158,"cm"
left 159,7  :top 159,60 :caption 159,"TERMINE À:"
left 160,7  :top 160,80 :caption 160,"X"
left 161,145:top 161,80 :caption 161,"cm"
left 162,207:top 162,80 :caption 162,"Y"
left 163,345:top 163,80 :caption 163,"cm"
left 164,20 :top 164,120
left 165,145:top 165,140:caption 165,"cm"
left 166,220:top 166,120:caption 166,"HAUTEUR"
left 167,345:top 167,140:caption 167,"cm"
left 168,20 :top 168,180:caption 168,"ÉPAISSEUR"
left 169,145:top 169,200:caption 169,"cm"

command_target_is 0
for j=300 to 1300:alpha j:hide j:next j

image 210: ' image ecran lors du traçage
image 211: ' image de la grille seule
image 212: ' image effaçant données porte et fenêtre
image 213: ' image du picture vierge
2d_image_copy 213,0,0,width(1),height(1)
gosub init

end

' ******************************************************************************
init:
show 0:2d_target_is 1:cls
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1:open=2
dh%=ha%/(z*4):nv=250:styl=2:pfstyl=1
gosub grille:gosub regle
return

cliquer:
wait 120:' <=== Valeur à ajuster (j'obtiens de bon résultats entre 100 et 200)
if scancode=1 then clic=clic+1
if scancode=1 then clic=clic+1
if clic=1 then mclic=1
if clic=2 then mclic=2
clic=0
return
' ******************************************************************************

pos_souris:
2d_fill_solid:2d_fill_color 255,255,100
print_locate xp%-20,yp%-30:print "x=";str$((xp%-50)*(z*2));" y=";str$((yp%-50)*(z*2))
wait 200
return

mur:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°";" Épaisseur= ";str$(ha%/100);"m"
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=nv:op(i)=0:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=1:ii=i
return

calcul_points:
      if xf%>xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100
      end_if
      if xf%<xd%
        k=atn((yd%-yf%)/(xf%-xd%)):a=k*180/pi:a=int(a*100)/100:a=180+a:k=k+3.14
      end_if
      if xd%=xf%
        if yf%<yd% then a=90:k=1.57
        if yf%>yd% then a=270:k=4.71
      end_if
      xa%=xd%-dh%*sin(k):ya%=yd%-dh%*cos(k): ' point A
      xe%=xd%+dh%*sin(k):ye%=yd%+dh%*cos(k): ' point E
      xc%=xe%+lg%*cos(k):yc%=ye%-lg%*sin(k): ' point C
      xb%=xa%+lg%*cos(k):yb%=ya%-lg%*sin(k): ' point B
return
motif_mur:
' Nettoyage
  2d_pen_color 255,255,255:2d_pen_width 2
  for j=-1*dh% to dh%
      x1%=xd%-j*sin(k):y1%=yd%-j*cos(k)
      x2%=x1%+lg%*cos(k):y2%=y1%-lg%*sin(k)
      2d_line x1%,y1%,x2%,y2%
  next j
  2d_pen_color 0,0,0
  2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  if (styl<>0 and pfstyl<>0)
      mx=(xd%+xf%)/2:my=(yd%+yf%)/2
      if styl=1 then 2d_fill_solid
      if styl=2 then 2d_fill_diagonal_up
      if styl=3 then 2d_fill_diagonal_down
      if styl=4 then 2d_fill_diagonal_cross
      if styl=5 then 2d_fill_cross
      2d_flood mx,my,0,0,0
  end_if
return

porte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+40:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      ' Tracé ouvrant gauche sud par défaut
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
        2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
      next j:j=j+0.01
      2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=210:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=3:ii=i
return

fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 210,0,0
      if (scancode>=160 and scancode<=163)
        xf%=mouse_x_position(1):yf%=mouse_y_position(1)
      else
        xd%=axd%:yd%=ayd%:xf%=xd%+80:yf%=yd%
      end_if
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
      gosub calcul_points:2d_pen_color 0,0,0:2d_pen_width 2
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche orienté sud par défaut
        2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%:xv%=axd%:yv%=ayd%
      for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit orienté sud par défaut
        2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
      next j:j=j+0.01
      2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%:wait 100
      2d_image_copy 212,0,0,width(1),height(1):xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-60:print "Angle: ";str$(wrap_value(a));"°"
      print_locate xp%-20,yp%-45:print "Largeur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
2d_image_paste 212,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:hm(i)=120:op(i)=2:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 210,0,0,width(1),height(1)
for j=11 to 17:active j:next j:c=5:ii=i
return

texte:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)

saisir:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir
  if tx$="" then goto s8
gosub cherche_num:typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_add 5,ligne$(i)
s8:
2d_image_copy 210,0,0,width(1),height(1)
cursor_arrow 1
for j=11 to 17:active j:next j:c=7:ii=i
return

cote:
for j=11 to 17:inactive j:next j:2d_target_is 1
2d_image_copy 210,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
repeat
  xd%=mouse_x_position(1):yd%=mouse_y_position(1):xf%=xd%:yf%=yd%
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 210,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
until (mouse_left_down(1)=1 and mouse_left_up(1)=0)
2d_image_paste 210,0,0:2d_image_copy 210,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  if scancode=162 or scancode=163 then yf%=yd%
  if scancode=160 or scancode=161 then xf%=xd%
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 210,0,0:gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      xv%=xf%:yv%=yf%:xp%=xf%:yp%=yf%
      print_locate xp%-20,yp%-45:print "Longueur= ";str$((int(lg%)/100)*(z*2));"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 210,0,0:lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
if lg%<>0
  2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  mx=(xd%+xf%)/2:my=(yd%+yf%)/2
  gosub cherche_num:typ$(i)="COTE":txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
  left 300+i,mx:top 300+i,my:caption 300+i,txt$(i):show 300+i
  dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
  ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2)
  gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 1
for j=11 to 17:active j:next j:c=9:ii=i
return

selection:
  if j>0
      if seg$(1)="COTE"
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      else
        2d_pen_color 0,0,0
        2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
      end_if
  end_if
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
  ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
  if seg$(1)="COTE"
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
  else
      2d_pen_color 200,0,0
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  mclic=0:j=i:annul$=ligne$(i)
return

modifmur:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES MURS":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s1
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER MUR":gosub form_mpf
for h=103 to 111:show h:next h:for h=154 to 169:show h:next h
caption 164,"LONGUEUR"
position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))
position 108,val(seg$(7)) :position 109,val(seg$(6))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
ha%=position(109):nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=0:typ$(i)="MURS"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 111:hide h:next h:for h=154 to 169:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s1:
for j=11 to 17:active j:next j:c=2
return

modifporte:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES PORTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="PORT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s2
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 113:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if (checked(112)=0 and checked(113)=0) then open=2
  if (checked(112)=1 and checked(113)=0) then open=3
  if (checked(112)=0 and checked(113)=1) then open=4
  if (checked(112)=1 and checked(113)=1) then open=5
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="PORT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 113:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s2:
for j=11 to 17:active j:next j:c=4
return

vc1:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v1=position(103):v2=position(104):v5=position(107)
return
vc2:
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc3:
  position 105,position(103)+position(107)*cos(a)
  position 106,position(104)-position(107)*sin(a)
  position 107,sqr(power(position(105)-position(103),2)+power(position(104)-position(106),2))
  v3=position(105):v4=position(106):v5=position(107)
return
vc4:
  if position(105)<>position(103)
      va=(atn((position(106)-position(104))/(position(105)-position(103)))*180)/pi:va=int(va*100)/100
  end_if
  if position(103)=position(105)
      if position(106)<position(104) then va=90
      if position(106)>position(104) then va=270
  end_if
  print_locate 220,200:print "ANGLE : "; wrap_value(va); "°        "
return

modifent:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES FENÊTRES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="FENT" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s3
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
for h=103 to 112:show h:next h:for h=154 to 167:show h:next h
caption 164,"LARGEUR"
dx(i)=val(seg$(2)):dy(i)=val(seg$(3)):fx(i)=val(seg$(4)):fy(i)=val(seg$(5))
hm(i)=val(seg$(7)):v1=dx(i):v2=dy(i):v3=fx(i):v4=fy(i)
v5=sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))

 position 103,dx(i):position 104,dy(i)
 position 105,fx(i):position 106,fy(i)
 position 107,sqr(power(fx(i)-dx(i),2)+power(dy(i)-fy(i),2))
 position 108,hm(i)

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
  gosub vc4
  if checked(112)=0 then open=2
  if checked(112)=1 then open=3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
nv=position(108):dh%=ha%/(z*4)
' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:hm(i)=nv:op(i)=open:typ$(i)="FENT"
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2
' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s3:
for j=11 to 17:active j:next j:c=6
return

modiftext:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES TEXTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s5
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub slectext
end_while
gosub slectext
hide 6:off_click 6:clear 6:hide 2

saisir2:
  tx$=message_input$("PLANORAMIC", "Entrez un nom (20 caractères maxi)" , "")
  if len(tx$)>20 then goto saisir2
  if len(tx$)=0 then tx$=txt$(i)
typ$(i)="TXTE":txt$(i)=tx$
font_name 300+i,"Terminal":font_bold 300+i:font_size 300+i,(6/z)+6
color 300+i,240,240,240:left 300+i,xd%:top 300+i,yd%:caption 300+i,txt$(i):show 300+i
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2)
gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
s5:
for j=11 to 17:active j:next j:c=8
return

slectext:
  color 300+i,240,240,240
  i=val(left$(item_read$(6,item_index(6)),3)):gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i)=ligne$(i)+seg$(q)+"*":next q:annul$=ligne$(i)
  xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
  txt$(i)=seg$(4)
  color 300+i,255,0,0
  mclic=0:j=i
return

modifcote:
for j=11 to 17:inactive j:next j
caption 2,"LISTE DES COTES":gosub form_list:j=0
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="COTE" then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s4
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6:clear 6

caption 2,"MODIFIER COTE":gosub form_mpf
for h=103 to 107:show h:next h:for h=154 to 164:show h:next h:show 111
caption 164,"LONGUEUR"

position 103,val(seg$(2)):position 104,val(seg$(3))
position 105,val(seg$(4)):position 106,val(seg$(5))
position 107,sqr(power(val(seg$(4))-val(seg$(2)),2)+power(val(seg$(3))-val(seg$(5)),2))

while clicked(111)=0
  if clicked(1)=1 then to_foreground 2
  gosub test_spin
  if position(103)<>v1 or position(104)<>v2 then gosub vc1
  if position(105)<>v3 or position(106)<>v4 then gosub vc2
  if position(107)<>v5 then gosub vc3
end_while

xd%=50+position(103)/(z*2):yd%=50+position(104)/(z*2)
xf%=50+position(105)/(z*2):yf%=50+position(106)/(z*2)
mx=(xd%+xf%)/2:my=(yd%+yf%)/2
lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))

' refaire ligne$(i)
dx(i)=(xd%-50)*(z*2):dy(i)=(yd%-50)*(z*2):fx(i)=(xf%-50)*(z*2):fy(i)=(yf%-50)*(z*2)
ep(i)=ha%:xm(i)=(mx-50)*(z*2):ym(i)=(my-50)*(z*2):txt$(i)=str$((int(lg%)/100)*(z*2))+"m"
typ$(i)="COTE":gosub fait_ligne:item_delete 5,i:item_insert 5,i,ligne$(i):ii=i
2d_target_is 2:for h=103 to 112:hide h:next h:for h=154 to 167:hide h:next h:hide 2

' refaire le plan
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s4:
for j=11 to 17:active j:next j:c=10
return

supprime:
for j=11 to 17:inactive j:next j:caption 111,"ANNULER":show 111
caption 2,"LISTE DES OBJETS":gosub form_list:j=0
for i=1 to count(5)
  if len(ligne$(i))>0 then item_add 6,ligne$(i):j=j+1
next i:if j=0 then hide 6:hide 2:clear 6:goto s6
show 2:print_target_is 2:font_bold 2
j=0:show 6
s7:
on_click 6,cliquer
while mclic<>2
  if clicked(1)=1 then to_foreground 2
  if clicked(111)=1 then off_click 6:hide 6:clear 6:hide 2:goto s6
end_while
off_click 6
i=val(left$(item_read$(6,item_index(6)),3))
if mid$(ligne$(i),5,4)="TXTE" : gosub slectext : else : gosub selection : end_if
j=message_warning_yes_no("SUPPRIMER?")
if j=0 or j=2
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240
if mid$(ligne$(i),5,4)="COTE" then 2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
if mid$(ligne$(i),5,4)="MURS" or mid$(ligne$(i),5,4)="PORT" or mid$(ligne$(i),5,4)="FENT"
  2d_pen_color 0,0,0:2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
end_if
goto s7
end_if
hide 6:clear 6:hide 2
sup:
if mid$(ligne$(i),5,4)="TXTE" then color 300+i,240,240,240:hide 300+i
if mid$(ligne$(i),5,4)="COTE" then hide 300+i
ligne$(i)="":item_delete 5,i:item_insert 5,i,ligne$(i)
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
gosub refait_plan
s6:
caption 111,"VALIDER":hide 111:for j=11 to 17:active j:next j:c=20
return

' Recherche des segments
cherche_seg:
for p=0 to 10:seg$(p)="":next p: ' purger les segments
n=0:q=instr(ligne$(i),"*"): ' on cherche la première occurence du séparateur
while q>0: ' tant qu'il y a un séparateur, faire:
    seg$(n)=left$(ligne$(i),q-1): ' mémoriser le premier segment
    ligne$(i)=mid$(ligne$(i),q+1,len(ligne$(i)))
    n=n+1: ' éliminer ce segment et son séparateur
    q=instr(ligne$(i),"*"): ' chercher un nouveau séparateur
end_while
return

' routine de recherche d'un numéro d'objet 3d disponible
cherche_num:
p=1
while len(ligne$(p))>4:p=p+1:end_while
if p>999 then message "Vous avez atteint la limite!"+chr$(10)+chr$(13)+"Vous ne pouvez plus rien créer!":p=p-1
i=p
return

fait_ligne:
num$=str$(i)
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+typ$(i)+"*": ' objet n°,type d'objet
if typ$(i)="MURS" or typ$(i)="PORT" or typ$(i)="FENT"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"
  ligne$(i)=ligne$(i)+str$(ep(i))+"*"+str$(hm(i))+"*"+str$(op(i))+"*"
end_if
if typ$(i)="COTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"
  ligne$(i)=ligne$(i)+str$(fx(i))+"*"+str$(fy(i))+"*"+str$(ep(i))+"*"
  ligne$(i)=ligne$(i)+str$(xm(i))+"*"+str$(ym(i))+"*"+txt$(i)+"*"
end_if
if typ$(i)="TXTE"
  ligne$(i)=ligne$(i)+str$(dx(i))+"*"+str$(dy(i))+"*"+txt$(i)+"*"
end_if
return

annule:
if c>10 then message "Impossible d'annuler!":return
if odd(c)=1 then i=ii:refair$=ligne$(i):gosub sup:return
if even(c)=1
  i=ii:refair$=ligne$(i):item_delete 5,i:ligne$(i)=annul$:item_insert 5,i,ligne$(i)
' refaire le plan
  2d_target_is 1:cls
  if gr=1 then 2d_image_paste 211,0,0
  if rg=1 then gosub regle
  gosub refait_plan:c=20
end_if
return

refait:
if refair$="" then message "Impossible de rétablir!":return
refair$=right$(refair$,len(refair$)-4):gosub cherche_num
if len(num$)=1 then num$="  "+num$
if len(num$)=2 then num$=" "+num$
ligne$(i)=num$+"*"+refair$:item_insert 5,i,ligne$(i)
' refaire le plan
  2d_target_is 1:cls
  if gr=1 then 2d_image_paste 211,0,0
  if rg=1 then gosub regle
  gosub refait_plan:c=20
refair$=""
return

zoom:
caption 2,"ZOOM":gosub form_zr:show 2:for h=81 to 86:show h:next h
if z=0.25 then set_focus 85:' 400%
if z=0.5 then set_focus 84: ' 200%
if z=1 then set_focus 83:  ' 100%
if z=2 then set_focus 82:  '  50%
if z=4 then set_focus 81:  '  25%
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(81)=1 then z=4:  '  25%
  if checked(82)=1 then z=2:  '  50%
  if checked(83)=1 then z=1:  ' 100%
  if checked(84)=1 then z=0.5: ' 200%
  if checked(85)=1 then z=0.25:' 400%
end_while
for h=81 to 86:hide h:next h:hide 2
2d_target_is 1:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

nouveau:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS?")
      if a=0 then return
      if a=1 then gosub enregistre
end_if
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
gosub init:caption 0,titre$
return

ouvre:
if count(5)>1
  msg$="ATTENTION, vous avez un fichier déjà ouvert!"+chr$(10)+chr$(13)
  msg$=msg$+"Si vous continuez ses données seront perdues"+chr$(10)+chr$(13)
  msg$=msg$+"Continuer quand-même?"
  a=message_warning_yes_no(msg$)
  if a<>1 then return
end_if
' initialisation
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="TXTE" or mid$(ligne$(i),5,4)="COTE" then delete 300+i:alpha 300+i:hide 300+i
  ligne$(i)=""
next i:clear 5
for i=0 to 10:seg$(i)="":next i:gosub init
' recherche du fichier à ouvrir
open_dialog 117
dir_dialog 117,"c:\planoramic"
filter 117,"Fichier PLANORAMIC  -  *.p23|*.p23"
img$=file_name$(117)
delete 117
if img$<>"_"
  i=1:clear 5
  file_open_read 118,img$
  while file_eof(118)<>1
      file_readln 118,ligne$(i)
      item_add 5,ligne$(i):i=i+1
  end_while
  file_close 118
  gosub refait_plan
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

enregistre:
save_dialog 115
dir_dialog 115,"c:\PLANORAMIC"
filter 115,"Fichier PLANORAMIC|*.p23"
img$=file_name$(115)
if right$(img$,4)<>".p23" then img$=img$+".p23"
delete 115
if img$="_.p23" then return
if file_exists(img$)=1
  msg$="Le fichier "+img$+" existe déjà dans le répertoire!"+chr$(10)+chr$(13)+"    Désirez-vous le remplacer?"
  a=message_warning_yes_no(msg$)
  if a=1
      file_read_only_off img$:file_delete img$
  else
  img$="_"
  end_if
end_if
if img$<>"_"
  file_open_write 116,img$
  for i=1 to count(5)
      file_writeln 116,ligne$(i)
  next i
  file_close 116
  c=0:caption 0,"P L A N O R A M I C ==> "+img$
end_if
return

' routine de test de non dépassement des valeurs min et max si un chiffre est rentré manuellement dans un spin
test_spin:
 if position(87)>100 then position 87,100
 if position(88)>300 then position 88,300
 if position(103)>9900 then position 103,9900
 if position(104)>9900 then position 104,9900
 if position(105)>9900 then position 105,9900
 if position(106)>9900 then position 106,9900
 if position(108)>300 then position 108,300
 if position(109)>100 then position 109,100
 if position(87)<4 then position 87,4
 if position(88)<10 then position 88,10
 if position(103)<-50 then position 103,-50
 if position(104)<-50 then position 104,-50
 if position(105)<-50 then position 105,-50
 if position(106)<-50 then position 106,-50
 if position(108)<10 then position 108,10
 if position(109)<4 then position 109,4
return

prefere:
for j=11 to 17:inactive j:next j
caption 2,"REGLAGES":gosub form_zr:show 2:for h=86 to 102:show h:next h
2d_target_is 2:2d_fill_color 255,255,255:print_target_is 2
for h=151 to 153:show h:next h
if rg=1 then mark_on 89
if rg<>1 then mark_off 89
if gr=1 then mark_on 90
if gr<>1 then mark_off 90
if styl=0 then mark_on 101
if styl=1 then mark_on 91
if styl=2 then mark_on 93
if styl=3 then mark_on 95
if styl=4 then mark_on 97
if styl=5 then mark_on 99
position 87,ha%:position 88,nv
while clicked(86)=0
      if clicked(1)=1 then to_foreground 2
  if checked(91)=1 then styl=1
  if checked(93)=1 then styl=2
  if checked(95)=1 then styl=3
  if checked(97)=1 then styl=4
  if checked(99)=1 then styl=5
  if checked(101)=1 then styl=0
  if checked(89)=1 then rg=1
  if checked(89)=0 then rg=0
  if checked(90)=1 then gr=1
  if checked(90)=0 then gr=0
  gosub test_spin
end_while
ha%=position(87):nv=position(88):dh%=ha%/(z*4)
for h=86 to 102:hide h:next h:for h= 151 to 153:hide h:next h:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
if rg=1 then gosub regle
for j=11 to 17:active j:next j

refait_plan:
2d_pen_color 0,0,0
for i=1 to count(5)
  gosub cherche_seg
  ligne$(i)="":for q=0 to n-1:ligne$(i) = ligne$(i) + seg$(q)+"*":next q:' reconstitue ligne$(i)
  if ligne$(i)="*" then ligne$(i)=""
  ' RESTAURER LES MURS    <*******************
  if seg$(1)="MURS" or seg$(1)="PORT" or seg$(1)="FENT"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      ha%=val(seg$(6)):nv=val(seg$(7)):dh%=ha%/(z*4):open=val(seg$(8))
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_poly_to xc%,yc%:2d_poly_to xb%,yb%:2d_poly_to xa%,ya%
  end_if
  if seg$(1)="MURS" then gosub motif_mur
  ' RESTAURER LES PORTES
  if seg$(1)="PORT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      ' Tracé ouvrant gauche sud
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01
            2d_point xc%-(lg%*cos(j)),yc%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xc%-(lg%*cos(j)),yc%-(lg%*sin(j)),xc%,yc%
      end_if
      ' Tracé ouvrant gauche nord
      if open=3
        for j=pi-k to (pi/2)-k step -0.01
            2d_point xa%-(lg%*cos(j)),ya%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xa%-(lg%*cos(j)),ya%-(lg%*sin(j)),xa%,ya%
      end_if
      ' Tracé ouvrant droit nord
      if open=4
        for j=pi+k to (pi/2)+k step -0.01
            2d_point xb%+(lg%*cos(j)),yb%-(lg%*sin(j))
        next j:j=j+0.01
        2d_line xb%+(lg%*cos(j)),yb%-(lg%*sin(j)),xb%,yb%
      end_if
      ' Tracé ouvrant droit sud
      if open=5
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01
            2d_point xe%+(lg%*cos(j)),ye%-(lg%*sin(j))
        next j:j=j+0.01:2d_line xe%+(lg%*cos(j)),ye%-(lg%*sin(j)),xe%,ye%
      end_if
  end_if
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      if open=2
        for j=(pi*2)-k to ((pi*3)/2)-k step -0.01: ' ouvrant gauche
            2d_point xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xc%-((lg%/2)*cos(j)),yc%-((lg%/2)*sin(j)),xc%,yc%
        for j=(pi*2)+k to ((pi*3)/2)+k step -0.01: ' ouvrant droit
            2d_point xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xe%+((lg%/2)*cos(j)),ye%-((lg%/2)*sin(j)),xe%,ye%
      end_if
      if open=3
        for j=pi-k to (pi/2)-k step -0.01: ' ouvrant gauche
            2d_point xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xa%-((lg%/2)*cos(j)),ya%-((lg%/2)*sin(j)),xa%,ya%
        for j=pi+k to (pi/2)+k step -0.01: ' ouvrant droit
            2d_point xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j))
        next j:j=j+0.01
        2d_line xb%+((lg%/2)*cos(j)),yb%-((lg%/2)*sin(j)),xb%,yb%
      end_if
  end_if
  ' RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2):xf%=50+val(seg$(4))/(z*2):yf%=50+val(seg$(5))/(z*2)
      mx=50+val(seg$(7))/(z*2):my=50+val(seg$(8))/(z*2):ha%=val(seg$(6)):dh%=ha%/(z*4)
      lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2)):gosub calcul_points
      2d_line xa%,ya%,xe%,ye%:2d_line xc%,yc%,xb%,yb%:2d_line xd%,yd%,xf%,yf%
      left 300+val(seg$(0)),mx:top 300+val(seg$(0)),my:caption 300+val(seg$(0)),seg$(9):show 300+val(seg$(0))
  end_if
  ' RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
      xd%=50+val(seg$(2))/(z*2):yd%=50+val(seg$(3))/(z*2)
      font_name 300+val(seg$(0)),"Terminal":font_bold 300+val(seg$(0))
      font_size 300+val(seg$(0)),(6/z)+6:left 300+val(seg$(0)),xd%:top 300+val(seg$(0)),yd%
      caption 300+val(seg$(0)),seg$(4):show 300+val(seg$(0))
  end_if
next i
return

' ******************************************************************************

regle:
hide 1
font_name 1,"Fixedsys":2d_target_is 1:2d_fill_color 255,255,255:print_target_is 1
for y=0 to height(1) step 50
  if (int(y/50)=y/50 and y<>0)
      if rg=1
        print_locate 1,y-7:rgy=(int(y/50)*z)-z
        if int(rgy)=rgy then print rgy
      end_if
  end_if
next y
for x=0 to width(1) step 50
  if (int(x/50)=x/50 and x<>0)
      if rg=1
        print_locate x-7,1:rgx=(int(x/50)*z)-z
        if int(rgx)=rgx then print rgx
      end_if
  end_if
next x
show 1
return

grille:
hide 1
2d_target_is 1:2d_pen_width 1
for y=0 to height(1) step 10
  if gr=1
      if int(y/50)<>y/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line 0,y,width(1),y
  end_if
next y
for x=0 to width(1) step 10
  if gr=1
      if int(x/50)<>x/50:2d_pen_color 0,200,200:else:2d_pen_color 0,0,250:end_if
      2d_line x,0,x,height(1)
  end_if
next x
2d_image_copy 211,0,0,width(1),height(1): ' Copie de la grille
show 1
return

form_list:
color 2,180,180,180:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2)
width 6,300:height 6,100
left 6,(width(2)/2)-(width(6)/2):top 2,(height(2)/2-height(6)/2):return
form_zr:
color 2,0,150,100:width 2,250:height 2,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
form_mpf:
color 2,200,200,200:width 2,400:height 2,330
left 2,(width(0)/2)+(width(2)/2):top 2,(height(0)/2-height(2)/2):return
retourne:
show 2:return

propos:
for j=11 to 17:inactive j:next j
msg$=    "PLANORAMIC créé le 14 Mars 2012 par Jean-Louis NAUDIN"+chr$(10)+chr$(13)
msg$=msg$+" Logiciel libre et gratuit. L'auteur ne peut pas être tenu"+chr$(10)+chr$(13)
msg$=msg$+" responsable des dommages éventuels suite à une mauvaise"+chr$(10)+chr$(13)
msg$=msg$+" utilisation de son logiciel."+chr$(10)+chr$(13)+chr$(10)+chr$(13)+chr$(10)+chr$(13)
msg$=msg$+"L'usage de ce programme à des fins commerciales est interdite."+chr$(10)+chr$(13)
message msg$
for j=11 to 17:active j:next j
return

aide:
' Pour Windows 7
if file_exists("c:\planoramic\aide_Planoramic.rtf")=1
  if file_exists("c:\Windows\write.exe")=1
      execute_wait "C:\Windows\write.exe C:\planoramic\aide_Planoramic.rtf"
  end_if
end_if
' Pour Windows XP
if file_exists("c:\planoramic\aide_Planoramic.rtf")=1
  if file_exists("c:\Windows\system32\write.exe")=1
      execute_wait "C:\Windows\system32\write.exe C:\planoramic\aide_Planoramic.rtf"
  end_if
end_if
return

fin:
if c>0
  a=message_warning_yes_no("VOULEZ-VOUS ENREGISTRER LES MODIFICATIONS AVANT DE QUITTER?")
  if a=1 then gosub enregistre
end_if
terminate