Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: e2a61927e7
Fetching contributors…

Cannot retrieve contributors at this time

132 lines (115 sloc) 3.771 kb
use v6;
use Num :Trig;
sub header {
'<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg
xmlns="http://www.w3.org/2000/svg"
width="500"
height="500">
'
}
sub polygon($color, @coords) {
qq[ <path
style="fill:$color;stroke:none"
d="] ~ pathspec(@coords) ~ '" />
'
}
sub pathspec(@coords) {
die "Need an even number of coords, got {+@coords}"
if @coords % 2;
return [~]
'M ',
(join ' L ', map -> $x, $y { sprintf '%.3f,%.3f', $x, $y }, @coords),
' z';
}
sub footer {
'</svg>
'
}
sub project(@coords3d, $camera-distance) {
die "Number of coords must be multiple of 3, got {+@coords3d}"
if @coords3d % 3;
return map -> $x,$y,$z {
my $t = $camera-distance / ($camera-distance - $z);
$x*$t, $y*$t
}, @coords3d;
}
sub translate(@coords, $dx, $dy) {
return map -> $x,$y { $x+$dx, $y+$dy }, @coords;
}
sub scale(@coords, $fx, $fy = $fx) {
return map -> $x,$y { $x*$fx, $y*$fx }, @coords;
}
sub rot-x(@coords3d, $deg) {
my $rad = $deg * pi / 180;
return map -> $x,$y,$z {
$x, $y*cos($rad)-$z*sin($rad), $y*sin($rad)+$z*cos($rad)
}, @coords3d;
}
sub rot-z(@coords3d, $deg) {
my $rad = $deg * pi / 180;
return map -> $x,$y,$z {
$x*cos($rad)-$y*sin($rad), $x*sin($rad)+$y*cos($rad), $z
}, @coords3d;
}
sub translate3d(@coords3d, $dx, $dy, $dz) {
die "Number of coords must be multiple of 3, got {+@coords3d}"
if @coords3d % 3;
return map -> $x,$y,$z { $x+$dx, $y+$dy, $z+$dz }, @coords3d;
}
sub block($color, @one-corner, @other-corner) {
my ($x1,$y1,$z1) = @one-corner;
my ($x2,$y2,$z2) = @other-corner;
my $c = $color.substr(1);
my $brighter-color = [~] '#', map { sprintf '%x', :16($_)+3 }, $c.comb;
my $darker-color = [~] '#', map { sprintf '%x', :16($_)-3 }, $c.comb;
# RAKUDO: Multi-arg return
return [
$darker-color, [$x1,$y2,$z1, $x1,$y2,$z2, $x2,$y2,$z2, $x2,$y2,$z1],
$color, [$x1,$y1,$z1, $x1,$y1,$z2, $x1,$y2,$z2, $x1,$y2,$z1],
$brighter-color, [$x1,$y1,$z2, $x1,$y2,$z2, $x2,$y2,$z2, $x2,$y1,$z2],
].list;
}
sub board {
return
map -> $y {
map -> $x {
block('#999999', [$x+.025,$y+.025,-.25], [$x+.975,$y+.975,0])
}, (^8).reverse
}, ^8;
}
sub piece($color, $row, $column, $height) {
return block(($color eq 'black' ?? '#553333' !! '#aaaacc'),
[$column-1,8-$row,$height-1],
[$column, 9-$row,$height ]);
}
my @heights = map { [ map { 0 }, ^8 ] }, ^8;
my @pieces = map {
[
<black white>.pick()[0],
(my $row = (1..8).pick()[0]),
(my $column = (1..8).pick()[0]),
++@heights[$row-1][$column-1]
]
}, ^25;
@pieces.=sort: -> $p1, $p2 {
my ($c1, $ro1, $co1, $h1, $c2, $ro2, $co2, $h2) = $p1.list, $p2.list;
my ($x1, $y1, $z1, $x2, $y2, $z2)
= $co1-.5, 8.5-$ro1, $h1-.5, $co2-.5, 8.5-$ro2, $h2-.5;
my @center-board = translate3d([$x1,$y1,$z1,$x2,$y2,$z2], -4, -4, 0);
my @rotated-coords3d = rot-x(rot-z(@center-board, -25), 45);
$h1 <=> $h2 || .[2] <=> .[5] given @rotated-coords3d;
};
print header;
for board,
(@pieces.map: { my ($c, $ro, $co, $h) = .list; piece($c, $ro, $co, $h) })
-> $color, @coords3d {
my @center-board = translate3d(@coords3d, -4, -4, 0);
my @rotated-coords3d = rot-x(rot-z(@center-board, -25), 45);
my @move-board-back = translate3d(@rotated-coords3d, 0, 0, -20);
my @projected-coords = project(@move-board-back, 1);
my @scaled-coords = scale(@projected-coords, 700);
my @coords2d = translate(@scaled-coords, 250, 250);
print polygon($color, @coords2d);
}
print footer;
Jump to Line
Something went wrong with that request. Please try again.