summaryrefslogtreecommitdiff
path: root/graphics/finomaton
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /graphics/finomaton
Initial commit
Diffstat (limited to 'graphics/finomaton')
-rw-r--r--graphics/finomaton/COPYING339
-rw-r--r--graphics/finomaton/ChangeLog25
-rw-r--r--graphics/finomaton/README143
-rw-r--r--graphics/finomaton/TODO14
-rw-r--r--graphics/finomaton/examples/finomaton.pdfbin0 -> 48903 bytes
-rw-r--r--graphics/finomaton/examples/finomaton.tex49
-rw-r--r--graphics/finomaton/examples/graph1.fin5
-rw-r--r--graphics/finomaton/examples/graph2.fin5
-rw-r--r--graphics/finomaton/examples/graph3.fin31
-rw-r--r--graphics/finomaton/examples/graph4.fin8
-rw-r--r--graphics/finomaton/examples/graph5.fin12
-rw-r--r--graphics/finomaton/examples/graph6.fin16
-rw-r--r--graphics/finomaton/examples/graph7.fin10
-rw-r--r--graphics/finomaton/examples/graph8.fin25
-rw-r--r--graphics/finomaton/examples/graph9.fin10
-rw-r--r--graphics/finomaton/finomaton.tcl1735
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
new file mode 100644
index 0000000000..0b8a8bfbdf
--- /dev/null
+++ b/graphics/finomaton/examples/finomaton.pdf
Binary files differ
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