From 6392d990f89103e16cbc7d2e41858b6b2f28c105 Mon Sep 17 00:00:00 2001 From: Stephan Barth Date: Sun, 24 Dec 2023 14:18:23 +0100 Subject: [PATCH] Vorbereitung auf ueberarbeitetes internes Datenformat. --- Manticore/Geometry/Point.pm | 27 ++++++++++++++ Manticore/Geometry/Vector.pm | 29 +++++++++++++++ Manticore/Layer.pm | 72 +++++++++++++++++++++++++++++------- Manticore/Layer/Traverse.pm | 31 ++++++++++++++++ Manticore/Mantis.pm | 66 +++++++++++++++++++++++++++++++++ 5 files changed, 212 insertions(+), 13 deletions(-) create mode 100644 Manticore/Geometry/Point.pm create mode 100644 Manticore/Geometry/Vector.pm create mode 100644 Manticore/Layer/Traverse.pm diff --git a/Manticore/Geometry/Point.pm b/Manticore/Geometry/Point.pm new file mode 100644 index 0000000..bc84f85 --- /dev/null +++ b/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; diff --git a/Manticore/Geometry/Vector.pm b/Manticore/Geometry/Vector.pm new file mode 100644 index 0000000..fdd6b2f --- /dev/null +++ b/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; diff --git a/Manticore/Layer.pm b/Manticore/Layer.pm index 9575585..389e940 100644 --- a/Manticore/Layer.pm +++ b/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|a(?&AB)ba(?&AB)b|a(?&AB)b)$# + my $remain = $cont; + my $parsed = ""; + my @all = (); + while( + $remain=~s#^(\s+)## || + $remain=~s#^((?:[^\s\(\)]+|(?\((?:[^\(\)]+|(?&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|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"}; } } diff --git a/Manticore/Layer/Traverse.pm b/Manticore/Layer/Traverse.pm new file mode 100644 index 0000000..7eb7c5d --- /dev/null +++ b/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; diff --git a/Manticore/Mantis.pm b/Manticore/Mantis.pm index f4a099d..3bc75a9 100644 --- a/Manticore/Mantis.pm +++ b/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;