#!/usr/bin/perl # # World editor for the Northlands Mud # Not yet working. # just needs to write the saved world to disk. otherwise working use Tk; require("init.pm"); $mw=MainWindow->new; $room=1; $editor=1; $filename="map/map.xml"; $roomnum=1; $topframe=$mw->Frame(-relief=>'ridge')->pack(-side=> 'top', -fill =>'x',-expand=>1); $bottomframe=$mw->Frame->pack(-side=>'bottom', -fill=>'x', -expand=>1); $fileframe=$mw->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $roomframe=$mw->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $longdescframe=$mw->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $shortdescframe=$mw->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $exitsframe=$mw->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $fileframe->Label(-text => "Filename: ")->pack(-side => 'left', -anchor =>"e"); $fileframe->Entry(-textvariable=> \$filename, -relief =>"ridge")->pack(-side=>"left", -anchor => "e", -expand=>0); $topframe->Button(-text=> "Exit(no save)", -command => sub{exit;})->pack(-side=>'left', -expand=>1); $topframe->Button(-text=> "Save", -command => \&savefile)->pack(-side=>'left', -expand=>1); $topframe->Button(-text=> "Load", -command => \&loadfile2)->pack(-side=>'left', -expand=>1); $roomframe->Label(-text=>"Room:")->pack(-side => 'left', -anchor=>'e'); $roomframe->Entry(-textvariable=>\$roomnum)->pack(-side=>'left', -anchor=>'e'); $roomframe->Button(-text=> "switch", -command => \&switchrooms)->pack(-side=>'left', -anchor=>'e'); $bottomframe->Label(-textvariable => \$info, -relief =>"ridge")->pack(-side => 'bottom', -fill =>'both', -anchor=>'s', -expand=>1); $longdescframe->Label(-text =>"Long Description", -relief=> "ridge")->pack(-side=>'top', -fill =>'x', -expand=>1, -anchor=>'n'); $data{longdesc}=$longdescframe->Scrolled("Text", -width=>"80", -height=>"7")->pack(-side=>'bottom', -fill => 'both', -expand =>1); $shortdescframe->Label(-text =>"Short Description", -relief=> "ridge")->pack(-side=>'top', -fill =>'x', -expand=>1, -anchor=>'n'); $data{shortdesc}=$shortdescframe->Scrolled("Text", -width=>"80", -height=>"3")->pack(-side=>'bottom', -fill => 'both', -expand =>1); $exitsframe->Label(-text =>"Exits", -relief=> "ridge")->pack(-side=>'top', -fill =>'x',-anchor=>'n'); $obviousframe=$exitsframe->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $obviousframe->Label(-text =>"Obvious", -relief=>'raised')->pack(-side=>'left', -anchor=>'w'); $data{exits}{obvious}=$obviousframe->Entry(-textvariable=>\$obvious)->pack(-side=>'right', -anchor=>'w', fill=>'both',expand=>1); $firstexitsframe=$exitsframe->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $secondexitsframe=$exitsframe->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $thirdexitsframe=$exitsframe->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $fourthexitsframe=$exitsframe->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $fifthexitsframe=$exitsframe->Frame->pack(-side => 'top', -fill => 'both', -expand=>1); $fifthexitsframe->Label(-text =>"Up")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{Up}{dest}=$fifthexitsframe->Entry(-textvariable=>\$up)->pack(-side=>'left', -anchor=>'n', -expand=>1); $fifthexitsframe->Label(-text =>"Down")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{Down}{dest}=$fifthexitsframe->Entry(-textvariable=>\$down)->pack(-side=>'left', -anchor=>'n', -expand=>1); $firstexitsframe->Label(-text =>"North")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{North}{dest}=$firstexitsframe->Entry(-textvariable=>\$north)->pack(-side=>'left', -anchor=>'n', -expand=>1); $firstexitsframe->Label(-text =>"South")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{South}{dest}=$firstexitsframe->Entry(-textvariable=>\$south)->pack(-side=>'left', -anchor=>'n', -expand=>1); $secondexitsframe->Label(-text =>"East")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{East}{dest}=$secondexitsframe->Entry(-textvariable=>\$east)->pack(-side=>'left', -anchor=>'n', -expand=>1); $secondexitsframe->Label(-text =>"West")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{West}{dest}=$secondexitsframe->Entry(-textvariable=>\$west)->pack(-side=>'left', -anchor=>'s', -expand=>1); $thirdexitsframe->Label(-text =>"North-West")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{NorthWest}{dest}=$thirdexitsframe->Entry(-textvariable=>\$Northwest)->pack(-side=>'left', -anchor=>'s', -expand=>1); $thirdexitsframe->Label(-text =>"North-East")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{NorthEast}{dest}=$thirdexitsframe->Entry(-textvariable=>\$NorthEast)->pack(-side=>'left', -anchor=>'s', -expand=>1); $fourthexitsframe->Label(-text =>"South-West")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{SouthWest}{dest}=$fourthexitsframe->Entry(-textvariable=>\$Southwest)->pack(-side=>'left', -anchor=>'s', -expand=>1); $fourthexitsframe->Label(-text =>"South-East")->pack(-side=>'left', -anchor=>'w', -expand=>1); $data{exits}{SouthEast}{dest}=$fourthexitsframe->Entry(-textvariable=>\$Southeast)->pack(-side=>'left', -anchor=>'s', -expand=>1); &loadfile2; MainLoop; sub loadfile2 { $info="Loading file"; loadroom($filename); &displayroom; $info="loaded $filename"; } sub displayroom { my $room=(shift or $roomnum); foreach $a (keys %data){ if (ref($data{$a}) eq "HASH"){ foreach $b (keys %{$data{$a}}){ if (ref($data{$a}{$b}) eq "HASH"){ foreach $c (keys %{$data{$a}{$b}}){ $data{$a}{$b}{$c}->delete("0.0","end"); $data{$a}{$b}{$c}->insert("end", $room[$room]{$a}{$b}{$c}); } next; }else { $data{$a}{$b}->delete("0.0","end"); $data{$a}{$b}->insert("end", $room[$room]{$a}{$b}); } } next; } $data{$a}->delete("0.0","end"); $data{$a}->insert("end", $room[$room]{$a}); } } sub switchrooms{ $room=$roomnum; displayroom($room); $info="Switching to room $room"; } sub savefile { $info="Saving $filename"; local $string; my $i=1; open(FILE, ">$filename"); foreach $a (@room){ unless($a){ next; } $string.="<room><num=$i>\n"; &descend($room[$i],$a); $string.="</room>\n"; $i++; } print FILE "$string\n"; } sub descend { #internal sub used for save. my $str=shift; my $key=shift; local $depth=$depth+1; if (ref($str) eq "HASH"){ #is a refrence need to descend if ($depth==1){ foreach $a (keys %{$str}){ descend(${$str}{$a},$a); } }else { $string.="<$key>\n"; foreach $a (keys %{$str}){ descend(${$str}{$a},$a); } $string.="</$key>\n"; } } elsif (ref($str) eq "ARRAY"){ return; } else { #is a plain value, save it. $string.="<$key>$str</$key>\n"; } }