Vorbereitung auf ueberarbeitetes internes Datenformat.

Manticore/Geometry/Point.pm

@@ -0,0 +1,27 @@
+package Manticore::Geometry::Point;
+
+use strict;
+use warnings;
+
+sub new {
+  my (undef, $x, $y) = @_;
+  return bless [$x,$y]
+}
+
+# parse a string and return as vector
+sub fromText {
+  my (undef,$text)=@_;
+  if($text=~m#^([0-9\.]+),([0-9\.]+)$#) {
+    return bless [$1,$2]
+  } else {
+    return { error=> "Parse error: Not a vector" }
+  }
+}
+
+# difference between two points; returns a vector
+sub diff {
+  my ($self, $other) = @_;
+  return Manticore::Geometry::Vector->new($other->[0]-$self->[0], $other->[1]-$self->[1]);
+}
+
+1;

Manticore/Geometry/Vector.pm

@@ -0,0 +1,29 @@
+package Manticore::Geometry::Vector;
+
+use strict;
+use warnings;
+
+sub new {
+  my (undef, $x, $y) = @_;
+  return bless [$x,$y]
+}
+
+# add point to a vector
+sub add {
+  my ($self, $other) = @_;
+  return Manticore::Geometry::Point->new($other->[0]+$self->[0], $other->[1]+$self->[1]);
+}
+
+# returns the size of a vector
+sub size {
+  my $self = shift;
+  return sqrt($self->[0]*$self->[0]+$self->[1]*$self->[1])
+}
+
+# scalarproduct with another vector
+sub scalar {
+  my ($self, $other) = @_;
+  return $self->[0]*$other->[0] + $self->[1]*$other->[1];
+}
+
+1;

Manticore/Layer.pm

@@ -1,5 +1,7 @@
 package Manticore::Layer;
 
+# package for internal handling and processing of layers
+
 # A layer contains an internal representation of data
 # It renders into a list of objects, which are one of
 #  * non-selfoverlapping polygons with abstract color
@@ -10,20 +12,33 @@ package Manticore::Layer;
 use strict;
 use warnings;
 
+use Manticore::Layer::Traverse;
+
+# Data representation:
+# {
+#   data => internal data format
+#   srcdata => string data representation
+#   mode => kind of the layer
+#   children => child layers
+# };
+
 # renderMode, each entry:
 #  convert -- return the polynomials from the data and sub-layers
 #  parse -- what we parse; either everything or blockwise
 #  parsemode -- do we parse blockwise (that is: whitespace free sequences thay may contain whitespace in (), but these may only contain matching ()s) or total
+#  serialize -- reverse of parse; not neccessary if data modification by other methods is not meant to happen
 #  desc -- description text
 #  children -- meant to have child layers
+# implementby -- implementation of most stuff by a submodule
 
 my %renderMode = (
   traverse => {
-    convert => sub {},
-    parse => sub {
-      my $block = shift;
-    },
+    #convert => sub {},
+    #parse => sub {
+    #  my $block = shift;
+    #},
     parsemode => "blockwise",
+    implementby => sub { return Manticore::Layer::Traverse::fromText(@_)},
     desc => 'A closed traverse line defining the object. That can be a polygon or contain additional interpolation primitives.',
     children => 0,
   },
@@ -85,24 +100,55 @@ my %renderMode = (
   },
 );
 
+# split input into blocks
+sub _splitBlocks {
+  my $cont = shift;
+  # split into blocks
+  # Note: regexes have sub-patterns
+  #  "aababb"=~m#^(?<AB>|ab|a(?&AB)ba(?&AB)b|a(?&AB)b)$#
+  my $remain = $cont;
+  my $parsed = "";
+  my @all = ();
+  while(
+    $remain=~s#^(\s+)## ||
+    $remain=~s#^((?:[^\s\(\)]+|(?<DYCK>\((?:[^\(\)]+|(?&DYCK))*\)))+)##
+  ) {
+    my $tok = $1;
+    $parsed .= $tok;
+    push @all, $tok unless $tok=~m#^\s#;
+  }
+  return { error=>"Could not complete parsing", parsed=> $parsed, remain=>$remain} if $remain;
+  return @all
+}
+
 sub fromText {
-  my (undef, $head, $cont) = @_;
+  my (undef, $head, $cont, $children) = @_;
   if(exists $renderMode{$head}) {
     my $render = $renderMode{$head};
     my @all = ($cont);
     if('blockwise' eq $render->{parsemode}) {
-      # split into blocks
-      # Note: regexes have sub-patterns
-      #  "aababb"=~m#^(?<AB>|ab|a(?&AB)ba(?&AB)b|a(?&AB)b)$#
+      @all = _splitBlocks($cont);
+      if('HASH' eq ref $all[0]) {
+        return $all[0]
+      }
     }
-    my $data = $render->{parse}->($cont);
-    return undef unless $data;
-    return bless {
+    if($render->{implementby}) {
+      return $render->{implementby}->(@all);
+    }
+    my $data = $render->{parse}->(@all);
+    return { error => "Could not parse input" } unless $data;
+    if($data and 'HASH' eq ref $data and $data->{error}) {
+      return { error => "Parse error: $data->{error}" }
+    }
+    my %h = (
       data => $data,
+      srcdata => $cont,
       mode => $head,
-    };
+    );
+    $h{children} = $children if $render->{children};
+    return bless \%h;
   } else {
-    return undef;
+    return { error => "Parse mode non-existent: $head"};
   }
 }
 

Manticore/Layer/Traverse.pm

@@ -0,0 +1,31 @@
+package Manticore::Layer::Traverse;
+
+# Implementation of the traverse line variant of the layer
+
+use strict;
+use warnings;
+
+sub fromText {
+  my @all = @_;
+  my @data = ();
+  for my $bli(0..$#all) {
+    my $bl = $all[$bli];
+    my $v = Manticore::Geometry::Point->new($bl);
+    if('HASH' eq ref $v) {
+      if($bl=~m#^([^\(\)]+)\((.*)\)$#) {
+        push @data, {function=>$1, param=>$2}
+      } else {
+        return { error=>'Not a traverse function', position=>$bli }
+      }
+    } else { # we have a point
+      push @data, $v;
+    }
+  }
+  return bless {
+    data => \@data,
+    srcdata => \@all,
+    mode => "traverse",
+  };
+}
+
+1;

Manticore/Mantis.pm

@@ -54,6 +54,72 @@ my %curvefunctions = (
 my $re_curves = join '|', keys %curvefunctions;
 $re_curves = qr((?:$re_curves));
 
+# split into ===-separated blocks
+sub splitIntoBlocks {
+  my $inp = shift;
+  my @blocks = ([]);
+  for my $line(@$inp) {
+    if($line=~m#^===#) {
+      push @blocks, [$line]
+    } else {
+      push @{$blocks[-1]}, $line
+    }
+  }
+  return \@blocks
+}
+
+# returns a layer read from a file
+sub loadFile {
+  my $fn = shift;
+  my $fh = undef;
+  open($fh, '<', $fn) or die "Could not read file '$fn', because: $!";
+#  my @blocks = ([]);
+#  while(my $line = <$fh>) {
+#    chomp $line;
+#    if($line=~m#^===#) {
+#      push @blocks, [$line]
+#    } else {
+#      push @{$blocks[-1]}, $line
+#    }
+#  }
+  my $blocks = splitIntoBlocks([map {chomp} <$fh>]);
+  my ($head) = @{shift @$blocks};
+  my @blocks = map {loadBlock($_)} @$blocks;
+  if(1==@blocks) {
+    return [$head, $blocks[0]]
+  } else {
+    return [$head, Manticore::Layer->fromText('traverse', '', \@blocks)]
+  }
+}
+
+# format
+#  === name
+#  cont
+#  cont
+#  !=== name
+#  !cont
+#  !=== name
+#  !cont
+sub loadBlock {
+  my $block = shift;
+  my @block = @$block;
+  my @this = ();
+  while(@block and $block[0]!~m#^!#) {
+    push @this, shift @block
+  }
+  s#^!## for @block;
+  my $subblocks = splitIntoBlocks(\@block);
+  shift @$subblocks;
+  my @children = map {loadBlock($_)} @$subblocks;
+  my $head = shift @this;
+  if($head=~m#===\s*(\S+)#) {
+    $head = $1
+  } else {
+    $head = "traverse"
+  }
+  Manticore::Layer->fromText($head, (join "\n", @this), \@children);
+}
+
 sub fontLoader {
   my %p = @_;
   my $lambdaw2a = $p{lambdaw2a} || 0.46;