#!/usr/local/bin/perl # Version 2.5 beta3 # - Additions and fixes by Mats Persson # - convert x to y # - goto, and new, # - unit put counters on the map # - cleanup of the code # - slopes added (sl) # - wired fence added (wf) # - fixed map location bugs. Location can now be specified as 01:C4 # - better print. you can specify from-to hexes # # Version 2.4.3 # - Fixes by Kevin Serafini # - Blazes added (BZ) # - Wrecks added (WK) # Version 2.4.2 # - Fixes by Patrik Manlig # - Added DIRT and PAVED options # Version 2.4.1 # - Fixes by Patrik Manlig # - Fixed sand bug, now "d" works. # - Added WINTER option - removes all grain. # - Added PTO option - makes all brush (bamboo) inherent terrain # - Added DENSE option - makes all woods (jungle) inherent terrain # # Version 2.4 # - Fixed 2 bugs # - all the map/ovr files can be in a tar file, thanks to # Herve Mignot . # # Version 2.3 # - All the RB terrain types added. # - Landscape works correctly # # Version 2.2 # - More code tweaks # - overlays now work. # # Version 2.1 # modifications made by Adrian Earle earle@cmc.ca # - 4th line added to stream - by Adrian Earle earle@cmc.ca # - the water system was changed # - 4th colour added to stream, stream widened # - gully widened # - canal terrain type added 'N' is the character to indicated canal # - more water colours added # - CMYK colours entered, gray colours adjusted # - ColHut, ColStream*, ColCanal*, ColWadi*, ColDsrtBckgnd added # - Wadi terrain type added 'a' is the character to indicate wadi # - Sunken Road terrain type added 'n' is the character # to indicate sunken road # # Version 2.0 # author Eric Young - eay@psych.psy.uq.oz.au # # Turn printnums off if you don't want page numbers printed as map2.pl works. $printnums=1; # Mac users should uncomment the following line and the closing bracket if( ! $MacPerl'Version ) { # The output is sent to the following. #$output="|mps.pl"; # Use if you want to always use mps - see README #$output="|./mps.pl|compress|uuencode map-ps.Z"; # Use this for the mailer. $mapdir="."; $list_tar_file="zcat $mapdir/maps.tar.Z|tar tf -"; $get_tar_file= "zcat $mapdir/maps.tar.Z|tar xf -"; } # Mac users - uncomment $error=0; $Pnumber=1; $PI=3.141592654; $NUMX=11; $NUMY=33; $a4NUMX=21; $a4NUMY=33; $SCALE=1; $D=100; $Dx=int(cos($PI/6)*$D); $Dy=int(sin($PI/6)*$D); $SBwidth="4"; $WBwidth="2"; $delete_file=""; @edgesX=(-$Dx,-$Dx,-$Dx/2,0,$Dx/2,$Dx,$Dx,$Dx,$Dx/2,0,-$Dx/2,-$Dx); @edgesY=(0,$D/2,$D/2+$Dy/2,$D/2+$Dy,$D/2+$Dy/2,$D/2,0, -$D/2,-$D/2-$Dy/2,-$D/2-$Dy,-$D/2-$Dy/2,-$D/2); @HexeX=(0,0,$Dx,$Dx*2,$Dx*2,$Dx,0); @HexeY=($Dy,$Dy+$D,$Dy*2+$D,$Dy+$D,$Dy,0,$Dy); @HexiX=(int($Dx/3),int($Dx/3),$Dx,int($Dx*2-$Dx/3),int($Dx*2-$Dx/3), $Dx,int($Dx/3)); @HexiY=(int($Dy+$D/6),int($Dy+$D-$D/6),int($Dy*2+$D-($Dy+$D/2)/3), int($Dy+$D-$D/6),int($Dy+$D/6),int(($D/2+$Dy)/3),int($Dy+$D/6)); # set COLOR=1 for colour, set it to 0 for greyscale $COLOR=1; # color part greyscale part $DESERT=0; $WINTER=0; $PTO=0; $DENSE=0; $DIRT=0; $PAVED=0; %DefCol=(); %Colors=( "ColBlack", "0.00 0.00 0.00 1.00 ; 0.00", "ColWhite", "0.00 0.00 0.00 0.00 ; 1.00", "ColBackground", "0.05 0.00 0.13 0.00 ; 1.00", "ColWntrBckgnd", "0.05 0.00 0.05 0.00 ; 1.00", "ColDsrtBckgnd", "0.06 0.08 0.13 0.00 ; 0.99", "ColLevel0", "0.05 0.00 0.05 0.00 ; 1.00", "ColLevel1", "0.00 0.15 0.50 0.30 ; 0.90", "ColLevel2", "0.00 0.17 0.42 0.40 ; 0.75", "ColLevel3", "0.00 0.20 0.40 0.52 ; 0.65", "ColLevel4", "0.00 0.10 0.45 0.60 ; 0.55", "ColL0", "1.00 0.00 0.33 0.47 ; 1.00", "ColL1", "1.00 0.00 0.50 0.34 ; 1.00", "ColL2", "0.45 0.00 0.57 0.22 ; 1.00", "ColOrchard", "0.60 0.00 0.60 0.00 ; 0.40", "ColStoneBld", "0.12 0.15 0.17 0.20 ; 0.90", "ColStoneBld2", "0.12 0.15 0.17 0.20 ; 0.70", "ColStoneBld3", "0.12 0.15 0.17 0.20 ; 0.50", "ColStoneBld4", "0.12 0.15 0.17 0.20 ; 0.30", "ColStoneBridge","0.12 0.15 0.17 0.20 ; 0.20", "ColWoodBld", "0.00 0.20 0.60 0.50 ; 0.95", "ColWoodBld2", "0.50 0.60 0.80 0.00 ; 0.50", "ColWoodBld3", "0.50 0.60 0.80 0.00 ; 0.70", "ColHut", "0.30 0.40 0.50 0.00 ; 0.95", "ColShellHole", "0.60 0.70 0.95 0.05 ; 0.50", "ColCliff", "0.50 0.60 0.70 0.40 ; 0.00", "ColHedge", "0.50 0.05 0.50 0.00 ; 0.50", "ColWall", "0.22 0.27 0.31 0.40 ; 0.20", "ColPerimeter", "0.00 0.75 0.75 0.00 ; 0.15", "ColGrain", "0.00 0.00 0.50 0.00 ; 0.95", "ColGrainBoarder","0.00 0.00 0.40 0.00 ; 1.00", "ColWoods1", "0.35 0.00 0.35 0.00 ; 0.80", "ColWoods2", "0.90 0.00 0.80 0.25 ; 0.30", "ColWater1", "0.50 0.07 0.01 0.00 ; 0.975", "ColWater2", "0.00 0.00 0.00 0.00 ; 0.30", "ColWater3", "0.05 0.00 0.05 0.00 ; 0.30", "ColWater4", "0.40 0.05 0.00 0.00 ; 0.99", "ColCanal1", "0.07 0.45 0.01 0.00 ; 0.65", "ColCanal2", "0.00 0.00 0.00 0.00 ; 1.00", "ColStream1", "0.05 0.45 0.00 0.00 ; 0.35", "ColStream2", "0.60 0.05 0.50 0.05 ; 0.50", "ColMarsh", "0.45 0.15 0.25 0.00 ; 0.95", "ColGraveYard", "0.20 0.05 0.20 0.00 ; 0.95", "ColBrush1", "0.15 0.00 0.15 0.00 ; 0.98", "ColBrush2", "0.80 0.00 0.70 0.10 ; 0.30", "ColScrub", "0.00 0.30 0.47 0.10 ; 0.30", "ColSmallWoodBld","0.50 0.60 0.80 0.00 ; 0.75", "ColRoad1", "0.00 0.10 0.21 0.24 ; 0.90", "ColRoad2", "0.12 0.15 0.17 0.07 ; 0.70", "ColUpRoad1", "0.30 0.36 0.54 0.00 ; 0.50", "ColUpRoad2", "0.60 0.72 0.84 0.20 ; 0.30", "ColSunkRoad0" ,"0.00 0.00 0.00 1.00 ; 0.00", "ColSunkRoad1", "0.30 0.36 0.54 0.00 ; 0.50", "ColSunkRoad2", "0.60 0.72 0.84 0.20 ; 0.75", "ColSunkRoad3", "0.60 0.72 0.84 0.20 ; 0.95", "ColPath1", "0.30 0.40 0.50 0.10 ; 0.50", "ColPath2", "0.17 0.00 0.17 0.00 ; 0.90", "ColGully1", "0.70 0.20 0.70 0.10 ; 0.65", "ColGully2", "0.50 0.70 0.70 0.10 ; 0.85", "ColGully3", "0.40 0.60 0.60 0.00 ; 0.35", "ColWadi1", "0.40 0.70 0.70 0.10 ; 0.50", "ColWadi2", "0.50 0.70 0.70 0.10 ; 0.40", "ColWadi3", "0.40 0.60 0.60 0.00 ; 0.80", "ColHammada", "0.00 0.20 0.50 0.10 ; 0.00", "ColSand", "0.00 0.12 1.00 0.00 ; 0.90", "ColDuneCrest", "0.00 0.05 0.50 0.00 ; 0.70", "ColDeier1", "0.00 0.10 0.50 0.00 ; 0.90", "ColDeier2", "0.00 0.10 0.30 0.00 ; 0.94", "ColInsideDeier","0.00 0.10 0.30 0.00 ; 0.97", "ColHill", "0.90 0.00 0.47 0.05 ; 0.75", "ColDot", "0.00 0.00 0.00 0.00 ; 1.00", "ColRicepaddy", "0.00 0.00 0.50 0.00 ; 0.50", "ColGerman", "0.35 0.07 0.00 0.00 ; 1.00", "ColRussian", "0.04 0.00 0.75 0.30 ; 0.90", "ColAmerican", "0.15 0.00 0.70 0.05 ; 0.90", "ColBritish", "0.00 0.10 0.30 0.10 ; 0.90", "ColItalian", "0.07 0.03 0.00 0.30 ; 1.00", "ColJapan", "0.00 0.14 1.00 0.00 ; 1.00", "ColAllied", "0.45 0.00 0.20 0.07 ; 0.90", "ColAxis", "0.87 0.00 0.62 0.11 ; 1.00", "ColFrench", "1.00 0.30 0.00 0.00 ; 0.90", ); $ColBackground= "DESERT 1 eq { ColDsrtBckgnd } { WINTER 1 eq { ColWntrBckgnd } { ColBackground } ifelse } ifelse"; @ColLevel= ("ColLevel0","ColLevel1","ColLevel2", "ColLevel3","ColLevel4"); foreach (0..12) { push(@ColLevels,"ColL$_"); } # not used #$ColStoneBld3= "ColStoneBld3"; #$ColStoneBld4= "ColStoneBld4"; #$ColWoodBld2= "ColWoodBld2"; #$ColWoodBld3= "ColWoodBld3"; #$ColWater3= "ColWater3"; #$ColPath2= "ColPath2"; #$ColHammada= "ColHammada"; #$ColHill= "ColHammada"; #$ColHut= "ColDot"; if (defined($output)) { open(OUT,$output) || die "unable to run $output:$!\n"; select(OUT); } sub dohex { local($Xloc,$Yloc,$d)=@_; local(@a,$f,$c); local(@rr,@r,$r,@r2,@r3); local($x,$y,$z); @a=split(/,/,$d); $forest=0; printf "%d %d moveto ",&xyloc($Xloc,$Yloc); foreach $f (@a) { foreach $c (@convert) { ($x,$y) = split(/:/,$c); $f =~ s/$x/$y/; } if (!defined($PSfunc{$f})) { if ($f =~ /^\.$/) {return;} $PSfunc{$f}="MAP-$f"; @CCol=(); print "\n/MAP-$f {\n"; SWITCH: { if ($f =~ /^s$/) { last;} if ($f =~ /^sc$/) { &doscrub(""),last;} if ($f =~ /^sc(\d+)$/){ &doscrub($1),last;} if ($f =~ /^d$/) { &dosand(""),last;} if ($f =~ /^D$/) { &dosand("123456"),last;} if ($f =~ /^d(\d+)$/){ &dosand($1),last;} if ($f =~ /^h$/) { &dohammada(),last;} if ($f =~ /^H$/) { &dohill(75,""),last;} if ($f =~ /^H(\d+)$/){ &dohill(75,$1),last;} if ($f =~ /^HH$/) { &dohill(200,"123456"),last;} if ($f =~ /^H$/) { &dohill(),last;} if ($f =~ /^dc(\d+)$/){ &dowall("ColDuneCrest",$1),last;} if ($f =~ /^q(\d)(\d)$/) { &dodeier($1,$2),last;} if ($f =~ /^Q(\d+)$/){ &dothindeier($1),last;} if ($f =~ /^q$/) { &doinsidedeier(),last;} if ($f =~ /^o$/) { &doorchard(0),last;} if ($f =~ /^o1$/) { &doorchard(1),last;} if ($f =~ /^o2$/) { &doorchard(2),last;} if ($f =~ /^G$/) { &dograveyard(),last;} if ($f =~ /^Od(\d)$/) { &dowaterdot($1),last;} if ($f =~ /^O(\d+)$/){ &dowateredge($1),last;} if ($f =~ /^O$/) { &dowater("","ColWater4","ColWater2"),last;} if ($f =~ /^N$/) { &dowater("","ColCanal2","ColCanal1"),last;} if ($f =~ /^O-(\d+)$/) { &dowater($1,"ColWater4","ColWater2"),last;} if ($f =~ /^N-(\d+)$/) { &dowater($1,"ColCanal2","ColCanal1"),last;} if ($f =~ /^OO$/) { &dowater("123456","ColWater4","ColWater2"),last;} if ($f =~ /^NN$/) { &dowater("123456","ColCanal2","ColCanal1"),last;} if ($f =~ /^O\+(\d+)$/){ &dowaterEdge($1),last;} if ($f =~ /^sw$/) { &dostairwell(),last;} if ($f =~ /^cd$/) { &docenterdot(),last;} if ($f =~ /^mh$/) { &domanhole(),last;} if ($f =~ /^g$/) { &dograin('1','s'),last;} if ($f =~ /^ga$/) { &dograin('3','s'),last;} if ($f =~ /^gb$/) { &dograin('2','s'),last;} if ($f =~ /^g-([A-Za-z1-6])([1-6])$/) { &dograin($2,$1),last;} if ($f =~ /^g\-(\d*)$/) { &dograinp($1),last;} if ($f =~ /^g\+$/) { &dograinp("123456"),last;} if ($f =~ /^xb$/) { &dorubble(30,"b"),last;} if ($f =~ /^xB$/) { &dorubble(30,"B"),last;} if ($f =~ /^x$/) { &dorubble(7,"x"),last;} if ($f =~ /^x-([A-Za-z1-6])([1-6])$/) { &dorubblebld($1,$2,7,"x"),last;} if ($f =~ /^rx(\d)$/){ &dorail($1),last;} if ($f =~ /^t$/) { &dotank(),last;} # storage tank if ($f =~ /^m$/) { &domarsh(""),last;} if ($f =~ /^m(\d+)$/){ &domarsh("$1"),last;} if ($f =~ /^M$/) { &domarsh("123456"),last;} if ($f =~ /^f$/) { &doforest(""),last;} if ($f =~ /^F$/) { &doforest("123456"),last;} if ($f =~ /^f(\d+)$/){ &doforest("$1"),last;} if ($f =~ /^z$/) { &dobrush(""),last;} if ($f =~ /^Z$/) { &dobrush("123456"),last;} if ($f =~ /^z(\d+)$/){ &dobrush("$1"),last;} if ($f =~ /^B-([A-Za-z1-9])([1-6])$/) { &doSBuilding($2,$1,$SBwidth,"ColStoneBld"),last;} if ($f =~ /^b-([A-Za-z1-9])([1-6])$/) { &doSBuilding($2,$1,$WBwidth,"ColWoodBld"),last;} if ($f =~ /^B$/) { &doSBuilding(1,'s',$SBwidth,"ColStoneBld"),last;} if ($f =~ /^Ba$/) { &doSBuilding(3,'s',$SBwidth,"ColStoneBld"),last;} if ($f =~ /^Bb$/) { &doSBuilding(2,'s',$SBwidth,"ColStoneBld"),last;} if ($f =~ /^b\+$/) { &doSbuilding(0,"ColHut"),last;} if ($f =~ /^b\+(\d)$/) { &doSbuilding($1,"ColHut"),last;} if ($f =~ /^B\+$/) { &doSbuilding(0,"ColStoneBld"),last;} if ($f =~ /^B\+(\d)$/) { &doSbuilding($1,"ColStoneBld"),last;} if ($f =~ /^b$/) { &dobuilding(0,0,$1),last;} if ($f =~ /^ba$/) { &dobuilding(0,60,$1),last;} if ($f =~ /^bb$/) { &dobuilding(0,120,$1),last;} if ($f =~ /^b(\d)$/){ &dobuilding(1,0,$1),last;} if ($f =~ /^Bw([abcdeABCDE])(\d)$/) { &dobuildingwall($2,$1,2*$SBwidth),last;} if ($f =~ /^p(\d)$/) { &dopath($1),last;} if ($f =~ /^u(\d+)$/) { &douproad("ColRoad1",$1),last;} if ($f =~ /^ul(\d+)$/) { &douproadleft("ColRoad1",$1),last;} if ($f =~ /^ur(\d+)$/) { &douproadright("ColRoad1",$1),last;} if ($f =~ /^n(\d+)$/) { &dosunkroad("ColRoad1",$1),last;} if ($f =~ /^nl(\d+)$/) { &dosunkroadleft("ColRoad1",$1),last;} if ($f =~ /^nr(\d+)$/) { &dosunkroadright("ColRoad1",$1),last;} if ($f =~ /^r(\d+)$/) { &doroad("center","ColRoad1",$1),last;} if ($f =~ /^R(\d+)$/) { &doroad("center","ColRoad2",$1),last;} if ($f =~ /^rr(\d+)$/) { &doroad("center","ColRoad1",$1),last;} if ($f =~ /^RR(\d+)$/) { &doroad("center","ColRoad2",$1),last;} if ($f =~ /^r([abcdef])$/){ &doroad("edge","ColRoad1",$1),last;} if ($f =~ /^R([abcdef])$/){ &doroad("edge","ColRoad2",$1),last;} if ($f =~ /^sl(\d+)$/) { &doslope($1),last;} if ($f =~ /^wf(\d+)$/) { &dowiredfence($1),last;} if ($f =~ /^w(\d+)$/) { &dowall("ColHedge",$1),last;} if ($f =~ /^W(\d+)$/) { &dowall("ColWall",$1),last;} if ($f =~ /^P(\d+)$/) { &dowall("ColPerimeter",$1),last;} if ($f =~ /^S$/) { &doshellholes(),last;} if ($f =~ /^c(\d+)$/) { &docliff("ColCliff",$1),last;} if ($f =~ /^l-([\@abcd])(\d+)$/) { local($t)=$1; $t =~ tr/a-z/A-Z/; &dowall($ColLevel[ord($t)-ord('@')],$2),last;} if ($f =~ /^l([\@abcd]|\d+)$/){ &dolevel($1),last;} if ($f =~ /^L([\@abcd])$/){ &dolevelholes($1),last;} if ($f =~ /^v(\d+)$/) { &dogully("g","$1", "ColGully3","ColGully2","ColGully1"),last;} if ($f =~ /^a(\d+)$/) { &dogully("w","$1", "ColWadi1","ColWadi2","ColWadi3"),last;} if ($f =~ /^V(\d+)$/) { &dostream("$1"),last;} if ($f =~ /^Ci([abcdefABCDEF]+)$/) { &dogullycliff("g","$1","i"),last;} if ($f =~ /^Co([abcdefABCDEF]+)$/) { &dogullycliff("g","$1","o"),last;} if ($f =~ /^Ai([abcdefABCDEF]+)$/) { &dogullycliff("w","$1","i"),last;} if ($f =~ /^Ao([abcdefABCDEF]+)$/) { &dogullycliff("w","$1","o"),last;} if ($f =~ /^k$/) { &docrag(0),last;} if ($f =~ /^k1$/) { &docrag(1),last;} if ($f =~ /^k2$/) { &docrag(2),last;} if ($f =~ /^y$/) { &dolumberyard(),last;} if ($f =~ /^rp(\d)$/) { &dopaddy($1,"i","i"),last;} if ($f =~ /^rP(\d)$/) { &dopaddy($1,"i","s"),last;} if ($f =~ /^Rp(\d)$/) { &dopaddy($1,"s","i"),last;} if ($f =~ /^BZ$/) { &doblaze(),last;} if ($f =~ /^WK$/) { &dowreck(),last;} $error=1; print STDERR "input file error, $Xloc,$Yloc,($f)\n"; } print "} def\n"; foreach (@CCol) { next if $DefCol{$_}++; local($cmyk,$gray) = split(/;/,$Colors{$_}); print "/$_ { COLOR 1 eq { $cmyk setcmykcolor }{ $gray setgray } ifelse } def\n"; } } $r=1; if ($f =~ /^r(\d+)$/) { print "0 "; push(@r3,"$PSfunc{$f} "); } elsif ($f =~ /^rr(\d+)$/) { print "4 "; push(@r3,"$PSfunc{$f} "); push(@rr,"$PSfunc{$f} "); } elsif ($f =~ /^(n|nl|nr|u|ul|ur)(\d+)$/) { print "0 "; push(@r,"$PSfunc{$f} "); push(@r2,"$PSfunc{$f} "); push(@r3,"$PSfunc{$f} "); } elsif ($f =~ /^R(\d+)$/) { print "0 "; push(@r3,"$PSfunc{$f} "); } elsif ($f =~ /^RR(\d+)$/) { print "4 "; push(@r3,"$PSfunc{$f} "); push(@rr,"$PSfunc{$f} "); } elsif ($f =~ /^r([abcdef])$/) { print "0 "; push(@r3,"$PSfunc{$f} "); } elsif ($f =~ /^R([abcdef])$/) { print "0 "; push(@r3,"$PSfunc{$f} "); } else { $r=0; } if (($#r3 >= 0) && ($r == 0)) { foreach $f (@r3) { print "1 $f\n"; } @r3=(); } if ($f =~ /^[av](\d+)$/) { print "$forest "; } print "$PSfunc{$f} "; } if ($#rr >= 0) { foreach $f (@rr) { print "0 $f\n"; } } if ($#r >= 0) { foreach $f (@r) { print "1 $f\n"; } } if ($#r2 >= 0) { foreach $f (@r2) { print "2 $f\n"; } } if ($#r3 >= 0) { foreach $f (@r3) { print "3 $f\n"; } } print "\n"; } sub dorail { local($s)=@_; local($x,$y)=($Dx,$D/2+$Dy); local($a)=(int($D/2+$Dy/2)); $s=(3-$s)*60; push(@CCol,"ColStoneBld2"); print <<"EOF"; gsave currentpoint hexo clip $y add exch $x add exch translate $s rotate newpath -$Dx $a moveto $Dx $a lineto gsave 40 setlinewidth ColStoneBld2 stroke grestore gsave 30 setlinewidth ColBlack stroke grestore gsave 15 setlinewidth ColStoneBld2 stroke grestore 40 setlinewidth ColBlack [5.2 12] 2.6 setdash stroke grestore EOF } sub dolevelholes { local($lvl)=@_; local($col)=$ColLevels[$lvl]; if ($lvl =~ /[\@abcdABCD]/) { $col = $ColLevel[ord($lvl)&31]; } elsif ($lvl !~ /\d+/) { return; } push(@CCol,$col); print "gsave currentpoint hexo clip\n"; printf "moveto %d %d rmoveto\n",$Dx,$D/2+$Dy; print "currentpoint translate $col\n"; print <<"EOF"; /num rand 3 mod 2 add def rand 360 mod rotate 0 1 num { gsave 360 num 1 add div mul /rot1 exch def newpath 10 rand 20 mod add mm dup rot1 cos mul exch rot1 sin mul translate rand 180 mod rotate rand 10 mod 10 add 20 div rand 10 mod 10 add 20 div scale 0 0 10 mm 0 360 arc fill grestore } for grestore EOF } sub doorchard { local($a)=@_; local($y); push(@CCol,"ColOrchard"); $y=$Dy+$D/2; print "gsave currentpoint $y add exch $Dx add exch "; print "translate ColOrchard newpath\n"; if ($a == 1) { print "-60 rotate\n"; } elsif ($a == 2) { print "-120 rotate\n"; } printf "%d %d 18 0 360 arc fill\n",-35,-35; printf "%d %d 18 0 360 arc fill\n",-35, 35; printf "%d %d 18 0 360 arc fill\n", 35,-35; printf "%d %d 18 0 360 arc fill\n", 35, 35; print "grestore\n"; } sub dorubble { local($num,$type)=@_; local($x,$y)=int($Dx*2),int($D+$Dy*2); local($d,$dd,$ddd)=(int($Dx/3*4),int($Dx),int($D/4)); print <<"EOF"; gsave currentpoint hexo clip exch $d 2 div sub $Dx add exch $d 2 div sub $D 2 div $Dy add add translate 2 setlinecap 0 1 $num { pop newpath rand $d mod rand $d mod moveto rand $dd mod $ddd add dup rand 360 mod dup cos /t exch def sin mul exch t mul rlineto EOF if ($type eq "x") { push(@CCol,"ColStoneBld"); print <<"EOF"; rand 7 cvi mod 8 add dup setlinewidth ColBlack gsave stroke grestore 4 sub setlinewidth ColStoneBld stroke EOF } elsif ($type eq "b") { push(@CCol,"ColWoodBld"); print <<"EOF"; rand 8 cvi mod 8 add dup setlinewidth ColBlack gsave stroke grestore 4 sub setlinewidth ColWoodBld stroke EOF } elsif ($type eq "B") { push(@CCol,"ColStoneBld"); print <<"EOF"; rand 25 cvi mod 8 add dup setlinewidth ColBlack gsave stroke grestore 4 sub setlinewidth ColStoneBld stroke EOF } print "} for grestore\n"; } sub docrag { local ($a)=@_; push(@CCol,"ColStoneBld"); printf "/tmpx [%d %d %d %d] def\n",-35,-35, 35, 35; printf "/tmpy [%d %d %d %d] def\n",-35, 35,-35, 35; print <<"EOF"; gsave currentpoint exch $Dx add exch $Dy $D 2 div add add translate $a 60 mul rotate 20 array /tmpxx exch def 20 array /tmpyy exch def newpath 0 1 3 { /tmpI exch def /tmpr rand 5 mod 7 add def /tmpa rand 360 mod def 0 1 tmpr { /tmpi exch def /tmpj 360 tmpr 1 add div tmpi mul tmpa add def tmpxx tmpi tmpj cos 8 mm mul rand 5 mm cvi mod 2.5 mm sub add put tmpyy tmpi tmpj sin 8 mm mul rand 5 mm cvi mod 2.5 mm sub add put } for /tmppx tmpx tmpI get def /tmppy tmpy tmpI get def newpath tmpxx 0 get tmppx add tmpyy 0 get tmppy add moveto 1 1 tmpr { /tmpi exch def tmpxx tmpi get tmppx add tmpyy tmpi get tmppy add lineto } for closepath gsave ColStoneBld fill grestore ColBlack stroke 0 1 tmpr { /tmpi exch def tmppx tmppy moveto tmpxx tmpi get tmpyy tmpi get rlineto } for stroke } for grestore EOF } sub doshellholes { push(@CCol,"ColShellHole"); print <<"EOF"; currentpoint /tmpy exch def /tmpx exch def gsave /tmpxm $Dx 2 mul $D sub 2 div def newpath 1 setlinecap rand 4 mod 3 add /tmpr exch def rrand 0 1 tmpr { pop rand $D mod tmpxm add tmpx add rand $D mod $Dy add tmpy add 7.5 mm 0 360 arc ColShellHole fill newpath } for srand 0 1 tmpr { pop rand $D mod tmpxm add tmpx add rand $D mod $Dy add tmpy add 3 mm 0 360 arc ColBlack fill newpath } for grestore EOF } sub dolevel { local($lvl)=@_; local($col)=$ColLevels[$lvl]; if ($lvl =~ /[\@abcdABCD]/) { $col = $ColLevel[ord($lvl)&31]; } elsif ($lvl !~ /\d+/) { return; } push(@CCol,$col); print "gsave $col hexo fill grestore\n"; } sub docliff { local($g,$a)=@_; local(@a,%a,$b); %a=(); push(@CCol,$g); print <<"EOF"; currentpoint /tmpy exch def /tmpx exch def gsave newpath EOF @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } foreach $b (1..6) { if (defined($a{$b})) { print "$HexeX[$b-1] tmpx add $HexeY[$b-1] tmpy add moveto\n"; print "$HexeX[$b] tmpx add $HexeY[$b] tmpy add lineto\n"; } } @a=(); print <<"EOF"; /tmpa 10 array def /tmpr 2 mm cvi def /tmpR 1 mm cvi def /tmpr2 2 mm cvi def /tmpR2 1 mm cvi def 0 1 4 { dup 2 mul tmpa exch rand tmpr mod tmpR add put 2 mul 1 add tmpa exch rand tmpr2 mod tmpR2 add put } for gsave tmpa rand 5 mm cvi 10 mul mod 10 mod setdash $g 10 mm setlinewidth 0 setlinecap stroke grestore /tmpr 3 mm cvi def /tmpR 2 mm cvi def /tmpr2 1 mm cvi def /tmpR2 1.5 mm cvi def 0 1 4 { dup 2 mul tmpa exch rand tmpr mod tmpR add put 2 mul 1 add tmpa exch rand tmpr2 mod tmpR2 add put } for gsave tmpa rand 5 mm cvi 10 mul mod 10 mod setdash $g 7.5 mm setlinewidth 0 setlinecap stroke grestore 5 mm setlinewidth 1 setlinejoin 1 setlinecap stroke grestore EOF } sub dowiredfence { local($a)=shift; local($b); local($d)=$D/8; print "gsave 1 mm setlinewidth\n"; foreach $b (1..6) { if ($a =~ /$b/) { print "gsave $HexeX[$b-1] $HexeY[$b-1] rmoveto currentpoint translate\n"; printf "%d rotate\n",90-($b-1)*60; printf "%d %d %d {\n",$D/10,$D/5,$D-$D/10; printf "newpath 0 moveto %d %d rmoveto -$d -$d rlineto\n",$d/2,$d/2; print "0 $d rmoveto $d -$d rlineto stroke\n"; print "} for grestore\n"; } } print "grestore\n"; } sub doslope { local($a)=shift; local($b,$d,@c,$x); $d=$D/10; @c=(0.5,0.6,0.7,0.9,1.2,1.3,1.2,0.9,0.7,0.6,0.5); print "gsave 1 mm setlinewidth\n"; foreach $b (1..6) { if ($a =~ /$b/) { print "gsave $HexeX[$b-1] $HexeY[$b-1] rmoveto currentpoint translate\n"; printf "%d rotate newpath\n",90-($b-1)*60; foreach $x (1..9) { printf "%d -%d moveto 0 -%d rlineto stroke\n",$d*$x,$d*$c[$x],$d*$c[$x]; } print "grestore\n"; } } print "grestore\n"; } sub dowall { local($g,$a)=@_; local(@a,%a,$b); %a=(); push(@CCol,$g); print <<"EOF"; currentpoint /tmpy exch def /tmpx exch def gsave newpath $g 10 mm setlinewidth 1 setlinejoin 1 setlinecap EOF @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } foreach $b (1..6) { if (defined($a{$b})) { print "$HexeX[$b-1] tmpx add $HexeY[$b-1] tmpy add moveto\n"; print "$HexeX[$b] tmpx add $HexeY[$b] tmpy add lineto\n"; } } print <<"EOF"; stroke grestore EOF } sub dorubblebld { local($a,$e,$p1,$p2)=@_; print "currentpoint gsave hexo clip moveto\n"; printf "%d %d rmoveto\n",$Dx,$D/2+$Dy; print "currentpoint translate newpath\n"; &doedge($e,$a); print "closepath clip newpath 0 0 moveto\n"; printf "%d %d rmoveto currentpoint translate\n",-$Dx,-$D/2-$Dy; &dorubble($p1,$p2); print "grestore\n"; } sub dograin { if ($WINTER==0) { local($angle,$edge)=@_; push(@CCol,"ColGrainBoarder","ColGrain"); print "currentpoint gsave hexo clip moveto\n"; printf "%d %d rmoveto\n",$Dx,$D/2+$Dy; print "currentpoint translate newpath 1 setlinejoin 1 setlinecap\n"; &doedge($angle,$edge); print "closepath \n"; print "ColGrainBoarder 10 mm setlinewidth gsave stroke grestore\n"; print "ColGrain gsave 5 mm setlinewidth stroke grestore fill grestore\n"; } } sub dograinp { if ($WINTER==0) { local($a)=@_; local(@a,%a,$b); %a=(); push(@CCol,"ColGrainBoarder","ColGrain"); print "gsave currentpoint currentpoint moveto hexo clip\n"; print "gsave translate currentpoint newpath moveto\n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b})) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } print <<"EOF"; closepath ColGrainBoarder 10 mm setlinewidth gsave stroke grestore ColGrain gsave 5 mm setlinewidth stroke grestore fill grestore grestore EOF } } sub doforest { local($a)=@_; local(@a,%a,$b); %a=(); push(@CCol,"ColWoods1","ColWoods2"); $forest=1; print "currentpoint gsave translate newpath \n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b}) || ($DENSE==1)) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } print "closepath clip newpath\n"; print "ColWoods1 1 setlinecap 1 mm setlinewidth\n"; print "0 0 moveto\n"; printf "%d 0 rlineto 0 %d rlineto\n",$Dx*2,$D+$Dy*2; printf "%d 0 rlineto closepath fill\n",-$Dx*2; print "ColWoods2\n"; printf "0 1 60 { pop rand 100 mod %d mul 100 div \n",$Dx*2; printf " rand 100 mod %d mul 100 div\n",$D+$Dy*2; printf " 3 mm rand 360 mod rand 360 mod arc stroke} for\n"; print "grestore\n"; } sub dowater { local($a,$c1,$c2)=@_; local(@a,%a,$b,$DY,$DD,$BD); %a=(); push(@CCol,$c1,$c2,"ColWater1"); $forest=1; print "currentpoint gsave hexo clip translate\n"; @a=split(//,$a); $DY=($D/2+$Dy); $DD=1.3; $BD=2; foreach $b (@a) { $a{$b}=1; } print "/dopath { newpath\n"; if (defined($a{1})) { printf "%d %d moveto\n", ($HexeX[0]-$Dx)*$BD+$Dx, ($HexeY[0]-$DY)*$BD+$DY; } else { printf "%d %d moveto\n", ($HexiX[0]-$Dx)*$DD+$Dx, ($HexiY[0]-$DY)*$DD+$DY; } for ($b=1; $b<=6; $b++) { if (defined($a{$b})) { printf "%d %d lineto\n", ($HexeX[$b-1]-$Dx)*$BD+$Dx, ($HexeY[$b-1]-$DY)*$BD+$DY; printf "%d %d lineto\n", ($HexeX[$b]-$Dx)*$BD+$Dx, ($HexeY[$b]-$DY)*$BD+$DY; } else { printf "%d %d lineto\n", ($HexiX[$b-1]-$Dx)*$DD+$Dx, ($HexiY[$b-1]-$DY)*$DD+$DY; printf "%d %d lineto\n", ($HexiX[$b]-$Dx)*$DD+$Dx, ($HexiY[$b]-$DY)*$DD+$DY; } } print "closepath } def\n"; print <<"EOF"; gsave dopath clip 1 setlinecap dopath gsave ColWater1 fill grestore gsave $c1 16 mm setlinewidth stroke grestore gsave $c2 8 mm setlinewidth stroke grestore grestore grestore EOF } sub domarsh { local($a)=@_; local(@a,%a,$b); local($Dx2)=$Dx*2; local($DDy2)=$D+$Dy*2; %a=(); push(@CCol,"ColMarsh"); $forest=1; print "currentpoint gsave translate newpath \n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b})) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } print <<"EOF"; closepath clip newpath ColMarsh 1 setlinecap 0.5 mm setlinewidth 0 0 moveto $Dx2 0 rlineto 0 $DDy2 rlineto -$Dx2 0 rlineto closepath fill newpath ColBlack 0 setlinewidth 0 10 mm 70 mm { /tmpm exch def 0 10 mm 70 mm { tmpm moveto rand 60 mod 30 sub 10 div mm rand 60 mod 30 sub 10 div mm rmoveto gsave currentpoint translate 0 0 moveto -4 mm 0 lineto 0 -2 mm moveto 0 2 mm lineto 0 0 moveto -3 mm -2 mm lineto 0 0 moveto -3 mm 2 mm lineto stroke grestore } for } for grestore EOF } sub dograveyard { push(@CCol,"ColGraveYard"); print <<"EOF"; currentpoint /tmpy exch def /tmpx exch def gsave hexo clip newpath ColGraveYard 0 setlinewidth tmpx tmpy moveto 80 mm 0 rlineto 0 80 mm rlineto -80 mm 0 rlineto closepath fill /tmpxs 8.8 mm def /tmpys 4.4 mm def tmpy tmpys 2 mul tmpy 80 mm add { /tmpi exch def tmpx tmpxs 2 mul tmpx 80 mm add { newpath rand 6.6 mm cvi mod add tmpi rand 3.3 mm cvi mod add moveto tmpxs 0 rlineto 0 tmpys rlineto tmpxs neg 0 rlineto closepath gsave ColWhite fill grestore ColBlack stroke } for } for grestore EOF } sub dobrush { local($a)=@_; local(@a,%a,$b); %a=(); push(@CCol,"ColBrush1","ColBrush2"); print "currentpoint gsave translate newpath \n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b}) || ($PTO==1)) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } print "closepath clip newpath\n"; print "ColBrush1 1 setlinecap 1 mm setlinewidth\n"; print "0 0 moveto\n"; printf "%d 0 rlineto 0 %d rlineto\n",$Dx*2,$D+$Dy*2; printf "%d 0 rlineto closepath fill\n",-$Dx*2; print "ColBrush2\n"; printf "0 1 40 { pop rand 100 mod %d mul 100 div \n",$Dx*2; printf " rand 100 mod %d mul 100 div\n",$D+$Dy*2; printf " 3 mm 90 270 arc stroke} for\n"; print "grestore\n"; } sub dohill { local($n,$a)=@_; local($xx,$yy,$x,$y,@a,%a,$b); %a=(); push(@CCol,"ColHammada"); print "currentpoint gsave translate newpath \n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b})) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } $x=int($Dx*2); $y=int($Dy*2+$D); print <<"EOF"; /tmp 20 mm cvi def /tmp2 10 mm cvi def closepath clip newpath ColHammada 3 mm setlinewidth 1 setlinecap 0 1 $n { pop rand $x mod rand $y mod moveto rand tmp mod tmp2 sub rand tmp mod tmp2 sub rlineto } for stroke newpath grestore EOF } sub dosand { local($a)=@_; local(@a,%a,$b); %a=(); push(@CCol,"ColSand"); $forest=1; print "currentpoint gsave translate newpath \n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b})) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } print "closepath clip newpath\n"; print "ColSand \n"; print "0 0 moveto\n"; printf "%d 0 rlineto 0 %d rlineto\n",$Dx*2,$D+$Dy*2; printf "%d 0 rlineto closepath fill\n",-$Dx*2; print "grestore\n"; } sub dodeier { local($s1,$s2)=@_; local($m,$x,$y,$a1,$a2); push(@CCol,"ColInsideDeier","ColDeier2","ColDeier1"); $a1=180-($s1-1)*60; $a2=180-($s2-1)*60; $s1=($s1-1)*2; $s2=($s2-1)*2; $m=((($s2-$s1+12)%12)/2+$s1)%12; $x=$edgesX[$m]; $y=$edgesY[$m]; print <<"EOF"; currentpoint /tmpy exch def /tmpx exch def gsave hexo clip newpath tmpx $Dx add tmpy $Dy $D 2 div add add translate $edgesX[$s1] 2 mul $edgesY[$s1] 2 mul moveto 0 0 lineto $edgesX[$s2] 2 mul $edgesY[$s2] 2 mul lineto 0 0 $Dx 2 mul $a2 $a1 arc ColInsideDeier 1 setlinejoin gsave fill grestore gsave 25 mm setlinewidth ColDeier2 stroke grestore 15 mm setlinewidth ColDeier1 stroke grestore EOF } sub dothindeier { local($s1)=@_; local(@a,$_,$m,$x,$y,$a1,$a2); push(@CCol,"ColInsideDeier","ColDeier2","ColDeier1"); @a=split(//,$s1); print "ColBlack gsave currentpoint currentpoint hexo clip\n"; print "translate\n"; printf "%d %d translate newpath\n",$Dx,$Dy+$D/2; printf "%d %d moveto\n",$edgesX[($a[0]-1)*2],$edgesY[($a[0]-1)*2]; print "0 0 lineto\n"; printf "%d %d rlineto\n",$edgesX[($a[1]-1)*2],$edgesY[($a[1]-1)*2] if ($#a > 0); print <<"EOF"; 1 setlinecap gsave 35 mm setlinewidth ColDeier1 stroke grestore gsave 25 mm setlinewidth ColDeier2 stroke grestore gsave 15 mm setlinewidth ColDeier1 stroke grestore 5 mm setlinewidth ColInsideDeier stroke grestore EOF } sub doinsidedeier { push(@CCol,"ColInsideDeier"); print <<"EOF"; currentpoint /tmpy exch def /tmpx exch def gsave hexo clip newpath ColInsideDeier tmpx tmpy moveto 80 mm 0 rlineto 0 80 mm rlineto -80 mm 0 rlineto closepath fill grestore EOF } sub doscrub { local($a)=@_; local(@a,%a,$b); %a=(); push(@CCol,"ColScrub"); print "currentpoint gsave translate newpath \n"; @a=split(//,$a); foreach $b (@a) { $a{$b}=1; } if (defined($a{1})) { print "$HexeX[0] $HexeY[0] moveto\n"; } else { print "$HexiX[0] $HexiY[0] moveto\n"; } for ($b=1; $b<=6; $b++) { if (defined($a{$b})) { print "$HexeX[$b-1] $HexeY[$b-1] lineto\n"; print "$HexeX[$b] $HexeY[$b] lineto\n"; } else { print "$HexiX[$b-1] $HexiY[$b-1] lineto\n"; print "$HexiX[$b] $HexiY[$b] lineto\n"; } } print "closepath clip newpath\n"; print "1 setlinecap 2 mm setlinewidth\n"; print "ColScrub\n"; printf "0 1 100 { pop /tmpx rand 100 mod %d mul 100 div def\n",$Dx*2; printf " /tmpy rand 100 mod %d mul 100 div def\n",$D+$Dy*2; print <<"EOF"; tmpx tmpy rand 4 mm cvi mod rand 180 mod rand 180 mod 180 add arc stroke tmpx tmpy rand 4 mm cvi mod rand 180 mod 180 add rand 180 mod arc stroke EOF printf " } for\n"; print "grestore\n"; } sub dohammada { local($x)=int($Dy*2+$D); print <<"EOF"; currentpoint gsave newpath translate 0 0 moveto hexo clip 10 array /tmpxx exch def 10 array /tmpyy exch def 0 setlinewidth 0 1 100 { /tmpI exch def /tmpx rand $x mod def /tmpy rand $x mod def /tmpa rand 360 mod def /tmpr rand 4 mod 1 add def 0 1 tmpr { /tmpi exch def /tmpl rand 2 mm cvi mod 1 add def /tmpl2 tmpl 2 div 1 add def /tmpl4 tmpl 4 div def /tmpj 360 tmpr 1 add div tmpi mul tmpa add def tmpxx tmpi tmpj cos tmpl mul rand tmpl2 cvi mod tmpl4 sub add put tmpyy tmpi tmpj sin tmpl mul rand tmpl2 cvi mod tmpl4 sub add put } for newpath 0 setlinewidth tmpxx 0 get tmpx add tmpyy 0 get tmpy add moveto 1 1 tmpr { /tmpi exch def tmpxx tmpi get tmpx add tmpyy tmpi get tmpy add lineto } for closepath ColBlack stroke } for grestore EOF } sub dobuilding { local($n,$rot,$a)=@_; local(@angle)=(0,0,300,240,180,120,60,0); push(@CCol,"ColSmallWoodBld"); print "gsave ColSmallWoodBld 1 mm setlinewidth\n"; printf "%d %d rmoveto gsave\n",$Dx,$D/2+$Dy; if ($n == 0) { print "currentpoint translate $rot rotate gsave\n" if ($rot ne '0'); printf "%d %d rmoveto\n",-$D/2,-$D/2; printf "%d 0 rlineto 0 %d rlineto %d 0 rlineto\n",$D,$D,-$D; print "closepath gsave fill grestore ColBlack\n"; print "stroke grestore ColBlack\n"; printf "%d %d rmoveto\n",-$D/2,-$D/2; printf "%d %d rlineto %d 0 rmoveto\n",$D,$D,-$D; printf "%d %d rlineto stroke\n",$D,-$D; printf "grestore\n" if ($rot ne '0'); } else { print "currentpoint translate $angle[$a] rotate\n"; printf "%d %d rmoveto\n",$D/2,-$D/2; printf "0 %d rlineto %d 0 rlineto 0 %d rlineto\n", $D,-$D/2-$Dx,-$D; printf "closepath gsave fill grestore ColBlack\n"; print "gsave stroke grestore ColBlack\n"; printf "%d %d rlineto 0 %d rmoveto\n",-$D/2-$Dx,$D,-$D; printf "%d %d rlineto stroke\n",$Dx+$D/2,$D; print "grestore\n"; } print "grestore\n"; } sub doSbuilding { local($num,$col)=@_; local(@angle)=(0,0,300,240,180,120,60,0); push(@CCol,$col); print "gsave ColBlack 0 setlinewidth\n"; printf "%d %d rmoveto currentpoint translate gsave\n",$Dx,$D/2+$Dy; print <<"EOF"; /hut { xsize 2 div neg ysize 2 div neg rmoveto xsize 0 rlineto 0 ysize rlineto xsize neg 0 rlineto 0 ysize neg rlineto gsave $col fill grestore xsize ysize rlineto 0 ysize neg rmoveto xsize neg ysize rlineto stroke } def EOF if ($num == 0) { print "/num rand 3 mod 1 add def\n"; } else { print "/num $num 1 sub def\n"; } print <<"EOF"; rand 360 mod rotate 0 0 moveto 0 1 num { gsave newpath 360 mul num 1 add div rotate 13 rand 5 mod add mm 0 moveto currentpoint translate rand 180 mod rotate /xsize rand 2 mod 3 add 3 mul mm def /ysize rand 2 mod 3 add 3 mul mm def hut grestore } for grestore grestore EOF } sub dolumberyard { local(@s)=($Dx/2,$Dy,$Dx*3/2,$Dy+$D); push(@CCol,"ColWoodBld"); print <<"EOF"; currentpoint gsave hexo clip newpath translate 0 setlinewidth $s[1] 15 mm $s[3] { /tmpy exch def $s[0] 15 mm $s[2] { /tmpx exch def /tmpr rand 2 mod def rand 8 mod 4 sub mm tmpx add rand 8 mod 4 sub mm tmpy add gsave translate tmpr 1 eq { 90 rotate } if rand 5 mod 7 add mm /tmpxx exch def rand 8 mod 10 add mm /tmpyy exch def tmpxx 2 div neg tmpyy 2 div neg translate 0 0 moveto tmpxx 0 lineto tmpxx tmpyy lineto 0 tmpyy lineto 0 0 lineto gsave ColWoodBld fill grestore stroke newpath tmpxx cvi 2.5 mm cvi mod 2 div 2.5 mm tmpxx { dup 0 moveto tmpyy lineto } for ColBlack stroke grestore } for } for grestore EOF } sub domanhole { print "currentpoint gsave ColBlack\n"; printf "currentpoint exch %d add exch %d add newpath\n",$Dx,$D/2+$Dy; print "1 mm setlinewidth 7 mm 0 360 arc\n"; print "stroke grestore newpath moveto\n"; } sub dostairwell { local ($size,$size2)=(3.5,7); print "gsave ColWhite 0 setlinewidth\n"; printf "%d %d rmoveto gsave currentpoint translate\n",$Dx,$D/2+$Dy; print <<"EOF"; newpath 0 0 moveto -$size mm -$size mm rmoveto $size2 mm 0 rlineto 0 $size2 mm rlineto -$size2 mm 0 rlineto closepath gsave fill grestore ColBlack stroke grestore grestore EOF } sub dotank { local ($size)=(22); push(@CCol,"ColStoneBld"); print "gsave ColStoneBld\n"; printf "%d %d rmoveto gsave currentpoint translate\n",$Dx,$D/2+$Dy; print <<"EOF"; newpath 0 0 $size mm 0 360 arc closepath gsave fill grestore ColBlack $SBwidth mm setlinewidth stroke grestore grestore EOF } sub docenterdot { local ($size)=(4.5); print "gsave ColWhite 0 setlinewidth\n"; printf "%d %d rmoveto gsave currentpoint translate\n",$Dx,$D/2+$Dy; print <<"EOF"; newpath 0 0 $size mm 0 360 arc closepath gsave fill grestore ColBlack stroke grestore grestore EOF } sub dobuildingwall { local($angle,$type,$width)=@_; print "currentpoint gsave moveto\n"; print "$width mm setlinewidth\n"; printf "%d %d rmoveto gsave\n",$Dx,$D/2+$Dy; print "currentpoint translate newpath 0 setlinejoin 0 setlinecap\n"; printf "0 0 moveto %d rotate\n",($angle-1)*-60; if ($type eq 'a') { printf "%d %d moveto\n",-$Dx,-$D/2*3/4; printf "%d %d lineto\n",-$Dx,$D/2*3/4; } elsif ($type eq 'b') { printf "%d %d moveto\n",-$Dx*2/3,-$D*2/3; printf "%d %d lineto\n",0,-$D; } elsif ($type eq 'c') { printf "%d %d moveto\n",$Dx*2/3,-$D*2/3; printf "%d %d lineto\n",0,-$D; } elsif ($type eq 'd') { printf "%d %d moveto\n",-$Dx,$D/2*3/4; printf "%d %d lineto\n",-$Dx,-$D/2; } elsif ($type eq 'D') { printf "%d %d moveto\n",-$Dx,-$D/2*3/4; printf "%d %d lineto\n",-$Dx,$D/2; } elsif (($type eq 'E') || ($type eq 'e')) { printf "1 setlinecap %d %d moveto\n",-$Dx,-$D/2; printf "%d %d lineto\n",-$Dx,$D/2; } print "closepath ColBlack\n"; print "stroke grestore grestore\n"; } sub doSBuilding { local($angle,$edge,$width,$g)=@_; local(@a,$f,$x,$y,$z); push(@CCol,$g); print "currentpoint gsave hexo clip moveto $g\n"; print "$width mm setlinewidth\n"; printf "%d %d rmoveto gsave\n",$Dx,$D/2+$Dy; print "currentpoint translate newpath 0 setlinejoin 2 setlinecap\n"; &doedge($angle,$edge); print "closepath gsave fill grestore ColBlack\n"; print "stroke grestore grestore\n"; } sub doedge { local($angle,$edge)=@_; local($SQRT3)=sqrt(3.0); printf "0 0 moveto %d rotate\n",($angle-1)*-60; if ($edge eq "a") { printf "%d %d moveto\n",-$Dx*2/3,-$D*2; printf "%d %d lineto\n",-$Dx*2/3,$D/3; printf "%d %d lineto\n",$Dx*2/3,$D/3; printf "%d %d lineto\n",$Dx*2/3,-$D*2; } elsif ($edge eq "b") { printf "%d %d moveto\n",-$D*3,$D*2; printf "%d %d lineto\n",-$Dx*1/3,$D*2; printf "%d %d lineto\n",-$Dx*1/3,$D/2*3/4; printf "%d %d lineto\n",$Dx*3, $D/2*3/4; printf "%d %d lineto\n",$Dx*3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*1/3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*1/3,-$D*2; printf "%d %d lineto\n",-$D*3,-$D*2; } elsif ($edge eq "c") { printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2,-$D/2*3/4; printf "%d %d lineto\n",$Dx*2,$D/2*3/4; printf "%d %d lineto\n",-$Dx*2, $D/2*3/4; } elsif ($edge eq "d") { printf "%d %d moveto\n",-$Dx*2, $D/2*3/4; printf "%d %d lineto\n",$Dx*2/3, $D/2*3/4; printf "%d %d lineto\n",$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*1/3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*1/3,-$D*2; printf "%d %d lineto\n",-$D*3,-$D*2; } elsif ($edge eq "D") { printf "%d %d moveto\n",$Dx*2, $D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3, $D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",$Dx*1/3,-$D/2*3/4; printf "%d %d lineto\n",$Dx*1/3,-$D*2; printf "%d %d lineto\n",$D*3,-$D*2; } elsif ($edge eq "e") { printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2/3, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2/3, $D*3; printf "%d %d lineto\n",-$Dx*2, $D*3; } elsif ($edge eq "E") { printf "%d %d moveto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3, $D*3; printf "%d %d lineto\n",$Dx*2, $D*3; } elsif ($edge eq "f") { printf "%d %d moveto\n",-$Dx*2, $D/2*3/4; printf "%d %d lineto\n",$Dx*2/3, $D/2*3/4; printf "%d %d lineto\n",$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",$Dx*2/3,-$D*2; printf "%d %d lineto\n",-$Dx*2/3,-$D*2; printf "%d %d lineto\n",-$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",-$D*3,-$D/2*3/4; } elsif ($edge eq "F") { printf "%d %d moveto\n",$Dx*2, $D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3, $D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3,-$D*2; printf "%d %d lineto\n",$Dx*2/3,-$D*2; printf "%d %d lineto\n",$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",$D*3,-$D/2*3/4; } elsif ($edge eq "g") { printf "%d %d moveto\n",$Dx/3,$D*2; printf "%d %d lineto\n",$Dx/3,$D/2; printf "%d %d lineto\n",-$Dx*2/3,$D/2; printf "%d %d lineto\n",-$Dx*2/3,-$D/2; printf "%d %d lineto\n",$Dx/3,-$D/2; printf "%d %d lineto\n",$Dx/3,-$D*2; printf "%d %d lineto\n",$Dx*3,-$D*2; printf "%d %d lineto\n",$Dx*3,$D*2; } elsif ($edge eq "G") { printf "%d %d moveto\n",-$Dx/3,$D*2; printf "%d %d lineto\n",-$Dx/3,$D/2; printf "%d %d lineto\n",$Dx*2/3,$D/2; printf "%d %d lineto\n",$Dx*2/3,-$D/2; printf "%d %d lineto\n",-$Dx/3,-$D/2; printf "%d %d lineto\n",-$Dx/3,-$D*2; printf "%d %d lineto\n",-$Dx*3,-$D*2; printf "%d %d lineto\n",-$Dx*3,$D*2; } elsif ($edge eq "h") { printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2, $D/2*3/4; printf "%d %d lineto\n",-$Dx/3, $D/2*3/4; printf "%d %d lineto\n",-$Dx/3, $D*2; printf "%d %d lineto\n",-$D*2, $D*2; } elsif ($edge eq "H") { printf "%d %d moveto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2, $D/2*3/4; printf "%d %d lineto\n",$Dx/3, $D/2*3/4; printf "%d %d lineto\n",$Dx/3, $D*2; printf "%d %d lineto\n",$D*2, $D*2; } elsif ($edge eq "i") { printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dy,-$D/2*3/4; printf "%d %d lineto\n",$Dy,$D/2*3/4; printf "%d %d lineto\n",-$Dx*2, $D/2*3/4; } elsif ($edge eq "j") { printf "%d %d moveto\n",-$Dx*2,-$D/2*3/4; printf "%d %d lineto\n",$Dx/3,-$D/2*3/4; printf "%d %d lineto\n",$Dx/3,-$D*3; printf "%d %d lineto\n",$D*2,-$D*3; printf "%d %d lineto\n",$D*2,$D*3; printf "%d %d lineto\n",-$D*2,$D*3; } elsif ($edge eq "J") { printf "%d %d moveto\n",$Dx*2,-$D/2*3/4; printf "%d %d lineto\n",-$Dx/3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx/3,-$D*3; printf "%d %d lineto\n",-$D*2,-$D*3; printf "%d %d lineto\n",-$D*2,$D*3; printf "%d %d lineto\n",$D*2,$D*3; } elsif ($edge eq "k") { printf "%d %d moveto\n",-$D*2,-$D*2; printf "%d %d lineto\n", $D*2,-$D*2; printf "%d %d lineto\n", $D*2, $D*2; printf "%d %d lineto\n",-$D*2, $D*2; } elsif ($edge eq "l") { printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2, $D*2; printf "%d %d lineto\n",-$Dx*2, $D*2; } elsif ($edge eq "m") { printf "%d %d moveto\n",$Dx*2/3,-$D*3; printf "%d %d lineto\n",$Dx*2/3,$D/3; printf "%d %d lineto\n",-$Dx/3,$D/3; printf "%d %d lineto\n",-$Dx/3,$D*3; printf "%d %d lineto\n",-$D*3,$D*3; printf "%d %d lineto\n",-$D*3,-$D*3; } elsif ($edge eq "M") { printf "%d %d moveto\n",-$Dx*2/3,-$D*3; printf "%d %d lineto\n",-$Dx*2/3,$D/3; printf "%d %d lineto\n",$Dx/3,$D/3; printf "%d %d lineto\n",$Dx/3,$D*3; printf "%d %d lineto\n",$D*3,$D*3; printf "%d %d lineto\n",$D*3,-$D*3; } elsif ($edge eq "n") { printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2/3, -$D/2*3/4; printf "%d %d lineto\n",$Dx*2/3, $D*2; printf "%d %d lineto\n",-$Dx*2, $D*2; } elsif ($edge eq "N") { printf "%d %d moveto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3, $D*2; printf "%d %d lineto\n",$Dx*2, $D*2; } elsif ($edge eq "o") { printf "%d %d moveto\n",-$Dx*2,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3,-$D/2*3/4; printf "%d %d lineto\n",-$Dx*2/3,-$D*3; printf "%d %d lineto\n",$D*2,-$D*3; printf "%d %d lineto\n",$D*2,$D*3; printf "%d %d lineto\n",-$D*2,$D*3; } elsif ($edge eq "O") { printf "%d %d moveto\n",$Dx*2,-$D/2*3/4; printf "%d %d lineto\n",$Dx/3,-$D/2*3/4; printf "%d %d lineto\n",$Dx/3,$D*3; printf "%d %d lineto\n",-$D*2,$D*3; printf "%d %d lineto\n",-$D*2,-$D*3; printf "%d %d lineto\n",$D*2,-$D*3; } elsif ($edge eq "p") { local($YY)=$D/2*3/4; local($x1,$y1)=(-$Dx/8,$Dy*7/8+$D/2); local($x2,$y2)=(-$Dx*7/8,$Dy/8+$D/2); local($x3,$y3)=($x1+($y1-$YY)/$SQRT3,$YY); local($x4,$y4)=($x2+($y2-$YY)/$SQRT3,$YY); printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dy,-$D/2*3/4; printf "%d %d lineto\n",$Dy,$D/2*3/4; printf "%d %d lineto\n",$x3,$y3; printf "%d %d lineto\n",$x1-$D,$y1+$D*$SQRT3; printf "%d %d lineto\n",$x2-$D,$y2+$D*$SQRT3; printf "%d %d lineto\n",$x4,$y4; printf "%d %d lineto\n",-$Dx*2, $D/2*3/4; } elsif ($edge eq "P") { local($YY)=$D/2*3/4; local($x1,$y1)=(-$Dx/8,$Dy*7/8+$D/2); local($x2,$y2)=(-$Dx*7/8,$Dy/8+$D/2); local($x3,$y3)=($x1+($y1-$YY)/$SQRT3,$YY); local($x4,$y4)=($x2+($y2-$YY)/$SQRT3,$YY); printf "%d %d moveto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dy,-$D/2*3/4; printf "%d %d lineto\n",-$Dy,$D/2*3/4; printf "%d %d lineto\n",-$x3,$y3; printf "%d %d lineto\n",-($x1-$D),$y1+$D*$SQRT3; printf "%d %d lineto\n",-($x2-$D),$y2+$D*$SQRT3; printf "%d %d lineto\n",-$x4,$y4; printf "%d %d lineto\n",$Dx*2, $D/2*3/4; } elsif ($edge eq "q") { local($YY)=$D/2*3/4; local($x1,$y1)=($Dx/8,$Dy*7/8+$D/2); local($x2,$y2)=($Dx*7/8,$Dy/8+$D/2); local($x3,$y3)=($x1-($y1-$YY)/+$SQRT3,$YY); local($x4,$y4)=($x2-($y2-$YY)/+$SQRT3,$YY); printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",$Dy*1.4,-$D/2*3/4; printf "%d %d lineto\n",$Dy*1.4,$D/2*3/4; printf "%d %d lineto\n",$x4,$y4; printf "%d %d lineto\n",$x2+$D,$y2+$D*$SQRT3; printf "%d %d lineto\n",$x1+$D,$y1+$D*$SQRT3; printf "%d %d lineto\n",$x3,$y3; printf "%d %d lineto\n",-$Dx*2, $D/2*3/4; } elsif ($edge eq "Q") { local($YY)=$D/2*3/4; local($x1,$y1)=($Dx/8,$Dy*7/8+$D/2); local($x2,$y2)=($Dx*7/8,$Dy/8+$D/2); local($x3,$y3)=($x1-($y1-$YY)/+$SQRT3,$YY); local($x4,$y4)=($x2-($y2-$YY)/+$SQRT3,$YY); printf "%d %d moveto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dy*1.4,-$D/2*3/4; printf "%d %d lineto\n",-$Dy*1.4,$D/2*3/4; printf "%d %d lineto\n",-$x4,$y4; printf "%d %d lineto\n",-($x2+$D),$y2+$D*$SQRT3; printf "%d %d lineto\n",-($x1+$D),$y1+$D*$SQRT3; printf "%d %d lineto\n",-$x3,$y3; printf "%d %d lineto\n",$Dx*2, $D/2*3/4; } elsif ($edge eq "r") { printf "%d %d moveto\n",-$Dx*2/3,-$D*2; printf "%d %d lineto\n",-$Dx*2/3,$D*2; printf "%d %d lineto\n",$Dx*2/3,$D*2; printf "%d %d lineto\n",$Dx*2/3,-$D*2; } elsif ($edge eq "s") { printf "%d %d rmoveto\n",-$D/2,-$D/2; printf "%d 0 rlineto 0 %d rlineto %d 0 rlineto\n",$D,$D,-$D; } elsif ($edge eq "t") { printf "%d %d moveto\n",-$Dx*2/3,-$D*2; printf "%d %d lineto\n",-$Dx*2/3,$D*2; printf "%d %d lineto\n",$Dx*2,$D*2; printf "%d %d lineto\n",$Dx*2,-$D*2; } elsif ($edge eq "u") { printf "%d %d moveto\n",$Dx/4,-$D*2; printf "%d %d lineto\n",$Dx/4, $D*2; printf "%d %d lineto\n",$Dx*2, $D*2; printf "%d %d lineto\n",$Dx*2,-$D*2; } elsif ($edge eq "v") { printf "%d %d moveto\n",-$Dx*2, -$D/2/3; printf "%d %d lineto\n",$Dx*2, -$D/2/3; printf "%d %d lineto\n",$Dx*2, $D*2; printf "%d %d lineto\n",-$Dx*2, $D*2; } elsif ($edge eq "w") { local($x,$y); printf "%d %d moveto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx, -$D/2*3/4; ($x,$y)=($Dx*1/8,-$D/2-$Dy*7/8); printf "%d %d lineto\n",$x,$y; printf "%d %d lineto\n",$x*2,$y*2; printf "%d %d lineto\n",$x*2+$Dx*6/8,$y*2+$Dy*6/8; ($x,$y)=($Dx*7/8,-$Dy/8-$D/2); printf "%d %d lineto\n",$x,$y; printf "%d %d lineto\n",$x,-$y; ($x,$y)=($x,-$y); printf "%d %d lineto\n",$x*2,$y*2; printf "%d %d lineto\n",$x*2-$Dx*6/8,$y*2+$Dy*6/8; printf "%d %d lineto\n",$Dx/8,$D/2+$Dy*7/8; printf "%d %d lineto\n",-$Dx, $D/2*3/4; printf "%d %d moveto\n",-$Dx*2, $D/2*3/4; } elsif ($edge eq "x") { local($dx,$dy)=(((-$Dx)-($Dx/8)),((-$D/2*3/4)-(-$D/2-$Dy*7/8))); printf "%d %d moveto\n",(-$Dx) +$dx,(-$D/2*3/4) +$dy; printf "%d %d lineto\n",($Dx/8) -$dx,(-$D/2-$Dy*7/8)-$dy; printf "%d %d lineto\n",($Dx*7/8)-$dx,(-$D/2-$Dy/8) -$dy; printf "%d %d lineto\n",(-$Dx) +$dx,($D/2*3/4) +$dy; } elsif ($edge eq "X") { local($dx,$dy)=(((-$Dx)-($Dx/8)),((-$D/2*3/4)-(-$D/2-$Dy*7/8))); printf "%d %d moveto\n",-((-$Dx) +$dx),(-$D/2*3/4) +$dy; printf "%d %d lineto\n",-(($Dx/8) -$dx),(-$D/2-$Dy*7/8)-$dy; printf "%d %d lineto\n",-(($Dx*7/8)-$dx),(-$D/2-$Dy/8) -$dy; printf "%d %d lineto\n",-((-$Dx) +$dx),($D/2*3/4) +$dy; } elsif ($edge eq "y") { printf "%d %d moveto\n",-$Dx/3,-$D*2; printf "%d %d lineto\n",-$Dx/3,-$D/2; printf "%d %d lineto\n", $Dx/3,-$D/2; printf "%d %d lineto\n", $Dx/3,-$D*2; printf "%d %d lineto\n", $Dx*2,-$D*2; printf "%d %d lineto\n", $Dx*2,$D/2*3/4; printf "%d %d lineto\n",-$Dx*2,$D/2*3/4; printf "%d %d lineto\n",-$Dx*2,-$D*2; } elsif ($edge eq "z") { local($dx,$dy)=(((-$Dx)-($Dx/8)),((-$D/2*3/4)-(-$D/2-$Dy*7/8))); printf "%d %d moveto\n",int(-$Dx*7/8),int(-$D*2); printf "%d %d lineto\n",int(-$Dx*7/8),int($D/2*3/4); printf "%d %d lineto\n",int(-$Dx/8), int($D/2*3/4); printf "%d %d lineto\n",int(-$Dx/8), int(-$D*2); } elsif ($edge eq "Z") { local($dx,$dy)=(((-$Dx)-($Dx/8)),((-$D/2*3/4)-(-$D/2-$Dy*7/8))); printf "%d %d moveto\n",int($Dx*7/8),int(-$D*2); printf "%d %d lineto\n",int($Dx*7/8),int($D/2*3/4); printf "%d %d lineto\n",int($Dx/8), int($D/2*3/4); printf "%d %d lineto\n",int($Dx/8), int(-$D*2); } elsif ($edge eq "1") { printf "%d %d moveto\n",$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2, -$D/2*3/4; printf "%d %d lineto\n",-$Dx*2, $D/2*3/4; printf "%d %d lineto\n",-$Dx*7/8,$D/2*3/4; printf "%d %d lineto\n",-$Dx*7/8,$D*3; printf "%d %d lineto\n",-$Dx/8, $D*3; printf "%d %d lineto\n",-$Dx/8, $D/2*3/4; printf "%d %d lineto\n",$Dx/3, $D/2*3/4; printf "%d %d lineto\n",$Dx/3, $D*2; printf "%d %d lineto\n",$D*2, $D*2; } elsif ($edge eq "2") { printf "%d %d moveto\n",-$Dx*2,-$D/2-$Dy*2/3; printf "%d %d lineto\n", $Dx*2,-$D/2-$Dy*2/3; printf "%d %d lineto\n", $Dx*2,$D*2; printf "%d %d lineto\n",-$Dx*2,$D*2; } } sub dowaterdot { local($a)=@_; push(@CCol,"ColWater2","ColWater4","ColWater1"); print <<"EOF"; gsave currentpoint exch $Dx add exch $Dy $D 2 div add add translate -$a 60 mul 30 add rotate -$Dy -$D 2 div add 0 translate newpath -$Dy 0 moveto $Dy 1 mm sub 0 lineto 0 setlinecap 28 mm setlinewidth ColWater2 stroke -$Dy 1 mm sub 0 moveto $Dy 1 mm add 0 lineto 20 mm setlinewidth ColWater4 stroke -$Dy 9 mm sub 0 moveto $Dy 9 mm add 0 lineto 1 setlinecap 12 mm setlinewidth ColWater1 stroke grestore EOF } sub dowateredge { local($g)=@_; local(@a,$a); push(@CCol,"ColWater2","ColWater4","ColWater1"); @a=split(//,$g); for $g (@a) { print <<"EOF"; gsave currentpoint /tmpy exch def /tmpx exch def newpath 28 mm setlinewidth ColWater2 1 setlinecap $HexeX[$g-1] tmpx add $HexeY[$g-1] tmpy add moveto $HexeX[$g] tmpx add $HexeY[$g] tmpy add lineto stroke grestore EOF } for $g (@a) { print <<"EOF"; gsave currentpoint /tmpy exch def /tmpx exch def newpath 20 mm setlinewidth ColWater4 1 setlinecap $HexeX[$g-1] tmpx add $HexeY[$g-1] tmpy add moveto $HexeX[$g] tmpx add $HexeY[$g] tmpy add lineto stroke grestore EOF } for $g (@a) { print <<"EOF"; gsave currentpoint /tmpy exch def /tmpx exch def newpath 12 mm setlinewidth ColWater1 1 setlinecap $HexeX[$g-1] tmpx add $HexeY[$g-1] tmpy add moveto $HexeX[$g] tmpx add $HexeY[$g] tmpy add lineto stroke grestore EOF } } sub dowaterEdge { print <<"EOF"; gsave currentpoint hexo clip moveto EOF &dowateredge(@_); print "grestore\n"; } sub doroad { local($t,$g,$a)=@_; local($d); $d=$Dy+$D/2; if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g); if ($t eq "center") { push(@CCol,"ColStoneBridge"); print <<"EOF"; gsave currentpoint hexo clip newpath moveto dup dup 4 eq {pop 30 mm ColStoneBridge} {0 eq {15 mm ColBlack} {13 mm $g } ifelse } ifelse 1 setlinecap setlinewidth $Dx $d rmoveto 4 eq { $edgesX[$a] .4 mul $edgesY[$a] .4 mul rlineto gsave stroke grestore 0 setlinecap $edgesX[$a] 2 div $edgesY[$a] 2 div rlineto stroke } { $edgesX[$a] $edgesY[$a] rlineto stroke } ifelse grestore EOF } else { $a=ord($a)-ord('a')+1; print <<"EOF"; gsave currentpoint /tmpy exch def /tmpx exch def hexo clip newpath 0 ne {13 mm $g} {15 mm ColBlack} ifelse 2 setlinecap setlinewidth $HexeX[$a-1] tmpx add $HexeY[$a-1] tmpy add moveto $HexeX[$a] tmpx add $HexeY[$a] tmpy add lineto stroke grestore EOF } } sub douproad { local($g,$a)=@_; local($DY)=$Dy+$D/2; local($d)=$Dx/8; local($d2,$d1)=($d/3,$d/6); local($x2,$x1)=($d*2/3,$d/3); if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g,"ColUpRoad1","ColUpRoad2"); print <<"EOF"; gsave currentpoint hexo clip newpath moveto dup 0 eq { 34 mm 0 setlinecap ColUpRoad1 setlinewidth [$x1 $x2] $d1 setdash $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if dup 1 eq { 24 mm 0 setlinecap ColUpRoad2 setlinewidth [$x2 $x1] $d2 setdash $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if dup 2 eq { 15 mm 1 setlinecap ColBlack setlinewidth $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if dup 3 eq { 13 mm $g 1 setlinecap setlinewidth $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if pop grestore EOF } sub douproadleft { local($g,$a)=@_; local($o1,$o2,$o3)=(($a+2)%12,($a+8)%12,($a+11)%12); local($X,$Y)=($Dx,$Dy+$D/2); if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g); print <<"EOF"; dup gsave currentpoint currentpoint /y exch $Y add def /x exch $X add def $edgesX[$o1] 2 mul x add $edgesY[$o1] 2 mul y add moveto $edgesX[$o2] 2 mul x add $edgesY[$o2] 2 mul y add lineto $edgesX[$o3] 2 mul x add $edgesY[$o3] 2 mul y add lineto closepath clip newpath moveto EOF &douproad($g,$a); &douproad($g,($a+6)%12); print "grestore\n"; } sub douproadright { local($g,$a)=@_; local($o1,$o2,$o3)=(($a+4)%12,($a+10)%12,($a+1)%12); local($X,$Y)=($Dx,$Dy+$D/2); if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g); print <<"EOF"; dup gsave currentpoint currentpoint /y exch $Y add def /x exch $X add def $edgesX[$o1] 2 mul x add $edgesY[$o1] 2 mul y add moveto $edgesX[$o2] 2 mul x add $edgesY[$o2] 2 mul y add lineto $edgesX[$o3] 2 mul x add $edgesY[$o3] 2 mul y add lineto closepath clip newpath moveto EOF &douproad($g,$a); &douproad($g,($a+6)%12); print "grestore\n"; } sub dosunkroadleft { local($g,$a)=@_; local($o1,$o2,$o3)=(($a+2)%12,($a+8)%12,($a+11)%12); local($X,$Y)=($Dx,$Dy+$D/2); if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g); print <<"EOF"; dup gsave currentpoint currentpoint /y exch $Y add def /x exch $X add def $edgesX[$o1] 2 mul x add $edgesY[$o1] 2 mul y add moveto $edgesX[$o2] 2 mul x add $edgesY[$o2] 2 mul y add lineto $edgesX[$o3] 2 mul x add $edgesY[$o3] 2 mul y add lineto closepath clip newpath moveto EOF &dosunkroad($g,$a); &dosunkroad($g,($a+6)%12); print "grestore\n"; } sub dosunkroadright { local($g,$a)=@_; local($o1,$o2,$o3)=(($a+4)%12,($a+10)%12,($a+1)%12); local($X,$Y)=($Dx,$Dy+$D/2); if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g); print <<"EOF"; dup gsave currentpoint currentpoint /y exch $Y add def /x exch $X add def $edgesX[$o1] 2 mul x add $edgesY[$o1] 2 mul y add moveto $edgesX[$o2] 2 mul x add $edgesY[$o2] 2 mul y add lineto $edgesX[$o3] 2 mul x add $edgesY[$o3] 2 mul y add lineto closepath clip newpath moveto EOF &dosunkroad($g,$a); &dosunkroad($g,($a+6)%12); print "grestore\n"; } sub dosunkroad { local($g,$a)=@_; local($DY)=$Dy+$D/2; local($d)=$Dx/8; local($d2,$d1)=($d/3,$d/6); local($x2,$x1)=($d*2/3,$d/3); if ($DIRT==1) { $g=ColRoad1 } if ($PAVED==1) { $g=ColRoad2 } push(@CCol,$g,"ColSunkRoad0","ColSunkRoad1","ColSunkRoad2","ColSunkRoad3"); print <<"EOF"; gsave currentpoint hexo clip newpath moveto dup 0 eq { 35 mm 0 setlinecap setlinewidth $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto gsave ColSunkRoad0 stroke grestore ColSunkRoad1 [$x1 $x2] $d1 setdash stroke } if dup 1 eq { 25 mm 0 setlinecap ColSunkRoad2 setlinewidth [$x2 $x1] $d2 setdash $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if dup 2 eq { 15 mm 1 setlinecap ColSunkRoad3 setlinewidth $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if dup 3 eq { 13 mm $g 1 setlinecap setlinewidth $Dx $DY rmoveto $edgesX[$a] $edgesY[$a] rlineto stroke } if pop grestore EOF } sub dopath { local($a)=@_; push(@CCol,"ColPath1"); print "gsave currentpoint hexo clip newpath moveto\n"; print "5 mm 1 setlinecap ColPath1 setlinewidth\n"; printf "%d %d rmoveto\n",$Dx,$Dy+$D/2; printf "%d %d rlineto stroke\n",$edgesX[($a-1)*2],$edgesY[($a-1)*2]; print "grestore\n"; } sub dogully { local($type,$t,$c1,$c2,$c3)=@_; local(@t,$x,$y,$dx,$dy,$px,$py); local(@w)=(12,12,6,3); local(@g)=(18,14,8,3); local(@wid); push(@CCol,$c1,$c2,$c3); @wid=@g if ($type eq "g"); @wid=@w if ($type eq "w"); $px=$Dx; $py=$Dy+$D/2; @t=split(//,$t); print <<"EOF"; gsave currentpoint hexo clip newpath translate 0 0 moveto /tmpr rrand def EOF print "0 eq {\n"; print "1 setlinecap $c1 $wid[0] mm setlinewidth\n"; foreach $t (@t) { printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "} if\n"; print "1 setlinecap $c2 $wid[1] mm setlinewidth\n"; foreach $t (@t) { print "tmpr srand\n"; printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "1 setlinecap $c3 $wid[2] mm setlinewidth\n"; foreach $t (@t) { print "tmpr srand\n"; printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "1 setlinecap ColBlack $wid[3] mm setlinewidth\n"; foreach $t (@t) { print "tmpr srand\n"; printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "grestore\n"; } sub dogullycliff { local($type,$t,$inner)=@_; local($a,$b,@t,$x,$y,$dx,$dy,$px,$py,$xx,$yy); local(@wad)=(23); local(@gul)=(33); local(@wid); push(@CCol,"ColCliff"); @wid=@wad if ($type eq "w"); @wid=@gul if ($type eq "g"); $px=$Dx; $py=$Dy+$D/2; @t=split(//,$t); print "currentpoint gsave hexo clip moveto\n"; printf "%d %d rmoveto gsave\n",$Dx,$D/2+$Dy; print "currentpoint translate newpath 0 setlinejoin\n"; print "1 setlinecap ColCliff $wid[0] mm setlinewidth\n"; foreach $t (@t) { $a=$t; $a =~ tr/a-z/A-Z/; $a=ord($a)-ord('@'); if ($t =~ /[ABCDEF]/) {$b="r";} else {$b="l";} printf "gsave \n"; printf "%d rotate\n",($a-1)*-60; printf "%d %d moveto %d %d lineto\n",-2*$D,0,2*$D,0; if ($b eq "r") { printf "%d %d %d %d ",2*$D,2*$D,-2*$D,2*$D; } else { printf "%d %d %d %d ",2*$D,-2*$D,-2*$D,-2*$D; } printf "lineto lineto closepath clip\n"; if ($inner eq "i") { printf "%d ",-$Dx/4; } else { printf "%d ",0; } printf "newpath 0 moveto -$Dx 0 lineto stroke grestore\n"; } print "grestore grestore\n"; } sub dostream { local($t)=@_; local(@t,$x,$y,$dx,$dy,$px,$py); push(@CCol,"ColStream1","ColStream2","ColWater1"); $px=$Dx; $py=$Dy+$D/2; @t=split(//,$t); print <<"EOF"; gsave currentpoint hexo clip newpath translate 0 0 moveto /tmpr rrand def EOF print "1 setlinecap ColStream2 28 mm setlinewidth\n"; foreach $t (@t) { printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "1 setlinecap ColStream1 17 mm setlinewidth\n"; foreach $t (@t) { print "tmpr srand\n"; printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "1 setlinecap ColWhite 13 mm setlinewidth\n"; foreach $t (@t) { print "tmpr srand\n"; printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "1 setlinecap ColWater1 9 mm setlinewidth\n"; foreach $t (@t) { print "tmpr srand\n"; printf "%d %d moveto\n",$px,$py; $x=$edgesX[($t-1)*2]; $y=$edgesY[($t-1)*2]; $dx=$x/3; $dy=$y/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; $dx=$x*2/3; $dy=$y*2/3; printf "%d %d lineto\n",$px+$dx,$py+$dy; printf "%d %d lineto stroke\n",$px+$x,$py+$y; } print "grestore\n"; } sub dopaddy { local($s1,$e1,$e2)=@_; local(@p1,@p2,$r,$r2,$i,$j); push(@CCol,"ColRicepaddy"); $i=int($Dy+$D/2); $r=$s1-1; @p1=(int(-$Dx*0.8),int($D/2),int(-$Dx*0.8),int(-$D/2)); @p2=(int(-$Dx*2.0),int($D/2),int(-$Dx*2.0),int(-$D/2)); print <<"EOF"; gsave currentpoint hexo clip newpath translate $Dx $i translate $r -60 mul rotate 1.5 mm setlinewidth ColRicepaddy EOF print "$p1[0] $p1[1] moveto $p1[2] $p1[3] lineto\n" if ($e1 eq "i"); print "$p2[0] $p2[1] moveto $p2[2] $p2[3] lineto\n" if ($e1 eq "s"); print "$p1[2] neg $p1[3] lineto $p1[0] neg $p1[1] lineto\n" if ($e2 eq "i"); print "$p2[2] neg $p2[3] lineto $p2[0] neg $p2[1] lineto\n" if ($e2 eq "s"); print <<"EOF"; closepath gsave clip -$Dx 1.2 mul -$i 1.2 mul translate /tmpxr 10 mm cvi def /tmpyr 14 mm cvi def 0 9 mm $Dx 3 mul { newpath /tmpx exch def 0 5 mm $i 1.5 mul { /tmpy exch def tmpx rand tmpxr mod add tmpy rand tmpyr mod add moveto tmpx rand tmpxr mod add 3 mm add tmpy rand tmpyr mod add tmpx rand tmpxr mod add 6 mm add tmpy rand tmpyr mod add tmpx rand tmpxr mod add 9 mm add tmpy rand tmpyr mod add curveto } for stroke } for grestore stroke grestore EOF } sub doblaze { push(@CCol,"ColPerimeter"); print "gsave ColPerimeter 1 mm setlinewidth\n"; printf "%d %d rmoveto gsave\n",$Dx,$D/2+$Dy; printf "%d %d rmoveto\n",-$D/2,-$D/2; printf "%d 0 rlineto 0 %d rlineto %d 0 rlineto\n",$D,$D,-$D; print "closepath gsave fill grestore ColBlack\n"; print "stroke grestore ColBlack\n"; printf "gsave\n"; printf "ColWhite\n"; printf "/Helvetica-Bold findfont\n"; printf "24 scalefont\n"; printf "setfont\n"; printf "%d %d rmoveto\n",-$D/4,-$D*0.4; printf "90 rotate\n"; printf "(BLAZE) show\n"; printf "-90 rotate\n"; printf "currentpoint translate\n"; printf "70 80 scale\n"; printf "270 rotate\n"; printf "BlazeImage\n"; printf "grestore\n"; printf "grestore\n"; } sub dowreck { print "gsave ColWhite 1 mm setlinewidth\n"; printf "%d %d rmoveto gsave\n",$Dx,$D/2+$Dy; printf "1.2 1.2 scale\n"; printf "%d %d rmoveto\n",-$D/2,-$D/2; printf "%d 0 rlineto 0 %d rlineto %d 0 rlineto\n",$D,$D,-$D; print "closepath gsave fill grestore ColBlack\n"; print "stroke grestore ColBlack\n"; printf "gsave\n"; printf "/Helvetica-Bold findfont\n"; printf "24 scalefont\n"; printf "setfont\n"; printf "%d %d rmoveto\n",-$D/3,-$D*0.45; printf "90 rotate\n"; printf "(WRECK) show\n"; printf "-90 rotate\n"; printf "grestore\n"; printf "gsave\n"; printf "%d %d rmoveto\n",0,-$D*0.4; printf "%d 0 rlineto 0 %d rlineto %d 0 rlineto\n",$D*0.4,$D*0.8,-$D*0.4; print "closepath gsave stroke grestore ColBlack\n"; printf "2 mm setlinewidth\n"; printf "%d %d rmoveto\n", $D*0.2, $D*0.4; printf "30 rotate 1 0.6 scale\n"; printf "currentpoint %d %d %d arc\n",0.18*$D,0,360; printf "%d %d rmoveto\n",-0.36*$D,0; printf "%d %d rlineto\n",-0.3*$D,0; printf "stroke grestore\n"; printf "grestore\n"; } %nations=("ge","ColGerman", "ru","ColRussian", "am","ColAmerican", "br","ColBritish", "it","ColItalian", "ax","ColAxis", "al","ColAllied", "fr","ColFrench", "ja","ColJapan"); %unittypes=("","unit","ld","leader","sq","squad","mg","mg"); %Unittypes=("","UNIT","TK","Tank"); %units=("wh","ColWhite;unit", "tca","ColWhite;tca", "bz","ColPerimeter;blaze", ); foreach $x (keys %nations) { foreach $y (keys %unittypes) { $units{$x.$y}="$nations{$x};$unittypes{$y}"; } foreach $y (keys %Unittypes) { $units{"\U$x$y\E"}="$nations{$x};$Unittypes{$y}"; } } $Pic{'squad'} = "{<0000 0000 4CC0 2CFE 19E0 3BD8 3BD8\n3BFF 19DC 1958 1958 195C 1D7E 0000 0000 0000>}\n"; $Pic{'leader'} = "{<0000 0000 0180 0180 0300 0380 07F0 0380 \n0380 0280 02C0 0240 0360 0000 0000 0000>}\n"; $Pic{'mg'} = "{<0000 0000 0100 0100 0100 0100 1F80 0100\n 0100 0380 0540 0920 1110 0000 0000 0000>}\n"; $dx=int(cos($PI/12)*$D); $dy=int(sin($PI/12)*$D); $d45=int(sin($PI/4)*$D); @stackX=(-$dx,-$dy,$d45,$dx,$dy,$d45); @stackY=($dy,$dx,$d45,-$dy,-$dx,$d45); sub docounter { local($size)=@_; print "1 mm setlinewidth\n"; printf "%d %d rmoveto\n",$Dx,$D/2+$Dy; print "gsave currentpoint translate rotate\n"; printf "%d %d moveto\n",-$size/2,-$size/2; print "$size 0 rlineto 0 $size rlineto -$size 0 rlineto\n"; print "closepath gsave fill grestore ColBlack stroke\n"; } sub dounit { local($x,$y,$by,$ro,$d)=@_; local($map,$color,$f,$rota,$type,$text); ($x,$y)=&xyloc($x,$y); foreach $f (split(/,/,$d)) { ($type)=($f =~ /^(\w+)/); $text="" unless ($text)=($f =~ /\((.*)\)/); $rota=$ro unless ($rota)=($f =~ /\[(\d+)\]/); if (defined($units{$type})) { ($color,$map)=split(/;/,$units{$type}); if ($by =~ /b(\d)/) { printf "%d %d moveto ",$x+$edgesX[($1-1)*2],$y+$edgesY[($1-1)*2]; } else { print "$x $y moveto "; } if (!defined($PSfunc{"MAP-$map"})) { $PSfunc{"MAP-$map"}="MAP-$map"; print "\n/MAP-$map {\n"; if ($map eq "unit" || defined($Pic{$map})) { &docounter($D); print "unitfont30 setfont\n"; print "dup stringwidth pop 2 div neg\n"; printf "-%d moveto show\n",$D*0.40; if (defined($Pic{$map})) { printf "%d %d translate\n",-$D*0.40,-$D*0.25; print "70 70 scale 16 16 true [16 0 0 -16 0 16]\n"; print $Pic{$map}; print "imagemask stroke\n"; } } if ($map eq "UNIT" || $map eq "Tank") { &docounter($D*5/4); print "unitfont30 setfont\n"; print "dup stringwidth pop 2 div neg\n"; printf "-%d moveto show\n",$D*0.55; if ($map eq "Tank") { print "1.5 mm setlinewidth newpath -28 55 moveto\n"; print "-27 -27 rlineto\n"; print "54 -54 rlineto\n"; print "27 27 rlineto closepath stroke\n"; print "newpath -16 16 13 45 225 arc\n"; print "16 -6 rlineto 10 10 rlineto\n"; print "closepath stroke\n"; print "newpath -5 5 moveto\n"; print "32 -32 rlineto stroke\n"; } } if ($map eq "tca") { &docounter($D); print "1.5 mm setlinewidth\n"; print "newpath -10 10 20 45 225 arc\n"; print "24 -9 rlineto 15 15 rlineto\n"; print "closepath stroke\n"; print "newpath 5 -5 moveto\n"; print "27 -27 rlineto stroke\n"; print "unitfont24 setfont -42 -42 moveto (TCA) show\n"; } if ($map eq "blaze") { &docounter($D); print "ColWhite\n"; print "unitfont24 setfont\n"; print "(BLAZE) dup stringwidth pop 2 div neg\n"; printf "%d moveto show\n",$D*0.28; printf "180 rotate %d %d translate\n",-$D*0.35,-$D*0.23; print "70 70 scale BlazeImage\n"; } print "grestore } def\n"; } if (!$DefCol{$color}++) { local($cmyk,$gray) = split(/;/,$Colors{$color}); print "\n/$color {COLOR 1 eq {$cmyk setcmykcolor}"; print "{$gray setgray} ifelse} def\n"; } printf "$color ($text) %d MAP-$map\n",75-($rota-1)*60; $x += int($stackX[$ro-1]*0.35); $y += int($stackY[$ro-1]*0.35); } else { print STDERR "unknown unit type: $f\n"; } } } sub loadline { local(*array,$file,@data)=@_; local($x,$y,$z,$dd,@h,$n,$d,$_); foreach (@data) { @h=split(/:/,$_); if ($#h == 1) { ($n,$d)=@h; } else { ($n,$d)=(1,@h); } for ($x=0; $x<$n; $x++) { if ($d =~ /^g\(([a-z]+)(\d+)\),(.*)/) { $x=$2; $z=$1; $y=0; $dd=$3; if (length($z) == 2) { $y+=26; chop($z); } $y+=ord($z)-ord('a'); $array{$file,"goto"}.="$x;$y;$dd "; } elsif ($d =~ /^g\((\d+)-(\d+)\),(.*)$/) { $array{$file,"goto"}.="$1;$2;$3 "; } else { $array{$file,$Xloc,$Yloc}=$d unless $d eq '.'; $Xloc++; } } } $array{$file,"MaxX"}=$Xloc if (($Xloc) > $array{$file,"MaxX"}); } sub map2xy { local($i)=@_; local($m,$x,$y,$z); if ($i =~ /^(\w+):([a-zA-Z]+)(\d+)$/) { ($m,$z,$x)=($1,$2,$3); # $m.=".map"; } elsif ($i =~ /^(\d+)([a-zA-Z]+)(\d+)$/) { ($m,$z,$x)=($1,$2,$3); # $m.=".map"; } elsif ($i =~ /^([a-zA-Z]+)(\d+)$/) { ($m,$z,$x)=($LASTmap,$1,$2); } else { print STDERR "Map location error: $i\n"; $error=1; } if (!defined($filemap{$m})) { if (defined($filemap{"0$m"})) { $m = "0$m"; } else { print STDERR "No such map: $m\n"; $error=1; } } $LASTmap=$m; $y=0; if (length($z) == 2) { $y=26; chop($z); } $y+=(ord($z)&31)-1; return ($m,$x,$y); } sub scanmap { local ($file,*data)=@_; local ($_,*IN,$x,@a); local ($rev)=0; @a=(); $Yloc=0; $Xloc=0; if ($file =~ /^rev\((.*)\)$/) { $file=$1; $rev=1; } $file =~ s/^[0-9]\.map$/0$&/; if( $MacPerl'Version ) { &openfile(IN,"$file") || &openfile(IN,":maps:$file") || &openfile(IN,":overlays:$file") || die "unable to open $file:$!\n"; } else { &openfile(IN,"$file") || &openfile(IN,"0$file") || die "unable to open $file:$!\n"; } $file =~ s/\.(map|ovr)$//; if (defined($filecnt{$file})) { $file .= ++$filecnt{$file}; } else { $filemap{$file."a"}=$file; $filecnt{$file}="a"; } $filemap{$file}=$file; $data{$file,"reverse"}=$rev; $data{$file,"Numx"}=$NUMX; $data{$file,"Numy"}=$NUMY; while () { s/#.*$//; if (/^MAP (.+)$/) { $data{$file,"Name"}=$1; $data{$file,"Overlay"}=0; } elsif (/^OVERLAY (.*)$/) { $data{$file,"Name"}=$1; $data{$file,"Overlay"}=1; } elsif (/^MARK (\S+) (\S+)$/) { $data{$file,"Hex1"}=$1; $data{$file,"Hex2"}=$2; } elsif (/^MARK (\S+)$/) { $data{$file,"Hex1"}=$1; $data{$file,"Hex2"}=$1; } elsif (/^NUMX (\d+)/) { $data{$file,"Numx"}=$1; } elsif (/^NUMY (\d+)/) { $data{$file,"Numy"}=$1; } elsif (/^next$/) { &loadline(*data,$file,@a); $data{$file,"MaxY"}=$Yloc; $Yloc++; $Xloc=0; @a=(); } else { push(@a,split); } } close(IN); if ($delete_file ne ""){ print STDERR "removing $delete_file\n"; unlink($delete_file) || die "unable to unlink $delete_file:$!\n"; $delete_file=""; } return $file; } sub xyloc { local($x,$y)=@_; local($rx,$ry); $rx=$Dx*2*$x; $ry=($Dy+$D)*$y-$D/2; $rx+=$Dx if ($y%2 == 1); return($rx,$ry); } sub name { local($x,$y)=@_; local($r); $r=sprintf("%c",($y%26)+ord("A")); $r.=$r if ($y >= 26); return("$r$x"); } sub dobegin { local(@a)=localtime(time); $a[4]++; print <<"EOF"; %!PS %%Title: ASL Postscript Board %%Creator: map2.pl by Eric Young eay\@psych.psy.uq.oz.au %%CreationDate: $a[5]/$a[4]/$a[3] $a[2]:$a[1] %%DocumentFonts: Helvetica-Bold Helvetica %%Pages: (atend) %%EndComments % This code was automagically generated by a perl script and a % description file. Don't bother thinking about modifying this % postscript, change the perl script or the map file. % This project is by Eric Young (eay\@psych.psy.uq.oz.au) % and started out as a postscript learning exersize. save /SCALE $SCALE def /COLOR $COLOR def /DESERT $DESERT def /WINTER $WINTER def /PTO $PTO def /DENSE $DENSE def /DIRT $DIRT def /PAVED $PAVED def /inch { 72 mul } def /mm { 72 mul 25.4 div } bind def /mmunits { 72 25.4 div } def 0 setlinewidth /hexfontsize 10 mm def /Bfontsize 40 mm def /Helvetica-Bold findfont /timesbold exch def /Helvetica findfont /timesroman exch def /tr {timesroman hexfontsize scalefont setfont} def /Btr {timesroman Bfontsize scalefont setfont} def /Btb {timesbold Bfontsize scalefont setfont} def /unitfont30 /Helvetica-Bold findfont 30 scalefont def /unitfont24 /Helvetica-Bold findfont 24 scalefont def /centertxt { % string width /tmpw exch def /tmps exch def tmps stringwidth pop tmpw exch sub 2 div 0 rmoveto tmps show } def /ColBlack { COLOR 1 eq { 0.00 setgray } { 0.00 setgray } ifelse } def /ColWhite { COLOR 1 eq { 1.00 setgray } { 1.00 setgray } ifelse } def /ColBackground { COLOR 1 eq { 0.05 0.00 0.13 0.00 setcmykcolor } { 1.00 setgray } ifelse } def /ColWntrBckgnd { COLOR 1 eq { 0.05 0.00 0.05 0.00 setcmykcolor } { 1.00 setgray } ifelse } def /ColDsrtBckgnd { COLOR 1 eq { 0.06 0.08 0.13 0.00 setcmykcolor } { 0.99 setgray } ifelse } def /BlazeImage { 16 16 true [16 0 0 16 0 0] {<04 00 02 44 ca 36 82 12 52 96 25 59 56 a5 ca 2b e1 56 fd 46 27 7e 33 f2 18 1c 07 70 03 80 02 80>} imagemask stroke } def EOF local($x,$y)=(int($Dx),int($D/2+$Dy)); print <<"EOF"; /namea [(A)(B)(C)(D)(E)(F)(G)(H)(I)(J)(K)(L)(M)(N)(O)(P) (Q)(R)(S)(T)(U)(V)(W)(X)(Y)(Z)(AA)(BB)(CC)(DD)(EE)(FF)(GG)(HH)(II) (JJ)(KK)(LL)(MM)(NN)(OO)(PP)(QQ)(RR)(SS)(TT)(UU)(VV)(WW)(XX)(YY)(ZZ)] def /nameb [ (0)(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)(37)(38)(39) (40)(41)(42)(43)(44)(45)(46)(47)(48)(49) (50)(51)(52)(53)(54)(55)(56)(57)(58)(59) (60)(61)(62)(63)(64)(65)(66)(67)(68)(69) ] def /name { exch nameb exch get /tmpnx exch def namea exch get /tmpny exch def tmpnx length tmpny length add string /tmps exch def tmps 0 tmpny putinterval tmps tmpny length tmpnx putinterval tmps } def /Dx $Dx 2 mul def /Dy $Dy $D add def /xyloc { exch Dx mul /tmpx exch def dup Dy mul $D 2 div sub /tmpy exch def 2 mod 1 eq {/tmpx tmpx $Dx add def} if tmpx tmpy } def /dodot { newpath exch $x add exch $y add 1 mm 0 360 arc gsave ColWhite fill grestore newpath } def /HEXes { /Hy exch def /Hx exch def ColBlack 0 setlinewidth 0 1 Hx 1 sub { /tmpnumx exch def 0 1 Hy 1 sub { tmpnumx exch 2 copy xyloc moveto gsave currentpoint dodot grestore name hex } for } for Btb 18.8 11 div mul $Dx mul $D $Dy add 1.6 mul moveto gsave 180 rotate show grestore } def EOF print "/hexo { \n"; printf "%d %d rmoveto\n",$Dx,0; printf "%d %d rlineto\n",$Dx,$Dy; printf "%d %d rlineto\n",0,$D; printf "%d %d rlineto\n",-$Dx,$Dy; printf "%d %d rlineto\n",-$Dx,-$Dy; printf "%d %d rlineto\n",0,-$D; printf "closepath } def\n"; print "/hex {\n"; printf "gsave hexo stroke grestore\n"; printf "hexfontsize %d rmoveto\n",$D-$Dy; printf "tr gsave 90 rotate %d centertxt grestore\n",$D; print "} bind def\n"; print "/MAPdict 1000 dict def\n"; print "MAPdict begin\n"; print "%%EndProlog\n"; } sub dobp { local($x,$y)=($a4NUMX-1,$a4NUMY-1); print <<"EOF"; %%Page: $Pnumber $Pnumber %%PageFonts: Helvetica-Bold Helvetica 0.5 inch 0.5 inch translate 0.0525 SCALE mul mm dup scale 0 setlinewidth EOF print "0 $a4NUMX $Dx 2 mul mul translate -90 rotate\n" if ($landscape); print <<"EOF"; -$Dx 2 mul 0 translate gsave newpath $Dx 2 mul $Dy $D 2 div sub moveto 0 $y $D $Dy add mul rlineto $x $Dx 2 mul mul 0 rlineto 0 -$y $D $Dy add mul rlineto closepath ColBlack gsave stroke grestore clip EOF } sub doend { local($x,$y)=($a4NUMX-1,$a4NUMY-1); print <<"EOF"; grestore 0 setlinewidth $Dx 2 mul $Dy $D 2 div sub moveto 0 $y $D $Dy add mul rlineto $x $Dx 2 mul mul 0 rlineto 0 -$y $D $Dy add mul rlineto closepath stroke newpath showpage EOF } sub rotation_of_overlay { local($dx2,$dy2,$y1)=@_; local($h); if (($dx2 == 0) && ($dy2 == 0)) { $h=0; } elsif ($y1 & 1) { if ($dx2 == 1) { $h=$dy2; } elsif ($dx2 == 0){$h=$dy2*2; } else { $h=3; } } else { if (($dx2 == -1) && ($dy2 == 0)) { $h=3; } elsif ($dx2 == -1) { $h=$dy2*2; } elsif ($dx2 == 0) {$h=$dy2; } else { $h=0; } } $h; } sub rot_trans { local($X1,$Y1,$X2,$Y2,$a)=@_; local($DXx,$DYx,$DXy,$DYy,$x2,$y2,$x,$y); if ($a == 0) { ($DXx,$DYx,$DXy,$DYy)=( 100, 0, 0, 100); } elsif ($a == 3) { ($DXx,$DYx,$DXy,$DYy)=(-100, 0, 0,-100); } elsif ($a == 1) { ($DXx,$DYx,$DXy,$DYy)=( 50, 100, -75, 50); } elsif ($a == -1) { ($DXx,$DYx,$DXy,$DYy)=( 50,-100, 75, 50); } elsif ($a == 2) { ($DXx,$DYx,$DXy,$DYy)=( -50, 100, -75, -50); } elsif ($a == -2) { ($DXx,$DYx,$DXy,$DYy)=( -50,-100, 75, -50); } $X1+=0.5 if ($Y1 & 1); $X2+=0.5 if ($Y2 & 1); $x2=$DXx*($X2-$X1)+$DXy*($Y2-$Y1); $y2=$DYx*($X2-$X1)+$DYy*($Y2-$Y1); if ($y2 < 0) { $y2=int($y2/100 +$Y1); } else { $y2=int($y2/100 +$Y1); } if ($x2 < 0) { $x2=int($x2/100 +$X1); } else { $x2=int($x2/100 +$X1); } ($x2,$y2); } sub overlay { local($name,$hex1,$hex2)=@_; local($x1,$y1,$x2,$y2,$dx1,$dy1,$dx2,$dy2,$rot); local($b,$mx,$my,$xx,$yy,$dX1,$dY1,$ret,$XX,$YY,$X); ($ret,$x1,$y1)=&map2xy($hex{$name,'Hex1'}); ($ret,$x2,$y2)=&map2xy($hex{$name,'Hex2'}); ($b,$dx1,$dy1)=&map2xy($hex1); ($b,$dx2,$dy2)=&map2xy($hex2); $mx=&rotation_of_overlay($x2-$x1,$y2-$y1,$y1); $my=&rotation_of_overlay($dx2-$dx1,$dy2-$dy1,$dy1); $rot=$my-$mx; $rot=6+$rot if ($rot < -2); $rot=$rot-6 if ($rot > 3); $dX1=$dx1; $dY1=$dy1; $hex{$name,'Xshift'}=$dx1; $hex{$name,'Yshift'}=$dy1; $hex{$name,'rotate'}=$rot; # $hex{$name,'board'}=$b; $mx=$hex{$name,"MaxX"}; $my=$hex{$name,"MaxY"}; for ($y=0; $y<=$my; $y++) { $X=0; if ($y1 & 1) { if ($dy1 & 1) { $X=0; } elsif ($y & 1) { $X=0; } else { $X=-1; } } else { if (($dy1 & 1) && ($y & 1)) { $X=1; } else { $X=0; } } for ($x=0; $x<=$mx; $x++) { if (defined($hex{$name,$x,$y})) { $XX=$x-$x1+$dx1; $YY=$y-$y1+$dy1; ($xx,$yy)=&rot_trans($dx1,$dy1, $XX+$X,$YY,$rot); $overlay{$b,$xx,$yy}=$name; if (defined($overlaymap{$b,$xx,$yy})) { undef $hex{$overlaymap{$b,$xx,$yy}}; } $overlaymap{$b,$xx,$yy}=join($;,$name,$x,$y); } } } } sub main { local ($_,@a,$x,$y,$i,$j,@data,$xtot,$ytot,$X,$Y); local($output,$print,%b,@argv); if( $MacPerl'Version ) { require "GUSI.ph"; if( $#ARGV == -1 ) { $#ARGV=0; $ARGV[0] = &MacPerl'Choose( &GUSI'AF_FILE, 0, "", &GUSI'pack_sa_constr_file("OBJ ", "TEXT")); } $output = &MacPerl'Ask("Enter the output file:"); open(STDOUT,">$output") || die "unable to run $output:$!\n"; } $print="all"; @argv=(); foreach (@ARGV) { if (/^-s(\S+)$/) { $SCALE=$1; } elsif (/^-l$/) { $landscape=1; } elsif (/^-p(\S+)$/) { $print=$1; } else { push(@argv,$_); } } @a=grep(/\.[mM][aA][pP]/,@argv); if ($#a >= 0) { push(@data,"board @a\n"); push(@data,"scale $SCALE\n"); push(@data,"print $print\n"); } else { @data=<>; } $x=$y=0; $print=""; foreach (@data) { chop if /\n$/; s/\s*#.*$//; if (/^scale\s+(.*)$/){ $SCALE=$1; } elsif (/^print\s+(.*)$/) { $print.="$1 "; } elsif (/^landscape$/) { $landscape=1; } elsif (/^desert$/) { $DESERT=1; } elsif (/^winter$/) { $WINTER=1; } elsif (/^pto$/) { $PTO=1; } elsif (/^PTO$/) { $PTO=1; } elsif (/^dense$/) { $DENSE=1; } elsif (/^dirt$/) { $DIRT=1; } elsif (/^paved$/) { $PAVED=1; } elsif (/^overlay\s+(\S+)\s+(\S+)\s+(\S+)$/) { local($z1,$z2,$z3)=($1,$2,$3); $z1 = &scanmap($z1,*hex); push(@boards,$z1); &overlay($z1,$z2,$z3); } elsif (/^overlay\s+(\S+) (\S+)$/) { local($z1,$z2,$z3)=($1,$2,$2); $z1 = &scanmap($z1,*hex); push(@boards,$z1); &overlay($z1,$z2,$z3); } elsif (/^board\s+(.*)$/) { $x=0; foreach $i (split(/\s+/,$1)) { $i = &scanmap($i,*hex); push(@boards,$i); $LASTmap=$i; $boards{$x++,$y}=$i; } $y++; } elsif (/^convert\s+(\S+)\s+to\s+(\S+)$/) { push(@convert,"$1:$2"); } elsif (/^goto\s+(\S+)\s+(\S+)$/) { local($dd)=$2; local($file,$x,$y)=&map2xy($1); if ($dd =~ s/^new,//) { $hex{$file,$x,$y} = "s"; } $hex{$file,"goto"}.="$x;$y;$dd "; } elsif (($i,$dd)=/^unit\s+(\S+)\s+(.*)$/o) { local($file,$x,$y)=&map2xy($i); if ($dd =~ /\[(\w+),(\d+)\]\s+(.+)/o) { $hex{$file,"unit"}.="$x;$y;$1;$2;$3#"; } elsif ($dd =~ /\[(\d+)\]\s+(.+)/o) { $hex{$file,"unit"}.="$x;$y;0;$1;$2#"; } else { $hex{$file,"unit"}.="$x;$y;1;1;$dd#"; } } elsif (/^\s*$/) {} else { print STDERR "unknown command (see the README):$_\n"; $error=1; } } $print="all" if ($print eq ""); # We now have the board layout in %boards and # the contents in %hex; local($xS,$yS)=(($a4NUMX+.5)*$Dx*2,($a4NUMY+.5)*($D+$Dy)); $a4NUMX=int($a4NUMX/$SCALE+0.5)+1; $a4NUMY=int($a4NUMY/$SCALE+0.5)+1; $a4NUMY-- if ($a4NUMY & 1) == 0; while ($xS <= int(($a4NUMX-1)*($Dx*2)*$SCALE)) { $a4NUMX--; } while ($yS <= int(($a4NUMY-1)*($D+$Dy)*$SCALE)) { $a4NUMY--; } if ($landscape) { ($a4NUMX,$a4NUMY)=( int($a4NUMY*($Dy+$D)/($Dx*2)), int($a4NUMX*($Dx*2)/($Dy+$D))); } $X=$Y=0; foreach (keys %boards) { ($x,$y)=split(/$;/); $X=$x if ($X < $x); $Y=$y if ($Y < $y); } foreach (keys %boards) { ($x,$y)=split(/$;/); $b{$x,$Y-$y}=$boards{$x,$y}; } %boards=%b; %map=(); $xtot=0; for ($x=0; $x<=$X; $x++) { $ytot=0; for ($y=0; $y<=$Y; $y++) { $boards{$boards{$x,$y},"xoffset"}=$xtot; $boards{$boards{$x,$y},"yoffset"}=$ytot; local($x1,$x2)=(0,$hex{$boards{$x,$y},"Numx"}-1); local($y1,$y2)=(0,$hex{$boards{$x,$y},"Numy"}-1); for ($i=$x1; $i<=$x2; $i++) { for ($j=$y1; $j<=$y2; $j++) { $map{$xtot+$i,$ytot+$j}.= "$boards{$x,$y},$i,$j "; } } $ytot+=$hex{$boards{$x,$y},"Numy"}-1; } $xtot+=$hex{$boards{$x,0},"Numx"}-1; } &dobegin(); foreach (split(/\s/,$print)) { if (/^all$/) { &dopages(0,0,$xtot,$ytot,*boards,*hex,*map); } elsif (/^(\S*[a-zA-Z]+\d+)\-(\S*[a-zA-Z]+\d+)$/o) { local($l1,$l2) = ($1,$2); local($f1,$x1,$y1)=&map2xy($l1); local($f2,$x2,$y2)=&map2xy($l2); if ($hex{$f1,"reverse"}) { $x1=$hex{$f1,"Numx"}-$x1; $y1=$hex{$f1,"Numy"}-$y1-1; } if ($hex{$f2,"reverse"}) { $x2=$hex{$f2,"Numx"}-$x2; $y2=$hex{$f2,"Numy"}-$y2-1; } $x1+=$boards{$f1,"xoffset"}; $y1+=$boards{$f1,"yoffset"}; $x2+=$boards{$f2,"xoffset"}; $y2+=$boards{$f2,"yoffset"}; if ($x1 > $x2) { ($x1,$x2)=($x2,$x1); } if ($y1 > $y2) { ($y1,$y2)=($y2,$y1); } $x1-- if $x1; &dopages($x1,$y1,$x2,$y2,*boards,*hex,*map); } elsif (/^(\S*[a-zA-Z]+\d+)$/o) { local($f,$x,$y)=&map2xy($1); if ($hex{$f,"reverse"} == 1) { $x=$hex{$f,"Numx"}-$x; $y=$hex{$f,"Numy"}-$y-1; } $x+=$boards{$f,"xoffset"}; $y+=$boards{$f,"yoffset"}; $y-- if ($y & 01) == 1; printf STDERR "page %d\n",$Pnumber if ($printnums); &dopage($x,$y,$a4NUMX,$a4NUMY,*boards,*hex,*map); $Pnumber++; } else { print STDERR "print command format error:$_\n"; $error=1; } } print "%%Trailer\n"; printf "%%Pages: %d\n",$Pnumber-1; print "end\n"; print "restore\n"; } sub dopages { local($startx,$starty,$endx,$endy,*boards,*hex,*map)=@_; local($nx,$ny,$i,$j); for ($i=$startx; $i<$endx; $i+=($a4NUMX-1)) { $nx=$endx-$i; $nx=$a4NUMX if $nx>$a4NUMX; next if $nx < 2; for ($j=$starty; $j<$endy; $j+=($a4NUMY-1)) { $ny=$endy-$j; $ny=$a4NUMY if $ny>$a4NUMY; printf STDERR "page $Pnumber\n" if ($printnums); &dopage($i,$j,$nx,$ny,*boards,*hex,*map); $Pnumber++; } } } sub dopage { local($sx,$sy,$lx,$ly,*boards,*hex,*map)=@_; local($i,$r,$j,@a,$x,$y,$_,$f,$xx,$yy,$Xx,$Yy,$X); local($fx,$fy,$tx,$ty,$rot,%B,%C,%ovr,$mx,$my); # $sy-- if ($sy&1); %B=%C=(); #print STDERR "sx=$sx,sy=$sy,lx=$lx,ly=$ly\n"; for ($y=0; $y<$ly+1; $y++) { for ($x=0; $x<$lx+1; $x++) { ($i,$j)=($x+$sx,$y+$sy); next if !defined($map{$i,$j}); foreach (split(/\s+/,$map{$i,$j})) { ($f,$xx,$yy)=split(/,/); $C{$f,"xmin"}=$xx if $C{$f,"xmin"}>$xx || !defined($C{$f,"xmin"}); $C{$f,"xmax"}=$xx if $C{$f,"xmax"}<$xx; $C{$f,"ymin"}=$yy if $C{$f,"ymin"}>$yy || !defined($C{$f,"ymin"}); $C{$f,"ymax"}=$yy if $C{$f,"ymax"}<$yy; $B{$f}.= "$xx,$yy "; } } } &dobp; foreach (keys %B) { @a=sort(split(/\s/,$B{$_})); %ovr=(); ($x,$y)=&xyloc( $boards{$_,"xoffset"}-$sx,$boards{$_,"yoffset"}-$sy); $x-=$Dx if ($sy&1); print "gsave $x $y translate\n"; #print STDERR "$_:@a\n"; $fx=($C{$_,"xmin"}+1)*$Dx*2; $fy=$C{$_,"ymin"}*($D+$Dy)+$Dy; $tx=($C{$_,"xmax"}+1)*$Dx*2; $ty=($C{$_,"ymax"}+0)*($D+$Dy)+$Dy; print <<"EOF"; newpath $fx $fy moveto $fx $ty lineto $tx $ty lineto $tx $fy lineto closepath gsave $ColBackground fill grestore clip gsave newpath EOF if ($hex{$_,"reverse"}) { $x=$hex{$_,"Numx"}+1; $y=$hex{$_,"Numy"}; print "$x $Dx 2 mul mul $y $D $Dy add mul $D 2 div sub translate 180 rotate\n"; foreach $i (reverse @a) { ($xx,$yy)=split(/,/,$i); $Xx=$hex{$_,"Numx"}-$xx-1; $Yy=$hex{$_,"Numy"}-$yy-1; if (defined($overlay{$_,$Xx,$Yy})) { $ovr{$overlay{$_,$Xx,$Yy}}=1; } else { &dohex($Xx,$Yy,$hex{$_,$Xx,$Yy}); } } } else { foreach $i (@a) { ($xx,$yy)=split(/,/,$i); if (defined($overlay{$_,$xx,$yy})) { $ovr{$overlay{$_,$xx,$yy}}=1; } else { &dohex($xx,$yy,$hex{$_,$xx,$yy}); } } } foreach $i (keys %ovr) { $x=$hex{$i,'Xshift'}; $y=$hex{$i,'Yshift'}; $rot=$hex{$i,'rotate'}; printf "gsave %d %d translate\n",&xyloc($x,$y); print <<"EOF"; $Dx $Dy $D 2 div add translate $rot 60 mul rotate -$Dx -$D 2 div translate EOF $mx=$hex{$i,"MaxX"}; $my=$hex{$i,"MaxY"}; local($z,$x1,$y1)=&map2xy($hex{$i,'Hex1'}); for ($y=0; $y<=$my; $y++) { $X=0; $X=-1 if ($y1 & 1) && !($y & 1); for ($x=0; $x<=$mx; $x++) { if (defined($hex{$i,$x,$y})) { &dohex($x-$x1+$X,$y-$y1,$hex{$i,$x,$y}); } } } print "grestore\n"; } foreach $i (split(/\s/,$hex{$_,"goto"})) { ($xx,$yy,$f)=split(/;/,$i); # next if $B{$_} !~ /$xx,$yy /; &dohex($xx,$yy,$f); } print "0 0 moveto\n"; printf "(%s) %d %d %d HEXes\n",$hex{$_,"Name"},$hex{$_,"Numx"}, $hex{$_,"Numx"},$hex{$_,"Numy"}; foreach $i (split(/#/,$hex{$_,"unit"})) { ($xx,$yy)=split(/;/,$i); next if $B{$_} !~ /$xx,$yy /; &dounit(split(/;/,$i)); } print "grestore 0 setgray 0 setlinewidth stroke grestore\n"; } &doend(); } sub openfile { local(*FD,$name)=@_; local($a,@a); return(1) if (open(FD,"<$mapdir/$name")); return(0) if( $MacPerl'Version ); # macs can't unzip on the fly return(0) unless (defined($list_tar_file)); if ($#ltar < $[) { @ltar=`$list_tar_file`; grep(chop,@ltar); } @a=grep(/^$name$/,@ltar); return(0) unless ($#a == $[); $delete_file=$a[0]; print STDERR "extracting $a[0]\n"; system("$get_tar_file '$a[0]'"); open(FD,"<$a[0]") || return(0); return(1); } &main(); exit($error);