pei000775 002123 000322 00000000000 05777463010 013004 5ustar00childrenpstaff000000 2106666 pei/BUGS000644 002123 000322 00000002321 06025576214 013526 0ustar00childrenpstaff000000 2506220 $Id: BUGS,v 2.3 1995/07/08 11:02:14 children Beta $ --- Known bugs in pei --- "Protocol not supported" If you see this message, edit sock.pl and change sub SOCK_STREAM { 1; } to sub SOCK_STREAM { 2; } "Command not found" If you get "Command not found" when you type "pei", try typing "perl pei" or "./pei". XRIX (IRIX?) simu.pl doesn't load (perl doesn't like the sort syntax). Solution: remove the lines: eval("package $game; do 'simu.pl';"); &nofind_error("simu.pl",$@) if !$simu_loaded; from the file called "pei" and try again. SunOS Sometimes perl (for example in SunOS) is unable to find the files tools.pl, parse.pl, ... In this case, put all the *.pl files in a directory called ~/perl and then in your ~/.login file put the line: setenv PERLLIB ~/perl "router" Router doesn't seem to behave as it should. For example, if you have two warehouses on the same island, and half of the sectors dist to one warehouse, and half to the other, then "router" will apparently switch which warehouse the sectors dist to. Very strange (I'll have to see it to believe it!). Hopefully (but unlikely) I'll have time to test it on a blitz sometime. pei/CHANGES.1000644 002123 000322 00000056156 05777462667 014242 0ustar00childrenpstaff000000 2505710 $Id: CHANGES.1,v 2.3 1995/07/08 11:02:14 children Beta $ --- PEI 1.x CHANGES --- This file records what changes were made with each version upgrade. 1.0 -> 1.0.1 28 Jun 94 Ken Stevens Rewrote eval { } and x77 so that it will work under older versions of perl. Added a 'bye' command. Moved stuff users don't need to know out of pei.man and into hacker.man. Fixed readline.pl so that it should now work on all systems. Fixed local prompt so that it now works without readline.pl. Fixed interrupt handler for the local prompt. 1.0.1 -> 1.0.2 29 Jun 94 Ken Stevens Fixed a bug in 'addgame' and 'games' which removed dots from hostnames. Changed addgame to allow any number of whitespace characters to separate fields (rather than insisting on space separated fields). 1.0.2 -> 1.0.3 30 Jun 94 Ken Stevens Fixed a serious bug in buildcost which caused router and cmvr to not work correctly. Fixed router. Fixed cmvr and umvr to use the argument. Fixed nova to use the argument. 1.0.3 -> 1.0.4 27 Jul 94 Ken Stevens Fixed a bug which resulted in the subroutine &main'ECONNREFUSED sometimes being undefined. It is now guaranteed to be defined. Fixed a bug which broke the ?scommand syntax--you can now safely use ?scommand syntax in your aliases. Fixed a bug which translated: alias sct "dump ${1:-#} ${2:+junk} | psect | more" incorrectly (when translating from .eifrc to .peirc). Fixed a bug in readline !history mechanism (if you typed at a sub-prompt then the empire command was not being put on the history list--now fixed). Added $AUTOGAME capability. Added support for environment variables EMPIRECOUNTRY, EMPIREREP, EMPIREHOST, and EMPIREPORT. Now permit ~/dir syntax for directories in "addgame" command. Can now just type "pei gamename" at the unix prompt. Added new local command: "terse" which toggles whether tools have long or short output (useful for people with 1200 or 2400 baud modems). Added new local command "quiet" to toggle the value of $quiet. Improved xmvr algorithm to make it much faster (once a sector has spent all its mob, it now is deleted from the @rich array speeding things up considerably). Fixed the spelling of "interrupt" in all files. Added four interrupt handlers: one for each tool. Made a new file "BUGS". 1.0.4 -> 1.0.5 27 Jul 94 Ken Stevens Fixed a bug which threw pei into an infinite loop when ^C was hit during an attack. Improved interrupt handler diagnostics. 1.0.5 -> 1.1.0 11 Aug 94 Sam Tetherow tools.pl: Added three new tools: "sneweff", "pneweff", and "lneweff" which calculate the new efficiency ships, planes, and land units will have after the update (based on commodities and avail). Added two new tools: "tele" and "anno" which let you use an editor to compose your telegrams and announcements, and then pei chops it into 1024 byte blocks and sends it off for you. Added two new tools: "mail" and "wmail" which are mail-like interfaces for reading your telegrams and announcements with reply, forward, and save capabilities (telegrams and announcements are saved in separate files in the users game directory, with messages marked as "read" or "unread"). Added a "foreach" tool which allows you to perform an Empire command on a specified group of sectors. Rewrote find_country_number to use nation vs relation 1, relation 2, and country *. pei: &find_country_number and &tools_init now occur before the reading of startup.exec. It is no longer necessary to put $coun=X in your startup.exec file. eval(''."ify(...)) was removed from country name and representative to allow users (like Drazz'zt) to have non-alphanumeric characters in their country name and rep. If $game is set from $country and $country contains non-alphanumeric characters, as much of $country as possible is used for the game name ($game must be alphanumeric because it is used as a package name). parse.pl: Removed all occurances of %parse_vars and moved the info that was in %parse_vars to comments at the top of parse.pl organised according to sect, country, unit, etc. Moved all calls to &add_parsemap to the top. Rewrote &parse_map. Fixed parsing for: ships, units, planes, sonar, lookout, llookout, coastwatch, spy, report, Bulletins, attack, relations, satellite, recon, mission query, build, map resource, country, Added functions &dump_info and &load_info which save and load unowned sector and unit data (so that enemy intelligence from spying, llook, etc... is saved over logging out and in again). The data is saved in a file called $game.dump. This functionality is currently not used. 1.1.0 -> 1.1.1 13 Aug 94 Ken Stevens Changed the name of README to INSTALL and made README now include information that users of older versions of pei will want to know. Moved "wish list" out of hacker.man and into a file called WISH_LIST. Copied the tool manual into a file called tools.man. I now run an integrity checking program which ensures that all repeated documentation is identical. Added "help tools" command. Fixed a bug in history which caused !abc to not work sometimes. Game names are now forced to be alphanumeric. Removed &getline from pei and renamed &drazz_getline to &getline in tools.pl. Fixed "games" command so that country and rep are not eval-quotify'd (since they aren't when they are specified). Added user definable variable $EDITOR for specifying which editor to use when composing telegrams. Fixed a bug in tele which prevented you from having blank lines in telegrams. Also added "Sending telegram...done" diagnostics. Changed pei so that now you can just put the *.pl files in the same directory as pei (they don't have to be in ~/perl anymore). Fixed the decimal formatting for xneweff functions. Fixed interrupt handers for routines which read data from the server. Added "rebel" command. 1.1.1 -> 1.1.2 18 Aug 94 Ken Stevens Completely rewrote all the mail/wmail stuff and put it in a new file called mail.pl. Now pei screams warnings at you if it can't find the tools it needs. Sam fixed a couple of bugs related to avail calculation in pneweff and lneweff. 1.1.1 -> 1.1.3 20 Aug 94 Sam Tetherow Fixed parse_produce. Added realm parsing to parse_nation. Added in_realm to tools.pl: in_realm($realmstring, $sect) will return 1 if $sect is in $realmstring, 0 otherwise. ($realmstring is of type x1:x2,y1:y2) Added two new tools "delta" and "cdelta": 1.1.3 -> 1.1.3a 11 Sep 94 Ken Stevens pei: The role of "startup.exec" has changed. It no longer contains commands sent to the server which are required by the tools. These commands are now automatically and silently run when the tools are loaded. The name of "startup.exec" has changed to "start.exec" and should now only contain commands which the user wants to run when they connect to the game (for example, maybe you want to display a map and check for starvation everytime you logon, so you could put "map #" and "starv *" in your start.exec file. tools.pl: Changed &find_country_number so that it can find your country number in the old server, the new server, or a HIDDEN game. Fixed interrupt handler for "nova" tool. Stuff that used to be in "startup.exec" is now in &tools_init. mail.pl: Now keeps "You lost your capitol..." messages out of mail. parse.pl: Changed &parse_nation so that it can work with either the old or the new server. 1.1.3a -> 1.2 12-15 Sep 94 Sam Tetherow tools.pl Added 7 new tools: stat, sstat, lstat, pstat, delta, wdelta, fdelta parse.pl Added parse_level Added lcargo (in parse_cargo) Added parse_power Misc fixes to parse_prod and others. Added &main'load_DB and &main'save_DB to load and store the internal DB. (Called from pei.) pei Added call to &main'load_DB to occur immediately following the loading of tools.pl and parse.pl Added call to &main'save_DB to occur both in do_exit and shutdown. I am not sure if there are the best places to put them, but that is what it looked like to me. Fixed ^C during wait 13-15 Sep 94 Ken Stevens readline.pl Upgraded from version 930122.003 to version 930306.007 of readline.pl. pei Fixed the way readline.pl handles cursor movement (007 does it nicer) Removed $, = ", " from pei because it conflicted with readline.pl I moved &getline out of pei and into tools.pl and mail.pl. You can now call pei with a "-n" flag which means "don't load tools". The idea here is to speed up the connection time if you just want to login and check your mail in a game. Changed load_DB and save_DB so that each game has its own copy and save_DB is called for each connected game at shutdown time. mail.pl Fixed a bug in headers which wrote "30" for the subject of BULLETINS Now if a message is >22 lines it will be piped to more. tools.pl Created a function &print_n_parse which prints a command to the screen and then parses it. It is used for the init commands. The foreach tool has been changed so that anything appearing after the sector specification is parsed as an input line rather than as an empire command. Thus it can now contain semicolons and aliases. 1.2 -> 1.2.1 16 Sep 94 Ken & Sam pei Fixed a bug which caused pei to seg fault when shutting down. tools.pl Fixed a bug which miscalculated co-ordinate wrapping and screwed up stat. parse.pl Fixed a bug in save_DB which separated first three fields by ',' by mistake. 1.2.1 -> 1.2.2 16 Sep 94 Ken Stevens pei Moved parsing of local commands after file redirection so that people can do stuff like "alias >! my_aliases" and "games >! mygames". Fixed alias recursion. There was a bug which caused aliases like alias info "info | more" alias power "power new | more" --to result in infinite loops when the user typed "info" or "power". The bug has been fixed. parse.pl Added parsing of %wkfc to &parse_produce. tools.pl Made a new tool called "extra" which will tell you how many extra civs you have in a sector. For example, if you had: sect des eff wkfc will make- p.e. cost use1 use2 use3 max1 max2 max3 max 6,2 i 100% 590 31 shell 0.31 $300 200l 100h 236l 118h 36 5,3 t 100% 590 4.43 tech 0.74 $1800 6d 30o 60l 22d 110o 220l 16.26 --then if you type "extra" in pei, you would get: You have 69 extra civs in 6,2. You have 330 extra civs in 5,3. 1.2.2 -> 1.2.3 6 Oct 94 Ken Stevens & Sam Tetherow tools.pl Fixed a bug in "delta" which wiped out the enemy sector database. Added argument to most tools, and changed the way that argument is processed. stat/sstat/pstat/lstat now allow arguments like ?own=Mirkwood. Added "relations" command to startup stuff for above change. Changed find_country_number to use "change country" to find the country number (this is much much faster). Completely rewrote tools_extra and called it tools_civs. Changed &print_n_parse to include the >/dev/null redirection. Put &print_n_parse in all places it could go. Fixed a bug which caused problems when you were country #0. Improved the stat algorithm to make it much faster (looping over known sectors rather than all sectors in realm.) parse.pl Added parse_change (for &find_country_number). Changed &parse_produce to &parse_product. "march" and "nav" are now parsed by parse_look. Fixed a bug in parse_produce which caused new guns not to appear on the "delta" report. pei Improved the error message you get when a tool doesn't load. Fixed a bug in "ify which was removing ' symbols from the middle of commands. mail.pl Fixed a bug in &getline which ate spaces at the beginning of lines. 1.2.3 -> 1.2.4 12 Oct 94 Ken Stevens tools.pl Added three new tools: reach - Tells you the range of your forts, radar stations, and coastwatch. sreach - Tells you the fire range of your ships, and how many sectors they can nav this update and next update. lreach - Tells you the fire range of your land units, and how many 100% (non-road non-mountain) sectors they can march this update and next update. Changed the "civs" tool to include uw's and mil in sector workforce and changed the name of the "civs" column to "workforce". Fixed a bug in wdelta which gave empty deltas when there were multiple dist centres (Sam made this fix). Added "show ship stats" and "show land stats" to startup sequence for the "sreach" and "lreach" tools. Renamed &build_target &build_sect_target. parse.pl Added parse of "Technology factor" in &parse_nation for use in "reach". Fixed a bug in &parse_land_stats. mail.pl You are now allowed to reply to telegrams ("BULLETINS") from the deity. pei Rewrote "help tools" to make things more clear. 1.2.4 -> 1.3 22 Oct 94 Ken Stevens & Sam Tetherow & Drake Diedrich RCS pei is now being maintained using RCS. An idea who's time had come. tools.pl Added three new tools: jack - Set iron thresholds in your "j" and "k" sectors to the value of "max1" in your production report. After calling "jack", you can call "imvr" to move iron into the sectors that need it. fus - Fuel ships in harbours and generate an error message if the harbour needs more fuel. cmap - Like bmap, but prints a letter representing the owner of sectors not owned by you, so you can see who is where. Added &init_letter, &toupper, &tolower for 'cmap' tool. Modified xmvr to have a sects argument. New syntax is: xmvr . Note that if you want to specify , you must also specify . Changed the 'civs' tools to show extra civs and uw's separately. Fixed 'civs' tools to show civs needed in the case when a sector is being redesignated. The tools "sstat", "pstat", and "lstat" now print the country name rather than the country number. The tools "stat", "sstat", "pstat", and "lstat" will now generate an error message if they are called incorrectly. Fixed a division by zero bug in the "reach" tool (now it prints "infinity" for the tech required for the highest ranges). Fixed a minor bug in sneweff (actually in build_ships) which showed commodities being used at sea. Put #' all over the place to make it emacs friendly. Removed the if (!$tools_loaded) bracketting the external tools. pei Added $, = ", " to &init so that when you print arrays in pei you can read them. "user" is now sent before "coun" in &connect to prevent an error log at the server end. Pei now reads 'sys/socket.ph' if it's available and uses it in the call to socket (this is required by the Solaris operating system). Created a new local command "reload" for reloading tools.pl and parse.pl. It is mainly for Sam and I who need to reload these files on the fly as we work on them. This is a "debugging" tool so I won't add it to the pei docs. parse.pl Fixed a bug in &parse_look, &parse_spy_plane, and &parse_attack which wasn't remembering that you saw approx 0 mil in a sector. Fixed a bug in &load_DB which wasn't loading both parts of the date. Fixed a bug in &parse_nation which misparsed realms. Added parse of tech decay rate to &parse_version. Changed &parse_product to match lines from start to finish. Added &parse_realm. readline.pl In SetTTY, replaced $TIOCSETP with $TIOCSETN to allow typeahead in pei. hacker.man Updated this file. 1.3 -> 1.4 2 Nov 94 Ken Stevens & Kevin O'Connor tools.pl Added a new command: crew - This command specifies exactly how many civs or mil your ships will need so that they won't decay when they are out at sea. (Note this might not be 100% accurate on all servers.) Modified three commands: fus - If the ship is at sea, and it is not completely fueled, then 'fus' will show the number of sectors (and updates) it will be able to sail before needing to refuel. 'fus' will also now list ships stranded at sea. sneweff - Added a new "total" line at the bottom which tells you the total amount of commodities consumed in the sector for building. Any extra commodities in the sector (i.e. not being used for building) are preceded by a +. this is helpful if you might need to use the commodities elsewhere. lneweff - Changed in the same way as sneweff. Fixed a bug in the 'jack' tool--it was only jacking thresholds in 'k' sectors (*blush*). Fixed a bug in 'reach' tool which was neglecting to add 1 to fort range. If &find_country_number is not able to find your country number, then it will ask you for it (since "change c" won't work if you don't have enough BTU's). pei (These changes were made by Kevin O'Connor) Pei now checks for environment variables EDITOR and PAGER and uses them if it finds them. $EDITOR and $PAGER may also be set in .peirc. Fixed a bug in the interrupt handler which wouldn't let you out of pei if you weren't able to flush server output because of lag. mail.pl (These changes were made by Kevin O'Connor) If the user puts "$mailflag = 1" in either .peirc or start.exec, then when the player uses the "mail" and "wmail" commands, the teles and annos will not be deleted on the server. This is most useful for co-rulers. To facilitate this, new headers are compared with old headers when $mailflag is set, to avoid duplicate telegrams in the teles file. 1.4 -> 1.4.1 7 Nov 94 Ken Stevens pei Fixed socket stuff so that pei will work on IRIX machines. It seems that IRIX machines require that you write to a socket before you can read from it. If you typed "pei badgamename" in unix, you got the cryptic error message "Cannot assign requested address." This has been changed to a "Usage:"... error message. tools.pl Changed "stat" tools so that they specify the month name instead of a number in the date column. parse.pl Added array %monthname for stat functions. Fixed spelling of agribusiness (was screwing up "stat" tool). 1.4.1 -> 1.5 12 Nov 94 Ken Stevens pei If pei gets a "Socket protocol not supported" error the first time it runs, then it will modify itself to fix the problem and ask you to run it again. Hopefully this will solve any pei socket problems on most machines. tools.pl Changed the "rebel" command so that it now shows sectors which have "too much" mil in them so that you can move mil around to prevent rebellion. "rebel" will now also show sector designation and mobility. "lneweff" will now only check land units in '!' or 'f' sectors. 1.5 -> 1.6 15 Dec 94 Ken Stevens mail.pl Fixed a bug in "anno" and "tele" tool which would delete a line of your text from time to time. The problem was that pei was forgetting to count the \n when calculating the length of a line. parse.pl Changed split(/ / to split(/[ \n]+/ in &parse_dump. Apparently this only affected the parsing of rads. There was an infinite loop in &parse_bulletin which was causing pei to hang when parsing plane output when it didn't know the country number for a country. The loop now terminates. pei If you put "$debug=1" in ~/.peirc, then pei will display the login conversation between pei and the server when it connects to a game. tools.pl The "setfood" tool will now not set food thresholds in warehouses. find_country_number now sets $number{$country} to $coun. In "pneweff" tool, added "total", "extra", and "needs". Changed "fus" so that it now tells you when your ship is in an ally's harbour and how far it can go from there before running out of fuel. Also fixed a bug which didn't notice petrol in the sector (it was spelled "pet" when it should have been spelled "petrol".) Changed "xmvr" so that you're now allowed to move commodities (not civs and uw's) out from (but not into) a sector if you're not the old owner of the sector. For example, feeding civs from a conquered warehouse. Changed $minmob (the minimum allowed mobility for a sector for xmvr) for harbours from 10 to 40. The reason is that you need mobility in harbours when feeding your civs using fishing boats. 1.6 -> 1.7 Ken Stevens, Jorg Schray, and Chris Farrell mail.pl Added new variable $mailflag{"gamename"} which does the same thing as $mailflag (keeps the mail on the server when you use the "mail" tool), except you now have the possibility to set the mail flag on some games but not others. (Jorg Schray) pei Ported pei to perl5.000. Note that it still works under perl4.x. (Jorg Schray) Added a new local command "firewall" to allow players stuck behind a firewall to use a proxy server to connect to an Empire server. Type "help local" from within pei for more details. (Chris Farrell) Documented that "a" in the "make" field of the "simu" tool refers to how much avail will be produced in that sector. readline.pl Jorg Schray also needed to change readline.pl in a number of places to get it to compile under perl5.000. 1.7 -> 1.8 11 May 95 Ken Stevens,Drake Diedrich,Steven White, Jorg Schray simu.pl Got a new version of simu.pl from Drake which calculates avail better. Applied a patch from Steven White which alligns the columns better. parse.pl Bugfix from Jorg Schray in perl5, "undef" only takes one arg. readline.pl Fixed reverse-search (patch from Drake). tools.pl Fixed a bug in sneweff which was giving the wrong info for ships at sea (I think that I screwed up the last time I fixed this, but now my present fix looks better...) Now x,y will line up at the , in sneweff, lneweff, and pneweff. Suggested by Steven A White . Fixed a bug (reported by m_turner@cs.wisc.edu (Michael Turner)) which was parsing "5 ships", "4 planes", ... at the bottom of "ship *" parsing, and thus generating some erroneous reports. Changed some multiple undef commands into single undef's for perl5. pei/CHANGES.2000644 002123 000322 00000005225 06120726445 014210 0ustar00childrenpstaff000000 2515225 $Id: CHANGES.2,v 2.3 1995/07/08 11:02:14 children Beta $ --- PEI 2.x CHANGES --- This file records what changes were made with each version upgrade, 1.8 -> 2.0 21 Jun 95 Ken Stevens pei Replaced socket read with calles to select() and sysread() Replaced the pei interrupt handler Rewrote many functions Changed environment variables EMPIRECOUNTRY and EMPIREREP to COUNTRY and PLAYER to make it compatable with the standard client. I made this CHANGES entry in a rush and it is not complete. I will do a more extensive and carefull job when I release 2.0. "history" command now accepts an argument for how many commands back you want to see. The output of all commands (except those typed at the Local% prompt) can now be redirected. For example, "simu > foo" now works. The Empire command "exe" (short for "execute") now works. This sends commands to the server directly (no alias expansion etc...) and the output from the server is not parsed by pei. local.pl Moved local commands into their own file 2.0 -> 2.0a 26 Jun 95 Ken Stevens pei When the user types pei now checks for (asynchronious) data from the server Support for the "flash" command was added. 2.0a -> 2.1 6 July 95 Ken Stevens pei sock.pl readline.pl Pei is now _fully_ asynchronous. I consider the code to be in an unstable state at the moment. 2.1 -> 2.2 7 July 95 Ken Stevens pei readline.pl Added support for the "toggle inform" mode now available in the new server. When the player types "toggle inform", then every time they receive a telegram from the server, then their prompt will instantly change to show how many telegrams are waiting for them to be read. Completely rewrote the interrupt handler (yet again...). 2.2 -> 2.3a 8 July 95 Ken Stevens readline.pl Is no more. I couldn't find a way to get readline to work asynchronously, so I have abandoned it. If you want readline and you don't care about asynch communication (e.g. you are playing on a chainsaw server) then use pei1.8 or pei2.0a. pei You now get a little beep when you get a new telegram. If you don't like this, you can turn it off by setting $beep = 0 in "~/.peirc". Removed readline Completely rewrote the interrupt handler (yet again...) and tested about 25 different possible combinations. Completely rewrote all three input loops and tested extensively. 2.3p -> 2.3q 3 March 96 Ken Stevens example.peirc Fixed the "convv" alias. 2.3q -> 2.4 10 March 96 Ken Stevens pei Made pei Empire3 compatable. pei/INSTALL000644 002123 000322 00000007154 06034435430 014105 0ustar00childrenpstaff000000 2505704 $Id: INSTALL,v 2.3 1995/07/08 11:02:14 children Beta $ Welcome to pei - Perl Empire Interface The pei manual is rather long, and if you're like me, you'll just want to take pei out of the box, plug it in, and see what it does. Here's how you can do just that: Type "make" in the pei directory. This will make the program "highlight". If you already use eif: Type "pei" at your unix prompt. pei will then convert your ~/.eifrc into ~/.peirc, and you will be faced with the familiar "Local%" prompt. To connect to a game, type the game name. (Note: pei does not have a "connect" command.) If you have never used eif: The quickest way for you to start is to type something like pei mycountryname mypassword game.host.name 1617 at the unix prompt, or to change the four lines at the top of the file called "pei". However, you are STRONGLY ENCOURAGED to do the following: 1. Copy the file called "example.peirc" to ~/.peirc. 2. Remove the aliases in this file that you don't like. 3. Edit the game stuff at the bottom, specifying the host, port, etc of the games that you want to connect to. PEI should work without ~/.peirc, however I have heard that it doesn't always work quite right, so use ~/.peirc to be safe. (Note that you'll only be able to access multiple games if $country is NOT defined at the top of pei.) Now for the magic: After you break, type "nova" and watch pei explore the entire island for you. Once you've got ships, assault an island with about 30 mil, and then next update type "nova" again and pei will explore that entire island too. Make sure that your #0 realm is big enough, because nova won't explore off the edge of a map. Once you've got lots of civs, and maybe you've bridged to a neighbouring island, use "cmvr" to migrate your civs to the "New World". If you don't have alot of civs, but you want to spread them out, then you can type something like "cmvr 50", and pei will try to get 50 civs into each sector. If there is food in your game, type "setfood" and then "fmvr" to get the right amount of food to all your sectors. pei has lots of other neat features, but I'll let you read about them in tools.man and pei.man. These are the files included in this distribution: README Things that users of older versions of pei will need to know about this latest version. INSTALL Installation instructions. BUGS A list of known bugs in pei. CHANGES.1 Version revision history for pei 1.x. CHANGES.2 Version revision history for pei 2.x. WISH_LIST Changes that we hope to implement in the future. pei The program you run. local.pl Contains all the pei local commands. parse.pl Parses server output into internal database. tools.pl Contains tools (nova, cmvr, ...). mail.pl Contains mail, wmail, tele, and anno tools. simu.pl Contains the "simu" tool. sock.pl Contains all socket I/O routines. example.peirc Stuff for you to put in your ~/.peirc file (NOTE: don't make a ~/.peirc file until pei has had a chance to convert your ~/.eifrc into ~/.peirc). help.pei Pei users manual--you can also get this by typing "help pei" from within pei. help.local Manual for pei commands that you can use at the local prompt. help.tools Manual for pei tools--you can also get this by typing "help tools" from within pei. highlight.c A program to pipe the output of "sect" to. Makefile For making highlight. README.hacker Information useful to hackers. ENJOY! Sam Tetherow tetherow@nol.org pei/Makefile000644 002123 000322 00000000334 05771776512 014523 0ustar00childrenpstaff000000 2510067 # Makefile for highlight # # On most systems, this should work: LIBS = -ltermcap # On some systems, you may need to use this instead: # LIBS = -lcurses highlight: highlight.c $(CC) $(CFLAGS) -o $@ highlight.c $(LIBS) pei/README000644 002123 000322 00000003243 05777462670 013763 0ustar00childrenpstaff000000 2507756 $Id: README,v 2.3 1995/07/08 11:02:14 children Beta $ Welcome to pei - Perl Empire Interface *** THIS IS A BETA RELEASE *** *** USE AT YOUR OWN RISK *** If you have never used pei before, then you should find out how to install pei and run it by reading the file called "INSTALL". The major changes in the upgrade from 1.8 to 2.3a are: * pei ie now fully asynchronious, supporting the FLASH and INFORM protocols of the new server. To learn more about the new server, connect to empire.net 7778 1-10/1-10 and type "info Empire2" and "info toggle" * If you're in INFORM mode (see "info toggle") then you'll get beeped whenever you receive a new telegram. If you don't like this, put $beep = 0 in "~/.peirc". * Fixed output redirection for tools (e.g. "simu > foo" works now). * Wrote a C program highlight.c to which you can pipe the output of "sect" to get highlighting to work with pei (see the comments at the top of highlight.c for installation instructions). * "history" command now takes an argument (for number of lines you want to see) * Changed the socket read routines to detect server timeout and EOF. * Coded a complete overhaul of the interrupt handler (what happens when you type ^C). It should now recover much better than before. * Changed environment variables EMPIRECOUNTRY and EMPIREREP to COUNTRY and PLAYER to make it compatable with the standard client. * I have removed readline because it couldn't work with asynch communication. The latest version of pei is available on the Planet's Empire Archives: http://www.empire.net/~children/PEA/player/clients/ ftp://ftp.empire.net/pub/empire/player/clients/ pei/README.hacker000644 002123 000322 00000006104 05777462671 015202 0ustar00childrenpstaff000000 2510074 $Id: README.hacker,v 2.3 1995/07/08 11:02:14 children Beta $ This file contains information useful to perl coders who would like to understand better how pei works. Function Maps The associative array %functionmap maps pei commands to perl functions. For example, when you type "exec cmdfile", then since $functionmap{"exec"} = '&execfile', the perl function &execfile will be called. You can write your own functionmap functions. Upon arriving at the functionmap function, the command which invoked it will be in the variable $command, and it's arguments will be in $commandarg. For example, you could add the following code to the file "pei": In the &init function of pei, add: $functionmap{"say"} = '&say'; And then at the end of the pei script put: sub say { print $commandarg . "\n"; } To see a list of functionmaps already defined, type: print sort keys %functionmap If your perl function makes reference to any of your country variables, then you will need to put it in the tools.pl file and call it tools_something. For an example of how to write a tool like this, have a look at the "jack", "rebel", or "fus" tools in tools.pl. They are all small and relatively easy to understand. Parse Maps Often the server sends you information that you want to remember internally in pei. Server output is parsed into pei variables using parse maps. For example, when you type "cen #", you receive a lot of information about your sectors, and since there is a parse map for the command "cen", as you read the output of "cen #", perl will be reading it as well, and parsing it into its internal database. Parse maps are defined in the associative array %parsemap. The key of the array is the name of the empire command, and the value is the name of a perl function used to parse the output of the data. When the perl function is called, the line to be parsed will be in $_. See parse.pl for examples. To see a list of the commands which are presently parsed, type: print %parsemap &S_read For those who are curious, here are some of the special characters interpretted by the telnet protocol: Name Dec. Octal Description ---- ---- ----- ----------- IAC 255 \377 /* interpret as command: */ DONT 254 \376 /* you are not to use option */ DO 253 \375 /* please, you use option */ WONT 252 \374 /* I won't use option */ WILL 251 \373 /* I will use option */ SB 250 \372 /* interpret as subnegotiation */ GA 249 \371 /* you may reverse the line */ EL 248 \370 /* erase the current line */ EC 247 \367 /* erase the current character */ AYT 246 \366 /* are you there */ AO 245 \365 /* abort output--but let prog finish */ IP 244 \364 /* interrupt process--permanently */ BREAK 243 \363 /* break */ DM 242 \362 /* data mark--for connect. cleaning */ NOP 241 \361 /* nop */ SE 240 \360 /* end sub negotiation */ EOR 239 \357 /* end of record (transparent mode) */ pei/WISH_LIST000644 002123 000322 00000002367 05777462671 014421 0ustar00childrenpstaff000000 2510160 $Id: WISH_LIST,v 2.3 1995/07/08 11:02:14 children Beta $ --- PEI WISH LIST --- These are things which we hope to add to pei in the future: xmvr remember which sectors have the plague, civil unrest, etc... and save the info in a file so that xmvr won't spread these things. Update in progress Check for "Update in progress" message in robot tools. (Mainly useful for blitzing.) Coverage tool Write a tool which estimates your air/fort/unit support for a given sector. mail interrupt You login to the blitz and type "mail" forgetting that you had 1000 telegrams. ^C should do something sensible. warehouse xmvr Make an xmvr which only uses dist centres mail record Record outgoing mail? land units in non-forts Find out the formula which land units use for building in non-fort/hq and add them to "lneweff". port pei to PC's Port pei to the Macintosh and Windows NT. parse exe output It wouldn't be hard to parse the output of the "exe" command because commands are printed as data with "Execute : command". rebel sees land units At present, only mil is used by the rebel command. Should count mil in land units as well. readline put readline back in pei pei/example.peirc000644 002123 000322 00000005421 06116455521 015533 0ustar00childrenpstaff000000 2511672 # $Id: example.peirc,v 2.3 1995/07/08 11:02:14 children Beta $ # Do NOT copy this file to ~/.peirc. First run pei and let it convert your # ~/.eifrc into ~/.peirc. Then after it has done that, you might want to # add some of these aliases to your ~/.peirc. # Use the "highlight" program to highlight the output of the sect command: alias sect "sect $+ | $PEIPATH/highlight" # Build a bridge and explore onto it: alias bb "build b $1 ; ?$2 ; expl c $1 1 ${2}h" # Set thresholds: alias thom "th o * ?newd=o 1; th i * ?newd=m 1; th d * ?newd=g 1; th l * ?newd=j 1; th h * ?newd=k 1; th s * ?newd=i 1; th g * ?newd=d 1; th p * ?newd=% 1; th r * ?newd=u 1" # After using cmvr, I use these two aliases: alias rs "res * ?newd=+&civ>40" alias ds "des * ?newd=+&civ>40&ocon>10 o; des * ?newd=+&civ>40&gold>10 g; thom" # Check oil and dust: alias cod "res * ?des=o&ocon<10; res * ?des=g&gold<10" # Convert civs: alias convv "conv * ?own#oldown&uw<999 40; shoot c * ?own#oldown 999; cen * ?old#own&mob>0" # fire alias fi "fire sect $1 $2" alias fl "fire land $1 $2" alias fs "fire ship $1 $2" # machine-gun fire alias mfi "fi $1 $2 ; fi $1 $2 ; fi $1 $2 ; fi $1 $2 ; fi $1 $2 ; fi $1 $2 ; fi $1 $2 ; fi $1 $2 " alias mfl "fl $1 $2 ; fl $1 $2 ; fl $1 $2 ; fl $1 $2 ; fl $1 $2 ; fl $1 $2 ; fl $1 $2 ; fl $1 $2 " alias mfs "fs $1 $2 ; fs $1 $2 ; fs $1 $2 ; fs $1 $2 ; fs $1 $2 ; fs $1 $2 ; fs $1 $2 ; fs $1 $2 " # Pipe info pages to more: alias info "info $1 | more" # Production of interesting sectors: alias pr "prod * ?newd#m&newd#g&newd#o&newd#a&newd#+" # Move commodities out of sectors they shouldn't be in: alias thod "th i * ?iron>1&newd#j&newd#k&newd#w 1; th o * ?oil>1&newd#%&newd#d&newd#t&newd#r&newd#w 1; th d * ?dust>1&newd#b&newd#t&newd#r&newd#w 1; th l * ?lcm>1&newd#h&newd#*&newd#!&newd#t&newd#r&newd#i&newd#d&newd#l&newd#p&newd#w 1; th h * ?hcm>1&newd#h&newd#*&newd#!&newd#i&newd#d&newd#w 1; th b * ?bar>1&newd#b&newd#w 1; th d * ?newd=b&bar=999 1" # common commands alias m "map #" alias h history alias x "exit" alias q "quit" # If you use X-windows, you can put the output of a command in it's # own window by using: alias xs "$+ | cat | (xmessage -t 'PeiShow: $+' & )" # typo's alias udpate update alias reda read alias mvoe move alias mvo move alias shiip ship alias cdn cen alias elnist enlist # directories $HOWDIR = "~/empire/how" # hosts $ENET = "empire.net" # blitzes addgame vhow visitor visitor $ENET 7778 ${HOWDIR} addgame how1 1 1 $ENET 7778 ${HOWDIR} addgame how2 2 2 $ENET 7778 ${HOWDIR} addgame how3 3 3 $ENET 7778 ${HOWDIR} addgame how4 4 4 $ENET 7778 ${HOWDIR} addgame how5 5 5 $ENET 7778 ${HOWDIR} addgame how6 6 6 $ENET 7778 ${HOWDIR} addgame how7 7 7 $ENET 7778 ${HOWDIR} addgame how8 8 8 $ENET 7778 ${HOWDIR} addgame how9 9 9 $ENET 7778 ${HOWDIR} addgame how10 10 10 $ENET 7778 ${HOWDIR} pei/help.local000644 002123 000322 00000003251 05771466355 015026 0ustar00childrenpstaff000000 2512404 These commands are local commands which may be typed at the local prompt or at the pei prompt: help [subject] - Print help on [subject]. addgame [game] [country] [password] [host] [port] [directory] - Add [game] to pei where [directory] is a unix directory that pei cd's to before connecting to the game. games - List games. [game] - Connect to [game]. try [game] - Connect to [game] as a different country. kill [game] - Kill process [game] on host. trykill [game] - Kill process [game] on host with a different country. echo [text] - Print [text] to the terminal. alias [name] [stuff] - Define [name] to mean [stuff] (see "Aliases" below). unalias [name] - Remove alias definition for [name]. terse - Toggle terse mode. If terse is on, then tools run quietly (useful for modems with low BAUD). quiet - Toggle quiet mode. If quiet is on, then commands read from exec files are not printed. firewall [proxyhost] [proxyport] ["proxyprompt"] - Use the proxy server to connect to the empire server. [proxyprompt] is the prompt from the server telling pei its ready to accept an address. proxyprompt should be in double quotes. exit - Exit pei. bye - Exit pei. pei/help.pei000644 002123 000322 00000031343 06034435376 014505 0ustar00childrenpstaff000000 2506240 NAME pei - Perl Empire Interface SYNOPSIS pei [ -n ] [country] [representative] [host] [port] -or- pei [ -n ] [gamename] DESCRIPTION pei is a powerful, fully extendible smart client for playing Empire. Features include: - Tools for managing and feeding civs, auto-exploring, setting dist-paths, calculating the new efficiency of ships/planes/units, reading/sending telegrams and announcements, keeping track of enemy sectors and units, and managing production deltas. - Full perl integration. You can type perl commands at the empire prompt. - File redirection, piping, exec (read commands from a file), and runfeed (pipe the output of a program to pei). - Aliases. You can define your own aliases with arguments. - !!, !abc, and ^a^b history substitution - Multiple games. You may be connected to more than one game at a time, and switch between them. - Function mapping. You can call your own perl functions from within the client by defining your own function maps. - Output parsing. Server output is automatically parsed and stored in an internal database. There is a separate database for each game connected to. - Interrupt handling. ^C should be handled properly in most cases. If the option -n is specified, then pei will be loaded without any tools. This is useful if you just want to log on quickly and check your mail. An instance of pei begins by executing commands from the file .peirc in the home directory of the invoker. If a game has not been specified, then the user is presented with a 'Local%' prompt at which they can choose any game that was specifed by an 'addgame' line in .peirc. Once a game has been specified, pei tries to connect to the game. If it was unable to connect, it will exit with a message explaining what went wrong. Once connected, pei begins executing commands from the file start.exec in the current directory. Note that 'addgame' lines in .peirc can associate to each game its own directory. Then pei repeatedly performs the following actions: Lines are read from the server and parsed until a prompt is encountered, then terminal input is parsed until an Empire command is encountered at which point pei sends the command to the server. Lexical Structure An input line can come from one of three places: (1) You typed it in. (2) It was read in from a file (e.g. "start.exec"). (3) It was the value of an alias. In case (1), if the input line is of one of the following forms, it will undergo history substitution: !! - Repeat the last command. ![text] - Repeat the last command starting with [text]. e.g. !cen ^[text]^[replace] - Replace [text] with [replace] in last command. e.g. ^jjh^jnh Input lines beginning with # are comments and are ignored. Each input line consists of sequence of command lines separated by semicolons (note that semicolons inside single or double quotes don't count): commandline1; commandline2; commandline3; ... Before each command line is processed, whitespace at the beginning and end of it is removed. Each command line has the following syntax: ?[scommand] - If we are at a sub-prompt, send [scommand] to it, otherwise, ignore. e.g. des; ?2,0; ?c [ecommand] - Send the empire command [ecommand] to the server. If we were expecting ?[scommand], abort the previous command before sending. e.g. cen 0,0 e.g. move; cen 2,0 (aborts move before doing cen) :[syscmd] - Send [syscmd] to your operating system. e.g. :ls [command] > [filename] - Write the output of [command] to [filename] only if the file does not exist. e.g. cen #1 > cenfile [command] >! [filename] - Write the output of [command] to [filename] (if the file exists, overwrite it). e.g. cen #1 >! cenfile [command] >> [filename] - Append the output of [command] to [filename]. e.g. spy 3,3 >> spyfile [command] | [syscmd] - Pipe the output of [command] to the system command [syscmd]. e.g. news | more Any commandline beginning with "$", "&", "@", "%", "{", "print ", "undef ", or "eval " will be evaluated as a perl expression. Commands These commands are "function maps", and may be typed at the pei prompt when you are connected to a game: exec [filename] - Read input lines from [filename]. If you don't want the commands printed to the terminal, then before the exec, you should have "$quiet = 1". e.g. exec pei_commands runfeed [syscmd] - Run the program [syscmd] and pipe the output to pei. e.g. runfeed mycivmover history [number] - Print the last [number] input lines. If [number] is ommitted, then $maxhistorysize is used. Note that any [filename] or [syscmd] may use ~ to refer to the home directory of the user. Variables Any pei command may contain perl variables. These variables will be replaced by their values when the command is parsed. For example: $a = "0,0" cen $a (evaluates to "cen 0,0") If you want to isolate a variable name from surrounding text, then you may use {} brackets as in: $x = "ti" na${x}on (evaluates to "nation") Here are some special pei variables which you can define: $AUTOGAME - If defined in ~/.peirc, then pei will automatically connect to this game when it starts up. $TIMEOUT - the length of time (in seconds) that pei will wait for data from the server (default is 120). Increase this if you have a bad lag, and decrease it if your link is good. $beep - default value is 1. If you don't want to get beeped when you receive a telegram in INFORM mode, then put $beep = 0 in your ~/.peirc file. $maxhistorysize - The number of input lines remembered by pei in the history mechanism (default is 100). $EDITOR - The editor that you would like to use for composing telegrams and announcements (default is "vi" or environment variable EDITOR if defined). $PAGER - Program to display output one screenful at a time. (default is "more" or environment variable PAGER if defined). $PEIPATH - The full pathname of the directory containing all the pei files (you shouldn't need to set this). $mailflag - If $mailflag = 1 or $mailflag{gamename} = 1, then when you %mailflag use "mail" to read your telegrams, pei will send "n" to the server so that your telegrams won't get deleted. Useful for co-rulers. $debug - If $debug = 1, then pei will display the login conversation between pei and the server when connecting to a game. Aliases You can define aliases in pei using the syntax: alias [name] [stuff] For example: alias d- des * ?newd=- + If you want to put multiple commands in an alias, then you must enclose [stuff] in quotes. For example: alias cod "res * ?des=o&ocon<10; res * ?des=g&gold<10" If you put perl variables in [stuff], then they will be evaluated at runtime. For example: alias ca cen $a $a = "0,0" ca (evaluates to "cen 0,0") The following variables are also defined: $0 - The alias name $1, $2, $3, ... - Arguments 1, 2, 3, ... that were used when the alias was called $+ - All of the arguments For example, if you define the alias foo as follows: alias foo first: $1, second: $2, all: $+, This should be foo: $0 then: foo a b c d e f would evaluate to: first: a, second: b, all: a b c d e f, This should be foo: foo Here's a more useful example: alias bridge "build b $1; ?$2; expl c $1 1 ${2}h" Alias recursion is permitted. For example: alias xp explore alias xx xp c 0,0 1 xx jjh (evaluates to "explore c 0,0 1 jjh") Comparison to eif For those of you who are used to using eif, I've included this section to describe how eif syntax translates into pei syntax. The easiest way to see how eif syntax translates into pei syntax is to see how pei converts your ~/.eifrc into ~/.peirc (this is automatically done if pei doesn't find ~/.peirc). For your reference, here is a translation table of eif syntax to pei syntax: When converting ~/.eifrc to ~/.peirc, the following translations are made: addgame a b c d e f addgame a d e b c f & ? @ : setvar name "string" $name = "string" ${N:+} ${N} ${N:-word} (tricky -- watch how pei converts it) These translations you'll have to make by hand: connect gamename gamename unsetvar name undef $name $%name $ENV{'name'} The following eif syntax should simply be rewritten in perl: !?str? ${N:?word} ${<:%word} ${name:=word} The eif syntax !n and !-n is not supported. ENVIRONMENT VARIABLES PERLLIB List of directories searched when locating PERL libraries. Used to find tools.pl, parse.pl, ... COUNTRY, PLAYER, EMPIREHOST, EMPIREPORT If specified pei will use these variables to connect to an empire game. EDITOR Default editor for pei. PAGER Default screen pager to be used in pei. PEIPATH The full pathname of the directory containing all the pei files (you shouldn't need to set this). FILES README Things that users of older versions of pei will need to know about this latest version. INSTALL Installation instructions. BUGS A list of known bugs. CHANGES A record of what got changed with version upgrades. WISH_LIST Changes that we hope to implement in the future. pei The program you run. parse.pl Parses server output into internal database. tools.pl Contains tools (nova, cmvr, ...). mail.pl Contains mail, wmail, tele, and anno tools. simu.pl Contains the "simu" tool. example.peirc Stuff for you to put in your ~/.peirc file (NOTE: don't make a ~/.peirc file until pei has had a chance to convert your ~/.eifrc into ~/.peirc). pei.man Pei users manual--you can also get this by typing "help pei" from within pei. tools.man Manual for pei tools--you can also get this by typing "help tools" from within pei. hacker.man Information useful to hackers. $HOME/.peirc Pei commands read when pei starts up. $HOME/.eifrc Converted to ~/.peirc if ~/.peirc doesn't exist. $gamedir/start.exec Commands executed when you first connect to a game. $gamedir/$gamename.dump Database of enemy sectors (used by "stat"). $gamedir/$gamename.ships Database of enemy ships (used by "sstat"). $gamedir/$gamename.planes Database of enemy planes (used by "pstat"). $gamedir/$gamename.units Database of enemy land units (used by "lstat"). $gamedir/$gamename.teles Your mailbox of Empire telegrams (used by "mail"). $gamedir/$gamename.wires Announcements (used by "wmail"). AUTHORS Drake Diedrich (harmless@empire.net) Wrote the original version of this program (called hpc.pl) which included perl integration, file redirection, piping, function mapping, parse mapping, shell escape, and exec. He also wrote parse.pl and user.pl. Ken Stevens (children@empire.net) Added .peirc, aliases, history substitution, runfeed, interrupt handling, documentation, multiple game support (addgame, kill, try), multiple commands separated by semicolon, sub-prompting using ?, and variable substitution. Sam Tetherow (tetherow@nol.org) Added the following tools: sneweff, pneweff, lneweff, tele, anno, mail, wmail, and foreach. Sam also completely rewrote parse.pl, adding many new parse maps. pei/help.tools000644 002123 000322 00000022514 06016003135 015050 0ustar00childrenpstaff000000 2506420 These commands are "tool commands" and may be typed at the pei prompt when you are conencted to a game. Note that if , , or are not specified in any of the tools, then '*' is used. Default is '#'. Note also that ?switches may always be used in specifications. These tools change your country: nova - Auto-explore all adjacent wilderness sectors in . If is not specified, #0 is used. e.g. nova #1 cmvr - Move civs in to try to get in each sector. If is not specified, then the value of "max safe civs" from the nation report is used. e.g. cmvr e.g. cmvr #3 e.g. cmvr #12 ?newd=g 300 umvr - Move uws (just like cmvr). imvr , dmvr , lmvr , smvr , ... - Move iron, dust... in according to dist thresholds. NOTE: The above tools will never lower the mobility of a sector below the value specified in the $minmob array. If you don't like the default values for $minmob, then edit $minmob in the xmvr_init function of tools.pl. setfood [number of updates] - Set food thresholds for maximum civ growth. (setfood will not reduce any existing thresholds.) After calling "setfood", you can call "fmvr" to move food into the sectors that need it. Won't set thresholds in warehouses. if [number of updates] is specified, then pei will set the food threshold for that many updates (assuming unlimited civ growth). Default [number of updates] is 2. jack - Set iron thresholds in your "j" and "k" sectors to the value of "max1" in your production report. After calling "jack", you can call "imvr" to move iron into the sectors that nead it. fus - Fuel ships in harbours and generate an error message if the harbour needs more fuel. If the ship is at sea, and it is not completely fueled, then the number of sectors it will be able to sail before needing to refuel is shown. router - Dist all sectors to the nearest warehouse. If there isn't a warehouse within 10 sectors, make a useless sector into a warehouse and dist to it. foreach [ecommand] - Perform the Empire command [ecommand] on where instances of the variables $sect, $civ, $mil, $uw, $food, $iron, $lcm, $hcm, $iron, $dust, $bar, $oil, $rad, $pet, $shell, and $gun in [ecommand] will be replaced by their values for each sector. e.g. foreach #1 ?mil<5 move m 0,0 5-$mil $sect (Make sure that each sector in #1 has at least 5 mil in it--if it doesn't, move the necessary amount of mil from 0,0 into the sector.) These tools tell you information about your country: civs - Produces a report showing which sectors have too many civs, and which sectors have too few (based on how many commodities are in the sector and what the neweff will be). rebel - Tells you how many more mil conquered sectors need to keep them from rebelling. crew - This command specifies exactly how many civs or mil your ships will need so that they won't decay when they are out at sea. reach - Tells you the range of your forts, radar stations, and coastwatch. sreach - Tells you the fire range of your ships, and how many sectors they can nav this update and next update. lreach - Tells you the fire range of your land units, and how many 100% (non-road non-mountain) sectors they can march this update and next update. sneweff pneweff lneweff - Calculates the new efficiency that ships, planes, or land units will have after the next update. If the sector doesn't have enough commodities to build all the units, then the extra commodities needed will show up in brackets in the commodities' column. The avail column will show the ammount of avail that this ship, plane, or unit will use. If the value in the avail column is in brackets it indicates the ammount of avail that this ship, plane, or unit needs for maximum production. Lastly, if a ship needs more mil on board to prevent efficiency decay, that will appear in brackets in the "Crew" column. The "total" at the bottom sums the total commodities consumed in the sector for building. Any extra commodities in the sector (i.e. not being used for building) will be preceded by a +. e.g. sneweff #1 e.g. pneweff 11,11 delta fdelta wdelta - These three commands calculate production deltas in different ways. The argument refers to distribution centres. So only sectors which distribute into are included in the calculations. So a sector in which distributes outside will not be included, while a sector outside which distributes into will be included. - "delta" adds up the total amount of commodities produced and subtracts that from the total amount consumed. The "supply" column says how many updates of supply you have left of that commodity. - "fdelta" projects civ/uw growth versus food production over the next 15 updates. - "wdelta" is like "delta" except that it bases its calculation on what will happen inside the warehouses. i.e. how much of each commoditiy is going into storage versus how much is being drawn out of storage. simu - "simulate" an update. Pei runs your country through a simulated update, showing how many of your commodities will get distributed where at the update. The update is always simulated for *all* the sectors in your country. The argument specifies which sectors you'd like displayed. The "mob" field specified how much mobility will be left in the sector after stuff is distributed out but before new mobility is added. The "commodities" field shows which commodities will end up in which sectors. A "+" after a commodity means that not all of that commodity got disted out. A "-" means that the sector didn't get all that it wanted. An "a" in the "make" field refers to how much avail will be created in that sector. cmap - Like bmap, but prints a letter representing the owner of sectors not owned by you, so you can see who is where. stat (?switches) - Report known information on all sectors in that statisfy ?switches (if defined). All normal sector switches apply although if you do not know the information about the sector in question the check will probably fail. e.g. stat * ?own=27 sstat (?switches) pstat (?switches) lstat (?switches) - Report known information on all land units, planes, or ships within that satisfy ?switches (if definded). Valid switches for land units are: own, tech, eff, and type. The only difference between these switches and normal empire switches are that type will handle a partial match. e.g. lstat * ?own=27&type=inf mail, wmail - mail-like interface for reading telegrams and announcements. Allows replying, forwarding, and saving to a file. To reply to an announcement as an announcement, forward without a country number. Type "?" in the mailer for help. tele, anno - Use the editor specified in the $EDITOR variable to compose a telegram or announcement. When you have finished editing your tele or anno, pei will chop it into 1024 byte blocks and send it off. pei/highlight.c000644 002123 000322 00000007175 06034435321 015166 0ustar00childrenpstaff000000 2506223 /* $Id: highlight.c,v 2.3 1995/07/08 11:02:14 children Beta $ * * highlight.c * * Based on print.c by Doug Hay * * Written by Ken Stevens * 21 June 95 * * DESCRIPTION * This C program suppliments pei to let pei do highlighting (required by * the "sect" command). You can get highlighting in pei by piping the * output of a highlit command to this program. * * INSTALLATION * 1. Type "make". (You shouldn't need to edit the "Makefile" file.) * 2. Add the following alias to your ~/.peirc file: * alias sect "sect $+ | $PEIPATH/highlight" * * HOW TO RUN IT * The "sect" command should now work properly in pei. * If, however, the highlight output doesn't look quite right, try one * or both of the following two fixes: * * FIX 1: * Uncomment the following define: */ /* #define CURSES_HIGH */ /* * FIX 2: * In the file "Makefile", change the line: * LIBS = -ltermcap * to: * LIBS = -lcurses */ /* BUG REPORTS: * mail your bug-reports and comments to: * Sam Tetherow */ /******************************************************* * Copyright (C) Doug Hay, 1989,90,91. * Permission to use and abuse this code, as long * as this copyright notice stays intact and with the * code. No warranty implied. This code supplied as is. *******************************************************/ #include static char *Terminal_SO, *Terminal_SE; static void terminit(); /******************************************* * stripprint * * Strip any EMPIRE hilighting bits from the * string, then print it to passed file. */ static void stripprint(str) char *str; { char *cp=str; while (*cp) *cp++ &= 0x7f; puts(str); } /******************************************* * hiprint * * Find any characters in passed string with EMPIRE * highlighting bits set, and hilight those characters. */ static void hiprint(str) char *str; { char *cp; int hav_hi = 0; for (cp=str; *cp; cp++) { if (*cp & 0x80) hav_hi = 1; } if (!hav_hi || !Terminal_SO || !Terminal_SE || !*Terminal_SO || !*Terminal_SE) { if (hav_hi) for (cp=str; *cp; cp++) *cp &= 0x7f; printf("%s", str); } else { for (cp=str; *cp;) { if (*cp & 0x80) { printf("%s", Terminal_SO); for ( ; (*cp & 0x80 && putchar(*cp & 0x7f)); cp++); printf("%s", Terminal_SE); } else putchar(*cp++); } } putchar('\n'); } void main(argc, argv) int argc; char *argv[]; { char buf[800]; terminit(); if (argc > 1) { while (!feof(stdin)) { if (gets(buf)) { stripprint(buf); } } } else { while (!feof(stdin)) { if (gets(buf)) { hiprint(buf); } } } } /******************************************* * terminit * * Go find the highlighting strings for the terminal. */ static void terminit() { char *getenv(), *tgetstr(); char *cp, *term; static char nullstring[2]; static char termbuf[1024]; static char data[1024]; static char *area; area = data; Terminal_SO = Terminal_SE = nullstring; term = getenv("TERM"); if (!term) { fprintf(stderr, "Unable to get TERM environment variable.\n"); return; } if (tgetent(termbuf, term) == -1) { fprintf(stderr, "terminit tgetent failed\n"); return; } cp = area; if (tgetstr("so", &area) == NULL) { fprintf(stderr, "highlight.c terminit, no so\n"); } else Terminal_SO = cp; cp = area; if (tgetstr("se", &area) == NULL) { fprintf(stderr, "highlight.c terminit, no se\n"); } else Terminal_SE = cp; #ifndef CURSES_HIGH ++Terminal_SO; ++Terminal_SE; #endif } pei/local.pl000644 002123 000322 00000015715 06034435272 014521 0ustar00childrenpstaff000000 2475760 # $Id: local.pl,v 2.3 1995/07/08 11:02:14 children Beta $ # # Perl Empire Interface Local Commands # # Written by Ken Stevens # # DESCRIPTION: # This perl module contains all of the functions which process pei commands # that the user is allowed to type at the Local% prompt (i.e. when they have # not yet connected to a game). # # INSTALLATION: # You do not need to do anything to install local.pl. It will be automatically # included into pei when you connect to a game. Just make sure that it # is in the same directory as pei when pei is run. Or you can put local.pl # in the directory ~/perl and add the following line to your ~/.login file: # setenv PERLLIB ~/perl # # Type "help local" from within pei for the syntax of local commands, # or read the file help.local that comes with pei. # # BUG REPORTS: # mail your bug-reports and comments to: # Sam Tetherow # # --- Global variables --- # # $alias{"command"} User-defined aliases # $lcommand{"command"} = "&function" # When player types local "command" call &function. # @expanded Expanded aliases (prevents infinite recursion) # $quiet Don't print commands read from files (set to 1 for .peirc) # $terse Run tools with terse output? # *UNTERSEOUT Where to send output when not running a tool. # $proxyhost Name of the proxy server # $proxyport Port to connect to on the proxy server # $proxyprompt Prompt that triggers us to send address of server # $firewall Boolean Flag Used to Indicate if Firewall Exists. # --- Functions --- # For a description of what the various functions in this module do, # type "help local" from within pei, or read the file "help.local". # # local_init Set the %lcommand associative array. # print_alias Print an alias. # get_country Get a country name and representative. sub local_init { $lcommand{'help'} = '&help'; $lcommand{'addgame'} = '&addgame'; $lcommand{'games'} = '&games'; $lcommand{'try'} = '&try'; $lcommand{'kill'} = '&kill'; $lcommand{'trykill'} = '&kill'; $lcommand{'echo'} = '&echo'; $lcommand{'alias'} = '&alias'; $lcommand{'unalias'} = '&unalias'; $lcommand{'terse'} = '&terse'; $lcommand{'quiet'} = '&quiet'; $lcommand{'firewall'} = '&firewall'; $lcommand{'exit'} = '&do_exit'; $lcommand{'bye'} = '&do_exit'; $lcommand{'reload'} = '&load_tools'; } sub help { local (*MORE, *HELPFILE); if ($commandarg ne "pei" && $commandarg ne "tools" && $commandarg ne "local") { print <<'EOF'; Help is available for the following subjects: help pei - pei syntax help local - local commands help tools - pei tools EOF return; } if (!open(MORE, "|$PAGER")) { print STDERR "Unable to run your PAGER \"$PAGER\".\n"; return; } if (!open(HELPFILE, "<$PEIPATH/help.$commandarg")) { print STDERR "Unable to open \"$PEIPATH/help.$commandarg\" for input.\n"; return; } while () { print MORE; } close HELPFILE; close MORE; } sub addgame { local ($name, $rest) = split(/\s+/, $commandarg, 2); if ($name =~ /^\w+$/) { $lcommand{$name} = "\&set_game(\"$name\")"; $games{$name} = eval(''."ify($rest)); } else { print STDERR "Invalid game name: \"$name\"\n"; } } # print a list of games they can connect to sub games { local ($dir, @_); printf "%8s %-14s %-10s %20s %6s %-14s\n", "name", "country", "password", "host", "port", "directory"; print "-----------------------------------------------------------------------------\n"; for (sort keys %games) { split(/\s+/, $games{$_}); # values of %games are separated by whitespace $dir = eval(''."ify(@_[4])); $dir =~ s/^$ENV{'HOME'}/~/; # replace home directory with ~ if (length($dir) > 14) { $dir = "..." . substr($dir,-11); } printf "%8s %-14s %-10s %20s %6s %-14s\n",$_, @_[0], @_[1], eval(''."ify(@_[2])), eval(''."ify(@_[3])), $dir; } } sub try { &set_game($commandarg); &get_country; # ask user for country name and password $game = $commandarg."_".$country; } sub kill { local ($gamesav); if ($games{$commandarg}) { # if the second word is a game name $gamesav = $game; &set_game($commandarg, 1); # chdir and set coun, rep, host, port if ($command eq "trykill") { &get_country; # ask user for country name and password } } else { print "No such game: $commandarg\n"; return; } if ($S = $socket{$game}) { print "Sending quit to $game\n"; print $S "quit\n"; &close_connection(1); } else { if (&connect_to_server) { # login to the host print $S "kill\n"; # kill our process $mode = -1; $_ = &sock'S_read($S, $TIMEOUT); print; } else { print STDERR "Connection failed.\n"; } &close_connection; } &set_game($gamesav); } # This function is used by the "try" and "trykill" functions. It reads a # country name and password from the user. sub get_country { $country = &line_prompt("Country:"); $representative = &line_prompt("Representative:"); } # Print text to the terminal. sub echo { print eval(''."ify($commandarg)) . "\n"; } # Either set an alias, show an alias, or show all aliases sub alias { # Either set $name and $val, just $name, or nothing depending on $commandarg local ($name,$val) = ($commandarg =~ /^(\S*)\s*((\S+(\s+\S+)*)*)/); if ($val) { $val =~ s/\$([0-9]+)/\@_[$1]/g; # convert $1 to @_[1] $val =~ s/\${([0-9]+)}/\@{_[$1]}/g; # convert ${1} to @{_[1]} $alias{$name} = $val; } elsif ($name) { # if only name is specified, show the alias if ($alias{$name}) { &print_alias($name); } else { print "$name undefined.\n"; } } else { foreach $name (sort(keys %alias)) { # show all aliases &print_alias($name); } } } # Print one alias. This function converts aliases back into what they # would have looked like when the user typed them in. sub print_alias { local($name) = @_; local($val) = $alias{$name}; $val =~ s/\@_\[([0-9]*)\]/\$$1/g; # convert @_[1] to $1 $val =~ s/\@{_\[([0-9]*)\]}/\${$1}/g; # convert @_{[1]} to ${1} print "alias $name " . "ify($val) . "\n"; # \ escape quotes } # Remove an alias sub unalias { if ($alias{$commandarg}) { delete $alias{$commandarg}; print "Alias \'$commandarg\' deleted.\n"; } else { print "Alias \'$commandarg\' not found.\n"; } } sub terse { $terse = !$terse; print "Terse mode ".($terse?"on":"off")."\n"; if ($terse) { if (!open(DEVNULL,">/dev/null")) { die "Unable to open /dev/null for output.\n"; } } } sub quiet { $quiet = !$quiet; print "Quiet mode ".($quiet?"on":"off")."\n"; } sub firewall { print STDERR "Entering Firewall Mode!\n\n"; $firewall = 1; ($proxyhost,$proxyport,$proxyprompt)=split(/\s+/,$commandarg,3); $proxyprompt =~ s/.*"(.*)".*/"$1"/e; #Only keep what's between the quotes. } $local_loaded = 1; pei/mail.pl000644 002123 000322 00000037127 06120724104 014326 0ustar00childrenpstaff000000 2516240 # $Id: mail.pl,v 2.3 1995/07/08 11:02:14 children Beta $ # mail.pl # Perl Empire Interface Mailer # # Written by Ken Stevens # # # DESCRIPTION: # This module contains the following tools: # # mail,wmail - mail-like interface for reading telegrams and announcements. # tele,anno - Use an editor to compose your telegram or announcement. # # The help for the mailer may be found at the bottom of this file. # Just type '?' from within the mailer to get the help. # # INSTALLATION: # You do not need to do anything to install mail.pl. It will be automatically # included into pei when you connect to a game. Just make sure that it # is in the same directory as pei when pei is run. Or you can put mail.pl # in the directory ~/perl and add the following line to your ~/.login file: # setenv PERLLIB ~/perl # # AUTHORS: # Written by Ken Stevens # tele, anno, forward, and reply based on ideas by Sam Tetherow # # BUG REPORTS: # mail your bug-reports and comments to: # tetherow@nol.org (Sam Tetherow) # --- Global variables --- # @type message type (PROD,BULL, or TELE) # @mark message mark (----,*, or author) # @from author # @date date message was written # @lines the number of lines in the message # @subj subject of message (money delta, attacker, or first line of tele) # @status N=new, U=unread, r=replied to, D=deleted # @header old header of the message # @msg the message body # # --- Functions --- # # parse_header parse the header of the telegram into type,mark,from,date # read_mailfile read and parse the entire mailfile # print_headers print the headers # write_mailfile save mail and status info to a file # print_message print an individual message # process_delete delete messages recursively # save save a telegram to a file # create_tmp_file create a file to edit that you're going to send # post_it chop and send the anno/tele to the server # reply reply to a tele/anno # forward post a reply to a tele/anno or forward to another user # mail_prompt print the prompt for the mailer # reader start up the mail/wmail reader # mail_help print help # tele use an editer to compose a tele/anno package mail; ######################### Mail parsing commands ####################### $main'functionmap{'mail'}="&mail'reader"; $main'functionmap{'wmail'}="&mail'reader"; sub parse_header { if (/> Production Report\s+dated\s+(\S+)\s+(\S+)\s+(\d+)\s+(\S+)/) { $type[$i] = 'PROD'; $mark[$i] = '----'; $from[$i] = 'Production'; $date[$i] = "$1 $2 $3 $4"; } elsif (/> BULLETIN\s+from\s+(\S+),\s+\(\#0\)\s+dated\s+(\S+)\s+(\S+)\s+(\d+)\s+(\S+)/) { $type[$i] = 'BULL'; $mark[$i] = '*'; $from[$i] = $1; $date[$i] = "$2 $3 $4 $5"; } elsif (/> Telegram\s+from\s+(\S+),\s+\((\#\d+)\)\s+dated\s+(\S+)\s+(\S+)\s+(\d+)\s+(\S+)/) { $type[$i] = 'TELE'; $mark[$i] = $2; $from[$i] = $1; $date[$i] = "$3 $4 $5 $6"; } elsif (/>(.)Announcement\s+from\s+(\S+),\s+\((\#\d+)\)\s+dated\s+(\S+)\s+(\S+)\s+(\d+)\s+(\S+)/) { $type[$i] = 'ANNO'; $mark[$i] = $3; $from[$i] = $2; $date[$i] = "$4 $5 $6 $7"; if ($1 eq '*') { $status[$i] = 'U'; } } else { $type[$i] = 'UNKNOWN'; $mark[$i] = 'UNKNOWN'; } if (/\S $/) { # message status is kept in trailing spaces $status[$i] = ' '; } elsif (/\S $/) { $status[$i] = 'U'; $current_message = $i if !$current_message && !$new_message; } elsif (/\S $/) { $status[$i] = 'r'; } elsif (!$new_message) { $current_message = $i; $new_message = 1; } $header[$i] = $_; $header[$i] =~ s/ +$//; # remove trailing spaces } sub parse_line { next if /^read $/; next if /^y\n$/; next if /^You have a new telegram waiting ...$/; next if /^You have a new announcement waiting ...$/; next if /^Into the shredder, boss? y\n$/; next if /^No telegrams for you at the moment...$/; next if /^No announcements for you at the moment...$/; next if /^You lost your capital... better designate one$/; ++$lines[$i]; $msg[$i] .= $_."\n"; if ($type[$i] eq 'PROD') { if (/money delta was (\$-*\d+) for this update/) { $subj[$i] = "money delta: $1"; } } elsif ($type[$i] eq 'BULL') { if (!$subj[$i]) { if (/taking/ || /attacking/ || /assaulting/ || /\(\#\d+\)/) { $subj[$i] = substr($_,0,30); } } } elsif (!$subj[$i]) { $subj[$i] = substr($_,0,30); } } sub reader { local($i,$new_message,$skip_message,$checked_mail,$n); local($current_message); local(@status,@type,@mark,@from,@date,@subj,@msg,@header,@lines); local($cnum); $cnum = " $main'coun" if $main'nstatus eq 'DEITY'; if ($main'command eq "mail") { #' $ext="teles"; $main'command = "read"; if ($main'mailflag || $main'mailflag{$main'game}) { #JS print $main'S "read$cnum n\n"; #' } else { print $main'S "read$cnum y\n"; #' } } elsif ($main'command eq "wmail") { #' $ext="wires"; $main'command = "wire"; if ($main'mailflag || $main'mailflag{$main'game}) { #' #JS print $main'S "wire n\n"; #' } else { print $main'S "wire y\n"; #' } } else { print STDERR "Bad call to &reader\n"; return; } open(MAILFILE, "< $main'game.$ext"); # open the mail file while () { chop; if (/^>/) { # line is a header ++$i; &parse_header; } elsif ($i) { &parse_line; } } $current_message = 1 if !$current_message; close(MAILFILE); $checked_mail = $i; open(MAILFILE, ">> $main'game.$ext"); $skip_message = 1; while(&getline()) { if (/^>/) { # line is a header $skip_message=0; if ($main'mailflag || $main'mailflag{$main'game}) #' #JS { for ($n=$checked_mail; $n > 0 && !$skip_message; $n--) { $skip_message = ($header[$n] eq $_); # # This for loop checks all the localy # stored message headers to see # if the newly read in # header is a duplicate. } } if (!$skip_message) { $i++; $status[$i] = 'N'; &parse_header; } } elsif ($i && !$skip_message) { &parse_line; } if (!$skip_message) { print MAILFILE "$_\n"; } } close(MAILFILE); if (!@msg) { print "No ".($ext eq "teles"?"telegrams":"announcements"). " for you at the moment...\n"; return; } &print_headers($current_message); if (&mail_prompt) { print "Saving changes to ". ($ext eq "teles"?"telegrams":"announcements")."...\n"; &write_mailfile("$main'game.$ext"); } } ####################### Mail reading commands ####################### sub print_headers { local ($current_message) = @_; local ($m,$headstart); if ($#msg <= 20) { $headstart = 1; } else { $headstart = $current_message - 10; $headstart = 1 if $headstart < 1; } for ($m = $headstart; $m <= $#msg && $m < $headstart + 20; ++$m) { printf "%3d %s%s %4s %-12s %19s %-30s\n", $m, $m == $current_message?'>':' ', $status[$m], $mark[$m], $from[$m], $date[$m], $subj[$m]; } } sub write_mailfile { local ($m); open(MAILFILE, '>'.pop(@_)); # open the mail file for ($m = 1; $m <= $#msg; ++$m) { next if $status[$m] eq 'D'; if ($status[$m] eq ' ') { print MAILFILE $header[$m].' '; } elsif ($status[$m] eq 'r') { print MAILFILE $header[$m].' '; } else { print MAILFILE $header[$m].' '; } print MAILFILE "\n".$msg[$m]; } close(MAILFILE); } sub print_message { print "Message #$m ($lines[$m] lines)\n"; print $header[$m]."\n"; if ($lines[$m] < 23) { print $msg[$m]; } else { local (*MORE); if (open(MORE, "|$main'PAGER")) { print MORE $msg[$m]; close MORE; } else { print $msg[$m]; } } $status[$m] = ' '; } sub process_delete { local($undelete) = @_; local(@del, $m); sub new_status { $status[$m] = $undelete?($status[$m] eq 'D')?'U':$status[$m]:'D'; } s/^ +//; s/ +$//; if (/ /) { for (split) { &process_delete($undelete); } return; } if (/^(\d+)-(\d+)$/) { if ($1 > $2 || $1 < 1 || $2 > $#msg) { print "Bad range: $1-$2\n"; } else { for ($m = $1; $m <= $2; ++$m) { &new_status; } } } elsif (/^(\d+)/) { if ($1 < 1 || $1 > $#msg) { print "Bad message number: $1\n"; } else { $m = $1; &new_status; } } elsif ($_ eq 'b') { for ($m = 1; $m <= $#msg; ++$m) { if ($type[$m] eq 'BULL') { &new_status; } } } elsif ($_ eq 't') { for ($m = 1; $m <= $#msg; ++$m) { if ($type[$m] eq 'TELE') { &new_status; } } } elsif ($_ eq 'p') { for ($m = 1; $m <= $#msg; ++$m) { if ($type[$m] eq 'PROD') { &new_status; } } } elsif ($_ eq '*') { for ($m = 1; $m <= $#msg; ++$m) { &new_status; } } else { print "Bad arg to ".($undelete?"undelete":"delete").": \'$_\'\n"; } } sub save { local ($filename); s/^ +//; s/ +$//; if (/^[\/\.\w]+$/) { $filename = $_; } elsif (/^(\d+)\s+([\/\.\w]+)$/) { if ($1 < 1 || $1 > $#msg) { print "Bad message number: $1\n"; return; } else { $m = $1; $filename = $2; } } else { print "Bad mail save syntax (perhaps your filename is a bit strange)\n"; return; } open(SAVEFILE, ">".$filename); print SAVEFILE $header[$m]."\n".$msg[$m]; close(SAVEFILE); } sub create_tmp_file { open(TMPFILE,">$filename"); print TMPFILE "} On $date[$m] $from[$m] wrote:\n"; for (split(/\n/,$msg[$m])) { print TMPFILE "} $_\n"; } print TMPFILE "}-- End of excerpt from $from[$m]\n\n"; close(TMPFILE); } sub save_it { local ($thing) = @_; open(RECORD, ">>$main'game.record"); print RECORD "> $thing, dated " . `date`; close RECORD; system("cat $filename >> $main'game.record"); } sub post_it { local ($cmd,$thing) = @_; local ($textin,$size,$textout); system("$main'EDITOR $filename"); $_ = &main'line_prompt("Are you sure you want to send the $thing? (y/n)"); #' if ($_ ne "y" && $_ ne "Y") { print "$thing aborted.\n"; &save_it($thing); system("rm -f $filename"); return 0; } open(TMPFILE,"<$filename"); while () { $textin .= $_; } close(TMPFILE); &save_it($thing); system("rm -f $filename"); $textout = $cmd; for (split(/\n/, $textin)) { $size += 1 + length; if ($size > 1024) { $textout .= ".\n$cmd"; $size = 0; } $textout .= "$_\n"; } $textout .= ".\n"; $| = 1; print "Sending $thing..."; for (split(/\n/, $textout)) { print $main'S "$_\n"; while (&getline) { #' if (/No such/) { print "$_\n"; } } } print "done\n"; $| = 0; 1; } sub reply { local ($filename) = "tmp.reply.file"; s/^ +//; s/ +$//; if ($_) { if (/^(\d+)$/) { if ($1 < 1 || $1 > $#msg) { print "Bad message number: $1\n"; return; } $m = $1; } else { print "Bad reply syntax.\n"; } } if ($type[$m] ne 'TELE' && $type[$m] ne 'ANNO' && $type[$m] ne 'BULL') { print "You may only reply to telegrams, announcements, and bulletins.\n"; return; } &create_tmp_file; if (&post_it("tele $from[$m]\n", "telegram to $from[$m]")) { $status[$m] = 'r'; } } sub forward { local ($filename) = "tmp.forward.file"; local ($to); s/^ +//; s/ +$//; if ($_) { if (/^(\d+)$/) { if ($1 < 1 || $1 > $#msg) { print "Bad message number: $1\n"; return; } $m = $1; } elsif (/^(\d+)\s+(\S+)$/) { if ($1 < 1 || $1 > $#msg) { print "Bad message number: $1\n"; return; } $m = $1; $to = $2; } elsif (/^(\S+)$/) { $to = $1; } else { print "Bad forward/followup syntax.\n"; } } &create_tmp_file; if ($to) { &post_it("tele $to\n", "telegram to \"$to\""); } else { &post_it("announce\n", "announcement"); } } sub mail_prompt { local($m) = ($current_message); $m = $#msg if $m > $#msg; $_ = &main'line_prompt("($m/$#msg):"); #' s/ +$//; s/^ +//; while ($_ ne 'q' && $_ ne 'x') { if ($_ eq 'h') { &print_headers($m); } elsif (/^h\s+(\d+)$/) { $m = $1 + 10; $m = 1 if $m < 1; $m = $#msg if $m > $#msg; &print_headers($m); } elsif ($_ eq 'z') { if ($#msg - $m < 10) { print "On last screen full of messages.\n"; } else { $m += 20; $m = $#msg - 9 if $m > $#msg; &print_headers($m); } } elsif ($_ eq 'Z') { if ($m <= 10) { print "On first screen full of messages.\n"; } else { $m -= 20; $m = 10 if $m < 1; &print_headers($m); } } elsif (/^s/) { $_ = $'; &save; } elsif (/^r/) { $_ = $'; &reply; } elsif (/^f/) { $_ = $'; &forward; } elsif ($_ eq 'd') { $status[$m] = 'D'; } elsif (/^d/) { $_ = $'; &process_delete(0); } elsif (/^u/) { $_ = $'; &process_delete(1); } elsif (/^(\d+)$/) { if ($1 < 1 || $1 > $#msg) { print "Bad message number: $1\n"; } else { $m = $1; &print_message; } } elsif (!$_) { if ($m == $#msg && $status[$m] ne 'U' && $status[$m] ne 'N') { print "No more messages.\n"; } else { if ($status[$m] eq ' ' || $status[$m] eq 'D') { ++$m; } &print_message; } } else { &mail_help; } print $main'S "ter 0,1\n"; #' Let the server know we're still here &main'suck; $_ = &main'line_prompt("($m/$#msg):"); #' s/ +$//; s/^ +//; } $_ eq 'q'; } sub mail_help { print <<'EOF'; Commands are: {} print message h {} print the list of headers {starting at } r {} reply to message {} f {} forward message {} to f {} follow up announcement {} s {} save message {} to a file called d {} delete {} u {} undelete {} z next screen of headers Z previous screen of headers q quit and save changes x quit without saving changes Arguments shown in {} brackets are optional. Default {} and {} is current message. may also be any of the following: message number - messages through ... messages , , ..., and p all Production Reports b all BULLETINS t all telegrams * all messages The meanings of the message markers are: N new U unread r replied to D deleted EOF } $main'functionmap{'tele'}="&mail'tele"; $main'functionmap{'anno'}="&mail'tele"; sub tele { if ($main'command eq "anno") { $filename = "tmp.anno.file"; &post_it("announce\n", "announcement"); } elsif ($main'command eq "tele") { $filename = "tmp.tele.file"; &post_it("tele $main'commandarg\n", "telegram to \"$main'commandarg\""); } else { print "Bad call to &tele.\n"; } } #*# Warning this function is duplicated in tools.pl (for speed reasons) package main; sub mail'getline { $mode = -1; $_ = &sock'S_read($S, $TIMEOUT); #' return 0 if $status; ($mode, $_)=/^\s*(\S+) (.+)*$/; if(defined($parsemap{$command})) { eval('&'.$game."'".$parsemap{$command}); #' } if ($mode eq $C_FLUSH || $mode eq $C_PROMPT) { return 0; } if ($mode ne $C_DATA) { # $mode = $C_DATA; $_ = "$mode $_"; &parse_serverline; } $mail'_ = $_; return 1; } $mail_loaded = 1; pei/parse.pl000644 002123 000322 00000157033 06034435206 014525 0ustar00childrenpstaff000000 2516260 #!/usr/local/bin/perl # $Id: parse.pl,v 2.3 1995/07/08 11:02:14 children Beta $ # Perl Empire Interface Parser # # Written by Drake Diedrich and Sam Tetherow # # # DESCRIPTION: # This module parses Empire data and stores it in variables. # # INSTALLATION: # You do not need to do anything to install parse.pl. It will be automatically # included into pei when you connect to a game. Just make sure that it # is in the same directory as pei when pei is run. Or you can put parse.pl # in the directory ~/perl and add the following line to your ~/.login file: # setenv PERLLIB ~/perl # # AUTHORS: # Written by Drake Diedrich. # Modified to use packages by Ken Stevens. # Completely rewritten by Sam Tetherow. # # BUG REPORTS: # mail your bug-reports and comments to: # tetherow@nol.org (Sam Tetherow) # --- Global variables --- # # Game related variables: # $etu Number of Empire Time Units per update # $obrate Civilian babies born per ETU per civilian # $eatrate Food eaten per person per ETU # $babyeat Food eaten per baby at the update # $uwbrate uw babies born per ETU per uw # $milcost Cost per active military per ETU # $reservecost Cost per reserve per ETU # $easytech Tech up to this amount is not reduced # $logtech Log base factored into tech above easytech # $secmob Monility gained in a sector at the update # $maxshipmob Ship mobility gained at the update # $planemob Plane mobility gained at the update # $unitmob Unit mobility gained at the update # $seceff Maximum sector efficiency gained at the update # $maxshipeff Maximum ship efficiency gained at the update # $planeeff Maximum plane efficiency gained at the update # $uniteff Maximum unit efficiency gained at the update # $width Width of the world # $height Height of the world # $maxnumcountries Maximum number of countries # %option Array of options # # Country related variables: # $budget Estimated treasury after the next update # $estimated_delta Change in the treasury at the next update # %relation Array of relations # $coun Number of player country # %country Array of country names # %number Array of country numbers # $cap Location of player capitol # %realm List of realms # $reserves Number of reserves # %money Current treasury # %edu Array of education levels # %hap Array of happiness levels # %tech Array of technology levels # %res Array of research levels # %status Array of country statuses # $maxciv Maximum number of civs that can reproduce/sector # $maxuw Maximum number of uws that can reproduce/sector # $maxpop Maximum number of people of each class/sector # # Sector related variables: # %newdes Sector designation after the next update # %neweff Sector efficiency after the next update # %mine Array of mines in a sector. # %defense_strength Defensive strength of a sector # %bdes Sector designations # %dump Values by sector and header field # %own Array of sector ownership # %oldown Original owners of sectors\n"; # %radar_center Array of radar stations # %radar_range Array of radar station ranges # %wkfc Workforce per sector # %will Amount of product produced by sectors # %make Product produced by sectors # %prodmax Maximum production by sectors # %use1 Amount of material used by sectors # %comm1 Type of material used by sectors # %max1 Amount of material that could be used by sectors # %use2 Amount of material used by sectors # %comm2 Type of material used by sectors # %max2 Amount of material that could be used by sectors # %use3 Amount of material used by sectors # %comm3 Type of material used by sectors # %max3 Amount of material that could be used by sectors # %sectype sector types # %movcost movment cost through sector # %secoff sector offensive multiplier # %secdef sector defensive multiplier # $bridgetech Minimum technology level to build a bridge # $bridgehcm hcm necessary to build a brige # $bridgeworkers number of civs+uws to build a bridge # $bridgeavail available work necessary to build a bridge # $bridgecost cost to build a bridge # # Plane, Unit, and Ship related variables: # %buildmil mil required to build item # %buildlcm lcm required to build item # %buildhcm hcm required to build item # %buildgun guns required to build unit # %buildshell shells required to build unit # %buildavail avail required to build unit # %buildcost cost to build unit # %buildtech tech required to build unit # %fuelcar fuel capacity of unit # %fueluse fuel use (per 10 mob) of unit # %capability capabilities of item # %cargo cargo capacities by item and commodity # # Planes: # %planename types of planes # %planesect locations of planes # %planewing wing assignments of planes # %planeeff plane efficiencies # %planemob mobility of planes # %planetech tech level planes were constructed at # %planehard amounts planes have been hardened # %planesln ship, land unit, or nuke carrying or carried by plane # %planeacc bombing accuracy # %planeload plane cargo limits # %planeatt plane attack values # %planedef plane defense values # %planeran plane ranges # %planefuel fuel used by planes # %planestlth likelyhood of avoiding detection # # Ships: # %shipflt fleets ships are in # %shipeff efficiencies of ships # %shipcargo commodities carried by ships # %shipmob mobility of ships # %shipfuel fuel aboard ships # %shiptech technology ships were constructed at # %shipdef armor rating of ship type # %shipspd speed of ship type # %visibility visibility og ship type # %shipspy spy range of ship type # %shipfrg double the basic firing range of ship type # %shiplnd units carried by ships # %shippln planes carried by ships # %shiphel helicopters carried by ships # %shipxpl sams carried by ships # %shipname Ship types # %shipsect Location of ships # %shipown Owners of ships # # Units: # %unitname type of each unit # %unitown owners of units # %unitsect locations of units # %unitnear approximate locations of units (if unknown) # %unitarmy armies units are in # %uniteff efficiencies of units # %unitfort fortifications of units # %unitmob mobility of units # %unitcargo cargo carried by units # %unitfuel fuel aboard units # %unittech technology level unit was constructed at # %unitretr retreat below these efficiencies # %unitrad unit reaction radii # %unitxpl sams carried by units # %unitatt unit attack multipliers # %unitdef unit defensive multipliers # %unitvul unit vulnerability to shelling # %unitspd unit speed # %visibility unit visibility # %unitspy unit spy range # %unitrad unit reaction radius # %unitfrg twice basic unit firing range # %unitacc unit shelling accuracy # %unitdam basic damage unit causes from shelling # %unitamm shells unit uses when firing # %unitaaf flak guns fired by unit # %unitxpl sam capacity of unit if (!$main'parse_loaded) { package main; %month=('Jan', 1, 'Feb', 2, 'Mar', 3, 'Apr', 4, 'May', 5, 'Jun', 6, 'Jul', 7, 'Aug', 8, 'Sep', 9, 'Oct', 10, 'Nov', 11, 'Dec', 12); %monthname=(0, 'Jan', 1, 'Feb', 2, 'Mar', 3, 'Apr', 4, 'May', 5, 'Jun', 6, 'Jul', 7, 'Aug', 8, 'Sep', 9, 'Oct', 10, 'Nov', 11, 'Dec'); %sectype=('gold mine','g', 'highway','+', 'airfield','*', 'warehouse','w', 'mine','m', 'bridge span','=', 'capitol','c', 'mountain','^', 'radar installation',')', 'light manufacturing','j', 'harbor','h', 'enlistment center','e', 'bank','b', 'refinery','%', 'park','p', 'headquarters','!', 'heavy manufacturing','k', 'agribusiness','a', 'technical center','t', 'research lab','r', 'defense plant','d', 'library/school','l', 'shell industry','i', 'wilderness','-', 'oil field','o', 'fortress','f', 'nuclear plant','n', 'sanctuary','s', 'wasteland','\\', 'uranium mine','u', 'bridge head','#'); sub add_parsemap { local ($command, $len, $subroutine) = @_; local ($i); for ($i = $len; $i <= length($command); ++$i) { $parsemap{substr($command, 0, $i)} = $subroutine; } } } if (!$main'parse_loaded) { package main; &add_parsemap('change', 2, 'parse_change'); &add_parsemap('version', 1, 'parse_version'); &add_parsemap('nation',3,'parse_nation'); &add_parsemap('budget',3,'parse_budget'); &add_parsemap('relations',3,'parse_relations'); &add_parsemap('realm',4,'parse_realm'); &add_parsemap('report',3,'parse_report'); &add_parsemap('power',3,'parse_power'); &add_parsemap('country',3,'parse_country'); &add_parsemap('read',4,'parse_read'); $parsemap{'show sect stats'}='parse_sector_stats'; $parsemap{'show sect build'}='parse_sector_build'; &add_parsemap('neweff',4,'parse_neweff'); &add_parsemap('product',2,'parse_product'); &add_parsemap('radar',3,'parse_radar'); &add_parsemap('navigate',3,'parse_look'); &add_parsemap('march',3,'parse_look'); &add_parsemap('lookout',3,'parse_look'); &add_parsemap('llookout',4,'parse_look'); &add_parsemap('sonar',3,'parse_look'); &add_parsemap('spy',2,'parse_spy_report'); &add_parsemap('recon',3,'parse_spy_plane'); &add_parsemap('bomb',3,'parse_spy_plane'); &add_parsemap('fly',3,'parse_spy_plane'); &add_parsemap('paradrop',4,'parse_spy_plane'); &add_parsemap('drop',3,'parse_spy_plane'); &add_parsemap('satellite',3,'parse_satellite'); &add_parsemap('dump',2,'parse_dump'); &add_parsemap('level',3,'parse_level'); &add_parsemap('map',2,'parse_map'); &add_parsemap('bmap',2,'parse_map'); &add_parsemap('attack',2,'parse_attack'); &add_parsemap('census',2,'parse_census'); &add_parsemap('resource',3,'parse_resource'); &add_parsemap('move',3,'parse_move'); &add_parsemap('explore',3,'parse_explore'); &add_parsemap('info',1,'parse_show'); &add_parsemap('show',4,'parse_show'); $parsemap{'show plane build'}='parse_plane_build'; $parsemap{'show plane stats'}='parse_plane_stats'; $parsemap{'show capabilities'}='parse_capabilities'; &add_parsemap('plane',2,'parse_plane'); $parsemap{"mission"} = "parse_mission"; &add_parsemap('mission',3,'parse_mission'); &add_parsemap('build',3,'parse_build'); $parsemap{'show ship build'}='parse_ship_build'; $parsemap{'show ship stats'}='parse_ship_stats'; &add_parsemap('coastwatch',3,'parse_look'); &add_parsemap('ship',3,'parse_ship'); &add_parsemap('cargo',3,'parse_cargo'); $parsemap{'show land build'}='parse_land_build'; $parsemap{'show land stats'}='parse_land_stats'; &add_parsemap('land',3,'parse_land'); &add_parsemap('unit',3,'parse_land'); &add_parsemap('lcargo',3,'parse_cargo'); } sub parse_change { if (/^Country \#(\d+) is already called/) { $coun = $1; } } sub parse_version { if (/An update consists of (\d+) empire time units/) { $etu=$1; return; } if (/1000 civilians will give birth to ([\d\.]+) babies per etu./) { $obrate = $1 / 1000.0; return; } if (/In one time unit, 1000 people eat ([\d\.]+) units of food./) { $eatrate = $1 / 1000.0; return; } if (/1000 babies eat ([\d\.]+) units of food becoming adults./) { $babyeat = $1 / 1000.0; return; } if (/1000 uncompensated workers will give birth to ([\d\.]+) babies./) { $uwbrate = $1 / 1000.0; return; } if (/1000 active military cost \$([\d.]+)\,/) { $milcost=$1 / 1000.0; return; } if (/reserves cost \$([\d.]+)\.$/) { $reservecost=$1/1000.0; return; } if (/Tech Buildup is limited to logarithmic growth \(base (.+)\) after (.+)\./) { $easytech = $2; $logtech = $1; return; } if (/Nation levels \(tech etc.\) decline (\d+)% every (\d+) time units./) { $level_decay_rate = $1 * $etu / $2 / 100.0; } if (/Max mob gain per update\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) { if ($1>0) { $secmob = $1; } if ($2>0) { $maxshipmob = $2; } if ($3>0) { $planemob = $3;} if ($4>0) { $unitmob = $4; } return; } if (/Max eff gain per update\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)/) { if ($1 > 0) { $seceff = $1; } if ($2 > 0) { $maxshipeff = $2; } if ($3 > 0) { $planeeff = $3; } if ($4 > 0) { $uniteff = $4; } return; } if (/World size is (\d+) by (\d+)\./) { $width = $1; $height = $2; return; } if (/There can be up to (\d+) countries\./) { $maxnumcountries = $1; return; } if (/Options enabled in this game:/) { $options=1; return; } if ($options==1) { @F = split(/\,/, $_); $options=0 if ($#F<1); for ($i=0;$i<=$#F;$i++) { $F[$i]=~s/\s+//go; $option{$F[$i]}=""; } } } sub parse_show { if (/sector type\s+mcost\s+off\s+def/) { $main'command='show sect stats'; } elsif (/^\s*sector type\s+cost to des/) { $main'command='show sect build'; } elsif (/^\s+lcm hcm avail tech \$$/) { $main'command='show ship build'; } elsif (/ *def d s y g r d n l l/) { $main'command='show ship stats'; } elsif (/ *cargos & capabilities/) { $main'command='show capabilities'; } elsif (/ *lcm hcm mil guns shells avail tech \$/) { $main'command='show land build'; } elsif (/^ *capabilities$/) { $main'command='show capabilities'; } elsif (/ *att def vul d s y d g c m m f c u l/) { $main'command='show land stats'; } elsif (/ *lcm hcm crew avail tech \$$/) { $main'command='show plane build'; } elsif (/ *acc load att def ran fuel stlth/) { $main'command='show plane stats'; } elsif (/^Bridges require (\d+) tech, (\d+) hcm, (\d+) workers,/) { $bridgetech=$1; $bridgehcm=$2; $bridgeworkers=$3; } elsif (/^(\d+) available workforce, and cost \$(\d+)/) { $bridgeavail=$1; $bridgecost=$2; } } sub parse_budget { if (/New treasury:\s+(\d+)/) { $budget = $1; } elsif (/Estimated Delta:\s+(\d+)/) { $estimated_delta = $1; } } sub parse_neweff { if (/(\S+,\S+)\s+(\S) +(\d+)\%$/) { $newdes{$1}=$2; $neweff{$1}=$3; } } sub parse_product { if (/PRODUCTION SIMULATION/) { # undef old values we can't rely on them undef %wkfc; undef %will; undef %make; undef %prodmax; undef %use1; undef %use2; undef %use3; undef %max1; undef %max2; undef %max3; undef %comm1; undef %comm2; undef %comm3; } elsif (/^\s*(\S+,\S+)\s+(\S)\s+\d+\%\s+(\d+)\s+(\S+)\s+(\S+)\s+\S+\s+\$\d+\s+(\S+)$/) { $newdes{$1}=$2; $wkfc{$1}=$3; $will{$1}=$4; $make{$1}=$5; $prodmax{$1}=$6; } elsif (/^\s*(\S+,\S+)\s+(\S)\s+\d+\%\s+(\d+)\s+(\S+)\s+(\S+)\s+\S+\s+\$\d+\s+(\d+)([a-z])\s+(\d+)[a-z]\s+(\S+)$/) { $newdes{$1}=$2; $wkfc{$1}=$3; $will{$1}=$4; $make{$1}=$5; $use1{$1}=$6; $comm1{$1}=$commstr{$7}; $max1{$1}=$8; $prodmax{$1}=$9; } elsif (/^\s*(\S+,\S+)\s+(\S)\s+\d+\%\s+(\d+)\s+(\S+)\s+(\S+)\s+\S+\s+\$\d+\s+(\d+)([a-z])\s+(\d+)([a-z])\s+(\d+)[a-z]\s+(\d+)[a-z]\s+(\S+)$/) { $newdes{$1}=$2; $wkfc{$1}=$3; $will{$1}=$4; $make{$1}=$5; $use1{$1}=$6; $comm1{$1}=$commstr{$7}; $use2{$1}=$8; $comm2{$1}=$commstr{$9}; $max1{$1}=$10; $max2{$1}=$11; $prodmax{$1}=$12; } elsif (/^\s*(\S+,\S+)\s+(\S)\s+\d+\%\s+(\d+)\s+(\S+)\s+(\S+)\s+\S+\s+\$\d+\s+(\d+)([a-z])\s+(\d+)([a-z])\s+(\d+)([a-z])\s+(\d+)[a-z]\s+(\d+)[a-z]\s+(\d+)[a-z]\s+(\S+)$/) { $newdes{$1}=$2; $wkfc{$1}=$3; $will{$1}=$4; $make{$1}=$5; $use1{$1}=$6; $comm1{$1}=$commstr{$7}; $use2{$1}=$8; $comm2{$1}=$commstr{$9}; $use3{$1}=$10; $comm3{$1}=$commstr{$11}; $max1{$1}=$12; $max2{$1}=$13; $max3{$1}=$14; $prodmax{$1}=$15; } if ($make{$1} eq 'petro') { $make{$1}='pet'; } if ($make{$1} eq 'bars') { $make{$1}='bar'; } if ($make{$1} eq 'guns') { $make{$1}='gun'; } } sub parse_nation { if (/\(\#(\d+)\)\s+(.+) Nation Report/) { $coun = $1; $country{$coun} = $2; $number{$2} = $coun; $new_server = 1; } elsif (/\s*(.+) Nation Report/) { if (defined $number{$1}) { $coun = $number{$1}; } if (defined $coun) { $country{$coun} = $1; $number{$1} = $coun; } } elsif (/^#\s*(\d+)\s+(\S+)\s+#\s*(\d+)\s+(\S+)\s+#\s*(\d+)\s+(\S+)\s*/) { $realm{$1}=$2; $realm{$3}=$4; $realm{$5}=$6; } elsif (/.* eff(| mountain) capit[oa]l at (\S+)/) { $cap = $2; } elsif (/No capit[oa]l\./) { $cap = ''; } elsif (/The treasury has \$(\d+)\.00\s+Military reserves:\s+(\d+)/) { if (defined $coun) { $money{$coun} = $1;} $reserves = $2; } elsif (/Education\.*\s+(.+) * Happiness\.* (.+)/) { if (defined $coun) { $edu{$coun} = $1; $hap{$coun} = $2; } } elsif (/Technology\.* *(.+) * Research\.*(.+)/) { if (defined $coun) { $tech{$coun} = $1; $res{$coun} = $2; } } elsif (/Technology factor : (.+)%\s+Plague factor/) { $techfactor = $1; } elsif (/^Max population : (\d+)/) { $maxpop=$1; } elsif (/^Max safe population for civs\/uws: (\d+)\/(\d+)$/) { $maxciv=$1; $maxuw=$2; } elsif (/^Nation status is (\S+)\s/) { $nstatus = $1; } } sub parse_radar { # Maybe add in map updating here (replace . with ? or ? with 'sectype') if (/(\S+,\S+) efficiency ([0-9]+)%, max range ([0-9]+)/) { $radar_center{$1} = $1; $radar_range{$1} = $3; } } sub parse_realm { if (/^Realm \#(\d{0,2}) is (\S+)$/) { $realm{$1} = $2; } } sub parse_payoff { } sub parse_orders { } sub parse_relations { if (/(.*) Diplomatic Relations Report/) { $last_relation_name=$1; } elsif (/^\s*([0-9]+)\) (.*\S)\s+(Neutral|At War|Hostile|Mobilizing|Sitzkrieg|Allied)\s+(Neutral|At War|Hostile|Mobilizing|Sitzkrieg|Allied)/) { $number{$2} = $1; $country{$1} = $2; $relation{$2,$last_relation_name} = $3; $relation{$last_relation_name,$2} = $4; } } sub parse_report { if (/^\s*(\d+)\s+(.+)\s+(> \d+|\d+ - \d+)\s+\s+(> \d+|\d+ - \d+)\s+(> \d+|\d+ - \d+)\s+(> \d+|\d+ - \d+)\s+(.+)\s*$/) { $country{$1}=$2; $number{$2}=$1; $tech{$1}=$3; $res{$1}=$4; $edu{$1}=$5; $hap{$1}=$6; $status{$1}=$7; } elsif (/^\s*(\d+)\s+(.+)\s+(backward|similar|primitive|advanced|superior)\s+(primitive|backward|similar|advanced|superior)\s+(primitive|backward|similar|advanced|superior)\s+(.+)\s*$/) { $country{$1}=$2; $number{$2}=$1; $tech{$1}=$3; $res{$1}=$4; $edu{$1}=$5; $status{$1}=$6; } } sub parse_power { $number{'worldwide'}=0; if (/^\s*(.+)\s+(\d+)\s+(\d+)%\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*$/) { local($name, $sect, $eff, $civ, $mil, $shell, $gun, $pet, $iron, $dust, $oil, $plane, $ship, $unit, $money)=($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14, $15); $name=~s/^\s*//; $name=~s/\s*$//; $num=$number{$name}; $sects{$num}=&todec($sect); $eff{$num}=&todec($eff); $civ{$num}=&todec($civ); $mil{$num}=&todec($mil); $shell{$num}=&todec($shell); $gun{$num}=&todec($gun); $petrol{$num}=&todec($pet); $iron{$num}=&todec($iron); $dust{$num}=&todec($dust); $oil{$num}=&todec($oil); $plane{$num}=&todec($plane); $ship{$num}=&todec($ship); $unit{$num}=&todec($unit); $money{$num}=&todec($money); } } sub parse_country { if (/\s*(\d+)\s+.+\s+DEITY\s+(\S.*)\s*$/) { $number{$2}=$1; $country{$1}=$2; $deity{$1}=$2; } } sub parse_look { ## mine detection from nuke sub 2s needs to be added (and the auto-des of the ## bmap accordingly. Also need to add this into parse_nav. if (/^Your (.+) (\d+)% efficient (.*)\s*@ (\S+,\S+)\s*/) { local($contents, $sect)=($3, $4); $own{$sect}=$coun; $dump{$sect, "eff"}=$2; $dump{$sect, "des"}=$main'sectype{$1}; if ($contents=~/with (\d+) civ/) { $dump{$sect, "civ"}=$1; } if ($contents=~/with (\d+) mil/) { $dump{$sect, "mil"}=$1; } } elsif (/^(.+)\s+\(#(\d+)\) (.+) (\d+)% efficient (.*)\s*@ (\S+,\S+)\s*/) { local($sect, $contents)=($6, $5); $country{$2}=$1; $number{$1}=$2; $own{$6}=$2; $dump{$sect, "eff"}=$4; $dump{$sect, "des"}=$main'sectype{$3}; if ($contents=~/with approx (\d+) civ/) { $dump{$sect, "civ"}=$1+1; } if ($contents=~/with approx (\d+) mil/) { $dump{$sect, "mil"}=$1+1; } local(@tmp)=localtime; $dump{$sect, 'date'}="$tmp[4]/$tmp[3] $tmp[2]:$tmp[1]"; } elsif (/^\s*(.+)\s+\(#\s*(\d+)\)\s+(\S+\D*\d*)\s+#(\d+)\s+@\s*(\S+,\S+)\s*/) { $country{$2}=$1; $number{$1}=$2; if ($shipname{$3}) { $shipname{$4}=$3; $shipsect{$4}=$5; $shipown{$4}=$2; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $shipdate{$4}="$mon/$mday $hour:$min"; } elsif ($unitname{$3}) { $unitname{$4}=$3; $unitsect{$4}=$5; $unitown{$4}=$2; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $unitdate{$4}="$mon/$mday $hour:$min"; } } } sub parse_spy_plane { if (/^Your (.+) (\d+)% efficient (.*)\s*@ (\S+,\S+)\s*/) { local($contents, $sect)=($3, $4); $own{$sect}=$coun; $dump{$sect, "eff"}=$2; $dump{$sect, "des"}=$main'sectype{$1}; if ($contents=~/with (\d+) civ/) { $dump{$sect, "civ"}=$1; } if ($contents=~/with (\d+) mil/) { $dump{$sect, "mil"}=$1; } } elsif (/^(.+)\s+\(#(\d+)\) (.+) (\d+)% efficient (.*)\s*@ (\S+,\S+)\s*/) { local($sect, $contents)=($6, $5); $country{$2}=$1; $number{$1}=$2; $own{$6}=$2; $dump{$sect, "eff"}=$4; $dump{$sect, "des"}=$main'sectype{$3}; if ($contents=~/with approx (\d+) civ/) { $dump{$sect, "civ"}=$1+1; } if ($contents=~/with approx (\d+) mil/) { $dump{$sect, "mil"}=$1+1; } local(@tmp)=localtime; $dump{$sect, 'date'}="$tmp[4]/$tmp[3] $tmp[2]:$tmp[1]"; } elsif (/\s*(\S+,\S+)\s+(\S)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { $own{$1}=$3; $dump{$1,"des"}=$2; $dump{$1,"eff"}=$4; $dump{$1,"civ"}=$5; $dump{$1,"mil"}=$6; $dump{$1,"shell"}=$7; $dump{$1,"gun"}=$8; $dump{$1,"iron"}=$9; $dump{$1,"pet"}=$10; $dump{$1,"food"}=$11; local(@tmp)=localtime; $dump{$1, 'date'}="$tmp[4]/$tmp[3] $tmp[2]:$tmp[1]"; } elsif (/flying over\s+(.+)\s+at\s+(\S+,\S+)/) { $bmap{$2}=$main'sectype{$1}; $last_overfly_sect=$2; } elsif (/^\s*(\d+)\s+(\d+)\s+(\S+\D*\d*)\s+(\S+,\S+)\s+(\d+)%\s*$/) { local($own, $unit, $type, $sect, $eff)=($1, $2, $3, $4, $5); $type=~s/\s*$//; if ($unitname{$type}) { $unitname{$unit}=$type; $unitown{$unit}=$own; $unitsect{$unit}=$sect; $uniteff{$unit}=$eff; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $unitdate{$unit}="$mon/$mday $hour:$min"; } elsif ($shipname{$type}) { $shipname{$unit}=$type; $shipown{$unit}=$own; $shipsect{$unit}=$sect; $shipeff{$unit}=$eff; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $shipdate{$unit}="$mon/$mday $hour:$min"; } } elsif (/\s*\(#\s*(\d+)\)\s+(.+)\s+(minimally|partially|moderately|completely)\s+(\S+\D*\d*)\s*$/) { local($unit, $countryname, $eff, $type)=($1, $2, $3, $4); $countryname=~s/\s*$//; $type=~s/\s*$//; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; if ($unitname{$type}) { $uniteff{$unit}=25 if $eff eq 'minimally'; $uniteff{$unit}=50 if $eff eq 'partially'; $uniteff{$unit}=75 if $eff eq 'moderately'; $uniteff{$unit}=100 if $eff eq 'completely'; $unitown{$unit}=$number{$countryname}; $unitsect{$unit}=$last_overfly_sect; $unitname{$unit}=$type; $unitdate{$unit}="$mon/$mday $hour:$min"; } elsif ($planename{substr($type,0,19)}) { $planeeff{$unit}=25 if $eff eq 'minimally'; $planeeff{$unit}=50 if $eff eq 'partially'; $planeeff{$unit}=75 if $eff eq 'moderately'; $planeeff{$unit}=100 if $eff eq 'completely'; $planeown{$unit}=$number{$countryname}; $planesect{$unit}=$last_overfly_sect; $planename{$unit}=substr($type,0,19); $planedate{$unit}="$mon/$mday $hour:$min"; } elsif ($shipname{$type}) { $shipeff{$unit}=25 if $eff eq 'minimally'; $shipeff{$unit}=50 if $eff eq 'partially'; $shipeff{$unit}=75 if $eff eq 'moderately'; $shipeff{$unit}=100 if $eff eq 'completely'; $shipown{$unit}=$number{$countryname}; $shipsect{$unit}=$last_overfly_sect; $shipname{$unit}=$type; $shipdate{$unit}="$mon/$mday $hour:$min"; } } } sub parse_spy_report { if (/\s*(\S+,\S+)\s+(\S)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { $own{$1}=$3; $dump{$1,"des"}=$2; $dump{$1,"eff"}=$4; $dump{$1,"civ"}=$5; $dump{$1,"mil"}=$6; $dump{$1,"shell"}=$7; $dump{$1,"gun"}=$8; $dump{$1,"iron"}=$9; $dump{$1,"pet"}=$10; $dump{$1,"food"}=$11; local(@tmp)=localtime; $dump{$1, 'date'}="$tmp[4]/$tmp[3] $tmp[2]:$tmp[1]"; } elsif (/$Spies report .+ unit in (\S+,\S+): (.+) #(\d+) (.*)/) { $unitown{$3}=$own{$1}; $unitsect{$3}=$1; $unitname{$3}=$2; local($unit, $rest)=($3, $4); if ($rest=~/efficiency (\d+)[,\)]/) { $uniteff{$unit}=$1; } if ($rest=~/tech (\d+)\)/) { $unittech{$unit}=$1; } local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $unitdate{$unit}="$mon/$mday $hour:$min"; } } sub parse_satellite { if (/\s*(\S+,\S+)\s+(\S)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { $own{$1}=$3; $dump{$1,"des"}=$2; $dump{$1,"eff"}=$4; $dump{$1,"civ"}=$5; $dump{$1,"mil"}=$6; $dump{$1,"shell"}=$7; $dump{$1,"gun"}=$8; $dump{$1,"iron"}=$9; $dump{$1,"pet"}=$10; $dump{$1,"food"}=$11; local(@tmp)=localtime; $dump{$1, 'date'}="$tmp[4]/$tmp[3] $tmp[2]:$tmp[1]"; } elsif (/^\s*(\d+)\s+(\d+)\s+(\S+\D*\d*)\s+(\S+,\S+)\s+(\d+)%\s*$/) { local($own, $unit, $type, $sect, $eff)=($1, $2, $3, $4, $5); $type=~s/\s*$//; if ($unitname{$type}) { $unitname{$unit}=$type; $unitown{$unit}=$own; $unitsect{$unit}=$sect; $uniteff{$unit}=$eff; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $unitdate{$unit}="$mon/$mday $hour:$min"; } elsif ($shipname{$type}) { $shipname{$unit}=$type; $shipown{$unit}=$own; $shipsect{$unit}=$sect; $shipeff{$unit}=$eff; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $shipdate{$unit}="$mon/$mday $hour:$min"; } } } sub parse_dump { local($i,@F,$x,$y); if (/x y des sdes/) { @header = split(/[ \n]+/, $_); for ($i=0;$i<=$#header;$i++) { if ($header[$i] eq 'x') { $xpos=$i; $ypos=$i + 1; last; } } } else { @F = split(/[ \n]+/, $_); if ($#header != $#F) { if ($#header>0) { undef @header; undef $xpos; undef $ypos; } return; } $x = $F[$xpos]; $y = $F[$ypos]; for ($i=0;$i<=$#F;$i++) { $dump{$x,$y,$header[$i]} = $F[$i]; } ## Isn't this a bit backwards? Shouldn't we be check for defined own for oldown ## before setting it to 0 if ($dump{$x,$y,'*'} eq '*') { $oldown{$x,$y} = 0; } elsif (defined $dump{$x,$y,'own'}) { $oldown{$x,$y} = $dump{$x,$y, 'own'}; } else { $oldown{$x,$y} = $coun; } $own{$x,$y} = $coun; } } sub parse_level { if (/^\s*(\S+,\S+)\s+(\S)\s+(\S+),(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { $dump{$1, 'des'}=$2; $dump{$1, 'dist_x'}=$3; $dump{$1, 'dist_y'}=$4; $dump{$1, 'c_dist'}=$5; $dump{$1, 'm_dist'}=$6; $dump{$1, 'u_dist'}=$7; $dump{$1, 'f_dist'}=$8; $dump{$1, 's_dist'}=$9; $dump{$1, 'g_dist'}=$10; $dump{$1, 'p_dist'}=$11; $dump{$1, 'i_dist'}=$12; $dump{$1, 'd_dist'}=$13; $dump{$1, 'b_dist'}=$14; $dump{$1, 'o_dist'}=$15; $dump{$1, 'l_dist'}=$16; $dump{$1, 'h_dist'}=$17; $dump{$1, 'r_dist'}=$18; $dump{$1, 'own'}=$main'coun; $own{$1}=$main'coun; } } sub parse_ship_build { if (/^(\S+\D*\d*) +(\d+) +(\d+) +(\d+) +(\d+) \$(\d+)$/) { local($lcm, $hcm, $avail, $tech, $cost)=($2, $3, $4, $5, $6); local($type)=$1; $type=~s/\s*$//; $type = substr($type,0,16) if length $type > 16; $shipname{$type}=$type; $buildlcm{$type}=$lcm; $buildhcm{$type}=$hcm; $buildavail{$type}=$avail; $buildtech{$type}=$tech; $buildcost{$type}=$cost; } } sub parse_capabilities { local (@F,$name,$tmp); if (/^(\S+( {1,2}\S+)*) +/) { $name=$1; @F=split(' ',$'); $capability{$name}=""; while ($tmp=pop(@F)) { if ($tmp =~ /(\d+)([a-z])/) { $cargo{$name,$commstr{$2}}=$1; } else { $capability{$name} .= " $tmp"; } } } } sub parse_ship_stats { if (/^(\S+\D*\d*) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+)\/(\d+)/) { local($def, $spd, $vis, $spy, $frg, $fir, $lnd, $pln, $hel, $xpl, $car, $use)=($2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13); local($type)=$1; $type=~s/\s*$//; $type = substr($type,0,16) if length $type > 16; $shipdef{$type} = $def; $shipspd{$type} = $spd; $visibility{$type} = $vis; $shipspy{$type} = $spy; $shipfrg{$type} = $frg; $shipfir{$type} = $fir; $shiplnd{$type} = $lnd; $shippln{$type} = $pln; $shiphel{$type} = $hel; $shipxpl{$type} = $xpl; $fuelcar{$type} = $car; $fueluse{$type} = $use; } } sub parse_land_stats { if (/^(\S+\D*\d*) +([\d\.]+) +([\d\.]+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+)/) { local($att, $def, $vul, $spd, $vis, $spy, $rad, $frg, $acc, $dam, $amm, $aaf, $car, $use, $xpl)=($2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12, $13, $14, $15, $16); local($type)=$1; $type=~s/\s*$//; $unitatt{$type} = $att; $unitdef{$type} = $def; $unitvul{$type} = $vul; $unitspd{$type} = $spd; $visibility{$type} = $vis; $unitspy{$type} = $spy; $unitrad{$type} = $rad; $unitfrg{$type} = $frg; $unitacc{$type} = $acc; $unitdam{$type} = $dam; $unitamm{$type} = $amm; $unitaaf{$type} = $aaf; $fuelcar{$type} = $car; $fueluse{$type} = $use; $unitxpl{$type} = $xpl; } } sub parse_land_build { if (/^(\S+\D*\d*) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +\$(\d+)/) { local($lcm, $hcm, $mil, $gun, $shell, $avail, $tech, $cost)=($2, $3, $4, $5, $6, $7, $8, $9); local($type)=$1; $type=~s/\s*$//; $unitname{$type}=$type; $buildlcm{$type}=$lcm; $buildhcm{$type}=$hcm; $buildmil{$type}=$mil; $buildgun{$type}=$gun; $buildshell{$type}=$shell; $buildavail{$type}=$avail; $buildtech{$type}=$tech; $buildcost{$type}=$cost; } } sub parse_plane_build { if (/^\s*(\S+\D*\d*) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +\$(\d+)/){ local($lcm, $hcm, $mil, $avail, $tech, $cost)=($2, $3, $4, $5, $6, $7); local($pname)=$1; $pname=~s/\s*$//; local($type)=substr($pname,0,19); $type=~s/\s*$//; $planename{$type}=$pname; $buildlcm{$pname}=$lcm; $buildhcm{$pname}=$hcm; $buildmil{$pname}=$mil; $buildavail{$pname}=$avail; $buildtech{$pname}=$tech; $buildcost{$pname}=$cost; } } sub parse_plane_stats { if (/^(\S+\D*\d*) +([\d-]+) +([\d-]+) +([\d-]+) +([\d-]+) +([\d-]+) +([\d-]+) +(\d+)\%/) { local($acc, $load, $att, $def, $ran, $fuel, $stlth)=($1, $2, $3, $4, $5, $6, $7, $8); local($type)=$1; $type=~s/\s*$//; $planeacc{$type}=$acc; $planeload{$type}=$load; $planeatt{$type}=$att; $planedef{$type}=$def; $planeran{$type}=$ran; $planefuel{$type}=$fuel; $planestlth{$type}=$stlth; } } sub parse_land { if (/^ *(\d+) +(\S+\D*\d*) +(\S+,\S+) +(\S?) +(\d+)\% +(\d+) +(\S+) +(\d+) +(\d+) +(\d+) +(\d+)\% +(\d+) +(\d+) *(\d*)/) { $unitown{$1}=$coun; $unitsect{$1}=$3; $unitarmy{$1}=$4; $uniteff{$1}=$5; $unitfort{$1}=$6; $unitmob{$1}=$7; $unitcargo{$1,"food"}=$8; $unitfuel{$1}=$9; $unittech{$1}=$10; $unitretr{$1}=$11; $unitrad{$1}=$12; $unitxpl{$1}=$13; if (defined $14) { $unitship{$1}=$14; } local($unit)=$1; $unitname{$1}=$2; $unitname{$unit}=~s/\s*$//; } } sub parse_ship { if (/^ *(\d+) +(\S+\D*\d*) +(\S+,\S+) +(\S?) +(\d+)\% +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\S+) +(\d+) +(\d+)/) { $shipsect{$1}=$3; $shipflt{$1}=$4; $shipeff{$1}=$5; $shipcargo{$1,"civ"}=$6; $shipcargo{$1,"mil"}=$7; $shipcargo{$1,"uw"}=$8; $shipcargo{$1,"food"}=$9; $shippln{$1}=$10; $shiphel{$1}=$11; $shipxpl{$1}=$12; $shiplnd{$1}=$13; $shipmob{$1}=$14; $shipfuel{$1}=$15; $shiptech{$1}=$16; local($unit)=$1; $shipname{$1}=$2; $shipname{$unit}=~s/\s*$//; $shipown{$unit}=$main'coun; } } sub parse_cargo { if (/lnd#/) { $cargo_type=1; } # lcargo output else { $cargo_type=0; } # cargo output if (/^ *(\d+) +([a-z]+( \w+)*) +(\S+,\S+) +(\S?) +(\d+)\% +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+)/) { if ($cargo_type) { $unitname{$1}=$2; $unitsect{$1}=$4; $unitflt{$1}=$5; $uniteff{$1}=$6; $unitcargo{$1,"shell"}=$7; $unitcargo{$1,"gun"}=$8; $unitcargo{$1,"pet"}=$9; $unitcargo{$1,"iron"}=$10; $unitcargo{$1,"dust"}=$11; $unitcargo{$1,"bar"}=$12; $unitcargo{$1,"oil"}=$13; $unitcargo{$1,"lcm"}=$14; $unitcargo{$1,"hcm"}=$15; $unitcargo{$1,"rad"}=$16; } else { $shipname{$1}=$2; $shipsect{$1}=$4; $shipflt{$1}=$5; $shipeff{$1}=$6; $shipcargo{$1,"shell"}=$7; $shipcargo{$1,"gun"}=$8; $shipcargo{$1,"pet"}=$9; $shipcargo{$1,"iron"}=$10; $shipcargo{$1,"dust"}=$11; $shipcargo{$1,"bar"}=$12; $shipcargo{$1,"oil"}=$13; $shipcargo{$1,"lcm"}=$14; $shipcargo{$1,"hcm"}=$15; } } } sub parse_plane { # Empire2 if (/^\s*(\d+)\s+(\S+\D*\d*)\s+(\S+,\S+)\s+(\S?)\s+(\d+)\%\s+(\S+)\s+([\d-]+)\s+(\d+)\s+(\d+)\s+(\d+)\s*(.*)/ || # Chainsaw /^\s*(\d+)\s+(\S+\D*\d*)\s+(\S+,\S+)\s+(\S?)\s+(\d+)\%\s+(\S+)\s+(\S+)\s+[\d-]+\s+(\d+)\s+(\d+)\s+(\d+)\s*(.*)/) { local($unit, $sect, $wing, $eff, $mob, $att, $tech, $ran, $hard, $sln)=($1, $3, $4, $5, $6, $7, $8, $9, $10, $11); local($type)=substr($2,0,19); $type=~s/\s*$//; $planename{$unit}=$planename{$type}; $planesect{$unit}=$sect; $planewing{$unit}=$wing; $planeeff{$unit}=$eff; $planemob{$unit}=$mob; $planeatt{$unit}=$att; $planetech{$unit}=$tech; $planeran{$unit}=$ran; $planehard{$unit}=$hard; $planesln{$unit}=$sln; $planeown{$unit}=$main'coun; } } sub parse_mission { local($type, $unit, $sect, $missioninfo, $op, $rad, $mission); if (/\s*(\S+\D*\d*)\s+#(\d+)\s+(\S+,\S+)\s+(.*)$/) { $type=$1; $unit=$2; $sect=$3; $missioninfo=$4; $type=~s/\s*$//; if ($missioninfo=~/has no mission/) { $mission=''; $op=''; $rad=''; } elsif ($missioninfo=~/(\S+,\S+)\s+(\d+)\s+is on an* (\S+\s*\S*) mission/) { $op=$1; $rad=$2; $mission=substr($3,0,1); } if ($unitname{$unit} eq $type) { $unitsect{$unit}=$sect; $unitmission{$unit}=$mission; $unitopsect{$unit}=$op; $unitmissionradius{$unit}=$rad; } elsif ($shipname{$unit} eq $type) { $shipsect{$unit}=$sect; $shipmission{$unit}=$mission; $shipopsect{$unit}=$op; $shipmissionradius{$unit}=$rad; } elsif ($planename{$unit} eq substr($type,0,19)) { $planesect{$unit}=$sect; $planemission{$unit}=$mission; $planeopsect{$unit}=$op; $planemissionradius{$unit}=$rad; } } } sub parse_build { local($tech, $unit, $type, $sect); if (/building with tech level (\d+)\./) { $tech=$1; } elsif (/\s*(\S+\D*\d*) +#(\d+) +built in sector (\S+,\S+)/) { $type=$1; $unit=$2; $sect=$3; $type=~s/\s*$//; if ($planename{$type}) { $planename{$unit}=substr($type,0,19); $planename{$unit}=~s/\s*$//; $planesect{$unit}=$sect; $planewing{$unit}=''; $planeeff{$unit}=10; $planemob{$unit}=0; $planetech{$unit}=$tech; $planehard{$unit}=0; $planesln{$unit}=''; $dump{$sect, "avail"}-=$buildavail{$type}; $money{$coun}-=$buildcost{$type}*0.1; } elsif ($shipname{$type}) { $shipname{$unit}=$type; $shipsect{$unit}=$sect; $shipflt{$unit}=''; $shipeff{$unit}=20; $shipcargo{$unit, "civ"}=0; $shipcargo{$unit, "mil"}=0; $shipcargo{$unit, "uw"}=0; $shipcargo{$unit, "food"}=0; $shipcargo{$unit, "shell"}=0; $shipcargo{$unit, "gun"}=0; $shipcargo{$unit, "pet"}=0; $shipcargo{$unit, "iron"}=0; $shipcargo{$unit, "dust"}=0; $shipcargo{$unit, "bar"}=0; $shipcargo{$unit, "oil"}=0; $shipcargo{$unit, "lcm"}=0; $shipcargo{$unit, "hcm"}=0; $shipcargo{$unit, "rad"}=0; $shippln{$unit}=0; $shiphel{$unit}=0; $shipxpl{$unit}=0; $shiplnd{$unit}=0; $shipmob{$unit}=0; $shipfuel{$unit}=$fuelcar{$type}; $shiptech{$unit}=$tech; $dump{$sect, "avail"}-=$buildavail{$type}; } elsif ($unitname{$type}) { $unitname{$unit}=$type; $unitown{$unit}=$coun; $unitsect{$unit}=$sect; $unitarmy{$unit}=''; $uniteff{$unit}=10; $unitfort{$unit}=0; $unitmob{$unit}=0; $unitfuel{$unit}=$fuelcar{$type}; $unittech{$unit}=$tech; $unitxpl{$unit}=0; $unitship{$unit}=''; $dump{$sect, "avail"}-=$buildavail{$type}; $money{$coun}-=$buildcost{$type}*0.1; } } elsif (/Bridge span built over (\S+,\S+)\s*/) { $own{$1}=0; $dump{$1, "des"}='='; $dump{$1, "own"}=0; $dump{$1, "mil"}=0; $dump{$1, "civ"}=0; $dump{$1, "uw"}=0; $dump{$1, "gun"}=0; $dump{$1, "shell"}=0; $dump{$bridgesect, "avail"}-=$bridgeavail; $dump{$bridgesect, "hcm"}-=$bridgehcm; } elsif (/Bridge head at (\S+,\S+);/) { $bridgesect=$1; } elsif (/That just cost you \$(\d+\.\d+)\s*/) { $money{$coun}-=$1; } } sub parse_map { # Internal variables: # @H Header lines of the map. # %mapcol The x coordinates. # $mapheader Set to 1 if the header has already been read. # $maprow The current y coordinate. # $mappartial Contains the map data minus the y coordinate. local($x, $y, $digit); if ($mapheader==0) { if (/\s*\S+\s+\S+/) { $mapheader=1; for($x=0;$x$mapcol[$x+1]) { $mapcol[$x]*=-1; } } if ($mapcol[$#mapcol-1]<0 && $mapcol[$#mapcol]<(-1*$mapcol[$#mapcol-1])) { $mapcol[$#mapcol]*=-1; } undef @H; } else { undef @mapcol; push(@H, $_); $H[$#H]=~s/^\s*//; $H[$#H]=~s/\s*$//; } } if (/\s*(\S+) (.+) \S+\s*$/ && $mapheader==1) { $maprow=$1; $mappartial=$2; for($x=0; $x<=$#mapcol; $x++) { if (substr($mappartial, $x, 1) cmp ' ') { $bdes{"$mapcol[$x],$maprow"}=substr($mappartial, $x, 1); } } } else { $mapheader=0; } } sub parse_sector_stats { if (/(\S) (\S+( \S+)*) +(\d+) +(\d+) +(\d+)/) { $main'sectype{$2}=$1; $movcost{$1}=$4; $secoff{$1}=$5; $secdef{$1}=$6; } } sub parse_sector_build { if (/(\S)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { $descost{$1}=$2; $buildcost{$1}=$3; $buildlcm{$1}=$4; $buildhcm{$1}=$5; } } sub parse_attack { if (/(\S+,\S+) is a (\d+)% (.+) with approximately (\d+) military\.$/) { local($thiscoun, $eff, $mil)=($3, $2, $4); $last_attacked_sector=$1; local(@info)=split(/ /, $3); if ($main'sectype{$info[$#info]}) { local($type)=pop(@info); $dump{$last_attacked_sector, 'des'}=$main'sectype{$type}; } else { local($type)=pop(@info); $type=pop(@info) . " " . $type; $dump{$last_attacked_sector, 'des'}=$main'sectype{$type}; } $thiscoun=join(' ', @info); $own{$last_attacked_sector}=$number{$thiscoun}; if (!$own{$last_attacked_sector} || $own{$last_attacked_sector}==$coun) { $own{$last_attacked_sector} = -1; } $dump{$last_attacked_sector,"mil"} = $mil+1; $dump{$last_attacked_sector,"eff"} = $eff; local(@tmp)=localtime(); $dump{$last_attacked_sector, 'date'}="$tmp[4]/$tmp[3] $tmp[2]:$tmp[1]"; } elsif (/^\s*defender\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*/) { $def{$last_attacked_sector, 'fort'}=$1; $def{$last_attacked_sector, 'ship'}=$2; $def{$last_attacked_sector, 'land'}=$3; $def{$last_attacked_sector, 'plane'}=$4; } elsif (/^Final defender strength (\d+)/) { $defense_strength{$last_attacked_sector} = $1; } elsif (/^\S+\D*\d* #(\d+) occupies (\S+,\S+)\s*/) { $unitsect{$1}=$2; } elsif (/^Scouts sight new enemy unit: (\S+\D*\d*) #(\d+)(.*)/) { $unitname{$2}=$1; $unitown{$2}=$own{$last_attacked_sector}; $unitnear{$2}=$last_attacked_sector; local($unit, $rest)=($2, $3); if ($rest=~/efficiency (\d+)[\,\)]/) { $uniteff{$unit}=$1; } if ($rest=~/tech (\d+)\)/) { $unittech{$unit}=$1; } } elsif (/^Scouts report enemy unit: (\S+\D*\d*) #(\d+)(.*)/) { $unitname{$2}=$1; $unitown{$2}=$own{$last_attacked_sector}; $unitsect{$2}=$last_attacked_sector; local($unit, $rest)=($2, $3); if ($rest=~/efficiency (\d+)[\,\)]/) { $uniteff{$unit}=$1; } if ($rest=~/tech (\d+)\)/) { $unittech{$unit}=$1; } } elsif (/^\s*\S+\D*\d* #(\d+) dies attacking/) { delete $unitname{$1}; delete $unitown{$1}; delete $unitarmy{$1}; delete $uniteff{$1}; delete $unitfort{$1}; delete $unitmob{$1}; delete $unitfuel{$1}; delete $unittech{$1}; delete $unitretr{$1}; delete $unitrad{$1}; delete $unitxpl{$1}; delete $unitnear{$1}; } elsif (/\s*(.+) #(\d+) retreats at (\d+)% efficiency to (\S+,\S+)!\s*/) { $unitname{$2}=$1; $uniteff{$2}=$3; $unitsect{$2}=$4; $unitown{$2}=$coun; local($tmp, $min, $hour, $mday, $mon, $tmp, $tmp, $tmp, $tmp)=localtime; $unitdate{$2}="$mon/$mday $hour:$min"; } elsif (/(\d+) of your troops now occupy (\S+,\S+)\s*/) { $own{$2}=$main'coun; $dump{$2, 'mil'}=$1; } } sub parse_read { # should the mines be in a BULLETIN?? if (/^Kawhomp! Mine detected by (.+) \(#(\d+)\) in (\S+,\S+)!/) { $mine{$3} = 20; } if ($teletype==0) { if (/^> BULLETIN.+dated \S+\s+(\S+)\s+(\S+)\s+(\d+):(\d+):.+/) { $teletype=1; $bullet_month=$main'month{$1}; $bullet_day=$2; $bullet_hour=$3; $bullet_min=$4; } } elsif ($teletype==1) { &parse_bulletin; } } sub parse_bulletin { if (/^> /) { $teletype=0; &parse_read; return; } elsif (/^(.+) \(#([0-9]+)\) lost ([0-9]+) troops taking (\S+,\S+)/) { ($mon, $mday, $hour, $min)=($dump{$sect, 'date'}=~/(\d+)\/(\d+) (\d+):(\d+)/); if (!($mon) || ($mon<=$bullet_month && $mday<=$bullet_day && $hour<=$bullet_hour && $min<=$bullet_min)) { $dump{$2, 'date'}="$bullet_month/$bullet_day $bullet_hour:$bullet_min"; $country{$2}=$1; $number{$1}=$2; $own{$4}=$2; } while($#aunits>-1) { $unitown{$aunits[0]}=$2; $unitnear{$aunits[0]}=$4; shift(@aunits); } } elsif (/^(.+) \(#(\d+)\) lost (\d+) troops attacking (\S+,\S+)/) { while($#aunits>-1) { $unitown{$aunits[0]}=$2; $unitnear{$aunits[0]}=$4; shift(@aunits); } } elsif (/^Scouts report attacking unit: (.+) #(\d+)(.*)/) { local($type, $unit, $rest)=($1, $2, $3); ($mon, $mday, $hour, $min)=($unitdate{$unit}=~/(\d+)\/(\d+) (\d+):(\d+)/); if (!($mon) || ($mon<=$bullet_month && $mday<=$bullet_day && $hour<=$bullet_hour && $min<=$bullet_min)) { $type=~s/\s*$//; $unitname{$unit}=$type; if ($rest=~/efficiency (\d+)[,\)]/) { $uniteff{$unit}=$1; } if ($rest=~/tech (\d+)\)/) { $unittech{$unit}=$1; } push(@aunits, $unit); $unitdate{$2}="$bullet_month/$bullet_day $bullet_hour:$bullet_min"; } } elsif (/\s*(.+) #(\d+) retreats at (\d+)% efficiency to (\S+,\S+)!\s*/) { local($type, $unit, $eff, $sect)=($1, $2, $3, $4); ($mon, $mday, $hour, $min)=($unitdate{$unit}=~/(\d+)\/(\d+) (\d+):(\d+)/); if (!($mon) || ($mon<=$bullet_month && $mday<=$bullet_day && $hour<=$bullet_hour && $min<=$bullet_min)) { $unitname{$2}=$1; $uniteff{$2}=$3; $unitsect{$2}=$4; $unitown{$2}=$coun; $unitdate{$2}="$bullet_month/$bullet_day $bullet_hour:$bullet_min"; } } elsif (/^\s*Diplomatic relations with (.+) downgraded to \"(.+)\"/) { $relation{$coun, $1}=$2; } elsif (/^\s*.+ \(#(\d+)\) .+ -- shot down/) { local($unit)=$1; ($mon, $mday, $hour, $min)=($planedate{$unit}=~/(\d+)\/(\d+) (\d+):(\d+)/); if (!($mon) || ($mon<=$bullet_month && $mday<=$bullet_day && $hour<=$bullet_hour && $min<=$bullet_min)) { delete $planename{$unit}; delete $planeeff{$unit}; delete $planesect{$unit}; delete $planewing{$unit}; delete $planemob{$unit}; delete $planetech{$unit}; delete $planehard{$unit}; delete $planesln{$unit}; delete $planeatt{$unit}; delete $planedef{$unit}; delete $planeran{$unit}; delete $planeown{$unit}; delete $planenear{$unit}; delete $planedate{$unit}; } } elsif (/firing \d+ flak guns in (\S+,[^.]+)\.+/) { $last_flak_sector=$1; } elsif (/\s*(.+)\s+\(#\s*(\d+)\)\s+takes \d+/) { local(@tmp)=split(/ /, $1); local($unit)=$2; local($pilot)=join(' ', shift(@tmp)); while (!(defined($number{$pilot})) && $#tmp > -1) { $pilot=join(' ', shift(@tmp)); } local($type)=join(' ', @tmp); $type=substr($type,0,19); ($mon, $mday, $hour, $min)=($planedate{$unit}=~/(\d+)\/(\d+) (\d+):(\d+)/); if (!($mon) || ($mon<=$bullet_month && $mday<=$bullet_day && $hour<=$bullet_hour && $min<=$bullet_min)) { $planeown{$unit}=$number{$pilot}; $planename{$unit}=$type; $planenear{$unit}=$last_flak_sector; $planedate{$unit}="$bullet_month/$bullet_day $bullet_hour:$bullet_min"; } } elsif (/^.+ turned (\S+,\S+) into a radioactive wasteland/) { $dump{$1, 'own'}=0; $dump{$1, 'des'}='\\'; $own{$1}=0; $dump{$1, 'date'}="$bullet_month/$bullet_day $bullet_hour:$bullet_min"; } elsif (/^\s*(.+) #(\d+) fires at you/) { local(@info)=split(/ /, $1); local($unit)=$2; local($countryname)=shift(@info); while(1) { if ($number{$countryname}) { last; } else { $countryname=$countryname . " " . shift(@info); } } $type=join(' ', @info); ($mon, $mday, $hour, $min)=($shipdate{$unit}=~/(\d+)\/(\d+) (\d+):(\d+)/); if (!($mon) || ($mon<=$bullet_month && $mday<=$bullet_day && $hour<=$bullet_hour && $min<=$bullet_min)) { if ($shipname{$type}) { $shipown{$unit}=$number{$countryname}; $shipname{$unit}=$type; $shipdate{$unit}="$bullet_month/$bullet_day $bullet_hour:$bullet_min"; } } } elsif (/Bridge falls at (\S+,\S+)\s*/) { $own{$1}=0; $dump{$1, "des"}='.'; } } sub parse_census { if (/^\s*(\S+,\S+) +(\S+) +(\d+)\% +(no)? +(\d+) .. .. (\S?) +(\d+) +(\d+) +(\d+) +(\d+) +(\d+)\% +(\d+)( +\d+)?$/) { $own{$1}=$coun; $dump{$1,'des'}=substr($2,0,1); if (substr($2,1,1)) { $dump{$1,'sdes'}=substr($2,1,1); } else { $dump{$1,'sdes'}='_'; } $dump{$1,'eff'} = $3; $dump{$1,'off'} = 1 if ($4); $dump{$1,'mob'} = $5; if ($6) { $oldown{$1} = -1; } else { $oldown{$1} = $own{$1}; } $dump{$1,'civ'} = $7; $dump{$1,'mil'} = $8; $dump{$1,'uw'} = $9; $dump{$1,'food'} = $10; $dump{$1,'work'} = $11; $dump{$1,'avail'} = $12; $dump{$1,'terr'} = int($13); } } sub parse_resource { if (/\s*(\S+,\S+)\s+(\S)\s+(\d+)%\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d*)\s*/) { $dump{$1, 'des'}=$2; $dump{$1, 'eff'}=$3; $dump{$1, 'min'}=$4; $dump{$1, 'gold'}=$5; $dump{$1, 'fert'}=$6; $dump{$1, 'ocontent'}=$6; $dump{$1, 'uran'}=$7; $dump{$1, 'terr'}=$8; } } sub parse_move { if (/^(\d+) +mob left in (\S+,\S+)\s*/) { $dump{$2, 'mob'}=$1; } } sub parse_explore { if (/\s+\S+\s+\S+\s+\S+\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { $expmin=$1; $expgold=$2; $expfert=$3; $expoil=$4; $expuran=$5; } elsif (/<\d+\.\d+:\s*(\S)\s+(\S+,\S+)>/) { $dump{$2, 'des'}=$1; $dump{$2, 'min'}=$expmin; $dump{$2, 'gold'}=$expgold; $dump{$2, 'fert'}=$expfert; $dump{$2, 'oil'}=$expoil; $dump{$2, 'uran'}=$expuran; undef $expmin; undef $expgold; undef $expfert; undef $expoil; undef $expuran; } elsif (/(\d+) mob left in (\S+,\S+)$/) { $dump{$2,'mob'} = $1; } elsif (/^Sector (\S+,\S+) is now yours.$/) { $own{$1} = $coun; $oldown{$1} = $coun; $dump{$1,'own'} = $coun; } } sub save_DB { print STDERR "Saving internal database for $main'game..."; if (defined(%own)) { open(DUMP, ">$main'game.dump"); foreach $sect (keys %own) { if ($own{$sect} ne $coun) { ($x, $y)=($sect=~/(\S+)\,(\S+)/); print DUMP "$x:$y:$own{$sect}:$dump{$sect, 'des'}:$dump{$sect, 'sdes'}:"; print DUMP "$dump{$sect, 'eff'}:$dump{$sect, 'mob'}:$dump{$sect, '*'}:"; print DUMP "$dump{$sect, 'off'}:$dump{$sect, 'min'}:$dump{$sect, 'gold'}:"; print DUMP "$dump{$sect, 'fert'}:$dump{$sect, 'ocontent'}:"; print DUMP "$dump{$sect, 'uran'}:$dump{$sect, 'work'}:"; print DUMP "$dump{$sect, 'avail'}:$dump{$sect, 'terr'}:"; print DUMP "$dump{$sect, 'civ'}:$dump{$sect, 'mil'}:$dump{$sect, 'uw'}:"; print DUMP "$dump{$sect, 'food'}:$dump{$sect, 'shell'}:"; print DUMP "$dump{$sect, 'gun'}:$dump{$sect, 'pet'}:$dump{$sect, 'iron'}:"; print DUMP "$dump{$sect, 'dust'}:$dump{$sect, 'bar'}:$dump{$sect, 'oil'}:"; print DUMP "$dump{$sect, 'lcm'}:$dump{$sect, 'hcm'}:$dump{$sect, 'rad'}:"; print DUMP "$def{$sect, 'fort'}:$def{$sect, 'ship'}:$def{$sect, 'land'}:$def{$sect, 'plane'}:"; print DUMP "$dump{$sect, 'date'}\n"; } } close DUMP; } if (defined(%planeown)) { open(DUMP, ">$main'game.planes"); foreach $unit (keys %planeown) { next if $planeown{$unit}==$main'coun; print DUMP "$unit:$planename{$unit}:$planesect{$unit}:$planenear{$unit}:$planewing{$unit}:"; print DUMP "$planeeff{$unit}:$planemob{$unit}:$planetech{$unit}:"; print DUMP "$planehard{$unit}:$planesln{$unit}:$planeatt{$unit}:"; print DUMP "$planedef{$unit}:$planeran{$unit}:$planeown{$unit}:"; print DUMP "$planedate{$unit}\n"; } close(DUMP); } if (defined(%shipown)) { open(DUMP, ">$main'game.ships"); foreach $unit (keys %shipown) { next if $shipown{$unit}==$main'coun; print DUMP "$unit:$shipname{$unit}:$shipsect{$unit}:$shipnear{$unit}:$shipflt{$unit}:"; print DUMP "$shipeff{$unit}:$shipmob{$unit}:$shiptech{$unit}:"; print DUMP "$shipfuel{$unit}:$shiplnd{$unit}:$shippln{$unit}:"; print DUMP "$shiphel{$unit}:$shipxpl{$unit}:$shipown{$unit}:"; print DUMP "$shipdate{$unit}\n"; } close(DUMP); } if (defined(%unitown)) { open(DUMP, ">$main'game.units"); foreach $unit (keys %unitown) { next if $unitown{$unit}==$main'coun; print DUMP "$unit:$unitname{$unit}:$unitsect{$unit}:$unitnear{$unit}:$unitarmy{$unit}:"; print DUMP "$uniteff{$unit}:$unitmob{$unit}:$unittech{$unit}:"; print DUMP "$unitfort{$unit}:$unitfuel{$unit}:$unitretr{$unit}:"; print DUMP "$unitxpl{$unit}:$unitrad{$unit}:$unitown{$unit}:"; print DUMP "$unitdate{$unit}\n"; } close(DUMP); } print STDERR "done\n"; } sub load_DB { if (-f "$main'game.dump") { local(@d); open(DUMP, "$main'game.dump"); while() { chop($_); (@d)=split(/:/, $_); $x=shift(@d); $y=shift(@d); if (!($x =~ /^-*\d+$/) || !($y =~ /^-*\d+$/)) { print STDERR "ERROR: Your internal database file $main'game.dump was corrupt--pei will now rename it $main'game.dump.bad and abort load_DB.\n"; close (DUMP); system "mv $main'game.dump $main'game.dump.bad"; last; } $sect="$x,$y"; $own{$sect}=shift(@d); $dump{$sect, 'own'}=$own{$sect}; $dump{$sect, 'des'}=shift(@d); $dump{$sect, 'sdes'}=shift(@d); $dump{$sect, 'eff'}=shift(@d); $dump{$sect, 'mob'}=shift(@d); $dump{$sect, '*'}=shift(@d); $dump{$sect, 'off'}=shift(@d); $dump{$sect, 'min'}=shift(@d); $dump{$sect, 'gold'}=shift(@d); $dump{$sect, 'fert'}=shift(@d); $dump{$sect, 'ocontent'}=shift(@d); $dump{$sect, 'uran'}=shift(@d); $dump{$sect, 'work'}=shift(@d); $dump{$sect, 'avail'}=shift(@d); $dump{$sect, 'terr'}=shift(@d); $dump{$sect, 'civ'}=shift(@d); $dump{$sect, 'mil'}=shift(@d); $dump{$sect, 'uw'}=shift(@d); $dump{$sect, 'food'}=shift(@d); $dump{$sect, 'shell'}=shift(@d); $dump{$sect, 'gun'}=shift(@d); $dump{$sect, 'pet'}=shift(@d); $dump{$sect, 'iron'}=shift(@d); $dump{$sect, 'dust'}=shift(@d); $dump{$sect, 'bar'}=shift(@d); $dump{$sect, 'oil'}=shift(@d); $dump{$sect, 'lcm'}=shift(@d); $dump{$sect, 'hcm'}=shift(@d); $dump{$sect, 'rad'}=shift(@d); $def{$sect, 'fort'}=shift(@d); $def{$sect, 'ship'}=shift(@d); $def{$sect, 'land'}=shift(@d); $def{$sect, 'plane'}=shift(@d); $dump{$sect, 'date'}=shift(@d); $dump{$sect, 'date'}.=':'; $dump{$sect, 'date'}.=shift(@d); } close(DUMP); } if (-f "$main'game.planes") { local(@p); open(DUMP, "$main'game.planes"); while() { chop($_); (@p)=split(/:/, $_); $unit=shift(@p); $planename{$unit}=shift(@p); $planesect{$unit}=shift(@p); $planenear{$unit}=shift(@p); $planewing{$unit}=shift(@p); $planeeff{$unit}=shift(@p); $planemob{$unit}=shift(@p); $planetech{$unit}=shift(@p); $planehard{$unit}=shift(@p); $planesln{$unit}=shift(@p); $planeatt{$unit}=shift(@p); $planedef{$unit}=shift(@p); $planeran{$unit}=shift(@p); $planeown{$unit}=shift(@p); $planedate{$unit}=shift(@p); $planedate{$unit}.=':'; $planedate{$unit}.=shift(@p); } close(DUMP); } if (-f "$main'game.ships") { local(@s); open(DUMP, "$main'game.ships"); while() { chop($_); (@s)=split(/:/, $_); $unit=shift(@s); $shipname{$unit}=shift(@s); $shipsect{$unit}=shift(@s); $shipnear{$unit}=shift(@s); $shipflt{$unit}=shift(@s); $shipeff{$unit}=shift(@s); $shipmob{$unit}=shift(@s); $shiptech{$unit}=shift(@s); $shipfuel{$unit}=shift(@s); $shiplnd{$unit}=shift(@s); $shippln{$unit}=shift(@s); $shiphel{$unit}=shift(@s); $shipxpl{$unit}=shift(@s); $shipown{$unit}=shift(@s); $shipdate{$unit}=shift(@s); $shipdate{$unit}.=':'; $shipdate{$unit}.=shift(@s); } close(DUMP); } if (-f "$main'game.units") { local(@u); open(DUMP, "$main'game.units"); while() { chop($_); (@u)=split(/:/, $_); $unit=shift(@u); $unitname{$unit}=shift(@u); $unitsect{$unit}=shift(@u); $unitnear{$unit}=shift(@u); $unitarmy{$unit}=shift(@u); $uniteff{$unit}=shift(@u); $unitmob{$unit}=shift(@u); $unittech{$unit}=shift(@u); $unitfort{$unit}=shift(@u); $unitfuel{$unit}=shift(@u); $unitretr{$unit}=shift(@u); $unitxpl{$unit}=shift(@u); $unitrad{$unit}=shift(@u); $unitown{$unit}=shift(@u); $unitdate{$unit}=shift(@u); $unitdate{$unit}.=':'; $unitdate{$unit}.=shift(@u); } close(DUMP); } } $main'parse_loaded = 1; pei/pei000755 002123 000322 00000134563 06120726167 013572 0ustar00childrenpstaff000000 2516360 #!/usr/local/bin/perl # $country = '7'; # $representative = '7'; # $host = 'random.chem.psu.edu'; # $port = 1618; # # $Id: pei,v 2.3 1995/07/08 11:02:14 children Beta $ # # Perl Empire Interface # # Based on eif by Doug Hay and hpc by Drake Diedrich # # written by Ken Stevens # # # DESCRIPTION: # pei is a powerful, fully extendible smart client for playing Empire. # Features include: # - Tools for managing and feeding civs, auto-exploring, setting dist-paths, # calculating the new efficiency of ships/planes/units, reading/sending # telegrams and announcements, keeping track of enemy sectors and units, # and managing production deltas. # - Full perl integration. You can type perl commands at the empire prompt. # - File redirection, piping, exec (read commands from a file), and # runfeed (pipe the output of a program to pei). # - Aliases. You can define your own aliases with arguments. # - !!, !abc, and ^a^b history substitution # - Multiple games. You may be connected to more than one game at a time, # and switch between them. # - Function mapping. You can call your own perl functions from within # the client by defining your own function maps. # - Output parsing. Server output is automatically parsed and stored in # an internal database. There is a separate database for each game # connected to. # - Interrupt handling. ^C should be handled properly in most cases. # # INSTALLATION: # Before you run this script, make sure that you have typed: # chmod +x pei # where pei is the name of this file. # # HOW TO RUN IT: # To get the client up and running, do one of the following: # 1) Uncomment and edit the four variables $country, $representative, # $host, and $port at the top of this file. Then in your operating system, # type 'pei'. # # Or, you can specify these four variables as command-line arguments: # 2) In your operating system type: # pei [country] [rep] [host] [port] # # Or, you can specify the information in a file: # 3) Copy example.peirc to ~/.peirc and edit the game data at the bottom # of the file. Then type 'pei'. # # Once in the client, type "help" for more information. The man page # for pei may be found at the bottom of this file. # # BUG REPORTS: # mail your bug-reports and comments to: # tetherow@nol.org (Sam Tetherow) # --- Glossary --- # # These are the terms used in the # comments in this program: # cprompt The main Empire command prompt ($mode eq $C_PROMPT). # sprompt An Empire sub-prompt ($mode eq $C_FLUSH). # prompt Either a cprompt or an sprompt. # ecommand An Empire command sent to a cprompt. # scommand Text sent to a sub-prompt. # command A command understood by this client (includes ecommands). # commandline A command with its arguments. # line One or more commandlines separated by semicolons. # --- Global variables --- # # User defined variables: # $EDITOR Name of system editor to use while in pei. # $PAGER Name of sytem pager to use while in pei. # $PEIPATH The name of the directory containing all the pei files # $TIMEOUT How long do we wait for output from the server? # $mailflag If true, mail.pl will not remove mail from the # empire server. # $mailflag{$game} Same as mailflag, but you can set it just for a game. # $debug If true, then print connect debug info. # $maxhistorysize The number of commands stored in the history list. # # Connection stuff: # $games{$name} A list of games we can connect to. # $game The name of the game I am currently connected to. # $country The name of our country. # $representative The password for our country. # $host The host we're connected to. # $port The port we're connected to. # $socket{$game} The name of the socket filehandle for $game if open. # $S The socket for the current game. # # Error recovery: # $depth How deep in input loops am I? # $status If not zero, drop what we're doing and &recover # $status us a bitfield. The following bits can be # set in $status: # $S_EOF The server closed the connection. # $S_TIMEOUT We waited longer than $TIMEOUT seconds for output # from the server. # $S_INTERRUPT The player hit ^C # $S_BROKEN_PIPE Broken pipe (most likely hit 'q' in 'more') # $S_NEW_GAME The player is switching games. # # Tools: # $coun My country number. # $functionmap{"command"} = "&function" # When player types "command" call &function. # $parsemap{"ecommand"} = "&parse_function" # Defined in parse.pl -- parse the output of this ecommand # # These i/o variables are used in the main loop: # $serverline A line of output from the server # @history A history of recent commands (used only in mainloop) # $command The current command # $commandarg The arguments of the current command # $prev_FH{$FH} Linked list of filehandles. Used for output redirection. # $new_filehandle Incremented to generate unique filehandle names. # $quoted_material # $semicolon_in_quotes These two string constants are used to parse # Semicolons in quotes in command lines. # # These three variables are sent by the server every time we get a cprompt: # $timeused The amount of time we've been playing so far # $btus How many btu's we have left # $mode See &init for details. # $tele{$game} A string used in our main promt showing if we have # any telegrams # --- Functions --- # # Main: # connectloop Whenever we connect to a new game, we enter this loop # load_tools Load tools.pl, parse.pl, and simu.pl for $game # greate_game_name Create name for game that is valid package name # # Initialization functions: # init Initialize variables # parse_argv Parse command line arguments to this program # # Read and parse user input: # parse_commandline Parse a single commandline # singlecommand Send a single ecommand to the server unparsed # parse_line Parse one line of input # mainloop Read lines from standard input and parse them # fmainloop Read lines from a file and parse them # # Read and parse server output: # parse_serverline Parse output from the server # slurp Read & parse server output until prompt # suck Read & parse server output until cprompt # # Local prompt: # local_prompt Dispatch local commands. # localloop Prompt user to select a new game. # prompt Prompt the user for input # set_game Set the coun, rep, host, and port from game name # # Connect to server: # connect_to_server Connect to the server # got_from_server Print an error message if we didn't get what we expected # # Error Recovery: # dokill Called when user hits ^C # broken_pipe Called when a pipe breaks # ih_print Special print function used by error recovery subroutines # ask_to_die Things are very bad. Ask user to kill pei. # recover Recover from error (called when $status is non-zero). # recover_data Recover from user interrupt when there's data on the server # flush_server_output Flush server output without parsing # nofind_error Pei can't locate a file. Tell the user where we looked. # abort_command Abort ecommand # close_connection Close the connection to the server for the current game. # do_exit Exit nicely # # Read init file: # read_peirc Read variables, aliases, and games from ~/.peirc # convert_eifrc_to_peirc Make a new ~/.peirc out of a ~/.eifrc # # Function maps: # execfile Execute lines from a file # runfeed Run a program and pipe the output to pei # runcommands Called by execfile and runfeed; # history print history of our lines # # String subroutines: # quotify Put something in quotes so that it can be eval'ed # strip_quotes Remove bracketing quotes from text # --- Main --- # # This is the entry point for pei. It all starts here... $version = '2.4'; print "\nWelcome to PEI\nPerl Empire Interface version $version\n\n"; &init; # initialize variables &read_peirc; # read & parse commands from ~/.peirc &parse_argv; # parse command-line arguments &connectloop; # the main loop &do_exit; # exit nicely # This is the main pei loop. Whenever we switch between games, we re-enter # this loop. sub connectloop { while (1) { $status &= ~$S_INTERRUPT; # Clear the interrupt flag # If $country has not been defined yet (e.g. in this file or ~/.peirc), # enter local prompt and ask for a game to connect to. &localloop unless $country || $status & $S_NEW_GAME; $status &= ~$S_NEW_GAME; # Clear the new game flag # $game is used as a part of the pei prompt # Create the game name from the country name # Note that $game must be a valid perl package name. &create_game_name unless $game || $game !~ /[A-Za-z]+[1-9]*/; # Each game has its own socket. if ($S = $socket{$game}) { # We are already connected to that game print STDERR "Reconnected.\n"; $status &= ~$S_EOF; $mode = $C_PROMPT; } elsif (&connect_to_server) { # If we are able to connect to the host, start playing. print STDERR "\nplay\n" if $debug; print $S "play\n"; # start playing! if (!&got_from_server("$C_INIT 2")) {&close_connection; next;} print STDERR "Connected!\n"; &slurp; # read and print motd if ($status) {&close_connection; next;} if (!$no_tools) { # Load tools for this game. &load_tools; if ($status) {&close_connection; next;} if ($tools_loaded) { &find_country_number; # find my country number -- needed for tools.pl if ($status) {&close_connection; next;} &tools_init; if ($status) {&close_connection; next;} eval ("&".$game."'load_DB"); if ($status) {&close_connection; next;} } if (-f "start.exec") { # if there is a start.exec file &parse_commandline("exec start.exec"); # execute it if ($status) {&close_connection; next;} } } } else { # we weren't able to connect &close_connection; next; } # Set these four variables for the current game. eval('$country = $'.$game."'country"); eval('$coun = $'.$game."'coun"); eval('$btus = $'.$game."'btus"); eval('$timeused = $'.$game."'timeused"); eval('$nstatus = $'.$game."'nstatus"); if (!(-t STDIN)) { # if pei was called as "pei < filename" &fmainloop(STDIN); # read commands using fmainloop } else { # otherwise &mainloop; # read commands using standard input } } } # Load the perl modules which are specific to being connected to a game. # These modules are loaded within the package $game to keep the namespace # of separate games distinct. sub load_tools { return unless $game; undef $tools_loaded; eval("package $game; do 'tools.pl';"); &nofind_error("tools.pl",$@) unless $tools_loaded; undef $parse_loaded; eval("package $game; do 'parse.pl';"); &nofind_error("parse.pl",$@) unless $parse_loaded; undef $simu_loaded; eval("package $game; do 'simu.pl';"); &nofind_error("simu.pl",$@,1) unless $simu_loaded; } # Create a game name from a country name, making sure that $game is a valid # perl package name. sub create_game_name { ($game) = ($country =~ /([A-Za-z]+[1-9]*)/); if (!$game) { # game had no letters in it e.g. '7' ($game) = ($country =~ /([A-Za-z1-9]*)/); $game = 'game_'.$game; } } # --- Initialization Functions --- # # Initialize variables sub init { local ($me, $sym_link, $pwd); # The following code adds directories to the system array @INC. # This is where perl looks for tools.pl, mail.pl, ... # pei will also look in these directories for help files. if (-l $0) { $sym_link = readlink($0); $sym_link =~ s|/[^/]+$||; if ($sym_link =~ m|^/|) { # absolute link $me = $sym_link; } else { $me = $0; # relative link $me =~ s|[^/]+$|$sym_link|; } push(@INC, $me); } # This code adds the directory from which pei was run to @INC: if ($0 =~ m|^(\S+)/[^/]+$|) { push(@INC, $1); } else { chop($pwd = `pwd`); push(@INC, $pwd); } eval("require 'mail.pl'"); &nofind_error("mail.pl", $@) unless $mail_loaded; # Socket connection code eval ("require 'sock.pl';"); &nofind_error('sock.pl', $@) unless defined &sock'open; #' # pei Local% commands eval ("require 'local.pl';"); &nofind_error('local.pl', $@) unless $local_loaded; # Map the following commands to perl functions: $functionmap{"eval"} = '$_'; $functionmap{"print"} = '$_'; $functionmap{"undef"} = '$_'; $functionmap{"exec"} = '&execfile'; $functionmap{"runfeed"} = '&runfeed'; $functionmap{"history"} = '&history'; # This is the length of our history list. $maxhistorysize = 100 unless $maxhistorysize; # Beep when we are informed of an incoming telegram $beep = 1; # If we recieve an interrupt, call &dokill $SIG{'INT'} = 'dokill'; # call &dokill if the user types ^C # If our pipe breaks, call &broken_pipe $SIG{'PIPE'}='broken_pipe'; # These variables are reserved words and are used for parsing: $quoted_material = "_Q_M_"; # material between quotes $semicolon_in_quotes = "_S_I_Q_"; # semicolon inside quotes # Special perl variables $; = ','; # array multiple index emulation $, = ", "; # for printing arrays # The following variables are used in &connect_to_server: eval("require 'sys/errno.ph'"); if (!defined(&ECONNREFUSED)) { eval 'sub TCP_EBASE {100;}'; eval 'sub ENETUNREACH {(17+ &TCP_EBASE);}'; eval 'sub EISCONN {(22+ &TCP_EBASE);}'; eval 'sub ETIMEDOUT {(26+ &TCP_EBASE);}'; eval 'sub ECONNREFUSED {(27+ &TCP_EBASE);}'; } # If any of the following bits are set in $status, then pei will drop # what it was doing and try to recover gracefully. $S_EOF = 1 << 0; # Server EOF $S_TIMEOUT = 1 << 1; # S_read timed out waiting for server output $S_INTERRUPT = 1 << 2; # The user typed ^C $S_BROKEN_PIPE = 1 << 3; # A pipe broke (usually 'q' in 'more') $S_NEW_GAME = 1 << 4; # The user wants to start a new game # We start with the socket closed. $status = $S_EOF; # This name is incremented to get unique filehandle names. $new_filehandle = 'pei00000001'; &local_init; $C_CMDOK = '0'; $C_DATA = '1'; $C_INIT = '2'; $C_EXIT = '3'; $C_FLUSH = '4'; $C_NOECHO = '5'; $C_PROMPT = '6'; $C_ABORT = '7'; $C_REDIR = '8'; $C_PIPE = '9'; $C_CMDERR = 'a'; $C_BADCMD = 'b'; $C_EXECUTE = 'c'; $C_FLASH = 'd'; $C_INFORM = 'e'; $C_SYNC = 'f'; } # Parse command-line arguments to this program sub parse_argv { if (@ARGV[0] eq '-n') { $no_tools = 1; shift(@ARGV); } local ($c,$r,$h,$p) = @ARGV; if ($games{$c}) { &set_game($c); return; } if ($p) { $country = $c; $representative = $r; $host = $h; $port = $p; } elsif ($c) { print STDERR <<'EOF'; Usage: pei [ -n ] [country] [representative] [host] [port] -or- pei [ -n ] [gamename] EOF &do_exit; } if (!$country && $ENV{'COUNTRY'} && $ENV{'PLAYER'} && $ENV{'EMPIREHOST'} && $ENV{'EMPIREPORT'}) { $country = $ENV{'COUNTRY'}; $representative = $ENV{'PLAYER'}; $host = $ENV{'EMPIREHOST'}; $port = $ENV{'EMPIREPORT'}; } } # --- Read and Parse User Input --- # Parse a single commandline sub parse_commandline { local ($_) = @_; # the command to be parsed local ($redir) = ''; # output redirection local ($al); # expanded alias local ($FH); # filehandle for redirected output return if /^\s*$/; # if commandline is all whitespace s/^\s*(\S.*)$/$1/; # remove whitespace at beginning s/^(.*\S)\s*$/$1/; # remove whitespace at end # Send scommand to sprompt if there is one: if ($mode eq $C_FLUSH) { # sprompt if (/^\?/) { # commandline starts with ? print $S "$'\n"; # send text to server &slurp; # read & parse server output until prompt return; } else { local ($commandline) = $_; # store $_ temprarily because &suck changes it &abort_command; # send abort to server and read until cprompt $_ = $commandline; } } elsif (/^\?/) { # ? encountered but not in sprompt return; # ignore the command } if (/^:/) { # command starts with : local ($syscommand) = $'; $syscommand =~ s/~/$ENV{'HOME'}/g; # replace ~ with value of $HOME system($syscommand); # send the command to the system return; } # Split command and commandargs: ($command,$commandarg)=split(/\s+/,$_,2); # Parse Aliases: if (defined($alias{$command}) && # is the command aliased to anything? !grep(/^$command$/, @expanded)) { # we haven't expanded this alias yet push(@expanded, $command); # add $command to list of expanded aliases $al = $alias{$command}; # expand the alias # Check if there are any $1 type variables in the alias: if ($al =~ /\@_\[[0-9]\]/ || # If there are $1 or $+ variables in $al =~ /\@\{_\[[0-9]\]/ || # the expansion $al =~ /\$\+/) { /^\s*\S+\s+(\S.*)$/; # prepare for $+ substitution split; # prepare for $1, $2, ... substitution $al = eval(''."ify($al)); # substitute $1, $2, ... and $variables } else { &strip_quotes(*al); # remove bracketing quotes from expansion if ($commandarg) { # if we called the alias with arguments $al = "$al $commandarg"; # put the arguments after the expansion } } &parse_line($al); # send the expanded alias to the line parser pop(@expanded); return; } # File Redirection # If we have a > or a | which is not in quotes, redirect the output: if (/ (>!|>>|>|\|)/ && !/\"[^\"]*[>|\|][^\"]*\"/ && !/\'[^\']*[>|\|][^\']*\'/) { local ($commandline, $rtype, $fname) = ($`, $1, $'); $fname =~ s/~/$ENV{'HOME'}/g; # replace ~ with $HOME # If redirecting to file, check for valid unix filename if ($rtype ne '|') { if ($fname =~ /^\s*([\/\.\w]+)\s*$/) { $fname = $1; } else { print STDERR "Illegal filename: \"$fname\". Redirection failed.\n"; return; } } # If you want to overwrite an existing file, you must use >! if ($rtype eq '>' && -e $fname && $fname ne '/dev/null') { print STDERR "Error: File \"$fname\" exists. Use >! to overwrite\n"; print STDERR " or >> to append. Redirection failed.\n"; return; } elsif ($rtype eq '>!') { $rtype = '>'; } $redir= $rtype . $fname; # where we will send output $FH = ++$new_filehandle; # Open the file or pipe: if (open($FH, $redir)) { $_ = $commandline; # our commandline $prev_FH{$FH} = select($FH); # send all new output to $FH ($command,$commandarg)=split(/\s+/,$_,2); # split command and commandargs if ($command ne "echo") { print "$_\n"; # print our commandline to $FH } } else { print STDERR "Unable to open $redir\n"; return; } } if ($command =~ /^[\$\&\@\%\{]/) { # if command starts with $, &, @, %, or { eval($_); # it's perl -- eval it! } elsif (defined($functionmap{$command})) { # is my command a function map? if ($functionmap{$command} =~ /^&tools_/) { # Call the function in the tool package for this game if ($terse) { $| = 1; *UNTERSEOUT = select(DEVNULL); eval('&'.$game."'tools_".$'); select(UNTERSEOUT); $| = 0; print UNTERSEOUT "\n"; } else { eval('&'.$game."'tools_".$'); } } else { eval($functionmap{$command}); } } elsif (/\S/) { # if my commandline is not empty if (!&local_prompt) { # Parse local command # The commandline is an ecommand. Put double quotes around it and eval it. # This will ensure that any $variables will get replaced with their values print $S eval(''."ify($_)) . "\n"; # send the command to the server &slurp; # read & parse server output until prompt } } if ($FH) { # do we have file redirection? select($prev_FH{$FH}); # revert to the old filehandle output close($FH); # close the file or pipe (this will flush) } } # Send a single ecommand to the server sub singlecommand { local ($commandline) = @_; print $S "$commandline\n"; # Go directly to server. Do not collect $200 ($command,$commandarg)=split(/\s+/,$commandline,2); &suck; # read & parse server output until cprompt } # Parse one line of input. We assume the newline has been stripped. # This function splits a line into commandlines separated by # semicolons. Most of the work in this function consists of taking # special care of semicolons that are in quotes. sub parse_line { local ($_) = @_; # put the line in $_ local (@stack); # what was between quotes local (@commandlines); # commandlines delimited by semi-colon return if /^\s*\#/; # ignore comments if (!/;/) { # line has no semi-colons. parse it! &parse_commandline($_); # the line is a commandline return; } # Replace semicolons in ' quotes by the value of $semicolon_in_quotes: while (s/(\'[^\']*\')/$quoted_material/) { push(@stack, $1); # put the ' quoted stuff into @stack } for (@stack) { s/;/$semicolon_in_quotes/g; # codify semi-colons in ' quotes } s/$quoted_material/shift(@stack)/ge; # put quoted stuff back in # The following few lines replace semicolons inside quotes by the value # of $semicolon_in_quotes: while (s/(\"[^\"]*\")|(\'[^\']*\')/$quoted_material/) { push(@stack, $1); # put the quoted stuff onto @stack } for (@stack) { s/;/$semicolon_in_quotes/g; # codify semi-colons in quotes } s/$quoted_material/shift(@stack)/ge; # put quoted stuff back in @commandlines = split(/;/); # chop the line into commandlines for (@commandlines) { s/$semicolon_in_quotes/;/g; # put the semicolons back &parse_commandline($_); # parse each commandline last if $status; } } # Note that ^C from main prompt doesn't work. # Read input lines from standard input and parse them sub mainloop { local ($rin, $rout); local ($line); # line of my input ++$depth; # used by &recover &prompt; while (1) { if ($sock'TelnetBuffer{$S}) { #' while ($sock'TelnetBuffer{$S}) { #' $_ = &sock'S_read($S, $TIMEOUT); #' last if $status; &parse_serverline; } } vec($rin, fileno($S), 1)=1; vec($rin, fileno(STDIN), 1)=1; select($rout=$rin, undef, undef, undef); if ($status) { last if &recover(1); &prompt; next; } if (vec($rout, fileno($S), 1)) { # Async server data $_ = &sock'S_read($S, $TIMEOUT); #' if ($status) {last if &recover;} &parse_serverline; } if (vec($rout, fileno(STDIN), 1)) { sysread(STDIN, $line, 2048); if ($line) { chop($line); if ($mode eq $C_PROMPT) { &history_expansion; @expanded = (); # reset expanded alias array &parse_line($line); # parse our line of input if ($status) {last if &recover(1);} } elsif ($mode eq $C_FLUSH) { # sprompt print $S "$line\n"; &slurp; # read & parse server output until prompt if ($status) {last if &recover(1);} } else { print STDERR "Lost sync with server.\n"; if ($status) {last if &recover;} &suck; if ($status) {last if &recover;} } } else { if ($mode eq $C_PROMPT) { if ($status) {last if &recover(1);} } elsif ($mode eq $C_FLUSH) { if ($status) {last if &recover(1);} &abort_command; if ($status) {last if &recover;} } else { print STDERR "Lost sync with server.\n"; &suck; if ($status) {last if &recover;} } } &prompt; } } --$depth; } # The following code does !!, !abc, and ^a^b history expansion: sub history_expansion { local ($i); # history index if ($line eq '!!' && @history) { # repeat last command $line = $history[$#history]; print "$line\n"; } else { if ($line =~ /^!(\S+)/) { # !abc type substitution local ($search) = $1; local ($histarg) = $'; for ($i = $#history; $i >= 0; --$i) { if ($history[$i] =~ /^$search/) { $line = $history[$i].$histarg; print "$line\n"; last; } } } elsif ($line =~ /^\^(.*)\^(.*)$/) { # ^a^b type substitution local ($replace) = $2; $line = $history[$#history]; $line =~ s/$1/$replace/; print "$line\n"; } if ($line =~ s/!!/$history[$#history]/ge) { print "$line\n"; } # Put $line on our history list shift(@history) if @history == $maxhistorysize; push(@history, $line); } } # Read lines from a file and parse them sub fmainloop { local ($FH) = @_; # The filehandle we're reading input from ++$depth; # used by &recover while (<$FH>) { # while there's still lines to read in the file if ($mode eq $C_PROMPT && !$quiet) { # if cprompt and not quiet print "\n$tele{$game}$game [$timeused:$btus]% $_"; # print cprompt and line } chop; # remove newline @expanded = (); # reset expanded alias array &parse_line($_); # parse our line of input if ($status) {last if &recover;} } --$depth; } # --- Read and Parse Server Output --- # # This command assumes that the serverline is in $_. It sets the # $mode, $timeused, and $btus. It returns 1 if $_ is a prompt. # Otherwise it prints $_. sub parse_serverline { local ($lastmode) = $mode; local ($lastserverline) = $serverline; $mode = substr($_,0,1); # grab the mode $serverline = $_ = substr($_,2); # cut the mode part off if (defined($parsemap{$command})) { eval("&".$game."'$parsemap{$command}"); } if ($mode eq $C_DATA) { # normal data print $_; return 0; } if ($mode eq $C_PROMPT) { # cprompt ($timeused,$btus) = split(' '); return 1; } return 1 if $mode eq $C_FLUSH; # sprompt if ($mode eq $C_EXIT) { # server error print STDERR "$_"; &close_connection(1); return 1; } if ($mode eq $C_FLASH) { # "flash" telegram from another player $mode = $lastmode; $serverline = $lastserverline; print "\n$_"; return ($mode eq $C_PROMPT || $mode eq $C_FLUSH); } if ($mode eq $C_SYNC) { # "flash" telegram from another player $mode = $lastmode; $serverline = $lastserverline; print "\n$_"; return ($mode eq $C_PROMPT || $mode eq $C_FLUSH); } if ($mode eq $C_INFORM) { # We just got a telegram chop($tele{$game} = $_); if ($tele{$game}) { print "\07" if $beep; $tele{$game} = "$tele{$game} "; } $mode = $lastmode; $serverline = $lastserverline; if ($mode eq $C_PROMPT) { &prompt; } elsif ($mode eq $C_FLUSH) { $| = 1; print "\n$tele{$game}$serverline"; $| = 0; } return ($mode eq $C_PROMPT || $mode eq $C_FLUSH); } if ($mode eq $C_EXECUTE) { s/~/$ENV{'HOME'}/g; if (open(EXEC, "<$_")) { print $S $_ while (); close EXEC; } else { print STDERR "Unable to open file \"$_\" for input\n"; } print $S "ctld\n"; &slurp; return 1; } if (!$mode) { $status |= $S_EOF; return 1; } print STDERR "Strange Empire packet: mode = ($mode) data = ($_)\n"; } # This function reads lines from the server until a prompt # is encountered. If we have written a perl function to parse the output # of our command, then we call that function. Note that when the parsemap # is called, the serverline is in $_. sub slurp { while (1) { $mode = -1; # waiting for output from server $_ = &sock'S_read($S, $TIMEOUT); last if $status; last if &parse_serverline; # we got a prompt last if $status; # socket closed } } # This function is exactly the same as &slurp except that it ignores sprompts. sub suck { do { while (1) { $mode = -1; # waiting for output from server $_ = &sock'S_read($S, $TIMEOUT); last if $status; last if &parse_serverline; # we got a prompt. last if $status; } last if $status; if ($mode ne $C_PROMPT) { # if not a cprompt print $S "aborted\n"; # send abort to server } } while ($mode eq $C_FLUSH); # while we're at an sprompt } # --- Local Prompt --- # # Parse local commands sub local_prompt { if (defined $lcommand{$command}) { eval($lcommand{$command}); return 1; } 0; } # We enter this loop at the start and when we leave a game. # Local commands are accepted. We leave the loop as soon as the # user has specified a game they want to connect to. sub localloop { local ($line); local ($rin, $rout); $status &= ~$S_NEW_GAME; # Clear the new game flag. &do_exit unless -t STDIN; # Don't ask tricky questions to a file do { &prompt; vec($rin, fileno(STDIN), 1)=1; select($rout=$rin, undef, undef, undef); if ($status & $S_INTERRUPT) { &ask_to_die; $status &= ~$S_INTERRUPT; &ih_print("And now back to your regularly scheduled Local prompt...\n"); } elsif (vec($rout, fileno(STDIN), 1)) { sysread(STDIN, $line, 2048); chop($line); if ($line) { next if $line =~ /^\s*$/; ($command,$commandarg) = split(/\s+/,$line,2); print "Not a local command, and not connected to a game.\n" unless &local_prompt; $status &= ~$S_BROKEN_PIPE if $status & $S_BROKEN_PIPE; } } } while (!($status & $S_NEW_GAME)); } # Prompt the user for input sub prompt { $| = 1; if (@_) { print pop(@_) . ' '; } else { if (defined $game) { if ($mode eq $C_PROMPT) { print "\n$tele{$game}$game [$timeused:$btus]% "; } elsif ($mode eq $C_FLUSH) { chop($serverline); # remove newline print "$serverline"; } else { print "$game [mode = $mode]% "; } } else { print "Local% "; } } $| = 0; } # Given a value of %game, set the country, rep, host, port. Also, try to # change directory to this game's directory. sub set_game { ($game, $no_new_status) = @_; local ($dir); return unless $games{$game}; split(/\s+/, $games{$game}); # the five fields are separated by a whitespace $country = @_[0]; $representative = @_[1]; $host = @_[2]; $port = @_[3]; if ($port !~ /^\d+$/) { print STDERR "Error: Port is \"$port\" for game \"$game\", but it should be a number.\n"; &close_connection; return; } # Change to the game's directory $dir = eval(''."ify(@_[4])); $dir =~ s/~/$ENV{'HOME'}/g; if (!chdir($dir)) { print STDERR "Cannot change directory to: \"".eval(''."ify(@_[4]))."\"\n"; } $status |= $S_NEW_GAME unless $no_new_status; } # --- Connect to Server --- # # Connect to the server sub connect_to_server { local ($user, $line, $i); print STDERR "Opening socket..." if $debug; if ($firewall) { $S = &sock'open($proxyhost, $proxyport); #' } else { $S = &sock'open($host, $port); #' } if (!$S) { print "\n$!\n"; print STDERR "Game is probably not up.\n" if $! == &ECONNREFUSED; print STDERR "Network problems?\n" if $! == &ETIMEDOUT; print STDERR "Good luck.\n" if $! == &ENETUNREACH; print STDERR "Already connected.\n" if $! == &EISCONN; return 0; } $socket{$game} = $S; print STDERR "done\n" if $debug; if ($firewall) { while ($i < $TIMEOUT) { $line = &sock'S_read($S, $TIMEOUT); #' return 0 if $status; chop($line); if ($line =~ m/^.*$proxyprompt.*$/) { #Its time to connect print $S "$host $port\n"; #Send the server address last; } else { ++$i; } } return 0 unless $i < $TIMEOUT; } # Send my country information to the server: $user = $ENV{'USER'}; $user = "nobody" unless $user; print STDERR "user $user\n" if $debug; print $S "user $user\n"; return 0 unless &got_from_server(".*$C_INIT Empire server ready"); print STDERR "\n"; return 0 unless &got_from_server("$C_CMDOK hello $user"); print STDERR "client pei $version\n" if $debug; print $S "client pei $version\n"; return 0 unless &got_from_server("$C_CMDOK talking to pei $version"); print STDERR "coun $country\n" if $debug; print $S "coun $country\n"; return 0 unless &got_from_server("$C_CMDOK country name $country"); print STDERR "\n"; print STDERR "pass $representative\n" if $debug; print $S "pass $representative\n"; return 0 unless &got_from_server("$C_CMDOK password ok"); print STDERR " -=O=-\n"; 1; } # return 1 if ok, return 0 if not ok. sub got_from_server { local($expect) = (@_); $_ = &sock'S_read($S, $TIMEOUT); #' print "status = $status\n" if $debug; return 0 if $status; print STDERR "$_\n" if $debug; chop; return 1 if /^$expect$/; return 1 if /^$C_BADCMD Command client not found/; # Empire2 doesn't support if (/^$C_CMDERR / || /^$C_BADCMD / || /^$C_EXIT / && $expect eq '$C_INIT 2') { print "$'\n"; } else { print STDERR "Expected: \"$expect\"\nGot: \"$_\"\n"; } 0; } # --- Error Recovery --- # # Call this function if our process is killed sub dokill { $SIG{'INT'} = 'dokill'; # call &dokill if the user types ^C print STDERR "\n"; if (!$coun || $nstatus eq 'DEITY') { &ih_print("DEITY interrupt <-+->\n"); &ih_print("This must mean trouble...\n"); print STDERR "pei shutting down...\n"; exit; } &ih_print("pei interrupt handler invoked <-+->\n"); # Abort wait $mode = 4 if $command eq 'wait'; if ($status & $S_INTERRUPT) { &ih_print("Interrupt received while handling another interrupt.\n"); &ask_to_die; &ih_print("Second interrupt ignored.\n"); return; } else { $status |= $S_INTERRUPT; } } # Called when a pipe breaks sub broken_pipe { $SIG{'PIPE'}='broken_pipe'; $status |= $S_BROKEN_PIPE; } sub ih_print { print STDERR "<-+-> ".pop(@_); } sub ask_to_die { local ($char); &do_exit if !(-t STDIN); # Don't ask tricky questions to a file $char = &getchar('Are you sure you want to exit pei? (y/n)'); return unless $char eq 'y'; &do_exit; } # When $status is not zero, loops and functions abort gracefully until # We are at the top level input loop. Then this function is called. # If STDIN is not a file, then we check $status to see what all the fuss # is about and then give the user a list of choices for how to deal with # the interruption. sub recover { local ($at_prompt) = @_; local ($char, $line, $rmask, $nfound); # Don't recover until we're at the top level input loop last if $depth > 1; # Go back to the connectloop to open a new game. return 1 if $status & $S_NEW_GAME; if ($status & $S_BROKEN_PIPE) { $status &= ~$S_BROKEN_PIPE; return 0; } if (!(-t STDIN)) { # Don't ask tricky questions to a file $line = 'Server EOF' if $status & $S_EOF; $line = 'Server Timeout' if $status & $S_TIMEOUT; $line = 'Process Interrupted' if $status & $S_INTERRUPT; print STDERR "$line\n"; &do_exit; } if ($status & $S_EOF) { if ($socket{$game}) { print STDERR "\nServer EOF\nGame died.\n"; &close_connection(1); } return 1; } if ($status & $S_TIMEOUT) { print STDERR "\nNet lag. Retry, Close connection, or More info? "; $char = &getchar('(r/c/m)'); if ($char eq 'r') { &slurp; return &recover if $status; return 0; } elsif ($char eq 'c') { &close_connection(1); return 1; } print STDERR <<"EOF"; pei has not heard from the Empire Server in $TIMEOUT seconds. Your last command was "$command". The last line pei read from the server was: "$serverline" If you want to change the length of time that pei waits to hear from the server, then set the value of \$TIMEOUT in the file "~/.peirc". For example, if you had a really bad lag, you might put the line: \$TIMEOUT = 360 in the file ~/.peirc to let pei wait 360 seconds to receive output from the server. EOF return &recover; } if ($status & $S_INTERRUPT) { $status &= ~$S_INTERRUPT; if ($at_prompt) { if ($mode eq $C_PROMPT) { &ih_print("Interrupt received at main prompt.\n"); $char = &getchar('Close connection? (y/n)'); if ($char eq 'y') { &close_connection(1); return 1; } return 0; } elsif ($mode eq $C_FLUSH) { &ih_print("Interrupted received at sub-prompt for the command \"$command\".\n"); $char = &getchar("Abort $command? (y/n)"); if ($char eq 'y') { &abort_command; return &recover if $status; return 0; } return 0; } } if ($mode == -1) { &ih_print("Interrupted while waiting for data from server (pei will naturally\n"); &ih_print("timeout after \$TIMEOUT = $TIMEOUT seconds).\n"); } &recover_data if $sock'TelnetBuffer{$S}; #' $rmask = ""; vec($rmask, fileno($S), 1) = 1; ($nfound, $rmask) = select($rmask, undef, undef, 0.01); if ($nfound) {return 1 if &recover_data;} &ih_print("Would you like to: resync pei with the server\n"); &ih_print(" test the connection to the server\n"); &ih_print(" close the connection\n"); $char = &getchar('(r/t/c)'); if ($char eq 'r') { &flush_server_output; return &recover if $status; return 0; } elsif ($char eq 't') { &ih_print("Testing connection with 10 second timeout..."); vec($rmask, fileno($S), 1) = 1; ($nfound, $rmask) = select($rmask, undef, undef, 10); print STDERR "done\n"; if ($nfound) { return 1 if &recover_data } &ih_print("I think there's nobody home.\n"); &close_connection(1); return 1; } &close_connection(1); return 1; } print STDERR "Internal error: Unknown status [$status]\n"; } sub getchar { local ($line, $char); local ($rin, $rout); do { $status &= ~$S_INTERRUPT; &prompt(@_); vec($rin, fileno(STDIN), 1)=1; select($rout=$rin, undef, undef, undef); if ($status & $S_INTERRUPT) { &ask_to_die; &ih_print("And now back to your regularly scheduled interrupt recovery prompt...\n"); } elsif (vec($rout, fileno(STDIN), 1)) { sysread(STDIN, $line, 2048); if ($line) { $char = substr($line,0,1); } } } while ($status & $S_INTERRUPT || !$char || $char !~ /^[a-z]$/); $char; } # There is data on the server. Give the player appropriate choices sub recover_data { &ih_print("There is output from the Empire Server waiting to be read.\n"); &ih_print("Would you like to: read server output\n"); &ih_print(" flush server output without reading it\n"); &ih_print(" close the connection\n"); $char = &getchar('(r/f/c)'); if ($char eq 'r') { &slurp; return &recover if $status; return 0; } elsif ($char eq 'f') { &flush_server_output; return &recover if $status; return 0; } &close_connection(1); return 1; } # Flush server output without parsing sub flush_server_output { local($syncronized, $wmask, $nfound); print STDERR "Testing to see if the server is listening...\n"; print STDERR "Client: \"Hey server, you've got smelly sockets!\"\n"; vec($wmask, fileno($S), 1) = 1; ($nfound, $wmask) = select(undef, $wmask, undef, $TIMEOUT); if (!$nfound) { print STDERR "Darn! The server is ignoring us!\n"; &close_connection(1); } print STDERR "Server: \"They smelled fine until you started sucking on them!\"\n"; print STDERR "(The server is listenning.)\n"; print STDERR "Flushing server output..."; print $S "aborted\nspy -1\n"; return if $status; $mode = -1; do { # flush server output until cprompt while (1) { $_ = &sock'S_read($S, $TIMEOUT); last if $status; $mode = substr($_,0,1); # grab the mode if ($mode eq $C_FLUSH) { print $S "aborted\n"; last if $status; } $syncronized = 1 if (/^1 Usage: spy / || /^1 "spy -1" is not a legal command/); last if ($mode eq $C_PROMPT); # we got a cprompt $mode = -1; } } while (!$syncronized && !$status); return 1 if $status; &parse_serverline; # set $timeused and $btus return 1 if $status; print STDERR "done\n"; } sub nofind_error { local ($file, $error, $no_exit) = @_; print STDERR "\n!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n"; if ($error) { print STDERR "ERROR: pei could not load the file \"$file\" because of the following error:\n"; warn $error; } print STDERR "WARNING: pei could not locate the file \"$file\"\n"; print STDERR " pei looked in the following directories for \"$file\":\n"; for (@INC) { print STDERR " $_\n"; } print STDERR "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\n"; exit 1 unless $no_exit; } # Send an abort to the server, read & parse server output until cprompt. # Assume we're at an sprompt of $command. sub abort_command { print STDERR "$command aborted.\n"; print $S "aborted\n"; &suck; } sub close_connection { local ($save_DB) = @_; if ($save_DB) { &set_game($game, 1); eval ("&".$game."'save_DB"); } if ($socket{$game}) { print STDERR "Closing connection for $game..."; &sock'close($socket{$game}); #' print STDERR "*CLICK*\n\n"; } undef $socket{$game}; undef $S; undef $country; undef $game; $status |= $S_EOF; } # Exit nicely sub do_exit { for $game (keys %socket) { next unless $socket{$game}; &close_connection(1); } &sock'close_all; #' Just in case we missed one. print STDERR "pei shutting down...\n"; exit; } # --- Read Init File --- # # Read commands from ~/.peirc. If there is no ~/.peirc, then try to make # one from an existing ~/.eifrc. sub read_peirc { local (*PEIRC); if (!(-r "$ENV{'HOME'}/.peirc")) { # if no ~/.peirc if (-r "$ENV{'HOME'}/.eifrc") { # if there is a ~/.eifrc &convert_eifrc_to_peirc; } } if (open(PEIRC,"<$ENV{'HOME'}/.peirc")) { $quiet = 1; # don't print commandlines read from ~/.peirc while () { if (/^\s*$/ || /^\s*#/) { # if all whitespace or commant next; # skip this line of input } if (/^[\$\&\@\%\{]/) { # if it's perl eval($_); # evaluate it next; } chop; # remove newline ($command,$commandarg)=split(/\s+/,$_,2); # split command and commandargs &local_prompt; if ($status & $S_INTERRUPT) { &ih_print("closing ~/.peirc"); $status &= ~$S_INTERRUPT; last; } } $quiet = 0; # print commandlines read from future files close (PEIRC); } else { print STDERR "Unable to open ~/.peirc for input\n"; } &set_game($AUTOGAME) if defined($AUTOGAME) && defined($games{$AUTOGAME}); if (!defined($PEIPATH)) { if (defined($ENV{'PEIPATH'})) { $PEIPATH = $ENV{'PEIPATH'}; } else { for (@INC) { if (-r "$_/help.pei") { $PEIPATH = $_; last; } } &nofind_error("help.pei", 0, 1) unless $PEIPATH; } } chop($PEIPATH = `pwd`) if $PEIPATH eq '.'; if (!(-r "$PEIPATH/help.pei")) { print STDERR <$ENV{'HOME'}/.peirc")) { # open #/.peirc for write print STDERR "Unable to open ~/.eifrc for output\n"; close(EIFRC); return; } # convert ~/.eifrc to ~/.peirc while () { next if /connect/; s/;\s*&/; ?/g; # replace sub-prompts s/@/:/g; # replace @ with : # Replace ${1:x} variables where possible. Warn if not possible. s/\${(\w+):\+}([\s|\"|\'])/\$$1$2/g; s/\${(\w+):\+}/${$1}/g; if (s/\${(\w+):\-([^}]+)}/".(\$$1?\$$1:"$2")."/g) { s/^\s*alias\s+(\w+)\s+(.+)$/alias $1 $2/; } if (/(\${.*:.*\})/) { print STDERR "Unable to convert string \"$&\" on line number $.:\n$_\n\n"; next; } if (/^\s*addgame/) { # convert addgame lines split; $_ = "addgame @_[1] @_[4] @_[5] @_[2] @_[3] @_[6]\n"; } elsif (/^\s*setvar\s+(\S+)\s+(\S.*)\n$/) { # convert setvar lines $_ = "\$$1 = " . "ify($2) . "\n"; } print PEIRC; } close(PEIRC); close(EIFRC); print STDERR "done\n"; } # --- Function Maps --- # # This function reads and parses commands from a specified file sub execfile { local ($filename) = $commandarg; $filename =~ s/~/$ENV{'HOME'}/g; &runcommands ("<$filename"); print STDERR "End of file \"$filename\"\n" unless $quiet; } # This function runs a program and pipes the output to pei sub runfeed { local ($filename) = $commandarg; $filename =~ s/~/$ENV{'HOME'}/g; eval('&runcommands("'.$filename.'|")'); print STDERR "End of runfeed \"$filename\"\n"; } # This function runs commands from a file or pipe sub runcommands { local($FH) = ++$new_filehandle; if (!open($FH,pop(@_))) { print STDERR "Unable to open $commandarg\n"; return; } &fmainloop($FH); # parse the commands using fmainloop close($FH); } # Print a history of recent commands. sub history { local ($n) = $commandarg?$commandarg:$maxhistorysize; local ($i); # history index $n = $#history if $#history < $n; for ($i = $#history - $n; $i < $#history; ++$i) { printf "%-4d %s\n", $i, $history[$i]; } } # --- Strings Subroutines --- # # Prepare a commandline for evaluation by putting double quotes around it. sub quotify { local ($val) = @_; if ($val =~ /^\"|^\'/) { # it's already enclosed in quotes return $val; # leave it alone } $val =~ s/\"/\\\"/g; # \ escape internal quotes return '"' . $val . '"'; # enclose in double quotes } # Remove bracketing quotes from text sub strip_quotes { local (*s) = @_; $s =~ s/^\"(.*)\"$/$1/; $s =~ s/^\'(.*)\'$/$1/; } sub line_prompt { local ($line); local ($rin, $rout); do { $status &= ~$S_INTERRUPT; &prompt(@_); vec($rin, fileno(STDIN), 1)=1; select($rout=$rin, undef, undef, undef); if ($status & $S_INTERRUPT) { &ask_to_die; &ih_print("And now back to your regularly scheduled prompt...\n"); } elsif (vec($rout, fileno(STDIN), 1)) { sysread(STDIN, $line, 2048); chop($line); } } while ($status & $S_INTERRUPT); $line; } sub bug {print STDERR "#$_[0]#\n";} 1; pei/simu.pl000644 002123 000322 00000043210 05777462675 014401 0ustar00childrenpstaff000000 2517020 # simu.pl was written by Drake Diedrich, and automatically converted to work # with pei using $Id: simu.pl,v 2.3 1995/07/08 11:02:14 children Beta $ $main'functionmap{'simu'}='&tools_simu'; #' # $Id: simu.pl,v 2.3 1995/07/08 11:02:14 children Beta $ # # Update simulator for hpc/pei # # order as per global/item.c. sub tools_simu { local($area); $area = $main'commandarg; #' $area = '*' unless $area; &build_sect_target($area); &print_n_parse("dump *") unless $area eq '*'; &print_n_parse("prod *"); &print_n_parse("neweff *"); &print_n_parse("ship *"); &print_n_parse("plane *"); &print_n_parse("land *"); local (%dump) = %dump; local (%uniteff) = %uniteff; local (%shipeff) = %shipeff; local (%planeeff) = %planeeff; local (%imported,%exported,%start,%produce,%consume,%delta,%net); local (@sectorder,@tmp); foreach $sect (keys %own) { if ($own{$sect}==$coun) { push(@tmp,$sect); } } @sectorder = sort sortsect @tmp; foreach $comm (keys %weight) { foreach $sect (@sectorder) { if ($dump{$sect,$comm}>0) { $start{$comm} += $dump{$sect,$comm}; } } } $start{"tech"} = $tech{$coun} if ($tech{$coun}>0); $start{"medic"} = $res{$coun} if ($res{$coun}>0); $start{"edu"} = $edu{$coun} if ($edu{$coun}>0); $start{"happy"} = $hap{$coun} if ($hap{$coun}>0); &unitupdate; &shipupdate; &planeupdate; §update; &distexport; &distimport; foreach $comm (keys %produce) { if ($produce{$comm}>0) { $start{$comm}=0 unless defined($start{$comm}); } } foreach $comm (keys %consume) { if ($consume{$comm}) { $start{$comm}=0 unless defined($start{$comm}); } } $consume{"tech"} = $start{"tech"} * $level_decay_rate; $consume{"medic"} = $start{"medic"} * $level_decay_rate; foreach $comm (keys %start) { $delta{$comm} = $produce{$comm} - $consume{$comm}; $net{$comm} = $start{$comm} + $produce{$comm} - $consume{$comm}; } if ($produce{"tech"} > $easytech) { $delta{"tech"} = $easytech + log($produce{"tech"}-$easytech+1)/log($logtech); $net{"tech"} = $start{"tech"} + $delta{"tech"} - $consume{"tech"};; } if ($produce{"medic"} > 0.75) { $delta{"medic"} = 0.75 + log($produce{"medic"}-0.75+1)/log(2.0); $net{"medic"} = $start{"medic"} + $delta{"medic"} - $consume{"medic"};; } if ($produce{"edu"}) { $delta{"edu"} = $produce{"edu"} * 4000 * int($etu/12) / $start{"civ"}; if ($delta{"edu"}>5) { $delta{"edu"} = ($delta{"edu"}-5)/(log(1+$delta{"edu"})/log(4)) + 5; } $net{"edu"} = ($start{"edu"}*(192-$etu) + $delta{"edu"} * $etu)/192; } if ($produce{"happy"}) { $delta{"happy"} = $produce{"happy"} * 5000 * int($etu/12) / $start{"civ"}; if ($delta{"happy"}>5) { $delta{"happy"} = ($delta{"happy"}-5)/(log(1+$delta{"happy"})/log(6)) + 5; } $net{"happy"} = ($start{"happy"}*(192-$etu) + $delta{"happy"} * $etu)/192; } print " sect des eff mob make imports exports commodities\n"; foreach $sect (@sectorder) { next if !$target{$sect}; printf("%3d,%-3d %s %3d%% %3d", $dump{$sect,"x"},$dump{$sect,"y"}, $dump{$sect,"des"},$dump{$sect,"eff"},$dump{$sect,"mob"}); if (defined($will{$sect})) { printf(" %4s",$will{$sect} . substr($make{$sect},0,1)); printf(" ") if (length($will{$sect} . "a") < 5); } elsif ($dump{$sect,"avail"}>0) { printf(" %3da ",$dump{$sect,"avail"}); } else { print " "; } $impstr=""; foreach $comm (keys %weight) { if ($imported{$sect,$comm}>0) { $impstr .= sprintf(" %d%s",$imported{$sect,$comm},substr($comm,0,1)); } } printf("%-14s ",$impstr); $expstr=""; foreach $comm (keys %weight) { if ($exported{$sect,$comm}>0) { $expstr .= sprintf(" %d%s",$exported{$sect,$comm},substr($comm,0,1)); } } printf("%-14s ",$expstr); { local ($thresh); foreach $comm (keys %weight) { if ($dump{$sect,$comm}>0) { printf(" %d%s",$dump{$sect,$comm},substr($comm,0,1)); $thresh = $dump{$sect,substr($comm,0,1) . "_dist"}; if ($thresh>0) { print "+" if $dump{$sect,$comm} > $thresh; print "-" if $dump{$sect,$comm} < $thresh; } } } } print "\n"; } } sub sortsect { local (@a, @b); @a = split(',',$a); @b = split(',',$b); ($a[1] <=> $b[1]) || ($a[0] <=> $b[0]); } sub sectupdate { foreach $sect (@sectorder) { if (!defined($option{"NOFOOD"})) { $eat = ($dump{$sect,"civ"}+$dump{$sect,"mil"}+$dump{$sect,"uw"}) * $etu * $eatrate; $eat += 2*($dump{$sect,"civ"}*$obrate + $dump{$sect,"uw"}*$uwbrate) * $etu * $babyeat; $dump{$sect,"food"} -= int($eat); $consume{"food"} += $eat; } if ($dump{$sect,"food"} < -1) { printf("** Warning: need %d more food in %s **\n",-$dump{$sect,"food"},$sect) if $verbose; $dump{$sect,"work"}=0; if (defined($option{"NEW_STARVE"})) { local ($starve); $starve = -$dump{$sect,"food"} / $etu / $eatrate; if ($starve * 2 > $dump{$sect,"uw"} + $dump{$sect,"civ"} + $dump{$sect,"mil"}) { $starve = int(($dump{$sect,"uw"} + $dump{$sect,"civ"} + $dump{$sect,"mil"})/2); } if ($starve <= $dump{$sect,"uw"}) { $dump{$sect,"uw"} -= $starve; $consume{"uw"} += $starve; } else { $starve -= $dump{$sect,"uw"}; $consume{"uw"} += $dump{$sect,"uw"}; $dump{$sect,"uw"}=0; if ($starve <= $dump{$sect,"civ"}) { $dump{$sect,"civ"} -= $starve; $consume{"civ"} += $starve; } else { $starve -= $dump{$sect,"civ"}; $consume{"civ"} += $dump{$sect,"civ"}; $dump{$sect,"civ"} = 0; $consume{"mil"} += $starve; $dump{$sect,"mil"} -= $starve; } } } else { $consume{"civ"} += $dump{$sect,"civ"}/2; $consume{"mil"} += $dump{$sect,"mil"}/2; $consume{"uw"} += $dump{$sect,"uw"}/2; $dump{$sect,"civ"} /= 2; $dump{$sect,"mil"} /= 2; $dump{$sect,"uw"} /= 2; } } else { $produce{"civ"} -= $dump{$sect,"civ"}; $produce{"uw"} -= $dump{$sect,"uw"}; $dump{$sect,"civ"} += int($dump{$sect,"civ"} * $etu * $obrate); $dump{$sect,"uw"} += int($dump{$sect,"uw"} * $etu * $uwbrate); $dump{$sect,"civ"} = $maxpop if ($dump{$sect,"civ"} > $maxpop); $dump{$sect,"uw"} = $maxpop if ($dump{$sect,"uw"} > $maxpop); $produce{"civ"} += $dump{$sect,"civ"}; $produce{"uw"} += $dump{$sect,"uw"}; } } foreach $sect (@sectorder) { $dump{$sect,'avail'} = ($dump{$sect,'civ'} * $dump{$sect,'work'}/100 + $dump{$sect,'uw'} + $dump{$sect,'mil'} * 0.4) * $etu / 100; } foreach $sect (keys %neweff) { if ($dump{$sect,'des'} ne $newdes{$sect}) { $dump{$sect,'avail'} -= $neweff{$sect}+$dump{$sect,'eff'}/4; } else { $dump{$sect,'avail'} -= $neweff{$sect}-$dump{$sect,'eff'}; } $dump{$sect,"des"} = $newdes{$sect}; $dump{$sect,"eff"} = $neweff{$sect}; } foreach $sect (keys %will) { if ($will{$sect}+$dump{$sect,$make{$sect}} > 999) { $produce{$make{$sect}} += 999-$dump{$sect,$make{$sect}}; $dump{$sect,$make{$sect}} = 999; } else { $produce{$make{$sect}} += $will{$sect}; $dump{$sect,$make{$sect}} += $will{$sect}; } } foreach $sect (keys %use1) { $consume{$comm1{$sect}} += $use1{$sect}; $dump{$sect,$comm1{$sect}} -= $use1{$sect}; } foreach $sect (keys %use2) { $consume{$comm2{$sect}} += $use2{$sect}; $dump{$sect,$comm2{$sect}} -= $use2{$sect}; } foreach $sect (keys %use3) { $consume{$comm3{$sect}} += $use3{$sect}; $dump{$sect,$comm3{$sect}} -= $use3{$sect}; } } sub unitupdate { local ($sect,$bcost,$lcm,$hcm,$mil,$gun,$shell,$avail); foreach $n (sort { $a <=> $b } keys %unitname) { $sect = $unitsect{$n}; if ($dump{$sect, 'des'} eq '!') { $bcost = 100 - $uniteff{$n}; if ($bcost > $uniteff) { $bcost = $uniteff; } $lcm = $bcost * $buildlcm{$unitname{$n}} / 100; if ($lcm > $dump{$sect,"lcm"}) { $bcost = 100 * $dump{$sect,'lcm'} / $buildlcm{$unitname{$n}} } $hcm = $bcost * $buildhcm{$unitname{$n}} / 100; if ($hcm > $dump{$sect,"hcm"}) { $bcost = 100 * $dump{$sect,'hcm'} / $buildhcm{$unitname{$n}} } $mil = $bcost * $buildmil{$unitname{$n}} / 100; if ($mil > $dump{$sect,"mil"}) { $bcost = 100 * $dump{$sect,'mil'} / $buildmil{$unitname{$n}} } $gun = $bcost * $buildgun{$unitname{$n}} / 100; if ($gun > $dump{$sect,"gun"}) { $bcost = 100 * $dump{$sect,'gun'} / $buildgun{$unitname{$n}} } $shell = $bcost * $buildshell{$unitname{$n}} / 100; if ($shell > $dump{$sect,"shell"}) { $bcost = 100 * $dump{$sect,'shell'} / $buildshell{$unitname{$n}} } $avail = $bcost * (20 + $buildlcm{$unitname{$n}} + 2 * $buildhcm{$unitname{$n}}) / 100; if ($avail > $dump{$sect,"avail"}) { $bcost = 100 * $dump{$sect,'avail'} / (20 + $buildlcm{$unitname{$n}} + 2 * $buildhcm{$unitname{$n}}); } $dump{$sect,"lcm"} -= $bcost * $buildlcm{$unitname{$n}} / 100; $dump{$sect,"hcm"} -= $bcost * $buildhcm{$unitname{$n}} / 100; $dump{$sect,"mil"} -= $bcost * $buildmil{$unitname{$n}} / 100; $dump{$sect,"gun"} -= $bcost * $buildgun{$unitname{$n}} / 100; $dump{$sect,"shell"} -= $bcost * $buildshell{$unitname{$n}} / 100; $dump{$sect,"avail"} -= $bcost * (20 + $buildlcm{$unitname{$n}} + 2 * $buildhcm{$unitname{$n}}) / 100; $consume{"lcm"} += $bcost * $buildlcm{$unitname{$n}} / 100; $consume{"hcm"} += $bcost * $buildhcm{$unitname{$n}} / 100; $consume{"mil"} += $bcost * $buildmil{$unitname{$n}} / 100; $consume{"gun"} += $bcost * $buildgun{$unitname{$n}} / 100; $consume{"shell"} += $bcost * $buildshell{$unitname{$n}} / 100; $uniteff{$n} += $bcost; } } } sub shipupdate { local ($sect,$bcost,$lcm,$hcm,$mil,$gun,$shell,$avail); foreach $n (sort keys %shipname) { $sect = $shipsect{$n}; if ($dump{$sect, 'des'} eq 'h') { $bcost = 100 - $shipeff{$n}; if ($bcost > $maxshipeff) { $bcost = $maxshipeff; } $lcm = $bcost * $buildlcm{$shipname{$n}} / 100; if ($lcm > $dump{$sect,"lcm"}) { $bcost = 100 * $dump{$sect,'lcm'} / $buildlcm{$shipname{$n}} } $hcm = $bcost * $buildhcm{$shipname{$n}} / 100; if ($hcm > $dump{$sect,"hcm"}) { $bcost = 100 * $dump{$sect,'hcm'} / $buildhcm{$shipname{$n}} } $mil = $bcost * $buildmil{$shipname{$n}} / 100; if ($mil > $dump{$sect,"mil"}) { $bcost = 100 * $dump{$sect,'mil'} / $buildmil{$shipname{$n}} } $gun = $bcost * $buildgun{$shipname{$n}} / 100; if ($gun > $dump{$sect,"gun"}) { $bcost = 100 * $dump{$sect,'gun'} / $buildgun{$shipname{$n}} } $shell = $bcost * $buildshell{$shipname{$n}} / 100; if ($shell > $dump{$sect,"shell"}) { $bcost = 100 * $dump{$sect,'shell'} / $buildshell{$shipname{$n}} } $avail = $bcost * (20 + $buildlcm{$shipname{$n}} + 2 * $buildhcm{$shipname{$n}}) / 100; if ($avail > $dump{$sect,"avail"}) { $bcost = 100 * $dump{$sect,'avail'} / (20 + $buildlcm{$shipname{$n}} + 2 * $buildhcm{$shipname{$n}}); } $dump{$sect,"lcm"} -= $bcost * $buildlcm{$shipname{$n}} / 100; $dump{$sect,"hcm"} -= $bcost * $buildhcm{$shipname{$n}} / 100; $dump{$sect,"mil"} -= $bcost * $buildmil{$shipname{$n}} / 100; $dump{$sect,"gun"} -= $bcost * $buildgun{$shipname{$n}} / 100; $dump{$sect,"shell"} -= $bcost * $buildshell{$shipname{$n}} / 100; $dump{$sect,"avail"} -= $bcost * (20 + $buildlcm{$shipname{$n}} + 2 * $buildhcm{$shipname{$n}}) / 100; $consume{"lcm"} += $bcost * $buildlcm{$shipname{$n}} / 100; $consume{"hcm"} += $bcost * $buildhcm{$shipname{$n}} / 100; $consume{"mil"} += $bcost * $buildmil{$shipname{$n}} / 100; $consume{"gun"} += $bcost * $buildgun{$shipname{$n}} / 100; $consume{"shell"} += $bcost * $buildshell{$shipname{$n}} / 100; $shipeff{$n} += $bcost; } } } # doesn't check for carrier work yet. sub planeupdate { local ($sect,$bcost,$lcm,$hcm,$mil,$gun,$shell,$avail); foreach $n (sort keys %planename) { $sect = $planesect{$n}; if ($dump{$sect, 'des'} eq '*') { $bcost = 100 - $planeeff{$n}; if ($bcost > $planeeff) { $bcost = $planeeff; } $lcm = $bcost * $buildlcm{$planename{$n}} / 100; if ($lcm > $dump{$sect,"lcm"}) { $bcost = 100 * $dump{$sect,'lcm'} / $buildlcm{$planename{$n}} } $hcm = $bcost * $buildhcm{$planename{$n}} / 100; if ($hcm > $dump{$sect,"hcm"}) { $bcost = 100 * $dump{$sect,'hcm'} / $buildhcm{$planename{$n}} } $mil = $bcost * $buildmil{$planename{$n}} / 100; if ($mil > $dump{$sect,"mil"}) { $bcost = 100 * $dump{$sect,'mil'} / $buildmil{$planename{$n}} } $gun = $bcost * $buildgun{$planename{$n}} / 100; if ($gun > $dump{$sect,"gun"}) { $bcost = 100 * $dump{$sect,'gun'} / $buildgun{$planename{$n}} } $shell = $bcost * $buildshell{$planename{$n}} / 100; if ($shell > $dump{$sect,"shell"}) { $bcost = 100 * $dump{$sect,'shell'} / $buildshell{$planename{$n}} } $avail = $bcost * (20 + $buildlcm{$planename{$n}} + 2 * $buildhcm{$planename{$n}}) / 100; if ($avail > $dump{$sect,"avail"}) { $bcost = 100 * $dump{$sect,'avail'} / (20 + $buildlcm{$planename{$n}} + 2 * $buildhcm{$planename{$n}}); } $dump{$sect,"lcm"} -= $bcost * $buildlcm{$planename{$n}} / 100; $dump{$sect,"hcm"} -= $bcost * $buildhcm{$planename{$n}} / 100; $dump{$sect,"mil"} -= $bcost * $buildmil{$planename{$n}} / 100; $dump{$sect,"gun"} -= $bcost * $buildgun{$planename{$n}} / 100; $dump{$sect,"shell"} -= $bcost * $buildshell{$planename{$n}} / 100; $dump{$sect,"avail"} -= $bcost * (20 + $buildlcm{$planename{$n}} + 2 * $buildhcm{$planename{$n}}) / 100; $consume{"lcm"} += $bcost * $buildlcm{$planename{$n}} / 100; $consume{"hcm"} += $bcost * $buildhcm{$planename{$n}} / 100; $consume{"mil"} += $bcost * $buildmil{$planename{$n}} / 100; $consume{"gun"} += $bcost * $buildgun{$planename{$n}} / 100; $consume{"shell"} += $bcost * $buildshell{$planename{$n}} / 100; $planeeff{$n} += $bcost; } } } sub distexport { local ($cost,$com,$lev); foreach $source (@sectorder) { $dest = $dump{$source,'dist_x'} . "," . $dump{$source,'dist_y'}; $cost = &pathcost($source,$dest); if ($cost>1000) { print "Unable to find path from $source to $dest\n"; next; } next if ($source eq $dest); foreach $c (@commo) { $comm=$dump{$source,$commstr{$c}}; $lev=$dump{$source,$c . "_dist"}; if ($lev>0 && $comm>$lev) { $move=$comm-$lev; $tmp = 9990-$dump{$dest,$commstr{$c}}; if ($tmp<$move) { $move = $tmp; } $mcost = $cost * $move/4; if (($dump{$dest,'des'} eq 'w' && $dump{$dest,"eff"}>=60) || ($dump{$source,'des'} eq 'w' && $dump{$source,"eff"}>=60)) { $mcost /= $packing{$commstr{$c}}; } elsif ($dump{$source,'des'} eq 'b' && $dump{$source,"eff"}>=60 && $c eq 'b') { $mcost /= 4; } if ($mcost > $dump{$source,"mob"}) { $move *= $dump{$source,"mob"}/$mcost; $mcost = $dump{$source,"mob"}; } if ($move>0) { $dump{$source,$commstr{$c}} -= $move; $dump{$source,"mob"} -= $mcost; $dump{$dest,$commstr{$c}} += $move; $exported{$source,$commstr{$c}} += $move; $imported{$dest,$commstr{$c}} += $move; } } } } } sub distimport { local ($cost,$com,$lev); foreach $dest (@sectorder) { $source = $dump{$dest,'dist_x'} . "," . $dump{$dest,'dist_y'}; $cost = &pathcost($source,$dest); if ($cost>1000) { print "Unable to find path from $source to $dest\n"; next; } next if ($source eq $dest); foreach $c (@commo) { $comm=$dump{$dest,$commstr{$c}}; $lev=$dump{$dest,$c . "_dist"}; if ($lev>0 && $lev>$comm) { $move=$lev-$comm; $tmp = $dump{$source,$commstr{$c}}; if ($tmp<$move) { $move = $tmp; } $mcost = $cost * $move/4; if (($dump{$dest,'des'} eq 'w' && $dump{$dest,"eff"}>=60) || ($dump{$source,'des'} eq 'w' && $dump{$source,"eff"}>=60)) { $mcost /= $packing{$commstr{$c}}; } elsif ($dump{$source,'des'} eq 'b' && $dump{$source,"eff"}>=60 && $c eq 'b') { $mcost /= 4; } if ($mcost > $dump{$source,"mob"}) { $move *= $dump{$source,"mob"}/$mcost; $mcost = $dump{$source,"mob"}; } if ($move>0) { $dump{$source,$commstr{$c}} -= $move; $dump{$source,"mob"} -= $mcost; $dump{$dest,$commstr{$c}} += $move; $exported{$source,$commstr{$c}} += $move; $imported{$dest,$commstr{$c}} += $move; } } } } } sub pathcost { local($from, $to) = @_; local(%cost,%marked); $cost{$from} = 0; while (!(defined $cost{$to}) && &buildcost(*cost, *marked)) { ; } if (defined $cost{$to}) { return $cost{$to}; } else { return 1e9; } 9999; } print "Loaded simu.pl\n" if $verbose; 1; $main'simu_loaded = 1 pei/sock.pl000644 002123 000322 00000013044 05777130344 014334 0ustar00childrenpstaff000000 2500000 #/usr/local/bin/perl package sock; ;# USAGE: ;# ====== ;# ;# To open a connection to a socket: ;# ;# $handle = &sock'open($hostname, $port) || die $!; ;# # hostname & port can each be either a name or a number ;# ;# Read and write the same as with any other file handle: ;# ;# print $handle "hello, socket\n"; ;# $response = <$handle>; ;# ;# To close cleanly: ;# ;# &sock'close($handle); ;# ;# To close all open sockets, in case of an emergency exit: ;# ;# &sock'close_all; ;# ;# AUTHOR: David Noble (dnoble@ufo.jpl.nasa.gov) ;# DATE: 11 Feb 1993 ;# ;# Modify and use as you see fit, but please leave my name on ;# it as long as it still resembles the original code. ;# ;############################################################################# ;# Get system-specific socket parameters, make assumptions if necessary. $sockaddr_t = 'S n a4 x8'; eval "require 'sys/socket.ph'"; eval <<'END_SOCKET_DEFINITIONS' if $@; sub AF_INET { 2; } sub SOCK_STREAM { 1; } sub SOL_SOCKET { 65535; } sub SO_REUSEADDR { 4; } END_SOCKET_DEFINITIONS ;# Seed the generation of names for file handles. $latest_handle = 'sock0000000001'; sub open { local ($remote_host, $remote_port) = @_; if (!$remote_port) { $! = "bad arguments to sock'open()"; return 0; } $sock = ++$latest_handle; ;# Look up the port if it was specified by name instead of by number. if ($remote_port =~ /\D/o) { ($name,$aliases,$remote_port) = getservbyname($remote_port,'tcp'); } ;# Look up the address if it was specified by name instead of by number. if ($remote_host =~ /\D/o) { ($name,$aliases,$type,$len,$remote_addr) = gethostbyname($remote_host); } else { $remote_addr = $remote_host; } ;# Make the socket structures. $this = pack($sockaddr_t, &AF_INET, 0, "\0\0\0\0"); $remote_sock = pack($sockaddr_t, &AF_INET, $remote_port, $remote_addr); ;# Make the socket filehandle. ($name,$aliases,$proto) = getprotobyname('tcp'); socket($sock, &AF_INET, &SOCK_STREAM, $proto) || return 0; ;# Set up the port so it's freed as soon as we're done. setsockopt($sock, &SOL_SOCKET, &SO_REUSEADDR, 1); ;# Bind this socket to an address. bind($sock, $this) || return 0; ;# Call up the remote socket. connect($sock,$remote_sock) || return 0; $handles{$sock} = 1; $oldfh = select($sock); $| = 1; select($oldfh); return "sock'" . $sock; } sub close { local ($sock) = shift(@_) || return 0; shutdown ($sock, 2); delete $handles{$sock}; } sub close_all { for $sock (keys %handles) { shutdown ($sock, 2); delete $handles{$sock}; } } # USAGE: # ====== # # $line = &S_read($handle, $timeout); # # INPUTS: # # $handle - regular file handle returned by opening the socket # $timeout - number of seconds to wait before returning empty-handed # # RETURN VALUE: # # Returns data from the socket after removing the garbage from telnet # handshaking. # Only one line at a time is returned. The remaining lines are buffered, # and will be used to satisfy further requests for data until # the buffer is empty again. A partial line may be returned if the timeout # was reached before a newline. # # Returns the empty string on EOF or timeout. # To decide which it was, use these variables: # # if (!$main'status) { # &data_received; # } elsif ($main'status & $main'S_EOF) { # &outta_here; # server EOF # } elsif ($main'status & $main'S_TIMEOUT) { # &whatever; # read timed out # } # # AUTHOR: David Noble (dnoble@ufo.jpl.nasa.gov) # DATE: 11 Feb 1993 # Modified for use by pei by Ken Stevens 14 June 95 # # Modify and use as you see fit, but please leave my name on # it as long as it still resembles the original code. # ############################################################################# sub S_read { local ($handle, $endtime) = @_; local ($rmask, $nfound, $nread, $thisbuf, $buf); $main'status &= ~($main'S_EOF | $main'S_TIMEOUT); if ($TelnetBuffer{$handle} =~ m/\n/) { $TelnetBuffer{$handle} =~ s/^(.*\n)//; $buf = $1; } else { $endtime += time; $* = 1; get_data: while ($endtime > time) { $rmask = ""; $thisbuf = ""; vec($rmask, fileno($handle), 1) = 1; ($nfound, $rmask) = select($rmask, undef, undef, $endtime - time); if ($nfound) { $nread = sysread($handle, $thisbuf, 1024); if ($nread > 0) { $TelnetBuffer{$handle} .= $thisbuf; last get_data if &_preprocess($handle); } else { $main'status |= $main'S_EOF; $* = 0; return ''; # connection closed } } else { $main'status |= $main'S_TIMEOUT; last get_data; } } $* = 0; if ($TelnetBuffer{$handle} =~ m/\n/) { $TelnetBuffer{$handle} =~ s/^(.*\n)//; $buf = $1; } else { $main'status |= $main'S_TIMEOUT; } } $buf; } sub _preprocess { local ($handle) = @_; local ($_) = $TelnetBuffer{$handle}; s/\015\012/\012/go; # combine (CR NL) into NL while (m/\377/) { # respond to "IAC DO x" or "IAC DON'T x" with "IAC WON'T x" if (s/([^\377])?\377[\375\376](.|\n)/\1/) { print $handle "\377\374$2"; } # ignore "IAC WILL x" or "IAC WON'T x" elsif (s/([^\377])?\377[\373\374](.|\n)/\1/) {;} # respond to "IAC AYT" (are you there) elsif (s/([^\377])?\377\366/\1/) { print $handle "nobody here but us pigeons\n"; } else { last; } } s/\377\377/\377/go; # handle escaped IAC characters $TelnetBuffer{$handle} = $_; m/\n/; # return value: whether there is a full line or not } pei/tools.pl000644 002123 000322 00000255315 06034435513 014557 0ustar00childrenpstaff000000 2517260 # $Id: tools.pl,v 2.3 1995/07/08 11:02:14 children Beta $ # # Perl Empire Interface Tools # # Written by Drake Diedrich, Ken Stevens, and Sam Tetherow # # # DESCRIPTION: # This perl module illustrates how user defined perl tools may be integrated # into pei. A list of the tools that it contains may be found in the file # "tools.man". # # INSTALLATION: # You do not need to do anything to install tools.pl. It will be automatically # included into pei when you connect to a game. Just make sure that it # is in the same directory as pei when pei is run. Or you can put tools.pl # in the directory ~/perl and add the following line to your ~/.login file: # setenv PERLLIB ~/perl # # Type "help tools" from within pei for the syntax of tool commands, # or read the file help.tools that comes with pei. # # AUTHORS: # Drake Diedrich and Ken Stevens co-wrote: # nova, xmvr, and router. # Sam Tetherow and Ken Stevens co-wrote: # delta, fdelta, tele, anno, mail, and wmail. # Ken Stevens wrote: # setfood, rebel, reach, sreach, lreach, and civs. # Sam Tetherow wrote: # sneweff, pneweff, lneweff, foreach, wdelta, stat, sstat, pstat, and lstat. # # BUG REPORTS: # mail your bug-reports and comments to: # Sam Tetherow # --- Global variables --- # # General tool variables: # %xdir, %ydir x,y direction vectors # @dirstr The six directions # $maxpath Maximum path length used by any of the tools # @desig Sector designations # @commo Commodities # %weight Weights of commodities # %packing Warehouse packing factors for commodities # %commstr Converts 'f' to 'food', etc... # %target Contains list of sectors in argument # # xmvr variables: # %minmob Minimum mob to be left in sector (by designation) # # External variables: # $main'tools_loaded Used by pei to determine if we need country number # --- Functions --- # # Initialization functions: # xmvr_init Initialize variables used by xmvr # comm_init Initialize commodity variables # buildcost_init Initialize variables used by buildcost # # Buildcost functions: # wrap If sector co-ords wrap around the world, fix them # adjacent Return an array of the six sectors adjacent to arg # movcost The mob cost to move into sector arg # buildcost Build up path costs for nearby sectors # # Nova functions: # border_sectors Find unowned '-' sectors on my border # makepath Find the cheapest path to an unowned sector # nova Explore into adjacent unowned '-' sectors # tools_supernova Keep calling nova until all '-' are explored # # xmvr functions: # do_move Move a commodity from one sector to another # tools_xmvr Move commodities based on $maxciv, $maxuw, or thresh # # Router functions: # useless Return a list of sectors in need of redesignation # tools_router Dist sectors to the nearest warehouse # # Setfood functions: # tools_setfood Set food thresholds for maximum civ growth # # External functions: # main'find_country_number Find my country number # main'tools_init Set $country, $coun, $btus, and $timeused # # Sam Tetherow's Functions # tools_landeff user interface for build_units # build_units Actual unit calculations # tools_planeeff user interface for build_planes # build_planes Actual plane calculations # tools_shipeff user interface for build_ships # build_ships Actual ship calculations # max return max of 2 numbers # min return min of 2 numbers # round standard round # getline stub for &main'getline # tools_foreach issue a command for an AREA of sectors # resolve evaluate variables in foreach command # resolve evaluate variables in foreach command # tools_prod_delta compute production delta for a country # tools_food_delta estimate civ/uw/food production # tools_warehouse_delta estimate deltas for dist centers # prod_warn used in tools_*_delta # in_realm return 1 if sect in a realm # tools_status show sector info from DB # tools_lstat show land info from DB # tools_pstat show plane info from DB # tools_sstat show ship info from DB # makerealm return all sectors in a realm (used in stat) # --- Main --- &buildcost_init; # initialize buildcost variables &comm_init; # initialize commodity variables &xmvr_init; # initialize xmvr variables # --- Initialization --- # You may wish to change some of the variables in xmvr_init. # The variables in this subroutine are used by xmvr. sub xmvr_init { local ($des, $comm); # The associative array $minmob{$des} specifies the minimum amount # of mobility we want left in a sector after moving stuff out. $minmob{'w'} = 60; $minmob{'e'} = 80; # need to move mil out of enlistment centres # b,l,t,r,p,) don't need to have much mob... $minmob{'b'} = 20; $minmob{'l'} = 20; $minmob{'t'} = 20; $minmob{'r'} = 20; $minmob{'p'} = 20; $minmob{')'} = 0; # Set $minmob to 40 for all other sector types: foreach $des (@desig) { $minmob{$des} = 40 unless defined($minmob{$des}); } foreach $comm (@commo) { $main'functionmap{$comm.'mvr'} = "&tools_xmvr('$comm')"; #' } } # Initialize commodity variables sub comm_init { # Sector designations @desig = ('-', '^', 'c', 'p', '+', ')', '#', '=', 'd', 'i', 'm', 'g', 'h', 'w', 'u', '*', 'a', 'o', 'j', 'k', '%', 't', 'f', 'r', 'n', 'l', 'e', '!', 'b'); # Commodities. @commo = ('c', 'm', 'u', 'f', 's', 'g', 'p', 'i', 'd', 'b', 'o', 'l', 'h', 'r'); # Commodity weights and warehouse packing factors. $weight{'civ'} = 1; $packing{'civ'} = 4; $weight{'mil'} = 1; $packing{'mil'} = 1; $weight{'uw'} = 2; $packing{'uw'} = 2; $weight{'food'} = 1; $packing{'food'} = 10; $weight{'shell'} = 1; $packing{'shell'} = 10; $weight{'gun'} = 10; $packing{'gun'} = 10; $weight{'pet'} = 1; $packing{'pet'} = 10; $weight{'iron'} = 1; $packing{'iron'} = 10; $weight{'dust'} = 5; $packing{'dust'} = 10; $weight{'bar'} = 50; $packing{'bar'} = 5; $weight{'oil'} = 1; $packing{'oil'} = 10; $weight{'lcm'} = 1; $packing{'lcm'} = 10; $weight{'hcm'} = 1; $packing{'hcm'} = 10; $weight{'rad'} = 8; $packing{'rad'} = 10; # Commodity strings $commstr{'c'} = 'civ'; $commstr{'m'} = 'mil'; $commstr{'u'} = 'uw'; $commstr{'f'} = 'food'; $commstr{'s'} = 'shell'; $commstr{'g'} = 'gun'; $commstr{'p'} = 'pet'; $commstr{'i'} = 'iron'; $commstr{'d'} = 'dust'; $commstr{'b'} = 'bar'; $commstr{'o'} = 'oil'; $commstr{'l'} = 'lcm'; $commstr{'h'} = 'hcm'; $commstr{'r'} = 'rad'; } sub buildcost_init { # x and y direction vectors. $xdir{'j'}=2; $ydir{'j'}=0; $xdir{'u'}=1; $ydir{'u'}=-1; $xdir{'y'}=-1; $ydir{'y'}=-1; $xdir{'g'}=-2; $ydir{'g'}=0; $xdir{'b'}=-1; $ydir{'b'}=1; $xdir{'n'}=1; $ydir{'n'}=1; # Directions. @dirstr = ( 'j', 'u', 'y', 'g', 'b', 'n' ); # Maximum path lengths (to prevent long loops). $maxpath MUST be positive. $maxpath=999; } # --- Buildcost --- # The following functions are used by the "buildcost" subroutine which # calculates pathcosts from a sector to nearby sectors. # Print a command and then send it to the server. sub send { local ($line) = @_; if ($main'terse) { #' print main'UNTERSEOUT '.'; #' } else { print $line."\n"; } &main'singlecommand($line); #' } # If co-ordinates wrap around the edge of the world, modify the co-ordinates. sub wrap { local ($x,$y) = @_; $x -= $width if ($x >= $width/2); $x += $width if ($x < -$width/2); $y -= $height if ($y >= $height/2); $y += $height if ($y < -$height/2); ($x,$y); } # Returns an array of the six sectors adjacent to the argument $sect. sub adjacent { local ($sect) = pop(@_); local (@adjacent,$x,$y,$ax,$ay,$dir); ($x,$y) = split(',', $sect); foreach $dir (@dirstr) { ($ax,$ay) = &wrap($x+$xdir{$dir}, $y+$ydir{$dir}); push(@adjacent, $ax.','.$ay); } @adjacent; } # Cost to move into a sector. # Uses $movcost{des} loaded from show sector stats. sub movcost { local($sect) = @_; local($des, $c); $des = $dump{$sect,'des'}; $des = $bdes{$sect} unless $des; if ($des eq '\.') { return 1e9; } # to keep us from moving through the sea $c = (100*$movcost{$des} - $dump{$sect,'eff'})*0.002; $c = 1e9 if $c < 0; $c = 0.01 if $c < 0.01; $c; } # buildcost calculates how much mobility it costs to move into a dest sector # from path-connected sectors. Each time it is called, the array of # sectors connected by a path to the dest sector grows to include certain # adjacent sectors. It is like an exploding disk, increasing in diameter # with each call to buildcost. It explodes along the cheapest path, with # each expanding ring having the same path cost to the dest sector. # The costs to move into the dist sector from the path-connected sectors # is contained in the associative array %cost. The associative array %marked, # contains those sectors of %cost which have the cheapest pathcost. # buildcost returns the number of sectors added to the %cost array. # If used in an array context, it returns the added sectors. sub buildcost { local(*cost, *marked) = @_; local (@added, $sect, $cost, $newsect, $mincost); @added=(); do { $mincost = 1e9; # Find the minimum pathcost to move into unmarked sectors. foreach $sect (keys %cost) { if ($cost{$sect} < $mincost && !(defined $marked{$sect})) { $mincost = $cost{$sect}; } } last if $mincost == 1e9; # For each sector with minimum pathcost. while (($sect,$cost) = each %cost) { next if $cost != $mincost; $marked{$sect} = 1; # mark the sector # find pathcost to all owned adjacent sectors not already in %cost foreach $newsect (&adjacent($sect)) { next if (defined($cost{$newsect}) || $own{$newsect} != $coun); $cost{$newsect} = $cost + &movcost($newsect); push (@added, $newsect); } } } while (!@added); @added; } # --- Nova --- # return a list of all unowned wilderness sectors adjacent to my sectors sub border_sectors { local ($asect, $sect, $own); local (%border_sectors); while (($sect,$own) = each %own) { next if $own != $coun; foreach $asect (&adjacent($sect)) { if (!$own{$asect} && $bdes{$asect} eq '-') { $border_sectors{$asect} = 1; } } } keys %border_sectors; } # Find the cheapest path from $from to $to. We cannot use "bestpath" because # we might not own the destination sector. sub makepath { local($from, $to, *cost) = @_; local($newsect,$path,$sect,$dir,$x,$y,$ax,$ay,$found); return '' unless defined $cost{$to}; $sect = $from; $path = ''; while ($sect ne $to) { ($x,$y) = split(',', $sect); $found = 0; foreach $dir (@dirstr) { ($ax,$ay) = &wrap($x+$xdir{$dir}, $y+$ydir{$dir}); $newsect = $ax . ',' . $ay; if (defined($cost{$newsect}) && $cost{$newsect} < $cost{$sect}) { $path .= $dir; $found = 1; last; } } if ($found) { $sect = $newsect; } else { warn "Failed to find path from $from to $to at $sect\n"; print STDERR %path; return ''; } } $path; } sub nova { local ($dest,$sect,$des,$comm,%cost,%marked,@added,$success); foreach $dest (&border_sectors) { last if $main'status; #' undef %cost; undef %marked; $cost{$dest} = &movcost($dest); explore: while (@added = &buildcost(*cost,*marked)) { foreach $sect (@added) { last explore if $main'status; #' next if ($dump{$sect,'mob'} <= 2*$cost{$sect} || $oldown{$sect} != $coun); if ($dump{$sect,"civ"} > 1) { $comm = 'c'; } elsif ($dump{$sect,"mil"} > 1) { $comm = 'm'; } else { next; } print "explore $comm $sect 1 ". &makepath($sect,$dest,*cost)."h\n"; print $main'S "explore $comm $sect 1 ". #' &makepath($sect,$dest,*cost)."h\n"; &main'slurp; #' if ($main'mode eq '4') { $own{$dest}=-1; print "$_\n"; print $main'S "\n"; #' &main'slurp; #' } else { $dump{$sect, $commstr{$comm}}--; $dump{$dest, $commstr{$comm}}++; $own{$dest} = $coun; $success = 1; } last explore; } } } &send("des * ?des=- +"); $success; } # Keep calling nova until there is no place else to expand to. # Argument is the realm to explore. $main'functionmap{'nova'} = '&tools_supernova'; #' sub tools_supernova { local ($realm) = $main'commandarg; #' $realm = '#' unless $realm; &print_n_parse('dump *'); &send("map $realm"); while (&nova && !$main'status) { #' &print_n_parse('dump *'); &send("map $realm"); } } # --- xmvr --- # This function moves a commodity from $from to $to. sub do_move { local ($from, $to, $des, $comm, $pathcost, *rich, *poor) = @_; local ($amount, $mobcost, $packing); if ($des eq 'w' && $dump{$from,'eff'} >= 60) { $packing = $packing{$cs}; } elsif ($des eq 'b' && $comm eq 'b' && $dump{$from,'eff'} >= 60) { $packing = 4; } else { $packing = 1; } $amount = $rich{$from}; $amount = $poor{$to} if $rich{$from} > $poor{$to}; $mobcost = $weight{$cs} * $pathcost / $packing; if ($dump{$from,'mob'} - $amount * $mobcost < $minmob{$des}) { $amount = int(($dump{$from,'mob'} - $minmob{$des})/$mobcost); $rich{$from} = 0; } if ($amount > 0) { # print "expected best path: " . &makepath($from, $to, *cost) . "h\n"; # printf "expected movement cost: %.3f\n", $pathcost; # print "expected total movement cost: " . $mobcost * $amount . "\n"; &send("move $comm $from $amount $to"); $dump{$from,$cs} -= $amount; $rich{$from} -= $amount; $rich{$from} = 0 if $rich{$from} < 0; $dump{$to,$cs} += $amount; $poor{$to} -= $amount; $poor{$to} = 0 if $poor{$to} < 0; } } # &tools_xmvr($comm) moves commodities from rich sectors to poor sectors. # If $comm is 'c' or 'u', then $maxciv and $maxuw are used to determine # the desired number of civs or uw's in each sector. Otherwise, # $dump{$sect,$comm.'_dist'} is used. xmvr does not reduce the mobility of any # sector below $minmob{$des}. It does not move out of or into conquered # sectors. It does not move civs or uws out of or into sectors with < 100% # work. It never moves into a mountain. 100% efficient sectors with # Civs and uws are never moved out of a warehouse. sub tools_xmvr { local ($comm) = @_; local ($cs) = $commstr{$comm}; local ($sect, $extra, $des); local (%rich, %poor, $total); local (%marked, %cost); local ($icount, @added); local ($from, $to); local ($rehash) = 1; local ($found_poor, $found_rich); local (@poor, @rich); local($realm,$switches,$th,$area); ($realm, $switches, $th) = ($main'commandarg =~ /^([#*]\d{0,2})\s*(\?\S+)?\s*(\d*)$/); $area = $realm if $realm; $area .= " $switches" if $switches; $area = '*' unless $area; &build_sect_target($area); &print_n_parse("dump *") unless $area eq '*'; if (!$th) { $th = $maxciv if $comm eq 'c'; $th = $maxuw if $comm eq 'u'; } if ($comm eq 'c' || $comm eq 'u') { foreach $sect (keys %own) { next if (!$target{$sect} || $own{$sect} != $coun || # we do not own sector $oldown{$sect} != $coun || # we are not oldowner of sector $dump{$sect,'work'} < 100); # do not move unhappy workers next if $dump{$sect,$cs} == $th; # has right amount $extra = $dump{$sect,$cs} - $th; if ($extra > 0) { # Don't move civs or uw's out if not enough mob or if is a warehouse. next if ($dump{$sect,'mob'} <= $minmob{$dump{$sect,'des'}} || $dump{$sect,'des'} eq 'w'); $rich{$sect} = $extra; } elsif ($extra < 0) { # Never move into a mountain. next if ($dump{$sect,'des'} eq '^'); $poor{$sect} = -$extra; } } } else { foreach $sect (keys %own) { $th = $dump{$sect,$comm.'_dist'}; next if (!$target{$sect} || $dump{$sect,$cs} == $th || $own{$sect} != $coun || ($oldown{$sect} != $coun && $dump{$sect,$cs} < $th)); $extra = $dump{$sect,$cs} - $th; if ($extra > 0) { # Don't move out if not enough mobility. next if ($dump{$sect,'mob'} <= $minmob{$dump{$sect,'des'}}); $rich{$sect} = $extra; } elsif ($extra < 0) { # Never move into a mountain. next if ($dump{$sect,'des'} eq '^'); $poor{$sect} = -$extra; } } } xmvrloop: while ($rehash && !$main'status) { #' if ($rehash == 2) { # Clean out all the sectors which have done their thing foreach $sect (@poor) { delete $poor{$sect} unless $poor{$sect}; } foreach $sect (@rich) { delete $rich{$sect} unless $rich{$sect}; } } @poor = keys %poor; @rich = keys %rich; $rehash = 0; if (!@poor) { print "No poor sectors.\n"; } elsif (!@rich) { print "No rich sectors.\n"; } elsif (@poor >= @rich) { print "Poor in $cs. Looping on rich sectors...\n"; loop_on_rich: foreach $from (@rich) { undef %marked; undef %cost; $cost{$from} = 0; $icount = 0; $found_poor = 0; $des = $dump{$from,'des'}; while ($icount++ < $maxpath && $rich{$from} && (@added = &buildcost(*cost, *marked))) { foreach $to (@added) { next unless $poor{$to}; $found_poor = 1; last xmvrloop if $main'status; #' &do_move($from, $to, $des, $comm, $cost{$to}, *rich, *poor); } } if (!$found_poor) { # No more poor on this island. foreach $sect (keys %cost) { delete $rich{$sect}; } $rehash = 2; print "\nSkipping island...\n"; last loop_on_rich; } } } else { print "Rich in $cs. Looping on poor sectors...\n"; loop_on_poor: foreach $to (@poor) { undef %marked; undef %cost; $cost{$to} = 0; $icount = 0; $found_rich = 0; while ($icount++ < $maxpath && $poor{$to} && (@added = &buildcost(*cost, *marked))) { foreach $from (@added) { next unless $rich{$from}; $found_rich = 1; last xmvrloop if $main'status; #' &do_move($from, $to, $dump{$from,'des'}, $comm, $cost{$from}, *rich, *poor); } } if (!$found_rich) { # No more rich on this island foreach $sect (keys %cost) { delete $poor{$sect}; } $rehash = 2; print "\nSkipping island...\n"; last loop_on_poor; } } } } } # --- Router --- # Return a list of sectors which have des '+', 'g', or 'o', and have less # than 8 gold and ocon. sub useless { local ($sect,$des,@useless); foreach $sect (keys %own) { next if $dump{$sect,'sdes'} ne '_'; $des = $dump{$sect,'des'}; if ($des eq '+' || $des eq 'g' || $des eq 'o') { if ($dump{$sect,'gold'} < 8 && $dump{$sect,'ocontent'} < 8) { push(@useless,$sect); } } } @useless; } # Find the nearest warehouse and dist to it. If a warehouse can not be # found within 10 sectors, find a useless sector, des it 'w', and dist to it. $main'functionmap{'router'} = '&tools_router'; #' sub tools_router { local ($dsect,$sect,%cost,%marked,$gotsect,$gotwarehouse,@useless,$dist); &build_sect_target($main'commandarg); @useless=&useless; routerloop: foreach $sect (keys %own) { last routerloop if $main'status; #' next if !$target{$sect} || $own{$sect} != $coun || $dump{$sect,"des"} eq 'w' || $dump{$sect,"sdes"} eq 'w'; undef %cost; undef %marked; $cost{$sect}=0; $gotwarehouse = 0; $gotsect=''; $dist=0; buildcost: while (($dist++)<$maxpath && (@added = &buildcost(*cost,*marked))) { foreach $dsect (@added) { last routerloop if $main'status; #' if ($dump{$dsect,"des"} eq 'w' || $dump{$dsect,"sdes"} eq 'w') { $gotwarehouse=1; if ($dsect ne $dump{$sect,"dist_x"}.','.$dump{$sect,"dist_y"}) { &send("dist $sect $dsect"); $gotsect=$dsect; last buildcost; } } } } if (!$gotsect) { # did not find a warehouse if (!$gotwarehouse) { # Find the closest useless sector. foreach $dsect (@useless) { if (defined($cost{$dsect})) { if (!($gotsect) || ($cost{$dsect} < $cost{$gotsect})) { $gotsect=$dsect; } } } if ($gotsect) { &send("des $gotsect w"); &send("dist $sect $gotsect"); $dump{$gotsect,"sdes"}='w'; $newdes{$gotsect}='w'; } else { print "Can't find a warehouse for $sect to dist to.\n"; } } } } } # --- Setfood --- # This function sets your food thresholds for maximum civ growth. It will # never lower any existing food thresholds, and it doesn't set food thresholds # in warehouses. $main'functionmap{'setfood'} = '&tools_setfood'; #' sub tools_setfood { local ($sect, $th); local ($realm, $switches, $area, $num); local ($i, $civ, $uw, $mil); if (!$eatrate) { print "No food is required in this game.\n"; return; } if ($main'commandarg =~ /^([#*]\d{0,2}|\d+,\d+)\s*(\?\S+)?\s*(\d*)$/) { #' ($realm,$switches,$num) = ($main'commandarg =~ #' /^([#*]\d{0,2}|\d+,\d+)\s*(\?\S+)?\s*(\d*)$/); } elsif ($main'commandarg =~ /^\d+$/) { $num = $main'commandarg; } $area = $realm if $realm; $area .= " $switches" if $switches; $area = '*' unless $area; &build_sect_target($area); $num = 1 unless $num; print "\nSetting food thresholds for $num updates...\n" if $num > 1; foreach $sect (keys %own) { last if $main'status; #' next if !$target{$sect} || $dump{$sect,'des'} eq 'w'; $civ = $dump{$sect,'civ'}; $uw = $dump{$sect,'uw'}; $mil = $dump{$sect,'mil'}; for $i (2..$num) { $civ += $civ*$obrate*$etu; $uw += $uw*$uwbrate*$etu; } # only capitols grow 1k+ civs if ($civ > 999) { # better than no limit.. $civ = 999 unless $dump{$sect,'des'} eq 'c' && defined($option{'BIG_CITY'}); } if ($uw > 999) { $uw = 999; } # compute food threshold that will feed the projected number of # civs in $num updates, assuming food will be distributed to # sector every update (09/03/95 lorphos@empire.net) $th = int($num + $etu * ($eatrate * ($civ + $uw + $mil)) + 2 * $babyeat * ($civ*$obrate + $uw*$uwbrate)); &send("th f $sect $th") if $th > $dump{$sect,'f_dist'} && $th > 1; } } # --- External Functions --- # Find my country number. sub main'find_country_number { #' undef $coun; &print_n_parse('nation'); $main'nstatus = $nstatus; if ($new_server) { print "Cool! You're using the new server!\n"; } else { &print_n_parse("change c $main'country"); #' } if (!defined($coun)) { print STDERR "You didn't have enough BTU's to get your country number.\n"; print STDERR "What is your country number? "; $coun = ; chop $coun; } $main'coun = $coun; #' $number{$main'country} = $coun; print "Your country number is $coun.\n"; } sub main'tools_init { #' &print_n_parse('show sector stats'); return if $main'status; &print_n_parse('show ship build'); return if $main'status; &print_n_parse('show ship capabilities'); return if $main'status; &print_n_parse('show ship stats'); return if $main'status; &print_n_parse('show plane build'); return if $main'status; &print_n_parse('show land build'); return if $main'status; &print_n_parse('show land stats'); return if $main'status; &print_n_parse('version'); return if $main'status; &print_n_parse('relations'); return if $main'status; &letter_init; $country = $main'country; #' $coun = $main'coun; #' $btus = $main'btus; #' $timeused = $main'timeused; #' } $main'functionmap{'lneweff'} = '&tools_landeff'; #' sub tools_landeff { local(@u, %units, %mil, %lcm, %hcm, %gun, %shell, %unituse, %unitneed, $unit, $xy, $x, $y, $out, $area); $area = $main'commandarg; #' $area = '*' unless $area; print STDERR "parsing land $area..."; print $main'S "land $area\n"; #' $main'command="land"; #' while(&getline()) { if (/%/) { ($unit) = /^\s*(\d+)\s+/; $units{$unitsect{$unit}}.="$unit "; } } print STDERR "done\n"; print "\n Unit Type x,y Eff Mil Lcm Hcm Gun Shell Avail Maint\n"; foreach $xy (keys %units) { print $main'S "dump $xy\n"; #' $main'command="dump"; #' while(&getline()) { 1; } next if $dump{$xy, 'des'} ne '!' && $dump{$xy, 'des'} ne 'f'; ($mil{$xy}, $lcm{$xy}, $hcm{$xy}, $gun{$xy}, $shell{$xy})=&build_units($xy); @u=split(/ /, $units{$xy}); ($x, $y)=($xy=~/(\S+),(\S+)/); while($#u>-1) { $unit=shift(@u); printf "#%-4d %-13s%4d,%-4d%3d%% %3d%-5s %2d%-4s %2d%-4s %2d%-4s %2d%-4s %-4s \$%-4d\n", $unit, $unitname{$unit}, $x, $y, $neweff{$unit}, $unituse{$unit, 'mil'}, $unitneed{$unit, 'mil'}, $unituse{$unit, 'lcm'}, $unitneed{$unit, 'lcm'}, $unituse{$unit, 'hcm'}, $unitneed{$unit, 'hcm'}, $unituse{$unit, 'gun'}, $unitneed{$unit, 'gun'}, $unituse{$unit, 'shell'}, $unitneed{$unit, 'shell'}, $unitneed{$unit, 'avail'}, $unitmaint{$unit}; } printf "--- total --- %4d,%-4d %3d %3d %3d %3d %3d %3d\n", $x,$y, $mil{$xy} <= 0?$dump{$xy, 'mil'}:($dump{$xy, 'mil'} - $mil{$xy}), $lcm{$xy} <= 0?$dump{$xy, 'lcm'}:($dump{$xy, 'lcm'} - $lcm{$xy}), $hcm{$xy} <= 0?$dump{$xy, 'hcm'}:($dump{$xy, 'hcm'} - $hcm{$xy}), $gun{$xy} <= 0?$dump{$xy, 'gun'}:($dump{$xy, 'gun'} - $gun{$xy}), $shell{$xy} <= 0?$dump{$xy, 'shell'}:($dump{$xy, 'shell'} - $shell{$xy}), $avail{$xy} <= 0?$dump{$xy, 'avail'}:($dump{$xy, 'avail'} - $avail{$xy}); printf "--- need/+extra -- %4d,%-4d %6s %6s %6s %6s %6s %6s\n", $x,$y, $mil{$xy} == 0?'-':($mil{$xy} < 0?-$mil{$xy}:('+'.$mil{$xy})), $lcm{$xy} == 0?'-':($lcm{$xy} < 0?-$lcm{$xy}:('+'.$lcm{$xy})), $hcm{$xy} == 0?'-':($hcm{$xy} < 0?-$hcm{$xy}:('+'.$hcm{$xy})), $gun{$xy} == 0?'-':($gun{$xy} < 0?-$gun{$xy}:('+'.$gun{$xy})), $shell{$xy} == 0?'-':($shell{$xy} < 0?-$shell{$xy}:('+'.$shell{$xy})), $avail{$xy} == 0?'-':($avail{$xy} < 0?-$avail{$xy}:('+'.$avail{$xy})); } foreach $xy (keys %units) { if ($dump{$xy, 'off'}==1) { print "Sector $xy is turned off!\n"; } $out="Sector $xy needs"; if ($mil{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $mil{$xy}*-1) , "mil"); } if ($lcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $lcm{$xy}*-1) , "lcm"); } if ($hcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $hcm{$xy}*-1) , "hcm"); } if ($gun{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $gun{$xy}*-1) , "gun"); } if ($shell{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $shell{$xy}*-1) , "shell"); } if (substr($out,length($out)-1,1) cmp "s") { print "$out\n"; } } } sub build_units { local($maint, $avail, $wp_eff, $delta, $left, $leftp, $mneed, $lneed, $hneed, $gneed, $sneed, $optbuild, $amneed, $alneed, $ahneed, $agneed, $asneed , $mult, $build, $buildp, $unit, $type); local(@units, %mil, %lcm, %hcm, %gun, %shell); local($xy)=@_; local(@units)=split(/ /, $units{$xy}); $avail{$xy}=$dump{$xy, 'avail'}; $mil{$xy}=$dump{$xy, 'mil'}; $lcm{$xy}=$dump{$xy, 'lcm'}; $hcm{$xy}=$dump{$xy, 'hcm'}; $gun{$xy}=$dump{$xy, 'gun'}; $shell{$xy}=$dump{$xy, 'shell'}; while($#units>-1) { $unit=shift(@units); $type=$unitname{$unit}; if ($tech{$coun}<$landtech{$unit}*0.85) { $mult=2; } else { $mult=1; } $maint=($mult*$etu*.001*$buildcost{$type})+($etu*$buildmil{$type}*$uniteff{$unit}/100*$milcost); $avail=$avail{$xy}*100; $eff{$unit}=$uniteff{$unit}; $wp_eff=20+($buildlcm{$type}+2*$buildhcm{$type}); $delta=$avail/$wp_eff; if ($delta>$uniteff) { $delta=$uniteff; } $left=100-$uniteff{$unit}; $optbuild=&min($left, $uniteff); if ($left>$delta) { $left=$delta; } $build=0; if ($left>0 && ($dump{$xy, "off"}==0)) { $leftp=$left/100; $mneed=&round($buildmil{$type}*$leftp); $lneed=&round($buildlcm{$type}*$leftp); $hneed=&round($buildhcm{$type}*$leftp); $gneed=&round($buildgun{$type}*$leftp); $sneed=&round($buildshell{$type}*$leftp); if ($mil{$xy}>=$mneed) { $buildp=$leftp; } else { $buildp=$mil{$xy}/$buildmil{$type}; } if ($lcm{$xy}<$lneed) { $buildp=&min($buildp, $lcm{$xy}/$buildlcm{$type}); } if ($hcm{$xy}<$hneed) { $buildp=&min($buildp, $hcm{$xy}/$buildhcm{$type}); } if ($buildgun{$type}!=0 && $gun{$xy}<$gneed) { $buildp=&min($buildp, $gun{$xy}/$buildgun{$type}); } if ($buildshell{$type}!=0 && $shell{$xy}<$sneed) { $buildp=&min($buildp, $shell{$xy}/$buildshell{$type}); } if ($buildp<0) { $buildp=0; } $amneed=&round($buildmil{$type}*$buildp); $alneed=&round($buildlcm{$type}*$buildp); $ahneed=&round($buildhcm{$type}*$buildp); $agneed=&round($buildgun{$type}*$buildp); $asneed=&round($buildshell{$type}*$buildp); $mil{$xy}-=$mneed; $lcm{$xy}-=$lneed; $hcm{$xy}-=$hneed; $gun{$xy}-=$gneed; $shell{$xy}-=$sneed; if ($dump{$xy, 'des'} cmp '!' && $dump{$xy, 'des'} cmp 'f') { $buildp/=3; $optbuild/=3; } $build=$buildp*100; $avail=$avail/100-&round($build*$wp_eff/100); $avail{$xy}=$avail; $unituse{$unit, 'avail'}=&round($build*$wp_eff/100); $neweff{$unit}=$eff{$unit}+$build; $maint=&round($maint+$mult*$buildcost{$type}*$build/100); $unituse{$unit, 'mil'}=$amneed; $unituse{$unit, 'lcm'}=$alneed; $unituse{$unit, 'hcm'}=$ahneed; $unituse{$unit, 'gun'}=$agneed; $unituse{$unit, 'shell'}=$asneed; if ($avail{$xy}<=0 && $eff{$unit}<100) { $unitneed{$unit, 'avail'}="(".int(($optbuild-$build)*$wp_eff/100).")"; } if ($mneed>$amneed && $mil{$xy}<$mneed) { if ($mil{$xy}>-1*$mneed) { $unitneed{$unit, 'mil'}="(".-1*$mil{$xy}.")"; } else { $unitneed{$unit, 'mil'}="(".$mneed.")"; } } if ($lneed>$alneed && $lcm{$xy}<$lneed) { if ($lcm{$xy}>-1*$lneed) { $unitneed{$unit, 'lcm'}="(".-1*$lcm{$xy}.")"; } else { $unitneed{$unit, 'lcm'}="(".$lneed.")"; } } if ($hneed>$ahneed && $hcm{$xy}<$hneed) { if ($hcm{$xy}>-1*$hneed) { $unitneed{$unit, 'hcm'}="(".-1*$hcm{$xy}.")"; } else { $unitneed{$unit, 'hcm'}="(".$hneed.")"; } } if ($gneed>$agneed && $gun{$xy}<$gneed) { if ($gun{$xy}>-1*$gneed) { $unitneed{$unit, 'gun'}="(".-1*$gun{$xy}.")"; } else { $unitneed{$unit, 'gun'}="(".$gneed.")"; } } if ($sneed>$asneed && $shell{$xy}<$sneed) { if ($shell{$xy}>-1*$sneed) { $unitneed{$unit, 'shell'}="(".-1*$shell{$xy}.")"; } else { $unitneed{$unit, 'shell'}="(".$sneed.")"; } } } else { $neweff{$unit}=$uniteff{$unit}; if ($optbuild!=0) { $unitneed{$unit, 'avail'}="(".int($optbuild*$wp_eff/100).")"; } } $unitneed{$unit, 'avail'}=$unituse{$unit, 'avail'} unless $unitneed{$unit, 'avail'}; $unitmaint{$unit}=int($maint); } return $mil{$xy}, $lcm{$xy}, $hcm{$xy}, $gun{$xy}, $shell{$xy}; } $main'functionmap{'pneweff'} = '&tools_planeeff'; #' sub tools_planeeff { local(@p, %planes, %mil, %lcm, %hcm, %planeuse, %planeneed, %unit, $x, $y, $out, $area); $area = $main'commandarg; #' $area = "*" unless $area; print STDERR "parsing plane $area..."; $main'command="plane"; #' print $main'S "plane $area\n"; #' while(&getline()) { if (/%/) { ($unit)=/^\s*(\d+)\s+/; $planes{$planesect{$unit}}.="$unit "; } } print STDERR "done\n"; print "\nPlane Type x,y Eff Mil Lcm Hcm Avail Maint\n"; foreach $xy (keys %planes) { print $main'S "dump $xy\n"; #' $main'command="dump"; #' while(&getline()) { 1; } ($mil{$xy}, $lcm{$xy}, $hcm{$xy})=&build_planes($xy); @p=split(/ /, $planes{$xy}); ($x, $y)=($xy=~/(\S+),(\S+)/); while($#p>-1) { $unit=shift(@p); printf "#%-4d %-20s%4d,%-4d%3d%% %3d%-5s %2d%-4s %2d%-4s %-5s \$%-4d\n", $unit, substr($planename{$unit},0,20), $x, $y, $neweff{$unit}, $planeuse{$unit, 'mil'}, $planeneed{$unit, 'mil'}, $planeuse{$unit, 'lcm'}, $planeneed{$unit, 'lcm'}, $planeuse{$unit, 'hcm'}, $planeneed{$unit, 'hcm'}, $planeneed{$unit, 'avail'}, $planemaint{$unit}; } printf "--- total --- %4d,%-4d %3d %3d %3d %3d\n", $x,$y, $mil{$xy} <= 0?$dump{$xy, 'mil'}:($dump{$xy, 'mil'} - $mil{$xy}), $lcm{$xy} <= 0?$dump{$xy, 'lcm'}:($dump{$xy, 'lcm'} - $lcm{$xy}), $hcm{$xy} <= 0?$dump{$xy, 'hcm'}:($dump{$xy, 'hcm'} - $hcm{$xy}), $avail{$xy} <= 0?$dump{$xy, 'avail'}:($dump{$xy, 'avail'} - $avail{$xy}); printf "--- need/+extra -- %4d,%-4d %6s %6s %6s %6s %6s %6s\n", $x,$y, $mil{$xy} == 0?'-':($mil{$xy} < 0?-$mil{$xy}:('+'.$mil{$xy})), $lcm{$xy} == 0?'-':($lcm{$xy} < 0?-$lcm{$xy}:('+'.$lcm{$xy})), $hcm{$xy} == 0?'-':($hcm{$xy} < 0?-$hcm{$xy}:('+'.$hcm{$xy})), $avail{$xy} == 0?'-':($avail{$xy} < 0?-$avail{$xy}:('+'.$avail{$xy})); } foreach $xy (keys %planes) { if ($dump{$xy, 'off'}==1) { print "Sector $xy is turned off!\n"; } $out="Sector $xy needs"; if ($mil{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $mil{$xy}*-1) , "mil"); } if ($lcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $lcm{$xy}*-1) , "lcm"); } if ($hcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", $hcm{$xy}*-1) , "hcm"); } if (substr($out,length($out)-1,1) cmp "s") { print "$out\n"; } } } sub build_planes { local($maint, $avail, $wp_eff, $delta, $left, $leftp, $mneed, $lneed, $hneed, $amneed, $alneed, $ahneed, $optbuild, $mult); local(@units, %mil, %lcm, %hcm, %eff); local($xy)=@_; local(@units)=split(/ /, $planes{$xy}); $avail{$xy}=$dump{$xy, 'avail'}; $mil{$xy}=$dump{$xy, 'mil'}; $lcm{$xy}=$dump{$xy, 'lcm'}; $hcm{$xy}=$dump{$xy, 'hcm'}; if ($planesln{$unit}=~/^(\d+)S/) { $main'command="ship"; #' local($ship)=$1; print $main'S "ship $ship\n"; #' while(&getline()) { 1; } $avail{$ship}=$etu*$shipcargo{$ship, "mil"}/2; } while($#units>-1) { ($unit)=shift(@units); $type=$planename{$unit}; if ($tech{$coun}<$planetech{$unit}*0.85) { $mult=2; } else { $mult=1; } $maint=($mult*$etu*.001*$buildcost{$type})+($etu*$buildmil{$type}*$milcost*5); $avail=$avail{$xy}*100; $eff{$unit}=$planeeff{$unit}; if ($planesln{$unit}=~ /^(\d+)S/) { $ship=$1; $avail=$avail+$avail{$ship}; } else { $ship=""; } $wp_eff=20+$buildlcm{$type}+2*$buildhcm{$type}; $delta=$avail/$wp_eff; if ($delta>$planeeff) { $delta=$planeeff; } $left=100-$planeeff{$unit}; $optbuild=&min($left, $planeeff); if ($delta>$left) { $delta=$left; } if ($left>$delta) { $left=$delta; } if ($left>0 && $dump{$xy, 'off'}==0) { $leftp=$left/100; $mneed=&round($buildmil{$type}*$leftp); $lneed=&round($buildlcm{$type}*$leftp); $hneed=&round($buildhcm{$type}*$leftp); if ($mil{$xy}>$mneed) { $buildp=$leftp; } else { $buildp=$mil{$xy}/$buildmil{$type}; } if ($lcm{$xy}<$lneed) { $buildp=&min($buildp, $lcm{$xy}/$buildlcm{$type}); } if ($hcm{$xy}<$hneed) { $buildp=&min($buildp, $hcm{$xy}/$buildhcm{$type}); } if ($buildp<0) { $buildp=0; } if ($planesln{$unit}) { $build=$delta; } else { $build=$buildp*100; } $amneed=&round($buildmil{$type}*$buildp); $alneed=&round($buildlcm{$type}*$buildp); $ahneed=&round($buildhcm{$type}*$buildp); $mil{$xy}-=$mneed; $lcm{$xy}-=$lneed; $hcm{$xy}-=$hneed; if ($dump{$xy, 'des'} cmp '*') { $build/=3; $optbuild/=3;} if ($planesln{$unit}=~/^\d+S/) { if ($eff{$unit}+$build>80) { $build=80-$eff{$unit}; } } local($used)=$build*$wp_eff; $avail=&round($used/100); if ($avail<0) { $avail=0; } $planeuse{$unit, 'avail'}=$avail; $avail{$xy}-=$avail; if ($avail{$xy}<0) { $avail{$ship}=$avail{$ship}+$avail{$xy}; $avail{$xy}=0; } $neweff{$unit}=$eff{$unit}+$build; $maint=$maint+$mult*$buildcost{$type}*$build/100; $planeuse{$unit, 'mil'}=$amneed; $planeuse{$unit, 'lcm'}=$alneed; $planeuse{$unit, 'hcm'}=$ahneed; if ($mneed>$amneed && $mil{$xy}<$mneed) { if ($mil{$xy}>-1*$mneed) { $planeneed{$unit, 'mil'}="(".-1*$mil{$xy}.")"; } else { $planeneed{$unit, 'mil'}="(".$mneed.")"; } } if ($lneed>$alneed && $lcm{$xy}<$lneed) { if ($lcm{$xy}>-1*$lneed) { $planeneed{$unit, 'lcm'}="(".-1*$lcm{$xy}.")"; } else { $planeneed{$unit, 'lcm'}="(".$lneed.")"; } } if ($hneed>$ahneed && $hcm{$xy}<$hneed) { if ($hcm{$xy}>-1*$hneed) { $planeneed{$unit, 'hcm'}="(".-1*$hcm{$xy}.")"; } else { $planeneed{$unit, 'hcm'}="(".$hneed.")"; } } if ($avail{$xy}<=0 && $avail{$ship}<=0 && $eff{$unit}<100) { $planeneed{$unit, 'avail'}=int(($optbuild-$build)*$wp_eff/100); } } else { $neweff{$unit}=$planeeff{$unit}; if ($avail{$xy}<=0 && $avail{$ship}<=0 && $eff{$unit}<100) { $planeneed{$unit, 'avail'}=int($optbuild*$wp_eff/100); } } $planeneed{$unit, 'avail'}=$planeuse{$unit, 'avail'} unless $planeneed{$unit, 'avail'}; $planemaint{$unit}=int($maint); } return $mil{$xy}, $lcm{$xy}, $hcm{$xy}; } $main'functionmap{'sneweff'}='&tools_shipeff'; #' sub tools_shipeff { local(@s, %ships, %mil, %lcm, %hcm, %shipuse, %shipneed, %crewneed, %unit, %avail, $x, $y, $out, $area); $area = $main'commandarg; #' $area = '*' unless $area; print STDERR "parsing ship $area..."; print $main'S "ship $area\n"; #' $main'command="ship"; #' while(&getline()) { if (/%/) { ($unit)=/^(\S+)\s+/; $ships{$shipsect{$unit}}.="$unit "; } } print STDERR "done\n"; print " Ship Type x,y Eff Crew Lcm Hcm Avail Maint\n"; foreach $xy (keys %ships) { print $main'S "dump $xy\n"; #' $main'command="dump"; #' while(&getline()) { 1; } ($lcm{$xy}, $hcm{$xy})=&build_ships($xy); ($x, $y)=($xy=~/(\S+),(\S+)/); @s=split(/ /, $ships{$xy}); while($#s>-1) { $unit=shift(@s); printf "#%-4d %-20s %4d,%-4d %3d%% %-6s %3d%5s %3d%5s %5s \$%4d\n", $unit, $shipname{$unit}, $x, $y, $neweff{$unit}, $crewneed{$unit}, $shipuse{$unit, 'lcm'}, $shipneed{$unit, 'lcm'}, $shipuse{$unit, 'hcm'}, $shipneed{$unit, 'hcm'}, $shipneed{$unit, 'avail'}, $shipmaint{$unit}; } printf "--- total (need/+extra) -- %4d,%-4d %3d%5s %3d%5s %3d%5s\n", $x,$y, $lcm{$xy} <= 0?$dump{$xy, 'lcm'}:($dump{$xy, 'lcm'} - $lcm{$xy}), $lcm{$xy} == 0?'':'('.($lcm{$xy} < 0?-$lcm{$xy}:('+'.$lcm{$xy})).')', $hcm{$xy} <= 0?$dump{$xy, 'hcm'}:($dump{$xy, 'hcm'} - $hcm{$xy}), $hcm{$xy} == 0?'':'('.($hcm{$xy} < 0?-$hcm{$xy}:('+'.$hcm{$xy})).')', $avail{$xy} <= 0?$dump{$xy, 'avail'}:($dump{$xy, 'avail'} - $avail{$xy}), $avail{$xy} == 0?'':'('.($avail{$xy} < 0?-int($avail{$xy}):('+'.int($avail{$xy}))).')'; } foreach $xy (keys %lcm) { next if $dump{$xy, 'des'} ne 'h'; if ($dump{$xy, 'off'}==1) { print "Sector $xy is turned off!\n"; } $out="Sector $xy needs"; if ($lcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", -$lcm{$xy}) , "lcm"); } if ($hcm{$xy}<0) { $out=join(' ', $out, sprintf("%.0f", -$hcm{$xy}) , "hcm"); } if (substr($out,length($out)-1,1) cmp "s") { print "$out\n"; } } } sub build_ships { local($maint, $avail, $wp_eff, $delta, $left, $leftp, $lneed, $hneed, $alneed, $ahneed, $optbuild, $mult); local(@units, %lcm, %hcm, %eff); local($xy)=@_; local(@units)=split(/ /, $ships{$xy}); $avail{$xy}=$dump{$xy, 'avail'}; $mil{$xy}=$dump{$xy, 'mil'}; $lcm{$xy}=$dump{$xy, 'lcm'}; $hcm{$xy}=$dump{$xy, 'hcm'}; while($#units>-1) { $unit=shift(@units); if ($tech{$coun}<$planetech{$unit}*0.85) { $mult=2; } else { $mult=1; } $type=$shipname{$unit}; $eff{$unit}=$shipeff{$unit}; $maint=$mult*$etu*.001*$buildcost{$type}+$etu*$shipcargo{$unit, "mil"}*$milcost; $wf=0; if (&is_military_ship($type)) { $wf=$etu*$shipcargo{$unit, "mil"}/2; } else { $wf=$etu*($shipcargo{$unit, "civ"}/2+$shipcargo{$unit, "mil"}/5); } if ($dump{$xy, "des"} cmp "h") { $wf=$wf/3; $avail=$wf; } else { $avail=$wf+$avail{$xy}*100; } $wp_eff=20+$buildlcm{$type}+2*$buildhcm{$type}; if ($dump{$xy, "des"} cmp "h") { if (&is_military_ship($type)) { $abs_max=$cargo{$type, "mil"}; $amt=$shipcargo{$unit, "mil"}; } else { $abs_max=$cargo{$type, "civ"}; $amt=$shipcargo{$unit, "civ"}; } $avail=$avail-$etu*(100-((100*$amt)/$abs_max))/7; } if ($avail<=0 && $dump{$xy, "des"} cmp "h") { $neweff{$unit}=$eff{$unit}+$avail/$wp_eff; if (&is_military_ship($type)) { $crewneed{$unit}=&round(100/((7/6)+(100/$cargo{$type, "mil"})))-$shipcargo{$unit, 'mil'}; } else { $crewneed{$unit}=&round((100-(7*$shipcargo{$unit, "mil"}/5))/((7/6)+(100/$cargo{$type, "civ"})))-$shipcargo{$unit, "civ"}; } $crewneed{$unit}="($crewneed{$unit})"; } else { $left=100-$eff{$unit}; $optbuild=&min($left, $maxshipeff); $delta=$avail/$wp_eff; if ($delta>$maxshipeff) { $delta=$maxshipeff; } if ($delta>$left) { $delta=$left; } if ($delta>0 && $left>0 && $dump{$xy, 'off'}==0) { if ($left>$delta) { $left=$delta; } $leftp=$left/100; $lneed=&round($buildlcm{$type}*$leftp); $hneed=&round($buildhcm{$type}*$leftp); if ($lcm{$xy}>$lneed) { $buildp=$leftp; } else { $buildp=$lcm{$xy}/$buildlcm{$type}; } if ($hcm{$xy}<$hneed) { $buildp=&min($buildp, $hcm{$xy}/$buildhcm{$type}); } if ($buildp<0) { $buildp=0; } $build=$buildp*100; $alneed=&round($buildlcm{$type}*$buildp); $ahneed=&round($buildhcm{$type}*$buildp); $lcm{$xy}-=$lneed; $hcm{$xy}-=$hneed; $shipuse{$unit, 'lcm'}=$lneed; $shipuse{$unit, 'hcm'}=$hneed; if ($dump{$xy, "des"} cmp "h") { $build=$delta; } $wf=$wf-$build*$wp_eff; if ($wf<0) { $avail=($avail{$xy}*100+$wf)/100; if ($avail<0) {$avail=0;} $avail{$xy} = $avail; } if ($dump{$xy, 'des'} cmp 'h') { if ($build+$eff{$unit}>80) { $build=80-$eff{$unit}; if ($build<0) { $build=0; $avail{$xy}=0; $lcm{$xy}=-$lneed; $hcm{$xy}=-$hneed; $optbuild=$build; $shipuse{$unit, 'lcm'}=0; $shipuse{$unit, 'hcm'}=0; } } } $maint=$maint+$mult*$buildcost{$type}*$build/100; $neweff{$unit}=$eff{$unit}+$build; if ($avail{$xy}<=0 && $eff{$unit}<100) { $shipneed{$unit, 'avail'}="(".int(($optbuild-$build)*$wp_eff/100).")"; } if ($lneed>$alneed && $lcm{$xy}<$lneed) { if ($lcm{$xy} > -$lneed) { $shipneed{$unit, 'lcm'}="(".-$lcm{$xy}.")"; } else { $shipneed{$unit, 'lcm'}="($lneed)"; } } if ($hneed>$ahneed && $hcm{$xy}<$hneed) { if ($hcm{$xy} > -$hneed) { $shipneed{$unit, 'hcm'}="(".-$hcm{$xy}.")"; } else { $shipneed{$unit, 'hcm'}="($hneed)"; } } } else { $neweff{$unit}=$eff{$unit}; if ($avail{$xy}<=0 && $eff{$unit}<100) { $shipneed{$unit, 'avail'}="(".int($optbuild*$wp_eff/100).")"; } } } $shipmaint{$unit}=$maint; } return $lcm{$xy}, $hcm{$xy}; } sub max { local($x, $y)=@_; if ($x>$y) { return $x; } else { return $y; } } sub min { local($x, $y)=@_; if ($x<$y) { return $x; } else { return $y; } } sub round { local($val)=@_; local($int)=sprintf("%.0f", $val); if ($val>$int) { return $int+1; } else { return $int; } } sub getline { $mode = -1; $_ = &sock'S_read($main'S, $main'TIMEOUT); #' return 0 if $main'status; ($mode, $_)=/^\s*(\S+)\s+(.+)*$/; if(defined($main'parsemap{$main'command})) { eval('&'.$main'game."'".$main'parsemap{$main'command}); #' } if ($mode eq $main'C_FLUSH || $mode eq $main'C_PROMPT) { $main'mode = $mode; return 0; } if ($mode ne $main'C_DATA) { $main'mode = $main'C_DATA; $_ = "$mode $_"; &main'parse_serverline; } return 1; } # foreach command # with replacement of $sect $mil $civ $uw $food $shell $gun $petrol $iron # $dust $bar $oil $lcm $hcm $rad # # Syntax: foreach AREA cmd # # Written by Sam "Drazz'zt" Tetherow $main'functionmap{'foreach'}='&tools_foreach()'; #' sub tools_foreach { local(@data); local($sect, $civ, $mil, $uw, $food, $shell, $gun, $petrol, $iron, $dust, $bar, $oil, $lcm, $hcm, $rad, $tmp); local(@arguments)=split(/ /, $main'commandarg); #' local($AREA)=shift(@arguments); if (substr($arguments[0],0,1) eq '?') { $AREA="$AREA " . shift(@arguments); } local($command)=join(' ', @arguments); $command='"' . $command . '"'; $main'command="dump"; #' print $main'S "dump $AREA\n"; #' while (&getline()) { if (/\./) { (@data)=split(/ /, $_); $sect=$data[0] . "," . $data[1]; $civ=$data[16]; $mil=$data[17]; $uw=$data[18]; $food=$data[19]; $shell=$data[20]; $gun=$data[21]; $petrol=$data[22]; $iron=$data[23]; $dust=$data[24]; $bar=$data[25]; $oil=$data[26]; $lcm=$data[27]; $hcm=$data[28]; $rad=$data[29]; push(@stack,&resolve(eval($command)) . "\n"); } } while(@stack) { &main'parse_line(shift(@stack)); last if $main'status;} } sub resolve { local($this)=@_; local($x); local(@stack)=split(/ /, $this); for($x=0; $x<=$#stack; $x++) { if ($stack[$x] =~ /\,/) { next; } if ($stack[$x] =~ /^[1234567890\-\+\/\*]+/) { $stack[$x]=eval($stack[$x]); } } return join(' ', @stack); } $main'functionmap{'reach'}='&tools_reach'; #' sub tools_reach { local ($reach); print "\n--------------Sector Reach Report--------------\n"; $reach = int(0.07*$techfactor) + 1; printf "Fire range of a 100%% fort: %2.2f (%d at tech %s)\n", 0.07*$techfactor + 1, $reach + 1, &reach_to_t($reach, 7); $reach = int(0.16*$techfactor); printf "Radar range general: %3d (%d at tech %s)\n", $reach, $reach + 1, &reach_to_t($reach + 1, 16); $reach = int(0.08*$techfactor); printf "Radar range specifics: %3d (%d at tech %s)\n", $reach, $reach + 1, &reach_to_t($reach + 1, 8); $reach = int(0.04*$techfactor); printf "Coastwatch range from non-radar: %3d (%d at tech %s)\n", $reach, $reach + 1, &reach_to_t($reach + 1, 4); $reach = int(0.14*$techfactor); printf "Coastwatch range from radar: %3d (%d at tech %s)\n", $reach, $reach + 1, &reach_to_t($reach + 1, 14); } sub reach_to_t { local ($r, $k) = (@_); if ($r < $k) { sprintf("%3.2f",(200*$r - 50*$k)/($k - $r)); } else { "infinity"; } } $main'functionmap{'sreach'}='&tools_sreach'; #' sub tools_sreach { local ($id, $mobcost, $tfactor, $newmob, $frange); &build_ships_target($main'commandarg); #' print "\n --------------Ship Reach Report--------------\n"; print " Fire Nav range Nav range\n"; print "Ship Type x,y Eff Tech range now next update\n"; foreach $id (keys %shiptech) { if ($target{$id}) { $tfactor = (50 + $shiptech{$id})/(200 + $shiptech{$id}); $mobcost = 48000/(($shipspd{$shipname{$id}} + $shipspd{$shipname{$id}}*$tfactor)*$shipeff{$id}); $newmob = $shipmob{$id} + $maxshipmob; $newmob = 127 if $newmob > 127; $frange = $shipeff{$id}>59?($shipfrg{$shipname{$id}}*$tfactor/2):0; if ($frange) { $frange = sprintf("%3.2f", $frange); } else { $frange = ""; } printf "%-4d %-20s %7s %3d%% %3d %6s %3d %3d\n", $id,$shipname{$id},$shipsect{$id},$shipeff{$id},$shiptech{$id}, $frange, $shipmob{$id}>0?int($shipmob{$id}/$mobcost+0.999):0, int($newmob/$mobcost+0.999); } } } $main'functionmap{'lreach'}='&tools_lreach'; #' sub tools_lreach { local ($id, $mobcost, $tfactor, $newmob, $frange); &build_lands_target($main'commandarg); #' print "\n --------------Land Unit Reach Report--------------\n"; print " Fire Mar range Mar range\n"; print "Unit Type x,y Eff Tech range now next update\n"; foreach $id (keys %unittech) { if ($target{$id}) { $tfactor = (50 + $unittech{$id})/(200 + $unittech{$id}); $mobcost = 48000/(($unitspd{$unitname{$id}} + $unitspd{$unitname{$id}}*$tfactor)*$uniteff{$id}); $newmob = $unitmob{$id} + $unitmob; $newmob = 127 if $newmob > 127; $frange = $uniteff{$id}>59?($unitfrg{$unitname{$id}}*$tfactor):0; if ($frange) { $frange = sprintf("%3.2f", $frange); } else { $frange = ""; } printf "%-4d %-20s %7s %3d%% %3d %6s %3d %3d\n", $id,$unitname{$id},$unitsect{$id},$uniteff{$id},$unittech{$id}, $frange, $unitmob{$id}>0?int($unitmob{$id}/$mobcost+0.999):0, int($newmob/$mobcost+0.999); } } } $main'functionmap{'fus'}='&tools_fus'; #' sub tools_fus { local($id, $fuelmob, $mobcost, $tfactor); &build_ships_target($main'commandarg); #' &print_n_parse("dump *"); foreach $id (keys %shipname) { next if !$target{$id} || $shipfuel{$id} == $fuelcar{$shipname{$id}}; if ($dump{$shipsect{$id}, 'des'} ne 'h') { if (!$shipfuel{$id} && $shipmob{$id} <= 0) { printf "Oops: ship \#%d %s is stranded at sea with no fuel and no mobility.\n", $id, $shipname{$id}; } else { $tfactor = (50 + $shiptech{$id})/(200 + $shiptech{$id}); $fuelmob = 10*($shipfuel{$id}/$fueluse{$shipname{$id}}); if ($shipmob{$id} + $maxshipmob > 127) { $fuelmob += 127 - $maxshipmob; } else { $fuelmob += $shipmob{$id}; } $mobcost = 48000/(($shipspd{$shipname{$id}}+$shipspd{$shipname{$id}} *$tfactor)*$shipeff{$id}); printf "ship \#%d %s is at sea and will run out of fuel in %.1f updates (%d sectors).\n", $id, $shipname{$id}, $shipfuel{$id}/($fueluse{$shipname{$id}}*($maxshipmob/10)), int($fuelmob/$mobcost+0.9999); } } elsif ($own{$shipsect{$id}} != $coun) { $tfactor = (50 + $shiptech{$id})/(200 + $shiptech{$id}); $fuelmob = 10*($shipfuel{$id}/$fueluse{$shipname{$id}}); if ($shipmob{$id} + $maxshipmob > 127) { $fuelmob += 127 - $maxshipmob; } else { $fuelmob += $shipmob{$id}; } $mobcost = 48000/(($shipspd{$shipname{$id}}+$shipspd{$shipname{$id}} *$tfactor)*$shipeff{$id}); printf "ship \#%d %s is in %s's harbour and will run out of fuel in %.1f updates (%d sectors).\n", $id, $shipname{$id}, $country{$own{$shipsect{$id}}}, $shipfuel{$id}/($fueluse{$shipname{$id}}*($maxshipmob/10)), int($fuelmob/$mobcost+0.9999); } else { if ($dump{$shipsect{$id},'oil'} == 0 && $dump{$shipsect{$id},'pet'} == 0) { print "Warning: Not enough fuel in $shipsect{$id} to fuel ship \#$id $shipname{$id}!\n"; } else { &send("fuel ship $id ".($fuelcar{$shipname{$id}} - $shipfuel{$id})); } } } } $main'functionmap{'crew'}='&tools_crew'; #' sub tools_crew { local($id,$type,$milship,$cneed,$mneed,$mil,$civ); &build_ships_target($main'commandarg); #' print "\n-----------------Ship Crew Report-----------------\n"; printf "%4s %-20s %8s %s\n", 'shp#', 'type', 'needs', 'can unload'; foreach $id (keys %shipname) { next if !$target{$id}; $type = $shipname{$id}; if ($milship = &is_military_ship($type)) { $mneed = &round(100/((7/6)+(100/$cargo{$type, 'mil'}))); $mil = $shipcargo{$id, 'mil'}; } else { $cneed = &round((100-(7*$shipcargo{$id, "mil"}/5))/((7/6)+(100/$cargo{$type, "civ"}))); $civ = $shipcargo{$id, 'civ'}; } next if $milship && $civ == $mneed || !$milship && $mil == $cneed; if ($milship) { if ($mil < $mneed) { printf "%4s %-20s %8s %s\n", $id, $type, ($mneed - $mil)." mil", ''; } else { printf "%4s %-20s %8s %s\n", $id, $type, '', ($mil - $mneed)." mil"; } } else { if ($civ < $cneed) { printf "%4s %-20s %8s %s\n", $id, $type, ($cneed - $civ)." civs", ''; } else { printf "%4s %-20s %8s %s\n", $id, $type, '', ($civ - $cneed)." civs"; } } } } sub is_military_ship { local($type) = @_; $shipfir{$type} || !$cargo{$type,'civ'}; } $main'functionmap{'jack'}='&tools_jack'; #' sub tools_jack { local($sect); &build_sect_target($main'commandarg); #' &print_n_parse("prod *"); foreach $sect (keys %own) { next if !$target{$sect} || $own{$sect} != $coun || ($newdes{$sect} ne 'j' && $newdes{$sect} ne 'k'); if ($use1{$sect} < $max1{$sect} && $dump{$sect, 'i_dist'} < $max1{$sect}) { &send("th i $sect $max1{$sect}"); } } } $main'functionmap{'rebel'}='&tools_rebel'; #' sub tools_rebel { local($sect); &build_sect_target($main'commandarg); #' print "\n--------------Che Riviera Report--------------\n"; printf "%7s %3s %3s %5s %5s\n", 'sector', 'des', 'mob', 'extra', 'needs'; foreach $sect (keys %own) { next if !$target{$sect} || $own{$sect} != $coun; if ($dump{$sect,'*'} eq '*') { if ($dump{$sect,'mil'} < int($dump{$sect,'civ'}/10) + 2) { printf "%7s %3s %3s %5s %5s\n", $sect, $dump{$sect,'des'}, '', '', int($dump{$sect,'civ'}/10) - $dump{$sect,'mil'} + 2; } elsif ($dump{$sect,'mil'} > int($dump{$sect,'civ'}/10) + 4 && $dump{$sect,'mob'} > 1) { printf "%7s %3s %3s %5s %5s\n", $sect, $dump{$sect,'des'},$dump{$sect,'mob'}, $dump{$sect,'mil'} - int($dump{$sect,'civ'}/10) - 4, ''; } } } } $main'functionmap{'civs'}='&tools_civs'; #' sub tools_civs { local($sect, $use, $extra, $effdelta, $des, $neweff); local ($c1, $c2, $c3, $d1, $d2, $d3, $f21, $f31, $work, $why, $area); $area = $main'commandarg; #' $area = '*' unless $area; &build_sect_target($area); &print_n_parse("prod $area"); &print_n_parse("neweff $area"); print "\n--------------Workforce Employment Report--------------\n"; printf " sector neweff workforce extra needs\n"; foreach $sect (keys %own) { next if !$target{$sect} || $own{$sect} != $coun || $dump{$sect,'work'} < 90 || $oldown{$sect} != $coun; $why = ''; # Calculate delta in sector efficiency $des = $dump{$sect, 'des'}; if ($des eq $newdes{$sect}) { if ($dump{$sect, 'eff'} < $neweff{$sect}) { # building up if ($neweff{$sect} > 30) { if ($neweff{$sect} > 61) { $effdelta = 100 - $dump{$sect, 'eff'}; $why = "to become 100%"; } else { $effdelta = 61 - $dump{$sect, 'eff'}; $why = "to become 61%"; } } else { $effdelta = 0; } } elsif ($dump{$sect, 'eff'} > $neweff{$sect}) { # tearing down $effdelta = ($dump{$sect, 'eff'} - $neweff{$sect}) / 4; } else { $effdelta = 0; } } else { # tear down and build up $effdelta = $dump{$sect, 'eff'} / 4 + $neweff{$sect}; if ($neweff{$sect} > 30) { if ($neweff{$sect} > 61) { $effdelta += 100 - $neweff{$sect}; $why = "to become 100%"; } else { $effdelta += 61 - $neweff{$sect}; $why = "to become 61%"; } } } if ($use1{$sect}) { # It consumes if ($use1{$sect} < $max1{$sect}) { # Too many civs $use = $use1{$sect} + $use2{$sect} + $use3{$sect}; $extra = $wkfc{$sect} - (($use>$effdelta?$use:0) + 2 * $effdelta) * 100 / $etu; } elsif ($des ne 'e') { # Maybe it needs more civs $c1 = $dump{$sect,$comm1{$sect}}; $c2 = $dump{$sect,$comm2{$sect}} if $comm2{$sect}; $c3 = $dump{$sect,$comm3{$sect}} if $comm3{$sect}; if ($use3{$sect}) { $f21 = $use2{$sect}/$use1{$sect}; $f31 = $use3{$sect}/$use1{$sect}; $d1 = $c1 - $use1{$sect}; $d2 = $c2 - $use2{$sect}; $d3 = $c3 - $use3{$sect}; if ($d1 > 0 && $f21 * $d1 < $d2 && $f31 * $d1 < $d3) { $work = (1 + $f21 + $f31) * $d1; $why = "to be able to use ".($use1{$sect}+$d1)." ".$comm1{$sect}; } elsif ($d2 > 0 && $d2 < $f21 * $d1 && $f31 * $d2 < $f21 * $d3) { $work = (1/$f21 + 1 + $f31/$f21) * $d2; $why = "to be able to use ".($use2{$sect}+$d2)." ".$comm2{$sect}; } elsif ($d3 > 0 && $d3 < $f31 * $d1 && $f21 * $d3 < $f31 * $d2) { $work = (1/$f31 + $f21/$f31 + 1) * $d3; $why = "to be able to use ".($use3{$sect}+$d3)." ".$comm3{$sect}; } else { $work = 0; } } elsif ($use2{$sect}) { $f21 = $use2{$sect}/$use1{$sect}; $d1 = $c1 - $use1{$sect}; $d2 = $c2 - $use2{$sect}; if ($d1 > 0 && $f21 * $d1 < $d2) { $work = (1 + $f21) * $d1; $why = "to be able to use ".($use1{$sect}+$d1)." ".$comm1{$sect}; } elsif ($d2 > 0 && $d2 < $f21 * $d1) { $work = (1/$f21 + 1) * $d2; $why = "to be able to use ".($use2{$sect}+$d2)." ".$comm2{$sect}; } else { $work = 0; } } elsif ($use1{$sect} < $c1) { $work = $c1 - $use1{$sect}; $why = "to be able to use ".($use1{$sect}+$work)." ".$comm1{$sect}; } else { $work = 0; } $extra = -$work * 100 / $etu; } else { $extra = 0; } } elsif ($will{$sect}) { # It produces but doesn't consume $extra = 0; } elsif ($des eq 'h' || $des eq '*' || $des eq '!' || $des eq 'f' || $des eq 'c') { $extra = 0; } else { # It doesn't produce $extra = $dump{$sect,'civ'} * (1 + $obrate * $etu) + $dump{$sect,'uw'} * (1 + $uwbrate * $etu) + $dump{$sect,'mil'} / 5 - 2 * $effdelta * 100 / $etu; } $extra = int($extra / (1 + $obrate * $etu) - 1); if ($extra && $extra < $dump{$sect, 'civ'} - $maxciv) { $extra = $dump{$sect, 'civ'} - $maxciv; } if ($extra > 1) { local ($cextra,$uextra); $cextra = &min($extra,$dump{$sect, 'civ'}); $uextra = &min($extra-$cextra,$dump{$sect, 'uw'}); $cextra -=1 if ($cextra && $uextra); printf "%7s %1s %3d%% %1s %4s %4s %4s %4s\n", $sect, $des, $dump{$sect, 'eff'}, ($newdes{$sect} ne $des)?$newdes{$sect}:'', ($neweff{$sect} != $dump{$sect, 'eff'})?$neweff{$sect}.'%':'', int($dump{$sect,'civ'} + $dump{$sect,'uw'} + $dump{$sect,'mil'} / 5), $cextra?($cextra.'c'):'', $uextra?($uextra.'u'):''; } elsif ($extra < -1) { printf "%7s %1s %3d%% %1s %4s %4s %5s %5s %s\n", $sect, $des, $dump{$sect, 'eff'}, ($newdes{$sect} ne $des)?$newdes{$sect}:'', ($neweff{$sect} != $dump{$sect, 'eff'})?$neweff{$sect}.'%':'', int($dump{$sect,'civ'} + $dump{$sect,'uw'} + $dump{$sect,'mil'} / 5), '', -$extra, $why?'('.$why.')':''; } } } $main'functionmap{'delta'}='&tools_prod_delta'; #' # prod_delta: originally written by Ken Stevens as a standalone perl script, # added to tools.pl by Sam Tetherow sub tools_prod_delta { local(%plus, %minus, %have, @usable, @unusable, $xy, $com, %unituse, %unitneed, %planeuse, %planeneed, %shipuse, %shipneed, $unit, $plane, $ship, %units, %planes, %ships, $area); $area = $main'commandarg; #' $area = '*' unless $area; &build_sect_target($area); &print_n_parse("dump *") if $area ne '*'; &print_n_parse("product *"); print STDERR "parsing land *..."; $main'command="land"; #' print $main'S "land *\n"; #' while(&getline()) { if (/\s*(\d+)\s+.+%/) { $units{$unitsect{$1}}.="$1 "; } } print STDERR "done\n"; foreach $xy (keys %units) { local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; if ($target{$disthit}) { &build_units($xy); } } foreach $unit (keys %unitmob) { # Use mob so you don't get enemy units $minus{'mil'}+=$unituse{$unit, 'mil'}; $minus{'lcm'}+=$unituse{$unit, 'lcm'}; $minus{'hcm'}+=$unituse{$unit, 'hcm'}; $minus{'gun'}+=$unituse{$unit, 'gun'}; $minus{'shell'}+=$unituse{$unit, 'shell'}; } print STDERR "parsing plane *..."; $main'command="plane"; #' print $main'S "plane *\n"; #' while(&getline()) { if (/\s*(\d+)\s+.+%/) { $planes{$planesect{$1}}.="$1 "; } } print STDERR "done\n"; foreach $xy (keys %planes) { local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; if ($target{$disthit}) { &build_planes($xy); } } foreach $plane (keys %planemob) { # Use mob so you don't get enemy planes $minus{'mil'}+=$planeuse{$plane, 'mil'}; $minus{'lcm'}+=$planeuse{$plane, 'lcm'}; $minus{'hcm'}+=$planeuse{$plane, 'hcm'}; } print STDERR "parsing ship *..."; $main'command="ship"; #' print $main'S "ship *\n"; #' while(&getline()) { if (/\s*(\d+)\s+.+%/) { $ships{$shipsect{$1}}.="$1 "; } } print STDERR "done\n"; foreach $xy (keys %ships) { local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; if ($target{$disthit}) { &build_ships($xy); } } foreach $ship (keys %shipmob) { # Use mob so you don't get enemy ships $minus{'lcm'}+=$shipuse{$ship, 'lcm'}; $minus{'hcm'}+=$shipuse{$ship, 'hcm'}; } foreach $xy (keys %will) { # all producing sectors local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; next unless $target{$disthit}; $plus{$make{$xy}}+=&min($will{$xy}, $prodmax{$xy}); if ($comm1{$xy}) { $minus{$comm1{$xy}}+=$use1{$xy}; } if ($comm2{$xy}) { $minus{$comm2{$xy}}+=$use2{$xy}; } if ($comm3{$xy}) { $minus{$comm3{$xy}}+=$use3{$xy}; } } foreach $xy (keys %own) { local($disthit)="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; next unless $target{$disthit}; next unless $own{$xy}==$main'coun; #' skip if not ours foreach $com (values %commstr) { # for all commodites $have{$com}+=$dump{$xy, $com}; } # Fort usage of hcms if (($dump{$xy,'des'} eq 'f' && $dump{$xy,'eff'}<100) || $dump{$xy,'sdes'} eq 'f') { $main'command='neweff'; #' print $main'S "neweff $xy\n"; #' while(&getline()) { 1; } if ($neweff{$xy}>$dump{$xy, 'eff'} && $dump{$xy, 'des'} eq 'f') { $minus{'hcm'}+=$buildhcm{'f'}*($neweff{$xy}-$dump{$xy, 'eff'}); } elsif ($dump{$xy, 'sdes'} eq 'f') { $minus{'hcm'}+=$buildhcm{'f'}*$neweff{$xy}; } } } $plus{'civ'}=int($have{'civ'}*$obrate*$etu); $plus{'uw'}=int($have{'uw'}*$uwbrate*$etu); $minus{'food'}=int(($have{'civ'}+$have{'uw'}+$have{'mil'})*$etu*$eatrate+($plus{'civ'}+$plus{'uw'})*$babyeat); print "\n--------------------Production Delta Report--------------------\n"; printf "%5s %8s %8s %8s %8s %8s %8s\n", 'com', 'start', '+', '-', 'delta', 'net', 'supply'; @usable=('food', 'iron', 'oil', 'dust', 'lcm', 'hcm'); @nonusable=('bar', 'pet', 'shell', 'gun', 'civ', 'uw', 'mil'); while($com=shift(@usable)) { if ($have{$com}!=0 || $plus{$com}!=0) { printf "%5s %8s %8s %8s %8s %8s %8s\n", $com, $have{$com}, $plus{$com}, $minus{$com}, $plus{$com}-$minus{$com}, $have{$com}+$plus{$com}-$minus{$com}, &prod_warn($have{$com}, $plus{$com}-$minus{$com}); } } print "---------------------------------------------------------------\n"; while($com=shift(@nonusable)) { if ($have{$com}!=0 || $plus{$com}!=0) { printf "%5s %8s %8s %8s %8s %8s\n", $com, $have{$com}, $plus{$com}, '', '', $have{$com}+$plus{$com}; } } } $main'functionmap{'fdelta'}='&tools_food_delta'; #' # food_delta: Originally written by Ken Stevens as part of delta a standalone # perl tool, added to tools.pl by Sam Tetherow sub tools_food_delta { local($type, $civcount, $uwcount, $sectcount, $citycount, $foodcount); local($xy, $fprod, $cbaby, $ubaby, $area); $area = $main'commandarg; #' $area = '*' unless $area; &build_sect_target($area); &print_n_parse("dump *") if $area ne '*'; &print_n_parse("product *"); foreach $xy (keys %own) { next unless $own{$xy}==$main'coun; #' $dist="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; next unless $target{$dist}; $civcount+=$dump{$xy, 'civ'}; $uwcount+=$dump{$xy, 'uw'}; if ($dump{$xy, 'des'} ne '^') { if ($dump{$xy, 'des'} eq 'c' && defined($option{'BIG_CITY'})) { ++$citycount; } else { ++$sectcount; } } $foodcount+=$dump{$xy, 'food'}; # If this sector products food add it if ($make{$xy} eq 'food') { $fprod+=&min($will{$xy}, $prodmax{$xy}); } } local($civmax)=$sectcount*$maxpop + $citycount*$maxpop*10; local($uwmax)=$civmax; local($civ)=$civcount+$milcount; local($uw)=$uwcount; local($foo)=$foodcount; print "\n ----FOOD DELTA REPORT----\n"; printf "%6s %6s %6s %6s %6s %6s %6s\n", '', 'start', '', '', 'food', 'food', 'food'; printf "%6s %6s %6s %6s %6s %6s %6s\n", 'update', 'food', 'civ', 'uw', 'eaten', 'prod', 'delta'; print "---------------------------------------------------\n"; for($i=1; $i<=15; ++$i) { local($cbaby)=$civ*$obrate*$etu; local($ubaby)=$uw*$uwbrate*$etu; local($eaten)=(($civ+$uw)*$eatrate*$etu)+(($cbaby+$ubaby)*$babyeat); local($delta)=$fprod-$eaten; printf "%5d: %6d %6d %6d %6d %6d %6d\n", $i, $foo, $civ, $uw, $eaten, $fprod, $delta; $foo +=$delta; $civ +=$cbaby; $civ=$civmax if $civ>$civmax; $uw +=$ubaby; $uw=$uwmax if $uw>$uwmax; } if ($citycount) { print "Maximum civs for $citycount cities and $sectcount sectors: $civmax\n"; print "Maximum uws for $citycount cities and $sectcount sectors: $uwmax\n"; } else { print "Maximum civs for $sectcount sectors: $civmax\n"; print "Maximum uws for $sectcount sectors: $uwmax\n"; } } $main'functionmap{'wdelta'}='&tools_warehouse_delta'; #' # warehouse_delta: Written by Sam Tetherow to show warehouse action at the # update. sub tools_warehouse_delta { local(%distcenters, %use, %make, @usabel, @nonusable); local($type, $dist, $xy, $c, $civbabies, $uwbabies, $com, $area); $area = $main'commandarg; #' $area = '*' unless $area; &build_sect_target($area); &print_n_parse("dump *") if $area ne '*'; &print_n_parse("product *"); print STDERR "parsing land *..."; $main'command="land"; #' print $main'S "land *\n"; #' while(&getline()) { if (/\s+(\d+)\s+.+%/) { $units{$unitsect{$1}}.="$1 "; } } print STDERR "done\n"; print STDERR "parsing plane *..."; $main'command="plane"; #' print $main'S "plane *\n"; #' while(&getline()) { if (/\s+(\d+)\s+.+%/) { $planes{$planesect{$1}}.="$1 "; } } print STDERR "done\n"; print STDERR "parsing ship *..."; $main'command="ship"; #' print $main'S "ship *\n"; #' while(&getline()) { if (/\s+(\d+)\s+.+%/) { $ships{$shipsect{$1}}.="$1 "; } } print STDERR "done\n"; foreach $xy (keys %own) { next unless $own{$xy}==$main'coun; #' $dist="$dump{$xy, 'dist_x'},$dump{$xy, 'dist_y'}"; next if $dist eq $xy; # If the distcenter is undefined (1st occurance) # initialize the use variables. if (!defined($distcenters{$dist})) { if ($target{$dist}) { $distcenters{$dist}=1; } else { $distcenters{$dist}=0; } } next unless $distcenters{$dist}==1; undef %unituse; undef %unitneed; undef %planeuse; undef %planeneed; undef %shipuse; undef %shipneed; &build_units($xy) if $units{$xy}; &build_planes($xy) if $planes{$xy}; &build_ships($xy) if $ships{$xy}; foreach $unit (keys %unituse) { $use{$xy, 'mil'}+=$unituse{$unit, 'mil'}; $use{$xy, 'lcm'}+=$unituse{$unit, 'lcm'}; $use{$xy, 'hcm'}+=$unituse{$unit, 'hcm'}; $use{$xy, 'gun'}+=$unituse{$unit, 'gun'}; $use{$xy, 'shell'}+=$unituse{$unit, 'shell'}; } foreach $plane (keys %planeuse) { $use{$xy, 'mil'}+=$planeuse{$plane, 'mil'}; $use{$xy, 'lcm'}+=$planeuse{$plane, 'lcm'}; $use{$xy, 'hcm'}+=$planeuse{$plane, 'hcm'}; } foreach $ship (keys %shipuse) { $use{$xy, 'lcm'}+=$shipuse{$ship, 'lcm'}; $use{$xy, 'hcm'}+=$shipuse{$ship, 'hcm'}; } # Fort usage of hcms if (($dump{$xy,'des'} eq 'f' && $dump{$xy,'eff'}<100) || $dump{$xy,'sdes'} eq 'f') { $main'command='neweff'; #' print $main'S "neweff $xy\n"; #' while(&getline()) { 1; } if ($neweff{$xy}>$dump{$xy, 'eff'} && $dump{$xy, 'des'} eq 'f') { $use{$xy, 'hcm'}+=$buildhcm{'f'}*($neweff{$xy}-$dump{$xy, 'eff'}); } elsif ($dump{$xy, 'sdes'} eq 'f') { $use{$xy, 'hcm'}+=$buildhcm{'f'}*$neweff{$xy}; } } if ($will{$xy}) { $make{$xy, $make{$xy}}+=&min($will{$xy}, $prodmax{$xy}); $use{$xy, $comm1{$xy}}+=$use1{$xy} if $comm1{$xy}; $use{$xy, $comm2{$xy}}+=$use2{$xy} if $comm2{$xy}; $use{$xy, $comm3{$xy}}+=$use3{$xy} if $comm3{$xy}; } # Grow population and figure food. if ($dump{$xy, 'civ'}<$maxciv) { $civbabies=$dump{$xy, 'civ'}*$obrate*$etu; if ($civbabies+$dump{$xy, 'civ'}>$maxciv) { $civbabies=$maxciv-$dump{$xy, 'civ'}; } $make{$xy, 'civ'}+=$civbabies; } if ($dump{$xy, 'uw'}<$maxuw) { $uwbabies=$dump{$xy, 'uw'}*$uwbrate*$etu; if ($uwbabies+$dump{$xy, 'uw'}>$maxuw) { $uwbabies=$maxuw-$dump{$xy, 'uw'}; } $make{$xy, 'uw'}+=$uwbabies; } $use{$xy, 'food'}+=($dump{$xy, 'civ'}+$dump{$xy, 'mil'}+$dump{$xy, 'uw'})*$etu*$eatrate; $use{$xy, 'food'}+=($uwbabies+$civbabies)*$babyeat; # If we have non-0 threshes account for them. foreach $c (keys %commstr) { local($distkey)="$c" . "_dist"; local($com)=$commstr{$c}; if ($dump{$xy, $distkey}!=0) { if ($dump{$dist, $com}+$make{$dist, $com}-$use{$dist, $com}<=9999) { if ($dump{$xy, $distkey}<$dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}) { $make{$dist, $com}+=$dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}-$dump{$xy, $distkey}; } else { $use{$dist, $com}+=$dump{$xy, $distkey}-($dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}); } } } } } foreach $xy (keys %distcenters) { @usable=('food', 'iron', 'oil', 'dust', 'lcm', 'hcm'); @nonusable=('bar', 'pet', 'shell', 'gun', 'civ', 'uw', 'mil'); if ($distcenters{$xy}!=1) { next; } print "\n--------------------Distcenter $xy--------------------\n"; printf(" %6s %8s %8s %8s %8s %8s %8s\n", "Com", "Start", "+", "-", "Delta", "Net", "Supply"); while($com=shift(@usable)) { if ($dump{$xy, $com}!=0 || $make{$xy, $com}!=0) { printf(" %6s %8d %8d %8d %8d %8d %8s\n", $com, $dump{$xy, $com}, $make{$xy, $com}, $use{$xy, $com}, $make{$xy, $com}-$use{$xy, $com}, $dump{$xy, $com}+$make{$xy, $com}-$use{$xy, $com}, &prod_warn($dump{$xy, $com}, $make{$xy, $com}-$use{$xy, $com})); } } print "----------------------------------------------------------------\n"; while($com=shift(@nonusable)) { if ($dump{$xy, $com}!=0 || $make{$xy, $com}!=0) { printf(" %6s %8d %8d %8s %8s %8d\n", $com, $dump{$xy, $com}, $make{$xy, $com}, ' ', ' ', $dump{$xy, $com}+$make{$xy, $com}); } } } } sub prod_warn { local($start, $delta)=@_; if ($delta>=0) { return ''; } return int(-1*$start / $delta) . ''; } sub in_realm { # in_realm($realmstring, $sect) local($realm, $sect)=@_; if ($realm eq '*') { return 1; } local($left,$top)=split(/,/, $realm); local(@tmp)=split(/:/, $left); local($left)=shift(@tmp); local($right)=shift(@tmp); $right=$left unless $right; local(@tmp)=split(/:/, $top); local($top)=shift(@tmp); local($bottom)=shift(@tmp); $bottom=$top unless $bottom; ($x, $y)=split(/,/, $sect); if ($left<=$right) { if ($top<=$bottom) { if ($x>=$left && $x<=$right && $y>=$top && $y<=$bottom) { return 1; } else { return 0; } } else { if ($x>=$left && $x<=$right && (($y>=$top && $y<$height/2) || ($y<=$bottom && $y>=-1*$height/2))) { return 1; } else { return 0; } } } else { if ($bottom<=$top) { if (($y>=$top && $y<=$bottom) && (($x>=$left && $x<$width/2) || ($x<=$right && $x>=-1*$width/2))) { return 1; } else { return 0; } } else { if ((($x>=$left && $x<$width/2) || ($x<=$right && $x>=-1*$width/2)) && (($y>$top && $y<$height/2) || ($y<$bottom && $y>-1*$height/2))) { return 1; } else { return 0; } } } return 0; } $main'functionmap{'stat'} = '&tools_status'; #' # Here are the status commands to get info out of the internal DB # I don't if these should go in tools.pl or parse.pl, but tools seemed to # be the logical place for them. # status will get you information about a sector in enemy territory # I should probably add dating to information while I am at it because it # would be nice to know how old this information is. sub tools_status { local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail); local($mon, $mday, $hour, $min); if ($main'commandarg=~/\s*(\S+)\s*(.*)/) { $area=$1; $switches=$2 if $2; } else { print STDERR "stat (?switch)\n"; return; } if ($area=~/#(\d+)/) { $area=$realm{$1}; } $switches=~s/^\?//; local(@switch)=split(/&/, $switches); while($tmp=shift(@switch)) { if ($tmp=~/(\S+)=(\S+)/) { push(@equal, "$1 $2"); } # mask type to des elsif ($tmp=~/(\S+)\#(\S+)/) { push(@nequal, "$1 $2"); } elsif ($tmp=~/(\S+)<(\S+)/) { push(@less, "$1 $2"); } elsif ($tmp=~/(\S+)>(\S+)/) { push(@great, "$1 $2"); } else { print "Unknown switch $tmp\n"; return; } } foreach $xy (keys %own) { push(@sects, $xy) if &in_realm($area, $xy); } print "own x,y des eff civ mil pet food fort ship air land date\n"; $sectcount=0; while($xy=shift(@sects)) { $fail=0; ($x, $y)=($xy=~/(\S+),(\S+)/); @tmp=@equal; while($#tmp>-1) { ($val, $amt)=split(/ /, shift(@tmp),2); if ($val eq 'type') { $val='des'; } if ($val eq 'own') { if ($own{$xy} ne $amt && $own{$xy} ne $number{$amt}) { $fail=1; } } elsif ($dump{$xy, $val} ne $amt) { $fail=1; } } @tmp=@nequal; while($#tmp>-1) { ($val, $amt)=split(/ /, shift(@tmp),2); if ($val eq 'type') { $val='des'; } if ($val eq 'own') { if ($own{$xy} ne $amt) { $fail=1; } } elsif ($dump{$xy, $val} eq $amt) { $fail=1; } } @tmp=@less; while($#tmp>-1) { ($val, $amt)=split(/ /, shift(@tmp),2); if ($val eq 'type') { $val='des'; } if ($dump{$xy, $val}>=$amt) { $fail=1; } } @tmp=@great; while($#tmp>-1) { ($val, $amt)=split(/ /, shift(@tmp),2); if ($val eq 'type') { $val='des'; } if ($dump{$xy, $val}<=$amt) { $fail=1; } } if ($fail==0) { ($mon, $mday, $hour, $min)=($dump{$xy, 'date'}=~ /(\d+)\/(\d+) (\d+):(\d+)/); printf "%2d%4d,%-4d %1s %3s%%%4d %3s %4s %4s %6s %6s %6s %6s %3s %2d %02d:%02d\n", $own{$xy}, $x, $y, $dump{$xy, 'des'}, $dump{$xy, 'eff'}, $dump{$xy, 'civ'}, $dump{$xy, 'mil'}, $dump{$xy, 'pet'}, $dump{$xy, 'food'}, $def{$xy, 'fort'}, $def{$xy, 'ship'}, $def{$xy, 'plane'}, $def{$xy, 'land'}, $main'monthname{$mon}, $mday, $hour, $min; $sectcount++; } } print "$sectcount Sectors.\n"; } $main'functionmap{'lstat'}='&tools_lstat'; #' sub tools_lstat { local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail); local($mon, $mday, $hour, $min); if ($main'commandarg=~/\s*(\S+)\s*(.*)/) { $area=$1; $switches=$2 if $2; } else { print STDERR "lstat (?switch)\n"; return; } if ($area=~/#(\d+)/) { $area=$realm{$1}; } $switches=~s/^\?//; local(@switch)=split(/&/, $switches); printf "%10s %4s %-20s %-9s %3s %3s %-11s\n", 'own', 'unit', 'Type', 'at(near)', 'eff', 'tech', 'date'; local($unitcount)=0; foreach $unit (keys %unitown) { $fail=0; next unless (&in_realm($area, $unitsect{$unit}) | &in_realm($area, $unitnear{$unit})); ; @tmp=@switch; while($tmp=shift(@tmp)) { ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/); if ($val eq 'eff') { $val=$uniteff{$unit}; } elsif ($val eq 'tech') { $val=$unittech{$unit}; } elsif ($val eq 'own') { $val=$unitown{$unit}; #*# Untested if (!($amt=~/^\d+$/)) { $amt=$number{$amt}; } } elsif ($val eq 'type') { $val=substr($unitname{$unit},0,length($amt)); } else { print "Invalid switch $tmp\n"; return; } if ($op eq '=') { if ($val ne $amt) { $fail=1; } } elsif ($op eq '#') { if ($val eq $amt) { $fail=1; } } elsif ($op eq '<') { if ($val>$amt) { $fail=1; } } elsif ($op eq '>') { if ($val<$amt) { $fail=1; } } } if ($fail==0) { $unitcount++; ($mon, $mday, $hour, $min)=($unitdate{$unit}=~ /(\d+)\/(\d+) (\d+):(\d+)/); printf "%10s %4d %-20s %-9s %3s%% %3s %3s %2d %02d:%02d\n", $country{$unitown{$unit}}?substr($country{$unitown{$unit}},0,10):$unitown{$unit}, $unit, $unitname{$unit}, $unitsect{$unit} ? $unitsect{$unit} : "(" . $unitnear{$unit} . ")", $uniteff{$unit}, $unittech{$unit}, $main'monthname{$mon}, $mday, $hour, $min; } } print "$unitcount Units.\n"; } $main'functionmap{'pstat'}='&tools_pstat'; #' sub tools_pstat { local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail); if ($main'commandarg=~/\s*(\S+)\s*(.*)/) { $area=$1; $switches=$2 if $2; } else { print STDERR "pstat (?switch)\n"; return; } if ($area=~/#(\d+)/) { $area=$realm{$1}; } $switches=~s/^\?//; local(@switch)=split(/&/, $switches); printf "%10s %4s %-20s %-9s %3s %3s %-11s\n", 'own', 'plane', 'Type', 'at(near)', 'eff', 'tech', 'date'; local($planecount)=0; foreach $plane (keys %planeown) { $fail=0; next unless (&in_realm($area, $planesect{$plane}) | &in_realm($area, $planenear{$plane})); @tmp=@switch; while($tmp=shift(@tmp)) { ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/); if ($val eq 'eff') { $val=$planeeff{$plane}; } elsif ($val eq 'tech') { $val=$planetech{$plane}; } elsif ($val eq 'own') { #*# Untested $val=$planeown{$plane}; if (($amt=~/^\d+$/)) { $amt=$number{$amt}; } } elsif ($val eq 'type') { $val=substr($planename{$plane},0,length($amt)); } else { print "Invalid switch $tmp\n"; return; } if ($op eq '=') { if ($val ne $amt) { $fail=1; } } elsif ($op eq '#') { if ($val eq $amt) { $fail=1; } } elsif ($op eq '<') { if ($val>$amt) { $fail=1; } } elsif ($op eq '>') { if ($val<$amt) { $fail=1; } } } if ($fail==0) { $planecount++; printf "%10s %4d %-20s %-9s %3s%% %3s %-11s\n", $country{$planeown{$plane}}?substr($country{$planeown{$plane}},0,10):$planeown{$plane}, $plane, $planename{$plane}, $planesect{$plane} ? $planesect{$plane} : "(" . $planenear{$plane} . ")", $planeeff{$plane}, $planetech{$plane}, $planedate{$plane}; } } print "$planecount Planes.\n"; } $main'functionmap{'sstat'}='&tools_sstat'; #' sub tools_sstat { local(@switch, @equal, @less, @nequal, @great, @tmp, $amt, $val, $xy, $fail); local($mon, $mday, $hour, $min); if ($main'commandarg=~/\s*(\S+)\s*(.*)/) { $area=$1; $switches=$2 if $2; } else { print STDERR "sstat (?switch)\n"; return; } if ($area=~/#(\d+)/) { $area=$realm{$1}; } $switches=~s/^\?//; local(@switch)=split(/&/, $switches); printf "%10s %4s %-20s %-9s %3s %3s %-11s\n", 'own', 'ship', 'Type', 'at(near)', 'eff', 'tech', 'date'; local($shipcount)=0; foreach $ship (keys %shipown) { $fail=0; next unless (&in_realm($area, $shipsect{$ship}) | &in_realm($area, $shipnear{$ship})); @tmp=@switch; while($tmp=shift(@tmp)) { ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/); if ($val eq 'eff') { $val=$shipeff{$ship}; } elsif ($val eq 'tech') { $val=$shiptech{$ship}; } elsif ($val eq 'own') { #*# Untested $val=$shipown{$ship}; if (!($amt=~/^\d+$/)) { $amt=$number{$amt}; } } elsif ($val eq 'type') { $val=substr($shipname{$ship},0,length($amt)); } else { print "Invalid switch $tmp\n"; return; } if ($op eq '=') { if ($val ne $amt) { $fail=1; } } elsif ($op eq '#') { if ($val eq $amt) { $fail=1; } } elsif ($op eq '<') { if ($val>$amt) { $fail=1; } } elsif ($op eq '>') { if ($val<$amt) { $fail=1; } } } if ($fail==0) { $shipcount++; ($mon, $mday, $hour, $min)=($shipdate{$ship}=~ /(\d+)\/(\d+) (\d+):(\d+)/); printf "%10s %4d %-20s %-9s %3s%% %3s %3s %2d %02d:%02d\n", $country{$shipown{$ship}}?substr($country{$shipown{$ship}},0,10):$shipown{$ship}, $ship, $shipname{$ship}, $shipsect{$ship} ? $shipsect{$ship} : "(" . $shipnear{$ship} . ")", $shipeff{$ship}, $shiptech{$ship}, $main'monthname{$mon}, $mday, $hour, $min; } } print "$shipcount Ships.\n"; } # Makerealm returns a list of every sector in a realm. Currently unused!! sub makerealm { local($range)=@_; if ($range eq '*') { $range=join("","-$width/2:",$width/2-1,",-$height/2:",$height/2-1); } local($xrange, $yrange)=($range=~/(\S+)\,(\S+)/); local(@tmp)=split(/:/, $xrange); local($xmin)=shift(@tmp); local($xmax)=shift(@tmp); $xmax=$xmin unless $xmax; (@tmp)=split(/:/, $yrange); local($ymin)=shift(@tmp); local($ymax)=shift(@tmp); $ymax=$ymin unless $ymax; local($x, $y); $y=$ymin-1; do { $y++; $y=-1*$height/2 if $y>=$height/2; $x=$xmin-1; do { $x++; $x=-1*$width/2 if $x>=$width/2; push (@sects, "$x,$y") if $x%2==$y%2; } until $x==$xmax; } until $y==$ymax; return @sects; } # todec converts 10K to 10000 and 10M to 10000000. It is called in parse.pl, # but I thought I should keep actual procedures out of parse.pl sub todec { local($val)=@_; if ($val=~/(\d+\.?\d*)M/) { return $1*1000000; } elsif ($val=~/(\d+\.?\d*)K/) { return $1*1000; } else { return $val; } } sub build_sect_target { local ($area) = @_; local ($x, $y); %target = (); $area = '*' unless $area; print STDERR "parsing dump $area..."; print $main'S "dump $area\n"; #' $main'command = 'dump'; #' while (&getline) { ($x,$y) = split(/\s/,$_,3); $target{"$x,$y"} = 1 unless /^\d+ sectors?$/; } print STDERR "done\n"; } sub build_ships_target { local ($ships) = @_; local ($id); %target = (); $ships = '*' unless $ships; print STDERR "parsing ship $ships..."; print $main'S "ship $ships\n"; #' $main'command = 'ship'; #' while (&getline) { ($id) = split(/\s/,$_,2); $target{$id} = 1 unless /^\d+ ships?$/; } print STDERR "done\n"; } sub build_lands_target { local ($lands) = @_; local ($id); %target = (); $lands = '*' unless $lands; print STDERR "parsing land $lands..."; print $main'S "land $lands\n"; #' $main'command = 'land'; #' while (&getline) { ($id) = split(/\s/,$_,2); $target{$id} = 1 unless /^\d+ units?$/; } print STDERR "done\n"; } sub print_n_parse { local ($line) = @_; print STDERR "parsing $line..."; &main'parse_commandline($line.' >/dev/null'); #' print STDERR "done\n"; } sub letter_init { # Put this in any init (such as find_country_number) or maybe I'll add # &deity_init for deity stuff. # Adding in single letter country desig here, used in dmap local(%used, @tmp); local($done)=0; (@tmp)=keys %country; $y=0; while(!$done) { while($#tmp>-1) { $x=pop(@tmp); next if $deity{$x}; if ($y>length($country{$x})-1) { push(@impossible, $x); next; } $test=&toupper(substr($country{$x},$y,1)); if (!defined($used{$test})) { $letter{$x}=$test; $used{$test}=1; } else { if (!defined($used{&tolower(substr($country{$x},$y,1))})) { $test=&tolower(substr($country{$x},$y,1)); if (!defined($used{$test})) { $letter{$x}=$test; $used{$test}=1; } } else { push(@tmp2, $x); } } } @tmp=@tmp2 unless $#tmp2==-1; undef(@tmp2); $done=1 unless $#tmp>-1; $y++; } if ($#impossible>-1) { local($every)="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890"; foreach $tmp (values %letter) { $every=~s/$tmp//; } local(@every)=split(//, $every); while($#impossible>-1) { $tmp=shift(@impossible); $letter{$tmp}=shift(@every); } } if (defined($mycounnum)) { print STDERR "Your country number is $mycounnum\n"; $main'coun=$mycounnum; return; } } $main'functionmap{'cmap'}='&tools_cmap'; sub tools_cmap { local(@row, $pad, %onmap, $c, @list, $tmp, $line); local ($area) = $main'commandarg; &print_n_parse("realm"); if ($area =~ /#(\d{1,2})/) { $area = $realm{$1}; } elsif ($area eq '*') { $area=join('', "-", $width/2, ":", $width/2-1, ",-", $height/2, ":", $height/2-1); } else { $area = $realm{0}; } &print_n_parse("bmap $area"); &print_n_parse("cen $area"); local($xrange, $yrange)=($area=~/(\S+),(\S+)/); local(@tmp)=split(/:/, $xrange); $xmin=shift(@tmp); $xmax=shift(@tmp); $xmax=$xmin unless $xmax; local(@tmp)=split(/:/, $yrange); $ymin=shift(@tmp); $ymax=shift(@tmp); $ymax=$ymin unless $ymax; $pad=substr(" ",0,length($height/2)+1); $x=$xmin-1; do { $x++; if ($x>$width/2-1) { print "after right x\n"; $x=$width/2*-1; } $xx=join("",substr(" ",0,length($width/2)+1-length($x)),$x); for($w=length($width/2)+1;$w>=0; $w--) { $row[$w].=substr($xx,$w,1); } } until $x==$xmax; for($w=0;$w$height/2-1; $x=$xmin-1; $pad=substr(" ",0,length($height/2)+1-length($y)); do { $x++; $x=-1*$width/2 if $x>$width/2-1; if (defined($dump{$x, $y, "des"})) { if ($dump{$x, $y, 'own'}==0 || $dump{$x, $y, 'own'}==$main'coun) { $line.=$dump{$x, $y, "des"}; } else { $line.=$letter{$dump{$x, $y, 'own'}}; $onmap{$dump{$x, $y, 'own'}}=1; } } else { if (defined($bdes{$x, $y})) { $line.=$bdes{$x, $y}; } else { $line.=" "; } } } until $x==$xmax; print "$pad$y $line $y\n"; $pad=""; $line=""; } until $y==$ymax; for($w=0;$w-1) { $line= pop(@list) . pop(@list) . pop(@list) . pop(@list); print "$line\n"; } } sub tolower { local($in)=@_; local($out, $c, $x); local(%alpha)=('A','a','B','b','C','c','D','d','E','e','F','f','G','g','H','h','I','i','J','j','K','k','L','l','M','m','N','n','O','o','P','p','Q','q','R','r','S','s','T','t','U','u','V','v','W','w','X','x','Y','y','Z','z','1','1','2','2','3','3','4','4','5','5','6','6','7','7','8','8','9','9','0','0'); $out=""; for($x=0;$x (?switch)\n"; return; } if ($area=~/#(\d+)/) { $area=$realm{$1}; } $switches=~s/^\?//; local(@switch)=split(/&/, $switches); printf "%10s %4s %-20s %-9s %3s %3s %-11s\n", 'own', 'ship', 'Type', 'at(near)', 'eff', 'tech', 'date'; local($shipcount)=0; foreach $ship (keys %shipown) { $fail=0; next unless (&in_realm($area, $shipsect{$ship}) | &in_realm($area, $shipnear{$ship})); @tmp=@switch; while($tmp=shift(@tmp)) { ($val, $op, $amt)=($tmp=~/^(\S+)([=\#<>])\"?(.+)\"?$/); if ($val eq 'eff') { $val=$shipeff{$ship}; } elsif ($val eq 'tech') { $val=$shiptech{$ship}; } elsif ($val eq 'own') { #*# Untested $val=$shipown{$ship}; if (!($amt=~/^\d+$/)) { $amt=$number{$amt}; } } elsif ($val eq 'type') { $val=substr($shipname{$ship},0,length($amt)); } else { pr