#!/usr/local/bin/perl
# hdw.p
# Makes hinton diagram from a file containing a list of floats in ascii
# and another file wights.d that specifies offsets. 
#
# usage
#  hdw.p o=hd.ps zero=0.0 range=2.0 inputs=4 rows=4 w=weights  20 20 20 1 
# the string of integers are number-per-line as in returns.p
#
# transformation rules: 
# 0     linear from min to max defined by zero and range
# 1     log from min to max
#

$background=0.5; # colour of surrounding box 
$neg = 0.0 ;     # colour of negatives
$pos = 1.0 ;     # colour of positive areas ( 1.0 is white )
$o="hd.ps"; 
$h=10; # box space
$maxbox=0; # max box radius , set to h/2 below if not changed from 0
$m=4;  # margin
$zero = 0.0 ;
$range = 1.0 ;
$rotate = 1 ; # whether to rotate the stuff
$r = 0 ;   # whether to give log transformation
$rows=4; # number of rows
$cols=0;
$grid=0;
# $x0=0; $y0=0;
$x0=40; $y0=40;
$stroke = ""; # change this to "stroke" to get lines round all boxes. 

#  How to override min and max values with command line
eval "\$$1=\$2" while @ARGV && $ARGV[0]=~ /^(\w+)=(.*)/ && shift;

$l=0;
while ( $ARGV[0]=~ /^(\d+)/ ) {
    $num[$l++]=$1; if($1 > $cols ) {$cols = $1; } shift;
}
$lmax = $l ; 
# what remains in argv is used as filenames for input

if ( $maxbox == 0 ) { $maxbox = $h / 2 ; }
$height = ( $rows * $h )  + (  2 * $m )  ;
$width  = ( $cols * $h ) + ( 2 * $m  );

open ( W , "<$w" ) ;
open ( WD , "<$w.d" ) ;
open ( OUT , ">$o" ) ;
print OUT "%!\n" ;
print OUT "%%Title:   none\n" ;
print OUT "%%Creator: hintond.p\n" ;
print OUT "%%Pages: 1\n" ;
print OUT "%%BoundingBox:" ;
if( $rotate == 1 ) {
    printf OUT " %d %d %d %d\n" , $y0, $x0  , $y0 + $height , $x0 + $width ;
}
else {
    printf OUT " %d %d %d %d\n" , $x0  ,$y0 ,  $x0 + $width ,$y0 + $height ;
}
print OUT "%%EndComments\n" ;
print OUT "/\$F2psDict 32 dict def \n" ;
 print OUT "\$F2psDict begin\n" ;
 print OUT "        \$F2psDict /mtrx matrix put\n" ;
 print OUT "\n" ;
 print OUT "        end\n" ;
print OUT "        /\$F2psBegin {\$F2psDict begin /\$F2psEnteredState save def} def\n" ;
print OUT "        /\$F2psEnd {\$F2psEnteredState restore end} def\n" ;
print OUT "        %%EndProlog\n" ;
print OUT "\n" ;
print OUT "\$F2psBegin\n" ;
print OUT "1 setlinecap 1 setlinejoin\n" ;
# printf OUT "-%d %d translate\n" ,  $y0 * 0.9 , $x0 * 0.9 ;
                           #   this gives coords of smallest corner, 
                           # except multiplied down by 0.9 
# printf OUT "0.000000 %f translate 0.900 -0.900 scale\n" , $width*0.9 ;
# print OUT "612 0 translate \n" ;
# print OUT "90 rotate\n" ; # don't understand this, 
				# but it seems independent of location 
				# Ah! the fact is that .eps means that 
				# the object is always put flush bottom left!
print OUT "0.10 setlinewidth\n" ;

$/ = "";  # read in by the paragraph
$* = 1 ;

if ( $r == 1 ) { $zero = log( $zero ) ;  $range = log( $range ) ; }

&box ( $x0 + $width / 2 , $y0  + $height/2 , 
      $width/2  , $height/2  , $background , "stroke") ;
$l=0; $thiscol=0; $currentrow = 1 ;
$x = $startx = $x0 + $m + $h / 2 ;
$y = $starty = $y0 + $m + $h / 2 ;
if ( $gridy ) {
    for ( $y += $gridy * $h - $h / 2 ; 
	 $y < $y0 +$height - $h ; $y += $gridy * $h ) { 
	&line ( $x0 , $y , $x0 + $width , $y ) ;
    }
}
if ( $grid ) {
    for ( $x += $grid * $h - $h / 2 ; 
	 $x < $x0 + $width - $h ; $x += $grid * $h ) { 
	&line ( $x , $y0 , $x , $y0 + $height ) ;
    }
}
$y = $starty ;
$x = $startx ;
while( ( $_ = <W> )  && ( $currentrow <= $rows) ){
    s/^\s*//; # get rid of initial gap on line 
    @fields=split ;
    if ( $#fields > 0 ) {
	for ( $i = 0 ; $i <= $#fields; $i++)
	{ 
#	    print $fields[$i] ; 
#	    print " ";
	    if ( $max && $fields[$i] > $max ) { $fields[$i] = $max ; }
	    if ( $min && $fields[$i] < $min ) { $fields[$i] = $min ; }
	    $radius = &size ( $fields[$i] ) * $maxbox ;
	    if ( &sign ( $fields[$i] ) < 0.0 ) {
		$g = $neg ;        #  0.0 ;
	    } else { $g = $pos ; } #  1.0 
	    if ( ( $stroke ne "" ) || ( $g != $background ) ) {
		&box ( $x , $y , $radius , $radius , $g , $stroke ) ;
	    }
	    $thiscol++; $x+= $h ;
	    while($thiscol==@num[$l]){
#		print "\n";
		$thiscol=0; $x = $startx ;
		$l++; $y += $h ; $currentrow ++ ;
		if($l>=$lmax){$l=0;}
	    }
	    if( $currentrow > $rows ) { last; }
	}
    }
#    print "\n";
}

print OUT "\$F2psEnd\nshowpage\n" ;

sub size { # returns something between -1 and 1
#usage ( $x )
    local( $x ) = @_ ;
    if ( $r == 1 ) { $x = log ( $x ) ; }
    $ans =  ($x-$zero)/$range ;
    if ( $ans < -0.0 ) { $ans = - $ans ; }
    if ( $ans > 1.0 ) { $ans = 1.0 ; }
    return sqrt($ans) ;
}

sub sign { # returns  -1 / 1
#usage ( $x )
    local( $x ) = @_ ;
    if ( $r == 1 ) { $x = log ( $x ) ; }
    $ans =  ($x-$zero) ;
    if ( $ans > 0.0 ) { $ans = 1.0 ; } else { $ans = -1.0 ; }
    return $ans ;
}

sub box { # draws a box centred on x,y with half width specified. 
# to get a box with an edge, set $stroke=stroke ;
#usage ( $x , $y , $xsize , $ysize, $gray )
 local( $y , $x , $ysize, $xsize, $gray , $stroke ) = @_ ; 
 if($rotate==0) {
     $tmpo = $x ; $x = $y ; $y = $tmpo ; 
     $tmpo = $xsize ; $xsize = $ysize ; $ysize = $tmpo ; 
 }

    printf OUT "newpath %f %f moveto %f %f lineto %f %f lineto %f %f lineto closepath gsave  %f setgray fill grestore %s\n" , 
    $x+$xsize, $y+$ysize, 
    $x+$xsize, $y-$ysize, 
    $x-$xsize, $y-$ysize, 
    $x-$xsize, $y+$ysize, 
    $gray , $stroke ;

}

sub line { # draws a line
#usage ( $x , $y , $x2 , $y2 ) ;
 local( $y , $x , $y2, $x2 ) = @_ ; 
 if($rotate==0) {
     $tmpo = $x ; $x = $y ; $y = $tmpo ; 
     $tmpo = $x2 ; $x2 = $y2 ; $y2 = $tmpo ; 
 }

    printf OUT "newpath %f %f moveto %f %f lineto stroke\n" , 
 $x,$y, $x2,$y2 ;

}