manticore/Manticore/Layer.pm

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
#  * Named lines
#  * Named points
#  * Named float values

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;
    #},
    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,
  },
  polynom => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'A polynomial whichs positive set defines the object.',
    children => 0,
  },
  union => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'Several layers atop of each other; the higher/earlier layers cover the layers below. It has the color if the color can be seen in the highest layer',
    children => 1,
  },
  intersect => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'Several layers atop of each other; color is only there if it is there in every layer and the same.',
    children => 1,
  },
  difference => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'Several layers atop of each other; color of the first layer unless any of the further layers has this color as well.',
    children => 1,
  },
  hull => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'Convex hull of the object.',
    children => 1,
  },
  sum => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'Minkowsky sum of the sub objects.',
    children => 1,
  },
  recol => {
    convert => sub {},
    parse => sub {},
    parsemode => "blockwise",
    desc => 'Recolorize the sub objects.',
    children => 1,
  },
  file => {
    convert => sub {},
    parse => sub {},
    parsemode => "everything",
    desc => 'Load the data from an external file.',
    children => 0,
  },
);

# 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, $children) = @_;
  if(exists $renderMode{$head}) {
    my $render = $renderMode{$head};
    my @all = ($cont);
    if('blockwise' eq $render->{parsemode}) {
      @all = _splitBlocks($cont);
      if('HASH' eq ref $all[0]) {
        return $all[0]
      }
    }
    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 { error => "Parse mode non-existent: $head"};
  }
}


1;