##############################################################################
#
# Jarl - SXPM Code
#   Perl code to handle generating sxpm shapes based off either a generic
# shape or compressing an existing grid of points.
#
##############################################################################

##############################################################################
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#  Jabber
#  Copyright (C) 1998-1999 The Jabber Team http://jabber.org/
#
##############################################################################


##############################################################################
#
# jarlSXPM_AddMessage - function to add the <message/> to the sxpm.
#
##############################################################################
sub jarlSXPM_AddMessage {
  my ($JID,$message,$server) = @_;

  $Debug->Log1("jarlSXPM_AddMessage: start");

  $server = 0 unless defined($server);

  my $fromMe = 0;
  my $sxpmID;
  my $myID;
  my $nickID;
  my $myJID;
  my $sxpmJID;
  my $currentID;

  if ($JID == $jabber{myJID}) {
    $myJID = $JID;
    $sxpmJID = $message->GetTo("jid");
    $fromMe = 1;
  } else {
    $myJID = $jabber{myJID};
    $sxpmJID = $JID;
  }

  $Debug->Log3("jarlSXPM_Addmessage: sxpmJID($sxpmJID) ref(".ref($sxpmJID).")");
  $Debug->Log3("jarlSXPM_Addmessage: sxpmJID(".$sxpmJID->GetJID("full").")")
    if (ref($sxpmJID) eq "Net::Jabber::JID");

  $sxpmID = $Roster->
    GetValue($sxpmJID->GetJID(),"name");
  $sxpmID = $sxpmJID->GetUserID() if (!defined($sxpmID) || ($sxpmID eq ""));
  $myID = $myJID->GetUserID();
  $nickID = $sxpmJID->GetUserID();
  
  if (exists($groupchat{jids}->{$sxpmJID->GetJID()})) {
    my $channel = $sxpmID;
    (($channel) = ($sxpmID =~ /^([^\@]+)\@/)) if ($channel =~ /\@/);
    $sxpmID = $channel."/".$sxpmJID->GetResource();
    $myID = $channel."/".$groupchat{tags}->{&jarlGroupChat_Tag($sxpmJID->GetJID())}->{nick};
    $nickID = $sxpmJID->GetResource();
  } else {
    $sxpmJID->SetResource();
  }

  if ($fromMe == 1) {
    $currentID = $myID;
  } else {
    $currentID = $sxpmID;
  }

  my $tag = "";
  
  my $reply = "";
  my $fullJID;
  if (exists($groupchat{jids}->{$sxpmJID->GetJID()})) {
    $fullJID = $sxpmJID->GetJID("full");
  } else {
    $fullJID = $sxpmJID->GetJID();	
  }

  $Debug->Log2("jarlSXPM_AddMessage: fullJID($fullJID)");

  if (ref($message) eq "Net::Jabber::Message") {
    if (!($message->DefinedFrom())) {
      $message->SetFrom($message->GetTo());
      $message->SetTo($jabber{myJID});
    }	
    if (!exists($sxpm{jids}->{$fullJID})) {
      $reply = $message->Reply();
      if ($message->GetThread() ne "") {
	$tag = "sxpm-$$-".$message->GetThread();
      } else {
	$tag = "sxpm-$$-jarl".$jabber{threadCount}.time;
	$jabber{threadCount}++;
      }
      $sxpm{jids}->{$fullJID} = $tag;
    } else {
      $tag = $sxpm{jids}->{$fullJID};
    }
  } else {
    if (!exists($sxpm{jids}->{$fullJID})) {
      $reply = new Net::Jabber::Message();
      $reply->SetMessage(from=>$jabber{myJID},
			 to=>$sxpmJID,
			 type=>"chat",
			 thread=>"jarl".$jabber{threadCount}.time);
      $tag = "sxpm-$$-".$reply->GetThread();
      $jabber{threadCount}++;
    
      $sxpm{jids}->{$fullJID} = $tag;
    } else {
      $tag = $sxpm{jids}->{$fullJID};
    }
  }
  
  if (&jarlSXPMIF_SXPMExists($tag) == 0) {
    &jarlSXPM_BoardName($tag,$sxpmID);
    &jarlSXPM_Type($tag,$reply->GetType());
    &jarlSXPM_SXPMID($tag,$sxpmID);
    &jarlSXPM_NickID($tag,$nickID);
    &jarlSXPM_Reply($tag,$reply);
    &jarlSXPM_JID($tag,$reply->GetTo("jid"));
    &jarlSXPMIF_NewSXPM($tag);
#    &jarlSXPM_UserSecure($tag,-1);
#    &jarlSXPM_SecureSXPM($reply->GetTo("jid"));
#    &jarlSXPM_UserSecure($tag,&jarlSXPM_Secure($tag));
  } else {
    if ($message eq "") {
      &jarlSXPMIF_RaiseSXPM($tag);
    }
  }

  $Debug->Log1("jarlSXPM_AddMessage: Use tag($tag)");

  if (ref($message) eq "Net::Jabber::Message") {
    
    my @sxpms = $message->GetX("jabber:x:sxpm");
    foreach my $sxpm (@sxpms) {
      if ($sxpm->DefinedBoard()) {
	&jarlSXPM_BoardHeight($tag,$sxpm->GetBoardHeight());
	&jarlSXPM_BoardWidth($tag,$sxpm->GetBoardWidth());
	my %newXPM = &jarlSXPM_NewXPM($sxpm->GetBoardWidth(),
				      $sxpm->GetBoardHeight());
	&jarlSXPM_BaseXPM($tag,\%newXPM);

	&jarlSXPMIF_ResizeBoard($tag);
	print "New board or resize....\n";
	print "Make resize function for base XPM...\n";
      }
      if ($sxpm->DefinedData()) {
	my %overlayXPM = &jarlSXPM_BuildXPM($sxpm->GetDataWidth(),
					    $sxpm->GetData());

	my %newXPM = &jarlXPM_Overlay(&jarlSXPM_BaseXPM($tag),
				      \%overlayXPM,
				      $sxpm->GetDataX(),
				      $sxpm->GetDataY());
	
	&jarlSXPM_BaseXPM($tag,\%newXPM);

	&jarlSXPMIF_AddXPM($tag,&jarlXPM_Create(%newXPM));

	print "Modify the sxpm...\n";
      }
      my @maps = $sxpm->GetMaps();
      if ($#maps > -1) {
	print "Modify the map...\n";
      }
    }
  }

  $Debug->Log1("jarlSXPM_AddMessage: finish");

  return $tag;
}


##############################################################################
#
# jarlSXPM_DeleteSXPM - delete the memory taken up by this sxpm session.
#
##############################################################################
sub jarlSXPM_DeleteSXPM {
  my ($tag) = @_;

  foreach my $jid (keys(%{$sxpm{jids}})) {
    delete($sxpm{jids}->{$jid}) if ($sxpm{jids}->{$jid} eq $tag);
  }
  delete($sxpm{tags}->{$tag});
}


##############################################################################
#
# jarlSXPM_Leave - leaves the current channel.
#
##############################################################################
sub jarlSXPM_Leave {
  my ($tag) = @_;

  &jarlSXPM_DeleteSXPM($tag);

  $Debug->Log1("jarlSXPMIF_Leave: tag($tag)");
}


##############################################################################
#
# jarlSXPM_NewXPM - takes sxpm data and build an XPM hash.
#
##############################################################################
sub jarlSXPM_NewXPM {
  my ($width,$height) = @_;

  my %xpm;
  
  foreach my $y (0..$height-1) {
    $xpm{xpm}[$y] = "$width ";
  }

  $xpm{width} = $width;
  $xpm{height} = $height;

  #
  # From Map to color list....
  #
  $xpm{colors}->{'#000000'} = "a";
  $xpm{colors}->{'None'} = " ";
  $xpm{symbols}->{'a'} = '#000000';
  $xpm{symbols}->{' '} = 'None';

  return %xpm;
}



##############################################################################
#
# jarlSXPM_BuildXPM - takes sxpm data and build an XPM hash.
#
##############################################################################
sub jarlSXPM_BuildXPM {
  my ($width,$data) = @_;

  my %xpm;

  my $newData = &jarlSXPM_Uncompress($data);

  my $y = 0;
  while($newData ne "") {
    $xpm{xpm}[$y] = substr($newData,0,$width);
    substr($newData,0,$width) = "";
    $y++;
  }
  $xpm{width} = $width;
  $xpm{height} = $y+1;


  #
  # From Map to color list....
  #
  $xpm{colors}->{'#000000'} = "a";
  $xpm{colors}->{'None'} = " ";
  $xpm{symbols}->{'a'} = '#000000';
  $xpm{symbols}->{' '} = 'None';

  return %xpm;
}



##############################################################################
#
# jarlSXPM_BaseXPM - if $value is not defined then it returns the basexpm
#                    pointer.  Otherwise, it sets the basexpm pointer.
#
##############################################################################
sub jarlSXPM_BaseXPM {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{basexpm} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{basexpm};
  }
}


##############################################################################
#
# jarlSXPM_BoardName - if $value is not defined then it returns the boardname.
#                      Otherwise, it sets the boardname.
#
##############################################################################
sub jarlSXPM_BoardName {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{boardname} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{boardname};
  }
}


##############################################################################
#
# jarlSXPM_BoardHeight - if $value is not defined then it returns the 
#                        boardheight.  Otherwise, it sets the boardheight.
#
##############################################################################
sub jarlSXPM_BoardHeight {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{boardheight} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{boardheight} 
      if exists($sxpm{tags}->{$tag}->{boardheight});
    return 10;
  }
}


##############################################################################
#
# jarlSXPM_BoardWidth - if $value is not defined then it returns the 
#                       boardwidth.  Otherwise, it sets the boardwidth.
#
##############################################################################
sub jarlSXPM_BoardWidth {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{boardwidth} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{boardwidth}
      if exists($sxpm{tags}->{$tag}->{boardwidth});
    return 10;
  }
}


##############################################################################
#
# jarlSXPM_Reply - if $value is not defined then it returns the reply.  
#                   Otherwise, it sets the reply.
#
##############################################################################
sub jarlSXPM_Reply {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{reply} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{reply};
  }
}


##############################################################################
#
# jarlSXPM_Type - if $value is not defined then it returns the nickid.  
#                   Otherwise, it sets the nickid.
#
##############################################################################
sub jarlSXPM_Type {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{type} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{type};
  }
}


##############################################################################
#
# jarlSXPM_NickID - if $value is not defined then it returns the nickid.  
#                   Otherwise, it sets the nickid.
#
##############################################################################
sub jarlSXPM_NickID {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{nickid} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{nickid};
  }
}


##############################################################################
#
# jarlSXPM_SXPMID - if $value is not defined then it returns the sxpmid.  
#                   Otherwise, it sets the sxpmid.
#
##############################################################################
sub jarlSXPM_SXPMID {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{sxpmid} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{sxpmid};
  }
}


##############################################################################
#
# jarlSXPM_JID - if $value is not defined then it returns the jid.  Otherwise,
#                it sets the jid.
#
##############################################################################
sub jarlSXPM_JID {
  my ($tag,$value) = @_;
  if (defined($value)) {
    $sxpm{tags}->{$tag}->{jid} = $value;
  } else {
    return $sxpm{tags}->{$tag}->{jid};
  }
}


##############################################################################
#
# jarlSXPM_Init - Initialize the grid with transparent pixels.
#
##############################################################################
sub jarlSXPM_Init {
  my ($width,$height,$transparent) = @_;
  
  my @grid;
  foreach my $y (0..$height) {
    foreach my $x (0..$width) {
      $grid[$y][$x] = $transparent;
    }
  }
  return @grid;
}
    

##############################################################################
#
# jarlSXPM_Draw - debug function to generate a string suitable for drawing on
#                 te terminal.
#
##############################################################################
sub jarlSXPM_Draw {
  my ($grid,$transparent) = @_;
  my @grid = @{$grid};
  my $sxpm = "";
  foreach my $y (0..$#grid) {
    foreach my $x (0..$#{$grid[$y]}) {
      $sxpm .= $grid[$y][$x];
    }
    $sxpm .= "\n";
  }
  return ($#{$grid[0]}+1,$sxpm);
}


##############################################################################
#
# jarlSXPM_CompressGrid - function to turn a grid of points and the colors
#                         the sxpm format and returns it in a string.
#
##############################################################################
sub jarlSXPM_CompressGrid {
  my ($grid) = @_;
  my @grid = @{$grid};

  my $newData = "";
  foreach my $y (0..$#grid) {
    $newData .= join("",@{$grid[$y]});
  }

  return ($#{$grid[0]}+1,&jarlSXPM_Compress($newData));
}


##############################################################################
#
# jarlSXPM_Compress - function to turn a string into a compressed sxpm format
#                     string.
#
##############################################################################
sub jarlSXPM_Compress {
  my ($data) = @_;
  my $newData = "";
  while($data ne "") {
    my ($char,$restChar) = ($data =~ /^(.)(\1*)/);
    my $subData = $char.$restChar;
    $data =~ s/^(.)(\1*)//;
    my $length = length($subData);
    $length = "" if ($length == 1);
    $newData .= $length.$char;
  }
  return $newData;
}


##############################################################################
#
# jarlSXPM_Uncompress - function to turn sxpm data back into a string.
#
##############################################################################
sub jarlSXPM_Uncompress {
  my ($sxpm) = @_;

  while($sxpm =~ /(\d+)(.)/) {
    my $newString = $2x$1;
    $sxpm =~ s/\d+./$newString/;
  }
  return $sxpm;
}


##############################################################################
#
# jarlSXPM_Rect - function to generate a rect based on starting (x,y), ending
#                 (x,y), thickness for border, and the colors.
#
##############################################################################
sub jarlSXPM_Rect {
  my($x0,$y0,$x1,$y1,$thickness,$transparent,$color,$fill) = @_;
  
  my $shiftX = ($x0 < $x1) ? $x0 : $x1;
  my $shiftY = ($y0 < $y1) ? $y0 : $y1;

  my $width = abs($x1-$x0);
  my $height = abs($y1-$y0);

  my @rect = &jarlSXPM_Init($width,$height,$transparent);

  foreach my $y (0..$height) {
    foreach my $x (0..$width) {
      $rect[$y][$x] = $color;
    }
  }

  foreach my $y ($thickness..($height-$thickness)) {
    foreach my $x (0..($thickness-1)) {
      $rect[$y][$x] = $color;
    }
    foreach my $x ($thickness..($width-$thickness)) {
      $rect[$y][$x] = $fill;
    }
    foreach my $x (($width-$thickness+1)..$width) {
      $rect[$y][$x] = $color;
    }
  }

  foreach my $y (($height-$thickness+1)..$height) {
    foreach my $x (0..$width) {
      $rect[$y][$x] = $color;
    }
  }
#  print "($shiftX,$shiftY,",&jarlSXPM_Draw(\@rect),")\n";
  return ($shiftX,$shiftY,&jarlSXPM_CompressGrid(\@rect));
}


##############################################################################
#
# jarlSXPM_Line - function to generate a line based on starting (x,y), ending
#                 (x,y), thickness for border, and the colors.
#
##############################################################################
sub jarlSXPM_Line {
  my($x0,$y0,$x1,$y1,$thickness,$transparent,$color,$fill) = @_;
  
  my $shiftX = ($x0 < $x1) ? $x0 : $x1;
  my $shiftY = ($y0 < $y1) ? $y0 : $y1;

  my $oddThick = ($thickness/2)-int($thickness/2);
  my $leftThick = (($oddThick >= .5) ? 
		   -int($thickness/2) : 
		   -(int($thickness/2)-1));
  
  $shiftX += $leftThick;

  my $width = abs($x1-$x0)+abs($leftThick)+int($thickness/2);
  my $height = abs($y1-$y0);

  print "width($width) height($height) thickness($thickness) leftThick($leftThick)\n";

  my @line =  &jarlSXPM_Init($width,$height,$transparent);

  my $dx = $x1 - $x0;
  my $dy = $y1 - $y0;

  my $x = $x0;
  my $y = $y0;

  foreach my $plotThick ($leftThick..int($thickness/2)) {
    print "$plotThick\n";
    print $x0-$shiftX+$plotThick,"\n";
    $line[$y-$shiftY][$x0-$shiftX+$plotThick] = $color;
  }

  if (abs($dx) > abs($dy)) {
    my $m = $dy / $dx;
    my $b = $y - ($m*$x);
    $dx = ($dx < 0) ? -1 : 1;
    while ($x != $x1) {
      $x += $dx;
      my $plotY = int(($m*$x) + $b)-$shiftY;
      print "($x,$plotY)\n";
      $plotY = 0 if ($plotY < 0);

      foreach my $plotThick ($leftThick..int($thickness/2)) {
	$line[$plotY][$x-$shiftX+$plotThick] = $color;
      }
    }
  } else {
    if ($dy != 0) {
      my $m = $dx / $dy;
      my $b = $x - ($m*$y);
      $dy = ($dy < 0) ? -1 : 1;
      while ($y != $y1) {
	$y += $dy;

	my $plotX = int(($m*$y) + $b)-$shiftX;

	foreach my $plotThick ($leftThick..int($thickness/2)) {
	  $line[$y-$shiftY][$plotX+$plotThick] = $color;
	}
      }
    }
  }
  print "($shiftX,$shiftY,",&jarlSXPM_Draw(\@line),")\n";
  return ($shiftX,$shiftY,&jarlSXPM_CompressGrid(\@line));
}


##############################################################################
#
# jarlSXPM_Oval - function to generate a oval based on starting (x,y),
#                 ending (x,y), thickness for border, and the colors.
#
##############################################################################
sub jarlSXPM_Oval {
  my ($x0,$y0,$x1,$y1,$thickness,$transparent,$color,$fill) = @_;
  
  my $shiftX = ($x0 < $x1) ? $x0 : $x1;
  my $shiftY = ($y0 < $y1) ? $y0 : $y1;

  my $width = abs($x1-$x0);
  my $height = abs($y1-$y0);

  my @oval = &jarlSXPM_Init($width,$height,$transparent);

  my $halfHeight = ($height/2);
  my $halfWidth = ($width/2);
  
  my $aSqr = ($halfWidth)**2;
  my $bSqr = ($halfHeight)**2;
  
  my $quarterX = int($halfWidth);
  my $quarterY = int($halfHeight);
  
  my $maxY = 0;
  my $maxX = 0;
  
  foreach my $y (0..($quarterY-1)) {
    my $x = int(sqrt((($halfWidth)**2)*(1-($y**2)/$bSqr)));

    $x = int($halfWidth) if ($x > int($halfWidth));
    
    foreach my $thick (0..($thickness-1)) {
      my $plotThick = $thick;
      $plotThick = 0 if (($x-$plotThick) < 0);
      
      my $plotPosX = ($x-$plotThick)+$quarterX;
      my $plotNegX = -($x-$plotThick)+$quarterX;
      my $plotPosY = $y+$quarterY;
      my $plotNegY = -$y+$quarterY;
      
      $oval[$plotPosY][$plotPosX] = $color;
      $oval[$plotPosY][$plotNegX] = $color;
      $oval[$plotNegY][$plotPosX] = $color;
      $oval[$plotNegY][$plotNegX] = $color; 
      $maxX = $plotPosX if ($plotPosX > $maxX);
    }
  }
  
  foreach my $x (0..($quarterX-1)) {
    my $y = int(sqrt((($halfHeight)**2)*(1-($x**2)/$aSqr)));
    
    foreach my $thick (0..($thickness-1)) {
      my $plotThick = $thick;
      $plotThick = 0 if (($y-$plotThick) < 0);
      
      my $plotPosX = $x+$quarterX;
      my $plotNegX = -$x+$quarterX;
      my $plotPosY = ($y-$plotThick)+$quarterY;
      my $plotNegY = -($y-$plotThick)+$quarterY;
      
      $oval[$plotPosY][$plotPosX] = $color;
      $oval[$plotPosY][$plotNegX] = $color;
      $oval[$plotNegY][$plotPosX] = $color;
      $oval[$plotNegY][$plotNegX] = $color;
      $maxY = $plotPosY if ($plotPosY > $maxY); 
    }
  }
  
  if (defined($fill)) {
    foreach my $x (0..$quarterX) {
      foreach my $y (0..$quarterY) {
	last if ($oval[$y+$quarterY][$x+$quarterX] eq $color);
	
	$oval[$y+$quarterY][$x+$quarterX] = $fill;
	$oval[$y+$quarterY][-$x+$quarterX] = $fill;
	$oval[-$y+$quarterY][$x+$quarterX] = $fill;
	$oval[-$y+$quarterY][-$x+$quarterX] = $fill;
      }
    }
  }

#  print "($shiftX,$shiftY,",&jarlSXPM_Draw(\@oval),")\n";
  return ($shiftX,$shiftY,&jarlSXPM_CompressGrid(\@oval));
}


##############################################################################
#
# jarlSXPM_Text - function to generate text starting (x,y), color, size and
#                 the text.
#
##############################################################################
sub jarlSXPM_Text {
  my ($x0,$y0,$size,$transparent,$color) = @_;

  my @text;

  return &jarlSXPM_Draw(\@text);
}


1;