September Morn Update
This commit is contained in:
Ingy döt Net
parent
4e2d22a71d
commit
aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
1
Task/Sierpinski-triangle-Graphical/00META.yaml
Normal file
1
Task/Sierpinski-triangle-Graphical/00META.yaml
Normal file
|
|
@ -0,0 +1 @@
|
|||
--- {}
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
USING: accessors images images.loader kernel literals math
|
||||
math.bits math.functions make sequences ;
|
||||
IN: rosetta-code.sierpinski-triangle-graphical
|
||||
|
||||
CONSTANT: black B{ 33 33 33 255 }
|
||||
CONSTANT: white B{ 255 255 255 255 }
|
||||
CONSTANT: size $[ 2 8 ^ ] ! edit 8 to change order
|
||||
|
||||
! Generate Sierpinksi's triangle sequence. This is sequence
|
||||
! A001317 in OEIS.
|
||||
|
||||
: sierpinski ( n -- seq )
|
||||
[ [ 1 ] dip [ dup , dup 2 * bitxor ] times ] { } make nip ;
|
||||
|
||||
! Convert a number to binary, then append a black pixel for each
|
||||
! set bit or a white pixel for each unset bit to the image being
|
||||
! built by make.
|
||||
|
||||
: expand ( n -- ) make-bits [ black white ? % ] each ;
|
||||
|
||||
! Append white pixels until the end of the row in the image
|
||||
! being built by make.
|
||||
|
||||
: pad ( n -- ) [ size ] dip 1 + - [ white % ] times ;
|
||||
|
||||
! Generate the image data for a sierpinski triangle of a given
|
||||
! size in pixels. The image is square so its dimensions are
|
||||
! n x n.
|
||||
|
||||
: sierpinski-img ( n -- seq )
|
||||
sierpinski [ [ [ expand ] dip pad ] each-index ] B{ } make ;
|
||||
|
||||
: main ( -- )
|
||||
<image>
|
||||
${ size size } >>dim
|
||||
BGRA >>component-order
|
||||
ubyte-components >>component-type
|
||||
size sierpinski-img >>bitmap
|
||||
"sierpinski-triangle.png" save-graphic-image ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
use Game.SDL2;
|
||||
use Game.Framework;
|
||||
|
||||
class Test {
|
||||
@framework : GameFramework;
|
||||
@colors : Color[];
|
||||
@step : Int;
|
||||
|
||||
function : Main(args : String[]) ~ Nil {
|
||||
Test->New()->Run();
|
||||
}
|
||||
|
||||
New() {
|
||||
@framework := GameFramework->New(GameConsts->SCREEN_WIDTH, GameConsts->SCREEN_HEIGHT, "Sierpinski Triangle");
|
||||
@framework->SetClearColor(Color->New(0,0,0));
|
||||
@colors := Color->New[1];
|
||||
@colors[0] := Color->New(178,34,34);
|
||||
}
|
||||
|
||||
method : Run() ~ Nil {
|
||||
if(@framework->IsOk()) {
|
||||
e := @framework->GetEvent();
|
||||
|
||||
quit := false;
|
||||
while(<>quit) {
|
||||
# process input
|
||||
while(e->Poll() <> 0) {
|
||||
if(e->GetType() = EventType->SDL_QUIT) {
|
||||
quit := true;
|
||||
};
|
||||
};
|
||||
|
||||
@framework->FrameStart();
|
||||
@framework->Clear();
|
||||
Render(8, 20, 20, 450);
|
||||
@framework->Show();
|
||||
@framework->FrameEnd();
|
||||
};
|
||||
}
|
||||
else {
|
||||
"--- Error Initializing Environment ---"->ErrorLine();
|
||||
return;
|
||||
};
|
||||
|
||||
leaving {
|
||||
@framework->Quit();
|
||||
};
|
||||
}
|
||||
|
||||
method : Render(level : Int, x : Int, y : Int, size : Int) ~ Nil {
|
||||
if(level > -1) {
|
||||
renderer := @framework->GetRenderer();
|
||||
|
||||
renderer->LineColor(x, y, x+size, y, @colors[0]);
|
||||
renderer->LineColor(x, y, x, y+size, @colors[0]);
|
||||
renderer->LineColor(x+size, y, x, y+size, @colors[0]);
|
||||
|
||||
Render(level-1, x, y, size/2);
|
||||
Render(level-1, x+size/2, y, size/2);
|
||||
Render(level-1, x, y+size/2, size/2);
|
||||
};
|
||||
}
|
||||
}
|
||||
|
||||
consts GameConsts {
|
||||
SCREEN_WIDTH := 640,
|
||||
SCREEN_HEIGHT := 480
|
||||
}
|
||||
|
|
@ -1,34 +1,33 @@
|
|||
my $side = 512;
|
||||
my $height = get_height($side);
|
||||
my $levels = 8;
|
||||
my $side = 512;
|
||||
my $height = get_height($side);
|
||||
|
||||
sub get_height ($side) { $side * 3.sqrt / 2 }
|
||||
|
||||
sub triangle ( $x1, $y1, $x2, $y2, $x3, $y3, $fill?, $animate? ) {
|
||||
print "<polygon points=\"$x1,$y1 $x2,$y2 $x3,$y3\"";
|
||||
if $fill { print " style=\"fill: $fill; stroke-width: 0;\"" };
|
||||
if $animate
|
||||
{
|
||||
say ">\n <animate attributeType=\"CSS\" attributeName=\"opacity\"\n values=\"1;0;1\""
|
||||
~ " keyTimes=\"0;.5;1\" dur=\"20s\" repeatCount=\"indefinite\" />\n</polygon>"
|
||||
}
|
||||
else
|
||||
{
|
||||
say ' />';
|
||||
}
|
||||
my $svg;
|
||||
$svg ~= qq{<polygon points="$x1,$y1 $x2,$y2 $x3,$y3"};
|
||||
$svg ~= qq{ style="fill: $fill; stroke-width: 0;"} if $fill;
|
||||
$svg ~= $animate
|
||||
?? qq{>\n <animate attributeType="CSS" attributeName="opacity"\n values="1;0;1" keyTimes="0;.5;1" dur="20s" repeatCount="indefinite" />\n</polygon>}
|
||||
!! ' />';
|
||||
return $svg;
|
||||
}
|
||||
|
||||
sub fractal ( $x1, $y1, $x2, $y2, $x3, $y3, $r is copy ) {
|
||||
triangle( $x1, $y1, $x2, $y2, $x3, $y3 );
|
||||
return unless --$r;
|
||||
my $side = abs($x3 - $x2) / 2;
|
||||
my $height = get_height($side);
|
||||
fractal( $x1, $y1-$height*2, $x1-$side/2, $y1-3*$height, $x1+$side/2, $y1-3*$height, $r);
|
||||
fractal( $x2, $y1, $x2-$side/2, $y1-$height, $x2+$side/2, $y1-$height, $r);
|
||||
fractal( $x3, $y1, $x3-$side/2, $y1-$height, $x3+$side/2, $y1-$height, $r);
|
||||
my $svg;
|
||||
$svg ~= triangle( $x1, $y1, $x2, $y2, $x3, $y3 );
|
||||
return $svg unless --$r;
|
||||
my $side = abs($x3 - $x2) / 2;
|
||||
my $height = get_height($side);
|
||||
$svg ~= fractal( $x1, $y1-$height*2, $x1-$side/2, $y1-3*$height, $x1+$side/2, $y1-3*$height, $r);
|
||||
$svg ~= fractal( $x2, $y1, $x2-$side/2, $y1-$height, $x2+$side/2, $y1-$height, $r);
|
||||
$svg ~= fractal( $x3, $y1, $x3-$side/2, $y1-$height, $x3+$side/2, $y1-$height, $r);
|
||||
}
|
||||
|
||||
say '<?xml version="1.0" standalone="no"?>
|
||||
my $fh = open('sierpinski_triangle.svg', :w) orelse .die;
|
||||
$fh.print: qq:to/EOD/,
|
||||
<?xml version="1.0" standalone="no"?>
|
||||
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
|
||||
<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg">
|
||||
<defs>
|
||||
|
|
@ -37,10 +36,11 @@ say '<?xml version="1.0" standalone="no"?>
|
|||
<stop offset="60%" stop-color="#f00" />
|
||||
<stop offset="99%" stop-color="#00f" />
|
||||
</radialGradient>
|
||||
</defs>';
|
||||
</defs>
|
||||
EOD
|
||||
|
||||
triangle( $side/2, 0, 0, $height, $side, $height, 'url(#basegradient)' );
|
||||
triangle( $side/2, 0, 0, $height, $side, $height, '#000', 'animate' );
|
||||
say '<g style="fill: #fff; stroke-width: 0;">';
|
||||
fractal( $side/2, $height, $side*3/4, $height/2, $side/4, $height/2, $levels );
|
||||
say '</g></svg>';
|
||||
triangle( $side/2, 0, 0, $height, $side, $height, 'url(#basegradient)' ),
|
||||
triangle( $side/2, 0, 0, $height, $side, $height, '#000', 'animate' ),
|
||||
'<g style="fill: #fff; stroke-width: 0;">',
|
||||
fractal( $side/2, $height, $side*3/4, $height/2, $side/4, $height/2, $levels ),
|
||||
'</g></svg>';
|
||||
|
|
|
|||
|
|
@ -1,29 +1,48 @@
|
|||
use List::Util qw'min max sum';
|
||||
my $levels = 6;
|
||||
my $side = 512;
|
||||
my $height = get_height($side);
|
||||
|
||||
sub write_eps {
|
||||
my @x = @_[0, 2, 4];
|
||||
my @y = @_[1, 3, 5];
|
||||
my $sx = sum(@x) / 3;
|
||||
my $sy = sum(@y) / 3;
|
||||
@x = map { $_ - $sx } @x;
|
||||
@y = map { $_ - $sy } @y;
|
||||
sub get_height { my($side) = @_; $side * sqrt(3) / 2 }
|
||||
|
||||
print <<"HEAD";
|
||||
%!PS-Adobe-3.0
|
||||
%%BoundingBox: @{[min(@x) - 10]} @{[min(@y) - 10]} @{[max(@x) + 10]} @{[max(@y) + 10]}
|
||||
/v1 { $x[0] $y[0] } def /v2 { $x[1] $y[1] } def /v3 { $x[2] $y[2] } def
|
||||
/t { translate } def
|
||||
/r { .5 .5 scale 2 copy t 2 index sierp pop neg exch neg exch t 2 2 scale } def
|
||||
|
||||
/sierp { dup 1 sub dup 0 ne
|
||||
{ v1 r v2 r v3 r }
|
||||
{ v1 moveto v2 lineto v3 lineto} ifelse
|
||||
pop
|
||||
} def
|
||||
|
||||
9 sierp fill pop showpage
|
||||
%%EOF
|
||||
HEAD
|
||||
sub triangle {
|
||||
my($x1, $y1, $x2, $y2, $x3, $y3, $fill, $animate) = @_;
|
||||
my $svg;
|
||||
$svg .= qq{<polygon points="$x1,$y1 $x2,$y2 $x3,$y3"};
|
||||
$svg .= qq{ style="fill: $fill; stroke-width: 0;"} if $fill;
|
||||
$svg .= $animate
|
||||
? qq{>\n <animate attributeType="CSS" attributeName="opacity"\n values="1;0;1" keyTimes="0;.5;1" dur="20s" repeatCount="indefinite" />\n</polygon>\n}
|
||||
: ' />';
|
||||
return $svg;
|
||||
}
|
||||
|
||||
write_eps 0, 0, 300, 215, -25, 200;
|
||||
sub fractal {
|
||||
my( $x1, $y1, $x2, $y2, $x3, $y3, $r ) = @_;
|
||||
my $svg;
|
||||
$svg .= triangle( $x1, $y1, $x2, $y2, $x3, $y3 );
|
||||
return $svg unless --$r;
|
||||
my $side = abs($x3 - $x2) / 2;
|
||||
my $height = get_height($side);
|
||||
$svg .= fractal( $x1, $y1-$height*2, $x1-$side/2, $y1-3*$height, $x1+$side/2, $y1-3*$height, $r);
|
||||
$svg .= fractal( $x2, $y1, $x2-$side/2, $y1-$height, $x2+$side/2, $y1-$height, $r);
|
||||
$svg .= fractal( $x3, $y1, $x3-$side/2, $y1-$height, $x3+$side/2, $y1-$height, $r);
|
||||
}
|
||||
|
||||
open my $fh, '>', 'run/sierpinski_triangle.svg';
|
||||
print $fh <<'EOD',
|
||||
<?xml version="1.0" standalone="no"?>
|
||||
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
|
||||
<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg">
|
||||
<defs>
|
||||
<radialGradient id="basegradient" cx="50%" cy="65%" r="50%" fx="50%" fy="65%">
|
||||
<stop offset="10%" stop-color="#ff0" />
|
||||
<stop offset="60%" stop-color="#f00" />
|
||||
<stop offset="99%" stop-color="#00f" />
|
||||
</radialGradient>
|
||||
</defs>
|
||||
EOD
|
||||
|
||||
triangle( $side/2, 0, 0, $height, $side, $height, 'url(#basegradient)' ),
|
||||
triangle( $side/2, 0, 0, $height, $side, $height, '#000', 'animate' ),
|
||||
'<g style="fill: #fff; stroke-width: 0;">',
|
||||
fractal( $side/2, $height, $side*3/4, $height/2, $side/4, $height/2, $levels ),
|
||||
'</g></svg>';
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
$ include "seed7_05.s7i";
|
||||
include "draw.s7i";
|
||||
include "keybd.s7i";
|
||||
include "bin64.s7i";
|
||||
|
||||
const proc: main is func
|
||||
local
|
||||
|
|
@ -15,7 +16,7 @@ const proc: main is func
|
|||
KEYBOARD := GRAPH_KEYBOARD;
|
||||
for y range 0 to pred(width) do
|
||||
for x range 0 to pred(width) do
|
||||
if bitset conv x & bitset conv y = bitset.value then
|
||||
if bin64(x) & bin64(y) = bin64(0) then
|
||||
point(margin + x, margin + y, black);
|
||||
end if;
|
||||
end for;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue