Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
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 about the Monastery: (7)
As of 2014-07-13 18:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (251 votes), past polls