b9f1ddd960d79fb4dfc274ec739ead974103bc94
1 implementation
3 uses Allegro, Math, SDL2, e_Log;
5 const
6 GL_INVALID_ENUM = $0500;
8 const
9 ValPerVertex = 2;
10 ValPerColor = 1; (* colors stored in one integer *)
11 ValPerCoord = 2;
12 StackSize = 16;
14 type
15 TArrayFloat = array of GLfloat;
16 TArrayInteger = array of Integer;
18 TCmds = record
19 mode: GLenum;
20 v: TArrayInteger;
21 c: TArrayInteger;
22 t: TArrayFloat;
23 end;
25 TArrayTexture = array of record
26 used: Boolean;
27 bmp: PBITMAP;
28 end;
30 var
31 cmds: TCmds;
32 tex: TArrayTexture;
33 ctex: Integer;
34 ccol: Integer;
35 clearColor: cint;
36 stack: array [0..StackSize - 1] of record
37 x, y: Integer;
38 end;
39 stack_ptr: Integer;
40 vpx, vpy: Integer;
41 pointSize: Integer;
42 matrixMode: GLenum;
44 function AddTexture: Integer;
45 var i: Integer;
46 begin
47 for i := 1 to High(tex) do
48 if not tex[i].used then
49 begin
50 tex[i].used := true;
51 tex[i].bmp := nil;
52 result := i;
53 exit
54 end;
55 i := Length(tex);
56 SetLength(tex, i + 1);
57 tex[i].used := true;
58 tex[i].bmp := nil;
59 result := i
60 end;
62 procedure RemoveTexture(i: Integer);
63 begin
64 assert(i >= 0);
65 assert(i <= High(tex));
66 assert((i = 0) or tex[i].used); (* free unallocated texture *)
67 tex[i].used := false;
68 if tex[i].bmp <> nil then
69 destroy_bitmap(tex[i].bmp);
70 tex[i].bmp := nil
71 end;
73 procedure Addi (var x: TArrayInteger; f: Integer);
74 var i: Integer;
75 begin
76 i := Length(x);
77 SetLength(x, i + 1);
78 x[i] := f;
79 end;
81 procedure Addf (var x: TArrayFloat; f: GLfloat);
82 var i: Integer;
83 begin
84 i := Length(x);
85 SetLength(x, i + 1);
86 x[i] := f;
87 end;
89 (** Open GL **)
91 procedure glEnable(cap: GLenum);
92 begin
93 end;
95 procedure glDisable(cap: GLenum);
96 begin
97 end;
99 function glIsEnabled(cap: GLenum): GLboolean;
100 begin
101 result := 0
102 end;
104 function glGetString(name: GLenum): PChar;
105 begin
106 if name = GL_EXTENSIONS then (* separated by space *)
107 result := 'GL_ARB_texture_non_power_of_two'
108 else
109 result := nil
110 end;
112 procedure glClearColor(red, green, blue, alpha: GLclampf);
113 begin
114 clearColor := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
115 end;
117 procedure glClear(mask: GLbitfield);
118 begin
119 if (mask and GL_COLOR_BUFFER_BIT) <> 0 then
120 clear_to_color(sdl2allegro_screen, clearColor)
121 end;
123 procedure glAlphaFunc(func: GLenum; ref: GLclampf);
124 begin
125 end;
127 procedure glBlendFunc(sfactor, dfactor: GLenum);
128 begin
129 end;
131 procedure glPointSize(size: GLfloat);
132 begin
133 ASSERT(size >= 0);
134 if size <= 1.0 then pointSize := ceil(size)
135 else pointSize := floor(size)
136 end;
138 procedure glLineWidth(width: GLfloat);
139 begin
140 (* width > 1 used in rare cases, not critical *)
141 end;
143 procedure glGetIntegerv(pname: GLenum; params: PGLint);
144 begin
145 params^ := 0
146 end;
148 procedure glFlush;
149 begin
150 end;
152 procedure glFinish;
153 begin
154 end;
156 procedure glBegin(mode: GLenum);
157 begin
158 assert(cmds.mode = GL_INVALID_ENUM);
159 assert((mode = GL_POINTS) or (mode = GL_LINES) or (mode = GL_QUADS));
160 cmds.mode := mode;
161 SetLength(cmds.v, 0);
162 SetLength(cmds.c, 0);
163 SetLength(cmds.t, 0);
164 end;
166 procedure glEnd;
167 var
168 i, j, k, w, h, x0, y0, x1, y1, offx, offy, tmp, s0, t0, s1, t1: Integer;
169 oldx0, oldy0, oldx1, oldy1: cint;
170 flipv, fliph: Boolean;
171 draw_sprite_proc: procedure (bmp, sprite: Allegro.PBITMAP; x, y: cint); cdecl;
172 begin
173 assert(cmds.mode <> GL_INVALID_ENUM);
174 assert(Length(cmds.v) mod ValPerVertex = 0);
175 assert(Length(cmds.c) mod ValPerColor = 0);
176 assert(Length(cmds.t) mod ValPerCoord = 0);
178 offx := vpx + stack[stack_ptr].x;
179 offy := vpy + stack[stack_ptr].y;
181 case cmds.mode of
182 GL_POINTS:
183 begin
184 (* implement case for texture coords? *)
185 if pointSize = 1 then
186 begin
187 if Length(cmds.c) <> 0 then
188 begin
189 assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
190 for i := 0 to Length(cmds.v) div 2 - 1 do
191 putpixel(sdl2allegro_screen, offx + cmds.v[i * 2], offy + cmds.v[i * 2 + 1], cmds.c[i])
192 end
193 else
194 begin
195 for i := 0 to Length(cmds.v) div 2 - 1 do
196 putpixel(sdl2allegro_screen, offx + cmds.v[i * 2], offy + cmds.v[i * 2 + 1], ccol)
197 end
198 end
199 else if pointSize > 1 then
200 begin
201 x0 := offx - pointSize div 2;
202 y0 := offy - pointSize div 2;
203 x1 := offx - (pointSize - 1) div 2;
204 y1 := offy - (pointSize - 1) div 2;
205 if Length(cmds.c) <> 0 then
206 begin
207 assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
208 for i := 0 to Length(cmds.v) div 2 - 1 do
209 begin
210 w := cmds.v[i * 2 + 0];
211 h := cmds.v[i * 2 + 1];
212 rectfill(sdl2allegro_screen, x0 + w, y0 + h, x1 + w, y1 + h, cmds.c[i])
213 end
214 end
215 else
216 begin
217 for i := 0 to Length(cmds.v) div 2 - 1 do
218 begin
219 w := cmds.v[i * 2 + 0];
220 h := cmds.v[i * 2 + 1];
221 rectfill(sdl2allegro_screen, x0 + w, y0 + h, x1 + w, y1 + h, ccol)
222 end
223 end
224 end
225 end;
226 GL_LINES:
227 begin
228 assert(Length(cmds.v) mod 4 = 0); (* broken line *)
229 (* implement case for texture coords? *)
230 if Length(cmds.c) <> 0 then
231 begin
232 assert(Length(cmds.c) * 2 = Length(cmds.v));
233 for i := 0 to Length(cmds.v) div 4 - 1 do
234 fastline(sdl2allegro_screen, offx + cmds.v[i * 4], offy + cmds.v[i * 4 + 1], offx + cmds.v[i * 4 + 2], offy + cmds.v[i * 4 + 3], cmds.c[i * 2])
235 end
236 else
237 begin
238 for i := 0 to Length(cmds.v) div 4 - 1 do
239 fastline(sdl2allegro_screen, offx + cmds.v[i * 4], offy + cmds.v[i * 4 + 1], offx + cmds.v[i * 4 + 2], offy + cmds.v[i * 4 + 3], ccol)
240 end
241 end;
242 GL_QUADS:
243 begin
244 ASSERT(Length(cmds.v) mod 8 = 0); (* broken quad *)
245 if Length(cmds.t) <> 0 then
246 begin
247 ASSERT(Length(cmds.t) = Length(cmds.v)); (* not enough texture coords *)
248 ASSERT(ctex >= 0);
249 ASSERT(ctex <= High(tex));
250 ASSERT(tex[ctex].bmp <> nil);
251 for i := 0 to Length(cmds.v) div 8 - 1 do
252 begin
253 flipv := False; fliph := False;
254 x0 := cmds.v[i * 8 + 0]; y0 := cmds.v[i * 8 + 1];
255 x1 := cmds.v[i * 8 + 4]; y1 := cmds.v[i * 8 + 5];
256 if x1 < x0 then
257 begin
258 tmp := x0;
259 x0 := x1;
260 x1 := tmp;
261 fliph := not fliph
262 end;
263 if y1 < y0 then
264 begin
265 tmp := y0;
266 y0 := y1;
267 y1 := tmp;
268 flipv := not flipv
269 end;
271 w := tex[ctex].bmp.w;
272 h := tex[ctex].bmp.h;
273 s0 := Trunc(cmds.t[i * 8 + 0] * w);
274 t0 := Trunc(cmds.t[i * 8 + 1] * h);
275 s1 := Trunc(cmds.t[i * 8 + 4] * w);
276 t1 := Trunc(cmds.t[i * 8 + 5] * h);
278 if s1 < s0 then
279 begin
280 tmp := s0;
281 s0 := s1;
282 s1 := tmp;
283 fliph := not fliph;
284 end;
285 if t1 < t0 then
286 begin
287 tmp := t0;
288 t0 := t1;
289 t1 := tmp;
290 flipv := not flipv;
291 end;
293 if fliph then
294 begin
295 tmp := s0;
296 s0 := w - s1;
297 s1 := w - tmp;
298 end;
299 if flipv then
300 begin
301 tmp := t0;
302 t0 := h - t1;
303 t1 := h - tmp;
304 end;
306 s0 := s0 mod w;
307 t0 := t0 mod h;
308 s1 := s1 mod w;
309 t1 := t1 mod h;
311 if flipv and fliph then
312 draw_sprite_proc := Allegro.draw_sprite_vh_flip
313 else if flipv then
314 draw_sprite_proc := Allegro.draw_sprite_v_flip
315 else if fliph then
316 draw_sprite_proc := Allegro.draw_sprite_h_flip
317 else
318 draw_sprite_proc := Allegro.draw_sprite;
320 oldx0 := 0; oldy0 := 0; oldx1 := 0; oldy1 := 0;
321 get_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
322 set_clip_rect(sdl2allegro_screen, max(oldx0, offx + x0), max(oldy0, offy + y0), min(oldx1, offx + x1), min(oldy1, offy + y1));
324 for j := 0 to (y1 - y0 + h - 1) div h - 1 do
325 for k := 0 to (x1 - x0 + w - 1) div w - 1 do
326 draw_sprite_proc(sdl2allegro_screen, tex[ctex].bmp, offx + x0 + k * w - s0, offy + y0 + j * h - t0);
328 set_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
330 //rect(sdl2allegro_screen, offx + x0, offy + y0, offx + x1, offy + y1, makecol(255, 0, 0));
331 //rect(sdl2allegro_screen, offx + oldx0, offy + oldy0, offx + oldx1, offy + oldx1, makecol(0, 255, 0));
332 end
333 end
334 else if Length(cmds.c) <> 0 then
335 begin
336 assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
337 for i := 0 to Length(cmds.v) div 8 - 1 do
338 rectfill(sdl2allegro_screen, offx + cmds.v[i * 8], offy + cmds.v[i * 8 + 1], offx + cmds.v[i * 8 + 4], offy + cmds.v[i * 8 + 5], cmds.c[i * 4])
339 end
340 else
341 begin
342 for i := 0 to Length(cmds.v) div 8 - 1 do
343 rectfill(sdl2allegro_screen, offx + cmds.v[i * 8], offy + cmds.v[i * 8 + 1], offx + cmds.v[i * 8 + 4], offy + cmds.v[i * 8 + 5], ccol)
344 end
345 end;
346 else
347 assert(false)
348 end;
350 SetLength(cmds.v, 0);
351 SetLength(cmds.c, 0);
352 SetLength(cmds.t, 0);
353 cmds.mode := GL_INVALID_ENUM;
354 end;
356 procedure glVertex2f(x, y: GLfloat);
357 begin
358 Addi(cmds.v, ceil(x));
359 Addi(cmds.v, ceil(y))
360 end;
362 procedure glVertex2i(x, y: GLint);
363 begin
364 Addi(cmds.v, x);
365 Addi(cmds.v, y)
366 end;
368 procedure glColor4f(red, green, blue, alpha: GLfloat);
369 begin
370 ccol := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
371 Addi(cmds.c, ccol)
372 end;
374 procedure glColor4ub(red, green, blue, alpha: GLubyte);
375 begin
376 ccol := makeacol(red, green, blue, alpha);
377 Addi(cmds.c, ccol)
378 end;
380 procedure glColor3ub(red, green, blue: GLubyte);
381 begin
382 ccol := makecol(red, green, blue);
383 Addi(cmds.c, ccol)
384 end;
386 procedure glTexCoord2f(s, t: GLfloat);
387 begin
388 Addf(cmds.t, s);
389 Addf(cmds.t, t);
390 end;
392 procedure glTexCoord2i(s, t: GLint);
393 begin
394 Addf(cmds.t, s);
395 Addf(cmds.t, t);
396 end;
398 procedure glReadPixels(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer);
399 begin
400 end;
402 procedure glLoadIdentity;
403 begin
404 if matrixMode <> GL_MODELVIEW then Exit;
405 with stack[stack_ptr] do
406 begin
407 x := 0;
408 y := 0;
409 (* TODO Rotation and scale *)
410 end
411 end;
413 procedure glMatrixMode(mode: GLenum);
414 begin
415 (* GL_PROJECTION -> verify or ignore *)
416 (* GL_MODELVIEW -> apply *)
417 ASSERT((mode = GL_PROJECTION) or (mode = GL_MODELVIEW));
418 matrixMode := mode;
419 end;
421 procedure glLoadMatrixd(const m: PGLdouble);
422 begin
423 if matrixMode <> GL_MODELVIEW then Exit;
425 (*
426 e_LogWritefln('glLoadMatrix:', []);
427 e_LogWritefln('| %s %s %s %s |', [m[0], m[1], m[2], m[3]]);
428 e_LogWritefln('| %s %s %s %s |', [m[4], m[5], m[6], m[7]]);
429 e_LogWritefln('| %s %s %s %s |', [m[8], m[9], m[10], m[11]]);
430 e_LogWritefln('| %s %s %s %s |', [m[12], m[13], m[14], m[15]]);
431 *)
432 with stack[stack_ptr] do
433 begin
434 x := Trunc(m[3]);
435 y := Trunc(m[7]);
436 ASSERT(m[11] = 0);
437 (* TODO Rotation and Scale *)
438 end
439 end;
441 procedure glPushMatrix;
442 begin
443 if matrixMode <> GL_MODELVIEW then Exit;
444 stack[stack_ptr + 1] := stack[stack_ptr];
445 INC(stack_ptr);
446 end;
448 procedure glPopMatrix;
449 begin
450 if matrixMode <> GL_MODELVIEW then Exit;
451 DEC(stack_ptr)
452 end;
454 procedure glTranslatef(x, y, z: GLfloat);
455 begin
456 if matrixMode <> GL_MODELVIEW then Exit;
457 ASSERT(z = 0); (* 3D not supported *)
458 stack[stack_ptr].x += Trunc(x);
459 stack[stack_ptr].y += Trunc(y);
460 end;
462 procedure glRotatef(angle, x, y, z: GLfloat);
463 begin
464 if matrixMode <> GL_MODELVIEW then Exit;
465 ASSERT(x = 0); (* 3D not supported *)
466 ASSERT(y = 0); (* 3D not supported *)
467 (* TODO a := deg(angle * z) *)
468 end;
470 procedure glScalef(x, y, z: GLfloat);
471 begin
472 if matrixMode <> GL_MODELVIEW then Exit;
473 (* 3D not supported, but z can be any *)
474 (* TODO Scale *)
475 end;
477 procedure glViewport(x, y: GLint; width, height: GLsizei);
478 begin
479 vpx := x; vpy := y;
480 set_clip_rect(sdl2allegro_screen, x, y, x + width, y + height);
481 end;
483 procedure glScissor(x, y: GLint; width, height: GLsizei);
484 begin
485 //set_clip_rect(sdl2allegro_screen, x, y, width, height)
486 end;
488 procedure glStencilMask(mask: GLuint);
489 begin
490 end;
492 procedure glStencilFunc(func: GLenum; ref: GLint; mask: GLuint);
493 begin
494 end;
496 procedure glStencilOp(fail, zfail, zpass: GLenum);
497 begin
498 end;
500 procedure glColorMask(red, green, blue, alpha: GLboolean);
501 begin
502 end;
504 procedure glBindTexture(target: GLenum; texture: GLuint);
505 begin
506 assert(target = GL_TEXTURE_2D);
507 ctex := texture;
508 end;
510 procedure glGenTextures(n: GLsizei; textures: PGLuint);
511 var i: Integer;
512 begin
513 for i := 0 to n - 1 do
514 textures[i] := AddTexture
515 end;
517 procedure glTexEnvi(target: GLenum; pname: GLenum; param: GLint);
518 begin
519 end;
521 procedure glTexParameterf(target: GLenum; pname: GLenum; param: GLfloat);
522 begin
523 end;
525 procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint);
526 begin
527 end;
529 procedure glTexImage2D(target: GLenum; level, internalformat: GLint; width, height: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer);
530 var i, j, adr: Integer; p: PByte; color, trans: cint;
531 begin
532 assert(target = GL_TEXTURE_2D);
533 assert(level = 0);
534 assert((internalformat = GL_RGBA) or (internalformat = GL_RGB));
535 assert((format = GL_RGBA) or (format = GL_RGB));
536 assert(border = 0);
537 assert(atype = GL_UNSIGNED_BYTE);
539 assert(ctex >= 0);
540 assert(ctex <= High(tex));
541 assert(tex[ctex].used);
543 if tex[ctex].bmp <> nil then
544 destroy_bitmap(tex[ctex].bmp);
545 tex[ctex].bmp := create_system_bitmap(width, height);
546 if tex[ctex].bmp = nil then
547 tex[ctex].bmp := create_bitmap(width, height);
548 assert(tex[ctex].bmp <> nil);
550 if pixels = nil then exit;
552 p := pixels;
553 if format = GL_RGBA then
554 begin
555 if DEFAULT_DEPTH <= 8 then
556 trans := 0
557 else
558 trans := makeacol(255, 0, 255, 0);
560 for j := 0 to height - 1 do
561 for i := 0 to width - 1 do
562 begin
563 adr := j * width * 4 + i * 4;
564 if p[adr + 3] = 0 then
565 color := trans
566 else
567 color := makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]);
568 putpixel(tex[ctex].bmp, i, j, color)
569 end
570 end
571 else
572 begin
573 for j := 0 to height - 1 do
574 for i := 0 to width - 1 do
575 begin
576 adr := j * width * 3 + i * 3;
577 putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
578 end
579 end
580 end;
582 procedure glTexSubImage2D(target: GLenum; level, xoffset, yoffset: GLint; width, height: GLsizei; format, atype: GLenum; const pixels: Pointer);
583 var i, j, adr: Integer; p: PByte; color, trans: Cint;
584 begin
585 assert(target = GL_TEXTURE_2D);
586 assert(level = 0);
587 assert((format = GL_RGBA) or (format = GL_RGB));
588 assert(atype = GL_UNSIGNED_BYTE);
590 assert(ctex >= 0);
591 assert(ctex <= High(tex));
592 assert(tex[ctex].used);
594 assert(xoffset = 0);
595 assert(yoffset = 0);
597 if pixels = nil then exit;
599 p := pixels;
600 if format = GL_RGBA then
601 begin
602 if DEFAULT_DEPTH <= 8 then
603 trans := 0
604 else
605 trans := makeacol(255, 0, 255, 0);
607 for j := 0 to height - 1 do
608 for i := 0 to width - 1 do
609 begin
610 adr := j * width * 4 + i * 4;
611 if p[adr + 3] = 0 then
612 color := trans
613 else
614 color := makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]);
615 putpixel(tex[ctex].bmp, i, j, color)
616 end
617 end
618 else
619 begin
620 for j := 0 to height - 1 do
621 for i := 0 to width - 1 do
622 begin
623 adr := j * width * 3 + i * 3;
624 putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
625 end
626 end
627 end;
629 procedure glDeleteTextures(n: GLsizei; const textures: PGLuint);
630 var i: Integer;
631 begin
632 for i := 0 to n - 1 do
633 RemoveTexture(textures[i])
634 end;
636 procedure nogl_Init;
637 begin
638 cmds.mode := GL_INVALID_ENUM
639 end;
641 procedure nogl_Quit;
642 begin
643 end;
645 initialization