PLANORAMIC

dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl
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%
dim titre$,num$,ligne$(1000),seg$(10),typ$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label modifmur,divismur,deplamur,porte,fenetre,escalier,meuble
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000:on_click 1,cliquer

form 2:hide 2:color 2,0,150,100:width 2,200:height 2,250
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2)
list 5:hide 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
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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur
sub_menu 41:parent 41,13:caption 41,"Créer cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Déplacer mur"  :on_click 52,deplamur
sub_menu 53:parent 53,14:caption 53,"Ajout porte"  :on_click 53,porte
sub_menu 54:parent 54,14:caption 54,"Ajout fenêtre" :on_click 54,fenetre
sub_menu 55:parent 55,14:caption 55,"Ajout escalier":on_click 55,escalier
sub_menu 56:parent 56,14:caption 56,"Ajout meuble"  :on_click 56,meuble

' 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
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


image 110: ' image ecran lors du traçage
image 111: ' image de la grille seule
image 112: ' image du picture vierge
2d_image_copy 112,0,0,width(1),height(1)
gosub init

end

init:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=2
dh%=ha%/(z*2):nv=250:styl=2
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 print "simple clic!"
' if clic=2 then print "double clic!"
clic=0
return
' ******************************************************************************

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

mur:
2d_image_copy 110,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 110,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 110,0,0:2d_image_copy 110,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)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 110,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);"m"
      gosub pos_souris:wait 100
  end_if
end_while
2d_image_paste 110,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=nv:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 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
      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

cote:
aire:
texte:
zoom:
caption 2,"ZOOM":show 2:for h=81 to 86:show h:next h
if z=0.5 then set_focus 85
if z=1 then set_focus 84
if z=2 then set_focus 83
if z=4 then set_focus 82
if z=8 then set_focus 81
while clicked(86)=0
if checked(81)=1 then z=8
if checked(82)=1 then z=4
if checked(83)=1 then z=2
if checked(84)=1 then z=1
if checked(85)=1 then z=0.5
end_while
for h=81 to 86:hide h:next h:hide 2
cls:2d_image_paste 111,0,0:gosub regle:dh%=ha%/(z*2)
gosub refait_plan
return
modifmur:
divismur:
deplamur:
porte:
fenetre:
escalier:
meuble:
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"
  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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
if typ$(i)="MOBL"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
return

prefere:
caption 2,"REGLAGES":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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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*2)
for h=86 to 102:hide h:next h:hide 2
cls
if gr=1 then 2d_image_paste 111,0,0
if rg=1 then gosub regle

refait_plan:
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"
      xd%=50+val(seg$(2))/z:yd%=50+val(seg$(3))/z:xf%=50+val(seg$(4))/z:yf%=50+val(seg$(5))/z
      ha%=val(seg$(6))/z:nv=val(seg$(7)):dh%=ha%/2
      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%
      gosub motif_mur
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
  end_if
  ' A FAIRE RESTAURER LES MEUBLES <*******************
  if seg$(1)="MOBL"
  end_if
next i
return
annule:
refait:
copie:
colle:
supprime:
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/2)-z/2
        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/2)-z/2
        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 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
next y
for x=0 to width(1) step 10
  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)
next x
2d_image_copy 111,0,0,width(1),height(1): ' Copie de la grille
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
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%
dim titre$,num$,ligne$(1000),seg$(10),typ$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label modifmur,divismur,deplamur,porte,fenetre,escalier,meuble
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000: on_click 1,cliquer

form 2:hide 2:color 2,0,150,100:width 2,200:height 2,250
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2)
list 5:hide 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
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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' sous-menu Plan
sub_menu 40:parent 40,13:caption 40,"Créer mur"    :on_click 40,mur
sub_menu 41:parent 41,13:caption 41,"Créer cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Déplacer mur"  :on_click 52,deplamur
sub_menu 53:parent 53,14:caption 53,"Ajout porte"  :on_click 53,porte
sub_menu 54:parent 54,14:caption 54,"Ajout fenêtre" :on_click 54,fenetre
sub_menu 55:parent 55,14:caption 55,"Ajout escalier":on_click 55,escalier
sub_menu 56:parent 56,14:caption 56,"Ajout meuble"  :on_click 56,meuble

' 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
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


image 110: ' image ecran lors du traçage
image 111: ' image de la grille seule
image 112: ' image du picture vierge
2d_image_copy 112,0,0,width(1),height(1)
gosub init

end

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

cliquer:
wait 90:' <=== 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 print "simple clic!"
' if clic=2 then print "double clic!"
clic=0
return
' ******************************************************************************

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

mur:
2d_image_copy 110,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 110,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 110,0,0:2d_image_copy 110,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
off_click 1
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 110,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);"m"
      gosub pos_souris:wait 100
  end_if
end_while
on_click 1,cliquer
2d_image_paste 110,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=nv:gosub fait_ligne:item_add 5,ligne$(i)
end_if
cursor_arrow 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
      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

cote:
aire:
texte:
zoom:
caption 2,"ZOOM":show 2:for h=81 to 86:show h:next h
if z=0.5 then set_focus 85
if z=1 then set_focus 84
if z=2 then set_focus 83
if z=4 then set_focus 82
if z=8 then set_focus 81
while clicked(86)=0
if checked(81)=1 then z=8
if checked(82)=1 then z=4
if checked(83)=1 then z=2
if checked(84)=1 then z=1
if checked(85)=1 then z=0.5
end_while
for h=81 to 86:hide h:next h:hide 2
cls:2d_image_paste 111,0,0:gosub regle:dh%=ha%/(z*2)
gosub refait_plan
return
modifmur:
divismur:
deplamur:
porte:
fenetre:
escalier:
meuble:
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"
  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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
if typ$(i)="MOBL"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
return

prefere:
caption 2,"REGLAGES":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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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*2)
for h=86 to 102:hide h:next h:hide 2
cls
if gr=1 then 2d_image_paste 111,0,0
if rg=1 then gosub regle

refait_plan:
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"
      xd%=50+val(seg$(2))/z:yd%=50+val(seg$(3))/z:xf%=50+val(seg$(4))/z:yf%=50+val(seg$(5))/z
      ha%=val(seg$(6))/z:nv=val(seg$(7)):dh%=ha%/2
      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%
      gosub motif_mur
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
  end_if
  ' A FAIRE RESTAURER LES MEUBLES <*******************
  if seg$(1)="MOBL"
  end_if
next i
return
annule:
refait:
copie:
colle:
supprime:
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/2)-z/2
        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/2)-z/2
        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 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
next y
for x=0 to width(1) step 10
  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)
next x
2d_image_copy 111,0,0,width(1),height(1): ' Copie de la grille
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
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%
dim titre$,num$,ligne$(1000),seg$(10),typ$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label modifmur,divismur,deplamur,porte,fenetre,escalier,meuble
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000:on_click 1,cliquer

form 2:hide 2:color 2,0,150,100:width 2,200:height 2,250
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2)
list 5:hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Déplacer mur"  :on_click 52,deplamur
sub_menu 53:parent 53,14:caption 53,"Ajout porte"  :on_click 53,porte
sub_menu 54:parent 54,14:caption 54,"Ajout fenêtre" :on_click 54,fenetre
sub_menu 55:parent 55,14:caption 55,"Ajout escalier":on_click 55,escalier
sub_menu 56:parent 56,14:caption 56,"Ajout meuble"  :on_click 56,meuble

' 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
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


image 110: ' image ecran lors du traçage
image 111: ' image de la grille seule
image 112: ' image du picture vierge
2d_image_copy 112,0,0,width(1),height(1)
gosub init

end

init:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=2
dh%=ha%/(z*2):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 print "simple clic!"
' if clic=2 then print "double clic!"
clic=0
return
' ******************************************************************************

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

mur:
for j=11 to 17:inactive j:next j
2d_image_copy 110,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 110,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 110,0,0:2d_image_copy 110,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
off_click 1
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 110,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);"m"
      gosub pos_souris:wait 100
  end_if
end_while
on_click 1,cliquer
2d_image_paste 110,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=nv: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

cote:
aire:
texte:
zoom:
caption 2,"ZOOM":show 2:for h=81 to 86:show h:next h
if z=0.5 then set_focus 85
if z=1 then set_focus 84
if z=2 then set_focus 83
if z=4 then set_focus 82
if z=8 then set_focus 81
while clicked(86)=0
if checked(81)=1 then z=8
if checked(82)=1 then z=4
if checked(83)=1 then z=2
if checked(84)=1 then z=1
if checked(85)=1 then z=0.5
end_while
for h=81 to 86:hide h:next h:hide 2
cls:2d_image_paste 111,0,0:gosub regle:dh%=ha%/(z*2)
gosub refait_plan
return
modifmur:
divismur:
deplamur:

porte:
for j=11 to 17:inactive j:next j
2d_image_copy 110,0,0,width(1),height(1): ' porte à 0.80 m de large
off_click 1
while mouse_left_up(1)=0
      xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xv% or yd%<>yv%
      2d_image_paste 110,0,0
      xf%=xd%+80:yf%=yd%: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
      for j=pi*2 to (pi*3)/2 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%=xd%:yv%=yd%:wait 100
      ' Tracé ouvrant droit <=== A VOIR COMMENT L'IMPLÉMENTER
      ' for j=pi*2 to (pi*3)/2 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%
' A VOIR SI APPUI SUR TOUCHE ctrl OU shift LA PORTE PIVOTE (mettre avant cette séquence)
  end_if
end_while
on_click 1,cliquer
pfstyl=0:gosub motif_mur:pfstyl=1
2d_image_copy 110,0,0,width(1),height(1)
' INCLURE ICI LES DONNÉES AU LIST
for j=11 to 17:active j:next j
return

fenetre:
for j=11 to 17:inactive j:next j
2d_image_copy 110,0,0,width(1),height(1): ' fenêtre à 1.20 m de large
off_click 1
while mouse_left_up(1)=0
      xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xv% or yd%<>yv%
      2d_image_paste 110,0,0
      xf%=xd%+120:yf%=yd%: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 to (pi*3)/2 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%:xv%=xd%:yv%=yd%
      for j=pi*2 to (pi*3)/2 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%:wait 100
' A VOIR SI APPUI SUR TOUCHE ctrl OU shift LA FENETRE PIVOTE (mettre avant cette séquence)
  end_if
end_while
on_click 1,cliquer
pfstyl=0:gosub motif_mur:pfstyl=1
2d_image_copy 110,0,0,width(1),height(1)
' INCLURE ICI LES DONNÉES AU LIST
for j=11 to 17:active j:next j
return

escalier:
meuble:
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"
  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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
if typ$(i)="MOBL"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
return

prefere:
caption 2,"REGLAGES":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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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*2)
for h=86 to 102:hide h:next h:hide 2
cls
if gr=1 then 2d_image_paste 111,0,0
if rg=1 then gosub regle

refait_plan:
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"
      xd%=50+val(seg$(2))/z:yd%=50+val(seg$(3))/z:xf%=50+val(seg$(4))/z:yf%=50+val(seg$(5))/z
      ha%=val(seg$(6))/z:nv=val(seg$(7)):dh%=ha%/2
      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%
      gosub motif_mur
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
  end_if
  ' A FAIRE RESTAURER LES MEUBLES <*******************
  if seg$(1)="MOBL"
  end_if
next i
return
annule:
refait:
copie:
colle:
supprime:
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/2)-z/2
        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/2)-z/2
        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 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
next y
for x=0 to width(1) step 10
  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)
next x
2d_image_copy 111,0,0,width(1),height(1): ' Copie de la grille
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
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%
dim titre$,num$,ligne$(1000),seg$(10),typ$(1000),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label modifmur,divismur,deplamur,porte,fenetre,escalier,meuble
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000:on_click 1,cliquer

form 2:hide 2:color 2,0,150,100:width 2,200:height 2,250
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2)
list 5:hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Déplacer mur"  :on_click 52,deplamur
sub_menu 53:parent 53,14:caption 53,"Ajout porte"  :on_click 53,porte
sub_menu 54:parent 54,14:caption 54,"Ajout fenêtre" :on_click 54,fenetre
sub_menu 55:parent 55,14:caption 55,"Ajout escalier":on_click 55,escalier
sub_menu 56:parent 56,14:caption 56,"Ajout meuble"  :on_click 56,meuble

' 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
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


image 110: ' image ecran lors du traçage
image 111: ' image de la grille seule
image 112: ' image du picture vierge
2d_image_copy 112,0,0,width(1),height(1)
gosub init

end

init:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=2
dh%=ha%/(z*2):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 print "simple clic!"
' if clic=2 then print "double clic!"
clic=0
return
' ******************************************************************************

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

mur:
off_click 1
while mouse_left_up(1)= 1
  wait 10
end_while
for j=11 to 17:inactive j:next j
2d_image_copy 110,0,0,width(1),height(1)
cursor_cross 1
print_target_is 1
while mouse_left_up(1)= 0
  xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xp% or yd%<>yp%
      2d_image_paste 110,0,0
      xp%=xd%:yp%=yd%:gosub pos_souris
  end_if
end_while
2d_image_paste 110,0,0:2d_image_copy 110,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)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 110,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);"m"
      gosub pos_souris:wait 100
  end_if
end_while
on_click 1,cliquer
2d_image_paste 110,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=nv: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

cote:
aire:
texte:
zoom:
caption 2,"ZOOM":show 2:for h=81 to 86:show h:next h
if z=0.5 then set_focus 85
if z=1 then set_focus 84
if z=2 then set_focus 83
if z=4 then set_focus 82
if z=8 then set_focus 81
while clicked(86)=0
if checked(81)=1 then z=8
if checked(82)=1 then z=4
if checked(83)=1 then z=2
if checked(84)=1 then z=1
if checked(85)=1 then z=0.5
end_while
for h=81 to 86:hide h:next h:hide 2
cls:2d_image_paste 111,0,0:gosub regle:dh%=ha%/(z*2)
gosub refait_plan
return
modifmur:
divismur:
deplamur:

porte:
for j=11 to 17:inactive j:next j
2d_image_copy 110,0,0,width(1),height(1): ' porte à 0.80 m de large
off_click 1
while mouse_left_up(1)=0
      xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xv% or yd%<>yv%
      2d_image_paste 110,0,0
      xf%=xd%+80:yf%=yd%: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
      for j=pi*2 to (pi*3)/2 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%=xd%:yv%=yd%:wait 100
      ' Tracé ouvrant droit <=== A VOIR COMMENT L'IMPLÉMENTER
      ' for j=pi*2 to (pi*3)/2 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%
' A VOIR SI APPUI SUR TOUCHE ctrl OU shift LA PORTE PIVOTE (mettre avant cette séquence)
  end_if
end_while
on_click 1,cliquer
pfstyl=0:gosub motif_mur:pfstyl=1
2d_image_copy 110,0,0,width(1),height(1)
' INCLURE ICI LES DONNÉES AU LIST
for j=11 to 17:active j:next j
return

fenetre:
for j=11 to 17:inactive j:next j
2d_image_copy 110,0,0,width(1),height(1): ' fenêtre à 1.20 m de large
off_click 1
while mouse_left_up(1)=0
      xd%=mouse_x_position(1):yd%=mouse_y_position(1)
  if xd%<>xv% or yd%<>yv%
      2d_image_paste 110,0,0
      xf%=xd%+120:yf%=yd%: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 to (pi*3)/2 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%:xv%=xd%:yv%=yd%
      for j=pi*2 to (pi*3)/2 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%:wait 100
' A VOIR SI APPUI SUR TOUCHE ctrl OU shift LA FENETRE PIVOTE (mettre avant cette séquence)
  end_if
end_while
on_click 1,cliquer
pfstyl=0:gosub motif_mur:pfstyl=1
2d_image_copy 110,0,0,width(1),height(1)
' INCLURE ICI LES DONNÉES AU LIST
for j=11 to 17:active j:next j
return

escalier:
meuble:
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"
  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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
if typ$(i)="MOBL"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
return

prefere:
caption 2,"REGLAGES":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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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*2)
for h=86 to 102:hide h:next h:hide 2
cls
if gr=1 then 2d_image_paste 111,0,0
if rg=1 then gosub regle

refait_plan:
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"
      xd%=50+val(seg$(2))/z:yd%=50+val(seg$(3))/z:xf%=50+val(seg$(4))/z:yf%=50+val(seg$(5))/z
      ha%=val(seg$(6))/z:nv=val(seg$(7)):dh%=ha%/2
      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%
      gosub motif_mur
  end_if
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  end_if
  ' A FAIRE RESTAURER LES AIRES  <*******************
  if seg$(1)="AIRE"
  end_if
  ' A FAIRE RESTAURER LES TEXTES  <*******************
  if seg$(1)="TXTE"
  end_if
  ' A FAIRE RESTAURER LES MEUBLES <*******************
  if seg$(1)="MOBL"
  end_if
next i
return
annule:
refait:
copie:
colle:
supprime:
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/2)-z/2
        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/2)-z/2
        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 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
next y
for x=0 to width(1) step 10
  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)
next x
2d_image_copy 111,0,0,width(1),height(1): ' Copie de la grille
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
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000:on_click 1,cliquer

form 2:hide 2:color 2,0,150,100:width 2,200:height 2,250
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2)
list 5:hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent

' 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
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


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

end

init:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=2
dh%=ha%/(z*2):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 print "simple clic!"
' if clic=2 then print "double clic!"
clic=0
return
' ******************************************************************************

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

mur:
for j=11 to 17:inactive j:next j
2d_image_copy 110,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 110,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 110,0,0:2d_image_copy 110,0,0,width(1),height(1)
2d_pen_color 0,0,0:2d_pen_width 2
off_click 1
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  lg%=sqr(power(xf%-xd%,2)+power(yd%-yf%,2))
  if xf%<>xv% or yf%<>yv%
      2d_image_paste 110,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);"m"
      gosub pos_souris:wait 100
  end_if
end_while
on_click 1,cliquer
2d_image_paste 110,0,0
if lg%<>0
  gosub motif_mur:gosub cherche_num:typ$(i)="MURS"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=nv: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

cote:
aire:
texte:
return

zoom:
caption 2,"ZOOM":show 2:for h=81 to 86:show h:next h
if z=0.5 then set_focus 85
if z=1 then set_focus 84
if z=2 then set_focus 83
if z=4 then set_focus 82
if z=8 then set_focus 81
while clicked(86)=0
if checked(81)=1 then z=8
if checked(82)=1 then z=4
if checked(83)=1 then z=2
if checked(84)=1 then z=1
if checked(85)=1 then z=0.5
end_while
for h=81 to 86:hide h:next h:hide 2
cls:2d_image_paste 111,0,0:gosub regle:dh%=ha%/(z*2)
gosub refait_plan
return

modifmur:
divismur:
return

porte:
for j=11 to 17:inactive j:next j
2d_image_copy 110,0,0,width(1),height(1)
off_click 1
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 110,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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      2d_image_copy 112,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);"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
on_click 1,cliquer
2d_image_paste 112,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="PORT"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=210:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 110,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_image_copy 110,0,0,width(1),height(1)
off_click 1
repeat
      axd%=mouse_x_position(1):ayd%=mouse_y_position(1)
  if axd%<>xv% or ayd%<>yv%
      2d_image_paste 110,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
        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
        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 112,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);"m"
      gosub pos_souris
  end_if
until mouse_left_down(1)=1
on_click 1,cliquer
2d_image_paste 112,0,0
pfstyl=0:gosub motif_mur:pfstyl=1:gosub cherche_num:typ$(i)="FENT"
  dx(i)=(xd%-50)*z:dy(i)=(yd%-50)*z:fx(i)=(xf%-50)*z:fy(i)=(yf%-50)*z
  ep(i)=ha%:hm(i)=120:gosub fait_ligne:item_add 5,ligne$(i)
2d_image_copy 110,0,0,width(1),height(1)
for j=11 to 17:active j:next j
return

modifporte:
modifent:
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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
return

prefere:
caption 2,"REGLAGES":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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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*2)
for h=86 to 102:hide h:next h:hide 2
cls
if gr=1 then 2d_image_paste 111,0,0
if rg=1 then gosub regle

refait_plan:
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:yd%=50+val(seg$(3))/z:xf%=50+val(seg$(4))/z:yf%=50+val(seg$(5))/z
      ha%=val(seg$(6))/z:nv=val(seg$(7)):dh%=ha%/2
      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
      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%
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      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
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  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
annule:
refait:
copie:
colle:
supprime:
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/2)-z/2
        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/2)-z/2
        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 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
next y
for x=0 to width(1) step 10
  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)
next x
2d_image_copy 111,0,0,width(1),height(1): ' Copie de la grille
return

fin:
terminate

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

dim h,i,j,n,q,p : ' réservés indices et boucles
dim x,y,z,gr,rg,rgy,rgx,clic,styl,pfstyl
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(1000)
' dx(i),dy(i) => xd%,yd% * fx(i),fy(i) => xf%,yf% * ep(i) => ha% * hm(i) => nv
label form_zr,form_mpf
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000:on_click 1,cliquer

form 2:hide 2
list 5:hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent

' 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
' 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:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,195:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,230:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,25:caption 112,"INVERSER"
check 113:hide 113:left 113,220:top 113,25:caption 113,"MIROIR"

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:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1
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 print "simple clic!"
' if clic=2 then print "double clic!"
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
off_click 1
while mouse_left_up(1)=0
  xf%=mouse_x_position(1):yf%=mouse_y_position(1)
  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
on_click 1,cliquer
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: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

cote:
aire:
texte:
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 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
cls:2d_image_paste 211,0,0:gosub regle:dh%=ha%/(z*4)
gosub refait_plan
return

modifmur:
' Modification d'un mur:
' 1°) afficher un list avec seulement les murs
' 2°) un clic colore le mur en rouge
' 3°) deux clics colore le mur en rouge, le sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER MUR":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LONGUEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ÉPAISSEUR"
show 109:print_locate 145,200:print "cm"
show 110:show 111
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=103 to 111:hide j:next j:cls:hide 2
return

divismur:
return

porte:
for j=11 to 17:inactive j:next j
2d_image_copy 210,0,0,width(1),height(1)
off_click 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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      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
on_click 1,cliquer
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: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_image_copy 210,0,0,width(1),height(1)
off_click 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
        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
        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
on_click 1,cliquer
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: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

modifporte:
' Modification d'une porte:
' 1°) afficher un list avec seulement les portes
' 2°) un clic colore la porte sélectionnée en rouge
' 3°) deux clics colore la porte en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112:show 113
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 113:hide j:next j:cls:hide 2
return

modifent:
' Modification d'une fenêtre:
' 1°) afficher un list avec seulement les fenêtres
' 2°) un clic colore la fenêtre sélectionnée en rouge
' 3°) deux clics colore la fenêtre en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 112:hide j:next j:cls:hide 2
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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
' if gr=0 then 2d_image_paste 213,0,0
if rg=1 then gosub regle

refait_plan:
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)
      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
      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%
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      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
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  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
annule:
refait:
copie:
colle:
supprime:
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_zr:
color 2,0,150,100:width 2,200:height 2,250
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,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
fin:
terminate

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 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

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
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),undo(50),unimage(50)
dim dx(1000),dy(1000),fx(1000),fy(1000),ep(1000),hm(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
label cliquer,init,grille,regle,refait_plan,motif_mur
label pos_souris,test_spin,calcul_points
label cherche_seg,fait_ligne,cherche_num
label mur,cote,aire,texte,zoom
label selection,modifmur,divismur,porte,fenetre,modifporte,modifent
label annule,refait,copie,colle,supprime
label aerien,visite,photo
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:picture 1:width 1,5000:height 1,5000

form 2:hide 2:dlist 5:' hide 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,"Coller"        :on_click 33,colle
sub_menu 34:parent 34,12:caption 34,"Supprimer"    :on_click 34,supprime

' 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 cotes"  :on_click 41,cote
sub_menu 42:parent 42,13:caption 42,"Créer surface" :on_click 42,aire
sub_menu 43:parent 43,13:caption 43,"Créer texte"  :on_click 43,texte
sub_menu 44:parent 44,13:caption 44,"Zoom"          :on_click 44,zoom          :' FAIT

' sous-menu Commandes
sub_menu 50:parent 50,14:caption 50,"Modifier mur"  :on_click 50,modifmur
sub_menu 51:parent 51,14:caption 51,"Diviser mur"  :on_click 51,divismur
sub_menu 52:parent 52,14:caption 52,"Ajout porte"  :on_click 52,porte        :' FAIT
sub_menu 53:parent 53,14:caption 53,"Ajout fenêtre" :on_click 53,fenetre      :' FAIT
sub_menu 54:parent 54,14:caption 54,"Modifier porte":on_click 54,modifporte
sub_menu 55:parent 55,14:caption 55,"Modifier fenêtre":on_click 55,modifent

' 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 2,(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:' spin début mur x
spin 104:hide 104:left 104,220:top 104,25:' spin début mur y
spin 105:hide 105:left 105, 20:top 105,75:' spin fin mur x
spin 106:hide 106:left 106,220:top 106,75:' spin fin mur y
spin 107:hide 107:left 107, 20:top 107,135:' spin longueur mur
spin 108:hide 108:left 108,220:top 108,135:' spin hauteur mur
spin 109:hide 109:left 109, 20:top 109,195:' spin épaisseur mur
button 110:hide 110:left 110,220:top 110,195:width 110,120:caption 110,"TEXTURE (3D)"
button 111:hide 111:left 111,220:top 111,230:width 111,120:caption 111,"VALIDER"
check 112:hide 112:left 112, 20:top 112,25:caption 112,"INVERSER"
check 113:hide 113:left 113,220:top 113,25:caption 113,"MIROIR"

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:
pi=4*atn(1):ha%=20:gr=1:rg=1:z=1
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)
  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)
  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: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

cote:
aire:
texte:
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 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

selection:
  if j>0
      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
  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
  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%
  mclic=0:j=i
return

modifmur:
' Modification d'un mur:
' 1°) afficher un list avec seulement les murs  ===> FAIT
' 2°) un clic colore le mur en rouge            ===> FAIT
' 3°) deux clics colore le mur en rouge, le sélectionne et ouvre le form suivant  ===> FAIT
' 4°) une fois que l'on a fait les changements et validé
'    on recolore en noir et on enregistre les nouvelles données
caption 2,"LISTE DES MURS":gosub form_list
for i=1 to count(5)
  if mid$(ligne$(i),5,4)="MURS" then item_add 6,ligne$(i)
next i
show 2:print_target_is 2:font_bold 2
j=0:show 6:on_click 6,cliquer
while mclic<>2
if mclic=1 then gosub selection
end_while
gosub selection
hide 6:off_click 6

caption 2,"MODIFIER MUR":gosub form_mpf

print_locate 7,10:print "DÉBUTE À:"
show 103:print_locate 7,  30:print "X":print_locate 145,30:print "cm"
show 104:print_locate 207,30:print "Y":print_locate 345,30:print "cm"
print_locate 7,60:print "TERMINE À:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LONGUEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ÉPAISSEUR"
show 109:print_locate 145,200:print "cm"
show 110:show 111
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=103 to 111:hide j:next j:cls:hide 2
return

divismur:
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
      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
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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%
      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: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
        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
        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: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

modifporte:
' Modification d'une porte:
' 1°) afficher un list avec seulement les portes
' 2°) un clic colore la porte sélectionnée en rouge
' 3°) deux clics colore la porte en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER PORTE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112:show 113
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 113:hide j:next j:cls:hide 2
return

modifent:
' Modification d'une fenêtre:
' 1°) afficher un list avec seulement les fenêtres
' 2°) un clic colore la fenêtre sélectionnée en rouge
' 3°) deux clics colore la fenêtre en rouge, la sélectionne et ouvre le form suivant
' 4°) une fois que l'on a fait les changements et validé, on recolore en noir et on enregistre les nouvelles données
caption 2,"MODIFIER FENÊTRE":gosub form_mpf
show 2:print_target_is 2:font_bold 2
print_locate 7,60:print "POSITION:"
show 105:print_locate 7,  80:print "X":print_locate 145,80:print "cm"
show 106:print_locate 207,80:print "Y":print_locate 345,80:print "cm"
print_locate 20,120:print "LARGEUR"
show 107:print_locate 145,140:print "cm"
print_locate 220,120:print "HAUTEUR"
show 108:print_locate 345,140:print "cm"
print_locate 20,180:print "ANGLE"
show 109:print_locate 145,200:print "°"
show 110:show 111:show 112
while scancode=0:end_while:wait 200
while scancode=0:end_while
2d_target_is 2:for j=105 to 112:hide j:next j:cls:hide 2
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))+"*"
end_if
if typ$(i)="COTE"
end_if
if typ$(i)="AIRE"
end_if
if typ$(i)="TXTE"
end_if
return

propos:
aide:
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(87)<4 then position 87,4
 if position(88)<10 then position 88,10
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
print_locate 45,60:print "  Style des murs  "
print_locate 60,10:print " cm. Épaisseur des murs "
print_locate 60,35:print " cm.  Hauteur  des murs "
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 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:hide 2
2d_target_is 1:cls
if gr=1 then 2d_image_paste 211,0,0
' if gr=0 then 2d_image_paste 213,0,0
if rg=1 then gosub regle

refait_plan:
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)
      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
      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%
      ' Tracé ouvrant droit <=== A IMPLÉMENTER DANS MODIFIER PORTE
      ' 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
  ' RESTAURER LES FENETRES
  if seg$(1)="FENT"
      pfstyl=0:gosub motif_mur:pfstyl=1
      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
  ' A FAIRE RESTAURER LES COTES  <*******************
  if seg$(1)="COTE"
  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
annule:
refait:
copie:
colle:
supprime:
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,200:height 2,250
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,300
left 2,(width(0)/2)-(width(2)/2):top 2,(height(0)/2-height(2)/2):return
fin:
terminate