Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

N-Puzzle

by Ido (Hermit)
on Sep 28, 2002 at 18:29 UTC ( [id://201476]=sourcecode: print w/replies, xml ) Need Help??
Category: Fun
Author/Contact Info Ido Trivizki
Description: So...How fast can you do a 4x4 puzzle? A friend of mine did it in 16 seconds. Have fun!
#!perl -w
use strict;
use Tk;
use Tk::DialogBox;
use GD;
use Tk::JPEG;
use Image::Size;
use Storable('nstore','retrieve');

my(@box,$gap,$image,@image,$fimg,$timesh,$movessh,$rpt,$moves,$btime,$
+ptime,$board,$control,$arrows,$mvlabel,$tmlabel,$name,$dif);
my($bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$bestime,$bestmov
+es,$size,$rows,$cols);
eval{($bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$bestime,$best
+moves,$size,$rows,$cols)=@{retrieve('puzzle.inf')}} or setdefcols();
$_+=0 for $size,$cols,$rows;
END{nstore [$bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$bestime
+,$bestmoves,$size,$rows,$cols],'puzzle.inf'};

my $mw=new MainWindow(-title=>'Puzzle',-bg=>$bgcolor);
$mw->geometry('+250+200');

my $menu=$mw->Menu(-tearoff=>0,-type=>'menubar');

    my $gamemenu=$menu->Menu(-tearoff=>0);
        $gamemenu->add('command',-label=>'New',-accelerator=>'F2',-com
+mand=>\&init,-underline=>0);$mw->bind('<F2>'=>sub{init()});
        $gamemenu->add('command',-label=>'Pause',-accelerator=>'F6',-c
+ommand=>\&pause,-underline=>0);$mw->bind('<F6>'=>\&pause);
        $gamemenu->add('separator');
        $gamemenu->add('command',-label=>'Hall of Fame',-underline=>0,
+-command=>sub{
                pause();
                my $hall=$mw->DialogBox(-title=>'Hall of Fame',-bg=>$b
+gcolor,-buttons=>['Close','Reset']);
                $hall->add('Label',-text=>'Time Records: ',-fg=>$hlcol
+or,-bg=>$bgcolor,-font=>'-*-*-bold-*-*-*-*-300-*-*-*-*-*-*-')->pack;
                my $l=0;
                for(sort {$a->[0]<=>$b->[0] or $a->[1]<=>$b->[1]} map 
+[split /$;/,$_],keys %$bestime){
                    $hall->add('Label',-font=>'-*-*-*-*-*-*-*-200-*-*-
+*-*-*-*-',-text=>sprintf('%s x %s: '.($$bestime{$$_[0],$$_[1]}[0]>=36
+00?'%02d:':'').'%02d:%02d'.($$bestime{$$_[0],$$_[1]}[1]?', by %s':'')
+,$$_[0],$$_[1],($$bestime{$$_[0],$$_[1]}[0]>=3600)?
                    (int $$bestime{$$_[0],$$_[1]}[0]/3600,int $$bestim
+e{$$_[0],$$_[1]}[0]%3600/60):(int $$bestime{$$_[0],$$_[1]}[0]/60),$$b
+estime{$$_[0],$$_[1]}[0]%60,$$bestime{$$_[0],$$_[1]}[1]),-fg=>$numcol
+or,-bg=>$bgcolor)->pack(-anchor=>'w');
                    $l||=1
                }
                $hall->add('Label',-text=>'--No Records--',-fg=>$numco
+lor,-bg=>$bgcolor,-font=>'-*-*-*-*-*-*-*-180-*-*-*-*-*-*-')->pack unl
+ess $l;
                
                $hall->add('Label',-text=>'Moves Records: ',-fg=>$hlco
+lor,-bg=>$bgcolor,-font=>'-*-*-bold-*-*-*-*-300-*-*-*-*-*-*-')->pack;
                $l=0;
                for(sort {$a->[0]<=>$b->[0] or $a->[1]<=>$b->[1]} map 
+[split /$;/,$_],keys %$bestmoves){
                    $hall->add('Label',-font=>'-*-*-*-*-*-*-*-200-*-*-
+*-*-*-*-',-text=>sprintf('%s x %s: %d'.($$bestmoves{$$_[0],$$_[1]}[1]
+?', by %s':''),$$_[0],$$_[1],$$bestmoves{$$_[0],$$_[1]}[0],$$bestmove
+s{$$_[0],$$_[1]}[1]),-fg=>$numcolor,-bg=>$bgcolor)->pack(-anchor=>'w'
+);
                    $l||=1
                }
                $hall->add('Label',-text=>'--No Records--',-fg=>$numco
+lor,-bg=>$bgcolor,-font=>'-*-*-*-*-*-*-*-180-*-*-*-*-*-*-')->pack unl
+ess $l;
                if($hall->Show eq 'Reset'){%$bestime=();%$bestmoves=()
+}
                continuen();
            });
        $gamemenu->add('separator');
        $gamemenu->add('command',-label=>'Exit',-command=>sub{exit},-u
+nderline=>1);

    my $optmenu=$menu->Menu(-tearoff=>0);

        my $colsmenu=$optmenu->Menu(-tearoff=>0);
            $colsmenu->add('radio',-variable=>\$cols,-value=>$_,-label
+=>$_,-indicatoron=>1,-command=>sub{setimage() if $image;init()}) for 
+3..7;
            $colsmenu->add('command',-label=>'Other...',-command=>sub{
                my $other;
                my $dial=$mw->DialogBox(-title=>'Custom Columns Number
+',-buttons=>['Ok','Cancel']);
                $dial->add('Label',-text=>'Enter number of columns: ')
+->pack;
                $dial->add('Entry',-textvariable=>\$other,-width=>4)->
+pack;
                $dial->Show eq 'Ok' or return;
                if($other<=2){$mw->messageBox(-icon=>'error',-message=
+>'Invalid number.',-title=>'Error')}else{$cols=$other;setimage() if $
+image;init()}
            });

        my $rowsmenu=$optmenu->Menu(-tearoff=>0);
            $rowsmenu->add('radio',-variable=>\$rows,-value=>$_,-label
+=>$_,-indicatoron=>1,-command=>sub{setimage() if $image;init()}) for 
+3..7;
            $rowsmenu->add('command',-label=>'Other...',-command=>sub{
                my $other;
                my $dial=$mw->DialogBox(-title=>'Custom Rows Number',-
+buttons=>['Ok','Cancel']);
                $dial->add('Label',-text=>'Enter number of rows: ')->p
+ack;
                $dial->add('Entry',-textvariable=>\$other,-width=>4)->
+pack;
                $dial->Show eq 'Ok' or return;
                if($other<=2){$mw->messageBox(-icon=>'error',-message=
+>'Invalid number.',-title=>'Error')}else{$rows=$other;setimage() if $
+image;init()}
            });

        my $sizemenu=$optmenu->Menu(-tearoff=>0);
            $sizemenu->add('radio',-variable=>\$size,-value=>$_->[1],-
+label=>$_->[0],-indicatoron=>1,-command=>sub{setimage() if $image;ini
+t(1)}) for ['Very Small'=>20],['Small'=>30],['Medium'=>40],['Large'=>
+50],['Extra Large'=>60];

        $optmenu->add('cascade',-label=>'Columns',-menu=>$colsmenu,-un
+derline=>0);
        $optmenu->add('cascade',-label=>'Rows',-menu=>$rowsmenu,-under
+line=>0);
        $optmenu->add('cascade',-label=>'Size',-menu=>$sizemenu,-under
+line=>0);
        $optmenu->add('separator');
        $optmenu->add('command',-label=>'Background Color...',-underli
+ne=>0,-command=>sub{$bgcolor=$mw->chooseColor(-initialcolor=>$bgcolor
+,-title=>'Background Color...')||$bgcolor;for($mw,$board,$control,$mv
+label,$tmlabel,$arrows){$_->configure(-bg=>$bgcolor)}});
        $optmenu->add('command',-label=>'Board Color...',-underline=>1
+,-command=>sub{$boardcolor=$mw->chooseColor($boardcolor?(-initialcolo
+r=>$boardcolor):(),-title=>'Board Color...')||$boardcolor;init(1)});
        $optmenu->add('command',-label=>'Text Color...',-underline=>0,
+-command=>sub{$numcolor=$mw->chooseColor(-initialcolor=>$numcolor,-ti
+tle=>'Numbers Color...')||$numcolor;for($mvlabel,$tmlabel){$_->config
+ure(-fg=>$numcolor)}init(1)});
        $optmenu->add('command',-label=>'Highlight Color...',-underlin
+e=>0,-command=>sub{$hlcolor=$mw->chooseColor(-initialcolor=>$hlcolor,
+-title=>'Highlight Color...')||$hlcolor});
        $optmenu->add('command',-label=>'Boxes Color...',-underline=>2
+,-command=>sub{$boxcolor=$mw->chooseColor(-initialcolor=>$boxcolor,-t
+itle=>'Boxes Color...')||$boxcolor;init(1)});
        $optmenu->add('separator');
        $optmenu->add('command',-label=>'Restore Defaults',-underline=
+>0,-command=>sub{setdefcols();for($mw,$board,$control,$mvlabel,$tmlab
+el,$arrows){$_->configure(-bg=>$bgcolor)}for($mvlabel,$tmlabel){$_->c
+onfigure(-fg=>$numcolor)}init()});

    my $imgmenu=$menu->Menu(-tearoff=>0);
        $imgmenu->add('radio',-variable=>\$image,-value=>'',-label=>'N
+one',-indicatoron=>1,-command=>sub{$fimg=undef;@image=();init()});
        $imgmenu->add('radio',-variable=>\$image,-value=>$_,-label=>(/
+(.+)\./)[0],-indicatoron=>1,-command=>sub{setimage();init()}) for <*.
+{jpg,jpeg}>;
        $imgmenu->add('separator');
        $imgmenu->add('command',-label=>'Load...',-underline=>0,-comma
+nd=>sub{my $img=$mw->getOpenFile(-title=>'Load Image...',-filetypes=>
+[['JPEG Image',['*.jpeg','*.jpg']]]) or return;$image=$img;$imgmenu->
+insert($imgmenu->index('Load...')-1,'radio',-variable=>\$image,-value
+=>$img,-label=>($img=~/([^\\\/]+)\.[^\\\/]*$/)[0],-indicatoron=>1,-co
+mmand=>\&setimage);setimage();init()});
        $imgmenu->add('command',-label=>'View Image',-underline=>0,-co
+mmand=>sub{return unless $image;$board->createImage($cols*$size/2+2,$
+rows*$size/2+2,-image=>$fimg,-tags=>['fimg']);$board->update;sleep 2;
+$btime++;$board->delete('fimg');});

    my $helpmenu=$menu->Menu(-tearoff=>0);
        $helpmenu->add('command',-label=>'About...',-underline=>0,-com
+mand=>sub{$mw->messageBox(-title=>'About N-Puzzle...',-message=>'N-Pu
+zzle 2.0 was made by Ido Trivizki.')});

$menu->add('cascade',-label=>'Game',-menu=>$gamemenu,-underline=>0);
$menu->add('cascade',-label=>'Options',-menu=>$optmenu,-underline=>0);
$menu->add('cascade',-label=>'Image',-menu=>$imgmenu,-underline=>0);
$menu->add('cascade',-label=>'Help',-menu=>$helpmenu,-underline=>0);
$mw->configure(-menu=>$menu);

$board=$mw->Canvas(-bg=>$bgcolor,-highlightthickness=>0)->pack(-padx=>
+10,-pady=>10);

$control=$mw->Frame(-bg=>$bgcolor)->pack;
    $tmlabel=$control->Label(-textvariable=>\$timesh,-bg=>$bgcolor,-fg
+=>$numcolor)->grid(-col=>0,-row=>0);
    $arrows=$control->Canvas(-width=>63,-height=>43,-bg=>$bgcolor,-hig
+hlightthickness=>0)->grid(-col=>1,-row=>0);
    $mvlabel=$control->Label(-textvariable=>\$movessh,-bg=>$bgcolor,-f
+g=>$numcolor)->grid(-col=>2,-row=>0);
    $control->gridColumnconfigure(0,-minsize=>90);
    $control->gridColumnconfigure(2,-minsize=>90);

$arrows->createRectangle(2+$_,22+$_,21-$_,41-$_,-tags=>['left'],-outli
+ne=>undef) for 1..10;
$arrows->createLine(2,41,21,41,-fill=>'black',-tags=>['left','se']);
$arrows->createLine(21,41,21,22,-fill=>'black',-tags=>['left','se']);
$arrows->createLine(21,22,2,22,-fill=>'gray',-tags=>['left','nw']);
$arrows->createLine(2,22,2,41,-fill=>'gray',-tags=>['left','nw']);
$arrows->createLine(5,32,18,32,-fill=>'black',-arrow=>'first',-tags=>[
+'left']);

$arrows->createRectangle(22+$_,22+$_,41-$_,41-$_,-tags=>['down'],-outl
+ine=>undef) for 1..10;
$arrows->createLine(22,41,41,41,-fill=>'black',-tags=>['down','se']);
$arrows->createLine(41,41,41,22,-fill=>'black',-tags=>['down','se']);
$arrows->createLine(41,22,22,22,-fill=>'gray',-tags=>['down','nw']);
$arrows->createLine(22,22,22,41,-fill=>'gray',-tags=>['down','nw']);
$arrows->createLine(32,25,32,38,-fill=>'black',-arrow=>'last',-tags=>[
+'down']);

$arrows->createRectangle(42+$_,22+$_,61-$_,41-$_,-tags=>['right'],-out
+line=>undef) for 1..10;
$arrows->createLine(42,41,61,41,-fill=>'black',-tags=>['right','se']);
$arrows->createLine(61,41,61,22,-fill=>'black',-tags=>['right','se']);
$arrows->createLine(61,22,42,22,-fill=>'gray',-tags=>['right','nw']);
$arrows->createLine(42,22,42,41,-fill=>'gray',-tags=>['right','nw']);
$arrows->createLine(45,32,58,32,-fill=>'black',-arrow=>'last',-tags=>[
+'right']);

$arrows->createRectangle(22+$_,2+$_,41-$_,21-$_,-tags=>['up'],-outline
+=>undef) for 1..10;
$arrows->createLine(22,21,41,21,-fill=>'black',-tags=>['up','se']);
$arrows->createLine(41,21,41,2,-fill=>'black',-tags=>['up','se']);
$arrows->createLine(41,2,22,2,-fill=>'gray',-tags=>['up','nw']);
$arrows->createLine(22,2,22,21,-fill=>'gray',-tags=>['up','nw']);
$arrows->createLine(32,5,32,18,-fill=>'black',-arrow=>'first',-tags=>[
+'up']);


my $updatetime=sub{$dif=time-$btime;$timesh=sprintf 'Time: '.($dif>=36
+00?'%02d:':'').'%02d:%02d',($dif>=3600)?(int $dif/3600,int $dif%3600/
+60):(int $dif/60),$dif%60};
my %move;
$move{up}=sub{$mw->bell,return if int($gap/$cols)==$rows-1;$board->mov
+e("$box[$gap+$cols]b",0,-$size);@box[$gap,$gap+$cols]=@box[$gap+$cols
+,$gap];$gap+=$cols;$movessh='Moves: '.++$moves;check() and gameover()
+;};
$move{down}=sub{$mw->bell,return unless int($gap/$cols);$board->move("
+$box[$gap-$cols]b",0,$size);@box[$gap,$gap-$cols]=@box[$gap-$cols,$ga
+p];$gap-=$cols;$movessh='Moves: '.++$moves;};
$move{left}=sub{$mw->bell,return if $gap%$cols==$cols-1;$board->move("
+$box[$gap+1]b",-$size,0);@box[$gap,$gap+1]=@box[$gap+1,$gap];$gap++;$
+movessh='Moves: '.++$moves;check() and gameover();};
$move{right}=sub{$mw->bell,return unless ($gap%$cols);$board->move("$b
+ox[$gap-1]b",$size,0);@box[$gap,$gap-1]=@box[$gap-1,$gap];$gap--;$mov
+essh='Moves: '.++$moves;};
my $mouseclick=sub{my $cur=substr(($board->gettags('current'))[0],0,-1
+);my $curpos;for(0..$#box){next unless defined $box[$_];$curpos=$_ an
+d last if $box[$_]==$cur}if($curpos+1==$gap){$move{right}->()}elsif($
+curpos-1==$gap){$move{left}->()}elsif($curpos+$cols==$gap){$move{down
+}->()}elsif($curpos-$cols==$gap){$move{up}->()}else{$mw->bell}};
my $enter=sub{$board->itemconfigure(($board->gettags('current'))[0].'&
+&box',-fill=>$hlcolor)};
my $press=sub{my $dir=($arrows->gettags('current'))[0];$move{$dir}->()
+;$arrows->itemconfigure("$dir&&se",-fill=>'grey');$arrows->itemconfig
+ure("$dir&&nw",-fill=>'black')};

sub init{
    unless($_[0]){
        @box=0..$cols*$rows-2;
        {my $i;for ($i = @box; --$i; ) {my $j = int rand ($i+1);next i
+f $i == $j;@box[$i,$j] = @box[$j,$i];}}

        $gap=int rand $cols*$rows;
        splice @box,$gap,0,undef;

        my $c;
        for(0..$#box-1){next if $_==$gap;for my $n(@box[$_+1..$#box]){
+next unless defined $n;$c++ if $n<$box[$_]}}
        if($cols&1 and $c&1 or ~$cols&1 and (($c+int($gap/$cols)+1)&1)
+^($rows&1)){my $j;do{$j=rand $#box}until defined $box[$j]&& defined $
+box[$j+1];@box[$j,$j+1]=@box[$j+1,$j]}

        $moves=0;
        $movessh='Moves: 0';
        $rpt->cancel if $rpt;
        $timesh='Time: 00:00';
        $btime=time;
        $rpt=$mw->repeat(1000,$updatetime);
        continuen() if $gamemenu->entrycget(1,'label') eq 'Continue';
    }
    $board->delete('all');
    $board->configure(-width=>$cols*$size+4,-height=>$rows*$size+4);
    
    if($image){
        $board->createImage($cols*$size/2+2,$rows*$size/2+2,-image=>$f
+img,-tags=>['fimg']);
        $board->update;
        sleep 1;
        $board->delete('fimg');
    }

    my($x,$y)=(2,2);
    for(@box){
        next unless defined $_;
        if($image){
            $board->createImage($x+.5*$size,$y+.5*$size,-image=>$image
+[$_],-tags=>["${_}b",'image']);
        }else{
            for my $m(1..$size*.5){
                $board->createRectangle($x+$m,$y+$m,$x+$size-$m,$y+$si
+ze-$m,-outline=>undef,-tags=>["${_}b"]);
            }
        $board->createRectangle($x,$y,$x+$size,$y+$size,-outline=>$box
+color,-fill=>$boardcolor,-tags=>["${_}b",'box']);
        $board->createText($x+.5*$size,$y+.5*$size,-text=>$_+1,-font=>
+'-*-*-*-*-*-*-*-'.($_>=99?7:10)*$size.'-*-*-*-*-*-',-tags=>["${_}b",'
+text'],-fill=>$numcolor);
    }
    }continue{
        $x+=$size;
        ($x-2)/$size==$cols and $y+=$size,$x=2;
    }
    if($_[0] and $gamemenu->entrycget(1,'label') eq 'Continue'){
        my($x,$y)=($board->cget('width')/2,$board->cget('height')/2);
        $board->createText($x-2,$y-2,-text=>'Pause',-font=>'-*-*-*-*-*
+-*-*-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$numcolor,-tags=>['pause'
+]);
        $board->createText($x,$y,-text=>'Pause',-font=>'-*-*-*-*-*-*-*
+-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$hlcolor,-tags=>['pause']);
    }
                
}


$board->bind('all','<Leave>'=>my $leave=sub{$board->itemconfigure(($bo
+ard->gettags('current'))[0].'&&box',-fill=>$boardcolor)});
$arrows->bind('all','<ButtonRelease-1>'=>sub{my $dir=($arrows->gettags
+('current'))[0];$arrows->itemconfigure("$dir&&se",-fill=>'black');$ar
+rows->itemconfigure("$dir&&nw",-fill=>'grey')});
sub setbinds{
    $mw->bind('<Up>'=>$move{up});
    $mw->bind('<Down>'=>$move{down});
    $mw->bind('<Left>'=>$move{left});
    $mw->bind('<Right>'=>$move{right});

    $board->bind('all','<Enter>'=>$enter);
    $board->bind('all','<1>'=>$mouseclick);

    $arrows->bind('all','<ButtonPress-1>'=>$press);
}

sub releasebinds{
    $mw->bind('<Up>'=>undef);
    $mw->bind('<Down>'=>undef);
    $mw->bind('<Left>'=>undef);
    $mw->bind('<Right>'=>undef);

    $board->bind('all','<Enter>'=>undef);
    $board->bind('all','<1>'=>undef);


    $arrows->bind('all','<ButtonPress-1>'=>undef);
}

sub check{
    for(1..$#box-1){return unless $box[$_] && $box[$_]>$box[$_-1]}
    return 1;
}

sub gameover{
    releasebinds();
    $rpt->cancel;
    if($image){
        $board->delete('all');
        $board->update;
        for(0..2){
            $board->createImage($cols*$size/2+2,$rows*$size/2+2,-image
+=>$fimg,-tags=>['fimg']);
            $board->update;
            select undef,undef,undef,0.3;
            $board->delete('fimg');
            $board->update;
            select undef,undef,undef,0.3;
        }
    }else{
        for(0..2){
            $board->itemconfigure('box',-outline=>undef,-fill=>$boardc
+olor);
            $board->itemconfigure('text',-fill=>$hlcolor);
            $board->update;
            select undef,undef,undef,0.3;
            $board->itemconfigure('box',-outline=>$boxcolor);
            $board->itemconfigure('text',-fill=>$numcolor);
            $board->update;
            select undef,undef,undef,0.3;
        }
    }
    if(!$$bestime{$cols,$rows} or $dif<$$bestime{$cols,$rows}[0]){my $
+dial=$mw->DialogBox(-title=>"New Time Record for ${cols}x$rows",-bg=>
+$bgcolor);$dial->add('Label',-text=>'Enter your name: ',-bg=>$bgcolor
+)->pack;$dial->add('Entry',-textvariable=>\$name)->pack;$dial->Show;$
+$bestime{$cols,$rows}=[$dif,$name]}
    if(!$$bestmoves{$cols,$rows} or $moves<$$bestmoves{$cols,$rows}[0]
+){my $dial=$mw->DialogBox(-title=>"New Moves Record for ${cols}x$rows
+",-bg=>$bgcolor);$dial->add('Label',-text=>'Enter your name: ',-bg=>$
+bgcolor)->pack;$dial->add('Entry',-textvariable=>\$name)->pack;$dial-
+>Show;$$bestmoves{$cols,$rows}=[$moves,$name]}
    setbinds();
    init();
}


sub pause{
    releasebinds();
    $rpt->cancel;
    $ptime=time;
    $gamemenu->entryconfigure(1,-label=>'Continue',-command=>\&continu
+en);$mw->bind('<F6>'=>\&continuen);
    my($x,$y)=($board->cget('width')/2,$board->cget('height')/2);
    $board->createText($x-2,$y-2,-text=>'Pause',-font=>'-*-*-*-*-*-*-*
+-'.(8+$cols)*$size.'-*-*-*-*-*-',-fill=>$numcolor,-tags=>['pause']);
    $board->createText($x,$y,-text=>'Pause',-font=>'-*-*-*-*-*-*-*-'.(
+8+$cols)*$size.'-*-*-*-*-*-',-fill=>$hlcolor,-tags=>['pause']);
}

sub continuen{
    setbinds();
    $btime+=time-$ptime;
    $timesh=sprintf 'Time: %02d:%02d',int((time-$btime)/60),(time-$bti
+me)%60;
    $rpt=$mw->repeat(1000,$updatetime);
    $board->delete('pause');
    $gamemenu->entryconfigure(1,-label=>'Pause',-command=>\&pause);$mw
+->bind('<F6>'=>\&pause);
}

sub setimage{
    open my $f,$image or die $!;
    my $simage=GD::Image->newFromJpeg($f);
    my($swidth,$sheight)=imgsize($image);
    my $nimg=new GD::Image(my $w=$size*$cols,my $h=$size*$rows);
    $nimg->copyResized($simage,0,0,0,0,$w,$h,$swidth,$sheight);
    my $tmpname;{my $i;do{$tmpname='temp'.$i++}while -e $tmpname}
    open O,">$tmpname";
    binmode O;
    print O $nimg->jpeg;
    close O;
    $fimg=$mw->Photo(-file=>$tmpname,-format=>'jpeg');
    unlink $tmpname;
    my($ix,$iy,$n)=(0,0);
    @image=();
    for(0..$rows*$cols-2){
        my $timg=$mw->Photo;
        $timg->copy($fimg,-from=>$ix+1,$iy+1,$ix+$size-1,$iy+$size-1,-
+to=>0,0);
        $image[$_]=$timg;
        $ix+=$size;
        $n++;
        $n%$cols or $iy+=$size,$ix=0;
    }
}

{my $def=do{(my $c=$mw->Label)->cget('background')};
sub setdefcols{($bgcolor,$boardcolor,$numcolor,$hlcolor,$boxcolor,$siz
+e,$rows,$cols)=($def,undef,'black','red','black',40,4,4)}
}
setbinds();
init();
MainLoop;
Replies are listed 'Best First'.
Re: N-Puzzle
by zentara (Archbishop) on Sep 29, 2002 at 14:46 UTC
    Hi, I get an error about setting background colors when trying to run your game.
    Can't set -background to `SystemButtonFace' for MainWindow=HASH(0x83aef5c):
    unknown color name "SystemButtonFace" at 
    /usr/lib/perl5/site_perl/5.6.0/i586-linux/Tk/Configure.pm line 46.
    at /usr/lib/perl5/site_perl/5.6.0/i586-linux/Tk/Derived.pm line 294
    
     at ./n-puzzle line 16
    
      Thanks! I think it should be alright now...
Re: N-Puzzle
by zentara (Archbishop) on Oct 01, 2002 at 15:20 UTC
    Getting close :-). Now the error message is:
    ^[^[zentara@zentara:~/1down > ./n-color-puzzle unknown color name "" at /usr/lib/perl5/site_perl/5.6.0/i586-linux/Tk/Widget.pm line 196. at ./n-color-puzzle line 106 It's still about $bgcolor. So I just added it manually.
    eval{($bgcolor,$boardcolor,.............................. $_+=0 for $size,$cols,$rows; $bgcolor= $bgcolor||"lightgrey"; END{nstore ;........................................
    Nice game!!! I really like the ability to play with a photo. This is top-notch stuff. :-)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://201476]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (5)
As of 2024-03-29 11:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found