home *** CD-ROM | disk | FTP | other *** search
/ Dream 50 / Amiga_Dream_50.iso / Magazine / TclTk / lib.tcl < prev    next >
Text File  |  1997-10-09  |  13KB  |  607 lines
  1.  
  2. # gestion de la librairie de fonctions mathematiques
  3.  
  4. ############### BOITES DE DIALOGUE LIBRAIRIE ###############
  5.  
  6. # boite de dialogue de gestion des fonctions
  7.  
  8. proc FillLibDialog { cat } {
  9.     global FuncLib
  10.  
  11.     set list_entry [array names FuncLib]
  12.  
  13.     .libdialog.frame1.lbox delete 0 end
  14.  
  15.     # toutes les categories
  16.  
  17.     if { $cat == "All" } {
  18.  
  19.     # categorie Basic
  20.  
  21.     set list_add {}
  22.  
  23.     foreach entry $list_entry {
  24.  
  25.         if { [string first "Basic" $entry] != "-1" } {
  26.         
  27.         lappend list_add "$entry -- [lindex $FuncLib($entry) 1]"
  28.  
  29.         }
  30.  
  31.     }
  32.     
  33.     set list_sort [lsort -ascii -increasing $list_add]
  34.  
  35.     foreach element $list_sort {
  36.  
  37.         .libdialog.frame1.lbox insert end $element
  38.  
  39.     }
  40.     
  41.     # categorie Trigo
  42.  
  43.     set list_add {}
  44.         
  45.     foreach entry $list_entry {
  46.  
  47.         if { [string first "Trigo" $entry] != "-1" } {
  48.         
  49.         lappend list_add "$entry -- [lindex $FuncLib($entry) 1]"
  50.  
  51.         }
  52.  
  53.     }
  54.     
  55.     set list_sort [lsort -ascii -increasing $list_add]
  56.  
  57.     foreach element $list_sort {
  58.  
  59.         .libdialog.frame1.lbox insert end $element
  60.  
  61.     }
  62.  
  63.     # categorie Conv
  64.  
  65.     set list_add {}
  66.         
  67.     foreach entry $list_entry {
  68.  
  69.         if { [string first "Conv" $entry] != "-1" } {
  70.         
  71.         lappend list_add "$entry -- [lindex $FuncLib($entry) 1]"
  72.  
  73.         }
  74.  
  75.     }
  76.     
  77.     set list_sort [lsort -ascii -increasing $list_add]
  78.  
  79.     foreach element $list_sort {
  80.  
  81.         .libdialog.frame1.lbox insert end $element
  82.  
  83.     }
  84.  
  85.     # categorie User
  86.  
  87.     set list_add {}
  88.  
  89.     foreach entry $list_entry {
  90.  
  91.         if { [string first "User" $entry] != "-1" } {
  92.         
  93.         lappend list_add "$entry -- [lindex $FuncLib($entry) 1]"
  94.  
  95.         }
  96.  
  97.     }
  98.     
  99.     set list_sort [lsort -ascii -increasing $list_add]
  100.  
  101.     foreach element $list_sort {
  102.  
  103.         .libdialog.frame1.lbox insert end $element
  104.  
  105.     }
  106.  
  107.     
  108.  
  109.     } else {
  110.  
  111.      # categorie en parametre cat
  112.  
  113.     set list_add {}
  114.         
  115.     foreach entry $list_entry {
  116.  
  117.         if { [string first $cat $entry] != "-1" } {
  118.         
  119.         lappend list_add "$entry -- [lindex $FuncLib($entry) 1]"
  120.  
  121.         }
  122.  
  123.     }
  124.     
  125.     set list_sort [lsort -ascii -increasing $list_add]
  126.  
  127.     foreach element $list_sort {
  128.  
  129.         .libdialog.frame1.lbox insert end $element
  130.  
  131.     }
  132.  
  133.     }
  134.  
  135. }
  136.  
  137. proc LibDialog {} {
  138.  
  139.     frame .libdialog.frame1 -relief groove -bd 1
  140.     
  141.     # boite a liste et scrollbars
  142.  
  143.     listbox .libdialog.frame1.lbox -height 10 -width 40 -yscrollcommand ".libdialog.frame1.yscroll set" -xscrollcommand ".libdialog.frame1.xscroll set"
  144.  
  145.     scrollbar .libdialog.frame1.yscroll -orient vertical -command ".libdialog.frame1.lbox yview"
  146.     scrollbar .libdialog.frame1.xscroll -orient horizontal -command ".libdialog.frame1.lbox xview" 
  147.     # le reste
  148.  
  149.     frame .libdialog.frame2 -relief raised -bd 2
  150.  
  151.     button .libdialog.frame2.allbtn -text "All" -command "FillLibDialog All"
  152.     button .libdialog.frame2.basicbtn -text "Basic" -command "FillLibDialog Basic"
  153.     button .libdialog.frame2.trigobtn -text "Trigo" -command "FillLibDialog Trigo"
  154.     button .libdialog.frame2.convbtn -text "Conv" -command "FillLibDialog Conv"
  155.     button .libdialog.frame2.userbtn -text "User" -command "FillLibDialog User"
  156.  
  157.     frame .libdialog.frame3 -relief raised -bd 1
  158.  
  159.     button .libdialog.frame3.usebtn -text "Use" -command UseFunction
  160.     button .libdialog.frame3.newbtn -text "New" -command NewFunctionDialog
  161.     button .libdialog.frame3.delbtn -text "Delete" -command DeleteFunction
  162.     button .libdialog.frame3.closebtn -text "Close" -command SwitchLibDialog
  163.  
  164.     pack .libdialog.frame2 -side right -anchor n
  165.  
  166.     pack .libdialog.frame2.allbtn -side top
  167.     pack .libdialog.frame2.basicbtn -side top
  168.     pack .libdialog.frame2.trigobtn -side top
  169.     pack .libdialog.frame2.convbtn -side top
  170.     pack .libdialog.frame2.userbtn -side top
  171.  
  172.     pack .libdialog.frame3 -side bottom -fill x
  173.  
  174.     pack .libdialog.frame3.usebtn .libdialog.frame3.newbtn .libdialog.frame3.delbtn -side left
  175.     pack .libdialog.frame3.closebtn -side right
  176.  
  177.     # boite a list et scrollbars 
  178.  
  179.     pack .libdialog.frame1 -side top -expand true -fill both
  180.   
  181.     pack .libdialog.frame1.yscroll -side right -fill y
  182.   
  183.     pack .libdialog.frame1.lbox -expand true -fill both
  184.  
  185.     pack .libdialog.frame1.xscroll -side bottom -fill x
  186.     
  187.  
  188.     wm deiconify .libdialog
  189.  
  190.     FillLibDialog "All"
  191.  
  192. }
  193.  
  194.  
  195. # affiche ou efface la boite de dialogue
  196.  
  197. proc SwitchLibDialog {} {
  198.     
  199.     if { [wm state .libdialog] != "normal" } {
  200.  
  201.     # afficher le boite de dialogue
  202.     
  203.     LibDialog
  204.  
  205.     } else {
  206.  
  207.     # sinon l'enlever
  208.  
  209.     destroy .libdialog
  210.     toplevel .libdialog
  211.     wm withdraw .libdialog
  212.     wm title .libdialog "Functions library"
  213.     wm transient .libdialog
  214.     }
  215. }
  216.  
  217. ############ PROCEDURES DE GESTION DE LA LIBRAIRIE ################
  218.  
  219. # utiliser une fonction
  220.  
  221. proc UseFunction {}  {
  222.     global FuncLib
  223.  
  224.     # recuperer le contenu de l'element selectionne
  225.     
  226.     set selected [ .libdialog.frame1.lbox curselection ]
  227.     
  228.     if { $selected == {} } return
  229.     
  230.     set index_item [ lindex $selected 0]
  231.     
  232.     set item [ .libdialog.frame1.lbox get $index_item ]
  233.  
  234.     # recuperer le nom complet de la fonction : cat/nom
  235.  
  236.     set function [string range $item 0 [string first " --" $item]]
  237.  
  238.     set function [string trim $function]
  239.  
  240.     # rajouter la valeur de la fonction dans le widget text
  241.  
  242.     .viewtxt insert insert [lindex $FuncLib(${function}) 0]
  243.  
  244. }
  245.  
  246. # boite de dialogue, nouvelle fonction
  247.  
  248. proc NewFunctionDialog {} {
  249.     global NewFunctionName NewFunctionVal NewFunctionComment
  250.  
  251.     set NewFunctionName ""
  252.     set NewFunctionVal ""
  253.     set NewFunctionComment ""
  254.  
  255.     toplevel .newdialog
  256.  
  257.     wm title .newdialog "New function"
  258.  
  259.     frame .newdialog.nameframe
  260.     label .newdialog.nameframe.label -text "Name"
  261.     entry .newdialog.nameframe.entry -textvariable NewFunctionName
  262.  
  263.     frame .newdialog.valframe
  264.     label .newdialog.valframe.label -text "Text value"
  265.     entry .newdialog.valframe.entry -textvariable NewFunctionVal
  266.  
  267.     frame .newdialog.commentframe
  268.     label .newdialog.commentframe.label -text "Comment"
  269.     entry .newdialog.commentframe.entry -textvariable NewFunctionComment
  270.  
  271.     frame .newdialog.commandframe -relief raised -bd 2
  272.     button .newdialog.commandframe.okbtn -text "Ok" -command NewFunctionOk
  273.     button .newdialog.commandframe.cancelbtn -text "Cancel" -command NewFunctionCancel
  274.  
  275.     pack .newdialog.nameframe -side top -expand true -fill x
  276.     pack .newdialog.nameframe.label -side left
  277.     pack .newdialog.nameframe.entry -side right -expand true -fill x
  278.  
  279.     pack .newdialog.valframe -side top -expand true -fill x
  280.     pack .newdialog.valframe.label -side left
  281.     pack .newdialog.valframe.entry -side right -expand true -fill x
  282.  
  283.     pack .newdialog.commentframe -side top -expand true -fill x
  284.     pack .newdialog.commentframe.label -side left
  285.     pack .newdialog.commentframe.entry -side right -expand true -fill x
  286.  
  287.     pack .newdialog.commandframe -side top -fill x
  288.     pack .newdialog.commandframe.okbtn -side left -expand true -fill x -padx 4 -pady 4
  289.     pack .newdialog.commandframe.cancelbtn -side right -expand true -fill x  -padx 4 -pady 4
  290.  
  291.     grab set .newdialog
  292.  
  293.     tkwait window .newdialog
  294.  
  295.     grab release newdialog
  296.  
  297. }
  298.  
  299. proc NewFunctionOk {} {
  300.     global NewFunctionName NewFunctionVal NewFunctionComment
  301.  
  302.     if { $NewFunctionName == "" } return
  303.     if { $NewFunctionVal == "" } return
  304.     if { $NewFunctionComment == "" } return
  305.  
  306.     AddFuncLib "User" $NewFunctionName $NewFunctionVal $NewFunctionComment
  307.  
  308.     destroy .newdialog
  309.  
  310. }
  311.  
  312. proc NewFunctionCancel {} {
  313.  
  314.     destroy .newdialog
  315.  
  316. }
  317.  
  318. proc DeleteFunction {} {
  319.     global FuncLib
  320.  
  321.     # poser la question 
  322.  
  323.     set answer [tk_dialog .deletedlg "Delete function" "Are you sure ?" "" 1 "Yes" "No"]
  324.  
  325.     if { $answer != 0 } return
  326.  
  327.    # recuperer le contenu de l'element selectionne
  328.     
  329.     set selected [ .libdialog.frame1.lbox curselection ]
  330.     
  331.     if { $selected == {} } return
  332.     
  333.     set index_item [ lindex $selected 0]
  334.     
  335.     set item [ .libdialog.frame1.lbox get $index_item ]
  336.  
  337.     # recuperer le nom complet de la fonction : cat/nom
  338.  
  339.     set function [string range $item 0 [string first " --" $item]]
  340.  
  341.     set function [string trim $function]
  342.  
  343.     if { ! [string match "User/*" $function] } return
  344.  
  345.     # effacer la fonction
  346.  
  347.     unset FuncLib(${function})
  348.  
  349. }
  350.  
  351.  
  352.  
  353. # ajout d'une fonction dans la librarie
  354.  
  355. proc AddFuncLib { cat name val comment } {
  356.     global FuncLib
  357.  
  358.     set "FuncLib(${cat}/${name})" [list "$val" "$comment" ]
  359.  
  360. }
  361.  
  362. # effacer la librairie
  363.  
  364. proc DeleteFuncLib {} {
  365.     global FuncLib
  366.  
  367.     unset FuncLib
  368. }
  369.     
  370.  
  371. # fonctions predefinies
  372.  
  373. proc InitBuiltInFuncLib {} {
  374.  
  375.     # les fonctions predefinies, categorie Basic
  376.  
  377.     # noms des fonctions
  378.  
  379.     set basic_func { "abs(x)" "exp(x)" "fmod(x,y)" "hypot(x,y)" "log(x)" "log10(x)" "pow(x,y)" "sqrt(x)" }
  380.  
  381.     # texte des fonctions
  382.  
  383.     set basic_val { "abs(" "exp(" "fmod(" "hypot(" "log(" "log10(" "pow(" "sqrt(" }
  384.  
  385.     # commentaires associes
  386.  
  387.     set basic_com { "Absolute value of x" "e raised to the power x" "Real remainder of x divided by y" "Square root of (x▓+y▓)" "Natural logarithm of x" "Base 10 logarithm of x" "x raised to the power y" "Square root of x" }
  388.  
  389.     # ajouter les fonctions de base a la librairie
  390.  
  391.     for { set i 0 } { $i < [llength $basic_func] } { incr i } {
  392.  
  393.     AddFuncLib "Basic" "[lindex $basic_func $i]" "[lindex $basic_val $i]" "[lindex $basic_com $i]" 
  394.     }   
  395.  
  396.     # les fonctions predefinies, categories Trigo
  397.  
  398.     set trigo_func { "acos(x)" "asin(x)" "atan(x)" "atan2(x)" "cos(x)" "cosh(x)" "sin(x)" "sinh(x)" "tan(x)" "tanh(x)" }
  399.  
  400.     set trigo_val { "acos(" "asin(" "atan(" "atan2(" "cos(" "cosh(" "sin(" "sinh(" "tan(" "tanh(" }
  401.  
  402.     set trigo_com { "Arc cosine of x, in the range 0 to PI" "Arc sine of x, int the range -PI/2 to PI/2" "Arc tangent of x, in the range -PI/2 to PI/2" "Arc tangent of x/y, in the range -PI/2 to PI/2" "Cosine of x (x in radians)" "Hyperbolic cosine of x" "Sine of x (x in radians)" "Hyperbolic sine of x" "Tangent of x (x in radians)" "Hyperbolic tangent of x" }
  403.  
  404.     for { set i 0 } { $i < [llength $trigo_func] } { incr i } {
  405.     
  406.     AddFuncLib "Trigo" "[lindex $trigo_func $i]" "[lindex $trigo_val $i]" "[lindex $trigo_com $i]"  
  407.     
  408.     }
  409.  
  410.     # les fonctions predefinies, categories conversion
  411.  
  412.     set conv_func { "ceil(x)" "double(i)" "floor(x)" "int(x)" "round(x)" }
  413.  
  414.     set conv_val { "ceil(" "double(" "floor(" "int(" "round(" }
  415.  
  416.     set conv_com { "Smallest integer not less than x" "Real value equal to integer i" "Largest integer not greater than x" "Integer value produced by truncating x toward 0" "Integer value produced by rounding x" }
  417.  
  418.     for { set i 0 } { $i < [llength $conv_func] } { incr i } {
  419.     
  420.     AddFuncLib "Conv" "[lindex $conv_func $i]" "[lindex $conv_val $i]" "[lindex $conv_com $i]"  
  421.     
  422.     }
  423.  
  424. }
  425.  
  426. ############ GESTION DES FICHIERS LIBRAIRIE ##########
  427.  
  428. # Charger
  429.  
  430. proc LoadLibrary {} {
  431.     global FuncLib
  432.  
  433.     set types {
  434.     {{Fonctions TkCalc}  {.flib} }
  435.     {{Tous les fichiers}              *       }
  436.     }
  437.  
  438.     # nom du fichier a charger
  439.     
  440.     set filename [tk_getOpenFile -filetypes $types]
  441.  
  442.     if { $filename == "" } return
  443.  
  444.     # effacer la librairie courante
  445.  
  446.     set funcnames [array names FuncLib "User/*"]
  447.  
  448.     foreach function $funcnames {
  449.     unset FuncLib(${function})
  450.     }
  451.  
  452.     # ouvrir le fichier en lecture
  453.  
  454.     set f [open $filename r]
  455.  
  456.     # chargement du fichier
  457.     
  458.     while { ! [eof $f] }  {  
  459.  
  460.     # recuperer la description de la fonction
  461.  
  462.     gets $f name
  463.     if { $name == "" } break
  464.  
  465.     gets $f accolade
  466.  
  467.     gets $f val 
  468.     gets $f comment
  469.  
  470.     gets $f accolade
  471.  
  472.     # ajouter la fonction a la librairie
  473.  
  474.     AddFuncLib "User" $name $val $comment
  475.  
  476.     }
  477.  
  478.     close $f
  479.  
  480. }
  481.  
  482. # charger une librairie sans effacer les fonctions courantes
  483.  
  484. proc MergeLibrary {} {
  485.  
  486.     set types {
  487.     {{Fonctions TkCalc}  {.flib} }
  488.     {{Tous les fichiers}              *       }
  489.     }
  490.  
  491.     set filename [tk_getOpenFile -filetypes $types]
  492.  
  493.     if { $filename == "" } return
  494.  
  495.     set f [open $filename r]
  496.  
  497.     while { ! [eof $f] }  {  
  498.  
  499.     # recuperer la description de la fonction
  500.  
  501.     gets $f name
  502.     if { $name == "" } break
  503.  
  504.     gets $f accolade
  505.  
  506.     gets $f val 
  507.     gets $f comment
  508.  
  509.     gets $f accolade
  510.  
  511.     # ajouter la fonction a la librairie
  512.  
  513.     AddFuncLib "User" $name $val $comment
  514.  
  515.     }
  516.  
  517.     close $f
  518.  
  519. }
  520.  
  521. # sauvegarder les fonctions utilisateur
  522.  
  523. proc SaveLibrary {} {
  524.     global FuncLib
  525.  
  526.     set types {
  527.     {{Fonctions TkCalc}  {.flib} }
  528.     {{Tous les fichiers}              *       }
  529.     }
  530.  
  531.     # demander le nom du fichier a sauvegarder
  532.     
  533.     set filename [tk_getSaveFile -filetypes $types]
  534.  
  535.     if { $filename == "" } return
  536.  
  537.     # recuperer les noms de fonctions
  538.     
  539.     set funcnames [ array names FuncLib "User/*" ]
  540.  
  541.     if { $funcnames == {} } return
  542.  
  543.     # ouvrir le fichier en ecriture
  544.  
  545.     set f [open $filename w]
  546.  
  547.     # effectuer la sauvegarde
  548.  
  549.     foreach name $funcnames  {  
  550.  
  551.     # recuperer la description de la fonction
  552.  
  553.     puts $f [string range $name [expr 1+ [string first "/" $name]] end]
  554.  
  555.     puts $f \{
  556.  
  557.     puts $f [lindex $FuncLib(${name}) 0] 
  558.     puts $f [lindex $FuncLib(${name}) 1] 
  559.  
  560.         puts $f \}
  561.  
  562.     }
  563.  
  564.     close $f
  565.  
  566. }
  567.  
  568. # Effacer la librairie
  569.  
  570. proc DeleteLibrary {} {
  571.     global FuncLib
  572.  
  573.     # poser la question 
  574.  
  575.     set answer [tk_dialog .deletedlg "Delete library" "Are you sure ?" "" 1 "Yes" "No"]
  576.  
  577.     if { $answer != 0 } return
  578.  
  579.     set funcnames [array names FuncLib "User/*"]
  580.  
  581.     foreach function $funcnames {
  582.     unset FuncLib(${function})
  583.     }
  584.  
  585. }
  586.  
  587. ################ CODE DE DEMARRAGE ####################
  588.  
  589. toplevel .libdialog
  590. wm withdraw .libdialog
  591. wm title .libdialog "Functions library"
  592. wm transient .libdialog
  593.  
  594. InitBuiltInFuncLib
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.