deskthority

Code: Select all

#!/usr/bin/perl -w

use strict;
use sort 'stable';
use bignum;

sub asin { atan2( $_[0], sqrt(1-$_[0]*$_[0]) ); }
sub acos { atan2( sqrt(1-$_[0]*$_[0]), $_[0] ); }

my $PI=2*atan2(1,0);
my $STEP    = 1;
my $EPSILON = 0.00000001;


my $scale   = 1; # actual scale factor
my $scaleg  = 1; # global scale factor
my $scalefx = 1; # relative scale factor x
my $scalefy = 1; # relative scale factor y

my $test_f    = 0; # draw support lines for testing
my $verbose_f = 0;

my $color="black";
my $testcolor="yellow";

my $line_wd     = 25*$scaleg;
my $testline_wd =  2*$scaleg;

my @testlines=();

my $sizex  = 380;
my $sizey  = 380;
my $shiftx = 190;
my $shifty = 190;

my $rangle = 0; # rotation angle, set by $ROTATE

my $read;
my $write;

my @var=();

my @lines=(); # used by include()

sub norm
{
    my $x=shift;
    my $y=shift;

    return sqrt($x*$x+$y*$y);
}

sub evaluate
{
    my $expr=shift;

    my $res=0;

    $expr =~ s/[+]/|[p]|/g;
    $expr =~ s/[-]/|[m]|/g;
    $expr =~ s/[*]/|[M]|/g;
    $expr =~ s/[\/]/|[D]|/g;

    my @terms=split(/[|]/,$expr);

    my $op="[p]";

    foreach my $term (@terms)
    {
	if($term =~ /[\[]/) { $op = $term; }
	else
	{
	    if($verbose_f) { print "$op : $term\n"; }
	    
	    if(abs($term)<$EPSILON) { $term=0; }


	    if($op =~ /p/) { $res+=$term; }
	    if($op =~ /m/) { $res-=$term; }
	    if($op =~ /M/) { $res*=$term; }
	    if($op =~ /D/) { $res/=$term; }
	}
    }
    if(abs($res)<$EPSILON) { $res=0; }
    return $res;
}

sub applyvars
{
    my $expr=shift;
    my $res = $expr;

    foreach my $vline (@var)
    {
	my @v=split(/[[:space:]]+/,$vline);
	if(@v==2)
	{
	    my $v0=$v[0];
	    my $v1=$v[1];
	    $res =~ s/(^|[-\/*+])$v0($|[-\/*+])/$1$v1$2/g;
	}
    }
    if($verbose_f) { print "applyvars: $expr : $res\n"; }
     # add 0 to make things easier.
    $res =~ s/[-][-]/+/g;
    if($res =~ /^[+-]/) { $res =~ s/^/0/; }
    return $res;
}

sub getvar
{
    my $V=shift;

    foreach my $vline (@var)
    {
	my @v=split(/[[:space:]]+/,$vline);
	if(@v==2)
	{
	    if($V eq $v[0]) { return $v[1]; }
	}
    }
    return "error";
}

sub setvar # retuns 0 if exists and 1 if it is a new variable
{
    my $V   = shift;
    my $val = shift;

    my $value=evaluate(applyvars($val));

    foreach my $vline (@var)
    {
	my @v=split(/[[:space:]]+/,$vline);
	if(@v==2)
	{
	    if($V eq $v[0])
	    {
		$v[1]=$value;
		$vline="$v[0] $v[1]";
		return 0;
	    }
	}
    }
    push(@var,"$V $value");
    return 1;
}


sub rotatex # rotate by global variable $rangle
{
    my $x=shift;
    my $y=shift;
    return (evaluate(applyvars($x))*cos($PI*$rangle/180)+evaluate(applyvars($y))*sin($PI*$rangle/180))*$scalefx;
}

sub rotatey # rotate by global variable $rangle
{
    my $x=shift;
    my $y=shift;
    return (-evaluate(applyvars($x))*sin($PI*$rangle/180)+evaluate(applyvars($y))*cos($PI*$rangle/180))*$scalefy;
}

sub printpreamble
{
    my $x = shift;
    my $y = shift;

    $x*=$scale;
    $y*=$scale;

    print $write "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
    print $write "<!-- Generator: Adobe Illustrator 16.0.0, SVG Export Plug-In . SVG Version: 6.00 Build 0)  -->\n";
    print $write "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">\n";
    print $write "<svg version=\"1.1\" id=\"Layer_1\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" x=\"0px\" y=\"0px\"\n";
    print $write "width=\"$x\" height=\"$y\" viewBox=\"0 0 $x $y\" enable-background=\"new 0 0 $x $y\" xml:space=\"preserve\">\n";
    print $write "<g>\n";

}


sub printend
{
  print $write "</g>\n";
  print $write "</svg>\n\n";
}

sub drawline
{
    my $xs  = shift;
    my $ys  = shift;
    my $xe  = shift;
    my $ye  = shift;
    my $mycolor = shift;

    $xs*=$scale;
    $ys*=$scale;
    $xe*=$scale;
    $ye*=$scale;

    print $write "<line fill=\"none\" stroke=\"$mycolor\" stroke-width=\"$line_wd\"\n";
    print $write "      stroke-linecap=\"round\" stroke-linejoin=\"round\" x1=\"$xs\" y1=\"$ys\" x2=\"$xe\" y2=\"$ye\"/>\n";

    if($test_f)
    {
	push(@testlines,"<line fill=\"none\" stroke=\"$testcolor\" stroke-width=\"$testline_wd\"\n");
	push(@testlines,"      stroke-linecap=\"round\" stroke-linejoin=\"round\" x1=\"$xs\" y1=\"$ys\" x2=\"$xe\" y2=\"$ye\"/>\n");
    }
}


sub drawarc
{
    my $x  = shift; # center x
    my $y  = shift; # center y
    my $r  = shift; # radius
    my $aa = shift; # start angle
    my $bb = shift; # end   angle

    $x*=$scale;
    $y*=$scale;
    $r*=$scale;

    print $write "<polyline fill=\"none\" stroke=\"$color\" stroke-width=\"$line_wd\"\n";
    print $write "          stroke-linecap=\"round\" stroke-linejoin=\"round\"\n";
    print $write "          points=\"";
    if($test_f)
    {
	push(@testlines,"<polyline fill=\"none\" stroke=\"$testcolor\" stroke-width=\"$testline_wd\"\n");
	push(@testlines,"          stroke-linecap=\"round\" stroke-linejoin=\"round\"\n");
	push(@testlines,"          points=\"");
    }

    if($aa<$bb)
    {
	for(my $ii=$aa;$ii<=$bb;$ii+=$STEP)
	{
	    my $xx=$x+$r*cos($ii/180*$PI);
	    my $yy=$y-$r*sin($ii/180*$PI);
	    print $write "$xx,$yy\n";
	    if($test_f)
	    {
		push(@testlines,"$xx,$yy\n");
	    }
	}
    }
    print $write "\"/>\n\n";
    if($test_f)
    {
	push(@testlines,"\"/>\n\n");
    }
}

sub drawbezierhead
{
    my $Xs=shift;
    my $Ys=shift;
    $Xs*=$scale;
    $Ys*=$scale;
    
    print $write "<path d=\"M $Xs $Ys ";
    if($test_f)
    {
	push(@testlines,"<path d=\"M $Xs $Ys ");
    }
}

sub drawbezierfoot
{
    print $write "\"\n";
    print $write "      stroke-linecap=\"round\" fill=\"none\" stroke=\"$color\"\n";
    print $write "      stroke-width=\"$line_wd\"/>\n";
    if($test_f)
    {
	push(@testlines,"\"\n");
	push(@testlines,"      stroke-linecap=\"round\" fill=\"none\" stroke=\"$testcolor\"\n");
	push(@testlines,"      stroke-width=\"$testline_wd\"/>\n");
    }
}


sub drawbezier
{
    my $Xs=shift;
    my $Ys=shift;
    my $Vs=shift;
    my $Ws=shift;
    my $Xe=shift;
    my $Ye=shift;
    my $Ve=shift;
    my $We=shift;
    
    $Xs*=$scale;
    $Ys*=$scale;
    $Vs*=$scale;
    $Ws*=$scale;
    $Xe*=$scale;
    $Ye*=$scale;
    $Ve*=$scale;
    $We*=$scale;
    
    print $write "\nC $Vs $Ws $Ve $We $Xe $Ye "; 

    if($test_f)
    {
	push(@testlines,"\nC $Vs $Ws $Ve $We $Xe $Ye ");
    }
}

sub include
{
    my $includefile=shift;

    if($includefile=~ /^[[:alnum:]]([[:alnum:][:punct:]]*)$/)
    {
	if(!($includefile =~ /[.]val$/)) { $includefile =~ s/$/.val/; }
	$includefile =~ s/^/val\//;
	my $iread;
	open($iread, "<", "$includefile") or die "file $includefile not found. $!";
	while (<$iread>)
	{
	    my $iline = $_;
	    $iline =~ s/\n//g;
	    $iline =~ s/[[:space:]]//g;
	    if($iline =~ /^[\$]INCLUDE[\(]/)
	    {
		$iline =~ s/^[\$]INCLUDE[\(](.*)[\)]$/$1/;
		include($iline);
	    }
	    else { push(@lines,$iline); }
	}
	close($iread);
    }
}

sub main
{
    my @myargs=();
    my $px    = 0;
    my $py    = 0;
    my $angle = 0;
    my $fx    = 0;
    my $bezier_f=0;
    my @test=(); # store support lines for bezier curves

    for(@ARGV)
    {
	my $myarg  = $_;
	   if($myarg =~ /^[-][-]/) { push(@myargs,$myarg); }
	elsif($myarg =~ /^[-]/)
	{
	    my @splitarg = split(//,$myarg);
	    foreach my $ch (@splitarg)
	    {
		if(!($ch eq "-")) { push(@myargs,"-$ch"); }
	    }
	}
	else { push(@myargs,$myarg); }
    }

    my $infile="error";
    my $outfile="/dev/null/error.svg";

    for(@myargs)
    {
	my $myarg  = $_;
	my @mountpos = ();
	my @stabs    = ();
	if($verbose_f) { print "ARG: $myarg\n"; }
	if($myarg eq "--help" || $myarg eq "-h")
	{
	    print "For help, please refer to the source code.\n";
	    print ":o\n";
	    return 0;
	}
	elsif($myarg eq "--test" || $myarg eq "-t")
	{
	    $test_f=1;
	}
	elsif($myarg eq "--verbose" || $myarg eq "-v")
	{
	    $verbose_f=1;
	}
	elsif($myarg eq "--production" || $myarg eq "-p")
	{
	    $scaleg= 72/1000;
	    $scale = $scaleg;
	    $line_wd=25*$scaleg;
	}
	elsif(!($myarg =~ /^[-]/)) # input file
	{
	    if($myarg=~ /^[[:alnum:]]([[:alnum:][:punct:]]*)$/)
	    {
		$infile=$myarg;
		if(!($infile =~ /[.]val$/)) { $infile =~ s/$/.val/; }
		$outfile=$infile;
		$outfile =~ s/[.]val/.svg/;
		$infile =~ s/^/val\//;
		$outfile =~ s/^/svg\//;
	    }
	}
    }

    if($infile eq "error")
    {
	print "error, input file not specified.\n";
	return -1;
    }

    open($read, "<", "$infile") or die "file $infile not found. $!";
    open($write, ">", "$outfile") or die "file $outfile not writable. $!";

    my $preamble_f=1;

    while (<$read>)
    {
	my $rline = $_;
	$rline =~ s/\n//g;
	$rline =~ s/[[:space:]]//g;
	push(@lines,$rline);
	
	foreach my $line (@lines)
	{
	    if($verbose_f) { print "line: $line\n"; }
	    if($line =~ /^[\$]SIZE/)
	    {
		if($verbose_f) { print "SIZE:\n"; }
		$line =~ s/^[\$]SIZE[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==2)
		{
		    $sizex=evaluate(applyvars($splitline[0]));
		    $sizey=evaluate(applyvars($splitline[1]));
		}
		next;
	    }
	    elsif($line =~ /^[\$]REM/) { next; }
	    elsif($preamble_f)
	    {
		printpreamble($sizex,$sizey);
		$preamble_f=0;
	    }
	    
	    if($line =~ /^[\$]VAR/)
	    {
		if($verbose_f) { print "VAR:\n"; }
		$line =~ s/^[\$]VAR//;
		$line =~ s/([;]*)$//;
		my @splitline=split(/[=]/,$line);
		if(@splitline==2)
		{
		    setvar($splitline[0],$splitline[1]);
		    next;
		}
	    }
	    elsif($line =~ /^[\$]INCLUDE[\(]/)
	    {
		if($bezier_f) { drawbezierfoot(); $bezier_f=0; }
		if($verbose_f) { print "INCLUDE:\n"; }
		$line =~ s/^[\$]INCLUDE[\(](.*)[\)]$/$1/;
		include($line);
		next;
	    }
	    elsif($line =~ /^[\$]CENTER[\(]/)
	    {
		if($verbose_f) { print "CENTER:\n"; }
		$line =~ s/^[\$]CENTER[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==2)
		{
		    $shiftx=evaluate(applyvars($splitline[0]));
		    $shifty=evaluate(applyvars($splitline[1]));
		    next;
		}
	    }
	    elsif($line =~ /^[\$]SCALE[\(]/)
	    {
		if($bezier_f) { drawbezierfoot(); $bezier_f=0; }
		if($verbose_f) { print "SCALE:\n"; }
		$line =~ s/^[\$]SCALE[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==1)
		{
		    my $newscale=evaluate(applyvars($splitline[0]));

		    if($scalefx<0 && $newscale>0) { $scalefx =-$newscale; }
		    else                          { $scalefx = $newscale; }

		    if($scalefy<0 && $newscale>0) { $scalefy =-$newscale; }
		    else                          { $scalefy = $newscale; }
		}
		elsif(@splitline==2)
		{
		    $scalefx=evaluate(applyvars($splitline[0]));
		    $scalefy=evaluate(applyvars($splitline[1]));
		}
	    }
	    elsif($line =~ /^[\$]ROTATE[\(]/)
	    {
		if($bezier_f) { drawbezierfoot(); $bezier_f=0; }
		if($verbose_f) { print "ROTATE:\n"; }
		$line =~ s/^[\$]ROTATE[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==1)
		{
		    $rangle=evaluate(applyvars($splitline[0]));
		}
	    }
	    elsif($line =~ /^[\$]FLIP[\(]/)
	    {
		if($bezier_f) { drawbezierfoot(); $bezier_f=0; }
		if($verbose_f) { print "FLIP:\n"; }
		$line =~ s/^[\$]FLIP[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==1)
		{
		    $rangle=evaluate(applyvars($splitline[0]));
		    $scalefx=-$scalefx;
		}
	    }
	    elsif($line =~ /^[\$]WIDTH[\(]/)
	    {
		if($verbose_f) { print "WIDTH:\n"; }
		$line =~ s/^[\$]WIDTH[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==1)
		{
		    $line_wd=evaluate(applyvars($splitline[0]))*$scaleg;
		}
	    }
	    elsif($line =~ /^[\$]MOVE[\(]/)
	    {
		if($bezier_f) { drawbezierfoot(); $bezier_f=0; }
		if($verbose_f) { print "MOVE:\n"; }
		$line =~ s/^[\$]MOVE[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==2)
		{
		    $px=$splitline[0];
		    $py=$splitline[1];
		    next;
		}
	    }
	    elsif($line =~ /^[\$]LINE[\(]/)
	    {
		if($bezier_f) { drawbezierfoot(); $bezier_f=0; }
		if($verbose_f) { print "LINE:\n"; }
		$line =~ s/^[\$]LINE[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline==2)
		{
		    my $Xs=rotatex($px,$py)+$shiftx;
		    my $Ys=rotatey($px,$py)+$shifty;
		    my $Xe=rotatex($splitline[0],$splitline[1])+$shiftx;
		    my $Ye=rotatey($splitline[0],$splitline[1])+$shifty;
		    drawline($Xs,$Ys,$Xe,$Ye,$color);
		    $px=$splitline[0];
		    $py=$splitline[1];
		    next;
		}
	    }
	    elsif($line =~ /^[\$]MOVEB[\(]/)
	    {
		if($verbose_f) { print "MOVEB:\n"; }
		$line =~ s/^[\$]MOVEB[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		if(@splitline>1)
		{
		    $px = $splitline[0];
		    $py = $splitline[1];
		}
		if(@splitline>2)
		{
		    $angle = evaluate(applyvars($splitline[2]));
		}
		if(@splitline>3)
		{
		    $fx    = evaluate(applyvars($splitline[3]));
		}
	    }
	    elsif($line =~ /^[\$]DRAWB[\(]/)
	    {
		if($verbose_f) { print "DRAWB:\n"; }
		$line =~ s/^[\$]DRAWB[\(](.*)[\)]$/$1/;
		my @splitline=split(/[,]/,$line);
		my $Xs=rotatex($px,$py)+$shiftx;
		my $Ys=rotatey($px,$py)+$shifty;
		my $Vs=rotatex(evaluate(applyvars($px))+$fx*cos($PI*$angle/180),evaluate(applyvars($py))-$fx*sin($PI*$angle/180))+$shiftx;
		my $Ws=rotatey(evaluate(applyvars($px))+$fx*cos($PI*$angle/180),evaluate(applyvars($py))-$fx*sin($PI*$angle/180))+$shifty;

		if(@splitline>0)
		{
		    $px    = $splitline[0];
		}
		if(@splitline>1)
		{
		    $py    = $splitline[1];
		}
		if(@splitline>2)
		{
		    $angle = evaluate(applyvars($splitline[2]));
		}
		if(@splitline>3)
		{
		    $fx    = evaluate(applyvars($splitline[3]));
		}
		my $Xe=rotatex($px,$py)+$shiftx;
		my $Ye=rotatey($px,$py)+$shifty;
		my $Ve=rotatex(evaluate(applyvars($px))+$fx*cos($PI*$angle/180),evaluate(applyvars($py))-$fx*sin($PI*$angle/180))+$shiftx;
		my $We=rotatey(evaluate(applyvars($px))+$fx*cos($PI*$angle/180),evaluate(applyvars($py))-$fx*sin($PI*$angle/180))+$shifty;

		if(!$bezier_f)
		{
		    drawbezierhead($Xs,$Ys);
		    $bezier_f=1;
		}
		drawbezier($Xs,$Ys,$Vs,$Ws,$Xe,$Ye,$Ve,$We);
		if($test_f)
		{
		    push(@test,"$Xs,$Ys,$Vs,$Ws,red");
		    push(@test,"$Xe,$Ye,$Ve,$We,green");
		}
	    }
	}
	@lines=();
    }

    if($bezier_f) { drawbezierfoot(); $bezier_f=0; }


    if($test_f)
    {
	my $myline_wd=$line_wd;
	$line_wd=$testline_wd;

	print $write "\n";
	print $write "\n";
	foreach my $line (@testlines)
	{
	    print $write "$line";
	}

	print $write "\n";
	print $write "\n";

	foreach my $line (@test)
	{
	    my @sline = split(/,/,$line);
	    if(@sline==5)
	    {
		drawline($sline[0],$sline[1],$sline[2],$sline[3],$sline[4]);
	    }
	}
	$line_wd=$myline_wd;
    }

    printend();

    close($read);
    close($write);

    print "output written to:\n\n$outfile\n\n";
}


main();

# eof.

Code: Select all

$SCALE(0.51)
$CENTER(190,86)
$INCLUDE(smalldollar)

$SCALE(0.7)
$CENTER(190,294)
$INCLUDE(four)

Code: Select all

$REM smalldollar
$INCLUDE(smallS)
$MOVE( 0,-140)
$LINE( 0,-110)
$MOVE( 0, 140)
$LINE( 0, 110)

Code: Select all

$REM 4
$VAR T= 104
$VAR L=  80
$VAR I=L-50
$VAR U=T-60
$MOVE( I, T)
$LINE( I,-T)
$LINE(-L, U)
$LINE( L, U)

Code: Select all

$REM smallS
$MOVEB( 67,-90, 145,80)
$DRAWB(-70,-57,  90,40)
$MOVEB(-70,-57, -90,82)
$DRAWB( 75, 47,  90,85)
$MOVEB( 75, 47, -90,62)
$DRAWB(-75, 73, 315,82)

Code: Select all

$SCALE(0.7)

$CENTER(190,86)
$INCLUDE(arrow)

$CENTER(190,294)
$INCLUDE(G)

Code: Select all

$VAR  T=104
$VAR  L=-25
$VAR  M=-35
$VAR  H= 28
$MOVE( 0, T)
$LINE( 0,-T)
$LINE(-H,  L)
$LINE( 0,  M)
$LINE( H,  L)
$LINE( 0, -T)

Code: Select all

$MOVEB( 65,-72, 135,90)
$DRAWB(-85,  0,  90,90)
$MOVEB(-85,  0, -90,105)
$DRAWB( 85, 62, 230,100)
$LINE(85,0)
$LINE(30,0)