FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» KGF.dll - demandes ou suggestions de modifications ou ajouts
par Klaus Hier à 23:55

» KGF_dll - nouvelles versions
par pascal10000 Hier à 17:27

» Mah-Jong européen new-look
par Minibug Mar 12 Déc 2017 - 22:31

» track_bar circulaire
par Klaus Mar 12 Déc 2017 - 13:54

» API Windows
par Klaus Mar 12 Déc 2017 - 3:21

» Cartes de voeux, menus, etc.
par JL35 Lun 11 Déc 2017 - 17:48

» a l'aide klaus
par Minibug Lun 11 Déc 2017 - 11:42

» bug SYNEDIT_TARGET_IS_OBJECT
par Jack Lun 11 Déc 2017 - 0:16

» Jukebox : Serge Reggiani
par papydall Sam 9 Déc 2017 - 5:58

» Ecouter la radio fm sur votre pc
par pascal10000 Sam 9 Déc 2017 - 3:42

» anomalie
par Klaus Sam 9 Déc 2017 - 3:21

» hommage
par Jicehel Ven 8 Déc 2017 - 11:29

» Logiciel de soutien scolaire en langues.
par Pedro Alvarez Ven 8 Déc 2017 - 10:43

» carte son
par Klaus Ven 8 Déc 2017 - 2:37

» mise a jour calculatrice
par joeeee2017 Mer 6 Déc 2017 - 22:19

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Décembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
25262728293031
CalendrierCalendrier

Partagez | 
 

 PLANORAMIC

Voir le sujet précédent Voir le sujet suivant Aller en bas 
Aller à la page : 1, 2, 3, 4  Suivant
AuteurMessage
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: PLANORAMIC   Mar 28 Fév 2012 - 22:21

Bonsoir à tous chers Panoramiciens, Smile
Je viens vous exposer le programme sur lequel je travaille en ce moment, mais que je vais peut-être abandonner car je me rends compte au fur et à mesure des difficultés que je recontre et que je vais rencontrer. Il s'agit d'un programme pour concevoir des plans de maisons ou appartement. Je ne veux pas faire un programme trop compliqué, juste tracer des murs, mettre des portes et des fenètres, pouvoir insérer un escalier éventuellement, du mobilier de base (table chaise canapé buffet lit) et ajouter du texte sur le plan ainsi que les cotes.
Je vous livre donc le code sur lequel je travaille. Pour le moment seulement 3 fonctions sont en partie codées:
- la fonction "Règlages" dans le menu "Fichier"
- la fonction "Créer mur" dans le menu "Plan"
- la fonction "Zoom" dans le menu "Plan"
Les fonctions à coder qui vont me poser problèmes, ce sont:
- "Créer surface" dans le menu "Plan"(j'ai une formule de calcul de surface pour n'importe quel polygone d'au moins 3 cotés, mais c'est la mise en oeuvre de l'algorythme qui me parait difficile)
- "Ajout fenêtre, ajout porte, ajout escalier, ajout meuble" dans le menu "commandes" me paraissent bien compliqués. Déjà, si je les fais en bmp ou jpg sur un picture, comment pivoter un picture, si je dois placer un de ces objets suivant l'angle d'orientation d'un mur? Autre solution, utiliser un sprite? C'est ce que je voudrais éviter. etc...
JL35, tu verras à quoi me servent les fameux rectangles en biais dans ce code (à créer des murs)! Ainsi que le nettoyage à l'intérieur pour y mettre un motif bien particulier.
Voici le code provisoire:
Code:
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
Attention, si vous êtes sous la version 0923i.5 enlevez la procédure "cliquer:" sinon ça plante!
Il me reste à vous souhaiter une bonne soirée à tous! Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Mar 28 Fév 2012 - 22:40

Ne laisse pas tomber, c'est bien partie.
Pour le coup, je te donne la solution pour que ça marche en version 0923i.5
Code:
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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Mar 28 Fév 2012 - 23:02

Bonsoir Jicehel Smile
Oui, je vois c'est la valeur du wait que tu as baissé à 90. Je me disais l'autre soir, ça marchait, et le lendemain matin, j'avais le bug et je ne comprenais plus rien. C'est certainement que j'avais du faire des essais à 80 dans mon petit programme de double clic, que j'avais jugé que 120 était meilleur, et j'ai enregistré avec cette valeur sans même réessayer le programme.
Bon, pour le moment la procédure du double clic elle sert à rien, mais elle devrait me permettre de sélectionner un mur dans le list ou éventuellement sur l'écran si j'arrive à programmer cela, et c'est pas gagné.
Et je me rends compte, trop de difficultés à l'horizon, ça me parait absurbe de vouloir continuer sur ce programme. Je vais voir demain matin ce que je décide.
Bonne soirée à toi. Wink

Edit: Oui, j'avais pas vu off_click et on_click. Je suis bête, pourquoi n'y ai-je pas pensé avant!!!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Mer 29 Fév 2012 - 0:50

Non bignono, le truc c'est de désactiver le test sur la souris avant la boucle et de le réactiver après comme on l'utilise pas à l’intérieur de ta boucle de dessin Smile
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
JL35



Nombre de messages : 6018
Localisation : 77
Date d'inscription : 29/11/2007

MessageSujet: Re: PLANORAMIC   Mer 29 Fév 2012 - 1:04

Bonsoir bignono, et chapeau, j'avais bien pensé à écrire un programme de ce genre (architecture), mais je n'ai pas osé concrétiser, trop de choses à maîtriser (notamment la 3D), et trop de complications à l'horizon. Mais c'est bien que tu te sois lancé, je n'ai pas encore regardé ton programme, je vais au moins l'essayer, déjà.
Effectivement, c'est très ambitieux...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Mer 29 Fév 2012 - 8:58

Bonjour Jicehel, JL35 et à tous les panoramiciens, Smile

Jicehel, j'avais vu après coup, la désactivation et la réactivation du test de la souris avant et après la boucle while end_while, mais je ne comprend pas pourquoi ça marche sans cela dans la version 0923i.4, alors qu'il est bien plus logique de faire comme tu as fait!

JL35, pour moi la partie 3d ne me posera pas de problème à programmer, c'est plus facile à maitriser que la 2d une fois qu'on a compris le principe. Ce qui m'enquiquinne, c'est que j'expliquais plus haut.

Bon, aujourd'hui, je vais essayé de programmer l'ajout porte dans le menu commandes et on verra bien!
Bonne journée à vous. Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Mer 29 Fév 2012 - 9:44

En tout cas, si tu galères, on essayera de t'aider et le début a une super tête. J'espère que tu vas pouvoir aller au bout, c'est vraiment prometteur
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Mer 29 Fév 2012 - 21:47

Bonsoir à tout le monde, Smile
Voici la suite de mon Planoramic. Dans le menu "Commandes", il y a "Ajout porte" et "Ajout fenêtre" qui commencent à fonctionner. La porte ou la fenêtre se dessine à l'écran et vous pouvez les positionner où vous voulez sur le quadrillage. Pour ce qui est de les orienter suivant un angle, je verrai plus tard.
Pour le moment, j'ai un bug que je n'arrive pas à résoudre: Je trace un mur, je positionne une porte ou une fenêtre, puis je reviens pour tracer un mur, et là le curseur croix apparait normalement, mais le fait de déplacer la souris me trace le mur sans pouvoir commander au clic mon point de départ et mon point d'arrivée en décliquant! Et je n'arrive pas à trouver la raison de ce bug. Si Jicehel ou JL35 ou Nardo ou quiconque peuvent jeter un oeil sur le programme et voir d'où ça vient cela m'avancerait.
Code:
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
Merci d'avance et bonne soirée. Wink
Là je vais aller manger et regarder un peu la télé.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
lodchjo

avatar

Nombre de messages : 162
Age : 46
Localisation : Anvers
Date d'inscription : 26/12/2011

MessageSujet: Re: PLANORAMIC   Mer 29 Fév 2012 - 23:02

J'ai pas encore trouvé le bug (juste regardé rapidement), mais je trouve ton programme impressionnant déjà! Bonne continuation!
Lode
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://lode.weebly.com
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Jeu 1 Mar 2012 - 0:03

Bignono, voici un code qui marche mais j'espère ne pas avoir modifié l'esprit du clic. Ajustes
si j'ai mal compris le clic
Code:
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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Jeu 1 Mar 2012 - 2:19

Bonsoir Jicehel, Smile
Je te remercie de ta solution, qui change beaucoup trop l'esprit du clic, puisqu'il faut faire un clic pour commencé à tracer le mur et un clic pour arrêter de tracer le mur.
Du coup, j'ai réfléchi, et j'ai trouvé la solution qui était très simple. Dans les 2 procédures porte et fenetre, j'ai tout simplement remplacé les boucles while mouse_left_up(1)=0...end_while par une boucle repeat...until mouse_left_down(1)=1, et ça marche nickel!
Bon prochaine étape, essayer de faire pivoter la porte et la fenêtre suivant l'angle. On verra demain car Sleep
Bonne soirée à tous Wink

PS: Merci Lode de tes encouragements, si tu as des idées fais moi en part! Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Jeu 1 Mar 2012 - 2:28

En tout cas moi, des idées, j'en ai pour ton programme mais vu le challenge que tu t'es déjà fixé et pour lequel on te soutiendra, je vais les garder pour le moment. Tu as déjà assez à faire (sauf les idées pour améliorer ce que tu fais sur le coup, mais pour l'instant, rien à dire, c'est vraiment sympatique pour le moment et on a hâte de voir la suite Smile )
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Jeu 1 Mar 2012 - 19:09

Bonjour à tous les Panoramiciens de la planète et de la galaxie, lol!
Bon, j'avoue que mon projet PLANORAMIC est ambitieux et que le challenge est difficile à réaliser. Alors, j'ai revu un peu à la baisse mes objectifs pour le moment, et il n'est pas exclu que je vire d'autres fonctions voir même que j'arrête tout! Faire un programme d'architecture même le plus simpliste soit-il est vraiment hard, très hard! scratch scratch scratch Donc pour le moment, exit "Ajout escalier" et "Ajout meuble". Evil or Very Mad
Bref, aujourd'hui, j'ai achevé de programmer les fonctions "Ajout porte" et "Ajout Fenêtre". Hier on ne pouvait juste que les déplacer orientées dans un seul angle. Aujourd'hui, Si on maintient appuyé soit une des touches "CTRL" ou soit une des touches "SHIFT" on peut non seulement les orienter suivant l'angle que l'on désire, mais aussi leur donner la largeur voulue. Au clic, elles se fixent à l'emplacement choisi à l'écran! L'implémentation au list est faite également ainsi qu'au zoom.
Cependant, il y a deux bugs qui me gènent.
Le premier, lorsqu'on est en zoom 400% par exemple, et que je crée une porte ou une fenêtre, pas de problème si je la met sur un mur (même épaisseur). Lorsque que je reviens au zoom 100%, l'épaisseur du mur diminue bien, mais pas celle de la fenêtre ou de la porte!
Le second, lorsqu'on commence au début par tracer un mur, les indications d'angle, de position x,y, de longueur, s'affichent sur un fond jaune ce qui les rend bien visibles. Au second tracé et pour les suivants aussi, le petit fond jaune a disparu. Ça c'est ennuyeux. Je suis sur que la solution est simple, mais justement, je ne la vois pas!
Bon voici le code pour le moment:
Code:
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
A+ et il faut que je me repose un peu sinon je vais devenir geek drunken
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Ven 2 Mar 2012 - 1:09

Salut Bignono, je me connecte tard, ce soir Smile
Bon pour ton fond pour le texte, la solution:
Code:
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

(Non, ce n'est pas le changement de couleur la solution mais juste le 2d_fill_solid .... Smile )
Bon, je jette un oeil à ton autre problème qui à première vue parrait plus complexe pour le zoom si je vois quelque chose je te le poste Smile
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Ven 2 Mar 2012 - 1:21

A priori, c'est juste que tu n'utilise pas ton multiplicateur z dans ton tracé des portes, sauf erreur de ma part pour le problème d'affichage quand tu change le zoom
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Ven 2 Mar 2012 - 23:38

Bonsoir à tous chers Panoramiciens, Laughing
Je suis très surpris de tout ce que je lis ce soir sur le forum. Trop de choses n'ont rien à voir avec panoramic en ce moment!
Maintenant, cela dit, je continue à vous parler de mon programme en développement.
Pour résoudre le bug du zoom, j'ai dû reprendre de a à z toute la fonction et le mode de calcul. Normalement ça marche maintenant, mais si vous détectez un bug prévenez moi quand même. Ça m'a pris une grande partie de ma journée aussi.
Les 3 prochaines étapes normalement, c'est dans le menu "Commandes", "Modifier mur", "Modifier porte" et "Modifier fenêtre". Si vous regardez le programme aux étiquuettes concernant ces fonctions, la manière dont je vais procéder est expliquée sous forme de remarque. Pour le moment, juste le form s'affiche avec les objets qui seront à utiliser. J'espère ainsi pouvoir utiliser le double clic sur le list. nous verrons bien si ça marche.
Donc, voici le code ^provisoire:

Code:
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
Je vous souhaite à tous une très très bonne soirée. Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Ven 2 Mar 2012 - 23:52

Petit bug, parfois en changeant le zoom, le programme recalcule bien les objets, mais il copie les anciens et les ajoute sur l'image (on a donc les objets dans les 2 tailles)
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 1:11

Bonsoir Jicehel,
Peux-tu m'expliquer comment tu as eu ce bug? Me décrire les opérations successives que tu as faites? Je n'arrive pas à reproduire le même bug chez moi.
Merci. Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 1:20

C'est quand on change le zoom après avoir fait un modifier
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 1:34

Problème règlé.
Code:
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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 1:50

Un autre, désolé, si tu zoom par exemple et que tu fais un modifier, quand tu fais ajouter porte ou fenêtre, tu ne vois pas la fenêtre ou la porte "accrochée" à la souris.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 2:16

C'est parce qu'il manque un 2d_target_is 1 sur les premières lignes des étiquettes porte: et fenetre:
for j=11 to 17:inactive j:next j:2d_target_is 1
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 2:36

Solution validée Smile
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 2:57

Bon voilà, maintenant je vais aller faire Sleep
J'ai commencer à faire la "modif mur"
On affiche un list avec la liste des murs,
1 clicl colore le mur en rouge,
double clic valide le mur et le colore en rouge.
Ensuite on ouvre le form avec les objets pour faire les changements sur le mur sélectionner.
Reste à programmer ces changements.
Ensuite ce sera du copier coller pour modif porte et modif fenêtre!
Code:
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
Bonne nuit les petits, le marchand de sable est passé! lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
bignono

avatar

Nombre de messages : 1104
Age : 60
Localisation : Val de Marne
Date d'inscription : 13/11/2011

MessageSujet: Re: PLANORAMIC   Sam 3 Mar 2012 - 21:22

Bonjour JL35, J'espère que tu es à l'écoute... Laughing
Pour continuer à développer mon projet PLANORAMIC, je bute sur un problème, qui parait simple au premier abord, mais que je n'arrive pas à résoudre. Pourtant je sais faire, mais il arrive à des moments que j'ai un grand vide dans ma tête et ça me paralyse depuis ce matin. En général, je laisse tomber et je fais autre chose, puis je reviens sur mon problème 3 ou 4 jours après pour trouver la solution. Mais là ça me torture les méninges! lol!
Bon (j'explose) pardon, j'expose mon problème:
Je connais les coordonnées de mon point (xd,yd), je connais la longueur de ma droite (lg) et je connais l'angle (a) de ma droite. Comment faire pour calculer mon point d'arrivée (xf,yf).
Autre problème, Je connais toujours mon point (xd,yd), je connais la longueur de ma droite (lg) et il faut que je calcule le point d'arrivée (xf,yf) en faisant varier l'angle de la droite (a).
Merci d'avance à toi si tu veux bien te préoccuper de mon problème. Wink
J'ai développé ma fonction "modifier mur", et ce hic m'empêche de faire mes fonctions "modifier porte" et "modifier fenêtre".
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Contenu sponsorisé




MessageSujet: Re: PLANORAMIC   

Revenir en haut Aller en bas
 
PLANORAMIC
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 4Aller à la page : 1, 2, 3, 4  Suivant

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos projets-
Sauter vers: