ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
Revision: 1.3
Committed: Thu Apr 6 20:15:10 2006 UTC (18 years, 2 months ago) by root
Branch: MAIN
Changes since 1.2: +1 -6 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3 root 1.2 use strict;
4    
5     use Crossfire::Client;
6     use Crossfire::Protocol;
7    
8     package Crossfire::Client; # uh, yeah
9    
10     use strict;
11    
12 root 1.1 use SDL;
13     use SDL::App;
14     use SDL::Event;
15     use SDL::Surface;
16 root 1.2 use SDL::OpenGL;
17     use SDL::OpenGL::Constants;
18 root 1.1
19     my $conn;
20 root 1.2 my $app;
21    
22     my $WIDTH = 640;
23     my $HEIGHT = 480;
24    
25     sub glinit {
26     # nuke all gl context data
27    
28     $app = new SDL::App
29     -title => "Crossfire+ Client",
30     -width => $WIDTH,
31     -height => $HEIGHT,
32     -depth => 24,
33     -opengl => 1,
34     -double_buffer => 1,
35     -resizeable => 0;
36    
37     glEnable GL_TEXTURE_2D;
38     glShadeModel GL_FLAT;
39     glDisable GL_DEPTH_TEST;
40     glMatrixMode GL_PROJECTION;
41    
42     #glViewport 0, 0, $WIDTH, $HEIGHT;
43     # re-bind all textures
44     }
45    
46     sub refresh {
47     glClearColor 0.5, 0.5, 0.7, 0;
48     glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT;
49    
50     glLoadIdentity;
51     glOrtho 0, $WIDTH / 32, $HEIGHT / 32, 0, -1 , 1;
52    
53     my $map = $conn->{map};
54 root 1.1
55 root 1.2 for my $x (0 .. $conn->{mapw} - 1) {
56     for my $y (0 .. $conn->{maph} - 1) {
57 root 1.1
58 root 1.2 my $cell = $map->[$x][$y]
59     or next;
60    
61     for my $num (grep $_, $cell->[0], $cell->[1], $cell->[2]) {
62 root 1.3 my $tex = $conn->{face}[$num]{texture} || 0;
63 root 1.2
64     glBindTexture GL_TEXTURE_2D, $tex;
65    
66     glBegin GL_QUADS;
67     glTexCoord 0, 0; glVertex $x, $y;
68     glTexCoord 1, 0; glVertex $x + 1, $y;
69     glTexCoord 1, 1; glVertex $x + 1, $y + 1;
70     glTexCoord 0, 1; glVertex $x, $y + 1;
71     glEnd;
72     }
73     }
74     }
75 root 1.1
76 root 1.2 SDL::GLSwapBuffers;
77 root 1.1 }
78    
79     my $ev = new SDL::Event;
80     my %ev_cb;
81    
82     sub event(&$) {
83     $ev_cb{$_[0]->()} = $_[1];
84     }
85    
86     sub does(&) { shift }
87    
88     event {SDL_QUIT} does {
89     exit;
90     };
91    
92     event {SDL_VIDEORESIZE} does {
93     print "resize\n";
94     };
95    
96     event {SDL_KEYDOWN} does {
97     print "keypress\n";
98     };
99    
100     event {SDL_KEYUP} does {
101     print "keyup\n";#d#
102     };
103    
104     event {SDL_MOUSEMOTION} does {
105     print "motion\n";
106     };
107    
108     event {SDL_MOUSEBUTTONDOWN} does {
109     print "button\n";
110     };
111    
112     event {SDL_MOUSEBUTTONUP} does {
113     print "buttup\n";
114     };
115    
116     event {SDL_ACTIVEEVENT} does {
117     print "active\n";
118     };
119    
120 root 1.2 package Crossfire::Client;
121 root 1.1
122 root 1.2 @conn::ISA = Crossfire::Protocol::;
123 root 1.1
124 root 1.2 sub conn::map_update {
125 root 1.1 my ($self, $dirty) = @_;
126    
127 root 1.2 refresh;
128 root 1.1 }
129    
130 root 1.2 sub conn::map_scroll {
131 root 1.1 my ($self, $dx, $dy) = @_;
132    
133 root 1.2 refresh;
134 root 1.1 }
135    
136 root 1.2 sub conn::map_clear {
137 root 1.1 my ($self) = @_;
138    
139 root 1.2 refresh;
140 root 1.1 }
141    
142 root 1.2 sub conn::face_update {
143 root 1.1 my ($self, $num, $face) = @_;
144    
145     warn "up face $self,$num,$face\n";#d#
146     #TODO
147     open my $fh, ">:raw", "/tmp/x~";
148     syswrite $fh, $face->{image};
149     close $fh;
150    
151 root 1.2 my $surface = new SDL::Surface -name => "/tmp/x~";
152 root 1.1
153     unlink "/tmp/x~";
154    
155 root 1.2 my ($tex) = @{glGenTextures 1};
156     glGetError();
157 root 1.1
158 root 1.2 $face->{texture} = $tex;
159    
160     glBindTexture GL_TEXTURE_2D, $tex;
161     my $glerr=glGetError(); die "a: ".gluErrorString($glerr)."\n" if $glerr;
162    
163     # glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
164     # glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
165    
166     $surface->rgba;
167    
168     glTexImage2D GL_TEXTURE_2D, 0,
169     4, # components
170     $surface->width, $surface->height,
171     0,
172     GL_RGBA,
173     GL_UNSIGNED_BYTE,
174     $surface->pixels;
175     my $glerr=glGetError(); die "Problem setting up 2d Texture (dimensions not a power of 2?)):".gluErrorString($glerr)."\n" if $glerr;
176 root 1.1 }
177    
178     #############################################################################
179    
180     use Event;
181    
182 root 1.2 glinit;
183    
184 root 1.1 $conn = new conn
185     host => "cf.schmorp.de",
186     port => 13327;
187    
188     Event->timer (after => 0, interval => 1/20, hard => 1, cb => sub {
189     while ($ev->poll) {
190     ($ev_cb{$ev->type} || sub { warn "unhandled event ", $ev->type })->();
191     }
192     });
193    
194     Event::loop;
195    
196