#!/usr/bin/perl -w

use strict;

use Gtk2 -init;
use Glib qw(:constants);

# input file is raw 16-bit grayscale image data at 512x512, from
# http://zentara.net/perlplay/DICOM/CT-MONO2-16-brain.raw
my $file = "CT-MONO2-16-brain.raw";
my $bits = 16;
my $width = 512;
my $height = 512;
open IN, $file or die "$file: $!\n";
my $expect_size = $width * $height * ($bits/8);
my $data;
my $n_read = sysread IN, $data, $expect_size;
die "File is the wrong size -- got $n_read, expected $expect_size\n"
	unless $n_read == $expect_size;


my $window = Gtk2::Window->new;
$window->signal_connect (destroy => sub { Gtk2->main_quit });

my $hbox = Gtk2::HBox->new;
$window->add ($hbox);

my $image = Gtk2::Image->new;
$image->set_size_request ($width, $height);
$hbox->add ($image);

my $vbox = Gtk2::VBox->new;
$hbox->add ($vbox);

foreach (
    { label => "out = low byte", func => \&low_byte },
    { label => "out = in >>  1", func => sub { shift_by (1) } },
    { label => "out = in >>  2", func => sub { shift_by (2) } },
    { label => "out = in >>  3", func => sub { shift_by (3) } },
    { label => "out = in >>  4", func => sub { shift_by (4) } },
    { label => "out = in >>  5", func => sub { shift_by (5) } },
    { label => "out = in >>  6", func => sub { shift_by (6) } },
    { label => "out = in >>  7", func => sub { shift_by (7) } },
    { label => "out = in >>  8", func => sub { shift_by (8) } },
    { label => "top 12 bits", func => sub { stretch ((1<<4)-1, (1<<16)-1) } },
    { label => "bottom 12 bits", func => sub { stretch (0, (1<<12)-1) } },
    { label => "bottom 10 bits", func => sub { stretch (0, (1<<10)-1) } },
    { label => "bottom 6 bits", func => sub { stretch (0, (1<<6)-1) } },
    { label => "sqrt curve", func => sub { curve () } },
) {
	my $button = Gtk2::Button->new ($_->{label});
	$button->signal_connect (clicked => $_->{func});
	$vbox->pack_start ($button, FALSE, FALSE, 0);
}

$window->show_all;

Gtk2->main;

sub set_from_rgb {
    my $rgb = shift;
    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($rgb, 'rgb', FALSE, 8,
                                                   $width, $height,
                                                   $width * 3);
    $image->set_from_pixbuf ($pixbuf);
}


#
# Dead simple -- just mask off bits 9-16 and show only the low byte.
# This will result in interesting wrapping effects for any pixel >255.
#
sub low_byte {
    my $rgb = pack "C*",
                  map { ($_ & 0x00ff) x 3 }
                      unpack "S*", $data;

    set_from_rgb ($rgb);
}

#
# Like low_byte(), but shift right by n first.
#
sub shift_by {
    my ($n) = @_;
    my $rgb = pack "C*",
                  map { (($_ >> $n) & 0x00ff) x 3 }
                      unpack "S*", $data;

    set_from_rgb ($rgb);
}

#
# Attempt to do a linear scaling of the input pixels from the range
# [$min, $max] to [0,255].  This is implemented in a very slow manner...
#
sub stretch {
    my ($min, $max) = @_;

    sub scale_one {
        my ($min, $max, $this) = @_;
        my $val = int (($this - $min) / ($max - $min) * 255);
        $val = 255 if $val > 255;
        $val = 0 if $val < 0;
        return 0x00ff & $val;
    }

    my $rgb = pack "C*",
                  map { (scale_one ($min, $max, $_)) x 3 }
                      unpack "S*", $data;

    set_from_rgb ($rgb);
}

#
# Apply a square root transformation to each pixel.
# The result is like looking at the high byte, but with more detail
# in the dark areas.
#
sub curve {

    my $rgb = pack "C*",
                  map { (int (255 * sqrt ($_ / 65535.0))) x 3 }
                      unpack "S*", $data;

    my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_data ($rgb, 'rgb', FALSE, 8,
                                                   $width, $height,
                                                   $width * 3);
    $image->set_from_pixbuf ($pixbuf);
}