Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

GUI japh

by Daruma (Curate)
on Oct 08, 2002 at 05:45 UTC ( #203574=obfuscated: print w/ replies, xml ) Need Help??

Greetings!!

Here's my latest japh in Perl/Tk...

#!c:\perl\bin\perl.exe use strict; use warnings; use Tk; my@e=split'',qw/xyz/;my$d='@e.perlmonks.org';$d=$#e-$#e;my$i=$#e/$#e; ;$_='join';my$j='P'.$d.'h'.$d.'p'.$d.'a'.$d;my$k='.';$_='-';my$r='c'; my$x=qw#bluesandredsandgreensandyellowsandblack#;#$r;my$zx=$#e+$i.$r; my$l=qw/-fill/;my$g=qw/round/;my$o='i';my$b=qw/-width/;my$w=qw/<Any/; my$v=q/Enter>/;my$u=qw/Leave>/;my$nz=$i.$d.$r;my$nw=($#e*$#e*$#e-$i); my@z=split'my',qw/-heightmysplitpackmy-reliefmysunkenmy-borderwidth/; my$bb=$#e*$#e.$k.$#e.($#e*$#e+$i).$r;push@z,$#e;splice@z,$i,$i,$bb;#; unshift@z,$nz;my$nx='';unshift@z,$b;$nx=$k.($i+$#e).($#e*$#e*$#e-$i). ($#e*$#e+$i).$r;my@a=split'q',#e($#e*$#e).$r;my$zr=($#e+$#e).$k.$xar; qw/-capqstrictpackagewarningsq-joinqcoffeeq-tagsqwxyz/;unshift@a,$nx; splice@a,$#e,$i,$g;splice@a,$#e*$#e,$i,$g;push@a,$l;#my$zx=$#e+$i.$r; my@w;unshift@a,$z[$d];splice@a,$nw,$i,$o;@w=split'p',qw%-titlepjAPH%; my@s=split'qw'#reverseqwsplitqwCanvasqw#';$r;my$zr=($#e+$#e).$k.$xa.; ,qw/-expandqwyesqwIAmNotANumberSixOfOnebutttonqwboth/;splice@s,$#e,$i ,$l;my$t='current';my(@v,@u);push@v,$l;unshift@u,@v;#push@u,$t,$s,iq; my@x;@x=split/s.../,$x;push@u,$x[$#x];unshift@u,$t;unshift@v,$t;my$y= MainWindow->new(@w);my$c=$y->Canvas(@z);my$p=sub{my($z,$y)=@_;#strict $y->{j}='';my$f=($z->itemconfigure(@v))[$#e+$#e];$y->{j}="\$c->item". "configure('$t',$l=>'$f')";$z->itemconfigure(@u);};my$q=sub{my($y,$z) =@_;eval$z->{j};};my$h=sub{my$xa=($#e*$#e+$i);my$xb=$#e.($#e*$#e+$i); my$xc=$i.($i+$i).($i+$#e*$#e);my$zz=$#e.$r;;my$zy=$i.$r;my$zx=$#e+$i. $r;;my$zw=$#e.$k.$xa.$r;my$zv=$#e.$k.$xb.$r;my$zu=($#e+$i).$k.$xb.$r; my$zt=($#e+$i).$k.$xa.$r;my$zs=($#e*$#e).$r;my$zr=($#e+$#e).$k.$xa.$r ;my$zq=($#e*$#e).$k.$xb.$r;my$zp=$#e.$k.$xc.$r;my$zo=($#e+$i).$k.($#e +$xa).$xa.$r;my$zn=$xa.$k.$xb.$r;my$zm=$xa.$k.($#e+$xa).$xa.$r;my$zl= ($xa+$i).$k.$xb.$r;my$zk=$i.$k.$xa.$r;my$zj=$xa.$k.$xa.$r;my$zi=($xa+ $#e).$r;my$zh=($xa+$#e+$i).$r;$z[$d]=[$zz,$zy,$zx,$zy,$zw,$zy,$zw,$zy ,$zw,$zx,$zv,$zu,$zz,$zx];$z[$i]=[$zt,$zu,$zs,$zy,$zr,$zu,$zq,$zp,$zo ,$zp];;;$z[$#e]=[$zn,$zu,$zn,$zy,$zm,$zy,$zl,$zk,$zm,$zz,$zj,$zp,$zn, $zp];$z[$i+$#e]=[$zi,$zy,$zi,$zu,$zi,$zp,$zi,$zp,$zh,$zp,$zh,$zy,$zh, $zy,$zh,$zu];};my%m=map{$_=>$_}split//,$j;$m{'j'}='';;&$h();for(my$s= $#e-$#e;$s<$#e*$#e;$s++){$c->createLine($z[$s],@a,$x[$s]);};my$n=join $_,$w,$v;$c->bind($o,$n,[\&$p,\%m]);$n=join$_,$w,$u;$c->#createGUI(); bind($o,$n,[\&$q,\%m]);$c->pack(@s);MainLoop();#ThereAreNoNumbersHere
-Daruma

Comment on GUI japh
Download Code
Re: GUI japh
by diotalevi (Canon) on Oct 16, 2002 at 05:31 UTC

    After following the constants through the program reduces to:

    my $hideLetter; my $restoreLetter; { my $prevColor; $hideLetter = sub { $prevColor = ($_[0]->itemconfigure(qw(current -fill)))[4]; $_[0]->itemconfigure(qw(current -fill black)); }; $restoreLetter = sub { $_[0]->itemconfigure(qw(current -fill), $prevColor); }; } my $mainWindow = MainWindow->new( qw(-title jAPH) ); my $canvas = $mainWindow->Canvas(-width => '10c', -height => '4.25c', -relief => 'sunken', -borderwidth => 2); $canvas->createLine( [qw(2c 1c 3c 1c 2.5c 1c 2.5c 1c 2.5c 3c 2.25c 3.25c 2c 3c)], -width => '.375c', -cap => 'round', -join => 'round', -tags => 'i', -fill => 'blue'); $canvas->createLine( [qw(3.5c 3.25c 4c 1c 4.5c 3.25c 4.25c 2.125c 3.75c 2.125c)], -width => '.375c', -cap => 'round', -join => 'round', -tags => 'i', -fill => 'red'); $canvas->createLine( [qw(5.25c 3.25c 5.25c 1c 5.75c 1c 6.25c 1.5c 5.75c 2c 5.5c 2.125c 5.25c 2.125c)], -width => '.375c', -cap => 'round', -join => 'round', -tags => 'i', -fill => 'green'); $canvas->createLine( [qw(7c 1c 7c 3.25c 7c 2.125c 7c 2.125c 8c 2.125c 8c 1c 8c 1c 8c 3.25c)], -width => '.375c', -cap => 'round', -join => 'round', -tags => 'i', -fill => 'yellow'); $canvas->bind( 'i', "<Any-Enter>", [ \&$hideLetter ] ); $canvas->bind( 'i', "<Any-Leave>", [ \&$restoreLetter ] ); $canvas->pack( -expand => 'yes', -fill => 'both' ); MainLoop();
    __SIG__ printf "You are here %08x\n", unpack "L!", unpack "P4", pack "L!", B::svref_2object(sub{})->OUTSIDE;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: obfuscated [id://203574]
Approved by PodMaster
Front-paged by giulienk
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2015-07-03 22:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (57 votes), past polls