TkEmpire-1.0/ 40755 12005 144 0 6041012770 11700 5ustar hellerusersTkEmpire-1.0/COPYING100644 12005 144 43070 6040762206 13061 0ustar hellerusers GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, 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 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. Copyright (C) 19yy 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., 675 Mass Ave, Cambridge, MA 02139, 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. , 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. TkEmpire-1.0/README100644 12005 144 2127 6041011275 12656 0ustar hellerusersThis is an frontend (client) for BSD Empire version 1.1 patch level 5 It requires TclX 7.3a, Tk 3.6, and addinput patch for Tk 3.6. Installing the package. Move the Tcl/Tk script file (TkEmpire) to /usr/local/lib (or someplace else if you prefer -- in which case edit the shell file (TkEmpire.sh) to include this directory in the XF_LOAD_PATH list). Then edit TkEmpire.sh to reflect the location of wishx and move it to a bin directory (i.e. /usr/local/bin). To run: The stript uses EMPIREHOST and EMPIREPORT environment variables to find the server. It also uses the USER environment variable to find your username. The stript takes two optional arguments: the name of the country and the representative name. If these are omitted, it will use a popup dialog box to get these names. The main GUI has a prompt area with an entry for entering commands and a text area for output. There are also a batch of pulldown menus with obvious meanings. Have Fun! Robert Heller D/B/A Deepwoods SOftware 51 Locke Hill Road Wendell, MA 01379 InterNet: heller@cs.umass.edu FidoNet: Robert Heller at 1:321/153 TkEmpire-1.0/TkEmpire100744 12005 144 475676 6041007651 13534 0ustar hellerusers#!/usr/bin/X11/wishx -f # Program: TkEmpire # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # TkEmpire -- A Tcl/Tk Front End for BSD Empire version 1.1 patch level 5 # Copyright (C) 1995 Robert Heller D/B/A Deepwoods Software # 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., 675 Mass Ave, Cambridge, MA 02139, USA. # # Robert Heller # 51 Locke Hill Road # Wendell, MA 01379 # InterNet E-Mail: heller@cs.umass.edu # FidoNet NetMail: Robert Heller at 1:321/153 # # module inclusion global env global xfLoadPath if {[info exists env(XF_LOAD_PATH)]} { if {[string first $env(XF_LOAD_PATH) /usr/local/lib/] == -1} { set xfLoadPath $env(XF_LOAD_PATH):/usr/local/lib/ } { set xfLoadPath /usr/local/lib/ } } { set xfLoadPath /usr/local/lib/ } global argc global argv global tkVersion global xfLoadInfo global xfLoadPath set xfLoadInfo 0 set tmpArgv "" for {set counter 0} {$counter < $argc} {incr counter 1} { case [string tolower [lindex $argv $counter]] in { {-xfloadpath} { incr counter 1 set xfLoadPath "[lindex $argv $counter]:$xfLoadPath" } {-xfstartup} { incr counter 1 source [lindex $argv $counter] } {-xfbindfile} { incr counter 1 set env(XF_BIND_FILE) "[lindex $argv $counter]" } {-xfcolorfile} { incr counter 1 set env(XF_COLOR_FILE) "[lindex $argv $counter]" } {-xfcursorfile} { incr counter 1 set env(XF_CURSOR_FILE) "[lindex $argv $counter]" } {-xffontfile} { incr counter 1 set env(XF_FONT_FILE) "[lindex $argv $counter]" } {-xfmodelmono} { if {$tkVersion >= 3.0} { tk colormodel . monochrome } } {-xfmodelcolor} { if {$tkVersion >= 3.0} { tk colormodel . color } } {-xfloading} { set xfLoadInfo 1 } {-xfnoloading} { set xfLoadInfo 0 } {default} { lappend tmpArgv [lindex $argv $counter] } } } set argv $tmpArgv set argc [llength $tmpArgv] unset counter unset tmpArgv # procedure to show window . proc ShowWindow. {args} {# xf ignore me 7 # Window manager configurations global tkVersion wm positionfrom . program wm sizefrom . program wm maxsize . 1000 768 wm minsize . 10 10 wm title . {TkEMpire} # build widget .frame frame .frame \ -relief {raised} # build widget .frame.scrollbar1 scrollbar .frame.scrollbar1 \ -command {.frame.text2 yview}\ -relief {raised} # build widget .frame.text2 text .frame.text2 \ -borderwidth {2}\ -relief {raised}\ -wrap {none}\ -yscrollcommand {.frame.scrollbar1 set} # bindings bind .frame.text2 {NoFunction} # pack widget .frame pack append .frame \ .frame.scrollbar1 {right frame center filly} \ .frame.text2 {top frame center expand fill} # build widget .frame0 frame .frame0 \ -borderwidth {2}\ -relief {raised} # build widget .frame0.menubutton0 menubutton .frame0.menubutton0 \ -menu {.frame0.menubutton0.m}\ -text {Maps} # build widget .frame0.menubutton0.m menu .frame0.menubutton0.m .frame0.menubutton0.m add command\ -command {DoMap "#0"}\ -label {Realm 0} .frame0.menubutton0.m add command\ -command {DoMap "#1"}\ -label {Realm 1} .frame0.menubutton0.m add command\ -command {DoMap "#2"}\ -label {Realm 2} .frame0.menubutton0.m add command\ -command {DoMap "#3"}\ -label {Realm 3} .frame0.menubutton0.m add command\ -command {DoMap "#4"}\ -label {Realm 4} .frame0.menubutton0.m add command\ -command {DoMap "#5"}\ -label {Realm 5} .frame0.menubutton0.m add command\ -command {DoMap "#6"}\ -label {Realm 6} .frame0.menubutton0.m add command\ -command {DoMap "#7"}\ -label {Realm 7} .frame0.menubutton0.m add command\ -command {DoMap "#8"}\ -label {Realm 8} .frame0.menubutton0.m add command\ -command {DoMap "#9"}\ -label {Realm 9} .frame0.menubutton0.m add command\ -command {DoMap "#10"}\ -label {Realm 10} .frame0.menubutton0.m add command\ -command {DoMap "#11"}\ -label {Realm 11} .frame0.menubutton0.m add command\ -command {DoMap "#12"}\ -label {Realm 13} .frame0.menubutton0.m add command\ -command {DoMap "#14"}\ -label {Realm 14} .frame0.menubutton0.m add command\ -command {DoMap "#15"}\ -label {Realm 16} .frame0.menubutton0.m add command\ -command {DoMapSectors}\ -label {Sectors} # build widget .frame0.menubutton1 menubutton .frame0.menubutton1 \ -menu {.frame0.menubutton1.m}\ -text {File}\ -underline {0} # build widget .frame0.menubutton1.m menu .frame0.menubutton1.m .frame0.menubutton1.m add command\ -command {ExecuteScript}\ -label {Execute script} .frame0.menubutton1.m add command\ -command {SaveAs}\ -label {Save As...}\ -underline {2} .frame0.menubutton1.m add command\ -command {.frame.text2 delete 1.0 end}\ -label {Clear}\ -underline {2} .frame0.menubutton1.m add command\ -command {Bye}\ -label {Exit}\ -underline {1} # build widget .frame0.menubutton2 menubutton .frame0.menubutton2 \ -menu {.frame0.menubutton2.m}\ -text {Help}\ -underline {0} # build widget .frame0.menubutton2.m menu .frame0.menubutton2.m .frame0.menubutton2.m add command\ -command {AboutTkEmpire}\ -label {About TkEmpire}\ -underline {0} .frame0.menubutton2.m add command\ -command {Copying}\ -label {Copying} .frame0.menubutton2.m add command\ -command {Warranty}\ -label {Warranty} .frame0.menubutton2.m add command\ -command {ListCommands}\ -label {List of Commands} .frame0.menubutton2.m add command\ -command {DoInfo}\ -label {Info} .frame0.menubutton2.m add command\ -command {Version}\ -label {Version} # build widget .frame0.menubutton3 menubutton .frame0.menubutton3 \ -text {Censuses}\ -menu {.frame0.menubutton3.m} # build widget .frame0.menubutton3.m menu .frame0.menubutton3.m .frame0.menubutton3.m add command\ -command {DoCensus "#0"}\ -label {Realm 0} .frame0.menubutton3.m add command\ -command {DoCensus "#1"}\ -label {Realm 1} .frame0.menubutton3.m add command\ -command {DoCensus "#2"}\ -label {Realm 2} .frame0.menubutton3.m add command\ -command {DoCensus "#3"}\ -label {Realm 3} .frame0.menubutton3.m add command\ -command {DoCensus "#4"}\ -label {Realm 4} .frame0.menubutton3.m add command\ -command {DoCensus "#5"}\ -label {Realm 5} .frame0.menubutton3.m add command\ -command {DoCensus "#6"}\ -label {Realm 6} .frame0.menubutton3.m add command\ -command {DoCensus "#7"}\ -label {Realm 7} .frame0.menubutton3.m add command\ -command {DoCensus "#8"}\ -label {Realm 8} .frame0.menubutton3.m add command\ -command {DoCensus "#9"}\ -label {Realm 9} .frame0.menubutton3.m add command\ -command {DoCensus "#10"}\ -label {Realm 10} .frame0.menubutton3.m add command\ -command {DoCensus "#11"}\ -label {Realm 11} .frame0.menubutton3.m add command\ -command {DoCensus "#12"}\ -label {Realm 13} .frame0.menubutton3.m add command\ -command {DoCensus "#14"}\ -label {Realm 14} .frame0.menubutton3.m add command\ -command {DoCensus "#15"}\ -label {Realm 16} .frame0.menubutton3.m add command\ -command {DoCensusSectors}\ -label {Sectors} # build widget .frame0.menubutton4 menubutton .frame0.menubutton4 \ -text {Commodities}\ -menu {.frame0.menubutton4.m} # build widget .frame0.menubutton4.m menu .frame0.menubutton4.m .frame0.menubutton4.m add command\ -command {DoCommodities "#0"}\ -label {Realm 0} .frame0.menubutton4.m add command\ -command {DoCommodities "#1"}\ -label {Realm 1} .frame0.menubutton4.m add command\ -command {DoCommodities "#2"}\ -label {Realm 2} .frame0.menubutton4.m add command\ -command {DoCommodities "#3"}\ -label {Realm 3} .frame0.menubutton4.m add command\ -command {DoCommodities "#4"}\ -label {Realm 4} .frame0.menubutton4.m add command\ -command {DoCommodities "#5"}\ -label {Realm 5} .frame0.menubutton4.m add command\ -command {DoCommodities "#6"}\ -label {Realm 6} .frame0.menubutton4.m add command\ -command {DoCommodities "#7"}\ -label {Realm 7} .frame0.menubutton4.m add command\ -command {DoCommodities "#8"}\ -label {Realm 8} .frame0.menubutton4.m add command\ -command {DoCommodities "#9"}\ -label {Realm 9} .frame0.menubutton4.m add command\ -command {DoCommodities "#10"}\ -label {Realm 10} .frame0.menubutton4.m add command\ -command {DoCommodities "#11"}\ -label {Realm 11} .frame0.menubutton4.m add command\ -command {DoCommodities "#12"}\ -label {Realm 13} .frame0.menubutton4.m add command\ -command {DoCommodities "#14"}\ -label {Realm 14} .frame0.menubutton4.m add command\ -command {DoCommodities "#15"}\ -label {Realm 16} .frame0.menubutton4.m add command\ -command {DoCommoditiesSectors}\ -label {Sectors} # build widget .frame0.menubutton5 menubutton .frame0.menubutton5 \ -text {Resources}\ -menu {.frame0.menubutton5.m} # build widget .frame0.menubutton5.m menu .frame0.menubutton5.m .frame0.menubutton5.m add command\ -command {DoResources "#0"}\ -label {Realm 0} .frame0.menubutton5.m add command\ -command {DoResources "#1"}\ -label {Realm 1} .frame0.menubutton5.m add command\ -command {DoResources "#2"}\ -label {Realm 2} .frame0.menubutton5.m add command\ -command {DoResources "#3"}\ -label {Realm 3} .frame0.menubutton5.m add command\ -command {DoResources "#4"}\ -label {Realm 4} .frame0.menubutton5.m add command\ -command {DoResources "#5"}\ -label {Realm 5} .frame0.menubutton5.m add command\ -command {DoResources "#6"}\ -label {Realm 6} .frame0.menubutton5.m add command\ -command {DoResources "#7"}\ -label {Realm 7} .frame0.menubutton5.m add command\ -command {DoResources "#8"}\ -label {Realm 8} .frame0.menubutton5.m add command\ -command {DoResources "#9"}\ -label {Realm 9} .frame0.menubutton5.m add command\ -command {DoResources "#10"}\ -label {Realm 10} .frame0.menubutton5.m add command\ -command {DoResources "#11"}\ -label {Realm 11} .frame0.menubutton5.m add command\ -command {DoResources "#12"}\ -label {Realm 13} .frame0.menubutton5.m add command\ -command {DoResources "#14"}\ -label {Realm 14} .frame0.menubutton5.m add command\ -command {DoResources "#15"}\ -label {Realm 16} .frame0.menubutton5.m add command\ -command {DoResourcesSectors}\ -label {Sectors} # build widget .frame0.menubutton6 menubutton .frame0.menubutton6 \ -text {Movement}\ -menu {.frame0.menubutton6.m} # build widget .frame0.menubutton6.m menu .frame0.menubutton6.m .frame0.menubutton6.m add cascade\ -label {Move} \ -menu {.frame0.menubutton6.m.mMove} .frame0.menubutton6.m add cascade\ -label {Test} \ -menu {.frame0.menubutton6.m.mTest} .frame0.menubutton6.m add cascade\ -label {Explore} \ -menu {.frame0.menubutton6.m.mExplore} .frame0.menubutton6.m add cascade\ -label {Deliver} \ -menu {.frame0.menubutton6.m.mDeliver} .frame0.menubutton6.m add cascade\ -label {Route} \ -menu {.frame0.menubutton6.m.mRoute} .frame0.menubutton6.m add cascade\ -label {Threshold} \ -menu {.frame0.menubutton6.m.mThreshold} .frame0.menubutton6.m add command\ -label {Distribute} \ -command {DoDistribute} # build widget .frame0.menubutton6.m.mMove menu .frame0.menubutton6.m.mMove .frame0.menubutton6.m.mMove add command\ -command {DoMove c}\ -label {Civilians} .frame0.menubutton6.m.mMove add command\ -command {DoMove m}\ -label {Military} .frame0.menubutton6.m.mMove add command\ -command {DoMove u}\ -label {Uncompensated Workers} .frame0.menubutton6.m.mMove add command\ -command {DoMove f}\ -label {Food} .frame0.menubutton6.m.mMove add command\ -command {DoMove g}\ -label {Guns} .frame0.menubutton6.m.mMove add command\ -command {DoMove s}\ -label {Shells} .frame0.menubutton6.m.mMove add command\ -command {DoMove p}\ -label {Petrol} .frame0.menubutton6.m.mMove add command\ -command {DoMove i}\ -label {Iron Ore} .frame0.menubutton6.m.mMove add command\ -command {DoMove d}\ -label {Gold Dust} .frame0.menubutton6.m.mMove add command\ -command {DoMove b}\ -label {Bars of Gold} .frame0.menubutton6.m.mMove add command\ -command {DoMove l}\ -label {Light Construction Materials} .frame0.menubutton6.m.mMove add command\ -command {DoMove h}\ -label {Heavy Construction Materials} .frame0.menubutton6.m.mMove add command\ -command {DoMove r}\ -label {Radioactive Materials} # build widget .frame0.menubutton6.m.mTest menu .frame0.menubutton6.m.mTest .frame0.menubutton6.m.mTest add command\ -command {DoTest c}\ -label {Civilians} .frame0.menubutton6.m.mTest add command\ -command {DoTest m}\ -label {Military} .frame0.menubutton6.m.mTest add command\ -command {DoTest u}\ -label {Uncompensated Workers} .frame0.menubutton6.m.mTest add command\ -command {DoTest f}\ -label {Food} .frame0.menubutton6.m.mTest add command\ -command {DoTest g}\ -label {Guns} .frame0.menubutton6.m.mTest add command\ -command {DoTest s}\ -label {Shells} .frame0.menubutton6.m.mTest add command\ -command {DoTest p}\ -label {Petrol} .frame0.menubutton6.m.mTest add command\ -command {DoTest i}\ -label {Iron Ore} .frame0.menubutton6.m.mTest add command\ -command {DoTest d}\ -label {Gold Dust} .frame0.menubutton6.m.mTest add command\ -command {DoTest b}\ -label {Bars of Gold} .frame0.menubutton6.m.mTest add command\ -command {DoTest l}\ -label {Light Construction Materials} .frame0.menubutton6.m.mTest add command\ -command {DoTest h}\ -label {Heavy Construction Materials} .frame0.menubutton6.m.mTest add command\ -command {DoTest r}\ -label {Radioactive Materials} # build widget .frame0.menubutton6.m.mExplore menu .frame0.menubutton6.m.mExplore .frame0.menubutton6.m.mExplore add command\ -command {DoExplore c}\ -label {Civilians} .frame0.menubutton6.m.mExplore add command\ -command {DoExplore m}\ -label {Military} # build widget .frame0.menubutton6.m.mDeliver menu .frame0.menubutton6.m.mDeliver .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver u}\ -label {Uncompensated Workers} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver f}\ -label {Food} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver g}\ -label {Guns} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver s}\ -label {Shells} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver p}\ -label {Planes} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver i}\ -label {Iron Ore} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver o}\ -label {Oil} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver d}\ -label {Gold Dust} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver b}\ -label {Bars of Gold} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver l}\ -label {Light Construction Materials} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver h}\ -label {Heavy Construction Materials} .frame0.menubutton6.m.mDeliver add command\ -command {DoDeliver r}\ -label {Radioactive Materials} # build widget .frame0.menubutton6.m.mRoute menu .frame0.menubutton6.m.mRoute foreach comm { {u {Uncompensated Workers}} {f Food} {g Guns} {s Shells} {p Planes} {i {Iron Ore}} {o Oil} {d {Gold Dust}} {b {Bars of Gold}} {l {Light Construction Materials}} {h {Heavy Construction Materials}} {r {Radioactive Materials}} } { .frame0.menubutton6.m.mRoute add cascade\ -label "[lindex $comm 1]"\ -menu ".frame0.menubutton6.m.mRoute.[lindex $comm 0]" menu .frame0.menubutton6.m.mRoute.[lindex $comm 0] for {set realm 0} {$realm < 18} {incr realm} { .frame0.menubutton6.m.mRoute.[lindex $comm 0] add command \ -command "DoRoute [lindex $comm 0] #$realm"\ -label "Realm $realm" } .frame0.menubutton6.m.mRoute.[lindex $comm 0] add command \ -command "DoRouteSectors [lindex $comm 0]"\ -label {Sectors} } # build widget .frame0.menubutton6.m.mThreshold menu .frame0.menubutton6.m.mThreshold .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold c}\ -label {Civilians} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold m}\ -label {Military} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold u}\ -label {Uncompensated Workers} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold f}\ -label {Food} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold g}\ -label {Guns} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold s}\ -label {Shells} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold p}\ -label {Planes} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold i}\ -label {Iron Ore} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold o}\ -label {Oil} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold d}\ -label {Gold Dust} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold b}\ -label {Bars of Gold} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold l}\ -label {Light Construction Materials} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold h}\ -label {Heavy Construction Materials} .frame0.menubutton6.m.mThreshold add command\ -command {DoThreshold r}\ -label {Radioactive Materials} # pack widget .frame0 pack append .frame0 \ .frame0.menubutton1 {left frame center} \ .frame0.menubutton0 {left frame center} \ .frame0.menubutton3 {left frame center} \ .frame0.menubutton4 {left frame center} \ .frame0.menubutton5 {left frame center} \ .frame0.menubutton6 {left frame center} \ .frame0.menubutton2 {right frame center} # build widget .status frame .status \ -borderwidth {2} # build widget .status.command entry .status.command \ -relief {sunken} # bindings bind .status.command {SendCommand %W} # build widget .status.prompt label .status.prompt \ -text {}\ -textvariable {Prompt} # pack widget .status pack append .status \ .status.prompt {left frame center} \ .status.command {top frame center expand fillx} # pack widget . pack append . \ .frame0 {top frame center fillx} \ .status {top frame center fillx} \ .frame {top frame center expand fill} if {"[info procs XFEdit]" != ""} { XFEditSetShowWindows XFMiscBindWidgetTree .xfInfoWidgetTree } global tkVersion if {$tkVersion >= 3.0} { tk_menuBar .frame0 .frame0.menubutton1 .frame0.menubutton2 } { tk_menus . .frame0.menubutton1 .frame0.menubutton2 } .frame.text2 insert end {} .status.command insert end {} } # User defined procedures # Procedure: AboutTkEmpire proc AboutTkEmpire {} { global alertBox set alertBox(justify) {left} AlertBox " TkEmpire is a Tcl/Tk frontend program for BSD Empire. You can just enter regular empire commands in the entry space provided or use the various pulldown menus." "" "550x100" "Information About TkEmpire" } # Procedure: Copying proc Copying {} { TextBox " TkEmpire -- A Tcl/Tk Front End for BSD Empire version 1.1 patch level 5 Copyright (C) 1995 Robert Heller D/B/A Deepwoods Software 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., 675 Mass Ave, Cambridge, MA 02139, USA. Robert Heller 51 Locke Hill Road Wendell, MA 01379 InterNet E-Mail: heller@cs.umass.edu FidoNet NetMail: Robert Heller at 1:321/153" "" "600x300" "Copying Message" } proc AlertBox {{alertBoxMessage {Alert message}} {alertBoxCommand ""} {alertBoxGeometry 350x150} {alertBoxTitle "Alert box"} args} {# xf ignore me 5 ########## # Procedure: AlertBox # Description: show alert box # Arguments: {alertBoxMessage} - the text to display # {alertBoxCommand} - the command to call after ok # {alertBoxGeometry} - the geometry for the window # {alertBoxTitle} - the title for the window # {args} - labels of buttons # Returns: The number of the selected button, ot nothing # Sideeffects: none # Notes: there exist also functions called: # AlertBoxFile - to open and read a file automatically # AlertBoxFd - to read from an already opened filedescriptor ########## # # global alertBox(activeBackground) - active background color # global alertBox(activeForeground) - active foreground color # global alertBox(after) - destroy alert box after n seconds # global alertBox(anchor) - anchor for message box # global alertBox(background) - background color # global alertBox(font) - message font # global alertBox(foreground) - foreground color # global alertBox(justify) - justify for message box # global alertBox(toplevelName) - the toplevel name global alertBox # show alert box if {[llength $args] > 0} { eval AlertBoxInternal "\{$alertBoxMessage\}" "\{$alertBoxCommand\}" "\{$alertBoxGeometry\}" "\{$alertBoxTitle\}" $args } { AlertBoxInternal $alertBoxMessage $alertBoxCommand $alertBoxGeometry $alertBoxTitle } if {[llength $args] > 0} { # wait for the box to be destroyed update idletask grab $alertBox(toplevelName) tkwait window $alertBox(toplevelName) return $alertBox(button) } } proc AlertBoxFd {{alertBoxInFile ""} {alertBoxCommand ""} {alertBoxGeometry 350x150} {alertBoxTitle "Alert box"} args} {# xf ignore me 5 ########## # Procedure: AlertBoxFd # Description: show alert box containing a filedescriptor # Arguments: {alertBoxInFile} - a filedescriptor to read. The descriptor # is closed after reading # {alertBoxCommand} - the command to call after ok # {alertBoxGeometry} - the geometry for the window # {alertBoxTitle} - the title for the window # {args} - labels of buttons # Returns: The number of the selected button, ot nothing # Sideeffects: none # Notes: there exist also functions called: # AlertBox - to display a passed string # AlertBoxFile - to open and read a file automatically ########## # # global alertBox(activeBackground) - active background color # global alertBox(activeForeground) - active foreground color # global alertBox(after) - destroy alert box after n seconds # global alertBox(anchor) - anchor for message box # global alertBox(background) - background color # global alertBox(font) - message font # global alertBox(foreground) - foreground color # global alertBox(justify) - justify for message box # global alertBox(toplevelName) - the toplevel name global alertBox # check file existance if {"$alertBoxInFile" == ""} { puts stderr "No filedescriptor specified" return } set alertBoxMessage [read $alertBoxInFile] close $alertBoxInFile # show alert box if {[llength $args] > 0} { eval AlertBoxInternal "\{$alertBoxMessage\}" "\{$alertBoxCommand\}" "\{$alertBoxGeometry\}" "\{$alertBoxTitle\}" $args } { AlertBoxInternal $alertBoxMessage $alertBoxCommand $alertBoxGeometry $alertBoxTitle } if {[llength $args] > 0} { # wait for the box to be destroyed update idletask grab $alertBox(toplevelName) tkwait window $alertBox(toplevelName) return $alertBox(button) } } proc AlertBoxFile {{alertBoxFile ""} {alertBoxCommand ""} {alertBoxGeometry 350x150} {alertBoxTitle "Alert box"} args} {# xf ignore me 5 ########## # Procedure: AlertBoxFile # Description: show alert box containing a file # Arguments: {alertBoxFile} - filename to read # {alertBoxCommand} - the command to call after ok # {alertBoxGeometry} - the geometry for the window # {alertBoxTitle} - the title for the window # {args} - labels of buttons # Returns: The number of the selected button, ot nothing # Sideeffects: none # Notes: there exist also functions called: # AlertBox - to display a passed string # AlertBoxFd - to read from an already opened filedescriptor ########## # # global alertBox(activeBackground) - active background color # global alertBox(activeForeground) - active foreground color # global alertBox(after) - destroy alert box after n seconds # global alertBox(anchor) - anchor for message box # global alertBox(background) - background color # global alertBox(font) - message font # global alertBox(foreground) - foreground color # global alertBox(justify) - justify for message box # global alertBox(toplevelName) - the toplevel name global alertBox # check file existance if {"$alertBoxFile" == ""} { puts stderr "No filename specified" return } if {[catch "open $alertBoxFile r" alertBoxInFile]} { puts stderr "$alertBoxInFile" return } set alertBoxMessage [read $alertBoxInFile] close $alertBoxInFile # show alert box if {[llength $args] > 0} { eval AlertBoxInternal "\{$alertBoxMessage\}" "\{$alertBoxCommand\}" "\{$alertBoxGeometry\}" "\{$alertBoxTitle\}" $args } { AlertBoxInternal $alertBoxMessage $alertBoxCommand $alertBoxGeometry $alertBoxTitle } if {[llength $args] > 0} { # wait for the box to be destroyed update idletask grab $alertBox(toplevelName) tkwait window $alertBox(toplevelName) return $alertBox(button) } } ########## # Procedure: AlertBoxInternal # Description: show alert box internal # Arguments: alertBoxMessage - the text to display # alertBoxCommand - the command to call after ok # alertBoxGeometry - the geometry for the window # alertBoxTitle - the title for the window # args - labels of buttons # Returns: none # Sideeffects: none ########## proc AlertBoxInternal {alertBoxMessage alertBoxCommand alertBoxGeometry alertBoxTitle args} {# xf ignore me 6 global alertBox set tmpButtonOpt "" set tmpFrameOpt "" set tmpMessageOpt "" if {"$alertBox(activeBackground)" != ""} { append tmpButtonOpt "-activebackground \"$alertBox(activeBackground)\" " } if {"$alertBox(activeForeground)" != ""} { append tmpButtonOpt "-activeforeground \"$alertBox(activeForeground)\" " } if {"$alertBox(background)" != ""} { append tmpButtonOpt "-background \"$alertBox(background)\" " append tmpFrameOpt "-background \"$alertBox(background)\" " append tmpMessageOpt "-background \"$alertBox(background)\" " } if {"$alertBox(font)" != ""} { append tmpButtonOpt "-font \"$alertBox(font)\" " append tmpMessageOpt "-font \"$alertBox(font)\" " } if {"$alertBox(foreground)" != ""} { append tmpButtonOpt "-foreground \"$alertBox(foreground)\" " append tmpMessageOpt "-foreground \"$alertBox(foreground)\" " } # start build of toplevel if {"[info commands XFDestroy]" != ""} { catch {XFDestroy $alertBox(toplevelName)} } { catch {destroy $alertBox(toplevelName)} } toplevel $alertBox(toplevelName) \ -borderwidth 0 catch "$alertBox(toplevelName) config $tmpFrameOpt" if {[catch "wm geometry $alertBox(toplevelName) $alertBoxGeometry"]} { wm geometry $alertBox(toplevelName) 350x150 } wm title $alertBox(toplevelName) $alertBoxTitle wm maxsize $alertBox(toplevelName) 1000 1000 wm minsize $alertBox(toplevelName) 100 100 # end build of toplevel message $alertBox(toplevelName).message1 \ -anchor "$alertBox(anchor)" \ -justify "$alertBox(justify)" \ -relief raised \ -text "$alertBoxMessage" catch "$alertBox(toplevelName).message1 config $tmpMessageOpt" set xfTmpWidth \ [string range $alertBoxGeometry 0 [expr [string first x $alertBoxGeometry]-1]] if {"$xfTmpWidth" != ""} { # set message size catch "$alertBox(toplevelName).message1 configure \ -width [expr $xfTmpWidth-10]" } { $alertBox(toplevelName).message1 configure \ -aspect 1500 } frame $alertBox(toplevelName).frame1 \ -borderwidth 0 \ -relief raised catch "$alertBox(toplevelName).frame1 config $tmpFrameOpt" set alertBoxCounter 0 set buttonNum [llength $args] if {$buttonNum > 0} { while {$alertBoxCounter < $buttonNum} { button $alertBox(toplevelName).frame1.button$alertBoxCounter \ -text "[lindex $args $alertBoxCounter]" \ -command " global alertBox set alertBox(button) $alertBoxCounter if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $alertBox(toplevelName)} } { catch {destroy $alertBox(toplevelName)} }" catch "$alertBox(toplevelName).frame1.button$alertBoxCounter config $tmpButtonOpt" pack append $alertBox(toplevelName).frame1 \ $alertBox(toplevelName).frame1.button$alertBoxCounter {left fillx expand} incr alertBoxCounter } } { button $alertBox(toplevelName).frame1.button0 \ -text "OK" \ -command " global alertBox set alertBox(button) 0 if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $alertBox(toplevelName)} } { catch {destroy $alertBox(toplevelName)} } $alertBoxCommand" catch "$alertBox(toplevelName).frame1.button0 config $tmpButtonOpt" pack append $alertBox(toplevelName).frame1 \ $alertBox(toplevelName).frame1.button0 {left fillx expand} } # packing pack append $alertBox(toplevelName) \ $alertBox(toplevelName).frame1 {bottom fill} \ $alertBox(toplevelName).message1 {top fill expand} if {$alertBox(after) != 0} { after [expr $alertBox(after)*1000] \ "catch \"$alertBox(toplevelName).frame1.button0 invoke\"" } } # Procedure: SaveAs proc SaveAs {} { global fsBox set fsBox(pattern) {*.txt} set outfile [FSBox "Filename: "] if {$outfile == {}} {return} if {[catch "open $outfile w" ofp]} { tkerror "Could not open '$outfile'" return } puts $ofp "[.frame.text2 get 1.0 end]" close $ofp } # Procedure: ExecuteScript proc ExecuteScript {} { global fsBox set fsBox(pattern) {*.emp} set script [FSBox "Script File: "] if {$script == {}} {return} .status.command delete 0 end .status.command insert end "execute $script" SendCommand .status.command } # Procedure: Bye proc Bye {} { global EmpireFileId global C_Codes if {$EmpireFileId != {}} {puts $EmpireFileId "bye"} } # Procedure: ListCommands proc ListCommands {} { set TopLevel ".listOfCommands" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "List Of Commands" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" # bindings bind $TopLevel.frame.text2 {NoFunction} bind $TopLevel.frame.text2 { set index [%W index @%x,%y] set linestart [%W index "$index linestart"] set cmdpos [%W index "$linestart+6c"] set word [%W get "$cmdpos wordstart" "$cmdpos wordend"] DoInfo "$word" } # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global OutWindow set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "list" update idletasks SendCommand .status.command } # Procedure: DoInfo proc DoInfo {{word {}}} { for {set i 0} {[winfo exists ".info$i"]} {incr i} {} set TopLevel ".info$i" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "Info $word" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" # bindings bind $TopLevel.frame.text2 {NoFunction} bind $TopLevel.frame.text2 \ {DoInfo [%W get "@%x,%y wordstart" "@%x,%y wordend"]} # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global OutWindow set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "info $word" update idletasks SendCommand .status.command } # Procedure: DoDeliver proc DoDeliver {what} { # .deliver # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .deliver if {"[info procs XFEdit]" != ""} { catch "XFDestroy .deliver" } { catch "destroy .deliver" } toplevel .deliver # Window manager configurations global tkVersion wm positionfrom .deliver program wm sizefrom .deliver program wm maxsize .deliver 1000 768 wm minsize .deliver 10 10 wm title .deliver "Deliver $what from sector in what direction?" # build widget .deliver.dbuttons1 frame .deliver.dbuttons1 \ -borderwidth {2} # build widget .deliver.dbuttons1.u button .deliver.dbuttons1.u \ -text {u}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" u .deliver" # build widget .deliver.dbuttons1.y button .deliver.dbuttons1.y \ -text {y}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" y .deliver" # pack widget .deliver.dbuttons1 pack append .deliver.dbuttons1 \ .deliver.dbuttons1.y {left frame center} \ .deliver.dbuttons1.u {right frame center} # build widget .deliver.dbuttons2 frame .deliver.dbuttons2 \ -borderwidth {2} # build widget .deliver.dbuttons2.g button .deliver.dbuttons2.g \ -text {g}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" g .deliver" # build widget .deliver.dbuttons2.h button .deliver.dbuttons2.h \ -text {h}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" h .deliver" # build widget .deliver.dbuttons2.j button .deliver.dbuttons2.j \ -text {j}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" j .deliver" # pack widget .deliver.dbuttons2 pack append .deliver.dbuttons2 \ .deliver.dbuttons2.g {left frame center} \ .deliver.dbuttons2.h {left frame center} \ .deliver.dbuttons2.j {left frame center} # build widget .deliver.dbuttons3 frame .deliver.dbuttons3 \ -borderwidth {2} # build widget .deliver.dbuttons3.b button .deliver.dbuttons3.b \ -text {b}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" b .deliver" # build widget .deliver.dbuttons3.n button .deliver.dbuttons3.n \ -text {n}\ -command "DoDeliver1 $what \"\[.deliver.deliver.sectors get\]\" n .deliver" # pack widget .deliver.dbuttons3 pack append .deliver.dbuttons3 \ .deliver.dbuttons3.b {left frame center} \ .deliver.dbuttons3.n {left frame center} # build widget .deliver.deliver frame .deliver.deliver \ -borderwidth {2} # build widget .deliver.deliver.label3 label .deliver.deliver.label3 \ -text {From Sectors:} # build widget .deliver.deliver.sectors entry .deliver.deliver.sectors \ -relief {sunken} # bindings bind .deliver.deliver.sectors {NoFunction} # pack widget .deliver.deliver pack append .deliver.deliver \ .deliver.deliver.label3 {left frame center} \ .deliver.deliver.sectors {left frame center expand fillx} # build widget .deliver.dismis button .deliver.dismis \ -command { if {"[info procs XFEdit]" != ""} { catch "XFDestroy .deliver" } { catch "destroy .deliver" } }\ -text {Dismis} # pack widget .deliver pack append .deliver \ .deliver.deliver {top frame center fillx} \ .deliver.dbuttons1 {top frame center} \ .deliver.dbuttons2 {top frame center} \ .deliver.dbuttons3 {top frame center} \ .deliver.dismis {top frame center expand fillx} .deliver.deliver.sectors insert end {} # end of widget tree update idletasks grab .deliver tkwait window .deliver } # Procedure: DoDeliver1 proc DoDeliver1 {what from dir toplevel} { .status.command delete 0 end .status.command insert end "deliver $what $from $dir" update idletasks SendCommand .status.command if {"[info procs XFEdit]" != ""} { catch "XFDestroy $toplevel" } { catch "destroy $toplevel" } } # Procedure: DoRouteSectors proc DoRouteSectors {what} { set sectors [InputBoxOne "Enter Sectors:"] if {$sectors == {}} {return} DoRoute $what "$sectors" } # Procedure: DoRoute proc DoRoute {what {sects "#0"}} { for {set i 0} {[winfo exists ".route$i"]} {incr i} {} set TopLevel ".route$i" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "Route of $what in $sects" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" # bindings bind $TopLevel.frame.text2 {NoFunction} # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global OutWindow set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "route $what $sects" update idletasks SendCommand .status.command } # Procedure: DoThreshold proc DoThreshold {what} { # .threshold # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .threshold if {"[info procs XFEdit]" != ""} { catch "XFDestroy .threshold" } { catch "destroy .threshold" } toplevel .threshold # Window manager configurations global tkVersion wm positionfrom .threshold program wm sizefrom .threshold program wm maxsize .threshold 1000 768 wm minsize .threshold 10 10 wm title .threshold "Threshold $what in which sectors?" # build widget .threshold.buttons frame .threshold.buttons \ -borderwidth {2} # build widget .threshold.buttons.cancel button .threshold.buttons.cancel \ -text {Cancel}\ -command { if {"[info procs XFEdit]" != ""} { catch "XFDestroy .threshold" } { catch "destroy .threshold" } } # build widget .threshold.buttons.help button .threshold.buttons.help \ -text {Help}\ -command { global alertBox set alertBox(justify) {left} AlertBox "Enter a sector specification and a threshold value" "" "380x50" "Threshold Help" } # build widget .threshold.buttons.ok button .threshold.buttons.ok \ -text {OK}\ -command " .status.command delete 0 end .status.command insert end \"threshold $what \[.threshold.sectors.sectors get\] \[.threshold.threshold.threshold get\]\" update idletasks SendCommand .status.command if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy .threshold\" } { catch \"destroy .threshold\" } " # pack widget .threshold.buttons pack append .threshold.buttons \ .threshold.buttons.ok {left frame center expand} \ .threshold.buttons.cancel {left frame center expand} \ .threshold.buttons.help {right frame center expand} # build widget .threshold.sectors frame .threshold.sectors \ -borderwidth {2} # build widget .threshold.sectors.label10 label .threshold.sectors.label10 \ -text {Sectors:} # build widget .threshold.sectors.sectors entry .threshold.sectors.sectors \ -relief {sunken} # bindings bind .threshold.sectors.sectors {focus .threshold.threshold.threshold} # pack widget .threshold.sectors pack append .threshold.sectors \ .threshold.sectors.label10 {left frame center} \ .threshold.sectors.sectors {left frame center expand fillx} # build widget .threshold.threshold frame .threshold.threshold \ -borderwidth {2} # build widget .threshold.threshold.label13 label .threshold.threshold.label13 \ -text {Threshold:} # build widget .threshold.threshold.threshold entry .threshold.threshold.threshold \ -relief {sunken} # bindings bind .threshold.threshold.threshold {.threshold.buttons.ok invoke} # pack widget .threshold.threshold pack append .threshold.threshold \ .threshold.threshold.label13 {left frame center} \ .threshold.threshold.threshold {left frame center expand fillx} # pack widget .threshold pack append .threshold \ .threshold.sectors {top frame center fillx} \ .threshold.threshold {top frame center fillx} \ .threshold.buttons {top frame center fillx} .threshold.sectors.sectors insert end {} .threshold.threshold.threshold insert end {} # end of widget tree focus .threshold.sectors.sectors update idletasks grab .threshold tkwait window .threshold } # Procedure: DoDistribute proc DoDistribute {} { # .distribute # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .distribute if {"[info procs XFEdit]" != ""} { catch "XFDestroy .distribute" } { catch "destroy .distribute" } toplevel .distribute # Window manager configurations global tkVersion wm positionfrom .distribute program wm sizefrom .distribute program wm maxsize .distribute 1000 768 wm minsize .distribute 10 10 wm title .distribute {Set Distributation sectors} # build widget .distribute.buttons frame .distribute.buttons \ -borderwidth {2} # build widget .distribute.buttons.cancel button .distribute.buttons.cancel \ -text {Cancel}\ -command { if {"[info procs XFEdit]" != ""} { catch "XFDestroy .distribute" } { catch "destroy .distribute" } } # build widget .distribute.buttons.help button .distribute.buttons.help \ -text {Help}\ -command { global alertBox set alertBox(justify) {left} AlertBox "Select the distribution sectors and the wharehouse for distribution" \ "" "500x50" "Set Distributation sectors help" } # build widget .distribute.buttons.ok button .distribute.buttons.ok \ -text {OK}\ -command { .status.command delete 0 end .status.command insert end "distribute [.distribute.sectors.sectors get] [.distribute.distsector.sector get]" update idletasks SendCommand .status.command if {"[info procs XFEdit]" != ""} { catch "XFDestroy .distribute" } { catch "destroy .distribute" } } # pack widget .distribute.buttons pack append .distribute.buttons \ .distribute.buttons.ok {left frame center expand} \ .distribute.buttons.cancel {left frame center expand} \ .distribute.buttons.help {right frame center expand} # build widget .distribute.distsector frame .distribute.distsector \ -borderwidth {2} # build widget .distribute.distsector.label20 label .distribute.distsector.label20 \ -text {Distribution Sector:} # build widget .distribute.distsector.sector entry .distribute.distsector.sector \ -relief {sunken} # bindings bind .distribute.distsector.sector {.distribute.buttons.ok invoke} # pack widget .distribute.distsector pack append .distribute.distsector \ .distribute.distsector.label20 {left frame center} \ .distribute.distsector.sector {left frame center expand fillx} # build widget .distribute.sectors frame .distribute.sectors \ -borderwidth {2} # build widget .distribute.sectors.label10 label .distribute.sectors.label10 \ -text {Sectors:} # build widget .distribute.sectors.sectors entry .distribute.sectors.sectors \ -relief {sunken} # bindings bind .distribute.sectors.sectors {focus .distribute.distsector.sector} # pack widget .distribute.sectors pack append .distribute.sectors \ .distribute.sectors.label10 {left frame center} \ .distribute.sectors.sectors {left frame center expand fillx} # pack widget .distribute pack append .distribute \ .distribute.sectors {top frame center fillx} \ .distribute.distsector {top frame center fillx} \ .distribute.buttons {top frame center fillx} .distribute.distsector.sector insert end {} .distribute.sectors.sectors insert end {} # end of widget tree focus .distribute.sectors.sectors update idletasks grab .distribute tkwait window .distribute } # Procedure: DoExecute proc DoExecute { data} { global EmpireFileId if {$EmpireFileId == {}} {return} set name [string trimleft $data] if {$name == {}} { tkerror "Null file to execute" return } if {[catch "open $name r" fileid]} { tkerror "Can't open execute file: $name" return } else { set buffer [read $fileid 4096] while {[string length $buffer] > 0} { puts $EmpireFileId "$buffer" update idletasks set buffer [read $fileid 4096] } global FnList puts $EmpireFileId $FnList(CTLD) } } # Procedure: DoFlush proc DoFlush { data} { global Prompt set Prompt "$data" focus .status.command } # Procedure: DoMapSectors proc DoMapSectors {} { set sectors [InputBoxOne "Enter Sectors:"] if {$sectors == {}} {return} DoMap "$sectors" } # Procedure: DoMap proc DoMap { {sects "#0"}} { for {set i 0} {[winfo exists ".map$i"]} {incr i} {} set TopLevel ".map$i" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "Map of $sects" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" # bindings bind $TopLevel.frame.text2 {NoFunction} # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global DoingMap global OutWindow set DoingMap 1 set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "map $sects" update idletasks SendCommand .status.command } # Procedure: GetMoveSectorAndNumber proc GetMoveSectorAndNumber {command what sector number} { global GetMoveSectorAndNumberResult set GetMoveSectorAndNumberResult(sector) {} set GetMoveSectorAndNumberResult(number) {} set GetMoveSectorAndNumberResult(button) {} # .moveSectorAndNumber # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .moveSectorAndNumber if {"[info procs XFEdit]" != ""} { catch "XFDestroy .moveSectorAndNumber" } { catch "destroy .moveSectorAndNumber" } toplevel .moveSectorAndNumber # Window manager configurations global tkVersion wm positionfrom .moveSectorAndNumber program wm sizefrom .moveSectorAndNumber program wm maxsize .moveSectorAndNumber 1000 768 wm minsize .moveSectorAndNumber 10 10 wm title .moveSectorAndNumber "$command how many $what from what sector?" # build widget .moveSectorAndNumber.buttons frame .moveSectorAndNumber.buttons \ -borderwidth {2} # build widget .moveSectorAndNumber.buttons.cancel button .moveSectorAndNumber.buttons.cancel \ -text {Cancel}\ -command { global GetMoveSectorAndNumberResult set GetMoveSectorAndNumberResult(button) {Cancel} if {"[info procs XFEdit]" != ""} { catch "XFDestroy .moveSectorAndNumber" } { catch "destroy .moveSectorAndNumber" } } # build widget .moveSectorAndNumber.buttons.help button .moveSectorAndNumber.buttons.help \ -text {Help}\ -command " global alertBox set alertBox(justify) {left} AlertBox \"Enter the sector to $command from and the number of $what\" \ \"\" \"500x50\" \"$command how many $what from what sector? help.\" " # build widget .moveSectorAndNumber.buttons.ok button .moveSectorAndNumber.buttons.ok \ -text {OK}\ -command { global GetMoveSectorAndNumberResult set GetMoveSectorAndNumberResult(button) {Ok} set GetMoveSectorAndNumberResult(sector) "[.moveSectorAndNumber.sector.sector get]" set GetMoveSectorAndNumberResult(number) "[.moveSectorAndNumber.number.number get]" if {"[info procs XFEdit]" != ""} { catch "XFDestroy .moveSectorAndNumber" } { catch "destroy .moveSectorAndNumber" } } # pack widget .moveSectorAndNumber.buttons pack append .moveSectorAndNumber.buttons \ .moveSectorAndNumber.buttons.ok {left frame center expand} \ .moveSectorAndNumber.buttons.cancel {left frame center expand} \ .moveSectorAndNumber.buttons.help {right frame center expand} # build widget .moveSectorAndNumber.number frame .moveSectorAndNumber.number \ -borderwidth {2} # build widget .moveSectorAndNumber.number.label6 label .moveSectorAndNumber.number.label6 \ -text {Number:} # build widget .moveSectorAndNumber.number.number entry .moveSectorAndNumber.number.number \ -relief {sunken} # bindings bind .moveSectorAndNumber.number.number {.moveSectorAndNumber.buttons.ok invoke} # pack widget .moveSectorAndNumber.number pack append .moveSectorAndNumber.number \ .moveSectorAndNumber.number.label6 {left frame center} \ .moveSectorAndNumber.number.number {left frame center expand fillx} # build widget .moveSectorAndNumber.sector frame .moveSectorAndNumber.sector \ -borderwidth {2} # build widget .moveSectorAndNumber.sector.label4 label .moveSectorAndNumber.sector.label4 \ -text {Sector: } # build widget .moveSectorAndNumber.sector.sector entry .moveSectorAndNumber.sector.sector \ -relief {sunken} # bindings bind .moveSectorAndNumber.sector.sector {focus .moveSectorAndNumber.number.number} # pack widget .moveSectorAndNumber.sector pack append .moveSectorAndNumber.sector \ .moveSectorAndNumber.sector.label4 {left frame center} \ .moveSectorAndNumber.sector.sector {left frame center expand fillx} # pack widget .moveSectorAndNumber pack append .moveSectorAndNumber \ .moveSectorAndNumber.sector {top frame center fillx} \ .moveSectorAndNumber.number {top frame center fillx} \ .moveSectorAndNumber.buttons {top frame center fillx} .moveSectorAndNumber.number.number insert end {} .moveSectorAndNumber.sector.sector insert end {} focus .moveSectorAndNumber.sector.sector # end of widget tree update idletasks grab .moveSectorAndNumber tkwait window .moveSectorAndNumber if {$GetMoveSectorAndNumberResult(button) == {Cancel}} { return 0 } uplevel 1 "set $sector \{$GetMoveSectorAndNumberResult(sector)\}" uplevel 1 "set $number \{$GetMoveSectorAndNumberResult(number)\}" return 1 } # Procedure: MoveWindow proc MoveWindow {command what sector number} { # .moveWindow # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .moveWindow if {"[info procs XFEdit]" != ""} { catch "XFDestroy .moveWindow" } { catch "destroy .moveWindow" } toplevel .moveWindow # Window manager configurations global tkVersion wm positionfrom .moveWindow program wm sizefrom .moveWindow program wm maxsize .moveWindow 1000 768 wm minsize .moveWindow 10 10 wm title .moveWindow "$command $what $sector $number" # build widget .moveWindow.dbuttons2 frame .moveWindow.dbuttons2 \ -borderwidth {2} # build widget .moveWindow.dbuttons2.g button .moveWindow.dbuttons2.g \ -text {g}\ -command { .moveWindow.prompt.dirletters insert end {g} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "g" } } # build widget .moveWindow.dbuttons2.h button .moveWindow.dbuttons2.h \ -text {h}\ -command { .moveWindow.prompt.dirletters insert end {h} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "h" } } # build widget .moveWindow.dbuttons2.j button .moveWindow.dbuttons2.j \ -text {j}\ -command { .moveWindow.prompt.dirletters insert end {j} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "j" } } # pack widget .moveWindow.dbuttons2 pack append .moveWindow.dbuttons2 \ .moveWindow.dbuttons2.g {left frame center} \ .moveWindow.dbuttons2.h {left frame center} \ .moveWindow.dbuttons2.j {left frame center} # build widget .moveWindow.dbuttons3 frame .moveWindow.dbuttons3 \ -borderwidth {2} # build widget .moveWindow.dbuttons3.b button .moveWindow.dbuttons3.b \ -text {b}\ -command { .moveWindow.prompt.dirletters insert end {b} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "b" } } # build widget .moveWindow.dbuttons3.n button .moveWindow.dbuttons3.n \ -text {n}\ -command { .moveWindow.prompt.dirletters insert end {n} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "n" } } # pack widget .moveWindow.dbuttons3 pack append .moveWindow.dbuttons3 \ .moveWindow.dbuttons3.b {left frame center} \ .moveWindow.dbuttons3.n {left frame center} # build widget .moveWindow.dirbuttons1 frame .moveWindow.dirbuttons1 \ -borderwidth {2} # build widget .moveWindow.dirbuttons1.u button .moveWindow.dirbuttons1.u \ -text {u}\ -command { .moveWindow.prompt.dirletters insert end {u} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "u" } } # build widget .moveWindow.dirbuttons1.y button .moveWindow.dirbuttons1.y \ -text {y}\ -command { .moveWindow.prompt.dirletters insert end {y} global EmpireFileId if {$EmpireFileId != {}} { puts $EmpireFileId "y" } } # pack widget .moveWindow.dirbuttons1 pack append .moveWindow.dirbuttons1 \ .moveWindow.dirbuttons1.y {left frame center} \ .moveWindow.dirbuttons1.u {right frame center} # build widget .moveWindow.echo frame .moveWindow.echo \ -height {9}\ -relief {raised}\ -width {42} # build widget .moveWindow.echo.text20 text .moveWindow.echo.text20 \ -height {9}\ -relief {sunken}\ -width {60}\ -wrap {none} # bindings bind .moveWindow.echo.text20 {NoFunction} # pack widget .moveWindow.echo pack append .moveWindow.echo \ .moveWindow.echo.text20 {top frame center} # build widget .moveWindow.prompt frame .moveWindow.prompt \ -borderwidth {2} # build widget .moveWindow.prompt.dirletters entry .moveWindow.prompt.dirletters \ -relief {sunken} # bindings bind .moveWindow.prompt.dirletters {NoFunction} # build widget .moveWindow.prompt.prompt label .moveWindow.prompt.prompt \ -text {}\ -textvariable {Prompt} # pack widget .moveWindow.prompt pack append .moveWindow.prompt \ .moveWindow.prompt.prompt {left frame center} \ .moveWindow.prompt.dirletters {left frame center expand fillx} # build widget .moveWindow.dismis button .moveWindow.dismis\ -text {Dismis}\ -state {disabled}\ -command { if {"[info procs XFEdit]" != ""} { catch "XFDestroy .moveWindow" } { catch "destroy .moveWindow" } } # pack widget .moveWindow pack append .moveWindow \ .moveWindow.prompt {top frame center fillx} \ .moveWindow.dirbuttons1 {top frame center} \ .moveWindow.dbuttons2 {top frame center} \ .moveWindow.dbuttons3 {top frame center} \ .moveWindow.echo {top frame center expand fill}\ .moveWindow.dismis {top frame center expand fillx} .moveWindow.echo.text20 insert end {} .moveWindow.prompt.dirletters insert end {} # end of widget tree global OutWindow set OutWindow {.moveWindow.echo.text20} .status.command delete 0 end .status.command insert end "$command $what $sector $number" SendCommand .status.command update idletasks set oldgrab [grab current] grab .moveWindow tkwait variable OutWindow .moveWindow.dirbuttons1.y config -state {disabled} .moveWindow.dirbuttons1.u config -state {disabled} .moveWindow.dbuttons2.g config -state {disabled} .moveWindow.dbuttons2.h config -state {disabled} .moveWindow.dbuttons2.j config -state {disabled} .moveWindow.dbuttons3.b config -state {disabled} .moveWindow.dbuttons3.n config -state {disabled} grab release .moveWindow if {$oldgrab != {}} {grab $oldgrab} } # Procedure: DoMove proc DoMove {what} { set sector {} set number {} if {![GetMoveSectorAndNumber Move $what sector number]} {return} MoveWindow move $what $sector $number } # Procedure: DoExplore proc DoExplore {what} { set sector {} set number {} if {![GetMoveSectorAndNumber Explore $what sector number]} {return} MoveWindow explore $what $sector $number } # Procedure: DoTest proc DoTest {what} { set sector {} set number {} if {![GetMoveSectorAndNumber Test $what sector number]} {return} MoveWindow test $what $sector $number } # Procedure: DoCensusSectors proc DoCensusSectors {} { set sectors [InputBoxOne "Enter Sectors:"] if {$sectors == {}} {return} DoCensus "$sectors" } # Procedure: DoCensus proc DoCensus { {sects "#0"}} { for {set i 0} {[winfo exists ".census$i"]} {incr i} {} set TopLevel ".census$i" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "Census of $sects" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" # bindings bind $TopLevel.frame.text2 {NoFunction} # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global DoingCensus global OutWindow set DoingCensus 1 set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "census $sects" update idletasks SendCommand .status.command } # Procedure: DoCommoditiesSectors proc DoCommoditiesSectors {} { set sectors [InputBoxOne "Enter Sectors:"] if {$sectors == {}} {return} DoCommodities "$sectors" } # Procedure: DoCommodities proc DoCommodities { {sects "#0"}} { for {set i 0} {[winfo exists ".commodities$i"]} {incr i} {} set TopLevel ".commodities$i" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "Commodities of $sects" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" -width 85 # bindings bind $TopLevel.frame.text2 {NoFunction} # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global OutWindow set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "commodity $sects" update idletasks SendCommand .status.command } # Procedure: DoResourcesSectors proc DoResourcesSectors {} { set sectors [InputBoxOne "Enter Sectors:"] if {$sectors == {}} {return} DoResources "$sectors" } # Procedure: DoResources proc DoResources { {sects "#0"}} { for {set i 0} {[winfo exists ".resources$i"]} {incr i} {} set TopLevel ".resources$i" # $TopLevel # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget $TopLevel if {"[info procs XFEdit]" != ""} { catch "XFDestroy $TopLevel" } { catch "destroy $TopLevel" } toplevel $TopLevel # Window manager configurations global tkVersion wm positionfrom $TopLevel program wm sizefrom $TopLevel program wm maxsize $TopLevel 1000 768 wm minsize $TopLevel 10 10 wm title $TopLevel "Resources of $sects" # build widget $TopLevel.dismis button $TopLevel.dismis -text {Dismis} -state {disabled} -command " if {\"\[info procs XFEdit\]\" != \"\"} { catch \"XFDestroy $TopLevel\" } { catch \"destroy $TopLevel\" }" # build widget $TopLevel.frame frame $TopLevel.frame -relief {raised} # build widget $TopLevel.frame.scrollbar1 scrollbar $TopLevel.frame.scrollbar1 -command "$TopLevel.frame.text2 yview" -relief {raised} # build widget $TopLevel.frame.text2 text $TopLevel.frame.text2 -borderwidth {2} -relief {raised} -wrap {none} -yscrollcommand "$TopLevel.frame.scrollbar1 set" # bindings bind $TopLevel.frame.text2 {NoFunction} # pack widget $TopLevel.frame pack append $TopLevel.frame $TopLevel.frame.scrollbar1 {right frame center filly} $TopLevel.frame.text2 {top frame center expand fill} # pack widget $TopLevel pack append $TopLevel $TopLevel.frame {top frame center expand fill} $TopLevel.dismis {top frame center fill} $TopLevel.frame.text2 insert end {} # end of widget tree global OutWindow set OutWindow $TopLevel.frame.text2 .status.command delete 0 end .status.command insert end "resources $sects" update idletasks SendCommand .status.command } # Procedure: DoOutput proc DoOutput { code data} { global {PipeId} global {ReDirId} global C_Codes switch -exact $code \ $C_Codes(NOECHO) {}\ $C_Codes(FLUSH) {}\ $C_Codes(ABORT) {WindowPuts "Aborted\n"}\ $C_Codes(CMDERR) - \ $C_Codes(BADCMD) {WindowPuts "Error; "}\ $C_Codes(EXIT) {ExitWait $data}\ default {} if {$PipeId != {}} { puts $PipeId "$data" } elseif {$ReDirId != {}} { puts $ReDirId "$data" } else { WindowPuts "$data\n" global DoingMap if {$DoingMap} {TagMapData $data} WindowPickPlace end } } # Procedure: TagMapData proc TagMapData {line} { global OutWindow set width [string length $line] set twidth [lindex [$OutWindow config -width] 4] if {$twidth < $width || $twidth > [expr $width + 5]} { $OutWindow config -width $width } set lineno [lindex [split [$OutWindow index "end-1l"] {.}] 0] set length [expr [string length $line] - 1] for {set c 0} {$c < $length} {incr c} { set c1 [expr $c + 1] set c2 [expr $c + 2] switch -exact -- [string range $line $c $c1] { # BASICS {. } {$OutWindow tag add sea "$lineno.$c" "$lineno.$c2"} {^ } {$OutWindow tag add mountain "$lineno.$c" "$lineno.$c2"} {s } {$OutWindow tag add sanctuary "$lineno.$c" "$lineno.$c2"} {/ } {$OutWindow tag add wasteland "$lineno.$c" "$lineno.$c2"} {- } {$OutWindow tag add wilderness "$lineno.$c" "$lineno.$c2"} {c } {$OutWindow tag add capital "$lineno.$c" "$lineno.$c2"} {p } {$OutWindow tag add park "$lineno.$c" "$lineno.$c2"} # COMMUNICATIONS {+ } {$OutWindow tag add highway "$lineno.$c" "$lineno.$c2"} {) } {$OutWindow tag add radar "$lineno.$c" "$lineno.$c2"} {# } {$OutWindow tag add bridgehead "$lineno.$c" "$lineno.$c2"} {= } {$OutWindow tag add bridgespan "$lineno.$c" "$lineno.$c2"} # INDUSTRIES {d } {$OutWindow tag add defense "$lineno.$c" "$lineno.$c2"} {i } {$OutWindow tag add shell "$lineno.$c" "$lineno.$c2"} {m } {$OutWindow tag add mine "$lineno.$c" "$lineno.$c2"} {g } {$OutWindow tag add gold "$lineno.$c" "$lineno.$c2"} {h } {$OutWindow tag add harbor "$lineno.$c" "$lineno.$c2"} {w } {$OutWindow tag add warehouse "$lineno.$c" "$lineno.$c2"} {u } {$OutWindow tag add uranium "$lineno.$c" "$lineno.$c2"} {* } {$OutWindow tag add airfield "$lineno.$c" "$lineno.$c2"} {a } {$OutWindow tag add agribusiness "$lineno.$c" "$lineno.$c2"} {o } {$OutWindow tag add oil "$lineno.$c" "$lineno.$c2"} {j } {$OutWindow tag add light "$lineno.$c" "$lineno.$c2"} {k } {$OutWindow tag add heavy "$lineno.$c" "$lineno.$c2"} {% } {$OutWindow tag add refinery "$lineno.$c" "$lineno.$c2"} # MILITARY / SCIENTIFIC {t } {$OutWindow tag add technical "$lineno.$c" "$lineno.$c2"} {f } {$OutWindow tag add fortress "$lineno.$c" "$lineno.$c2"} {r } {$OutWindow tag add research "$lineno.$c" "$lineno.$c2"} {n } {$OutWindow tag add nuclear "$lineno.$c" "$lineno.$c2"} {l } {$OutWindow tag add library "$lineno.$c" "$lineno.$c2"} {e } {$OutWindow tag add enlistment "$lineno.$c" "$lineno.$c2"} {! } {$OutWindow tag add headquarters "$lineno.$c" "$lineno.$c2"} # FINANCIAL {b } {$OutWindow tag add bank "$lineno.$c" "$lineno.$c2"} } } if {[expr $lineno % 10] == 0} {update idletasks} } # Procedure: DoPipe proc DoPipe { data} { global PipeId if {$PipeId != {}} { catch "close $PipeId" set PipeId {} } set data [string trimleft $data] if {[string trimleft [string range $data 1 end]] == {}} { tkerror "Null program name after redirect" return } if {[catch "open $data w" outfd]} { tkerror "Pipe open failed" return } set PipeId outfd } # Procedure: DoPrompt proc DoPrompt { data} { global ReDirId global PipeId if {$ReDirId != {}} { catch "close $ReDirId" set ReDirId {} } if {$PipeId != {}} { catch "close $PipeId" set PipeId {} } global OutWindow if {$OutWindow != {.frame.text2}} { global DoingMap if {$DoingMap} { FinMap set DoingMap 0 } set toplevel [winfo parent [winfo parent $OutWindow]] catch "$toplevel.dismis configure -state normal" set OutWindow {.frame.text2} } scan $data {%d %d} nbtu nmin global Prompt set Prompt [format {[%d:%d] Command : } $nbtu $nmin] focus .status.command } # Procedure: DoRedir proc DoRedir { data} { global ReDirId if {$ReDirId != {}} { catch "close $ReDirId" set ReDirId {} } set data [string trimleft $data] puts stderr "*** data = '$data'" set how [string index $data 1] if {$how == ">" || $how == "!"} { set name [string trimleft [string range $data 2 end]] } else { set name [string trimleft [string range $data 1 end]] } set mode "w" set perm "0600" if {$name == ""} { tkerror "Null file name after redirect" return } set exists [file exists $name] if {$how == ">"} { set mode "a" if {!$exists} { set mode "w" } } elseif {$how != "!"} { if {$exists} { tkerror "File '$name' already exists!" return } } if {[catch "open $name $mode $perm" outfd]} { tkerror "Redirect open failed: $outfd" return } else { set ReDirId $outfd } } # Procedure: ExitWait proc ExitWait { {message ""}} { global EmpireFileId removeinput $EmpireFileId close $EmpireFileId set EmpireFileId {} # .exitWait # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .exitWait if {"[info procs XFEdit]" != ""} { catch "XFDestroy .exitWait" } { catch "destroy .exitWait" } toplevel .exitWait # Window manager configurations global tkVersion wm positionfrom .exitWait program wm sizefrom .exitWait program wm maxsize .exitWait 1000 768 wm minsize .exitWait 10 10 if {$tkVersion >= 3.0} { wm protocol .exitWait WM_DELETE_WINDOW {exit} } wm title .exitWait {Exiting} wm transient .exitWait . # build widget .exitWait.ok button .exitWait.ok -command {exit} -text {ok} # build widget .exitWait.theMessage message .exitWait.theMessage -aspect {1500} -padx {5} -pady {2} -text "$message" # pack widget .exitWait pack append .exitWait .exitWait.theMessage {top frame center expand fillx} .exitWait.ok {top frame center expand fillx} # end of widget tree } # Procedure: Expect proc Expect { expectedcode {bufname ""}} { global EmpireFileId if {[gets $EmpireFileId line] <= 0} {return 0} set code [string index $line 0] set data [string range $line 2 end] if {$bufname != {}} { uplevel 1 "set $bufname \{$data\}" } if {$code == $expectedcode} { return 1 } else { return 0 } } # Procedure: FSBox proc FSBox { {fsBoxMessage "Select file:"} {fsBoxFileName ""} {fsBoxActionOk ""} {fsBoxActionCancel ""}} { # xf ignore me 5 ########## # Procedure: FSBox # Description: show file selector box # Arguments: fsBoxMessage - the text to display # fsBoxFileName - a file name that should be selected # fsBoxActionOk - the action that should be performed on ok # fsBoxActionCancel - the action that should be performed on cancel # Returns: the filename that was selected, or nothing # Sideeffects: none ########## # # global fsBox(activeBackground) - active background color # global fsBox(activeForeground) - active foreground color # global fsBox(background) - background color # global fsBox(font) - text font # global fsBox(foreground) - foreground color # global fsBox(extensions) - scan directory for extensions # global fsBox(scrollActiveForeground) - scrollbar active background color # global fsBox(scrollBackground) - scrollbar background color # global fsBox(scrollForeground) - scrollbar foreground color # global fsBox(scrollSide) - side where scrollbar is located global fsBox set tmpButtonOpt "" set tmpFrameOpt "" set tmpMessageOpt "" set tmpScaleOpt "" set tmpScrollOpt "" if {"$fsBox(activeBackground)" != ""} { append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" " } if {"$fsBox(activeForeground)" != ""} { append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" " } if {"$fsBox(background)" != ""} { append tmpButtonOpt "-background \"$fsBox(background)\" " append tmpFrameOpt "-background \"$fsBox(background)\" " append tmpMessageOpt "-background \"$fsBox(background)\" " } if {"$fsBox(font)" != ""} { append tmpButtonOpt "-font \"$fsBox(font)\" " append tmpMessageOpt "-font \"$fsBox(font)\" " } if {"$fsBox(foreground)" != ""} { append tmpButtonOpt "-foreground \"$fsBox(foreground)\" " append tmpMessageOpt "-foreground \"$fsBox(foreground)\" " } if {"$fsBox(scrollActiveForeground)" != ""} { append tmpScrollOpt "-activeforeground \"$fsBox(scrollActiveForeground)\" " } if {"$fsBox(scrollBackground)" != ""} { append tmpScrollOpt "-background \"$fsBox(scrollBackground)\" " } if {"$fsBox(scrollForeground)" != ""} { append tmpScrollOpt "-foreground \"$fsBox(scrollForeground)\" " } if {[file exists [file tail $fsBoxFileName]] && [IsAFile [file tail $fsBoxFileName]]} { set fsBox(name) [file tail $fsBoxFileName] } { set fsBox(name) "" } if {[file exists $fsBoxFileName] && [IsADir $fsBoxFileName]} { set fsBox(path) $fsBoxFileName } { if {"[file rootname $fsBoxFileName]" != "."} { set fsBox(path) [file rootname $fsBoxFileName] } } if {$fsBox(showPixmap)} { set fsBox(path) [string trimleft $fsBox(path) @] } if {"$fsBox(path)" != "" && [file exists $fsBox(path)] && [IsADir $fsBox(path)]} { set fsBox(internalPath) $fsBox(path) } { if {"$fsBox(internalPath)" == "" || ![file exists $fsBox(internalPath)]} { set fsBox(internalPath) [pwd] } } # build widget structure # start build of toplevel if {"[info commands XFDestroy]" != ""} { catch {XFDestroy .fsBox} } { catch {destroy .fsBox} } toplevel .fsBox -borderwidth 0 catch ".fsBox config $tmpFrameOpt" wm geometry .fsBox 350x300 wm title .fsBox {File select box} wm maxsize .fsBox 1000 1000 wm minsize .fsBox 100 100 # end build of toplevel label .fsBox.message1 -anchor c -relief raised -text "$fsBoxMessage" catch ".fsBox.message1 config $tmpMessageOpt" frame .fsBox.frame1 -borderwidth 0 -relief raised catch ".fsBox.frame1 config $tmpFrameOpt" button .fsBox.frame1.ok -text "OK" -command " global fsBox set fsBox(name) \[.fsBox.file.file get\] if {$fsBox(showPixmap)} { set fsBox(path) @\[.fsBox.path.path get\] } { set fsBox(path) \[.fsBox.path.path get\] } set fsBox(internalPath) \[.fsBox.path.path get\] $fsBoxActionOk if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy .fsBox} } { catch {destroy .fsBox} }" catch ".fsBox.frame1.ok config $tmpButtonOpt" button .fsBox.frame1.rescan -text "Rescan" -command { global fsBox FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)} catch ".fsBox.frame1.rescan config $tmpButtonOpt" button .fsBox.frame1.cancel -text "Cancel" -command " global fsBox set fsBox(name) {} set fsBox(path) {} $fsBoxActionCancel if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy .fsBox} } { catch {destroy .fsBox} }" catch ".fsBox.frame1.cancel config $tmpButtonOpt" if {$fsBox(showPixmap)} { frame .fsBox.frame2 -borderwidth 0 -relief raised catch ".fsBox.frame2 config $tmpFrameOpt" scrollbar .fsBox.frame2.scrollbar3 -command {.fsBox.frame2.canvas2 xview} -orient {horizontal} -relief {raised} catch ".fsBox.frame2.scrollbar3 config $tmpScrollOpt" scrollbar .fsBox.frame2.scrollbar1 -command {.fsBox.frame2.canvas2 yview} -relief {raised} catch ".fsBox.frame2.scrollbar1 config $tmpScrollOpt" canvas .fsBox.frame2.canvas2 -confine {true} -relief {raised} -scrollregion {0c 0c 20c 20c} -width {100} -xscrollcommand {.fsBox.frame2.scrollbar3 set} -yscrollcommand {.fsBox.frame2.scrollbar1 set} catch ".fsBox.frame2.canvas2 config $tmpFrameOpt" .fsBox.frame2.canvas2 addtag currentBitmap withtag [.fsBox.frame2.canvas2 create bitmap 5 5 -anchor nw] } frame .fsBox.path -borderwidth 0 -relief raised catch ".fsBox.path config $tmpFrameOpt" frame .fsBox.path.paths -borderwidth 2 -relief raised catch ".fsBox.path.paths config $tmpFrameOpt" menubutton .fsBox.path.paths.paths -borderwidth 0 -menu ".fsBox.path.paths.paths.menu" -relief flat -text "Pathname:" catch ".fsBox.path.paths.paths config $tmpButtonOpt" menu .fsBox.path.paths.paths.menu catch ".fsBox.path.paths.paths.menu config $tmpButtonOpt" .fsBox.path.paths.paths.menu add command -label "[string trimright $fsBox(internalPath) {/@}]" -command " global fsBox FSBoxFSShow \[.fsBox.path.path get\] \[.fsBox.pattern.pattern get\] \$fsBox(all) .fsBox.path.path delete 0 end .fsBox.path.path insert 0 [string trimright $fsBox(internalPath) {/@}]" entry .fsBox.path.path -relief raised catch ".fsBox.path.path config $tmpMessageOpt" if {![IsADir $fsBox(internalPath)]} { set $fsBox(internalPath) [pwd] } .fsBox.path.path insert 0 $fsBox(internalPath) frame .fsBox.pattern -borderwidth 0 -relief raised catch ".fsBox.pattern config $tmpFrameOpt" frame .fsBox.pattern.patterns -borderwidth 2 -relief raised catch ".fsBox.pattern.patterns config $tmpFrameOpt" menubutton .fsBox.pattern.patterns.patterns -borderwidth 0 -menu ".fsBox.pattern.patterns.patterns.menu" -relief flat -text "Selection pattern:" catch ".fsBox.pattern.patterns.patterns config $tmpButtonOpt" menu .fsBox.pattern.patterns.patterns.menu catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt" .fsBox.pattern.patterns.patterns.menu add checkbutton -label "Scan extensions" -variable fsBoxExtensions -command { global fsBox FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)} entry .fsBox.pattern.pattern -relief raised catch ".fsBox.pattern.pattern config $tmpMessageOpt" .fsBox.pattern.pattern insert 0 $fsBox(pattern) frame .fsBox.files -borderwidth 0 -relief raised catch ".fsBox.files config $tmpFrameOpt" scrollbar .fsBox.files.vscroll -relief raised -command ".fsBox.files.files yview" catch ".fsBox.files.vscroll config $tmpScrollOpt" scrollbar .fsBox.files.hscroll -orient horiz -relief raised -command ".fsBox.files.files xview" catch ".fsBox.files.hscroll config $tmpScrollOpt" listbox .fsBox.files.files -exportselection false -relief raised -xscrollcommand ".fsBox.files.hscroll set" -yscrollcommand ".fsBox.files.vscroll set" catch ".fsBox.files.files config $tmpMessageOpt" frame .fsBox.file -borderwidth 0 -relief raised catch ".fsBox.file config $tmpFrameOpt" label .fsBox.file.labelfile -relief raised -text "Filename:" catch ".fsBox.file.labelfile config $tmpMessageOpt" entry .fsBox.file.file -relief raised catch ".fsBox.file.file config $tmpMessageOpt" .fsBox.file.file delete 0 end .fsBox.file.file insert 0 $fsBox(name) checkbutton .fsBox.pattern.all -offvalue 0 -onvalue 1 -text "Show all files" -variable fsBox(all) -command { global fsBox FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)} catch ".fsBox.pattern.all config $tmpButtonOpt" FSBoxFSShow $fsBox(internalPath) $fsBox(pattern) $fsBox(all) # bindings bind .fsBox.files.files " FSBoxFSFileSelectDouble %W $fsBox(showPixmap) \{$fsBoxActionOk\} %y" bind .fsBox.files.files " FSBoxFSFileSelect %W $fsBox(showPixmap) %y" bind .fsBox.files.files " FSBoxFSFileSelect %W $fsBox(showPixmap) %y" bind .fsBox.files.files " FSBoxFSFileSelect %W $fsBox(showPixmap) %y" bind .fsBox.files.files " FSBoxFSFileSelect %W $fsBox(showPixmap) %y" bind .fsBox.path.path { FSBoxFSNameComplete path} bind .fsBox.path.path { global tkVersion global fsBox FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all) FSBoxFSInsertPath if {$tkVersion >= 3.0} { .fsBox.file.file icursor end } { .fsBox.file.file cursor end } focus .fsBox.file.file} catch "bind .fsBox.path.path {}" bind .fsBox.path.path { global tkVersion if {$tkVersion >= 3.0} { .fsBox.file.file icursor end } { .fsBox.file.file cursor end } focus .fsBox.file.file} bind .fsBox.file.file { FSBoxFSNameComplete file} bind .fsBox.file.file " global fsBox set fsBox(name) \[.fsBox.file.file get\] if {$fsBox(showPixmap)} { set fsBox(path) @\[.fsBox.path.path get\] } { set fsBox(path) \[.fsBox.path.path get\] } set fsBox(internalPath) \[.fsBox.path.path get\] $fsBoxActionOk if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy .fsBox} } { catch {destroy .fsBox} }" bind .fsBox.file.file { global tkVersion if {$tkVersion >= 3.0} { .fsBox.path.path icursor end } { .fsBox.path.path cursor end } focus .fsBox.path.path} bind .fsBox.file.file { global tkVersion if {$tkVersion >= 3.0} { .fsBox.pattern.pattern icursor end } { .fsBox.pattern.pattern cursor end } focus .fsBox.pattern.pattern} bind .fsBox.pattern.pattern { global fsBox FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)} bind .fsBox.pattern.pattern { global tkVersion if {$tkVersion >= 3.0} { .fsBox.file.file icursor end } { .fsBox.file.file cursor end } focus .fsBox.file.file} catch "bind .fsBox.pattern.pattern {}" # packing pack append .fsBox.files .fsBox.files.vscroll "$fsBox(scrollSide) filly" .fsBox.files.hscroll {bottom fillx} .fsBox.files.files {left fill expand} pack append .fsBox.file .fsBox.file.labelfile {left} .fsBox.file.file {left fill expand} pack append .fsBox.frame1 .fsBox.frame1.ok {left fill expand} .fsBox.frame1.rescan {left fill expand} .fsBox.frame1.cancel {left fill expand} pack append .fsBox.path.paths .fsBox.path.paths.paths {left} pack append .fsBox.pattern.patterns .fsBox.pattern.patterns.patterns {left} pack append .fsBox.path .fsBox.path.paths {left} .fsBox.path.path {left fill expand} pack append .fsBox.pattern .fsBox.pattern.patterns {left} .fsBox.pattern.all {right fill} .fsBox.pattern.pattern {left fill expand} if {$fsBox(showPixmap)} { pack append .fsBox.frame2 .fsBox.frame2.scrollbar1 {left filly} .fsBox.frame2.canvas2 {top expand fill} .fsBox.frame2.scrollbar3 {top fillx} pack append .fsBox .fsBox.message1 {top fill} .fsBox.frame1 {bottom fill} .fsBox.pattern {bottom fill} .fsBox.file {bottom fill} .fsBox.path {bottom fill} .fsBox.frame2 {right fill} .fsBox.files {left fill expand} } { pack append .fsBox .fsBox.message1 {top fill} .fsBox.frame1 {bottom fill} .fsBox.pattern {bottom fill} .fsBox.file {bottom fill} .fsBox.path {bottom fill} .fsBox.files {left fill expand} } if {"$fsBoxActionOk" == "" && "$fsBoxActionCancel" == ""} { # wait for the box to be destroyed update idletask grab .fsBox tkwait window .fsBox if {"[string trim $fsBox(path)]" != "" || "[string trim $fsBox(name)]" != ""} { if {"[string trimleft [string trim $fsBox(name)] /]" == ""} { return [string trimright [string trim $fsBox(path)] /] } { return [string trimright [string trim $fsBox(path)] /]/[string trimleft [string trim $fsBox(name)] /] } } } } # Procedure: FSBoxBindSelectOne proc FSBoxBindSelectOne { fsBoxW fsBoxY} { # xf ignore me 6 set fsBoxNearest [$fsBoxW nearest $fsBoxY] if {$fsBoxNearest >= 0} { $fsBoxW select from $fsBoxNearest $fsBoxW select to $fsBoxNearest } } # Procedure: FSBoxFSFileSelect proc FSBoxFSFileSelect { fsBoxW fsBoxShowPixmap fsBoxY} { # xf ignore me 6 global fsBox FSBoxBindSelectOne $fsBoxW $fsBoxY set fsBoxNearest [$fsBoxW nearest $fsBoxY] if {$fsBoxNearest >= 0} { set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest] if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "/" || "[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "@"} { set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]] if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] && ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} { set fsBoxFileName $fsBoxTmpEntry } } { if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "*"} { set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]] if {![file executable $fsBox(internalPath)/$fsBoxFileName]} { set fsBoxFileName $fsBoxTmpEntry } } { set fsBoxFileName $fsBoxTmpEntry } } if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} { set fsBox(name) $fsBoxFileName .fsBox.file.file delete 0 end .fsBox.file.file insert 0 $fsBox(name) if {$fsBoxShowPixmap} { catch ".fsBox.frame2.canvas2 itemconfigure currentBitmap -bitmap \"@$fsBox(internalPath)/$fsBox(name)\"" } } } } # Procedure: FSBoxFSFileSelectDouble proc FSBoxFSFileSelectDouble { fsBoxW fsBoxShowPixmap fsBoxAction fsBoxY} { # xf ignore me 6 global fsBox FSBoxBindSelectOne $fsBoxW $fsBoxY set fsBoxNearest [$fsBoxW nearest $fsBoxY] if {$fsBoxNearest >= 0} { set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest] if {"$fsBoxTmpEntry" == "../"} { set fsBoxTmpEntry [string trimright [string trim $fsBox(internalPath)] "@/"] if {"$fsBoxTmpEntry" == ""} { return } FSBoxFSShow [file dirname $fsBoxTmpEntry] [.fsBox.pattern.pattern get] $fsBox(all) .fsBox.path.path delete 0 end .fsBox.path.path insert 0 $fsBox(internalPath) } { if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "/" || "[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "@"} { set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]] if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] && ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} { set fsBoxFileName $fsBoxTmpEntry } } { if {"[string index $fsBoxTmpEntry [expr [string length $fsBoxTmpEntry]-1]]" == "*"} { set fsBoxFileName [string range $fsBoxTmpEntry 0 [expr [string length $fsBoxTmpEntry]-2]] if {![file executable $fsBox(internalPath)/$fsBoxFileName]} { set fsBoxFileName $fsBoxTmpEntry } } { set fsBoxFileName $fsBoxTmpEntry } } if {[IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} { set fsBox(internalPath) "[string trimright $fsBox(internalPath) {/@}]/$fsBoxFileName" FSBoxFSShow $fsBox(internalPath) [.fsBox.pattern.pattern get] $fsBox(all) .fsBox.path.path delete 0 end .fsBox.path.path insert 0 $fsBox(internalPath) } { set fsBox(name) $fsBoxFileName if {$fsBoxShowPixmap} { set fsBox(path) @$fsBox(internalPath) } { set fsBox(path) $fsBox(internalPath) } if {"$fsBoxAction" != ""} { eval "global fsBox; $fsBoxAction" } if {"[info commands XFDestroy]" != ""} { catch {XFDestroy .fsBox} } { catch {destroy .fsBox} } } } } } # Procedure: FSBoxFSInsertPath proc FSBoxFSInsertPath {} { # xf ignore me 6 global fsBox set fsBoxLast [.fsBox.path.paths.paths.menu index last] set fsBoxNewEntry [string trimright [.fsBox.path.path get] "/@"] for {set fsBoxCounter 0} {$fsBoxCounter <= $fsBoxLast} {incr fsBoxCounter 1} { if {"$fsBoxNewEntry" == "[lindex [.fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -label] 4]"} { return } } if {$fsBoxLast < 9} { .fsBox.path.paths.paths.menu add command -label "$fsBoxNewEntry" -command " global fsBox FSBoxFSShow $fsBoxNewEntry \[.fsBox.pattern.pattern get\] \$fsBox(all) .fsBox.path.path delete 0 end .fsBox.path.path insert 0 $fsBoxNewEntry" } { for {set fsBoxCounter 0} {$fsBoxCounter < $fsBoxLast} {incr fsBoxCounter 1} { .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -label [lindex [.fsBox.path.paths.paths.menu entryconfigure [expr $fsBoxCounter+1] -label] 4] .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -command " global fsBox FSBoxFSShow [lindex [.fsBox.path.paths.paths.menu entryconfigure [expr $fsBoxCounter+1] -label] 4] \[.fsBox.pattern.pattern get\] \$fsBox(all) .fsBox.path.path delete 0 end .fsBox.path.path insert 0 [lindex [.fsBox.path.paths.paths.menu entryconfigure [expr $fsBoxCounter+1] -label] 4]" } .fsBox.path.paths.paths.menu entryconfigure $fsBoxLast -label "$fsBoxNewEntry" .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter -command " global fsBox FSBoxFSShow \[.fsBox.path.path get\] \[.fsBox.pattern.pattern get\] \$fsBox(all) .fsBox.path.path delete 0 end .fsBox.path.path insert 0 $fsBoxNewEntry" } } # Procedure: FSBoxFSNameComplete proc FSBoxFSNameComplete { fsBoxType} { # xf ignore me 6 global tkVersion global fsBox set fsBoxNewFile "" if {"$fsBoxType" == "path"} { set fsBoxDirName [file dirname [.fsBox.path.path get]] set fsBoxFileName [file tail [.fsBox.path.path get]] } { set fsBoxDirName [file dirname [.fsBox.path.path get]/] set fsBoxFileName [file tail [.fsBox.file.file get]] } set fsBoxNewFile "" if {[IsADir [string trimright $fsBoxDirName @]]} { catch "glob -nocomplain $fsBoxDirName/${fsBoxFileName}*" fsBoxResult foreach fsBoxCounter $fsBoxResult { if {"$fsBoxNewFile" == ""} { set fsBoxNewFile [file tail $fsBoxCounter] } { if {"[string index [file tail $fsBoxCounter] 0]" != "[string index $fsBoxNewFile 0]"} { set fsBoxNewFile "" break } set fsBoxCounter1 0 set fsBoxTmpFile1 $fsBoxNewFile set fsBoxTmpFile2 [file tail $fsBoxCounter] set fsBoxLength1 [string length $fsBoxTmpFile1] set fsBoxLength2 [string length $fsBoxTmpFile2] set fsBoxNewFile "" if {$fsBoxLength1 > $fsBoxLength2} { set fsBoxLength1 $fsBoxLength2 } while {$fsBoxCounter1 < $fsBoxLength1} { if {"[string index $fsBoxTmpFile1 $fsBoxCounter1]" == "[string index $fsBoxTmpFile2 $fsBoxCounter1]"} { append fsBoxNewFile [string index $fsBoxTmpFile1 $fsBoxCounter1] } { break } incr fsBoxCounter1 1 } } } } if {"$fsBoxNewFile" != ""} { if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]] || ![IsAFile [string trimright $fsBoxDirName/$fsBoxNewFile @]]} { if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]]} { if {"$fsBoxDirName" == "/"} { .fsBox.path.path delete 0 end .fsBox.path.path insert 0 "/[string trimright [string trim $fsBoxNewFile /] @]/" } { .fsBox.path.path delete 0 end .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]/" } FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all) FSBoxFSInsertPath } { .fsBox.path.path delete 0 end .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]" } } { .fsBox.path.path delete 0 end .fsBox.path.path insert 0 "[string trimright $fsBoxDirName {@/}]/" .fsBox.file.file delete 0 end .fsBox.file.file insert 0 $fsBoxNewFile if {$tkVersion >= 3.0} { .fsBox.file.file icursor end } { .fsBox.file.file cursor end } focus .fsBox.file.file } } } # Procedure: FSBoxFSShow proc FSBoxFSShow { fsBoxPath fsBoxPattern fsBoxAll} { # xf ignore me 6 global fsBox set tmpButtonOpt "" if {"$fsBox(activeBackground)" != ""} { append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" " } if {"$fsBox(activeForeground)" != ""} { append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" " } if {"$fsBox(background)" != ""} { append tmpButtonOpt "-background \"$fsBox(background)\" " } if {"$fsBox(font)" != ""} { append tmpButtonOpt "-font \"$fsBox(font)\" " } if {"$fsBox(foreground)" != ""} { append tmpButtonOpt "-foreground \"$fsBox(foreground)\" " } set fsBox(pattern) $fsBoxPattern if {[file exists $fsBoxPath] && [file readable $fsBoxPath] && [IsADir $fsBoxPath]} { set fsBox(internalPath) $fsBoxPath } { if {[file exists $fsBoxPath] && [file readable $fsBoxPath] && [IsAFile $fsBoxPath]} { set fsBox(internalPath) [file dirname $fsBoxPath] .fsBox.file.file delete 0 end .fsBox.file.file insert 0 [file tail $fsBoxPath] set fsBoxPath $fsBox(internalPath) } { while {"$fsBoxPath" != "" && "$fsBoxPath" != "/" && ![file isdirectory $fsBoxPath]} { set fsBox(internalPath) [file dirname $fsBoxPath] set fsBoxPath $fsBox(internalPath) } } } if {"$fsBoxPath" == ""} { set fsBoxPath "/" set fsBox(internalPath) "/" } .fsBox.path.path delete 0 end .fsBox.path.path insert 0 $fsBox(internalPath) if {[.fsBox.files.files size] > 0} { .fsBox.files.files delete 0 end } if {$fsBoxAll} { if {[catch "exec ls -F -a $fsBoxPath" fsBoxResult]} { puts stderr "$fsBoxResult" } } { if {[catch "exec ls -F $fsBoxPath" fsBoxResult]} { puts stderr "$fsBoxResult" } } set fsBoxElementList [lsort $fsBoxResult] foreach fsBoxCounter [winfo children .fsBox.pattern.patterns.patterns] { if {[string length [info commands XFDestroy]] > 0} { catch {XFDestroy $fsBoxCounter} } { catch {destroy $fsBoxCounter} } } menu .fsBox.pattern.patterns.patterns.menu catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt" if {$fsBox(extensions)} { .fsBox.pattern.patterns.patterns.menu add command -label "*" -command { global fsBox set fsBox(pattern) "*" .fsBox.pattern.pattern delete 0 end .fsBox.pattern.pattern insert 0 $fsBox(pattern) FSBoxFSShow [.fsBox.path.path get] $fsBox(pattern) $fsBox(all)} } if {"$fsBoxPath" != "/"} { .fsBox.files.files insert end "../" } foreach fsBoxCounter $fsBoxElementList { if {[string match $fsBoxPattern $fsBoxCounter] || [IsADir [string trimright $fsBoxPath/$fsBoxCounter "/@"]]} { if {"$fsBoxCounter" != "../" && "$fsBoxCounter" != "./"} { .fsBox.files.files insert end $fsBoxCounter } } if {$fsBox(extensions)} { catch "file rootname $fsBoxCounter" fsBoxRootName catch "file extension $fsBoxCounter" fsBoxExtension set fsBoxExtension [string trimright $fsBoxExtension "/*@"] if {"$fsBoxExtension" != "" && "$fsBoxRootName" != ""} { set fsBoxInsert 1 set fsBoxLast [.fsBox.pattern.patterns.patterns.menu index last] for {set fsBoxCounter1 0} {$fsBoxCounter1 <= $fsBoxLast} {incr fsBoxCounter1 1} { if {"*$fsBoxExtension" == "[lindex [.fsBox.pattern.patterns.patterns.menu entryconfigure $fsBoxCounter1 -label] 4]"} { set fsBoxInsert 0 } } if {$fsBoxInsert} { .fsBox.pattern.patterns.patterns.menu add command -label "*$fsBoxExtension" -command " global fsBox set fsBox(pattern) \"*$fsBoxExtension\" .fsBox.pattern.pattern delete 0 end .fsBox.pattern.pattern insert 0 \$fsBox(pattern) FSBoxFSShow \[.fsBox.path.path get\] \$fsBox(pattern) \$fsBox(all)" } } } } if {$fsBox(extensions)} { .fsBox.pattern.patterns.patterns.menu add separator } if {$fsBox(extensions) || "[.fsBox.pattern.patterns.patterns.menu index last]" == "none"} { .fsBox.pattern.patterns.patterns.menu add checkbutton -label "Scan extensions" -variable "fsBox(extensions)" -command { global fsBox FSBoxFSShow [.fsBox.path.path get] [.fsBox.pattern.pattern get] $fsBox(all)} } } # Procedure: FinMap proc FinMap {} { global OutWindow $OutWindow tag configure sea -background "sky blue" $OutWindow tag configure mountain -background black -foreground white -relief raised $OutWindow tag configure sanctuary -background white $OutWindow tag configure wasteland -background brown -foreground white $OutWindow tag configure wilderness -background "dark green" -foreground white $OutWindow tag configure capital -background white -foreground green $OutWindow tag configure park -background green -foreground white $OutWindow tag configure highway -background brown -foreground yellow $OutWindow tag configure radar -background white -foreground red $OutWindow tag configure bridgehead -background brown -foreground gray $OutWindow tag configure bridgespan -background brown -foreground gray $OutWindow tag configure defense -background white -foreground orange $OutWindow tag configure shell -background white -foreground red $OutWindow tag configure mine -background black -foreground "indian red" $OutWindow tag configure gold -background black -foreground gold $OutWindow tag configure harbor -background "sky blue" -foreground orange $OutWindow tag configure warehouse -background brown -foreground blue $OutWindow tag configure uranium -background black -foreground violet $OutWindow tag configure airfield -background brown -foreground blue $OutWindow tag configure agribusiness -background brown -foreground green $OutWindow tag configure oil -background yellow -foreground black $OutWindow tag configure light -background grey -foreground black $OutWindow tag configure heavy -background grey -foreground brown $OutWindow tag configure refinery -background black -foreground yellow $OutWindow tag configure technical -background grey -foreground red $OutWindow tag configure fortress -background brown -foreground "olive drab" $OutWindow tag configure research -background grey -foreground blue $OutWindow tag configure nuclear -background violet -foreground black $OutWindow tag configure library -background grey -foreground "orange red" $OutWindow tag configure enlistment -background grey -foreground "olive drab" $OutWindow tag configure headquarters -background "olive drab" -foreground brown } # Procedure: GetCountryAndRepresentitive proc GetCountryAndRepresentitive {} { global Representitive global Country # .startPopUp # The above line makes pasting MUCH easier for me. # It contains the pathname of the cutted widget. # Tcl version: 7.3 (Tcl/Tk/XF) # Tk version: 3.6 # XF version: $__lastrelease$ # # build widget .startPopUp if {"[info procs XFEdit]" != ""} { catch "XFDestroy .startPopUp" } { catch "destroy .startPopUp" } toplevel .startPopUp # Window manager configurations global tkVersion wm positionfrom .startPopUp program wm sizefrom .startPopUp program wm maxsize .startPopUp 1000 768 wm minsize .startPopUp 10 10 if {$tkVersion >= 3.0} { wm protocol .startPopUp WM_DELETE_WINDOW {exit} } if {$tkVersion >= 3.0} { wm protocol .startPopUp WM_SAVE_YOURSELF {exit} } wm title .startPopUp {Enter Country And Representative} wm transient .startPopUp . # build widget .startPopUp.buttons frame .startPopUp.buttons -borderwidth {2} -relief {raised} # build widget .startPopUp.buttons.button10 button .startPopUp.buttons.button10 -command {exit} -text {Cancel} # build widget .startPopUp.buttons.button11 button .startPopUp.buttons.button11 -text {Help}\ -command { global alertBox set alertBox(justify) {left} AlertBox "Enter the name of your country and your representative name. The representative name is echoed with '*' characters." "" "400x60" "Startup Help" } # build widget .startPopUp.buttons.ok button .startPopUp.buttons.ok -command { global Country set Country "[.startPopUp.countryFrame.country get]" if {"[info procs XFEdit]" != ""} { catch "XFDestroy .startPopUp" } { catch "destroy .startPopUp" } } -text {OK} # pack widget .startPopUp.buttons pack append .startPopUp.buttons .startPopUp.buttons.ok {left frame center expand} .startPopUp.buttons.button10 {left frame center expand} .startPopUp.buttons.button11 {right frame center expand} # build widget .startPopUp.countryFrame frame .startPopUp.countryFrame -borderwidth {2} # build widget .startPopUp.countryFrame.country entry .startPopUp.countryFrame.country -relief {sunken} # bindings bind .startPopUp.countryFrame.country {focus .startPopUp.repFrame.entry8} # build widget .startPopUp.countryFrame.label5 label .startPopUp.countryFrame.label5 -text {Country:} # pack widget .startPopUp.countryFrame pack append .startPopUp.countryFrame .startPopUp.countryFrame.label5 {left frame center} .startPopUp.countryFrame.country {left frame center expand fillx} # build widget .startPopUp.label1 label .startPopUp.label1 -font {-Adobe-Helvetica-Bold-R-Normal--*-240-*} -text {Enter Country Name and Representitive} # build widget .startPopUp.repFrame frame .startPopUp.repFrame -borderwidth {2} # build widget .startPopUp.repFrame.entry8 entry .startPopUp.repFrame.entry8 -relief {sunken} # bindings bind .startPopUp.repFrame.entry8 { if {%s > 1} { } else { if {[string length "%K"] > 1} { } else { %W insert end "*" global Representitive set Representitive [join [list "$Representitive" "%K"] {}] } } } bind .startPopUp.repFrame.entry8 {%W delete 0 end global Representitive set Representitive {}} bind .startPopUp.repFrame.entry8 {%W delete [expr [%W index end] - 1] global Representitive set Representitive [string range $Representitive 0 [expr [string length $Representitive] - 2]} bind .startPopUp.repFrame.entry8 {.startPopUp.buttons.ok invoke} # build widget .startPopUp.repFrame.label7 label .startPopUp.repFrame.label7 -text {Representitive} # pack widget .startPopUp.repFrame pack append .startPopUp.repFrame .startPopUp.repFrame.label7 {left frame center} .startPopUp.repFrame.entry8 {left frame center expand fillx} # pack widget .startPopUp pack append .startPopUp .startPopUp.label1 {top frame center} .startPopUp.countryFrame {top frame center fillx} .startPopUp.repFrame {top frame center fillx} .startPopUp.buttons {top frame center fillx} .startPopUp.countryFrame.country insert end "$Country" .startPopUp.repFrame.entry8 insert end [Stars [string length $Representitive]] # end of widget tree update idletasks focus .startPopUp.countryFrame.country grab .startPopUp tkwait window .startPopUp } # Procedure: InputBoxInternal proc InputBoxInternal { inputBoxMessage inputBoxCommandOk inputBoxCommandCancel inputBoxGeometry inputBoxTitle lineNum} { # xf ignore me 6 global inputBox set tmpButtonOpt "" set tmpFrameOpt "" set tmpMessageOpt "" set tmpScaleOpt "" set tmpScrollOpt "" if {"$inputBox(activeBackground)" != ""} { append tmpButtonOpt "-activebackground \"$inputBox(activeBackground)\" " } if {"$inputBox(activeForeground)" != ""} { append tmpButtonOpt "-activeforeground \"$inputBox(activeForeground)\" " } if {"$inputBox(background)" != ""} { append tmpButtonOpt "-background \"$inputBox(background)\" " append tmpFrameOpt "-background \"$inputBox(background)\" " append tmpMessageOpt "-background \"$inputBox(background)\" " } if {"$inputBox(font)" != ""} { append tmpButtonOpt "-font \"$inputBox(font)\" " append tmpMessageOpt "-font \"$inputBox(font)\" " } if {"$inputBox(foreground)" != ""} { append tmpButtonOpt "-foreground \"$inputBox(foreground)\" " append tmpMessageOpt "-foreground \"$inputBox(foreground)\" " } if {"$inputBox(scrollActiveForeground)" != ""} { append tmpScrollOpt "-activeforeground \"$inputBox(scrollActiveForeground)\" " } if {"$inputBox(scrollBackground)" != ""} { append tmpScrollOpt "-background \"$inputBox(scrollBackground)\" " } if {"$inputBox(scrollForeground)" != ""} { append tmpScrollOpt "-foreground \"$inputBox(scrollForeground)\" " } # start build of toplevel if {"[info commands XFDestroy]" != ""} { catch {XFDestroy $inputBox(toplevelName)} } { catch {destroy $inputBox(toplevelName)} } toplevel $inputBox(toplevelName) -borderwidth 0 catch "$inputBox(toplevelName) config $tmpFrameOpt" if {[catch "wm geometry $inputBox(toplevelName) $inputBoxGeometry"]} { wm geometry $inputBox(toplevelName) 350x150 } wm title $inputBox(toplevelName) $inputBoxTitle wm maxsize $inputBox(toplevelName) 1000 1000 wm minsize $inputBox(toplevelName) 100 100 # end build of toplevel message $inputBox(toplevelName).message1 -anchor "$inputBox(anchor)" -justify "$inputBox(justify)" -relief raised -text "$inputBoxMessage" catch "$inputBox(toplevelName).message1 config $tmpMessageOpt" set xfTmpWidth [string range $inputBoxGeometry 0 [expr [string first x $inputBoxGeometry]-1]] if {"$xfTmpWidth" != ""} { # set message size catch "$inputBox(toplevelName).message1 configure -width [expr $xfTmpWidth-10]" } { $inputBox(toplevelName).message1 configure -aspect 1500 } frame $inputBox(toplevelName).frame0 -borderwidth 0 -relief raised catch "$inputBox(toplevelName).frame0 config $tmpFrameOpt" frame $inputBox(toplevelName).frame1 -borderwidth 0 -relief raised catch "$inputBox(toplevelName).frame1 config $tmpFrameOpt" if {$lineNum == 1} { scrollbar $inputBox(toplevelName).frame1.hscroll -orient "horizontal" -relief raised -command "$inputBox(toplevelName).frame1.input view" catch "$inputBox(toplevelName).frame1.hscroll config $tmpScrollOpt" entry $inputBox(toplevelName).frame1.input -relief raised -scrollcommand "$inputBox(toplevelName).frame1.hscroll set" catch "$inputBox(toplevelName).frame1.input config $tmpMessageOpt" $inputBox(toplevelName).frame1.input insert 0 $inputBox($inputBox(toplevelName),inputOne) # bindings bind $inputBox(toplevelName).frame1.input " global inputBox set inputBox($inputBox(toplevelName),inputOne) \[$inputBox(toplevelName).frame1.input get\] if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $inputBox(toplevelName)} } { catch {destroy $inputBox(toplevelName)} } $inputBoxCommandOk" # packing pack append $inputBox(toplevelName).frame1 $inputBox(toplevelName).frame1.hscroll {bottom fill} $inputBox(toplevelName).frame1.input {top fill expand} } { text $inputBox(toplevelName).frame1.input -relief raised -wrap none -borderwidth 2 -yscrollcommand "$inputBox(toplevelName).frame1.vscroll set" catch "$inputBox(toplevelName).frame1.input config $tmpMessageOpt" scrollbar $inputBox(toplevelName).frame1.vscroll -relief raised -command "$inputBox(toplevelName).frame1.input yview" catch "$inputBox(toplevelName).frame1.vscroll config $tmpScrollOpt" $inputBox(toplevelName).frame1.input insert 1.0 $inputBox($inputBox(toplevelName),inputMulti) # bindings bind $inputBox(toplevelName).frame1.input " global inputBox set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\] if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $inputBox(toplevelName)} } { catch {destroy $inputBox(toplevelName)} } $inputBoxCommandOk" bind $inputBox(toplevelName).frame1.input " global inputBox set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\] if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $inputBox(toplevelName)} } { catch {destroy $inputBox(toplevelName)} } $inputBoxCommandOk" # packing pack append $inputBox(toplevelName).frame1 $inputBox(toplevelName).frame1.vscroll "$inputBox(scrollSide) filly" $inputBox(toplevelName).frame1.input {left fill expand} } button $inputBox(toplevelName).frame0.button0 -text "OK" -command " global inputBox if {$lineNum == 1} { set inputBox($inputBox(toplevelName),inputOne) \[$inputBox(toplevelName).frame1.input get\] } { set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\] } if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $inputBox(toplevelName)} } { catch {destroy $inputBox(toplevelName)} } $inputBoxCommandOk" catch "$inputBox(toplevelName).frame0.button0 config $tmpButtonOpt" button $inputBox(toplevelName).frame0.button1 -text "Cancel" -command " global inputBox if {$lineNum == 1} { set inputBox($inputBox(toplevelName),inputOne) \"\" } { set inputBox($inputBox(toplevelName),inputMulti) \"\" } if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $inputBox(toplevelName)} } { catch {destroy $inputBox(toplevelName)} } $inputBoxCommandCancel" catch "$inputBox(toplevelName).frame0.button1 config $tmpButtonOpt" pack append $inputBox(toplevelName).frame0 $inputBox(toplevelName).frame0.button0 {left fill expand} $inputBox(toplevelName).frame0.button1 {left fill expand} pack append $inputBox(toplevelName) $inputBox(toplevelName).frame0 {bottom fill} $inputBox(toplevelName).frame1 {bottom fill expand} $inputBox(toplevelName).message1 {top fill} } # Procedure: InputBoxMulti proc InputBoxMulti { {inputBoxMessage "Input box:"} {inputBoxCommandOk ""} {inputBoxCommandCancel ""} {inputBoxGeometry "350x150"} {inputBoxTitle "Input box"}} { # xf ignore me 5 ########## # Procedure: InputBoxMulti # Description: show input box with one text line # Arguments: {inputBoxMessage} - message to display # {inputBoxCommandOk} - the command to call after ok # {inputBoxCommandCancel} - the command to call after cancel # {inputBoxGeometry} - the geometry for the window # {inputBoxTitle} - the title for the window # Returns: The entered text # Sideeffects: none # Notes: there exist also a function called: # InputBoxOne - to enter one line text ########## # # global inputBox(activeBackground) - active background color # global inputBox(activeForeground) - active foreground color # global inputBox(anchor) - anchor for message box # global inputBox(background) - background color # global inputBox(erase) - erase previous text # global inputBox(font) - message font # global inputBox(foreground) - foreground color # global inputBox(justify) - justify for message box # global inputBox(scrollActiveForeground) - scrollbar active background color # global inputBox(scrollBackground) - scrollbar background color # global inputBox(scrollForeground) - scrollbar foreground color # global inputBox(scrollSide) - side where scrollbar is located # global inputBox(toplevelName) - the toplevel name # global inputBox(toplevelName,inputMulti) - the text in the text widget global inputBox if {"$inputBoxGeometry" == ""} { set inputBoxGeometry 350x150 } if {$inputBox(erase)} { set inputBox($inputBox(toplevelName),inputMulti) "" } { if {![info exists inputBox($inputBox(toplevelName),inputMulti)]} { set inputBox($inputBox(toplevelName),inputMulti) "" } } InputBoxInternal $inputBoxMessage $inputBoxCommandOk $inputBoxCommandCancel $inputBoxGeometry $inputBoxTitle 2 # wait for the box to be destroyed update idletask grab $inputBox(toplevelName) tkwait window $inputBox(toplevelName) return $inputBox($inputBox(toplevelName),inputMulti) } # Procedure: InputBoxOne proc InputBoxOne { {inputBoxMessage "Input box:"} {inputBoxCommandOk ""} {inputBoxCommandCancel ""} {inputBoxGeometry "350x150"} {inputBoxTitle "Input box"}} { # xf ignore me 5 ########## # Procedure: InputBoxOne # Description: show input box with one text line # Arguments: {inputBoxMessage} - message to display # {inputBoxCommandOk} - the command to call after ok # {inputBoxCommandCancel} - the command to call after cancel # {inputBoxGeometry} - the geometry for the window # {inputBoxTitle} - the title for the window # Returns: The entered text # Sideeffects: none # Notes: there exist also a function called: # InputBoxMulti - to enter multiline text ########## # # global inputBox(activeBackground) - active background color # global inputBox(activeForeground) - active foreground color # global inputBox(anchor) - anchor for message box # global inputBox(background) - background color # global inputBox(erase) - erase previous text # global inputBox(font) - message font # global inputBox(foreground) - foreground color # global inputBox(justify) - justify for message box # global inputBox(scrollActiveForeground) - scrollbar active background color # global inputBox(scrollBackground) - scrollbar background color # global inputBox(scrollForeground) - scrollbar foreground color # global inputBox(scrollSide) - side where scrollbar is located # global inputBox(toplevelName) - the toplevel name # global inputBox(toplevelName,inputOne) - the text in the entry widget global inputBox if {$inputBox(erase)} { set inputBox($inputBox(toplevelName),inputOne) "" } { if {![info exists inputBox($inputBox(toplevelName),inputOne)]} { set inputBox($inputBox(toplevelName),inputOne) "" } } InputBoxInternal $inputBoxMessage $inputBoxCommandOk $inputBoxCommandCancel $inputBoxGeometry $inputBoxTitle 1 # wait for the box to be destroyed update idletask grab $inputBox(toplevelName) tkwait window $inputBox(toplevelName) return $inputBox($inputBox(toplevelName),inputOne) } # Procedure: IsADir proc IsADir { pathName} { # xf ignore me 5 ########## # Procedure: IsADir # Description: check if name is a directory (including symbolic links) # Arguments: pathName - the path to check # Returns: 1 if its a directory, otherwise 0 # Sideeffects: none ########## if {[file isdirectory $pathName]} { return 1 } { catch "file type $pathName" fileType if {"$fileType" == "link"} { if {[catch "file readlink $pathName" linkName]} { return 0 } catch "file type $linkName" fileType while {"$fileType" == "link"} { if {[catch "file readlink $linkName" linkName]} { return 0 } catch "file type $linkName" fileType } return [file isdirectory $linkName] } } return 0 } # Procedure: IsAFile proc IsAFile { fileName} { # xf ignore me 5 ########## # Procedure: IsAFile # Description: check if filename is a file (including symbolic links) # Arguments: fileName - the filename to check # Returns: 1 if its a file, otherwise 0 # Sideeffects: none ########## if {[file isfile $fileName]} { return 1 } { catch "file type $fileName" fileType if {"$fileType" == "link"} { if {[catch "file readlink $fileName" linkName]} { return 0 } catch "file type $linkName" fileType while {"$fileType" == "link"} { if {[catch "file readlink $linkName" linkName]} { return 0 } catch "file type $linkName" fileType } return [file isfile $linkName] } } return 0 } # Procedure: IsASymlink proc IsASymlink { fileName} { # xf ignore me 5 ########## # Procedure: IsASymlink # Description: check if filename is a symbolic link # Arguments: fileName - the path/filename to check # Returns: none # Sideeffects: none ########## catch "file type $fileName" fileType if {"$fileType" == "link"} { return 1 } return 0 } # Procedure: MapData proc MapData { data} { } # Procedure: SendCommand proc SendCommand { entry} { set line [$entry get] $entry delete 0 end global EmpireFileId if {$EmpireFileId == {}} {return} puts $EmpireFileId "$line" } # Procedure: ServerRead proc ServerRead { event fileid} { if {$event == {EXCEPTION}} { tkerror "EXCEPTION on $fileid" return } if {$event == {READ}} { if {[gets $fileid line] < 0} { tkerror "READ: error on $fileid" return } set code [string index $line 0] set i 0 set l [string length $line] while {$i < $l && [string index $line $i] > " "} {incr i} set data [string range $line $i end] global C_Codes switch -exact $code\ $C_Codes(PROMPT) {DoPrompt $data}\ $C_Codes(REDIR) {DoRedir $data}\ $C_Codes(PIPE) {DoPipe $data}\ $C_Codes(FLUSH) {DoFlush $data}\ $C_Codes(EXECUTE) {DoExecute $data}\ default {DoOutput $code $data} } } # Procedure: Stars proc Stars { n} { set result {} while {$n > 0} { set result [join [list $result *] {}] incr $n -1 } return $result } # Procedure: StartEmpireConnection proc StartEmpireConnection {} { global env global EmpireHost global EmpirePort global argc global argv global Representitive global Country if {[info exists env(EMPIREHOST)]} { set EmpireHost "$env(EMPIREHOST)" } if {[info exists env(EMPIREPORT)]} { set EmpirePort "$env(EMPIREPORT)" } if {$argc > 0} { set Country "[lindex $argv 0]" } if {$argv > 1} { set Representitive "[lindex $argv 1]" } if {[string length $Country] == 0 || [string length $Representitive] == 0} { GetCountryAndRepresentitive } global EmpireFileId if {![info exists env(USER)]} { puts stderr "You don't exist. Go away!" exit } if {[catch "server_open -nobuf $EmpireHost $EmpirePort" EmpireFileId]} { puts stderr "Cannot connect to server: $EmpireFileId" exit } global C_Codes global FnList if {![Expect $C_Codes(INIT)]} {exit} puts $EmpireFileId "$FnList(USER) $env(USER)" if {![Expect $C_Codes(CMDOK)]} {exit} puts $EmpireFileId "$FnList(COUN) $Country" if {![Expect $C_Codes(CMDOK)]} { puts stderr "No such country: $Country" exit } puts $EmpireFileId "$FnList(PASS) $Representitive" if {![Expect $C_Codes(CMDOK)]} { puts stderr "Bad password" exit } puts $EmpireFileId "$FnList(PLAY)" if {![Expect $C_Codes(INIT)]} { puts stderr "Server error" exit } addinput -read -exception $EmpireFileId {ServerRead %E %F} wm title . "TkEMpire: $Country" wm iconname . "TkEMpire: $Country" wm protocol . {WM_DELETE_WINDOW} {Bye} } proc TextBox {{textBoxMessage {Text message}} {textBoxCommand ""} {textBoxGeometry 350x150} {textBoxTitle "Text box"} args} {# xf ignore me 5 ########## # Procedure: TextBox # Description: show text box # Arguments: {textBoxMessage} - the text to display # {textBoxCommand} - the command to call after ok # {textBoxGeometry} - the geometry for the window # {textBoxTitle} - the title for the window # {args} - labels of buttons # Returns: The number of the selected button, or nothing # Sideeffects: none # Notes: there exist also functions called: # TextBoxFile - to open and read a file automatically # TextBoxFd - to read from an already opened filedescriptor ########## # # global textBox(activeBackground) - active background color # global textBox(activeForeground) - active foreground color # global textBox(background) - background color # global textBox(font) - text font # global textBox(foreground) - foreground color # global textBox(scrollActiveForeground) - scrollbar active background color # global textBox(scrollBackground) - scrollbar background color # global textBox(scrollForeground) - scrollbar foreground color # global textBox(scrollSide) - side where scrollbar is located global textBox # show text box if {[llength $args] > 0} { eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args } { TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle } if {[llength $args] > 0} { # wait for the box to be destroyed update idletask grab $textBox(toplevelName) tkwait window $textBox(toplevelName) return $textBox(button) } } proc TextBoxFd {{textBoxInFile ""} {textBoxCommand ""} {textBoxGeometry 350x150} {textBoxTitle "Text box"} args} {# xf ignore me 5 ########## # Procedure: TextBoxFd # Description: show text box containing a filedescriptor # Arguments: {textBoxInFile} - a filedescriptor to read. The descriptor # is closed after reading # {textBoxCommand} - the command to call after ok # {textBoxGeometry} - the geometry for the window # {textBoxTitle} - the title for the window # {args} - labels of buttons # Returns: The number of the selected button, ot nothing # Sideeffects: none # Notes: there exist also functions called: # TextBox - to display a passed string # TextBoxFile - to open and read a file automatically ########## # # global textBox(activeBackground) - active background color # global textBox(activeForeground) - active foreground color # global textBox(background) - background color # global textBox(font) - text font # global textBox(foreground) - foreground color # global textBox(scrollActiveForeground) - scrollbar active background color # global textBox(scrollBackground) - scrollbar background color # global textBox(scrollForeground) - scrollbar foreground color # global textBox(scrollSide) - side where scrollbar is located global textBox # check file existance if {"$textBoxInFile" == ""} { puts stderr "No filedescriptor specified" return } set textBoxMessage [read $textBoxInFile] close $textBoxInFile # show text box if {[llength $args] > 0} { eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args } { TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle } if {[llength $args] > 0} { # wait for the box to be destroyed update idletask grab $textBox(toplevelName) tkwait window $textBox(toplevelName) return $textBox(button) } } proc TextBoxFile {{textBoxFile ""} {textBoxCommand ""} {textBoxGeometry 350x150} {textBoxTitle "Text box"} args} {# xf ignore me 5 ########## # Procedure: TextBoxFile # Description: show text box containing a file # Arguments: {textBoxFile} - filename to read # {textBoxCommand} - the command to call after ok # {textBoxGeometry} - the geometry for the window # {textBoxTitle} - the title for the window # {args} - labels of buttons # Returns: The number of the selected button, ot nothing # Sideeffects: none # Notes: there exist also functions called: # TextBox - to display a passed string # TextBoxFd - to read from an already opened filedescriptor ########## # # global textBox(activeBackground) - active background color # global textBox(activeForeground) - active foreground color # global textBox(background) - background color # global textBox(font) - text font # global textBox(foreground) - foreground color # global textBox(scrollActiveForeground) - scrollbar active background color # global textBox(scrollBackground) - scrollbar background color # global textBox(scrollForeground) - scrollbar foreground color # global textBox(scrollSide) - side where scrollbar is located global textBox # check file existance if {"$textBoxFile" == ""} { puts stderr "No filename specified" return } if {[catch "open $textBoxFile r" textBoxInFile]} { puts stderr "$textBoxInFile" return } set textBoxMessage [read $textBoxInFile] close $textBoxInFile # show text box if {[llength $args] > 0} { eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args } { TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle } if {[llength $args] > 0} { # wait for the box to be destroyed update idletask grab $textBox(toplevelName) tkwait window $textBox(toplevelName) return $textBox(button) } } ########## # Procedure: TextBoxInternal # Description: show text box internal # Arguments: textBoxMessage - the text to display # textBoxCommand - the command to call after ok # textBoxGeometry - the geometry for the window # textBoxTitle - the title for the window # args - labels of buttons # Returns: none # Sideeffects: none ########## proc TextBoxInternal {textBoxMessage textBoxCommand textBoxGeometry textBoxTitle args} {# xf ignore me 6 global textBox set tmpButtonOpt "" set tmpFrameOpt "" set tmpMessageOpt "" set tmpScrollOpt "" if {"$textBox(activeBackground)" != ""} { append tmpButtonOpt "-activebackground \"$textBox(activeBackground)\" " } if {"$textBox(activeForeground)" != ""} { append tmpButtonOpt "-activeforeground \"$textBox(activeForeground)\" " } if {"$textBox(background)" != ""} { append tmpButtonOpt "-background \"$textBox(background)\" " append tmpFrameOpt "-background \"$textBox(background)\" " append tmpMessageOpt "-background \"$textBox(background)\" " } if {"$textBox(font)" != ""} { append tmpButtonOpt "-font \"$textBox(font)\" " append tmpMessageOpt "-font \"$textBox(font)\" " } if {"$textBox(foreground)" != ""} { append tmpButtonOpt "-foreground \"$textBox(foreground)\" " append tmpMessageOpt "-foreground \"$textBox(foreground)\" " } if {"$textBox(scrollActiveForeground)" != ""} { append tmpScrollOpt "-activeforeground \"$textBox(scrollActiveForeground)\" " } if {"$textBox(scrollBackground)" != ""} { append tmpScrollOpt "-background \"$textBox(scrollBackground)\" " } if {"$textBox(scrollForeground)" != ""} { append tmpScrollOpt "-foreground \"$textBox(scrollForeground)\" " } # start build of toplevel if {"[info commands XFDestroy]" != ""} { catch {XFDestroy $textBox(toplevelName)} } { catch {destroy $textBox(toplevelName)} } toplevel $textBox(toplevelName) \ -borderwidth 0 catch "$textBox(toplevelName) config $tmpFrameOpt" if {[catch "wm geometry $textBox(toplevelName) $textBoxGeometry"]} { wm geometry $textBox(toplevelName) 350x150 } wm title $textBox(toplevelName) $textBoxTitle wm maxsize $textBox(toplevelName) 1000 1000 wm minsize $textBox(toplevelName) 100 100 # end build of toplevel frame $textBox(toplevelName).frame0 \ -borderwidth 0 \ -relief raised catch "$textBox(toplevelName).frame0 config $tmpFrameOpt" text $textBox(toplevelName).frame0.text1 \ -relief raised \ -wrap none \ -borderwidth 2 \ -yscrollcommand "$textBox(toplevelName).frame0.vscroll set" catch "$textBox(toplevelName).frame0.text1 config $tmpMessageOpt" scrollbar $textBox(toplevelName).frame0.vscroll \ -relief raised \ -command "$textBox(toplevelName).frame0.text1 yview" catch "$textBox(toplevelName).frame0.vscroll config $tmpScrollOpt" frame $textBox(toplevelName).frame1 \ -borderwidth 0 \ -relief raised catch "$textBox(toplevelName).frame1 config $tmpFrameOpt" set textBoxCounter 0 set buttonNum [llength $args] if {$buttonNum > 0} { while {$textBoxCounter < $buttonNum} { button $textBox(toplevelName).frame1.button$textBoxCounter \ -text "[lindex $args $textBoxCounter]" \ -command " global textBox set textBox(button) $textBoxCounter set textBox(contents) \[$textBox(toplevelName).frame0.text1 get 1.0 end\] if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $textBox(toplevelName)} } { catch {destroy $textBox(toplevelName)} }" catch "$textBox(toplevelName).frame1.button$textBoxCounter config $tmpButtonOpt" pack append $textBox(toplevelName).frame1 \ $textBox(toplevelName).frame1.button$textBoxCounter {left fillx expand} incr textBoxCounter } } { button $textBox(toplevelName).frame1.button0 \ -text "OK" \ -command " global textBox set textBox(button) 0 set textBox(contents) \[$textBox(toplevelName).frame0.text1 get 1.0 end\] if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy $textBox(toplevelName)} } { catch {destroy $textBox(toplevelName)} } $textBoxCommand" catch "$textBox(toplevelName).frame1.button0 config $tmpButtonOpt" pack append $textBox(toplevelName).frame1 \ $textBox(toplevelName).frame1.button0 {left fillx expand} } $textBox(toplevelName).frame0.text1 insert end "$textBoxMessage" $textBox(toplevelName).frame0.text1 config \ -state $textBox(state) # packing pack append $textBox(toplevelName).frame0 \ $textBox(toplevelName).frame0.vscroll "$textBox(scrollSide) filly" \ $textBox(toplevelName).frame0.text1 {left fill expand} pack append $textBox(toplevelName) \ $textBox(toplevelName).frame1 {bottom fill} \ $textBox(toplevelName).frame0 {top fill expand} } # Procedure: Version proc Version {} { AlertBox "TkEmpire Version 1.0" "" "250x50" "TkEmpire Version" } # Procedure: Warranty proc Warranty {} { TextBox " 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. " "" "600x300" "Warranty Message" } # Procedure: WindowPickPlace proc WindowPickPlace { where} { global OutWindow $OutWindow yview -pickplace $where } # Procedure: WindowPuts proc WindowPuts { string} { global OutWindow $OutWindow insert end "$string" } # Procedure: YesNoBox proc YesNoBox { {yesNoBoxMessage "Yes/no message"} {yesNoBoxGeometry "350x150"}} { # xf ignore me 5 ########## # Procedure: YesNoBox # Description: show yesno box # Arguments: {yesNoBoxMessage} - the text to display # {yesNoBoxGeometry} - the geometry for the window # Returns: none # Sideeffects: none ########## # # global yesNoBox(activeBackground) - active background color # global yesNoBox(activeForeground) - active foreground color # global yesNoBox(anchor) - anchor for message box # global yesNoBox(background) - background color # global yesNoBox(font) - message font # global yesNoBox(foreground) - foreground color # global yesNoBox(justify) - justify for message box # global yesNoBox(afterNo) - destroy yes-no box after n seconds. # The no button is activated # global yesNoBox(afterYes) - destroy yes-no box after n seconds. # The yes button is activated global yesNoBox set tmpButtonOpt "" set tmpFrameOpt "" set tmpMessageOpt "" if {"$yesNoBox(activeBackground)" != ""} { append tmpButtonOpt "-activebackground \"$yesNoBox(activeBackground)\" " } if {"$yesNoBox(activeForeground)" != ""} { append tmpButtonOpt "-activeforeground \"$yesNoBox(activeForeground)\" " } if {"$yesNoBox(background)" != ""} { append tmpButtonOpt "-background \"$yesNoBox(background)\" " append tmpFrameOpt "-background \"$yesNoBox(background)\" " append tmpMessageOpt "-background \"$yesNoBox(background)\" " } if {"$yesNoBox(font)" != ""} { append tmpButtonOpt "-font \"$yesNoBox(font)\" " append tmpMessageOpt "-font \"$yesNoBox(font)\" " } if {"$yesNoBox(foreground)" != ""} { append tmpButtonOpt "-foreground \"$yesNoBox(foreground)\" " append tmpMessageOpt "-foreground \"$yesNoBox(foreground)\" " } # start build of toplevel if {"[info commands XFDestroy]" != ""} { catch {XFDestroy .yesNoBox} } { catch {destroy .yesNoBox} } toplevel .yesNoBox -borderwidth 0 catch ".yesNoBox config $tmpFrameOpt" if {[catch "wm geometry .yesNoBox $yesNoBoxGeometry"]} { wm geometry .yesNoBox 350x150 } wm title .yesNoBox {Alert box} wm maxsize .yesNoBox 1000 1000 wm minsize .yesNoBox 100 100 # end build of toplevel message .yesNoBox.message1 -anchor "$yesNoBox(anchor)" -justify "$yesNoBox(justify)" -relief raised -text "$yesNoBoxMessage" catch ".yesNoBox.message1 config $tmpMessageOpt" set xfTmpWidth [string range $yesNoBoxGeometry 0 [expr [string first x $yesNoBoxGeometry]-1]] if {"$xfTmpWidth" != ""} { # set message size catch ".yesNoBox.message1 configure -width [expr $xfTmpWidth-10]" } { .yesNoBox.message1 configure -aspect 1500 } frame .yesNoBox.frame1 -borderwidth 0 -relief raised catch ".yesNoBox.frame1 config $tmpFrameOpt" button .yesNoBox.frame1.button0 -text "Yes" -command " global yesNoBox set yesNoBox(button) 1 if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy .yesNoBox} } { catch {destroy .yesNoBox} }" catch ".yesNoBox.frame1.button0 config $tmpButtonOpt" button .yesNoBox.frame1.button1 -text "No" -command " global yesNoBox set yesNoBox(button) 0 if {\"\[info commands XFDestroy\]\" != \"\"} { catch {XFDestroy .yesNoBox} } { catch {destroy .yesNoBox} }" catch ".yesNoBox.frame1.button1 config $tmpButtonOpt" pack append .yesNoBox.frame1 .yesNoBox.frame1.button0 {left fillx expand} .yesNoBox.frame1.button1 {left fillx expand} # packing pack append .yesNoBox .yesNoBox.frame1 {bottom fill} .yesNoBox.message1 {top fill expand} if {$yesNoBox(afterYes) != 0} { after [expr $yesNoBox(afterYes)*1000] "catch \".yesNoBox.frame1.button0 invoke\"" } if {$yesNoBox(afterNo) != 0} { after [expr $yesNoBox(afterNo)*1000] "catch \".yesNoBox.frame1.button1 invoke\"" } # wait for the box to be destroyed update idletask grab .yesNoBox tkwait window .yesNoBox return $yesNoBox(button) } # Procedure: auto_load_ouster_index proc auto_load_ouster_index { fn} { global auto_index set dir [file dirname $fn] if [catch {set f [open $dir/tclIndex]}] { return } set error [catch { set id [gets $f] if {$id == "# Tcl autoload index file, version 2.0"} { eval [read $f] } elseif {$id == "# Tcl autoload index file: each line identifies a Tcl"} { while {[gets $f line] >= 0} { if {([string index $line 0] == "#") || ([llength $line] != 2)} { continue } set name [lindex $line 0] if {![info exists auto_index($name)]} { set auto_index($name) "source $dir/[lindex $line 1]" } } } else { error "$dir/tclIndex isn't a proper Tcl index file" } } msg] if {$f != ""} { close $f } if $error { global errorInfo errorCode error $msg $errorInfo $errorCode } } # Procedure: tclx_unknown2 proc tclx_unknown2 { cmd} { global tcl_interactive auto_noexec set name [lindex $cmd 0] if ![info exists auto_noexec] { if [auto_execok $name] { if {!$tcl_interactive || ([info level] > 2) || [info script] != ""} { error "Auto execution of Unix commands only supported as interactive commands.\nUse \"exec\" to execute \"$name\"" } uplevel 2 system [list $cmd] return } } if {!$tcl_interactive || ([info level] > 2) || [info script] != ""} { error "invalid command name \"$name\"" } if {([info level] == 2) && ([info script] == "")} { if {$name == "!!"} { return [uplevel 2 {history redo}] } if [regexp {^!(.+)$} $name dummy event] { return [uplevel 2 [list history redo $event]] } if [regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new] { return [uplevel 2 [list history substitute $old $new]] } set cmds [info commands $name*] if {[llength $cmds] == 1} { return [uplevel 2 [lreplace $cmd 0 0 $cmds]] } if {[llength $cmds] != 0} { if {$name == ""} { return -code error "empty command name \"\"" } else { return -code error "ambiguous command name \"$name\": [lsort $cmds]" } } } error "invalid command name \"$name\"" } # Internal procedures # Procedure: Alias proc Alias { args} { # xf ignore me 7 ########## # Procedure: Alias # Description: establish an alias for a procedure # Arguments: args - no argument means that a list of all aliases # is returned. Otherwise the first parameter is # the alias name, and the second parameter is # the procedure that is aliased. # Returns: nothing, the command that is bound to the alias or a # list of all aliases - command pairs. # Sideeffects: internalAliasList is updated, and the alias # proc is inserted ########## global internalAliasList if {[llength $args] == 0} { return $internalAliasList } { if {[llength $args] == 1} { set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"] if {$xfTmpIndex != -1} { return [lindex [lindex $internalAliasList $xfTmpIndex] 1] } } { if {[llength $args] == 2} { eval "proc [lindex $args 0] {args} {#xf ignore me 4 return \[eval \"[lindex $args 1] \$args\"\]}" set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"] if {$xfTmpIndex != -1} { set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"] } { lappend internalAliasList "[lindex $args 0] [lindex $args 1]" } } { error "Alias: wrong number or args: $args" } } } } # Procedure: GetSelection if {"[info procs GetSelection]" == ""} { proc GetSelection {} { # xf ignore me 7 ########## # Procedure: GetSelection # Description: get current selection # Arguments: none # Returns: none # Sideeffects: none ########## # the save way set xfSelection "" catch "selection get" xfSelection if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} { return "" } { return $xfSelection } } } # Procedure: MenuPopupAdd if {"[info procs MenuPopupAdd]" == ""} { proc MenuPopupAdd { xfW xfButton xfMenu {xfModifier ""} {xfCanvasTag ""}} { # xf ignore me 7 # the popup menu handling is from (I already gave up with popup handling :-): # # Copyright 1991,1992 by James Noble. # Everyone is granted permission to copy, modify and redistribute. # This notice must be preserved on all copies or derivates. # ########## # Procedure: MenuPopupAdd # Description: attach a popup menu to widget # Arguments: xfW - the widget # xfButton - the button we use # xfMenu - the menu to attach # {xfModifier} - a optional modifier # {xfCanvasTag} - a canvas tagOrId # Returns: none # Sideeffects: none ########## if {"$xfModifier" != ""} { set xfPressModifier "$xfModifier-" set xfMoveModifier "$xfModifier-" set xfReleaseModifier "Any-" } { set xfPressModifier "" set xfMoveModifier "" set xfReleaseModifier "" } if {"$xfCanvasTag" == ""} { if {[catch "bind $xfW \"<${xfPressModifier}ButtonPress-$xfButton>\" \"$xfMenu post %X %Y\"" xfResult]} { if {"[info commands XFProcError]" != ""} { XFProcError "$xfResult" } { puts stdout "$xfResult" } return } if {[catch "bind $xfW \"<${xfMoveModifier}B$xfButton-Motion>\" \"MenuPopupHandle $xfMenu %W %X %Y\"" xfResult]} { if {"[info commands XFProcError]" != ""} { XFProcError "$xfResult" } { puts stdout "$xfResult" } return } # we need these to counteract the effects of passive grabs :-( if {[catch "bind $xfW \"<${xfReleaseModifier}ButtonRelease-$xfButton>\" \"$xfMenu invoke active; $xfMenu unpost\"" xfResult]} { if {"[info commands XFProcError]" != ""} { XFProcError "$xfResult" } { puts stdout "$xfResult" } return } } { if {[catch "$xfW bind $xfCanvasTag \"<${xfPressModifier}ButtonPress-$xfButton>\" \"$xfMenu post %X %Y\"" xfResult]} { if {"[info commands XFProcError]" != ""} { XFProcError "$xfResult" } { puts stdout "$xfResult" } return } if {[catch "$xfW bind $xfCanvasTag \"<${xfMoveModifier}B$xfButton-Motion>\" \"MenuPopupHandle $xfMenu %W %X %Y\"" xfResult]} { if {"[info commands XFProcError]" != ""} { XFProcError "$xfResult" } { puts stdout "$xfResult" } return } # we need these to counteract the effects of passive grabs :-( if {[catch "$xfW bind $xfCanvasTag \"<${xfReleaseModifier}ButtonRelease-$xfButton>\" \"$xfMenu invoke active; $xfMenu unpost\"" xfResult]} { if {"[info commands XFProcError]" != ""} { XFProcError "$xfResult" } { puts stdout "$xfResult" } return } } } } # Procedure: MenuPopupHandle if {"[info procs MenuPopupHandle]" == ""} { proc MenuPopupHandle { xfMenu xfW xfX xfY} { # xf ignore me 7 ########## # Procedure: MenuPopupHandle # Description: handle the popup menus # Arguments: xfMenu - the menu to attach # xfW - the widget # xfX - the root x coordinate # xfY - the root x coordinate # Returns: none # Sideeffects: none ########## if {"[info commands $xfMenu]" != "" && [winfo ismapped $xfMenu]} { set xfPopMinX [winfo rootx $xfMenu] set xfPopMaxX [expr $xfPopMinX+[winfo width $xfMenu]] if {($xfX >= $xfPopMinX) && ($xfX <= $xfPopMaxX)} { $xfMenu activate @[expr $xfY-[winfo rooty $xfMenu]] } { $xfMenu activate none } } } } # Procedure: NoFunction if {"[info procs NoFunction]" == ""} { proc NoFunction { args} { # xf ignore me 7 ########## # Procedure: NoFunction # Description: do nothing (especially with scales and scrollbars) # Arguments: args - a number of ignored parameters # Returns: none # Sideeffects: none ########## } } # Procedure: SN if {"[info procs SN]" == ""} { proc SN { {xfName ""}} { # xf ignore me 7 ########## # Procedure: SN # Description: map a symbolic name to the widget path # Arguments: xfName # Returns: the symbolic name # Sideeffects: none ########## SymbolicName $xfName } } # Procedure: SymbolicName if {"[info procs SymbolicName]" == ""} { proc SymbolicName { {xfName ""}} { # xf ignore me 7 ########## # Procedure: SymbolicName # Description: map a symbolic name to the widget path # Arguments: xfName # Returns: the symbolic name # Sideeffects: none ########## global symbolicName if {"$xfName" != ""} { set xfArrayName "" append xfArrayName symbolicName ( $xfName ) if {![catch "set \"$xfArrayName\"" xfValue]} { return $xfValue } { if {"[info commands XFProcError]" != ""} { XFProcError "Unknown symbolic name:\n$xfName" } { puts stderr "XF error: unknown symbolic name:\n$xfName" } } } return "" } } # Procedure: Unalias proc Unalias { aliasName} { # xf ignore me 7 ########## # Procedure: Unalias # Description: remove an alias for a procedure # Arguments: aliasName - the alias name to remove # Returns: none # Sideeffects: internalAliasList is updated, and the alias # proc is removed ########## global internalAliasList set xfIndex [lsearch $internalAliasList "$aliasName *"] if {$xfIndex != -1} { rename $aliasName "" set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex] } } # application parsing procedure proc XFLocalParseAppDefs {xfAppDefFile} { global xfAppDefaults # basically from: Michael Moore if {[file exists $xfAppDefFile] && [file readable $xfAppDefFile] && "[file type $xfAppDefFile]" == "link"} { catch "file type $xfAppDefFile" xfType while {"$xfType" == "link"} { if {[catch "file readlink $xfAppDefFile" xfAppDefFile]} { return } catch "file type $xfAppDefFile" xfType } } if {!("$xfAppDefFile" != "" && [file exists $xfAppDefFile] && [file readable $xfAppDefFile] && "[file type $xfAppDefFile]" == "file")} { return } if {![catch "open $xfAppDefFile r" xfResult]} { set xfAppFileContents [read $xfResult] close $xfResult foreach line [split $xfAppFileContents "\n"] { # backup indicates how far to backup. It applies to the # situation where a resource name ends in . and when it # ends in *. In the second case you want to keep the * # in the widget name for pattern matching, but you want # to get rid of the . if it is the end of the name. set backup -2 set line [string trim $line] if {[string index $line 0] == "#" || "$line" == ""} { # skip comments and empty lines continue } set list [split $line ":"] set resource [string trim [lindex $list 0]] set i [string last "." $resource] set j [string last "*" $resource] if {$j > $i} { set i $j set backup -1 } incr i set name [string range $resource $i end] incr i $backup set widname [string range $resource 0 $i] set value [string trim [lindex $list 1]] if {"$widname" != "" && "$widname" != "*"} { # insert the widget and resourcename to the application # defaults list. set xfAppDefaults($widname:[string tolower $name]) $value } } } } # application loading procedure proc XFLocalLoadAppDefs {xfClasses {xfPriority "startupFile"} {xfAppDefFile ""}} { global env if {"$xfAppDefFile" == ""} { set xfFileList "" if {[info exists env(XUSERFILESEARCHPATH)]} { append xfFileList [split $env(XUSERFILESEARCHPATH) :] } if {[info exists env(XAPPLRESDIR)]} { append xfFileList [split $env(XAPPLRESDIR) :] } if {[info exists env(XFILESEARCHPATH)]} { append xfFileList [split $env(XFILESEARCHPATH) :] } append xfFileList " /usr/lib/X11/app-defaults" append xfFileList " /usr/X11/lib/X11/app-defaults" foreach xfCounter1 $xfClasses { foreach xfCounter2 $xfFileList { set xfPathName $xfCounter2 if {[regsub -all "%N" "$xfPathName" "$xfCounter1" xfResult]} { set xfPathName $xfResult } if {[regsub -all "%T" "$xfPathName" "app-defaults" xfResult]} { set xfPathName $xfResult } if {[regsub -all "%S" "$xfPathName" "" xfResult]} { set xfPathName $xfResult } if {[regsub -all "%C" "$xfPathName" "" xfResult]} { set xfPathName $xfResult } if {[file exists $xfPathName] && [file readable $xfPathName] && ("[file type $xfPathName]" == "file" || "[file type $xfPathName]" == "link")} { catch "option readfile $xfPathName $xfPriority" if {"[info commands XFParseAppDefs]" != ""} { XFParseAppDefs $xfPathName } { if {"[info commands XFLocalParseAppDefs]" != ""} { XFLocalParseAppDefs $xfPathName } } } { if {[file exists $xfCounter2/$xfCounter1] && [file readable $xfCounter2/$xfCounter1] && ("[file type $xfCounter2/$xfCounter1]" == "file" || "[file type $xfCounter2/$xfCounter1]" == "link")} { catch "option readfile $xfCounter2/$xfCounter1 $xfPriority" if {"[info commands XFParseAppDefs]" != ""} { XFParseAppDefs $xfCounter2/$xfCounter1 } { if {"[info commands XFLocalParseAppDefs]" != ""} { XFLocalParseAppDefs $xfCounter2/$xfCounter1 } } } } } } } { # load a specific application defaults file if {[file exists $xfAppDefFile] && [file readable $xfAppDefFile] && ("[file type $xfAppDefFile]" == "file" || "[file type $xfAppDefFile]" == "link")} { catch "option readfile $xfAppDefFile $xfPriority" if {"[info commands XFParseAppDefs]" != ""} { XFParseAppDefs $xfAppDefFile } { if {"[info commands XFLocalParseAppDefs]" != ""} { XFLocalParseAppDefs $xfAppDefFile } } } } } # application setting procedure proc XFLocalSetAppDefs {{xfWidgetPath "."}} { global xfAppDefaults if {![info exists xfAppDefaults]} { return } foreach xfCounter [array names xfAppDefaults] { if {[string match "${xfWidgetPath}*" $xfCounter]} { set widname [string range $xfCounter 0 [expr [string first : $xfCounter]-1]] set name [string range $xfCounter [expr [string first : $xfCounter]+1] end] # Now lets see how many tcl commands match the name # pattern specified. set widlist [info command $widname] if {"$widlist" != ""} { foreach widget $widlist { # make sure this command is a widget. if {![catch "winfo id $widget"]} { catch "$widget configure -[string tolower $name] $xfAppDefaults($xfCounter)" } } } } } } # end source proc EndSrc {} { update idletasks global alertBox set alertBox(justify) {left} AlertBox " TkEmpire version 1.0 Copyright (C) 1995 Robert Heller D/B/A Deepwoods software TkEmpire comes with ABSOLUTELY NO WARRANTY; for details select \"Warrantry\" under the Help menu. This is free software, and you are welcome to redistribute it under certain conditions; select \"Copying\" under the Help menu." "" "550x130"\ "TkEmpire Copyright Notice" update idletasks if {![winfo exists .xfLoading]} {StartEmpireConnection} } # prepare auto loading global auto_path global tk_library global xfLoadPath set auto_path "[split $xfLoadPath :] $tk_library [info library]" # initialize global variables proc InitGlobals {} { global {C_Codes} set {C_Codes(ABORT)} {7} set {C_Codes(BADCMD)} {b} set {C_Codes(CMDERR)} {a} set {C_Codes(CMDOK)} {0} set {C_Codes(DATA)} {1} set {C_Codes(EXECUTE)} {c} set {C_Codes(EXIT)} {3} set {C_Codes(FLUSH)} {4} set {C_Codes(INIT)} {2} set {C_Codes(NOECHO)} {5} set {C_Codes(PIPE)} {9} set {C_Codes(PROMPT)} {6} set {C_Codes(REDIR)} {8} global {Country} set {Country} {} global {DoingMap} set {DoingMap} {0} global {EmpireFileId} set {EmpireFileId} {} global {EmpireHost} set {EmpireHost} {empire} global {EmpirePort} set {EmpirePort} {1617} global {FnList} set {FnList(CMD)} {cmd} set {FnList(COUN)} {coun} set {FnList(CTLD)} {ctld} set {FnList(KILL)} {kill} set {FnList(LIST)} {list} set {FnList(PASS)} {pass} set {FnList(PLAY)} {play} set {FnList(USER)} {user} global {OutWindow} set {OutWindow} {.frame.text2} global {PipeId} set {PipeId} {} global {Prompt} set {Prompt} {} global {ReDirId} set {ReDirId} {} global {Representitive} set {Representitive} {} global {fsBox} global alertBox set alertBox(activeBackground) "" set alertBox(activeForeground) "" set alertBox(after) 0 set alertBox(anchor) nw set alertBox(background) "" set alertBox(font) "" set alertBox(foreground) "" set alertBox(justify) center set alertBox(toplevelName) .alertBox set alertBox(button) 0 set {fsBox(activeBackground)} {} set {fsBox(activeForeground)} {} set {fsBox(all)} {0} set {fsBox(background)} {} set {fsBox(button)} {0} set {fsBox(extensions)} {0} set {fsBox(font)} {} set {fsBox(foreground)} {} set {fsBox(internalPath)} {/usr/home/heller/TkEmpire} set {fsBox(name)} {} set {fsBox(path)} {/usr/home/heller/TkEmpire} set {fsBox(pattern)} {*} set {fsBox(scrollActiveForeground)} {} set {fsBox(scrollBackground)} {} set {fsBox(scrollForeground)} {} set {fsBox(scrollSide)} {left} set {fsBox(showPixmap)} {0} global {inputBox} set {inputBox(activeBackground)} {} set {inputBox(activeForeground)} {} set {inputBox(anchor)} {n} set {inputBox(background)} {} set {inputBox(erase)} {1} set {inputBox(font)} {} set {inputBox(foreground)} {} set {inputBox(justify)} {center} set {inputBox(scrollActiveForeground)} {} set {inputBox(scrollBackground)} {} set {inputBox(scrollForeground)} {} set {inputBox(scrollSide)} {left} set {inputBox(toplevelName)} {.inputBox} global textBox set textBox(activeBackground) "" set textBox(activeForeground) "" set textBox(background) "" set textBox(font) "" set textBox(foreground) "" set textBox(scrollActiveForeground) "" set textBox(scrollBackground) "" set textBox(scrollForeground) "" set textBox(scrollSide) left set textBox(state) disabled set textBox(toplevelName) .textBox set textBox(button) 0 set textBox(contents) "" global {yesNoBox} set {yesNoBox(activeBackground)} {} set {yesNoBox(activeForeground)} {} set {yesNoBox(afterNo)} {0} set {yesNoBox(afterYes)} {0} set {yesNoBox(anchor)} {n} set {yesNoBox(background)} {} set {yesNoBox(button)} {0} set {yesNoBox(font)} {*times-bold-r-normal*24*} set {yesNoBox(foreground)} {} set {yesNoBox(justify)} {center} # please don't modify the following # variables. They are needed by xf. global {autoLoadList} set {autoLoadList(TkEmpire)} {0} set {autoLoadList(main.tcl)} {0} global {internalAliasList} set {internalAliasList} {} global {moduleList} set {moduleList(TkEmpire)} {} global {preloadList} set {preloadList(xfInternal)} {} global {symbolicName} set {symbolicName(root)} {.} global {xfWmSetPosition} set {xfWmSetPosition} {} global {xfWmSetSize} set {xfWmSetSize} {} global {xfAppDefToplevels} set {xfAppDefToplevels} {} } # initialize global variables InitGlobals # display/remove toplevel windows. ShowWindow. # load default bindings. if {[info exists env(XF_BIND_FILE)] && "[info procs XFShowHelp]" == ""} { source $env(XF_BIND_FILE) } # parse and apply application defaults. XFLocalLoadAppDefs TkEmpire XFLocalSetAppDefs # end source EndSrc # eof # TkEmpire-1.0/TkEmpire.sh100744 12005 144 2102 6037776112 14061 0ustar hellerusers#!/bin/sh # # Program: TkEmpire # # This file is an automatically created shell script # for starting the application named: TkEmpire # # adapt the following variables to fit your # local site # # WHIS_CMD is the wish interpreter to use WISH_CMD=/usr/bin/X11/wishx # # XF_LOAD_PATH is the path were the tcl modules # for this application are located if test "$XF_LOAD_PATH" = ""; then XF_LOAD_PATH=/usr/local/lib/ else XF_LOAD_PATH=$XF_LOAD_PATH:/usr/local/lib/ fi # # ARGC=$# COMMANDLINE= while [ $ARGC -gt 0 ]; do C=$1 shift ARGC=`expr $ARGC - 1` case $C in -xfloadpath) if [ $ARGC -gt 0 ]; then C=$1 shift ARGC=`expr $ARGC - 1` XF_LOAD_PATH=$C:$XF_LOAD_PATH else echo "TkEmpire: expected path for -xfloadpath" exit 2 fi;; *) COMMANDLINE=$COMMANDLINE" "$C;; esac done # export XF_LOAD_PATH for p in `echo $XF_LOAD_PATH|awk 'BEGIN{RS=":"}{print $0}'`; do if test -f $p/TkEmpire; then exec $WISH_CMD -n TkEmpire -f $p/TkEmpire $COMMANDLINE fi done echo "Could not find: TkEmpire" # eof