more work, switching places so commiting and pushing

lib/POE/Component/Minecraft/Client/Filter.pm

@@ -11,7 +11,7 @@ sub _read_keep_alive {
   # Packet data:
   # 0-3 uint32: Keep Alive ID
 
-  return [unpack("N", $data)];
+  return ["keep_alive", unpack("N", $data)];
 }
 
 sub _read_login_request {
@@ -36,7 +36,7 @@ sub _read_login_request {
   die "Login Request: String was not empty! The protocol has changed.  This library is not compatible with the server." if ($str_len != 0);
   die "Login Request: Height was not 128.  Height was ". $height.".  This library is not compatible with the server." if ($height != 128);
   
-  return [$player_ent_id, $map_seed, $mode, $dimen, $diff, $max_players];
+  return ["login_request",$player_ent_id, $map_seed, $mode, $dimen, $diff, $max_players];
 }
 
 sub _read_handshake {
@@ -44,6 +44,7 @@ sub _read_handshake {
   my $data = $self->_buf_read(2);
   # Packet data:
   # 0-1 int16: hash string length
+  # 2-N String16: hash
 
   my ($str_len) = unpack("n!", $data);
   die "Handshake: hash was negative length: ". $str_len if ($str_len < 0); # this could also be an unsigned, but i'm not entirely sure on it
@@ -55,14 +56,15 @@ sub _read_handshake {
   warn "Handshake: buffer left is: ".$self->_buf_size()." read: ".$str_len+2;
 
   warn "Didn't convert from UCS-2!"; # This must be fixed! I need to decode it here, but i'm not.  I'don't know when this will be used so this should be fine for now.
-  return [$hash];
+  return ["handshake", $hash];
 }
 
 sub _read_chat {
   my $self = shift;
   my $data = $self->_buf_read(2);
   # Packet data:
-  # 0-1 int16: hash string length
+  # 0-1 int16: hash string length (bytes or chars)
+  # 2-X string16: ucs-2 encoded string
 
   my ($str_len) = unpack("n!", $data);
   die "Chat: message was negative length: ". $str_len if ($str_len < 0); # this could also be an unsigned, but i'm not entirely sure on it
@@ -74,27 +76,226 @@ sub _read_chat {
   warn "Chat: buffer left is: ".$self->_buf_size()." read: ".$str_len+2;
 
   warn "Didn't convert from UCS-2!"; # This must be fixed! I need to decode it here, but i'm not.  I'don't know when this will be used so this should be fine for now.
-  return [$hash];
+  return ["chat", $hash];
 }
 
 sub _read_time {
   my $self = shift;
   my $data = $self->_buf_read(8);
   # Packet data:
-  # 0-1 int16: hash string length
+  # 0-7 uint64: The current game time
 
-  my ($str_len) = unpack("n!", $data);
+  my ($time) = unpack("Q", $data);
-  die "Chat: message was negative length: ". $str_len if ($str_len < 0); # this could also be an unsigned, but i'm not entirely sure on it
+
+  return ["time", $time];
+}
+
+sub _read_entity_equipment {
+  my $self = shift;
+  my $data = $self->_buf_read(10);
+  # Packet data:
+  # 0-3 int32: The current game time
+  # 4-5 int16: Slot on the entity
+  # 6-7 int16: ID of the item
+  # 8-9 int16: damage, rarely used.  Likely only for colors/types, e.g. pink wool
+
+  my ($entity_id, $slot, $item_id, $damage) = unpack("N!n!n!n!", $data);
+
+  return ["entity_equipment", $entity_id, $slot, $item_id, $damage];
+}
+
+sub _read_spawn_position {
+  my $self = shift;
+  my $data = $self->_buf_read(12);
+  # Packet data:
+  # 0-3  int32: X
+  # 4-7  int32: y
+  # 8-11 int32: z
+
+  my ($x, $y, $z) = unpack("N!N!N!", $data);
+
+  return ["spawn_position", $x, $y, $z];
+}
+
+sub _read_update_health {
+  my $self = shift;
+  my $data = $self->_buf_read(8);
+  # Packet data:
+  # 0-1 int16: health 0-20
+  # 2-3 int16: food 0-20
+  # 4-7 float: food saturation? 0.0 - 5.0? what?  no idea what this is for yet
+
+  my ($health, $food, $saturation) = unpack("n!n!f>", $data);
+
+  return ["update_health", $health, $food, $saturation];
+}
+
+sub _read_player_position_look {
+  my $self = shift;
+  my $data = $self->_buf_read(41);
+  # Packet data:
+  # 0-7  double: player X
+  # 8-15 double: stance
+  #16-23 double: player Y
+  #24-31 double: player Z
+  #32-35 float:  look_yaw
+  #36-39 float:  look_pitch
+  #40-40 bool:   on_ground
+
+  my ($x, $s, $y, $z, $yaw, $pitch, $ground) = unpack("(FFFFff)>C", $data);
+
+  return ["player_position_look", $x, $s, $y, $z, $yaw, $pitch, $ground];
+}
+
+# this may never be sent
+sub _read_player_digging {
+  my $self = shift;
+  my $data = $self->_buf_read(11);
+  # Packet data:
+  # 0-0  int8:  action (status)
+  # 1-4  int32: block X
+  # 5-5  uint8: block Y
+  # 6-9  int32: block Z
+  #10-10 int8:  face
+
+  my ($action, $x, $y, $z, $face) = unpack("cN!CN!c", $data);
+
+  return ["player_digging", $action, $x, $y, $z, $face];
+}
+
+sub _read_player_block_placement {
+  my $self = shift;
+  my $data = $self->_buf_read(12);
+  # Packet data:
+  # 0-3  int32: block X
+  # 4-4  uint8: block Y
+  # 5-8  int32: block Z
+  # 9-9  int8:  direction
+  #10-11 int16: block/item id
+
+  # optional data: if (block/item id > 0)
+  #12-12 int8:  amount
+  #13-14 int16: damage/data
+
+  my ($x, $y, $z, $dir, $block_id) = unpack("N!CN!cn!", $data);
+  
+  if ($block_id > 0) {
+    my $data2 = $self->_buf_read(3);
+    my ($amount, $damage) = unpack("cn!", $data2);
+    return ["player_block_placement", $x, $y, $z, $dir, $block_id, $amount, $damage];
+  } else {
+    return ["player_block_placement", $x, $y, $z, $dir, $block_id];
+  }
+}
+
+sub _read_player_use_bed {
+  my $self = shift;
+  my $data = $self->_buf_read(14);
+  # Packet data:
+  # 0-3  int32: entity_id
+  # 4-4  int8:  in bed?
+  # 5-8  int32: block X
+  # 9-9  uint8: block Y
+  #10-13  int32: block Z
+
+  # in bed, seems to always be zero according to the docs, gonna setup an assert on it for testing
+
+  my ($entity_id, $in_bed, $x, $y, $z) = unpack("N!cN!CN!", $data);
+  return ["player_use_bed", $entity_id, $in_bed, $x, $y, $z);
+}
+
+sub _read_animation {
+  my $self = shift;
+  my $data = $self->_buf_read(5);
+  # Packet data:
+  # 0-3  int32: entity_id
+  # 4-4  int8:  animation
+
+  my ($entity_id, $animation) = unpack("N!c", $data);
+  return ["animation", $entity_id, $animation);
+}
+
+sub _read_named_entity_spawn {
+  my $data = $self->_buf_read(6);
+  # Packet data:
+  # 0-3  int32: entity_id
+  # 4-X0 string16:  Entity Name
+  #X1-X4 int32:  X
+  #X5-X5 int8:   Y
+  #X6-X10 int32: Z
+  #X11-X11 uint8: Rotation ($_ / 256 * 360)
+  #X12-X12 uint8: Pitch ($_ / 256 * 360)
+  #X13-X14 int16: item held
+
+  my ($entity_id, $str_len) = unpack("N!n!", $data);
+  die "Named entity spawn: hash was negative length: ". $str_len if ($str_len < 0); # this could also be an unsigned, but i'm not entirely sure on it
 
   #I don't know if this is in characters or in bytes...
 
   # assume it's bytes
-  my $hash = $self->_buf_read($str_len);
+  my $name = $self->_buf_read($str_len);
-  warn "Chat: buffer left is: ".$self->_buf_size()." read: ".$str_len+2;
+  warn "Named entity spawn: buffer left is: ".$self->_buf_size()." read: ".$str_len+2;
 
   warn "Didn't convert from UCS-2!"; # This must be fixed! I need to decode it here, but i'm not.  I'don't know when this will be used so this should be fine for now.
-  return [$hash];
 
+  $data = $self->buf_read(14);
+
+  my ($x, $y, $z, $rotation, $pitch, $item) = unpack("N!CN!CCn!", $data);
+  return ["Named Entity Spawn", $entity_id, $name, $x, $y, $z, $rotation, $pitch, $item);
+}
+
+sub _read_pickup_spawn {
+  my $data = $self->_buf_read(24);
+  # Packet data:
+  # 0-3  int32: entity_id
+  # 4-5  int16: item_id
+  # 6-6  int8:  count
+  # 7-8  int16: damage
+  # 9-12 int32: X
+  #13-16 int32: Y  # why use an int32 for Y here, but not elsewhere?
+  #17-20 int32: Z
+  #21-21 int8:  Rotation # OMG! not using quaternions!
+  #22-22 int8:  Pitch
+  #23-23 int8:  Roll
+
+  my ($entity_id, $item_id, $count, $damage, $x, $y, $z, $rotation, $pitch, $roll) = unpack("N!n!Cn!N!CN!CCC", $data);
+  return ["pickup_spawn", $entity_id, $item_id, $count, $damage, $x, $y, $z, $rotation, $pitch, $roll);
+}
+
+sub _read_collect_item {
+  my $data = $self->_buf_read(8);
+  # Packet data:
+  # 0-3  int32: pickup entity_id
+  # 4-7  int32: collector entity_id
+  
+  my ($entity_id, $collector_id) = unpack("N!N!", $data);
+  return ["collect_item", $entity_id, $collector_id);
+}
+
+sub _read_add_object {
+  my $data = $self->_buf_read(8);
+  # Packet data:
+  # 0-3  int32: entity_id
+  # 4-4  int8: type of object
+  # 5-8  int32: X
+  # 9-12 int32: Y
+  #13-16 int32: Z
+  #17-20 int32: Fireball thrower's ID
+
+  #Optional Data: if (fireball_id != 0)
+  #21-22 int16: FB X
+  #23-24 int16: FB Y
+  #25-26 int16: FB Z  
+
+  my ($entity_id, $type, $x, $y, $z, $thrower_id) = unpack("N!CN!N!N!N!", $data);
+  my ($fb_x, $fb_y, $fb_z);
+
+  if ($thrower_id) { # is negative something else? dunno
+    my $data = $self->_buf_read(6);
+    ($fb_x, $fb_y, $fb_z) = unpack("n!n!n!", $data);
+  }
+
+  return ["add_object", $entity_id, $type, $x, $y, $z, $thrower_id, $fb_x, $fb_y, $fb_z];
 }
 
 my $read_dispatch = {
@@ -106,10 +307,10 @@ my $read_dispatch = {
   0x05 => \&_read_entity_equipment,
   0x06 => \&_read_spawn_position,
   0x08 => \&_read_update_health,
-  0x0D => \&_read_player_position,
+  0x0D => \&_read_player_position_look,
   0x0E => \&_read_player_digging, #CTS?
   0x0F => \&_read_player_block_placement, #CTS?
-  0x10 => \&_read_player_holding, #CTS?
+#  0x10 => \&_read_player_holding, #CTS
   0x11 => \&_read_player_use_bed,
   0x12 => \&_read_animation, #CTS?
 # 0x13 => CTS only, only needed for writing