Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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 imbibing at the Monastery: (5)
As of 2014-10-02 02:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    What is your favourite meta-syntactic variable name?














    Results (42 votes), past polls