I lied again:
> The perl scripts that generated the ball are attached. The ball.pl
> script spits out the .ac file, while balltex.pl generates the texture
> Postscript in a very similar manner to the gauge stuff I posted
> earlier. Pass it an argument of north/south/east/west/top/bottom to
> tell it which texture to generate.
Oops.
Andy
--
Andrew J. Ross NextBus Information Systems
Senior Software Engineer Emeryville, CA
[EMAIL PROTECTED] http://www.nextbus.com
"Men go crazy in conflagrations. They only get better one by one."
- Sting (misquoted)
#!/usr/bin/perl -w
use strict;
# Output gadget
sub ac { print join("\n", @_), "\n"; }
# Axis contstants.
my ($X, $Y, $Z) = (1, 2, 3);
# How big?
my $RADIUS = 0.075; # grapefruit
# How many squares across is a face?
my $N = 4;
# Base coordinates. These should really be done differently. A
# better mechanism would be to arrive at each point as the center of
# two "parents" rather than assuming linearity over the square.
my @XCOORDS = ();
my @YCOORDS = ();
for(my $i=0; $i<=$N; $i++) {
$XCOORDS[$i] = 2 * $i/$N - 1;
$YCOORDS[$i] = 2 * $i/$N - 1;
}
# Initialize the "P" array of points for a cube face in a single
# coordinate system. We'll get the others by swapping and inverting axes.
my @P = ();
for(my $i=0; $i<=$N; $i++) {
for(my $j=0; $j<=$N; $j++) {
my $x = $XCOORDS[$j];
my $y = $YCOORDS[$i];
my $z = 1;
my $norm = $RADIUS/sqrt($x*$x + $y*$y + $z*$z);
$x *= $norm;
$y *= $norm;
$z *= $norm;
$P[$i]->[$j] = [$x, $y, $z];
}
}
ac "AC3Db";
ac 'MATERIAL "BallSurface" rgb 1 1 1 amb 0.2 0.2 0.2 emis 0 0 0 spec 0.5 0.5 0.5
shi 10 trans 0';
ac "OBJECT world";
# The directions specified are the directions displayed *on* the
# faces, not the directions of the faces from the center of the cube
# (that is, the south-facing cube face says "north".
ac "kids 6";
doface("north", $Y, $Z, $X);
doface("south", -$Y, $Z, -$X);
doface("east", $X, $Z, -$Y);
doface("west", -$X, $Z, $Y);
doface("top", $Y, -$X, $Z);
doface("bottom", $Y, $X, -$Z);
########################################################################
########################################################################
########################################################################
sub sgn { shift() < 0 ? -1 : 1 }
sub doface {
my $name = shift;
my $xidx = shift;
my $yidx = shift;
my $zidx = shift;
# Extract the signs and correct the indices
my $xsgn = sgn($xidx); $xidx = abs($xidx);
my $ysgn = sgn($yidx); $yidx = abs($yidx);
my $zsgn = sgn($zidx); $zidx = abs($zidx);
my @idxtmp = ();
$idxtmp[$xidx] = $xsgn * 1;
$idxtmp[$yidx] = $ysgn * 2;
$idxtmp[$zidx] = $zsgn * 3;
$xidx = $idxtmp[1];
$yidx = $idxtmp[2];
$zidx = $idxtmp[3];
$xsgn = sgn($xidx); $xidx = abs($xidx) - 1;
$ysgn = sgn($yidx); $yidx = abs($yidx) - 1;
$zsgn = sgn($zidx); $zidx = abs($zidx) - 1;
# Object header
ac "OBJECT poly";
ac "name \"$name\"";
ac "texture \"$name.rgb\"";
# Print out the vertex list
my $numvert = ($N+1)*($N+1);
ac "numvert $numvert";
for(my $i=0; $i<=$N; $i++) {
for(my $j=0; $j<=$N; $j++) {
my $p = $P[$i]->[$j];
my $x = $xsgn * $p->[$xidx];
my $y = $ysgn * $p->[$yidx];
my $z = $zsgn * $p->[$zidx];
# Final complication: plib's AC3D loader munges the axes.
ac sprintf("%.4f %.4f %.4f", $x, $z, -$y);
}
}
# And now a triangle list. This is identical across faces.
# The vertex indices go left to right, then bottom to top:
# 12 13 14 15
# 8 9 10 11
# 4 5 6 7
# 0 1 2 3
my $numsurf = 2*$N*$N;
ac "numsurf $numsurf";
for(my $i=0; $i<$N; $i++) {
for(my $j=0; $j<$N; $j++) {
# Vertex indices (bottom/top, left/right)
my $bl = ($N+1)*$i + $j;
my $br = ($N+1)*$i + ($j+1);
my $tl = ($N+1)*($i+1) + $j;
my $tr = ($N+1)*($i+1) + ($j+1);
# Texture coordinates
my $texb = sprintf "%.3f", $i / $N;
my $text = sprintf "%.3f", ($i+1) / $N;
my $texl = sprintf "%.3f", $j / $N;
my $texr = sprintf "%.3f", ($j+1) / $N;
if($i+$j & 0x01) {
# Bottom right triangle
ac "SURF 0x10";
ac "mat 0";
ac "refs 3";
ac "$bl $texl $texb";
ac "$br $texr $texb";
ac "$tr $texr $text";
# Top left triangle
ac "SURF 0x10";
ac "mat 0";
ac "refs 3";
ac "$tr $texr $text";
ac "$tl $texl $text";
ac "$bl $texl $texb";
} else {
# Bottom left triangle
ac "SURF 0x10";
ac "mat 0";
ac "refs 3";
ac "$tl $texl $text";
ac "$bl $texl $texb";
ac "$br $texr $texb";
# Top right triangle
ac "SURF 0x10";
ac "mat 0";
ac "refs 3";
ac "$br $texr $texb";
ac "$tr $texr $text";
ac "$tl $texl $text";
}
}
}
ac "kids 0";
}
#!/usr/bin/perl -w
use strict;
# Contstants
my ($X, $Y, $Z) = (1, 2, 3);
my $DEG2RAD = 3.14159265358979323846/180;
# This is the "out" axis for a given face, based on the X/Y/Z
# constants. Negative means what you think it does.
my $arg = shift or die "NO FACE ARGUMENT SPECIFIED";
my $FACE;
if ($arg eq "north") { $FACE = $X; }
elsif($arg eq "south") { $FACE = -$X; }
elsif($arg eq "east") { $FACE = -$Y; }
elsif($arg eq "west") { $FACE = $Y; }
elsif($arg eq "top") { $FACE = $Z; }
elsif($arg eq "bottom") { $FACE = -$Z; }
else { die "BAD FACE ARGUMENT"; }
initface();
drawglobe();
ps("showpage");
########################################################################
########################################################################
########################################################################
# Gadgets
sub ps { print((join " ", @_), "\n"); }
sub darkcolor { ps "0.15 0.15 0.15 setrgbcolor"; }
sub lightcolor { ps "0.7 1.0 1.0 setrgbcolor"; }
sub max { $_[0] > $_[1] ? $_[0] : $_[1] }
##
# Converts a lat/lon coordinate into a 2D X/Y coordinate in the
# current face, as defined by FACE. May return undef for points
# that are not projectable onto the current face.
#
sub latlon2face {
my ($lat, $lon) = @_;
$lat *= $DEG2RAD;
$lon *= $DEG2RAD;
my @p = (cos($lon) * cos($lat),
-sin($lon) * cos($lat),
sin($lat));
# There is no valid projection for points on the other side of the
# globe. We have to special case this to prevent them from being
# "mirrored" onto this side.
my $faceCoord = $p[abs($FACE) - 1];
if($faceCoord == 0 or $faceCoord * $FACE < 0) { return undef; }
my ($tx, $ty);
if($FACE == $X) { $tx = $p[1]; $ty = $p[2]; }
if($FACE == -$X) { $tx = -$p[1]; $ty = $p[2]; }
if($FACE == $Y) { $tx = -$p[0]; $ty = $p[2]; }
if($FACE == -$Y) { $tx = $p[0]; $ty = $p[2]; }
if($FACE == $Z) { $tx = $p[1]; $ty = -$p[0]; }
if($FACE == -$Z) { $tx = $p[1]; $ty = $p[0]; }
my $norm = 1/abs($faceCoord);
$tx *= $norm;
$ty *= $norm;
return [$tx, $ty];
}
##
# Draws a great-circle arc on the current face in lat/lon space.
#
sub drawarc {
my ($lat0, $lon0, $lat1, $lon1) = @_;
# Pick a number of subdivisions to get at most 1/2 degree line
# segments.
my $dist = max(abs($lat1 - $lat0), abs($lon1 - $lon0));
my $n = int($dist * 2 + 0.99);
# Generate a list of vertices in "face space"
my @verts = ();
for(my $i=0; $i<=$n; $i++) {
my $frac = $i/$n;
my $lat = $lat0 + $frac * ($lat1 - $lat0);
my $lon = $lon0 + $frac * ($lon1 - $lon0);
push @verts, latlon2face($lat, $lon);
}
# Draw the line segments that make sense
drawverts(@verts);
}
##
# Draws a latitude-aligned (i.e. *not* great circle) arc centered at
# the specified point. The width is in absolute degrees.
#
sub drawtic {
my ($lat, $lon, $wid) = @_;
my $n = int(2 * $wid + 0.99);
my @verts = ();
my $wfactor = 1/cos($lat*$DEG2RAD);
for(my $i=0; $i<=$n; $i++) {
my $frac = $i/$n - 0.5;
push @verts, latlon2face($lat, $frac * $wid * $wfactor + $lon);
}
drawverts(@verts);
}
##
# Takes a list of points (as returned by latlon2face) and draws them.
# The list may legally include points not inside the face, or
# undefined points.
#
sub drawverts {
for(my $i=1; $i<@_; $i++) {
my $a = $_[$i-1];
my $b = $_[$i];
next if ! defined $a;
next if ! defined $b;
if(inside($a) or inside($b)) {
my ($ax, $ay) = @$a;
my ($bx, $by) = @$b;
ps "newpath $ax $ay moveto $bx $by lineto stroke";
}
}
}
##
# Returns true if the point lies inside the valid face area (the
# square from [-1:1])
#
sub inside {
my ($x, $y) = @{$_[0]};
if($x < -1.01 or $x > 1.01) { return 0; }
if($y < -1.01 or $y > 1.01) { return 0; }
return 1;
}
##
# Initializes the Postscript state and draws the background colors
#
sub initface {
# Get to where we want. Draw the whole thing in a 1 inch square at
# the bottom left of the "page".
ps "36 36 scale";
ps "1 1 translate";
# Fill with sky
lightcolor();
ps "-1 -1 moveto";
ps "-1 1 lineto 1 1 lineto 1 -1 lineto";
ps "closepath";
ps "fill";
# Draw the ground
darkcolor();
if($FACE == -$Z) {
# bottom
ps "-1 -1 moveto";
ps "-1 1 lineto 1 1 lineto 1 -1 lineto";
ps "closepath";
ps "fill";
} elsif($FACE != $Z) {
# north/south/east/west
ps "-1 -1 moveto";
ps "-1 0 lineto 1 0 lineto 1 -1 lineto";
ps "closepath";
ps "fill";
}
}
sub putletter {
my ($c, $lat, $lon, $hgt, $wid) = @_;
my $loc = latlon2face($lat, $lon);
return if ! defined $loc;
return if ! inside $loc;
my ($x, $y) = @$loc;
$wid *= $hgt;
$x -= $wid/2;
ps "/Helvetica-Bold findfont $hgt scalefont setfont";
lightcolor();
ps "newpath $x $y moveto";
ps $x, $y+$hgt, "lineto";
ps $x+$wid, $y+$hgt, "lineto";
ps $x+$wid, $y, "lineto";
ps "closepath fill";
darkcolor();
ps "$x $y moveto";
ps "($c) show";
}
sub drawglobe {
ps "0.015 setlinewidth";
for(my $lon=0; $lon<360; $lon+=30) {
# Big vertical guide lines
my $top = ($lon % 90 == 0) ? 85 : 60;
darkcolor();
drawarc($top, $lon, 0, $lon);
lightcolor();
drawarc(-$top, $lon, 0, $lon);
# A big tic at 45 degrees
darkcolor();
drawtic(45, $lon, 15.9);
lightcolor();
drawtic(-45, $lon, 15.9);
# 10 degree ticks
for(my $lat=10; $lat<=80; $lat+=10) {
my $wid = 22.5;
if($lat % 30 == 0) { $wid *= sin(30*$DEG2RAD); }
else { $wid *= sin(10*$DEG2RAD); }
darkcolor();
drawtic($lat, $lon, $wid);
lightcolor();
drawtic(-$lat, $lon, $wid);
}
}
# Note hand-collected font metrics. Eeew.
putletter("N", 1, 0, 0.2, 0.722);
putletter("S", 1, 180, 0.2, 0.667);
putletter("E", 1, 270, 0.2, 0.667);
putletter("W", 1, 90, 0.2, 0.944);
}
