diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /graphics/finomaton |
Initial commit
Diffstat (limited to 'graphics/finomaton')
-rw-r--r-- | graphics/finomaton/COPYING | 339 | ||||
-rw-r--r-- | graphics/finomaton/ChangeLog | 25 | ||||
-rw-r--r-- | graphics/finomaton/README | 143 | ||||
-rw-r--r-- | graphics/finomaton/TODO | 14 | ||||
-rw-r--r-- | graphics/finomaton/examples/finomaton.pdf | bin | 0 -> 48903 bytes | |||
-rw-r--r-- | graphics/finomaton/examples/finomaton.tex | 49 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph1.fin | 5 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph2.fin | 5 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph3.fin | 31 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph4.fin | 8 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph5.fin | 12 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph6.fin | 16 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph7.fin | 10 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph8.fin | 25 | ||||
-rw-r--r-- | graphics/finomaton/examples/graph9.fin | 10 | ||||
-rw-r--r-- | graphics/finomaton/finomaton.tcl | 1735 |
16 files changed, 2427 insertions, 0 deletions
diff --git a/graphics/finomaton/COPYING b/graphics/finomaton/COPYING new file mode 100644 index 0000000000..14771d0441 --- /dev/null +++ b/graphics/finomaton/COPYING @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + 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 the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19yy name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/graphics/finomaton/ChangeLog b/graphics/finomaton/ChangeLog new file mode 100644 index 0000000000..1773d874f8 --- /dev/null +++ b/graphics/finomaton/ChangeLog @@ -0,0 +1,25 @@ +Version 1.0 (June 21st, 2007) + *) control point interpolation + *) some smaller improvements + +Version 0.9 (July 16th, 2006) + *) spread functions + *) more keyboard shortcuts + *) entry field for state coordinates, suggested by Mojca Miklavec + *) rudimentary support for directed graphs + +Version 0.8 (October 9th, 2003) + *) batch mode to convert files non-interactively + *) scrollbar for main canvas + *) file comment, author's name and verbatim TeX commands + *) move objects with arrow keys + *) configurable length and breadth of MetaPost arrowheads + *) DEL removes objects + *) display mouse coordinates + *) improved selection handling + *) remember MetaPost export file + *) don't save or export redundant data + *) some smaller corrections and improvements + +Version 0.7 (September 10th, 2003) + *) initial public release diff --git a/graphics/finomaton/README b/graphics/finomaton/README new file mode 100644 index 0000000000..a75818c577 --- /dev/null +++ b/graphics/finomaton/README @@ -0,0 +1,143 @@ + + Finomaton - Draw Finite State Machines + ====================================== + + +This is free software, and you are welcome to redistribute it under certain +conditions; see "COPYING" for more information. + +Finomaton comes WITHOUT ANY WARRANTY. + + + Requirements + ------------ + +You need Tcl/Tk and MetaPost. + + + Using Finomaton + --------------- + +Start Finomaton: + + wish finomaton.tcl + RETURN + +To add states, click "New state" and then on the canvas. Click "Select" and +then on the states to select and move them. Analogous for lines and text +items. Add a line, and you see three circles: two end-points, and one control +point. + +When you click on a state or somewhere on the canvas, control points become +invisible. When you select a line, its control points become visible and can be +moved. Add a second control point to a line by clicking "Control point" and +then on a line. Any item can be removed by clicking "Remove" and then on the +item you want to remove, or by selecting an item and then pressing "DEL". To +obtain a straight line, remove its control points. + +Select multiple items and toggle selections by holding CONTROL while clicking +on an item. Click "|" to assign all selected items the X-coordinate of the +first selected item (analogous for "--" and Y-coordinate). Press "h" to spread +(i.e., make equidistant between leftmost and rightmost) selected items +horizontally, "v" to spread vertically. + +Double-click on a state, text item or line for attributes. States have a label +for display on the canvas, and a "TeX" attribute that can contain any valid +TeX-string. If specified, it is used instead of the canvas label when +exporting. Include the TeX-command "\strut" if states turn out too small. + +Lines can have labels. The label will be typeset nearby the line (depending on +the anchor position you choose), and you can choose a percentage to select how +far along the line the label will be placed. The label will NOT be displayed +on the canvas, and a setting of 50% does NOT necessarily mean the optical +mid-point of the line. + +States act like magnets for control points. When you move a state, all its +attached control points move with it. If you move a control point by using the +arrow keys, it is not affected by magnetic states. + +Via "File => Settings...", you adjust parameters that affect the MetaPost +output. These settings are saved on a per-file basis. + + + Typesetting the Generated Graph + ------------------------------- + +Having exported a graph to MetaPost-format, say "graph.mp", you: + + +a) Invoke MetaPost: + + mpost graph.mp ("mp graph.mp" on some systems) + + This creates a new (PostScript) file, "graph.1". + + +b) Include "graph.1" in TeX and LaTeX-documents: + + *) pdftex (requires ConTeXt): + + \input supp-pdf.tex + \convertMPtoPDF{graph.1}{1}{1} + + Syntax is \convertMPtoPDF {filename} {x scale} {y scale}. + + *) pdflatex (requires ConTeXt): + + \usepackage{graphics} + \convertMPtoPDF{graph.1}{1}{1} + + *) tex: + + \special{psfile=graph.1} + + *) latex: + + \usepackage{graphics} + \includegraphics{graph.1} + +You can also try dvips, dvipdf, gs and ps2pdf on generated graphs and +documents. + + + Key bindings + ------------ + + Ctrl + m Export MetaPost... + Ctrl + o Open... + Ctrl + s Save + Alt + x Exit + + DEL Remove selected items + c Control point + e Select + h Spread selected items horizontally + l New line + r Remove + s New state + t New text + v Spread selected items vertically + x Same X coordinate for all selected items + y Same Y coordinate for all selected items + +When you use Ctrl + m, you are prompted for a file name only on the first +export. The same path is used when you use the binding again. + +For batch-conversions, use + + ./finomaton.tcl -exportmp file1.fin file2.fin ... + +to create file1.mp, file2.mp, ... . If a file's suffix is not "fin", +then ".mp" is appended to the filename. + + + Latest Version and Contact + -------------------------- + +The latest version of Finomaton is available from + + http://www.ctan.org + + +Good luck, +Markus Triska (triska@gmx.at) +October 9th, 2003 diff --git a/graphics/finomaton/TODO b/graphics/finomaton/TODO new file mode 100644 index 0000000000..b23428515a --- /dev/null +++ b/graphics/finomaton/TODO @@ -0,0 +1,14 @@ +*) grid +*) multiple MetaPost pictures per file +*) circle resizing +*) font selection +*) line labels on canvas +*) more options for label placement (tangent slope, ...) +*) create MetaPost preview on the fly +*) undo/redo +*) switch to export / not export object +*) choose type of arrow (none, one, both) +*) more items (ovals, rectangles, ...) +*) export to other graph drawing packages (xfig, xypic, ...) +*) clone function to duplicate items (for example, states with loops) +... diff --git a/graphics/finomaton/examples/finomaton.pdf b/graphics/finomaton/examples/finomaton.pdf Binary files differnew file mode 100644 index 0000000000..0b8a8bfbdf --- /dev/null +++ b/graphics/finomaton/examples/finomaton.pdf diff --git a/graphics/finomaton/examples/finomaton.tex b/graphics/finomaton/examples/finomaton.tex new file mode 100644 index 0000000000..bb5278514a --- /dev/null +++ b/graphics/finomaton/examples/finomaton.tex @@ -0,0 +1,49 @@ +\input supp-pdf.tex + +\def\graph#1{\vskip0.5cm plus1cm\centerline +{\convertMPtoPDF{#1}{1}{1}}\vskip0.5cm plus1cm\noindent\ignorespaces} + +\noindent +This graph was drawn with {\it Finomaton}: +\graph{graph1.1} +You can change the ``How far along'' and ``position'' parameters of the +line's label: +\graph{graph2.1} +The following graph contains two loops. A loop looks best with an +additional control point, which you can add by clicking on {\bf +Control point} and then on the line. +\graph{graph4.1} +The next graph contains one straight line that was created by +selecting the line, clicking {\bf Remove} and then on the control +point to delete it: +\graph{graph5.1} +When creating a graph, you need not worry about placement. MetaPost +and \TeX\ take the minimal bounding box into account when rendering +and placing the graph, regardless of its position on the canvas. + +\medskip\noindent +In the next example, I changed all {\tt drawarrow} commands to {\tt +draw} in the generated MetaPost file: +\graph{graph6.1} +\goodbreak\noindent +Another graph: +\graph{graph7.1} +With a label in the picture, and using a font not defined in +plain \TeX:\bigskip +\graph{graph8.1} +You can set ``Export style'' to {\tt digraph}: +\graph{graph3.1} +Or change {\tt circleit} to {\tt boxit} in the MetaPost file: +\graph{graph9.1} + +\vfill +\noindent +You can download +{\it Finomaton} from: +\bigskip +\hskip3cm http://www.ctan.org +\bigskip\ \bigskip\noindent +Good luck!\hfil\break +Markus Triska\hfil\break +triska$@$gmx.at +\bye diff --git a/graphics/finomaton/examples/graph1.fin b/graphics/finomaton/examples/graph1.fin new file mode 100644 index 0000000000..d29bc1e54a --- /dev/null +++ b/graphics/finomaton/examples/graph1.fin @@ -0,0 +1,5 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Sun Jun 17 08:27:20 PM CEST 2007 +object state id 1 x 52 y 138 radius 20 label a tex {\strut $a$} accept 0 start 1 +object state id 2 x 214 y 138 radius 20 label b tex {\strut $b$} accept 1 start 0 +object line cp1attached 1 cp1angle 45 cp2attached -1 cp2x 126 cp2y 83 cp3attached 2 cp3angle 140 cpnum 3 tex {1, 2, 3} texpos 0.5 anchor top bisect 1 diff --git a/graphics/finomaton/examples/graph2.fin b/graphics/finomaton/examples/graph2.fin new file mode 100644 index 0000000000..04807dcdfa --- /dev/null +++ b/graphics/finomaton/examples/graph2.fin @@ -0,0 +1,5 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Tue Jun 19 05:44:07 PM CEST 2007 +object state id 1 x 52 y 138 radius 20 label a tex {\strut $a$} accept 0 start 1 +object state id 2 x 214 y 138 radius 20 label b tex {\strut $b$} accept 1 start 0 +object line cp1attached 1 cp1angle 45 cp2attached -1 cp2x 126 cp2y 83 cp3attached 2 cp3angle 140 cpnum 3 tex {1, 2, 3} texpos 0.12 anchor lrt bisect 1 diff --git a/graphics/finomaton/examples/graph3.fin b/graphics/finomaton/examples/graph3.fin new file mode 100644 index 0000000000..998f698f8f --- /dev/null +++ b/graphics/finomaton/examples/graph3.fin @@ -0,0 +1,31 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Wed Jun 20 09:57:48 PM CEST 2007 +object state id 1 x 52.0 y 130.0 radius 20 label {} tex {} accept 0 start 0 +object state id 2 x 187.0 y 60.0 radius 20 label {} tex {} accept 0 start 0 +object state id 3 x 187.0 y 130.0 radius 20 label {} tex {} accept 0 start 0 +object state id 4 x 187.0 y 200.0 radius 20 label {} tex {} accept 0 start 0 +object state id 5 x 52.0 y 60.0 radius 20 label {} tex {} accept 0 start 0 +object state id 6 x 52.0 y 200.0 radius 20 label {} tex {} accept 0 start 0 +object state id 7 x 347.0 y 60.0 radius 20 label {} tex {} accept 0 start 0 +object state id 8 x 347.0 y 200.0 radius 20 label {} tex {} accept 0 start 0 +object state id 9 x 450.0 y 60.0 radius 20 label {} tex {} accept 0 start 0 +object state id 10 x 450.0 y 200.0 radius 20 label {} tex {} accept 0 start 0 +object state id 11 x 275.0 y 87.0 radius 20 label {} tex {} accept 0 start 0 +object line cp1attached 1 cp1angle -1 cp2attached 2 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 1 cp1angle -1 cp2attached 3 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 1 cp1angle -1 cp2attached 4 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 5 cp1angle -1 cp2attached 2 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 5 cp1angle -1 cp2attached 3 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 5 cp1angle -1 cp2attached 4 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 6 cp1angle -1 cp2attached 2 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 6 cp1angle -1 cp2attached 3 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 6 cp1angle -1 cp2attached 4 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 8 cp1angle -1 cp2attached 7 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 9 cp1angle -1 cp2attached 7 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 9 cp1angle -1 cp2attached 10 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 10 cp1angle -1 cp2attached 8 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 10 cp1angle -1 cp2attached -1 cp2x 289.0 cp2y 285.0 cp3attached 11 cp3angle 267 cp4attached 11 cp4angle -1 cpnum 4 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 11 cp1angle -1 cp2attached -1 cp2x 333.0 cp2y 154.0 cp3attached 8 cp3angle -1 cpnum 3 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 8 cp1angle -1 cp2attached 9 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 7 cp1angle -1 cp2attached 10 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object setting variable graphstyle value digraph diff --git a/graphics/finomaton/examples/graph4.fin b/graphics/finomaton/examples/graph4.fin new file mode 100644 index 0000000000..96c13d3e7c --- /dev/null +++ b/graphics/finomaton/examples/graph4.fin @@ -0,0 +1,8 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Wed Jun 20 08:58:33 PM CEST 2007 +object state id 1 x 59 y 131.5 radius 20 label s1 tex {\strut $s_1$} accept 0 start 1 +object state id 2 x 214.0 y 131.5 radius 20 label s2 tex {\strut $s_2$} accept 1 start 0 +object line cp1attached 2 cp1angle 27 cp2attached -1 cp2x 281 cp2y 102 cp3attached -1 cp3x 281 cp3y 161.0 cp4attached 2 cp4angle 328 cpnum 4 tex {$\underline{d}$} texpos 0.5 anchor rt bisect 1 +object line cp1attached 1 cp1angle 27 cp2attached -1 cp2x 136.5 cp2y 65 cp3attached 2 cp3angle 162 cpnum 3 tex {$\underline{a}$} texpos 0.5 anchor top bisect 1 +object line cp1attached 2 cp1angle 221 cp2attached -1 cp2x 136.5 cp2y 179 cp3attached 1 cp3angle 330 cpnum 3 tex {$\underline{b}$} texpos 0.5 anchor bot bisect 1 +object line cp1attached 1 cp1angle 118 cp2attached -1 cp2x 39.0 cp2y 68.0 cp3attached -1 cp3x 79.0 cp3y 68.0 cp4attached 1 cp4angle 62 cpnum 4 tex {$\underline{c}$} texpos 0.5 anchor top bisect 1 diff --git a/graphics/finomaton/examples/graph5.fin b/graphics/finomaton/examples/graph5.fin new file mode 100644 index 0000000000..da4ea914c4 --- /dev/null +++ b/graphics/finomaton/examples/graph5.fin @@ -0,0 +1,12 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Wed Jun 20 08:59:27 PM CEST 2007 +object state id 1 x 44 y 75 radius 20 label s1 tex {\strut $s_1$} accept 0 start 1 +object state id 2 x 94 y 194 radius 20 label s2 tex {\strut $s_2$} accept 0 start 0 +object state id 3 x 233 y 76 radius 20 label s4 tex {\strut $s_4$} accept 1 start 0 +object state id 4 x 238 y 204 radius 20 label s3 tex {\strut $s_3$} accept 1 start 0 +object line cp1attached 1 cp1angle 270 cp2attached -1 cp2x 35 cp2y 149 cp3attached 2 cp3angle 141 cpnum 3 tex {$\underline{b}$} texpos 0.5 anchor lft bisect 1 +object line cp1attached 2 cp1angle 77 cp2attached 3 cp2angle 208 cpnum 2 tex {$\underline{c}$} texpos 0.68 anchor lrt bisect 1 +object line cp1attached 1 cp1angle 43 cp2attached -1 cp2x 130 cp2y 22 cp3attached 3 cp3angle 153 cpnum 3 tex {$\underline{a}$} texpos 0.5 anchor top bisect 1 +object line cp1attached 3 cp1angle 319 cp2attached -1 cp2x 313 cp2y 113 cp3attached -1 cp3x 312 cp3y 45 cp4attached 3 cp4angle 33 cpnum 4 tex {$\underline{u}$} texpos 0.5 anchor rt bisect 1 +object line cp1attached 2 cp1angle 360 cp2attached -1 cp2x 166 cp2y 169 cp3attached 4 cp3angle 167 cpnum 3 tex {$\varepsilon$} texpos 0.5 anchor top bisect 1 +object line cp1attached 4 cp1angle 216 cp2attached -1 cp2x 169 cp2y 234 cp3attached 2 cp3angle 323 cpnum 3 tex {$\underline{\alpha}$} texpos 0.5 anchor bot bisect 1 diff --git a/graphics/finomaton/examples/graph6.fin b/graphics/finomaton/examples/graph6.fin new file mode 100644 index 0000000000..3fab2fc5ff --- /dev/null +++ b/graphics/finomaton/examples/graph6.fin @@ -0,0 +1,16 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Wed Jun 20 08:59:59 PM CEST 2007 +object state id 1 x 278.999999999 y 184 radius 20 label 0 tex {\strut 0} accept 0 start 0 +object state id 2 x 238.666666666 y 98 radius 20 label 0 tex {\strut 0} accept 0 start 0 +object state id 3 x 198.333333333 y 184 radius 20 label 1 tex {\strut 1} accept 0 start 0 +object state id 4 x 77.3333333333 y 98 radius 20 label 1 tex {\strut 1} accept 0 start 0 +object state id 5 x 37 y 184 radius 20 label 1 tex {\strut 1} accept 0 start 0 +object state id 6 x 117.666666667 y 184 radius 20 label 0 tex {\strut 0} accept 0 start 0 +object state id 7 x 158.0 y 36 radius 20 label r tex {\strut $r$} accept 0 start 0 +object line cp1attached 2 cp1angle 305 cp2attached 1 cp2angle 109 cpnum 2 tex {} texpos 0.5 anchor top bisect 0 +object line cp1attached 7 cp1angle 322 cp2attached 2 cp2angle 119 cpnum 2 tex {} texpos 0.5 anchor top bisect 0 +object line cp1attached 4 cp1angle 299 cp2attached 6 cp2angle 90 cpnum 2 tex {} texpos 0.5 anchor top bisect 0 +object line cp1attached 2 cp1angle 236 cp2attached 3 cp2angle 74 cpnum 2 tex {} texpos 0.5 anchor top bisect 0 +object line cp1attached 7 cp1angle 215 cp2attached 4 cp2angle 59 cpnum 2 tex {} texpos 0.5 anchor top bisect 0 +object line cp1attached 4 cp1angle 241 cp2attached 5 cp2angle 78 cpnum 2 tex {} texpos 0.5 anchor top bisect 0 +object setting variable filecomment value {Change all "drawarrow" commands to "draw" to get rid of arrowheads.} diff --git a/graphics/finomaton/examples/graph7.fin b/graphics/finomaton/examples/graph7.fin new file mode 100644 index 0000000000..f068bbeee5 --- /dev/null +++ b/graphics/finomaton/examples/graph7.fin @@ -0,0 +1,10 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Wed Jun 20 09:02:11 PM CEST 2007 +object state id 1 x 150.5 y 159 radius 20 label q2 tex {\strut $q_2$} accept 1 start 0 +object state id 2 x 41 y 159 radius 20 label q1 tex {\strut $q_1$} accept 0 start 1 +object state id 3 x 260.0 y 159 radius 20 label q3 tex {\strut $q_3$} accept 0 start 0 +object line cp1attached 1 cp1angle 360 cp2attached 3 cp2angle 180 cpnum 2 tex {$\underline{1}$} texpos 0.5 anchor top bisect 1 +object line cp1attached 3 cp1angle 241 cp2attached -1 cp2x 206.0 cp2y 244 cp3attached 1 cp3angle 292 cpnum 3 tex {$\underline{0}$, $\underline{1}$} texpos 0.5 anchor bot bisect 1 +object line cp1attached 2 cp1angle 299 cp2attached -1 cp2x 96.5 cp2y 244 cp3attached 1 cp3angle 240 cpnum 3 tex {$\underline{0}$} texpos 0.5 anchor bot bisect 1 +object line cp1attached 2 cp1angle 63 cp2attached -1 cp2x 150.5 cp2y 38 cp3attached 3 cp3angle 115 cpnum 3 tex {$\underline{1}$} texpos 0.5 anchor top bisect 1 +object line cp1attached 2 cp1angle 360 cp2attached 1 cp2angle 180 cpnum 2 tex {$\underline{0}$} texpos 0.5 anchor top bisect 1 diff --git a/graphics/finomaton/examples/graph8.fin b/graphics/finomaton/examples/graph8.fin new file mode 100644 index 0000000000..db3e080ddf --- /dev/null +++ b/graphics/finomaton/examples/graph8.fin @@ -0,0 +1,25 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Wed Jun 20 09:25:25 PM CEST 2007 +object state id 1 x 494.0 y 215.0 radius 20 label q2 tex {\strut $q_2$} accept 0 start 0 +object state id 2 x 660.0 y 120.0 radius 20 label q3 tex {\strut $q_3$} accept 0 start 0 +object state id 3 x 494.0 y 25.0 radius 20 label q0 tex {\strut $q_0$} accept 0 start 1 +object state id 4 x 494.0 y 120.0 radius 20 label q1 tex {\strut $q_1$} accept 0 start 0 +object state id 5 x 328.0 y 234.0 radius 20 label H tex {\strut $H$} accept 1 start 0 +object state id 6 x 328.0 y 120.0 radius 20 label q4 tex {\strut $q_4$} accept 0 start 0 +object line cp1attached 3 cp1angle -1 cp2attached 4 cp2angle -1 cpnum 2 tex {\Box/1/\R} texpos 0.5 anchor rt bisect 1 +object line cp1attached 3 cp1angle -1 cp2attached -1 cp2x 362.0 cp2y 118.0 cp3attached 1 cp3angle -1 cpnum 3 tex {1/1/\L} texpos 0.5 anchor lft bisect 1 +object line cp1attached 4 cp1angle 332 cp2attached -1 cp2x 561.0 cp2y 148.0 cp3attached -1 cp3x 561.0 cp3y 90.0 cp4attached 4 cp4angle 37 cpnum 4 tex {1/1/\R} texpos 0.5 anchor rt bisect 0 +object line cp1attached 4 cp1angle -1 cp2attached 1 cp2angle -1 cpnum 2 tex {\Box/1/\R} texpos 0.5 anchor rt bisect 1 +object line cp1attached 2 cp1angle 322 cp2attached -1 cp2x 723.0 cp2y 148.0 cp3attached -1 cp3x 723.0 cp3y 92.0 cp4attached 2 cp4angle 38 cpnum 4 tex {1/1/\L} texpos 0.5 anchor rt bisect 0 +object line cp1attached 2 cp1angle -1 cp2attached -1 cp2x 622.0 cp2y 18.0 cp3attached 3 cp3angle -1 cpnum 3 tex {\Box/1/\L} texpos 0.5 anchor urt bisect 1 +object line cp1attached 1 cp1angle -1 cp2attached -1 cp2x 622.0 cp2y 217.0 cp3attached 2 cp3angle -1 cpnum 3 tex {\Box/1/\R} texpos 0.5 anchor lrt bisect 1 +object line cp1attached 1 cp1angle -1 cp2attached -1 cp2x 373.0 cp2y 214.0 cp3attached 6 cp3angle -1 cpnum 3 tex {1/\Box/\L} texpos 0.14 anchor llft bisect 1 +object line cp1attached 6 cp1angle -1 cp2attached -1 cp2x 366.0 cp2y 18.0 cp3attached 3 cp3angle -1 cpnum 3 tex {1/\Box/\L} texpos 0.5 anchor ulft bisect 1 +object line cp1attached 6 cp1angle 264 cp2attached 5 cp2angle 96 cpnum 2 tex {\Box/1/\R} texpos 0.5 anchor lft bisect 1 +object text x 81.0 y 115.0 label {My defined label} tex {\mylabel} +object setting variable filecomment value {This demonstrates how to embed TeX commands in your file.} +object setting variable verbatimtex value {\font\lasy=lasy10 +\def\Box{{\lasy\char'62}} +\def\R{R} +\def\L{L} +\def\mylabel{\vbox{\hbox{This is a 5-state}\hbox{{\it Busy Beaver\/}-candidate}}}} diff --git a/graphics/finomaton/examples/graph9.fin b/graphics/finomaton/examples/graph9.fin new file mode 100644 index 0000000000..aa3d7ac871 --- /dev/null +++ b/graphics/finomaton/examples/graph9.fin @@ -0,0 +1,10 @@ +# Creator: Finomaton 1.0 +# Creation-Date: Thu Jun 21 01:56:43 PM CEST 2007 +object state id 1 x 165.5 y 211.0 radius 20 label {} tex {\cb r} accept 0 start 0 +object state id 2 x 77.0 y 114.0 radius 20 label {} tex {\cb a} accept 0 start 0 +object state id 3 x 165.5 y 114.0 radius 20 label {} tex {\cb b} accept 0 start 0 +object state id 4 x 254.0 y 114.0 radius 20 label {} tex {\cb c} accept 0 start 0 +object line cp1attached 1 cp1angle -1 cp2attached 2 cp2angle 279 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 1 cp1angle -1 cp2attached 3 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object line cp1attached 1 cp1angle -1 cp2attached 4 cp2angle -1 cpnum 2 tex {} texpos 0.5 anchor top bisect 1 +object setting variable verbatimtex value {\def\cb#1{\strut\hbox to 30pt{\hfil #1\hfil}}} diff --git a/graphics/finomaton/finomaton.tcl b/graphics/finomaton/finomaton.tcl new file mode 100644 index 0000000000..e3af7d8db8 --- /dev/null +++ b/graphics/finomaton/finomaton.tcl @@ -0,0 +1,1735 @@ +#!/bin/sh +# the next line restarts using wish \ +exec wish "$0" "$@" + +# Finomaton - Draw Finite State Machines +# Copyright (C) 2003, 2006, 2007 Markus Triska (triska@gmx.at) +# +# 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 the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA + + +if {[info tclversion] < 8.3} { + puts "This program requires Tcl >= 8.3. You have: [info tclversion]" + exit +} + +set PROGRAM "Finomaton" +set VERSION 1.0 +set PI [expr atan(1)*4] +set windowtitle $PROGRAM +set batchmode 0 + +set default_stateradius 20 +set default_linelength 80 +set default_cpradius 6 +set magnetic_radius 7 +set highlight "#3078d8" +set metapost_scale_default 0.5 +set metapost_scale $metapost_scale_default + +set selectedlist {} +set dragobject -1 +set dragstart "0 0" +set dragend "0 0" +set dragrectangleid -1 +set currentcommand "" +set anchormenu "" +set needs_save 0 +set currentfile "" +set export_mp_file_default "" +set export_mp_file $export_mp_file_default +set export_ps_file "" +set filecomment_default "" +set filecomment $filecomment_default +set ahangle_default 35 +set ahangle $ahangle_default +set ahlength_default 4 +set ahlength $ahlength_default +set fileauthor_default "" +set fileauthor $fileauthor_default +set verbatimtex_default "" +set verbatimtex $verbatimtex_default +set graphstyle "automaton" +set graphstyle_default "automaton" +set modifiable_params {metapost_scale ahangle ahlength filecomment \ + export_mp_file fileauthor verbatimtex graphstyle} +array set objectinfo {} + + +proc digraph {} { + global graphstyle + return [string equal $graphstyle "digraph"] +} + +proc automaton {} { + return [expr ![digraph]] +} + +proc reset_parameter {param} { + upvar #0 $param p + upvar #0 ${param}_default pd + set p $pd +} + +proc reset_all_parameters {} { + global modifiable_params + foreach mp $modifiable_params { reset_parameter $mp } +} + +proc is_numeric {s} { + return [regexp {^[+-]?\d*\.?\d+$} $s] +} + +proc check_parameters {} { + global metapost_scale ahangle ahlength + foreach numericparam {metapost_scale ahangle ahlength} { + if {![is_numeric [subst $$numericparam]]} { + reset_parameter $numericparam + } + } +} + +set unid 0 +proc unique_id {} { + # simulate behaviour of the canvas widget in batch mode + global unid + incr unid + return $unid +} + +proc get_objects_type {type} { + global objectinfo + set objlist "" + foreach id [array names objectinfo {*-id}] { + set id [string replace $id [string first "-" $id] end] + if {$objectinfo($id-type) == $type} { lappend objlist $id } + } + return $objlist +} + +proc set_command {command} { + global currentcommand commandsframe + if {$currentcommand != ""} { + set path "$commandsframe.command_$currentcommand" + $path configure -relief raised + } + + set newpath "$commandsframe.command_$command" + $newpath configure -relief sunken + set currentcommand $command +} + +proc dist {x1 y1 x2 y2} { + set dx [expr {$x2 - $x1}] + set dy [expr {$y2 - $y1}] + return [expr hypot($dx, $dy)] +} + +proc inside_object {X Y} { + upvar #0 objectinfo oi + + # check control points first since they can be inside states + foreach id [get_objects_type "controlpoint"] { + if {[dist $oi($id-x) $oi($id-y) $X $Y] <= $oi($id-radius)} { + return $id + } + } + + foreach id [get_objects_type "state"] { + if {[dist $oi($id-x) $oi($id-y) $X $Y] <= $oi($id-radius)} { + return $id + } + } + return -1 +} + +proc correct_angle {angle a} { + set corr 7 + if {($angle >= $a - $corr) && ($angle <= $a + $corr)} { return $a } + return $angle +} + +proc magnetic_anchor {X Y} { + # pull control points to states (outline or center), return stateid + # and angle to attach line (-1 for center), or -1 if no state found + + global magnetic_radius + + foreach id [get_objects_type "state"] { + upvar #0 objectinfo oi + set d [dist $X $Y $oi($id-x) $oi($id-y)] + if {abs($d - $oi($id-radius)) <= $magnetic_radius} { + # pull to point on outline + set dx [expr {$X - $oi($id-x)}] + set cos [expr {$dx / $d}] + global PI + set angle [expr {(acos($cos)/$PI*180)}] + if {$Y > $oi($id-y)} { set angle [expr {360 - $angle}] } + foreach a {0 90 180 270 360} { + # set angle [correct_angle $angle $a] + } + return "$id [expr round($angle)]" + } elseif {$d <= $magnetic_radius} { + # pull to center + return "$id -1" + } + } + return -1 +} + +proc anchor_coords {stateid angle} { + global objectinfo PI + set x $objectinfo($stateid-x) + set y $objectinfo($stateid-y) + if {$angle == -1} { return "$x $y" } + + set r $objectinfo($stateid-radius) + set anchx [expr {$x + $r*cos($angle*$PI/180)}] + set anchy [expr {$y - $r*sin($angle*$PI/180)}] + return "$anchx $anchy" +} + +proc create_state {X Y r} { + global maincanvas objectinfo batchmode + + set id 0 + if {$batchmode} { + set id [unique_id] + set labelid [unique_id] + } else { + set id [$maincanvas create oval 0 0 0 0 -tags state] + set labelid [$maincanvas create text $X $Y -text "s"] + } + set objectinfo($id-radius) $r + set objectinfo($id-x) $X + set objectinfo($id-y) $Y + set objectinfo($id-id) $id + set objectinfo($id-type) "state" + set objectinfo($id-label) "" + set objectinfo($id-tex) "" + set objectinfo($id-accept) 0 + set objectinfo($id-acceptid) -1 + set objectinfo($id-start) 0 + set objectinfo($id-labelid) $labelid + set objectinfo($labelid-type) "statelabel" + + update_object $id + return $id +} + +proc add_control_point {line X Y {interactive 1}} { + global objectinfo maincanvas default_cpradius batchmode + + set id 0 + if {$batchmode} { + set id [unique_id] + } else { + set id [$maincanvas create oval 0 0 0 0 -tags cp] + } + set objectinfo($id-x) $X + set objectinfo($id-y) $Y + set objectinfo($id-type) "controlpoint" + set objectinfo($id-line) $line + set objectinfo($id-id) $id + + set insertpos end + if {$interactive} { + set insertpos 1 + if {[llength $objectinfo($line-cplist)] == 3} { + # insert it depending on which endpoint is nearer + set ep1 [lindex $objectinfo($line-cplist) 0] + set ep2 [lindex $objectinfo($line-cplist) 2] + set d1 [dist $objectinfo($ep1-x) $objectinfo($ep1-y) $X $Y] + set d2 [dist $objectinfo($ep2-x) $objectinfo($ep2-y) $X $Y] + if {$d2 < $d1} { set insertpos 2 } + } + } + + set objectinfo($line-cplist) [linsert $objectinfo($line-cplist) \ + $insertpos $id] + set objectinfo($id-radius) $default_cpradius + set objectinfo($id-attached) -1 + set objectinfo($id-angle) 0 + # don't use update_object here, because the line might not be finished yet + update_oval $id + return $id +} + +proc create_line {X Y {interactive 1}} { + global maincanvas default_linelength objectinfo batchmode + # set control points + set cp1x $X + set cp2x [expr {$X + ($default_linelength / 2)}] + set cp3x [expr {$X + $default_linelength}] + set lid 0 + if {$batchmode} { + set lid [unique_id] + } else { + set lid [$maincanvas create line $cp1x $Y $cp2x $Y $cp3x $Y \ + -smooth 1 -arrow last -tags line] + } + set objectinfo($lid-type) "line" + set objectinfo($lid-id) $lid + set objectinfo($lid-tex) "" + set objectinfo($lid-texpos) 0.5 + set objectinfo($lid-anchor) "top" + set objectinfo($lid-cplist) "" + set objectinfo($lid-bisect) 1 + # coordinates for lines are used to compute relative movement when + # the line is being dragged. meaningless otherwise. + set objectinfo($lid-x) 0 + set objectinfo($lid-y) 0 + + if {$interactive} { + foreach cp {cp1 cp2 cp3} { + set cpx [subst $${cp}x] + add_control_point $lid $cpx $Y 0 + } + update_object $lid + } + return $lid +} + +proc create_text {X Y} { + global maincanvas objectinfo batchmode + set id 0 + if {$batchmode} { + set id [unique_id] + } else { + set id [$maincanvas create text $X $Y -text "text" -tags text] + } + set objectinfo($id-type) "text" + set objectinfo($id-x) $X + set objectinfo($id-y) $Y + set objectinfo($id-label) "text" + set objectinfo($id-tex) "" + set objectinfo($id-id) $id + return $id +} + +proc remove_object {id {interactive 1}} { + global objectinfo maincanvas + + if {$objectinfo($id-type) == "controlpoint"} { + set lid $objectinfo($id-line) + set cplist $objectinfo($lid-cplist) + set i [lsearch $cplist $id] + set objectinfo($lid-cplist) [lreplace $cplist $i $i] + if {$interactive} { + # called by user, not when deleting whole line + if {[llength $objectinfo($lid-cplist)] <= 1} { + remove_object $lid + } else { + update_object $lid + } + } + } elseif {$objectinfo($id-type) == "line"} { + foreach cp $objectinfo($id-cplist) { remove_object $cp 0 } + } elseif {$objectinfo($id-type) == "state"} { + remove_object $objectinfo($id-labelid) + if {$objectinfo($id-accept)} { + remove_object $objectinfo($id-acceptid) + } + foreach cpid [get_objects_type "controlpoint"] { + if {$objectinfo($cpid-attached) == $id} { + set objectinfo($cpid-attached) -1 + } + } + } + + remove_select $id + $maincanvas delete $id + array unset objectinfo "$id-*" +} + +proc update_oval {id} { + global maincanvas batchmode objectinfo + if {$batchmode} { return } + + set r $objectinfo($id-radius) + set x1 [expr {$objectinfo($id-x) - $r}] + set x2 [expr {$objectinfo($id-x) + $r}] + set y1 [expr {$objectinfo($id-y) - $r}] + set y2 [expr {$objectinfo($id-y) + $r}] + $maincanvas coords $id $x1 $y1 $x2 $y2 +} + +proc update_object {id} { + global objectinfo maincanvas batchmode + if {$batchmode} { return } + if {$objectinfo($id-type) == "line"} { + set points "" + foreach cp $objectinfo($id-cplist) { + set points [concat $points "$objectinfo($cp-x) $objectinfo($cp-y)"] + } + $maincanvas coords $id $points + } elseif {$objectinfo($id-type) == "controlpoint"} { + update_oval $id + update_object $objectinfo($id-line) + } elseif {$objectinfo($id-type) == "state"} { + update_oval $id + if {$objectinfo($id-start)} { + $maincanvas itemconfigure $id -width 3 + } else { + $maincanvas itemconfigure $id -width 1 + } + + if {$objectinfo($id-accept)} { + set accid $objectinfo($id-acceptid) + if {$accid == -1} { + set accid [$maincanvas create oval 0 0 0 0] + global default_stateradius + set objectinfo($accid-radius) [expr {$default_stateradius - 4}] + set objectinfo($accid-type) "acceptcircle" + set objectinfo($id-acceptid) $accid + } + set objectinfo($accid-x) $objectinfo($id-x) + set objectinfo($accid-y) $objectinfo($id-y) + update_oval $accid + } else { + if {$objectinfo($id-acceptid) != -1} { + remove_object $objectinfo($id-acceptid) + set objectinfo($id-acceptid) -1 + } + } + $maincanvas itemconfigure $objectinfo($id-labelid) -text \ + $objectinfo($id-label) + $maincanvas coords $objectinfo($id-labelid) \ + $objectinfo($id-x) $objectinfo($id-y) + foreach cp [get_objects_type "controlpoint"] { + if {$objectinfo($cp-attached) == $id} { + set c [anchor_coords $id $objectinfo($cp-angle)] + set objectinfo($cp-x) [lindex $c 0] + set objectinfo($cp-y) [lindex $c 1] + update_object $cp + } + } + } elseif {$objectinfo($id-type) == "text"} { + $maincanvas itemconfigure $id -text $objectinfo($id-label) + $maincanvas coords $id $objectinfo($id-x) $objectinfo($id-y) + } +} + +proc move_delta {id dx dy} { + global objectinfo + set objectinfo($id-x) [expr {$objectinfo($id-x) + $dx}] + set objectinfo($id-y) [expr {$objectinfo($id-y) + $dy}] + if {$objectinfo($id-x) < 0} { set objectinfo($id-x) 0 } + if {$objectinfo($id-y) < 0} { set objectinfo($id-y) 0 } + update_object $id +} + + +proc move_objects {coords} { + global selectedlist objectinfo dragobject + if {$dragobject == -1} { return } + + set X [lindex $coords 0] + set Y [lindex $coords 1] + + set newx $X + set newy $Y + + # a control point might be moved to coordinates different from ($X/$Y) + # because of magnetic states. so check this first. + if {$objectinfo($dragobject-type) == "controlpoint"} { + set magna [magnetic_anchor $X $Y] + if {$magna != -1} { + set magid [lindex $magna 0] + set angle [lindex $magna 1] + set coords [anchor_coords $magid $angle] + set newx [lindex $coords 0] + set newy [lindex $coords 1] + set objectinfo($dragobject-attached) $magid + set objectinfo($dragobject-angle) $angle + } else { + set objectinfo($dragobject-attached) -1 + set objectinfo($dragobject-angle) 0 + } + } + + # now compute the relative movement of the primarily dragged object + set dx [expr {$newx - $objectinfo($dragobject-x)}] + set dy [expr {$newy - $objectinfo($dragobject-y)}] + + # move all selected objects accordingly (includes dragged object) + foreach id $selectedlist { + if {$id != $dragobject && $objectinfo($id-type) == "controlpoint"} { + # detach other control points if necessary + set s $objectinfo($id-attached) + if {$s != -1 && [lsearch $selectedlist $s] == -1} { + set objectinfo($id-attached) -1 + } + } + move_delta $id $dx $dy + } +} + +proc hide_control_points {} { + global maincanvas + $maincanvas itemconfigure cp -outline "" +} + +proc add_select {id} { + global selectedlist maincanvas objectinfo highlight + if {[lsearch $selectedlist $id] == -1} { + lappend selectedlist $id + } + + if {$objectinfo($id-type) == "line" || $objectinfo($id-type) == "text"} { + $maincanvas itemconfigure $id -fill $highlight + } else { + $maincanvas itemconfigure $id -outline $highlight + } + + if {$objectinfo($id-type) == "line"} { + foreach cp $objectinfo($id-cplist) { add_select $cp } + } +} + +proc remove_select {id} { + global selectedlist objectinfo maincanvas + set pos [lsearch $selectedlist $id] + if {$pos != -1} { + set selectedlist [lreplace $selectedlist $pos $pos] + if {$objectinfo($id-type) == "line" || \ + $objectinfo($id-type) == "text"} { + $maincanvas itemconfigure $id -fill black + } else { + $maincanvas itemconfigure $id -outline black + } + } + global dragobject + if {$dragobject == $id} { + set dragobject -1 + } +} + +proc toggle_item {id} { + global selectedlist dragobject + if {[lsearch $selectedlist $id] == -1} { + add_select $id + set dragobject $id + } else { + remove_select $id + } +} + +proc closest_item {coords} { + global maincanvas objectinfo + set X [lindex $coords 0] + set Y [lindex $coords 1] + + set id [inside_object $X $Y] + if {$id != -1} { return $id } + + set id [$maincanvas find closest $X $Y] + if {$id != ""} { + if {$objectinfo($id-type) == "line"} { + return $id + } elseif {$objectinfo($id-type) == "text"} { + return $id + } + } + return -1 +} + +proc toggle_select {coords} { + global objectinfo + set id [closest_item $coords] + if {$id != -1} { + toggle_item $id + if {$objectinfo($id-type) == "line"} { + set objectinfo($id-x) [lindex $coords 0] + set objectinfo($id-y) [lindex $coords 1] + } + } +} + + +proc canvas_clicked {command coords} { + global maincanvas objectinfo default_stateradius needs_save + set X [lindex $coords 0] + set Y [lindex $coords 1] + if {$command == "newstate"} { + create_state $X $Y $default_stateradius + hide_control_points + set needs_save 1 + } elseif {$command == "newline"} { + create_line $X $Y + set needs_save 1 + } elseif {$command == "newcp"} { + set id [$maincanvas find closest $X $Y] + if {$id == "" || $objectinfo($id-type) != "line"} { return } + if {[llength $objectinfo($id-cplist)] < 4} { + add_control_point $id $X $Y + update_object $id + set needs_save 1 + } + } elseif {$command == "newtext"} { + create_text $X $Y + set needs_save 1 + } elseif {$command == "select"} { + global dragobject selectedlist + set id [closest_item "$X $Y"] + + if {$id == -1 || [lsearch $selectedlist $id] == -1} { + foreach sid $selectedlist { remove_select $sid } + } + + if {$id == -1} { + hide_control_points + set dragobject -1 + global dragstart dragend dragrectangleid + set dragstart "$X $Y" + set dragend $dragstart + set dragrectangleid [$maincanvas create rectangle $X $Y $X $Y] + return + } + + if {$objectinfo($id-type) == "state"} { + hide_control_points + } elseif {$objectinfo($id-type) == "line"} { + # here, the line is assigned coordinates to compute + # relative movement when dragged + set objectinfo($id-x) $X + set objectinfo($id-y) $Y + } elseif {$objectinfo($id-type) == "controlpoint"} { + set lid $objectinfo($id-line) + remove_select $lid + foreach cp $objectinfo($lid-cplist) { + remove_select $cp + } + } + + set dragobject $id + add_select $id + } elseif {$command == "remove"} { + set id [closest_item "$X $Y"] + if {$id != -1} { + remove_object $id + set needs_save 1 + } + } +} + +proc center_window {win} { + set x [expr {[winfo rootx .] + [winfo reqwidth .]/2 \ + - [winfo reqwidth $win]/2}] + set y [expr {[winfo rooty .] + [winfo reqheight .]/2 \ + - [winfo reqheight $win]/2}] + wm geometry $win "+$x+$y" +} + +proc set_geometry {win} { + wm withdraw $win + update idletasks + center_window $win + wm deiconify $win + wm minsize $win [winfo reqwidth $win] [winfo reqheight $win] +} + +proc transient_window {win title} { + if {[winfo exists $win]} { + center_window $win + return -1 + } + toplevel $win + wm title $win $title + wm transient $win . + return $win +} + +proc double_click {coords} { + global objectinfo + set id [closest_item $coords] + if {$id == -1} { return } + + if {$objectinfo($id-type) == "text"} { + edit_text $id + } elseif {$objectinfo($id-type) == "line"} { + edit_line $id + } elseif {$objectinfo($id-type) == "state"} { + edit_state $id + } +} + + +proc edit_state {id} { + set w [transient_window .editstate "Edit state"] + if {$w == -1} { return } + + wm protocol $w WM_DELETE_WINDOW { set statebutton 0 } + + global objectinfo + set f1 [frame $w.f1] + label $f1.lab1 -text "Label:" + entry $f1.ent1 + $f1.ent1 insert 0 $objectinfo($id-label) + bind $f1.ent1 <Return> { set statebutton 1 } + + label $f1.lab2 -text "TeX:" + entry $f1.ent2 + $f1.ent2 insert 0 $objectinfo($id-tex) + bind $f1.ent2 <Return> { set statebutton 1 } + + label $f1.lab3 -text \ + "Tip for TeX: Include a \\strut to\nmake the circle bigger" + + grid $f1.lab1 $f1.ent1 -padx 5 -pady 5 + grid $f1.lab2 $f1.ent2 -padx 5 -pady 5 + grid $f1.lab3 - + grid configure $f1.lab1 -sticky w + grid configure $f1.lab2 -sticky w + grid configure $f1.ent1 -sticky e + grid configure $f1.ent2 -sticky nesw + grid columnconfigure $f1 1 -weight 1 + pack $f1 -expand yes -fill both + + set f2 [frame $w.f2] + label $f2.lab1 -text "X:" + entry $f2.ent1 -width 6 + $f2.ent1 insert 0 $objectinfo($id-x) + bind $f2.ent1 <Return> { set statebutton 1 } + + label $f2.lab2 -text "Y:" + entry $f2.ent2 -width 6 + $f2.ent2 insert 0 $objectinfo($id-y) + bind $f2.ent2 <Return> { set statebutton 1 } + + grid $f2.lab1 $f2.ent1 -padx 5 -pady 5 + grid $f2.lab2 $f2.ent2 -padx 5 -pady 5 + grid configure $f2.lab1 -sticky w + grid configure $f2.lab2 -sticky w + grid configure $f2.ent1 -sticky e + grid configure $f2.ent2 -sticky e + grid columnconfigure $f2 1 -weight 1 + pack $f2 -expand yes -fill both + + global acceptcheck startcheck + + set f3 [frame $w.f3] + label $f3.lab -text "Accepting state:" + pack $f3.lab -side left -padx 5 -pady 5 + pack [checkbutton $f3.acceptcheck] -side left -expand yes -anchor e + set acceptcheck $objectinfo($id-accept) + pack $f3 -expand yes -fill both + + set f4 [frame $w.f4] + label $f4.lab -text "Starting state:" + pack $f4.lab -side left -padx 5 -pady 5 + pack [checkbutton $f4.startcheck] -side left -expand yes -anchor e + set startcheck $objectinfo($id-start) + pack $f4 -expand yes -fill both + + + global statebutton needs_save + set statebutton "" + set f5 [frame $w.f5] + button $f5.ok -text " OK " -command { set statebutton 1 } + pack $f5.ok -side left -padx 5 -pady 5 + button $f5.cancel -text " Cancel " -command { set statebutton 0 } + pack $f5.cancel -side left -padx 5 -pady 5 + pack $f5 -padx 5 -pady 5 + + set_geometry $w + focus $f1.ent1 + tkwait variable statebutton + if {$statebutton == 1} { + set objectinfo($id-label) [$f1.ent1 get] + set objectinfo($id-tex) [$f1.ent2 get] + set x [$f2.ent1 get] + set y [$f2.ent2 get] + if {[is_numeric $x] && $x >= 0} { set objectinfo($id-x) $x } + if {[is_numeric $y] && $y >= 0} { set objectinfo($id-y) $y } + set objectinfo($id-accept) $acceptcheck + set objectinfo($id-start) $startcheck + set needs_save 1 + update_object $id + } + destroy $w +} + +proc edit_text {id} { + set w [transient_window .edittext "Edit text"] + if {$w == -1} { return } + + wm protocol $w WM_DELETE_WINDOW { set textbutton 0 } + + global objectinfo + set f1 [frame $w.f1] + label $f1.lab -text "Label:" + pack $f1.lab -side left -padx 5 -pady 5 + entry $f1.ent + pack $f1.ent -side left -padx 5 -pady 5 -expand yes -fill x + $f1.ent insert 0 $objectinfo($id-label) + pack $f1 -padx 5 -pady 5 -fill both -expand yes -anchor e + bind $f1.ent <Return> { set textbutton 1 } + + set f2 [frame $w.f2] + label $f2.lab -text "TeX:" + pack $f2.lab -side left -padx 5 -pady 5 + entry $f2.ent + pack $f2.ent -side left -padx 5 -pady 5 -expand yes -fill x + $f2.ent insert 0 $objectinfo($id-tex) + pack $f2 -padx 5 -pady 5 -fill both -expand yes -anchor e + bind $f2.ent <Return> { set textbutton 1 } + + global textbutton needs_save + set textbutton "" + set f3 [frame $w.f3] + button $f3.ok -text " OK " -command { set textbutton 1 } + pack $f3.ok -side left -padx 5 -pady 5 + button $f3.cancel -text " Cancel " -command { set textbutton 0 } + pack $f3.cancel -side left -padx 5 -pady 5 + pack $f3 -padx 5 -pady 5 + + set_geometry $w + focus $f1.ent + tkwait variable textbutton + if {$textbutton == 1} { + set objectinfo($id-label) [$f1.ent get] + set objectinfo($id-tex) [$f2.ent get] + set needs_save 1 + update_object $id + } + destroy $w +} + +proc edit_line {id} { + set w [transient_window .editline "Edit line"] + if {$w == -1} { return } + + wm protocol $w WM_DELETE_WINDOW { set linebutton 0 } + + global objectinfo + set f1 [frame $w.f1] + label $f1.lab -text "Label (TeX):" + pack $f1.lab -side left -padx 5 -pady 5 + entry $f1.ent + pack $f1.ent -side left -padx 5 -pady 5 -expand yes -fill x + $f1.ent insert 0 $objectinfo($id-tex) + pack $f1 -fill both -expand yes + bind $f1.ent <Return> { set linebutton 1 } + + set f2 [frame $w.f2] + label $f2.lab -text "How far along (percent):" + pack $f2.lab -side left -padx 5 -pady 5 + scale $f2.pos -from 0 -to 100 -orient horizontal + pack $f2.pos -side left -padx 5 -pady 5 -expand yes -fill x + pack $f2 -fill both -expand yes + $f2.pos set [expr {$objectinfo($id-texpos) * 100}] + + set f3 [frame $w.f3] + label $f3.lab -text "Label position:" + pack $f3.lab -side left -padx 5 -pady 5 + set mb [menubutton $f3.mbutton -menu $f3.mbutton.menu -relief raised] + pack $mb -side left -padx 5 -pady 5 + + global anchorpos + set anchorpos $objectinfo($id-anchor) + set m [menu $f3.mbutton.menu -tearoff 0] + foreach {l p} {Top top Right rt Bottom bot Left lft "Upper right" urt \ + "Lower right" lrt "Lower left" llft "Upper left" ulft} { + if {$anchorpos == $p} { $mb configure -text $l } + $m add command -label $l -command \ + "set anchorpos $p; $mb configure -text [list $l]" + } + pack $f3 -fill both -expand yes + + global bisectcheck + set f4 [frame $w.f4] + label $f4.lab -text "Interpolate control points:" + pack $f4.lab -side left -padx 5 -pady 5 + pack [checkbutton $f4.bisectcheck] -side left -expand yes -anchor e + set bisectcheck $objectinfo($id-bisect) + pack $f4 -expand yes -fill both + + global linebutton + set linebutton "" + set f5 [frame $w.f5] + button $f5.ok -text " OK " -command { set linebutton 1 } + pack $f5.ok -side left -padx 5 -pady 5 + button $f5.cancel -text " Cancel " -command { set linebutton 0 } + pack $f5.cancel -side left -padx 5 -pady 5 + pack $f5 -padx 5 -pady 5 + + set_geometry $w + focus $f1.ent + tkwait variable linebutton + if {$linebutton == 1} { + set objectinfo($id-tex) [$f1.ent get] + set objectinfo($id-texpos) [expr {[$f2.pos get] / 100.0}] + set objectinfo($id-anchor) $anchorpos + set objectinfo($id-bisect) $bisectcheck + global needs_save + set needs_save 1 + } + destroy $w +} + +proc settings {} { + global metapost_scale filecomment ahangle ahlength fileauthor + global verbatimtex graphstyle + set w [transient_window .settings "Settings for this file"] + if {$w == -1} { return } + + wm protocol $w WM_DELETE_WINDOW { set settingsbutton 0 } + + set f1 [frame $w.f1] + label $f1.lab -text "MetaPost scale factor:" + pack $f1.lab -side left -padx 5 -pady 5 + entry $f1.ent -width 3 + $f1.ent insert 0 $metapost_scale + pack $f1.ent -side left -padx 5 -pady 5 -expand yes -anchor e + pack $f1 -fill x + + set f2 [frame $w.f2] + label $f2.lab -text "Arrowhead breadth:" + pack $f2.lab -side left -padx 5 -pady 5 + entry $f2.ent -width 3 + pack $f2.ent -side left -padx 5 -pady 5 -expand yes -anchor e + $f2.ent insert 0 $ahangle + pack $f2 -fill x + + set f3 [frame $w.f3] + label $f3.lab -text "Arrowhead length (bp):" + pack $f3.lab -side left -padx 5 -pady 5 + entry $f3.ent -width 3 + pack $f3.ent -side left -padx 5 -pady 5 -expand yes -anchor e + $f3.ent insert 0 $ahlength + pack $f3 -fill x + + set f4 [frame $w.f4] + label $f4.lab -text "Export style:" + pack $f4.lab -side left -padx 5 -pady 5 + set mb [menubutton $f4.mbutton -menu $f4.mbutton.menu \ + -text $graphstyle -relief raised] + pack $mb -side left -padx 5 -pady 5 + + set m [menu $f4.mbutton.menu -tearoff 0] + foreach gs {automaton digraph} { + $m add command -label $gs -command "$mb configure -text $gs" + } + pack $f4 -fill x + + set tp [frame $w.textparent] + + label $tp.authorlab -text "Author:" + entry $tp.authorent -width 20 + $tp.authorent insert 0 $fileauthor + + label $tp.commentlab -text "File comment:" + text $tp.commentent -width 40 -height 5 + $tp.commentent insert end $filecomment + + label $tp.verbatimlab -text "TeX macros:" + text $tp.verbatiment -width 40 -height 7 + $tp.verbatiment insert end $verbatimtex + + grid $tp.authorlab $tp.authorent -padx 5 -pady 5 + grid $tp.commentlab $tp.commentent -padx 5 -pady 5 + grid $tp.verbatimlab $tp.verbatiment -padx 5 -pady 5 + grid configure $tp.authorent -sticky w + grid configure $tp.commentent -sticky nesw + grid configure $tp.verbatiment -sticky nesw + grid columnconfigure $tp 1 -weight 1 + grid rowconfigure $tp 1 -weight 1 + grid rowconfigure $tp 2 -weight 1 + pack $tp -expand yes -fill both + + global settingsbutton needs_save + set settingsbutton "" + + set f5 [frame $w.f5] + button $f5.ok -text " OK " -command { set settingsbutton 1 } + pack $f5.ok -side left -padx 5 -pady 5 + button $f5.cancel -text " Cancel " -command { set settingsbutton 0 } + pack $f5.cancel -side left -padx 5 -pady 5 + pack $f5 -padx 5 -pady 5 + + set_geometry $w + focus $f1.ent + + tkwait variable settingsbutton + if {$settingsbutton == 1} { + set needs_save 1 + set metapost_scale [$f1.ent get] + set ahangle [$f2.ent get] + set ahlength [$f3.ent get] + set graphstyle [$f4.mbutton cget -text] + set fileauthor [$tp.authorent get] + set filecomment [string trim [$tp.commentent get 1.0 end]] + set verbatimtex [string trim [$tp.verbatiment get 1.0 end]] + check_parameters + } + destroy $w +} + +proc about {} { + global PROGRAM VERSION + set aboutwin [transient_window .aboutwin "About $PROGRAM"] + if {$aboutwin == ""} { return } + label $aboutwin.copyright -text \ + "$PROGRAM $VERSION - Draw Finite State Machines\n\n\ + $PROGRAM comes with ABSOLUTELY NO WARRANTY. This is\n\ + free software, and you are welcome to distribute it\n\ + under certain conditions. Read the file COPYING for\n\ + more information.\n\n\ + Copyright (C) 2003, 2006, 2007 Markus Triska triska@gmx.at" + button $aboutwin.ok -text "OK" -command { destroy .aboutwin } + pack $aboutwin.copyright -pady 10 -padx 20 + pack $aboutwin.ok -pady 4 + set_geometry $aboutwin + focus $aboutwin.ok +} + + +# The rest is about loading, saving and exporting. + + +proc mpost_scale {coord} { + global metapost_scale + set newcoord [expr {$metapost_scale * $coord}] + return $newcoord +} + +proc mpost_coords {id} { + global objectinfo + if {$objectinfo($id-type) == "controlpoint"} { + set attid $objectinfo($id-attached) + if {$attid != -1} { + return "(s$attid.c)" + } + } + + # MetaPost y coordinate is reversed (from our standpoint) + set y [expr {- $objectinfo($id-y)}] + return "([mpost_scale $objectinfo($id-x)], [mpost_scale $y])" +} + +proc mpost_line {id} { + # approximate the given line in MetaPost syntax + global objectinfo + set firstid [lindex $objectinfo($id-cplist) 0] + set lastid [lindex $objectinfo($id-cplist) end] + set numcp [llength $objectinfo($id-cplist)] + set coord1 [mpost_coords $firstid] + set coord2 [mpost_coords [lindex $objectinfo($id-cplist) 1]] + + set coords "" + set loop 0 + if {$numcp == 2} { + set coords "$coord1--$coord2" + } elseif {$numcp == 3} { + set coord3 [mpost_coords $lastid] + if {$objectinfo($firstid-attached) != -1 && \ + $objectinfo($firstid-attached) == $objectinfo($lastid-attached)} { + # state points to itself, use angles + set loop 1 + set point "s$objectinfo($firstid-attached)" + set startangle $objectinfo($firstid-angle) + set endangle [expr {$objectinfo($lastid-angle) + 180}] + if {[automaton]} { + set coords "directionpoint dir [expr {$startangle + 90}] of bpath $point..controls $coord2 and $coord2..directionpoint dir [expr {$endangle - 90}] of bpath $point" + } else { + set coords "$point.c..controls $coord2 and $coord2..$point.c" + } + } else { + if {$objectinfo($id-bisect)} { + # interpolate the two control points by bisecting the + # lines from the endpoints to the single control point + set coords "$coord1..controls .5\[$coord1,$coord2\] and .5\[$coord2,$coord3\]..$coord3" + } else { + # use the endpoint as second control point + set coords "$coord1..controls $coord2 and $coord3..$coord3" + } + } + } elseif {$numcp == 4} { + if {$objectinfo($firstid-attached) != -1 && \ + $objectinfo($firstid-attached) == $objectinfo($lastid-attached)} { + # state points to itself, use angles + set loop 1 + set coord3 [mpost_coords [lindex $objectinfo($id-cplist) 2]] + set startangle $objectinfo($firstid-angle) + set endangle [expr {$objectinfo($lastid-angle) + 180}] + set point "s$objectinfo($firstid-attached)" + if {[automaton]} { + set coords "directionpoint dir [expr {$startangle + 90}] of bpath $point..controls $coord2 and $coord3..directionpoint dir [expr {$endangle - 90}] of bpath $point" + } else { + set coords "$point.c..controls $coord2 and $coord3..$point.c" + } + } else { + set coord3 [mpost_coords [lindex $objectinfo($id-cplist) 2]] + set coord4 [mpost_coords $lastid] + set coords "$coord1..controls $coord2 and $coord3..$coord4" + } + } + + if {[automaton] && !$loop} { + if {$objectinfo($firstid-attached) != -1} { + set coords "$coords cutbefore bpath s$objectinfo($firstid-attached)" + } + + if {$objectinfo($lastid-attached) != -1} { + set coords "$coords cutafter bpath s$objectinfo($lastid-attached)" + } + } + + return $coords; +} + +proc save_metapost {file} { + global PROGRAM VERSION objectinfo ahangle ahlength filecomment + global fileauthor verbatimtex + + set fid [open $file w] + puts $fid "% Creator: $PROGRAM $VERSION" + puts $fid "% Creation-Date: [clock format [clock seconds]]" + if {$fileauthor != ""} { puts $fid "% Author: $fileauthor" } + regsub -all {\n} $filecomment "\n% " exportcomment + if {$exportcomment != ""} { puts $fid "% Comment: $exportcomment" } + + if {$verbatimtex != ""} { puts $fid "verbatimtex $verbatimtex etex" } + puts $fid "" + puts $fid "input boxes" + puts $fid "% Breadth of arrowheads (MetaPost default is 45)" + puts $fid "ahangle := $ahangle;" + puts $fid "% Length of arrowheads (MetaPost default is 4bp)" + puts $fid "ahlength := $ahlength;" + puts $fid "beginfig(1);" + puts $fid "% for temporary paths (might be unused)" + puts $fid {path p[];} + puts $fid "" + puts $fid "% First, define and draw all the states" + + if {[digraph]} { puts $fid {pair s[].c;} } + + foreach id [lsort -integer [get_objects_type "state"]] { + set lbl "\"$objectinfo($id-label)\"" + if {$objectinfo($id-tex) != ""} { + set lbl "btex $objectinfo($id-tex) etex" + } + + if {[automaton]} { + puts $fid "circleit.s${id}($lbl);" + puts $fid "s$id.c = [mpost_coords $id];" + if {$objectinfo($id-start)} { + puts $fid "pickup pencircle scaled 1.2bp;" + puts $fid "drawboxed(s$id);" + puts $fid "pickup defaultpen;" + } else { + puts $fid "drawboxed(s$id);" + } + if {$objectinfo($id-accept)} { + puts $fid "draw fullcircle scaled 0.85(ypart s$id.n - ypart s$id.s) shifted s$id.c;" + } + } elseif {[digraph]} { + puts $fid "s$id.c = [mpost_coords $id];" + puts $fid "draw s$id.c withpen pencircle scaled 5pt;" + } + puts $fid "" + } + + + puts $fid "\n% Next, draw the lines" + foreach id [lsort -integer [get_objects_type "line"]] { + set coords [mpost_line $id] + if {$objectinfo($id-tex) != ""} { + puts $fid "p$id = $coords;" + if {[automaton]} { + puts $fid "drawarrow p$id;" + } else { + puts $fid "drawarrow subpath (0,0.86) of p$id;" + } + puts $fid "label.$objectinfo($id-anchor)(btex $objectinfo($id-tex) etex, point $objectinfo($id-texpos) of p$id);" + } else { + if {[automaton]} { + puts $fid "drawarrow $coords;" + } else { + set numcp [llength $objectinfo($id-cplist)] + if {$numcp == 2} { + puts $fid "drawarrow subpath (0,0.92) of ($coords);" + } else { + puts $fid "drawarrow subpath (0,0.82) of ($coords);" + } + } + } + puts $fid "" + } + + puts $fid "\n% Finally, create labels" + foreach id [lsort -integer [get_objects_type "text"]] { + set x [mpost_scale $objectinfo($id-x)] + set y [mpost_scale [expr {-$objectinfo($id-y)}]] + set lbl "\"$objectinfo($id-label)\"" + if {$objectinfo($id-tex) != ""} { + set lbl "btex $objectinfo($id-tex) etex" + } + puts $fid "label($lbl, ($x, $y));" + } + + puts $fid "\nendfig;\nend" + close $fid +} + +proc export_metapost {{choose 0}} { + global export_mp_file batchmode currentfile + if {$batchmode} { + if {[regexp "\.fin$" $currentfile]} { + regsub {fin$} $currentfile {mp} export_mp_file + } else { + set export_mp_file "${currentfile}.mp" + } + puts "Exporting to $export_mp_file." + } else { + if {$export_mp_file == "" || $choose} { + set ifile "[file rootname [file tail $currentfile]].mp" + set export_mp_file [tk_getSaveFile -defaultextension ".mp" -initialfile $ifile -filetypes {{MetaPost .mp} {All *}}] + if {$export_mp_file == ""} { return -1 } + global needs_save + set needs_save 1 + } + } + + if {[catch [list save_metapost $export_mp_file]]} { + set msg "Could not write to $export_mp_file." + if {$batchmode} { + puts "Error: $msg" + } else { + tk_messageBox -icon error -message $msg + } + return -1 + } + + return 0 +} + + +proc save_native {file} { + global VERSION PROGRAM + upvar #0 objectinfo oi + + set fid [open $file w] + puts $fid "# Creator: $PROGRAM $VERSION" + puts $fid "# Creation-Date: [clock format [clock seconds]]" + + # internal IDs of states are normalised to 1...n to avoid + # introducing differences by saving an unchanged file + + array set statemap {} + set stateid 0 + + foreach id [lsort -integer [get_objects_type "state"]] { + set lblstring "label [list $oi($id-label)]" + set texstring "tex [list $oi($id-tex)]" + incr stateid + set statemap($id) $stateid + puts $fid "object state id $stateid x $oi($id-x) y $oi($id-y) radius $oi($id-radius) $lblstring $texstring accept $oi($id-accept) start $oi($id-start)" + } + + foreach id [lsort -integer [get_objects_type "line"]] { + puts -nonewline $fid "object line" + set cpnum 0 + foreach cp $oi($id-cplist) { + incr cpnum + if {$oi($cp-attached) == -1} { + puts -nonewline $fid " cp${cpnum}attached -1 cp${cpnum}x $oi($cp-x) cp${cpnum}y $oi($cp-y)" + } else { + puts -nonewline $fid " cp${cpnum}attached $statemap($oi($cp-attached)) cp${cpnum}angle $oi($cp-angle)" + } + } + set texstring "tex [list $oi($id-tex)] texpos $oi($id-texpos) anchor $oi($id-anchor)" + puts $fid " cpnum $cpnum $texstring bisect $oi($id-bisect)" + } + + foreach id [lsort -integer [get_objects_type "text"]] { + set lblstring "label [list $oi($id-label)]" + set texstring "tex [list $oi($id-tex)]" + + puts $fid "object text x $oi($id-x) y $oi($id-y) $lblstring $texstring" + } + + global modifiable_params + foreach mp $modifiable_params { + if {[uplevel #0 "string compare $$mp $${mp}_default"]} { + global $mp + set val [list [subst $$mp]] + puts $fid "object setting variable $mp value $val" + } + } + + close $fid +} + +proc clear_all {} { + global objectinfo maincanvas selectedlist needs_save batchmode + if {!$batchmode} { $maincanvas delete all } + array unset objectinfo + set selectedlist "" + set needs_save 0 + reset_all_parameters +} + +proc save_file {{choose 0}} { + global currentfile needs_save + set oldcurrentfile $currentfile + if {$currentfile == "" || $choose} { + set currentfile [tk_getSaveFile -defaultextension ".fin" -filetypes {{Finomaton .fin} {All *}}] + if {$currentfile == ""} { return -1 } + } + + if {[catch [list save_native $currentfile]]} { + tk_messageBox -icon error -message "Could not write to $currentfile." + set currentfile $oldcurrentfile + return -1 + } + + set needs_save 0 + set_window_title + return 0 +} + + +proc load_native {file} { + global objectinfo modifiable_params + + array set statemap {} + set fid [open $file r] + set wholeobject "" + while {![eof $fid]} { + gets $fid oneline + if {[eof $fid]} { break } + if {$wholeobject == "" && [regexp {^#} $oneline]} { continue } + append wholeobject $oneline + if {![info complete $wholeobject]} { + append wholeobject "\n" + continue + } + + eval "array set object {$wholeobject}" + set wholeobject "" + + if {$object(object) == "setting"} { + set var $object(variable) + if {[lsearch $modifiable_params $var] == -1} { + continue + } + uplevel #0 [list set $var $object(value)] + array unset object + continue + } + + set id -1 + if {$object(object) == "state"} { + set id [create_state $object(x) $object(y) $object(radius)] + set statemap($object(id)) $id + set objectinfo($id-label) $object(label) + set objectinfo($id-tex) $object(tex) + set objectinfo($id-accept) $object(accept) + set objectinfo($id-start) $object(start) + } elseif {$object(object) == "line"} { + set id [create_line 0 0 0] + set objectinfo($id-tex) $object(tex) + set objectinfo($id-texpos) $object(texpos) + set objectinfo($id-anchor) $object(anchor) + set objectinfo($id-bisect) \ + [expr [info exists object(bisect)] ? {$object(bisect)} : 0] + + for {set i 1} {$i <= $object(cpnum)} {incr i} { + set cp [add_control_point $id 0 0 0] + if {$object(cp${i}attached) != -1} { + set attachedto $statemap($object(cp${i}attached)) + set objectinfo($cp-attached) $attachedto + set objectinfo($cp-angle) $object(cp${i}angle) + set coords [anchor_coords $attachedto $objectinfo($cp-angle)] + set objectinfo($cp-x) [lindex $coords 0] + set objectinfo($cp-y) [lindex $coords 1] + } else { + set objectinfo($cp-x) $object(cp${i}x) + set objectinfo($cp-y) $object(cp${i}y) + } + # don't use update_object, since the line might not be complete + update_oval $cp + } + } elseif {$object(object) == "text"} { + set id [create_text $object(x) $object(y)] + set objectinfo($id-label) $object(label) + set objectinfo($id-tex) $object(tex) + } + update_object $id + array unset object + } + + if {$wholeobject != ""} { error "premature end of file" } + close $fid + check_parameters +} + +proc ask_save {title} { + set response [tk_messageBox -icon question -type yesnocancel -title $title -message "File modified. Save changes?"] + return $response +} + +proc needs_save {} { + global needs_save + return $needs_save +} + +proc exit_yesno {} { + global PROGRAM + if {[needs_save]} { + set response [ask_save "Exit"] + if {$response == "cancel"} { + return + } elseif {$response == "yes"} { + if {[save_file] == -1} { + return + } + } + exit + } else { + set response [tk_messageBox -icon question -type yesno -title "Exit" -message "Really exit $PROGRAM?"] + if {$response} { exit } + } +} + +proc set_window_title {} { + global windowtitle currentfile + if {$currentfile == ""} { + wm title . $windowtitle + } else { + wm title . "$windowtitle - $currentfile" + } +} + +proc new_file {} { + if {[needs_save]} { + set response [ask_save "New"] + if {$response == "yes"} { + if {[save_file] == -1} { + return + } + } elseif {$response == "cancel"} { + return + } + } + global currentfile + set currentfile "" + set_window_title + clear_all +} + +proc load_file {file} { + global PROGRAM batchmode + if {![file exists $file] || ![file readable $file]} { + set msg "File $file does not exist or is not readable." + if {$batchmode} { + puts "Error: $msg" + } else { + tk_messageBox -icon error -message $msg + } + return -1 + } + + clear_all + if {[catch [list load_native $file]]} { + set msg "File $file contains no or corrupted graph, or your version of $PROGRAM is outdated." + if {$batchmode} { + puts "Error: $msg" + } else { + tk_messageBox -icon error -message $msg + } + clear_all + return -1 + } else { + global currentfile + set currentfile $file + + if {!$batchmode} { + set_window_title + hide_control_points + } + } + return 0 +} + +proc open_file {} { + if {[needs_save]} { + set response [ask_save "Open"] + if {$response == "cancel"} { + return + } elseif {$response == "yes"} { + if {[save_file] == -1} { + return + } + } + } + set file [tk_getOpenFile -defaultextension ".fin" -filetypes {{Finomaton .fin} {All *}}] + if {$file == ""} { return } + load_file $file +} + +# Execution entry point. Batch-process or set up the main window. + + +if {[llength $argv] > 0 && [lindex $argv 0] == "-exportmp"} { + set filelist [lreplace $argv 0 0] + if {[llength $filelist] > 0} { + set batchmode 1 + foreach file $filelist { + set unid 0 + if {[load_file $file] != -1} { + puts "Processing $file..." + export_metapost + } + } + exit + } +} + +frame .themenu +menubutton .themenu.file -text "File" -menu .themenu.file.m +set m [menu .themenu.file.m] +$m add command -label "New" -command new_file +$m add command -label "Open... (C-o)" -command open_file +$m add command -label "Save (C-s)" -command save_file +$m add command -label "Save as..." -command "save_file 1" +$m add command -label "Settings..." -command settings +$m add command -label "Export MetaPost... (C-m)" -command "export_metapost 1" + +$m add separator +$m add command -label Exit -command exit_yesno + +menubutton .themenu.help -text "Help" -menu .themenu.help.m +set m [menu .themenu.help.m] +$m add command -label "About..." -command about +pack .themenu.file -side left -padx 5 -pady 5 +pack .themenu.help -side right -padx 5 -pady 5 +pack .themenu -fill x + + +set commandsframe [frame .commands] +# these variable names must equal the respective button's name +set command_select \ + [button $commandsframe.command_select -text "Select" -underline 1] +set command_newstate \ + [button $commandsframe.command_newstate -text "New state" -underline 4] +set command_newline \ + [button $commandsframe.command_newline -text "New line" -underline 4] +set command_newtext \ + [button $commandsframe.command_newtext -text "New text" -underline 4] +set command_newcp \ + [button $commandsframe.command_newcp -text "Control point" -underline 0] +set command_remove \ + [button $commandsframe.command_remove -text "Remove" -underline 0] +set command_balancex \ + [button $commandsframe.command_balancex -text "| x" -underline 4] +set command_balancey \ + [button $commandsframe.command_balancey -text "-- y" -underline 4] + +foreach b {select newstate newline newtext newcp remove balancex balancey} { + set path [subst "\$command_$b"] + pack $path -side top -fill both -expand yes -padx 5 -pady 5 + bind $path <ButtonPress-1> "set_command $b ; break" +} + +set coordslabel [label $commandsframe.corodslabel] +pack $coordslabel -side bottom -expand yes -padx 5 -pady 5 + +proc balance {which} { + global selectedlist objectinfo + + set first [lindex $selectedlist 0] + foreach id $selectedlist { + set objectinfo($id-$which) $objectinfo($first-$which) + update_object $id + } +} + +bind $commandsframe.command_balancex <ButtonPress-1> "balance x" +bind $commandsframe.command_balancey <ButtonPress-1> "balance y" + +set canvasframe [frame .canvasframe] +set border [frame $canvasframe.border -relief ridge -borderwidth 5] +set maincanvas [canvas $border.maincanvas -width 320 -height 300 \ + -xscrollcommand "$canvasframe.xbar set" \ + -yscrollcommand "$canvasframe.ybar set" -scrollregion "0 0 800 640"] +pack $maincanvas -expand yes -fill both + +set xbar [scrollbar $canvasframe.xbar -orient horizontal \ + -command "$maincanvas xview"] +set ybar [scrollbar $canvasframe.ybar -orient vertical \ + -command "$maincanvas yview"] +grid $border $ybar +grid $xbar x +grid configure $border -sticky nesw +grid configure $xbar -sticky ew +grid configure $ybar -sticky ns +grid columnconfigure $canvasframe 0 -weight 1 +grid rowconfigure $canvasframe 0 -weight 1 + +pack $commandsframe -side left -padx 5 -pady 5 +pack $canvasframe -side left -padx 5 -pady 5 -expand yes -fill both + +proc canvascoords {x y} { + global maincanvas + return "[$maincanvas canvasx $x] [$maincanvas canvasy $y]" +} + +proc spread {which} { + global selectedlist objectinfo + + if {[llength $selectedlist] <= 1} { return } + set min "" + set max "" + set objs {} + foreach id $selectedlist { + set obj $objectinfo($id-$which) + lappend objs [list $obj $id] + if {$min == "" || $obj < $min} { set min $obj } + if {$max == "" || $obj > $max} { set max $obj } + } + + set range [expr {$max - $min}] + if {$range == 0} { return } + + set increment [expr double($range) / ([llength $selectedlist] - 1)] + + set curr $min + foreach e [lsort -real -index 0 $objs] { + set id [lindex $e 1] + set objectinfo($id-$which) $curr + update_object $id + set curr [expr {$curr + $increment}] + } +} + +bind $maincanvas <h> "spread x" +bind $maincanvas <v> "spread y" + +bind $maincanvas <x> "balance x" +bind $maincanvas <y> "balance y" + +bind $maincanvas <l> "set_command newline" +bind $maincanvas <c> "set_command newcp" +bind $maincanvas <r> "set_command remove" +bind $maincanvas <s> "set_command newstate" +bind $maincanvas <t> "set_command newtext" +bind $maincanvas <e> "set_command select" + +bind $maincanvas <ButtonPress-1> { + canvas_clicked $currentcommand [canvascoords %x %y] +} + +bind $maincanvas <Motion> { + $coordslabel configure -text [canvascoords %x %y] +} + +bind $maincanvas <B1-Motion> { + set coords [canvascoords %x %y] + $coordslabel configure -text $coords + if {$dragobject == -1} { + set dragend $coords + eval $maincanvas coords $dragrectangleid $dragstart $dragend + } else { + if {$currentcommand == "select"} { + set needs_save 1 + move_objects [canvascoords %x %y] + } + } +} + +bind $maincanvas <ButtonRelease-1> { + if {$dragobject == -1 && $currentcommand == "select"} { + if {$dragrectangleid != -1} { + $maincanvas delete $dragrectangleid + } + set dragrectangleid -1 + set x [lsort -real "[lindex $dragstart 0] [lindex $dragend 0]"] + set y [lsort -real "[lindex $dragstart 1] [lindex $dragend 1]"] + set items [$maincanvas find enclosed [lindex $x 0] \ + [lindex $y 0] [lindex $x 1] [lindex $y 1]] + foreach i $items { + if {$objectinfo($i-type) == "statelabel" || \ + $objectinfo($i-type) == "acceptcircle"} { + continue + } + add_select $i + } + } +} + + +bind $maincanvas <Control-B1-Motion> { + set needs_save 1 + set coords [canvascoords %x %y] + $coordslabel configure -text $coords + if {$currentcommand == "select"} { move_objects $coords } +} + +bind $maincanvas <Control-ButtonRelease-1> { + if {$dragrectangleid != -1} { + $maincanvas delete $dragrectangleid + set dragrectangleid -1 + } +} + +bind $maincanvas <Control-ButtonPress-1> { toggle_select [canvascoords %x %y] } +bind $maincanvas <Double-Button-1> { double_click [canvascoords %x %y] } +bind $maincanvas <Control-o> { open_file; break } +bind $maincanvas <Control-s> { save_file; break } +bind $maincanvas <Control-m> { export_metapost; break } +bind $maincanvas <Alt-x> { exit_yesno; break } +bind $maincanvas <Delete> { + while {[llength $selectedlist] > 0} { + remove_object [lindex $selectedlist 0] + } +} + +proc move_all_delta {dx dy} { + # this differs from move_objects in that magnetic states are ignored + global selectedlist objectinfo needs_save + set needs_save 1 + foreach id $selectedlist { + if {$objectinfo($id-type) == "controlpoint"} { + set objectinfo($id-attached) -1 + } + move_delta $id $dx $dy + } +} + +bind $maincanvas <Up> { move_all_delta 0 -1 } +bind $maincanvas <Right> { move_all_delta 1 0 } +bind $maincanvas <Down> { move_all_delta 0 1 } +bind $maincanvas <Left> { move_all_delta -1 0 } + +wm title . $windowtitle +wm protocol . WM_DELETE_WINDOW { exit_yesno } + +set win . +wm withdraw $win +update idletasks +set x [expr {[winfo screenwidth $win]/2 - [winfo reqwidth $win]/2}] +set y [expr {[winfo screenheight $win]/2 - [winfo reqheight $win]/2}] +wm geometry $win "+$x+$y" +wm deiconify $win +wm minsize $win [winfo reqwidth $win] [winfo reqheight $win] + +set_command select + +if {$argc > 0} { load_file [lindex $argv 0] } + +focus $maincanvas |