3 uses Allegro, Math, SDL2, e_Log;
6 GL_INVALID_ENUM = $0500;
10 ValPerColor = 1; (* colors stored in one integer *)
21 TArrayFloat = array of GLfloat;
22 TArrayInteger = array of Integer;
31 TArrayTexture = array of record
42 stack: array [0..StackSize - 1] of record
51 globalTransTable: COLOR_MAP_T;
52 redTransTable: COLOR_MAP_T;
53 greenTransTable: COLOR_MAP_T;
54 blueTransTable: COLOR_MAP_T;
55 darkTransTable: COLOR_MAP_T;
56 lightTransTable: COLOR_MAP_T;
58 function AddTexture: Integer;
61 for i := 1 to High(tex) do
62 if not tex[i].used then
70 SetLength(tex, i + 1);
76 procedure RemoveTexture(i: Integer);
79 assert(i <= High(tex));
80 assert((i = 0) or tex[i].used); (* free unallocated texture *)
82 if tex[i].bmp <> nil then
83 destroy_bitmap(tex[i].bmp);
87 procedure Addi (var x: TArrayInteger; f: Integer);
95 procedure Addf (var x: TArrayFloat; f: GLfloat);
105 procedure glEnable(cap: GLenum);
109 procedure glDisable(cap: GLenum);
113 function glIsEnabled(cap: GLenum): GLboolean;
118 function glGetString(name: GLenum): PChar;
120 if name = GL_EXTENSIONS then (* separated by space *)
121 result := 'GL_ARB_texture_non_power_of_two'
126 procedure glClearColor(red, green, blue, alpha: GLclampf);
128 clearColor := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
131 procedure glClear(mask: GLbitfield);
133 if (mask and GL_COLOR_BUFFER_BIT) <> 0 then
134 clear_to_color(sdl2allegro_screen, clearColor)
137 procedure glAlphaFunc(func: GLenum; ref: GLclampf);
141 procedure glBlendFunc(sfactor, dfactor: GLenum);
143 if (sfactor = GL_SRC_ALPHA) and (dfactor = GL_ONE) then blendMode := BLEND_BLEND
144 else if (sfactor = GL_ZERO) and (dfactor = GL_SRC_ALPHA) then blendMode := BLEND_DARKER
145 else if (sfactor = GL_DST_COLOR) and (dfactor = GL_SRC_COLOR) then blendMode := BLEND_FILTER
146 else if (sfactor = GL_ONE_MINUS_DST_COLOR) and (dfactor = GL_ZERO) then blendMode := BLEND_INVERT
147 else if (sfactor = GL_SRC_ALPHA) and (dfactor = GL_ONE_MINUS_SRC_ALPHA) then blendMode := BLEND_DEFAULT
151 procedure SetupBlendColor (col: cint);
152 var r, g, b, a: cint;
154 //set_trans_blender(r, g, b, a);
155 //set_add_blender(r, g, b, a);
156 //set_burn_blender(r, g, b, a);
157 //set_color_blender(r, g, b, a);
158 //set_difference_blender(r, g, b, a);
159 //set_dissolve_blender(r, g, b, a);
160 //set_dodge_blender(r, g, b, a);
161 //set_hue_blender(r, g, b, a);
162 //set_invert_blender(r, g, b, a);
163 //set_luminance_blender(r, g, b, a);
164 //set_multiply_blender(r, g, b, a);
165 //set_saturation_blender(r, g, b, a);
166 //set_screen_blender(r, g, b, a);
171 color_map := @globalTransTable;
175 color_map := @lightTransTable;
176 set_add_blender(r, g, b, a);
177 drawing_mode(DRAW_MODE_TRANS, nil, 0, 0)
181 color_map := @darkTransTable;
182 set_multiply_blender(0, 0, 0, 255 - a);
183 drawing_mode(DRAW_MODE_TRANS, nil, 0, 0)
187 set_luminance_blender(0, 0, 0, 255);
189 color_map := @redTransTable
191 color_map := @greenTransTable
193 color_map := @blueTransTable;
194 drawing_mode(DRAW_MODE_TRANS, nil, 0, 0)
198 drawing_mode(DRAW_MODE_XOR, nil, 0, 0)
202 (* FIX texture colorize *)
203 if sdl2allegro_bpp <= 8 then
205 drawing_mode(DRAW_MODE_SOLID, nil, 0, 0)
209 set_color_blender(0, 0, 0, 0);
210 drawing_mode(DRAW_MODE_TRANS, nil, 0, 0)
218 procedure glPointSize(size: GLfloat);
221 if size <= 1.0 then pointSize := ceil(size)
222 else pointSize := floor(size)
225 procedure glLineWidth(width: GLfloat);
227 (* width > 1 used in rare cases, not critical *)
230 procedure glGetIntegerv(pname: GLenum; params: PGLint);
243 procedure glBegin(mode: GLenum);
245 assert(cmds.mode = GL_INVALID_ENUM);
246 assert((mode = GL_POINTS) or (mode = GL_LINES) or (mode = GL_QUADS));
248 SetLength(cmds.v, 0);
249 SetLength(cmds.c, 0);
250 SetLength(cmds.t, 0);
255 i, j, k, w, h, x0, y0, x1, y1, offx, offy, tmp, s0, t0, s1, t1, angle: Integer;
256 oldx0, oldy0, oldx1, oldy1: cint;
257 flipv, fliph: Boolean;
258 draw_sprite_proc: procedure (bmp, sprite: Allegro.PBITMAP; x, y: cint); cdecl;
259 rotate_sprite_proc: procedure (bmp, sprite: Allegro.PBITMAP; x, y: cint; a: cint32); cdecl;
261 assert(cmds.mode <> GL_INVALID_ENUM);
262 assert(Length(cmds.v) mod ValPerVertex = 0);
263 assert(Length(cmds.c) mod ValPerColor = 0);
264 assert(Length(cmds.t) mod ValPerCoord = 0);
266 offx := vpx + stack[stack_ptr].x;
267 offy := vpy + stack[stack_ptr].y;
268 angle := stack[stack_ptr].a;
270 drawing_mode(DRAW_MODE_SOLID, nil, 0, 0);
275 (* implement case for texture coords? *)
276 if pointSize = 1 then
278 if Length(cmds.c) <> 0 then
280 assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
281 for i := 0 to Length(cmds.v) div 2 - 1 do
282 putpixel(sdl2allegro_screen, offx + cmds.v[i * 2], offy + cmds.v[i * 2 + 1], cmds.c[i])
286 for i := 0 to Length(cmds.v) div 2 - 1 do
287 putpixel(sdl2allegro_screen, offx + cmds.v[i * 2], offy + cmds.v[i * 2 + 1], ccol)
290 else if pointSize > 1 then
292 x0 := offx - pointSize div 2;
293 y0 := offy - pointSize div 2;
294 x1 := offx - (pointSize - 1) div 2;
295 y1 := offy - (pointSize - 1) div 2;
296 if Length(cmds.c) <> 0 then
298 assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
299 for i := 0 to Length(cmds.v) div 2 - 1 do
301 w := cmds.v[i * 2 + 0];
302 h := cmds.v[i * 2 + 1];
303 rectfill(sdl2allegro_screen, x0 + w, y0 + h, x1 + w, y1 + h, cmds.c[i])
308 for i := 0 to Length(cmds.v) div 2 - 1 do
310 w := cmds.v[i * 2 + 0];
311 h := cmds.v[i * 2 + 1];
312 rectfill(sdl2allegro_screen, x0 + w, y0 + h, x1 + w, y1 + h, ccol)
319 assert(Length(cmds.v) mod 4 = 0); (* broken line *)
320 (* implement case for texture coords? *)
321 if Length(cmds.c) <> 0 then
323 assert(Length(cmds.c) * 2 = Length(cmds.v));
324 for i := 0 to Length(cmds.v) div 4 - 1 do
325 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])
329 for i := 0 to Length(cmds.v) div 4 - 1 do
330 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)
335 ASSERT(Length(cmds.v) mod 8 = 0); (* broken quad *)
336 if Length(cmds.t) <> 0 then
338 ASSERT(Length(cmds.t) = Length(cmds.v)); (* not enough texture coords *)
340 ASSERT(ctex <= High(tex));
341 ASSERT(tex[ctex].bmp <> nil);
342 for i := 0 to Length(cmds.v) div 8 - 1 do
344 flipv := False; fliph := False;
345 x0 := cmds.v[i * 8 + 0]; y0 := cmds.v[i * 8 + 1];
346 x1 := cmds.v[i * 8 + 4]; y1 := cmds.v[i * 8 + 5];
362 w := tex[ctex].bmp.w;
363 h := tex[ctex].bmp.h;
364 s0 := Trunc(cmds.t[i * 8 + 0] * w);
365 t0 := Trunc(cmds.t[i * 8 + 1] * h);
366 s1 := Trunc(cmds.t[i * 8 + 4] * w);
367 t1 := Trunc(cmds.t[i * 8 + 5] * h);
402 if flipv and fliph then
403 draw_sprite_proc := Allegro.draw_sprite_vh_flip
405 draw_sprite_proc := Allegro.draw_sprite_v_flip
407 draw_sprite_proc := Allegro.draw_sprite_h_flip
409 draw_sprite_proc := Allegro.draw_sprite;
411 if flipv and fliph then
412 rotate_sprite_proc := Allegro.rotate_sprite_v_flip (* ??? *)
414 rotate_sprite_proc := Allegro.rotate_sprite_v_flip
416 rotate_sprite_proc := Allegro.rotate_sprite (* ??? *)
418 rotate_sprite_proc := Allegro.rotate_sprite;
420 oldx0 := 0; oldy0 := 0; oldx1 := 0; oldy1 := 0;
421 get_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
422 set_clip_rect(sdl2allegro_screen, max(oldx0, offx + x0), max(oldy0, offy + y0), min(oldx1, offx + x1), min(oldy1, offy + y1));
424 SetupBlendColor(ccol);
426 for j := 0 to (y1 - y0 + h - 1) div h - 1 do
427 for k := 0 to (x1 - x0 + w - 1) div w - 1 do
428 draw_sprite_proc(sdl2allegro_screen, tex[ctex].bmp, offx + x0 + k * w - s0, offy + y0 + j * h - t0)
430 for j := 0 to (y1 - y0 + h - 1) div h - 1 do
431 for k := 0 to (x1 - x0 + w - 1) div w - 1 do
432 rotate_sprite_proc(sdl2allegro_screen, tex[ctex].bmp, offx + x0 + k * w - s0, offy + y0 + j * h - t0, angle);
434 set_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
436 //rect(sdl2allegro_screen, offx + x0, offy + y0, offx + x1, offy + y1, makecol(255, 0, 0));
437 //rect(sdl2allegro_screen, offx + oldx0, offy + oldy0, offx + oldx1, offy + oldx1, makecol(0, 255, 0));
440 else if Length(cmds.c) <> 0 then
442 assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
443 for i := 0 to Length(cmds.v) div 8 - 1 do
445 SetupBlendColor(cmds.c[i * 4]);
446 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])
451 SetupBlendColor(ccol);
452 for i := 0 to Length(cmds.v) div 8 - 1 do
453 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)
460 SetLength(cmds.v, 0);
461 SetLength(cmds.c, 0);
462 SetLength(cmds.t, 0);
463 cmds.mode := GL_INVALID_ENUM;
466 procedure glVertex2f(x, y: GLfloat);
468 Addi(cmds.v, ceil(x));
469 Addi(cmds.v, ceil(y))
472 procedure glVertex2i(x, y: GLint);
478 procedure glColor4f(red, green, blue, alpha: GLfloat);
480 ccol := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
484 procedure glColor4ub(red, green, blue, alpha: GLubyte);
486 ccol := makeacol(red, green, blue, alpha);
490 procedure glColor3ub(red, green, blue: GLubyte);
492 ccol := makecol(red, green, blue);
496 procedure glTexCoord2f(s, t: GLfloat);
502 procedure glTexCoord2i(s, t: GLint);
508 procedure glReadPixels(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer);
512 procedure glLoadIdentity;
514 if matrixMode <> GL_MODELVIEW then Exit;
515 with stack[stack_ptr] do
519 (* TODO Rotation and scale *)
523 procedure glMatrixMode(mode: GLenum);
525 (* GL_PROJECTION -> verify or ignore *)
526 (* GL_MODELVIEW -> apply *)
527 ASSERT((mode = GL_PROJECTION) or (mode = GL_MODELVIEW));
531 procedure glLoadMatrixd(const m: PGLdouble);
533 if matrixMode <> GL_MODELVIEW then Exit;
536 e_LogWritefln('glLoadMatrix:', []);
537 e_LogWritefln('| %s %s %s %s |', [m[0], m[1], m[2], m[3]]);
538 e_LogWritefln('| %s %s %s %s |', [m[4], m[5], m[6], m[7]]);
539 e_LogWritefln('| %s %s %s %s |', [m[8], m[9], m[10], m[11]]);
540 e_LogWritefln('| %s %s %s %s |', [m[12], m[13], m[14], m[15]]);
542 with stack[stack_ptr] do
547 (* TODO Rotation and Scale *)
551 procedure glPushMatrix;
553 if matrixMode <> GL_MODELVIEW then Exit;
554 stack[stack_ptr + 1] := stack[stack_ptr];
558 procedure glPopMatrix;
560 if matrixMode <> GL_MODELVIEW then Exit;
564 procedure glTranslatef(x, y, z: GLfloat);
566 if matrixMode <> GL_MODELVIEW then Exit;
567 ASSERT(z = 0); (* 3D not supported *)
568 stack[stack_ptr].x += Trunc(x);
569 stack[stack_ptr].y += Trunc(y);
572 procedure glRotatef(angle, x, y, z: GLfloat);
574 if matrixMode <> GL_MODELVIEW then Exit;
575 ASSERT(x = 0); (* 3D not supported *)
576 ASSERT(y = 0); (* 3D not supported *)
577 // angle 360deg == 256 with conversion to fixed point 16.16
578 stack[stack_ptr].a += floor(angle * z * 0.71111) * 65536
581 procedure glScalef(x, y, z: GLfloat);
583 if matrixMode <> GL_MODELVIEW then Exit;
584 (* 3D not supported, but z can be any *)
588 procedure glViewport(x, y: GLint; width, height: GLsizei);
591 set_clip_rect(sdl2allegro_screen, x, y, x + width, y + height);
594 procedure glScissor(x, y: GLint; width, height: GLsizei);
596 //set_clip_rect(sdl2allegro_screen, x, y, width, height)
599 procedure glStencilMask(mask: GLuint);
603 procedure glStencilFunc(func: GLenum; ref: GLint; mask: GLuint);
607 procedure glStencilOp(fail, zfail, zpass: GLenum);
611 procedure glColorMask(red, green, blue, alpha: GLboolean);
615 procedure glBindTexture(target: GLenum; texture: GLuint);
617 assert(target = GL_TEXTURE_2D);
621 procedure glGenTextures(n: GLsizei; textures: PGLuint);
624 for i := 0 to n - 1 do
625 textures[i] := AddTexture
628 procedure glTexEnvi(target: GLenum; pname: GLenum; param: GLint);
632 procedure glTexParameterf(target: GLenum; pname: GLenum; param: GLfloat);
636 procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint);
640 procedure glTexImage2D(target: GLenum; level, internalformat: GLint; width, height: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer);
641 var i, j, adr: Integer; p: PByte; color, trans: cint;
643 assert(target = GL_TEXTURE_2D);
645 assert((internalformat = GL_RGBA) or (internalformat = GL_RGB));
646 assert((format = GL_RGBA) or (format = GL_RGB));
648 assert(atype = GL_UNSIGNED_BYTE);
651 assert(ctex <= High(tex));
652 assert(tex[ctex].used);
654 if tex[ctex].bmp <> nil then
655 destroy_bitmap(tex[ctex].bmp);
656 tex[ctex].bmp := create_system_bitmap(width, height);
657 if tex[ctex].bmp = nil then
658 tex[ctex].bmp := create_bitmap(width, height);
659 assert(tex[ctex].bmp <> nil);
661 if pixels = nil then exit;
664 if format = GL_RGBA then
666 if sdl2allegro_bpp <= 8 then
669 trans := makeacol(255, 0, 255, 0);
671 for j := 0 to height - 1 do
672 for i := 0 to width - 1 do
674 adr := j * width * 4 + i * 4;
675 if p[adr + 3] = 0 then
678 color := makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]);
679 putpixel(tex[ctex].bmp, i, j, color)
684 for j := 0 to height - 1 do
685 for i := 0 to width - 1 do
687 adr := j * width * 3 + i * 3;
688 putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
693 procedure glTexSubImage2D(target: GLenum; level, xoffset, yoffset: GLint; width, height: GLsizei; format, atype: GLenum; const pixels: Pointer);
694 var i, j, adr: Integer; p: PByte; color, trans: Cint;
696 assert(target = GL_TEXTURE_2D);
698 assert((format = GL_RGBA) or (format = GL_RGB));
699 assert(atype = GL_UNSIGNED_BYTE);
702 assert(ctex <= High(tex));
703 assert(tex[ctex].used);
708 if pixels = nil then exit;
711 if format = GL_RGBA then
713 if sdl2allegro_bpp <= 8 then
716 trans := makeacol(255, 0, 255, 0);
718 for j := 0 to height - 1 do
719 for i := 0 to width - 1 do
721 adr := j * width * 4 + i * 4;
722 if p[adr + 3] = 0 then
725 color := makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]);
726 putpixel(tex[ctex].bmp, i, j, color)
731 for j := 0 to height - 1 do
732 for i := 0 to width - 1 do
734 adr := j * width * 3 + i * 3;
735 putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
740 procedure glDeleteTextures(n: GLsizei; const textures: PGLuint);
743 for i := 0 to n - 1 do
744 RemoveTexture(textures[i])
749 cmds.mode := GL_INVALID_ENUM;
750 create_trans_table(@globalTransTable, default_palette, 255, 255, 255, nil);
751 create_trans_table(@redTransTable, default_palette, 0, 255, 255, nil);
752 create_trans_table(@greenTransTable, default_palette, 255, 0, 255, nil);
753 create_trans_table(@blueTransTable, default_palette, 255, 255, 0, nil);
754 create_trans_table(@darkTransTable, default_palette, 191, 191, 191, nil);
755 create_trans_table(@lightTransTable, default_palette, 64, 64, 64, nil);
756 color_map := @globalTransTable;