pax_global_header 0000666 0000000 0000000 00000000064 11654211675 0014522 g ustar 00root root 0000000 0000000 52 comment=b4875371a44bd67e7632e3cbb1c138dc19e9e9f6
.gitignore 0000664 0000000 0000000 00000000013 11654211675 0013050 0 ustar 00root root 0000000 0000000 /_manpages
Changelog 0000664 0000000 0000000 00000005230 11654211675 0012700 0 ustar 00root root 0000000 0000000 dizzy 0.3 - Wed Nov 2 10:47:57 2011 +0100
* update to SDL.pm 2.5+ API
* re-enable shader rendering on Mesa versions that have the compiler
bug fixed
dizzy 0.2 - Tue Mar 2 20:59:46 2010 +0100
Changes since 0.1.1:
Main features:
* new textures and animations
* integration with XScreenSaver
* render performance improvements:
GPU: support Shaders for high-resolution textures and fast blending
CPU: cache rendered textures to save time on future runs
* progress bar on loading
Other cool stuff:
* replace -s (scale) with more user friendly -z/--zoom option
* increase default zoom level
* raise default texture size to 256x256 for higher quality textures
Internals:
* switch from GLUT to SDL
dizzy 0.1.96 - Thu Feb 25 14:04:18 2010 +0100
* switch to SDL
* add a progress bar while loading
* change render aspect ratio on resizing
* actually use the cached texture data
dizzy 0.1.95 - Mon Jan 18 13:57:04 2010 +0100
* implement different rotator functions
* zoom the textures on the planes independently
* raise default texture size to 256x256
* optimize rendering for 16:10 resolutions
* move XScreenSaver XS bindings to OpenGL::XScreenSaver module
* new texture "Airy"
dizzy 0.1.94 - Tue Jan 5 20:48:05 2010 +0100
* fix texture switching via cursor keys
* tweaks to the XScreenSaver integration
dizzy 0.1.93 - Mon Jan 4 19:29:38 2010 +0100
* basic XScreenSaver support
* code refactoring
dizzy 0.1.92 - Sun Oct 25 02:37:57 2009 +0200
* write textures to the cache dir automatically
* replace -s with -z/--zoom option, which takes a user-friendly percentage
value
* rewrote the build system
dizzy 0.1.91 - Mon Oct 19 02:28:13 2009 +0200
* cache rendered textures to speed up program start
* add two new textures: Holegrid and Egg
* extensions to the Perl to GLSL converter
dizzy 0.1.90 - Thu Oct 15 16:07:41 2009 +0200
* texture blending using shaders, automatically selected if available
* texture rendering using shaders, using framebuffer objects
* automatic runtime conversion of Perl texture definitions to GLSL
dizzy 0.1.1 - Mon Sep 21 20:56:45 2009 +0200
* Added META.yml
* Added description of keybindings to documentation
* add 'q' key as alias for escape (to exit)
dizzy 0.1.0 - Sun Sep 20 18:47:26 2009 +0200
* rotating planes with patterns that can make you dizzy
* 15 textures included
* textures can be switched manually or automatically by a timer
* they can be crossfaded to create a smooth transition
* view can be zoomed to look good on non-average (XGA) render sizes
INSTALL 0000664 0000000 0000000 00000001410 11654211675 0012113 0 ustar 00root root 0000000 0000000 You need:
- perl 5.10.0 or higher
- OpenGL 0.58 or higher '
abstract: a graphics demo that makes you dizzy using rotating textures
license: perl
resources:
license: http://dev.perl.org/licenses/
requires:
Convert::Color: 0
OpenGL: 0.58
OpenGL::XScreenSaver: 0.04
SDL: 0
perl: v5.10.0
configure_requires:
File::Find::Rule: 0
File::Copy::Recursive: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
dizzy 0000775 0000000 0000000 00000016412 11654211675 0012171 0 ustar 00root root 0000000 0000000 #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use lib 'lib';
use OpenGL qw(:all);
use SDL 2.5 qw(:init);
use SDL::Video;
use SDL::Surface;
use SDL::Event;
use SDL::Events;
use Math::Trig;
use Time::HiRes qw(sleep time);
use Dizzy::Handlers;
use Dizzy::Core;
use Dizzy::GLFeatures;
my %options = Dizzy::Core::init_arguments();
sub do_resize {
my ($w, $h) = @_;
# set default resolutions:
if (!$w or !$h) {
if ($options{fullscreen}) {
# no specific resolution for fullscreen mode
$w = $h = 0;
} else {
# 800x500 for windowed mode
($w, $h) = (800, 500);
}
}
my $surf = SDL::Video::set_video_mode($w, $h, 0,
SDL_OPENGL() |
SDL_HWSURFACE() |
SDL_RESIZABLE() |
($options{fullscreen} ? SDL_FULLSCREEN() : 0));
if (!$surf) {
print STDERR "fatal: SDL Error: " . SDL::get_error() . "\n";
exit(1);
}
# find out actual new window size and reset projection
($w, $h) = ($surf->w, $surf->h);
glViewport(0, 0, $w, $h);
Dizzy::Render::init_projection($w / $h);
}
# initialize OpenGL
# (returns 0 on success, therefore "and", not "or")
SDL::init(SDL_INIT_VIDEO()) and die(SDL::get_error());
SDL::Video::wm_set_caption("Dizzy", "");
SDL::Video::GL_set_attribute(SDL_GL_DOUBLEBUFFER(), 1) and die(SDL::get_error());
do_resize($options{width}, $options{height});
if ($options{fullscreen}) {
SDL::Mouse::show_cursor(0);
}
Dizzy::Handlers::register_last(
render => sub {
Dizzy::Core::_fps_tick();
Dizzy::Handlers::GO_ON;
},
'exit' => sub {
my $ev = SDL::Event->new();
$ev->type(SDL_QUIT());
SDL::Events::push_event($ev);
Dizzy::Handlers::GO_ON;
},
);
Dizzy::GLFeatures::update_capabilities();
# prepare for progress screen
glClearColor(0.0, 0.0, 0.0, 0.0);
glClear(GL_COLOR_BUFFER_BIT);
glLoadIdentity();
# initialize dizzy subsystems
Dizzy::Core::init_subsystems(%options,
callback_texture_load => sub {
my %args = @_;
# if window is resized while displaying the progress bar, handle that
my $event = SDL::Event->new();
while (SDL::Events::poll_event($event)) {
my $type = $event->type();
if ($type == SDL_QUIT()) {
print STDERR "warning: exiting during initialization\n";
exit(2);
} elsif ($type == SDL_VIDEORESIZE()) {
do_resize($event->resize_w(), $event->resize_h());
}
}
glClear(GL_COLOR_BUFFER_BIT);
# bar background
glColor3f((0.125) x 3);
glRectf(-2.0, +0.0625, +2.0, -0.125);
# bar itself
glColor3f((1.0) x 3);
glRectf(-2.0, +0.0625, -2.0 + 4.0 * ($args{current} / $args{total}), -0.125);
glFlush();
SDL::Video::GL_swap_buffers();
},
);
if ($options{debug_time_startup}) {
print "debug: startup complete, exiting as requested\n";
exit(0);
}
my $event = SDL::Event->new();
while (1) {
if (SDL::Events::poll_event($event)) {
my $type = $event->type();
if ($type == SDL_QUIT()) {
exit(0);
} elsif ($type == SDL_KEYDOWN()) {
my $keysym = $event->key_sym();
my $k;
if ($keysym == SDLK_LEFT()) {
$k = "LEFT";
} elsif ($keysym == SDLK_RIGHT()) {
$k = "RIGHT";
} elsif ($keysym == SDLK_DOWN()) {
$k = "DOWN";
} elsif ($keysym == SDLK_UP()) {
$k = "UP";
} elsif ($keysym == SDLK_ESCAPE()) {
$k = "\e";
} elsif ($keysym == SDLK_q()) {
$k = "q";
} else {
$k = "OTHER:$keysym";
}
Dizzy::Handlers::invoke("keyboard", key => $k);
} elsif ($type == SDL_VIDEORESIZE()) {
do_resize($event->resize_w(), $event->resize_h());
}
}
Dizzy::Handlers::invoke("render");
glFlush();
SDL::Video::GL_swap_buffers();
}
__END__
=head1 NAME
B - a graphics demo that makes you dizzy using rotating textures
=head1 SYNOPSIS
B [B<-f>|B<-w> I B<-h> I] [B<-t> I] [B<-T> I]
=head1 DESCRIPTION
B is a graphics demo that rotates planes of patterns on a colored
background to make you dizzy. Textures can be cross-faded and there is a mode
that automatically changes textures, allowing Dizzy to be run as a screensaver.
=head1 OPTIONS
=over
=item B<-w> I
=item B<--width> I
=item B<-h> I
=item B<--height> I
Sets the window width and height.
=item B<-f>
=item B<--fullscreen>
Attempts to switch into a true fullscreen mode, if possible. The window size
parameters are ignored.
=item B<-a>
=item B<--automode> I
Automatically switches textures after a specified number of seconds has passed.
I can be fractional and the decimal separator is always the period.
=item B<-t> I
=item B<--texswitcher> I
Selects the texture switching module to use. Default is B.
See below for available texture switchers and their descriptions.
=item B<-T> I=I
=item B<--texswitcher-options> I=I
Passes an option I with the value I to the selected texture
switcher. The available options depend on the texture switcher used.
This option can be given multiple times to set multiple options.
=item B<-d> I
=item B<--rotswitcher> I
Selects the rotator switching module to use. Default is B.
See below for available texture switchers and their descriptions.
=item B<-D> I=I
=item B<--rotswitcher-options> I=I
Passes an option I with the value I to the selected rotator
switcher. The available options depend on the rotator switcher used.
This option can be given multiple times to set multiple options.
=item B<-r> I
=item B<--texture-resolution> I
Changes the texture resolution. I must be a power of two. The default
value is 256.
=item B<-R> I
=item B<--shader-resolution> I
Changes the resolution used when rendering using shaders. I must be
a power of two. The default is 1024.
=item B<-z> I
=item B<--zoom> I
Zooms the textures. The default value is 100.
=item B<-c> I
=item B<--cache-paths> I
Use a different path for cached textures. This option can be specified multiple
times.
=item B<-C>
=item B<--disable-cache>
Don't use any texture cache at all.
=item B<--debug-show-planes>
Zooms out of the normal view so you can see how Dizzy creates the animation. A
white border will also be drawn around the area that would have been shown had
this option not been used.
=back
=head1 TEXTURE SWITCHERS
=head2 Simple
A simple texture switcher. It just sets the new texture when it is told to do
so. It takes no options.
=head2 Blend
A texture switcher that crossfades between textures to generate a smooth
transition. It takes one option:
=over
=item B=I
Sets the duration of a blend to I seconds. The value can be fractional
(the decimal separator is always a period). The default value is 2.
Note that you have to add the time you specify here to the automode time, so if
you want the transition to take two seconds and every image to stay for five
seconds, you set the duration to 2 and automode to 7 (not 5).
=back
=head1 ROTATOR SWITCHERS
=head2 Simple
A simple switcher that just activates the new rotator without any transition.
=head1 KEYBOARD COMMANDS
=over
=item Cursor left
Select previous available texture.
=item Cursor right
Select next available texture.
=item Cursor down
Select previous available rotator function.
=item Cursor up
Select next available rotator function.
=item Escape
=item q
Exit Dizzy.
=back
=cut
dizzy-render 0000775 0000000 0000000 00000006042 11654211675 0013444 0 ustar 00root root 0000000 0000000 #!/usr/bin/env perl
use strict;
use warnings;
use B::Deparse;
use Digest::SHA qw(sha1_hex);
use File::Path qw(make_path);
use Time::HiRes qw(time);
use lib 'lib';
use Dizzy::Textures;
use Getopt::Long qw(:config no_ignore_case bundling);
use Pod::Usage;
my %options = (
help => 0, man => 0,
resolution => 256,
output_path => "/var/cache/dizzy/textures",
);
GetOptions(\%options,
'help|?',
'man',
'resolution|r=i',
'output_path|output-path|o=s',
) or pod2usage(2);
pod2usage(1) if $options{help};
pod2usage(-exitstatus => 0, -verbose => 2) if $options{man};
my @textures = Dizzy::Textures::textures();
my @tbr = @ARGV;
# create the path first
print STDERR "seeding texture cache in $options{output_path}\n";
make_path($options{output_path});
# render all textures or the ones specified
foreach my $texture (@textures) {
next if (@tbr and not grep { $_ eq $texture->{name} } @tbr);
my $hash = sha1_hex(B::Deparse->new()->coderef2text($texture->{function}));
my $fn = "$hash-$texture->{name}-$options{resolution}";
print STDERR "rendering $fn " . " " x (16 + 70 - length($fn));
open(my $outfile, ">", "$options{output_path}/$fn");
my ($t_s, $t_e);
$t_s = time();
for (my $y = 0; $y < $options{resolution}; $y++) {
print STDERR sprintf("%s(line %4d/%4d)", "\b" x 16, $y, $options{resolution}) if (!($y % 16));
my $val;
for (my $x = 0; $x < $options{resolution}; $x++) {
$val = $texture->{function}->($x / $options{resolution} - 0.5, $y / $options{resolution} - 0.5);
print $outfile pack("f", $val);
}
}
$t_e = time();
print STDERR sprintf("%s(line %4d/%2\$4d) in %.2fs\n", "\b" x 16, $options{resolution}, $t_e - $t_s);
close($outfile);
}
__END__
=head1 NAME
B - seed a directory with cached texture files
=head1 SYNOPSIS
B B<-o> I B<-r> I [I]
=head1 DESCRIPTION
B can be used to preseed a directory with cached textures.
Why an extra tool, if Dizzy can do this itself? Well, people might want to
generate textures in the installation script of a distro package, where it's
unlikely or at least unwanted that an X11 program spawns to render textures.
=head1 OPTIONS
=over
=item B<-o> I
=item B<--output-path> I
Dump the textures to this directory. The directory will be created if it does
not exist. The default value is F.
=item B<-r> I
=item B<--resolution> I
Sets the resolution at which the textures will be rendered. The default value
is 256, just like Dizzy's default resolution.
=back
The options can be followed by a list of I. If there are any such
I specified, only textures with these names will be rendered.
=head1 CAVEATS
This tool cannot make use of GLSL shaders to speed up rendering. But on the
other hand, the cache files are not portable, and there is no need to generate
them on a GLSL supporting machine.
This is not even recommended, as performance tests have shown GLSL rendering
to be much faster than loading the textures from disk for high resolutions.
=cut
dizzy-xscreensaver 0000775 0000000 0000000 00000002402 11654211675 0014671 0 ustar 00root root 0000000 0000000 #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use lib 'lib';
use OpenGL qw(:all);
use OpenGL::XScreenSaver 0.04;
use Math::Trig;
use Time::HiRes qw(sleep time);
use Dizzy::Handlers;
use Dizzy::Core;
use Dizzy::GLFeatures;
# parse XSS options
OpenGL::XScreenSaver::init();
# now we can parse the standard options
my %options = Dizzy::Core::init_arguments();
# initialize OpenGL
if (!OpenGL::XScreenSaver::start()) {
print STDERR "dizzy-xscreensaver: XLIB error, dying\n";
exit(1);
}
Dizzy::GLFeatures::update_capabilities();
# initialize dizzy subsystems
Dizzy::Core::init_subsystems(%options);
# main loop
my ($w, $h) = (0, 0);
my ($nw, $nh);
while (1) {
($nw, $nh) = OpenGL::XScreenSaver::dimensions();
if ($nw != $w or $nh != $h) {
($w, $h) = ($nw, $nh);
Dizzy::Render::init_projection($w / $h);
}
Dizzy::Handlers::invoke("render");
OpenGL::XScreenSaver::update();
}
__END__
=head1 NAME
B - XScreenSaver compliant variant of dizzy
=head1 SYNOPSIS
B [I]
=head1 DESCRIPTION
For a description of what Dizzy is and what options it takes, refer to the
L manpage.
This program is a version of Dizzy that can be used as a XScreenSaver hack. It
is not designed to be run directly by users.
=cut
dizzy.xml 0000664 0000000 0000000 00000001535 11654211675 0012765 0 ustar 00root root 0000000 0000000
install_dizzy 0000775 0000000 0000000 00000014552 11654211675 0013722 0 ustar 00root root 0000000 0000000 #!/usr/bin/env perl
use strict;
use warnings;
use Config;
use File::Find::Rule;
use File::Copy::Recursive qw(fcopy);
use Getopt::Long qw(:config no_ignore_case bundling);
use Pod::Man;
# files to be installed
my %files = (
bin => [ "dizzy" ],
sbin => [ "dizzy-render" ],
lib => [ File::Find::Rule->file()->name("*.pm")->in("lib") ],
man => [ ], # filled by manpage generator
);
my %man_sources = (
6 => { "dizzy" => "dizzy" },
8 => { "dizzy-render" => "dizzy-render" },
);
my %options = (
dry_run => 0,
install_xscreensaver => 0,
set => "site",
prefix => undef,
install_root => "",
bin_path => undef,
sbin_path => undef,
lib_path => undef,
man_path => undef,
xss_lib_path => "/usr/lib/xscreensaver",
xss_share_path => "/usr/share/xscreensaver",
);
GetOptions(\%options,
'dry_run|dry-run|n+',
'install_xscreensaver|install-xscreensaver|X+',
'set=s',
'prefix=s',
'install_root|install-root=s',
'bin_path|bin-path=s',
'sbin_path|sbin-path=s',
'lib_path|lib-path=s',
'man_path|man-path=s',
'xss_lib_path|xss-lib-path=s',
'xss_share_path|xss-share-path=s',
);
# fill in the paths that were not overridden by user
if (defined($options{prefix})) {
$options{bin_path} //= "$options{prefix}/bin";
$options{sbin_path} //= "$options{prefix}/sbin";
$options{lib_path} //= "$options{prefix}/share/perl5";
$options{man_path} //= "$options{prefix}/share/man";
} else {
die("Argument to --set must be site or vendor") if ($options{set} !~ /^(site|vendor)$/);
$options{bin_path} //= $Config{"install$options{set}bin"};
if (!defined($options{sbin_path})) {
$options{sbin_path} = $Config{"install$options{set}bin"};
$options{sbin_path} =~ s{/bin$}{/sbin};
}
$options{lib_path} //= $Config{"install$options{set}lib"};
if (!defined($options{man_path})) {
$options{man_path} = $Config{"install$options{set}man1dir"};
$options{man_path} =~ s{/man1$}{};
}
}
# generate manpages
print STDERR "Generating manpages... ";
mkdir("_manpages") unless ($options{dry_run});
foreach my $section (keys(%man_sources)) {
mkdir("_manpages/man$section") unless ($options{dry_run});
while (my ($in, $out) = each(%{$man_sources{$section}})) {
Pod::Man
->new(section => $section)
->parse_from_file($in, "_manpages/man$section/$out.$section")
unless ($options{dry_run});
push(@{$files{man}}, "_manpages/man$section/$out.$section");
}
}
print STDERR "done.\n";
# now actually install the files
sub install {
my ($in, $out) = @_;
$in =~ s@/+@/@g;
$out =~ s@/+@/@g;
printf("%-40s -> %s\n", $in, $out);
if ($options{dry_run}) {
return 1;
} else {
fcopy($in, $out) or die("Couldn't install to $out: $! - installation aborted");
}
}
# prefixes to be stripped from input file names before appending them to install dirs.
my %install_prefixes = (
bin => "^.*/",
sbin => "^.*/",
lib => "^lib/",
man => "^_manpages/",
);
foreach my $set (keys(%files)) {
foreach my $from (@{$files{$set}}) {
my $to = $from; $to =~ s@$install_prefixes{$set}@@;
install($from, $options{install_root} . "/" . $options{$set . "_path"} . "/" . $to);
}
}
if ($options{install_xscreensaver}) {
install("dizzy-xscreensaver", "$options{install_root}/$options{xss_lib_path}/dizzy");
install("dizzy.xml", "$options{install_root}/$options{xss_share_path}/config/dizzy.xml");
}
if ($options{dry_run}) {
print STDERR "Dry run complete, now run without -n to install files.\n";
} else {
print STDERR "All files installed successfully.\n";
}
exit(0);
__END__
=head1 NAME
B - Dizzy's configuration and installation script
=head1 SYNOPSIS
B [B<-n>] [B<--set> I] [B<--install-root> I] ...
=head1 DESCRIPTION
B is the tool that is used to install Dizzy. The motivation for
using this self-written script instead of something existing could best be
described as "special needs" (or "laziness"). At least it works.
When run, the tool will generate manpages from embedded POD and install
libraries, binaries, and manpages to the system.
See the options described below for controlling the location Dizzy will be
installed (by default, this is something like /usr/local).
=head1 OPTIONS
=over
=item B<-n>
=item B<--dry-run>
Don't actually install anything, just print what would be done.
=item B<-X>
=item B<--install-xscreensaver>
Install the XScreenSaver version of Dizzy. It will by default be installed to
F and not to something specified by B<--prefix> because
XScreenSaver only looks in that folder. Override with B<--xss-path> if necessary.
=item B<--set> I
Set default install paths according to what L thinks about this set.
Typically, I means something like F and I means something
like F. The default is I.
=item B<--prefix> I
Set default install paths to be under I. This will install binaries to
F, superuser binaries to F, libraries to F,
and manpages to F, unless overridden by one of the five B<--*-path>
options.
=item B<--install-root> I
Prefix I to all paths that will be written to. This is useful for scripts
of package managers, which install software into a directory and then pack this
directory. Example: F (will create
F and so on.) This option is
unset by default, which means all files will be installed into the system.
=item B<--bin-path> I
=item B<--sbin-path> I
=item B<--lib-path> I
=item B<--man-path> I
=item B<--xss-lib-path> I
=item B<--xss-share-path> I
Set different install paths for some elements. I specifies where
the F binary is installed, I for F, I
for all the modules under F and I for all documentation.
I is the location where the XScreenSaver version is installed if
B<-X> is given. The default values for these options are specified by the B<--set>
or B<--prefix> options, the default for I is F
and that for I is F.
A sensible value for I might be F.
=back
=head1 EXAMPLE
A command line like this is used in Debian build scripts:
./install_dizzy --set vendor --bin-path /usr/games --install-root ./debian/dizzy --install-xscreensaver
lib/ 0000775 0000000 0000000 00000000000 11654211675 0011634 5 ustar 00root root 0000000 0000000 lib/Dizzy/ 0000775 0000000 0000000 00000000000 11654211675 0012745 5 ustar 00root root 0000000 0000000 lib/Dizzy/Core.pm 0000664 0000000 0000000 00000013316 11654211675 0014177 0 ustar 00root root 0000000 0000000 package Dizzy::Core;
use strict;
use warnings;
use 5.010;
use Getopt::Long qw(:config no_ignore_case bundling);
use OpenGL qw(:all);
use Time::HiRes qw(sleep time);
use Dizzy::Handlers;
use Dizzy::GLFeatures;
use Dizzy::GLText;
use Dizzy::Render;
use Dizzy::TextureManager;
use Dizzy::TextureSwitcher;
use Dizzy::Textures;
use Dizzy::RotatorManager;
use Dizzy::RotatorSwitcher;
use Dizzy::Rotators;
my ($fps_starttime, $fps_frames, $fps_text, $fps_fps) = (time(), 0, "", 0);
sub _fps_reset {
$fps_starttime = time();
$fps_frames = 0;
}
sub _fps_update_value {
$fps_fps = $fps_frames / (time() - $fps_starttime);
}
sub _fps_update_text {
$fps_text = sprintf("%5.1f FPS (%5.3fs avg)",
$fps_fps, time() - $fps_starttime);
}
sub _fps_display {
my $color;
if ($fps_fps > 25) {
$color = [0, 1, 0];
} elsif ($fps_fps > 15) {
$color = [1 - ($fps_fps - 15) / 10, 1, 0];
} elsif ($fps_fps > 5) {
$color = [1, ($fps_fps - 5) / 10, 0];
} else {
$color = [1, 0, 0];
}
Dizzy::GLText::render_text(10, 10, $color, "test", $fps_text);
}
sub _fps_tick {
$fps_frames++;
_fps_display();
if (time() - $fps_starttime > 0.25) {
_fps_update_value();
_fps_update_text();
_fps_reset();
}
}
sub usage_message {
print STDERR << "EOH";
usage: dizzy [options]
Graphics settings:
-w num set window width
-h num set window height
-f run in fullscreen mode
-r num set texture resolution (power of two)
-R num set shader texture resolution
-z num set texture zoom
-c path set texture cache path
-C disable usage of the texture cache
Auto mode:
-a num set a new texture every num seconds
Texture switching options:
-t switcher choose the texture switcher
-T opt=val pass options to the texture switcher
Rotator switching options:
-d switcher choose the rotator switcher
-D opt=val pass options to the rotator switcher
Keyboard commands:
cursor left select previous texture
cursor right select next texture
cursor down select previous rotator
cursor up select next rotator
escape exit dizzy
EOH
}
sub init_arguments {
# default cache paths
my $user_cache_root = $ENV{XDG_CACHE_HOME} || "$ENV{HOME}/.cache";
my @default_cache_paths = (
"/var/cache/dizzy/textures",
"$user_cache_root/dizzy/textures"
);
my %options = (
help => sub { usage_message(); exit(0); },
width => 0,
height => 0,
fullscreen => 0,
texture_resolution => 256,
shader_resolution => 1024,
zoom => 100,
cache_paths => \@default_cache_paths,
cache_disable => 0,
automode => 0,
texswitcher => 'Simple',
texswitcher_options => {},
rotswitcher => 'Simple',
rotswitcher_options => {},
);
GetOptions(\%options,
'help|?',
'width|w=i',
'height|h=i',
'fullscreen|f+',
'texture_resolution|texture-resolution|r=i',
'shader_resolution|shader-resolution|R=i',
'zoom|z=f',
'cache_paths|cache-paths|c=s',
'cache_disable|disable-cache|C+',
'automode|a=f',
'texswitcher|t=s',
'texswitcher_options|texswitcher-options|T=s',
'rotswitcher|d=s',
'rotswitcher_options|rotswitcher-options|D=s',
'debug_show_planes|debug-show-planes+',
'debug_time_startup|debug-time-startup+',
) or (usage_message(), exit(1));
return %options;
}
sub init_subsystems {
my %options = @_;
Dizzy::Render::init(texture_scale => 4000 / $options{zoom}, debug_show_planes => $options{debug_show_planes});
# initialize textures
Dizzy::TextureManager::init(
texture_resolution => $options{texture_resolution},
shader_resolution => $options{shader_resolution},
cache_paths => [reverse(@{$options{cache_paths}})],
cache_disable => $options{cache_disable},
);
my @textures = Dizzy::Textures::textures();
foreach my $tex (0..$#textures) {
print STDERR sprintf("Loading textures (%d/%d)\r", $tex + 1, scalar(@textures));
if ($options{callback_texture_load}) {
$options{callback_texture_load}->(current => $tex, total => scalar(@textures));
}
Dizzy::TextureManager::add(%{$textures[$tex]});
}
Dizzy::TextureSwitcher::init(
$options{texswitcher},
%{$options{texswitcher_options}},
);
# initialize rotator functions
Dizzy::RotatorManager::init();
Dizzy::RotatorManager::add(%{$_}) foreach (Dizzy::Rotators::rotators());
Dizzy::RotatorSwitcher::init(
$options{rotswitcher},
%{$options{rotswitcher_options}},
);
Dizzy::Handlers::register(
keyboard => sub {
my %args = @_;
# so we don't get warning spam
if ($args{key} eq "\e" or $args{key} eq "q") { # escape/q
Dizzy::Handlers::invoke("exit");
} elsif ($args{key} eq "LEFT" or $args{key} eq "RIGHT") {
Dizzy::Handlers::invoke("texture_switch",
direction => (($args{key} eq "LEFT") ? -1 : +1),
);
} elsif ($args{key} eq "UP" or $args{key} eq "DOWN") {
Dizzy::Handlers::invoke("rotator_switch",
direction => (($args{key} eq "DOWN") ? -1 : +1),
);
}
Dizzy::Handlers::GO_ON;
},
# notify user about texture switches
texture_changed => sub {
my %args = @_;
print "*** selected texture \"$args{name}\"\n";
},
rotator_changed => sub {
my %args = @_;
print "*** selected rotator \"$args{name}\"\n";
},
# auto texture changing mode
render => sub {
state $last_switch = 0;
if ($options{automode} > 0) {
if ($last_switch + $options{automode} <= time()) {
$last_switch = time();
Dizzy::Handlers::invoke("texture_switch", direction => +1);
}
}
Dizzy::Handlers::GO_ON;
},
);
Dizzy::TextureManager::set(0);
}
1;
lib/Dizzy/GLFeatures.pm 0000664 0000000 0000000 00000002641 11654211675 0015307 0 ustar 00root root 0000000 0000000 package Dizzy::GLFeatures;
use strict;
use warnings;
use OpenGL qw(glpCheckExtension glGetString GL_VENDOR GL_RENDERER GL_VERSION);
# cached capabilities
my %capabilities;
sub update_capabilities {
$capabilities{glsl} = !glpCheckExtension("GL_ARB_shading_language_100");
$capabilities{fbo} = !glpCheckExtension("GL_EXT_framebuffer_object");
if (has_mesa_shader_bug()) {
print "warning: MESA library < 7.9 detected, disabling shaders for texture rendering.\n";
print " (details: )\n";
}
# override the detected values, if forced to do so by user
if (exists($ENV{FORCE_CAP_GLSL})) {
$capabilities{glsl} = $ENV{FORCE_CAP_GLSL};
print "note: forcefully overriding GLSL capability\n";
}
printf("GPU features: [%s] GLSL [%s] FBOs\n",
$capabilities{glsl} ? "x" : " ",
$capabilities{fbo} ? "x" : " ",
);
}
sub supports {
my $feature = shift;
return $capabilities{$feature};
}
sub is_mesa {
# work around mesa bug ()
my $gl_vendor = glGetString(GL_VENDOR);
my $gl_renderer = glGetString(GL_RENDERER);
return "$gl_vendor $gl_renderer" =~ /\bmesa\b/i;
}
sub has_mesa_shader_bug {
if (!is_mesa()) {
return 0;
}
my $gl_version = glGetString(GL_VERSION);
if ($gl_version =~ /Mesa (\d+)\.(\d+)/) {
if (($1 == 7 and $2 >= 9) or $1 > 7) {
return 0;
} else {
return 1;
}
}
}
1;
lib/Dizzy/GLText.pm 0000664 0000000 0000000 00000015367 11654211675 0014466 0 ustar 00root root 0000000 0000000 package Dizzy::GLText;
use strict;
use warnings;
use OpenGL qw(:all);
sub mc {
my ($va, $vb) = @_;
my $glyph = [[], [], [], [], [], [], [], []];
for (my $x = 31; $x >= 0; $x--) {
$glyph->[ int($x / 8)]->[$x % 8] = ($va >> $x) & 1;
$glyph->[4 + int($x / 8)]->[$x % 8] = ($vb >> $x) & 1;
}
return $glyph;
}
my %fonts = (
test => {
"" => [ # undefined symbol
[ .0, .0, .0, .6, .6, .0, .0, .0 ],
[ .0, .0, .6, .3, .3, .3, .0, .0 ],
[ .0, .6, 1., 1., 1., .3, .6, .0 ],
[ .6, 1., 1., 1., .3, .6, 1., .6 ],
[ .0, 1., 1., .6, .3, 1., 1., .3 ],
[ .0, .0, 1., 1., .6, 1., .3, .0 ],
[ .0, .0, .0, .6, .3, .3, .0, .0 ],
[ .0, .0, .0, .0, .3, .0, .0, .0 ]
],
# generated from John Hall's 8x8 bitmapped font ,
# which is "free to use for any purpose".
# converted it to a luminance-alpha RAW file using GIMP
# (1024*8*2=16384 bytes)
# and ran this perl code on it:
# my $c = 0; while (read(STDIN, $_, 2)) {
# $pixels[int($c / 8)] .= substr($_, 0, 1); $c++; $c %= 128 * 8;
# } for ($c = 0; $c < 128; $c++) {
# $va = 0; $vb = 0; for ($x = 31; $x >= 0; $x--) {
# $va = (substr($pixels[$c], $x , 1) eq "\xff" ? 0 : 1) | ($va << 1);
# $vb = (substr($pixels[$c], $x + 32, 1) eq "\xff" ? 0 : 1) | ($vb << 1);
# } printf("\"%c\" => mc(0x%08x, 0x%08x),\n", $c, $va, $vb); }
" " => mc(0x00000000, 0x00000000), "!" => mc(0x10101010, 0x00100010),
'"' => mc(0x00002828, 0x00000000), "#" => mc(0x28fe2828, 0x002828fe),
'$' => mc(0x38147810, 0x00103c50), "%" => mc(0x102c4c00, 0x00006468),
"&" => mc(0x14081418, 0x005c2262), "'" => mc(0x00001010, 0x00000000),
"(" => mc(0x08081020, 0x00201008), ")" => mc(0x20201008, 0x00081020),
"*" => mc(0x38549210, 0x00109254), "+" => mc(0xfe101010, 0x00101010),
"," => mc(0x00000000, 0x10203030), "-" => mc(0xfe000000, 0x00000000),
"." => mc(0x00000000, 0x00303000), "/" => mc(0x10204080, 0x00020408),
"0" => mc(0x54444438, 0x00384444), "1" => mc(0x10101810, 0x00381010),
"2" => mc(0x20404438, 0x007c0810), "3" => mc(0x30404438, 0x00384440),
"4" => mc(0x7c242830, 0x00702020), "5" => mc(0x3c04047c, 0x00384440),
"6" => mc(0x3c044438, 0x00384444), "7" => mc(0x1020407c, 0x00080808),
"8" => mc(0x38444438, 0x00384444), "9" => mc(0x78444438, 0x00384440),
":" => mc(0x00303000, 0x00003030), ";" => mc(0x00303000, 0x10203030),
"<" => mc(0x04081020, 0x00201008), "=" => mc(0x00fe0000, 0x000000fe),
">" => mc(0x20100804, 0x00040810), "?" => mc(0x20404438, 0x00100010),
"@" => mc(0x54744438, 0x00380474), "A" => mc(0x7c444438, 0x00444444),
"B" => mc(0x3c44443c, 0x003c4444), "C" => mc(0x04044438, 0x00384404),
"D" => mc(0x4444443c, 0x003c4444), "E" => mc(0x3c04047c, 0x007c0404),
"F" => mc(0x7c04047c, 0x00040404), "G" => mc(0x74044438, 0x00384444),
"H" => mc(0x7c444444, 0x00444444), "I" => mc(0x10101038, 0x00381010),
"J" => mc(0x20202070, 0x00182424), "K" => mc(0x1c244444, 0x00444424),
"L" => mc(0x08080808, 0x00780808), "M" => mc(0x92aac682, 0x00828282),
"N" => mc(0x54544c44, 0x00444464), "O" => mc(0x44444438, 0x00384444),
"P" => mc(0x38484838, 0x00080808), "Q" => mc(0x44444438, 0x60384444),
"R" => mc(0x3c44443c, 0x00442414), "S" => mc(0x38044438, 0x00384440),
"T" => mc(0x1010107c, 0x00101010), "U" => mc(0x44444444, 0x00384444),
"V" => mc(0x28444444, 0x00101028), "W" => mc(0x54828282, 0x00282854),
"X" => mc(0x10284444, 0x00444428), "Y" => mc(0x10284444, 0x00101010),
"Z" => mc(0x1020407c, 0x007c0408), "[" => mc(0x08080838, 0x00380808),
"\\"=> mc(0x10080402, 0x00804020), "]" => mc(0x20202038, 0x00382020),
"^" => mc(0x00442810, 0x00000000), "_" => mc(0x00000000, 0xfe000000),
"`" => mc(0x00001008, 0x00000000), "a" => mc(0x78403800, 0x00b84444),
"b" => mc(0x48380808, 0x00344848), "c" => mc(0x04380000, 0x00380404),
"d" => mc(0x48704040, 0x00b04848), "e" => mc(0x44380000, 0x0038047c),
"f" => mc(0x1c084830, 0x00080808), "g" => mc(0x44b80000, 0x38407844),
"h" => mc(0x4c340404, 0x00444444), "i" => mc(0x10001000, 0x00101010),
"j" => mc(0x10001000, 0x0c101010), "k" => mc(0x14240404, 0x0024140c),
"l" => mc(0x10101018, 0x00101010), "m" => mc(0x926d0000, 0x00828292),
"n" => mc(0x48340000, 0x00484848), "o" => mc(0x44380000, 0x00384444),
"p" => mc(0x48340000, 0x08083848), "q" => mc(0x24580000, 0x20203824),
"r" => mc(0x0c340000, 0x00040404), "s" => mc(0x04380000, 0x001c2018),
"t" => mc(0x10381000, 0x00101010), "u" => mc(0x24240000, 0x00582424),
"v" => mc(0x44440000, 0x00102844), "w" => mc(0x82820000, 0x0044aa92),
"x" => mc(0x28440000, 0x00442810), "y" => mc(0x48480000, 0x38407048),
"z" => mc(0x203c0000, 0x003c0810), "{" => mc(0x04080830, 0x00300808),
"|" => mc(0x10101010, 0x00101010), "}" => mc(0x2010100c, 0x000c1010),
"~" => mc(0x920c0000, 0x00000060),
}
);
sub _window_pos {
my ($x, $y) = @_;
# get viewport dims
my (undef, undef, $vx, $vy) = glGetIntegerv_p(GL_VIEWPORT);
return (
(2 * $x / $vx) - 1,
-(2 * $y / $vy) + 1
);
}
sub _char {
my ($glyph, $color) = @_;
my $pixels = "";
my $packed_color = pack("f3", @{$color});
# iterate over the glyph, coloring it in the progress.
for (my $gy = $#$glyph; $gy >= 0; $gy--) {
for (my $gx = 0; $gx <= $#{$glyph->[$gy]}; $gx++) {
$pixels .= $packed_color . pack("f", $glyph->[$gy]->[$gx]);
}
}
glDrawPixels_s(
scalar(@{$glyph->[0]}),
scalar(@{$glyph}),
GL_RGBA, GL_FLOAT,
$pixels);
}
sub render_text {
my ($x, $y, $color, $font, $text) = @_;
# save old state
my ($old_blend_enable, $old_blend_src, $old_blend_dst);
$old_blend_enable = glIsEnabled(GL_BLEND);
$old_blend_src = glGetIntegerv_p(GL_BLEND_SRC);
$old_blend_dst = glGetIntegerv_p(GL_BLEND_DST);
my $old_matrix = glGetIntegerv_p(GL_MATRIX_MODE);
my $old_texture_enable = glIsEnabled(GL_TEXTURE_2D);
# set blending method we need
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glDisable(GL_TEXTURE_2D);
# set a new matrix
glMatrixMode(GL_PROJECTION);
glPushMatrix();
glLoadIdentity();
glMatrixMode(GL_MODELVIEW);
glPushMatrix();
glLoadIdentity();
# draw the text
$y += scalar(@{$fonts{$font}->{" "}});
$x -= scalar(@{$fonts{$font}->{substr($text, 0, 1)}->[0]});
foreach (split(//, $text)) {
my $char;
if ($fonts{$font}->{$_}) {
$char = $_;
} else {
$char = "";
}
# draw shadow first
glRasterPos2f(_window_pos($x + 1, $y + 1));
_char($fonts{$font}->{$char}, [0, 0, 0]);
# then draw the main text
glRasterPos2f(_window_pos($x, $y));
_char($fonts{$font}->{$char}, $color);
# and move the "cursor"
$x += scalar(@{$fonts{$font}->{$char}->[0]});
}
# reset state
if (!$old_blend_enable) {
glDisable(GL_BLEND);
}
glBlendFunc($old_blend_src, $old_blend_dst);
if ($old_texture_enable) {
glEnable(GL_TEXTURE_2D);
}
glMatrixMode(GL_MODELVIEW);
glPopMatrix();
glMatrixMode(GL_PROJECTION);
glPopMatrix();
glMatrixMode($old_matrix);
}
1;
lib/Dizzy/Handlers.pm 0000664 0000000 0000000 00000001026 11654211675 0015042 0 ustar 00root root 0000000 0000000 package Dizzy::Handlers;
use strict;
use warnings;
my %handlers;
my %handlers_last;
sub GO_ON() { 1; }
sub STOP() { 0; }
sub invoke {
my ($name, @args) = @_;
my $ret;
foreach my $handler (@{$handlers{$name}}, @{$handlers_last{$name}}) {
$ret = $handler->(@args);
last if ($ret == STOP);
}
}
sub register {
while (my ($name, $code) = splice(@_, 0, 2)) {
push(@{$handlers{$name}}, $code);
}
}
sub register_last {
while (my ($name, $code) = splice(@_, 0, 2)) {
push(@{$handlers_last{$name}}, $code);
}
}
1;
lib/Dizzy/Perl2GLSL.pm 0000664 0000000 0000000 00000015172 11654211675 0014757 0 ustar 00root root 0000000 0000000 package Dizzy::Perl2GLSL;
use strict;
use warnings;
use 5.010;
use B;
sub walk_optree {
my ($op, $cv) = @_;
# gather op information
my $optype = ref($op);
$optype =~ s/^B:://;
my $opname = $op->name;
if ($optype ~~ [qw(UNOP BINOP LISTOP LOGOP)]) {
my @list = $op->name;
my $child = $op->first;
while (ref($child) ne "B::NULL") {
push(@list, walk_optree($child, $cv));
# and go on with the next one
$child = $child->sibling;
}
if ($op->name eq "null" or $op->name eq "leavesub") {
return @list[1..$#list];
} else {
return [@list];
}
} elsif ($opname eq "const") {
if ($op->sv->isa("B::SV")) {
# unthreaded perl
return ${$op->sv->object_2svref};
} else {
# threaded perl
return ${(($cv->PADLIST->ARRAY)[1]->ARRAY)[$op->targ]->object_2svref};
}
} elsif ($opname eq "gv") {
if ($op->gv->isa("B::GV")) {
# unthreaded perl
return ["glob", $op->gv->NAME, $op->gv];
} else {
# threaded perl
my $pad = (($cv->PADLIST->ARRAY)[1]->ARRAY)[$op->padix];
return ["glob", $pad->NAME, $pad];
}
} elsif ($optype eq "OP") {
if ($op->name eq "padsv") {
return "var" . $op->targ;
} elsif ($op->name eq "pushmark" or $op->name eq "null") {
return ();
} else {
return "# op description " . $op->desc;
}
} elsif ($optype eq "COP") {
return ();
}
}
# check if a trivial optimization can be applied
# if the op looks like it's been generated by code like
# my $dist = sqrt($x**2 + $y**2);
# then return 1.
sub opt_check_dist_assignment {
my ($op, $symtab) = @_;
my @op = @{$op};
return 0 if (ref($op[1]) eq ""); # RHS is scalar
return 0 if ($op[1]->[0] ne "sqrt"); # not the sqrt function
return 0 if (ref($op[1]->[1]) eq ""); # scalar in sqrt
my @arg = @{$op[1]->[1]};
return 0 if ($arg[0] ne "add"); # no addition
return 0 if (ref($arg[1]) eq "" or ref($arg[2]) eq ""); # addition with a scalar
return 0 if ($arg[1]->[0] ne "pow" or $arg[2]->[0] ne "pow"); # not adding two powers ($x**2 + $y**2)
return 0 if ($arg[1]->[2] != 2 or $arg[2]->[2] != 2); # not squaring the arguments
if ($symtab->{$arg[1]->[1]} ne "coord_x"
or $symtab->{$arg[2]->[1]} ne "coord_y") {
return 0;
}
# assume it is dist assignment
return 1;
}
# check for inline functions to be expanded
sub opt_check_inline_builtin {
my ($op, $symtab) = @_;
my @op = @{$op};
if ($op[$#op]->[1] eq "cosec") {
return '(1. / sin(@))';
} elsif ($op[$#op]->[1] =~ /^(asin|tan)$/) {
return "$1(\@)";
} else {
return undef;
}
}
sub make_code {
my ($op, $symtab, $in_sub) = @_;
$in_sub ||= 0;
# not a ref? then it's a scalar
if (ref($op) eq "") {
# turn integers into floats..
if ($op =~ /^\d+$/) {
$op .= ".";
}
return $op;
}
# else it's a subexpression
my @op = @{$op};
if ($op[0] eq "lineseq") {
# all child expressions are statements
return join(";\n", map { make_code($_, $symtab, $in_sub) } @op[1..$#op]) . ";";
} elsif ($op[0] eq "cond_expr") {
# conditional expression
return "(" . make_code($op[1], $symtab, $in_sub) . " ? " . make_code($op[2], $symtab, $in_sub) . " : " . make_code($op[3], $symtab, $in_sub) . ")";
} elsif ($op[0] eq "glob") {
return "GLOB?!";
} elsif ($op[0] eq "return") {
# return a value - behaviour depends on if we're in main() or not
if ($in_sub) {
# just return the value in question
return "return " . make_code($op[1], $symtab, $in_sub);
} else {
# assign to the fragment color and return
return "float retval = " . make_code($op[1], $symtab, $in_sub) . "; gl_FragColor = vec4(vec3(retval), 1.0)";
}
} elsif ($op[0] eq "entersub") {
# external subroutine call: last child is the sub, rest is arguments
my $code = opt_check_inline_builtin($op, $symtab);
if (defined($code)) {
# substitute the inline code and return
$code =~ s/\@/join(", ", map { make_code($_, $symtab, $in_sub) } @op[1..$#op-1])/e;
return $code;
} else {
# register the subroutine name and the associated code
$symtab->{$op[$#op]->[1]} = "subroutine code:" . perl2glsl($op[$#op]->[2]->CV, $op[$#op]->[1]);
return $op[$#op]->[1] . "(" . join(", ", map { make_code($_, $symtab, $in_sub) } @op[1..$#op-1]) . ")";
}
} elsif ($op[0] eq "sassign") {
# scalar assignment
my $allocate = defined($symtab->{$op[2]}) ? "" : "float ";
$symtab->{$op[2]} = 1;
if (opt_check_dist_assignment($op, $symtab)) {
return "$allocate$op[2] = length(gl_TexCoord[0].xy - 0.5)";
} else {
return "$allocate$op[2] = " . make_code($op[1], $symtab, $in_sub);
}
} elsif ($op[0] eq "aassign") {
# list assignment
# for now, only allow parameter assignment for this and reject everything else
if ($op[1]->[0] ne "rv2av" or ref($op[1]->[1]) ne "ARRAY" or $op[1]->[1]->[0] ne "glob" or $op[1]->[1]->[1] ne "_") {
return "ERROR";
}
if ($in_sub) {
foreach (2..$#op) {
$symtab->{$op[$_]} = "argument_" . ($_ - 2);
}
return "1";
} else {
$symtab->{$op[2]} = "coord_x";
$symtab->{$op[3]} = "coord_y";
return "float $op[2] = gl_TexCoord[0].x - 0.5; float $op[3] = gl_TexCoord[0].y - 0.5";
}
} elsif ($op[0] =~ /^(add|subtract|multiply|divide|[lg][te])$/) {
my $operator = {
add => "+", subtract => "-", multiply => "*", divide => "/",
"lt" => "<", "gt" => ">", "le" => "<=", "ge" => ">=",
}->{$op[0]};
return "(" . make_code($op[1], $symtab, $in_sub) . " $operator " . make_code($op[2], $symtab, $in_sub) . ")";
} elsif ($op[0] eq "negate") {
return "-(" . make_code($op[1], $symtab, $in_sub) . ")";
} elsif ($op[0] ~~ [qw(sqrt sin cos pow log abs)]) {
# builtin functions
return "$op[0](" . join(", ", map { make_code($_, $symtab, $in_sub) } @op[1..$#op]) . ")";
} else {
return "UNKNOWN_$op[0]_OP";
}
}
sub perl2glsl {
my ($coderef, $in_sub) = @_;
$in_sub ||= 0;
# generate an optree suitable for further processing - if needed
my $cv;
if (ref($coderef) ne "B::CV") {
$cv = B::svref_2object($coderef);
} else {
$cv = $coderef;
}
my $tree = walk_optree($cv->ROOT, $cv);
# walk the optree, generating code out of it
my $symtab = {};
my $code = make_code($tree, $symtab, $in_sub);
# get any subroutine definitions out and prepend them to the shader code
my $subdefs = join("\n", map { /^subroutine code:(.*)$/s } grep { /^subroutine code:/ } values(%{$symtab}));
# now if we've been generating code for a subroutine, generate the parameter list
if ($in_sub) {
my @params = sort { $symtab->{$a} cmp $symtab->{$b} } grep { $symtab->{$_} =~ /^argument_/ } keys(%{$symtab});
return "float $in_sub(float " . join(", float ", @params) . ") { $code }\n";
} else {
return $subdefs . "void main() { $code }\n";
}
}
1;
lib/Dizzy/Render.pm 0000664 0000000 0000000 00000005250 11654211675 0014524 0 ustar 00root root 0000000 0000000 package Dizzy::Render;
use strict;
use warnings;
use OpenGL qw(:all);
use Math::Trig;
use Time::HiRes qw(sleep time);
use Convert::Color;
use Convert::Color::HSV;
use Dizzy::RotatorManager;
my $debug_show_planes;
my $tex_scale;
sub set_color_from_hsv {
my ($h, $v, $s) = @_;
glColor3f(Convert::Color::HSV->new($h * 360, $s, $v)->rgb());
}
sub render_planes {
my %args = @_;
my $tick = $args{tick};
glClear(GL_COLOR_BUFFER_BIT);
glLoadIdentity();
set_color_from_hsv(
($tick * 0.2) - int($tick * 0.2),
cos($tick) * 0.125 + 0.5,
0.5);
foreach my $plane (1, 2) {
glPushMatrix();
if ($debug_show_planes) {
glScalef(0.2, 0.2, 0.2);
}
glMatrixMode(GL_TEXTURE);
foreach my $tex (GL_TEXTURE1, GL_TEXTURE0) {
glActiveTextureARB($tex);
glLoadIdentity();
glScalef(($tex_scale * 0.3 ** (0.75 + 0.25 * sin(($plane == 1 ? 0.4 : 0.3 ) * $tick))) x 3);
}
glMatrixMode(GL_MODELVIEW);
$args{rotator_func}->($tick, $plane);
glBegin(GL_QUADS);
glMultiTexCoord2fARB(GL_TEXTURE0_ARB, 0, 0);
glMultiTexCoord2fARB(GL_TEXTURE1_ARB, 0, 0);
glVertex2f(-8, -8);
glMultiTexCoord2fARB(GL_TEXTURE0_ARB, 0, 1);
glMultiTexCoord2fARB(GL_TEXTURE1_ARB, 0, 1);
glVertex2f(-8, 8);
glMultiTexCoord2fARB(GL_TEXTURE0_ARB, 1, 1);
glMultiTexCoord2fARB(GL_TEXTURE1_ARB, 1, 1);
glVertex2f( 8, 8);
glMultiTexCoord2fARB(GL_TEXTURE0_ARB, 1, 0);
glMultiTexCoord2fARB(GL_TEXTURE1_ARB, 1, 0);
glVertex2f( 8, -8);
glEnd();
glPopMatrix();
}
}
sub handler_render {
render_planes(
tick => time() - $^T,
rotator_func => Dizzy::RotatorManager::current(),
);
Dizzy::Handlers::GO_ON;
}
sub init_projection {
my $aspect = $_[0] || 1.6;
my $old_matrix = glGetIntegerv_p(GL_MATRIX_MODE);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
if ($aspect >= 1.0) {
glOrtho(-3.2, 3.2, -3.2 / $aspect, 3.2 / $aspect, 1, -1);
} else {
glOrtho(-3.2 * $aspect, 3.2 * $aspect, -3.2, 3.2, 1, -1);
}
glMatrixMode($old_matrix);
}
sub init {
my %args = @_;
# initialize GL view
glClearColor(0.0, 0.0, 0.0, 0.0);
init_projection(1.6);
glEnable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE);
# render handler registration
$debug_show_planes = $args{debug_show_planes};
$tex_scale = $args{texture_scale};
Dizzy::Handlers::register(
render => \&handler_render
);
if ($debug_show_planes) {
Dizzy::Handlers::register_last(render => sub {
glLineWidth(3);
glColor4f(1.0, 1.0, 1.0, 1.0);
my ($xe, $ye) = (3.2 * 0.2, 2.0 * 0.2);
glBegin(GL_LINE_STRIP);
glVertex2f( $xe, $ye);
glVertex2f(-$xe, $ye);
glVertex2f(-$xe, -$ye);
glVertex2f( $xe, -$ye);
glVertex2f( $xe, $ye);
glEnd();
Dizzy::Handlers::GO_ON;
});
}
}
1;
lib/Dizzy/RotatorManager.pm 0000664 0000000 0000000 00000003017 11654211675 0016231 0 ustar 00root root 0000000 0000000 package Dizzy::RotatorManager;
use strict;
use warnings;
use OpenGL qw(:all);
use Time::HiRes qw(sleep time);
use Dizzy::Handlers;
my @rotators;
my $current_rotator_id = 0;
sub add {
my %args = @_;
push(@rotators, \%args);
return $#rotators;
}
sub set {
my ($id) = @_;
Dizzy::Handlers::invoke("rotator_switch",
old_rotator => $current_rotator_id,
new_rotator => $id,
);
}
sub current {
return $rotators[$current_rotator_id]->{function};
}
# -----------------------------------------------------------------------------
# some handlers
# transforms a texture walk request (such as one triggered by cursor keys) into
# something that we all understand: a renderable GL texture ID.
sub handler_walking {
my %args = @_;
if (exists($args{direction})) {
# find out about the next texture
my $id = $current_rotator_id + $args{direction};
$id += @rotators;
$id %= @rotators;
set($id);
return Dizzy::Handlers::STOP;
} else {
return Dizzy::Handlers::GO_ON;
}
}
# this event serves to tell texman that the texture has now changed.
# it is essentially like texture_switch, but this one is needed for texblend
# to work.
sub handler_switched {
my %args = @_;
$current_rotator_id = $args{new_rotator};
Dizzy::Handlers::invoke("rotator_changed",
name => $rotators[$current_rotator_id]->{name},
);
Dizzy::Handlers::STOP;
}
sub init {
my %args = @_;
Dizzy::Handlers::register(
rotator_switch => \&handler_walking,
);
Dizzy::Handlers::register_last(
rotator_switched => \&handler_switched,
);
}
1;
lib/Dizzy/RotatorSwitcher.pm 0000664 0000000 0000000 00000000467 11654211675 0016455 0 ustar 00root root 0000000 0000000 package Dizzy::RotatorSwitcher;
use strict;
use warnings;
sub init {
my ($rotator_switcher, %rotator_switcher_opts) = @_;
require "Dizzy/RotatorSwitcher/$rotator_switcher.pm";
my $init = eval '\&Dizzy::RotatorSwitcher::'.$rotator_switcher.'::init';
die $@ if ($@);
$init->(%rotator_switcher_opts);
}
1;
lib/Dizzy/RotatorSwitcher/ 0000775 0000000 0000000 00000000000 11654211675 0016110 5 ustar 00root root 0000000 0000000 lib/Dizzy/RotatorSwitcher/Blend.pm 0000664 0000000 0000000 00000012700 11654211675 0017472 0 ustar 00root root 0000000 0000000 package Dizzy::TextureSwitcher::Blend;
use strict;
use warnings;
use OpenGL qw(:all);
use Math::Trig;
use Time::HiRes qw(time);
use Dizzy::TextureGenerator;
use Dizzy::Handlers;
use Dizzy::GLFeatures;
my $blend_params = undef; # parameters of original texture_switch request
my $blend_start; # time at which current blend was started
my $blend_texture; # texture ID used for intermediate textures
my $blend_duration = 0;
# saved parameters
my $shader_prog;
# blend function to use
my $func_init;
my $func_blend;
sub handler_init_switch {
my %args = @_;
# check here if we are currently blending. if we are, STOP.
if (defined($blend_params)) {
print "*** Cannot switch to different texture, because Dizzy is blending right now.\n";
return Dizzy::Handlers::STOP;
}
# else:
$blend_params = \%args;
$blend_start = time;
Dizzy::Handlers::STOP;
}
# ******************************* SOFTWARE ***********************************
sub software_init {
$blend_texture = Dizzy::TextureGenerator::create_texture();
}
# software blend two textures into a third one
sub software_blend {
my ($tex_a, $tex_b, $ratio) = @_;
# $tex_a = first GL texture ID
# $tex_b = second GL texture ID
# $ratio = 0.0 .. 1.0 (0.0 = 100% A 0% B, 1.0 = 0% A 100% B)
# retrieve the two textures to be blended
my (@data_a, @data_b);
glBindTexture(GL_TEXTURE_2D, $tex_a);
@data_a = glGetTexImage_p(GL_TEXTURE_2D, 0, GL_LUMINANCE, GL_FLOAT);
glBindTexture(GL_TEXTURE_2D, $tex_b);
@data_b = glGetTexImage_p(GL_TEXTURE_2D, 0, GL_LUMINANCE, GL_FLOAT);
# also retrieve their dimensions (as the program always uses squares, one
# dimension suffices)
my $res = glGetTexLevelParameteriv_p(GL_TEXTURE_2D, 0, GL_TEXTURE_WIDTH);
# blend the two textures
my $target_data;
while (@data_a > 0) {
$target_data .= pack("f", shift(@data_a) * (1 - $ratio) + shift(@data_b) * $ratio);
}
# now load the blended image into the intermediate texture
glBindTexture(GL_TEXTURE_2D, $blend_texture);
glTexImage2D_s(
GL_TEXTURE_2D,
0,
GL_LUMINANCE,
$res, $res,
0,
GL_LUMINANCE,
GL_FLOAT,
$target_data
);
}
# ********************************** GLSL ************************************
sub glsl_init {
my $fragment_id = glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
glShaderSourceARB_p($fragment_id, << "__END_SHADER__");
uniform sampler2D Texture0;
uniform sampler2D Texture1;
uniform float BlendFactor;
void main() {
vec4 texel0 = texture2D(Texture0, gl_TexCoord[0].xy);
vec4 texel1 = texture2D(Texture1, gl_TexCoord[1].xy);
gl_FragColor.rgb = gl_Color.rgb * mix(texel0, texel1, BlendFactor).r;
gl_FragColor.a = 1.0;
}
__END_SHADER__
glCompileShaderARB($fragment_id);
if (!glGetObjectParameterivARB_p($fragment_id, GL_OBJECT_COMPILE_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($fragment_id);
die("Shader compilation failed: $stat - dying");
}
$shader_prog = glCreateProgramObjectARB();
glAttachObjectARB($shader_prog, $fragment_id);
glLinkProgramARB($shader_prog);
if (!glGetObjectParameterivARB_p($shader_prog, GL_OBJECT_LINK_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($shader_prog);
die("Failed to link shader program: $stat - dying");
}
glUseProgramObjectARB($shader_prog);
glUniform1iARB(glGetUniformLocationARB_p($shader_prog, "Texture0"), 0);
glUniform1iARB(glGetUniformLocationARB_p($shader_prog, "Texture1"), 1);
}
sub glsl_blend {
my ($tex_a, $tex_b, $ratio) = @_;
# activate shader (in case it didn't happen already)
glUseProgramObjectARB($shader_prog);
# load the textures
glActiveTextureARB(GL_TEXTURE0);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, $tex_a);
glActiveTextureARB(GL_TEXTURE1);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, $tex_b);
# set the blend factor
glUniform1fARB(glGetUniformLocationARB_p($shader_prog, "BlendFactor"), $ratio);
}
# ******************************** HANDLERS **********************************
# this routine generates and activates intermediate textures
# if there is a blend in progress right now.
# it also sets off necessary events once the blend is finished.
sub handler_render {
if (defined($blend_params)) {
# blend the texture. calculate the ratio first
my $ratio = (time() - $blend_start) / $blend_duration;
# decide if we are done, or if we need to generate an intermediate image
# (assert we are done if the source and target match, so we don't block
# on program start)
if ($ratio < 1.0 and $blend_params->{old_gl_texture} != $blend_params->{gl_texture}) {
$func_blend->(
$blend_params->{old_gl_texture},
$blend_params->{gl_texture},
$ratio,
);
} else {
glBindTexture(GL_TEXTURE_2D, $blend_params->{gl_texture});
Dizzy::Handlers::invoke("texture_switched", %{$blend_params});
$blend_params = undef;
}
}
Dizzy::Handlers::GO_ON;
}
sub select_render_path {
if (Dizzy::GLFeatures::supports("glsl")) {
print "TexBlend: will use fast GLSL shaders for blending :-)\n";
$func_init = \&glsl_init;
$func_blend = \&glsl_blend;
} else {
print "TexBlend: GLSL not supported, falling back to slow software blending :-(\n";
$func_init = \&software_init;
$func_blend = \&software_blend;
}
}
sub init {
my %args = @_;
$blend_duration = $args{duration} || 2;
# allocate a texture for blends
$blend_texture = Dizzy::TextureGenerator::create_texture();
# select and initialize render path
select_render_path();
$func_init->();
Dizzy::Handlers::register(
texture_switch => \&handler_init_switch,
render => \&handler_render,
);
}
1;
lib/Dizzy/RotatorSwitcher/Simple.pm 0000664 0000000 0000000 00000000457 11654211675 0017705 0 ustar 00root root 0000000 0000000 package Dizzy::RotatorSwitcher::Simple;
use strict;
use warnings;
use OpenGL qw(:all);
use Dizzy::Handlers;
sub init {
Dizzy::Handlers::register(
rotator_switch => sub {
my %args = @_;
# do stuff
Dizzy::Handlers::invoke("rotator_switched", %args);
Dizzy::Handlers::STOP;
}
);
}
1;
lib/Dizzy/Rotators.pm 0000664 0000000 0000000 00000000237 11654211675 0015122 0 ustar 00root root 0000000 0000000 package Dizzy::Rotators;
use strict;
use warnings;
use Dizzy::Rotators::Default;
sub rotators {
return (
Dizzy::Rotators::Default::rotators(),
);
}
1;
lib/Dizzy/Rotators/ 0000775 0000000 0000000 00000000000 11654211675 0014562 5 ustar 00root root 0000000 0000000 lib/Dizzy/Rotators/Default.pm 0000664 0000000 0000000 00000001515 11654211675 0016506 0 ustar 00root root 0000000 0000000 package Dizzy::Rotators::Default;
use strict;
use warnings;
use OpenGL qw(glRotatef glTranslatef);
my @rotators = (
{
name => "Foobar",
function => sub {
my ($tick, $plane) = @_;
if ($plane == 1) {
glRotatef(sin($tick * 0.75) * 10 + $tick * 5, 0, 0, 1);
glTranslatef(sin($tick * 0.5), cos($tick * 0.75), 0);
} elsif ($plane == 2) {
glRotatef(sin($tick * 0.25) * 50 + $tick * -2.5, 0, 0, 1);
glTranslatef(sin($tick * 0.5), cos($tick * 0.75), 0);
}
},
},
{
name => "Classic",
function => sub {
my ($tick, $plane) = @_;
if ($plane == 1) {
glRotatef($tick * 5, 0, 0, 1);
glTranslatef(sin($tick * 0.5), cos($tick * 0.75), 0);
} else {
glRotatef($tick * -2.5, 0, 0, 1);
glTranslatef(sin($tick * 0.5), cos($tick * 0.75), 0);
}
},
},
);
sub rotators {
return @rotators;
}
1;
lib/Dizzy/TextureGenerator.pm 0000664 0000000 0000000 00000016302 11654211675 0016614 0 ustar 00root root 0000000 0000000 package Dizzy::TextureGenerator;
use strict;
use warnings;
use B::Deparse;
use Digest::SHA qw(sha1_hex);
use File::Path qw(make_path);
use OpenGL qw(:all);
use Dizzy::GLFeatures;
use Dizzy::Perl2GLSL;
use 5.010;
sub create_texture {
# save old texture
my $old_texture = glGetIntegerv_p(GL_TEXTURE_BINDING_2D);
# allocate the new texture
my $new_texture = (glGenTextures_p(1))[0];
glBindTexture(GL_TEXTURE_2D, $new_texture);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
# restore the old texture
glBindTexture(GL_TEXTURE_2D, $old_texture);
return $new_texture;
}
sub render_function_software {
my %args = @_;
my $tex = "";
my ($nx, $ny, $val);
for (my $y = 0; $y < $args{resolution}; $y++) {
for (my $x = 0; $x < $args{resolution}; $x++) {
$nx = ($x / $args{resolution}) - 0.5;
$ny = ($y / $args{resolution}) - 0.5;
$val = $args{function}->($nx, $ny);
# clip excessive values
if ($val > 1.0) {
$val = 1.0;
} elsif ($val < 0.0) {
$val = 0.0;
}
# append pixel data
$tex .= pack("f", $val);
}
}
glTexImage2D_s(
GL_TEXTURE_2D,
0,
GL_LUMINANCE,
$args{resolution}, $args{resolution},
0,
GL_LUMINANCE,
GL_FLOAT,
$tex
);
}
sub render_function_shader {
my %args = @_;
# allocate texture memory.
# on windows systems, passing a NULL pointer to glTexImage2D is faster than
# allocating and passing the memory manually; in this case, the GL allocates
# the memory itself.
# on other systems (tested so far: Linux with MESA), when passing a NULL
# pointer hell breaks loose and all kinds of render errors are in the texture
# and so.
if ($^O eq "MSWin32") {
glTexImage2D_c(
GL_TEXTURE_2D, 0,
GL_RGBA8,
$args{resolution}, $args{resolution},
0,
GL_LUMINANCE, GL_FLOAT,
0
);
} else {
glTexImage2D_s(
GL_TEXTURE_2D,
0,
GL_RGBA8,
$args{resolution}, $args{resolution},
0,
GL_LUMINANCE, GL_FLOAT,
pack("f", 0) x ($args{resolution} ** 2)
);
}
# create and use a framebuffer object
my $fbo = (glGenFramebuffersEXT_p(1))[0];
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, $fbo);
glFramebufferTexture2DEXT(
GL_FRAMEBUFFER_EXT,
GL_COLOR_ATTACHMENT0_EXT,
GL_TEXTURE_2D,
glGetIntegerv_p(GL_TEXTURE_BINDING_2D),
0
);
# redefine the viewport (temporarily)
glPushAttrib(GL_VIEWPORT_BIT);
glViewport(0, 0, $args{resolution}, $args{resolution});
# prepare projection
glMatrixMode(GL_TEXTURE);
glPushMatrix();
glLoadIdentity();
glMatrixMode(GL_PROJECTION);
glPushMatrix();
glLoadIdentity();
glOrtho(-1.0, 1.0, 1.0, -1.0, 1, -1);
glMatrixMode(GL_MODELVIEW);
glEnable(GL_TEXTURE_2D);
# load shader
my $fragment_id = glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
glShaderSourceARB_p($fragment_id, $args{shader});
glCompileShaderARB($fragment_id);
if (!glGetObjectParameterivARB_p($fragment_id, GL_OBJECT_COMPILE_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($fragment_id);
print STDERR "Shader compilation failed: $stat\n";
print STDERR "Shader source:\n";
print STDERR $args{shader} . "\n";
die();
}
my $shader_prog = glCreateProgramObjectARB();
glAttachObjectARB($shader_prog, $fragment_id);
glLinkProgramARB($shader_prog);
if (!glGetObjectParameterivARB_p($shader_prog, GL_OBJECT_LINK_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($shader_prog);
die("Failed to link shader program: $stat - dying");
}
glUseProgramObjectARB($shader_prog);
# render a plane
glLoadIdentity();
glBegin(GL_QUADS);
glTexCoord2f(0, 0); glVertex2f(-1, -1);
glTexCoord2f(0, 1); glVertex2f(-1, 1);
glTexCoord2f(1, 1); glVertex2f( 1, 1);
glTexCoord2f(1, 0); glVertex2f( 1, -1);
glEnd();
# flush the output, so we can capture it
glFlush();
glFinish();
# reset everything
glUseProgramObjectARB(0);
glDeleteObjectARB($shader_prog);
glDeleteObjectARB($fragment_id);
glMatrixMode(GL_PROJECTION);
glPopMatrix();
glMatrixMode(GL_TEXTURE);
glPopMatrix();
glMatrixMode(GL_MODELVIEW);
glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0);
glDeleteFramebuffersEXT_p($fbo);
glPopAttrib();
}
# receives a base path like path/to/cache/c34b7a5b72-Ornament-256
# will try that file, and possibly compressed formats
sub try_load_cached_texture {
my ($base_path) = @_;
local $/;
# try uncompressed
if (-e $base_path) {
open(my $fd, "<", $base_path);
return <$fd>;
}
# try a gzip compressed version
if (-e "$base_path.gz") {
open(my $raw_fd, "<", "$base_path.gz");
require IO::Uncompress::Gunzip;
my $z = IO::Uncompress::Gunzip->new($raw_fd);
return <$z>;
}
# else...
return undef;
}
sub render_from_func {
my %args = @_;
# if GLSL is supported and so, render it freshly, without cache
# (cache read/write just wastes time here)
if (Dizzy::GLFeatures::supports("glsl") and (!Dizzy::GLFeatures::has_mesa_shader_bug() or $args{shader}) and Dizzy::GLFeatures::supports("fbo")) {
# if GLSL is supported and stuff, render it
my $shader = $args{shader} // Dizzy::Perl2GLSL::perl2glsl($args{function});
render_function_shader(
resolution => $args{shader_resolution},
shader => $shader,
);
return;
}
# so it's not supported, try to find it in the cache first.
my $hash = sha1_hex(B::Deparse->new()->coderef2text($args{function}));
if (defined($args{cache_paths})) {
foreach my $path (@{$args{cache_paths}}) {
my $name = "$path/$hash-$args{name}-$args{texture_resolution}";
my $data = try_load_cached_texture($name);
if (defined($data)) {
glTexImage2D_s(
GL_TEXTURE_2D,
0,
GL_LUMINANCE,
$args{texture_resolution}, $args{texture_resolution},
0,
GL_LUMINANCE,
GL_FLOAT,
$data
);
return;
}
}
}
# it's not found in the cache, render it on the CPU.
render_function_software(
resolution => $args{texture_resolution},
function => $args{function},
);
# if caching is active, write the texture to the cache now.
if (defined($args{cache_paths}->[0])) {
eval { make_path($args{cache_paths}->[0]) };
if ($@) {
print STDERR "$@ - not writing to cache.\n";
return;
}
my $res = glGetTexLevelParameteriv_p(GL_TEXTURE_2D, 0, GL_TEXTURE_WIDTH);
my $fn = "$args{cache_paths}->[0]/$hash-$args{name}-$res";
open(my $outfile, ">", $fn) or do {
print STDERR "Couldn't write to cache file $fn ($!), not writing to cache.\n";
return;
};
# fucking _s version of this routine is fucking broken, so no way around
# pointlessly unpacking and repacking the data
my @pixels = glGetTexImage_p(GL_TEXTURE_2D, 0, GL_LUMINANCE, GL_FLOAT);
print $outfile pack("f*", @pixels);
close($outfile);
}
}
sub new_from_func {
my %args = @_;
# allocate a new texture and render into it.
my $new_texture = create_texture();
# save old texture and prepare new
my $old_texture = glGetIntegerv_p(GL_TEXTURE_BINDING_2D);
glBindTexture(GL_TEXTURE_2D, $new_texture);
render_from_func(
name => $args{name},
function => $args{function},
shader => $args{shader},
texture_resolution => $args{texture_resolution},
shader_resolution => $args{shader_resolution},
cache_paths => $args{cache_paths},
target => $new_texture,
);
# restore the old texture
glBindTexture(GL_TEXTURE_2D, $old_texture);
return $new_texture;
}
1;
lib/Dizzy/TextureManager.pm 0000664 0000000 0000000 00000004414 11654211675 0016241 0 ustar 00root root 0000000 0000000 package Dizzy::TextureManager;
use strict;
use warnings;
use OpenGL qw(:all);
use Math::Trig;
use Time::HiRes qw(sleep time);
use Dizzy::TextureGenerator;
use Dizzy::Handlers;
my @textures;
my $current_texture_id = 0;
my $texture_resolution = 0;
my $shader_resolution = 0;
my $cache_paths;
sub add {
my %args = @_;
push(@textures, \%args);
$textures[$#textures]->{gl_texture} = Dizzy::TextureGenerator::new_from_func(
name => $textures[$#textures]->{name},
function => $textures[$#textures]->{function},
shader => $textures[$#textures]->{shader},
texture_resolution => $texture_resolution,
shader_resolution => $shader_resolution,
cache_paths => $cache_paths,
);
delete($textures[$#textures]->{function});
return $#textures;
}
sub set {
my ($id) = @_;
Dizzy::Handlers::invoke("texture_switch",
gl_texture => $textures[$id]->{gl_texture},
old_gl_texture => $textures[$current_texture_id]->{gl_texture},
_texman_new_id => $id,
_texman_old_id => $current_texture_id,
);
}
# -----------------------------------------------------------------------------
# some handlers
# transforms a texture walk request (such as one triggered by cursor keys) into
# something that we all understand: a renderable GL texture ID.
sub handler_walking {
my %args = @_;
if (exists($args{direction})) {
# find out about the next texture
my $id = $current_texture_id + $args{direction};
$id += @textures;
$id %= @textures;
set($id);
return Dizzy::Handlers::STOP;
} else {
return Dizzy::Handlers::GO_ON;
}
}
# this event serves to tell texman that the texture has now changed.
# it is essentially like texture_switch, but this one is needed for texblend
# to work.
sub handler_switched {
my %args = @_;
$current_texture_id = $args{_texman_new_id};
Dizzy::Handlers::invoke("texture_changed",
name => $textures[$current_texture_id]->{name},
);
Dizzy::Handlers::STOP;
}
sub init {
my %args = @_;
$texture_resolution = $args{texture_resolution};
$shader_resolution = $args{shader_resolution};
$cache_paths = $args{cache_disable} ? [] : $args{cache_paths};
Dizzy::Handlers::register(
texture_switch => \&handler_walking,
);
Dizzy::Handlers::register_last(
texture_switched => \&handler_switched,
);
}
1;
lib/Dizzy/TextureSwitcher.pm 0000664 0000000 0000000 00000000443 11654211675 0016455 0 ustar 00root root 0000000 0000000 package Dizzy::TextureSwitcher;
use strict;
use warnings;
sub init {
my ($tex_switcher, %tex_switcher_opts) = @_;
require "Dizzy/TextureSwitcher/$tex_switcher.pm";
my $init = eval '\&Dizzy::TextureSwitcher::'.$tex_switcher.'::init';
die $@ if ($@);
$init->(%tex_switcher_opts);
}
1;
lib/Dizzy/TextureSwitcher/ 0000775 0000000 0000000 00000000000 11654211675 0016116 5 ustar 00root root 0000000 0000000 lib/Dizzy/TextureSwitcher/Blend.pm 0000664 0000000 0000000 00000012700 11654211675 0017500 0 ustar 00root root 0000000 0000000 package Dizzy::TextureSwitcher::Blend;
use strict;
use warnings;
use OpenGL qw(:all);
use Math::Trig;
use Time::HiRes qw(time);
use Dizzy::TextureGenerator;
use Dizzy::Handlers;
use Dizzy::GLFeatures;
my $blend_params = undef; # parameters of original texture_switch request
my $blend_start; # time at which current blend was started
my $blend_texture; # texture ID used for intermediate textures
my $blend_duration = 0;
# saved parameters
my $shader_prog;
# blend function to use
my $func_init;
my $func_blend;
sub handler_init_switch {
my %args = @_;
# check here if we are currently blending. if we are, STOP.
if (defined($blend_params)) {
print "*** Cannot switch to different texture, because Dizzy is blending right now.\n";
return Dizzy::Handlers::STOP;
}
# else:
$blend_params = \%args;
$blend_start = time;
Dizzy::Handlers::STOP;
}
# ******************************* SOFTWARE ***********************************
sub software_init {
$blend_texture = Dizzy::TextureGenerator::create_texture();
}
# software blend two textures into a third one
sub software_blend {
my ($tex_a, $tex_b, $ratio) = @_;
# $tex_a = first GL texture ID
# $tex_b = second GL texture ID
# $ratio = 0.0 .. 1.0 (0.0 = 100% A 0% B, 1.0 = 0% A 100% B)
# retrieve the two textures to be blended
my (@data_a, @data_b);
glBindTexture(GL_TEXTURE_2D, $tex_a);
@data_a = glGetTexImage_p(GL_TEXTURE_2D, 0, GL_LUMINANCE, GL_FLOAT);
glBindTexture(GL_TEXTURE_2D, $tex_b);
@data_b = glGetTexImage_p(GL_TEXTURE_2D, 0, GL_LUMINANCE, GL_FLOAT);
# also retrieve their dimensions (as the program always uses squares, one
# dimension suffices)
my $res = glGetTexLevelParameteriv_p(GL_TEXTURE_2D, 0, GL_TEXTURE_WIDTH);
# blend the two textures
my $target_data;
while (@data_a > 0) {
$target_data .= pack("f", shift(@data_a) * (1 - $ratio) + shift(@data_b) * $ratio);
}
# now load the blended image into the intermediate texture
glBindTexture(GL_TEXTURE_2D, $blend_texture);
glTexImage2D_s(
GL_TEXTURE_2D,
0,
GL_LUMINANCE,
$res, $res,
0,
GL_LUMINANCE,
GL_FLOAT,
$target_data
);
}
# ********************************** GLSL ************************************
sub glsl_init {
my $fragment_id = glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
glShaderSourceARB_p($fragment_id, << "__END_SHADER__");
uniform sampler2D Texture0;
uniform sampler2D Texture1;
uniform float BlendFactor;
void main() {
vec4 texel0 = texture2D(Texture0, gl_TexCoord[0].xy);
vec4 texel1 = texture2D(Texture1, gl_TexCoord[1].xy);
gl_FragColor.rgb = gl_Color.rgb * mix(texel0, texel1, BlendFactor).r;
gl_FragColor.a = 1.0;
}
__END_SHADER__
glCompileShaderARB($fragment_id);
if (!glGetObjectParameterivARB_p($fragment_id, GL_OBJECT_COMPILE_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($fragment_id);
die("Shader compilation failed: $stat - dying");
}
$shader_prog = glCreateProgramObjectARB();
glAttachObjectARB($shader_prog, $fragment_id);
glLinkProgramARB($shader_prog);
if (!glGetObjectParameterivARB_p($shader_prog, GL_OBJECT_LINK_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($shader_prog);
die("Failed to link shader program: $stat - dying");
}
glUseProgramObjectARB($shader_prog);
glUniform1iARB(glGetUniformLocationARB_p($shader_prog, "Texture0"), 0);
glUniform1iARB(glGetUniformLocationARB_p($shader_prog, "Texture1"), 1);
}
sub glsl_blend {
my ($tex_a, $tex_b, $ratio) = @_;
# activate shader (in case it didn't happen already)
glUseProgramObjectARB($shader_prog);
# load the textures
glActiveTextureARB(GL_TEXTURE0);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, $tex_a);
glActiveTextureARB(GL_TEXTURE1);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, $tex_b);
# set the blend factor
glUniform1fARB(glGetUniformLocationARB_p($shader_prog, "BlendFactor"), $ratio);
}
# ******************************** HANDLERS **********************************
# this routine generates and activates intermediate textures
# if there is a blend in progress right now.
# it also sets off necessary events once the blend is finished.
sub handler_render {
if (defined($blend_params)) {
# blend the texture. calculate the ratio first
my $ratio = (time() - $blend_start) / $blend_duration;
# decide if we are done, or if we need to generate an intermediate image
# (assert we are done if the source and target match, so we don't block
# on program start)
if ($ratio < 1.0 and $blend_params->{old_gl_texture} != $blend_params->{gl_texture}) {
$func_blend->(
$blend_params->{old_gl_texture},
$blend_params->{gl_texture},
$ratio,
);
} else {
glBindTexture(GL_TEXTURE_2D, $blend_params->{gl_texture});
Dizzy::Handlers::invoke("texture_switched", %{$blend_params});
$blend_params = undef;
}
}
Dizzy::Handlers::GO_ON;
}
sub select_render_path {
if (Dizzy::GLFeatures::supports("glsl")) {
print "TexBlend: will use fast GLSL shaders for blending :-)\n";
$func_init = \&glsl_init;
$func_blend = \&glsl_blend;
} else {
print "TexBlend: GLSL not supported, falling back to slow software blending :-(\n";
$func_init = \&software_init;
$func_blend = \&software_blend;
}
}
sub init {
my %args = @_;
$blend_duration = $args{duration} || 2;
# allocate a texture for blends
$blend_texture = Dizzy::TextureGenerator::create_texture();
# select and initialize render path
select_render_path();
$func_init->();
Dizzy::Handlers::register(
texture_switch => \&handler_init_switch,
render => \&handler_render,
);
}
1;
lib/Dizzy/TextureSwitcher/Simple.pm 0000664 0000000 0000000 00000000525 11654211675 0017707 0 ustar 00root root 0000000 0000000 package Dizzy::TextureSwitcher::Simple;
use strict;
use warnings;
use OpenGL qw(:all);
use Dizzy::Handlers;
sub init {
Dizzy::Handlers::register(
texture_switch => sub {
my %args = @_;
glBindTexture(GL_TEXTURE_2D, $args{gl_texture});
Dizzy::Handlers::invoke("texture_switched", %args);
Dizzy::Handlers::STOP;
}
);
}
1;
lib/Dizzy/Textures.pm 0000664 0000000 0000000 00000000237 11654211675 0015130 0 ustar 00root root 0000000 0000000 package Dizzy::Textures;
use strict;
use warnings;
use Dizzy::Textures::Default;
sub textures {
return (
Dizzy::Textures::Default::textures(),
);
}
1;
lib/Dizzy/Textures/ 0000775 0000000 0000000 00000000000 11654211675 0014570 5 ustar 00root root 0000000 0000000 lib/Dizzy/Textures/Default.pm 0000664 0000000 0000000 00000010640 11654211675 0016513 0 ustar 00root root 0000000 0000000 package Dizzy::Textures::Default;
use strict;
use warnings;
use Math::Trig;
sub wrapval {
my ($val) = @_;
return ($val < 0.0 ? 1.0 : (
$val > 1.0 ? 0.0 : $val)
);
}
my @textures = (
{
name => "Ornament",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return sin(pi / (0.0001 + 2 * $dist)) / 2 + 0.5;
},
},
{
name => "Spots",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cos($dist * pi) / 2 + 0.5;
},
},
{
name => "Aurora",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cos($dist * pi + $y / ($dist + 0.0001)) / 2 + 0.5;
},
},
{
name => "Flowers",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cos($dist * pi + sin(asin($y / ($dist + 0.00001)) * 8) * 0.2) / 2 + 0.5;
},
},
{
name => "Blurred Circles",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return sin($dist * pi / 2) / 2 + 0.5;
},
},
{
name => "Blurred Anticircles",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cos($dist * pi + sin(asin($y / ($dist + 0.00001)) * 2) * 0.2) / 2 + 0.5;
},
},
{
name => "Waves",
function => sub {
my ($x, $y) = @_;
return wrapval((cos($y * pi) + sin($x * pi)) / 2 + 0.5);
},
},
{
name => "Crystal",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cos(($x * 2) + asin($y / ($dist + 0.0001))) / 2 + 0.5;
},
},
{
name => "Black Circles",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return 1.0 - (cos($dist * pi) / 2 + 0.5);
},
},
{
name => "Hexagon",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return wrapval(asin($y / ($dist + 0.0001)) / 2 + 0.5);
},
},
{
name => "Boxes",
function => sub {
my ($x, $y) = @_;
return ($x + 0.5) * ($y + 0.5);
},
},
{
name => "Bubbles",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cosec($dist + 0.1) / 3;
},
},
{
name => "Winter Dream",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return cosec($dist * 3 + 0.1) / 3;
},
},
{
name => "Pills",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return -log($dist + 0.01);
},
},
{
name => "Stars",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return 22.35468769 * $dist**6 + sin(12) * $dist**2 / 5.734;
},
},
{
name => "Eggs",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return tan($dist);
},
},
{
name => "Holegrid",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
return abs($dist - 0.5) < 0.1 ? 1.0 : 0.0;
},
},
{
name => "Airy",
function => sub {
my ($x, $y) = @_;
my $dist = sqrt($x ** 2 + $y ** 2);
my $i = ($dist <= 0.1 ? 0.1 : $dist) * 24 + 0.25;
my $j1 = sin($i) / ($i ** 2) - cos($i) / $i;
my $v = abs($j1 * (1 - ($i / 24) ** 2) * 1.5);
return $dist > 0.1 ? $v : $v * (($dist / 0.1) ** 1.5) + 1 - ($dist / 0.1) ** 1.5;
},
},
{
name => "Blurry Vision",
function => sub {
my ($x, $y) = @_;
return sin(2 * $x * pi) / 2 + 0.5;
},
},
{
name => "Zigzag",
function => sub {
my ($x, $y) = @_;
return sin(2 * $x * pi) / 2 - $y + 1;
},
},
);
=begin comment
{
name => "Swirl",
shader => << " // END SHADER",
void main() {
float vx = gl_TexCoord[0].x - 0.5;
float vy = gl_TexCoord[0].y - 0.5;
float vr = length(vec2(vx, vy));
float vt = atan(vy, vx);
vt = vt + vr * 16.;
vx = vr * cos(vt) + 0.5;
vy = vr * sin(vt) + 0.5;
float angle = atan(vy, vx);
float val = (sqrt(abs(sqrt(abs(vy - abs(sin(vx * 5. + 1.4))) * 2.) - 1.))) * (1. - vr * 2.);
gl_FragColor = vec4(vec3(val), 1.0);
}
// END SHADER
},
{
name => "Spaceballs",
shader => << " // END SHADER",
void main() {
float vx = gl_TexCoord[0].x - 0.5;
float vy = gl_TexCoord[0].y - 0.5;
float vr = length(vec2(vx, vy));
float vt = atan(vx, 1);
vt = vt + vr * 16;
vx = vr * cos(vt) + 0.5;
vy = vr * sin(vt) + 0.5;
float angle = atan(vx, 1);
float val = (sqrt(abs(sqrt(abs(vy - abs(sin(vx * 5 + 1.4))) * 2) - 1)) + (vr + angle / 4)) * (1 - vr * 2);
gl_FragColor = vec4(vec3(val), 1.0);
}
// END SHADER
},
=end comment
=cut
sub textures {
return @textures;
}
1;
shader-render 0000775 0000000 0000000 00000003705 11654211675 0013544 0 ustar 00root root 0000000 0000000 #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use OpenGL qw(:all);
use Math::Trig;
use Time::HiRes qw(sleep time);
####### GL HANDLERS
sub handler_resize {
glViewport(0, 0, $_[0], $_[1]);
}
sub handler_idle {
handler_render();
glFlush();
glutSwapBuffers();
sleep(1 / 50);
}
sub init_gl {
glutInit();
glutInitDisplayMode(GLUT_DOUBLE | GLUT_RGBA | GLUT_DEPTH);
glutInitWindowSize(512, 512);
glutCreateWindow("example");
glutReshapeFunc (\&handler_resize);
glutIdleFunc (\&handler_idle);
glutDisplayFunc (\&handler_render);
}
sub init_vp {
glClearColor(0.0, 0.0, 0.0, 0.0);
glColor3f(1.0, 1.0, 1.0);
glMatrixMode(GL_PROJECTION);
glOrtho(-1.0, 1.0, 1.0, -1.0, 1, -1);
glMatrixMode(GL_TEXTURE);
glMatrixMode(GL_MODELVIEW);
glEnable(GL_TEXTURE_2D);
# glEnable(GL_BLEND);
# glBlendFunc(GL_SRC_ALPHA, GL_ONE);
}
init_gl();
init_vp();
# #########
sub handler_render {
# ...
glClear(GL_COLOR_BUFFER_BIT);
glLoadIdentity();
glPushMatrix();
glBegin(GL_QUADS);
glTexCoord2f(0, 0); glVertex2f(-1, -1);
glTexCoord2f(0, 1); glVertex2f(-1, 1);
glTexCoord2f(1, 1); glVertex2f( 1, 1);
glTexCoord2f(1, 0); glVertex2f( 1, -1);
glEnd();
glPopMatrix();
}
my $fragment_id = glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
glShaderSourceARB_p($fragment_id, << "__END_SHADER__");
void main() {
float dist = length(gl_TexCoord[0].xy - 0.5);
float val = sin(3.141 / (0.001 + 2 * dist)) / 2 + 0.5;
gl_FragColor = vec4(val, val, val, 1.0);
}
__END_SHADER__
glCompileShaderARB($fragment_id);
my $stat = glGetInfoLogARB_p($fragment_id);
print "WARN shader compile $stat\n" if $stat;
my $shader_prog = glCreateProgramObjectARB();
glAttachObjectARB($shader_prog, $fragment_id);
glLinkProgramARB($shader_prog);
if (!glGetObjectParameterivARB_p($shader_prog, GL_OBJECT_LINK_STATUS_ARB)) {
my $stat = glGetInfoLogARB_p($shader_prog);
die("Failed to link shader program: $stat - dying");
}
glUseProgramObjectARB($shader_prog);
glutMainLoop();
texture-display 0000775 0000000 0000000 00000004320 11654211675 0014156 0 ustar 00root root 0000000 0000000 #!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use OpenGL qw(:all);
use Math::Trig;
use Time::HiRes qw(sleep time);
####### GL HANDLERS
sub handler_resize {
glViewport(0, 0, $_[0], $_[1]);
}
sub handler_idle {
handler_render();
glFlush();
glutSwapBuffers();
sleep(1 / 50);
}
sub init_gl {
glutInit();
glutInitDisplayMode(GLUT_DOUBLE | GLUT_RGBA | GLUT_DEPTH);
glutInitWindowSize(512, 512);
glutCreateWindow($_[0]);
glutReshapeFunc (\&handler_resize);
glutIdleFunc (\&handler_idle);
glutDisplayFunc (\&handler_render);
}
sub init_vp {
glClearColor(0.0, 0.0, 0.0, 0.0);
glColor3f(1.0, 1.0, 1.0);
glMatrixMode(GL_PROJECTION);
glOrtho(-1.0, 1.0, 1.0, -1.0, 1, -1);
glMatrixMode(GL_TEXTURE);
glMatrixMode(GL_MODELVIEW);
glEnable(GL_TEXTURE_2D);
}
sub handler_render {
# ...
glClear(GL_COLOR_BUFFER_BIT);
glLoadIdentity();
glPushMatrix();
glBegin(GL_QUADS);
glTexCoord2f(0, 0); glVertex2f(-1, -1);
glTexCoord2f(0, 1); glVertex2f(-1, 1);
glTexCoord2f(1, 1); glVertex2f( 1, 1);
glTexCoord2f(1, 0); glVertex2f( 1, -1);
glEnd();
glPopMatrix();
}
# load the data
my $data = do { local $/; open(my $fh, "<", $ARGV[0]) or die("Can't open $ARGV[0]: $!"); <$fh>; };
# texture resolution:
my $res;
if (defined($ARGV[1])) {
# if specified by user, use that value.
$res = $ARGV[1];
print "texture resolution: $res (user defined)\n";
} elsif ($ARGV[0] =~ /-(\d+)$/) {
# otherwise, derive from filename (files generated by dizzy contain that info)
$res = $1;
print "texture resolution: $res (from filename)\n";
} elsif (sqrt(length($data)) == int(sqrt(length($data)))) {
# or from file size?
$res = sqrt(length($data));
print "texture resolution: $res (from filesize)\n";
} else {
print "unknown texture resolution, please specify as second argument.\n";
exit(1);
}
# init stuff
init_gl("file=$ARGV[0] res=$res");
init_vp();
# allocate new texture ID
my $new_texture = (glGenTextures_p(1))[0];
glBindTexture(GL_TEXTURE_2D, $new_texture);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexImage2D_s(
GL_TEXTURE_2D, 0,
GL_LUMINANCE,
$res, $res,
0,
GL_LUMINANCE,
GL_FLOAT,
$data
);
glutMainLoop();