标题: [原创代码] [Perl]旋转、倾斜、缩放混合变换矩阵的分解和重组 [打印本页]
作者: 523066680 时间: 2023-3-3 22:17 标题: [Perl]旋转、倾斜、缩放混合变换矩阵的分解和重组
本帖最后由 523066680 于 2023-3-3 22:25 编辑
源自某一个需求,要把多种变换合并成的矩阵解算还原成 旋转角度值、X倾斜角度值、X/Y缩放值
碰巧 Straberry Perl 自带 Imager::Matrix2d 模块,支持简单的变换矩阵运算,就拿来验证了。- use utf8;
- use Encode;
- use Modern::Perl;
- use File::Slurp;
- use Math::Trig;
- use Math::Round qw/round nearest nearest_floor nearest_ceil/;
- use Imager::Matrix2d;
- use JSON qw/from_json to_json/;
- STDOUT->autoflush(1);
-
- my $mt_str = "matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)";
-
- #提取矩阵拆解的结果
- my $mt_info = pack_mt_info( $mt_str );
- my ( $ang, $scaleX, $scaleY, $skewX, $x, $y ) = @{$mt_info}{ 'rotate', 'scaleX', 'scaleY', 'skewX', 'x', 'y' };
-
- printf "%s\n\n", $mt_str;
- printf "Decompose:\n";
- printf "rotate(%.2f) scale(%.2f, %.2f) skewX(%.2f) skewY(%.2f) %d %d\n\n", $ang, $scaleX, $scaleY, $skewX, 0, $x, $y;
-
- # 根据获取的角度值和缩放值,重新创建、合并多种变换矩阵、验证结果
- my $mat =
- Imager::Matrix2d->translate( x => $x, y => $y ) * # 平移
- Imager::Matrix2d->rotate( degrees => $ang ) *
- Imager::Matrix2d->scale( x => $scaleX, y => $scaleY ) *
- Imager::Matrix2d->shear( x => tan(deg2rad( $skewX )) ) * #shear参数接受tan(θ)值
- Imager::Matrix2d->identity()
- ;
-
- printf "Compose Matrices Again:\n";
- print $mat;
- say "";
-
-
- sub transform_point
- {
- my ($x, $y, $matrix) = @_;
- return
- (
- $x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2],
- $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]
- );
- }
-
- sub pack_mt_info
- {
- my $transform = shift;
-
- # 矩阵解构
- my ( $scaleX, $scaleY, $skewX, $rotate, $x, $y );
- if ( defined $transform and $transform =~/matrix\((.*)\)/i )
- {
- my ($a, $b, $c, $d, $e, $f) = split( /\s+/, $1 );
- ( $x, $y ) = ( $e, $f );
- ( $scaleX, $scaleY, $skewX, undef, $rotate ) = decompose_scale_skewX_rotate_matrix( $a, $b, $c, $d );
- }
-
- return {
- 'x' => $x, 'y' => $y,
- 'scaleX' => nearest(0.000001, $scaleX),
- 'scaleY' => nearest(0.000001, $scaleY),
- 'rotate' => nearest(0.000001, $rotate),
- 'skewX' => nearest(0.000001, $skewX),
- };
- }
-
- sub decompose_scale_skewX_rotate_matrix
- {
- my ($a, $b, $c, $d) = @_;
-
- my $pi = 3.151592653;
- my $rad = atan2( $b, $a );
- my $denom = $a **2 + $b ** 2;
-
- my ($scale_x) = sqrt( $denom );
- my ($scale_y) = ( $a*$d - $b*$c )/ $scale_x;
-
- my ($skew_x) = atan2( $a * $c + $b * $d, $denom );
- my $skew_y = 0;
- return ( $scale_x, $scale_y, rad2deg( $skew_x ), rad2deg( $skew_y ), rad2deg($rad) );
- }
-
- sub gbk { encode('gbk', $_[0]) }
- sub utf8 { encode('utf8', $_[0]) }
- sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
- sub uni { decode('utf8', $_[0]) }
复制代码
输出- matrix(0.9063 -0.4226 -0.8998 -0.1465 124.3052 135.0586)
-
- Decompose:
- rotate(-25.00) scale(1.00, -0.51) skewX(37.00) skewY(0.00) 124 135
-
- Compose Matrices Again:
- [ 0.9063, 0.8998, 124.3052,
- 0.4226, -0.1465, 135.0586,
- 0, 0, 1, ]
复制代码
作者: 老刘1号 时间: 2023-3-4 12:47
之前挖的坑LinearAlgebra.vbs,就写了一点点,高斯约旦消元和PLUP'分解一直没填(逃
作者: 523066680 时间: 2023-3-4 15:40
本帖最后由 523066680 于 2023-3-4 19:42 编辑
之前挖的坑,就写了一点点,高斯约旦消元和PLUP'分解一直没填(逃
老刘1号 发表于 2023-3-4 12:47
有感到满满的压迫感了唉,
不过好在,我刚摆脱桎梏,接下来可以做点有意思的事情了。
欢迎光临 批处理之家 (http://www.bathome.net/) |
Powered by Discuz! 7.2 |