Original Perl Tk Forum

use Tk;$m=MainWindow->new;$c=$m->Canvas(-he,30,-wi,70,-ba,white)->pack;
%h=(1,blue,0,black);@d=('R/K6Q(W6','<&F&<4F4','5/.64(:6','?*I*?8I8');  for(@d){$i++;create $c 'line'=>map((ord($_)-30),
map(split(//),$_)),-wi,2,-fill,$h{$i%2}}MainLoop;

use Tk;$m=MainWindow->new;$c=$m->Canvas(-he,100,-wi,90)->pack;
$j=$m->Photo(p);$j->put(white,-to,0,0,90,100);
$d='D21021>23>7310276732273774673@76776766733232100100100102102112>12>10110­1 
12112212310>237312737373231632>7>3737337733>73?7310373373G76766740101G04467­6 
776776E73633766B7376B76B73673664?5012104100100100104004B0>414521414>04>0>46­7 
6766776@7636>73676756756766767363273375650400456>7C501311210100E4B011001410­4 
500>4673676?766>76B76@7667767677673>7654B511>21101001001>01>04001004G01>040­4 
5565644>544044540440404B0401?0101010>4?5040?1233A763B763677>676476?4004@012­0 
1201>01011401';
@f=split//,$d;$b=0;while($#f>-1){$a=shift(@f);
if($a=~/[0-7]/){$e[$b++]=$a}
else{$h=shift(@f);$a=ord($a)-60;while($a>=0){$e[$b++]=$h;$a--}}}
$x=7;$y=10;$i=0;for(@e){if($i==563){$x=56;$y=55}
$j->put(black,-to=>$x,$y);$i++;if(/0|7/){$o=3.5}else{$o=$_}
$x+=-($o<=>3.5);if(/0|1|4/){$y+=-1}elsif(!/2|5/){$y+=1}}
$c->createImage(45,50,-image,p);sub F($$){my($x,$y)=@_;
$q=$j->get($x,$y);if($q!~/0/){$j->put(black,-to=>$x,$y);
F($x+1,$y);F($x-1,$y);F($x,$y+1);F($x,$y-1)}}
@h=('2796','8746','8657','8558','5891','7895','2990','5688','7983',
'4550');for(@h){$r=substr $_,0,2,'';&F($r,$_)}
@d=('4e4o&e&o','7b7l)b)l',',q4z&s4p',',X4a&Z4W');for(@d)
{create $c 'line'=>map(ord($_)-30, map(split(//),$_)),-wi,2}MainLoop;

Advertisement