code-aster-gui 1.8.4-5 / usr / share / astk / meshtool.tcl

This file is indexed.

/usr/share/astk/meshtool.tcl is in code-aster-gui 1.8.4-5.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
#########################################################################
# COPYRIGHT (C) 2003         EDF R&D              WWW.CODE-ASTER.ORG    #
#                                                                       #
# THIS PROGRAM IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR         #
# MODIFY IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE AS        #
# PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER VERSION 2 OF THE    #
# LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION.                       #
# THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL,       #
# BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF        #
# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU      #
# GENERAL PUBLIC LICENSE FOR MORE DETAILS.                              #
#                                                                       #
# YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE     #
# ALONG WITH THIS PROGRAM; IF NOT, WRITE TO : EDF R&D CODE_ASTER,       #
#    1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE.        #
#########################################################################

# $Id: meshtool.tcl 3255 2008-04-10 17:13:17Z courtois $

# retourne le format associé à un type de maillage ou l'extension
#################################################################
proc type2format { typ ext } {
   global meshtool_format meshtool_type
   set trouv 0
   for { set i 0 } { $i < [llength $meshtool_type] } { incr i } {
      if { $typ == [lindex $meshtool_type $i] || $ext == ".[lindex $meshtool_type $i]" \
        || $ext == ".[lindex $meshtool_format $i]" } {
         set trouv 1
         return [lindex $meshtool_format $i]
      }
   }
   return ""
}

# extension à partir du format
#################################################################
proc format2ext { fmt } {
   global meshtool_format meshtool_type
   for { set i 0 } { $i < [llength $meshtool_format] } { incr i } {
      if { $fmt == [lindex $meshtool_format $i] } {
         return [lindex $meshtool_type $i]
      }
   }
   return "convert"
}

# positionne le nom du maillage résultat
#################################################################
proc auto_mesh_out { } {
   global meshtool_para
   
   set root $meshtool_para(mesh_in)
   
   set ext [file extension $root]
   # retirer .gz
   if { $ext == ".gz" } {
      set root [file rootname $root]
   }

   set intyp  [format2ext $meshtool_para(format_in)]
   set outtyp [format2ext $meshtool_para(format_out)]
   set meshtool_para(mesh_out) [get_valeur_defaut $meshtool_para(mesh_in) $intyp $outtyp 38]
   if { $meshtool_para(mesh_out) == $meshtool_para(mesh_in) } {
      # inchangé, on essaie autre chose pour le type med
      set meshtool_para(mesh_out) [get_valeur_defaut $meshtool_para(mesh_in) mail.med $outtyp 38]
      set meshtool_para(mesh_out) [get_valeur_defaut $meshtool_para(mesh_out) med $outtyp 38]
   }

   if { $meshtool_para(compress_result) == 1 } {
      append meshtool_para(mesh_out) ".gz"
   }
}

# Vérifie que les données nécessaires sont présentes
# puis appel le service "as_run --serv"
# numfich pour compatibilité avec les run_$outil
#################################################################
proc run_MeshTool { {numfich -1} } {
   global meshtool_para meshtool_format meshtool_type
   set meshtool_format {aster med  gmsh ideas gibi}
   set meshtool_type   {mail  mmed msh  msup  mgib}
   
   # fichier IN sélectionné
   set lfich $astk::sel(filename)
   if { [llength $lfich] != 1 } {
      return 50
   }
   set indice $astk::sel(indice)
   set var $astk::sel(liste)
   set typ $astk::profil($var,fich,$indice,type)
   set nom [abspath $var $astk::profil($var,fich,$indice,nom)]
   set serv_in $astk::profil($var,fich,$indice,serv)
   
   set ext [file extension $nom]
   if { $ext == ".gz" } {
      set root [file rootname $nom]
      set ext [file extension $root]
   }

   set meshtool_para(format_in)       [type2format $typ $ext]
   set meshtool_para(mesh_in)         $nom
   set meshtool_para(format_out)      "med"
   set meshtool_para(compress_result) 0
   auto_mesh_out
   set meshtool_para(info_mail)       1
   set meshtool_para(info_cmd)        1
#   set meshtool_para(visu)       "1"
   if { $astk::config(-1,langue) == "FR" } {
      set meshtool_para(lang)       "FRANCAIS"
   } else {
      set meshtool_para(lang)       "ENGLISH"
   }
   
   # appel la boite de dialogue
   set iret [meshtool_ihm]
   if { $iret != 0 } {
      # annulé
      return 0
   }
   set fout [abspath $var $meshtool_para(mesh_out)]
   
   # on met les lignes du .export sauf les unités logiques
   # qui seront choisies par meshtool (pour n'être qu'à un seul endroit)
   set astk::profil(special) "meshtool%NEXT%"

   # chemin des fichiers de maillage IN et OUT
   set valf ""
   set valout ""
   set sfic $astk::inv(serv,$astk::profil($var,fich,$indice,serv))
   set serv $astk::inv(serv,$astk::profil(serveur))
   if { [ashare::meme_machine $astk::config($sfic,nom_complet) $astk::config($serv,nom_complet)] != 1
     || $astk::config($sfic,login) != $astk::config($serv,login) } {
      append valf   "$astk::config($sfic,login)@$astk::config($sfic,nom_complet):"
      append valout "$astk::config($sfic,login)@$astk::config($sfic,nom_complet):"
   }
   append valf   $nom
   append valout $fout
   # enlever les /./
   regsub -all {/\./} $valf   "/" valf
   regsub -all {/\./} $valout "/" valout

   set flagIN " D"
   if { $astk::profil($var,fich,$indice,compress) } {
      append flagIN "C"
   }
   set flagOUT " R"
   if { $meshtool_para(compress_result) == 1 } {
      append flagOUT "C"
   }
   
   # remplit special
   append astk::profil(special) "F libr $valf $flagIN"
   append astk::profil(special) "%NEXT%"
   append astk::profil(special) "F libr $valout $flagOUT"
   
   # paramètres décodés par le service "as_exec_special"
   # ATTENTION : syntaxe Python, "'" autour des chaines
   append astk::profil(special) "%NEXT%format_in='$meshtool_para(format_in)'"
   append astk::profil(special) "%NEXT%format_out='$meshtool_para(format_out)'"
   append astk::profil(special) "%NEXT%info_mail=$meshtool_para(info_mail)"
   append astk::profil(special) "%NEXT%info_cmd=$meshtool_para(info_cmd)"
#   append astk::profil(special) "%NEXT%visu=$meshtool_para(visu)"
   append astk::profil(special) "%NEXT%lang='$meshtool_para(lang)'"
   
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (run_MeshTool) special : $astk::profil(special)"
   }
# on force interactif + suivi interactif
   set astk::profil(batch) 0
   set astk::profil(suivi_interactif) 1
   mod_batch
# enregistrement du profil
   set iret [enregistrer $astk::profil(serv_profil) $astk::profil(nom_profil)]
   if { $iret != 0 } {
      return 5
   }
# indices ihm
   set serv $astk::inv(serv,$astk::profil(serveur))
# nom du fichier export
   set serv_export $astk::profil(serv_profil)
   set nom_export [file rootname $astk::profil(nom_profil)]
   append nom_export "_mesh.export"
# export du profil sans les vérifications supplémentaires
   set iret [exporter astk_serv $serv_export $nom_export "noverif" "non"]
   if { $iret == 4 } {
      return $iret
   } elseif { $iret == 2 } {
   # alarmes emises
      change_status [ashare::mess info 16]
      tk_messageBox -message [ashare::mess info 16] -type ok -icon info
   }
   set astk::profil(special) ""

# préparation de la ligne de commande à exécuter
   set lcmd ""
   set argu ""
# profil
   append lcmd [file join $astk::config($serv,rep_serv) "bin" as_run]
   append lcmd " --serv"
   append lcmd [ashare::get_glob_args]
   if { [ashare::meme_machine $astk::config($serv,nom_complet) $astk::config($serv_export,nom_complet)] != 1
     || $astk::config($serv,login) != $astk::config($serv_export,login) } {
      append argu "$astk::config($serv_export,login)@$astk::config($serv_export,nom_complet):"
   }
   append argu $nom_export

#  execution
   set iret [ ashare::rexec_cmd $serv astk::config $lcmd $argu 0 out .]
   set jret $iret
   if { $iret == 0 } {
   # ajouter le maillage résultat dans le profil si pas déjà présent
      set trouv 0
      for { set i 0 } {$i < $astk::profil($var,nbfic)} {incr i} {
         if { [abspath $var $fout] == [abspath $var $astk::profil($var,fich,$i,nom)] } {
            set trouv 1
            break
         }
      }
      if { $trouv == 0 } {
         $astk::ihm(fenetre).active.princ.icone.nouveau invoke
         set i [expr $astk::profil($var,nbfic) - 1]
         
         set typ [format2ext $meshtool_para(format_out)]
         
         set astk::profil($var,fich,$i,nom)  [relpath $var $fout]
         set astk::profil($var,fich,$i,type) $typ
         set astk::profil($var,fich,$i,FR)   "F"
         set nul 0
         set ilibr 0
         for {set j 0} {$j < $astk::UL($var,nbre)} {incr j} {
            if { $typ == $astk::UL($var,$j,nom) } {
               set nul $j
            }
            if { $astk::UL($var,$j,nom) == "libr" } {
               set ilibr $j
            }
         }
         if { $nul == 0 } {
            set nul $ilibr
         }
         # ne doit pas être pris en compte dans l'export
         set astk::profil($var,fich,$i,donnee)   0
         set astk::profil($var,fich,$i,resultat) 0
         set astk::profil($var,fich,$i,compress) $meshtool_para(compress_result)
         set_UL $i $nul $var
      }
      set astk::profil($var,fich,$i,serv) $serv_in
   
   # traitement du retour
      set nomjob [get_nomjob]
      append nomjob "_mesh"
      set jret [retour_as_exec $nomjob $out]
#      tk_messageBox -message $msg -type ok -icon info
      show_fen $astk::ihm(asjob)
   
   } else {
   # pb lancement
      ashare::mess "erreur" 3 $lcmd $jret $out
      return "MeshTool"
   }
   if { $ashare::dbg >= 4 } {
      ashare::log "<DEBUG> (run_MeshTool) iret : $iret, output :\n$out"
      catch { ashare::log "<DEBUG> (run_MeshTool) jobid=$jobid\nqueue=$queue" }
   }
   
   return $jret
}



# fenêtre pour renseigner les paramètres de meshtool
# retourne 0 si ok, 1 si annuler
#################################################################
proc meshtool_ihm { } {
   global iret_meshtool meshtool_para meshtool_format
   
   set iret_meshtool 0

   set fen .f_meshtool
   catch {destroy $fen}
   set tit [ashare::mess ihm 369]
   toplevel $fen
   wm title $fen $tit
   wm transient $fen .

   set marg1 10
   set marg2 5

#  Maillage en données
   pack [frame $fen.f1 -relief sunken -bd 1] -fill x -anchor nw -padx $marg1 -pady $marg1
      pack [frame $fen.f1.nom -bd 0] -side top -fill x -padx $marg2 -pady $marg2
      pack [frame $fen.f1.fmt -bd 0] -side top -fill x -padx $marg2 -pady $marg2

   label $fen.f1.nom.lbl -font $astk::ihm(font,lab) -text [ashare::mess ihm 274] -width 20 -anchor w
   entry $fen.f1.nom.path -width 50 -font $astk::ihm(font,val) -textvariable meshtool_para(mesh_in) \
      -state disabled
   pack $fen.f1.nom.lbl $fen.f1.nom.path -pady 3 -side left

   label $fen.f1.fmt.lbl -font $astk::ihm(font,lab) -text [ashare::mess ihm 339] -width 20 -anchor w
   pack $fen.f1.fmt.lbl -side left
   for {set i 0} {$i < [llength $meshtool_format]} {incr i} {
      set lab [lindex $meshtool_format $i]
      radiobutton $fen.f1.fmt.$lab -font $astk::ihm(font,lab) -text $lab -value $lab \
         -variable meshtool_para(format_in)
      pack $fen.f1.fmt.$lab -side left
   }

#  Maillage résultat
   pack [frame $fen.f2 -relief sunken -bd 1] -fill x -anchor nw -padx $marg1 -pady $marg1
      pack [frame $fen.f2.nom -bd 0] -side top -fill x -padx $marg2 -pady $marg2
      pack [frame $fen.f2.fmt -bd 0] -side top -fill x -padx $marg2 -pady $marg2

   label $fen.f2.nom.lbl -font $astk::ihm(font,lab) -text [ashare::mess ihm 311] -width 20 -anchor w
   entry $fen.f2.nom.path -width 50 -font $astk::ihm(font,val) -textvariable meshtool_para(mesh_out)
   pack $fen.f2.nom.lbl $fen.f2.nom.path -pady 3 -side left

   label $fen.f2.fmt.lbl -font $astk::ihm(font,lab) -text [ashare::mess ihm 339] -width 20 -anchor w
   pack $fen.f2.fmt.lbl -side left
   for {set i 0} {$i < [llength $meshtool_format]} {incr i} {
      set lab [lindex $meshtool_format $i]
      radiobutton $fen.f2.fmt.$lab -font $astk::ihm(font,lab) -text $lab -value $lab \
         -variable meshtool_para(format_out) -command auto_mesh_out
      pack $fen.f2.fmt.$lab -side left
   }

# paramètres
   pack [frame $fen.f3 -relief sunken -bd 1] -fill x -anchor n -padx $marg1 -pady $marg1
   label $fen.f3.lbl -font $astk::ihm(font,lab) -text [ashare::mess ihm 69] -width 20 -anchor w
   pack $fen.f3.lbl -side left -fill x -anchor nw
      pack [frame $fen.f3.infma -bd 0] -fill x -side top -padx $marg2 -pady $marg2
      checkbutton $fen.f3.infma.cb -variable meshtool_para(info_mail) -onvalue 1 -offvalue 0 \
         -anchor w -text [ashare::mess ihm 338]
      pack $fen.f3.infma.cb  -side left
      
      pack [frame $fen.f3.infcmd -bd 0] -fill x -side top -padx $marg2 -pady $marg2
      checkbutton $fen.f3.infcmd.cb -variable meshtool_para(info_cmd) -onvalue 2 -offvalue 1 \
         -anchor w -text [ashare::mess ihm 336]
      pack $fen.f3.infcmd.cb -side left
      
      pack [frame $fen.f3.cmpr -bd 0] -fill x -side top -padx $marg2 -pady $marg2
      checkbutton $fen.f3.cmpr.cb -variable meshtool_para(compress_result) -onvalue 1 -offvalue 0 \
         -anchor w -text [ashare::mess ihm 86] -command auto_mesh_out
      pack $fen.f3.cmpr.cb -side left
      
#      pack [frame $fen.f3.visu -bd 0] -fill x -side top -padx $marg2 -pady $marg2
#      checkbutton $fen.f3.visu.cb -variable meshtool_para(visu) -onvalue 2 -offvalue 1 \
#         -anchor w -text [ashare::mess ihm 97]
#      pack $fen.f3.visu.cb   -side left

#  fermer
   pack [frame $fen.valid -relief solid -bd 0] -padx $marg1 -pady $marg1
   button $fen.valid.ok -font $astk::ihm(font,labbout) -text "Ok" \
      -background $astk::ihm(couleur,valid) \
      -command "valid_para $fen"
   button $fen.valid.can -font $astk::ihm(font,labbout) -text [ashare::mess ihm 85] \
      -background $astk::ihm(couleur,annul) \
      -command "set iret_meshtool 1 ; destroy $fen"
   pack $fen.valid.ok $fen.valid.can -side left -padx 10 -pady 3
   focus $fen.f2.nom.path

   tkwait window $fen
   return $iret_meshtool
}

# valide les valeurs des paramètres
#################################################################
proc valid_para { parent } {
   global iret_meshtool meshtool_format meshtool_para
   if { [lsearch $meshtool_format $meshtool_para(format_in)] < 0 } {
      set msg [ashare::mess ihm 97]
      change_status $msg
      tk_messageBox -message $msg -type ok -icon error -parent $parent
      return
   }
   
   destroy $parent
}

APT Browse - Built by Thomas Orozco.