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 = 4;
  11     ValPerCoord = 2;
  12
  13   type
  14     TArrayFloat = array of Integer;
  15
  16     TCmds = record
  17       mode: GLenum;
  18       v, c, t: TArrayFloat;
  19     end;
  20
  21     TArrayTexture = array of record
  22       used: Boolean;
  23       bmp: PBITMAP;
  24     end;
  25
  26   var
  27     cmds: TCmds;
  28     tex: TArrayTexture;
  29     ctex: Integer;
  30     ccol: Integer;
  31
  32   function AddTexture: Integer;
  33     var i: Integer;
  34   begin
  35     for i := 0 to High(tex) do
  36       if not tex[i].used then
  37       begin
  38         tex[i].used := true;
  39         tex[i].bmp := nil;
  40         result := i;
  41         exit
  42       end;
  43     i :=  Length(tex);
  44     SetLength(tex, i + 1);
  45     tex[i].used := true;
  46     tex[i].bmp := nil;
  47     result := i
  48   end;
  49
  50   procedure RemoveTexture(i: Integer);
  51   begin
  52     assert(i >= 0);
  53     assert(i <= High(tex));
  54     assert(tex[i].used);
  55     tex[i].used := false;
  56     if tex[i].bmp <> nil then
  57       destroy_bitmap(tex[i].bmp)
  58   end;
  59
  60   procedure Add (var x: TArrayFloat; f: Integer);
  61     var i: Integer;
  62   begin
  63     i := Length(x);
  64     SetLength(x, i + 1);
  65     x[i] := f;
  66   end;
  67
  68   (** Open GL **)
  69
  70   procedure glEnable(cap: GLenum);
  71   begin
  72   end;
  73
  74   procedure glDisable(cap: GLenum);
  75   begin
  76   end;
  77
  78   function glIsEnabled(cap: GLenum): GLboolean;
  79   begin
  80     result := 0
  81   end;
  82
  83   function glGetString(name: GLenum): PChar;
  84   begin
  85     result := ''
  86   end;
  87
  88   procedure glClearColor(red, green, blue, alpha: GLclampf);
  89     var color: Integer;
  90   begin
  91     color := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
  92     clear_to_color(sdl2allegro_screen, color)
  93   end;
  94
  95   procedure glClear(mask: GLbitfield);
  96   begin
  97   end;
  98
  99   procedure glAlphaFunc(func: GLenum; ref: GLclampf);
 100   begin
 101   end;
 102
 103   procedure glBlendFunc(sfactor, dfactor: GLenum);
 104   begin
 105   end;
 106
 107   procedure glPointSize(size: GLfloat);
 108   begin
 109   end;
 110
 111   procedure glLineWidth(width: GLfloat);
 112   begin
 113   end;
 114
 115   procedure glGetIntegerv(pname: GLenum; params: PGLint);
 116   begin
 117     params^ := 0
 118   end;
 119
 120   procedure glFlush;
 121   begin
 122   end;
 123
 124   procedure glFinish;
 125   begin
 126   end;
 127
 128   procedure glBegin(mode: GLenum);
 129   begin
 130     assert(cmds.mode = GL_INVALID_ENUM);
 131     assert((mode = GL_POINTS) or (mode = GL_LINES) or (mode = GL_QUADS));
 132     cmds.mode := mode;
 133     SetLength(cmds.v, 0);
 134     SetLength(cmds.c, 0);
 135     SetLength(cmds.t, 0);
 136   end;
 137
 138   procedure glEnd;
 139     var i, x, y, w, h: Integer;
 140   begin
 141     assert(cmds.mode <> GL_INVALID_ENUM);
 142     assert(Length(cmds.v) mod ValPerVertex = 0);
 143     assert(Length(cmds.c) mod ValPerColor = 0);
 144     assert(Length(cmds.t) mod ValPerCoord = 0);
 145
 146     case cmds.mode of
 147     GL_POINTS:
 148       begin
 149          (* implement case for texture coords? *)
 150          if Length(cmds.c) <> 0 then
 151          begin
 152            assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
 153            for i := 0 to Length(cmds.v) div 2 - 1 do
 154              putpixel(sdl2allegro_screen, cmds.v[i * 2], cmds.v[i * 2 + 1], cmds.c[i])
 155          end
 156          else
 157          begin
 158            for i := 0 to Length(cmds.v) div 2 - 1 do
 159              putpixel(sdl2allegro_screen, cmds.v[i * 2], cmds.v[i * 2 + 1], ccol)
 160          end
 161       end;
 162     GL_LINES:
 163       begin
 164         assert(Length(cmds.v) mod 4 = 0); (* broken line *)
 165         (* implement case for texture coords? *)
 166         if Length(cmds.c) <> 0 then
 167         begin
 168           assert(Length(cmds.c) * 2 = Length(cmds.v));
 169           for i := 0 to Length(cmds.v) div 4 - 1 do
 170             fastline(sdl2allegro_screen, cmds.v[i * 4], cmds.v[i * 4 + 1], cmds.v[i * 4 + 2], cmds.v[i * 4 + 3], cmds.c[i * 2])
 171         end
 172         else
 173         begin
 174           for i := 0 to Length(cmds.v) div 4 - 1 do
 175             fastline(sdl2allegro_screen, cmds.v[i * 4], cmds.v[i * 4 + 1], cmds.v[i * 4 + 2], cmds.v[i * 4 + 3], ccol)
 176         end
 177       end;
 178     GL_QUADS:
 179       begin
 180         assert(Length(cmds.v) mod 8 = 0); (* broken quad *)
 181         if Length(cmds.t) <> 0 then
 182         begin
 183           assert(Length(cmds.t) = Length(cmds.v)); (* not enough texture coords *)
 184           assert(ctex >= 0);
 185           assert(ctex <= High(tex));
 186           for i := 0 to Length(cmds.v) div 8 - 1 do
 187           begin
 188             x := cmds.v[i * 8];
 189             y := cmds.v[i * 8 + 1];
 190             w := abs(cmds.v[i * 4 + 5] - x);
 191             h := abs(cmds.v[i * 4 + 6] - y);
 192             //e_LogWriteFLn('Textured Quad %s %s', [w, h]);
 193             draw_sprite(sdl2allegro_screen, tex[ctex].bmp, x, y);
 194             //rect(sdl2allegro_screen, x, y, w, h, makecol(255, 0, 0))
 195           end
 196         end
 197         else if Length(cmds.c) <> 0 then
 198         begin
 199           assert(Length(cmds.c) * 2 = Length(cmds.v)); (* not enough colors *)
 200           for i := 0 to Length(cmds.v) div 8 - 1 do
 201             rectfill(sdl2allegro_screen, cmds.v[i * 8], cmds.v[i * 8 + 1], cmds.v[i * 4 + 5], cmds.v[i * 4 + 6], cmds.c[i * 4])
 202         end
 203         else
 204         begin
 205           for i := 0 to Length(cmds.v) div 8 - 1 do
 206             rectfill(sdl2allegro_screen, cmds.v[i * 8], cmds.v[i * 8 + 1], cmds.v[i * 4 + 5], cmds.v[i * 4 + 6], ccol)
 207         end
 208       end;
 209     else
 210       assert(false)
 211     end;
 212
 213     SetLength(cmds.v, 0);
 214     SetLength(cmds.c, 0);
 215     SetLength(cmds.t, 0);
 216     cmds.mode := GL_INVALID_ENUM;
 217   end;
 218
 219   procedure glVertex2f(x, y: GLfloat);
 220   begin
 221     Add(cmds.v, ceil(x));
 222     Add(cmds.v, ceil(y))
 223   end;
 224
 225   procedure glVertex2i(x, y: GLint);
 226   begin
 227     Add(cmds.v, x);
 228     Add(cmds.v, y)
 229   end;
 230
 231   procedure glColor4f(red, green, blue, alpha: GLfloat);
 232   begin
 233     ccol := makeacol(floor(red * 255), floor(green * 255), floor(blue * 255), floor(alpha * 255));
 234     Add(cmds.c, ccol)
 235   end;
 236
 237   procedure glColor4ub(red, green, blue, alpha: GLubyte);
 238   begin
 239     ccol := makeacol(red, green, blue, alpha);
 240     Add(cmds.c, ccol)
 241   end;
 242
 243   procedure glColor3ub(red, green, blue: GLubyte);
 244   begin
 245     ccol := makecol(red, green, blue);
 246     Add(cmds.c, ccol)
 247   end;
 248
 249   procedure glTexCoord2f(s, t: GLfloat);
 250   begin
 251     Add(cmds.t, floor(s));
 252     Add(cmds.t, floor(t));
 253   end;
 254
 255   procedure glTexCoord2i(s, t: GLint);
 256   begin
 257     Add(cmds.t, s);
 258     Add(cmds.t, t);
 259   end;
 260
 261   procedure glReadPixels(x, y: GLint; width, height: GLsizei; format, atype: GLenum; pixels: Pointer);
 262   begin
 263   end;
 264
 265   procedure glLoadIdentity;
 266   begin
 267   end;
 268
 269   procedure glMatrixMode(mode: GLenum);
 270   begin
 271   end;
 272
 273   procedure glLoadMatrixd(const m: PGLdouble);
 274   begin
 275     //m[x,y]
 276   end;
 277
 278   procedure glPushMatrix;
 279   begin
 280   end;
 281
 282   procedure glPopMatrix;
 283   begin
 284   end;
 285
 286   procedure glTranslatef(x, y, z: GLfloat);
 287   begin
 288   end;
 289
 290   procedure glRotatef(angle, x, y, z: GLfloat);
 291   begin
 292   end;
 293
 294   procedure glScalef(x, y, z: GLfloat);
 295   begin
 296   end;
 297
 298   procedure glViewport(x, y: GLint; width, height: GLsizei);
 299   begin
 300   end;
 301
 302   procedure glScissor(x, y: GLint; width, height: GLsizei);
 303   begin
 304   end;
 305
 306   procedure glStencilMask(mask: GLuint);
 307   begin
 308   end;
 309
 310   procedure glStencilFunc(func: GLenum; ref: GLint; mask: GLuint);
 311   begin
 312   end;
 313
 314   procedure glStencilOp(fail, zfail, zpass: GLenum);
 315   begin
 316   end;
 317
 318   procedure glColorMask(red, green, blue, alpha: GLboolean);
 319   begin
 320   end;
 321
 322   procedure glBindTexture(target: GLenum; texture: GLuint);
 323   begin
 324     assert(target = GL_TEXTURE_2D);
 325     ctex := texture;
 326   end;
 327
 328   procedure glGenTextures(n: GLsizei; textures: PGLuint);
 329     var i: Integer;
 330   begin
 331     for i := 0 to n - 1 do
 332       textures[i] := AddTexture
 333   end;
 334
 335   procedure glTexEnvi(target: GLenum; pname: GLenum; param: GLint);
 336   begin
 337   end;
 338
 339   procedure glTexParameterf(target: GLenum; pname: GLenum; param: GLfloat);
 340   begin
 341   end;
 342
 343   procedure glTexParameteri(target: GLenum; pname: GLenum; param: GLint);
 344   begin
 345   end;
 346
 347   procedure glTexImage2D(target: GLenum; level, internalformat: GLint; width, height: GLsizei; border: GLint; format, atype: GLenum; const pixels: Pointer);
 348     var i, j, adr: Integer; p: PByte;
 349   begin
 350     assert(target = GL_TEXTURE_2D);
 351     assert(level = 0);
 352     assert((internalformat = GL_RGBA) or (internalformat = GL_RGB));
 353     assert((format = GL_RGBA) or (format = GL_RGB));
 354     assert(border = 0);
 355     assert(atype = GL_UNSIGNED_BYTE);
 356
 357     assert(ctex >= 0);
 358     assert(ctex <= High(tex));
 359     assert(tex[ctex].used);
 360
 361     if tex[ctex].bmp <> nil then
 362       destroy_bitmap(tex[ctex].bmp);
 363     //tex[ctex].bmp := create_video_bitmap(width, height);
 364     //if tex[ctex].bmp = nil then
 365       tex[ctex].bmp := create_system_bitmap(width, height);
 366     if tex[ctex].bmp = nil then
 367       tex[ctex].bmp := create_bitmap(width, height);
 368     assert(tex[ctex].bmp <> nil);
 369
 370     if pixels = nil then exit;
 371
 372     p := pixels;
 373     if format = GL_RGBA then
 374     begin
 375       for j := 0 to height - 1 do
 376         for i := 0 to width - 1 do
 377         begin
 378           adr := j * width * 4 + i * 4;
 379           putpixel(tex[ctex].bmp, i, height - j, makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]))
 380         end
 381     end
 382     else
 383     begin
 384       for j := 0 to height - 1 do
 385         for i := 0 to width - 1 do
 386         begin
 387           adr := j * width * 3 + i * 3;
 388           putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
 389         end
 390     end
 391   end;
 392
 393   procedure glTexSubImage2D(target: GLenum; level, xoffset, yoffset: GLint; width, height: GLsizei; format, atype: GLenum; const pixels: Pointer);
 394     var i, j, adr: Integer; p: PByte;
 395   begin
 396     assert(target = GL_TEXTURE_2D);
 397     assert(level = 0);
 398     assert((format = GL_RGBA) or (format = GL_RGB));
 399     assert(atype = GL_UNSIGNED_BYTE);
 400
 401     assert(ctex >= 0);
 402     assert(ctex <= High(tex));
 403     assert(tex[ctex].used);
 404
 405     assert(xoffset = 0);
 406     assert(yoffset = 0);
 407
 408     if pixels = nil then exit;
 409
 410     p := pixels;
 411     if format = GL_RGBA then
 412     begin
 413       for j := 0 to height - 1 do
 414         for i := 0 to width - 1 do
 415         begin
 416           adr := j * width * 4 + i * 4;
 417           putpixel(tex[ctex].bmp, i, height - j, makeacol(p[adr], p[adr + 1], p[adr + 2], p[adr + 3]))
 418         end
 419     end
 420     else
 421     begin
 422       for j := 0 to height - 1 do
 423         for i := 0 to width - 1 do
 424         begin
 425           adr := j * width * 3 + i * 3;
 426           putpixel(tex[ctex].bmp, i, j, makecol(p[adr], p[adr + 1], p[adr + 2]))
 427         end
 428     end
 429   end;
 430
 431   procedure glDeleteTextures(n: GLsizei; const textures: PGLuint);
 432     var i: Integer;
 433   begin
 434     for i := 0 to n - 1 do
 435       RemoveTexture(textures[i])
 436   end;
 437
 438   procedure nogl_Init;
 439   begin
 440     cmds.mode := GL_INVALID_ENUM
 441   end;
 442
 443   procedure nogl_Quit;
 444   begin
 445   end;
 446
 447 initialization