src/nogl/noGLALSW.inc

   1 implementation
   2
   3   uses Allegro, Math, SDL2, e_Log;
   4
   5   const
   6     GL_INVALID_ENUM = $0500;
   7
   8   const
   9     ValPerVertex = 2;
  10     ValPerColor = 1; (* colors stored in one integer *)
  11     ValPerCoord = 2;
  12     StackSize = 16;
  13
  14   type
  15     TArrayFloat = array of GLfloat;
  16     TArrayInteger = array of Integer;
  17
  18     TCmds = record
  19       mode: GLenum;
  20       v: TArrayInteger;
  21       c: TArrayInteger;
  22       t: TArrayFloat;
  23     end;
  24
  25     TArrayTexture = array of record
  26       used: Boolean;
  27       bmp: PBITMAP;
  28     end;
  29
  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
  41   function AddTexture: Integer;
  42     var i: Integer;
  43   begin
  44     for i := 0 to High(tex) do
  45       if not tex[i].used then
  46       begin
  47         tex[i].used := true;
  48         tex[i].bmp := nil;
  49         result := i;
  50         exit
  51       end;
  52     i :=  Length(tex);
  53     SetLength(tex, i + 1);
  54     tex[i].used := true;
  55     tex[i].bmp := nil;
  56     result := i
  57   end;
  58
  59   procedure RemoveTexture(i: Integer);
  60   begin
  61     assert(i >= 0);
  62     assert(i <= High(tex));
  63     //assert(tex[i].used); (* free unallocated texture *)
  64     tex[i].used := false;
  65     if tex[i].bmp <> nil then
  66       destroy_bitmap(tex[i].bmp);
  67     tex[i].bmp := nil
  68   end;
  69
  70   procedure Addi (var x: TArrayInteger; f: Integer);
  71     var i: Integer;
  72   begin
  73     i := Length(x);
  74     SetLength(x, i + 1);
  75     x[i] := f;
  76   end;
  77
  78   procedure Addf (var x: TArrayFloat; f: GLfloat);
  79     var i: Integer;
  80   begin
  81     i := Length(x);
  82     SetLength(x, i + 1);
  83     x[i] := f;
  84   end;
  85
  86   (** Open GL **)
  87
  88   procedure glEnable(cap: GLenum);
  89   begin
  90   end;
  91
  92   procedure glDisable(cap: GLenum);
  93   begin
  94   end;
  95
  96   function glIsEnabled(cap: GLenum): GLboolean;
  97   begin
  98     result := 0
  99   end;
 100
 101   function glGetString(name: GLenum): PChar;
 102   begin
 103     result := ''
 104   end;
 105
 106   procedure glClearColor(red, green, blue, alpha: GLclampf);
 107   begin
 108     clearColor := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
 109   end;
 110
 111   procedure glClear(mask: GLbitfield);
 112   begin
 113     if (mask and GL_COLOR_BUFFER_BIT) <> 0 then
 114       clear_to_color(sdl2allegro_screen, clearColor)
 115   end;
 116
 117   procedure glAlphaFunc(func: GLenum; ref: GLclampf);
 118   begin
 119   end;
 120
 121   procedure glBlendFunc(sfactor, dfactor: GLenum);
 122   begin
 123   end;
 124
 125   procedure glPointSize(size: GLfloat);
 126   begin
 127   end;
 128
 129   procedure glLineWidth(width: GLfloat);
 130   begin
 131   end;
 132
 133   procedure glGetIntegerv(pname: GLenum; params: PGLint);
 134   begin
 135     params^ := 0
 136   end;
 137
 138   procedure glFlush;
 139   begin
 140   end;
 141
 142   procedure glFinish;
 143   begin
 144   end;
 145
 146   procedure glBegin(mode: GLenum);
 147   begin
 148     assert(cmds.mode = GL_INVALID_ENUM);
 149     assert((mode = GL_POINTS) or (mode = GL_LINES) or (mode = GL_QUADS));
 150     cmds.mode := mode;
 151     SetLength(cmds.v, 0);
 152     SetLength(cmds.c, 0);
 153     SetLength(cmds.t, 0);
 154   end;
 155
 156   procedure glEnd;
 157     var
 158       i, j, k, w, h, x0, y0, x1, y1, offx, offy, tmp, s0, t0, s1, t1: Integer;
 159       oldx0, oldy0, oldx1, oldy1: cint;
 160       flipv, fliph: Boolean;
 161       draw_sprite_proc: procedure (bmp, sprite: Allegro.PBITMAP; x, y: cint); cdecl;
 162   begin
 163     assert(cmds.mode <> GL_INVALID_ENUM);
 164     assert(Length(cmds.v) mod ValPerVertex = 0);
 165     assert(Length(cmds.c) mod ValPerColor = 0);
 166     assert(Length(cmds.t) mod ValPerCoord = 0);
 167
 168     offx := stack[stack_ptr].x;
 169     offy := stack[stack_ptr].y;
 170
 171     case cmds.mode of
 172     GL_POINTS:
 173       begin
 174          (* implement case for texture coords? *)
 175          if Length(cmds.c) <> 0 then
 176          begin
 177            assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
 178            for i := 0 to Length(cmds.v) div 2 - 1 do
 179              putpixel(sdl2allegro_screen, offx + cmds.v[i * 2], offy + cmds.v[i * 2 + 1], cmds.c[i])
 180          end
 181          else
 182          begin
 183            for i := 0 to Length(cmds.v) div 2 - 1 do
 184              putpixel(sdl2allegro_screen, offx + cmds.v[i * 2], offy + cmds.v[i * 2 + 1], ccol)
 185          end
 186       end;
 187     GL_LINES:
 188       begin
 189         assert(Length(cmds.v) mod 4 = 0); (* broken line *)
 190         (* implement case for texture coords? *)
 191         if Length(cmds.c) <> 0 then
 192         begin
 193           assert(Length(cmds.c) * 2 = Length(cmds.v));
 194           for i := 0 to Length(cmds.v) div 4 - 1 do
 195             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])
 196         end
 197         else
 198         begin
 199           for i := 0 to Length(cmds.v) div 4 - 1 do
 200             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)
 201         end
 202       end;
 203     GL_QUADS:
 204       begin
 205         ASSERT(Length(cmds.v) mod 8 = 0); (* broken quad *)
 206         if Length(cmds.t) <> 0 then
 207         begin
 208           ASSERT(Length(cmds.t) = Length(cmds.v)); (* not enough texture coords *)
 209           ASSERT(ctex >= 0);
 210           ASSERT(ctex <= High(tex));
 211           ASSERT(tex[ctex].bmp <> nil);
 212           for i := 0 to Length(cmds.v) div 8 - 1 do
 213           begin
 214             flipv := False; fliph := False;
 215             x0 := cmds.v[i * 8 + 0]; y0 := cmds.v[i * 8 + 1];
 216             x1 := cmds.v[i * 8 + 4]; y1 := cmds.v[i * 8 + 5];
 217             if x1 < x0 then
 218             begin
 219               tmp := x0;
 220               x0 := x1;
 221               x1 := tmp;
 222               fliph := not fliph
 223             end;
 224             if y1 < y0 then
 225             begin
 226               tmp := y0;
 227               y0 := y1;
 228               y1 := tmp;
 229               flipv := not flipv
 230             end;
 231
 232             w := tex[ctex].bmp.w;
 233             h := tex[ctex].bmp.h;
 234             s0 := Trunc(cmds.t[i * 8 + 0] * w);
 235             t0 := Trunc(cmds.t[i * 8 + 1] * h);
 236             s1 := Trunc(cmds.t[i * 8 + 4] * w);
 237             t1 := Trunc(cmds.t[i * 8 + 5] * h);
 238
 239             if s1 < s0 then
 240             begin
 241               tmp := s0;
 242               s0 := s1;
 243               s1 := tmp;
 244               fliph := not fliph
 245             end;
 246             if t1 < t0 then
 247             begin
 248               tmp := t0;
 249               t0 := t1;
 250               t1 := tmp;
 251               flipv := not flipv
 252             end;
 253
 254             s0 := s0 mod w;
 255             t0 := t0 mod h;
 256             s1 := s1 mod w;
 257             t1 := t1 mod h;
 258
 259             if flipv and fliph then
 260               draw_sprite_proc := Allegro.draw_sprite_vh_flip
 261             else if flipv then
 262               draw_sprite_proc := Allegro.draw_sprite_v_flip
 263             else if fliph then
 264               draw_sprite_proc := Allegro.draw_sprite_h_flip
 265             else
 266               draw_sprite_proc := Allegro.draw_sprite;
 267
 268             oldx0 := 0; oldy0 := 0; oldx1 := 0; oldy1 := 0;
 269             get_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
 270             set_clip_rect(sdl2allegro_screen, max(oldx0, offx + x0), max(oldy0, offy + y0), min(oldx1, offx + x1), min(oldy1, offy + y1));
 271
 272             for j := 0 to (y1 - y0 + h - 1) div h - 1 do
 273               for k := 0 to (x1 - x0 + w - 1) div w - 1 do
 274                 draw_sprite_proc(sdl2allegro_screen, tex[ctex].bmp, offx + x0 + k * w - s0, offy + y0 + j * h - t0);
 275                 //blit(tex[ctex].bmp, sdl2allegro_screen, 0, 0, offx + x0 + k * w - s0, offy + y0 + j * h - t0, w, h);
 276
 277             set_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
 278
 279             //rect(sdl2allegro_screen, offx + x0, offy + y0, offx + x1, offy + y1, makecol(255, 0, 0));
 280             //rect(sdl2allegro_screen, offx + oldx0, offy + oldy0, offx + oldx1, offy + oldx1, makecol(0, 255, 0));
 281           end
 282         end
 283         else if Length(cmds.c) <> 0 then
 284         begin
 285           assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
 286           for i := 0 to Length(cmds.v) div 8 - 1 do
 287             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])
 288         end
 289         else
 290         begin
 291           for i := 0 to Length(cmds.v) div 8 - 1 do
 292             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)
 293         end
 294       end;
 295     else
 296       assert(false)
 297     end;
 298
 299     SetLength(cmds.v, 0);
 300     SetLength(cmds.c, 0);
 301     SetLength(cmds.t, 0);
 302     cmds.mode := GL_INVALID_ENUM;
 303   end;
 304
 305   procedure glVertex2f(x, y: GLfloat);
 306   begin
 307     Addi(cmds.v, ceil(x));
 308     Addi(cmds.v, ceil(y))
 309   end;
 310
 311   procedure glVertex2i(x, y: GLint);
 312   begin
 313     Addi(cmds.v, x);
 314     Addi(cmds.v, y)
 315   end;
 316
 317   procedure glColor4f(red, green, blue, alpha: GLfloat);
 318   begin
 319     ccol := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
 320     Addi(cmds.c, ccol)
 321   end;
 322
 323   procedure glColor4ub(red, green, blue, alpha: GLubyte);
 324   begin
 325     ccol := makeacol(red, green, blue, alpha);
 326     Addi(cmds.c, ccol)
 327   end;
 328
 329   procedure glColor3ub(red, green, blue: GLubyte);
 330   begin
 331     ccol := makecol(red, green, blue);
 332     Addi(cmds.c, ccol)
 333   end;
 334
 335   procedure glTexCoord2f(s, t: GLfloat);
 336   begin
 337     Addf(cmds.t, s);
 338     Addf(cmds.t, t);
 339   end;
 340
 341   procedure glTexCoord2i(s, t: GLint);
 342   begin
 343     Addf(cmds.t, s);
 344     Addf(cmds.t, t);
 345   end;
 346
 347   procedure glReadPixels(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer);
 348   begin
 349   end;
 350
 351   procedure glLoadIdentity;
 352   begin
 353     with stack[stack_ptr] do
 354     begin
 355       x := 0;
 356       y := 0;
 357     end
 358   end;
 359
 360   procedure glMatrixMode(mode: GLenum);
 361   begin
 362   end;
 363
 364   procedure glLoadMatrixd(const m: PGLdouble);
 365   begin
 366     //m[x,y]
 367   end;
 368
 369   procedure glPushMatrix;
 370   begin
 371     stack[stack_ptr + 1] := stack[stack_ptr];
 372     INC(stack_ptr);
 373   end;
 374
 375   procedure glPopMatrix;
 376   begin
 377     DEC(stack_ptr)
 378   end;
 379
 380   procedure glTranslatef(x, y, z: GLfloat);
 381   begin
 382     ASSERT(z = 0); (* 3D not supported *)
 383     stack[stack_ptr].x := Trunc(x);
 384     stack[stack_ptr].y := Trunc(y);
 385   end;
 386
 387   procedure glRotatef(angle, x, y, z: GLfloat);
 388   begin
 389     //ASSERT(z = 0); (* 3D not supported *)
 390     (* TODO Rotation *)
 391   end;
 392
 393   procedure glScalef(x, y, z: GLfloat);
 394   begin
 395     //ASSERT(z = 1); (* 3D not supported *)
 396     (* TODO Scale *)
 397   end;
 398
 399   procedure glViewport(x, y: GLint; width, height: GLsizei);
 400   begin
 401   end;
 402
 403   procedure glScissor(x, y: GLint; width, height: GLsizei);
 404   begin
 405   end;
 406
 407   procedure glStencilMask(mask: GLuint);
 408   begin
 409   end;
 410
 411   procedure glStencilFunc(func: GLenum; ref: GLint; mask: GLuint);
 412   begin
 413   end;
 414
 415   procedure glStencilOp(fail, zfail, zpass: GLenum);
 416   begin
 417   end;
 418
 419   procedure glColorMask(red, green, blue, alpha: GLboolean);
 420   begin
 421   end;
 422
 423   procedure glBindTexture(target: GLenum; texture: GLuint);
 424   begin
 425     assert(target = GL_TEXTURE_2D);
 426     ctex := texture;
 427   end;
 428
 429   procedure glGenTextures(n: GLsizei; textures: PGLuint);
 430     var i: Integer;
 431   begin
 432     for i := 0 to n - 1 do
 433       textures[i] := AddTexture
 434   end;
 435
 436   procedure glTexEnvi(target: GLenum; pname: GLenum; param: GLint);
 437   begin
 438   end;
 439
 440   procedure glTexParameterf(target: GLenum; pname: GLenum; param: GLfloat);
 441   begin
 442   end;
 443
 444   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint);
 445   begin
 446   end;
 447
 448   procedure glTexImage2D(target: GLenum; level, internalformat: GLint; width, height: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer);
 449     var i, j, adr: Integer; p: PByte; color: cint;
 450   begin
 451     assert(target = GL_TEXTURE_2D);
 452     assert(level = 0);
 453     assert((internalformat = GL_RGBA) or (internalformat = GL_RGB));
 454     assert((format = GL_RGBA) or (format = GL_RGB));
 455     assert(border = 0);
 456     assert(atype = GL_UNSIGNED_BYTE);
 457
 458     assert(ctex >= 0);
 459     assert(ctex <= High(tex));
 460     assert(tex[ctex].used);
 461
 462     if tex[ctex].bmp <> nil then
 463       destroy_bitmap(tex[ctex].bmp);
 464     // Video bitmap can lead to bad textures under dos
 465     //tex[ctex].bmp := create_video_bitmap(width, height);
 466     //if tex[ctex].bmp = nil then
 467       tex[ctex].bmp := create_system_bitmap(width, height);
 468     if tex[ctex].bmp = nil then
 469       tex[ctex].bmp := create_bitmap(width, height);
 470     assert(tex[ctex].bmp <> nil);
 471
 472     if pixels = nil then exit;
 473
 474     p := pixels;
 475     if format = GL_RGBA then
 476     begin
 477       for j := 0 to height - 1 do
 478         for i := 0 to width - 1 do
 479         begin
 480           adr := j * width * 4 + i * 4;
 481           if p[adr + 3] <> $FF then
 482             color := 0
 483           else
 484             color := makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]);
 485           putpixel(tex[ctex].bmp, i, j, color)
 486         end
 487     end
 488     else
 489     begin
 490       for j := 0 to height - 1 do
 491         for i := 0 to width - 1 do
 492         begin
 493           adr := j * width * 3 + i * 3;
 494           putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
 495         end
 496     end
 497   end;
 498
 499   procedure glTexSubImage2D(target: GLenum; level, xoffset, yoffset: GLint; width, height: GLsizei; format, atype: GLenum; const pixels: Pointer);
 500     var i, j, adr: Integer; p: PByte; color: Cint;
 501   begin
 502     assert(target = GL_TEXTURE_2D);
 503     assert(level = 0);
 504     assert((format = GL_RGBA) or (format = GL_RGB));
 505     assert(atype = GL_UNSIGNED_BYTE);
 506
 507     assert(ctex >= 0);
 508     assert(ctex <= High(tex));
 509     assert(tex[ctex].used);
 510
 511     assert(xoffset = 0);
 512     assert(yoffset = 0);
 513
 514     if pixels = nil then exit;
 515
 516     p := pixels;
 517     if format = GL_RGBA then
 518     begin
 519       for j := 0 to height - 1 do
 520         for i := 0 to width - 1 do
 521         begin
 522           adr := j * width * 4 + i * 4;
 523           if p[adr + 3] <> $FF then
 524             color := 0
 525           else
 526             color := makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]);
 527           putpixel(tex[ctex].bmp, i, j, color)
 528         end
 529     end
 530     else
 531     begin
 532       for j := 0 to height - 1 do
 533         for i := 0 to width - 1 do
 534         begin
 535           adr := j * width * 3 + i * 3;
 536           putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
 537         end
 538     end
 539   end;
 540
 541   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint);
 542     var i: Integer;
 543   begin
 544     for i := 0 to n - 1 do
 545       RemoveTexture(textures[i])
 546   end;
 547
 548   procedure nogl_Init;
 549   begin
 550     cmds.mode := GL_INVALID_ENUM
 551   end;
 552
 553   procedure nogl_Quit;
 554   begin
 555   end;
 556
 557 initialization