add first bits of figure support

diff --git a/sweavealike.pm b/sweavealike.pm
index 4747b18c98e65e1fa8d6d46dfcf3212be1d5c479..d330a58706919225541363b9ec039b5acca261f0 100644 (file)
--- a/sweavealike.pm
+++ b/sweavealike.pm
@@ -30,6 +30,9 @@ use Statistics::R;
 
 use IkiWiki '3.00';
 
+use Encode qw(decode);
+use Digest::MD5 qw(md5_hex);
+
 my $id = "sweavealike";
 sub import {
     hook(type => "getsetup", id => $id, call => \&getsetup);
@@ -48,6 +51,11 @@ sub getsetup {
          );
 }
 
+sub code_md5 {
+    my ($code) = @_;
+    return(md5_hex(decode('utf8',$code)));
+}
+
 sub preprocess {
     my %param = @_;
 
@@ -63,6 +71,20 @@ sub preprocess {
        or not length $param{code}) {
        error("There wasn't any R code supplied");
     }
+
+    $param{width} = '400' unless exists $param{width} and defined $param{width};
+    $param{height} = '400' unless exists $param{height} and defined $param{height};
+    for (qw(width height)) {
+       if ($param{$_} !~ /^\d+$/) {
+           error("invalid $_; must be an integer: $param{$_}");
+       }
+    }
+    if (exists $param{picture}) {
+       my $md5 = code_md5($param{code}."width=$param{width}height=$param{height}");
+       my $page_esc = $params->{page};
+       $page_esc =~ s/"/\\"/g;
+       $pagestate{$param{page}}{$id}{R}->run(qq{png(filename="$page_esc",width=$param{width},height=$param{height});});
+    }
     my $code_result;
     eval {
        $code_result = $pagestate{$param{page}}{$id}{R}->run($param{code});
@@ -70,13 +92,25 @@ sub preprocess {
     if ($@) {
        error("code '$param{code}' produced error '$@'");
     }
-    my $output;
-    if (exists $param{verbatim}) {
-       $output = $param{code};
+    if (exists $param{picture}) {
+       $pagestate{$param{page}}{$id}{R}->run(qq{dev.off();});
+    }
+    if (exists $param{nooutput}) {
+       return('');
+    }
+    my $output = '';
+    if (exists $param{echo}) {
+       $output .= $param{code};
        $output =~ s/^/> /mg;
+       $output .= "\n";
+    }
+    if (exists $param{results}) {
+       $output .= $code_result;
+    }
+    if (exists $param{echo} or
+       exists $param{results}) {
+       $output =~ s/^/    /mg;
     }
-    $output .= "\n".$code_result;
-    $output =~ s/^/    /mg;
     return($output);
 }