--- deliantra/Deliantra-Client/bin/pclient	2006/04/06 15:30:09	1.1
+++ deliantra/Deliantra-Client/bin/pclient	2006/04/06 21:09:15	1.5
@@ -1,27 +1,83 @@
 #!/opt/bin/perl
 
+use strict;
+
+use Crossfire::Client;
+use Crossfire::Protocol;
+
+package Crossfire::Client; # uh, yeah
+
+use strict;
+
 use SDL;
 use SDL::App;
 use SDL::Event;
 use SDL::Surface;
+use SDL::OpenGL;
+use SDL::OpenGL::Constants;
 
 my $conn;
-my $map_surface;
+my $app;
+
+my $WIDTH  = 640;
+my $HEIGHT = 480;
+
+sub glinit {
+   # nuke all gl context data
+   
+   $app = new SDL::App
+      -flags         => SDL_ANYFORMAT | SDL_HWSURFACE,
+      -title         => "Crossfire+ Client",
+      -width         => $WIDTH,
+      -height        => $HEIGHT,
+      -opengl        => 1,
+      -red_size      => 8,
+      -green_size    => 8,
+      -blue_size     => 8,
+      -double_buffer => 1,
+      -resizeable    => 0;
+
+   glEnable GL_TEXTURE_2D;
+   glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL;
+   glShadeModel GL_FLAT;
+   glDisable GL_DEPTH_TEST;
+   glMatrixMode GL_PROJECTION;
+
+   glLoadIdentity;
+   glOrtho 0, $WIDTH / 32, $HEIGHT / 32, 0, -1 , 1;
+
+   # re-bind all textures
+}
+
+sub refresh {
+   glClearColor 0.5, 0.5, 0.7, 0;
+   glClear GL_COLOR_BUFFER_BIT;
+
+   my $map = $conn->{map};
 
-my $app = new SDL::App
-   -flags  => SDL_HWSURFACE | SDL_ANYFORMAT | SDL_HWACCEL | SDL_ASYNCBLIT,
-   -title  => "Crossfire+ Client",
-   -width  => 640,
-   -height => 480,
-   -depth  => 24,
-   -double_buffer => 1,
-   -resizeable => 1;
+   for my $x (0 .. $conn->{mapw} - 1) {
+      for my $y (0 .. $conn->{maph} - 1) {
 
-sub redraw {
-   $map_surface or return;
+         my $cell = $map->[$x][$y]
+            or next;
 
-   $map_surface->blit (0, $app, 0);
-   $app->sync;
+         for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
+            my $tex = $conn->{face}[$num]{texture} || 0;
+ 
+            glBindTexture GL_TEXTURE_2D, $tex;
+
+            glColor 1,0.2,0.7;
+            glBegin GL_QUADS;
+            glTexCoord 0, 0; glVertex $x, $y;
+            glTexCoord 0, 1; glVertex $x,       $y + 0.9;
+            glTexCoord 1, 1; glVertex $x + 0.9, $y + 0.9;
+            glTexCoord 1, 0; glVertex $x + 0.9, $y;
+            glEnd;
+         }
+      }
+   }
+
+   SDL::GLSwapBuffers;
 }
 
 my $ev = new SDL::Event;
@@ -41,6 +97,10 @@
    print "resize\n";
 };
 
+event {SDL_VIDEOEXPOSE} does {
+   refresh;
+};
+
 event {SDL_KEYDOWN} does {
    print "keypress\n";
 };
@@ -65,262 +125,29 @@
    print "active\n";
 };
 
-package Crossfire::Protocol;
-
-use AnyEvent;
-use IO::Socket::INET;
-
-sub new {
-   my $class = shift;
-   my $self = bless { @_ }, $class;
-
-   $self->{fh} = new IO::Socket::INET PeerHost => $self->{host}, PeerPort => $self->{port}
-      or die "$self->{host}:$self->{port}: $!";
-   $self->{fh}->blocking (0); # stupid nonblock default
-
-   my $buf;
-
-   $self->{w} = AnyEvent->io (fh => $self->{fh}, poll => 'r', cb => sub {
-      if (sysread $self->{fh}, $buf, 16384, length $buf) {
-         if (2 <= length $buf) {
-            my $len = unpack "n", $buf;
-            if ($len + 2 <= length $buf) {
-               substr $buf, 0, 2, "";
-               $self->feed (substr $buf, 0, $len, "");
-            }
-         }
-      } else {
-         delete $self->{w};
-         close $self->{fh};
-      }
-   });
-
-   $self->send ("version 1023 1027 perlclient");
-   $self->send ("setup sound 1 exp 1 map1acmd 1 itemcmd 2 darkness 1 mapsize 63x63 newmapcmd 1 facecache 1 extendedMapInfos 1 extendedTextInfos 1");
-   $self->send ("addme");
-
-   $self
-}
-
-sub feed {
-   my ($self, $data) = @_;
-
-   $data =~ s/^(\S+)\s//
-      or return;
-
-   my $command = "feed_$1";
-
-   $self->$command ($data);
-}
-
-sub feed_version {
-   my ($self, $version) = @_;
-}
-
-sub feed_setup {
-   my ($self, $data) = @_;
-
-   $data =~ s/^ +//;
-
-   $self->{setup} = { split / +/, $data };
-
-   ($self->{mapw}, $self->{maph}) = split /x/, $self->{setup}{mapsize};
-
-   $self->feed_newmap;
-}
-
-sub feed_query {
-   my ($self, $data) = @_;
-   warn "Q<$data>\n";
-}
-
-sub feed_stats {
-   my ($self, $data) = @_;
-#   warn "S<$data>\n";
-}
-
-sub feed_face1 {
-   my ($self, $data) = @_;
-
-   my ($num, $chksum, $name) = unpack "nNa*", $data;
-
-   $self->{face}[$num] = { name => $name, chksum => $chksum };
-}
-
-sub feed_drawinfo {
-   my ($self, $data) = @_;
-#   warn "<$data>\n";
-}
-
-sub feed_delinv {
-   my ($self, $data) = @_;
-}
-
-sub feed_item2 {
-   my ($self, $data) = @_;
-}
-
-sub feed_map1a {
-   my ($self, $data) = @_;
-
-   my $map = $self->{map} ||= [];
-
-   my @dirty;
-   my ($coord, $x, $y, $darkness, $fa, $fb, $fc, $cell);
-
-   while (length $data) {
-      $coord = unpack "n", substr $data, 0, 2, "";
-
-      $x = ($coord >> 10) & 63;
-      $y = ($coord >>  4) & 63;
-
-      $cell = $map->[$x][$y] ||= [];
+package Crossfire::Client;
 
-      $cell->[3] = unpack "C", substr $data, 0, 1, ""
-         if $coord & 8;
-      $cell->[0] = unpack "n", substr $data, 0, 2, ""
-         if $coord & 4;
-      $cell->[1] = unpack "n", substr $data, 0, 2, ""
-         if $coord & 2;
-      $cell->[2] = unpack "n", substr $data, 0, 2, ""
-         if $coord & 1;
+@conn::ISA = Crossfire::Protocol::;
 
-      @$cell = ()
-         unless $coord & 15;
-
-      push @dirty, [$x, $y];
-   }
-
-   $self->map_update (\@dirty);
-}
-
-sub feed_map_scroll {
-   my ($self, $data) = @_;
-
-   my ($dx, $dy) = split / /, $data;
-
-   my $map = $self->{map} ||= [];
-
-   $self->{mapx} += $dx;
-   $self->{mapy} += $dy;
-
-   if ($dx > 0) {
-      unshift @$_, ([]) x $dx for @$map;
-   } elsif ($dx < 0) {
-      splice @$_, 0, -$dx, () for @$map;
-   }
-
-   if ($dy > 0) {
-      unshift @$map, ([]) x $dy;
-   } elsif ($dy < 0) {
-      splice @$map, 0, -$dy, ();
-   }
-
-   $self->map_scroll ($dx, $dy);
-}
-
-sub feed_newmap {
-   my ($self) = @_;
-
-   $self->{map}  = [];
-   $self->{mapx} = 0;
-   $self->{mapy} = 0;
-
-   $self->map_clear;
-}
-
-sub feed_image {
-   my ($self, $data) = @_;
-
-   my ($face, $len, $data) = unpack "NNa*", $data;
-
-   $self->{face}[$face]{image} = $data;
-
-   $self->face_update ($face, $self->{face}[$face]);
-}
-
-sub map_clear  { }
-sub map_update { }
-sub map_scroll { }
-
-sub face_update { }
-
-sub send {
-   my ($self, $data) = @_;
-
-   $data = pack "na*", length $data, $data;
-
-   syswrite $self->{fh}, $data;
-}
-
-package conn;
-
-@ISA = Crossfire::Protocol::;
-
-sub map_update {
+sub conn::map_update {
    my ($self, $dirty) = @_;
 
-   for (@$dirty) {
-      my ($x, $y) = @$_;
-
-      my $px = $x * 32;
-      my $py = $y * 32;
-
-      my $dst = new SDL::Rect -x => $px, -y => $py, -width => 32, -height => 32;
-
-      my $cell = $self->{map}[$x][$y];
-
-      if ($cell) {
-         $cell->[0] or $map_surface->fill ($dst, new SDL::Color -r => 0, -g => 0, -b => 0); # is_floor is opaque, I hope
-
-         for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
-            my $surface = $self->{face}[$num]{surface} ||= do {
-               $self->send ("askface $num");
-
-               # TODO: fog of "war"
-               my $surface = new SDL::Surface
-                  -flags  => SDL::SDL_HWSURFACE | SDL::SDL_ANYFORMAT | SDL::SDL_HWACCEL | SDL::SDL_ASYNCBLIT,
-                  -width  => 32,
-                  -height => 32,
-                  -depth  => 32;
-
-               $surface->fill (0, new SDL::Color -r => 128, -g => 128, -b => 128);
-
-               $surface
-            };
-
-            $surface->blit (0, $map_surface, $dst);
-         }
-      } else {
-         $map_surface->fill ($dst, new SDL::Color -r => 0, -g => 0, -b => 0);
-      }
-   }
-
-   ::redraw;
+   refresh;
 }
 
-sub map_scroll {
+sub conn::map_scroll {
    my ($self, $dx, $dy) = @_;
 
-   ::redraw;
+   refresh;
 }
 
-sub map_clear {
+sub conn::map_clear {
    my ($self) = @_;
 
-   $map_surface = new SDL::Surface
-      -flags  => SDL::HWSURFACE,
-      -width  => $self->{mapw} * 32,
-      -height => $self->{maph} * 32,
-      -depth  => 32;
-
-   SDL::SetClipRect $$map_surface, 0;
-   $map_surface->fill (0, new SDL::Color -r => 0, -g => 0, -b => 0);
-
-   ::redraw;
+   refresh;
 }
 
-sub face_update {
+sub conn::face_update {
    my ($self, $num, $face) = @_;
 
    warn "up face $self,$num,$face\n";#d#
@@ -329,27 +156,39 @@
    syswrite $fh, $face->{image};
    close $fh;
 
-   $face->{surface} = (new SDL::Surface -name  => "/tmp/x~")->display_format;
+   my $surface = new SDL::Surface -name  => "/tmp/x~";
 
    unlink "/tmp/x~";
 
-   my @dirty;
+   my ($tex) = @{glGenTextures 1};
+   glGetError();
 
-   for my $x (0..$self->{mapw} - 1) {
-      for my $y (0..$self->{maph} - 1) {
-         push @dirty, [$x, $y]
-            if grep $_ == $num, @{$self->{map}[$x][$y] || []};
-      }
-   }
-   $self->map_update (\@dirty);
+   $face->{texture} = $tex;
+   
+   glBindTexture GL_TEXTURE_2D, $tex;
+   my $glerr=glGetError(); die "a: ".gluErrorString($glerr)."\n" if $glerr;
+                
+   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
+   glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
+   
+   $surface->rgba;
+
+   glTexImage2D GL_TEXTURE_2D, 0,
+                4, # components
+                $surface->width, $surface->height,
+                0,
+                GL_RGBA,
+                GL_UNSIGNED_BYTE,
+                $surface->pixels;
+   my $glerr=glGetError(); die "Problem setting up 2d Texture (dimensions not a power of 2?)):".gluErrorString($glerr)."\n" if $glerr;
 }
 
-package main;
-
 #############################################################################
 
 use Event;
 
+glinit;
+
 $conn = new conn
    host => "cf.schmorp.de",
    port => 13327;