Perl的能力的体现,看看这个160行不到的画图程序吧
原来是 159 行,不带注释
为了方便大家来熟悉Tk,我把注释都写上了
大家来看看perl tk的威力吧
#!/usr/bin/perl
# writen by NetKen.
use Tk;
use Tk::LabFrame;
# 开一个新窗口
$main_window = MainWindow->new( '-title'=>'Perl/Tk Paint!+' );
# 调整窗口位置到 x=0 , y=0 , 左上角
$main_window->geometry("+0+0");
# 建立一个Frame区域,容纳各个Button,Radio,Check ...
$left_frame = $main_window->Frame( '-relief'=>'groove' , '-borderwidth'=>2 , '-label'=>'Tools:' )->pack( '-fill'=>'y' , '-side'=>'left' );
# 建立一个 清除Canvas内所有内容的Button.先判断 Background 是否有内容
# 也就是 Format BG , Button是不是被按下了
# 如果有内容了,就要在清楚所有物件后再画一个Background
# [ 调用 format_background() 函数 ]
$clear_canvas = $left_frame->Button( '-text'=>'CLEAR!!!' , '-width'=>20 , '-foreground'=>'red' , '-command'=>sub {
$canvas->delete('all');
format_background() if $format_bg_button->cget('relief') eq 'sunken';
})->pack('-side'=>'top');
# 画Background , 并且让 Format BG , Button 有动画效果
# [ 调用 format_background() 函数 ]
$format_bg_button = $left_frame->Button( '-text'=>'Format BG' , '-width'=>20 , '-foreground'=>'white' , '-relief'=>'raised' , '-command'=>sub {
format_background();
if ($format_bg_button->cget('relief') eq 'raised') {
$format_bg_button->configure('-relief'=>'sunken');
format_background();
} else {
$format_bg_button->configure('-relief'=>'raised');
$canvas->delete('background');
}})->pack( '-side'=>'top');
# 开始在 $left_frame 中画各个 Button.Check.Radio ...
# 这里是标准 Radiobutton 区域
# 有三个 line oval rectangle 标准格式
$standard_label = $left_frame->LabFrame('-label'=>'Standard Tools :' , '-labelside'=>'acrosstop' );
$draw_tool = 'line';# 默认选项为 line
$standard_label->Radiobutton('-text'=>'Line Tool' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'line' )->pack('-side'=>'top');
$standard_label->Radiobutton('-text'=>'Oval Tool' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'oval' )->pack('-side'=>'top');
$standard_label->Radiobutton('-text'=>'Rectangle' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'rectangle' )->pack('-side'=>'top');
$standard_label->pack('-side'=>'top');
# 这里设置是否进行 扩散效果
# 用 boolean 值 $diffuse_boolean
$diffuse_boolean = 0;# 默认为 0 [无]
$diffuse = $left_frame->Checkbutton('-text'=>'Diffuse the Objects ?' , '-variable'=>\$diffuse_boolean )->pack('-side'=>'top');
# 这里是扩展 Radiobutton 区域
# 有四个 Arc Oval Rectang FreeHand 扩展格式
$extend_label = $left_frame->LabFrame('-label'=>'Extend Tools :' , '-labelside'=>'acrosstop' );
$extend_label->Radiobutton('-text'=>'Arc Line' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'arcline' )->pack('-side'=>'top');
$extend_label->Radiobutton('-text'=>'Rect Line' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'rectangleline' )->pack('-side'=>'top');
$extend_label->Radiobutton('-text'=>'Oval Line' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'ovalline' )->pack('-side'=>'top');
$extend_label->Radiobutton('-text'=>'Free Hand' , '-width'=>16 , '-variable'=>\$draw_tool , '-value'=>'freedraw' )->pack('-side'=>'top');
$extend_label->pack('-side'=>'top');
# 这里设置是否对画的东西内部进行填充
# 用 boolean 值 $fill_boolean
$fill_boolean = 0;# 默认为 0 [不填充]
$fill_obj = $left_frame->Checkbutton('-text'=>'Fill the Objects ?' , '-variable'=>\$fill_boolean )->pack('-side'=>'top');
# 这里是 设置线条宽度 的区域
# 用 Scale 取值
$linesize_label = $left_frame->LabFrame('-label'=>'Line Size & Border Width' , '-labelside'=>'acrosstop' );
$linesize_label->Scale('-width'=>10 , '-length'=>120 , '-variable'=>\$linesize , '-orient'=>'h' , '-from'=>1 , '-to'=>50 )->pack('-side'=>'top');
$linesize_label->pack('-side'=>'top');
# 这里是 颜色选择 区域
# 用三个 Scale 分别代表 Red Green Blue
# 用 color_palette() 函数进行选择颜色分析
$color_label = $left_frame->LabFrame('-label'=>'Color Palette' , '-labelside'=>'acrosstop' );
$color_label->Label('-text'=>'Red Green Blue' , '-width'=>20 )->pack('side'=>'top');
$color_r = 0;$color_g = 0;$color_b = 0;
$color_label->Scale('-width'=>10 , '-length'=>120 , '-variable'=>\$color_r , '-orient'=>'v' , '-from'=>0 , '-to'=>255 , '-command'=>\&color_palette )->pack('-side'=>'left');
$color_label->Scale('-width'=>10 , '-length'=>120 , '-variable'=>\$color_g , '-orient'=>'v' , '-from'=>0 , '-to'=>255 , '-command'=>\&color_palette )->pack('-side'=>'left');
$color_label->Scale('-width'=>10 , '-length'=>120 , '-variable'=>\$color_b , '-orient'=>'v' , '-from'=>0 , '-to'=>255 , '-command'=>\&color_palette )->pack('-side'=>'left');
$color_label->pack('-side'=>'top');
# 这里则显示上面选中的 颜色
# 从 color_palette() 函数中修改这里的 Configure
$color_palette = $left_frame->Label('-width'=>20 , '-background'=>'#000000' , '-borderwidth'=>2 , '-relief'=>'groove' )->pack('side'=>'top');
# 做一个带 Scollbar 的 Canvas
$paint = $main_window->Scrolled('Canvas' , '-cursor'=>'tcross' )->pack( '-side'=>'left' , '-fill'=>'both' , '-expand'=>1 );
# 从中取 对象 $canvas
$canvas = $paint->Subwidget("canvas");
# 开始对事件进行联编
bind_start();
MainLoop();
# 这个函数是格式化画板背景的
sub format_background {
my($x,$y)=$main_window->maxsize();
($x-=$x%10)++;
($y-=$y%10)++;
for (my $i=0;$i<$x ;$i+=10 ) {
$canvas->create('line',$i,0,$i,$y,'-width'=>1,'-fill'=>'white','-tag'=>'background');
}
for (my $i=0;$i<$y ;$i+=10 ) {
$canvas->create('line',0,$i,$x,$i,'-width'=>1,'-fill'=>'white','-tag'=>'background');
}
};
# 这是是对 颜色调节 进行反映的一个函数
# 要把颜色信息转化成 #RRGGBB 形式
# 并在 $left_frame 中的 $color_palette 中显示出来
# 颜色信息保存在 $color 中
# 用到 to_hex() 函数 [把小于16的 dec 转换为 hex ]
sub color_palette {
my($red,$green,$blue);
if ($color_r > 15 ) {
my $color_r_2 = $color_r % 16;
my $color_r_1 = ($color_r - $color_r_2 ) / 16;
$red = to_hex($color_r_1).to_hex($color_r_2);
} else {$red = "0".to_hex($color_r);}
if ($color_g > 15 ) {
my $color_g_2 = $color_g % 16;
my $color_g_1 = ($color_g - $color_g_2 ) / 16;
$green = to_hex($color_g_1).to_hex($color_g_2);
} else {$green = "0".to_hex($color_g);}
if ($color_b > 15 ) {
my $color_b_2 = $color_b % 16;
my $color_b_1 = ($color_b - $color_b_2 ) / 16;
$blue = to_hex($color_b_1).to_hex($color_b_2);
} else {$blue = "0".to_hex($color_b);}
$color = "#".$red.$green.$blue;
$color_palette->configure('-background'=>$color );
};
# 转换 dec 到 hex
sub to_hex {
my $dec = pop;
return sprintf("%x",$dec);
};
# 开始事件联编
sub bind_start {
# 如果已有联编,则返回
@bindings = $canvas->CanvasBind("<Motion>");
return if ($#bindings >= 0);
#开始 bind 鼠标 1 键 到 start_drawing() 函数,并传给 x,y 左边值
$canvas->CanvasBind("<Button-1>", [\&start_drawing, Ev('x'), Ev('y')]);
};
# 联编 后 开始对 Canvas 进行 画
sub start_drawing {
my ($canv, $x, $y) = @_;
$x = $canv->canvasx($x);
$y = $canv->canvasy($y);
# 分各种情况进行分析
# 每个情况中都要分析 $fill_boolean 的问题
# 这里都是 Standard 类型的
if ($draw_tool eq "rectangle") {
$canvas->createRectangle($x, $y, $x, $y, '-width' => $linesize, '-tags' => "draw") unless $fill_boolean;
$canvas->createRectangle($x, $y, $x, $y, '-width' => $linesize, '-tags' => "draw" , '-fill'=>$color ) if $fill_boolean;
} elsif ($draw_tool eq "oval") {
$canvas->createOval($x, $y, $x, $y, '-width' => $linesize, '-tags' => "draw") unless $fill_boolean;
$canvas->createOval($x, $y, $x, $y, '-width' => $linesize, '-tags' => "draw" , '-fill'=>$color ) if $fill_boolean;
} elsif ($draw_tool eq "line") {
$canvas->createLine($x, $y, $x, $y, '-width' => $linesize, '-tags' => "draw" , '-fill'=>$color );
}
# 设置开始位置不变
$startx = $x; $starty = $y;
# 再次进行 联编 ,当 鼠标移动时 ,进行 size_item() 函数操作 , 并传给 x,y 坐标
$canvas->CanvasBind("<Motion>", [\&size_item, Ev('x'), Ev('y')]);
# 当 再次 按 鼠标 1 键 时,画操作结束 , 调用 end_drawing() 函数 , 并确定 x,y 坐标
$canvas->CanvasBind("<Button-1>", [\&end_drawing, Ev('x'), Ev('y')]);
};
# 进行 Standard 中的动画效果 和 Extend 中的连续画效果
sub size_item {
my ($canv, $x, $y) = @_;
$x = $canv->canvasx($x);
$y = $canv->canvasy($y);
# 这里是娶上次 鼠标位置 ,然后在 Extand 中 进行 连续 画
# 如果上次没有 位置,也就是这是新开始的一次,那么这里就是把上次位置假设为当前位置了
$last_x = $x unless $last_x;$last_y = $y unless $last_y;
# 开始分析
if ($draw_tool ne "freedraw" and $draw_tool ne "ovalline" and $draw_tool ne "arcline" and $draw_tool ne "rectangleline") {
# 这里是 Standard 情况下 动画效果 的展现
if ($diffuse_boolean) {
# 这里是 Standard 中 开启了 扩散 效果的时候的效果
# 若有 '-fill' 选项,则内部颜色会填充
$canvas->createRectangle($startx,$starty,$x,$y,'-width'=>$linesize, '-fill'=>$color ) if $draw_tool eq "rectangle";
$canvas->createOval($startx,$starty,$x,$y,'-width'=>$linesize, '-fill'=>$color ) if $draw_tool eq "oval";
$canvas->createLine($startx,$starty,$x,$y,'-width'=>$linesize, '-fill'=>$color ) if $draw_tool eq "line";
} else {
# 普通 效果
$canvas->coords("draw", $startx, $starty, $x, $y);
}} else {
# 这里是 Extand 情况下 连续画效果 的展现
# 需要判断是否有 $fill_boolean 填充的选项
if ($draw_tool eq "freedraw") {
$canvas->createLine($last_x,$last_y,$x,$y,'-width'=>$linesize , '-fill'=>$color );
};
if ($draw_tool eq "ovalline") {
$canvas->createOval($last_x,$last_y,$x,$y,'-width'=>$linesize) unless $fill_boolean;
$canvas->createOval($last_x,$last_y,$x,$y,'-width'=>$linesize , '-fill'=>$color ) if $fill_boolean;
};
if ($draw_tool eq "arcline") {
$canvas->createArc($last_x,$last_y,$x,$y , '-width'=>$linesize) unless $fill_boolean;
$canvas->createArc($last_x,$last_y,$x,$y , '-width'=>$linesize , '-fill'=>$color ) if $fill_boolean;
};
if ($draw_tool eq "rectangleline") {
$canvas->createRectangle($last_x,$last_y,$x,$y , '-width'=>$linesize) unless $fill_boolean;
$canvas->createRectangle($last_x,$last_y,$x,$y , '-width'=>$linesize , '-fill'=>$color ) if $fill_boolean;
};
}
# 为了下一次的 鼠标取值 做 准备
$last_x = $x;$last_y = $y;
};
# 画 结束
sub end_drawing {
my ($canv, $x, $y) = @_;
$x = $canv->canvasx($x);
$y = $canv->canvasy($y);
# 因为不希望下次进行 连续画 时 会重复上次的位置
# 所以要在这里 进行 undef , 清除 原有 $last_x , $last_y 内容
undef $last_x;
undef $last_y;
# 进行分析, 如果是属于 Extand 操作的,则跳跃一个步骤 [不在移动画好的内容]
if ($draw_tool ne "freedraw" and $draw_tool ne "ovalline" and $draw_tool ne "arcline" and $draw_tool ne "rectangleline") {
$canvas->coords("draw", $startx, $starty, $x, $y);
}
# 删除 标记 draw
$canvas->dtag("draw");
# 消除 联编 Motion
$canvas->CanvasBind("<Motion>", "");
# 从新开始循环 bind_start() 函数
&bind_start();
};