#!/usr/bin/perl -w # BridgeMats.pl - Copyright 2012 Pete Matthews # Version Date By Description # A704 1-Apr-2007 PDM New - not for BAM (yet). # A704a 5-Apr-2007 PDM Bug fixes and improvements for Individual Movements # A704b 7-Apr-2007 PDM Switch file (BridgeMats.sw) # A704c 14-Apr-2007 PDM Fixes for scale factor, arrow switch # A704d 22-Apr-2007 PDM Arrow switch detection for single table (H0712) # A705 10-May-2007 PDM Add -w, -L. # A705a 20-May-2007 PDM Add Orange & Brown. First published version # A709 3-Sep-2007 PDM Baron/Barclay sleeves -f 1.11. Old ACBL -f 1.15. # A710 6-Oct-2007 PDM Trivial help/switch changes, posting PDFs. # A802 24-Feb-2008 PDM Trivial help/switch changes. # A805 11-May-2008 PDM Fix player count with more than one phantom (S0413) # A902 16-Feb-2009 PDM Add -x (Appendix/Bowman), QM0404, fix -o # A911 15-Nov-2009 PDM Add -s, output scoring table # B205 2-Apr-2012 PDM Add -m, -M, -R; write movement file with rover # B309 20-Sep-2013 PDM Add -W with default 8.0 (use 5.0 for old print) $VERSION = "BridgeMats Version B309"; sub Usage() { # 1 2 3 4 5 6 7 #234567890123456789012345678901234567890123456789012345678901234567890123456789 print <<"EndUsage"; $VERSION Copyright (c) 2013 Usage: BridgeMats.pl [switches] movement-file where movement-file is an ACBLscore movement file and switches are: -b number Number of boards per round (default for ~24 boards) -c number Text color (0 in BridgeMats.sw): 0=use number of tables, black for partial tables 1=Black (program default), 2=Olive, 3=Purple, 4=Green, 5=Blue, 6=Teal, 7=Red, 8=Orange, 9=Brown. -d Dump the movement file as text to stdout (see -n) Use Notepad to print after redirecting (> file.txt) -f factor scale factor: default 1.0 for US Letter. Use 1.27 for full US Legal, 1.11 for Baron/Barclay sleeves, 1.15 for old ACBL. See -W. -g number group this number of ACBLscore rounds as one - when applicable, -g is required for correct next table -h Print this help to stdout and exit -l Omit the last mat (dummy table in ACBLscore) -L Print the license for BridgeMats and exit -m Write .IND rover movement file (sets -n, -d), error if not: input output with -R note S0721.IND S0721R.IND S0721RR.IND rotation S0824.IND S0824R.IND S0824RR.IND rotation S0924.IND S0924R.IND S0924RR.IND rotation S1027.IND S1027R.IND S1027RR.IND rotation S1133.IND S1133R.IND S1133RR.IND rotation S1224.IND unable to compute, if any S/E switch S1326.IND S1326R.IND S1326RR.IND S/E switch -M Perform calculations for .IND rover movement and exit. Over 9 tables: calculations may be lengthy, and a rover movement without conflicts may not exist. -t 8 or -t 11 recommended. To use the results, the program must be modified. -n Produce no PostScript mats, dump only (sets -d) -o number Produce only the mat for this table number -r number Roving pair/player number (value from file is ignored) -R number The direction of the SECOND rover (0=N, 1=E, 2=S, 3=W); must be a double rover individual movement. With rotation, the first rover is always W; without rotation, the first rover is always N. Usually specify 3, but use 0 for S1224 or S1326. -s Print scoring table to Scorer.htm -- this switch must be last, and the switch file is not read. (Open Scorer.htm with MS Word, paste the table into Excel.) -t number Truncate movement after this number of grouped rounds - 27 ungrouped rounds is the maximum without overprinting -w Double-weave movement (even EW down, odd EW up), board jump -W inches Specifies the print area width, in inches. For the width produced prior to version B309, perhaps with -f 1.11 for Baron/Barclay sleeves, use -W 5.0. To fill the width of US Letter paper, use -W 8.0, the default. -x 2-table appendix (Bowman) movement: only top two tables BridgeMats.pl writes a PostScript file of guide cards (table mats) from a binary ACBLscore duplicate bridge movement file. You should run it in a DOS box. Next, open the resulting file in GSview, where you may examine, print and/or convert to a PDF. The PostScript file could also be tweaked using Notepad - its name is the same as the movement file, but with the .PS extension. For best results, the current working directory should contain the movement file (whose extension must be .MOV, .BAM, or .IND), BridgeMats.pl, BridgeMats.ps, and BridgeMats.sw. Movements normally come from C:\\ACBLSCOR\\MOV, \\BAM or \\IND - or wherever you saved them from ACBLscore. Perl must be installed on your system and in your path. Get it for MS Windows from http://www.activestate.com/Products/ActivePerl/. Get GSview and Ghostscript from http://www.ghostgum.com.au/ or http://www.cs.wisc.edu/~ghost/gsview/ - both are needed. You'll probably need to run BridgeMats.pl, to determine the best switches to use for a new movement. Some movements are difficult or impossible to diagnose. Check the results! BridgeMats.sw provides specific defaults for the tested cases below. Unless otherwise noted, the movements are ACBLscore "External". A full command line example (others rely on BridgeMats.sw): 13 pairs: bridgemats.pl -c 0 -d -g 2 -l -r 13 H7ROVER.MOV One-winner movements, generally 24 boards: 4 pairs: bridgemats.pl H0203.MOV -- save from ACBLscore 4 pairs: bridgemats.pl H0206.MOV -- ACBLscore external 6 pairs: bridgemats.pl H0305.MOV -- save from ACBLscore 8 pairs: bridgemats.pl H0406.MOV -- save from ACBLscore 10 pairs: bridgemats.pl H0508.MOV -- save from ACBLscore 12 pairs: bridgemats.pl H0608.MOV -- save from ACBLscore 13 pairs: bridgemats.pl H7RVR-S.MOV -- from PDM 14 pairs: bridgemats.pl H0712.MOV -- save from ACBLscore 12-board movements for Bridge Plus: 6 pairs: bridgemats.pl H0305B+.MOV -- save from ACBLscore 8 pairs: bridgemats.pl H0406B+.MOV -- save from ACBLscore 8 pairs: bridgemats.pl QM0404B+.MOV -- from PDM per Sicherman 10 pairs: bridgemats.pl H0506B+.MOV -- save from ACBLscore Square Mitchell Movement (no relay): 4 pairs: bridgemats.pl QM0404.MOV -- from PDM per Sicherman Double-weave movements: 16 pairs: bridgemats.pl M0808.MOV 24 pairs: bridgemats.pl M1212DW.MOV -- from Tim Francis-Wright 2-Table Appendix (Bowman) Movements (require two board sets): 20 pairs: bridgemats.pl MB1008.MOV -- from Tim Francis-Wright 22 pairs: bridgemats.pl MB1108.MOV -- from Tim Francis-Wright 28 pairs: bridgemats.pl MB1412.MOV -- from Tim Francis-Wright 30 pairs: bridgemats.pl MB1513.MOV -- from Tim Francis-Wright Individual movements, with rotation, when possible: 8 players: bridgemats.pl S0207.IND 10 players: bridgemats.pl S0310A.IND 12 players: bridgemats.pl S0311A.IND 13 players: bridgemats.pl S0413.IND 14 players: bridgemats.pl S0414.IND 16 players: bridgemats.pl S0412A.IND 18 players: bridgemats.pl S0509.IND 20 players: bridgemats.pl S0515.IND 22 players: bridgemats.pl S0611.IND * 24 players: bridgemats.pl S0621.IND 26 players: bridgemats.pl S0713M.IND 28 players: bridgemats.pl S0721.IND 29 players: bridgemats.pl S0721R.IND 30 players: bridgemats.pl S0721RR.IND * 32 players: bridgemats.pl S0824.IND * 33 players: bridgemats.pl S0824R.IND * 34 players: bridgemats.pl S0824RR.IND 36 players: bridgemats.pl S0924.IND 37 players: bridgemats.pl S0924R.IND 38 players: bridgemats.pl S0924RR.IND * 40 players: bridgemats.pl S1027.IND * 41 players: bridgemats.pl S1027R.IND * 42 players: bridgemats.pl S1027RR.IND 44 players: bridgemats.pl S1133.IND 45 players: bridgemats.pl S1133R.IND 46 players: bridgemats.pl S1133RR.IND * 48 players: bridgemats.pl S1224.IND 52 players: bridgemats.pl S1326.IND 53 players: bridgemats.pl S1326R.IND 54 players: bridgemats.pl S1326RR.IND * Personal guide cards are required for this movement (print from ACBLscore). EndUsage # 1 2 3 4 5 6 7 #234567890123456789012345678901234567890123456789012345678901234567890123456789 exit 1; } sub License() { # The MIT License from http://www.opensource.org/licenses/mit-license.php print <<"EndLicense"; Copyright (c) 2013 Peter D. Matthews, Jr. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. EndLicense # 1 2 3 4 5 6 7 #234567890123456789012345678901234567890123456789012345678901234567890123456789 exit 1; } # -- Declarations use strict 'subs'; sub ReadSwitchFile(); sub ProcessSwitches($@); sub FindNext($$$); sub ReadMovementFile(); sub PrintSetupVars(); sub SetNext($$); sub PrintPageVars(); #----------------------------------------------------------------# sub ReadSwitchFile() { my $i; my $j; my $c; open (SWFILE, $SWFILE) or warn "--> unable to open switch file: $SWFILE <--"; $nfsw = 0; my $swstate = 0; while () { $c = substr($_,0,1); ($c eq '#') && next; # comment chomp; # remove newline my $l = length($_); my $v; if ($l > 2) { $v = substr($_,2); } else { $v = ""; } if ($c eq '%') { # -- movement file section $v =~ tr/a-z \t/A-Z/d; # uppercase without whitespace ($swstate==2) && last; # all done at end of local section if ( "$v" eq "$FILE" ) { $swstate = 2; # this is our local section next; } else { $swstate = 1; } # wrong local section } ($swstate==1) && next; # switch in wrong local section # switch is global or in correct local section if ($c ge '0' and $c le '9' ) { $j = ord($c) - ord('0'); $desc[$c] = $v; $DI[$c] = 1; } else { # add to file switch array $fsw[$nfsw] = "-$c"; $nfsw++; if ($l > 2) { $fsw[$nfsw] = $v; $nfsw++; } } } close(SWFILE); print "Defaults:"; for ($i=0; $i<$nfsw; $i++) { print " $fsw[$i]"; } print "\n"; } #----------------------------------------------------------------# sub ProcessSwitches($@) { my ($source,@Switch) = @_; while ($#Switch >= 0) { if ($Switch[0] eq "-b") { shift @Switch; $BoardsPerRound = $Switch[0]; shift @Switch; if ( $BoardsPerRound < 1 or $BoardsPerRound > 36 ) { die "--> not between 1 and 36: -b $BoardsPerRound <--"; } } elsif ($Switch[0] eq "-c") { shift @Switch; $NColor = $Switch[0]; shift @Switch; if ( $NColor < 0 or $NColor > $MaxColor ) { die "--> not between 0 and $MaxColor: -c $NColor <--"; } } elsif ($Switch[0] eq "-d") { shift @Switch; $DUMP = 1; } elsif ($Switch[0] eq "-f") { shift @Switch; $FACT = $Switch[0]; shift @Switch; if ( $FACT < .5 or $FACT > 2 ) { die "--> not between .5 and 2: -f $FACT <--"; } } elsif ($Switch[0] eq "-g") { shift @Switch; $GROUP = $Switch[0]; shift @Switch; if ( $GROUP < 1 or $GROUP >6 ) { die "--> not between 1 and 6: -g $GROUP <--"; } } elsif ($Switch[0] eq "-h") { Usage; } elsif ($Switch[0] eq "-l") { shift @Switch; $PrintLast = 0; } elsif ($Switch[0] eq "-L") { License; } elsif ($Switch[0] eq "-m") { shift @Switch; $Calc = 0; $WriteMov = 1; $PrintMats = 0; $DUMP = 1; } elsif ($Switch[0] eq "-M") { shift @Switch; $Calc = 1; $WriteMov = 0; $PrintMats = 0; $DUMP = 1; } elsif ($Switch[0] eq "-n") { shift @Switch; $PrintMats = 0; $DUMP = 1; } elsif ($Switch[0] eq "-o") { shift @Switch; $PrintOnly = $Switch[0]; shift @Switch; if ( $PrintOnly<1 or $PrintOnly>40 ) { die "--> not between 1 and 40: -o $PrintOnly <--"; } } elsif ($Switch[0] eq "-r") { shift @Switch; $Rover = $Switch[0]; shift @Switch; if ( $Rover<1 or $Rover>80 ) { die "--> not between 1 and 80: -r $Rover <--"; } } elsif ($Switch[0] eq "-R") { shift @Switch; $R2D = $Switch[0]; shift @Switch; if ( $R2D<0 or $R2D>3 ) { die "--> not between 0 and 3: -r $R2D <--"; } } elsif ($Switch[0] eq "-t") { shift @Switch; $TruncAfter = $Switch[0]; shift @Switch; if ( $TruncAfter<2 or $TruncAfter>36 ) { die "--> not between 2 and 36: -t $TruncAfter <--"; } } elsif ($Switch[0] eq "-w") { $Weave = 1; shift @Switch; } elsif ($Switch[0] eq "-W") { shift @Switch; $XWIDE = $Switch[0]; shift @Switch; if ( $XWIDE < 4.99 or $XWIDE > 8.1 ) { die "--> not between 5.0 and 8.1: -W $XWIDE <--"; } } elsif ($Switch[0] eq "-x") { $Appx = 1; shift @Switch; } else { my $msg; if ($source==1) { $msg = "switch file"; warn "--> if previous switch has no value, check line ends before column 3 <--"; } else { $msg = "command line"; } die "--> Unrecognized $msg switch: $Switch[0] <--"; } } } #----------------------------------------------------------------# sub ReadMovementFile() { open (MOV, $file) or die "--> unable to open switch defaults file: $file <--\n"; binmode (MOV); # otherwise read converts 0x0d0a (CRLF) to 0x0a (LF) - H7ROVER my ($buf, @byte); my ($c1, $c2, $c3, $c4); my $signature; my $tablehdr; my $breaktest; my $NB; # Header1, Header2, Header36 are global, for WriteMovementFile # Keep print from converting an x13=CR/x10=\n combo to only an x10 binmode MOV; # -- read the first 2 bytes of the header, convert to hexadecimal # Note: unable to get ActivePerl to convert 2 bytes to signed integer) read (MOV, $buf, 1); $Header1 = $buf; $c1 = unpack('H',$buf); $c2 = unpack('h',$buf); read (MOV, $buf, 1); $Header2 = $buf; $c3 = unpack('H',$buf); $c4 = unpack('h',$buf); $signature = "${c1}${c2}${c3}${c4}"; if ( $signature eq "5d8d" ) { # = -19347 if ( $TYPE eq "BAM" ) { $movement = "Board-a-Match"; } else { $movement = "Pair"; } } elsif ( $signature eq "55ba" ) { $movement = "Individual"; } # = -27835 elsif ( $signature eq "6db4" ) { $movement = "Board-a-Match"; } # (B0807TH.BAM) else { die "--> signature=$signature - not an ACBLscore movement file: $file <--\n"; } ($DUMP) && print "Type: ", $movement, " (", $signature, ")\n"; # -- now read the next four header bytes read (MOV, $buf, 4); $Header36 = $buf; @byte = unpack ('c*', $buf); $howell = $byte[0]; $tables = $byte[1]; $pairs = $tables*2; # adjust later $players = $tables*4; $rounds = $byte[2]; $boards = $byte[3]; ($DUMP) && print "Howell: $howell\n"; ($DUMP) && print "Tables: $tables\n"; ($DUMP) && print "Rounds: $rounds\n"; ($DUMP) && print "Boards: $boards (if only 1 board/round)\n"; # -- Set up table numbers - use indexes except in TN and TNP arrays for ($h=0; $h<$tables; $h++) { $t = $h +1; $TN[$h] = $t; # table number (numeric) if ($t == 6) { $TNP[$h] = "SIX"; } elsif ($t == 9) { $TNP[$h] = "NINE"; } else { $TNP[$h] = $t; } } # -- read description ($DUMP) && print "Description: 1 2 3 4 5 6\n"; ($DUMP) && print " 123456789012345678901234567890123456789012345678901234567890\n"; for ($t=0; $t<10; $t++) { read (MOV, $buf, 60); ($DUMP) && print " $t=> ", $buf, "\n"; if ($DI[$t]) { ($DUMP) && print " ++$t=> ", $desc[$t], "\n"; } else { $desc[$t] = $buf; } } # -- read rest of header if ( $TYPE eq "IND" ) { ($DUMP) && print " [no pair/board/phantom/rover info for Individual movement]\n"; @board = (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18, 19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36); # -- Set up for Rest of Read $ND = 4; # number of directions $b = 4; # index of boards in cell array $NB = 5; # number of bytes to read $n = 5; # index of notes in cell array $breaktest = 3; $tablehdr = ": (N,E,S,W,BD) --------------------------------------\n"; } else { # MOV or BAM read (MOV, $buf, 1); $highpair = ord($buf); ($DUMP) && print "HighPair: $highpair\n"; read (MOV, $buf, 64); @pair = unpack ('c*', $buf); ($DUMP) && print "Pairs: "; for ($t=0; $t<64; $t++) { ($DUMP) && print $pair[$t], " "; if ( ($t%16) == 15 ) { ($DUMP) && print "\n"; if ($t < 63) {print " "; } } } $phantom = $pair[61]; if ($phantom>0) { ($DUMP) && print "Phantom: $phantom NS\n"; } elsif ($phantom<0) { ($DUMP) && print "Phantom: $phantom EW\n"; } else { ($DUMP) && print "Phantom: $phantom\n"; } $rover = $pair[63]; if ($rover>0) { ($DUMP) && print "Rover: EW\n"; } elsif ($rover<0) { ($DUMP) && print "Rover: NS\n"; } else { ($DUMP) && print "Rover: $rover\n"; } # -- read board data read (MOV, $buf, 36); # $BoardData = $buf; -- for writing movement @board = unpack ('c*', $buf); ($DUMP) && print "Boards: "; for ($t=0; $t<36; $t++) { ($DUMP) && print $board[$t], " "; if ( $t == 17 ) { ($DUMP) && print "\n "; } } ($DUMP) && print "\n"; if ( $highpair != 0 ) { die "--> unable to handle renumbered pairs at this time<--"; } # -- Set up for Rest of Read $ND = 2; # number of directions $b = 2; # index of boards in cell array $NB = 3; # number of bytes to read $n = 3; # index of notes in cell array $breaktest = 5; $tablehdr = ": (NS,EW,BD) ----------------------------------------\n"; } # -- Read & Check Table Records for ($t=0; $t<$tables; $t++) { ($DUMP) && print "Table ", $t+1, $tablehdr; for ($r=0; $r<$rounds; $r++) { read (MOV, $buf, $NB) or die "--> bad read - file is probably damaged <--"; @byte = unpack ('c*', $buf) or die "--> bad unpack <--"; ($DUMP) && print "("; for ($d=0; $d<=$ND; $d++) { # read boards as well as directions $cell[$d][$r][$t] = $byte[$d]; ($DUMP) && print $byte[$d]; if ( $d < $ND ) { ($DUMP) && print ","; } } ($DUMP) && print ") "; if ( $r%($breaktest+1) == $breaktest ) { ($DUMP) && print "\n"; } # initialize Notes $cell[$n][$r][$t] = ""; } ($DUMP) && print "\n"; # initialize for the checking loop for ($d=0; $d<$ND; $d++) { $NextTable[$d][$t] = -1; # index, -2=unpredictable $NextDir[$d][$t] = -1; # direction or -2=switch } } close(MOV); # -- Check tables, groups, rounds if ( $PrintOnly>$tables ) { die "--> exceeds number of tables: -o $PrintOnly <--"; } if ( $GROUP > 1 ) { $bpr = $GROUP * int($rounds/$GROUP); ($bpr==$rounds) || die "--> not a factor of number of rounds ($rounds): -g $GROUP <--"; $bpr = $GROUP * int($boards/$GROUP); ($bpr==$boards) || die "--> not a factor of number of boards ($boards): -g $GROUP <--"; } my $T = $TruncAfter * $GROUP; if ( $T < $rounds ) { $rounds = $T; ($DUMP) && print "Rounds: $rounds (-t)\n"; } if ($BoardsPerRound == 0) { $BoardsPerRound = int(29/$rounds); $bpr="BridgeMats default, see -b"; } else { $bpr="from -b"; } $BoardsTotal = $rounds * $BoardsPerRound; ($DUMP) && print "Bd/Rd: $BoardsPerRound ($bpr)\n"; ($DUMP) && print "Played: $BoardsTotal (calculated)\n"; # -- Check for Relays, Initialize if ($Appx == 0) { $t0 = 0; } else { $t0 = $tables - 2; } # only last two tables for ($t=0; $t<$tables; $t++) { $RealTable[$t] = 0; $SwitchPair[$t] = -1; for ($r=0; $r<$rounds; $r++) { # check for fake tables $bd = $cell[$b][$r][$t]; if ($bd>0) { $RealTable[$t] = 1; } } for ($r=0; $r<$rounds; $r+=$GROUP) { # by grouped rounds $bd = $cell[$b][$r][$t]; $set = 0; # -- check for relays for ($x=$t0; $x<$tables; $x++) { ($x == $t) && next; # skip current table ($t < $t0) && next; # only last two tables for -x for ($g=0; $g<$GROUP; $g++) { if ($cell[$b][$r+$g][$x] == $bd) { if ($set) { # more than 2 table relay $cell[$n][$r][$t] = "Relay"; $cell[$n][$r+$g][$t] = "Relay"; } else { # assume 2-table relay for now $set = 1; my $xp = $x + 1; $cell[$n][$r][$t] = "Relay T$xp"; $cell[$n][$r+$g][$t] = "Relay T$xp"; } } } } } } # -- if pairs, check for switch tables if ( $TYPE eq "MOV" ) { for ($t=0; $t<$tables; $t++) { my $x = $cell[0][0][$t]; my $y = $cell[1][0][$t]; my $u = $cell[0][1][$t]; my $v = $cell[1][1][$t]; my $z = -1; my $d = -1; for ($r=$GROUP; $r<$rounds; $r+=$GROUP) { $u = $cell[0][$r][$t]; $v = $cell[1][$r][$t]; ($u==$Rover) && next; ($v==$Rover) && next; if ($z>-1) { # test switch pair candidate if ($u==$z) { if ($d==-1) { $d = 0; } elsif ($d!=-2) { if ($d==1) { $d = -2; } # switch } next; } elsif ($v==$z) { if ($d==-1) { $d = 1; } elsif ($d!=-2) { if ($d==0) { $d = -2; } # switch } next; } else { $z = -1; last; } # not a switch table } else { # look for switch pair candidate if ($u==$x or $v==$x) { $z = $x; } elsif ($u==$y or $v==$y) { $z = $y; } else { last; } # not a switch table } } if ($z>-1 and $d==-2) { $SwitchPair[$t] = $z; } } } # -- find next tables for ($t=0; $t<$tables; $t++) { for ($r=0; $r<$rounds-$GROUP; $r+=$GROUP) { # omit last round for ($d=0; $d<$ND; $d++) { if ($NextTable[$d][$t]>=-1) { FindNext($d,$r,$t); } if ($SwitchPair[$t]>-1) { last; } # only check one dir } } } # -- check Double-Weave movement if ($Weave == 1) { $Half = int($tables/2); if ( $tables != (2*$Half) ) { die "Number of tables must be even for double-weave: -w"; } my $w; my $x; my $y; my $z; for ($t=0; $t<$tables; $t++) { for ($r=0; $r<$rounds-$GROUP; $r+=$GROUP) { $x = $cell[1][$r][$t]; $z= int($x/2); if ($x == (2*$z)) { if ($t>0) { $y = $t - 1; } else { $y = $tables - 1; } } elsif ($t<$tables-1) { $y = $t + 1; } else { $y = 0; } $w = $cell[1][$r+1][$y]; if ($w != $x) { print "\nr=$r, t=$t w=$w, x=$x, y=$y, z=$z \n"; die "Expected EW movement not found for double-weave"; } } } } } #----------------------------------------------------------------# sub FindNext($$$) { # called once for each table/round/direction my($d,$r,$t) = @_; my $sp = $SwitchPair[$t]; my $pr = $cell[$d][$r][$t]; if ($r+$GROUP >= $rounds) { return; } # can't test last round elsif ($SwitchPair[$t]>-1) { # test the correct direction (only) if ($sp == $pr) { $d = 1; $pr = $cell[$d][$r][$t]; $NextDir[$d][$t] = -2; # don't check direction at target table } } if ($Rover == $pr) { return; } # skip if this is rover if ($Rover2 == $pr) { return; } # skip if this is rover 2 my $n = $NextTable[$d][$t]; my $j = $r + $GROUP; my $k = $NextDir[$d][$t]; my $tg; my $i; my $l; if ($n == -2) { return; } # unpredictable - do nothing if ($n > -1) { if ($k > -1) { # check expected location $tg = $cell[$k][$j][$n]; if ($pr==$tg or $Rover==$tg) { goto RETURN; } } for ($l=0; $l<$ND; $l++) { # check same table $tg = $cell[$l][$j][$n]; if ($pr==$tg or $Rover==$tg) { # at same table $NextDir[$d][$t] = -2 ; # ($DUMP) && # print "d=$d, r=$r, t=$t k=$k, j=$j, n=$n, l=$l pr=$pr tg=$tg", # " -- direction change\n"; goto RETURN; } } $NextTable[$d][$t] = -2; # not found # ($DUMP) && # print "d=$d, r=$r, t=$t k=$k, j=$j, n=$n", # " -- not found\n"; goto RETURN; } else { # search entire next round for ($k=0; $k<$ND; $k++) { for ($i=0; $i<$tables; $i++) { if ($RealTable[$i]==0 and $Rover) { # skip fake table (H7ROVER) # ($DUMP) && # print "d=$d, r=$r, t=$t k=$k, j=$j, i=$i", # " -- skip fake table with rover\n"; next; } if ($pr==$cell[$k][$j][$i]) { $NextTable[$d][$t] = $i; $NextDir[$d][$t] = $k; ($SwitchPair[$t]>-1) and $NextDir[$d][$t] = -2; # ($DUMP) && # print "d=$d, r=$r, t=$t k=$k, j=$j, i=$i, n=$n", # " -- found next table\n"; goto RETURN; } } } # if not found, just check next time # ($DUMP) && # print "d=$d, r=$r, t=$t k=$k, j=$j, i=$i", # " -- next table not found yet\n"; } return; RETURN: if ($SwitchPair[$t]>-1) { # brute force $n = $NextTable[$d][$t]; $NextTable[0][$t] = $n; $NextTable[1][$t] = $n; $NextDir[0][$t] = -2; $NextDir[1][$t] = -2; } return; } #----------------------------------------------------------------# sub PrintSetupVars() { my $t; my $r; my $d; my $p; my $test; # reduce number of pairs... if ($TYPE eq "BAM") { $Title1 = "(Board-a-Match Bridge)"; $Title2 = "(Movement for)"; $PAIRS = "($tables TEAMS)"; } elsif ($TYPE eq "IND") { # -- deduct phantom players from total (S0713M,S0413) for ($t=0; $t<$tables; $t++) { if ( ! $RealTable[$t] ) { for ($d=0; $d<$ND; $d++) { $p = $cell[$d][0][$t]; $test = 1; for ($r=1; $r<$rounds; $r++) { if ($p!=$cell[$d][$r][$t]) { $test = 0; # this player is not a phantom next; } } $players -= $test; } } } # ($Rover==0) or $players++; -- rover requires phantom table, counted above $Title1 = "(Individual Bridge)"; $Title2 = "(Movement for)"; $PAIRS = "($players PLAYERS)"; $BoxLine[0] = "/BoxLine {"; $BoxLine[1] = " NT n get"; $BoxLine[2] = " BD n get"; $BoxLine[3] = " WW n get"; $BoxLine[4] = " SS n get"; $BoxLine[5] = " EE n get"; $BoxLine[6] = " NN n get"; $BoxLine[7] = " RD n get"; $BoxLine[8] = " IndBoxLine } def"; $NBoxLine = 9; @DirArr = ("NN", "EE", "SS", "WW"); $add=4; } else { # "MOV" ($Rover>0 || $phantom!=0) && $pairs--; $Title1 = "(Duplicate Bridge)"; $Title2 = "(Movement for)"; $PAIRS = "($pairs PAIRS)"; $BoxLine[0] = "/BoxLine {"; $BoxLine[1] = " NT n get"; $BoxLine[2] = " BD n get"; $BoxLine[3] = " EW n get"; $BoxLine[4] = " NS n get"; $BoxLine[5] = " RD n get"; $BoxLine[6] = " PairsBoxLine } def"; $NBoxLine = 7; @DirArr = ("NS", "EW"); $add=0; } # -- print "here document" with interpolation print PSOUT <<"PrintEndSetup"; /VERSION ($VERSION) def /FACT $FACT def /XWIDE $XWIDE def /TITLE ($FILE) def /Title1 $Title1 def /Title2 $Title2 def /PAIRS $PAIRS def /ROUNDS $rounds def /DESC [ ($desc[0]) ($desc[1]) ($desc[2]) ($desc[3]) ($desc[4]) ($desc[5]) ($desc[6]) ($desc[7]) ($desc[8]) ($desc[9]) ] def PrintEndSetup for ($i=0; $i<$NBoxLine; $i++) { print PSOUT "$BoxLine[$i] \n"; } } #----------------------------------------------------------------# sub SetNext($$) { my ($d, $t) = @_; my $k = $NextDir[$d][$t]; my $n = $NextTable[$d][$t]; my $Next; my $Other; if ($DUMP) { print "Next for T", $TN[$t], ", ", $Dir[$d+4]; ($d%2==1) && print " "; print " ==> "; # print "(k=$k, n=$n) "; # if (! $RealTable[$n]) { print " Sit Out"; } if ($n > -1) { print "T", $TN[$n]; if ($k > -1) { print ", ", $Dir[$k+4]; } } if ($SwitchPair[$t]>-1) { print " - Switch Table, Pair ", $SwitchPair[$t]; } print "\n"; } if ($n<0) { # unpredictable $Next = "()"; $Other = "()"; return ($Next, $Other); } elsif ($n==$t) { # this table if ($k==$d) { if ($RealTable[$t]) { if ($GROUP==1) { $Next = "(Remain Stationary)"; } else { $Next = "(Remain at This Table)"; } } else { $Next = "(Phantom Player)"; } $Other = $Next; return ($Next, $Other); } # else drop through } if ($k>-1) { # specific table and direction # ($DUMP) && print "... t=$t, d=$d n=$n, k=$k\n"; if (($ND==4) or ($k==$d)) { # use second half of @Dir if ($SwitchPair[$t]==-1) { $k+=4; } } if ($SwitchPair[$t]>-1) { $Next = "(Other Pairs Go Next to Table $TN[$n])"; } else { $Next = "(Go Next to Table $TN[$n], $Dir[$k])"; } if ($k%4 < 2) { if ($SwitchPair[$t]>-1) { $Other = "(Other Pairs Go Next to Table $TN[$n])"; } else { $Other = "(Go Next to Table $TN[$n], $Dir[$k+2])"; } } else { $Other = "(--)"; # should never be used } } else { # another table, direction switches if ($SwitchPair[$t]>-1) { $Next = "(Other Pairs Go Next to Table $TN[$n])"; } else { $Next = "(Go Next to Table $TN[$n])"; } $Other = $Next; } return ($Next, $Other); } #----------------------------------------------------------------# sub PrintPageVars() { my $la1NS = 3; my $la1EW = 3; my $up; my $down; my $L2N = "()"; my $L2S = "()"; my $L2E = "()"; my $L2W = "()"; my $Note = "(Note)"; if ($TYPE eq "IND") { ($NextNorth, $ignore) = SetNext(0,$t); ($NextEast, $ignore) = SetNext(1,$t); ($NextSouth, $ignore) = SetNext(2,$t); ($NextWest, $ignore) = SetNext(3,$t); } else { # MOV or BAM # set North-South ($NextNorth, $NextSouth) = SetNext(0,$t); # set East-West if ($Weave) { if ($t>0) { $down = $t - 1; } else { $down = $tables - 1; } if ($t<$tables-1) { $up = $t + 1; } else { $up = 0; } $NextEast = "(EVEN-number pair DOWN to table $TN[$down])"; $L2E = "(ODD-number pair UP to table $TN[$up])"; $NextWest = $NextEast; $L2W = $L2E; $la1EW = -9; # set Notes for board movement $Note="(Move Bds)"; my $b = 2; my $n = 3; my $r; my $s; my $bd; my $next; for ($r=0; $r<$rounds-$GROUP; $r+=$GROUP) { # by grouped rounds $bd = $cell[$b][$r][$t]; $next = -1; for ($s=0; $s<$tables; $s++) { if ($bd == $cell[$b][$r+1][$s]) { $next = $s; last; } } ($next == -1 ) and die "Bad board layout in weave movement."; $cell[$n][$r][$t] = "to Table $TN[$next]"; } } elsif ($SwitchPair[$t]>-1) { $L2N = $NextNorth; $L2E = $L2N; $L2S = $L2N; $L2W = $L2N; $NextNorth = "(Pair $SwitchPair[$t] Remain at This Table)"; $NextEast = $NextNorth; $NextSouth = $NextNorth; $NextWest = $NextNorth; $la1NS = -9; $la1EW = -9; } else { ($NextEast, $NextWest) = SetNext(1,$t); } } print PSOUT "$Color[$NColor]\n"; # -- Rounds print PSOUT "/RD [ (Rd.)"; $l=0; for ($r=0; $r<$rounds; $r++) { if ($r%$GROUP == 0) { $l++; print PSOUT " (${l}.)"; } else { print PSOUT " ()"; } } print PSOUT " ] def\n"; # -- Directions for ($d=0; $d<$ND; $d++) { $k = $d + $add; print PSOUT "/$DirArr[$d] [ ($Dir[$k])"; for ($r=0; $r<$rounds; $r++) { print PSOUT " ($cell[$d][$r][$t])"; if ($Rover>0) { if ($Rover==$cell[$d][$r][$t]) { $cell[$ND+1][$r][$t] = "-ROVER-"; } } if ($Rover2>0) { if ($Rover2==$cell[$d][$r][$t]) { $cell[$ND+1][$r][$t] = "-ROVER-"; } } } print PSOUT " ] def\n"; } # -- Boards print PSOUT "/BD [ (Boards)"; for ($r=0; $r<$rounds; $r++) { $k = $ND; $b1 = $cell[$k][$r][$t]; # apply board translation if ($b1 == 0) { $b2 = 'BYE'; } else { $b1 = $board[$b1-1]; $b1 = ($b1*$BoardsPerRound)-$BoardsPerRound+1; if ($BoardsPerRound>1) { $b2 = $b1+$BoardsPerRound-1; $b2 = "$b1-$b2"; } else { $b2 = $b1; } } print PSOUT " ($b2)"; } print PSOUT " ] def\n"; # -- Notes print PSOUT "/NT [ $Note"; for ($r=0; $r<$rounds; $r++) { $k = $ND +1; print PSOUT " ($cell[$k][$r][$t])"; } print PSOUT " ] def\n"; print PSOUT <<"PrintEndMOV"; /NextEast $NextEast def /NextSouth $NextSouth def /NextWest $NextWest def /NextNorth $NextNorth def /TableNumber ($TNP[$p]) def /Line1AdjNS $la1NS def /Line1AdjEW $la1EW def /Line2Adj 4 def /Line2N $L2N def /Line2S $L2S def /Line2E $L2E def /Line2W $L2W def PrintEndMOV } #----------------------------------------------------------------# sub Made($$$$$) { # $bid = number of tricks bid # $made = number of tricks made # $first = 20 (minor), 30 major, 40 (NT) = first trick value # $dbl = 1 (undoubled), 2 (doubled), 4 (redoubled) # $vul = 0 (not vul, false), 1 (vul, true) my ($bid, $made, $first, $dbl, $vul) = @_; my ($result); ($bid > $made ) && die "Made: bid ($bid) > made ($made)"; $second = $first; if ($first == 40) { $second = 30; } # -- bid tricks $result = ($first + ($bid-1)*$second) * $dbl; if ($result<100) { $result += 50; } else { if ($vul) { $result += 500; } else { $result += 300; } } if ($bid==6) { if ($vul) { $result += 750; } else { $result += 500; } } if ($bid==7) { if ($vul) { $result += 1500; } else { $result += 1000; } } # -- overtricks and insult if ($dbl==1) { $result += $second*($made-$bid); } # trick score else { $result += 50*($vul+1)*$dbl*($made-$bid); $result += 25*$dbl; # insult } return $result; } #----------------------------------------------------------------# sub Down($$$) { # $down = number of tricks down # $dbl = 1 (undoubled), 2 (doubled), 4 (redoubled) # $vul = 0 (not vul, false), 1 (vul, true) my ($down, $dbl, $vul) = @_; my ($first, $second, $fourth, $result); $first = 50 * $dbl * ($vul+1); if ($dbl == 1) { $second = $first; $fourth = $second; } elsif ($vul) { $second = 150 * $dbl; $fourth = 150 * $dbl; } else { $second = 100 * $dbl; $fourth = 150 * $dbl; } $result = $first; if ($down>1) { $result += $second; } if ($down>2) { $result += $second; } if ($down>3) { $result += $fourth * ($down-3); } return $result; } #----------------------------------------------------------------# sub Scorer() { my ($b, $m, $v, $h1, $h2, $big1, $big2, $cd, $hs, $nt, $break, $blank, $blank2, $blank5, $blank11, $ct, $d, $minors, $majors, $notrump); my (@h); $h[0] = "Not Vulnerable"; $h[1] = "Vulnerable"; $wide = int(400*$FACT+0.99); $high = int(796*$FACT+0.99); $SCOUT = ">Scorer.htm"; open (SCOUT, $SCOUT) or die "--> unable to open output file: '$SCOUT' <--\n"; $h1 = "\n"; $h2 = "\n"; $big1=""; $big2="\n"; $minors="Minors\n"; $majors="Majors\n"; $notrump="NoTrump\n"; $cd="♣ ♦\n"; $hs="♥ ♠\n"; $nt="NT\n"; $blank = " \n"; $blank2 = " \n"; $blank5 = " \n"; $blank11 = " \n"; $break = " \n\n"; print SCOUT "\n"; print SCOUT "\n"; # -- Defeated contracts and Title print SCOUT "\n"; print SCOUT $blank11, $blank; print SCOUT "\n"; print SCOUT "\n"; print SCOUT "\n"; print SCOUT "\n"; print SCOUT "\n"; print SCOUT $blank11, $blank2, $blank, "\n"; print SCOUT "\n"; print SCOUT $blank, "\n"; print SCOUT "\n"; for ($d=1; $d<=13; $d++) { print SCOUT "\n"; if ($d==1) { print SCOUT $big1, "Duplicate", $big2; } elsif ($d==4) { print SCOUT $big1, "Bridge", $big2; } elsif ($d==7) { print SCOUT $big1, "Scoring", $big2; } elsif ($d>9) { if ($d==11) { print SCOUT "\n"; } else { print SCOUT $blank11; } } print SCOUT $blank2; print SCOUT "\n"; print SCOUT "\n"; print SCOUT "\n"; print SCOUT "\n"; } print SCOUT $break; # -- Contracts Made # header 1: Not Vul Vul print SCOUT "\n"; print SCOUT $blank, "\n"; print SCOUT "\n"; print SCOUT "\n"; print SCOUT $blank, "\n\n"; # header 2: Minors, Majors, NT print SCOUT "\n"; print SCOUT $minors, $blank; print SCOUT $majors, $blank; print SCOUT $notrump; print SCOUT $blank2; print SCOUT $minors, $blank; print SCOUT $majors, $blank; print SCOUT $notrump; print SCOUT "\n\n"; # header 3: X XX Bid Made print SCOUT "\n"; print SCOUT $cd, "", "", $blank; print SCOUT $hs, "", "", $blank; print SCOUT $nt, "", ""; print SCOUT "\n"; print SCOUT "\n"; print SCOUT $cd, "", "", $blank; print SCOUT $hs, "", "", $blank; print SCOUT $nt, "", ""; print SCOUT "\n\n"; for ($b=1; $b<=7; $b++) { $ct = 8 - $b; for ($m=$b; $m<=7; $m++) { print SCOUT "\n"; # minors print SCOUT "\n"; # majors print SCOUT "\n"; # NT print SCOUT "\n"; if ($m == $b) { # bid (once per section) print SCOUT "\n"; } # made print SCOUT "\n"; # minors print SCOUT "\n"; # majors print SCOUT "\n"; # NT print SCOUT "\n"; print SCOUT "\n"; if ($m==7) { print SCOUT $break; } } } print SCOUT "
Not Vulnerable\n"; print SCOUT "  – Defeated –Vulnerable
XXXDownXXX
"; print SCOUT $VERSION, "", Down($d,1,0); print SCOUT "", Down($d,2,0); print SCOUT "", Down($d,4,0), "", $d, "", Down($d,1,1); print SCOUT "", Down($d,2,1); print SCOUT "", Down($d,4,1), "
\n"; print SCOUT "Not Vulnerable\n"; print SCOUT "— Fulfilled —\n"; print SCOUT "Vulnerable
XXXXXXXXXBidMadeXXXXXXXXX
", Made($b,$m,20,1,0); print SCOUT "", Made($b,$m,20,2,0); print SCOUT "", Made($b,$m,20,4,0); print SCOUT " ", Made($b,$m,30,1,0); print SCOUT "", Made($b,$m,30,2,0); print SCOUT "", Made($b,$m,30,4,0); print SCOUT " ", Made($b,$m,40,1,0); print SCOUT "", Made($b,$m,40,2,0); print SCOUT "", Made($b,$m,40,4,0); print SCOUT "  ", $b, "", $m, "", Made($b,$m,20,1,1); print SCOUT "", Made($b,$m,20,2,1); print SCOUT "", Made($b,$m,20,4,1); print SCOUT " ", Made($b,$m,30,1,1); print SCOUT "", Made($b,$m,30,2,1); print SCOUT "", Made($b,$m,30,4,1); print SCOUT " ", Made($b,$m,40,1,1); print SCOUT "", Made($b,$m,40,2,1); print SCOUT "", Made($b,$m,40,4,1); print SCOUT "
"; print SCOUT "\n"; close (SCOUT); } #----------------------------------------------------------------# sub Insert_Rover_init() { ($TYPE eq "IND") or die "Can only calculate or write rover movement for .IND file ($TYPE)"; $phantom_table = $tables; # one less as an index $tables++; # movement will have phantom table where bumpees go # print "phantom_table=$phantom_table\n"; if ($cell[2][0][0]<($tables-1)) { # starting South at table 1 ($howell) and die "Movement file is one-winner, but appears to be a Mitchell/Rainbow"; $Rotation = 0; $Rover = $tables; $Rover2 = $Rover; # Mitchell, rover 2 direction must be different if ($R2D==0) { die "Rover 2 must not be North for non-rotation movement." } $RD = 0; # rover will be North } else { $Rotation = 1; $Rover = (4*$tables) - 3; # Calculate, since cannot provide as input $Rover2 = $Rover + 1; $RD = 3; # rover will be West } } #----------------------------------------------------------------# sub Calc_Rover_IND() { # line 1374 ### Insert_Rover_init; # Our rover will always sit in a defined position, as will a second rover. # We are going to brute force this, checking every conceivable movement. # All individual movements are external to ACBLscore except non-rotation # Mitchell movements for a prime number of tables (3, 5, 7, 11, 13). # Rover tables for a rotation movement work for equivalent non-rotation # movement, but replace a West second rover with East. # Must have two or three grouped 1-board rounds per table # ($GROUP>1) or die "GROUP ($GROUP) is not 2 or 3, cannot calculate rover movement\n"; # -- initialize variables my @rtables = (0) x $Grounds; # effective argument to CALC my $w = $Grounds-1; my $maxtable = $tables -2; my $G; my $i; my $r; my $t; my $p; my $N; my $E; my $S; my $W; my $B; my @rboards = (0) x $Grounds; my @rnorths = (0) x $Grounds; my @reasts = (0) x $Grounds; my @rsouths = (0) x $Grounds; my @rwests = (0) x $Grounds; my $c; # count (0,...,0,0), (0,...,0,1), ..., ($t,...,$t,$t) [base $tables] # lots of things start at 0, but player/pair numbers start at 1 # $cell[$d][$r][$t] all start at 0 print "\nConflict: tables by grouped round\n"; LOOP: while (1) { # forever # -- initialize for ($G=0; $G<$Grounds; $G++) { $rboards[$G] = 0; $rnorths[$G] = 0; $reasts[$G] = 0; $rsouths[$G] = 0; $rwests[$G] = 0; } $c = 0; # -- calculate (can be slow, so not a subroutine) CALC: for ($G=0; $G<$Grounds; $G++) { # G is grouped round index $r = $G * $GROUP; $t = $rtables[$G]; # pick out current boards and players $B = $cell[4][$r][$t]; $rboards[$G] = $B; $N = $cell[0][$r][$t]; $rnorths[$G] = $N; $E = $cell[1][$r][$t]; $reasts[$G] = $E; $S = $cell[2][$r][$t]; $rsouths[$G] = $S; $W = $cell[3][$r][$t]; $rwests[$G] = $W; ($G==0) and next CALC; # saves initializing loops, no conflicts on first round # boards: first board must not have been played (assumes played in order) for ($i=0; $i<$G; $i++) { if ($B==($rboards[$i])) { $c = 90; last CALC; } } # Howell: check for conflict among all positions of all previous rounds if ($howell) { for ($i=0; $i<$G; $i++) { # too slow otherwise, hope we only need to detect a conflict foreach $p ($N,$E,$S,$W) { if ($p==($rnorths[$i])) { $c = 10; last CALC; } if ($p==($reasts[$i])) { $c = 11; last CALC; } if ($p==($rsouths[$i])) { $c = 12; last CALC; } if ($p==($rwests[$i])) { $c = 13; last CALC; } } } } # Mitchell: check for conflict at each position else { for ($i=0; $i<$G; $i++) { if ($N==($rnorths[$i])) { $c = 20; last CALC; } if ($E==($reasts[$i])) { $c = 21; last CALC; } if ($S==($rsouths[$i])) { $c = 22; last CALC; } if ($W==($rwests[$i])) { $c = 23; last CALC; } } } } # CALC # -- test & print if ($c==0) { print "$c: "; for ($G=0; $G<$Grounds; $G++) { print $rtables[$G]+1, " "; } print "\n"; } ##### Line 1483 # -- add one to table pattern (counting: right to left) $w = $Grounds - 1; # look first at right-most position PLUS: while (1) { # forever $i = $rtables[$w]; if ($i < $maxtable) { # we can, so add 1 to where we are $rtables[$w] ++; last PLUS; } elsif ($w==0) { last LOOP; # done when all values at max } else { # reset to 0 and carry the 1 $rtables[$w] = 0; $w--; } } # PLUS } # LOOP print "Calculations complete.\n"; exit 0; } #----------------------------------------------------------------# sub Insert_Rover_IND() { # insert the rover into the movement Insert_Rover_init; # ten description lines: # 0-3: set/blanked here to describe general features of movement # 4: set/blanked here, reserved for "personal guide cards" # 5-7: rover movement description # 8-9: 2nd rover movement description print "\n"; if ( ($BASEFILE eq "S0721") or ($BASEFILE eq "R0721") or ($BASEFILE eq "R0728") ) { # padded with blanks on output # 1 2 3 4 5 6 #123456789012345678901234567890123456789012345678901234567890 if ($BASEFILE eq "S0721") { $desc[0]="7 tables, 7 rounds of 3 boards. Rainbow, rotation, rover."; $desc[1]="Players rotate clockwise around North after each board."; $desc[2]="Computer set up as 21 rounds of 1 board."; } elsif ($BASEFILE eq "R0721") { $desc[0]="7 tables, 7 rounds of 3 boards. Rainbow, no rotation, rover."; $desc[1]=""; $desc[2]=""; } elsif ($BASEFILE eq "R0728") { $desc[0]="7 tables, 7 rounds of 4 boards. Rainbow, no rotation, rover."; $desc[1]=""; $desc[2]=""; } $desc[3]="North stationary, East up 2, South up 1, West down 2 tables."; $desc[4]=""; # prime: rover can start any table, go up or down 3. @rover_tables=(1,4,7,3,6,2,5); @rover_table2=(3,6,2,5,1,4,7); } elsif ($BASEFILE eq "S0824") { $desc[0]="8 tables, 8 rounds of 3 boards. Rotation, rover."; $desc[1]="Players rotate clockwise around North after each board."; $desc[2]="Computer set up as 24 rounds of 1 board."; $desc[3]=""; $desc[4]="==> PERSONAL GUIDE CARDS ARE REQUIRED FOR THIS MOVEMENT <=="; # 0: 1 2 3 4 2 3 4 5 # 0: 1 4 4 7 4 7 5 8 # 0: 1 7 2 2 3 5 8 4 # 0: 2 3 4 5 1 2 3 4 # 0: 2 5 3 6 3 6 6 1 # 0: 2 6 1 3 4 4 7 5 # 0: 3 5 8 4 1 7 2 2 # 0: 3 6 6 1 2 5 3 6 # 0: 3 8 5 2 4 1 6 3 # 0: 4 1 6 3 3 8 5 2 # 0: 4 4 7 5 2 6 1 3 # 0: 4 7 5 8 1 4 4 7 # 0: 5 3 6 6 7 1 4 8 # 0: 5 6 7 8 6 7 8 1 # 0: 5 8 8 3 8 3 1 4 # 0: 6 1 7 2 7 2 2 5 # 0: 6 2 5 7 8 8 3 1 # 0: 6 7 8 1 5 6 7 8 # 0: 7 1 4 8 5 3 6 6 # 0: 7 2 2 5 6 1 7 2 # 0: 7 4 1 6 8 5 2 7 # 0: 8 3 1 4 5 8 8 3 # 0: 8 5 2 7 7 4 1 6 # 0: 8 8 3 1 6 2 5 7 @rover_tables=(4,7,5,8,1,4,4,7); @rover_table2=(8,3,1,4,5,8,8,3); } elsif ($BASEFILE eq "S0924") { $desc[0]="9 tables, 8 rounds of 3 boards. Rainbow, rotation, rover."; $desc[1]="Players rotate clockwise around North after each board."; $desc[2]="Computer set up as 24 rounds of 1 board."; #123456789012345678901234567890123456789012345678901234567890 $desc[3]=" ==> Boards 25-27 remain on table 9. <=="; $desc[4]="All other boards move down one table bypassing table 9."; # many acceptable movements, takes a long time to calculate, these are the best: @rover_table2=(8,8,8,8,8,8,8,8); @rover_table2=(6,6,6,6,6,6,6,6); @rover_tables=(4,4,4,4,4,4,4,4); @rover_tables=(2,2,2,2,2,2,2,2); } elsif ($BASEFILE eq "S1027") { $desc[0]="10 tables, 8 rounds of 3 boards. Rotation, rover."; $desc[1]="Players rotate clockwise around North after each board."; $desc[2]="Computer set up as 24 rounds of 1 board."; $desc[3]=""; $desc[4]="==> PERSONAL GUIDE CARDS ARE REQUIRED FOR THIS MOVEMENT <=="; # no perfect movements for 9 rounds, use -M -t8 to get these results # 0: 1 4 10 1 2 8 1 1 # 0: 2 5 9 10 1 9 2 10 # 0: 3 6 2 9 4 6 9 9 # 0: 4 7 1 8 3 7 10 8 # 0: 5 10 4 5 8 2 7 7 # 0: 6 1 3 4 7 3 8 6 # 0: 7 2 6 3 10 10 5 5 # 0: 8 3 5 2 9 1 6 4 @rover_tables=(8,3,5,2,9,1,6,4); @rover_table2=(6,1,3,4,7,3,8,6); } elsif ( ($BASEFILE eq "S1133") or ($BASEFILE eq "R1122") or ($BASEFILE eq "R1133") ) { if ($BASEFILE eq "S1133") { $desc[0]="11 tables, 11 rounds of 3 boards. Rainbow, rotation, rover."; $desc[1]="Players rotate clockwise around North after each board."; $desc[2]="Computer set up as 33 rounds of 1 board."; } elsif ($BASEFILE eq "R1122") { $desc[0]="11 tables, 11 rounds of 2 boards. Rainbow, no rotate, rover."; $desc[1]=""; $desc[2]=""; } elsif ($BASEFILE eq "R1133") { $desc[0]="11 tables, 11 rounds of 3 boards. Rainbow, no rotate, rover."; $desc[1]=""; $desc[2]=""; } $desc[3]="North stationary, East up 2, South up 1, West down 2 tables."; $desc[4]=""; # Inserting predetermined answers (prime) @rover_tables=(1,4,7,10,2,5,8,11,3,6,9); @rover_table2=(5,8,11,3,6,9,1,4,7,10,2); } ### line 1643 elsif ($BASEFILE eq "S1224") { $desc[0]="12 tables, 12 rounds of 2 boards. Rotation, rover."; $desc[1]="South and East switch seats for second board of round."; $desc[2]="Computer set up as 24 rounds of 1 board."; $desc[3]=""; $desc[4]=""; die "Sorry, I don't know a movement, might take days to compute, if there is one."; @rover_table2=(8,8,8,8,8,8,8,8); @rover_tables=(2,2,2,2,2,2,2,2); } elsif ( ($BASEFILE eq "S1326") or ($BASEFILE eq "R1326") ) { if ($BASEFILE eq "S1326") { $desc[0]="13 tables, 13 rounds of 2 boards. Rainbow, rotation, rover."; $desc[1]="South and East switch seats for second board of round."; $desc[2]="Computer set up as 26 rounds of 1 board."; } elsif ($BASEFILE eq "R1326") { $desc[0]="13 tables, 13 rounds of 2 boards. Rainbow, no rotate, rover."; $desc[1]=""; $desc[2]=""; } $desc[3]="North stationary, East up 2, South up 1, West down 2 tables."; $desc[4]=""; # Inserting predetermined answers (prime) @rover_tables=(1,4,7,10,13,3,6,9,12,2,5,8,11); @rover_table2=(6,9,12,2,5,8,11,1,4,7,10,13,3); } else { die "rover movement for file not known: $BASEFILE.IND"; } # -- print movement selected for ($G=0; $G<$Grounds; $G++) { # convert to low index 0 $rover_tables[$G] --; $rover_table2[$G] --; } print "Defined rover movement for $BASEFILE:\n"; $rtstring="Rover tables: "; for ($G=0; $G<$Grounds; $G++) { ($G==0) and (!$Rotation) and next; # sit out entire first round w/o rotation $s = $rover_tables[$G]+1; $rtstring = $rtstring . " $s"; } $RDstring = "North"; if ($RD==1) { $RDstring = "East"; } elsif ($RD==2) { $RDstring = "South"; } elsif ($RD==3) { $RDstring = "West"; } print "${rtstring} (${RDstring})\n"; # -- set rover description # padded with blanks on output # 1 2 3 4 5 6 #123456789012345678901234567890123456789012345678901234567890 $desc[6] = $rtstring; $desc[8] = ""; $desc[9] = ""; if ($Rotation) { $desc[5]="Rover $Rover bumps $GROUP players at $RDstring in each ${GROUP}-board round."; $s = $rover_tables[0]+1; $desc[7] = "Rover starts $RDstring with second board at table $s."; if ($R2D>=0) { $rtstring="2nd Rover tables:"; for ($G=0; $G<$Grounds; $G++) { $s = $rover_table2[$G]+1; $rtstring = $rtstring . " $s"; } $desc[9] = $rtstring; $RDstring = "North"; if ($R2D==1) { $RDstring = "East"; } elsif ($R2D==2) { $RDstring = "South"; } elsif ($R2D==3) { $RDstring = "West"; } $s = $rover_table2[0]+1; $desc[8] = "2nd Rover $Rover2 starts $RDstring with second board at table $s."; print "${rtstring} (${RDstring})\n"; } } else { $desc[5]="Rover $Rover bumps $RDstring players for one round each."; $s = $rover_tables[1]+1; $desc[7] = "Rover starts $RDstring on second round at table $s."; if ($R2D>=0) { $rtstring="2nd Rover tables:"; for ($G=1; $G<$Grounds; $G++) { # start at 1, sit out entire first round w/o rotation $s = $rover_table2[$G]+1; $rtstring = $rtstring . " $s"; } $desc[9] = $rtstring; $RDstring = "North"; if ($R2D==1) { $RDstring = "East"; } elsif ($R2D==2) { $RDstring = "South"; } elsif ($R2D==3) { $RDstring = "West"; } $s = $rover_table2[1]+1; $desc[8] = "2nd Rover $Rover2 starts $RDstring on second round at table $s."; print "${rtstring} (${RDstring})\n"; } } # -- insert the selected rover movement $first = 1; for ($G=0; $G<$Grounds; $G++) { $G3 = ($G+1)*$GROUP; # $cell[$d][$r][$t] all start at 0 for ($r=$G*$GROUP; $r<$G3; $r++) { for ($i=0; $i<5; $i++) { $cell[$i][$r][$phantom_table] = 0; } # zero the phantoms if ($first) { # Rover to phantom table $first = 0; $cell[$RD][$r][$phantom_table] = $Rover; if ($R2D>=0) { if ($RD==$R2D) { $t=0; ($R2D==0) and $t=3; $cell[$t][$r][$phantom_table] = $Rover2; } else { $cell[$R2D][$r][$phantom_table] = $Rover2; } } } else { # bumpee to phantom table, replaced by rover $t = $rover_tables[$G]; $cell[$RD][$r][$phantom_table] = $cell[$RD][$r][$t]; $cell[$RD][$r][$t] = $Rover; if ($R2D>=0) { $t = $rover_table2[$G]; $cell[$R2D][$r][$phantom_table] = $cell[$R2D][$r][$t]; $cell[$R2D][$r][$t] = $Rover2; } } } } } #----------------------------------------------------------------# sub WriteMovementFile() { my ($buf, @byte); # Keep print from inserting an x13=CR byte before an x10=LF=\n byte binmode MOVOUT; $byte[0] = $howell; $byte[1] = $tables; # changes for rover individual $byte[2] = $rounds; $byte[3] = $boards; $buf = pack ('cccc', @byte) or die "--> bad pack 1 <--"; $Header36 = $buf; $buf = $Header1 . $Header2 . $Header36; print MOVOUT $buf; # -- write description for ($t=0; $t<10; $t++) { print MOVOUT substr("$desc[$t] ",0,60); # 1 2 3 4 5 6 #123456789012345678901234567890123456789012345678901234567890 } # -- Write Table Records for ($t=0; $t<$tables; $t++) { for ($r=0; $r<$rounds; $r++) { for ($d=0; $d<=$ND; $d++) { # write boards as well as directions (<=) $byte[$d] = $cell[$d][$r][$t]; # ( $t < 6) || print "cell[$d][$r][$t] = $cell[$d][$r][$t] \n"; } $buf = pack ('ccccc', @byte) or die "--> bad pack 2 <--"; printf MOVOUT "%5s", $buf; } } close(MOVOUT); } #----------------------------------------------------------------# # -- Process File Name Argument if ($#ARGV < 0) { Usage(); } if ("$ARGV[0]" eq "-h") { Usage(); } if ("$ARGV[0]" eq "-L") { License(); } # -- Initialize Command Line Switches $DUMP=0; $GROUP=1; $FACT=1.0; $XWIDE=8.0; $BoardsPerRound=0; $PrintLast=1; $PrintMats=1; $PrintOnly=0; $WriteMov=0; $Rover=0; $R2D=-1; $NColor=1; $Calc=0; $TruncAfter=999; $Weave=0; $Appx=0; $t0=0; for ($i=0; $i<10; $i++) { $desc[$i] = ""; $DI[$i] = 0; } $Rover2=0; # -- Initialize Text Arrays @Dir = ("N-S", "E-W", "N-S", "E-W", "North", "East", "South", "West"); @Color = ("error","Black","Olive","Purple","Green","Blue","Teal","Red","Orange","Brown"); $MaxColor = 9; # -- check file or -s switch (must be last) $file = $ARGV[$#ARGV]; pop @ARGV; if ($file ne "-s") { $FILE = $file; $FILE =~ tr/a-z \t/A-Z/d; # uppercase without whitespace print "File: $FILE \n"; # -- Process the File Extension if ( $FILE =~ /.*MOV$/ ) { $TYPE = "MOV"; } elsif ( $FILE =~ /.*IND$/ ) { $TYPE = "IND"; } elsif ( $FILE =~ /.*BAM$/ ) { $TYPE = "BAM"; } else { die "--> file extension is not MOV, IND, or BAM: $FILE <--"; } # -- Check File Existence $BASEFILE = substr($FILE,0,length($FILE)-4); $SWFILE = "BridgeMats.sw"; $PSin = "BridgeMats.ps"; ( -e $FILE ) || die "--> movement file does not exist: $FILE <--"; ( -e $SWFILE ) || warn "--> switch default file does not exist: $SWFILE <--"; ( -e $PSin ) || die "--> model PostScript file does not exist: $FILE <--"; # -- process switch file ReadSwitchFile(); ProcessSwitches (1,@fsw); # switch file } # -- process command-line switches ProcessSwitches (2,@ARGV); # command line $wide = int(400*$FACT+0.99); $high = int(796*$FACT+0.99); # -- Print scoring table and exit if ($file eq "-s") { Scorer(); exit 0; } # -- Process Movement File # This program is driven by cell[index][round][table] where # # index Pairs/BAM Individual # 0 NS N # 1 EW E # 2 board S # 3 notes W # 4 N/A board # 5 N/A notes ReadMovementFile(); # Grouped rounds $Grounds = $rounds / $GROUP; # -- Calculate individual rover movement and exit if ($Calc) { Calc_Rover_IND(); } # -- Write .IND movement file and exit if ($WriteMov) { Insert_Rover_IND(); # -- Open the Movement output file if ($R2D<0) { $MOFILE = ">$BASEFILE" . "R.IND"; } # single rover else { $MOFILE = ">$BASEFILE" . "RR.IND"; } # double rover # print "Output movement file is: $MOFILE\n"; open (MOVOUT, $MOFILE) or die "--> unable to open output file: '$MOFILE' <--\n"; # -- Write the movement file WriteMovementFile(); print "Finished writing movement file $MOFILE.\n"; exit 0; } # set Rover2 for double-rover individual movement if ($Rover > 0) { if ($R2D > -1) { if ($cell[2][0][0]<$tables) { # starting South at table 1 $Rotation = 0; $Rover2 = $Rover; # Mitchell, rover 2 direction must be different if ($R2D==0) { die "Rover 2 must not be North for non-rotation movement." } } else { $Rotation = 1; $Rover2 = $Rover + 1; } } } ($PrintMats) || die "--> dump complete, not printing mats (-n) <--"; #($howell) || #die "--> BridgeMats is currently only for one-winner movements. <--"; ($TYPE eq "BAM") && die "--> BridgeMats cannot do mats for Board-a-Match movements. <--"; # -- Open the PostScript input file open (PSIN, $PSin) or die "--> unable to open model PostScript file: $PSin <--\n"; # -- Open the PostScript output file $PSFILE = ">$BASEFILE.PS"; open (PSOUT, $PSFILE) or die "--> unable to open output file: '$PSFILE' <--\n"; # -- calculate number of pages if ( $PrintLast == 0 ) { $pages = $tables - 1; } else { $pages = $tables; } $pageloop = $pages; if ( $Appx == 1 ) { $pages = 2; } if ( $PrintOnly > 0 ) { $pages = 1; } # -- get date info @month = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); $sec=0; $wday=0; $yday=0; $tsdst=0; # (no -w msgs) ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$tsdst) = localtime(time); $year += 1900; # -- read input header info and write it back out $cut = 0; while () { if ( $_ =~ /^%ereh.tuc/ ) { $cut = 0; print PSOUT $_; } elsif ( $_ =~ /^%cut1here/ ) { $cut = 1; print PSOUT $_; PrintSetupVars; # -- process color request (after PrintSetupVars, changes players) if ($NColor==0) { if ($Rover==0 and ($pairs/2)==$tables and ($players/4)==$tables) { $NColor = ($tables-2)%($MaxColor-1) + 2; } else { $NColor = 1; } } ($DUMP) && print "Color: $Color[$NColor] ($NColor)\n"; } elsif ( $_ =~ /^%%CreationDate:/ ) { print PSOUT "%%CreationDate: $mday-$month[$mon]-$year $hour:$min\n"; } elsif ( $_ =~ /^%%Pages:/ ) { print PSOUT "%%Pages: $pages\n"; } elsif ( $_ =~ /^%%BoundingBox:/ ) { print PSOUT "%%BoundingBox: 0 0 $wide $high\n"; } elsif ( $_ =~ /^%%Page:/ ) { last; # break out, once page data starts } else { ($cut) || print PSOUT $_; } } # -- Read First Chunk of Page Data $t = 0; $cut = 0; $Nchunk2 = 0; while () { if ( $_ =~ /^%cut2here/ ) { $cut = 2; $chunk1[$t] = $_; $Nchunk1 = $t + 1; } elsif ( $_ =~ /^%%PageBoundingBox:/ ) { $chunk1[$t] = "%%PageBoundingBox: 0 0 $wide $high\n"; $Nchunk1 = $t + 1; } elsif ( $_ =~ /^%ereh.tuc/ ) { last; } else { ($cut) or $chunk1[$t] = $_; } $t++; } ($Nchunk1>0) || die "--> (Nchunk1=0) corrupt file: $PSin <--"; # -- read second chunk of page data $chunk2[0] = $_; # ereh2tuc $t = 1; $Nchunk2 = 0; while () { if ( $_ =~ /^%%EOF/ ) { $Nchunk2 = $t; # counts before current $t last; } else { $chunk2[$t] = $_; } $t++; } ($Nchunk2>0) || die "--> (Nchunk2=0) corrupt file: $PSin <--"; close (PSIN); # -- Now Print the Pages # $p = page index # $t = table index # $r = round index # $d = direction index # $l = line index # $pn = page number $pn=0; for ($p=0; $p<$pageloop; $p++) { $t = $p; # print "-- p=$p TN[$p]=$TN[$p] PrintOnly=$PrintOnly Appx=$Appx \n"; ( $PrintOnly > 0 ) && ( $PrintOnly != $TN[$p] ) && next; ($p < $t0 ) && next; # skip early tables with Appendix $pn++; print PSOUT "%%Page: Table$TNP[$p] $pn\n"; for ($l=0; $l<$Nchunk1; $l++) { print PSOUT $chunk1[$l]; } PrintPageVars(); for ($l=0; $l<$Nchunk2; $l++) { print PSOUT $chunk2[$l]; } } print PSOUT "%%EOF\n"; close (PSOUT); exit 0