Initialer Commit.
This commit is contained in:
Stephan Barth
parent
9700c97d13
commit
c6f972110d
216
Manticore/Mantis.pm
Normal file
216
Manticore/Mantis.pm
Normal file
@ -0,0 +1,216 @@
|
||||
package Manticore::Mantis;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Math::Trig;
|
||||
|
||||
our %font;
|
||||
|
||||
my %curvefunctions = (
|
||||
curve => sub {
|
||||
my $ratio = shift;
|
||||
return ($ratio, 1-$ratio, $ratio)
|
||||
},
|
||||
smooth => sub {
|
||||
my $ratio = shift;
|
||||
my $sr = 0;
|
||||
if($ratio < 0) {
|
||||
$sr = 0
|
||||
} elsif($ratio > 1) {
|
||||
$sr = 1
|
||||
} else {
|
||||
my $sq = $ratio*$ratio;
|
||||
$sr = -2*$ratio*$sq+3*$sq
|
||||
}
|
||||
return ($ratio, 1-$ratio, $sr);
|
||||
},
|
||||
circ => sub {
|
||||
# On a right angled curve point that has both ends at the same location we get a perfect circle
|
||||
# formula derived on a sheet of paper
|
||||
my $ratio = shift;
|
||||
my $pirat = $ratio*pi/2;
|
||||
my $s = sin $pirat;
|
||||
my $c = cos $pirat;
|
||||
my $ratV = ($c + $s*($s-1)/$c);
|
||||
my $ratU = ($s - $c*(1-$c)/$s);
|
||||
my $dxU = $s*($s-1)/$c;
|
||||
my $dyU = 1-$s;
|
||||
my $dxV = 1-$c;
|
||||
my $dyV = $c*(1-$c)/$s;
|
||||
my $l2 = sqrt($dxU*$dxU + $dyU*$dyU);
|
||||
my $l1 = sqrt($dxV*$dxV + $dyV*$dyV);
|
||||
#print "[[ $ratio -> $ratU $ratV $l1 $l2 ]]\n";
|
||||
return
|
||||
(
|
||||
$ratU,
|
||||
$ratV,
|
||||
$l1/($l1+$l2)
|
||||
#$ratio
|
||||
)
|
||||
},
|
||||
);
|
||||
my $re_curves = join '|', keys %curvefunctions;
|
||||
$re_curves = qr((?:$re_curves));
|
||||
|
||||
sub fontLoader {
|
||||
my %p = @_;
|
||||
my $lambdaw2a = $p{lambdaw2a} || 0.46;
|
||||
my $lambdaw2b = $p{lambdaw2b} || 0.28;
|
||||
%font = (
|
||||
W2=>{
|
||||
data => [
|
||||
[[0+3*$lambdaw2a,0+6*$lambdaw2a], [1+3*$lambdaw2b,0+6*$lambdaw2b], [4,6], [3,6]],
|
||||
[[3,6], [4,6], [5.5,3.2], [4.5,3.2]],
|
||||
[[4.5,3.2], [5.5,3.2], [7,6], [6,6]],
|
||||
[[6,6], [7,6], [10,0], [9,0]],
|
||||
]
|
||||
},
|
||||
);
|
||||
if(my $dir = $p{dir}) {
|
||||
my $dh = undef;
|
||||
opendir($dh, $dir) or die "Could not read directory '$dir', because: $!";
|
||||
while(my $fn = readdir($dh)) {
|
||||
next unless $fn=~m#(.*)\.mant$#;
|
||||
my $gly = $1;
|
||||
my $fullfile = "$dir/$fn";
|
||||
my $fh = undef;
|
||||
open($fh, '<', $fullfile) or die "Could not read file '$fullfile', because: $!";
|
||||
my @blocks = ([]);
|
||||
while(my $line = <$fh>) {
|
||||
if($line=~m#^===#) {
|
||||
push @blocks, []
|
||||
} else {
|
||||
push @{$blocks[-1]}, $line
|
||||
}
|
||||
}
|
||||
my ($head) = @{shift @blocks};
|
||||
if($head=~m#^(\S+)#) {
|
||||
die "Head glyphem identifier does not equal file name in '$fullfile' ('$1' vs. '$gly')" unless $1 eq $gly
|
||||
} else {
|
||||
die "Malformed head in file $fullfile"
|
||||
}
|
||||
$font{$gly}{data} = [map {rowText2data(join '', @$_)} @blocks]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub font { return %font }
|
||||
|
||||
# return display data out of a glyphem name
|
||||
sub glyphemDisplay {
|
||||
my $gly = shift;
|
||||
#return [map {[map {@$_} @$_]} @{$font{$gly}{data}}];
|
||||
my $data = glyphemData($gly);
|
||||
return undef unless defined $data;
|
||||
return [map {rowData2display($_)} @$data]
|
||||
}
|
||||
|
||||
# return definition data out of a glyphem name
|
||||
sub glyphemData {
|
||||
my $gly = shift;
|
||||
return $font{$gly}{data};
|
||||
}
|
||||
|
||||
# Glyphems are stored per line and in the modes
|
||||
# text -- the textual representation
|
||||
# data -- the complete data representation
|
||||
# display -- display mode as flattened coordinate list
|
||||
# Conversion subs are
|
||||
# rowData2text, rowText2data, rowData2display
|
||||
# as Display is information rendered into linear vectors there is no rowDisplay2data
|
||||
|
||||
sub rowData2text {
|
||||
my $fg = shift;
|
||||
my @text = ();
|
||||
for my $i(0..$#$fg) {
|
||||
my $point = $fg->[$i];
|
||||
if('ARRAY' eq ref $point) {
|
||||
$point = "$point->[0],$point->[1]"
|
||||
} elsif('HASH' eq ref $point) {
|
||||
$point = "$point->{fun}($point->{par})";
|
||||
}
|
||||
push @text, $point;
|
||||
}
|
||||
my $astext = '';
|
||||
#join ' ', @text;
|
||||
for(0..$#text) {
|
||||
$astext .= $text[$_];
|
||||
if($_ != $#text) {
|
||||
$astext .= (5 != $_ % 6) ? " " : "\n"
|
||||
}
|
||||
}
|
||||
return $astext;
|
||||
}
|
||||
|
||||
# generate a data row out of a content block
|
||||
sub rowText2data {
|
||||
my $content = shift;
|
||||
my @blocks = ();
|
||||
$content=~s#(-?[0-9\.]+,-?[0-9\.]+|$re_curves\([0-9]+\))#push @blocks,$1;""#ge;
|
||||
if($content!~m#^\s*$#) {
|
||||
warn "Leftover characters: $content"
|
||||
#print "<<@blocks>> [[$content]]\n"
|
||||
}
|
||||
my @lblock = map {
|
||||
my $ret = undef;
|
||||
if(m#(.*),(.*)#) {
|
||||
$ret = [$1,$2]
|
||||
} elsif(m#([a-z]+)\(([0-9]+)\)#) {
|
||||
$ret = {fun=>$1, par=>$2}
|
||||
} else {
|
||||
die "Illegal data state (\$content was preparsed but that did let pass the illegal string '$_')";
|
||||
}
|
||||
$ret
|
||||
} @blocks;
|
||||
return \@lblock;
|
||||
}
|
||||
|
||||
|
||||
sub rowData2display {
|
||||
my $i = shift;
|
||||
#return [map {@$_} @$i]
|
||||
my @dis = @$i;
|
||||
my @ret = ();
|
||||
for(0..$#dis) {
|
||||
my $pre = $dis[$_-4];
|
||||
my $xy0 = $dis[$_-3];
|
||||
my $here = $dis[$_-2];
|
||||
my $xy1 = $dis[$_-1];
|
||||
my $post = $dis[$_];
|
||||
if('ARRAY' eq ref $here) {
|
||||
if('ARRAY' eq ref $xy0 and 'ARRAY' eq ref $xy1) {
|
||||
push @ret, @$here; # normal point context, we don't do anything fancy
|
||||
} else {
|
||||
# intentionally empty as we use this point for context of the function and not for something else
|
||||
}
|
||||
} elsif('HASH' eq ref $here) {
|
||||
if('ARRAY' eq ref $xy0 and 'ARRAY' eq ref $xy1 and 'ARRAY' eq ref $post and 'ARRAY' eq ref $pre) {
|
||||
my $func = $curvefunctions{$here->{fun}};
|
||||
my $count = $here->{par};
|
||||
# Old code state: function is curve, as we do not support anything else so far
|
||||
# TODO New code state: func contains a function ratio -> ratio in line 1 -> ratio in line 2 -> ratio between lines
|
||||
#print "===\n";
|
||||
for my $lambda(1..$count) {
|
||||
my $preratio = $lambda/($count+1);
|
||||
#my $s = sin($ratio*pi/2);
|
||||
#my $c = cos($ratio*pi/2);
|
||||
my ($ratio, $r1, $rel1) = $func->($preratio);
|
||||
my $rel2 = 1-$rel1;
|
||||
#my $r1 = 1-$ratio;
|
||||
my $xypre = [$pre->[0]*(1-$ratio) + $xy0->[0]*$ratio, $pre->[1]*(1-$ratio) + $xy0->[1]*$ratio];
|
||||
my $xypost = [$post->[0]*(1-$r1) + $xy1->[0]*$r1, $post->[1]*(1-$r1) + $xy1->[1]*$r1];
|
||||
my $pushy = [$xypre->[0]*$rel2 + $xypost->[0]*$rel1, $xypre->[1]*$rel2 + $xypost->[1]*$rel1,];
|
||||
#print "<<$ratio $r1 -- [@$pre !! @$xy0] [@$xy1 !! @$post]\n [@$xypre] [@$xypost]\n [@$pushy]>>\n";
|
||||
push @ret, @$pushy;
|
||||
}
|
||||
} else {
|
||||
die "Illegal data, probably two functions too close to each other"
|
||||
}
|
||||
} else {
|
||||
die "illegal data: neither ARRAY nor HASH";
|
||||
}
|
||||
}
|
||||
return \@ret
|
||||
}
|
||||
|
||||
1;
|
||||
67
doc/curveformulae
Normal file
67
doc/curveformulae
Normal file
@ -0,0 +1,67 @@
|
||||
Curves are a transition from one line to another such that a curved line
|
||||
emerges.
|
||||
For doing so one needs to interpolate between 4 points.
|
||||
|
||||
curve is a simple curve with linear interpolation twice;
|
||||
looks quite curvy anyway
|
||||
|
||||
smooth is a smoother interpolation with continous derivations at its end
|
||||
when continuing with the constant 0 or 1 function
|
||||
|
||||
f(0) = 0
|
||||
f(1) = 1
|
||||
f'(0) = 0
|
||||
f'(1) = 0
|
||||
|
||||
f = bx^3+cx^2+dx+e
|
||||
f' = 3bx^2 + 2cx + d
|
||||
|
||||
f(0) = 0 -> e=0
|
||||
f(1) = 1 -> b+c+d+e = 1
|
||||
f'(0) = 0 -> d = 0
|
||||
f'(1) = 0 -> 3b+2c+d = 0
|
||||
|
||||
b+c = 1
|
||||
3b+2c = 0
|
||||
|
||||
c = 3
|
||||
b = -2
|
||||
|
||||
-2*$x*$x*$x+3*$x*$x
|
||||
|
||||
circ is an interpolation that results in a proper quarter circle when
|
||||
used on two interpolation base lines of the same length that have a
|
||||
common vertex
|
||||
|
||||
\
|
||||
\
|
||||
--------U----+
|
||||
-----....\ |
|
||||
"X |
|
||||
\\ |
|
||||
\\|
|
||||
|V
|
||||
||\
|
||||
|| \
|
||||
|
||||
X = (cos phi, sin phi) = (x,y)
|
||||
|
||||
l = (x + µ y, y - µ y)
|
||||
|
||||
U = (x + µ1 y, y - µ1 x = 1)
|
||||
V = (x + µ2 y = 1, y - µ2 x)
|
||||
|
||||
µ1 = (y-1)/x
|
||||
µ2 = (1-x)/y
|
||||
|
||||
U = (x + y(y-1)/x, 1)
|
||||
V = (1, y - x(1-x)/y)
|
||||
|
||||
dxU = y(y-1)/x
|
||||
dyU = 1-y
|
||||
dxV = 1-x
|
||||
dyV = x(1-x)/y
|
||||
|
||||
l1 = sqrt (dxU*dxU + dyU*dyU)
|
||||
l2 = sqrt (dxV*dxV + dyV*dyV)
|
||||
|
||||
BIN
fonts/refont/.IconOK.ff.swp
Normal file
BIN
fonts/refont/.IconOK.ff.swp
Normal file
Binary file not shown.
7
fonts/refont/IconCourseFavouriteAutomatic.mant
Normal file
7
fonts/refont/IconCourseFavouriteAutomatic.mant
Normal file
@ -0,0 +1,7 @@
|
||||
IconCourseFavouriteAutomatic
|
||||
===
|
||||
3,4.5 1,3.5 3,4 5,4 7,3.5 5,4.5
|
||||
6,7 4,5 2,7
|
||||
===
|
||||
3.5,3.75 1.5,3.5 3.25,3.5 4,1 4.75,3.5 6.5,3.5
|
||||
4.5,3.75 4,1.75
|
||||
4
fonts/refont/IconCourseFavouriteManual.mant
Normal file
4
fonts/refont/IconCourseFavouriteManual.mant
Normal file
@ -0,0 +1,4 @@
|
||||
IconCourseFavouriteManual
|
||||
===
|
||||
3,4.5 1,3.5 3.25,3.5 4,1 4.75,3.5 7,3.5
|
||||
5,4.5 6,7 4,5 2,7
|
||||
8
fonts/refont/IconCourseFavouriteOff.mant
Normal file
8
fonts/refont/IconCourseFavouriteOff.mant
Normal file
@ -0,0 +1,8 @@
|
||||
IconCourseFavouriteOff
|
||||
===
|
||||
3,4.5 1,3.5 2.75,3.5 5.75,6.5 6,7 4,5
|
||||
2,7
|
||||
===
|
||||
3.5,2.75 4,1 4.75,3.5 7,3.5 5.125,4.375
|
||||
===
|
||||
1.25,1.75 1.75,1.25 6.75,6.25 6.25,6.75
|
||||
6
fonts/refont/IconLanguage.mant
Normal file
6
fonts/refont/IconLanguage.mant
Normal file
@ -0,0 +1,6 @@
|
||||
IconLanguage
|
||||
===
|
||||
1,0.5 1.5,0.5 1.5,1.5 2.5,1.25 3,1.25 3.5,1.25
|
||||
4,1.5 4.5,1.75 5,1.75 5.5,1.75 6,1.5 6,4
|
||||
5.5,4.25 5,4.25 4.5,4.25 4,4 3.5,3.75 3,3.75
|
||||
2.5,3.75 1.5,4 1.5,7.5 1,7.5
|
||||
5
fonts/refont/IconNotOK.mant
Normal file
5
fonts/refont/IconNotOK.mant
Normal file
@ -0,0 +1,5 @@
|
||||
IconNotOK
|
||||
===
|
||||
1.5,2 2.25,1.25 6.75,5.75 6,6.5
|
||||
===
|
||||
1.5,5.75 2.25,6.5 6.75,2 6,1.25
|
||||
5
fonts/refont/IconOK.mant
Normal file
5
fonts/refont/IconOK.mant
Normal file
@ -0,0 +1,5 @@
|
||||
IconOK
|
||||
===
|
||||
1,4 1.75,3.25 3.75,5.25 3,6
|
||||
===
|
||||
2.75,5.75 3.5,6.5 7,3 6.25,2.25
|
||||
3
fonts/refont/IconProblem.mant
Normal file
3
fonts/refont/IconProblem.mant
Normal file
@ -0,0 +1,3 @@
|
||||
IconProblem
|
||||
===
|
||||
1.5,4.5 4,0.5 4,3.5 6.5,3.5 4,7.5 4,4.5
|
||||
5
fonts/refont/IconVisible.mant
Normal file
5
fonts/refont/IconVisible.mant
Normal file
@ -0,0 +1,5 @@
|
||||
IconVisible
|
||||
===
|
||||
1,4 2.5,2.5 curve(10) 2,1.5 3.5,2 4.5,2
|
||||
6,1.5 curve(10) 5.5,2.5 7,4 5.5,5.5 curve(10)
|
||||
6,6.5 4.5,6 3.5,6 2,6.5 curve(10) 2.5,5.5
|
||||
7
fonts/refont/IconWarning.mant
Normal file
7
fonts/refont/IconWarning.mant
Normal file
@ -0,0 +1,7 @@
|
||||
IconWarning
|
||||
===
|
||||
3,0.75 5,0.75 4.5,5.25 3.5,5.25
|
||||
===
|
||||
3.625,6 curve(10) 3.5,6.125 3.5,6.5 3.5,6.875 curve(10)
|
||||
3.625,7 4,7 4.375,7 curve(10) 4.5,6.875 4.5,6.5
|
||||
4.5,6.125 curve(10) 4.375,6 4,6
|
||||
7
fonts/uwx/I.mant
Normal file
7
fonts/uwx/I.mant
Normal file
@ -0,0 +1,7 @@
|
||||
I
|
||||
===
|
||||
1.5,6 2.5,6 5.5,0 4.5,0
|
||||
===
|
||||
3,0 7,0 6.5,1 2.5,1
|
||||
===
|
||||
0.5,5 4.5,5 4,6 0,6
|
||||
7
fonts/uwx/N.mant
Normal file
7
fonts/uwx/N.mant
Normal file
@ -0,0 +1,7 @@
|
||||
N
|
||||
===
|
||||
0,6 1,6 4,0 3,0
|
||||
===
|
||||
3,6 4,6 4,0 3,0
|
||||
===
|
||||
3,6 4,6 7,0 6,0
|
||||
11
fonts/uwx/O.mant
Normal file
11
fonts/uwx/O.mant
Normal file
@ -0,0 +1,11 @@
|
||||
O
|
||||
===
|
||||
1,2 0.5,3 -0.5,5 curve(20) -1,6 0.75,6
|
||||
1.75,6 3,6 curve(20) 3,6 4,4 4,2
|
||||
3,4 2.5,5 curve(20) 2.5,5 1.5,5 0.5,5
|
||||
curve(20) 0.5,5 1.25,3.5 2,2
|
||||
===
|
||||
4,4 4.5,3 5.5,1 curve(20) 6,0 4.25,0
|
||||
3.25,0 2,0 curve(20) 2,0 1,2 1,4
|
||||
2,2 2.5,1 curve(20) 2.5,1 3.5,1 4.5,1
|
||||
curve(20) 4.5,1 3.75,2.5 3,4
|
||||
13
fonts/uwx/R.mant
Normal file
13
fonts/uwx/R.mant
Normal file
@ -0,0 +1,13 @@
|
||||
R
|
||||
===
|
||||
3,3 4,3 4.5,4 4.75,4.5 curve(20) 4.75,4.5 4.5,5 4,6
|
||||
3,6 3.5,5 3.75,4.5 curve(20) 3.75,4.5 3.5,4
|
||||
===
|
||||
0,6 1,6 4,0 3,0
|
||||
===
|
||||
2,2.5 4,2.5 4,3.5 2,3.5
|
||||
===
|
||||
4.75,1 3.25,1 3.25,0 5.75,0 7,0 curve(20)
|
||||
7,0 6.5,1 5.75,2.5 5.25,3.5 curve(20) 5.25,3.5
|
||||
4.25,3.5 3.25,3.5 3.25,2.5 4,2.5 4.75,2.5 curve(20)
|
||||
4.75,2.5 5,2 5.25,1.5 5.5,1 curve(20) 5.5,1
|
||||
14
fonts/uwx/R2.mant
Normal file
14
fonts/uwx/R2.mant
Normal file
@ -0,0 +1,14 @@
|
||||
R2
|
||||
===
|
||||
2.5,3 3.5,3 4.25,4.5 4.5,5 curve(20) 4.5,5
|
||||
4.25,5.5 4,6 3,6 3.25,5.5 3.5,5 curve(20)
|
||||
3.5,5 3.25,4.5
|
||||
===
|
||||
0,6 1,6 4,0 3,0
|
||||
===
|
||||
2,2.5 4,2.5 4,3.5 2,3.5
|
||||
===
|
||||
5.25,1 3.25,1 3.25,0 5.75,0 7,0 curve(20)
|
||||
7,0 6.5,1 5.75,2.5 5.25,3.5 curve(20) 5.25,3.5
|
||||
4.25,3.5 3.25,3.5 3.25,2.5 4.25,2.5 4.825,2.5 curve(20)
|
||||
4.825,2.5 5.075,2 5.45,1.25
|
||||
14
fonts/uwx/R3.mant
Normal file
14
fonts/uwx/R3.mant
Normal file
@ -0,0 +1,14 @@
|
||||
R3
|
||||
===
|
||||
2.75,3 3.75,3 4.25,4 4.625,4.75 curve(20) 4.625,4.75
|
||||
4.375,5.25 4,6 3,6 3.375,5.25 3.625,4.75 curve(20)
|
||||
3.625,4.75 3.25,4
|
||||
===
|
||||
0,6 1,6 4,0 3,0
|
||||
===
|
||||
2,2.5 4,2.5 4,3.5 2,3.5
|
||||
===
|
||||
4.75,1 3.25,1 3.25,0 5.75,0 7,0 curve(20)
|
||||
7,0 6.5,1 5.75,2.5 5.25,3.5 curve(20) 5.25,3.5
|
||||
4.25,3.5 3.25,3.5 3.25,2.5 4,2.5 4.75,2.5 curve(20)
|
||||
4.75,2.5 5,2 5.25,1.5 5.5,1 curve(20) 5.5,1
|
||||
6
fonts/uwx/U.mant
Normal file
6
fonts/uwx/U.mant
Normal file
@ -0,0 +1,6 @@
|
||||
U
|
||||
===
|
||||
3,0 1.25,3.5 0.25,5.5 curve(20) 0.5,6 1.5,6
|
||||
2.75,6 4,6 curve(20) 4,6 5.25,3.5 7,0
|
||||
6,0 4,4 3.5,5 curve(20) 3.5,5 2.75,5
|
||||
2.25,5 1.5,5 curve(20) 1.5,5 2,4 4,0
|
||||
9
fonts/uwx/W.mant
Normal file
9
fonts/uwx/W.mant
Normal file
@ -0,0 +1,9 @@
|
||||
W
|
||||
===
|
||||
0,0 1,0 4,6 3,6
|
||||
===
|
||||
3,6 4,6 5.5,3 4.5,3
|
||||
===
|
||||
4.5,3 5.5,3 7,6 6,6
|
||||
===
|
||||
6,6 7,6 10,0 9,0
|
||||
5
fonts/uwx/X.mant
Normal file
5
fonts/uwx/X.mant
Normal file
@ -0,0 +1,5 @@
|
||||
X
|
||||
===
|
||||
0,0 1,0 4,6 3,6
|
||||
===
|
||||
0,6 1,6 4,0 3,0
|
||||
54
iconize.pl
Executable file
54
iconize.pl
Executable file
@ -0,0 +1,54 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Tk;
|
||||
|
||||
use POSIX;
|
||||
setlocale(LC_NUMERIC, "C");
|
||||
|
||||
BEGIN {
|
||||
unshift @INC, '.';
|
||||
};
|
||||
|
||||
use Manticore::Mantis;
|
||||
|
||||
my $main = MainWindow->new();
|
||||
my $can = $main->Canvas(-width=>1000,-height=>900,-background=>'#aaaaaa')->pack();
|
||||
|
||||
Manticore::Mantis::fontLoader(dir=>"fonts/refont");
|
||||
|
||||
|
||||
show();
|
||||
|
||||
MainLoop;
|
||||
|
||||
sub show {
|
||||
my $x = 0;
|
||||
my $y = 0;
|
||||
my $distx = 230;
|
||||
my $disty = 39;
|
||||
for(qw(IconNew IconOK IconNotOK IconWarning IconProblem IconVisible IconInvisible IconCourseFavouriteManual IconCourseFavouriteAutomatic IconCourseFavouriteOff IconEnrolTrue IconEnrolFalse IconPlanned IconAnnounce IconExam IconExamRegisterTrue IconExamRegisterFalse IconExamAutoOccurrenceNudgeUp IconExamAutoOccurrenceNudgeDown IconExamAutoOccurrenceIgnore IconExamAutoOccurrenceReconsider IconCommentTrue IconCommentFalse IconLink IconFileDownload IconFileUpload IconFileZip IconFileCSV IconSFTQuestion IconSFTHint IconSFTSolution IconSFTMarking IconEmail IconRegisterTemplate IconNoCorrectors IconRemoveUser IconTooltipDefault IconNotificationSuccess IconNotificationInfo IconNotificationWarning IconNotificationError IconNotificationNonactive IconFavourite IconLanguage IconNavContainerClose IconPageActionChildrenClose IconMenuNews IconMenuHelp IconMenuProfile IconMenuLogin IconMenuLogout IconBreadcrumbsHome IconMenuExtra IconMenuCourseList IconMenuCorrections IconMenuExams IconMenuAdmin IconMenuLms IconMenuQualification IconPageActionPrimaryExpand IconPageActionSecondary IconBreadcrumbSeparator IconFileUploadSession IconStandaloneFieldError IconFileUser IconNotification IconNotificationSent IconNoNotification IconPersonalIdentification IconMenuWorkflows IconVideo IconSubmissionUserDuplicate IconSubmissionNoUsers IconReset IconBlocked IconCertificate IconPrintCenter IconLetter IconAt IconSupervisor IconSupervisorForeign IconExpired IconLocked IconUnlocked IconResetTries IconCompany IconEdit IconUserEdit)) {
|
||||
$can->createText(45+$x*$distx,12+$y*$disty,-text=>$_,-anchor=>'w');
|
||||
my $icon = Manticore::Mantis::glyphemDisplay($_);
|
||||
if($icon) {
|
||||
for my $ic(@$icon) {
|
||||
my @newpoly = ();
|
||||
my $xy = 1;
|
||||
for(@$ic) {
|
||||
push @newpoly, ($xy
|
||||
? ($_*6+0+$x*$distx)
|
||||
: ($_*6-12+$y*$disty)
|
||||
);
|
||||
$xy = $xy ? 0 : 1;
|
||||
}
|
||||
$can->createPolygon(@newpoly, -fill=>'#000000', -outline=>undef);
|
||||
}
|
||||
}
|
||||
$y++;
|
||||
if($y > 22) {
|
||||
$y = 0;
|
||||
$x++;
|
||||
}
|
||||
}
|
||||
}
|
||||
224
manticore.pl
Executable file
224
manticore.pl
Executable file
@ -0,0 +1,224 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Tk;
|
||||
|
||||
# Wir wollen keine , in Dezimalbruechen. Wer kommt nur auf solche Ideen?
|
||||
use POSIX;
|
||||
setlocale(LC_NUMERIC, "C");
|
||||
|
||||
BEGIN {
|
||||
unshift @INC, '.';
|
||||
};
|
||||
|
||||
use Manticore::Mantis;
|
||||
|
||||
my $sticky = 0;
|
||||
my $helplines = "1:2";
|
||||
|
||||
#my @display = ();
|
||||
my @edit = ();
|
||||
#(
|
||||
# [2.3,3, 3.3,3, 4.8,6, 3.8,6],
|
||||
# [0,6, 1,6, 4,0, 3,0],
|
||||
# [2,2.5, 4,2.5, 4,3.5, 2,3.5],
|
||||
# [5,1, 3,1, 3,0, 5.5,0, 6,0.5, 6.25,1, 5.125,3.25, 4.5,3.5, 3,3.5, 3,2.5, 4.575,2.5, 5.2,1.25,],
|
||||
#);
|
||||
my $fgi = 1;
|
||||
|
||||
my $gl = shift @ARGV;
|
||||
$gl = 'W' unless defined $gl;
|
||||
if(defined $gl) {
|
||||
my $path = "fonts/uwx";
|
||||
my $icon = $gl;
|
||||
if($gl=~m#(.*)/(.*)\.mant#) {
|
||||
$path = $1;
|
||||
$icon = $2;
|
||||
}
|
||||
Manticore::Mantis::fontLoader(dir=>$path);
|
||||
#@bg = @{$Manticore::Mantis::font{$gl}{data}};
|
||||
#@display = @{Manticore::Mantis::glyphemDisplay($gl)};
|
||||
@edit = @{Manticore::Mantis::glyphemData($icon)};
|
||||
$fgi = 0;
|
||||
}
|
||||
|
||||
my $offset = 60;
|
||||
|
||||
my $scale = 80;
|
||||
|
||||
my $main = MainWindow->new();
|
||||
|
||||
my $can = $main->Canvas(-background=>'#ffffff',-width=>700,-height=>700)->pack(-side=>'left');
|
||||
|
||||
my $frame = $main->Frame->pack(-side=>'left');
|
||||
|
||||
for my $i(0..$#edit) {
|
||||
#my $rowdata = $display[$i];
|
||||
my $row = $frame->Frame->pack;
|
||||
$row->Radiobutton(-value=>$i, -variable=>\$fgi, -command=>sub {draw(); loadtextblock()})->pack;
|
||||
}
|
||||
|
||||
my $textarea = $frame->Text->pack();
|
||||
|
||||
$frame->Button(-text=>'apply', -command=>sub { usetextblock(); draw() })->pack();
|
||||
|
||||
$frame->Label(-text=>'Sticky')->pack;
|
||||
my $stickyframe = $frame->Frame->pack;
|
||||
|
||||
for(['None', 0], [1,1], [2,2], [4,4], [8,8]) {
|
||||
$stickyframe->Radiobutton(-text=>$_->[0],-value=>$_->[1],-variable=>\$sticky)->pack(-side=>'left');
|
||||
}
|
||||
|
||||
$frame->Label(-text=>'Help lines')->pack;
|
||||
my $helplineframe = $frame->Frame->pack;
|
||||
for("1:2", "1:1") {
|
||||
$helplineframe->Radiobutton(-text=>$_,-value=>$_,-variable=>\$helplines, -command=>sub {draw()})->pack(-side=>'left');
|
||||
}
|
||||
|
||||
sub one {
|
||||
my ($data, $col, $hl) = @_;
|
||||
my $display = Manticore::Mantis::rowData2display($data);
|
||||
$can->createPolygon((map {$_*$scale+$offset} @$display), -fill=>$col, -outline=>undef);
|
||||
if($hl) {
|
||||
for(0..$#$data) {
|
||||
my $xy0 = $data->[$_-1];
|
||||
my $xy1 = $data->[$_];
|
||||
next unless 'ARRAY' eq ref $xy0;
|
||||
next unless 'ARRAY' eq ref $xy1;
|
||||
my $x0 = $xy0->[0];
|
||||
my $y0 = $xy0->[1];
|
||||
my $x1 = $xy1->[0];
|
||||
my $y1 = $xy1->[1];
|
||||
my $dx = abs($x1-$x0);
|
||||
my $dy = abs($y1-$y0);
|
||||
my $epsilon = 0.0000001;
|
||||
my $horvert = $dx < $epsilon || $dy < $epsilon;
|
||||
my $diag = sub {'1:2' eq $helplines
|
||||
? abs($dx/$dy-2) < $epsilon || abs($dy/$dx-2) < $epsilon
|
||||
: abs($dx/$dy-1) < $epsilon && abs($dy/$dx-1) < $epsilon
|
||||
}
|
||||
;
|
||||
if($horvert || $diag->()) {
|
||||
$can->createLine((map {$_*$scale+$offset} ($x0,$y0,$x1,$y1)), -fill=>'#0000ff', -width=>4);
|
||||
} else {
|
||||
$can->createLine((map {$_*$scale+$offset} ($x0,$y0,$x1,$y1)), -fill=>'#888888', -width=>2);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub draw {
|
||||
$can->delete('all');
|
||||
one($_,'#444444', 0) for @edit;
|
||||
one($edit[$fgi], '#aaaa00', 1);
|
||||
for my $cx(0..20) {
|
||||
my $x = $cx*$scale+$offset;
|
||||
for my $cy(0..20) {
|
||||
my $y = $cy*$scale+$offset;
|
||||
$can->createOval($x-5,$y-5,$x+5,$y+5,-fill=>'#0000aa',-outline=>undef);
|
||||
}
|
||||
}
|
||||
my $fg = $edit[$fgi];
|
||||
for my $i(0..$#$fg) {
|
||||
my $xy = $fg->[$i];
|
||||
next unless 'ARRAY' eq ref $xy;
|
||||
my $cx = $xy->[0];
|
||||
my $cy = $xy->[1];
|
||||
my $x = $cx*$scale+$offset;
|
||||
my $y = $cy*$scale+$offset;
|
||||
$can->createOval($x-7,$y-7,$x+7,$y+7,-fill=>'#bb0000',-outline=>undef);
|
||||
$i += 2;
|
||||
}
|
||||
}
|
||||
|
||||
draw();
|
||||
loadtextblock();
|
||||
|
||||
my $pressed = 0;
|
||||
my $pressedInd = undef;
|
||||
|
||||
$can->Tk::bind('<1>'=>[sub {
|
||||
my (undef,$x,$y) = @_;
|
||||
($x,$y) = map {($_-$offset)/$scale} ($x,$y);
|
||||
my ($eins) = closest($x,$y);
|
||||
$pressedInd = $eins;
|
||||
$pressed = 1;
|
||||
#@{$display[$fgi]}[$pressedInd,$pressedInd+1] = ($x,$y);
|
||||
$edit[$fgi][$pressedInd] = makeSticky([$x,$y]);
|
||||
draw();
|
||||
}, Ev('x'), Ev('y')]);
|
||||
$can->Tk::bind('<Motion>'=>[sub {
|
||||
return unless $pressed;
|
||||
my (undef,$x,$y) = @_;
|
||||
($x,$y) = map {($_-$offset)/$scale} ($x,$y);
|
||||
#@{$display[$fgi]}[$pressedInd,$pressedInd+1] = ($x,$y);
|
||||
$edit[$fgi][$pressedInd] = makeSticky([$x,$y]);
|
||||
draw();
|
||||
}, Ev('x'), Ev('y')]);
|
||||
$can->Tk::bind('<ButtonRelease-1>'=>sub {$pressed = 0});
|
||||
$can->Tk::bind('<3>'=>[sub {
|
||||
my (undef,$x,$y) = @_;
|
||||
($x,$y) = map {($_-$offset)/$scale} ($x,$y);
|
||||
my ($eins,$zwei) = closest($x,$y);
|
||||
my $fg = $edit[$fgi];
|
||||
my $xy1 = $fg->[$eins];
|
||||
my ($x1,$y1) = @{$xy1};
|
||||
my $dx = $x-$x1;
|
||||
my $dy = $y-$y1;
|
||||
if($dx*$dx + $dy*$dy < 0.01) {
|
||||
splice(@$fg, $eins, 1);
|
||||
} else {
|
||||
print "<$eins $zwei>\n";
|
||||
my $newind = 0;
|
||||
if($zwei > $eins || 0==$zwei) {
|
||||
$newind = $eins+1
|
||||
} else {
|
||||
$newind = $zwei+1
|
||||
}
|
||||
splice(@$fg, $newind, 0, [$x,$y]);
|
||||
}
|
||||
draw();
|
||||
}, Ev('x'), Ev('y')]);
|
||||
|
||||
# return the ids from the closet entry to the farest
|
||||
sub closest {
|
||||
my ($x,$y) = @_;
|
||||
my $fg = $edit[$fgi];
|
||||
my @dists = ();
|
||||
for my $i(0..$#$fg) {
|
||||
my $txy = $fg->[$i];
|
||||
next unless 'ARRAY' eq ref $txy;
|
||||
my $tx = $txy->[0];
|
||||
my $ty = $txy->[1];
|
||||
my $dx = $x-$tx;
|
||||
my $dy = $y-$ty;
|
||||
push @dists, [$dx*$dx+$dy*$dy, $i, $tx,$ty];
|
||||
}
|
||||
@dists = sort {$a->[0] <=> $b->[0]} @dists;
|
||||
map {$_->[1]} @dists
|
||||
}
|
||||
|
||||
MainLoop;
|
||||
|
||||
sub makeSticky {
|
||||
my $xy = shift;
|
||||
my $x = $xy->[0];
|
||||
my $y = $xy->[1];
|
||||
if($sticky > 0.5) {
|
||||
$_ = POSIX::floor($_*$sticky+0.5)/$sticky for $x,$y
|
||||
}
|
||||
return [$x,$y]
|
||||
}
|
||||
|
||||
sub loadtextblock {
|
||||
$textarea->delete('1.0','end');
|
||||
$textarea->insert('end', Manticore::Mantis::rowData2text($edit[$fgi]));
|
||||
}
|
||||
|
||||
sub usetextblock {
|
||||
my $content = $textarea->get('1.0', 'end');
|
||||
$edit[$fgi] = Manticore::Mantis::rowText2data($content);
|
||||
}
|
||||
|
||||
|
||||
189
uniworx.pl
Executable file
189
uniworx.pl
Executable file
@ -0,0 +1,189 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Tk;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
# Wir wollen keine , in Dezimalbruechen. Wer kommt nur auf solche Ideen?
|
||||
use POSIX;
|
||||
setlocale(LC_NUMERIC, "C");
|
||||
|
||||
BEGIN {
|
||||
unshift @INC, '.';
|
||||
};
|
||||
|
||||
use Manticore::Mantis;
|
||||
|
||||
#my %font = ();
|
||||
|
||||
my $logoDist = 0;
|
||||
my $logoDist2 = 0;
|
||||
|
||||
sub refont {
|
||||
Manticore::Mantis::fontLoader(dir => "fonts/uwx");
|
||||
}
|
||||
|
||||
refont();
|
||||
|
||||
my $graysim = 0;
|
||||
|
||||
sub col {
|
||||
my ($R,$G,$B,$mkgray) = @_;
|
||||
if($mkgray) {
|
||||
my $mid = ($R+$G+$B)/3;
|
||||
$R = $mid;
|
||||
$G = $mid;
|
||||
$B = $mid;
|
||||
}
|
||||
my $r = int($R*255);
|
||||
my $g = int($G*255);
|
||||
my $b = int($B*255);
|
||||
for($r,$g,$b) { $_=0 if $_<0; $_=255 if $_>255 }
|
||||
sprintf("#%02x%02x%02x",$r,$g,$b);
|
||||
}
|
||||
|
||||
my $main = MainWindow->new();
|
||||
|
||||
my $can = $main->Canvas(-background=>'#ffffff',-width=>700,-height=>700)->pack(-side=>'left');
|
||||
my $scrolls = $main->Frame(-width=>350,-height=>300,-background=>'#000000')->pack(-side=>'left',-expand=>0);
|
||||
|
||||
#$scrolls->Label(-text=>" ")->pack;
|
||||
|
||||
#renderOutline(5, 425,200,30, "X", '#000000');
|
||||
#render(425,200,30, "X", '#ff0000');
|
||||
#renderOutline(5, 200,200,30, "W", '#000000');
|
||||
#render(200,200,30, "W", '#ff0000');
|
||||
#renderOutline(5, 185,200,30, "U", '#000000');
|
||||
#render(185,200,30, "U", '#ff0000');
|
||||
|
||||
|
||||
#renderOutline(5, 415,200,30, "X", '#000000');
|
||||
#render(415,200,30, "X", '#553080');
|
||||
#renderOutline(5, 200,200,30, "W", '#000000');
|
||||
#render(200,200,30, "W", '#88409e');
|
||||
#renderOutline(5, 195,200,30, "U", '#000000');
|
||||
#render(195,200,30, "U", '#aa50bb');
|
||||
|
||||
#my $r1 = 0.3;
|
||||
#my $g1 = 0.3;
|
||||
#my $b1 = 0.8;
|
||||
#my $r0 = 0.55;
|
||||
#my $g0 = 0.15;
|
||||
#my $b0 = 0.15;
|
||||
|
||||
#$scrolls->Checkbutton(-text=>'draw grayscale',-variable=>\$graysim,-command=>sub {renderAll()})->pack;
|
||||
|
||||
my $r1 = 0.4;
|
||||
my $g1 = 0.4;
|
||||
my $b1 = 0.8;
|
||||
my $r0 = 0.2;
|
||||
my $g0 = 0.2;
|
||||
my $b0 = 0.5;
|
||||
|
||||
for(
|
||||
['r',\$r0,'#ff0000'],
|
||||
['g',\$g0,'#00ff00'],
|
||||
['b',\$b0,'#0000ff'],
|
||||
['r',\$r1,'#ff0000'],
|
||||
['g',\$g1,'#00ff00'],
|
||||
['b',\$b1,'#0000ff'],
|
||||
) {
|
||||
#$scrolls->Scrollbar(-orient=>'horizontal')->pack(-fill=>'x');
|
||||
my $row = $scrolls->Frame->pack(-fill=>'x');
|
||||
$row->Label(-text=>$_->[0],-width=>2,-background=>$_->[2])->pack(-side=>'left');
|
||||
#$row->Scrollbar(-orient=>'horizontal',-command=>sub {print "[[ @_ ]]\n"; return 1})->pack(-expand=>1,-fill=>'x',-side=>'left');
|
||||
my $vb = $_->[1];
|
||||
$row->Scale(-orient=>'horizontal',-length=>200,-variable=>$vb,-resolution=>-1,-from=>0,-to=>1,
|
||||
-command=>sub {
|
||||
my $v = shift;
|
||||
#print "[[ @_ ]]\n"; return 1
|
||||
#$$vb = $v/100;
|
||||
renderAll();
|
||||
})->pack(-side=>'left')
|
||||
}
|
||||
|
||||
$scrolls->Scale(-orient=>'horizontal',-length=>200,-variable=>\$logoDist,-resolution=>-1,-from=>0,-to=>100,
|
||||
-command=>sub {
|
||||
renderAll();
|
||||
})->pack();
|
||||
$scrolls->Scale(-orient=>'horizontal',-length=>200,-variable=>\$logoDist2,-resolution=>-1,-from=>-20,-to=>20,
|
||||
-command=>sub {
|
||||
renderAll();
|
||||
})->pack();
|
||||
|
||||
my $dunkelbg = '#333333';
|
||||
my $hellbg = '#cccccc';
|
||||
|
||||
sub renderAll {
|
||||
$can->delete('all');
|
||||
|
||||
renderOutline(5, 415+$logoDist,120,30, "X", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render(415+$logoDist,120,30, "X", col($r0,$g0,$b0,0));
|
||||
renderOutline(5, 200,120,30, "W", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render(200,120,30, "W", col(($r0+$r1)/2,($g0+$g1)/2,($b0+$b1)/2,0));
|
||||
renderOutline(5, 165-$logoDist,120,30, "U", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render(165-$logoDist,120,30, "U", col($r1,$g1,$b1,0));
|
||||
|
||||
renderOutline(5, 415+$logoDist,340,30, "X", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render(415+$logoDist,340,30, "X", col($r0,$g0,$b0,1));
|
||||
renderOutline(5, 200,340,30, "W", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render(200,340,30, "W", col(($r0+$r1)/2,($g0+$g1)/2,($b0+$b1)/2,1));
|
||||
renderOutline(5, 165-$logoDist,340,30, "U", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render(165-$logoDist,340,30, "U", col($r1,$g1,$b1,1));
|
||||
|
||||
# renderOutline(5, 120,220,50, "R", [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
#render(120,220,50, "R", col(0.5,1,0,0));
|
||||
|
||||
my $i = 0;
|
||||
for my $c(reverse (
|
||||
[185,0.0,"U"],
|
||||
[235,0.1666,"N"],
|
||||
[285,0.3333,"I"],
|
||||
[320,0.5,"W2"],
|
||||
[410,0.6666,"O"],
|
||||
[450,0.8333,"R"],
|
||||
[502,1,"X"],
|
||||
)) {
|
||||
my $dx = $i*$logoDist2;
|
||||
$i++;
|
||||
renderOutline(2, $c->[0]+$dx,570,10, $c->[2], [$dunkelbg, $hellbg, $hellbg, $dunkelbg]);
|
||||
render($c->[0]+$dx,570,10, $c->[2], col($r0*$c->[1]+$r1*(1-$c->[1]),$g0*$c->[1]+$g1*(1-$c->[1]),$b0*$c->[1]+$b1*(1-$c->[1]),0));
|
||||
}
|
||||
}
|
||||
|
||||
renderAll();
|
||||
|
||||
|
||||
|
||||
MainLoop;
|
||||
|
||||
sub renderOutline {
|
||||
my ($diff, $x, $y, $size, $letter, $col) = @_;
|
||||
my @where = (
|
||||
[$diff,-$diff],
|
||||
[-$diff,-$diff],
|
||||
[-$diff,$diff],
|
||||
[$diff,$diff],
|
||||
);
|
||||
for(0..$#where) {
|
||||
my ($dx, $dy) = @{$where[$_]};
|
||||
my $scol = ref $col ? $col->[$_] : $col;
|
||||
render($dx+$x, $dy+$y, $size, $letter, $scol);
|
||||
}
|
||||
}
|
||||
|
||||
sub render {
|
||||
my ($x,$y,$scale,$t, $col) = @_;
|
||||
my $font = Manticore::Mantis::glyphemDisplay($t) or die "Letter not found: $t";
|
||||
#print Data::Dumper::Dumper($font);
|
||||
for my $frag(@{$font}) {
|
||||
my @newpoly = map {$scale*$_} @{$frag};
|
||||
for(0..$#newpoly) {
|
||||
$newpoly[$_] += ($_ % 2) == 0 ? $x : $y
|
||||
}
|
||||
$can->createPolygon(@newpoly, -fill=>$col, -outline=>undef);
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user