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     vpx, vpy: Integer;
  41     pointSize: Integer;
  42     matrixMode: GLenum;
  43
  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;
  61
  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;
  72
  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;
  80
  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;
  88
  89   (** Open GL **)
  90
  91   procedure glEnable(cap: GLenum);
  92   begin
  93   end;
  94
  95   procedure glDisable(cap: GLenum);
  96   begin
  97   end;
  98
  99   function glIsEnabled(cap: GLenum): GLboolean;
 100   begin
 101     result := 0
 102   end;
 103
 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;
 111
 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;
 116
 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;
 122
 123   procedure glAlphaFunc(func: GLenum; ref: GLclampf);
 124   begin
 125   end;
 126
 127   procedure glBlendFunc(sfactor, dfactor: GLenum);
 128   begin
 129   end;
 130
 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;
 137
 138   procedure glLineWidth(width: GLfloat);
 139   begin
 140     (* width > 1 used in rare cases, not critical *)
 141   end;
 142
 143   procedure glGetIntegerv(pname: GLenum; params: PGLint);
 144   begin
 145     params^ := 0
 146   end;
 147
 148   procedure glFlush;
 149   begin
 150   end;
 151
 152   procedure glFinish;
 153   begin
 154   end;
 155
 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;
 165
 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);
 177
 178     offx := vpx + stack[stack_ptr].x;
 179     offy := vpy + stack[stack_ptr].y;
 180
 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;
 270
 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);
 277
 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;
 292
 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;
 305
 306             s0 := s0 mod w;
 307             t0 := t0 mod h;
 308             s1 := s1 mod w;
 309             t1 := t1 mod h;
 310
 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;
 319
 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));
 323
 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);
 327
 328             set_clip_rect(sdl2allegro_screen, oldx0, oldy0, oldx1, oldy1);
 329
 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;
 349
 350     SetLength(cmds.v, 0);
 351     SetLength(cmds.c, 0);
 352     SetLength(cmds.t, 0);
 353     cmds.mode := GL_INVALID_ENUM;
 354   end;
 355
 356   procedure glVertex2f(x, y: GLfloat);
 357   begin
 358     Addi(cmds.v, ceil(x));
 359     Addi(cmds.v, ceil(y))
 360   end;
 361
 362   procedure glVertex2i(x, y: GLint);
 363   begin
 364     Addi(cmds.v, x);
 365     Addi(cmds.v, y)
 366   end;
 367
 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;
 373
 374   procedure glColor4ub(red, green, blue, alpha: GLubyte);
 375   begin
 376     ccol := makeacol(red, green, blue, alpha);
 377     Addi(cmds.c, ccol)
 378   end;
 379
 380   procedure glColor3ub(red, green, blue: GLubyte);
 381   begin
 382     ccol := makecol(red, green, blue);
 383     Addi(cmds.c, ccol)
 384   end;
 385
 386   procedure glTexCoord2f(s, t: GLfloat);
 387   begin
 388     Addf(cmds.t, s);
 389     Addf(cmds.t, t);
 390   end;
 391
 392   procedure glTexCoord2i(s, t: GLint);
 393   begin
 394     Addf(cmds.t, s);
 395     Addf(cmds.t, t);
 396   end;
 397
 398   procedure glReadPixels(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer);
 399   begin
 400   end;
 401
 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;
 412
 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;
 420
 421   procedure glLoadMatrixd(const m: PGLdouble);
 422   begin
 423     if matrixMode <> GL_MODELVIEW then Exit;
 424
 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;
 440
 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;
 447
 448   procedure glPopMatrix;
 449   begin
 450     if matrixMode <> GL_MODELVIEW then Exit;
 451     DEC(stack_ptr)
 452   end;
 453
 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;
 461
 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;
 469
 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;
 476
 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;
 482
 483   procedure glScissor(x, y: GLint; width, height: GLsizei);
 484   begin
 485     //set_clip_rect(sdl2allegro_screen, x, y, width, height)
 486   end;
 487
 488   procedure glStencilMask(mask: GLuint);
 489   begin
 490   end;
 491
 492   procedure glStencilFunc(func: GLenum; ref: GLint; mask: GLuint);
 493   begin
 494   end;
 495
 496   procedure glStencilOp(fail, zfail, zpass: GLenum);
 497   begin
 498   end;
 499
 500   procedure glColorMask(red, green, blue, alpha: GLboolean);
 501   begin
 502   end;
 503
 504   procedure glBindTexture(target: GLenum; texture: GLuint);
 505   begin
 506     assert(target = GL_TEXTURE_2D);
 507     ctex := texture;
 508   end;
 509
 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;
 516
 517   procedure glTexEnvi(target: GLenum; pname: GLenum; param: GLint);
 518   begin
 519   end;
 520
 521   procedure glTexParameterf(target: GLenum; pname: GLenum; param: GLfloat);
 522   begin
 523   end;
 524
 525   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint);
 526   begin
 527   end;
 528
 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);
 538
 539     assert(ctex >= 0);
 540     assert(ctex <= High(tex));
 541     assert(tex[ctex].used);
 542
 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);
 549
 550     if pixels = nil then exit;
 551
 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);
 559
 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;
 581
 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);
 589
 590     assert(ctex >= 0);
 591     assert(ctex <= High(tex));
 592     assert(tex[ctex].used);
 593
 594     assert(xoffset = 0);
 595     assert(yoffset = 0);
 596
 597     if pixels = nil then exit;
 598
 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);
 606
 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;
 628
 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;
 635
 636   procedure nogl_Init;
 637   begin
 638     cmds.mode := GL_INVALID_ENUM
 639   end;
 640
 641   procedure nogl_Quit;
 642   begin
 643   end;
 644
 645 initialization