#!/bin/sh # -*- mode: tcl; mode: folding; -*- \ exec wish "$0" ${1+"$@"} #{{{ COPYRIGHT INFO #{{{ copyright note set copyright_note \ {Copyright (C) 2000-2001 Steve Webb , (http://www.badcheese.com/~steve/) Copyright (C) 2002 Dmitry Morozhnikov Shipyard part: Copyright (C) 1999 Frans Slothouber galng.tcl comes with ABSOLUTELY NO WARRANTY This is free software, and you are welcome to redistribute it under certain conditions. See Help->Copying menu for details.} #}}} #{{{ GPL 2 set gpl_text \ { GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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. } #}}} #}}} #{{{ splash wm withdraw . toplevel .splash -bg white wm withdraw .splash label .splash.txt -text "galng.tcl loading.." -font [font create -family Helvetica -size 72] pack .splash.txt wm overrideredirect .splash 1 wm transient .splash wm geometry .splash +64+64 wm deiconify .splash update idletasks #}}} #{{{ initial values set galng_version "1.5.10" set galng_datafile_version 2.0 set zoom 10 set planet_size_factor 1 set can_xview 0 set can_yview 0 set max_x 0 set max_y 0 set max_groups 0 set map_s_side 15 set wopr_path {} set wopr_run_count 100 set wopr_use_internal 1 switch $tcl_platform(platform) { unix { set default_file_name "$env(HOME)/.galng" } windows { set default_file_name "$env(HOME)/galng" } macintosh { set default_file_name "$env(HOME)/galng" } } set game_name "" set race_name "" set turn_number 0 set forecast 0 set smtphost "host.com" set subject "orders" set to_addr "galaxyng@host.com" set from_addr "me@host.com" set orders {} set galaxy_variant GalaxyNG set orders_passwd "" set orders_strip_quoting 1 set mailed_home_yet 0 set selected_planet "" set smallfont [font create -size 10 -family Helvetica] set smallerfont [font create -size 8 -family Helvetica] set canvasfont Helvetica set font_size_factor 1 set draw_planet_names 1 set draw_routes_cap 1 set draw_routes_col 1 set draw_routes_mat 1 set draw_routes_emp 1 switch $tcl_platform(platform) { unix { set fixedfont [font create -family Courier -size 10] set fixedfont2 [font create -family Courier -size 12] set Tree(font) [font create -family Helvetica -size 10] set MLbox(font) [font create -family Helvetica -size 10] set battlefont [font create -family Helvetica -size 10] set sb_width_opt 0.3c } windows { set fixedfont [font create -family Courier -size 8] set fixedfont2 [font create -family Courier -size 10] set Tree(font) [font create -family Helvetica -size 8] set MLbox(font) [font create -family Helvetica -size 8] set battlefont [font create -family Helvetica -size 8] set sb_width_opt 0.5c } macintosh { set fixedfont [font create -family Courier -size 10] set fixedfont2 [font create -family Courier -size 12] set Tree(font) [font create -family Helvetica -size 10] set MLbox(font) [font create -family Helvetica -size 10] set battlefont [font create -family Helvetica -size 10] set sb_width_opt 0.3c } } set Sock {} set green_color PaleGreen set red_color PaleVioletRed # background text mine alien unin unid orbit transit transit_group alien incoming incoming_group battle lines set green_theme {"black" "green" "darkgreen" "white" "black" "blue" "yellow"} set printer_theme {"white" "black" "peachpuff3" "black" "grey" "blue" "blue"} set original_theme {"peachpuff3" "black" "white" "black" "grey" "blue" "blue"} set dmiceman_theme {"black" "grey" "green" "red" "PaleVioletRed" "grey" \ "green" "grey" "green" "PaleVioletRed" "PaleVioletRed" "PaleVioletRed" "yellow" "white" \ "blue" "cyan" "magenta" "yellow"} set theme dmiceman set current_theme $dmiceman_theme set main_win_geom 600x400+0+0 set order_win_geom 505x482+20+20 set report_win_geom 505x388+40+40 set shipyard_win_geom 494x427+60+60 set notes_win_geom 497x375+80+80 set wopr_win_geom 671x765+100+100 set battleview_win_geom +100+100 set incoming_group_num 0 set alien_groups_num 0 set wopr_my_groups {} set wopr_their_groups {} set wopr_results "" set wopr_results_pct 50 set wopr_my_results "" set wopr_their_results "" set closest_objects {} set closest_objects_x -1000 set closest_objects_y -1000 set closest_objects_ndx 0 set selected_planet "" # i think line better for default # set distance_mark circle set distance_mark line set canvas_action center set canvas_action_start_x 0 set canvas_action_start_y 0 set canvas_action_end_x 0 set canvas_action_end_y 0 set tree_sort_planets_alien_orbited name set tree_sort_planets_other_orbited name set tree_sort_planets_mine name set groups_orbit_visible "" set groups_orbit_order {-1 increasing} set groups_transit_visible "" set groups_transit_order {-1 increasing} set groups_incoming_visible "" set groups_incoming_order {-1 increasing} set battle_my_groups_visible "" set battle_my_groups_order {-1 increasing} set battle_their_groups_visible "" set battle_their_groups_order {-1 increasing} #}}} #{{{ load & save defaults #{{{ load_defaults_2_0 proc load_defaults_2_0 {filename} { global galng_default_email galng_default_smtp from_addr smtphost source "$filename" frame_hs left frame_hs right frame_hs sec set galng_default_email $from_addr set galng_default_smtp $smtphost } #}}} #{{{ load_defaults_1_5 proc load_defaults_1_5 {filename} { global smtphost orders subject to_addr from_addr zoom wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom global mailed_home_yet set infile [open "$filename" "r"] gets $infile gets $infile set main_win_geom [gets $infile] set order_win_geom [gets $infile] set report_win_geom [gets $infile] set shipyard_win_geom [gets $infile] set notes_win_geom [gets $infile] set wopr_win_geom [gets $infile] set wopr_path [gets $infile] set mailed_home_yet [gets $infile] close $infile } #}}} #{{{ load_defaults_1_4 proc load_defaults_1_4 {filename} { global smtphost orders subject to_addr from_addr zoom wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom global mailed_home_yet global game_name race_name turn_number global can_xview can_yview set infile [open "$filename" "r"] gets $infile gets $infile set main_win_geom [gets $infile] set order_win_geom [gets $infile] set report_win_geom [gets $infile] set shipyard_win_geom [gets $infile] set notes_win_geom [gets $infile] set wopr_win_geom [gets $infile] set wopr_path [gets $infile] close $infile } #}}} #{{{ load_defaults_1_3 proc load_defaults_1_3 {filename} { global smtphost orders subject to_addr from_addr zoom wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom global mailed_home_yet set infile [open "$filename" "r"] gets $infile gets $infile set main_win_geom [gets $infile] set order_win_geom [gets $infile] set report_win_geom [gets $infile] set shipyard_win_geom [gets $infile] set notes_win_geom [gets $infile] set wopr_win_geom [gets $infile] set wopr_path [gets $infile] set zoom [gets $infile] set smtphost [gets $infile] set to_addr [gets $infile] set from_addr [gets $infile] set subject [gets $infile] set mailed_home_yet [gets $infile] close $infile } #}}} #{{{ load_defaults_1_2 proc load_defaults_1_2 {filename} { global smtphost orders subject to_addr from_addr zoom wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom set infile [open "$filename" "r"] gets $infile gets $infile set main_win_geom [gets $infile] set order_win_geom [gets $infile] set report_win_geom [gets $infile] set shipyard_win_geom [gets $infile] set notes_win_geom [gets $infile] set wopr_win_geom [gets $infile] set wopr_path [gets $infile] set zoom [gets $infile] set smtphost [gets $infile] set to_addr [gets $infile] set from_addr [gets $infile] set subject [gets $infile] close $infile } #}}} #{{{ load_game_defaults_2_0 proc load_game_defaults_2_0 {filename} { global orders_passwd left_frame_content default_left_frame_content set default_left_frame_content $left_frame_content set report_passwd $orders_passwd source "$filename" # password from report takes precedence over preferences if {$report_passwd != "" && $report_passwd != $orders_passwd} { set orders_passwd $report_passwd } set_tree_orders } #}}} #{{{ load_game_defaults_1_5 proc load_game_defaults_1_5 {filename} { global smtphost orders subject to_addr from_addr zoom global game_name race_name turn_number global can_xview can_yview set infile [open "$filename" "r"] gets $infile set zoom [gets $infile] set can_xview [gets $infile] set can_yview [gets $infile] set smtphost [gets $infile] set to_addr [gets $infile] set from_addr [gets $infile] set subject [gets $infile] set orders {} while {![eof $infile]} { set line [gets $infile] if {![eof $infile] && $orders != {}} { append orders "\n" } append orders $line } close $infile } #}}} #{{{ load_game_defaults_1_4 proc load_game_defaults_1_4 {filename} { global smtphost orders subject to_addr from_addr zoom wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom global mailed_home_yet global game_name race_name turn_number global can_xview can_yview set infile [open "$filename" "r"] gets $infile set zoom [gets $infile] set can_xview [gets $infile] set can_yview [gets $infile] set smtphost [gets $infile] set to_addr [gets $infile] set from_addr [gets $infile] set subject [gets $infile] set mailed_home_yet [gets $infile] set orders {} while {![eof $infile]} { set line [gets $infile] if {![eof $infile] && $orders != {}} { append orders "\n" } append orders $line } close $infile } #}}} #{{{ save_defaults proc save_defaults {} { global smtphost orders subject to_addr from_addr default_file_name zoom galng_datafile_version wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom global mailed_home_yet global game_name race_name turn_number global map_can global galng_version global frame_hs_left frame_hs_right frame_hs_sec global wopr_run_count wopr_use_internal global groups_orbit_visible groups_transit_visible groups_incoming_visible global groups_orbit_order groups_transit_order groups_incoming_order global battle_my_groups_visible battle_their_groups_visible global battle_my_groups_order battle_their_groups_order if {[file exists "$default_file_name.rc"]} { file delete "$default_file_name.rc" } set outfile [open "$default_file_name.rc" "w" 0666] puts $outfile "# GALNGVER: $galng_datafile_version" puts $outfile "# automatically generated by galng.tcl version $galng_version." puts $outfile "# timestamp: [clock format [clock seconds] -format %c]" puts $outfile "# DO NOT EDIT!" puts $outfile "" puts $outfile "# Theme (broken now)" puts $outfile "# global theme" puts $outfile "# set theme \"$theme\"" puts $outfile "" puts $outfile "# Geometry of windows" puts $outfile "global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom" puts $outfile "set main_win_geom $main_win_geom" puts $outfile "set order_win_geom $order_win_geom" puts $outfile "set report_win_geom $report_win_geom" puts $outfile "set shipyard_win_geom $shipyard_win_geom" puts $outfile "set notes_win_geom $notes_win_geom" puts $outfile "set wopr_win_geom $wopr_win_geom" puts $outfile "" puts $outfile "# Frames hidden/showed" puts $outfile "global frame_hs_left frame_hs_right frame_hs_sec" puts $outfile "set frame_hs_left $frame_hs_left" puts $outfile "set frame_hs_right $frame_hs_right" puts $outfile "set frame_hs_sec $frame_hs_sec" puts $outfile "" puts $outfile "# Visible fields & order in MLbox-es" # FIXME: kludge save_mlbox_state .sec.groups.list puts $outfile "global groups_orbit_visible groups_transit_visible groups_incoming_visible" puts $outfile "set groups_orbit_visible {$groups_orbit_visible}" puts $outfile "set groups_transit_visible {$groups_transit_visible}" puts $outfile "set groups_incoming_visible {$groups_incoming_visible}" puts $outfile "global groups_orbit_order groups_transit_order groups_incoming_order" puts $outfile "set groups_orbit_order {$groups_orbit_order}" puts $outfile "set groups_transit_order {$groups_transit_order}" puts $outfile "set groups_incoming_order {$groups_incoming_order}" # FIXME: kludge save_mlbox_state .sec.battle.my.list save_mlbox_state .sec.battle.their.list puts $outfile "global battle_my_groups_visible battle_their_groups_visible" puts $outfile "set battle_my_groups_visible {$battle_my_groups_visible}" puts $outfile "set battle_their_groups_visible {$battle_their_groups_visible}" puts $outfile "global battle_my_groups_order battle_their_groups_order" puts $outfile "set battle_my_groups_order {$battle_my_groups_order}" puts $outfile "set battle_their_groups_order {$battle_their_groups_order}" puts $outfile "" puts $outfile "# Path to wopr executable" puts $outfile "global wopr_path" puts $outfile "set wopr_path \"$wopr_path\"" puts $outfile "" puts $outfile "# Count to run simulation" puts $outfile "global wopr_run_count" puts $outfile "set wopr_run_count $wopr_run_count" puts $outfile "" puts $outfile "# Use internal battlesim" puts $outfile "global wopr_use_internal" puts $outfile "set wopr_use_internal $wopr_use_internal" puts $outfile "" puts $outfile "# Is mailed home yet?" puts $outfile "global mailed_home_yet" puts $outfile "set mailed_home_yet $mailed_home_yet" puts $outfile "" puts $outfile "# Default (last) email & smtp host" puts $outfile "global from_addr smtphost" puts $outfile "set from_addr $from_addr" puts $outfile "set smtphost $smtphost" close $outfile # FIXME: kludge. we need normal atexit procedure save_notes } #}}} #{{{ save_game_defaults proc save_game_defaults {} { global smtphost orders subject to_addr from_addr default_file_name zoom galng_datafile_version wopr_path theme global main_win_geom order_win_geom report_win_geom shipyard_win_geom notes_win_geom wopr_win_geom global mailed_home_yet global game_name race_name turn_number global map_can global galng_version global planet_size_factor global orders_passwd orders global font_size_factor draw_planet_names global forecast_file global left_frame_content global tree_sort_planets_alien_orbited tree_sort_planets_other_orbited tree_sort_planets_mine global draw_routes_col draw_routes_cap draw_routes_mat draw_routes_emp if {$game_name != ""} { if {[file exists "$default_file_name.$game_name.rc"]} { file delete "$default_file_name.$game_name.rc" } set outfile [open "$default_file_name.$game_name.rc" "w" 0666] puts $outfile "# GALNGVERGAME: $galng_datafile_version" puts $outfile "# automatically generated by galng.tcl version $galng_version." puts $outfile "# timestamp: [clock format [clock seconds] -format %c]" puts $outfile "# DO NOT EDIT!" puts $outfile "" puts $outfile "# Zoom level" puts $outfile "global zoom" puts $outfile "set zoom $zoom" puts $outfile "" puts $outfile "# Planet size" puts $outfile "global planet_size_factor" puts $outfile "set planet_size_factor $planet_size_factor" puts $outfile "" puts $outfile "# Font size factor" puts $outfile "global font_size_factor" puts $outfile "set font_size_factor $font_size_factor" puts $outfile "" puts $outfile "# Do display planet names at all" puts $outfile "global draw_planet_names" puts $outfile "set draw_planet_names $draw_planet_names" puts $outfile "" puts $outfile "# Do display routes of different types" puts $outfile "global draw_routes_col draw_routes_cap draw_routes_mat draw_routes_emp" puts $outfile "set draw_routes_col $draw_routes_col" puts $outfile "set draw_routes_cap $draw_routes_cap" puts $outfile "set draw_routes_mat $draw_routes_mat" puts $outfile "set draw_routes_emp $draw_routes_emp" puts $outfile "" puts $outfile "# Scroll positions of map" puts $outfile "global can_xview can_yview" puts $outfile "set can_xview [lindex [$map_can xview] 0]" puts $outfile "set can_yview [lindex [$map_can yview] 0]" puts $outfile "" puts $outfile "# Content of left frame (tree or orders)" puts $outfile "global left_frame_content" puts $outfile "set left_frame_content $left_frame_content" puts $outfile "" puts $outfile "# Sort orders for tree" puts $outfile "global tree_sort_planets_alien_orbited tree_sort_planets_other_orbited tree_sort_planets_mine" puts $outfile "set tree_sort_planets_alien_orbited $tree_sort_planets_alien_orbited" puts $outfile "set tree_sort_planets_other_orbited $tree_sort_planets_other_orbited" puts $outfile "set tree_sort_planets_mine $tree_sort_planets_mine" puts $outfile "" puts $outfile "# SMTP host" puts $outfile "global smtphost" puts $outfile "set smtphost \"$smtphost\"" puts $outfile "" puts $outfile "# Address to send messages" puts $outfile "global to_addr" puts $outfile "set to_addr \"$to_addr\"" puts $outfile "" puts $outfile "# Our address" puts $outfile "global from_addr" puts $outfile "set from_addr \"$from_addr\"" puts $outfile "" puts $outfile "# Subject of messages" puts $outfile "global subject" puts $outfile "set subject {$subject}" puts $outfile "" puts $outfile "# Password for sending orders" puts $outfile "global orders_passwd" puts $outfile "set orders_passwd {$orders_passwd}" puts $outfile "" if {$forecast_file == ""} { puts $outfile "# Orders itself" puts $outfile "global orders" set orders {} foreach l [split [get_orders] \012] { if {![regexp "^;" $l whole] && !($l == "")} { append orders $l "\n" } } puts $outfile "set orders {$orders}" } close $outfile } } #}}} #{{{ load_defaults proc load_defaults {} { global default_file_name galng_version galng_upgrade_from galng_upgrade set upgrade 0 set wrong 0 set delete 0 set defaults_version "-" set ifilename "" set update_from no_update set galng_upgrade 0 if {[file exists "$default_file_name.rc"]} { set ifilename "$default_file_name.rc" set vregexp "^# GALNGVER: (\[0-9\]+\\.\[0-9\]+)" } elseif {[file exists ".galng.defaults"]} { set ifilename ".galng.defaults" set vregexp "^GALNGVER: (\[0-9\]+\\.\[0-9\]+)" } elseif {[file exists "defaults.txt"]} { set ifilename "defaults.txt" set vregexp "^GALNGVER: (\[0-9\]+\\.\[0-9\]+)" } if {$ifilename != ""} { set ifile [open "$ifilename" "r"] set version_string [gets $ifile] set line [gets $ifile] if {[regexp "^# automatically generated by galng.tcl version (\[0-9\]+\\.\[0-9\]+\\.\[0-9\]+)\\." \ $line whole ver]} { set update_from $ver } else { set update_from {*UNKNOWN*} } close $ifile if {[regexp $vregexp $version_string whole defaults_version]} { switch $defaults_version { 2.0 { load_defaults_2_0 "$ifilename" } 1.5 { set upgrade 1 load_defaults_1_5 "$ifilename" set update_from {1.5.x} } 1.4 { set upgrade 1 load_defaults_1_4 "$ifilename" set update_from {1.4} } 1.3 { set upgrade 1 load_defaults_1_3 "$ifilename" set update_from {1.3} } 1.2 { set upgrade 1 load_defaults_1_2 "$ifilename" set update_from {1.2} } default { set wrong 1 set update_from {*WRONG*} } } } else { set wrong 1 set update_from {*WRONG*} } if {$upgrade} { set delete [tk_messageBox -type yesno -icon question -title "old preferences file found" \ -message "Old preferences file found and loaded. Do you want to delete it now?\n(Say no if you want to use previous version of galng.tcl; this question will not be asked again)"] } elseif {$wrong} { set delete [tk_messageBox -type yesno -icon question -title "wrong preferences file found" \ -message "Wrong preferences file found: $ifilename\nDelete?"] } show_string "NOTE: Found preferences file version $defaults_version" if {$delete} { file delete $ifilename } } else { show_string "NOTE: No preferences file found" set update_from "-" } if {$update_from != "no_update" && $update_from != $galng_version} { set galng_upgrade_from $update_from set galng_upgrade 1 } } #}}} #{{{ load_game_defaults proc load_game_defaults {game} { global default_file_name set upgrade 0 set wrong 0 set delete 0 set defaults_version "-" set ifilename "" if {[file exists "$default_file_name.$game.rc"]} { set ifilename "$default_file_name.$game.rc" set vregexp "^# GALNGVERGAME: (\[0-9\]+\\.\[0-9\]+)" } elseif {[file exists ".galng.defaults.$game"]} { set ifilename ".galng.defaults.$game" set vregexp "^GALNGVERGAME: (\[0-9\]+\\.\[0-9\]+)" } if {$ifilename != ""} { set ifile [open "$ifilename" "r"] set version_string [gets $ifile] close $ifile if {[regexp $vregexp $version_string whole defaults_version]} { switch $defaults_version { 2.0 { load_game_defaults_2_0 "$ifilename" } 1.5 { set upgrade 1 load_game_defaults_1_5 "$ifilename" } 1.4 { set upgrade 1 load_game_defaults_1_4 "$ifilename" } default { set wrong 1 } } } else { set wrong 1 } if {$upgrade} { set delete [tk_messageBox -type yesno -icon question -title "old game preferences file found" \ -message "Old game preferences file found and loaded. Do you want to delete it now?\n(Say no if you want to use previous version of galng.tcl; this question will not be asked again)"] } elseif {$wrong} { set delete [tk_messageBox -type yesno -icon question -title "wrong game preferences file found" \ -message "Wrong game preferences file found: $ifilename\nDelete?"] } show_string "NOTE: Found game preferences file version $defaults_version" if {$delete} { file delete $ifilename } } else { show_string "NOTE: No game preferences file found" } } #}}} #}}} #{{{ main frame & menu & etc.. etc.. #{{{ autoscroll # # taken from Tcl`ers wiki (http://wiki.tcl.tk/) # Copyright by Kevin Kenny # #---------------------------------------------------------------------- # # autoscroll.tcl -- # # Package to create scroll bars that automatically appear when # a window is too small to display its content. # #---------------------------------------------------------------------- namespace eval autoscroll { namespace export autoscroll bind Autoscroll [namespace code [list delete %W]] bind Autoscroll [namespace code [list map %W]] } #---------------------------------------------------------------------- # # autoscroll::autoscroll -- # # Create a scroll bar that disappears when it is not needed, and # reappears when it is. # # Parameters: # w -- Path name of the scroll bar, which should already # exist and have its geometry managed by the gridder. # # Results: # None. # # Side effects: # The widget command is renamed, so that the 'set' command can # be intercepted and determine whether the widget should appear. # In addition, the 'Autoscroll' bind tag is added to the widget, # so that the event can be intercepted. # # Notes: # It is an error to change the widget's gridding after # calling 'autoscroll' on it. # #---------------------------------------------------------------------- proc autoscroll::autoscroll { w args } { variable grid variable needed variable text set text($w) 0 for {set i 0} {$i < [llength $args]} {incr i} { switch -exact -- [lindex $args $i] { -text { set text($w) 1 } default { # do nothing } } } rename $w [namespace current]::renamed$w proc ::$w {args} " return \[eval \[list autoscroll::widgetCommand $w\] \$args\] " set i [grid info $w] if { [string match {} $i] } { error "$w is not gridded" } set grid($w) $i set needed($w) 1 bindtags $w [linsert [bindtags $w] 1 Autoscroll] eval [list ::$w set] [renamed$w get] return } #---------------------------------------------------------------------- # # autoscroll::widgetCommand -- # # Widget command on an 'autoscroll' scrollbar # # Parameters: # w -- Path name of the scroll bar # command -- Widget command being executed # args -- Arguments to the commane # # Results: # Returns whatever the widget command returns # # Side effects: # Has whatever side effects the widget command has. In # addition, the 'set' widget command is handled specially, # by setting/unsetting the 'needed' flag and gridding/ungridding # the scroll bar according to whether it is required. # #---------------------------------------------------------------------- proc autoscroll::widgetCommand { w command args } { variable grid variable needed variable needed_prot variable needed_try variable text switch -exact -- $command { set { foreach { min max } $args {} if { $min <= 0 && $max >= 1 } { if {$text($w)} { if { [info exists needed($w)] && ![info exists needed_prot($w)]} { unset needed($w) grid forget $w set needed_try($w) 1 update catch "unset needed_try($w)" } } else { if { [info exists needed($w)] } { unset needed($w) grid forget $w } } } else { if {$text($w)} { if { ! [info exists needed($w)] } { set needed($w) {} eval [list grid $w] $grid($w) if {[info exists needed_try($w)]} { set needed_prot($w) 1 } elseif {[info exists needed_prot($w)]} { unset needed_prot($w) } } elseif {[info exists needed_prot($w)]} { unset needed_prot($w) } } else { if { ! [info exists needed($w)] } { set needed($w) {} eval [list grid $w] $grid($w) } } } } } return [eval [list renamed$w $command] $args] } #---------------------------------------------------------------------- # # autoscroll::delete -- # # Delete an automatic scroll bar # # Parameters: # w -- Path name of the scroll bar # # Results: # None. # # Side effects: # Cleans up internal memory. # #---------------------------------------------------------------------- proc autoscroll::delete { w } { variable grid variable needed catch { unset grid($w) } catch { unset needed($w) } catch { rename renamed$w {} } return } #---------------------------------------------------------------------- # # autoscroll::map -- # # Callback executed when an automatic scroll bar is mapped. # # Parameters: # w -- Path name of the scroll bar. # # Results: # None. # # Side effects: # Geometry of the scroll bar's top-level window is constrained. # # This procedure keeps the top-level window associated with an # automatic scroll bar from being resized automatically after the # scroll bar is mapped. This effect avoids a potential endless loop # in the case where the resize of the top-level window resizes the # widget being scrolled, causing the scroll bar no longer to be needed. # #---------------------------------------------------------------------- proc autoscroll::map { w } { # wm geometry [winfo toplevel $w] \ # [wm geometry [winfo toplevel $w]] } namespace import ::autoscroll::autoscroll #}}} #{{{ Tree widget #{{{ tree data # # Bitmaps used to show which parts of the tree can be opened. # set maskdata "#define solid_width 9\n#define solid_height 9" append maskdata { static unsigned char solid_bits[] = { 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01, 0xff, 0x01 }; } set data "#define open_width 9\n#define open_height 9" append data { static unsigned char open_bits[] = { 0xff, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0xff, 0x01 }; } image create bitmap Tree:openbm -data $data -maskdata $maskdata \ -foreground black -background white set data "#define closed_width 9\n#define closed_height 9" append data { static unsigned char closed_bits[] = { 0xff, 0x01, 0x01, 0x01, 0x11, 0x01, 0x11, 0x01, 0x7d, 0x01, 0x11, 0x01, 0x11, 0x01, 0x01, 0x01, 0xff, 0x01 }; } image create bitmap Tree:closedbm -data $data -maskdata $maskdata \ -foreground black -background white image create photo idir -data { R0lGODdhEAAQAPIAAAAAAHh4eLi4uPj4APj4+P///wAAAAAAACwAAAAAEAAQAAADPVi63P4w LkKCtTTnUsXwQqBtAfh910UU4ugGAEucpgnLNY3Gop7folwNOBOeiEYQ0acDpp6pGAFArVqt hQQAO/// } image create photo ifile -data { R0lGODdhEAAQAPIAAAAAAHh4eLi4uPj4+P///wAAAAAAAAAAACwAAAAAEAAQAAADPkixzPOD yADrWE8qC8WN0+BZAmBq1GMOqwigXFXCrGk/cxjjr27fLtout6n9eMIYMTXsFZsogXRKJf6u P0kCADv/ } #}}} #{{{ Tree:create # # Create a new tree widget. $args become the configuration arguments to # the canvas widget from which the tree is constructed. # proc Tree:create {w args} { global Tree eval canvas $w -bg white $args bind $w "Tree:delitem $w /" Tree:dfltconfig $w / Tree:buildwhenidle $w set Tree($w:selection) {} set Tree($w:selidx) {} } #}}} #{{{ Tree:dfltconfig # Initialize a element of the tree. # Internal use only # proc Tree:dfltconfig {w v} { global Tree set Tree($w:$v:children) {} set Tree($w:$v:open) 0 set Tree($w:$v:icon) {} set Tree($w:$v:tags) {} } #}}} #{{{ Tree:config # # Pass configuration options to the tree widget # proc Tree:config {w args} { eval $w config $args } #}}} #{{{ Tree:newitem # # Insert a new element $v into the tree $w. # proc Tree:newitem {w v args} { global Tree set dir [file dirname $v] set n [file tail $v] if {![info exists Tree($w:$dir:open)]} { error "parent item \"$dir\" is missing" } set i [lsearch -exact $Tree($w:$dir:children) $n] if {$i>=0} { error "item \"$v\" already exists" } lappend Tree($w:$dir:children) $n # we want not to sort them # set Tree($w:$dir:children) [lsort $Tree($w:$dir:children)] Tree:dfltconfig $w $v foreach {op arg} $args { switch -exact -- $op { -image {set Tree($w:$v:icon) $arg} -tags {set Tree($w:$v:tags) $arg} } } Tree:buildwhenidle $w } #}}} #{{{ Tree:delitem # # Delete element $v from the tree $w. If $v is /, then the widget is # deleted. # proc Tree:delitem {w v} { global Tree if {![info exists Tree($w:$v:open)]} return if {[string compare $v /]==0} { # delete the whole widget catch {destroy $w} foreach t [array names Tree $w:*] { unset Tree($t) } } foreach c $Tree($w:$v:children) { catch {Tree:delitem $w $v/$c} } unset Tree($w:$v:open) unset Tree($w:$v:children) unset Tree($w:$v:icon) set dir [file dirname $v] set n [file tail $v] set i [lsearch -exact $Tree($w:$dir:children) $n] if {$i>=0} { set Tree($w:$dir:children) [lreplace $Tree($w:$dir:children) $i $i] } Tree:buildwhenidle $w } #}}} #{{{ Tree:setselection # # Change the selection to the indicated item # proc Tree:setselection {w v} { global Tree set Tree($w:selection) $v Tree:drawselection $w } #}}} #{{{ Tree:getselection # # Retrieve the current selection # proc Tree:getselection w { global Tree return $Tree($w:selection) } #}}} #{{{ Tree:build # Internal use only. # Draw the tree on the canvas proc Tree:build w { global Tree $w delete all catch {unset Tree($w:buildpending)} set Tree($w:y) 30 Tree:buildlayer $w / 10 $w config -scrollregion [$w bbox all] Tree:drawselection $w } #}}} #{{{ Tree:buildlayer # Internal use only. # Build a single layer of the tree on the canvas. Indent by $in pixels proc Tree:buildlayer {w v in} { global Tree if {$v=="/"} { set vx {} } else { set vx $v } set start [expr {$Tree($w:y)-10}] set y $start foreach c $Tree($w:$v:children) { set y $Tree($w:y) incr Tree($w:y) 17 $w create line $in $y [expr {$in+10}] $y -fill gray50 set icon $Tree($w:$vx/$c:icon) set taglist x foreach tag $Tree($w:$vx/$c:tags) { lappend taglist $tag } set x [expr {$in+12}] if {[string length $icon]>0} { set k [$w create image $x $y -image $icon -anchor w -tags $taglist] incr x 20 set Tree($w:tag:$k) $vx/$c } set j [$w create text $x $y -text $c -font $Tree(font) \ -anchor w -tags $taglist] set Tree($w:tag:$j) $vx/$c set Tree($w:$vx/$c:tag) $j if {[string length $Tree($w:$vx/$c:children)]} { if {$Tree($w:$vx/$c:open)} { set j [$w create image $in $y -image Tree:openbm] $w bind $j <1> "set Tree($w:$vx/$c:open) 0; Tree:build $w" Tree:buildlayer $w $vx/$c [expr {$in+18}] } else { set j [$w create image $in $y -image Tree:closedbm] $w bind $j <1> "set Tree($w:$vx/$c:open) 1; Tree:build $w" } } } set j [$w create line $in $start $in [expr {$y+1}] -fill gray50 ] $w lower $j } #}}} #{{{ Tree:open # Open a branch of a tree # proc Tree:open {w v} { global Tree if {[info exists Tree($w:$v:open)] && $Tree($w:$v:open)==0 && [info exists Tree($w:$v:children)] && [string length $Tree($w:$v:children)]>0} { set Tree($w:$v:open) 1 Tree:build $w } } #}}} #{{{ Tree:close proc Tree:close {w v} { global Tree if {[info exists Tree($w:$v:open)] && $Tree($w:$v:open)==1} { set Tree($w:$v:open) 0 Tree:build $w } } #}}} #{{{ Tree:drawselection # Internal use only. # Draw the selection highlight proc Tree:drawselection w { global Tree if {[string length $Tree($w:selidx)]} { $w delete $Tree($w:selidx) } set v $Tree($w:selection) if {[string length $v]==0} return if {![info exists Tree($w:$v:tag)]} return set bbox [$w bbox $Tree($w:$v:tag)] if {[llength $bbox]==4} { set i [eval $w create rectangle $bbox -fill skyblue -outline {{}}] set Tree($w:selidx) $i $w lower $i } else { set Tree($w:selidx) {} } } #}}} #{{{ Tree:buildwhenidle # Internal use only # Call Tree:build then next time we're idle proc Tree:buildwhenidle w { global Tree if {![info exists Tree($w:buildpending)]} { set Tree($w:buildpending) 1 after idle "Tree:build $w" } } #}}} #{{{ Tree:labelat # # Return the full pathname of the label for widget $w that is located # at real coordinates $x, $y # proc Tree:labelat {w x y} { set x [$w canvasx $x] set y [$w canvasy $y] global Tree foreach m [$w find overlapping $x $y $x $y] { if {[info exists Tree($w:tag:$m)]} { return $Tree($w:tag:$m) } } return "" } #}}} #}}} #{{{ MLbox #{{{ data # set MLbox(font) [font create -family helvetica -size 10] set MLbox(layout_image) [image create bitmap -data { #define mlbox_width 14 #define mlbox_height 14 static unsigned char mlbox_bits[] = { 0x00, 0x00, 0xfe, 0x0f, 0x42, 0x08, 0x42, 0x08, 0xfe, 0x0f, 0x02, 0x08, 0x02, 0x08, 0x02, 0x08, 0xfe, 0x0f, 0x00, 0x00, 0x00, 0x1f, 0x00, 0x0e, 0x00, 0x04, 0x00, 0x00}; }] set MLbox(sort_asc_image) [image create bitmap -data { #define sort_asc_width 5 #define sort_asc_height 5 static unsigned char sort_asc_bits[] = { 0x00, 0x1f, 0x0e, 0x04, 0x00}; }] set MLbox(sort_desc_image) [image create bitmap -data { #define sort_desc_width 5 #define sort_desc_height 5 static unsigned char sort_desc_bits[] = { 0x00, 0x04, 0x0e, 0x1f, 0x00}; }] #}}} #{{{ create proc MLbox:create {w args} { global MLbox set MLbox($w:state) normal set MLbox($w:autoindex) 0 set canvas_args "" for {set i 0} {$i < [llength $args]} {incr i} { switch -exact -- [lindex $args $i] { -autoindex { set MLbox($w:autoindex) 1 set MLbox($w:lastindex) 0 } default { lappend canvas_args [lindex $args $i] } } } eval canvas $w $canvas_args set MLbox($w:menuposted) 0 menu $w.menu -tearoff 0 -postcommand "set MLbox($w:menuposted) 1" MLbox:clear $w set MLbox($w:state) normal MLbox:setlayout $w "" set MLbox(linespace) [font metrics $MLbox(font) -linespace] set MLbox($w:orderby) -1 set MLbox($w:orderdirection) increasing $w bind header <1> "MLbox:orderby $w \[lindex \[$w gettags current\] 1\]" $w bind selectlayout <1> "$w.menu post %X %Y" $w bind item <1> "MLbox:setselection $w \[lindex \[$w gettags current\] 1\]" $w bind bg <1> "MLbox:setselection $w \[lindex \[$w gettags current\] 1\]" MLbox:buildwhenidle $w } #}}} #{{{ clear proc MLbox:clear {w} { global MLbox set MLbox($w:items) "" set MLbox($w:lastindex) 0 set MLbox($w:selection) -1 set MLbox($w:header) {} set MLbox($w:tag) {} MLbox:buildwhenidle $w } #}}} #{{{ setlayout proc MLbox:setlayout {w args} { global MLbox set MLbox($w:layout) "" set args_l [llength $args] for {set i 0} {$i < $args_l} {incr i} { set l [lindex $args $i] catch "unset MLbox($w:format:$i)" # FIXME: uncomment when needed # catch "unset MLbox($w:justify:$i)" set MLbox($w:minwidth:$i) 0 set MLbox($w:order:$i) ascii if {[llength $l] > 1} { lappend MLbox($w:layout) [lindex $l 0] set l_l [llength $l] for {set li 1} {$li < $l_l} {incr li} { set opt [lindex $l $li] if {$opt == "-minwidth"} { set MLbox($w:minwidth:$i) [font measure $MLbox(font) [lindex $l [expr {$li + 1}]]] incr li } elseif {$opt == "-format"} { set MLbox($w:format:$i) [lindex $l [expr {$li + 1}]] incr li } elseif {$opt == "-ascii"} { set MLbox($w:order:$i) ascii } elseif {$opt == "-dictionary"} { set MLbox($w:order:$i) dictionary } elseif {$opt == "-integer"} { set MLbox($w:order:$i) integer } elseif {$opt == "-real"} { set MLbox($w:order:$i) real } # FIXME: rewrite justify when needed } } else { lappend MLbox($w:layout) $l } } $w.menu delete 0 end set layout_l [llength $MLbox($w:layout)] for {set f 0} {$f < $layout_l} {incr f} { set MLbox($w:layout:$f) 1 $w.menu add checkbutton -label [lindex $MLbox($w:layout) $f] -variable MLbox($w:layout:$f) -command " MLbox:buildwhenidle $w " } MLbox:buildwhenidle $w } #}}} #{{{ setvisible proc MLbox:setvisible {w v} { global MLbox for {set i 0} {$i < [llength $MLbox($w:layout)]} {incr i} { if {[lindex $v $i] != ""} { set MLbox($w:layout:$i) [lindex $v $i] } } MLbox:buildwhenidle $w } #}}} #{{{ getvisible proc MLbox:getvisible {w} { global MLbox set v "" for {set i 0} {$i < [llength $MLbox($w:layout)]} {incr i} { if {[info exists MLbox($w:layout:$i)]} { lappend v $MLbox($w:layout:$i) } else { lappend v 1 } } return $v } #}}} #{{{ setheader & settag & gettag & setstate proc MLbox:setheader {w str} { global MLbox set MLbox($w:header) $str MLbox:buildwhenidle $w } proc MLbox:settag {w str} { global MLbox set MLbox($w:tag) $str } proc MLbox:gettag {w} { global MLbox if {[info exists MLbox($w:tag)]} { return $MLbox($w:tag) } else { return "" } } proc MLbox:setstate {w state} { global MLbox set MLbox($w:state) $state MLbox:buildwhenidle $w } #}}} #{{{ orderby proc MLbox:orderby {w f} { global MLbox if {[info exists MLbox($w:orderby)] && $MLbox($w:orderby) == $f} { if {$MLbox($w:orderdirection) == "increasing"} { set MLbox($w:orderdirection) decreasing } else { set MLbox($w:orderdirection) increasing } } else { set MLbox($w:orderby) $f set MLbox($w:orderdirection) increasing } MLbox:buildwhenidle $w } #}}} #{{{ setorder proc MLbox:setorder {w i d} { global MLbox set MLbox($w:orderby) $i set MLbox($w:orderdirection) $d MLbox:buildwhenidle $w } #}}} #{{{ getorder proc MLbox:getorder {w} { global MLbox if {[info exists MLbox($w:orderby)]} { set i $MLbox($w:orderby) } else { set i -1 } if {[info exists MLbox($w:orderdirection)]} { set d $MLbox($w:orderdirection) } else { set d increasing } return [list $i $d] } #}}} #{{{ sort proc MLbox:sort {w} { global MLbox if {![info exists MLbox($w:orderby)] || $MLbox($w:orderby) < 0} { return } set i $MLbox($w:orderby) if {[info exists MLbox($w:order:$i)]} { set type $MLbox($w:order:$i) } else { set type ascii } if {![catch "lsort -$type -$MLbox($w:orderdirection) -index [expr {$i + 1}] [list $MLbox($w:items)]" err]} { set MLbox($w:items) [lsort -$type -$MLbox($w:orderdirection) -index [expr {$i + 1}] $MLbox($w:items)] } else { # puts $err } } #}}} #{{{ setselection proc MLbox:setselection {w i} { global MLbox set MLbox($w:selection) $i if {$MLbox($w:state) == "normal"} { MLbox:buildwhenidle $w } } #}}} #{{{ calc_layer_width proc MLbox:calc_layer_width {w} { global MLbox if {[info exists MLbox($w:orderby)]} { set orderby $MLbox($w:orderby) } else { set orderby -1 } for {set f 0} {$f < [llength $MLbox($w:layout)]} {incr f} { set fields($f) [font measure $MLbox(font) [lindex $MLbox($w:layout) $f]] if {$f == $orderby} { set fields($f) [expr {$fields($f) + [image width $MLbox(sort_desc_image)] + 4}] } if {[info exists MLbox($w:minwidth:$f)] && $MLbox($w:minwidth:$f) > $fields($f)} { set fields($f) $MLbox($w:minwidth:$f) } } foreach i $MLbox($w:items) { for {set f 1} {$f <= [llength $MLbox($w:layout)]} {incr f} { set width [font measure $MLbox(font) [lindex $i $f]] if {$width > $fields([expr {$f - 1}])} { set fields([expr {$f - 1}]) $width } } } set MLbox($w:width) "" for {set f 0} {$f < [llength $MLbox($w:layout)]} {incr f} { lappend MLbox($w:width) $fields($f) } } #}}} #{{{ build proc MLbox:build {w} { global MLbox catch {unset MLbox($w:buildpending)} MLbox:sort $w MLbox:calc_layer_width $w $w delete all set dy $MLbox(linespace) set x 8 set y 5 set orderby $MLbox($w:orderby) set selection $MLbox($w:selection) set canvas_bg [$w cget -background] set layout_l [llength $MLbox($w:layout)] set layout $MLbox($w:layout) set width $MLbox($w:width) set font $MLbox(font) if {$MLbox($w:header) != ""} { $w create text $x $y -text $MLbox($w:header) -anchor nw -font $font incr y $dy incr y 4 } for {set f 0} {$f < $layout_l} {incr f} { if {$MLbox($w:layout:$f)} { $w create text $x $y -text [lindex $layout $f] -anchor nw -font $font -tag "header $f" incr x [expr {[lindex $width $f] + 8}] if {$f == $orderby} { if {$MLbox($w:orderdirection) == "increasing"} { $w create image \ [expr {$x - 10 - [image width $MLbox(sort_asc_image)]}] \ [expr {$y + ($dy / 2) - ([image height $MLbox(sort_asc_image)] / 2)}] \ -image $MLbox(sort_asc_image) -anchor nw -tag "header $f" } else { $w create image \ [expr {$x - 10 - [image width $MLbox(sort_desc_image)]}] \ [expr {$y + ($dy / 2) - ([image height $MLbox(sort_asc_image)] / 2)}] \ -image $MLbox(sort_desc_image) -anchor nw -tag "header $f" } } } } if {$MLbox($w:header) != ""} { $w create line 3 [expr {$y - 2}] [expr {$x - 3}] [expr {$y - 2}] } $w create image $x $y -anchor nw -image $MLbox(layout_image) -tag selectlayout if {[image height $MLbox(layout_image)] > $dy} { incr y [image height $MLbox(layout_image)] } else { incr y $dy } $w create line 3 $y [expr {$x - 3}] $y incr y 3 foreach i $MLbox($w:items) { set x 8 set id [lindex $i 0] set fg $MLbox($w:fg:$id) set bg $MLbox($w:bg:$id) for {set f 1} {$f <= $layout_l} {incr f} { set f1 [expr {$f - 1}] if {$MLbox($w:layout:$f1)} { set str [lindex $i $f] # FIXME: reenable when we will need justify # if {$MLbox($w:justify:$f1) == "right"} { # set xt [expr {$x + [lindex $width $f1] - \ # [font measure $font $str]}] # } else { # set xt $x # } set xt $x $w create text $xt $y -text $str -anchor nw \ -font $font -fill $fg -tag "item $id" incr x [expr {[lindex $width $f1] + 8}] } } if {$MLbox($w:state) == "normal" && $id == $selection} { set outline $fg } else { set outline $bg } if {$bg != $canvas_bg || $outline != $canvas_bg} { $w create rectangle 3 $y [expr {$x - 3}] [expr {$y + $dy}] \ -fill $bg -outline $outline -width 2 \ -tags "bg $id" } incr y [expr {$dy + 3}] } $w lower bg $w config -scrollregion [$w bbox all] } #}}} #{{{ add proc MLbox:add {w args} { global MLbox set fg [$w cget -insertbackground] set bg [$w cget -bg] set args_l [llength $args] for {set i 0} {$i < $args_l} {incr i} { set arg [lindex $args $i] if {$arg == "-fg"} { incr i set fg [lindex $args $i] } elseif {$arg == "-bg"} { incr i set bg [lindex $args $i] } else { if {$MLbox($w:autoindex)} { set item $MLbox($w:lastindex) set id $item incr MLbox($w:lastindex) } else { set item "" set id [lindex $args $i] } for {set j $i} {$j < $args_l} {incr j} { set argj [lindex $args $j] if {[info exists MLbox($w:format:[expr {$j - $i}])] && $argj != ""} { lappend item [string trim [format $MLbox($w:format:[expr {$j - $i}]) $argj]] } else { lappend item $argj } } set layout_l [llength $MLbox($w:layout)] for {set j [llength $item]} {$j <= $layout_l} {incr j} { lappend item "" } lappend MLbox($w:items) $item set MLbox($w:fg:$id) $fg set MLbox($w:bg:$id) $bg MLbox:buildwhenidle $w return } } } #}}} #{{{ buildwhenidle proc MLbox:buildwhenidle {w} { global MLbox if {![info exists MLbox($w:buildpending)]} { set MLbox($w:buildpending) 1 after idle "MLbox:build $w" } } #}}} #}}} #{{{ map_incapsulate proc map_incapsulate {map} { global incapsulated_map rename $map incapsulated_map proc $map {args} " return \[eval \[list map_command\] \$args\] " } #}}} #{{{ main frame creation wm title . "galng.tcl" wm protocol . WM_DELETE_WINDOW { set main_win_geom [wm geometry .] save_defaults save_game_defaults exit } # top ------------------------------------------- frame .top # primary --------------------------------------- frame .prim frame .prim.left frame .prim.main frame .prim.right # left ---------------------- button .prim.left.switch -text "Show orders" -command { switch_tree_orders } pack .prim.left.switch -fill x frame .prim.left.tree -width 150 Tree:create .prim.left.tree.w \ -yscrollcommand [list .prim.left.tree.vsb set] \ -xscrollcommand [list .prim.left.tree.hsb set] scrollbar .prim.left.tree.vsb -orient vertical -command [list .prim.left.tree.w yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .prim.left.tree.hsb -orient horizontal -command [list .prim.left.tree.w xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 pack .prim.left.tree -fill both -expand 1 grid .prim.left.tree.w -column 0 -row 0 -sticky news grid .prim.left.tree.vsb -column 1 -row 0 -sticky ns grid .prim.left.tree.hsb -column 0 -row 1 -sticky ew grid rowconfigure .prim.left.tree 0 -weight 2 grid columnconfigure .prim.left.tree 0 -weight 2 grid propagate .prim.left.tree 0 autoscroll .prim.left.tree.vsb autoscroll .prim.left.tree.hsb frame .prim.left.orders -width 150 text .prim.left.orders.txt -wrap none \ -xscrollcommand [list .prim.left.orders.h set] -yscrollcommand [list .prim.left.orders.v set] scrollbar .prim.left.orders.v -orient vertical -command [list .prim.left.orders.txt yview] \ -width $sb_width_opt -border 1 scrollbar .prim.left.orders.h -orient horizontal -command [list .prim.left.orders.txt xview] \ -width $sb_width_opt -border 1 grid .prim.left.orders.txt -column 0 -row 0 -sticky news grid .prim.left.orders.v -column 1 -row 0 -sticky ns grid .prim.left.orders.h -column 0 -row 1 -sticky ew grid rowconfigure .prim.left.orders 0 -weight 2 grid columnconfigure .prim.left.orders 0 -weight 2 grid propagate .prim.left.orders 0 autoscroll .prim.left.orders.v -text autoscroll .prim.left.orders.h -text set left_frame_content tree # main ---------------------- canvas .prim.main.can -relief sunken -bd 0 -bg [lindex $current_theme 0] \ -xscrollcommand [list .prim.main.hsb set] -yscrollcommand [list .prim.main.vsb set] \ -xscrollincrement 4 -yscrollincrement 4 \ -closeenough 2.0 -cursor circle -width 100 -height 100 scrollbar .prim.main.vsb -orient vertical -command [list .prim.main.can yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .prim.main.hsb -orient horizontal -command [list .prim.main.can xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 grid .prim.main.can -column 0 -row 0 -sticky news grid .prim.main.vsb -column 1 -row 0 -sticky ns grid .prim.main.hsb -column 0 -row 1 -sticky ew grid columnconfigure .prim.main 0 -weight 2 grid rowconfigure .prim.main 0 -weight 2 autoscroll .prim.main.vsb autoscroll .prim.main.hsb # right --------------------- frame .prim.right.inventory -width 150 text .prim.right.inventory.txt -wrap none -takefocus 0 -state disabled -font $fixedfont \ -xscrollcommand [list .prim.right.inventory.h set] -yscrollcommand [list .prim.right.inventory.v set] scrollbar .prim.right.inventory.v -orient vertical -command [.prim.right.inventory.txt yview] \ -width $sb_width_opt -border 1 scrollbar .prim.right.inventory.h -orient horizontal -command [.prim.right.inventory.txt xview] \ -width $sb_width_opt -border 1 button .prim.right.log -text "Log" -state normal -command {show_info log} button .prim.right.groups -text "Orbit" -state disabled -command {show_info groups} button .prim.right.battle -text "Battle" -state disabled -command {show_info battle} button .prim.right.messages -text "Messages" -state disabled -command {show_info messages} button .prim.right.battleview -text "BattleViewer" -state disabled -command {show_battleview} grid .prim.right.log -column 0 -row 0 -columnspan 2 -sticky ew grid .prim.right.groups -column 0 -row 1 -sticky ew grid .prim.right.battle -column 1 -row 1 -sticky ew # grid .prim.right.messages -column 0 -row 2 -columnspan 2 -sticky ew grid .prim.right.battleview -column 0 -row 2 -columnspan 2 -sticky ew grid .prim.right.inventory.txt -column 0 -row 0 -sticky news grid .prim.right.inventory.v -column 1 -row 0 -sticky ns grid .prim.right.inventory.h -column 0 -row 1 -sticky ew grid rowconfigure .prim.right.inventory 0 -weight 2 grid columnconfigure .prim.right.inventory 0 -weight 2 grid .prim.right.inventory -column 0 -row 3 -columnspan 2 -sticky news grid rowconfigure .prim.right 3 -weight 2 grid propagate .prim.right.inventory 0 autoscroll .prim.right.inventory.v -text autoscroll .prim.right.inventory.h -text # pack ---------------------- # may be don`t show it by default? pack .prim.left -fill y -side left pack .prim.main -fill both -expand 1 -side left pack .prim.right -fill y -side right # secondary ------------------------------------- frame .sec -height 120 frame .sec.log frame .sec.groups frame .sec.battle frame .sec.messages # log ----------------------- text .sec.log.text -wrap word -yscrollcommand [list .sec.log.sb set] scrollbar .sec.log.sb -orient vertical -command [list .sec.log.text yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 pack .sec.log.text -side left -fill both -expand 1 pack .sec.log.sb -side right -fill y # groups -------------------- # listbox .sec.groups.list -font $fixedfont \ # -yscrollcommand [list .sec.groups.vsb set] \ # -xscrollcommand [list .sec.groups.hsb set] MLbox:create .sec.groups.list -autoindex \ -yscrollcommand [list .sec.groups.vsb set] \ -xscrollcommand [list .sec.groups.hsb set] MLbox:setstate .sec.groups.list disabled scrollbar .sec.groups.vsb -orient vertical -command [list .sec.groups.list yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .sec.groups.hsb -orient horizontal -command [list .sec.groups.list xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 grid .sec.groups.list -column 0 -row 0 -sticky news grid .sec.groups.vsb -column 1 -row 0 -sticky ns grid .sec.groups.hsb -column 0 -row 1 -sticky ew grid columnconfigure .sec.groups 0 -weight 2 grid rowconfigure .sec.groups 0 -weight 2 autoscroll .sec.groups.vsb autoscroll .sec.groups.hsb # battle -------------------- # listbox .sec.battle.my_list \ # -yscrollcommand [list .sec.battle.my_vsb set] \ # -xscrollcommand [list .sec.battle.my_hsb set] \ # -bg $green_color -font $fixedfont -takefocus 0 frame .sec.battle.my MLbox:create .sec.battle.my.list -autoindex \ -yscrollcommand [list .sec.battle.my.vsb set] \ -xscrollcommand [list .sec.battle.my.hsb set] MLbox:setstate .sec.battle.my.list disabled scrollbar .sec.battle.my.vsb -orient vertical -command [list .sec.battle.my.list yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .sec.battle.my.hsb -orient horizontal -command [list .sec.battle.my.list xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 # listbox .sec.battle.their_list \ # -yscrollcommand [list .sec.battle.their_vsb set] \ # -xscrollcommand [list .sec.battle.their_hsb set] \ # -bg $red_color -font $fixedfont -takefocus 0 frame .sec.battle.their MLbox:create .sec.battle.their.list -autoindex \ -yscrollcommand [list .sec.battle.their.vsb set] \ -xscrollcommand [list .sec.battle.their.hsb set] MLbox:setstate .sec.battle.their.list disabled scrollbar .sec.battle.their.vsb -orient vertical -command [list .sec.battle.their.list yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .sec.battle.their.hsb -orient horizontal -command [list .sec.battle.their.list xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 # noone can understand this. it`s woodoo.. pack .sec.battle.my -side left -fill both -expand 1 pack .sec.battle.their -side right -fill both -expand 1 grid .sec.battle.my.list -column 0 -row 0 -sticky news grid .sec.battle.my.vsb -column 1 -row 0 -sticky ns grid .sec.battle.my.hsb -column 0 -row 1 -sticky ew grid .sec.battle.their.list -column 0 -row 0 -sticky news grid .sec.battle.their.vsb -column 1 -row 0 -sticky ns grid .sec.battle.their.hsb -column 0 -row 1 -sticky ew grid columnconfigure .sec.battle.my 0 -weight 2 grid columnconfigure .sec.battle.their 0 -weight 2 grid rowconfigure .sec.battle.my 0 -weight 2 grid rowconfigure .sec.battle.their 0 -weight 2 autoscroll .sec.battle.my.vsb autoscroll .sec.battle.my.hsb autoscroll .sec.battle.their.vsb autoscroll .sec.battle.their.hsb # messages ------------------ text .sec.messages.text -wrap word -yscrollcommand [list .sec.messages.sb set] scrollbar .sec.messages.sb -orient vertical -command [list .sec.messages.text yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 pack .sec.messages.text -side left -fill both -expand 1 pack .sec.messages.sb -side right -fill y # pack ---------------------- pack .sec.log -fill both -expand 1 pack propagate .sec 0 set current_sec_frame log # bottom ---------------------------------------- entry .bottom -state disabled -textvariable chattext # pack them all.. ------------------------------- pack .top -fill x pack .prim -fill both -expand 1 pack .sec -fill x pack .bottom -fill x # set global variables -------------------------- set galng_frame_top .top set galng_frame_primary .prim set galng_frame_secondary .sec set galng_frame_bottom .bottom set map_can $galng_frame_primary.main.can map_incapsulate $map_can set tree $galng_frame_primary.left.tree.w set inventory $galng_frame_primary.right.inventory.txt set chat_entry $galng_frame_bottom set chat_box $galng_frame_secondary.log.text set log_button $galng_frame_primary.right.log set groups_button $galng_frame_primary.right.groups set battle_button $galng_frame_primary.right.battle set battleview_button $galng_frame_primary.right.battleview set messages_button $galng_frame_primary.right.messages set frame_groups_list $galng_frame_secondary.groups.list set frame_battle_my_list $galng_frame_secondary.battle.my.list set frame_battle_their_list $galng_frame_secondary.battle.their.list set frame_messages_text $galng_frame_secondary.messages.text #}}} #{{{ top menu menubutton $galng_frame_top.main -text Galaxy -underline 0 -menu $galng_frame_top.main.menu pack $galng_frame_top.main -side left menubutton $galng_frame_top.tools -text Tools -underline 0 -menu $galng_frame_top.tools.menu pack $galng_frame_top.tools -side left menubutton $galng_frame_top.options -text Options -underline 0 -menu $galng_frame_top.options.menu pack $galng_frame_top.options -side left menubutton $galng_frame_top.galng_help -text Help -underline 0 -menu $galng_frame_top.galng_help.menu pack $galng_frame_top.galng_help -side left # menu $galng_frame_top.menubar -type menubar -relief flat # $galng_frame_top.menubar add cascade -label Galaxy -menu $galng_frame_top.menubar.main -underline 0 # $galng_frame_top.menubar add cascade -label Tools -menu $galng_frame_top.menubar.tools -underline 0 # $galng_frame_top.menubar add cascade -label Options -menu $galng_frame_top.menubar.options -underline 0 # $galng_frame_top.menubar add cascade -label Help -menu $galng_frame_top.menubar.galng_help -underline 0 # if {$tcl_platform(platform) == "macintosh"} { # . configure -menu $galng_frame_top.menubar # } else { # pack $galng_frame_top.menubar -in $galng_frame_top -side left -fill both -expand 1 # } # Galaxy menu ----------------------------------- menu $galng_frame_top.main.menu -tearoff 0 $galng_frame_top.main.menu add command -label "Load report..." -command {load_report} $galng_frame_top.main.menu add command -label "Load forecast..." -command {load_forecast} $galng_frame_top.main.menu add separator $galng_frame_top.main.menu add command -label "Your Turn Report" -command { if {[winfo exists .c]} { raise .c } else { make_report_window } } $galng_frame_top.main.menu add command -label "Notes" -command { if {[winfo exists .d]} { raise .d } else { make_notes_window } } $galng_frame_top.main.menu add separator $galng_frame_top.main.menu add command -label Quit -command { set main_win_geom [wm geometry .] save_defaults save_game_defaults exit } # Tools menu ------------------------------------ menu $galng_frame_top.tools.menu -tearoff 0 $galng_frame_top.tools.menu add command -label "Orders" -command { if {[winfo exists .orders]} { raise .orders } else { make_command_window_dm } } $galng_frame_top.tools.menu add command -label "Ship Designer (originally by fslothouber@acm.org)" -command { if {[winfo exists .shipyard]} { raise .shipyard } else { draw_shipyard } } $galng_frame_top.tools.menu add command -label "WOPR simulator" -command { if {[winfo exists .wopr]} { raise .wopr } else { make_wopr_window_dm } } # Options menu ---------------------------------- menu $galng_frame_top.options.menu -tearoff 0 $galng_frame_top.options.menu add cascade -label "Planet size" -menu $galng_frame_top.options.menu.psize $galng_frame_top.options.menu add cascade -label "Font size" -menu $galng_frame_top.options.menu.fsize menu $galng_frame_top.options.menu.psize -tearoff 0 $galng_frame_top.options.menu.psize add radiobutton -label "Huge" -value 4 -variable planet_size_factor \ -command { map_update planet_size } $galng_frame_top.options.menu.psize add radiobutton -label "Large" -value 2 -variable planet_size_factor \ -command { map_update planet_size } $galng_frame_top.options.menu.psize add radiobutton -label "Normal" -value 1 -variable planet_size_factor \ -command { map_update planet_size } $galng_frame_top.options.menu.psize add radiobutton -label "Small" -value 0.5 -variable planet_size_factor \ -command { map_update planet_size } $galng_frame_top.options.menu.psize add radiobutton -label "Tiny" -value 0.25 -variable planet_size_factor \ -command { map_update planet_size } $galng_frame_top.options.menu.psize add radiobutton -label "And yet more smaller" -value 0.1 \ -variable planet_size_factor -command { map_update planet_size } menu $galng_frame_top.options.menu.fsize -tearoff 0 $galng_frame_top.options.menu.fsize add radiobutton -label "Huge" -value 2 -variable font_size_factor \ -command { map_update font_size } $galng_frame_top.options.menu.fsize add radiobutton -label "Large" -value 1.5 -variable font_size_factor \ -command { map_update font_size } $galng_frame_top.options.menu.fsize add radiobutton -label "Normal" -value 1 -variable font_size_factor \ -command { map_update font_size } $galng_frame_top.options.menu.fsize add radiobutton -label "Small" -value 0.75 -variable font_size_factor \ -command { map_update font_size } $galng_frame_top.options.menu.fsize add radiobutton -label "Tiny" -value 0.4 -variable font_size_factor \ -command { map_update font_size } $galng_frame_top.options.menu.fsize add radiobutton -label "And yet more smaller" -value 0.25 \ -variable font_size_factor -command { map_update font_size } $galng_frame_top.options.menu add checkbutton -label "Display planet names" \ -variable draw_planet_names -command { map_update show_names } $galng_frame_top.options.menu add checkbutton -label "Display COL routes" \ -variable draw_routes_col -command { map_update show_routes } $galng_frame_top.options.menu add checkbutton -label "Display CAP routes" \ -variable draw_routes_cap -command { map_update show_routes } $galng_frame_top.options.menu add checkbutton -label "Display MAT routes" \ -variable draw_routes_mat -command { map_update show_routes } $galng_frame_top.options.menu add checkbutton -label "Display EMP routes" \ -variable draw_routes_emp -command { map_update show_routes } $galng_frame_top.options.menu add separator $galng_frame_top.options.menu add cascade -label "Sort orbited alien planets in tree" \ -menu $galng_frame_top.options.menu.tree_sort_a menu $galng_frame_top.options.menu.tree_sort_a -tearoff 0 $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by name" \ -variable tree_sort_planets_alien_orbited -value name -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by potential" \ -variable tree_sort_planets_alien_orbited -value potential -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by size" \ -variable tree_sort_planets_alien_orbited -value size -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by RES" \ -variable tree_sort_planets_alien_orbited -value res -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by POP" \ -variable tree_sort_planets_alien_orbited -value pop -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by IND" \ -variable tree_sort_planets_alien_orbited -value ind -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by CAP" \ -variable tree_sort_planets_alien_orbited -value cap -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by COL" \ -variable tree_sort_planets_alien_orbited -value col -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu.tree_sort_a add radiobutton -label "by MAT" \ -variable tree_sort_planets_alien_orbited -value mat -command { fill_tree_planets_alien_orbited } $galng_frame_top.options.menu add cascade -label "Sort unhabitated planets in tree" \ -menu $galng_frame_top.options.menu.tree_sort_u menu $galng_frame_top.options.menu.tree_sort_u -tearoff 0 $galng_frame_top.options.menu.tree_sort_u add radiobutton -label "by name" \ -variable tree_sort_planets_other_orbited -value name -command { fill_tree_planets_other_orbited } $galng_frame_top.options.menu.tree_sort_u add radiobutton -label "by potential" \ -variable tree_sort_planets_other_orbited -value potential -command { fill_tree_planets_other_orbited } $galng_frame_top.options.menu.tree_sort_u add radiobutton -label "by size" \ -variable tree_sort_planets_other_orbited -value size -command { fill_tree_planets_other_orbited } $galng_frame_top.options.menu.tree_sort_u add radiobutton -label "by RES" \ -variable tree_sort_planets_other_orbited -value res -command { fill_tree_planets_other_orbited } $galng_frame_top.options.menu add cascade -label "Sort mine planets in tree" \ -menu $galng_frame_top.options.menu.tree_sort_m menu $galng_frame_top.options.menu.tree_sort_m -tearoff 0 $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by name" \ -variable tree_sort_planets_mine -value name -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by potential" \ -variable tree_sort_planets_mine -value potential -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by size" \ -variable tree_sort_planets_mine -value size -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by RES" \ -variable tree_sort_planets_mine -value res -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by POP" \ -variable tree_sort_planets_mine -value pop -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by IND" \ -variable tree_sort_planets_mine -value ind -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by CAP" \ -variable tree_sort_planets_mine -value cap -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by COL" \ -variable tree_sort_planets_mine -value col -command { fill_tree_planets_mine } $galng_frame_top.options.menu.tree_sort_m add radiobutton -label "by MAT" \ -variable tree_sort_planets_mine -value mat -command { fill_tree_planets_mine } $galng_frame_top.options.menu add separator $galng_frame_top.options.menu add command -label "Save options" -command { save_defaults } $galng_frame_top.options.menu add command -label "Save game options" -command { save_game_defaults } # Help menu ------------------------------------- menu $galng_frame_top.galng_help.menu -tearoff 0 $galng_frame_top.galng_help.menu add command -label "on-line Help" -command { if {[winfo exists .e]} { raise .e } else { do_help_dialog } } $galng_frame_top.galng_help.menu add separator $galng_frame_top.galng_help.menu add command -label "About" -command { if {[winfo exists .about]} { raise .about } else { do_about_dialog } } $galng_frame_top.galng_help.menu add command -label "Copying" -command { if {[winfo exists .gpl]} { raise .gpl } else { do_copying } } $galng_frame_top.galng_help.menu add separator $galng_frame_top.galng_help.menu add command -label "Register" -command { if {[winfo exists .mail_home]} { raise .mail_home } else { make_mail_home_window 1 - } } #}}} #{{{ zoom buttons & search & other top-side buttons button $galng_frame_top.zero -text "1:1" -command "set_zoom 0" -width 3 -border 1 button $galng_frame_top.plus -text "+" -command "set_zoom 1" -width 2 -border 1 button $galng_frame_top.minus -text "-" -command "set_zoom -1" -width 2 -border 1 entry $galng_frame_top.search -width 10 -border 1 button $galng_frame_top.wopr -text "WOPR" -border 1 -command { if {[winfo exists .wopr]} { raise .wopr } else { make_wopr_window_dm } } button $galng_frame_top.shipyard -text "Shipyard" -border 1 -command { if {[winfo exists .shipyard]} { raise .shipyard } else { draw_shipyard } } button $galng_frame_top.orders -text "Orders" -border 1 -command { if {[winfo exists .orders]} { raise .orders } else { make_command_window_dm } } set frame_hs_left 1 checkbutton $galng_frame_top.hs_left -indicatoron 0 -text "L" -variable frame_hs_left \ -command {frame_hs left} -width 2 -height 1 -border 1 set frame_hs_right 1 checkbutton $galng_frame_top.hs_right -indicatoron 0 -text "R" -variable frame_hs_right \ -command {frame_hs right} -width 2 -height 1 -border 1 set frame_hs_sec 1 checkbutton $galng_frame_top.hs_sec -indicatoron 0 -text "B" -variable frame_hs_sec \ -command {frame_hs sec} -width 2 -height 1 -border 1 pack $galng_frame_top.minus -side right pack $galng_frame_top.plus -side right pack $galng_frame_top.zero -side right pack $galng_frame_top.hs_right -side right pack $galng_frame_top.hs_sec -side right pack $galng_frame_top.hs_left -side right pack $galng_frame_top.search -side right pack [label $galng_frame_top.searchLabel -text "Find:"] -side right pack $galng_frame_top.orders -side right pack $galng_frame_top.shipyard -side right pack $galng_frame_top.wopr -side right #}}} #{{{ top-level bindings bind . { focus $galng_frame_top.search } bind . { save_defaults save_game_defaults exit } bind . { $chat_entry configure -state normal $chat_entry del 0 end focus $chat_entry } bind . { $chat_entry configure -state normal $chat_entry del 0 end focus $chat_entry } bind . { $chat_entry del 0 end $chat_entry configure -state disabled focus $map_can } bind . { $log_button flash $log_button invoke } bind . { $groups_button flash $groups_button invoke } bind . { $battle_button flash $battle_button invoke } bind . { $galng_frame_top.wopr flash $galng_frame_top.wopr invoke } bind . { $galng_frame_top.shipyard flash $galng_frame_top.shipyard invoke } bind . { $galng_frame_top.orders flash $galng_frame_top.orders invoke } bind . { $galng_frame_primary.left.switch flash $galng_frame_primary.left.switch invoke } bind . { $galng_frame_top.hs_left invoke } bind . { $galng_frame_top.hs_left invoke } bind . { $galng_frame_top.hs_sec invoke } bind . { $galng_frame_top.hs_sec invoke } bind . { $galng_frame_top.hs_right invoke } bind . { $galng_frame_top.hs_right invoke } #}}} #{{{ chat_entry bindings bind $chat_entry { process_chat $chattext $chat_entry del 0 end set chattext "" } bind $chat_entry { $chat_entry del 0 end focus $map_can set chattext "" } #}}} #{{{ search entry binding bind $galng_frame_top.search { set planet [$galng_frame_top.search get] if {[info exists planets_n($planet)]} { find_planet $planet update_current_object planet $planet show_string "find $planet" } else { show_string "ERROR: no such planet: $planet" } } #}}} #{{{ tree bindings $tree bind x <1> { set lbl [Tree:labelat %W %x %y] Tree:setselection %W $lbl parsetree $lbl } $tree bind x { Tree:open %W [Tree:labelat %W %x %y] } #}}} #}}} #{{{ map_update & others #{{{ map_command proc map_command {command args} { set ret_val [eval [list incapsulated_map $command] $args] if {$command == "xview" || $command == "yview"} { map_update_planets map_update_final } return $ret_val } #}}} #{{{ map_update_redraw proc map_update_redraw {} { global max_x max_y current_theme zoom map_s_show can_xview can_yview incapsulated_map delete all incapsulated_map configure -bg [lindex $current_theme 0] if {$max_x > 0} { incapsulated_map configure -scrollregion \ [list -10 -10 [expr {$max_x * $zoom + 10}] [expr {$max_y * $zoom + 10}]] } else { incapsulated_map configure -scrollregion [list 0 0 100 100] } # yet another magic; i can`t understand tk there.. update incapsulated_map xview moveto $can_xview incapsulated_map yview moveto $can_yview } #}}} #{{{ map_update_final proc map_update_final {} { global map_can incapsulated_map lower group_orbit incapsulated_map lower alien_orbit incapsulated_map lower battles incapsulated_map lower transit incapsulated_map lower incoming incapsulated_map lower transit_lines incapsulated_map lower incoming_lines incapsulated_map lower planet_names incapsulated_map lower route_lines # not a very good idea. we always have # focus $map_can } #}}} #{{{ map_update_transit proc map_update_transit {} { global group_transit_n groups planets current_theme zoom set group_color_transit [lindex $current_theme 7] set group_color_transit_group [lindex $current_theme 8] set sfactor [expr {[get_pfactor] / 2}] if {$sfactor < 1.5} {set sfactor 1.5} incapsulated_map delete transit_lines transit foreach n [array names group_transit_n] { set x1 [expr {$groups($n,x) * $zoom}] set y1 [expr {$groups($n,y) * $zoom}] set x2 [expr {$planets($groups($n,dest),x) * $zoom}] set y2 [expr {$planets($groups($n,dest),y) * $zoom}] incapsulated_map create line \ $x1 $y1 $x2 $y2 \ -fill $group_color_transit -tag transit_lines incapsulated_map create oval \ [expr {$x1 - $sfactor}] [expr {$y1 - $sfactor}] \ [expr {$x1 + $sfactor}] [expr {$y1 + $sfactor}] \ -fill $group_color_transit_group -tag "transit $n" } } #}}} #{{{ map_update_incoming proc map_update_incoming {} { global incoming_group_num group_incoming planets current_theme zoom set group_color_incoming [lindex $current_theme 10] set group_color_incoming_group [lindex $current_theme 11] set sfactor [expr {[get_pfactor] / 2}] if {$sfactor < 1.5} {set sfactor 1.5} incapsulated_map delete incoming_lines incoming for {set n 1} {$n <= $incoming_group_num} {incr n} { set x1 [expr {$group_incoming($n,x) * $zoom}] set y1 [expr {$group_incoming($n,y) * $zoom}] set x2 [expr {$planets($group_incoming($n,dest),x) * $zoom}] set y2 [expr {$planets($group_incoming($n,dest),y) * $zoom}] incapsulated_map create line \ $x1 $y1 $x2 $y2 \ -fill $group_color_incoming -tag incoming_lines incapsulated_map create oval \ [expr {$x1 - $sfactor}] [expr {$y1 - $sfactor}] \ [expr {$x1 + $sfactor}] [expr {$y1 + $sfactor}] \ -fill $group_color_incoming_group -tag "incoming $n" } } #}}} #{{{ map_update_routes proc map_update_routes {} { global route_n routes planets current_theme zoom incapsulated_map delete route_lines foreach r [array names route_n] { foreach {t c} {cap 14 mat 15 col 16 emp 17} { global draw_routes_${t} if {[set draw_routes_${t}]} { if {$routes($r,$t) != "-" && $routes($r,$t) != $r} { set x1 [expr {$planets($r,x) * $zoom}] set y1 [expr {$planets($r,y) * $zoom}] set x2 [expr {$planets($routes($r,$t),x) * $zoom}] set y2 [expr {$planets($routes($r,$t),y) * $zoom}] incapsulated_map create line \ $x1 $y1 $x2 $y2 \ -fill [lindex $current_theme $c] -tag route_lines } } } } } #}}} #{{{ map_drop_planets proc map_drop_planets {} { global map_s_show incapsulated_map delete my_planet alien_planet unid_planet unin_planet planet_names \ group_orbit alien_orbit battles array set map_s_show {} unset map_s_show array set map_s_show {} } #}}} #{{{ map_update_planets proc map_update_planets {} { global max_x max_y map_s_show map_s current_theme zoom global font_size_factor canvasfont draw_planet_names global planets map_can battles set planet_text_color [lindex $current_theme 1] set planet_color_mine [lindex $current_theme 2] set planet_color_alien [lindex $current_theme 3] set planet_color_unin [lindex $current_theme 4] set planet_color_unid [lindex $current_theme 5] set group_color_orbit [lindex $current_theme 6] set group_color_alien [lindex $current_theme 9] set battle_color [lindex $current_theme 12] set pfactor [get_pfactor] set ofactor [expr {$pfactor + 1}] set afactor [expr {$ofactor + 1}] set tsize [expr {int(($pfactor + 7) * $font_size_factor)}] if {$tsize < 6 || $pfactor < 2} { set tsize 0 } else { set tfont [font create -family $canvasfont -size $tsize] set tfactor [expr {$pfactor + [font actual $tfont -size]}] } set bfactor [expr {$ofactor * 2}] set bwidth [expr {int($bfactor / 10) ? int($bfactor / 10) : 1}] foreach s [get_map_s_rect $max_x $max_y [incapsulated_map xview] [incapsulated_map yview]] { foreach obj $map_s($s) { if {[lindex $obj 0] == "planet"} { set p [lindex $obj 1] set kind $planets($p,kind) set x [expr {$planets($p,x) * $zoom}] set y [expr {$planets($p,y) * $zoom}] if {$kind == "mine"} { set color $planet_color_mine set tag "my_planet $p" } elseif {$kind == "alien"} { set color $planet_color_alien set tag "alien_planet $p" } elseif {$kind == "unid"} { set color $planet_color_unid set tag "unid_planet $p" } elseif {$kind == "unin"} { set color $planet_color_unin set tag "unin_planet $p" } incapsulated_map create oval \ [expr {$x - $pfactor}] [expr {$y - $pfactor}] \ [expr {$x + $pfactor}] [expr {$y + $pfactor}] \ -fill $color -tag $tag if {$draw_planet_names && $tsize > 0} { incapsulated_map create text \ $x [expr {$y + $tfactor}] \ -justify center -text $p -font $tfont -tag planet_names -fill $planet_text_color } if {[info exists planets($p,orbit)]} { foreach n $planets($p,orbit) { incapsulated_map create oval \ [expr {$x - $ofactor}] [expr {$y - $ofactor}] \ [expr {$x + $ofactor}] [expr {$y + $ofactor}] \ -outline $group_color_orbit -tag "group_orbit" } } if {[info exists planets($p,alien)]} { foreach n $planets($p,alien) { incapsulated_map create oval \ [expr {$x - $afactor}] [expr {$y - $afactor}] \ [expr {$x + $afactor}] [expr {$y + $afactor}] \ -outline $group_color_alien -tag "alien_orbit" } } if {[info exists battles($p)]} { incapsulated_map create line \ [expr {$x - $bfactor}] [expr {$y - $bfactor}] \ $x $y \ -fill $battle_color -width $bwidth -tag battles } } set map_s_show($s) 1 } } } #}}} #{{{ map_update proc map_update {reason} { switch $reason { planet_size { map_drop_planets map_update_planets map_update_final } font_size { map_drop_planets map_update_planets map_update_final } show_names { map_drop_planets map_update_planets map_update_final } show_routes { map_update_routes map_update_final } zoom { map_update_redraw map_update_transit map_update_incoming map_update_routes map_drop_planets map_update_planets map_update_final } redraw { map_update_redraw map_update_transit map_update_incoming map_update_routes map_drop_planets map_update_planets map_update_final } } } #}}} #}}} #{{{ report data tools #{{{ clear_data proc clear_data {} { # drop all data global max_x max_y incoming_group_num alien_groups_num set max_x 0 set max_y 0 set incoming_group_num 0 set alien_groups_num 0 foreach a {p_my_n p_my p_unin_n p_unin p_unid_n p_unid planets_n planets group_incoming alien_group \ my_options my_orders race_n race_status ship_n ship_types alien_ship_race alien_ship_types \ bombed_n bombed ships_production_n ships_production battles battle_my_groups battle_alien_races \ battle_alien_groups battle_protocols fleet_n fleets alien_group_races alien_group_n \ group_incoming_n group_n groups routes route_n known_ships known_ships_n \ alien_known_ships alien_known_ships_n group_transit_n p_alien_n p_alien} { global $a array set $a {} unset $a array set $a {} } global orders my_orders_report my_orders_forecast my_orders_report_mistakes my_orders_forecast_mistakes set orders {} set my_orders_report {} set my_orders_report_mistakes {} set my_orders_forecast {} set my_orders_forecast_mistakes {} global map_s {} array set map_s {} unset map_s array set map_s {} } #}}} #{{{ clear_data_forecast proc clear_data_forecast {} { # drop data found in forecast foreach a {p_my_n p_my my_orders ship_types ships_production_n ships_production fleet_n fleets \ group_n groups routes route_n} { global $a array set $a {} unset $a array set $a {} } # drop non actual data foreach a {bombed_n bombed battles battle_my_groups battle_alien_races \ battle_alien_groups battle_protocols group_transit_n} { global $a array set $a {} unset $a array set $a {} } global my_orders_forecast my_orders_forecast_mistakes set my_orders_forecast {} global map_s array set map_s {} } #}}} #{{{ read_turn_file_galaxyng proc read_turn_file_galaxyng {filename} { global p_my_n p_my p_unin_n p_unin p_unid_n p_unid planets planets_n global incoming_group_num group_incoming alien_groups_num alien_group game_name race_name turn_number global my_options my_orders_report race_n race_status ship_n ship_types alien_ship_race alien_ship_types global bombed_n bombed ships_production_n ships_production max_x max_y global battles battle_my_groups battle_alien_groups battle_alien_races battle_protocols global fleet_n fleets fleet_group_n global alien_group_races alien_group_n group_incoming_n group_n groups global routes route_n global my_orders_report_mistakes global p_alien_n p_alien global orders_passwd set infile [open "$filename" "r"] set found_part "" set found_race "*ERROR*" set found_battle_planet "*ERROR*" set found_fleet "*ERROR*" while { ! [eof $infile] } { set len [gets $infile line] if {($found_part == "planets" || $found_part == "alien_planets") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)?\[ \t\]*$" $line whole name x y size pop ind res prod cap mat col l]} { # puts "MINE: $name $x,$y $size $pop $ind $res $prod $cap $mat $col $l" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y if {$found_part == "alien_planets"} { set p_alien_n($name) $name set p_alien($name,x) $x set p_alien($name,y) $y set p_alien($name,size) $size set p_alien($name,pop) $pop set p_alien($name,ind) $ind set p_alien($name,res) $res set p_alien($name,prod) $prod set p_alien($name,cap) $cap set p_alien($name,mat) $mat set p_alien($name,col) $col set p_alien($name,l) $l set p_alien($name,mine) 0 set p_alien($name,race) $found_race set planets($name,kind) alien } else { set p_my_n($name) $name set p_my($name,x) $x set p_my($name,y) $y set p_my($name,size) $size set p_my($name,pop) $pop set p_my($name,ind) $ind set p_my($name,res) $res set p_my($name,prod) $prod set p_my($name,cap) $cap set p_my($name,mat) $mat set p_my($name,col) $col set p_my($name,l) $l set p_my($name,mine) 1 set planets($name,kind) mine } } elseif {($found_part == "unin_planets") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name x y]} { # puts "UNIDENTIFIED: $name $x,$y" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y set planets($name,kind) unin set p_unin_n($name) $name set p_unin($name,x) $x set p_unin($name,y) $y } elseif {($found_part == "unid_planets") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name x y]} { # puts "UNINHABITED BUT NOT ORBITING: $name $x,$y" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y set planets($name,kind) unid set p_unid_n($name) $name set p_unid($name,x) $x set p_unid($name,y) $y set p_unid($name,size) "-" set p_unid($name,res) "-" set p_unid($name,cap) "-" set p_unid($name,mat) "-" } elseif {($found_part == "unid_planets") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name x y size res cap mat]} { # puts "UNINHABITED BUT ORBITING: $name $x,$y $size $res $cap $mat" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y set planets($name,kind) unid set p_unid_n($name) $name set p_unid($name,x) $x set p_unid($name,y) $y set p_unid($name,size) $size set p_unid($name,res) $res set p_unid($name,cap) $cap set p_unid($name,mat) $mat } elseif {($found_part == "routes") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" \ $line whole name cap mat col emp]} { # i assume what planet $ is not existent if {$cap != "$"} { # puts "ROUTE: $name $cap $mat $col $emp" set route_n($name) $name set routes($name,cap) $cap set routes($name,mat) $mat set routes($name,col) $col set routes($name,emp) $emp } } elseif {($found_part == "alien_groups") && [regexp "^\[ \t\]?\[ \t\]?(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole count name drive weapon shield cargo type quantity dest]} { # puts "ALIEN GROUP AT PLANET: $count $name $dest" incr alien_groups_num set alien_group_races($found_race) $found_race lappend alien_group_n($found_race) $alien_groups_num set alien_group($alien_groups_num,race) $found_race set alien_group($alien_groups_num,dest) $dest set alien_group($alien_groups_num,count) $count set alien_group($alien_groups_num,name) $name set alien_group($alien_groups_num,drive) $drive set alien_group($alien_groups_num,weapon) $weapon set alien_group($alien_groups_num,shield) $shield set alien_group($alien_groups_num,cargo) $cargo set alien_group($alien_groups_num,type) $type set alien_group($alien_groups_num,quantity) $quantity } elseif {($found_part == "incoming") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole orig dest remain speed mass] && [string compare $orig "InitialTechLevels"]} { # puts "INCOMING: $orig $dest $remain $speed $mass" incr incoming_group_num set group_incoming_n($incoming_group_num) $incoming_group_num set group_incoming($incoming_group_num,origin) $orig set group_incoming($incoming_group_num,dest) $dest set group_incoming($incoming_group_num,dist) $remain set group_incoming($incoming_group_num,speed) $speed set group_incoming($incoming_group_num,mass) $mass } elseif {($found_part == "groups" || $found_part == "fleet") && \ [regexp "(\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole num count name drive weapon shield cargo type quantity dest]} { # puts "GROUP AT PLANET: $num $count $name $dest" set group_n($num) $num set groups($num,count) $count set groups($num,name) $name set groups($num,drive) $drive set groups($num,weapon) $weapon set groups($num,shield) $shield set groups($num,cargo) $cargo set groups($num,type) $type set groups($num,quantity) $quantity set groups($num,dest) $dest set groups($num,dist) 0.00 set groups($num,origin) - if {$found_part == "fleet"} { set groups($num,fleet) $found_fleet set fleets($found_fleet,dest) $dest set fleets($found_fleet,dist) 0.00 set fleets($found_fleet,origin) - lappend fleet_group_n($found_fleet) $num } else { set groups($num,fleet) - } } elseif {($found_part == "groups" || $found_part == "fleet") && \ [regexp "(\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole num count name drive weapon shield cargo type quantity dest dist origin]} { # puts "GROUP IN TRANSIT: $num $count $name $dest $origin" set group_n($num) $num set groups($num,count) $count set groups($num,name) $name set groups($num,drive) $drive set groups($num,weapon) $weapon set groups($num,shield) $shield set groups($num,cargo) $cargo set groups($num,type) $type set groups($num,quantity) $quantity set groups($num,dest) $dest set groups($num,dist) $dist set groups($num,origin) $origin if {$found_part == "fleet"} { set groups($num,fleet) $found_fleet set fleets($found_fleet,dest) $dest set fleets($found_fleet,dist) $dist set fleets($found_fleet,origin) $origin lappend fleet_group_n($found_fleet) $num } else { set groups($num,fleet) - } } elseif {($found_part == "battle_my_groups") && \ [regexp "^\[ \t\]*(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)" \ $line whole count name drive weapon shield cargo type quantity left]} { # puts "GAME: my group in battle at $found_battle_planet: $count $name $drive $weapon $shield $cargo $type $quantity $left" lappend battle_my_groups($found_battle_planet) \ [list $count $name $drive $weapon $shield $cargo $type $quantity $left] } elseif {($found_part == "battle_alien_groups") && \ [regexp "^\[ \t\]*(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)" \ $line whole count name drive weapon shield cargo type quantity left]} { # puts "GAME: $found_race group in battle at $found_battle_planet: $count $name $drive $weapon $shield $cargo $type $quantity $left" lappend battle_alien_groups($found_battle_planet,$found_race) \ [list $count $name $drive $weapon $shield $cargo $type $quantity $left] } elseif {($found_part == "battle_protocol") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+fires on\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+:\[ \t\]+(\[^ \t\]+)" \ $line whole race1 ship1 race2 ship2 result]} { # puts "GAME: $race1 $ship1 fires on $race2 $ship2 : $result" lappend battle_protocols($found_battle_planet) \ [list $race1 $ship1 $race2 $ship2 $result] } elseif {($found_part == "options") && [regexp "^(\[^ \t\]+)\[ \t\]+(ON|OFF)\[ \t\]*$" $line whole option onoff]} { if {$onoff == "ON"} { set my_options($option) 1 } else { set my_options($option) 0 } } elseif {($found_part == "orders") && [regexp "^> (\.*) $" $line whole order]} { lappend my_orders_report $order } elseif {($found_part == "status") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole race drive weapons shield cargo pop ind col dip_status]} { # puts "GAME: race status $race $drive $weapons $shield $cargo $pop $ind $col $dip_status" set race_n($race) $race set race_status($race,drive) $drive set race_status($race,weapon) $weapons set race_status($race,shield) $shield set race_status($race,cargo) $cargo set race_status($race,pop) $pop set race_status($race,ind) $ind set race_status($race,col) $col set race_status($race,dip_status) $dip_status } elseif {($found_part == "ship_types") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole ship drive attks weapon shield cargo mass speed def]} { # puts "GAME: ship type $ship $drive $attks $weapon $shield $cargo $mass $speed $def" set ship_n($ship) $ship set ship_types($ship,drive) $drive set ship_types($ship,attks) $attks set ship_types($ship,weapon) $weapon set ship_types($ship,shield) $shield set ship_types($ship,cargo) $cargo set ship_types($ship,mass) $mass set ship_types($ship,speed) $speed set ship_types($ship,def) $def } elseif {($found_part == "alien_ship_types") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole ship drive attks weapon shield cargo mass speed def]} { # puts "GAME: ship type of $found_race $ship $drive $attks $weapon $shield $cargo $mass $speed $def" set alien_ship_race($found_race) $found_race lappend alien_ship_types($found_race,ships) $ship set alien_ship_types($found_race,$ship,drive) $drive set alien_ship_types($found_race,$ship,attks) $attks set alien_ship_types($found_race,$ship,weapon) $weapon set alien_ship_types($found_race,$ship,shield) $shield set alien_ship_types($found_race,$ship,cargo) $cargo set alien_ship_types($found_race,$ship,mass) $mass set alien_ship_types($found_race,$ship,speed) $speed set alien_ship_types($found_race,def) $def } elseif {($found_part == "bombings") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole who owner name pop ind prod cap mat col]} { # puts "GAME: planet bombed $who $owner $name $pop $ind $prod $cap $mat $col" set bombed_n($name) $name set bombed($name,who) $who set bombed($name,owner) $owner set bombed($name,name) $name set bombed($name,pop) $pop set bombed($name,ind) $ind set bombed($name,prod) $prod set bombed($name,cap) $cap set bombed($name,mat) $mat set bombed($name,col) $col } elseif {($found_part == "ships_production") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name ship need used]} { # puts "GAME: ships in production $name $ship $need $used" set ships_production($name) $name set ships_production_n($name,ship) $ship set ships_production_n($name,need) $need set ships_production_n($name,used) $used } elseif {[regexp "^-message starts-" $line whole]} { set found_part message } elseif {[regexp "^-message ends-" $line whole]} { set found_part "" } elseif {[regexp "^\[ \t\]+Galaxy Game (\[^ \t\]+) Turn (\[0-9\]+) Report for (\[^ \t\]+)\[ \t\]*$" $line whole game turn race]} { # puts "GAME: $game TURN: $turn RACE: $race" # set game_name $game # set turn_number $turn set race_name $race } elseif {[regexp "^Bulletins for Galaxy Game (\[^ \t\]+) Turn (\[0-9\]+)\[ \t\]*$" \ $line whole game turn]} { # puts "GAME: $game TURN: $turn" set game_name $game set turn_number $turn } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Options" $line whole]} { # puts "GAME: in options" set found_part options } elseif {($found_part != "message") && [regexp "^ORDERS RECEIVED" $line whole]} { # puts "GAME: in orders" set found_part orders } elseif {($found_part != "message") && [regexp "^MISTAKES" $line whole]} { # puts "GAME: in mistakes" set found_part mistakes } elseif {($found_part != "message") && [regexp "^\[ \t\]+Status of Players" $line whole]} { # puts "GAME: in status" set found_part status } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Ship Types" $line whole]} { # puts "GAME: in ship types" set found_part ship_types } elseif {($found_part != "message") && [regexp "^\[ \t\]+(\[^ \t\]+) Ship Types" $line whole race]} { # puts "GAME: in ship types of $race" set found_part alien_ship_types set found_race $race } elseif {($found_part != "message") && \ [regexp "^\[ \t\]+Battle at (\[^ \t\]+)\[ \t\]*$" $line whole planet]} { # puts "GAME: in battle at $planet" set found_part battle set found_battle_planet $planet set battles($planet) $planet } elseif {($found_part != "message") && [regexp "^\[ \t\]+Bombings" $line whole]} { # puts "GAME: in bombings" set found_part bombings } elseif {($found_part != "message") && [regexp "^\[ \t\]+Incoming Groups" $line whole]} { # puts "GAME: in incoming" set found_part incoming } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Planets" $line whole]} { # puts "GAME: in planets" set found_part planets # Unidentified & Uninhabited planets must be checked before planets of other races # what to do if races have this stupid names? } elseif {($found_part != "message") && [regexp "^\[ \t\]+Unidentified Planets" $line whole]} { # puts "GAME: in unidentified planets" set found_part unin_planets } elseif {($found_part != "message") && [regexp "^\[ \t\]+Uninhabited Planets" $line whole]} { # puts "GAME: in uninhabited planets" set found_part unid_planets } elseif {($found_part != "message") && [regexp "^\[ \t\]+(\[^ \t\]+) Planets" $line whole race]} { # puts "GAME: in planets of $race" set found_part alien_planets set found_race $race } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Routes" $line whole]} { # puts "GAME: in routes" set found_part routes } elseif {($found_part != "message") && [regexp "^\[ \t\]+Ships In Production" $line whole]} { # puts "GAME: in ship production" set found_part ships_production } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Groups" $line whole]} { # puts "GAME: in groups" if {$found_part != "battle" && $found_part != "battle_alien_groups"} { set found_part groups } else { set found_part battle_my_groups } } elseif {($found_part != "message") && \ [regexp "^\[ \t\]+Fleet\[ \t\]+(\[^ \t\]+)\[ \t\]+\\(speed\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\\)" \ $line whole name speed]} { # puts "GAME: in fleet $name" set found_part fleet set found_fleet $name set fleet_n($name) $name set fleets($name,speed) $speed } elseif {($found_part != "message") && [regexp "^\[ \t\]+(\[^ \t\]+) Groups" $line whole race]} { # puts "GAME: in groups of $race" if {$found_part != "battle" \ && $found_part != "battle_alien_groups" && $found_part != "battle_my_groups"} { set found_part alien_groups } else { set found_part battle_alien_groups lappend battle_alien_races($found_battle_planet) $race } set found_race $race } elseif {($found_part != "message") && [regexp "^\[ \t\]+Battle Protocol" $line whole]} { set found_part battle_protocol } elseif {($found_part != "message") && \ [regexp "^Password for player \[^ \t\]+ set to (\[^ \t\]+)" \ $line whole passwd]} { # puts "PASSWD: $passwd" set orders_passwd $passwd } elseif {($found_part != "message") && [regexp "^--------------------------------------------------------------------------------" $line whole]} { # puts "GAME: in map" set found_part map # dont understand what is that # } elseif {[regexp "^----------------------------------------------------------" $line whole]} { # puts "GAME: in bombing" # set found_part bombing } elseif {($found_part == "mistakes")} { lappend my_orders_report_mistakes $line } else { # puts "??? - MAP: regexp: $line" } } close $infile } #}}} #{{{ read_turn_file_galaxyplus proc read_turn_file_galaxyplus {filename} { global p_my_n p_my p_unin_n p_unin p_unid_n p_unid planets planets_n global incoming_group_num group_incoming alien_groups_num alien_group game_name race_name turn_number global my_options my_orders_report race_n race_status ship_n ship_types alien_ship_race alien_ship_types global bombed_n bombed ships_production_n ships_production max_x max_y global battles battle_my_groups battle_alien_groups battle_alien_races battle_protocols global fleet_n fleets fleet_group_n global alien_group_races alien_group_n group_incoming_n group_n groups global routes route_n global my_orders_report_mistakes global p_alien_n p_alien global orders_passwd set infile [open "$filename" "r"] set found_part "" set found_race "*ERROR*" set found_battle_planet "*ERROR*" set found_fleet "*ERROR*" while { ! [eof $infile] } { set len [gets $infile line] if {($found_part == "planets" || $found_part == "alien_planets") && \ [regexp "(\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)?\[ \t\]*$" \ $line whole num x y name size pop ind res prod cap mat col l]} { # puts "MINE: $num $name $x,$y $size $pop $ind $res $prod $cap $mat $col $l" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,num) $num set planets($name,x) $x set planets($name,y) $y if {$found_part == "alien_planets"} { set p_alien_n($name) $name set p_alien($name,num) $num set p_alien($name,x) $x set p_alien($name,y) $y set p_alien($name,size) $size set p_alien($name,pop) $pop set p_alien($name,ind) $ind set p_alien($name,res) $res set p_alien($name,prod) $prod set p_alien($name,cap) $cap set p_alien($name,mat) $mat set p_alien($name,col) $col set p_alien($name,l) $l set p_alien($name,mine) 0 set p_alien($name,race) $found_race set planets($name,kind) alien } else { set p_my_n($name) $name set p_my($name,x) $x set p_my($name,y) $y set p_my($name,num) $num set p_my($name,size) $size set p_my($name,pop) $pop set p_my($name,ind) $ind set p_my($name,res) $res set p_my($name,prod) $prod set p_my($name,cap) $cap set p_my($name,mat) $mat set p_my($name,col) $col set p_my($name,l) $l set p_my($name,mine) 1 set planets($name,kind) mine } } elseif {($found_part == "unin_planets") && \ [regexp "(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" \ $line whole num x y]} { # puts "UNIDENTIFIED: $num $x,$y" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($num) $num set planets($num) $num set planets($num,x) $x set planets($num,y) $y # of cource it`s unin, but for G+ it look like unid set planets($num,kind) unid set p_unid_n($num) $num set p_unid($num,x) $x set p_unid($num,y) $y set p_unid($num,size) "-" set p_unid($num,res) "-" set p_unid($num,cap) "-" set p_unid($num,mat) "-" } elseif {($found_part == "unid_planets") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name x y]} { # puts "UNINHABITED BUT NOT ORBITING: $name $x,$y" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y set planets($name,kind) unid set p_unid_n($name) $name set p_unid($name,x) $x set p_unid($name,y) $y set p_unid($name,size) "-" set p_unid($name,res) "-" set p_unid($name,cap) "-" set p_unid($name,mat) "-" } elseif {($found_part == "unid_planets") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name x y size res cap mat]} { # puts "UNINHABITED BUT ORBITING: $name $x,$y $size $res $cap $mat" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y set planets($name,kind) unid set p_unid_n($name) $name set p_unid($name,x) $x set p_unid($name,y) $y set p_unid($name,size) $size set p_unid($name,res) $res set p_unid($name,cap) $cap set p_unid($name,mat) $mat } elseif {($found_part == "routes") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" \ $line whole name cap mat col emp]} { # i assume what planet $ is not existent if {$cap != "$"} { # puts "ROUTE: $name $cap $mat $col $emp" set route_n($name) $name set routes($name,cap) $cap set routes($name,mat) $mat set routes($name,col) $col set routes($name,emp) $emp } } elseif {($found_part == "alien_groups") && [regexp "^\[ \t\]?\[ \t\]?(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole count name drive weapon shield cargo type quantity dest]} { # puts "ALIEN GROUP AT PLANET: $count $name $dest" incr alien_groups_num set alien_group_races($found_race) $found_race lappend alien_group_n($found_race) $alien_groups_num set alien_group($alien_groups_num,race) $found_race set alien_group($alien_groups_num,dest) $dest set alien_group($alien_groups_num,count) $count set alien_group($alien_groups_num,name) $name set alien_group($alien_groups_num,drive) $drive set alien_group($alien_groups_num,weapon) $weapon set alien_group($alien_groups_num,shield) $shield set alien_group($alien_groups_num,cargo) $cargo set alien_group($alien_groups_num,type) $type set alien_group($alien_groups_num,quantity) $quantity } elseif {($found_part == "incoming") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole orig dest remain speed mass] && [string compare $orig "InitialTechLevels"]} { # puts "INCOMING: $orig $dest $remain $speed $mass" incr incoming_group_num set group_incoming_n($incoming_group_num) $incoming_group_num set group_incoming($incoming_group_num,origin) $orig set group_incoming($incoming_group_num,dest) $dest set group_incoming($incoming_group_num,dist) $remain set group_incoming($incoming_group_num,speed) $speed set group_incoming($incoming_group_num,mass) $mass } elseif {($found_part == "groups") && \ [regexp "(\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[-0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" \ $line whole num count name drive weapon shield cargo type quantity dest origin dist speed mass fleet state]} { # puts "GROUP: $num $count $name $dest $origin" set group_n($num) $num set groups($num,count) $count set groups($num,name) $name set groups($num,drive) $drive set groups($num,weapon) $weapon set groups($num,shield) $shield set groups($num,cargo) $cargo set groups($num,type) $type set groups($num,quantity) $quantity if {[regexp "^#(.+)$" $dest whole dest1]} { set dest $dest1 } set groups($num,dest) $dest if {$dist == "-"} { set groups($num,dist) 0 } else { set groups($num,dist) $dist } if {[regexp "^#(.+)$" $origin whole origin1]} { set origin $origin1 } set groups($num,origin) $origin set groups($num,r_speed) $speed set groups($num,r_mass) $mass set groups($num,state) $state if {$fleet != "-"} { set groups($num,fleet) $fleet set fleets($fleet,dest) $dest set fleets($fleet,dist) $dist set fleets($fleet,origin) $origin lappend fleet_group_n($fleet) $num } else { set groups($num,fleet) - } } elseif {($found_part == "battle_my_groups") && \ [regexp "^\[ \t\]*(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)" \ $line whole count name drive weapon shield cargo type quantity left]} { # puts "GAME: my group in battle at $found_battle_planet: $count $name $drive $weapon $shield $cargo $type $quantity $left" lappend battle_my_groups($found_battle_planet) \ [list $count $name $drive $weapon $shield $cargo $type $quantity $left] } elseif {($found_part == "battle_alien_groups") && \ [regexp "^\[ \t\]*(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)" \ $line whole count name drive weapon shield cargo type quantity left]} { # puts "GAME: $found_race group in battle at $found_battle_planet: $count $name $drive $weapon $shield $cargo $type $quantity $left" lappend battle_alien_groups($found_battle_planet,$found_race) \ [list $count $name $drive $weapon $shield $cargo $type $quantity $left] } elseif {($found_part == "battle_protocol") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+fires on\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+:\[ \t\]+(\[^ \t\]+)" \ $line whole race1 ship1 race2 ship2 result]} { # puts "GAME: $race1 $ship1 fires on $race2 $ship2 : $result" lappend battle_protocols($found_battle_planet) \ [list $race1 $ship1 $race2 $ship2 $result] } elseif {($found_part == "options") && [regexp "^(\[^ \t\]+)\[ \t\]+(ON|OFF)\[ \t\]*$" $line whole option onoff]} { if {$onoff == "ON"} { set my_options($option) 1 } else { set my_options($option) 0 } } elseif {($found_part == "orders") && [regexp "^> (\.*) $" $line whole order]} { lappend my_orders_report $order } elseif {($found_part == "status") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+)\[ \t\]*$" \ $line whole race drive weapons shield cargo pop ind col dip_status votes]} { # puts "GAME: race status $race $drive $weapons $shield $cargo $pop $ind $col $dip_status $votes" set race_n($race) $race set race_status($race,drive) $drive set race_status($race,weapon) $weapons set race_status($race,shield) $shield set race_status($race,cargo) $cargo set race_status($race,pop) $pop set race_status($race,ind) $ind set race_status($race,col) $col set race_status($race,dip_status) $dip_status set race_status($race,votes) $votes } elseif {($found_part == "ship_types") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]+(\[0-9\]+\\.?\[0-9\]*)\[ \t\]*$" \ $line whole ship drive attks weapon shield cargo mass]} { # puts "GAME: ship type $ship $drive $attks $weapon $shield $cargo $mass" set ship_n($ship) $ship set ship_types($ship,drive) $drive set ship_types($ship,attks) $attks set ship_types($ship,weapon) $weapon set ship_types($ship,shield) $shield set ship_types($ship,cargo) $cargo set ship_types($ship,mass) $mass # set ship_types($ship,speed) $speed # set ship_types($ship,def) $def } elseif {($found_part == "alien_ship_types") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole ship drive attks weapon shield cargo mass speed def]} { # puts "GAME: ship type of $found_race $ship $drive $attks $weapon $shield $cargo $mass $speed $def" set alien_ship_race($found_race) $found_race lappend alien_ship_types($found_race,ships) $ship set alien_ship_types($found_race,$ship,drive) $drive set alien_ship_types($found_race,$ship,attks) $attks set alien_ship_types($found_race,$ship,weapon) $weapon set alien_ship_types($found_race,$ship,shield) $shield set alien_ship_types($found_race,$ship,cargo) $cargo set alien_ship_types($found_race,$ship,mass) $mass set alien_ship_types($found_race,$ship,speed) $speed set alien_ship_types($found_race,def) $def } elseif {($found_part == "bombings") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole who owner name pop ind prod cap mat col]} { # puts "GAME: planet bombed $who $owner $name $pop $ind $prod $cap $mat $col" set bombed_n($name) $name set bombed($name,who) $who set bombed($name,owner) $owner set bombed($name,name) $name set bombed($name,pop) $pop set bombed($name,ind) $ind set bombed($name,prod) $prod set bombed($name,cap) $cap set bombed($name,mat) $mat set bombed($name,col) $col } elseif {($found_part == "ships_production") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name ship need used]} { # puts "GAME: ships in production $name $ship $need $used" set ships_production($name) $name set ships_production_n($name,ship) $ship set ships_production_n($name,need) $need set ships_production_n($name,used) $used } elseif {[regexp "^-message starts-" $line whole]} { set found_part message } elseif {[regexp "^-message ends-" $line whole]} { set found_part "" } elseif {[regexp "(\[^ \t\]+) Report for Galaxy PLUS (\[^ \t\]+) Turn (\[0-9\]+)" \ $line whole race game turn]} { # puts "GAME: $game TURN: $turn RACE: $race" set game_name $game set turn_number $turn set race_name $race } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Options" $line whole]} { # puts "GAME: in options" set found_part options } elseif {($found_part != "message") && [regexp "^ORDERS RECEIVED" $line whole]} { # puts "GAME: in orders" set found_part orders } elseif {($found_part != "message") && [regexp "^MISTAKES" $line whole]} { # puts "GAME: in mistakes" set found_part mistakes } elseif {($found_part != "message") && [regexp "^\[ \t\]+Status of Players \\(total (\[0-9\]+) votes\\)$" \ $line whole votes]} { # puts "GAME: in status" set found_part status } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Ship Types" $line whole]} { # puts "GAME: in ship types" set found_part ship_types } elseif {($found_part != "message") && [regexp "^\[ \t\]+(\[^ \t\]+) Ship Types" $line whole race]} { # puts "GAME: in ship types of $race" set found_part alien_ship_types set found_race $race } elseif {($found_part != "message") && \ [regexp "^\[ \t\]+Battle at (\[^ \t\]+)\[ \t\]*$" $line whole planet]} { # puts "GAME: in battle at $planet" set found_part battle set found_battle_planet $planet set battles($planet) $planet } elseif {($found_part != "message") && [regexp "^\[ \t\]+Bombings" $line whole]} { # puts "GAME: in bombings" set found_part bombings } elseif {($found_part != "message") && [regexp "^\[ \t\]+Incoming Groups" $line whole]} { # puts "GAME: in incoming" set found_part incoming } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Planets" $line whole]} { # puts "GAME: in planets" set found_part planets # Unidentified & Uninhabited planets must be checked before planets of other races # what to do if races have this stupid names? } elseif {($found_part != "message") && [regexp "^\[ \t\]+Unidentified Planets" $line whole]} { # puts "GAME: in unidentified planets" set found_part unin_planets } elseif {($found_part != "message") && [regexp "^\[ \t\]+Uninhabited Planets" $line whole]} { # puts "GAME: in uninhabited planets" set found_part unid_planets } elseif {($found_part != "message") && [regexp "^\[ \t\]+(\[^ \t\]+) Planets" $line whole race]} { # puts "GAME: in planets of $race" set found_part alien_planets set found_race $race } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Routes" $line whole]} { # puts "GAME: in routes" set found_part routes } elseif {($found_part != "message") && [regexp "^\[ \t\]+Ships In Production" $line whole]} { # puts "GAME: in ship production" set found_part ships_production } elseif {($found_part != "message") && [regexp "^\[ \t\]+Your Groups" $line whole]} { # puts "GAME: in groups" if {$found_part != "battle" && $found_part != "battle_alien_groups"} { set found_part groups } else { set found_part battle_my_groups } } elseif {($found_part != "message") && \ [regexp "^\[ \t\]+Fleet\[ \t\]+(\[^ \t\]+)\[ \t\]+\\(speed\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\\)" \ $line whole name speed]} { # puts "GAME: in fleet $name" set found_part fleet set found_fleet $name set fleet_n($name) $name set fleets($name,speed) $speed } elseif {($found_part != "message") && [regexp "^\[ \t\]+(\[^ \t\]+) Groups" $line whole race]} { # puts "GAME: in groups of $race" if {$found_part != "battle" \ && $found_part != "battle_alien_groups" && $found_part != "battle_my_groups"} { set found_part alien_groups } else { set found_part battle_alien_groups lappend battle_alien_races($found_battle_planet) $race } set found_race $race } elseif {($found_part != "message") && [regexp "^\[ \t\]+Battle Protocol" $line whole]} { set found_part battle_protocol } elseif {($found_part != "message") && \ [regexp "^Password for player \[^ \t\]+ set to (\[^ \t\]+)" \ $line whole passwd]} { # puts "PASSWD: $passwd" set orders_passwd $passwd } elseif {($found_part != "message") && [regexp "^--------------------------------------------------------------------------------" $line whole]} { # puts "GAME: in map" set found_part map # dont understand what is that # } elseif {[regexp "^----------------------------------------------------------" $line whole]} { # puts "GAME: in bombing" # set found_part bombing } elseif {($found_part == "mistakes")} { lappend my_orders_report_mistakes $line } else { # puts "??? - MAP: regexp: $line" } } close $infile } #}}} #{{{ read_forecast_file_galaxyng proc read_forecast_file_galaxyng {filename} { global p_my_n p_my p_unin_n p_unin p_unid_n p_unid planets planets_n global incoming_group_num group_incoming alien_groups_num alien_group game_name race_name turn_number global my_options my_orders_forecast race_n race_status ship_n ship_types alien_ship_race alien_ship_types global bombed_n bombed ships_production_n ships_production max_x max_y global battles battle_my_groups battle_alien_groups battle_alien_races battle_protocols global fleet_n fleets fleet_group_n global alien_group_races alien_group_n group_incoming_n group_n groups global routes route_n global my_orders_forecast_mistakes global p_alien_n p_alien set infile [open "$filename" "r"] set found_part "" set found_race "*ERROR*" set found_battle_planet "*ERROR*" set found_fleet "*ERROR*" while { ! [eof $infile] } { set len [gets $infile line] if {($found_part == "planets") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)?\[ \t\]*$" $line whole name x y size pop ind res prod cap mat col l]} { # puts "MINE: $name $x,$y $size $pop $ind $res $prod $cap $mat $col $l" if {$x > $max_x} {set max_x $x} if {$y > $max_y} {set max_y $y} foreach e [array names planets_n] { if {[regexp "^\[^,\]+$" $e]} { if {($planets($e,x) == $x) && ($planets($e,y) == $y)} { unset planets_n($e) if {$planets($e,kind) == "unid"} { unset p_unid_n($e) } elseif {$planets($e,kind) == "unin"} { unset p_unin_n($e) } elseif {$planets($e,kind) == "alien"} { unset p_alien_n($e) } } } } set planets_n($name) $name set planets($name) $name set planets($name,x) $x set planets($name,y) $y set p_my_n($name) $name set p_my($name,x) $x set p_my($name,y) $y set p_my($name,size) $size set p_my($name,pop) $pop set p_my($name,ind) $ind set p_my($name,res) $res set p_my($name,prod) $prod set p_my($name,cap) $cap set p_my($name,mat) $mat set p_my($name,col) $col set p_my($name,l) $l set p_my($name,mine) 1 set planets($name,kind) mine } elseif {($found_part == "routes") && \ [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" \ $line whole name cap mat col emp]} { # i assume what planet $ is not existent if {$cap != "$"} { # puts "ROUTE: $name $cap $mat $col $emp" set route_n($name) $name set routes($name,cap) $cap set routes($name,mat) $mat set routes($name,col) $col set routes($name,emp) $emp } } elseif {($found_part == "groups" || $found_part == "fleet") && \ [regexp "(\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole num count name drive weapon shield cargo type quantity dest]} { # puts "GROUP AT PLANET: $num $count $name $dest" set group_n($num) $num set groups($num,count) $count set groups($num,name) $name set groups($num,drive) $drive set groups($num,weapon) $weapon set groups($num,shield) $shield set groups($num,cargo) $cargo set groups($num,type) $type set groups($num,quantity) $quantity set groups($num,dest) $dest set groups($num,dist) 0.00 set groups($num,origin) - if {$found_part == "fleet"} { set groups($num,fleet) $found_fleet set fleets($found_fleet,dest) $dest set fleets($found_fleet,dist) 0.00 set fleets($found_fleet,origin) - lappend fleet_group_n($found_fleet) $num } else { set groups($num,fleet) - } } elseif {($found_part == "groups" || $found_part == "fleet") && \ [regexp "(\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[\-A-Z\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole num count name drive weapon shield cargo type quantity dest dist origin]} { # puts "GROUP IN TRANSIT: $num $count $name $dest $origin" set group_n($num) $num set groups($num,count) $count set groups($num,name) $name set groups($num,drive) $drive set groups($num,weapon) $weapon set groups($num,shield) $shield set groups($num,cargo) $cargo set groups($num,type) $type set groups($num,quantity) $quantity set groups($num,dest) $dest set groups($num,dist) $dist set groups($num,origin) $origin if {$found_part == "fleet"} { set groups($num,fleet) $found_fleet set fleets($found_fleet,dest) $dest set fleets($found_fleet,dist) $dist set fleets($found_fleet,origin) $origin lappend fleet_group_n($found_fleet) $num } else { set groups($num,fleet) - } } elseif {($found_part == "orders") && [regexp "^> (\.*) $" $line whole order]} { # puts "ORDER: $order" lappend my_orders_forecast $order } elseif {($found_part == "status") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]*$" $line whole race drive weapons shield cargo pop ind col dip_status]} { # puts "GAME: race status $race $drive $weapons $shield $cargo $pop $ind $col $dip_status" set race_n($race) $race set race_status($race,drive) $drive set race_status($race,weapon) $weapons set race_status($race,shield) $shield set race_status($race,cargo) $cargo set race_status($race,pop) $pop set race_status($race,ind) $ind set race_status($race,col) $col set race_status($race,dip_status) $dip_status } elseif {($found_part == "ship_types") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole ship drive attks weapon shield cargo mass speed def]} { # puts "GAME: ship type $ship $drive $attks $weapon $shield $cargo $mass $speed $def" set ship_n($ship) $ship set ship_types($ship,drive) $drive set ship_types($ship,attks) $attks set ship_types($ship,weapon) $weapon set ship_types($ship,shield) $shield set ship_types($ship,cargo) $cargo set ship_types($ship,mass) $mass set ship_types($ship,speed) $speed set ship_types($ship,def) $def } elseif {($found_part == "ships_production") && [regexp "^(\[^ \t\]+)\[ \t\]+(\[^ \t\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\[ \t\]*$" $line whole name ship need used]} { # puts "GAME: ships in production $name $ship $need $used" set ships_production($name) $name set ships_production_n($name,ship) $ship set ships_production_n($name,need) $need set ships_production_n($name,used) $used } elseif {[regexp "^ORDERS RECEIVED" $line whole]} { # puts "GAME: in orders" set found_part orders } elseif {[regexp "^MISTAKES" $line whole]} { # puts "GAME: in mistakes" set found_part mistakes } elseif {[regexp "^\[ \t\]+Your Status" $line whole]} { # puts "GAME: in status" set found_part status } elseif {[regexp "^\[ \t\]+Your Ship Types" $line whole]} { # puts "GAME: in ship types" set found_part ship_types } elseif {[regexp "^\[ \t\]+Battle at (\[^ \t\]+)\[ \t\]*$" $line whole planet]} { # puts "GAME: in battle at $planet" set found_part battle set found_battle_planet $planet set battles($planet) $planet } elseif {[regexp "^\[ \t\]+Your Planets" $line whole]} { # puts "GAME: in planets" set found_part planets } elseif {[regexp "^\[ \t\]+Your Routes" $line whole]} { # puts "GAME: in routes" set found_part routes } elseif {[regexp "^\[ \t\]+Ships In Production" $line whole]} { # puts "GAME: in ship production" set found_part ships_production } elseif {[regexp "^\[ \t\]+Your Groups" $line whole]} { # puts "GAME: in groups" set found_part groups } elseif {[regexp "^\[ \t\]+Fleet\[ \t\]+(\[^ \t\]+)\[ \t\]+\\(speed\[ \t\]+(\[0-9\]+\\.\[0-9\]+)\\)" \ $line whole name speed]} { # puts "GAME: in fleet $name" set found_part fleet set found_fleet $name set fleet_n($name) $name set fleets($name,speed) $speed } elseif {($found_part == "mistakes")} { # should be last resort lappend my_orders_forecast_mistakes $line } else { # puts "??? - MAP: regexp: $line" } } close $infile } #}}} #{{{ get_galaxy_version proc get_galaxy_version {file} { set ver "*WRONG*" set if [open $file "r"] while {![eof $if]} { set line [gets $if] if {[regexp "GalaxyNG release-(\[^ \t\]+), (\.+)." $line whole version date]} { set ver GalaxyNG break } elseif {[regexp "Galaxy PLUS version (\[^ \t\]+) - (\.+)$" $line whole version date]} { set ver GalaxyPLUS break } } close $if return $ver } #}}} #{{{ read_turn_file proc read_turn_file {file} { global galaxy_variant set galaxy_variant [get_galaxy_version $file] switch $galaxy_variant { GalaxyNG { read_turn_file_galaxyng $file } GalaxyPLUS { read_turn_file_galaxyplus $file } default { tk_messageBox -type ok -icon error -title "Wrong report file" \ -message "Wrong or unsupported report file format. Sorry." } } } #}}} #{{{ read_forecast_file proc read_forecast_file {file} { global galaxy_variant switch $galaxy_variant { GalaxyNG { read_forecast_file_galaxyng $file } default { tk_messageBox -type ok -icon error -title "Can`t read forecast file" \ -message "Loading forecast file not supported for $galaxy_variant. Sorry" } } } #}}} #{{{ optimize_data proc optimize_data {} { global planets_n planets global group_n groups global alien_group alien_group_races alien_group_n alien_groups_num global group_incoming group_incoming_n incoming_group_num global group_transit_n global battles global map_s map_s_side global race_status race_n array set group_transit_n {} foreach n [array names group_n] { if {$groups($n,origin) == "-"} { set groups($n,x) $planets($groups($n,dest),x) set groups($n,y) $planets($groups($n,dest),y) lappend planets($groups($n,dest),orbit) $n } else { set x1 $planets($groups($n,dest),x) set y1 $planets($groups($n,dest),y) set x2 $planets($groups($n,origin),x) set y2 $planets($groups($n,origin),y) set xdiff [expr {$x1 - $x2}] set ydiff [expr {$y1 - $y2}] set distance [dist $x1 $y1 $x2 $y2] set my_mult [expr {($distance - $groups($n,dist)) / $distance}] set x [expr {$x2 + ($xdiff * $my_mult)}] set y [expr {$y2 + ($ydiff * $my_mult)}] set groups($n,x) $x set groups($n,y) $y set group_transit_n($n) $n lappend map_s([expr {int($x / $map_s_side)}],[expr {int($y / $map_s_side)}]) [list group $n] } lappend planets($groups($n,dest),groups) $n } for {set n 1} {$n <= $alien_groups_num} {incr n} { set alien_group($n,x) $planets($alien_group($n,dest),x) set alien_group($n,y) $planets($alien_group($n,dest),y) lappend planets($alien_group($n,dest),alien) $n } for {set n 1} {$n <= $incoming_group_num} {incr n} { set x1 $planets($group_incoming($n,dest),x) set y1 $planets($group_incoming($n,dest),y) set x2 $planets($group_incoming($n,origin),x) set y2 $planets($group_incoming($n,origin),y) set xdiff [expr {$x1 - $x2}] set ydiff [expr {$y1 - $y2}] set distance [dist $x1 $y1 $x2 $y2] set my_mult [expr {($distance - $group_incoming($n,dist)) / $distance}] set x [expr {$x2 + ($xdiff * $my_mult)}] set y [expr {$y2 + ($ydiff * $my_mult)}] set group_incoming($n,x) $x set group_incoming($n,y) $y lappend planets($group_incoming($n,dest),incoming) $n lappend map_s([expr {int($x / $map_s_side)}],[expr {int($y / $map_s_side)}]) [list incoming $n] } foreach p [array names planets_n] { lappend map_s([expr {int($planets($p,x) / $map_s_side)}],[expr {int($planets($p,y) / $map_s_side)}]) \ [list planet $p] } foreach r [array names race_n] { if {$race_status($r,dip_status) == "War"} { set race_status($r,atwar) 1 } else { set race_status($r,atwar) 0 } } } #}}} #{{{ fill_tree proc fill_tree {} { global tree planets planets_n groups group_n ship_types global alien_groups_num alien_group alien_ship_types global incoming_group_num group_incoming global fleets fleet_n battles battles battle_protocol global battle_my_groups battle_alien_races battle_alien_groups global bombed_n bombed global routes route_n global p_my p_alien p_unid Tree:delitem $tree /Battles Tree:delitem $tree /Bombed Tree:delitem $tree /Groups Tree:delitem $tree /Fleets Tree:delitem $tree /Planets Tree:delitem $tree /Routes Tree:delitem $tree /Production Tree:newitem $tree /Battles -image idir Tree:newitem $tree /Battles/major -image idir Tree:newitem $tree /Battles/minor -image idir Tree:newitem $tree /Battles/probes -image idir Tree:newitem $tree /Bombed -image idir Tree:newitem $tree /Groups -image idir Tree:newitem $tree /Groups/incoming -image idir Tree:newitem $tree /Groups/alien -image idir Tree:newitem $tree /Groups/mine -image idir Tree:newitem $tree /Groups/mine/heavy -image idir Tree:newitem $tree /Groups/mine/medium -image idir Tree:newitem $tree /Groups/mine/small -image idir Tree:newitem $tree /Groups/mine/probe -image idir Tree:newitem $tree /Groups/mine/cargo -image idir Tree:newitem $tree /Fleets -image idir Tree:newitem $tree /Planets -image idir Tree:newitem $tree /Planets/alien -image idir # Tree:newitem $tree /Planets/alien/orbited -image idir Tree:newitem $tree /Planets/alien/unorbited -image idir Tree:newitem $tree /Planets/other -image idir # Tree:newitem $tree /Planets/other/orbited -image idir Tree:newitem $tree /Planets/other/unorbited -image idir Tree:newitem $tree /Planets/mine -image idir Tree:newitem $tree /Routes -image idir Tree:newitem $tree /Routes/CAP -image idir Tree:newitem $tree /Routes/MAT -image idir Tree:newitem $tree /Routes/COL -image idir Tree:newitem $tree /Routes/EMP -image idir Tree:newitem $tree /Production -image idir Tree:newitem $tree /Production/ship -image idir Tree:newitem $tree /Production/drive -image idir Tree:newitem $tree /Production/weapons -image idir Tree:newitem $tree /Production/shields -image idir Tree:newitem $tree /Production/cargo -image idir Tree:newitem $tree /Production/CAP -image idir Tree:newitem $tree /Production/MAT -image idir foreach p [array names planets_n] { switch $planets($p,kind) { mine { # Tree:newitem $tree /Planets/mine/$p switch $p_my($p,prod) { CAP { Tree:newitem $tree /Production/CAP/$p } MAT { Tree:newitem $tree /Production/MAT/$p } Drive { Tree:newitem $tree /Production/drive/$p } Weapons { Tree:newitem $tree /Production/weapons/$p } Shields { Tree:newitem $tree /Production/shields/$p } Cargo { Tree:newitem $tree /Production/cargo/$p } default { Tree:newitem $tree "/Production/ship/$p $p_my($p,prod)" } } } alien { # Tree:newitem $tree /Planets/alien/orbited/$p } unin { Tree:newitem $tree /Planets/alien/unorbited/$p } unid { if {$p_unid($p,size) != "-"} { # Tree:newitem $tree /Planets/other/orbited/$p } else { Tree:newitem $tree /Planets/other/unorbited/$p } } } } foreach n [lsort -integer [array names group_n]] { set mass [shipmass $ship_types($groups($n,name),drive) \ $ship_types($groups($n,name),attks) \ $ship_types($groups($n,name),weapon) \ $ship_types($groups($n,name),shield) \ $ship_types($groups($n,name),cargo)] if {$ship_types($groups($n,name),attks) > 0 && $mass > 90} { Tree:newitem $tree "/Groups/mine/heavy/$n: $groups($n,count) $groups($n,name)" } elseif {$ship_types($groups($n,name),attks) > 0 && $mass > 10} { Tree:newitem $tree "/Groups/mine/medium/$n: $groups($n,count) $groups($n,name)" } elseif {$ship_types($groups($n,name),attks) > 0} { Tree:newitem $tree "/Groups/mine/small/$n: $groups($n,count) $groups($n,name)" } elseif {$ship_types($groups($n,name),cargo) > 0} { Tree:newitem $tree "/Groups/mine/cargo/$n: $groups($n,count) $groups($n,name)" } else { Tree:newitem $tree "/Groups/mine/probe/$n: $groups($n,count) $groups($n,name)" } } for {set n 1} {$n <= $alien_groups_num} {incr n} { Tree:newitem $tree "/Groups/alien/$n: $alien_group($n,count) $alien_group($n,race) $alien_group($n,name)" } for {set n 1} {$n <= $incoming_group_num} {incr n} { Tree:newitem $tree "/Groups/incoming/$n: mass:$group_incoming($n,mass)" } foreach f [array names fleet_n] { Tree:newitem $tree "/Fleets/$f" } foreach b [array names battles] { set my_mass [battle_my_mass $b] set alien_mass [battle_alien_mass $b] if {$my_mass > 100 && $alien_mass > 100} { Tree:newitem $tree "/Battles/major/$b" } elseif {$my_mass > 10 && $alien_mass > 10} { Tree:newitem $tree "/Battles/minor/$b" } else { Tree:newitem $tree "/Battles/probes/$b" } } foreach b [array names bombed_n] { Tree:newitem $tree "/Bombed/$b" } foreach p [array names route_n] { if {$routes($p,cap) != "-"} { Tree:newitem $tree "/Routes/CAP/$p to $routes($p,cap)" } if {$routes($p,mat) != "-"} { Tree:newitem $tree "/Routes/MAT/$p to $routes($p,mat)" } if {$routes($p,col) != "-"} { Tree:newitem $tree "/Routes/COL/$p to $routes($p,col)" } if {$routes($p,emp) != "-"} { Tree:newitem $tree "/Routes/EMP/$p to $routes($p,emp)" } } fill_tree_planets_alien_orbited fill_tree_planets_other_orbited fill_tree_planets_mine } #}}} #{{{ fill_tree_planets_alien_orbited proc fill_tree_planets_alien_orbited {} { global tree tree_sort_planets_alien_orbited p_alien_n p_alien Tree:delitem $tree /Planets/alien/orbited Tree:newitem $tree /Planets/alien/orbited -image idir set found {} foreach p [array names p_alien_n] { if {$tree_sort_planets_alien_orbited == "name"} { lappend found $p } elseif {$tree_sort_planets_alien_orbited == "potential"} { lappend found [list $p [expr {$p_alien($p,size) / (10.0 + (1.0 / $p_alien($p,res)))}]] } else { lappend found [list $p $p_alien($p,$tree_sort_planets_alien_orbited)] } } if {$tree_sort_planets_alien_orbited == "name"} { set found [lsort $found] } else { set found [lsort -index 1 -real -decreasing $found] } foreach p $found { Tree:newitem $tree /Planets/alien/orbited/[lindex $p 0] } } #}}} #{{{ fill_tree_planets_other_orbited proc fill_tree_planets_other_orbited {} { global tree tree_sort_planets_other_orbited p_unid_n p_unid planets Tree:delitem $tree /Planets/other/orbited Tree:newitem $tree /Planets/other/orbited -image idir set found {} foreach p [array names p_unid_n] { if {$p_unid($p,size) != "-"} { if {$tree_sort_planets_other_orbited == "name"} { lappend found $p } elseif {$tree_sort_planets_other_orbited == "potential"} { lappend found [list $p [expr {$p_unid($p,size) / (10.0 + (1.0 / $p_unid($p,res)))}]] } else { lappend found [list $p $p_unid($p,$tree_sort_planets_other_orbited)] } } } if {$tree_sort_planets_other_orbited == "name"} { set found [lsort $found] } else { set found [lsort -index 1 -real -decreasing $found] } foreach p $found { Tree:newitem $tree /Planets/other/orbited/[lindex $p 0] } } #}}} #{{{ fill_tree_planets_mine proc fill_tree_planets_mine {} { global tree tree_sort_planets_mine p_my_n p_my Tree:delitem $tree /Planets/mine Tree:newitem $tree /Planets/mine -image idir set found {} foreach p [array names p_my_n] { if {$tree_sort_planets_mine == "name"} { lappend found $p } elseif {$tree_sort_planets_mine == "potential"} { lappend found [list $p [expr {$p_my($p,size) / (10.0 + (1.0 / $p_my($p,res)))}]] } else { lappend found [list $p $p_my($p,$tree_sort_planets_mine)] } } if {$tree_sort_planets_mine == "name"} { set found [lsort $found] } else { set found [lsort -index 1 -real -decreasing $found] } foreach p $found { Tree:newitem $tree /Planets/mine/[lindex $p 0] } } #}}} #{{{ fill_orders proc fill_orders {} { global my_orders_report my_orders_report_mistakes global my_orders_forecast my_orders_forecast_mistakes global orders if {$my_orders_forecast != ""} { set orders {} foreach l $my_orders_forecast { append orders $l "\n" } } if {$my_orders_forecast_mistakes != ""} { append orders "\n" append orders "; MISTAKES:\n" foreach l $my_orders_forecast_mistakes { append orders "; $l\n" } } if {$my_orders_report != ""} { append orders "\n" append orders "; ORDERS\n; for previous turn:\n" foreach l $my_orders_report { append orders "; $l\n" } } if {$my_orders_report_mistakes != ""} { append orders "\n" append orders "; MISTAKES\n; from previous turn:\n" foreach l $my_orders_report_mistakes { append orders "; $l\n" } } set_orders $orders } #}}} #}}} #{{{ help & about & copying & notes & report & commands #{{{ do_about_dialog proc do_about_dialog {} { global galng_version copyright_note toplevel .about wm title .about "about galng.tcl" wm geometry .about wm group .about . wm resizable .about 0 0 label .about.text -justify left -text " galng.tcl version $galng_version using tcl/tk [info patchlevel] $copyright_note go to http://galng.sf.net for current version " pack .about.text -side top -fill both button .about.close -text Close -command { destroy .about } pack .about.close -side bottom -fill x -expand 1 } #}}} #{{{ do_help_dialog proc do_help_dialog {} { global galng_version sb_width_opt toplevel .e wm title .e "HEEEEELLLLPPPP!!!!" wm geometry .e "500x400" frame .e.f1 frame .e.f1.f1 pack .e.f1 -expand 1 -fill both pack .e.f1.f1 -expand 1 -fill both text .e.f1.f1.txt -width 40 -height 5 \ -yscrollcommand [list .e.f1.f1.vsb set] scrollbar .e.f1.f1.vsb -orient vertical -command [list .e.f1.f1.txt yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 pack .e.f1.f1.txt -in .e.f1.f1 -fill both -expand 1 -side left pack .e.f1.f1.vsb -in .e.f1.f1 -fill y -side right button .e.f1.close -text Close -command { destroy .e } pack .e.f1.close -side left -fill x -expand 1 set txt .e.f1.f1.txt $txt configure -wrap word -font {Helvetica 10} -cursor xterm -tabs {5c 10c 15c} $txt tag configure h1 -font {Times 20} -spacing1 1c $txt tag configure h1b -font {Times 20 bold} -spacing1 1c $txt tag configure h2 -font {Times 16} -spacing1 0.3c $txt tag configure h2b -font {Times 16 bold} -spacing1 0.3c $txt tag configure h3 -font {Times 12} -spacing1 0.1c $txt tag configure h3b -font {Times 12 bold} -spacing1 0.1c $txt tag configure b -font {Helvetica 10 bold} $txt tag configure i -font {Helvetica 10 italic} $txt tag configure u -underline 1 $txt tag configure sp1 -lmargin1 2c -lmargin2 2c $txt tag configure sp2 -lmargin1 1c -lmargin2 1c $txt tag configure acenter -justify center $txt tag configure aleft -justify left $txt tag configure aright -justify right $txt tag configure vspace -spacing2 1c $txt tag configure link -underline 1 -foreground blue $txt tag configure alink -foreground red $txt tag configure vlink -foreground #303080 $txt tag bind link { set help_range [%W tag prevrange link "[%W index @%x,%y] + 1 char"] %W tag add alink [lindex $help_range 0] [lindex $help_range 1] %W config -cursor hand2 } $txt tag bind link { %W tag remove alink 1.0 end %W config -cursor xterm set help_range "" } $txt tag bind link { set help_newrange [%W tag prevrange link "[%W index @%x,%y] + 1 char"] if {[string compare $help_newrange $help_range] != 0} { %W tag remove alink 1.0 end set help_range $help_newrange %W tag add alink [lindex $help_range 0] [lindex $help_range 1] } } $txt tag bind link { set help_newrange [%W tag prevrange link "[%W index @%x,%y] + 1 char"] if {[string compare $help_newrange $help_range] != 0} { %W tag remove alink 1.0 end set help_range $help_newrange %W tag add alink [lindex $help_range 0] [lindex $help_range 1] } } $txt tag bind link { set help_tags [%W tag names [%W index @%x,%y]] set help_mark_index [lsearch -glob $help_tags go-*] if {$help_mark_index < 0} return %W see end %W see [string range [lindex $help_tags $help_mark_index] 3 end] %W tag add vlink [lindex $help_range 0] [lindex $help_range 1] } $txt mark set top current $txt mark gravity top left $txt insert end "galng.tcl " {h1b acenter} $txt insert end "version $galng_version using tcl/tk [info patchlevel]\n" h2 $txt insert end "Release status: Alpha\n" {h2b acenter} $txt insert end "\n" vspace $txt insert end "written by Steve Webb \n" {i sp1} $txt insert end "modified and maintained by Dmitry Morozhnikov \n" {i sp1} $txt insert end "\n" vspace $txt mark set about current $txt mark gravity about left $txt insert end "galng.tcl is a report viewer/tool for play by email (pbem) game Galaxy. " h3b $txt insert end "Currently it can work with reports from NG variant of Galaxy server.\n" h3b $txt insert end "\n" vspace $txt mark set toc current $txt mark gravity toc left $txt insert end "Table of content:\n" {h2b sp2} $txt insert end "Command line options" {h2 sp2 link go-run} "\n" $txt insert end "Main window" {h2 sp2 link go-main} "\n" $txt insert end "Galaxy map" {h2 sp2 link go-mouse} "\n" $txt insert end "Key bindings" {h2 sp2 link go-keys} "\n" $txt insert end "WOPR" {h2 sp2 link go-wopr} "\n" $txt insert end "Shipyard" {h2 sp2 link go-sy} "\n" $txt insert end "Orders sending" {h2 sp2 link go-orders} "\n" $txt insert end "\n" vspace $txt mark set run current $txt mark gravity run left $txt insert end "top" {link go-top} " Command line options" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end " \[--help\] \[--version\] \[ \[\]\]\n" b $txt insert end "\n" vspace $txt insert end "executable" b " -- executable file or script for galng.tcl\n" $txt insert end "--help | --version" b " -- display help on usage or version number and exit\n" $txt insert end "turn_report_file" b " -- GalaxyNG report file\n" $txt insert end "forecast_file" b " -- GalaxyNG forecast file\n" $txt insert end "\n" vspace $txt insert end "Note: galng.tcl can be invoked without specifying report file in command line. " {sp2 i} $txt insert end "You can use menu to load it latter " {sp2 i} $txt insert end "(or reload; or load report from different game; etc..).\n" {sp2 i} $txt insert end "\n" vspace $txt mark set main current $txt mark gravity main left $txt insert end "top" {link go-top} " Main window" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end "to be written..\n" {i sp2} $txt insert end "\n" vspace $txt mark set mouse current $txt mark gravity mouse left $txt insert end "top" {link go-top} " Galaxy map" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end "Bindings:\n" h3b $txt insert end "\n" vspace $txt insert end "Left mouse button" b " -- select closest object (planet or group in space). " $txt insert end "Press it several times to cicle objects in range of 1 light year.\n" sp2 $txt insert end "Mouse motion with left button pressed" b $txt insert end " -- display distance from current object to point. " $txt insert end "(Press space button to change between drawing line and circle).\n" sp2 $txt insert end "Right mouse button" b " -- center map at clicked point.\n" $txt insert end "Mouse motion with right button pressed" b " -- select rectangle to zoom in.\n" $txt insert end "\n" vspace $txt insert end "Note: on macintosh with stupid one button mouse you can use " {i sp2} $txt insert end "Ctrl key to emulate right mouse button.\n" {i sp2} $txt insert end "\n" vspace $txt mark set keys current $txt mark gravity keys left $txt insert end "top" {link go-top} " Key bindings" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end "Alt+1, Alt+2, Alt+3" b " -- hide/show left, bottom and right panels, respectively.\n" $txt insert end "Ctrl+l" b " -- show log in bottom panel.\n" $txt insert end "Ctrl+g" b " -- show orbit/group in bottom panel.\n" $txt insert end "Ctrl+b" b " -- show battle results in bottom panel.\n" $txt insert end "Ctrl+s" b " -- focus find planet entry.\n" $txt insert end "Alt+x" b " -- activate commands line. " $txt insert end "(Enter 'help' and press enter to view commands usage).\n" sp2 $txt insert end "0" b " -- set one to one zoom level for map. " $txt insert end "(It`s not actually one to one, but who cares?)\n" sp2 $txt insert end "+" b " or " {} "=" b " -- zoom in.\n" $txt insert end "-" b " -- zoom out.\n" $txt insert end "Escape" b " -- focus on map.\n" $txt insert end "Ctrl+w" b " -- open WOPR window.\n" $txt insert end "Ctrl+y" b " -- open ShipYard window.\n" $txt insert end "Ctrl+o" b " -- open Orders window.\n" $txt insert end "\n" vspace $txt mark set wopr current $txt mark gravity wopr left $txt insert end "top" {link go-top} " WOPR" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end "to be written...\n" {sp2 i} $txt insert end "\n" vspace $txt insert end "Note: you need wopr program to use it. " {sp2 i} $txt insert end "Take it from " {sp2 i} "http://www.galaxyng.com/ng/Tools/wopr.html" {sp2 u} "\n" {sp2 i} $txt insert end "\n" vspace $txt mark set sy current $txt mark gravity sy left $txt insert end "top" {link go-top} " Shipyard" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end "to be written...\n" {sp2 i} $txt insert end "\n" vspace $txt mark set orders current $txt mark gravity orders left $txt insert end "top" {link go-top} " Orders sending" {h2b sp1} "\n" $txt insert end "\n" vspace $txt insert end "to be written...\n" {sp2 i} $txt insert end "\n" vspace $txt configure -state disabled focus .e.f1.f1.vsb } #}}} #{{{ do_copying proc do_copying {} { global gpl_text sb_width_opt toplevel .gpl wm title .gpl "Copying" wm geometry .gpl "600x400" frame .gpl.f1 frame .gpl.f1.f1 pack .gpl.f1 -expand 1 -fill both pack .gpl.f1.f1 -expand 1 -fill both text .gpl.f1.f1.txt -width 40 -height 5 -wrap none -xscrollcommand [list .gpl.f1.hsb set] -yscrollcommand [list .gpl.f1.f1.vsb set] scrollbar .gpl.f1.f1.vsb -orient vertical -command [list .gpl.f1.f1.txt yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 pack .gpl.f1.f1.txt -in .gpl.f1.f1 -fill both -expand 1 -side left pack .gpl.f1.f1.vsb -in .gpl.f1.f1 -fill y -side right scrollbar .gpl.f1.hsb -orient horizontal -command [list .gpl.f1.f1.txt xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 pack .gpl.f1.hsb -in .gpl.f1 -fill x button .gpl.f1.close -text Close -command { destroy .gpl } pack .gpl.f1.close -side left -fill x -expand 1 .gpl.f1.f1.txt insert end $gpl_text .gpl.f1.f1.txt configure -state disabled } #}}} #{{{ make_notes_window proc make_notes_window {} { global argv last_index default_file_name notes_win_geom sb_width_opt toplevel .d wm title .d "Notes" # wm iconname .d "GALNG: Notes" wm geometry .d $notes_win_geom wm protocol .d WM_DELETE_WINDOW { save_notes set notes_win_geom [wm geometry .d] destroy .d } frame .d.f1 frame .d.f1.f1 pack .d.f1 -expand 1 -fill both pack .d.f1.f1 -expand 1 -fill both -side bottom text .d.f1.f1.txt -width 40 -height 5 -wrap none \ -xscrollcommand [list .d.f1.f1.hsb set] -yscrollcommand [list .d.f1.f1.vsb set] scrollbar .d.f1.f1.vsb -orient vertical -command [list .d.f1.f1.txt yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .d.f1.f1.hsb -orient horizontal -command [list .d.f1.f1.txt xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 # pack .d.f1.f1.txt -in .d.f1.f1 -fill both -expand 1 -side left # pack .d.f1.f1.vsb -in .d.f1.f1 -fill y -side right # pack .d.f1.hsb -in .d.f1 -fill x grid .d.f1.f1.txt -sticky news grid .d.f1.f1.vsb -sticky ns -column 1 -row 0 grid .d.f1.f1.hsb -sticky ew -column 0 -row 1 grid columnconfigure .d.f1.f1 0 -weight 2 grid rowconfigure .d.f1.f1 0 -weight 2 autoscroll .d.f1.f1.vsb -text autoscroll .d.f1.f1.hsb -text button .d.f1.close -text Close -command { save_notes set notes_win_geom [wm geometry .d] destroy .d } pack .d.f1.close -side right .d.f1.f1.txt delete 0.1 end if {[file exists "$default_file_name.notes.txt"]} { set infile [open "$default_file_name.notes.txt" "r"] while {-1 != [gets $infile line]} { .d.f1.f1.txt insert end "$line\n" } close $infile } focus .d.f1.f1.txt } #}}} #{{{ make_report_window proc make_report_window {} { global turn_file last_index report_win_geom sb_width_opt fixedfont2 set last_index 0.1 toplevel .c wm title .c "Your Turn Report" # wm iconname .c "GALNG: Report" wm geometry .c $report_win_geom wm protocol .c WM_DELETE_WINDOW { set report_win_geom [wm geometry .c] destroy .c } frame .c.f1 frame .c.f1.f1 pack .c.f1 -expand 1 -fill both pack .c.f1.f1 -expand 1 -fill both -side bottom text .c.f1.f1.txt -wrap none -font $fixedfont2 -width 80 \ -xscrollcommand [list .c.f1.f1.hsb set] -yscrollcommand [list .c.f1.f1.vsb set] scrollbar .c.f1.f1.vsb -orient vertical -command [list .c.f1.f1.txt yview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 scrollbar .c.f1.f1.hsb -orient horizontal -command [list .c.f1.f1.txt xview] \ -width $sb_width_opt -elementborderwidth 1 -border 1 # pack .c.f1.f1.txt -in .c.f1.f1 -fill both -expand 1 -side left # pack .c.f1.f1.vsb -in .c.f1.f1 -fill y -side right # pack .c.f1.hsb -in .c.f1 -fill x grid .c.f1.f1.txt -sticky news grid .c.f1.f1.vsb -sticky ns -column 1 -row 0 grid .c.f1.f1.hsb -sticky ew -column 0 -row 1 grid columnconfigure .c.f1.f1 0 -weight 2 grid rowconfigure .c.f1.f1 0 -weight 2 autoscroll .c.f1.f1.vsb -text autoscroll .c.f1.f1.hsb -text label .c.f1.search_l -text "Search:" entry .c.f1.search_entry -textvariable search_string menubutton .c.f1.comm -text QuickSearch -menu .c.f1.comm.menus -indicatoron 1 -relief raised menu .c.f1.comm.menus -tearoff 0 .c.f1.comm.menus add command -label "Bombings" -command { set last_index [.c.f1.f1.txt search "Bombings" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "Score" -command { set last_index [.c.f1.f1.txt search "Bulletins for Galaxy Game" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "GLOBAL Messages" -command { set last_index [.c.f1.f1.txt search "GLOBAL Messages" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "PERSONAL Messages" -command { set last_index [.c.f1.f1.txt search "PERSONAL Messages" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "Status of Players" -command { set last_index [.c.f1.f1.txt search "Status of Players" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "Your Ship Types" -command { set last_index [.c.f1.f1.txt search "Your Ship Types" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "Your Planets" -command { set last_index [.c.f1.f1.txt search "Your Planets" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "Your Groups" -command { set last_index [.c.f1.f1.txt search -backwards "Your Groups" end] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } .c.f1.comm.menus add command -label "Map" -command { set last_index [.c.f1.f1.txt search -- "-----------------------------" 0.1] if {$last_index != ""} { .c.f1.f1.txt see $last_index } } pack .c.f1.search_l .c.f1.search_entry .c.f1.comm -side left button .c.f1.close -text "Close" -command { set report_win_geom [wm geometry .c] destroy .c } pack .c.f1.close -side right bind .c.f1.search_entry { set last_index [.c.f1.f1.txt search $search_string $last_index] if {$last_index != ""} { .c.f1.f1.txt see $last_index set last_index [expr {$last_index + 0.1}] } } bind .c { focus .c.f1.search_entry } bind .c { focus .c.f1.f1.txt } if {[file exists $turn_file]} { set infile [open $turn_file "r"] while {![eof $infile]} { .c.f1.f1.txt insert end "[gets $infile]\n" } close $infile .c.f1.f1.txt configure -state disabled focus .c.f1.f1.txt } } #}}} #{{{ make_command_window_dm proc make_command_window_dm {} { global smtphost subject to_addr from_addr order_win_geom sb_width_opt galaxy_variant global orders_strip_quoting toplevel .orders wm title .orders "Order Editor" wm geometry .orders $order_win_geom wm protocol .orders WM_DELETE_WINDOW { set_orders [.orders.orders.txt get 1.0 end-1c] set order_win_geom [wm geometry .orders] save_defaults save_game_defaults destroy .orders } # top frame ----------------------------------- frame .orders.top label .orders.top.lsmtp -text "SMTP host:" entry .orders.top.smtp -textvariable smtphost label .orders.top.lsubject -text "Subject:" entry .orders.top.subject -textvariable subject label .orders.top.lto -text "To:" entry .orders.top.to -textvariable to_addr label .orders.top.lfrom -text "From:" entry .orders.top.from -textvariable from_addr label .orders.top.lgame -text "Game name:" entry .orders.top.game -textvariable game_name -state disabled label .orders.top.lrace -text "Race name:" entry .orders.top.race -textvariable race_name -state disabled label .orders.top.lpasswd -text "Password:" entry .orders.top.passwd -textvariable orders_passwd -show * button .orders.top.send -text "Send orders" -command { set_orders [.orders.orders.txt get 1.0 end-1c] save_defaults if {$game_name != "" && $race_name != ""} { if {$orders_passwd != ""} { save_game_defaults connect_to_server } else { tk_messageBox -type ok -title "Error sending orders" -parent .orders \ -message "Probably you need to specify your password?" } } else { tk_messageBox -type ok -title "Error sending orders" -parent .orders \ -message "Don`t know what game is, don`t know what race is. Probably you need to load report first?" } } button .orders.top.close -text Close -command { set_orders [.orders.orders.txt get 1.0 end-1c] set order_win_geom [wm geometry .orders] save_defaults save_game_defaults destroy .orders } menubutton .orders.top.comm -text "Insert command" \ -indicatoron 1 -relief raised if {$galaxy_variant == "GalaxyNG"} { .orders.top.comm configure -menu .orders.top.comm.menus_ng } elseif {$galaxy_variant == "GalaxyPLUS"} { .orders.top.comm configure -menu .orders.top.comm.menus_plus } # GalaxyNG menus ------------------------------ menu .orders.top.comm.menus_ng -tearoff 1 .orders.top.comm.menus_ng add cascade -label "General commands" -menu .orders.top.comm.menus_ng.general menu .orders.top.comm.menus_ng.general -tearoff 0 .orders.top.comm.menus_ng.general add command -label "Send Message to one or more nations" -command { .orders.orders.txt insert insert "@ \n" .orders.orders.txt insert insert "Hello NationName!\n" .orders.orders.txt insert insert "This is my message.\n" .orders.orders.txt insert insert "@\n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Rename my nation" -command { .orders.orders.txt insert insert "; Rename my nation.\n" .orders.orders.txt insert insert "C \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Set your real name" -command { .orders.orders.txt insert insert "; Set my real name for inclusion into the hall of fame.\n" .orders.orders.txt insert insert "= \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Declare war on a nation" -command { .orders.orders.txt insert insert "; Declare war on a nation.\n" .orders.orders.txt insert insert "W \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Declare peace on another nation" -command { .orders.orders.txt insert insert "; Declare peace on another nation.\n" .orders.orders.txt insert insert "A \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Find the e-mail address of another nation" -command { .orders.orders.txt insert insert "; Find the e-mail address of another nation.\n" .orders.orders.txt insert insert "F \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Change the map size of your report" -command { .orders.orders.txt insert insert "; Change the map size of your report.\n" .orders.orders.txt insert insert "M \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Change your password" -command { .orders.orders.txt insert insert "; Change your password.\n" .orders.orders.txt insert insert "Y \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Change the email address turn reports are sent to" -command { .orders.orders.txt insert insert "; Change the email address turn reports are sent to.\n" .orders.orders.txt insert insert "Z \n" .orders.orders.txt see end } .orders.top.comm.menus_ng.general add command -label "Set game option" -command { .orders.orders.txt insert insert "; Set game option.\n" .orders.orders.txt insert insert "O