├── DelphiCraft.png ├── DelphiCraft2.png ├── LICENSE ├── bin ├── DelphiCraft.exe ├── glfw3_32.dll ├── shaders │ ├── block_fragment.glsl │ ├── block_vertex.glsl │ ├── line_fragment.glsl │ ├── line_vertex.glsl │ ├── sky_fragment.glsl │ ├── sky_vertex.glsl │ ├── text_fragment.glsl │ └── text_vertex.glsl └── textures │ ├── Thumbs.db │ ├── font.png │ ├── sign.png │ ├── sky.png │ └── texture.png ├── deps └── Neslib.glfw3.pas ├── lib ├── Execute.CrossGL.pas ├── Execute.Inflate.pas ├── Execute.PNGLoader.pas ├── Execute.SQLite3.pas ├── Execute.SysUtils.pas ├── Execute.Textures.pas └── sqlite3.obj ├── readme.md └── src ├── CaseyDuncan.noise.pas ├── Craft.Auth.pas ├── Craft.Chunk.pas ├── Craft.Client.pas ├── Craft.Config.pas ├── Craft.Cube.pas ├── Craft.Item.pas ├── Craft.Main.pas ├── Craft.Map.pas ├── Craft.Matrix.pas ├── Craft.Player.pas ├── Craft.Render.pas ├── Craft.Ring.pas ├── Craft.Sign.pas ├── Craft.Util.pas ├── Craft.World.pas ├── Craft.db.pas ├── DelphiCraft.dpr ├── DelphiCraft.dproj └── MarcusGeelnard.TinyCThread.pas /DelphiCraft.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/DelphiCraft.png -------------------------------------------------------------------------------- /DelphiCraft2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/DelphiCraft2.png -------------------------------------------------------------------------------- /bin/DelphiCraft.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/DelphiCraft.exe -------------------------------------------------------------------------------- /bin/glfw3_32.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/glfw3_32.dll -------------------------------------------------------------------------------- /bin/shaders/block_fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform sampler2D sampler; 4 | uniform sampler2D sky_sampler; 5 | uniform float timer; 6 | uniform float daylight; 7 | uniform int ortho; 8 | 9 | varying vec2 fragment_uv; 10 | varying float fragment_ao; 11 | varying float fragment_light; 12 | varying float fog_factor; 13 | varying float fog_height; 14 | varying float diffuse; 15 | 16 | const float pi = 3.14159265; 17 | 18 | void main() { 19 | vec3 color = vec3(texture2D(sampler, fragment_uv)); 20 | if (color == vec3(1.0, 0.0, 1.0)) { 21 | discard; 22 | } 23 | bool cloud = color == vec3(1.0, 1.0, 1.0); 24 | if (cloud && bool(ortho)) { 25 | discard; 26 | } 27 | float df = cloud ? 1.0 - diffuse * 0.2 : diffuse; 28 | float ao = cloud ? 1.0 - (1.0 - fragment_ao) * 0.2 : fragment_ao; 29 | ao = min(1.0, ao + fragment_light); 30 | df = min(1.0, df + fragment_light); 31 | float value = min(1.0, daylight + fragment_light); 32 | vec3 light_color = vec3(value * 0.3 + 0.2); 33 | vec3 ambient = vec3(value * 0.3 + 0.2); 34 | vec3 light = ambient + light_color * df; 35 | color = clamp(color * light * ao, vec3(0.0), vec3(1.0)); 36 | vec3 sky_color = vec3(texture2D(sky_sampler, vec2(timer, fog_height))); 37 | color = mix(color, sky_color, fog_factor); 38 | gl_FragColor = vec4(color, 1.0); 39 | } 40 | -------------------------------------------------------------------------------- /bin/shaders/block_vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform mat4 matrix; 4 | uniform vec3 camera; 5 | uniform float fog_distance; 6 | uniform int ortho; 7 | 8 | attribute vec4 position; 9 | attribute vec3 normal; 10 | attribute vec4 uv; 11 | 12 | varying vec2 fragment_uv; 13 | varying float fragment_ao; 14 | varying float fragment_light; 15 | varying float fog_factor; 16 | varying float fog_height; 17 | varying float diffuse; 18 | 19 | const float pi = 3.14159265; 20 | const vec3 light_direction = normalize(vec3(-1.0, 1.0, -1.0)); 21 | 22 | void main() { 23 | gl_Position = matrix * position; 24 | fragment_uv = uv.xy; 25 | fragment_ao = 0.3 + (1.0 - uv.z) * 0.7; 26 | fragment_light = uv.w; 27 | diffuse = max(0.0, dot(normal, light_direction)); 28 | if (bool(ortho)) { 29 | fog_factor = 0.0; 30 | fog_height = 0.0; 31 | } 32 | else { 33 | float camera_distance = distance(camera, vec3(position)); 34 | fog_factor = pow(clamp(camera_distance / fog_distance, 0.0, 1.0), 4.0); 35 | float dy = position.y - camera.y; 36 | float dx = distance(position.xz, camera.xz); 37 | fog_height = (atan(dy, dx) + pi / 2) / pi; 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /bin/shaders/line_fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | void main() { 4 | gl_FragColor = vec4(0.0, 0.0, 0.0, 1.0); 5 | } 6 | -------------------------------------------------------------------------------- /bin/shaders/line_vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform mat4 matrix; 4 | 5 | attribute vec4 position; 6 | 7 | void main() { 8 | gl_Position = matrix * position; 9 | } 10 | -------------------------------------------------------------------------------- /bin/shaders/sky_fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform sampler2D sampler; 4 | uniform float timer; 5 | 6 | varying vec2 fragment_uv; 7 | 8 | void main() { 9 | vec2 uv = vec2(timer, fragment_uv.t); 10 | gl_FragColor = texture2D(sampler, uv); 11 | } 12 | -------------------------------------------------------------------------------- /bin/shaders/sky_vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform mat4 matrix; 4 | 5 | attribute vec4 position; 6 | attribute vec3 normal; 7 | attribute vec2 uv; 8 | 9 | varying vec2 fragment_uv; 10 | 11 | void main() { 12 | gl_Position = matrix * position; 13 | fragment_uv = uv; 14 | } 15 | -------------------------------------------------------------------------------- /bin/shaders/text_fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform sampler2D sampler; 4 | uniform bool is_sign; 5 | 6 | varying vec2 fragment_uv; 7 | 8 | void main() { 9 | vec4 color = texture2D(sampler, fragment_uv); 10 | if (is_sign) { 11 | if (color == vec4(1.0)) { 12 | discard; 13 | } 14 | } 15 | else { 16 | color.a = max(color.a, 0.4); 17 | } 18 | gl_FragColor = color; 19 | } 20 | -------------------------------------------------------------------------------- /bin/shaders/text_vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | uniform mat4 matrix; 4 | 5 | attribute vec4 position; 6 | attribute vec2 uv; 7 | 8 | varying vec2 fragment_uv; 9 | 10 | void main() { 11 | gl_Position = matrix * position; 12 | fragment_uv = uv; 13 | } 14 | -------------------------------------------------------------------------------- /bin/textures/Thumbs.db: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/textures/Thumbs.db -------------------------------------------------------------------------------- /bin/textures/font.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/textures/font.png -------------------------------------------------------------------------------- /bin/textures/sign.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/textures/sign.png -------------------------------------------------------------------------------- /bin/textures/sky.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/textures/sky.png -------------------------------------------------------------------------------- /bin/textures/texture.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/bin/textures/texture.png -------------------------------------------------------------------------------- /lib/Execute.Inflate.pas: -------------------------------------------------------------------------------- 1 | unit Execute.Inflate; 2 | { 3 | Delphi Inflate Unit by Paul TOTH 4 | 5 | This code is based on the following: 6 | 7 | "inflate.c -- Not copyrighted 1992 by Mark Adler" 8 | version c10p1, 10 January 1993 9 | 10 | Written 1995 by Oliver Fromme . 11 | Donated to the public domain. 12 | 13 | Freely distributable, freely usable. 14 | Nobody may claim copyright on this code. 15 | 16 | Disclaimer: Use it at your own risk. I am not liable for anything. 17 | } 18 | {$R-,Q-} 19 | interface 20 | 21 | uses 22 | Execute.SysUtils; 23 | 24 | type 25 | // NB: Sender is for Object Method compatibilities 26 | TReadProc = procedure(Sender: Pointer; var Data; Size: NativeInt); 27 | TWriteProc = procedure(Sender: Pointer; const Data; Size: NativeInt); 28 | 29 | TReadMethod = procedure(var Data; Size: NativeInt) of object; 30 | TWriteMethod = procedure(const Data; Size: NativeInt) of object; 31 | 32 | function InflateProcs(Read: TReadProc; Write: TWriteProc; Reader, Writer: Pointer): NativeInt; 33 | function InflateMethods(Read: TReadMethod; Write: TWriteMethod): NativeInt; 34 | function InflateStream(ASource, ATarget: TStream): Integer; inline; 35 | 36 | implementation 37 | 38 | const 39 | WSIZE = $8000; 40 | BMAX = 16; // maximum bit length of any code (16 for explode) 41 | N_MAX = 288; // maximum number of codes in any set 42 | 43 | {Tables for deflate from PKZIP's appnote.txt.} 44 | 45 | border:array [0..18] of word = ( // Order of the bit length code lengths 46 | 16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15 47 | ); 48 | 49 | cplens:array [0..30] of word = ( // Copy lengths for literal codes 257..285 50 | 3, 4, 5, 6, 7, 8, 9,10, 11, 13, 15, 17, 19, 23,27, 51 | 31,35,43,51,59,67,83,99,115,131,163,195,227,258, 0, 0 52 | ); 53 | 54 | cplext:array [0..30] of word = ( // Extra bits for literal codes 257..285 55 | 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2, 56 | 3,3,3,3,4,4,4,4,5,5,5,5,0,99,99 57 | ); {99=invalid} 58 | 59 | cpdist:array [0..29] of word = ( // Copy offsets for distance codes 0..29 60 | 1,2,3,4,5,7,9,13,17,25,33,49,65,97,129,193, 61 | 257,385,513,769,1025,1537,2049,3073,4097,6145, 62 | 8193,12289,16385,24577 63 | ); 64 | 65 | cpdext:array [0..29] of word = ( // Extra bits for distance codes 66 | 0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6, 67 | 7,7,8,8,9,9,10,10,11,11,12,12,13,13 68 | ); 69 | 70 | mask_bits:array [0..16] of word = ( 71 | 0,1,3,7,15,31,63,127,255,511,1023, 72 | 2047,4095,8191,16383,32767,65535 73 | ); 74 | 75 | lbits = 9; // bits in base literal/length lookup table 76 | dbits = 6; // bits in base distance lookup table 77 | 78 | type 79 | phuft = ^huft ; 80 | huft = record 81 | e : byte ; {number of extra bits or operation} 82 | b : byte ; {number of bits in this code or subcode} 83 | v : record {this odd Record is just for easier Pas2C} 84 | case integer of 85 | 0:(n:word); {literal, length base, or distance base} 86 | 1:(t:phuft); {pointer to next level of table} 87 | end 88 | end; 89 | pphuft=^phuft ; 90 | 91 | var 92 | Slide:array[0..WSIZE-1] of byte; 93 | ReadSource : TReadMethod; 94 | WriteTarget: TWriteMethod; 95 | wp:word; // current position in Slide 96 | bk:byte; // bits in bit buffer 97 | bb:cardinal; // bit buffer, unsigned 98 | hufts:word; // track memory usage 99 | 100 | procedure NEEDBITS(n:byte); 101 | var 102 | Src: Byte; 103 | begin 104 | while bk < n do 105 | begin 106 | ReadSource(Src, 1); 107 | bb := bb or (Src shl bk); 108 | inc(bk,8); 109 | end; 110 | end; 111 | 112 | procedure DUMPBITS(n:byte); 113 | begin 114 | bb:=bb shr n; 115 | dec(bk,n); 116 | end; 117 | 118 | function inflate_stored:integer; 119 | var 120 | n:word; // number of bytes in block 121 | begin 122 | // go to byte boundary 123 | n:=bk and 7; 124 | DUMPBITS(n); 125 | // get the length and its complement 126 | NEEDBITS(16); 127 | n:=bb and $ffff; 128 | DUMPBITS(16); 129 | NEEDBITS(16); 130 | if n<>((not bb) and $ffff) then begin 131 | Result:=1; {error in compressed data} 132 | exit; 133 | end; 134 | DUMPBITS(16) ; 135 | // read and output the compressed data 136 | while n<>0 do begin 137 | dec(n); 138 | ReadSource(slide[wp], 1); 139 | inc(wp); 140 | if wp=WSIZE then begin 141 | WriteTarget(slide[0], wp); 142 | wp:=0 143 | end; 144 | end; 145 | Result:=0; 146 | end; 147 | 148 | function huft_build( 149 | b : pWord ; {code lengths in bits (all assumed <= BMAX)} 150 | n : Word ; {number of codes (assumed <= N_MAX)} 151 | s : Word ; {number of simple-valued codes (0..s-1)} 152 | d : pWord ; {list of base values for non-simple codes} 153 | e : pWord ; {list of extra bits for non-simple codes} 154 | t : pphuft; {result: starting table} 155 | m : pInteger {maximum lookup bits, returns actual} 156 | ) : integer ; 157 | 158 | var 159 | c:array [0..BMAX] of word; // bit length count table 160 | p:pword; // pointer into c[], b[], or v[] (register variable) 161 | i:word; // counter, current code (register variable) 162 | a:word; {counter for codes of length k} 163 | f : word ; {i repeats in table every f entries} 164 | g : Integer ; {maximum code length} 165 | h : Integer ; {table level} 166 | j : Word ; {counter (register variable)} 167 | k : Integer ; {number of bits in current code (register variable)} 168 | l : Integer ; {bits per table (returned in m)} 169 | q : phuft ; {points to current table (register variable)} 170 | r : huft ; {table entry for structure assignment} 171 | u : Array [0..BMAX-1] Of phuft ;{table stack} 172 | v : Array [0..N_MAX-1] Of Word ;{values in order of bit length} 173 | w : Integer ; {bits before this table = (l*h) (register variable)} 174 | x : Array [0..BMAX] Of Word ; {bit offsets, then code stack} 175 | xp : pWord ; {pointer into x} 176 | y : Integer ; {number of dummy codes added} 177 | z : Word ; {number of entries in current table} 178 | alloc_tmp : Word ; 179 | phuft_tmp : phuft ; 180 | pword_tmp : pWord ; 181 | begin 182 | // Generate counts for each bit length 183 | Fillchar(c,SizeOf(c),0); 184 | p:=b; 185 | for i:=0 to n-1 do begin 186 | inc(c[p^]); // assume all entries <= BMAX 187 | inc(p); 188 | end; 189 | if c[0]=n then begin // null input--all zero length codes 190 | t^:=nil; 191 | m^:=0; 192 | Result:=0; 193 | exit; 194 | end; 195 | 196 | // Find minimum and maximum length, bound m^ by those 197 | l:=m^; 198 | j:=1; while (j<=BMAX) and (c[j]=0) do inc(j); 199 | k:=j; // minimum code length 200 | if l0)and(c[i]=0) do dec(i); 202 | g:=i; // maximum code length 203 | if l>i then l:=i; 204 | m^:=l; 205 | 206 | // Adjust last length count to fill out codes, if needed 207 | y:=1 shl j; 208 | while j0 do begin 231 | inc(j,p^); 232 | inc(p); 233 | xp^:=j; 234 | inc(xp); 235 | dec(i); 236 | end; 237 | 238 | // Make a table of values in order of bit lengths 239 | p:=b; 240 | i:=0; 241 | repeat 242 | j:=p^; 243 | inc(p); 244 | if j<>0 then begin 245 | v[x[j]]:=i; 246 | inc(x[j]); 247 | end; 248 | inc(i); 249 | until i>=n; 250 | 251 | // Generate the Huffman codes and for each, make the table entries 252 | x[0]:=0; // first Huffman code is zero 253 | i:=0; 254 | p:=Addr(v); // grab values in bit order 255 | h:=-1; // no tables yet--level -1 256 | w:=-l; // bits decoded = (l*h) 257 | u[0]:=nil; // just to keep compilers happy 258 | q:=nil; // ditto 259 | z:=0; // ditto 260 | 261 | // go through the bit lengths (k already is bits in shortest code) 262 | while k<=g do begin 263 | a:=c[k]; 264 | while (a>0) do begin 265 | dec(a); 266 | // here i is the Huffman code of length k bits for value *p 267 | // make tables up to required level 268 | while k>w+l do begin 269 | inc(h); 270 | inc(w,l); // previous table always l bits 271 | // compute minimum size table less than or equal to l bits 272 | if g-w>l then // upper limit on table size 273 | z:=l 274 | else 275 | z:=g-w; 276 | j:=k-w; // try a k-w bit table 277 | f:=1 shl j; 278 | if f>a+1 then begin // too few codes for k-w bit table 279 | dec(f,a+1); // deduct codes from patterns left 280 | xp:=Addr(c[k]); 281 | inc(j); 282 | while j0 then begin 304 | x[h]:=i; // save pattern for backing up 305 | r.b:=l; // bits to dump before this table 306 | r.e:=16+j; // bits in this table 307 | r.v.t:=q; // pointer to this table 308 | j:=i shr (w-l); // (get around Turbo C bug) 309 | {u[h-1][j] := r} 310 | phuft_tmp:=u[h-1]; 311 | inc(phuft_tmp,j); 312 | phuft_tmp^:=r; // connect to last table 313 | end; 314 | end; 315 | // set up table entry in r 316 | r.b:=byte(k-w); 317 | if cardinal(p)>=cardinal(@(v[n])) then 318 | r.e:=99 // out of values--invalid code 319 | else if p^0 do begin 347 | i:=i xor j; 348 | j:=j shr 1; 349 | end; 350 | i:=i xor j; 351 | // backup over finished tables 352 | while (i and (1 shl w -1))<>x[h] do begin 353 | dec(h); // don't need to update q 354 | dec(w,l); 355 | end; 356 | 357 | end; 358 | // dec(a); 359 | inc(k); 360 | end; 361 | // Return 1 if we were given an incomplete table 362 | if (y<>0) and (g<>1) then 363 | huft_build:=1 364 | else 365 | huft_build:=0; 366 | end; 367 | 368 | procedure huft_free(t:phuft {table to free}); 369 | var 370 | p,q : phuft; {(register variables)} 371 | alloc_tmp : Word; 372 | begin 373 | // Go through linked list, freeing from the malloced (t[-1]) address. 374 | p := t; 375 | while p <> nil do begin 376 | dec(p); 377 | q := p^.v.t; 378 | Dec(cardinal(p),2); 379 | alloc_tmp := (pWord(p))^; 380 | FreeMem(p,alloc_tmp); 381 | p := q; 382 | end; 383 | end ; 384 | 385 | 386 | function inflate_codes( 387 | tl,td : phuft ; {literal/length and distance decoder tables} 388 | bl,bd : Integer {number of bits decoded by tl[] and td[]} 389 | ):integer ; 390 | var 391 | e:word ; {table entry flag/number of extra bits (register variable)} 392 | n,d:Word ; {length and index for copy} 393 | t : phuft ; {pointer to table entry} 394 | ml,md : Word ; {masks for bl and bd bits} 395 | begin 396 | // inflate the coded data 397 | ml := mask_bits[bl]; {precompute masks for speed} 398 | md := mask_bits[bd]; 399 | while true do begin // do until end of block 400 | NEEDBITS(bl); 401 | t := tl; 402 | inc(t,bb and ml); 403 | e := t^.e; 404 | if e > 16 then 405 | repeat 406 | if e = 99 then begin 407 | Result:=1; 408 | exit; 409 | end; 410 | DUMPBITS(t^.b); 411 | dec(e,16); 412 | NEEDBITS(e); 413 | t := t^.v.t; 414 | inc(t,bb and mask_bits[e]); 415 | e := t^.e; 416 | until e <= 16; 417 | DUMPBITS(t^.b); 418 | if e = 16 then begin // it's a literal 419 | slide[wp] := t^.v.n; 420 | Inc(wp); 421 | If wp=WSIZE Then Begin 422 | // move(Slide[0],Dst^,wp); 423 | // inc(Dst,wp); 424 | WriteTarget(Slide[0], wp); 425 | wp:=0; 426 | end; 427 | end else begin // it's an EOB or a length 428 | // exit if end of block 429 | if e=15 then break; 430 | // get length of block to copy 431 | NEEDBITS(e); 432 | n := t^.v.n+(bb And mask_bits[e]); 433 | DUMPBITS(e); 434 | // decode distance of block to copy 435 | NEEDBITS(bd); 436 | t := td; 437 | inc(t,bb and md); 438 | e := t^.e; 439 | if e > 16 then 440 | repeat 441 | if e = 99 then begin 442 | Result:=1; 443 | exit; 444 | end; 445 | DUMPBITS(t^.b); 446 | dec(e,16); 447 | NEEDBITS(e); 448 | t := t^.v.t; 449 | inc(t,bb and mask_bits[e]); 450 | e := t^.e; 451 | until e <= 16; 452 | DUMPBITS(t^.b); 453 | NEEDBITS(e); 454 | d := wp - t^.v.n - Word(bb And mask_bits[e]); 455 | DUMPBITS(e); 456 | // do the copy 457 | repeat 458 | d := d And(WSIZE-1); 459 | if d > wp Then 460 | e := WSIZE-d 461 | else 462 | e := WSIZE-wp; 463 | if e > n Then e := n; 464 | Dec(n,e); 465 | while e > 0 do begin 466 | slide[wp] := slide[d]; 467 | inc(wp); 468 | inc(d); 469 | dec(e); 470 | end; 471 | if wp=WSIZE then begin 472 | // Move(Slide[0],Dst^,wp); 473 | // inc(Dst,wp); 474 | WriteTarget(Slide[0], wp); 475 | wp:=0; 476 | end 477 | until n=0; 478 | end; 479 | end; 480 | //done 481 | Result:= 0; 482 | end; 483 | 484 | function inflate_fixed:integer; 485 | var 486 | i :integer; // temporary variable 487 | tl:phuft; // literal/length code table 488 | td:phuft; // distance code table 489 | bl:integer; // lookup bits for tl 490 | bd:integer; // lookup bits for td 491 | l :array [0..287] of word ; // length list for huft_build 492 | begin 493 | // set up literal table 494 | for i:=0 to 143 do l[i]:=8; 495 | for i:=144 to 255 do l[i]:=9; 496 | for i:=256 to 279 do l[i]:=7; 497 | for i:=280 to 287 do l[i]:=8; 498 | 499 | bl:=7; 500 | Result:=huft_build(@l,288,257,@cplens,@cplext,Addr(tl),Addr(bl)); 501 | if Result<>0 then exit; 502 | try 503 | // set up distance table 504 | for i:=0 to 29 do l[i]:=5;// make an incomplete code set 505 | bd:=5; 506 | Result:=huft_build(@l,30,0,@cpdist,@cpdext,Addr(td),Addr(bd)); 507 | if Result>1 then exit; 508 | // decompress until an end-of-block code 509 | Result:=inflate_codes(tl,td,bl,bd); 510 | huft_free(td); 511 | finally 512 | huft_free(tl); 513 | end; 514 | end; 515 | 516 | function inflate_dynamic:integer; 517 | var 518 | i : Integer; {temporary variables} 519 | j : Word; 520 | l : Word; {last length} 521 | m : Word; {mask for bit lengths table} 522 | n : Word; {number of lengths to get} 523 | tl : phuft; {literal/length code table} 524 | td : phuft; {distance code table} 525 | bl : Integer; {lookup bits for tl} 526 | bd : Integer; {lookup bits for td} 527 | nb : Word; {number of bit length codes} 528 | nl : Word; {number of literal/length codes} 529 | nd : Word; {number of distance codes} 530 | ll : Array[0..286+30-1] Of Word; {literal/length and distance code lengths} 531 | begin 532 | // read in table lengths 533 | NEEDBITS(5); 534 | nl := 257+(bb And $1f); {number of literal/length codes} 535 | DUMPBITS(5); 536 | NEEDBITS(5); 537 | nd := 1+(bb And $1f); {number of distance codes} 538 | DUMPBITS(5); 539 | NEEDBITS(4); 540 | nb := 4+(bb And $f); {number of bit length codes} 541 | DUMPBITS(4); 542 | If (nl>286) Or (nd > 30) Then Begin 543 | Result:=1; {bad lengths} 544 | exit; 545 | end; 546 | // read in bit-length-code lengths 547 | for j:=0 To nb-1 Do Begin 548 | NEEDBITS(3); 549 | ll[border[j]] := bb And 7; 550 | DUMPBITS(3); 551 | end ; 552 | for j:=nb to 18 do ll[border[j]] := 0; 553 | // build decoding table for trees--single level, 7 bit lookup 554 | bl := 7; 555 | Result:=huft_build(@ll,19,19,NIL,NIL,Addr(tl),Addr(bl)); 556 | if Result<>0 then begin {incomplete code set} 557 | if Result=1 then huft_free(tl); 558 | exit; 559 | end; 560 | // read in literal and distance code lengths} 561 | n := nl+nd; 562 | m := mask_bits[bl]; 563 | l := 0; 564 | i := 0; 565 | while in Then Begin 581 | Result:= 1; 582 | exit; 583 | end; 584 | while j <> 0 Do Begin 585 | Dec(j); 586 | ll[i] := l; 587 | Inc(i); 588 | end; 589 | // Dec(j); 590 | end else If j = 17 Then Begin {3 to 10 zero length codes} 591 | NEEDBITS(3); 592 | j := 3+(bb And 7); 593 | DUMPBITS(3); 594 | If i+j > n Then Begin 595 | Result:= 1; 596 | exit; 597 | end; 598 | While j <> 0 Do Begin 599 | Dec(j); 600 | ll[i] := 0; 601 | Inc(i); 602 | end; 603 | // dec(j); 604 | l := 0; 605 | end else Begin {j=18: 11 to 138 zero length codes} 606 | NEEDBITS(7); 607 | j := 11+(bb And $7f); 608 | DUMPBITS(7); 609 | If i+j > n Then Begin 610 | Result:= 1; 611 | exit 612 | end ; 613 | While j <> 0 Do Begin 614 | Dec(j); 615 | ll[i] := 0; 616 | Inc(i) 617 | end; 618 | // Dec(j); 619 | l := 0; 620 | end 621 | end; 622 | // free decoding table for trees 623 | huft_free(tl); 624 | // build the decoding tables for literal/length and distance codes 625 | bl := lbits; 626 | Result:=huft_build(@ll,nl,257,@cplens,@cplext,Addr(tl),Addr(bl)); 627 | if Result <> 0 Then Begin 628 | if Result = 1 Then huft_free(tl); 629 | exit; 630 | end; 631 | bd := dbits; 632 | Result:= huft_build(@(ll[nl]),nd,0,@cpdist,@cpdext,Addr(td),Addr(bd)); 633 | If Result<>0 then begin 634 | if Result= 1 then huft_free (td); 635 | huft_free (tl); 636 | exit; 637 | end; 638 | // decompress until an end-of-block code 639 | Result:=inflate_codes(tl,td,bl,bd); 640 | huft_free (tl); 641 | huft_free (td); 642 | end; 643 | 644 | function inflate_block(e:pInteger {last block flag}):integer; 645 | var 646 | t:word; // block type 647 | begin 648 | // read in last block bit 649 | NEEDBITS(1); 650 | e^:= bb and 1; 651 | DUMPBITS(1); 652 | // read in block type 653 | NEEDBITS(2); 654 | t := bb and 3; 655 | DUMPBITS(2); 656 | // inflate that block type 657 | case t of 658 | 0 : Result:=inflate_stored; 659 | 1 : Result:=inflate_fixed; 660 | 2 : Result:=inflate_dynamic; 661 | else Result:=2 {bad block type}; 662 | end; 663 | end; 664 | 665 | //function Inflate(const SrcData,DstBuffer):integer; 666 | //var 667 | // e:integer; // last block flag 668 | // h:word; // maximum struct huft's malloc'ed 669 | //begin 670 | // Src:=@SrcData; 671 | // Dst:=@DstBuffer; 672 | // // initialize window, bit buffer 673 | // wp:=0; 674 | // bk:=0; 675 | // bb:=0; 676 | // // decompress until the last block 677 | // h:=0; 678 | // repeat 679 | // hufts:=0; 680 | // Result:=inflate_block(Addr(e)); 681 | // if Result<>0 then exit; 682 | // if hufts>h then h:=hufts; 683 | // until e<>0; 684 | // // flush out slide, return error code 685 | // Move(Slide[0],Dst^,wp); 686 | // Result:=0; 687 | //end; 688 | 689 | function Inflate: NativeInt; 690 | var 691 | e: Integer; // last block flag 692 | h: Word; // maximum struct huft's malloc'ed 693 | begin 694 | // initialize window, bit buffer 695 | wp := 0; 696 | bk := 0; 697 | bb := 0; 698 | // decompress until the last block 699 | h := 0; 700 | repeat 701 | hufts := 0; 702 | Result := inflate_block(Addr(e)); 703 | if Result <> 0 then 704 | Exit; 705 | if hufts > h then 706 | h := hufts; 707 | until e <> 0; 708 | // flush out slide, return error code 709 | WriteTarget(Slide[0], wp); // Move(Slide[0],Dst^,wp); 710 | Result := 0; 711 | end; 712 | 713 | function InflateMethods(Read: TReadMethod; Write: TWriteMethod): NativeInt; 714 | begin 715 | ReadSource := Read; 716 | WriteTarget := Write; 717 | Result := Inflate(); 718 | end; 719 | 720 | function InflateProcs(Read: TReadProc; Write: TWriteProc; Reader, Writer: Pointer): NativeInt; 721 | begin 722 | TMethod(ReadSource).Code := @Read; 723 | TMethod(ReadSource).Data := Reader; 724 | TMethod(WriteTarget).Code := @Write; 725 | TMethod(WriteTarget).Data := Writer; 726 | Result := Inflate(); 727 | end; 728 | 729 | function InflateStream(ASource, ATarget: TStream): Integer; 730 | begin 731 | Result := InflateMethods(ASource.ReadBuffer, ATarget.WriteBuffer); 732 | end; 733 | 734 | end. 735 | 736 | 737 | -------------------------------------------------------------------------------- /lib/Execute.PNGLoader.pas: -------------------------------------------------------------------------------- 1 | unit Execute.PNGLoader; 2 | 3 | { 4 | PNGLoader for Delphi Tokyo (c)2017 by Execute SARL 5 | http://www.execute.fr 6 | } 7 | 8 | interface 9 | {$IFOPT Q+}{$DEFINE QP}{$ENDIF} 10 | uses 11 | Execute.SysUtils, 12 | Execute.Textures, 13 | Execute.Inflate; 14 | 15 | procedure LoadPNG(const AFileName: string; var Texture: TTexture); 16 | 17 | implementation 18 | 19 | const 20 | // supported Chunks 21 | IHDR: array[0..3] of AnsiChar = 'IHDR'; // Image Header 22 | IEND: array[0..3] of AnsiChar = 'IEND'; // Image End 23 | PLTE: array[0..3] of AnsiChar = 'PLTE'; // Palette 24 | IDAT: array[0..3] of AnsiChar = 'IDAT'; // Image Data 25 | 26 | // Image Format 27 | COLOR_GRAYSCALE = 0; 28 | COLOR_RGB = 2; // support 2017.07.23 29 | COLOR_PALETTE = 3; 30 | COLOR_GRAYSCALEALPHA = 4; 31 | COLOR_RGBA = 6; // support 2017.07.22 32 | 33 | // Filter Mode 34 | FILTER_NONE = 0; // support 2017.07.22 35 | FILTER_SUB = 1; // support 2017.07.22 36 | FILTER_UP = 2; // support 2017.07.22 37 | FILTER_AVERAGE = 3; 38 | FILTER_PAETH = 4; // support 2017.07.22 39 | 40 | type 41 | TPNGSignature = record 42 | PNG : Cardinal; 43 | CRLF : Cardinal; 44 | end; 45 | 46 | TPNGHeader = packed record 47 | Width : Cardinal; 48 | Height : Cardinal; 49 | BitDepth : Byte; 50 | ColorType : Byte; 51 | CompressionMethod : Byte; 52 | FilterMethod : Byte; 53 | InterlaceMethod : Byte; 54 | end; 55 | 56 | TRGBColor = record 57 | R, G, B: Byte; 58 | end; 59 | TPalette = array of TRGBColor; 60 | 61 | TChunk = packed record 62 | Size: Cardinal; 63 | Name: Cardinal; 64 | end; 65 | 66 | TPNGContext = record 67 | private 68 | FStream : TStream; // source Stream 69 | FTexture : PTexture; // target Texture 70 | FHeader : TPNGHeader; // PNG header 71 | FChunk : TChunk; // current Chunk 72 | FPalette : TPalette; // PLTE chunk 73 | FLineSize : NativeInt; // number of bytes per line in the decompressed stream (without Filter byte) 74 | FBPP : NativeInt; // number of byte per pixel (3, 4 or 0 for monochrome) 75 | FReadLine : NativeInt; 76 | FFilter : Byte; 77 | FIndex : NativeInt; 78 | procedure ReadChunk; 79 | procedure LoadIDAT; 80 | procedure ReadIDAT(var AData; ASize: NativeInt); 81 | procedure WriteTexture(const AData; ASize: NativeInt); 82 | procedure FilterRow; 83 | public 84 | procedure ReadHeader; 85 | procedure ReadChunks; 86 | end; 87 | 88 | function Paeth(a, b, c: Byte): Byte; 89 | // a = left, b = above, c = upper left 90 | var 91 | pa, pb, pc: NativeInt; 92 | begin 93 | pa := abs(b - c); 94 | pb := abs(a - c); 95 | pc := abs(a + b - 2 * c); 96 | if (pa <= pb) and (pa <= pc) then 97 | Exit(a); 98 | if pb <= pc then 99 | Result := b 100 | else 101 | Result := c; 102 | end; 103 | 104 | procedure TPNGContext.ReadChunk; 105 | begin 106 | FStream.ReadBuffer(FChunk, SizeOf(FChunk)); 107 | BSwap(FChunk.Size); 108 | end; 109 | 110 | procedure TPNGContext.ReadHeader; 111 | var 112 | Sign : TPNGSignature; 113 | Format: TTextureFormat; 114 | begin 115 | // Signature is required 116 | FStream.ReadBuffer(Sign, SizeOf(Sign)); 117 | // First chunk 118 | ReadChunk; 119 | if (Cardinal(Sign.PNG) <> $474E5089) 120 | or (Sign.CRLF <> $A1A0A0D) 121 | or (FChunk.Size <> SizeOf(FHeader)) 122 | or (FChunk.Name <> Cardinal(IHDR)) then 123 | raise Exception.Create('Not a PNG file'); 124 | // Read Header 125 | FStream.ReadBuffer(FHeader, SizeOf(FHeader)); 126 | if (FHeader.CompressionMethod <> 0) 127 | or (FHeader.FilterMethod <> 0) 128 | or (FHeader.InterlaceMethod <> 0) then 129 | raise Exception.Create('Unsupported PNG'); 130 | 131 | // Endianness 132 | BSwap(FHeader.Width); 133 | BSwap(FHeader.Height); 134 | 135 | case FHeader.BitDepth of 136 | 1: 137 | case FHeader.ColorType of 138 | COLOR_GRAYSCALE, 139 | COLOR_PALETTE : 140 | begin 141 | FBPP := 0; // 1/8 - not used 142 | FLineSize := (FHeader.Width + 7) div 8; 143 | Format := tfLUMINANCE_8; 144 | end; 145 | else 146 | raise Exception.Create('Unsupported PNG ColorType = ' + IntToStr(FHeader.ColorType) + ' for BitDepth 1'); 147 | end; 148 | 8: 149 | begin 150 | case FHeader.ColorType of 151 | COLOR_GRAYSCALE : 152 | begin 153 | FBPP := 1; // Grayscale 154 | Format := tfLUMINANCE_8; 155 | end; 156 | COLOR_PALETTE : 157 | begin 158 | FBPP := 1; // Palette Index 159 | Format := tfRGB_24; 160 | end; 161 | COLOR_RGB : 162 | begin 163 | FBPP := 3; // R, G, B 164 | Format := tfRGB_24; 165 | end; 166 | COLOR_RGBA : 167 | begin 168 | FBPP := 4; // R, G, B, A 169 | Format := tfARGB_32; 170 | end; 171 | COLOR_GRAYSCALEALPHA : 172 | begin 173 | FBPP := 2; // Grayscale, Alpha 174 | Format := tfLUMINACE_ALPHA_16; 175 | end 176 | else 177 | raise Exception.Create('Unsupported PNG ColorType = ' + IntToStr(FHeader.ColorType) + ' for BitDepth 8'); 178 | end; 179 | FLineSize := NativeInt(FHeader.Width) * FBPP; 180 | end; 181 | else 182 | raise Exception.Create('Unsupported PNG (BitDepth = ' + IntToStr(FHeader.BitDepth) + ')'); 183 | end; 184 | 185 | FTexture.Setup(FHeader.Width, FHeader.Height, Format); 186 | 187 | // Skip Chunk CRC 188 | FStream.Seek(4, soFromCurrent); 189 | end; 190 | 191 | procedure TPNGContext.ReadChunks; 192 | begin 193 | // Next Chunk 194 | ReadChunk; 195 | // while not Image End 196 | while FChunk.Name <> Cardinal(IEND) do 197 | begin 198 | // Found Image Data 199 | if FChunk.Name = Cardinal(IDAT) then 200 | begin 201 | LoadIDAT; 202 | // don't need to parse the remaining chunks 203 | Break; 204 | end; 205 | // Found Image Palette 206 | if FChunk.Name = Cardinal(PLTE) then 207 | begin 208 | if ((FChunk.Size mod 3) <> 0) or (FChunk.Size > 3 * 256) then 209 | raise Exception.Create('Invalid PLTE chunk'); 210 | SetLength(FPalette, FChunk.Size div 3); 211 | FStream.ReadBuffer(FPalette[0], FChunk.Size); 212 | FChunk.Size := 0; // consumed 213 | end; 214 | // skip unsupported Chunk + CRC 215 | FStream.Seek(FChunk.Size + 4, soFromCurrent); 216 | // Next Chunk 217 | ReadChunk; 218 | end; 219 | end; 220 | 221 | procedure TPNGContext.LoadIDAT; 222 | begin 223 | FReadLine := 0; 224 | FIndex := 0; 225 | // skip GZIP Header 226 | Dec(FChunk.Size, 2); 227 | FStream.Seek(2, soFromCurrent); 228 | // deflate data 229 | InflateMethods(ReadIDAT, WriteTexture); 230 | // Filter last row 231 | FilterRow; 232 | end; 233 | 234 | procedure TPNGContext.ReadIDAT(var AData; ASize: NativeInt); 235 | var 236 | Len : NativeInt; 237 | begin 238 | while ASize > 0 do 239 | begin 240 | // need to read a new IDAT chunk 241 | if FChunk.Size = 0 then 242 | begin 243 | FStream.Seek(4, soFromCurrent); // CRC 244 | ReadChunk; 245 | if FChunk.Name <> Cardinal(IDAT) then 246 | raise Exception.Create('Out of IDAT chunk'); 247 | end; 248 | Len := FChunk.Size; 249 | if Len > ASize then 250 | Len := ASize; 251 | FStream.ReadBuffer(AData, Len); 252 | Dec(ASize, Len); 253 | Dec(FChunk.Size, Len); 254 | end; 255 | end; 256 | 257 | procedure TPNGContext.WriteTexture(const AData; ASize: NativeInt); 258 | var 259 | Source: PByte; 260 | Pixels: NativeInt; 261 | begin 262 | Source := @AData; 263 | 264 | while ASize > 0 do 265 | begin 266 | // start of a new Line 267 | if FReadLine = 0 then 268 | begin 269 | // Filter previous row 270 | FilterRow; 271 | // Filter byte 272 | FFilter := Source^; 273 | Inc(Source); 274 | Dec(ASize); 275 | end; 276 | // output per line pixels 277 | if ASize > FReadLine then 278 | Pixels := FReadLine 279 | else 280 | Pixels := ASize; 281 | Move(Source^, FTexture.Bytes[FIndex], Pixels); 282 | // next position 283 | Inc(FIndex, Pixels); 284 | // move source 285 | Inc(Source, Pixels); 286 | // line progression 287 | Dec(FReadLine, Pixels); 288 | // Written bytes 289 | Dec(ASize, Pixels); 290 | end; 291 | end; 292 | 293 | procedure TPNGContext.FilterRow; 294 | var 295 | Pixel : PByte; 296 | Above : PByte; 297 | x : NativeInt; 298 | Left : PByte; 299 | TopLeft: PByte; 300 | Color : PByte; 301 | begin 302 | // Bytes needed 303 | FReadLine := FLineSize; 304 | // do not filter the first line until it is loaded 305 | if FIndex = 0 then 306 | Exit; 307 | case FFilter of 308 | FILTER_NONE : { do nothing }; 309 | FILTER_SUB : // Pixel[x, y] := Pixel[x, y] + Pixel[x - 1, y] 310 | begin 311 | Pixel := @FTexture.Bytes[FIndex - FLineSize]; 312 | Left := Pixel; 313 | // Ignore first Pixel 314 | Inc(Pixel, FBPP); 315 | for x := (FBPP * (NativeInt(FHeader.Width) - 1)) - 1 downto 0 do 316 | begin 317 | {$IFDEF QP}{$Q-}{$ENDIF} 318 | Inc(Pixel^, Left^); 319 | {$IFDEF QP}{$Q+}{$ENDIF} 320 | Inc(Pixel); 321 | Inc(Left); 322 | end; 323 | end; 324 | FILTER_UP : // Pixel[x, y] := Pixel[x, y] + Pixel[x, y - 1] 325 | begin 326 | if FIndex = FLineSize then // do not filter first line 327 | Exit; 328 | Pixel := @FTexture.Bytes[FIndex - FLineSize]; 329 | Above := Pixel; 330 | Dec(Above, FLineSize); 331 | for x := (FBPP * NativeInt(FHeader.Width)) - 1 downto 0 do 332 | begin 333 | {$IFDEF QP}{$Q-}{$ENDIF} 334 | Inc(Pixel^, Above^); 335 | {$IFDEF QP}{$Q+}{$ENDIF} 336 | Inc(Pixel); 337 | Inc(Above); 338 | end; 339 | end; 340 | FILTER_AVERAGE: // Pixel[x, y] := Pixel[x, y] + (Pixel[x - 1, y] + Pixel[x, y - 1]) div 2 341 | begin 342 | Pixel := @FTexture.Bytes[FIndex - FLineSize]; 343 | Left := Pixel; 344 | if FIndex = FLineSize then // special case, first line 345 | begin 346 | Inc(Pixel, FBPP); 347 | for x := (FBPP * (NativeInt(FHeader.Width) - 1)) - 1 downto 0 do 348 | begin 349 | Inc(Pixel^, Left^ div 2); 350 | Inc(Pixel); 351 | Inc(Left); 352 | end; 353 | end else begin 354 | Above := Pixel; 355 | Dec(Above, FLineSize); 356 | for x := FBPP - 1 downto 0 do // special case, first pixel 357 | begin 358 | Inc(Pixel^, Above^ div 2); 359 | Inc(Pixel); 360 | Inc(Above); 361 | end; 362 | for x := (FBPP * (NativeInt(FHeader.Width) - 1)) - 1 downto 0 do 363 | begin 364 | Inc(Pixel^, (Above^ + Left^) div 2); 365 | Inc(Pixel); 366 | Inc(Above); 367 | Inc(Left); 368 | end; 369 | end; 370 | end; 371 | FILTER_PAETH: // Pixel[x, y] := Pixel[x, y] + Paeth(Pixel[x - 1, y], Pixel[x, y - 1], Pixel[x - 1, y - 1]) 372 | begin 373 | Pixel := @FTexture.Bytes[FIndex - FLineSize]; 374 | Left := Pixel; 375 | if FIndex = FLineSize then // first line 376 | begin 377 | Inc(Pixel, FBPP); 378 | for x := (FBPP * (NativeInt(FHeader.Width) - 1)) - 1 downto 0 do 379 | begin 380 | Inc(Pixel^, Paeth(Left^, 0, 0)); 381 | Inc(Pixel); 382 | Inc(Left); 383 | end; 384 | end else begin 385 | Above := Pixel; 386 | Dec(Above, FLineSize); 387 | TopLeft := Above; 388 | for x := FBPP - 1 downto 0 do // first pixel 389 | begin 390 | {$IFDEF QP}{$Q-}{$ENDIF} 391 | Inc(Pixel^, Paeth(0, Above^, 0)); 392 | {$IFDEF QP}{$Q+}{$ENDIF} 393 | Inc(Pixel); 394 | Inc(Above); 395 | end; 396 | // rest of the line 397 | for x := (FBPP * (NativeInt(FHeader.Width) - 1)) - 1 downto 0 do 398 | begin 399 | {$IFDEF QP}{$Q-}{$ENDIF} 400 | Inc(Pixel^, Paeth(Left^, Above^, TopLeft^)); 401 | {$IFDEF QP}{$Q+}{$ENDIF} 402 | Inc(Pixel); 403 | Inc(Left); 404 | Inc(Above); 405 | Inc(TopLeft); 406 | end; 407 | end; 408 | end; 409 | else 410 | raise Exception.Create('Unknow Filter ' + IntToStr(FFilter)); 411 | end; 412 | if Length(FPalette) > 0 then 413 | begin 414 | Color := @FTexture.Bytes[FIndex]; 415 | Pixel := @FTexture.Bytes[FIndex - FLineSize + 3 * NativeInt(FHeader.Width)]; 416 | for x := 0 to FLineSize - 1 do 417 | begin 418 | Dec(Pixel, 3); 419 | Move(FPalette[Color^], Pixel^, 3); 420 | Dec(Color); 421 | end; 422 | end; 423 | end; 424 | 425 | procedure LoadPNG(const AFileName: string; var Texture: TTexture); 426 | var 427 | Context: TPNGContext; 428 | begin 429 | Context.FStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone); 430 | try 431 | Context.FTexture := @Texture; 432 | Context.ReadHeader; 433 | Context.ReadChunks; 434 | finally 435 | Context.FStream.Free; 436 | end; 437 | end; 438 | 439 | end. 440 | -------------------------------------------------------------------------------- /lib/Execute.SQLite3.pas: -------------------------------------------------------------------------------- 1 | unit Execute.SQLite3; 2 | 3 | interface 4 | {$DEFINE LINK_OBJ} 5 | {-$DEFINE DEBUG} 6 | 7 | uses 8 | Winapi.Windows; 9 | 10 | type 11 | sqlite3 = Pointer; 12 | sqlite3_stmt = Pointer; 13 | 14 | PUTF8Char = PAnsiChar; 15 | PPUTF8Char = ^PUTF8Char; 16 | 17 | const 18 | SQLITE_OK = 0; 19 | SQLITE_ERROR = 1; 20 | SQLITE_INTERNAL = 2; 21 | SQLITE_PERM = 3; 22 | SQLITE_ABORT = 4; 23 | SQLITE_BUSY = 5; 24 | SQLITE_LOCKED = 6; 25 | SQLITE_NOMEM = 7; 26 | SQLITE_READONLY = 8; 27 | SQLITE_INTERRUPT = 9; 28 | SQLITE_IOERR = 10; 29 | SQLITE_CORRUPT = 11; 30 | SQLITE_NOTFOUND = 12; 31 | SQLITE_FULL = 13; 32 | SQLITE_CANTOPEN = 14; 33 | SQLITE_PROTOCOL = 15; 34 | SQLITE_EMPTY = 16; 35 | SQLITE_SCHEMA = 17; 36 | SQLITE_TOOBIG = 18; 37 | SQLITE_CONSTRAINT = 19; 38 | SQLITE_MISMATCH = 20; 39 | SQLITE_MISUSE = 21; 40 | SQLITE_NOLFS = 22; 41 | SQLITE_AUTH = 23; 42 | SQLITE_FORMAT = 24; 43 | SQLITE_RANGE = 25; 44 | SQLITE_NOTADB = 26; 45 | SQLITE_ROW = 100; 46 | SQLITE_DONE = 101; 47 | 48 | type 49 | TSQLiteCallBack = function(param: Pointer; col_count: Integer; const col_text, col_names: array of PUTF8Char): Integer; cdecl; 50 | 51 | function sqlite3_open(filename: PUTF8Char; var db: sqlite3): Integer; cdecl; 52 | function sqlite3_close(db: sqlite3): Integer; cdecl; 53 | 54 | function sqlite3_errmsg(db: sqlite3): PUTF8Char; cdecl; 55 | 56 | function sqlite3_prepare_v2(db: sqlite3; zSql: PUTF8Char; nByte: Integer; var pStmt: sqlite3_stmt; pzTail: PPUTF8Char): integer; cdecl; 57 | function sqlite3_step(stmt: sqlite3_stmt): Integer; cdecl; 58 | function sqlite3_column_count(stmt: sqlite3_stmt): Integer; cdecl; 59 | function sqlite3_column_name(stmt: sqlite3_stmt; iCol: Integer): PUTF8Char; cdecl; 60 | function sqlite3_column_type(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; 61 | function sqlite3_column_int(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; 62 | function sqlite3_column_int64(stmt: sqlite3_stmt; iCol: Integer): Int64; cdecl; 63 | function sqlite3_column_double(stmt: sqlite3_stmt; iCol: Integer): Double; cdecl; 64 | function sqlite3_column_text(stmt: sqlite3_stmt; iCol: Integer): PUTF8Char; cdecl; 65 | function sqlite3_column_blob(stmt: sqlite3_stmt; iCol: Integer): Pointer; cdecl; 66 | function sqlite3_column_bytes(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; 67 | 68 | function sqlite3_bind_text(stmt: sqlite3_stmt; iCol: Integer; text: PAnsiChar; size: Integer; freeproc: Pointer): Integer; cdecl; 69 | function sqlite3_bind_int(stmt: sqlite3_stmt; iCol: Integer; value: Integer): Integer; cdecl; 70 | function sqlite3_bind_double(stmt: sqlite3_stmt; iCol: Integer; value: Double): Integer; cdecl; 71 | function sqlite3_changes(stmt: sqlite3_stmt): Integer; cdecl; 72 | 73 | function sqlite3_last_insert_rowid(db: sqlite3): Int64; cdecl; 74 | 75 | function sqlite3_reset(stmt: sqlite3_stmt): Integer; cdecl; 76 | function sqlite3_finalize(stmt: sqlite3_stmt): Integer; cdecl; 77 | 78 | function sqlite3_exec(db: sqlite3; sql: PUTF8Char; callback: TSQLiteCallBack; param: Pointer; errmsg: PPUTF8Char): integer; cdecl; 79 | 80 | implementation 81 | 82 | {$IFDEF LINK_OBJ} 83 | 84 | {$LINK sqlite3.obj} 85 | 86 | var __turbofloat: word; { not used, but must be present for linking } 87 | 88 | procedure _lldiv; 89 | asm 90 | jmp System.@_lldiv 91 | end; 92 | 93 | procedure _llmod; 94 | asm 95 | jmp System.@_llmod 96 | end; 97 | 98 | procedure _llmul; 99 | asm 100 | jmp System.@_llmul 101 | end; 102 | 103 | procedure _llumod; 104 | asm 105 | jmp System.@_llumod 106 | end; 107 | 108 | procedure _lludiv; 109 | asm 110 | jmp System.@_lludiv 111 | end; 112 | 113 | procedure _llshl; 114 | asm 115 | jmp System.@_llshl 116 | end; 117 | 118 | procedure _llushr; 119 | asm 120 | jmp System.@_llushr 121 | end; 122 | 123 | function _ftol: Int64; 124 | asm 125 | jmp System.@Trunc // FST(0) -> EDX:EAX, as expected by BCC32 compiler 126 | end; 127 | 128 | function memset(P: Pointer; B: Integer; count: Integer): pointer; cdecl; { always cdecl } 129 | // a fast full pascal version of the standard C library function 130 | begin 131 | result := P; 132 | FillChar(P^, count, B); 133 | end; 134 | 135 | var 136 | { as standard C library documentation states: 137 | Statically allocated buffer, shared by the functions gmtime() and localtime(). 138 | Each call of these functions overwrites the content of this structure. 139 | -> since timing is not thread-dependent, it's OK to share this buffer :) } 140 | atm: packed record 141 | tm_sec: Integer; { Seconds. [0-60] (1 leap second) } 142 | tm_min: Integer; { Minutes. [0-59] } 143 | tm_hour: Integer; { Hours. [0-23] } 144 | tm_mday: Integer; { Day. [1-31] } 145 | tm_mon: Integer; { Month. [0-11] } 146 | tm_year: Integer; { Year - 1900. } 147 | tm_wday: Integer; { Day of week. [0-6] } 148 | tm_yday: Integer; { Days in year. [0-365] } 149 | tm_isdst: Integer; { DST. [-1/0/1]} 150 | __tm_gmtoff: Integer; { Seconds east of UTC. } 151 | __tm_zone: ^Char; { Timezone abbreviation.} 152 | end; 153 | 154 | function localtime(t: PCardinal): pointer; cdecl; { always cdecl } 155 | // a fast full pascal version of the standard C library function 156 | var uTm: TFileTime; 157 | lTm: TFileTime; 158 | S: TSystemTime; 159 | begin 160 | Int64(uTm) := (Int64(t^) + 11644473600)*10000000; // unix time to dos file time 161 | FileTimeToLocalFileTime(uTM,lTM); 162 | FileTimeToSystemTime(lTM,S); 163 | with atm do begin 164 | tm_sec := S.wSecond; 165 | tm_min := S.wMinute; 166 | tm_hour := S.wHour; 167 | tm_mday := S.wDay; 168 | tm_mon := S.wMonth-1; 169 | tm_year := S.wYear-1900; 170 | tm_wday := S.wDayOfWeek; 171 | end; 172 | result := @atm; 173 | end; 174 | 175 | function malloc(size: cardinal): Pointer; cdecl; { always cdecl } 176 | // the SQLite3 database engine will use the FastMM4/SynScaleMM fast heap manager 177 | begin 178 | GetMem(Result, size); 179 | end; 180 | 181 | procedure free(P: Pointer); cdecl; { always cdecl } 182 | // the SQLite3 database engine will use the FastMM4 very fast heap manager 183 | begin 184 | FreeMem(P); 185 | end; 186 | 187 | function realloc(P: Pointer; Size: Integer): Pointer; cdecl; { always cdecl } 188 | // the SQLite3 database engine will use the FastMM4/SynScaleMM very fast heap manager 189 | begin 190 | result := P; 191 | ReallocMem(result,Size); 192 | end; 193 | 194 | procedure memmove(dest, source: pointer; count: Integer); cdecl; { always cdecl } 195 | // a fast full pascal version of the standard C library function 196 | begin 197 | Move(source^, dest^, count); // move() is overlapping-friendly 198 | end; 199 | 200 | procedure memcpy(dest, source: Pointer; count: Integer); cdecl; { always cdecl } 201 | // a fast full pascal version of the standard C library function 202 | begin 203 | Move(source^, dest^, count); 204 | end; 205 | 206 | function memcmp(p1, p2: pByte; Size: integer): integer; cdecl; { always cdecl } 207 | // a fast full pascal version of the standard C library function 208 | begin 209 | if (p1<>p2) and (Size<>0) then 210 | if p1<>nil then 211 | if p2<>nil then begin 212 | repeat 213 | if p1^<>p2^ then begin 214 | result := p1^-p2^; 215 | exit; 216 | end; 217 | dec(Size); 218 | inc(p1); 219 | inc(p2); 220 | until Size=0; 221 | result := 0; 222 | end else 223 | result := 1 else 224 | result := -1 else 225 | result := 0; 226 | end; 227 | 228 | function strcmp(p1, p2: PByte): integer; cdecl; { always cdecl } 229 | // a fast full pascal version of the standard C library function 230 | begin 231 | result := p1^-p2^; 232 | while (result = 0) and (p1^ <> 0) and (p2^ <> 0) do 233 | begin 234 | inc(p1); 235 | inc(p2); 236 | result := p1^-p2^; 237 | end; 238 | end; 239 | 240 | function strncmp(p1, p2: PByte; Size: integer): integer; cdecl; { always cdecl } 241 | // a fast full pascal version of the standard C library function 242 | var i: integer; 243 | begin 244 | for i := 1 to Size do begin 245 | result := p1^-p2^; 246 | if (result<>0) or (p1^=0) then 247 | exit; 248 | inc(p1); 249 | inc(p2); 250 | end; 251 | result := 0; 252 | end; 253 | 254 | function sqlite3_open(filename: PUTF8Char; var db: sqlite3): Integer; cdecl; external; 255 | function sqlite3_close(db: sqlite3): Integer; cdecl; external; 256 | 257 | function sqlite3_errmsg(db: sqlite3): PUTF8Char; cdecl; external; 258 | 259 | function sqlite3_prepare_v2(db: sqlite3; zSql: PUTF8Char; nByte: Integer; var pStmt: sqlite3_stmt; pzTail: PPUTF8Char): integer; cdecl; external; 260 | function sqlite3_step(stmt: sqlite3_stmt): Integer; cdecl; external; 261 | function sqlite3_column_count(stmt: sqlite3_stmt): Integer; cdecl; external; 262 | function sqlite3_column_name(stmt: sqlite3_stmt; iCol: Integer): PUTF8Char; cdecl; external; 263 | function sqlite3_column_type(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; external; 264 | function sqlite3_column_int(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; external; 265 | function sqlite3_column_int64(stmt: sqlite3_stmt; iCol: Integer): Int64; cdecl; external; 266 | function sqlite3_column_double(stmt: sqlite3_stmt; iCol: Integer): Double; cdecl; external; 267 | function sqlite3_column_text(stmt: sqlite3_stmt; iCol: Integer): PUTF8Char; cdecl; external; 268 | function sqlite3_column_blob(stmt: sqlite3_stmt; iCol: Integer): Pointer; cdecl; external; 269 | function sqlite3_column_bytes(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; external; 270 | 271 | function sqlite3_bind_text(stmt: sqlite3_stmt; iCol: Integer; text: PAnsiChar; size: Integer; freeproc: Pointer): Integer; cdecl; external; 272 | function sqlite3_bind_int(stmt: sqlite3_stmt; iCol: Integer; value: Integer): Integer; cdecl; external; 273 | function sqlite3_bind_double(stmt: sqlite3_stmt; iCol: Integer; value: Double): Integer; cdecl; external; 274 | 275 | 276 | function sqlite3_changes(stmt: sqlite3_stmt): Integer; cdecl; external; 277 | 278 | function sqlite3_last_insert_rowid(db: sqlite3): Int64; cdecl; external; 279 | 280 | function sqlite3_reset(stmt: sqlite3_stmt): Integer; cdecl; external; 281 | function sqlite3_finalize(stmt: sqlite3_stmt): Integer; cdecl; external; 282 | 283 | function sqlite3_exec(db: sqlite3; sql: PUTF8Char; callback: TSQLiteCallBack; param: Pointer; errmsg: PPUTF8Char): integer; cdecl; external; 284 | 285 | {$ELSE} 286 | const 287 | libSQLite3 = 'sqlite3.dll'; 288 | 289 | function sqlite3_open(filename: PUTF8Char; var db: sqlite3): Integer; cdecl; external libSQLite3; 290 | function sqlite3_close(db: sqlite3): Integer; cdecl; external libSQLite3; 291 | 292 | function sqlite3_errmsg(db: sqlite3): PUTF8Char; cdecl; external libSQLite3; 293 | 294 | function sqlite3_prepare_v2(db: sqlite3; zSql: PUTF8Char; nByte: Integer; var pStmt: sqlite3_stmt; pzTail: PPUTF8Char): integer; cdecl; external libSQLite3; 295 | function sqlite3_step(stmt: sqlite3_stmt): Integer; cdecl; external libSQLite3; 296 | function sqlite3_column_count(stmt: sqlite3_stmt): Integer; cdecl; external libSQLite3; 297 | function sqlite3_column_name(stmt: sqlite3_stmt; iCol: Integer): PUTF8Char; cdecl; external libSQLite3; 298 | function sqlite3_column_type(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; external libSQLite3; 299 | function sqlite3_column_int(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; external libSQLite3; 300 | function sqlite3_column_int64(stmt: sqlite3_stmt; iCol: Integer): Int64; cdecl; external libSQLite3; 301 | function sqlite3_column_double(stmt: sqlite3_stmt; iCol: Integer): Double; cdecl; external libSQLite3; 302 | function sqlite3_column_text(stmt: sqlite3_stmt; iCol: Integer): PUTF8Char; cdecl; external libSQLite3; 303 | function sqlite3_column_blob(stmt: sqlite3_stmt; iCol: Integer): Pointer; cdecl; external libSQLite3; 304 | function sqlite3_column_bytes(stmt: sqlite3_stmt; iCol: Integer): Integer; cdecl; external libSQLite3; 305 | 306 | function sqlite3_last_insert_rowid(db: sqlite3): Int64; cdecl; external libSQLite3; 307 | 308 | function sqlite3_bind_text(stmt: sqlite3_stmt; iCol: Integer; text: PAnsiChar; size: Integer; freeproc: Pointer): Integer; cdecl; external libSQLite3; 309 | function sqlite3_bind_int(stmt: sqlite3_stmt; iCol: Integer; value: Integer): Integer; cdecl; external libSQLite3; 310 | function sqlite3_bind_double(stmt: sqlite3_stmt; iCol: Integer; value: Double): Integer; cdecl; external libSQLite3; 311 | 312 | function sqlite3_changes(stmt: sqlite3_stmt): Integer; cdecl; external libSQLite3; 313 | 314 | function sqlite3_reset(stmt: sqlite3_stmt): Integer; cdecl; external libSQLite3; 315 | function sqlite3_finalize(stmt: sqlite3_stmt): Integer; cdecl; external libSQLite3; 316 | 317 | function sqlite3_exec(db: sqlite3; sql: PUTF8Char; callback: TSQLiteCallBack; param: Pointer; errmsg: PPUTF8Char): integer; cdecl; external libSQLite3; 318 | {$ENDIF} 319 | 320 | end. 321 | -------------------------------------------------------------------------------- /lib/Execute.Textures.pas: -------------------------------------------------------------------------------- 1 | unit Execute.Textures; 2 | 3 | interface 4 | 5 | uses 6 | Execute.SysUtils; 7 | 8 | type 9 | TTextureFormat = ( 10 | tfLUMINANCE_8, 11 | tfLUMINACE_ALPHA_16, 12 | tfRGB_24, 13 | tfARGB_32 14 | ); 15 | 16 | TTexture = record 17 | Width : Integer; 18 | Height: Integer; 19 | Format: TTextureFormat; 20 | BPP : Integer; 21 | Bytes : array of Byte; 22 | procedure Setup(AWidth, AHeight: Integer; AFormat: TTextureFormat); 23 | procedure SaveAsBitmap(const AFileName: string); 24 | procedure Flip; 25 | end; 26 | PTexture = ^TTexture; 27 | 28 | implementation 29 | 30 | type 31 | TBitmap32 = packed record // 54 bytes 32 | // 14 header bytes 33 | bfType : array[0..1] of AnsiChar; 34 | bfSize : Integer; 35 | brReserved : Integer; 36 | bgOffBits : Integer; 37 | // 40 dib info 38 | biSize : Integer; // 40 39 | biWidth : Integer; 40 | biHeight : Integer; 41 | biPlanes : Word; // 1 42 | biBitCount : Word; // 32 43 | biCompression : Integer; // 0 44 | biSizeImage : Integer; // 0 45 | biXPelsPerMeter: Integer; 46 | biYPelsPerMeter: Integer; 47 | biClrUsed : Integer; // 0 48 | biClrImportant : Integer; // 0 49 | end; 50 | 51 | { TTexture } 52 | 53 | procedure BGR2RGB(var AColor; ACount: NativeInt); 54 | type 55 | TRGB = record 56 | r, g, b: Byte; 57 | end; 58 | var 59 | Color: ^TRGB; 60 | Index: Integer; 61 | t: Byte; 62 | begin 63 | Color := @AColor; 64 | for Index := 0 to ACount - 1 do 65 | begin 66 | t := Color.r; 67 | Color.r := Color.b; 68 | Color.b := t; 69 | Inc(Color); 70 | end; 71 | end; 72 | 73 | procedure ABGR2ARGB(var AColor; ACount: NativeInt); 74 | var 75 | Color: PCardinal; 76 | Index: Integer; 77 | begin 78 | Color := @AColor; 79 | for Index := 0 to ACount - 1 do 80 | begin 81 | Color^ := Color^ and $FF00FF00 + Color^ and $FF shl 16 + (Color^ shr 16) and $FF; 82 | Inc(Color); 83 | end; 84 | end; 85 | 86 | procedure TTexture.Flip; 87 | var 88 | a, b: PByte; 89 | l: array of Byte; 90 | begin 91 | a := @Bytes[0]; 92 | b := @Bytes[BPP * Width * (Height - 1)]; 93 | SetLength(l, BPP * Width); 94 | while b > a do 95 | begin 96 | move(a^, l[0], length(l)); 97 | move(b^, a^, length(l)); 98 | move(l[0], b^, length(l)); 99 | Inc(a, BPP * Width); 100 | Dec(b, BPP * Width); 101 | end; 102 | end; 103 | 104 | procedure TTexture.SaveAsBitmap(const AFileName: string); 105 | var 106 | Stream: TFileStream; 107 | Bitmap: TBitmap32; 108 | y : NativeInt; 109 | Line : array of Cardinal; 110 | BSize : Integer; 111 | begin 112 | Stream := TFileStream.Create(AFileName, fmCreate); 113 | try 114 | Bitmap.bfType := 'BM'; 115 | Bitmap.bfSize := BPP * Width * Height + SizeOf(Bitmap); 116 | Bitmap.brReserved := 0; 117 | Bitmap.bgOffBits := SizeOf(Bitmap); 118 | Bitmap.biSize := 40; 119 | Bitmap.biWidth := Width; 120 | Bitmap.biHeight := Height; 121 | Bitmap.biPlanes := 1; 122 | Bitmap.biBitCount := 8 * BPP; 123 | Bitmap.biCompression := 0; 124 | Bitmap.biSizeImage := 0; 125 | Bitmap.biXPelsPerMeter := 0; 126 | Bitmap.biYPelsPerMeter := 0; 127 | if BPP = 1 then 128 | begin 129 | Bitmap.biClrUsed := 256; 130 | end else begin 131 | Bitmap.biClrUsed := 0; 132 | end; 133 | Bitmap.biClrImportant := 0; 134 | Stream.WriteBuffer(Bitmap, SizeOf(Bitmap)); 135 | if BPP = 1 then // Grayscale 136 | begin 137 | SetLength(Line, 256); 138 | for y := 0 to 255 do 139 | begin 140 | Line[y] := $02000000 + y + y shl 8 + y shl 16; 141 | end; 142 | Stream.WriteBuffer(Line[0], 256 * SizeOf(Cardinal)); 143 | end; 144 | SetLength(Line, Width); 145 | BSize := BPP * Width; 146 | BSize := 4 * ((BSize + 3) div 4); 147 | for y := Height - 1 downto 0 do 148 | begin 149 | Move(Bytes[BPP * Width * y], Line[0], BPP * Width); 150 | case BPP of 151 | 3: BGR2RGB(Line[0], Width); 152 | 4: ABGR2ARGB(Line[0], Width); 153 | end; 154 | Stream.WriteBuffer(Line[0], BSize); 155 | end; 156 | finally 157 | Stream.Free; 158 | end; 159 | end; 160 | 161 | procedure TTexture.Setup(AWidth, AHeight: Integer; AFormat: TTextureFormat); 162 | begin 163 | if (Width = AWidth) and (Height = AHeight) and (Format = AFormat) then 164 | Exit; 165 | Width := AWidth; 166 | Height := AHeight; 167 | Format := AFormat; 168 | case Format of 169 | tfLUMINANCE_8 : BPP := 1; 170 | tfLUMINACE_ALPHA_16 : BPP := 2; 171 | tfRGB_24 : BPP := 3; 172 | tfARGB_32 : BPP := 4; 173 | end; 174 | SetLength(Bytes, Width * Height * BPP); 175 | end; 176 | 177 | end. 178 | -------------------------------------------------------------------------------- /lib/sqlite3.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/lib/sqlite3.obj -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Delphi Craft 2 | 3 | this is a Delphi translation of the C project by Michael Fogleman 4 | 5 | https://www.michaelfogleman.com/projects/craft/ 6 | 7 | ![screenshot](DelphiCraft.png) 8 | 9 | the code is somehow inhabituel for a Delphi developer because it's a raw translation of the original code with as few change as possible to identify easily the translation errors. 10 | 11 | it took me some time to identify two errors: 12 | 1. shr in Delphi is not signed, >> in C is signed. 13 | 3. C do not have a div operator, I've miss translated a / to a float operator. 14 | 15 | # Now it support the network protocol ! 16 | 17 | note that Craft.Auth.pas do not implement the authentication against Michael's server, so you can only join it's server as a guest (I don't wont to bother him with my code). 18 | 19 | 20 | ![screenshot](DelphiCraft2.png) -------------------------------------------------------------------------------- /src/CaseyDuncan.noise.pas: -------------------------------------------------------------------------------- 1 | unit CaseyDuncan.noise; 2 | 3 | // Delphi Tokyo translation (c)2017 by Execute SARL 4 | // http://www.execute.fr 5 | 6 | (* 7 | noise.h and noise.c are derived from this project: 8 | 9 | https://github.com/caseman/noise 10 | 11 | Copyright (c) 2008 Casey Duncan 12 | 13 | Permission is hereby granted, free of charge, to any person obtaining a copy 14 | of this software and associated documentation files (the "Software"), to deal 15 | in the Software without restriction, including without limitation the rights 16 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 17 | copies of the Software, and to permit persons to whom the Software is 18 | furnished to do so, subject to the following conditions: 19 | 20 | The above copyright notice and this permission notice shall be included in all 21 | copies or substantial portions of the Software. 22 | 23 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 24 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 25 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 26 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 27 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 28 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 29 | SOFTWARE. 30 | *) 31 | 32 | interface 33 | 34 | function simplex2( 35 | x, y: Single; 36 | octaves: Integer; persistence, lacunarity: Single): Single; 37 | 38 | function simplex3( 39 | x, y, z: Single; 40 | octaves: Integer; persistence, lacunarity: Single): Single; 41 | 42 | implementation 43 | 44 | function floorf(X: Single): Single; 45 | begin 46 | Result := Trunc(X); 47 | if Frac(X) < 0 then 48 | Result := Result - 1; 49 | end; 50 | 51 | const 52 | F2 = 0.3660254037844386; 53 | G2 = 0.21132486540518713; 54 | 55 | F3 = 1.0 / 3.0; 56 | 57 | G3 = 1.0 / 6.0; 58 | 59 | //#define ASSIGN(a, v0, v1, v2) (a)[0] = v0; (a)[1] = v1; (a)[2] = v2; 60 | type 61 | TInteger3 = array[0..2] of Integer; 62 | 63 | procedure ASSIGN(var a: TInteger3; v0, v1, v2: Integer); inline; 64 | begin 65 | a[0] := v0; 66 | a[1] := v1; 67 | a[2] := v2; 68 | end; 69 | 70 | //#define DOT3(v1, v2) ((v1)[0] * (v2)[0] + (v1)[1] * (v2)[1] + (v1)[2] * (v2)[2]) 71 | type 72 | TSingle3 = array[0..2] of Single; 73 | 74 | function DOT3(const v1, v2: TSingle3): Single; inline; 75 | begin 76 | Result := v1[0] * v2[0] + v1[1] * v2[1] + v1[2] * v2[2]; 77 | end; 78 | 79 | const 80 | GRAD3: array[0..15] of TSingle3 = ( 81 | ( 1, 1, 0), (-1, 1, 0), ( 1,-1, 0), (-1,-1, 0), 82 | ( 1, 0, 1), (-1, 0, 1), ( 1, 0,-1), (-1, 0,-1), 83 | ( 0, 1, 1), ( 0,-1, 1), ( 0, 1,-1), ( 0,-1,-1), 84 | ( 1, 0,-1), (-1, 0,-1), ( 0,-1, 1), ( 0, 1, 1) 85 | ); 86 | 87 | PERM: array[0..511] of Byte = ( 88 | 151, 160, 137, 91, 90, 15, 131, 13, 89 | 201, 95, 96, 53, 194, 233, 7, 225, 90 | 140, 36, 103, 30, 69, 142, 8, 99, 91 | 37, 240, 21, 10, 23, 190, 6, 148, 92 | 247, 120, 234, 75, 0, 26, 197, 62, 93 | 94, 252, 219, 203, 117, 35, 11, 32, 94 | 57, 177, 33, 88, 237, 149, 56, 87, 95 | 174, 20, 125, 136, 171, 168, 68, 175, 96 | 74, 165, 71, 134, 139, 48, 27, 166, 97 | 77, 146, 158, 231, 83, 111, 229, 122, 98 | 60, 211, 133, 230, 220, 105, 92, 41, 99 | 55, 46, 245, 40, 244, 102, 143, 54, 100 | 65, 25, 63, 161, 1, 216, 80, 73, 101 | 209, 76, 132, 187, 208, 89, 18, 169, 102 | 200, 196, 135, 130, 116, 188, 159, 86, 103 | 164, 100, 109, 198, 173, 186, 3, 64, 104 | 52, 217, 226, 250, 124, 123, 5, 202, 105 | 38, 147, 118, 126, 255, 82, 85, 212, 106 | 207, 206, 59, 227, 47, 16, 58, 17, 107 | 182, 189, 28, 42, 223, 183, 170, 213, 108 | 119, 248, 152, 2, 44, 154, 163, 70, 109 | 221, 153, 101, 155, 167, 43, 172, 9, 110 | 129, 22, 39, 253, 19, 98, 108, 110, 111 | 79, 113, 224, 232, 178, 185, 112, 104, 112 | 218, 246, 97, 228, 251, 34, 242, 193, 113 | 238, 210, 144, 12, 191, 179, 162, 241, 114 | 81, 51, 145, 235, 249, 14, 239, 107, 115 | 49, 192, 214, 31, 181, 199, 106, 157, 116 | 184, 84, 204, 176, 115, 121, 50, 45, 117 | 127, 4, 150, 254, 138, 236, 205, 93, 118 | 222, 114, 67, 29, 24, 72, 243, 141, 119 | 128, 195, 78, 66, 215, 61, 156, 180, 120 | 151, 160, 137, 91, 90, 15, 131, 13, 121 | 201, 95, 96, 53, 194, 233, 7, 225, 122 | 140, 36, 103, 30, 69, 142, 8, 99, 123 | 37, 240, 21, 10, 23, 190, 6, 148, 124 | 247, 120, 234, 75, 0, 26, 197, 62, 125 | 94, 252, 219, 203, 117, 35, 11, 32, 126 | 57, 177, 33, 88, 237, 149, 56, 87, 127 | 174, 20, 125, 136, 171, 168, 68, 175, 128 | 74, 165, 71, 134, 139, 48, 27, 166, 129 | 77, 146, 158, 231, 83, 111, 229, 122, 130 | 60, 211, 133, 230, 220, 105, 92, 41, 131 | 55, 46, 245, 40, 244, 102, 143, 54, 132 | 65, 25, 63, 161, 1, 216, 80, 73, 133 | 209, 76, 132, 187, 208, 89, 18, 169, 134 | 200, 196, 135, 130, 116, 188, 159, 86, 135 | 164, 100, 109, 198, 173, 186, 3, 64, 136 | 52, 217, 226, 250, 124, 123, 5, 202, 137 | 38, 147, 118, 126, 255, 82, 85, 212, 138 | 207, 206, 59, 227, 47, 16, 58, 17, 139 | 182, 189, 28, 42, 223, 183, 170, 213, 140 | 119, 248, 152, 2, 44, 154, 163, 70, 141 | 221, 153, 101, 155, 167, 43, 172, 9, 142 | 129, 22, 39, 253, 19, 98, 108, 110, 143 | 79, 113, 224, 232, 178, 185, 112, 104, 144 | 218, 246, 97, 228, 251, 34, 242, 193, 145 | 238, 210, 144, 12, 191, 179, 162, 241, 146 | 81, 51, 145, 235, 249, 14, 239, 107, 147 | 49, 192, 214, 31, 181, 199, 106, 157, 148 | 184, 84, 204, 176, 115, 121, 50, 45, 149 | 127, 4, 150, 254, 138, 236, 205, 93, 150 | 222, 114, 67, 29, 24, 72, 243, 141, 151 | 128, 195, 78, 66, 215, 61, 156, 180 152 | ); 153 | 154 | function noise2(x, y: Single): Single; 155 | var 156 | i1, j1, I_, J_, c: Integer; 157 | s, i, j, t: Single; 158 | xx, yy, f, noise: array[0..2] of Single; 159 | g: array[0..2] of Integer; 160 | begin 161 | s := (x + y) * F2; 162 | i := floorf(x + s); 163 | j := floorf(y + s); 164 | t := (i + j) * G2; 165 | 166 | FillChar(noise, SizeOf(noise), 0); 167 | 168 | xx[0] := x - (i - t); 169 | yy[0] := y - (j - t); 170 | 171 | i1 := ord(xx[0] > yy[0]); 172 | j1 := ord(xx[0] <= yy[0]); 173 | 174 | xx[2] := xx[0] + G2 * 2.0 - 1.0; 175 | yy[2] := yy[0] + G2 * 2.0 - 1.0; 176 | xx[1] := xx[0] - i1 + G2; 177 | yy[1] := yy[0] - j1 + G2; 178 | 179 | I_ := Round(i) and 255; 180 | J_ := Round(j) and 255; 181 | g[0] := PERM[I_ + PERM[J_]] mod 12; 182 | g[1] := PERM[I_ + i1 + PERM[J_ + j1]] mod 12; 183 | g[2] := PERM[I_ + 1 + PERM[J_ + 1]] mod 12; 184 | 185 | for c := 0 to 2 do begin 186 | f[c] := 0.5 - xx[c]*xx[c] - yy[c]*yy[c]; 187 | end; 188 | 189 | for c := 0 to 2 do begin 190 | if (f[c] > 0) then begin 191 | noise[c] := f[c] * f[c] * f[c] * f[c] * 192 | (GRAD3[g[c]][0] * xx[c] + GRAD3[g[c]][1] * yy[c]); 193 | end; 194 | end; 195 | 196 | Result := (noise[0] + noise[1] + noise[2]) * 70.0; 197 | end; 198 | 199 | function noise3(x, y, z: Single): Single; 200 | var 201 | c: Integer; 202 | o1, o2: TInteger3; 203 | g: array[0..3] of Integer; 204 | I_, J_, K_: Integer; 205 | f, noise: array[0..3] of Single; 206 | s, i, j, k, t: Single; 207 | pos: array[0..3] of TSingle3; 208 | begin 209 | FillChar(noise, SizeOf(noise), 0); 210 | s := (x + y + z) * F3; 211 | i := floorf(x + s); 212 | j := floorf(y + s); 213 | k := floorf(z + s); 214 | t := (i + j + k) * G3; 215 | 216 | pos[0][0] := x - (i - t); 217 | pos[0][1] := y - (j - t); 218 | pos[0][2] := z - (k - t); 219 | 220 | if (pos[0][0] >= pos[0][1]) then begin 221 | if (pos[0][1] >= pos[0][2]) then begin 222 | ASSIGN(o1, 1, 0, 0); 223 | ASSIGN(o2, 1, 1, 0); 224 | end else if (pos[0][0] >= pos[0][2]) then begin 225 | ASSIGN(o1, 1, 0, 0); 226 | ASSIGN(o2, 1, 0, 1); 227 | end else begin 228 | ASSIGN(o1, 0, 0, 1); 229 | ASSIGN(o2, 1, 0, 1); 230 | end; 231 | end else begin 232 | if (pos[0][1] < pos[0][2]) then begin 233 | ASSIGN(o1, 0, 0, 1); 234 | ASSIGN(o2, 0, 1, 1); 235 | end else if (pos[0][0] < pos[0][2]) then begin 236 | ASSIGN(o1, 0, 1, 0); 237 | ASSIGN(o2, 0, 1, 1); 238 | end else begin 239 | ASSIGN(o1, 0, 1, 0); 240 | ASSIGN(o2, 1, 1, 0); 241 | end; 242 | end; 243 | 244 | for c := 0 to 2 do begin 245 | pos[3][c] := pos[0][c] - 1.0 + 3.0 * G3; 246 | pos[2][c] := pos[0][c] - o2[c] + 2.0 * G3; 247 | pos[1][c] := pos[0][c] - o1[c] + G3; 248 | end; 249 | 250 | I_ := Round(i) and 255; 251 | J_ := Round(j) and 255; 252 | K_ := Round(k) and 255; 253 | g[0] := PERM[I_ + PERM[J_ + PERM[K_]]] mod 12; 254 | g[1] := PERM[I_ + o1[0] + PERM[J_ + o1[1] + PERM[o1[2] + K_]]] mod 12; 255 | g[2] := PERM[I_ + o2[0] + PERM[J_ + o2[1] + PERM[o2[2] + K_]]] mod 12; 256 | g[3] := PERM[I_ + 1 + PERM[J_ + 1 + PERM[K_ + 1]]] mod 12; 257 | 258 | for c := 0 to 3 do begin 259 | f[c] := 0.6 - pos[c][0] * pos[c][0] - pos[c][1] * pos[c][1] - 260 | pos[c][2] * pos[c][2]; 261 | end; 262 | 263 | for c := 0 to 3 do begin 264 | if (f[c] > 0) then begin 265 | noise[c] := f[c] * f[c] * f[c] * f[c] * DOT3(pos[c], GRAD3[g[c]]); 266 | end; 267 | end; 268 | 269 | Result := (noise[0] + noise[1] + noise[2] + noise[3]) * 32.0; 270 | end; 271 | 272 | function simplex2( 273 | x, y: Single; 274 | octaves: Integer; persistence, lacunarity: Single): Single; 275 | var 276 | freq: Single; 277 | amp: Single; 278 | max: Single; 279 | total: Single; 280 | i: Integer; 281 | begin 282 | freq := 1.0; 283 | amp := 1.0; 284 | max := 1.0; 285 | total := noise2(x, y); 286 | for i := 1 to octaves - 1 do 287 | begin 288 | freq := freq * lacunarity; 289 | amp := amp * persistence; 290 | max := max + amp; 291 | total := total + noise2(x * freq, y * freq) * amp; 292 | end; 293 | Result := (1 + total / max) / 2; 294 | end; 295 | 296 | 297 | function simplex3( 298 | x, y, z: Single; 299 | octaves: Integer; persistence, lacunarity: Single): Single; 300 | var 301 | freq, amp, max, total: Single; 302 | i: Integer; 303 | begin 304 | freq := 1.0; 305 | amp := 1.0; 306 | max := 1.0; 307 | total := noise3(x, y, z); 308 | for i := 1 to octaves - 1 do begin 309 | freq := freq * lacunarity; 310 | amp := amp * persistence; 311 | max := max + amp; 312 | total := total + noise3(x * freq, y * freq, z * freq) * amp; 313 | end; 314 | Result := (1 + total / max) / 2; 315 | end; 316 | 317 | end. 318 | -------------------------------------------------------------------------------- /src/Craft.Auth.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Auth; 2 | 3 | interface 4 | 5 | function get_access_token(token: PAnsiChar; len: Integer; username, identity_token: PAnsiChar): Boolean; 6 | 7 | implementation 8 | 9 | function get_access_token(token: PAnsiChar; len: Integer; username, identity_token: PAnsiChar): Boolean; 10 | begin 11 | { 12 | 13 | If you want to log on Michael's server, use the original client ! 14 | 15 | https://www.michaelfogleman.com/projects/craft/ 16 | 17 | } 18 | Result := False; 19 | end; 20 | 21 | end. 22 | -------------------------------------------------------------------------------- /src/Craft.Chunk.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Chunk; 2 | { 3 | Parts of Craft.main about Chunks 4 | } 5 | 6 | interface 7 | 8 | uses 9 | System.Math, 10 | Execute.CrossGL, 11 | Craft.Config, 12 | Craft.Util, 13 | Craft.Map, 14 | Craft.Sign, 15 | Craft.Matrix; 16 | 17 | type 18 | TChunk = record 19 | map : TMap; 20 | lights : TMap; 21 | signs : TSignList; 22 | p : Integer; 23 | q : Integer; 24 | faces : Integer; 25 | sign_faces : Integer; 26 | dirty : Integer; 27 | miny : Integer; 28 | maxy : Integer; 29 | buffer : GLuint; 30 | sign_buffer: GLuint; 31 | end; 32 | pChunk = ^TChunk; 33 | 34 | function chunked(x: Single): Integer; 35 | function find_chunk(p, q: Integer): pChunk; 36 | function chunk_distance(chunk: pChunk; p, q: Integer): Integer; 37 | function chunk_visible(const planes: TPlanes; p, q, miny, maxy: Integer): Integer; 38 | procedure dirty_chunk(chunk: pChunk); 39 | procedure delete_all_chunks(); 40 | 41 | implementation 42 | 43 | uses 44 | Craft.Main; 45 | 46 | function chunked(x: Single): Integer; 47 | begin 48 | Result := Floor(Round(x) / CHUNK_SIZE); 49 | end; 50 | 51 | function find_chunk(p, q: Integer): pChunk; 52 | var 53 | i: Integer; 54 | begin 55 | for i := 0 to g.chunk_count - 1 do 56 | begin 57 | Result := @g.chunks[i]; 58 | if (Result.p = p) and (Result.q = q) then 59 | Exit; 60 | end; 61 | Result := nil; 62 | end; 63 | 64 | function chunk_distance(chunk: pChunk; p, q: Integer): Integer; 65 | var 66 | dp, dq: Integer; 67 | begin 68 | dp := ABS(chunk.p - p); 69 | dq := ABS(chunk.q - q); 70 | Result := MAX(dp, dq); 71 | end; 72 | 73 | function chunk_visible(const planes: TPlanes; p, q, miny, maxy: Integer): Integer; 74 | var 75 | x, z, d: Integer; 76 | points: array[0..7, 0..2] of Single; 77 | n, i, in_, out_, j: Integer; 78 | d_: Single; 79 | begin 80 | x := p * CHUNK_SIZE - 1; 81 | z := q * CHUNK_SIZE - 1; 82 | d := CHUNK_SIZE + 1; 83 | points[0][0] := x + 0; points[0, 1] := miny; points[0, 2] := z + 0; 84 | points[1][0] := x + d; points[1, 1] := miny; points[1, 2] := z + 0; 85 | points[2][0] := x + 0; points[2, 1] := miny; points[2, 2] := z + d; 86 | points[3][0] := x + d; points[3, 1] := miny; points[3, 2] := z + d; 87 | points[4][0] := x + 0; points[4, 1] := maxy; points[4, 2] := z + 0; 88 | points[5][0] := x + d; points[5, 1] := maxy; points[5, 2] := z + 0; 89 | points[6][0] := x + 0; points[6, 1] := maxy; points[6, 2] := z + d; 90 | points[7][0] := x + d; points[7, 1] := maxy; points[7, 2] := z + d; 91 | if g.ortho <> 0 then 92 | n := 4 93 | else 94 | n := 6; 95 | for i := 0 to n - 1 do 96 | begin 97 | in_ := 0; 98 | out_ := 0; 99 | for j := 0 to 7 do begin 100 | d_ := 101 | planes[i][0] * points[j][0] + 102 | planes[i][1] * points[j][1] + 103 | planes[i][2] * points[j][2] + 104 | planes[i][3]; 105 | if (d_ < 0) then begin 106 | Inc(out_); 107 | end 108 | else begin 109 | Inc(in_); 110 | end; 111 | if (in_ <> 0) and (out_ <> 0) then begin 112 | break; 113 | end; 114 | end; 115 | if (in_ = 0) then begin 116 | Exit(0); 117 | end; 118 | end; 119 | Result := 1; 120 | end; 121 | 122 | function has_lights(chunk: pChunk): Integer; 123 | var 124 | dp: Integer; 125 | dq: Integer; 126 | other: pChunk; 127 | map: pMap; 128 | begin 129 | if (SHOW_LIGHTS = 0) then begin 130 | Exit(0); 131 | end; 132 | for dp := -1 to +1 do begin 133 | for dq := -1 to +1 do begin 134 | other := chunk; 135 | if (dp <> 0) or (dq <> 0) then begin 136 | other := find_chunk(chunk.p + dp, chunk.q + dq); 137 | end; 138 | if (other = nil) then begin 139 | continue; 140 | end; 141 | map := @other.lights; 142 | if (map.size <> 0) then begin 143 | Exit(1); 144 | end; 145 | end; 146 | end; 147 | Result := 0; 148 | end; 149 | 150 | procedure dirty_chunk(chunk: pChunk); 151 | var 152 | dp: Integer; 153 | dq: Integer; 154 | other: pChunk; 155 | begin 156 | chunk.dirty := 1; 157 | if (has_lights(chunk) <> 0) then begin 158 | for dp := -1 to + 1 do begin 159 | for dq := -1 to + 1 do begin 160 | other := find_chunk(chunk.p + dp, chunk.q + dq); 161 | if (other <> nil) then begin 162 | other.dirty := 1; 163 | end; 164 | end; 165 | end; 166 | end; 167 | end; 168 | 169 | procedure delete_all_chunks(); 170 | var 171 | i: Integer; 172 | chunk: pChunk; 173 | begin 174 | for i := 0 to g.chunk_count - 1 do begin 175 | chunk := @g.chunks[i]; 176 | map_free(&chunk.map); 177 | map_free(&chunk.lights); 178 | sign_list_free(@chunk.signs); 179 | del_buffer(chunk.buffer); 180 | del_buffer(chunk.sign_buffer); 181 | end; 182 | g.chunk_count := 0; 183 | end; 184 | 185 | end. 186 | -------------------------------------------------------------------------------- /src/Craft.Client.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Client; 2 | 3 | interface 4 | {$POINTERMATH ON} 5 | uses 6 | Winapi.Windows, 7 | Winapi.Winsock, 8 | Execute.SysUtils, 9 | MarcusGeelnard.TinyCThread; 10 | 11 | const 12 | DEFAULT_PORT = 4080; 13 | 14 | procedure client_enable(); 15 | procedure client_disable(); 16 | function get_client_enabled(): Boolean; 17 | procedure client_connect(hostname: PAnsiChar; port: Integer); 18 | procedure client_start(); 19 | procedure client_stop(); 20 | procedure client_send(data: PAnsiChar); 21 | function client_recv(): PAnsiChar; 22 | procedure client_version(version: Integer); 23 | procedure client_login(username, identity_token: PAnsiChar); 24 | procedure client_position(x, y, z, rx, ry: Single); 25 | procedure client_chunk(p, q, key: Integer); 26 | procedure client_block(x, y, z, w: Integer); 27 | procedure client_light(x, y, z, w: Integer); 28 | procedure client_sign(x, y, z, face: Integer; text: PAnsiChar); 29 | procedure client_talk(text: PAnsiChar); 30 | 31 | implementation 32 | 33 | { 34 | #ifdef _WIN32 35 | #include 36 | #include 37 | #define close closesocket 38 | #define sleep Sleep 39 | #else 40 | #include 41 | #include 42 | #endif 43 | 44 | #include 45 | #include 46 | #include 47 | #include "client.h" 48 | #include "tinycthread.h" 49 | } 50 | 51 | const 52 | QUEUE_SIZE = 1048576; 53 | RECV_SIZE = 4096; 54 | 55 | var 56 | client_enabled : Boolean = False; 57 | running : Boolean = False; 58 | sd : Integer = 0; 59 | bytes_sent : Integer = 0; 60 | bytes_received : Integer = 0; 61 | queue : PAnsiChar = nil; 62 | qsize : Integer = 0; 63 | recv_thread: thrd_t; 64 | mutex: mtx_t; 65 | 66 | procedure client_enable(); 67 | {$IFDEF MSWINDOWS} 68 | var 69 | WSA: TWSAData; 70 | {$ENDIF} 71 | begin 72 | client_enabled := True; 73 | {$IFDEF MSWINDOWS} 74 | WSAStartup($202, WSA); 75 | {$ENDIF} 76 | end; 77 | 78 | procedure client_disable(); 79 | begin 80 | client_enabled := False; 81 | end; 82 | 83 | function get_client_enabled(): Boolean; 84 | begin 85 | Result := client_enabled; 86 | end; 87 | 88 | function client_sendall(sd: Integer; data: PAnsiChar; length: Integer): Integer; 89 | var 90 | count, n : Integer; 91 | begin 92 | if (not client_enabled) then begin 93 | Exit(0); 94 | end; 95 | count := 0; 96 | while (count < length) do begin 97 | n := send(sd, data[count], length, 0); 98 | if (n = -1) then begin 99 | Exit(-1); 100 | end; 101 | Inc(count, n); 102 | Dec(length, n); 103 | Inc(bytes_sent, n); 104 | end; 105 | Result := 0; 106 | end; 107 | 108 | procedure client_send(data: PAnsiChar); 109 | begin 110 | if (not client_enabled) then begin 111 | Exit; 112 | end; 113 | if (client_sendall(sd, data, strlen(data)) = -1) then begin 114 | //perror('client_sendall'); 115 | Halt(1); 116 | end; 117 | end; 118 | 119 | procedure client_version(version: Integer); 120 | var 121 | buffer: array[0..1023] of AnsiChar; 122 | begin 123 | if (not client_enabled) then begin 124 | Exit; 125 | end; 126 | snprintf(buffer, 1024, 'V,%d\n', [version]); 127 | client_send(buffer); 128 | end; 129 | 130 | procedure client_login(username, identity_token: PAnsiChar); 131 | var 132 | buffer: array[0..1023] of AnsiChar; 133 | begin 134 | if (not client_enabled) then begin 135 | Exit; 136 | end; 137 | snprintf(buffer, 1024, 'A,%s,%s\n', [username, identity_token]); 138 | client_send(buffer); 139 | end; 140 | 141 | var 142 | px : Single = 0; 143 | py : Single = 0; 144 | pz : Single = 0; 145 | prx : Single = 0; 146 | pry : Single = 0; 147 | 148 | procedure client_position(x, y, z, rx, ry: Single); 149 | var 150 | distance: Single; 151 | buffer: array[0..1023] of AnsiChar; 152 | begin 153 | if (not client_enabled) then begin 154 | Exit; 155 | end; 156 | distance := 157 | (px - x) * (px - x) + 158 | (py - y) * (py - y) + 159 | (pz - z) * (pz - z) + 160 | (prx - rx) * (prx - rx) + 161 | (pry - ry) * (pry - ry); 162 | if (distance < 0.0001) then begin 163 | Exit; 164 | end; 165 | px := x; py := y; pz := z; prx := rx; pry := ry; 166 | snprintf(buffer, 1024, 'P,%.2f,%.2f,%.2f,%.2f,%.2f\n', [x, y, z, rx, ry]); 167 | client_send(buffer); 168 | end; 169 | 170 | procedure client_chunk(p, q, key: Integer); 171 | var 172 | buffer: array[0..1023] of AnsiChar; 173 | begin 174 | if (not client_enabled) then begin 175 | Exit; 176 | end; 177 | snprintf(buffer, 1024, 'C,%d,%d,%d\n', [p, q, key]); 178 | client_send(buffer); 179 | end; 180 | 181 | procedure client_block(x, y, z, w: Integer); 182 | var 183 | buffer: array[0..1023] of AnsiChar; 184 | begin 185 | if (not client_enabled) then begin 186 | Exit; 187 | end; 188 | snprintf(buffer, 1024, 'B,%d,%d,%d,%d\n', [x, y, z, w]); 189 | client_send(buffer); 190 | end; 191 | 192 | procedure client_light(x, y, z, w: Integer); 193 | var 194 | buffer: array[0..1023] of AnsiChar; 195 | begin 196 | if (not client_enabled) then begin 197 | Exit; 198 | end; 199 | snprintf(buffer, 1024, 'L,%d,%d,%d,%d\n', [x, y, z, w]); 200 | client_send(buffer); 201 | end; 202 | 203 | procedure client_sign(x, y, z, face: Integer; text: PAnsiChar); 204 | var 205 | buffer: array[0..1023] of AnsiChar; 206 | begin 207 | if (not client_enabled) then begin 208 | Exit; 209 | end; 210 | snprintf(buffer, 1024, 'S,%d,%d,%d,%d,%s\n', [x, y, z, face, text]); 211 | client_send(buffer); 212 | end; 213 | 214 | procedure client_talk(text: PAnsiChar); 215 | var 216 | buffer: array[0..1023] of AnsiChar; 217 | begin 218 | if (not client_enabled) then begin 219 | Exit; 220 | end; 221 | if (strlen(text) = 0) then begin 222 | Exit; 223 | end; 224 | snprintf(buffer, 1024, 'T,%s\n', [text]); 225 | client_send(buffer); 226 | end; 227 | 228 | function client_recv(): PAnsiChar; 229 | var 230 | p: PAnsiChar; 231 | length: Integer; 232 | remaining: Integer; 233 | begin 234 | if (not client_enabled) then begin 235 | Exit(nil); 236 | end; 237 | result := nil; 238 | mtx_lock(mutex); 239 | p := queue + qsize - 1; 240 | while (p >= queue) and (p^ <> #10) do begin 241 | Dec(p); 242 | end; 243 | if (p >= queue) then begin 244 | length := p - queue + 1; 245 | //result := malloc(sizeof(char) * (length + 1)); 246 | //memcpy(result, queue, sizeof(char) * length); 247 | GetMem(Result, length + 1); 248 | move(queue^, result^, length); 249 | result[length] := #0; 250 | remaining := qsize - length; 251 | //memmove(queue, p + 1, remaining); 252 | move(p[1], queue^, remaining); 253 | Dec(qsize, length); 254 | Inc(bytes_received, length); 255 | end; 256 | mtx_unlock(mutex); 257 | end; 258 | 259 | function recv_worker(arg: Pointer): Integer; 260 | var 261 | data: PAnsiChar; 262 | length: Integer; 263 | done: Boolean; 264 | begin 265 | //char *data = malloc(sizeof(char) * RECV_SIZE); 266 | GetMem(data, RECV_SIZE); 267 | while (true) do begin 268 | length := recv(sd, data[0], RECV_SIZE - 1, 0); 269 | if (length <= 0) then begin 270 | if (running) then begin 271 | //perror("recv"); 272 | Exit(1); 273 | end 274 | else begin 275 | break; 276 | end; 277 | end; 278 | data[length] := #0; 279 | while (true) do begin 280 | done := False; 281 | mtx_lock(mutex); 282 | if (qsize + length < QUEUE_SIZE) then begin 283 | //memcpy(queue + qsize, data, sizeof(char) * (length + 1)); 284 | move(data^, queue[qsize], length + 1); 285 | Inc(qsize, length); 286 | done := True; 287 | end; 288 | mtx_unlock(mutex); 289 | if (done) then begin 290 | break; 291 | end; 292 | sleep(0); 293 | end; 294 | end; 295 | freemem(data); 296 | Result := 0; 297 | end; 298 | 299 | procedure client_connect(hostname: PAnsiChar; port: Integer); 300 | var 301 | host: phostent; 302 | address: sockaddr_in; 303 | begin 304 | if (not client_enabled) then begin 305 | Exit; 306 | end; 307 | host := gethostbyname(hostname); 308 | if (host = nil) then begin 309 | //perror("gethostbyname"); 310 | halt(1); 311 | end; 312 | FillChar(address, sizeof(address), 0); 313 | address.sin_family := AF_INET; 314 | address.sin_addr.s_addr := PInAddr(Pointer(host.h_addr_list)^).s_addr; 315 | address.sin_port := htons(port); 316 | sd := socket(AF_INET, SOCK_STREAM, 0); 317 | if (sd = -1) then begin 318 | //perror("socket"); 319 | Halt(1); 320 | end; 321 | if (connect(sd, address, sizeof(address)) = -1) then begin 322 | //perror("connect"); 323 | Halt(1); 324 | end; 325 | end; 326 | 327 | procedure client_start(); 328 | begin 329 | if (not client_enabled) then begin 330 | Exit; 331 | end; 332 | running := True; 333 | GetMem(queue, QUEUE_SIZE); 334 | qsize := 0; 335 | mtx_init(mutex, mtx_plain); 336 | if (thrd_create(recv_thread, recv_worker, nil) <> thrd_success) then begin 337 | //perror("thrd_create"); 338 | Halt(1); 339 | end; 340 | end; 341 | 342 | procedure client_stop(); 343 | begin 344 | if (not client_enabled) then begin 345 | Exit; 346 | end; 347 | running := False; 348 | closesocket(sd); 349 | // if (thrd_join(recv_thread, NULL) != thrd_success) { 350 | // perror("thrd_join"); 351 | // exit(1); 352 | // } 353 | // mtx_destroy(&mutex); 354 | qsize := 0; 355 | freemem(queue); 356 | // printf("Bytes Sent: %d, Bytes Received: %d\n", 357 | // bytes_sent, bytes_received); 358 | end; 359 | 360 | 361 | end. 362 | -------------------------------------------------------------------------------- /src/Craft.Config.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Config; 2 | 3 | interface 4 | 5 | uses 6 | Neslib.glfw3; 7 | 8 | const 9 | // app parameters 10 | FULLSCREEN = 0; 11 | WINDOW_WIDTH = 1024; 12 | WINDOW_HEIGHT = 768; 13 | VSYNC = 1; 14 | SCROLL_THRESHOLD = 0.1; 15 | MAX_MESSAGES = 4; 16 | DB_PATH = 'craft.db'; 17 | USE_CACHE = True; 18 | DAY_LENGTH = 600; 19 | INVERT_MOUSE = False; 20 | 21 | // rendering options 22 | SHOW_LIGHTS = 1; 23 | SHOW_PLANTS = 1; 24 | SHOW_CLOUDS = 1; 25 | SHOW_TREES = 1; 26 | SHOW_CROSSHAIRS = True; 27 | SHOW_WIREFRAME = True; 28 | SHOW_ITEM = True; 29 | SHOW_INFO_TEXT = True; 30 | SHOW_CHAT_TEXT = True; 31 | SHOW_PLAYER_NAMES = True; 32 | 33 | // advanced parameters 34 | CREATE_CHUNK_RADIUS = 10; 35 | RENDER_CHUNK_RADIUS = 10; 36 | RENDER_SIGN_RADIUS = 4; 37 | DELETE_CHUNK_RADIUS = 14; 38 | CHUNK_SIZE = 32; 39 | COMMIT_INTERVAL = 5; 40 | 41 | // key bindings 42 | CRAFT_KEY_FORWARD = Ord('W'); 43 | CRAFT_KEY_BACKWARD = Ord('S'); 44 | CRAFT_KEY_LEFT = Ord('A'); 45 | CRAFT_KEY_RIGHT = Ord('D'); 46 | CRAFT_KEY_JUMP = GLFW_KEY_SPACE; 47 | CRAFT_KEY_FLY = GLFW_KEY_TAB; 48 | CRAFT_KEY_OBSERVE = 'O'; 49 | CRAFT_KEY_OBSERVE_INSET = 'P'; 50 | CRAFT_KEY_ITEM_NEXT = 'E'; 51 | CRAFT_KEY_ITEM_PREV = 'R'; 52 | CRAFT_KEY_ZOOM = GLFW_KEY_LEFT_SHIFT; 53 | CRAFT_KEY_ORTHO = Ord('F'); 54 | CRAFT_KEY_CHAT = 't'; 55 | CRAFT_KEY_COMMAND = '/'; 56 | CRAFT_KEY_SIGN = '`'; 57 | 58 | implementation 59 | 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /src/Craft.Cube.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Cube; 2 | 3 | interface 4 | {$POINTERMATH ON} 5 | uses 6 | System.Math, 7 | Craft.Util, 8 | Craft.Item, 9 | Craft.Matrix; 10 | 11 | procedure make_cube( 12 | data: PSingle; const ao, light: tfloat_6_4; 13 | left, right, top, bottom, front, back: Boolean; 14 | x, y, z, n: Single; w: Integer); 15 | 16 | procedure make_plant( 17 | data: PSingle; ao, light, 18 | px, py, pz, n: Single; w: Integer; rotation: Single); 19 | 20 | procedure make_player( 21 | data: PSingle; x, y, z, rx, ry: Single); 22 | 23 | procedure make_cube_wireframe(data: PSingle; x, y, z, n: Single); 24 | 25 | procedure make_character( 26 | data: PSingle; 27 | x, y, n, m: Single; c: AnsiChar); 28 | 29 | procedure make_character_3d( 30 | data: PSingle; x, y, z, n: Single; face: Integer; c: AnsiChar); 31 | 32 | procedure make_sphere(data: PSingle; r: Single; detail: Integer); 33 | 34 | implementation 35 | 36 | procedure make_cube_faces( 37 | data: PSingle; const ao, light: tfloat_6_4; 38 | left, right, top, bottom, front, back: Boolean; 39 | wleft, wright, wtop, wbottom, wfront, wback: Integer; 40 | x, y, z, n: Single); 41 | const 42 | positions: array[0..5, 0..3, 0..2] of Single = ( 43 | ((-1, -1, -1), (-1, -1, +1), (-1, +1, -1), (-1, +1, +1)), 44 | ((+1, -1, -1), (+1, -1, +1), (+1, +1, -1), (+1, +1, +1)), 45 | ((-1, +1, -1), (-1, +1, +1), (+1, +1, -1), (+1, +1, +1)), 46 | ((-1, -1, -1), (-1, -1, +1), (+1, -1, -1), (+1, -1, +1)), 47 | ((-1, -1, -1), (-1, +1, -1), (+1, -1, -1), (+1, +1, -1)), 48 | ((-1, -1, +1), (-1, +1, +1), (+1, -1, +1), (+1, +1, +1)) 49 | ); 50 | normals: array[0..5, 0..2] of Single = ( 51 | (-1, 0, 0), 52 | (+1, 0, 0), 53 | (0, +1, 0), 54 | (0, -1, 0), 55 | (0, 0, -1), 56 | (0, 0, +1) 57 | ); 58 | uvs: array[0..5, 0..3, 0..1] of Byte = ( 59 | ((0, 0), (1, 0), (0, 1), (1, 1)), 60 | ((1, 0), (0, 0), (1, 1), (0, 1)), 61 | ((0, 1), (0, 0), (1, 1), (1, 0)), 62 | ((0, 0), (0, 1), (1, 0), (1, 1)), 63 | ((0, 0), (0, 1), (1, 0), (1, 1)), 64 | ((1, 0), (1, 1), (0, 0), (0, 1)) 65 | ); 66 | indices: array[0..5, 0..5] of Integer = ( 67 | (0, 3, 2, 0, 1, 3), 68 | (0, 3, 1, 0, 2, 3), 69 | (0, 3, 2, 0, 1, 3), 70 | (0, 3, 1, 0, 2, 3), 71 | (0, 3, 2, 0, 1, 3), 72 | (0, 3, 1, 0, 2, 3) 73 | ); 74 | flipped: array[0..5, 0..5] of Integer = ( 75 | (0, 1, 2, 1, 3, 2), 76 | (0, 2, 1, 2, 3, 1), 77 | (0, 1, 2, 1, 3, 2), 78 | (0, 2, 1, 2, 3, 1), 79 | (0, 1, 2, 1, 3, 2), 80 | (0, 2, 1, 2, 3, 1) 81 | ); 82 | var 83 | d: PSingle; 84 | s, a, b: Single; 85 | faces: array[0..5] of Boolean; 86 | tiles: array[0..5] of Integer; 87 | i: Integer; 88 | du, dv: Single; 89 | flip: Boolean; 90 | v, j: Integer; 91 | begin 92 | d := data; 93 | s := 0.0625; 94 | a := 0 + 1 / 2048.0; 95 | b := s - 1 / 2048.0; 96 | faces[0] := left; 97 | faces[1] := right; 98 | faces[2] := top; 99 | faces[3] := bottom; 100 | faces[4] := front; 101 | faces[5] := back; 102 | tiles[0] := wleft; 103 | tiles[1] := wright; 104 | tiles[2] := wtop; 105 | tiles[3] := wbottom; 106 | tiles[4] := wfront; 107 | tiles[5] := wback; 108 | for i := 0 to 5 do begin 109 | if (faces[i] = False) then begin 110 | continue; 111 | end; 112 | du := (tiles[i] mod 16) * s; 113 | dv := (tiles[i] div 16) * s; 114 | flip := ao[i][0] + ao[i][3] > ao[i][1] + ao[i][2]; 115 | for v := 0 to 5 do begin 116 | if flip then 117 | j := flipped[i, v] 118 | else 119 | j := indices[i, v]; 120 | d^ := x + n * positions[i][j][0]; Inc(d); 121 | d^ := y + n * positions[i][j][1]; Inc(d); 122 | d^ := z + n * positions[i][j][2]; Inc(d); 123 | d^ := normals[i][0]; Inc(d); 124 | d^ := normals[i][1]; Inc(d); 125 | d^ := normals[i][2]; Inc(d); 126 | if uvs[i][j][0] <> 0 then 127 | d^ := du + b 128 | else 129 | d^ := du + a; 130 | Inc(d); 131 | if uvs[i][j][1] <> 0 then 132 | d^ := dv + b 133 | else 134 | d^ := dv + a; 135 | Inc(d); 136 | d^ := ao[i][j]; Inc(d); 137 | d^ := light[i][j]; Inc(d); 138 | end; 139 | end; 140 | end; 141 | 142 | procedure make_cube( 143 | data: PSingle; const ao, light: tfloat_6_4; 144 | left, right, top, bottom, front, back: Boolean; 145 | x, y, z, n: Single; w: Integer); 146 | var 147 | wleft, wright, wtop, wbottom, wfront, wback: Integer; 148 | begin 149 | wleft := blocks[w][0]; 150 | wright := blocks[w][1]; 151 | wtop := blocks[w][2]; 152 | wbottom := blocks[w][3]; 153 | wfront := blocks[w][4]; 154 | wback := blocks[w][5]; 155 | make_cube_faces( 156 | data, ao, light, 157 | left, right, top, bottom, front, back, 158 | wleft, wright, wtop, wbottom, wfront, wback, 159 | x, y, z, n); 160 | end; 161 | 162 | procedure make_plant( 163 | data: PSingle; ao, light, 164 | px, py, pz, n: Single; w: Integer; rotation: Single); 165 | const 166 | positions:array[0..3,0..3,0..2] of Single = ( 167 | (( 0, -1, -1), ( 0, -1, +1), ( 0, +1, -1), ( 0, +1, +1)), 168 | (( 0, -1, -1), ( 0, -1, +1), ( 0, +1, -1), ( 0, +1, +1)), 169 | ((-1, -1, 0), (-1, +1, 0), (+1, -1, 0), (+1, +1, 0)), 170 | ((-1, -1, 0), (-1, +1, 0), (+1, -1, 0), (+1, +1, 0)) 171 | ); 172 | normals: array[0..3, 0..2] of Single = ( 173 | (-1, 0, 0), 174 | (+1, 0, 0), 175 | (0, 0, -1), 176 | (0, 0, +1) 177 | ); 178 | uvs: array[0..3, 0..3, 0..1] of Single = ( 179 | ((0, 0), (1, 0), (0, 1), (1, 1)), 180 | ((1, 0), (0, 0), (1, 1), (0, 1)), 181 | ((0, 0), (0, 1), (1, 0), (1, 1)), 182 | ((1, 0), (1, 1), (0, 0), (0, 1)) 183 | ); 184 | indices: array[0..3, 0..5] of Integer = ( 185 | (0, 3, 2, 0, 1, 3), 186 | (0, 3, 1, 0, 2, 3), 187 | (0, 3, 2, 0, 1, 3), 188 | (0, 3, 1, 0, 2, 3) 189 | ); 190 | var 191 | d: pSingle; 192 | s, a, b: Single; 193 | du, dv: Single; 194 | i, v, j: Integer; 195 | ma, mb: array[0..15] of Single; 196 | begin 197 | d := data; 198 | s := 0.0625; 199 | a := 0; 200 | b := s; 201 | du := (plants[w] mod 16) * s; 202 | dv := (plants[w] div 16) * s; 203 | for i := 0 to 3 do begin 204 | for v := 0 to 5 do begin 205 | j := indices[i][v]; 206 | d^ := n * positions[i][j][0]; Inc(d); 207 | d^ := n * positions[i][j][1]; Inc(d); 208 | d^ := n * positions[i][j][2]; Inc(d); 209 | d^ := normals[i][0]; Inc(d); 210 | d^ := normals[i][1]; Inc(d); 211 | d^ := normals[i][2]; Inc(d); 212 | if uvs[i][j][0] <> 0 then 213 | d^ := du + b 214 | else 215 | d^ := du + a; 216 | Inc(d); 217 | if uvs[i][j][1] <> 0 then 218 | d^ := dv + b 219 | else 220 | d^ := dv + a; 221 | Inc(d); 222 | d^ := ao; Inc(d); 223 | d^ := light; Inc(d); 224 | end; 225 | end; 226 | mat_identity(@ma); 227 | mat_rotate(@mb, 0, 1, 0, RADIANS(rotation)); 228 | mat_multiply(@ma, @mb, @ma); 229 | mat_apply(data, @ma, 24, 3, 10); 230 | mat_translate(@mb, px, py, pz); 231 | mat_multiply(@ma, @mb, @ma); 232 | mat_apply(data, @ma, 24, 0, 10); 233 | end; 234 | 235 | 236 | procedure make_player( 237 | data: PSingle; 238 | x, y, z, rx, ry: Single); 239 | var 240 | ao: tfloat_6_4; 241 | const 242 | light: tfloat_6_4 = ( 243 | (0.8, 0.8, 0.8, 0.8), 244 | (0.8, 0.8, 0.8, 0.8), 245 | (0.8, 0.8, 0.8, 0.8), 246 | (0.8, 0.8, 0.8, 0.8), 247 | (0.8, 0.8, 0.8, 0.8), 248 | (0.8, 0.8, 0.8, 0.8) 249 | ); 250 | var 251 | ma, mb:array[0..15] of Single; 252 | begin 253 | FillChar(ao, SizeOf(ao), 0); 254 | make_cube_faces( 255 | data, ao, light, 256 | true, true, true, true, true, true, 257 | 226, 224, 241, 209, 225, 227, 258 | 0, 0, 0, 0.4); 259 | mat_identity(@ma); 260 | mat_rotate(@mb, 0, 1, 0, rx); 261 | mat_multiply(@ma, @mb, @ma); 262 | mat_rotate(@mb, cos(rx), 0, sin(rx), -ry); 263 | mat_multiply(@ma, @mb, @ma); 264 | mat_apply(data, @ma, 36, 3, 10); 265 | mat_translate(@mb, x, y, z); 266 | mat_multiply(@ma, @mb, @ma); 267 | mat_apply(data, @ma, 36, 0, 10); 268 | end; 269 | 270 | procedure make_cube_wireframe(data: PSingle; x, y, z, n: Single); 271 | const 272 | positions:array[0..7,0..2] of Single = ( 273 | (-1, -1, -1), 274 | (-1, -1, +1), 275 | (-1, +1, -1), 276 | (-1, +1, +1), 277 | (+1, -1, -1), 278 | (+1, -1, +1), 279 | (+1, +1, -1), 280 | (+1, +1, +1) 281 | ); 282 | indices: array[0..23] of Integer = ( 283 | 0, 1, 0, 2, 0, 4, 1, 3, 284 | 1, 5, 2, 3, 2, 6, 3, 7, 285 | 4, 5, 4, 6, 5, 7, 6, 7 286 | ); 287 | var 288 | d: PSingle; 289 | i, j: Integer; 290 | begin 291 | d := data; 292 | for i := 0 to 23 do begin 293 | j := indices[i]; 294 | d^ := x + n * positions[j][0]; Inc(d); 295 | d^ := y + n * positions[j][1]; Inc(d); 296 | d^ := z + n * positions[j][2]; Inc(d); 297 | end; 298 | end; 299 | 300 | procedure make_character( 301 | data: PSingle; 302 | x, y, n, m: Single; c: AnsiChar); 303 | var 304 | d: PSingle; 305 | s, a, b: Single; 306 | w: Integer; 307 | du, dv: Single; 308 | begin 309 | d := data; 310 | s := 0.0625; 311 | a := s; 312 | b := s * 2; 313 | w := Ord(c) - 32; 314 | du := (w mod 16) * a; 315 | dv := 1 - (w div 16) * b - b; 316 | d^ := x - n; Inc(d); d^ := y - m; Inc(d); 317 | d^ := du + 0; Inc(d); d^ := dv; Inc(d); 318 | d^ := x + n; Inc(d); d^ := y - m; Inc(d); 319 | d^ := du + a; Inc(d); d^ := dv; Inc(d); 320 | d^ := x + n; Inc(d); d^ := y + m; Inc(d); 321 | d^ := du + a; Inc(d); d^ := dv + b; Inc(d); 322 | d^ := x - n; Inc(d); d^ := y - m; Inc(d); 323 | d^ := du + 0; Inc(d); d^ := dv; Inc(d); 324 | d^ := x + n; Inc(d); d^ := y + m; Inc(d); 325 | d^ := du + a; Inc(d); d^ := dv + b; Inc(d); 326 | d^ := x - n; Inc(d); d^ := y + m; Inc(d); 327 | d^ := du + 0; Inc(d); d^ := dv + b; Inc(d); 328 | end; 329 | 330 | procedure make_character_3d( 331 | data: PSingle; x, y, z, n: Single; face: Integer; c: AnsiChar); 332 | const 333 | positions: array[0..7,0..5,0..2] of Single = ( 334 | ((0, -2, -1), (0, +2, +1), (0, +2, -1), 335 | (0, -2, -1), (0, -2, +1), (0, +2, +1)), 336 | ((0, -2, -1), (0, +2, +1), (0, -2, +1), 337 | (0, -2, -1), (0, +2, -1), (0, +2, +1)), 338 | ((-1, -2, 0), (+1, +2, 0), (+1, -2, 0), 339 | (-1, -2, 0), (-1, +2, 0), (+1, +2, 0)), 340 | ((-1, -2, 0), (+1, -2, 0), (+1, +2, 0), 341 | (-1, -2, 0), (+1, +2, 0), (-1, +2, 0)), 342 | ((-1, 0, +2), (+1, 0, +2), (+1, 0, -2), 343 | (-1, 0, +2), (+1, 0, -2), (-1, 0, -2)), 344 | ((-2, 0, +1), (+2, 0, -1), (-2, 0, -1), 345 | (-2, 0, +1), (+2, 0, +1), (+2, 0, -1)), 346 | ((+1, 0, +2), (-1, 0, -2), (-1, 0, +2), 347 | (+1, 0, +2), (+1, 0, -2), (-1, 0, -2)), 348 | ((+2, 0, -1), (-2, 0, +1), (+2, 0, +1), 349 | (+2, 0, -1), (-2, 0, -1), (-2, 0, +1)) 350 | ); 351 | uvs: array[0..7,0..5,0..1] of Single = ( 352 | ((0, 0), (1, 1), (0, 1), (0, 0), (1, 0), (1, 1)), 353 | ((1, 0), (0, 1), (0, 0), (1, 0), (1, 1), (0, 1)), 354 | ((1, 0), (0, 1), (0, 0), (1, 0), (1, 1), (0, 1)), 355 | ((0, 0), (1, 0), (1, 1), (0, 0), (1, 1), (0, 1)), 356 | ((0, 0), (1, 0), (1, 1), (0, 0), (1, 1), (0, 1)), 357 | ((0, 1), (1, 0), (1, 1), (0, 1), (0, 0), (1, 0)), 358 | ((0, 1), (1, 0), (1, 1), (0, 1), (0, 0), (1, 0)), 359 | ((0, 1), (1, 0), (1, 1), (0, 1), (0, 0), (1, 0)) 360 | ); 361 | offsets: array[0..7,0..2] of single= ( 362 | (-1, 0, 0), (+1, 0, 0), (0, 0, -1), (0, 0, +1), 363 | (0, +1, 0), (0, +1, 0), (0, +1, 0), (0, +1, 0) 364 | ); 365 | var 366 | d: pSingle; 367 | s: Single; 368 | pu: Single; 369 | pv: Single; 370 | u1, v1, u2, v2: Single; 371 | p: Single; 372 | w: Integer; 373 | du, dv: Single; 374 | i: Integer; 375 | begin 376 | d := data; 377 | s := 0.0625; 378 | pu := s / 5; 379 | pv := s / 2.5; 380 | u1 := pu; 381 | v1 := pv; 382 | u2 := s - pu; 383 | v2 := s * 2 - pv; 384 | p := 0.5; 385 | w := Ord(c) - 32; 386 | du := (w mod 16) * s; 387 | dv := 1 - (w div 16 + 1) * s * 2; 388 | x := x + p * offsets[face][0]; 389 | y := y + p * offsets[face][1]; 390 | z := z + p * offsets[face][2]; 391 | for i := 0 to 5 do 392 | begin 393 | d^ := x + n * positions[face][i][0]; Inc(d); 394 | d^ := y + n * positions[face][i][1]; Inc(d); 395 | d^ := z + n * positions[face][i][2]; Inc(d); 396 | if uvs[face][i][0] <> 0 then 397 | d^ := du + u2 398 | else 399 | d^ := du + u1; 400 | Inc(d); 401 | if uvs[face][i][1] <> 0 then 402 | d^ := dv + v2 403 | else 404 | d^ := dv + v1; 405 | Inc(d); 406 | end; 407 | end; 408 | 409 | function _make_sphere( 410 | data: PSingle; r: Single; detail: Integer; 411 | a, b, c, ta, tb, tc: PSingle): Integer; 412 | var 413 | d: PSingle; 414 | ab, ac, bc: array[0..2] of Single; 415 | i: Integer; 416 | tab, tac, tbc: array[0..1] of Single; 417 | n: Integer; 418 | begin 419 | if (detail = 0) then 420 | begin 421 | d := data; 422 | d^ := a[0] * r; Inc(d); 423 | d^ := a[1] * r; Inc(d); 424 | d^ := a[2] * r; Inc(d); 425 | 426 | d^ := a[0]; Inc(d); 427 | d^ := a[1]; Inc(d); 428 | d^ := a[2]; Inc(d); 429 | 430 | d^ := ta[0]; Inc(d); 431 | d^ := ta[1]; Inc(d); 432 | 433 | d^ := b[0] * r; Inc(d); 434 | d^ := b[1] * r; Inc(d); 435 | d^ := b[2] * r; Inc(d); 436 | 437 | d^ := b[0]; Inc(d); 438 | d^ := b[1]; Inc(d); 439 | d^ := b[2]; Inc(d); 440 | 441 | d^ := tb[0]; Inc(d); 442 | d^ := tb[1]; Inc(d); 443 | 444 | d^ := c[0] * r; Inc(d); 445 | d^ := c[1] * r; Inc(d); 446 | d^ := c[2] * r; Inc(d); 447 | 448 | d^ := c[0]; Inc(d); 449 | d^ := c[1]; Inc(d); 450 | d^ := c[2]; Inc(d); 451 | 452 | d^ := tc[0]; Inc(d); 453 | d^ := tc[1]; Inc(d); 454 | Exit(1); 455 | end; 456 | for i := 0 to 2 do 457 | begin 458 | ab[i] := (a[i] + b[i]) / 2; 459 | ac[i] := (a[i] + c[i]) / 2; 460 | bc[i] := (b[i] + c[i]) / 2; 461 | end; 462 | normalize(ab[0], ab[1], ab[2]); 463 | normalize(ac[0], ac[1], ac[2]); 464 | normalize(bc[0], bc[1], bc[2]); 465 | tab[0] := 0; tab[1] := 1 - arccos(ab[1]) / PI; 466 | tac[0] := 0; tac[1] := 1 - arccos(ac[1]) / PI; 467 | tbc[0] := 0; tbc[1] := 1 - arccos(bc[1]) / PI; 468 | Result := 0; 469 | n := _make_sphere(data, r, detail - 1, a, @ab, @ac, ta, @tab, @tac); 470 | Inc(result, n); Inc(data, n * 24); 471 | n := _make_sphere(data, r, detail - 1, b, @bc, @ab, tb, @tbc, @tab); 472 | Inc(Result, n); Inc(data, n * 24); 473 | n := _make_sphere(data, r, detail - 1, c, @ac, @bc, tc, @tac, @tbc); 474 | Inc(Result, n); Inc(data, n * 24); 475 | n := _make_sphere(data, r, detail - 1, @ab, @bc, @ac, @tab, @tbc, @tac); 476 | Inc(Result, n); Inc(data, n * 24); 477 | end; 478 | 479 | procedure make_sphere(data: PSingle; r: Single; detail: Integer); 480 | // detail, triangles, floats 481 | // 0, 8, 192 482 | // 1, 32, 768 483 | // 2, 128, 3072 484 | // 3, 512, 12288 485 | // 4, 2048, 49152 486 | // 5, 8192, 196608 487 | // 6, 32768, 786432 488 | // 7, 131072, 3145728 489 | const 490 | indices: array[0..7, 0..2] of Integer = ( 491 | (4, 3, 0), (1, 4, 0), 492 | (3, 4, 5), (4, 1, 5), 493 | (0, 3, 2), (0, 2, 1), 494 | (5, 2, 3), (5, 1, 2) 495 | ); 496 | positions: array[0..5, 0..2] of Single = ( 497 | ( 0, 0,-1), ( 1, 0, 0), 498 | ( 0,-1, 0), (-1, 0, 0), 499 | ( 0, 1, 0), ( 0, 0, 1) 500 | ); 501 | uvs: array[0..5, 0..1] of Single = ( 502 | (0, 0.5), (0, 0.5), 503 | (0, 0), (0, 0.5), 504 | (0, 1), (0, 0.5) 505 | ); 506 | var 507 | total: Integer; 508 | i, n : Integer; 509 | begin 510 | total := 0; 511 | for i := 0 to 7 do 512 | begin 513 | n := _make_sphere( 514 | data, r, detail, 515 | @positions[indices[i][0]], 516 | @positions[indices[i][1]], 517 | @positions[indices[i][2]], 518 | @uvs[indices[i][0]], 519 | @uvs[indices[i][1]], 520 | @uvs[indices[i][2]] 521 | ); 522 | Inc(total, n); 523 | Inc(data, n * 24); 524 | end; 525 | end; 526 | 527 | end. 528 | -------------------------------------------------------------------------------- /src/Craft.Item.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Item; 2 | 3 | interface 4 | 5 | const 6 | EMPTY =0; 7 | GRASS =1; 8 | SAND =2; 9 | STONE =3; 10 | BRICK =4; 11 | WOOD =5; 12 | CEMENT =6; 13 | DIRT =7; 14 | PLANK =8; 15 | SNOW =9; 16 | GLASS =10; 17 | COBBLE =11; 18 | LIGHT_STONE =12; 19 | DARK_STONE =13; 20 | CHEST =14; 21 | LEAVES =15; 22 | CLOUD =16; 23 | TALL_GRASS =17; 24 | YELLOW_FLOWER =18; 25 | RED_FLOWER =19; 26 | PURPLE_FLOWER =20; 27 | SUN_FLOWER =21; 28 | WHITE_FLOWER =22; 29 | BLUE_FLOWER =23; 30 | COLOR_00 =32; 31 | COLOR_01 =33; 32 | COLOR_02 =34; 33 | COLOR_03 =35; 34 | COLOR_04 =36; 35 | COLOR_05 =37; 36 | COLOR_06 =38; 37 | COLOR_07 =39; 38 | COLOR_08 =40; 39 | COLOR_09 =41; 40 | COLOR_10 =42; 41 | COLOR_11 =43; 42 | COLOR_12 =44; 43 | COLOR_13 =45; 44 | COLOR_14 =46; 45 | COLOR_15 =47; 46 | COLOR_16 =48; 47 | COLOR_17 =49; 48 | COLOR_18 =50; 49 | COLOR_19 =51; 50 | COLOR_20 =52; 51 | COLOR_21 =53; 52 | COLOR_22 =54; 53 | COLOR_23 =55; 54 | COLOR_24 =56; 55 | COLOR_25 =57; 56 | COLOR_26 =58; 57 | COLOR_27 =59; 58 | COLOR_28 =60; 59 | COLOR_29 =61; 60 | COLOR_30 =62; 61 | COLOR_31 =63; 62 | 63 | 64 | const 65 | items: array[0..53] of Integer = ( 66 | // items the user can build 67 | GRASS, 68 | SAND, 69 | STONE, 70 | BRICK, 71 | WOOD, 72 | CEMENT, 73 | DIRT, 74 | PLANK, 75 | SNOW, 76 | GLASS, 77 | COBBLE, 78 | LIGHT_STONE, 79 | DARK_STONE, 80 | CHEST, 81 | LEAVES, 82 | TALL_GRASS, 83 | YELLOW_FLOWER, 84 | RED_FLOWER, 85 | PURPLE_FLOWER, 86 | SUN_FLOWER, 87 | WHITE_FLOWER, 88 | BLUE_FLOWER, 89 | COLOR_00, 90 | COLOR_01, 91 | COLOR_02, 92 | COLOR_03, 93 | COLOR_04, 94 | COLOR_05, 95 | COLOR_06, 96 | COLOR_07, 97 | COLOR_08, 98 | COLOR_09, 99 | COLOR_10, 100 | COLOR_11, 101 | COLOR_12, 102 | COLOR_13, 103 | COLOR_14, 104 | COLOR_15, 105 | COLOR_16, 106 | COLOR_17, 107 | COLOR_18, 108 | COLOR_19, 109 | COLOR_20, 110 | COLOR_21, 111 | COLOR_22, 112 | COLOR_23, 113 | COLOR_24, 114 | COLOR_25, 115 | COLOR_26, 116 | COLOR_27, 117 | COLOR_28, 118 | COLOR_29, 119 | COLOR_30, 120 | COLOR_31 121 | ); 122 | item_count = Length(items); 123 | 124 | blocks: array[0..63, 0..5] of Integer = ( 125 | // w => (left, right, top, bottom, front, back) tiles 126 | (0, 0, 0, 0, 0, 0), // 0 - empty 127 | (16, 16, 32, 0, 16, 16), // 1 - grass 128 | (1, 1, 1, 1, 1, 1), // 2 - sand 129 | (2, 2, 2, 2, 2, 2), // 3 - stone 130 | (3, 3, 3, 3, 3, 3), // 4 - brick 131 | (20, 20, 36, 4, 20, 20), // 5 - wood 132 | (5, 5, 5, 5, 5, 5), // 6 - cement 133 | (6, 6, 6, 6, 6, 6), // 7 - dirt 134 | (7, 7, 7, 7, 7, 7), // 8 - plank 135 | (24, 24, 40, 8, 24, 24), // 9 - snow 136 | (9, 9, 9, 9, 9, 9), // 10 - glass 137 | (10, 10, 10, 10, 10, 10), // 11 - cobble 138 | (11, 11, 11, 11, 11, 11), // 12 - light stone 139 | (12, 12, 12, 12, 12, 12), // 13 - dark stone 140 | (13, 13, 13, 13, 13, 13), // 14 - chest 141 | (14, 14, 14, 14, 14, 14), // 15 - leaves 142 | (15, 15, 15, 15, 15, 15), // 16 - cloud 143 | (0, 0, 0, 0, 0, 0), // 17 144 | (0, 0, 0, 0, 0, 0), // 18 145 | (0, 0, 0, 0, 0, 0), // 19 146 | (0, 0, 0, 0, 0, 0), // 20 147 | (0, 0, 0, 0, 0, 0), // 21 148 | (0, 0, 0, 0, 0, 0), // 22 149 | (0, 0, 0, 0, 0, 0), // 23 150 | (0, 0, 0, 0, 0, 0), // 24 151 | (0, 0, 0, 0, 0, 0), // 25 152 | (0, 0, 0, 0, 0, 0), // 26 153 | (0, 0, 0, 0, 0, 0), // 27 154 | (0, 0, 0, 0, 0, 0), // 28 155 | (0, 0, 0, 0, 0, 0), // 29 156 | (0, 0, 0, 0, 0, 0), // 30 157 | (0, 0, 0, 0, 0, 0), // 31 158 | (176, 176, 176, 176, 176, 176), // 32 159 | (177, 177, 177, 177, 177, 177), // 33 160 | (178, 178, 178, 178, 178, 178), // 34 161 | (179, 179, 179, 179, 179, 179), // 35 162 | (180, 180, 180, 180, 180, 180), // 36 163 | (181, 181, 181, 181, 181, 181), // 37 164 | (182, 182, 182, 182, 182, 182), // 38 165 | (183, 183, 183, 183, 183, 183), // 39 166 | (184, 184, 184, 184, 184, 184), // 40 167 | (185, 185, 185, 185, 185, 185), // 41 168 | (186, 186, 186, 186, 186, 186), // 42 169 | (187, 187, 187, 187, 187, 187), // 43 170 | (188, 188, 188, 188, 188, 188), // 44 171 | (189, 189, 189, 189, 189, 189), // 45 172 | (190, 190, 190, 190, 190, 190), // 46 173 | (191, 191, 191, 191, 191, 191), // 47 174 | (192, 192, 192, 192, 192, 192), // 48 175 | (193, 193, 193, 193, 193, 193), // 49 176 | (194, 194, 194, 194, 194, 194), // 50 177 | (195, 195, 195, 195, 195, 195), // 51 178 | (196, 196, 196, 196, 196, 196), // 52 179 | (197, 197, 197, 197, 197, 197), // 53 180 | (198, 198, 198, 198, 198, 198), // 54 181 | (199, 199, 199, 199, 199, 199), // 55 182 | (200, 200, 200, 200, 200, 200), // 56 183 | (201, 201, 201, 201, 201, 201), // 57 184 | (202, 202, 202, 202, 202, 202), // 58 185 | (203, 203, 203, 203, 203, 203), // 59 186 | (204, 204, 204, 204, 204, 204), // 60 187 | (205, 205, 205, 205, 205, 205), // 61 188 | (206, 206, 206, 206, 206, 206), // 62 189 | (207, 207, 207, 207, 207, 207) // 63 190 | ); 191 | 192 | var 193 | plants: array[17..23] of Integer = ( 194 | 48, // 17 - tall grass 195 | 49, // 18 - yellow flower 196 | 50, // 19 - red flower 197 | 51, // 20 - purple flower 198 | 52, // 21 - sun flower 199 | 53, // 22 - white flower 200 | 54 // 23 - blue flower 201 | ); 202 | 203 | 204 | function is_plant(w: Integer): Boolean; 205 | function is_obstacle(w: Integer): Boolean; 206 | function is_transparent(w: Integer): Boolean; 207 | function is_destructable(w: Integer): Boolean; 208 | 209 | implementation 210 | 211 | function is_plant(w: Integer): Boolean; 212 | begin 213 | case (w) of 214 | TALL_GRASS, 215 | YELLOW_FLOWER, 216 | RED_FLOWER, 217 | PURPLE_FLOWER, 218 | SUN_FLOWER, 219 | WHITE_FLOWER, 220 | BLUE_FLOWER: 221 | Result := True; 222 | else 223 | Result := False; 224 | end; 225 | end; 226 | 227 | function is_obstacle(w: Integer): Boolean; 228 | begin 229 | w := ABS(w); 230 | if (is_plant(w)) then begin 231 | Exit(False); 232 | end; 233 | case (w) of 234 | EMPTY, 235 | CLOUD: 236 | Exit(False); 237 | else 238 | Exit(True); 239 | end; 240 | end; 241 | 242 | function is_transparent(w: Integer): Boolean; 243 | begin 244 | if (w = EMPTY) then begin 245 | Exit(True); 246 | end; 247 | w := ABS(w); 248 | if (is_plant(w)) then begin 249 | Exit(True); 250 | end; 251 | case (w) of 252 | EMPTY, 253 | GLASS, 254 | LEAVES: 255 | Result := True; 256 | else 257 | Result := False; 258 | end; 259 | end; 260 | 261 | function is_destructable(w: Integer): Boolean; 262 | begin 263 | case (w) of 264 | EMPTY, 265 | CLOUD: 266 | Exit(False); 267 | else 268 | Exit(True); 269 | end; 270 | end; 271 | 272 | end. 273 | -------------------------------------------------------------------------------- /src/Craft.Map.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Map; 2 | 3 | interface 4 | {$POINTERMATH ON} 5 | type 6 | TMapEntry = packed record 7 | case boolean of 8 | false: (value: Cardinal); 9 | true : ( 10 | e: record 11 | x: Byte; 12 | y: Byte; 13 | z: Byte; 14 | w: ShortInt; 15 | end 16 | ); 17 | end; 18 | pMapEntry = ^TMapEntry; 19 | 20 | TMap = record 21 | dx : Integer; 22 | dy : Integer; 23 | dz : Integer; 24 | mask : Cardinal; 25 | size : Cardinal; 26 | data : pMapEntry; 27 | end; 28 | pMap = ^TMap; 29 | 30 | TMapForEach = reference to procedure(ex, ey, ez, ew: Integer); 31 | 32 | procedure MAP_FOR_EACH(map: pMap; proc: TMapForEach); 33 | 34 | procedure map_alloc(var map: TMap; dx, dy, dz, mask: Integer); 35 | procedure map_free(var map: TMap); 36 | procedure map_copy(dst, src: pMap); 37 | function map_set(map: pMap; x, y, z, w: Integer): Integer; 38 | function map_get(map: pMap; x, y, z: Integer): Integer; 39 | procedure map_grow(map: pMap); 40 | 41 | implementation 42 | 43 | // #define EMPTY_ENTRY(entry) ((entry)->value == 0) 44 | function EMPTY_ENTRY(entry: pMapEntry): Boolean; inline; 45 | begin 46 | Result := entry.value = 0; 47 | end; 48 | 49 | //#define MAP_FOR_EACH(map, ex, ey, ez, ew) \ 50 | // for (unsigned int i = 0; i <= map->mask; i++) { \ 51 | // MapEntry *entry = map->data + i; \ 52 | // if (EMPTY_ENTRY(entry)) { \ 53 | // continue; \ 54 | // } \ 55 | // int ex = entry->e.x + map->dx; \ 56 | // int ey = entry->e.y + map->dy; \ 57 | // int ez = entry->e.z + map->dz; \ 58 | // int ew = entry->e.w; 59 | // 60 | //#define END_MAP_FOR_EACH } 61 | 62 | procedure MAP_FOR_EACH(map: pMap; proc: TMapForEach); 63 | var 64 | i: Cardinal; 65 | entry: pMapEntry; 66 | ex, ey, ez, ew: Integer; 67 | begin 68 | for i := 0 to map.mask do 69 | begin 70 | entry := @map.data[i]; 71 | if EMPTY_ENTRY(entry) then 72 | begin 73 | Continue; 74 | end; 75 | ex := entry.e.x + map.dx; 76 | ey := entry.e.y + map.dy; 77 | ez := entry.e.z + map.dz; 78 | ew := entry.e.w; 79 | proc(ex, ey, ez, ew); 80 | end; 81 | end; 82 | 83 | function sar(i, bits: Integer): Integer; inline; 84 | begin 85 | if i < 0 then 86 | Result := not ((not i) shr bits) 87 | else 88 | result := i shr bits; 89 | end; 90 | 91 | function hash_int(key: Integer): Integer; 92 | begin 93 | key := not key + (key shl 15); 94 | key := key xor sar(key, 12); 95 | key := key + (key shl 2); 96 | key := key xor sar(key, 4); 97 | {$IFOPT Q+}{$DEFINE QP}{$Q-}{$ENDIF} 98 | key := key * 2057; 99 | {$IFDEF QP}{$Q+}{$ENDIF} 100 | key := key xor sar(key, 16); 101 | Result := key; 102 | end; 103 | 104 | function hash(x, y, z: Integer): Integer; 105 | begin 106 | x := hash_int(x); 107 | y := hash_int(y); 108 | z := hash_int(z); 109 | Result := x xor y xor z; 110 | end; 111 | 112 | procedure map_alloc(var map: TMap; dx, dy, dz, mask: Integer); 113 | begin 114 | map.dx := dx; 115 | map.dy := dy; 116 | map.dz := dz; 117 | map.mask := mask; 118 | map.size := 0; 119 | map.data := pMapEntry(AllocMem((map.mask + 1) * sizeof(TMapEntry))); 120 | end; 121 | 122 | procedure map_free(var map: TMap); 123 | begin 124 | FreeMem(map.data); 125 | end; 126 | 127 | procedure map_copy(dst, src: pMap); 128 | begin 129 | dst.dx := src.dx; 130 | dst.dy := src.dy; 131 | dst.dz := src.dz; 132 | dst.mask := src.mask; 133 | dst.size := src.size; 134 | dst.data := pMapEntry(AllocMem((dst.mask + 1) * sizeof(TMapEntry))); 135 | Move(src.data^, dst.data^, (dst.mask + 1) * sizeof(TMapEntry)); 136 | end; 137 | 138 | function map_set(map: pMap; x, y, z, w: Integer): Integer; 139 | var 140 | index: Cardinal; 141 | entry: pMapEntry; 142 | overwrite: Integer; 143 | begin 144 | index := hash(x, y, z) and map.mask; 145 | Dec(x, map.dx); 146 | Dec(y, map.dy); 147 | Dec(z, map.dz); 148 | entry := @map.data[index]; 149 | overwrite := 0; 150 | while (not EMPTY_ENTRY(entry)) do begin 151 | if (entry.e.x = x) and (entry.e.y = y) and (entry.e.z = z) then begin 152 | overwrite := 1; 153 | break; 154 | end; 155 | index := (index + 1) and map.mask; 156 | entry := @map.data[index]; 157 | end; 158 | if (overwrite <> 0) then begin 159 | if (entry.e.w <> w) then begin 160 | entry.e.w := w; 161 | Exit(1); 162 | end; 163 | end 164 | else if (w <> 0) then begin 165 | entry.e.x := x; 166 | entry.e.y := y; 167 | entry.e.z := z; 168 | entry.e.w := w; 169 | Inc(map.size); 170 | if (map.size * 2 > map.mask) then begin 171 | map_grow(map); 172 | end; 173 | Exit(1); 174 | end; 175 | Result := 0; 176 | end; 177 | 178 | function map_get(map: pMap; x, y, z: Integer): Integer; 179 | var 180 | index: Cardinal; 181 | entry: pMapEntry; 182 | begin 183 | index := hash(x, y, z) and map.mask; 184 | Dec(x, map.dx); 185 | Dec(y, map.dy); 186 | Dec(z, map.dz); 187 | if (x < 0) or (x > 255) then Exit(0); 188 | if (y < 0) or (y > 255) then Exit(0); 189 | if (z < 0) or (z > 255) then Exit(0); 190 | entry := @map.data[index]; 191 | while (EMPTY_ENTRY(entry) = False) do begin 192 | if (entry.e.x = x) and (entry.e.y = y) and (entry.e.z = z) then begin 193 | Exit(entry.e.w); 194 | end; 195 | index := (index + 1) and map.mask; 196 | entry := @map.data[index]; 197 | end; 198 | Result := 0; 199 | end; 200 | 201 | procedure map_grow(map: pMap); 202 | var 203 | new_map: TMap; 204 | begin 205 | new_map.dx := map.dx; 206 | new_map.dy := map.dy; 207 | new_map.dz := map.dz; 208 | new_map.mask := (map.mask shl 1) or 1; 209 | new_map.size := 0; 210 | // new_map.data := (MapEntry *)calloc(new_map.mask + 1, sizeof(MapEntry)); 211 | new_map.data := AllocMem((new_map.mask + 1) * SizeOf(TMapEntry)); 212 | MAP_FOR_EACH(map, procedure (ex, ey, ez, ew: Integer) 213 | begin 214 | map_set(@new_map, ex, ey, ez, ew); 215 | end);// END_MAP_FOR_EACH; 216 | freemem(map.data); 217 | map.mask := new_map.mask; 218 | map.size := new_map.size; 219 | map.data := new_map.data; 220 | end; 221 | 222 | initialization 223 | Assert(SizeOf(TMapEntry) = SizeOf(Cardinal)); 224 | end. 225 | -------------------------------------------------------------------------------- /src/Craft.Matrix.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Matrix; 2 | 3 | interface 4 | 5 | uses 6 | System.Math; 7 | 8 | type 9 | TPlanes = array[0..5, 0..3] of Single; 10 | 11 | procedure normalize(var x, y, z: Single); 12 | procedure mat_identity(matrix: PSingle); 13 | procedure mat_translate(matrix: PSingle; dx, dy, dz: Single); 14 | procedure mat_rotate(matrix: PSingle; x, y, z, angle: Single); 15 | procedure mat_multiply(matrix, a, b: PSingle); 16 | procedure mat_apply(data, matrix: PSingle; count, offset, stride: Integer); 17 | procedure frustum_planes(var planes: TPlanes; radius: Integer; matrix: PSingle); 18 | 19 | procedure set_matrix_2d(matrix: PSingle; width, height: Integer); 20 | 21 | procedure set_matrix_3d( 22 | matrix: PSingle; width, height: Integer; 23 | x, y, z, rx, ry, fov: Single; 24 | ortho, radius: Integer); 25 | 26 | procedure set_matrix_item(matrix: PSingle; width, height, scale: Integer); 27 | 28 | implementation 29 | {$POINTERMATH ON} 30 | 31 | procedure normalize(var x, y, z: Single); 32 | var 33 | d: Single; 34 | begin 35 | d := sqrt(x * x + y * y + z * z); 36 | x := x/d; 37 | y := y/d; 38 | z := z/d; 39 | end; 40 | 41 | procedure mat_identity(matrix: PSingle); 42 | begin 43 | matrix[0] := 1; 44 | matrix[1] := 0; 45 | matrix[2] := 0; 46 | matrix[3] := 0; 47 | matrix[4] := 0; 48 | matrix[5] := 1; 49 | matrix[6] := 0; 50 | matrix[7] := 0; 51 | matrix[8] := 0; 52 | matrix[9] := 0; 53 | matrix[10] := 1; 54 | matrix[11] := 0; 55 | matrix[12] := 0; 56 | matrix[13] := 0; 57 | matrix[14] := 0; 58 | matrix[15] := 1; 59 | end; 60 | 61 | procedure mat_translate(matrix: PSingle; dx, dy, dz: Single); 62 | begin 63 | matrix[0] := 1; 64 | matrix[1] := 0; 65 | matrix[2] := 0; 66 | matrix[3] := 0; 67 | matrix[4] := 0; 68 | matrix[5] := 1; 69 | matrix[6] := 0; 70 | matrix[7] := 0; 71 | matrix[8] := 0; 72 | matrix[9] := 0; 73 | matrix[10] := 1; 74 | matrix[11] := 0; 75 | matrix[12] := dx; 76 | matrix[13] := dy; 77 | matrix[14] := dz; 78 | matrix[15] := 1; 79 | end; 80 | 81 | procedure mat_rotate(matrix: PSingle; x, y, z, angle: Single); 82 | var 83 | s, c: Single; 84 | m: Single; 85 | begin 86 | normalize(x, y, z); 87 | s := sin(angle); 88 | c := cos(angle); 89 | m := 1 - c; 90 | matrix[0] := m * x * x + c; 91 | matrix[1] := m * x * y - z * s; 92 | matrix[2] := m * z * x + y * s; 93 | matrix[3] := 0; 94 | matrix[4] := m * x * y + z * s; 95 | matrix[5] := m * y * y + c; 96 | matrix[6] := m * y * z - x * s; 97 | matrix[7] := 0; 98 | matrix[8] := m * z * x - y * s; 99 | matrix[9] := m * y * z + x * s; 100 | matrix[10] := m * z * z + c; 101 | matrix[11] := 0; 102 | matrix[12] := 0; 103 | matrix[13] := 0; 104 | matrix[14] := 0; 105 | matrix[15] := 1; 106 | end; 107 | 108 | procedure mat_vec_multiply(vector, a, b: PSingle); 109 | var 110 | result: array[0..3] of Single; 111 | i: Integer; 112 | total: Single; 113 | j: Integer; 114 | p, q: Integer; 115 | begin 116 | for i := 0 to 3 do begin 117 | total := 0; 118 | for j := 0 to 3 do begin 119 | p := j * 4 + i; 120 | q := j; 121 | total := total + a[p] * b[q]; 122 | end; 123 | result[i] := total; 124 | end; 125 | for i := 0 to 3 do begin 126 | vector[i] := result[i]; 127 | end; 128 | end; 129 | 130 | procedure mat_multiply(matrix, a, b: PSingle); 131 | var 132 | result: array[0..15] of Single; 133 | c, r: Integer; 134 | index: Integer; 135 | total: Single; 136 | i,p,q: Integer; 137 | begin 138 | for c := 0 to 3 do 139 | begin 140 | for r := 0 to 3 do 141 | begin 142 | index := c * 4 + r; 143 | total := 0; 144 | for i := 0 to 3 do 145 | begin 146 | p := i * 4 + r; 147 | q := c * 4 + i; 148 | total := total + a[p] * b[q]; 149 | end; 150 | result[index] := total; 151 | end; 152 | end; 153 | for i := 0 to 15 do 154 | begin 155 | matrix[i] := result[i]; 156 | end; 157 | end; 158 | 159 | procedure mat_apply(data, matrix: PSingle; count, offset, stride: Integer); 160 | var 161 | vec: array[0..3] of Single; 162 | i: Integer; 163 | d: PSingle; 164 | begin 165 | vec[3] := 1; 166 | for i := 0 to count - 1 do begin 167 | d := @data[offset + stride * i]; 168 | vec[0] := d^; Inc(d); vec[1] := d^; Inc(d); vec[2] := d^; 169 | mat_vec_multiply(@vec, matrix, @vec); 170 | d := @data[offset + stride * i]; 171 | d^ := vec[0]; Inc(d); d^ := vec[1]; Inc(d); d^ := vec[2]; 172 | end; 173 | end; 174 | 175 | procedure frustum_planes(var planes: TPlanes; radius: Integer; matrix: PSingle); 176 | var 177 | znear, zfar: Single; 178 | m: PSingle; 179 | begin 180 | znear := 0.125; 181 | zfar := radius * 32 + 64; 182 | m := matrix; 183 | planes[0][0] := m[3] + m[0]; 184 | planes[0][1] := m[7] + m[4]; 185 | planes[0][2] := m[11] + m[8]; 186 | planes[0][3] := m[15] + m[12]; 187 | planes[1][0] := m[3] - m[0]; 188 | planes[1][1] := m[7] - m[4]; 189 | planes[1][2] := m[11] - m[8]; 190 | planes[1][3] := m[15] - m[12]; 191 | planes[2][0] := m[3] + m[1]; 192 | planes[2][1] := m[7] + m[5]; 193 | planes[2][2] := m[11] + m[9]; 194 | planes[2][3] := m[15] + m[13]; 195 | planes[3][0] := m[3] - m[1]; 196 | planes[3][1] := m[7] - m[5]; 197 | planes[3][2] := m[11] - m[9]; 198 | planes[3][3] := m[15] - m[13]; 199 | planes[4][0] := znear * m[3] + m[2]; 200 | planes[4][1] := znear * m[7] + m[6]; 201 | planes[4][2] := znear * m[11] + m[10]; 202 | planes[4][3] := znear * m[15] + m[14]; 203 | planes[5][0] := zfar * m[3] - m[2]; 204 | planes[5][1] := zfar * m[7] - m[6]; 205 | planes[5][2] := zfar * m[11] - m[10]; 206 | planes[5][3] := zfar * m[15] - m[14]; 207 | end; 208 | 209 | procedure mat_frustum( 210 | matrix: PSingle; left, right, bottom, 211 | top, znear, zfar: Single); 212 | var 213 | temp, temp2, temp3, temp4: Single; 214 | begin 215 | temp := 2.0 * znear; 216 | temp2 := right - left; 217 | temp3 := top - bottom; 218 | temp4 := zfar - znear; 219 | matrix[0] := temp / temp2; 220 | matrix[1] := 0.0; 221 | matrix[2] := 0.0; 222 | matrix[3] := 0.0; 223 | matrix[4] := 0.0; 224 | matrix[5] := temp / temp3; 225 | matrix[6] := 0.0; 226 | matrix[7] := 0.0; 227 | matrix[8] := (right + left) / temp2; 228 | matrix[9] := (top + bottom) / temp3; 229 | matrix[10] := (-zfar - znear) / temp4; 230 | matrix[11] := -1.0; 231 | matrix[12] := 0.0; 232 | matrix[13] := 0.0; 233 | matrix[14] := (-temp * zfar) / temp4; 234 | matrix[15] := 0.0; 235 | end; 236 | 237 | procedure mat_perspective( 238 | matrix: PSingle; fov, aspect, 239 | znear, zfar: Single); 240 | var 241 | ymax, xmax: Single; 242 | begin 243 | ymax := znear * tan(fov * PI / 360.0); 244 | xmax := ymax * aspect; 245 | mat_frustum(matrix, -xmax, xmax, -ymax, ymax, znear, zfar); 246 | end; 247 | 248 | procedure mat_ortho( 249 | matrix: PSingle; 250 | left, right, bottom, top, &near, &far: Single); 251 | begin 252 | matrix[0] := 2 / (right - left); 253 | matrix[1] := 0; 254 | matrix[2] := 0; 255 | matrix[3] := 0; 256 | matrix[4] := 0; 257 | matrix[5] := 2 / (top - bottom); 258 | matrix[6] := 0; 259 | matrix[7] := 0; 260 | matrix[8] := 0; 261 | matrix[9] := 0; 262 | matrix[10] := -2 / (&far - &near); 263 | matrix[11] := 0; 264 | matrix[12] := -(right + left) / (right - left); 265 | matrix[13] := -(top + bottom) / (top - bottom); 266 | matrix[14] := -(&far + &near) / (&far - &near); 267 | matrix[15] := 1; 268 | end; 269 | 270 | procedure set_matrix_2d(matrix: PSingle; width, height: Integer); 271 | begin 272 | mat_ortho(matrix, 0, width, 0, height, -1, 1); 273 | end; 274 | 275 | procedure set_matrix_3d( 276 | matrix: PSingle; width, height: Integer; 277 | x, y, z, rx, ry, fov: Single; 278 | ortho, radius: Integer); 279 | var 280 | a, b: array[0..15] of Single; 281 | aspect: Single; 282 | znear : Single; 283 | zfar : Single; 284 | size : Integer; 285 | begin 286 | aspect := width / height; 287 | znear := 0.125; 288 | zfar := radius * 32 + 64; 289 | mat_identity(@a); 290 | mat_translate(@b, -x, -y, -z); 291 | mat_multiply(@a, @b, @a); 292 | mat_rotate(@b, cos(rx), 0, sin(rx), ry); 293 | mat_multiply(@a, @b, @a); 294 | mat_rotate(@b, 0, 1, 0, -rx); 295 | mat_multiply(@a, @b, @a); 296 | if (ortho <> 0) then 297 | begin 298 | size := ortho; 299 | mat_ortho(@b, -size * aspect, size * aspect, -size, size, -zfar, zfar); 300 | end else begin 301 | mat_perspective(@b, fov, aspect, znear, zfar); 302 | end; 303 | mat_multiply(@a, @b, @a); 304 | mat_identity(matrix); 305 | mat_multiply(matrix, @a, matrix); 306 | end; 307 | 308 | procedure set_matrix_item(matrix: PSingle; width, height, scale: Integer); 309 | var 310 | a, b: array[0..15] of Single; 311 | aspect, size, box, xoffset, yoffset: Single; 312 | begin 313 | aspect := width / height; 314 | size := 64 * scale; 315 | box := height / size / 2; 316 | xoffset := 1 - size / width * 2; 317 | yoffset := 1 - size / height * 2; 318 | mat_identity(@a); 319 | mat_rotate(@b, 0, 1, 0, -PI / 4); 320 | mat_multiply(@a, @b, @a); 321 | mat_rotate(@b, 1, 0, 0, -PI / 10); 322 | mat_multiply(@a, @b, @a); 323 | mat_ortho(@b, -box * aspect, box * aspect, -box, box, -1, 1); 324 | mat_multiply(@a, @b, @a); 325 | mat_translate(@b, -xoffset, -yoffset, 0); 326 | mat_multiply(@a, @b, @a); 327 | mat_identity(matrix); 328 | mat_multiply(matrix, @a, matrix); 329 | end; 330 | 331 | end. 332 | -------------------------------------------------------------------------------- /src/Craft.Player.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Player; 2 | 3 | interface 4 | 5 | uses 6 | System.Math, 7 | Execute.CrossGL, 8 | Neslib.glfw3, 9 | Craft.Util; 10 | 11 | const 12 | MAX_NAME_LENGTH = 32; 13 | 14 | type 15 | TState = record 16 | x : Single; 17 | y : Single; 18 | z : Single; 19 | rx : Single; 20 | ry : Single; 21 | t : Single; 22 | end; 23 | PState = ^TState; 24 | 25 | TPlayer = record 26 | id : Integer; 27 | name : array[0..MAX_NAME_LENGTH - 1] of AnsiChar; 28 | state : TState; 29 | state1: TState; 30 | state2: TState; 31 | buffer: GLuint; 32 | end; 33 | PPlayer = ^TPlayer; 34 | 35 | function find_player(id: Integer): pPlayer; 36 | procedure update_player(player: pPlayer; 37 | x, y, z, rx, ry: Single; interpolate: Integer); 38 | procedure interpolate_player(player: pPlayer); 39 | function player_crosshair(player: pPlayer): pPlayer; 40 | procedure delete_player(id: Integer); 41 | procedure delete_all_players(); 42 | 43 | implementation 44 | 45 | uses 46 | Craft.Main, 47 | Craft.Render; 48 | 49 | function find_player(id: Integer): pPlayer; 50 | var 51 | i: Integer; 52 | begin 53 | for i := 0 to g.player_count - 1 do begin 54 | Result := @g.players[i]; 55 | if (Result.id = id) then begin 56 | Exit; 57 | end; 58 | end; 59 | Result := nil; 60 | end; 61 | 62 | procedure update_player(player: pPlayer; 63 | x, y, z, rx, ry: Single; interpolate: Integer); 64 | var 65 | s, s1, s2: pState; 66 | begin 67 | if (interpolate <> 0) then begin 68 | s1 := @player.state1; 69 | s2 := @player.state2; 70 | //memcpy(s1, s2, sizeof(State)); 71 | s1^ := s2^; 72 | s2.x := x; s2.y := y; s2.z := z; s2.rx := rx; s2.ry := ry; 73 | s2.t := glfwGetTime(); 74 | if (s2.rx - s1.rx) > PI then begin 75 | s1.rx := s1.rx + 2 * PI; 76 | end; 77 | if (s1.rx - s2.rx) > PI then begin 78 | s1.rx := s1.rx - 2 * PI; 79 | end; 80 | end 81 | else begin 82 | s := @player.state; 83 | s.x := x; s.y := y; s.z := z; s.rx := rx; s.ry := ry; 84 | del_buffer(player.buffer); 85 | player.buffer := gen_player_buffer(s.x, s.y, s.z, s.rx, s.ry); 86 | end; 87 | end; 88 | 89 | procedure interpolate_player(player: pPlayer); 90 | var 91 | s1, s2: pState; 92 | t1, t2, p: Single; 93 | begin 94 | s1 := @player.state1; 95 | s2 := @player.state2; 96 | t1 := s2.t - s1.t; 97 | t2 := glfwGetTime() - s2.t; 98 | t1 := MIN(t1, 1); 99 | t1 := MAX(t1, 0.1); 100 | p := MIN(t2 / t1, 1); 101 | update_player( 102 | player, 103 | s1.x + (s2.x - s1.x) * p, 104 | s1.y + (s2.y - s1.y) * p, 105 | s1.z + (s2.z - s1.z) * p, 106 | s1.rx + (s2.rx - s1.rx) * p, 107 | s1.ry + (s2.ry - s1.ry) * p, 108 | 0); 109 | end; 110 | 111 | procedure delete_player(id: Integer); 112 | var 113 | player: pPlayer; 114 | count: Integer; 115 | other: pPlayer; 116 | begin 117 | player := find_player(id); 118 | if (player = nil) then begin 119 | Exit; 120 | end; 121 | count := g.player_count; 122 | del_buffer(player.buffer); 123 | Dec(count); 124 | other := @g.players[count]; 125 | //memcpy(player, other, sizeof(Player)); 126 | player^ := other^; 127 | g.player_count := count; 128 | end; 129 | 130 | procedure delete_all_players(); 131 | var 132 | i: Integer; 133 | player: pPlayer; 134 | begin 135 | for i := 0 to g.player_count - 1 do begin 136 | player := @g.players[i]; 137 | del_buffer(player.buffer); 138 | end; 139 | g.player_count := 0; 140 | end; 141 | 142 | function player_player_distance(p1, p2: pPlayer): Single; 143 | var 144 | s1, s2: pState; 145 | x, y, z: Single; 146 | begin 147 | s1 := @p1.state; 148 | s2 := @p2.state; 149 | x := s2.x - s1.x; 150 | y := s2.y - s1.y; 151 | z := s2.z - s1.z; 152 | Result := sqrt(x * x + y * y + z * z); 153 | end; 154 | 155 | function player_crosshair_distance(p1, p2: pPlayer): Single; 156 | var 157 | s1, s2: pState; 158 | d, vx, vy, vz: Single; 159 | px, py, pz: Single; 160 | x, y, z: Single; 161 | begin 162 | s1 := @p1.state; 163 | s2 := @p2.state; 164 | d := player_player_distance(p1, p2); 165 | get_sight_vector(s1.rx, s1.ry, &vx, &vy, &vz); 166 | vx := vx * d; vy := vy * d; vz := vz * d; 167 | px := s1.x + vx; py := s1.y + vy; pz := s1.z + vz; 168 | x := s2.x - px; 169 | y := s2.y - py; 170 | z := s2.z - pz; 171 | Result := sqrt(x * x + y * y + z * z); 172 | end; 173 | 174 | function player_crosshair(player: pPlayer): pPlayer; 175 | var 176 | threshold: Single; 177 | best: Single; 178 | i: Integer; 179 | other: pPlayer; 180 | p, d: Single; 181 | begin 182 | result := nil; 183 | threshold := RADIANS(5); 184 | best := 0; 185 | for i := 0 to g.player_count - 1 do begin 186 | other := @g.players[i]; 187 | if (other = player) then begin 188 | continue; 189 | end; 190 | p := player_crosshair_distance(player, other); 191 | d := player_player_distance(player, other); 192 | if (d < 96) and (p / d < threshold) then begin 193 | if (best = 0) or (d < best) then begin 194 | best := d; 195 | result := other; 196 | end; 197 | end; 198 | end; 199 | end; 200 | 201 | end. 202 | -------------------------------------------------------------------------------- /src/Craft.Render.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Render; 2 | { 3 | parts of Craft.main about rendering 4 | } 5 | interface 6 | {$POINTERMATH ON} 7 | uses 8 | System.Math, 9 | Execute.CrossGL, 10 | Execute.SysUtils, 11 | Craft.Config, 12 | Craft.Util, 13 | Craft.Matrix, 14 | Craft.Cube, 15 | Craft.Chunk, 16 | Craft.Item, 17 | Craft.Sign, 18 | Craft.Player; 19 | 20 | type 21 | TAttrib = record 22 | &program : GLuint; 23 | position : GLuint; 24 | normal : GLuint; 25 | uv : GLuint; 26 | matrix : GLuint; 27 | sampler : GLuint; 28 | camera : GLuint; 29 | timer : GLuint; 30 | extra1 : GLuint; 31 | extra2 : GLuint; 32 | extra3 : GLuint; 33 | extra4 : GLuint; 34 | end; 35 | 36 | function gen_crosshair_buffer(): GLuint; 37 | function gen_player_buffer(x, y, z, rx, ry: Single): GLuint; 38 | function gen_sky_buffer: GLuint; 39 | procedure gen_sign_buffer(chunk :pChunk); 40 | 41 | procedure draw_chunk(var attrib: TAttrib; chunk: pChunk); 42 | procedure draw_signs(var attrib: TAttrib; chunk: pChunk); 43 | procedure draw_sign(var attrib: TAttrib; buffer: GLuint; length: Integer); 44 | procedure draw_player(var attrib: TAttrib; player :pPlayer); 45 | 46 | procedure render_sky(var attrib: TAttrib; player: pPlayer; buffer: GLuint); 47 | procedure render_wireframe(var attrib: TAttrib; player: pPlayer); 48 | procedure render_crosshairs(var attrib: TAttrib); 49 | procedure render_item(var attrib: TAttrib); 50 | procedure render_text(var attrib: TAttrib; justify: Integer; x, y, n: Single; text: PAnsiChar); 51 | function render_chunks(var attrib: TAttrib; player: PPlayer): Integer; 52 | procedure render_signs(var attrib: TAttrib; player: pPlayer); 53 | procedure render_sign(var attrib: TAttrib; player: pPlayer); 54 | procedure render_players(var attrib: TAttrib; player: pPlayer); 55 | 56 | implementation 57 | 58 | uses 59 | Craft.Main; 60 | 61 | function gen_crosshair_buffer(): GLuint; 62 | var 63 | x, y, p: Integer; 64 | data: array[0..7] of Single; 65 | begin 66 | x := g.width div 2; 67 | y := g.height div 2; 68 | p := 10 * g.scale; 69 | data[0] := x; 70 | data[1] := y - p; 71 | data[2] := x; 72 | data[3] := y + p; 73 | data[4] := x - p; 74 | data[5] := y; 75 | data[6] := x + p; 76 | data[7] := y; 77 | Result := gen_buffer(sizeof(data), @data); 78 | end; 79 | 80 | function gen_wireframe_buffer(x, y, z, n: Single): GLuint; 81 | var 82 | data: array[0..71] of Single; 83 | begin 84 | make_cube_wireframe(@data, x, y, z, n); 85 | Result := gen_buffer(sizeof(data), @data); 86 | end; 87 | 88 | function gen_sky_buffer: GLuint; 89 | var 90 | data: array[0..12287] of single; 91 | begin 92 | make_sphere(@data, 1, 3); 93 | Result := gen_buffer(SizeOf(data), @data); 94 | end; 95 | 96 | function gen_cube_buffer(x, y, z, n: Single; w: Integer): GLuint; 97 | var 98 | data: pGLfloat; 99 | ao: tfloat_6_4; 100 | const 101 | light: tfloat_6_4 = ( 102 | (0.5, 0.5, 0.5, 0.5), 103 | (0.5, 0.5, 0.5, 0.5), 104 | (0.5, 0.5, 0.5, 0.5), 105 | (0.5, 0.5, 0.5, 0.5), 106 | (0.5, 0.5, 0.5, 0.5), 107 | (0.5, 0.5, 0.5, 0.5) 108 | ); 109 | begin 110 | data := malloc_faces(10, 6); 111 | FillChar(ao, SizeOf(ao), 0); 112 | make_cube(data, ao, light, True, True, True, True, True, True, x, y, z, n, w); 113 | Result := gen_faces(10, 6, data); 114 | end; 115 | 116 | function gen_plant_buffer(x, y, z, n: Single; w: Integer): GLuint; 117 | var 118 | data: pGLfloat; 119 | ao: Single; 120 | light: Single; 121 | begin 122 | data := malloc_faces(10, 4); 123 | ao := 0; 124 | light := 1; 125 | make_plant(data, ao, light, x, y, z, n, w, 45); 126 | Result := gen_faces(10, 4, data); 127 | end; 128 | 129 | function gen_player_buffer(x, y, z, rx, ry: Single): GLuint; 130 | var 131 | data: pGLFloat; 132 | begin 133 | data := malloc_faces(10, 6); 134 | make_player(data, x, y, z, rx, ry); 135 | Result := gen_faces(10, 6, data); 136 | end; 137 | 138 | function gen_text_buffer(x, y, n: Single; text: PAnsiChar): GLuint; 139 | var 140 | length: Integer; 141 | data: pGLFloat; 142 | i: Integer; 143 | begin 144 | length := strlen(text); 145 | data := malloc_faces(4, length); 146 | for i := 0 to length - 1 do begin 147 | make_character(data + i * 24, x, y, n / 2, n, text[i]); 148 | x := x + n; 149 | end; 150 | Result := gen_faces(4, length, data); 151 | end; 152 | 153 | function _gen_sign_buffer( 154 | data: pGLfloat; x, y, z: Single; face: Integer; text: PAnsiChar): Integer; 155 | const 156 | glyph_dx: array[0..7] of Integer = (0, 0, -1, 1, 1, 0, -1, 0); 157 | glyph_dz: array[0..7] of Integer = (1, -1, 0, 0, 0, -1, 0, 1); 158 | line_dx : array[0..7] of Integer = (0, 0, 0, 0, 0, 1, 0, -1); 159 | line_dy : array[0..7] of Integer = (-1, -1, -1, -1, 0, 0, 0, 0); 160 | line_dz : array[0..7] of Integer = (0, 0, 0, 0, 1, 0, -1, 0); 161 | max_width = 64; 162 | var 163 | count: Integer; 164 | line_height: Single; 165 | lines: array[0..1023] of AnsiChar; 166 | rows: Integer; 167 | dx, dz, ldx, ldy, ldz: Integer; 168 | n, sx, sy, sz: Single; 169 | key, line: PAnsiChar; 170 | length: Integer; 171 | line_width: Integer; 172 | rx, ry, rz: Single; 173 | i: Integer; 174 | width: Integer; 175 | begin 176 | if (face < 0) or (face >= 8) then 177 | begin 178 | Exit(0); 179 | end; 180 | count := 0; 181 | line_height := 1.25; 182 | rows := wrap(text, max_width, lines, 1024); 183 | rows := MIN(rows, 5); 184 | dx := glyph_dx[face]; 185 | dz := glyph_dz[face]; 186 | ldx := line_dx[face]; 187 | ldy := line_dy[face]; 188 | ldz := line_dz[face]; 189 | n := 1.0 / (max_width / 10); 190 | sx := x - n * (rows - 1) * (line_height / 2) * ldx; 191 | sy := y - n * (rows - 1) * (line_height / 2) * ldy; 192 | sz := z - n * (rows - 1) * (line_height / 2) * ldz; 193 | line := tokenize(lines, #10, key); 194 | while (line <> nil) do 195 | begin 196 | length := strlen(line); 197 | line_width := string_width(line); 198 | line_width := MIN(line_width, max_width); 199 | rx := sx - dx * line_width / max_width / 2; 200 | ry := sy; 201 | rz := sz - dz * line_width / max_width / 2; 202 | for i := 0 to length - 1 do 203 | begin 204 | width := char_width(line[i]); 205 | Dec(line_width, width); 206 | if (line_width < 0) then 207 | begin 208 | break; 209 | end; 210 | rx := rx + dx * width / max_width / 2; 211 | rz := rz + dz * width / max_width / 2; 212 | if (line[i] <> ' ') then 213 | begin 214 | make_character_3d( 215 | @data[count * 30], rx, ry, rz, n / 2, face, line[i]); 216 | Inc(count); 217 | end; 218 | rx := rx + dx * width / max_width / 2; 219 | rz := rz + dz * width / max_width / 2; 220 | end; 221 | sx := sx + n * line_height * ldx; 222 | sy := sy + n * line_height * ldy; 223 | sz := sz + n * line_height * ldz; 224 | line := tokenize(nil, #10, key); 225 | Dec(rows); 226 | if (rows <= 0) then 227 | begin 228 | break; 229 | end; 230 | end; 231 | Result := count; 232 | end; 233 | 234 | procedure gen_sign_buffer(chunk :pChunk); 235 | var 236 | signs: pSignList; 237 | max_faces: Integer; 238 | i: Integer; 239 | e: pSign; 240 | data: pGLfloat; 241 | faces: Integer; 242 | begin 243 | signs := @chunk.signs; 244 | 245 | if signs.size = 0 then // Execute 246 | Exit; 247 | 248 | // first pass - count characters 249 | max_faces := 0; 250 | for i := 0 to signs.size - 1 do 251 | begin 252 | e := @signs.data[i]; 253 | Inc(max_faces, strlen(e.text)); 254 | end; 255 | 256 | // second pass - generate geometry 257 | data := malloc_faces(5, max_faces); 258 | faces := 0; 259 | for i := 0 to signs.size - 1 do 260 | begin 261 | e := @signs.data[i]; 262 | Inc(faces, _gen_sign_buffer( 263 | @data[faces * 30], e.x, e.y, e.z, e.face, e.text)); 264 | end; 265 | 266 | del_buffer(chunk.sign_buffer); 267 | chunk.sign_buffer := gen_faces(5, faces, data); 268 | chunk.sign_faces := faces; 269 | end; 270 | 271 | procedure draw_triangles_3d_ao(var attrib: TAttrib; buffer: GLuint; count: Integer); 272 | begin 273 | glBindBuffer(GL_ARRAY_BUFFER, buffer); 274 | glEnableVertexAttribArray(attrib.position); 275 | glEnableVertexAttribArray(attrib.normal); 276 | glEnableVertexAttribArray(attrib.uv); 277 | glVertexAttribPointer(attrib.position, 3, GL_FLOAT, GL_FALSE, 278 | sizeof(GLfloat) * 10, Pointer(0)); 279 | glVertexAttribPointer(attrib.normal, 3, GL_FLOAT, GL_FALSE, 280 | sizeof(GLfloat) * 10, Pointer(sizeof(GLfloat) * 3)); 281 | glVertexAttribPointer(attrib.uv, 4, GL_FLOAT, GL_FALSE, 282 | sizeof(GLfloat) * 10, Pointer(sizeof(GLfloat) * 6)); 283 | glDrawArrays(GL_TRIANGLES, 0, count); 284 | glDisableVertexAttribArray(attrib.position); 285 | glDisableVertexAttribArray(attrib.normal); 286 | glDisableVertexAttribArray(attrib.uv); 287 | glBindBuffer(GL_ARRAY_BUFFER, 0); 288 | end; 289 | 290 | procedure draw_triangles_3d_text(var attrib: TAttrib; buffer: GLuint; count: Integer); 291 | begin 292 | glBindBuffer(GL_ARRAY_BUFFER, buffer); 293 | glEnableVertexAttribArray(attrib.position); 294 | glEnableVertexAttribArray(attrib.uv); 295 | glVertexAttribPointer(attrib.position, 3, GL_FLOAT, GL_FALSE, 296 | sizeof(GLfloat) * 5, Pointer(0)); 297 | glVertexAttribPointer(attrib.uv, 2, GL_FLOAT, GL_FALSE, 298 | sizeof(GLfloat) * 5, GLvoid(sizeof(GLfloat) * 3)); 299 | glDrawArrays(GL_TRIANGLES, 0, count); 300 | glDisableVertexAttribArray(attrib.position); 301 | glDisableVertexAttribArray(attrib.uv); 302 | glBindBuffer(GL_ARRAY_BUFFER, 0); 303 | end; 304 | 305 | procedure draw_triangles_3d(var attrib: TAttrib; buffer: GLuint; count: Integer); 306 | begin 307 | glBindBuffer(GL_ARRAY_BUFFER, buffer); 308 | glEnableVertexAttribArray(attrib.position); 309 | glEnableVertexAttribArray(attrib.normal); 310 | glEnableVertexAttribArray(attrib.uv); 311 | glVertexAttribPointer(attrib.position, 3, GL_FLOAT, GL_FALSE, 312 | sizeof(GLfloat) * 8, nil); 313 | glVertexAttribPointer(attrib.normal, 3, GL_FLOAT, GL_FALSE, 314 | sizeof(GLfloat) * 8, GLvoid(sizeof(GLfloat) * 3)); 315 | glVertexAttribPointer(attrib.uv, 2, GL_FLOAT, GL_FALSE, 316 | sizeof(GLfloat) * 8, GLvoid(sizeof(GLfloat) * 6)); 317 | glDrawArrays(GL_TRIANGLES, 0, count); 318 | glDisableVertexAttribArray(attrib.position); 319 | glDisableVertexAttribArray(attrib.normal); 320 | glDisableVertexAttribArray(attrib.uv); 321 | glBindBuffer(GL_ARRAY_BUFFER, 0); 322 | end; 323 | 324 | procedure draw_triangles_2d(var attrib: TAttrib; buffer: GLuint; count: Integer); 325 | begin 326 | glBindBuffer(GL_ARRAY_BUFFER, buffer); 327 | glEnableVertexAttribArray(attrib.position); 328 | glEnableVertexAttribArray(attrib.uv); 329 | glVertexAttribPointer(attrib.position, 2, GL_FLOAT, GL_FALSE, 330 | sizeof(GLfloat) * 4, Pointer(0)); 331 | glVertexAttribPointer(attrib.uv, 2, GL_FLOAT, GL_FALSE, 332 | sizeof(GLfloat) * 4, Pointer(sizeof(GLfloat) * 2)); 333 | glDrawArrays(GL_TRIANGLES, 0, count); 334 | glDisableVertexAttribArray(attrib.position); 335 | glDisableVertexAttribArray(attrib.uv); 336 | glBindBuffer(GL_ARRAY_BUFFER, 0); 337 | end; 338 | 339 | procedure draw_lines(var attrib: TAttrib; buffer: GLuint; components, count: Integer); 340 | begin 341 | glBindBuffer(GL_ARRAY_BUFFER, buffer); 342 | glEnableVertexAttribArray(attrib.position); 343 | glVertexAttribPointer( 344 | attrib.position, components, GL_FLOAT, GL_FALSE, 0, Pointer(0)); 345 | glDrawArrays(GL_LINES, 0, count); 346 | glDisableVertexAttribArray(attrib.position); 347 | glBindBuffer(GL_ARRAY_BUFFER, 0); 348 | end; 349 | 350 | procedure draw_chunk(var attrib: TAttrib; chunk: pChunk); 351 | begin 352 | draw_triangles_3d_ao(attrib, chunk.buffer, chunk.faces * 6); 353 | end; 354 | 355 | procedure draw_item(var attrib: TAttrib; buffer: GLuint; count: Integer); 356 | begin 357 | draw_triangles_3d_ao(attrib, buffer, count); 358 | end; 359 | 360 | procedure draw_text(var attrib: TAttrib; buffer: GLuint; length: Integer); 361 | begin 362 | glEnable(GL_BLEND); 363 | glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); 364 | draw_triangles_2d(attrib, buffer, length * 6); 365 | glDisable(GL_BLEND); 366 | end; 367 | 368 | procedure draw_signs(var attrib: TAttrib; chunk: pChunk); 369 | begin 370 | if chunk.sign_faces > 0 then begin // Execute 371 | glEnable(GL_POLYGON_OFFSET_FILL); 372 | glPolygonOffset(-8, -1024); 373 | draw_triangles_3d_text(attrib, chunk.sign_buffer, chunk.sign_faces * 6); 374 | glDisable(GL_POLYGON_OFFSET_FILL); 375 | end; 376 | end; 377 | 378 | procedure draw_sign(var attrib: TAttrib; buffer: GLuint; length: Integer); 379 | begin 380 | glEnable(GL_POLYGON_OFFSET_FILL); 381 | glPolygonOffset(-8, -1024); 382 | draw_triangles_3d_text(attrib, buffer, length * 6); 383 | glDisable(GL_POLYGON_OFFSET_FILL); 384 | end; 385 | 386 | procedure draw_cube(var attrib: TAttrib; buffer: GLuint); 387 | begin 388 | draw_item(attrib, buffer, 36); 389 | end; 390 | 391 | procedure draw_plant(var attrib: TAttrib; buffer: GLuint); 392 | begin 393 | draw_item(attrib, buffer, 24); 394 | end; 395 | 396 | procedure draw_player(var attrib: TAttrib; player :pPlayer); 397 | begin 398 | draw_cube(attrib, player.buffer); 399 | end; 400 | 401 | procedure render_sky(var attrib: TAttrib; player: pPlayer; buffer: GLuint); 402 | var 403 | s: ^TState; 404 | matrix: array[0..15] of Single; 405 | begin 406 | s := @player.state; 407 | set_matrix_3d( 408 | @matrix, g.width, g.height, 0, 0, 0, s.rx, s.ry, g.fov, 0, g.render_radius 409 | ); 410 | glUseProgram(attrib.&program); 411 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 412 | glUniform1i(attrib.sampler, 2); 413 | glUniform1f(attrib.timer, time_of_day()); 414 | draw_triangles_3d(attrib, buffer, 512 * 3); 415 | end; 416 | 417 | procedure render_wireframe(var attrib: TAttrib; player: pPlayer); 418 | var 419 | s: pState; 420 | matrix: array[0..15] of Single; 421 | hx, hy, hz, hw: Integer; 422 | wireframe_buffer: GLuint; 423 | begin 424 | s := @player.state; 425 | set_matrix_3d( 426 | @matrix, g.width, g.height, 427 | s.x, s.y, s.z, s.rx, s.ry, g.fov, g.ortho, g.render_radius); 428 | hw := hit_test(0, s.x, s.y, s.z, s.rx, s.ry, &hx, &hy, &hz); 429 | if (is_obstacle(hw)) then begin 430 | glUseProgram(attrib.&program); 431 | glLineWidth(1); 432 | glEnable(GL_COLOR_LOGIC_OP); 433 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 434 | wireframe_buffer := gen_wireframe_buffer(hx, hy, hz, 0.53); 435 | draw_lines(attrib, wireframe_buffer, 3, 24); 436 | del_buffer(wireframe_buffer); 437 | glDisable(GL_COLOR_LOGIC_OP); 438 | end; 439 | end; 440 | 441 | procedure render_crosshairs(var attrib: TAttrib); 442 | var 443 | matrix: array[0..15] of Single; 444 | crosshair_buffer: GLuint; 445 | begin 446 | set_matrix_2d(@matrix, g.width, g.height); 447 | glUseProgram(attrib.&program); 448 | glLineWidth(4 * g.scale); 449 | glEnable(GL_COLOR_LOGIC_OP); 450 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 451 | crosshair_buffer := gen_crosshair_buffer(); 452 | draw_lines(attrib, crosshair_buffer, 2, 4); 453 | del_buffer(crosshair_buffer); 454 | glDisable(GL_COLOR_LOGIC_OP); 455 | end; 456 | 457 | procedure render_item(var attrib: TAttrib); 458 | var 459 | matrix: array[0..15] of Single; 460 | w: Integer; 461 | buffer: GLuint; 462 | begin 463 | set_matrix_item(@matrix, g.width, g.height, g.scale); 464 | glUseProgram(attrib.&program); 465 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 466 | glUniform3f(attrib.camera, 0, 0, 5); 467 | glUniform1i(attrib.sampler, 0); 468 | glUniform1f(attrib.timer, time_of_day()); 469 | w := items[g.item_index]; 470 | if (is_plant(w)) then begin 471 | buffer := gen_plant_buffer(0, 0, 0, 0.5, w); 472 | draw_plant(attrib, buffer); 473 | del_buffer(buffer); 474 | end 475 | else begin 476 | buffer := gen_cube_buffer(0, 0, 0, 0.5, w); 477 | draw_cube(attrib, buffer); 478 | del_buffer(buffer); 479 | end; 480 | end; 481 | 482 | procedure render_text( 483 | var attrib: TAttrib; justify: Integer; x, y, n: Single; text: PAnsiChar); 484 | var 485 | matrix: array[0..15] of Single; 486 | length: Integer; 487 | buffer: GLuint; 488 | begin 489 | set_matrix_2d(@matrix, g.width, g.height); 490 | glUseProgram(attrib.&program); 491 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 492 | glUniform1i(attrib.sampler, 1); 493 | glUniform1i(attrib.extra1, 0); 494 | length := strlen(text); 495 | x := x - n * justify * (length - 1) / 2; 496 | buffer := gen_text_buffer(x, y, n, text); 497 | draw_text(attrib, buffer, length); 498 | del_buffer(buffer); 499 | end; 500 | 501 | function render_chunks(var attrib: TAttrib; player: PPlayer): Integer; 502 | var 503 | s: pState; 504 | p: Integer; 505 | q: Integer; 506 | light: Single; 507 | matrix: array[0..15] of Single; 508 | planes: TPlanes; 509 | i: Integer; 510 | chunk: pChunk; 511 | begin 512 | result := 0; 513 | s := @player.state; 514 | ensure_chunks(player); 515 | p := chunked(s.x); 516 | q := chunked(s.z); 517 | light := get_daylight(); 518 | set_matrix_3d( 519 | @matrix, g.width, g.height, 520 | s.x, s.y, s.z, s.rx, s.ry, g.fov, g.ortho, g.render_radius); 521 | frustum_planes(planes, g.render_radius, @matrix); 522 | glUseProgram(attrib.&program); 523 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 524 | glUniform3f(attrib.camera, s.x, s.y, s.z); 525 | glUniform1i(attrib.sampler, 0); 526 | glUniform1i(attrib.extra1, 2); 527 | glUniform1f(attrib.extra2, light); 528 | glUniform1f(attrib.extra3, g.render_radius * CHUNK_SIZE); 529 | glUniform1i(attrib.extra4, g.ortho); 530 | glUniform1f(attrib.timer, time_of_day()); 531 | for i := 0 to g.chunk_count - 1 do 532 | begin 533 | chunk := @g.chunks[i]; 534 | if (chunk_distance(chunk, p, q) > g.render_radius) then 535 | begin 536 | continue; 537 | end; 538 | if (0 = chunk_visible( 539 | planes, chunk.p, chunk.q, chunk.miny, chunk.maxy)) then 540 | begin 541 | continue; 542 | end; 543 | draw_chunk(attrib, chunk); 544 | Inc(result, chunk.faces); 545 | end; 546 | end; 547 | 548 | procedure render_signs(var attrib: TAttrib; player: pPlayer); 549 | var 550 | s: pState; 551 | p, q: Integer; 552 | matrix: array[0..15] of Single; 553 | planes: TPlanes; 554 | i: Integer; 555 | chunk: pChunk; 556 | begin 557 | s := @player.state; 558 | p := chunked(s.x); 559 | q := chunked(s.z); 560 | set_matrix_3d( 561 | @matrix, g.width, g.height, 562 | s.x, s.y, s.z, s.rx, s.ry, g.fov, g.ortho, g.render_radius); 563 | frustum_planes(planes, g.render_radius, @matrix); 564 | glUseProgram(attrib.&program); 565 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 566 | glUniform1i(attrib.sampler, 3); 567 | glUniform1i(attrib.extra1, 1); 568 | for i := 0 to g.chunk_count - 1 do begin 569 | chunk := @g.chunks[i]; 570 | if (chunk_distance(chunk, p, q) > g.sign_radius) then begin 571 | continue; 572 | end; 573 | if (0 = chunk_visible( 574 | planes, chunk.p, chunk.q, chunk.miny, chunk.maxy)) 575 | then begin 576 | continue; 577 | end; 578 | draw_signs(attrib, chunk); 579 | end; 580 | end; 581 | 582 | procedure render_sign(var attrib: TAttrib; player: pPlayer); 583 | var 584 | x, y, z, face: Integer; 585 | s: pState; 586 | matrix: array[0..15] of Single; 587 | text: array[0..MAX_SIGN_LENGTH - 1] of AnsiChar; 588 | data: pGLFloat; 589 | length: Integer; 590 | buffer: GLuint; 591 | begin 592 | if (g.typing = 0) or (g.typing_buffer[0] <> CRAFT_KEY_SIGN) then begin 593 | Exit; 594 | end; 595 | if not hit_test_face(player, &x, &y, &z, &face) then begin 596 | Exit; 597 | end; 598 | s := @player.state; 599 | set_matrix_3d( 600 | @matrix, g.width, g.height, 601 | s.x, s.y, s.z, s.rx, s.ry, g.fov, g.ortho, g.render_radius); 602 | glUseProgram(attrib.&program); 603 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 604 | glUniform1i(attrib.sampler, 3); 605 | glUniform1i(attrib.extra1, 1); 606 | strncpy(text, g.typing_buffer + 1, MAX_SIGN_LENGTH); 607 | text[MAX_SIGN_LENGTH - 1] := #0; 608 | data := malloc_faces(5, strlen(text)); 609 | length := _gen_sign_buffer(data, x, y, z, face, text); 610 | buffer := gen_faces(5, length, data); 611 | draw_sign(attrib, buffer, length); 612 | del_buffer(buffer); 613 | end; 614 | 615 | procedure render_players(var attrib: TAttrib; player: pPlayer); 616 | var 617 | s: pState; 618 | matrix: array[0..15] of Single; 619 | i: Integer; 620 | other: pPlayer; 621 | begin 622 | s := @player.state; 623 | set_matrix_3d( 624 | @matrix, g.width, g.height, 625 | s.x, s.y, s.z, s.rx, s.ry, g.fov, g.ortho, g.render_radius); 626 | glUseProgram(attrib.&program); 627 | glUniformMatrix4fv(attrib.matrix, 1, GL_FALSE, @matrix); 628 | glUniform3f(attrib.camera, s.x, s.y, s.z); 629 | glUniform1i(attrib.sampler, 0); 630 | glUniform1f(attrib.timer, time_of_day()); 631 | for i := 0 to g.player_count - 1 do begin 632 | other := @g.players[i]; 633 | if (other <> player) then begin 634 | draw_player(attrib, other); 635 | end; 636 | end; 637 | end; 638 | 639 | end. 640 | -------------------------------------------------------------------------------- /src/Craft.Ring.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Ring; 2 | 3 | // [100%] Translation from C to Delphi by Execute SARL 4 | 5 | interface 6 | {$POINTERMATH ON} 7 | type 8 | TRingEntryType = ( 9 | BLOCK, 10 | LIGHT, 11 | KEY, 12 | COMMIT, 13 | EXIT_ 14 | ); 15 | 16 | TRingEntry = record 17 | &type: TRingEntryType; 18 | p: Integer; 19 | q: Integer; 20 | x: Integer; 21 | y: Integer; 22 | z: Integer; 23 | w: Integer; 24 | key: Integer; 25 | end; 26 | pRingEntry = ^TRingEntry; 27 | 28 | TRing = record 29 | capacity: Cardinal; 30 | start: Cardinal; 31 | &end: Cardinal; 32 | data: pRingEntry; 33 | end; 34 | pRing = ^TRing; 35 | 36 | procedure ring_alloc(ring: pRing; capacity: Integer); 37 | procedure ring_free(ring: pRing); 38 | function ring_empty(ring: pRing): Boolean; 39 | function ring_full(ring: pRing): Boolean; 40 | function ring_size(ring: pRing): Integer; 41 | procedure ring_grow(ring: pRing); 42 | procedure ring_put(ring: pRing; entry: pRingEntry); 43 | procedure ring_put_block(ring: pRing; p, q, x, y, z, w: Integer); 44 | procedure ring_put_light(ring: pRing; p, q, x, y, z, w: Integer); 45 | procedure ring_put_key(ring: pRing; p, q, key: Integer); 46 | procedure ring_put_commit(ring: pRing); 47 | procedure ring_put_exit(ring: pRing); 48 | function ring_get(ring: pRing; entry: pRingEntry): Boolean; 49 | 50 | implementation 51 | 52 | procedure ring_alloc(ring: pRing; capacity: Integer); 53 | begin 54 | ring.capacity := capacity; 55 | ring.start := 0; 56 | ring.&end := 0; 57 | ring.data := AllocMem(capacity * sizeof(TRingEntry)); 58 | end; 59 | 60 | procedure ring_free(ring: pRing); 61 | begin 62 | FreeMem(ring.data); 63 | end; 64 | 65 | function ring_empty(ring: pRing) : Boolean; 66 | begin 67 | Result := ring.start = ring.&end; 68 | end; 69 | 70 | function ring_full(ring: pRing): Boolean; 71 | begin 72 | Result := ring.start = (ring.&end + 1) mod ring.capacity; 73 | end; 74 | 75 | function ring_size(ring: pRing): Integer; 76 | begin 77 | if (ring.&end >= ring.start) then begin 78 | Result := ring.&end - ring.start; 79 | end 80 | else begin 81 | Result := ring.capacity - (ring.start - ring.&end); 82 | end; 83 | end; 84 | 85 | procedure ring_grow(ring: pRing); 86 | var 87 | new_ring: TRing; 88 | entry: TRingEntry; 89 | begin 90 | ring_alloc(@new_ring, ring.capacity * 2); 91 | while (ring_get(ring, @entry)) do begin 92 | ring_put(@new_ring, @entry); 93 | end; 94 | FreeMem(ring.data); 95 | ring.capacity := new_ring.capacity; 96 | ring.start := new_ring.start; 97 | ring.&end := new_ring.&end; 98 | ring.data := new_ring.data; 99 | end; 100 | 101 | procedure ring_put(ring: pRing; entry: pRingEntry); 102 | var 103 | e: pRingEntry; 104 | begin 105 | if (ring_full(ring)) then begin 106 | ring_grow(ring); 107 | end; 108 | e := ring.data + ring.&end; 109 | //memcpy(e, entry, sizeof(RingEntry)); 110 | e^ := entry^; 111 | ring.&end := (ring.&end + 1) mod ring.capacity; 112 | end; 113 | 114 | procedure ring_put_block(ring: pRing; p, q, x, y, z, w: Integer); 115 | var 116 | entry: TRingEntry; 117 | begin 118 | entry.&type := BLOCK; 119 | entry.p := p; 120 | entry.q := q; 121 | entry.x := x; 122 | entry.y := y; 123 | entry.z := z; 124 | entry.w := w; 125 | ring_put(ring, @entry); 126 | end; 127 | 128 | procedure ring_put_light(ring: pRing; p, q, x, y, z, w: Integer); 129 | var 130 | entry: TRingEntry; 131 | begin 132 | entry.&type := LIGHT; 133 | entry.p := p; 134 | entry.q := q; 135 | entry.x := x; 136 | entry.y := y; 137 | entry.z := z; 138 | entry.w := w; 139 | ring_put(ring, @entry); 140 | end; 141 | 142 | procedure ring_put_key(ring: pRing; p, q, key: Integer); 143 | var 144 | entry: TRingEntry; 145 | begin 146 | entry.&type := TRingEntryType.KEY; 147 | entry.p := p; 148 | entry.q := q; 149 | entry.key := key; 150 | ring_put(ring, @entry); 151 | end; 152 | 153 | procedure ring_put_commit(ring: pRing); 154 | var 155 | entry: TRingEntry; 156 | begin 157 | entry.&type := COMMIT; 158 | ring_put(ring, @entry); 159 | end; 160 | 161 | procedure ring_put_exit(ring: pRing); 162 | var 163 | entry: TRingEntry; 164 | begin 165 | entry.&type := EXIT_; 166 | ring_put(ring, @entry); 167 | end; 168 | 169 | function ring_get(ring: pRing; entry: pRingEntry): Boolean; 170 | var 171 | e: pRingEntry; 172 | begin 173 | if (ring_empty(ring)) then begin 174 | Exit(False); 175 | end; 176 | e := ring.data + ring.start; 177 | //memcpy(entry, e, sizeof(RingEntry)); 178 | entry^ := e^; 179 | ring.start := (ring.start + 1) mod ring.capacity; 180 | Exit(True); 181 | end; 182 | 183 | end. 184 | -------------------------------------------------------------------------------- /src/Craft.Sign.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Sign; 2 | 3 | interface 4 | {$POINTERMATH ON} 5 | uses 6 | Execute.SysUtils; 7 | 8 | const 9 | MAX_SIGN_LENGTH = 64; 10 | 11 | type 12 | TSign = record 13 | x : Integer; 14 | y : Integer; 15 | z : Integer; 16 | face : Integer; 17 | text : array[0..MAX_SIGN_LENGTH - 1] of AnsiChar; 18 | end; 19 | pSign = ^TSign; 20 | 21 | TSignList = record 22 | capacity : Cardinal; 23 | size : Integer; 24 | data : pSign; 25 | end; 26 | pSignList = ^TSignList; 27 | 28 | procedure sign_list_alloc(list: pSignList; capacity: Integer); 29 | procedure sign_list_free(list: pSignList); 30 | procedure sign_list_grow(list: pSignList); 31 | procedure sign_list_add( 32 | list: pSignList; x, y, z, face: Integer; text: PAnsiChar); 33 | function sign_list_remove(list: pSignList; x, y, z, face: Integer): Integer; 34 | function sign_list_remove_all(list: pSignList; x, y, z: Integer): Integer; 35 | 36 | 37 | implementation 38 | 39 | procedure sign_list_alloc(list: pSignList; capacity: Integer); 40 | begin 41 | list.capacity := capacity; 42 | list.size := 0; 43 | //list.data := pSign(calloc(capacity, sizeof(TSign))); 44 | list.data := AllocMem(capacity * SizeOf(TSign)); 45 | end; 46 | 47 | 48 | procedure sign_list_free(list: pSignList); 49 | begin 50 | FreeMem(list.data); 51 | end; 52 | 53 | procedure sign_list_grow(list: pSignList); 54 | var 55 | new_list: TSignList; 56 | begin 57 | sign_list_alloc(@new_list, list.capacity * 2); 58 | //memcpy(new_list.data, list->data, list->size * sizeof(Sign)); 59 | move(list.data^, new_list.data^, list.size * SizeOf(TSign)); 60 | freemem(list.data); 61 | list.capacity := new_list.capacity; 62 | list.data := new_list.data; 63 | end; 64 | 65 | procedure _sign_list_add(list: pSignList; sign: pSign); 66 | var 67 | e: pSign; 68 | begin 69 | if (list.size = list.capacity) then begin 70 | sign_list_grow(list); 71 | end; 72 | e := list.data + list.size; 73 | Inc(list.size); 74 | //memcpy(e, sign, sizeof(Sign)); 75 | e^ := sign^; 76 | end; 77 | 78 | procedure sign_list_add( 79 | list: pSignList; x, y, z, face: Integer; text: PAnsiChar); 80 | var 81 | sign: TSign; 82 | begin 83 | sign_list_remove(list, x, y, z, face); 84 | sign.x := x; 85 | sign.y := y; 86 | sign.z := z; 87 | sign.face := face; 88 | strncpy(sign.text, text, MAX_SIGN_LENGTH); 89 | sign.text[MAX_SIGN_LENGTH - 1] := #0; 90 | _sign_list_add(list, @sign); 91 | end; 92 | 93 | 94 | function sign_list_remove(list: pSignList; x, y, z, face: Integer): Integer; 95 | var 96 | i: Integer; 97 | e: pSign; 98 | other: pSign; 99 | begin 100 | result := 0; 101 | i := 0; 102 | while (i < list.size) do begin 103 | e := @list.data[i]; 104 | if (e.x = x) and (e.y = y) and (e.z = z) and (e.face = face) then begin 105 | Dec(list.Size); 106 | other := @list.data[list.size]; 107 | //memcpy(e, other, sizeof(Sign)); 108 | e^ := other^; 109 | Dec(i); 110 | Inc(result); 111 | end; 112 | Inc(i); 113 | end; 114 | end; 115 | 116 | function sign_list_remove_all(list: pSignList; x, y, z: Integer): Integer; 117 | var 118 | i: Integer; 119 | e: pSign; 120 | other: pSign; 121 | begin 122 | result := 0; 123 | i := 0; 124 | while (i < list.size) do begin 125 | e := list.data + i; 126 | if (e.x = x) and (e.y = y) and (e.z = z) then 127 | begin 128 | Dec(list.size); 129 | other := list.data + list.size; 130 | //memcpy(e, other, sizeof(Sign)); 131 | e^ := other^; 132 | Dec(i); 133 | Inc(result); 134 | end; 135 | Inc(i); 136 | end; 137 | end; 138 | 139 | end. 140 | -------------------------------------------------------------------------------- /src/Craft.Util.pas: -------------------------------------------------------------------------------- 1 | unit Craft.Util; 2 | 3 | interface 4 | 5 | uses 6 | Execute.SysUtils, 7 | Execute.CrossGL, 8 | Execute.Textures, 9 | Execute.PNGLoader; 10 | 11 | type 12 | tbool_27 = array[0..26] of Boolean; 13 | tbyte_27 = array[0..26] of Byte; 14 | tfloat_27 = array[0..26] of Single; 15 | tfloat_6_4 = array[0..5, 0..3] of Single; 16 | 17 | function DEGREES(radians: Single): Single; inline; 18 | function RADIANS(degrees: Single): Single; inline; 19 | 20 | { 21 | function MAX(a, b: Integer): Integer; overload; 22 | function MAX(a, b: Single): Single; overload; 23 | function MIN(a, b: Integer): Integer; overload; 24 | function MIN(a, b: Single): Single; overload; 25 | } 26 | 27 | type 28 | TFPS = record 29 | fps : Cardinal; 30 | frames : Cardinal; 31 | since : Double; 32 | end; 33 | PFPS = ^TFPS; 34 | 35 | procedure update_fps(fps: PFPS); 36 | 37 | procedure load_png_texture(const AFileName: string); 38 | function load_program(path1, path2: string): GLuint; 39 | 40 | function gen_buffer(size: GLsizei; data: PSingle): GLuint; 41 | procedure del_buffer(buffer: GLuint); 42 | function malloc_faces(components, faces: Integer): pGLfloat; 43 | function gen_faces(components, faces: Integer; data: pGLfloat): GLuint; 44 | 45 | function strlen(s: PAnsiChar): Integer; 46 | function strcpy(dst, src: PAnsiChar): PAnsiChar; 47 | 48 | function tokenize(str, delim: PAnsiChar; var key: PAnsiChar): PAnsiChar; 49 | function char_width(input: AnsiChar): Integer; 50 | function string_width(input: PAnsiChar): Integer; 51 | function wrap(input: PAnsiChar; max_width: Integer; output: PansiChar; max_length: Integer): Integer; 52 | 53 | implementation 54 | 55 | uses Neslib.glfw3; 56 | 57 | procedure update_fps(fps: PFPS); 58 | var 59 | now: Double; 60 | elapsed: Double; 61 | begin 62 | Inc(fps.frames); 63 | now := glfwGetTime(); 64 | elapsed := now - fps.since; 65 | if (elapsed >= 1) then begin 66 | fps.fps := round(fps.frames / elapsed); 67 | fps.frames := 0; 68 | fps.since := now; 69 | end; 70 | end; 71 | 72 | function DEGREES(radians: Single): Single; 73 | begin 74 | Result := ((radians) * 180 / PI); 75 | end; 76 | 77 | function RADIANS(degrees: Single): Single; 78 | begin 79 | Result := ((degrees) * PI / 180); 80 | end; 81 | { 82 | function MAX(a, b: Integer): Integer; 83 | begin 84 | if a > b then 85 | Result := a 86 | else 87 | Result := b; 88 | end; 89 | 90 | function MAX(a, b: Single): Single; 91 | begin 92 | if a > b then 93 | Result := a 94 | else 95 | Result := b; 96 | end; 97 | 98 | function MIN(a, b: Integer): Integer; 99 | begin 100 | if a < b then 101 | Result := a 102 | else 103 | Result := b; 104 | end; 105 | 106 | function MIN(a, b: Single): Single; 107 | begin 108 | if a < b then 109 | Result := a 110 | else 111 | Result := b; 112 | end; 113 | } 114 | function strlen(s: PAnsiChar): Integer; 115 | begin 116 | Result := 0; 117 | while s[Result] <> #0 do 118 | begin 119 | Inc(Result); 120 | end; 121 | end; 122 | 123 | function strcpy(dst, src: PAnsiChar): PAnsiChar; 124 | var 125 | c: AnsiChar; 126 | begin 127 | repeat 128 | c := src^; 129 | Inc(src); 130 | dst^ := c; 131 | Inc(dst); 132 | until c = #0; 133 | end; 134 | 135 | function charpos(ch: AnsiChar; p: PAnsiChar): Integer; 136 | begin 137 | Result := 0; 138 | while p[Result] <> #0 do 139 | begin 140 | if p[Result] = ch then 141 | Exit; 142 | Inc(Result); 143 | end; 144 | Result := -1; 145 | end; 146 | 147 | // Returns the length of the initial portion of str1 which consists only of characters that are part of str2. 148 | function strspn(str1, str2: PAnsiChar): Integer; 149 | begin 150 | Result := 0; 151 | while str1[Result] <> #0 do 152 | begin 153 | if charpos(str1[Result], str2) < 0 then 154 | Exit; 155 | Inc(Result); 156 | end; 157 | end; 158 | 159 | // Scans str1 for the first occurrence of any of the characters that are part of str2, 160 | // returning the number of characters of str1 read before this first occurrence. 161 | function strcspn(str1, str2: PAnsiChar): Integer; 162 | begin 163 | Result := 0; 164 | while str1[Result] <> #0 do 165 | begin 166 | if charpos(str1[Result], str2) >= 0 then 167 | Exit; 168 | Inc(Result); 169 | end; 170 | end; 171 | 172 | function strncat(dst, src: PAnsiChar; num: Integer): PAnsiChar; 173 | var 174 | i: Integer; 175 | c: AnsiChar; 176 | begin 177 | Result := dst; 178 | while dst^ <> #0 do 179 | Inc(dst); 180 | for i := 0 to num do 181 | begin 182 | c := src^; 183 | dst^ := c; 184 | if c = #0 then 185 | break; 186 | Inc(src); 187 | Inc(dst); 188 | end; 189 | dst^ := #0; 190 | end; 191 | 192 | function load_file(path: string): AnsiString; 193 | var 194 | f: file; 195 | l: Integer; 196 | begin 197 | Assignfile(f, path); 198 | Reset(f, 1); 199 | l := filesize(f); 200 | SetLength(Result, l); 201 | BlockRead(f, Result[1], l); 202 | CloseFile(f); 203 | end; 204 | 205 | procedure load_png_texture(const AFileName: string); 206 | var 207 | Texture: TTexture; 208 | begin 209 | LoadPNG(AFileName, Texture); 210 | // Texture.SaveAsBitmap(AFileName + '.1.BMP'); 211 | Texture.Flip; 212 | // Texture.SaveAsBitmap(AFileName + '.2.BMP'); 213 | glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Texture.Width, Texture.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, Pointer(Texture.Bytes)); 214 | end; 215 | 216 | function make_shader(&type: GLenum; source: AnsiString): GLuint; 217 | var 218 | status: GLint; 219 | length: GLint; 220 | src : PGLchar; 221 | info : string; 222 | begin 223 | Result := glCreateShader(&type); 224 | length := System.Length(Source) - 1; 225 | src := PGLchar(source); 226 | glShaderSource(Result, 1, @src, @length); 227 | glCompileShader(Result); 228 | glGetShaderiv(Result, GL_COMPILE_STATUS, @status); 229 | if (status = GL_FALSE) then 230 | begin 231 | glGetShaderiv(Result, GL_INFO_LOG_LENGTH, @length); 232 | SetLength(info, length); 233 | glGetShaderInfoLog(Result, length, nil, Pointer(info)); 234 | raise Exception.Create('glCompileShader failed : ' + info); 235 | end; 236 | end; 237 | 238 | function load_shader(&type: GLenum; path: string): GLuint; 239 | var 240 | data: AnsiString; 241 | begin 242 | data := load_file(path); 243 | Result := make_shader(&type, data); 244 | end; 245 | 246 | function make_program(shader1, shader2: GLuint ): GLuint; 247 | var 248 | status: GLint; 249 | length: GLint; 250 | info : AnsiString; 251 | begin 252 | Result := glCreateProgram(); 253 | glAttachShader(Result, shader1); 254 | glAttachShader(Result, shader2); 255 | glLinkProgram(Result); 256 | glGetProgramiv(Result, GL_LINK_STATUS, @status); 257 | if (status = GL_FALSE) then 258 | begin 259 | glGetProgramiv(Result, GL_INFO_LOG_LENGTH, @length); 260 | SetLength(info, length); 261 | glGetProgramInfoLog(Result, length, nil, PGLchar(info)); 262 | raise Exception.Create('glLinkProgram failed: ' + string(info)); 263 | end; 264 | glDetachShader(Result, shader1); 265 | glDetachShader(Result, shader2); 266 | glDeleteShader(shader1); 267 | glDeleteShader(shader2); 268 | end; 269 | 270 | function load_program(path1, path2: string): GLuint; 271 | var 272 | shader1, shader2: GLuint; 273 | begin 274 | shader1 := load_shader(GL_VERTEX_SHADER, path1); 275 | shader2 := load_shader(GL_FRAGMENT_SHADER, path2); 276 | Result := make_program(shader1, shader2); 277 | end; 278 | 279 | function gen_buffer(size: GLsizei; data: PSingle): GLuint; 280 | begin 281 | glGenBuffers(1, @Result); 282 | glBindBuffer(GL_ARRAY_BUFFER, Result); 283 | glBufferData(GL_ARRAY_BUFFER, size, data, GL_STATIC_DRAW); 284 | glBindBuffer(GL_ARRAY_BUFFER, 0); 285 | end; 286 | 287 | procedure del_buffer(buffer: GLuint); 288 | begin 289 | glDeleteBuffers(1, @buffer); 290 | end; 291 | 292 | function malloc_faces(components, faces: Integer): pGLfloat; 293 | begin 294 | Result := AllocMem(sizeof(GLfloat) * 6 * components * faces); 295 | end; 296 | 297 | function gen_faces(components, faces: Integer; data: pGLfloat): GLuint; 298 | var 299 | buffer: GLuint; 300 | begin 301 | buffer := gen_buffer(sizeof(GLfloat) * 6 * components * faces, data); 302 | FreeMem(data); 303 | Result := buffer; 304 | end; 305 | 306 | function tokenize(str, delim: PAnsiChar; var key: PAnsiChar): PAnsiChar; 307 | begin 308 | if (str = nil) then 309 | begin 310 | str := key; 311 | end; 312 | Inc(str, strspn(str, delim)); 313 | if (str^ = #0) then 314 | Exit(nil); 315 | result := str; 316 | Inc(str, strcspn(str, delim)); 317 | if (str^ <> #0) then 318 | begin 319 | str^ := #0; 320 | Inc(str); 321 | end; 322 | key := str; 323 | end; 324 | 325 | function char_width(input: AnsiChar): Integer; 326 | const 327 | lookup:array[0..127] of Integer = ( 328 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 329 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 330 | 4, 2, 4, 7, 6, 9, 7, 2, 3, 3, 4, 6, 3, 5, 2, 7, 331 | 6, 3, 6, 6, 6, 6, 6, 6, 6, 6, 2, 3, 5, 6, 5, 7, 332 | 8, 6, 6, 6, 6, 6, 6, 6, 6, 4, 6, 6, 5, 8, 8, 6, 333 | 6, 7, 6, 6, 6, 6, 8,10, 8, 6, 6, 3, 6, 3, 6, 6, 334 | 4, 7, 6, 6, 6, 6, 5, 6, 6, 2, 5, 5, 2, 9, 6, 6, 335 | 6, 6, 6, 6, 5, 6, 6, 6, 6, 6, 6, 4, 2, 5, 7, 0 336 | ); 337 | begin 338 | if Ord(Input) > 127 then 339 | begin 340 | WriteLn('char_width overflow for ', input); 341 | Result := 0; 342 | end else begin 343 | Result := lookup[Ord(input)]; 344 | end; 345 | end; 346 | 347 | function string_width(input: PAnsiChar): Integer; 348 | var 349 | length: Integer; 350 | i: Integer; 351 | begin 352 | result := 0; 353 | length := strlen(input); 354 | for i := 0 to length - 1 do 355 | begin 356 | Inc(Result, char_width(input[i])); 357 | end; 358 | end; 359 | 360 | function wrap(input: PAnsiChar; max_width: Integer; output: PansiChar; max_length: Integer): Integer; 361 | var 362 | text: PAnsiChar; 363 | space_width: Integer; 364 | line_number: Integer; 365 | key1, key2, line: PAnsiChar; 366 | line_width: Integer; 367 | token: PAnsiChar; 368 | token_width: Integer; 369 | begin 370 | output^ := #0; 371 | GetMem(text, sizeof(Ansichar) * (strlen(input) + 1)); 372 | strcpy(text, input); 373 | space_width := char_width(' '); 374 | line_number := 0; 375 | line := tokenize(text, #13#10, key1); 376 | while (line <> nil) do 377 | begin 378 | line_width := 0; 379 | token := tokenize(line, ' ', key2); 380 | while (token <> nil) do 381 | begin 382 | token_width := string_width(token); 383 | if (line_width <> 0) then 384 | begin 385 | if (line_width + token_width > max_width) then 386 | begin 387 | line_width := 0; 388 | Inc(line_number); 389 | strncat(output, #10, max_length - strlen(output) - 1); 390 | end 391 | else begin 392 | strncat(output, ' ', max_length - strlen(output) - 1); 393 | end; 394 | end; 395 | strncat(output, token, max_length - strlen(output) - 1); 396 | Inc(line_width, token_width + space_width); 397 | token := tokenize(nil, ' ', key2); 398 | end; 399 | Inc(line_number); 400 | strncat(output, #10, max_length - strlen(output) - 1); 401 | line := tokenize(nil, #13#10, key1); 402 | end; 403 | FreeMem(text); 404 | Result := line_number; 405 | end; 406 | 407 | 408 | end. 409 | -------------------------------------------------------------------------------- /src/Craft.World.pas: -------------------------------------------------------------------------------- 1 | unit Craft.World; 2 | 3 | interface 4 | 5 | // typedef void (*world_func)(int, int, int, int, void *); 6 | type 7 | world_func = procedure(x, y, z, w : Integer; p: Pointer); 8 | 9 | procedure create_world(p, q: Integer; func: world_func; arg: Pointer); 10 | 11 | implementation 12 | 13 | uses Craft.Config, CaseyDuncan.noise; 14 | 15 | procedure create_world(p, q: Integer; func: world_func; arg: Pointer); 16 | var 17 | pad: Integer; 18 | dx: Integer; 19 | dz: Integer; 20 | flag: Integer; 21 | x, z: Integer; 22 | f, g: Single; 23 | mh, h, w, t: Integer; 24 | y: Integer; 25 | ok: Integer; 26 | ox, oz, d: Integer; 27 | begin 28 | pad := 1; 29 | for dx := -pad to pad + CHUNK_SIZE - 1 do begin 30 | for dz := -pad to pad + CHUNK_SIZE - 1 do begin 31 | flag := 1; 32 | if (dx < 0) or (dz < 0) or (dx >= CHUNK_SIZE) or (dz >= CHUNK_SIZE) then begin 33 | flag := -1; 34 | end; 35 | x := p * CHUNK_SIZE + dx; 36 | z := q * CHUNK_SIZE + dz; 37 | f := simplex2( x * 0.01, z * 0.01, 4, 0.5, 2); 38 | g := simplex2(-x * 0.01, -z * 0.01, 2, 0.9, 2); 39 | mh := Trunc(g * 32) + 16; 40 | h := Trunc(f * mh); 41 | w := 1; 42 | t := 12; 43 | if (h <= t) then begin 44 | h := t; 45 | w := 2; 46 | end; 47 | // sand and grass terrain 48 | for y := 0 to h - 1 do begin 49 | func(x, y, z, w * flag, arg); 50 | end; 51 | if (w = 1) then begin 52 | if (SHOW_PLANTS <> 0) then begin 53 | // grass 54 | if (simplex2(-x * 0.1, z * 0.1, 4, 0.8, 2) > 0.6) then begin 55 | func(x, h, z, 17 * flag, arg); 56 | end; 57 | // flowers 58 | if (simplex2(x * 0.05, -z * 0.05, 4, 0.8, 2) > 0.7) then begin 59 | w := 18 + Trunc(simplex2(x * 0.1, z * 0.1, 4, 0.8, 2) * 7); 60 | func(x, h, z, w * flag, arg); 61 | end; 62 | end; 63 | // trees 64 | ok := SHOW_TREES; 65 | if (dx - 4 < 0) or (dz - 4 < 0) or 66 | (dx + 4 >= CHUNK_SIZE) or (dz + 4 >= CHUNK_SIZE) then 67 | begin 68 | ok := 0; 69 | end; 70 | if (ok <> 0) and (simplex2(x, z, 6, 0.5, 2) > 0.84) then begin 71 | for y := h + 3 to h + 7 do begin 72 | for ox := -3 to +3 do begin 73 | for oz := -3 to +3 do begin 74 | d := (ox * ox) + (oz * oz) + 75 | (y - (h + 4)) * (y - (h + 4)); 76 | if (d < 11) then begin 77 | func(x + ox, y, z + oz, 15, arg); 78 | end; 79 | end; 80 | end; 81 | end; 82 | for y := h to h + 6 do begin 83 | func(x, y, z, 5, arg); 84 | end; 85 | end; 86 | end; 87 | // clouds 88 | if (SHOW_CLOUDS <> 0) then begin 89 | for y := 64 to 71 do begin 90 | if (simplex3( 91 | x * 0.01, y * 0.1, z * 0.01, 8, 0.5, 2) > 0.75) then 92 | begin 93 | func(x, y, z, 16 * flag, arg); 94 | end; 95 | end; 96 | end; 97 | end; 98 | end; 99 | end; 100 | 101 | end. 102 | -------------------------------------------------------------------------------- /src/Craft.db.pas: -------------------------------------------------------------------------------- 1 | unit Craft.db; 2 | 3 | interface 4 | 5 | uses 6 | Execute.SQLite3, 7 | Execute.SysUtils, 8 | Craft.Map, 9 | Craft.Sign, 10 | Craft.Ring, 11 | MarcusGeelnard.TinyCThread; 12 | 13 | function db_create(path: PAnsiChar; var db: sqlite3): Integer; 14 | 15 | procedure db_enable(); 16 | procedure db_disable(); 17 | function get_db_enabled(): Boolean; 18 | function db_init(path: PAnsiChar): Integer; 19 | procedure db_close(); 20 | procedure db_commit(); 21 | procedure db_auth_set(username, identity_token: PAnsiChar); 22 | function db_auth_select(username: PAnsiChar): Integer; 23 | procedure db_auth_select_none(); 24 | function db_auth_get( 25 | username, 26 | identity_token: PAnsiChar; identity_token_length: Integer): Integer; 27 | function db_auth_get_selected( 28 | username: PAnsiChar; username_length: Integer; 29 | identity_token: PAnsiChar; identity_token_length: Integer): Integer; 30 | procedure db_save_state(x, y, z, rx, ry: Single); 31 | function db_load_state(var x, y, z, rx, ry: Single): Boolean; 32 | procedure db_insert_block(p, q, x, y, z, w: Integer); 33 | procedure db_insert_light(p, q, x, y, z, w: Integer); 34 | procedure db_insert_sign( 35 | p, q, x, y, z, face: Integer; text: PAnsiChar); 36 | procedure db_delete_sign(x, y, z, face: Integer); 37 | procedure db_delete_signs(x, y, z: Integer); 38 | procedure db_delete_all_signs(); 39 | procedure db_load_blocks(map: pMap; p, q: Integer); 40 | procedure db_load_lights(map: pMap; p, q: Integer); 41 | procedure db_load_signs(list: pSignList; p, q: Integer); 42 | function db_get_key(p, q: Integer): Integer; 43 | procedure db_set_key(p, q, key: Integer); 44 | procedure db_worker_start(path : PAnsiChar); 45 | procedure db_worker_stop(); 46 | function db_worker_run(arg: Pointer): Integer; 47 | 48 | implementation 49 | 50 | var 51 | db_enabled: Boolean = False; 52 | 53 | db: sqlite3; 54 | insert_block_stmt: sqlite3_stmt; 55 | insert_light_stmt: sqlite3_stmt; 56 | insert_sign_stmt: sqlite3_stmt; 57 | delete_sign_stmt: sqlite3_stmt; 58 | delete_signs_stmt: sqlite3_stmt; 59 | load_blocks_stmt: sqlite3_stmt; 60 | load_lights_stmt: sqlite3_stmt; 61 | load_signs_stmt: sqlite3_stmt; 62 | get_key_stmt: sqlite3_stmt; 63 | set_key_stmt: sqlite3_stmt; 64 | 65 | ring: TRing; 66 | thrd: thrd_t; 67 | mtx: mtx_t; 68 | cnd: cnd_t; 69 | load_mtx: mtx_t; 70 | 71 | 72 | procedure db_enable(); 73 | begin 74 | db_enabled := True; 75 | end; 76 | 77 | procedure db_disable(); 78 | begin 79 | db_enabled := False; 80 | end; 81 | 82 | function get_db_enabled(): Boolean; 83 | begin 84 | Result := db_enabled; 85 | end; 86 | 87 | function db_create(path: PAnsiChar; var db: sqlite3): Integer; 88 | const 89 | create_query : PAnsiChar = 90 | 'attach database ''auth.db'' as auth;' 91 | + 'create table if not exists auth.identity_token (' 92 | + ' username text not null,' 93 | + ' token text not null,' 94 | + ' selected int not null' 95 | + ');' 96 | + 'create unique index if not exists auth.identity_token_username_idx' 97 | + ' on identity_token (username);' 98 | + 'create table if not exists state (' 99 | + ' x float not null,' 100 | + ' y float not null,' 101 | + ' z float not null,' 102 | + ' rx float not null,' 103 | + ' ry float not null' 104 | + ');' 105 | + 'create table if not exists block (' 106 | + ' p int not null,' 107 | + ' q int not null,' 108 | + ' x int not null,' 109 | + ' y int not null,' 110 | + ' z int not null,' 111 | + ' w int not null' 112 | + ');' 113 | + 'create table if not exists light (' 114 | + ' p int not null,' 115 | + ' q int not null,' 116 | + ' x int not null,' 117 | + ' y int not null,' 118 | + ' z int not null,' 119 | + ' w int not null' 120 | + ');' 121 | + 'create table if not exists key (' 122 | + ' p int not null,' 123 | + ' q int not null,' 124 | + ' key int not null' 125 | + ');' 126 | + 'create table if not exists sign (' 127 | + ' p int not null,' 128 | + ' q int not null,' 129 | + ' x int not null,' 130 | + ' y int not null,' 131 | + ' z int not null,' 132 | + ' face int not null,' 133 | + ' text text not null' 134 | + ');' 135 | + 'create unique index if not exists block_pqxyz_idx on block (p, q, x, y, z);' 136 | + 'create unique index if not exists light_pqxyz_idx on light (p, q, x, y, z);' 137 | + 'create unique index if not exists key_pq_idx on key (p, q);' 138 | + 'create unique index if not exists sign_xyzface_idx on sign (x, y, z, face);' 139 | + 'create index if not exists sign_pq_idx on sign (p, q);'; 140 | begin 141 | Result := sqlite3_open(path, db); 142 | if Result = 0 then 143 | begin 144 | Result := sqlite3_exec(db, create_query, nil, nil, nil); 145 | end; 146 | end; 147 | 148 | function db_init(path: PAnsiChar): Integer; 149 | const 150 | insert_block_query : PAnsiChar = 151 | 'insert or replace into block (p, q, x, y, z, w) ' 152 | + 'values (?, ?, ?, ?, ?, ?);'; 153 | insert_light_query : PAnsiChar = 154 | 'insert or replace into light (p, q, x, y, z, w) ' 155 | + 'values (?, ?, ?, ?, ?, ?);'; 156 | insert_sign_query : PAnsiChar = 157 | 'insert or replace into sign (p, q, x, y, z, face, text) ' 158 | + 'values (?, ?, ?, ?, ?, ?, ?);'; 159 | delete_sign_query : PAnsiChar = 160 | 'delete from sign where x = ? and y = ? and z = ? and face = ?;'; 161 | delete_signs_query : PAnsiChar = 162 | 'delete from sign where x = ? and y = ? and z = ?;'; 163 | load_blocks_query : PAnsiChar = 164 | 'select x, y, z, w from block where p = ? and q = ?;'; 165 | load_lights_query : PAnsiChar = 166 | 'select x, y, z, w from light where p = ? and q = ?;'; 167 | load_signs_query : PAnsiChar = 168 | 'select x, y, z, face, text from sign where p = ? and q = ?;'; 169 | get_key_query : PAnsiChar = 170 | 'select key from key where p = ? and q = ?;'; 171 | set_key_query : PAnsiChar = 172 | 'insert or replace into key (p, q, key) ' 173 | + 'values (?, ?, ?);'; 174 | var 175 | rc: Integer; 176 | begin 177 | if (not db_enabled) then begin 178 | Exit(0); 179 | end; 180 | rc := db_create(path, db); 181 | if (rc <> 0) then Exit(rc); 182 | rc := sqlite3_prepare_v2( 183 | db, insert_block_query, -1, insert_block_stmt, nil); 184 | if (rc <> 0) then Exit(rc); 185 | rc := sqlite3_prepare_v2( 186 | db, insert_light_query, -1, insert_light_stmt, nil); 187 | if (rc <> 0) then Exit(rc); 188 | rc := sqlite3_prepare_v2( 189 | db, insert_sign_query, -1, insert_sign_stmt, nil); 190 | if (rc <> 0) then Exit(rc); 191 | rc := sqlite3_prepare_v2( 192 | db, delete_sign_query, -1, delete_sign_stmt, nil); 193 | if (rc <> 0) then Exit(rc); 194 | rc := sqlite3_prepare_v2( 195 | db, delete_signs_query, -1, delete_signs_stmt, nil); 196 | if (rc <> 0) then Exit(rc); 197 | rc := sqlite3_prepare_v2(db, load_blocks_query, -1, load_blocks_stmt, nil); 198 | if (rc <> 0) then Exit(rc); 199 | rc := sqlite3_prepare_v2(db, load_lights_query, -1, load_lights_stmt, nil); 200 | if (rc <> 0) then Exit(rc); 201 | rc := sqlite3_prepare_v2(db, load_signs_query, -1, load_signs_stmt, nil); 202 | if (rc <> 0) then Exit(rc); 203 | rc := sqlite3_prepare_v2(db, get_key_query, -1, get_key_stmt, nil); 204 | if (rc <> 0) then Exit(rc); 205 | rc := sqlite3_prepare_v2(db, set_key_query, -1, set_key_stmt, nil); 206 | if (rc <> 0) then Exit(rc); 207 | sqlite3_exec(db, 'begin;', nil, nil, nil); 208 | db_worker_start('db_worker_start'); 209 | Result := 0; 210 | end; 211 | 212 | procedure db_close(); 213 | begin 214 | if (not db_enabled) then begin 215 | Exit; 216 | end; 217 | db_worker_stop(); 218 | sqlite3_exec(db, 'commit;', nil, nil, nil); 219 | sqlite3_finalize(insert_block_stmt); 220 | sqlite3_finalize(insert_light_stmt); 221 | sqlite3_finalize(insert_sign_stmt); 222 | sqlite3_finalize(delete_sign_stmt); 223 | sqlite3_finalize(delete_signs_stmt); 224 | sqlite3_finalize(load_blocks_stmt); 225 | sqlite3_finalize(load_lights_stmt); 226 | sqlite3_finalize(load_signs_stmt); 227 | sqlite3_finalize(get_key_stmt); 228 | sqlite3_finalize(set_key_stmt); 229 | sqlite3_close(db); 230 | end; 231 | 232 | procedure db_commit(); 233 | begin 234 | if (not db_enabled) then begin 235 | Exit; 236 | end; 237 | mtx_lock(mtx); 238 | ring_put_commit(@ring); 239 | cnd_signal(cnd); 240 | mtx_unlock(mtx); 241 | end; 242 | 243 | procedure _db_commit(); 244 | begin 245 | sqlite3_exec(db, 'commit; begin;', nil, nil, nil); 246 | end; 247 | 248 | procedure db_auth_set(username, identity_token: PAnsiChar); 249 | const 250 | query : PAnsiChar = 251 | 'insert or replace into auth.identity_token ' 252 | + '(username, token, selected) values (?, ?, ?);'; 253 | var 254 | stmt: sqlite3_stmt; 255 | begin 256 | if (not db_enabled) then begin 257 | Exit; 258 | end; 259 | sqlite3_prepare_v2(db, query, -1, stmt, nil); 260 | sqlite3_bind_text(stmt, 1, username, -1, nil); 261 | sqlite3_bind_text(stmt, 2, identity_token, -1, nil); 262 | sqlite3_bind_int(stmt, 3, 1); 263 | sqlite3_step(stmt); 264 | sqlite3_finalize(stmt); 265 | db_auth_select(username); 266 | end; 267 | 268 | function db_auth_select(username: PAnsiChar) : Integer; 269 | const 270 | query : PAnsiChar = 271 | 'update auth.identity_token set selected = 1 where username = ?;'; 272 | var 273 | stmt: sqlite3_stmt; 274 | begin 275 | if (not db_enabled) then begin 276 | Exit(0); 277 | end; 278 | db_auth_select_none(); 279 | sqlite3_prepare_v2(db, query, -1, stmt, nil); 280 | sqlite3_bind_text(stmt, 1, username, -1, nil); 281 | sqlite3_step(stmt); 282 | sqlite3_finalize(stmt); 283 | Result := sqlite3_changes(db); 284 | end; 285 | 286 | procedure db_auth_select_none(); 287 | begin 288 | if (not db_enabled) then begin 289 | Exit; 290 | end; 291 | sqlite3_exec(db, 'update auth.identity_token set selected = 0;', 292 | nil, nil, nil); 293 | end; 294 | 295 | function db_auth_get( 296 | username, 297 | identity_token: PAnsiChar; identity_token_length: Integer): Integer; 298 | const 299 | query : PAnsiChar = 300 | 'select token from auth.identity_token ' 301 | + 'where username = ?;'; 302 | var 303 | stmt: sqlite3_stmt; 304 | a: PAnsiChar; 305 | begin 306 | if (not db_enabled) then begin 307 | Exit(0); 308 | end; 309 | Result := 0; 310 | sqlite3_prepare_v2(db, query, -1, stmt, nil); 311 | sqlite3_bind_text(stmt, 1, username, -1, nil); 312 | if (sqlite3_step(stmt) = SQLITE_ROW) then begin 313 | a := sqlite3_column_text(stmt, 0); 314 | strncpy(identity_token, a, identity_token_length - 1); 315 | identity_token[identity_token_length - 1] := #0; 316 | result := 1; 317 | end; 318 | sqlite3_finalize(stmt); 319 | end; 320 | 321 | function db_auth_get_selected( 322 | username: PAnsiChar; username_length: Integer; 323 | identity_token: PAnsiChar; identity_token_length: Integer): Integer; 324 | const 325 | query : PAnsiChar = 326 | 'select username, token from auth.identity_token ' 327 | + 'where selected = 1;'; 328 | var 329 | stmt: sqlite3_stmt; 330 | a, b: PAnsiChar; 331 | begin 332 | if (not db_enabled) then begin 333 | Exit(0); 334 | end; 335 | Result := 0; 336 | sqlite3_prepare_v2(db, query, -1, stmt, nil); 337 | if (sqlite3_step(stmt) = SQLITE_ROW) then begin 338 | a := sqlite3_column_text(stmt, 0); 339 | b := sqlite3_column_text(stmt, 1); 340 | strncpy(username, a, username_length - 1); 341 | username[username_length - 1] := #0; 342 | strncpy(identity_token, b, identity_token_length - 1); 343 | identity_token[identity_token_length - 1] := #0; 344 | result := 1; 345 | end; 346 | sqlite3_finalize(stmt); 347 | end; 348 | 349 | procedure db_save_state(x, y, z, rx, ry: Single); 350 | const 351 | query : PAnsiChar = 352 | 'insert into state (x, y, z, rx, ry) values (?, ?, ?, ?, ?);'; 353 | var 354 | stmt: sqlite3_stmt; 355 | begin 356 | if (not db_enabled) then begin 357 | Exit; 358 | end; 359 | sqlite3_exec(db, 'delete from state;', nil, nil, nil); 360 | sqlite3_prepare_v2(db, query, -1, stmt, nil); 361 | sqlite3_bind_double(stmt, 1, x); 362 | sqlite3_bind_double(stmt, 2, y); 363 | sqlite3_bind_double(stmt, 3, z); 364 | sqlite3_bind_double(stmt, 4, rx); 365 | sqlite3_bind_double(stmt, 5, ry); 366 | sqlite3_step(stmt); 367 | sqlite3_finalize(stmt); 368 | end; 369 | 370 | function db_load_state(var x, y, z, rx, ry: Single): Boolean; 371 | const 372 | query : PAnsiChar = 373 | 'select x, y, z, rx, ry from state;'; 374 | var 375 | stmt: sqlite3_stmt; 376 | begin 377 | if (not db_enabled) then begin 378 | Exit(False); 379 | end; 380 | result := False; 381 | sqlite3_prepare_v2(db, query, -1, stmt, nil); 382 | if (sqlite3_step(stmt) = SQLITE_ROW) then begin 383 | x := sqlite3_column_double(stmt, 0); 384 | y := sqlite3_column_double(stmt, 1); 385 | z := sqlite3_column_double(stmt, 2); 386 | rx := sqlite3_column_double(stmt, 3); 387 | ry := sqlite3_column_double(stmt, 4); 388 | Result := True; 389 | end; 390 | sqlite3_finalize(stmt); 391 | end; 392 | 393 | procedure db_insert_block(p, q, x, y, z, w: Integer); 394 | begin 395 | if (not db_enabled) then begin 396 | Exit; 397 | end; 398 | mtx_lock(mtx); 399 | ring_put_block(@ring, p, q, x, y, z, w); 400 | cnd_signal(cnd); 401 | mtx_unlock(mtx); 402 | end; 403 | 404 | procedure _db_insert_block(p, q, x, y, z, w: Integer); 405 | begin 406 | sqlite3_reset(insert_block_stmt); 407 | sqlite3_bind_int(insert_block_stmt, 1, p); 408 | sqlite3_bind_int(insert_block_stmt, 2, q); 409 | sqlite3_bind_int(insert_block_stmt, 3, x); 410 | sqlite3_bind_int(insert_block_stmt, 4, y); 411 | sqlite3_bind_int(insert_block_stmt, 5, z); 412 | sqlite3_bind_int(insert_block_stmt, 6, w); 413 | sqlite3_step(insert_block_stmt); 414 | end; 415 | 416 | procedure db_insert_light(p, q, x, y, z, w: Integer); 417 | begin 418 | if (not db_enabled) then begin 419 | Exit; 420 | end; 421 | mtx_lock(mtx); 422 | ring_put_light(@ring, p, q, x, y, z, w); 423 | cnd_signal(cnd); 424 | mtx_unlock(mtx); 425 | end; 426 | 427 | procedure _db_insert_light(p, q, x, y, z, w: Integer); 428 | begin 429 | sqlite3_reset(insert_light_stmt); 430 | sqlite3_bind_int(insert_light_stmt, 1, p); 431 | sqlite3_bind_int(insert_light_stmt, 2, q); 432 | sqlite3_bind_int(insert_light_stmt, 3, x); 433 | sqlite3_bind_int(insert_light_stmt, 4, y); 434 | sqlite3_bind_int(insert_light_stmt, 5, z); 435 | sqlite3_bind_int(insert_light_stmt, 6, w); 436 | sqlite3_step(insert_light_stmt); 437 | end; 438 | 439 | procedure db_insert_sign( 440 | p, q, x, y, z, face: Integer; text: PAnsiChar); 441 | begin 442 | if (not db_enabled) then begin 443 | Exit; 444 | end; 445 | sqlite3_reset(insert_sign_stmt); 446 | sqlite3_bind_int(insert_sign_stmt, 1, p); 447 | sqlite3_bind_int(insert_sign_stmt, 2, q); 448 | sqlite3_bind_int(insert_sign_stmt, 3, x); 449 | sqlite3_bind_int(insert_sign_stmt, 4, y); 450 | sqlite3_bind_int(insert_sign_stmt, 5, z); 451 | sqlite3_bind_int(insert_sign_stmt, 6, face); 452 | sqlite3_bind_text(insert_sign_stmt, 7, text, -1, nil); 453 | sqlite3_step(insert_sign_stmt); 454 | end; 455 | 456 | procedure db_delete_sign(x, y, z, face: Integer); 457 | begin 458 | if (not db_enabled) then begin 459 | Exit; 460 | end; 461 | sqlite3_reset(delete_sign_stmt); 462 | sqlite3_bind_int(delete_sign_stmt, 1, x); 463 | sqlite3_bind_int(delete_sign_stmt, 2, y); 464 | sqlite3_bind_int(delete_sign_stmt, 3, z); 465 | sqlite3_bind_int(delete_sign_stmt, 4, face); 466 | sqlite3_step(delete_sign_stmt); 467 | end; 468 | 469 | procedure db_delete_signs(x, y, z: Integer); 470 | begin 471 | if (not db_enabled) then begin 472 | Exit; 473 | end; 474 | sqlite3_reset(delete_signs_stmt); 475 | sqlite3_bind_int(delete_signs_stmt, 1, x); 476 | sqlite3_bind_int(delete_signs_stmt, 2, y); 477 | sqlite3_bind_int(delete_signs_stmt, 3, z); 478 | sqlite3_step(delete_signs_stmt); 479 | end; 480 | 481 | procedure db_delete_all_signs(); 482 | begin 483 | if (not db_enabled) then begin 484 | Exit; 485 | end; 486 | sqlite3_exec(db, 'delete from sign;', nil, nil, nil); 487 | end; 488 | 489 | procedure db_load_blocks(map: pMap; p, q: Integer); 490 | var 491 | x, y, z, w: Integer; 492 | begin 493 | if (not db_enabled) then begin 494 | Exit; 495 | end; 496 | mtx_lock(load_mtx); 497 | sqlite3_reset(load_blocks_stmt); 498 | sqlite3_bind_int(load_blocks_stmt, 1, p); 499 | sqlite3_bind_int(load_blocks_stmt, 2, q); 500 | while (sqlite3_step(load_blocks_stmt) = SQLITE_ROW) do begin 501 | x := sqlite3_column_int(load_blocks_stmt, 0); 502 | y := sqlite3_column_int(load_blocks_stmt, 1); 503 | z := sqlite3_column_int(load_blocks_stmt, 2); 504 | w := sqlite3_column_int(load_blocks_stmt, 3); 505 | map_set(map, x, y, z, w); 506 | end; 507 | mtx_unlock(load_mtx); 508 | end; 509 | 510 | procedure db_load_lights(map: pMap; p, q: Integer); 511 | var 512 | x, y, z, w: Integer; 513 | begin 514 | if (not db_enabled) then begin 515 | Exit; 516 | end; 517 | mtx_lock(load_mtx); 518 | sqlite3_reset(load_lights_stmt); 519 | sqlite3_bind_int(load_lights_stmt, 1, p); 520 | sqlite3_bind_int(load_lights_stmt, 2, q); 521 | while (sqlite3_step(load_lights_stmt) = SQLITE_ROW) do begin 522 | x := sqlite3_column_int(load_lights_stmt, 0); 523 | y := sqlite3_column_int(load_lights_stmt, 1); 524 | z := sqlite3_column_int(load_lights_stmt, 2); 525 | w := sqlite3_column_int(load_lights_stmt, 3); 526 | map_set(map, x, y, z, w); 527 | end; 528 | mtx_unlock(load_mtx); 529 | end; 530 | 531 | procedure db_load_signs(list: pSignList; p, q: Integer); 532 | var 533 | x, y, z, face: Integer; 534 | text: PAnsiChar; 535 | begin 536 | if (not db_enabled) then begin 537 | Exit; 538 | end; 539 | sqlite3_reset(load_signs_stmt); 540 | sqlite3_bind_int(load_signs_stmt, 1, p); 541 | sqlite3_bind_int(load_signs_stmt, 2, q); 542 | while (sqlite3_step(load_signs_stmt) = SQLITE_ROW) do begin 543 | x := sqlite3_column_int(load_signs_stmt, 0); 544 | y := sqlite3_column_int(load_signs_stmt, 1); 545 | z := sqlite3_column_int(load_signs_stmt, 2); 546 | face := sqlite3_column_int(load_signs_stmt, 3); 547 | text := sqlite3_column_text( 548 | load_signs_stmt, 4); 549 | sign_list_add(list, x, y, z, face, text); 550 | end; 551 | end; 552 | 553 | function db_get_key(p, q: Integer): Integer; 554 | begin 555 | if (not db_enabled) then begin 556 | Exit(0); 557 | end; 558 | Result := 0; 559 | sqlite3_reset(get_key_stmt); 560 | sqlite3_bind_int(get_key_stmt, 1, p); 561 | sqlite3_bind_int(get_key_stmt, 2, q); 562 | if (sqlite3_step(get_key_stmt) = SQLITE_ROW) then begin 563 | Result := sqlite3_column_int(get_key_stmt, 0); 564 | end; 565 | end; 566 | 567 | procedure db_set_key(p, q, key: Integer); 568 | begin 569 | if (not db_enabled) then begin 570 | Exit; 571 | end; 572 | mtx_lock(mtx); 573 | ring_put_key(@ring, p, q, key); 574 | cnd_signal(cnd); 575 | mtx_unlock(mtx); 576 | end; 577 | 578 | procedure _db_set_key(p, q, key: Integer); 579 | begin 580 | sqlite3_reset(set_key_stmt); 581 | sqlite3_bind_int(set_key_stmt, 1, p); 582 | sqlite3_bind_int(set_key_stmt, 2, q); 583 | sqlite3_bind_int(set_key_stmt, 3, key); 584 | sqlite3_step(set_key_stmt); 585 | end; 586 | 587 | procedure db_worker_start(path : PAnsiChar); 588 | begin 589 | if (not db_enabled) then begin 590 | Exit; 591 | end; 592 | ring_alloc(@ring, 1024); 593 | mtx_init(mtx, mtx_plain); 594 | mtx_init(load_mtx, mtx_plain); 595 | cnd_init(cnd); 596 | thrd_create(thrd, db_worker_run, path); 597 | end; 598 | 599 | procedure db_worker_stop(); 600 | begin 601 | if (not db_enabled) then begin 602 | Exit; 603 | end; 604 | mtx_lock(mtx); 605 | ring_put_exit(@ring); 606 | cnd_signal(cnd); 607 | mtx_unlock(mtx); 608 | thrd_join(thrd, nil); 609 | cnd_destroy(cnd); 610 | mtx_destroy(load_mtx); 611 | mtx_destroy(mtx); 612 | ring_free(@ring); 613 | end; 614 | 615 | function db_worker_run(arg: Pointer): Integer; 616 | var 617 | running: Boolean; 618 | e: TRingEntry; 619 | begin 620 | running := True; 621 | while (running) do begin 622 | mtx_lock(mtx); 623 | while (not ring_get(@ring, @e)) do begin 624 | cnd_wait(cnd, mtx); 625 | end; 626 | mtx_unlock(mtx); 627 | case (e.&type) of 628 | BLOCK: 629 | _db_insert_block(e.p, e.q, e.x, e.y, e.z, e.w); 630 | LIGHT: 631 | _db_insert_light(e.p, e.q, e.x, e.y, e.z, e.w); 632 | KEY: 633 | _db_set_key(e.p, e.q, e.key); 634 | COMMIT: 635 | _db_commit(); 636 | EXIT_: 637 | running := False; 638 | end; 639 | end; 640 | Result := 0; 641 | end; 642 | 643 | end. 644 | -------------------------------------------------------------------------------- /src/DelphiCraft.dpr: -------------------------------------------------------------------------------- 1 | program DelphiCraft; 2 | 3 | { 4 | Delphi Tokyo conversion of Craft by Michael Fogleman 5 | https://www.michaelfogleman.com/projects/craft/ 6 | 7 | (c)2017-2018 by Paul TOTH 8 | http://www.execute.fr 9 | } 10 | 11 | {$R *.res} 12 | 13 | // https://github.com/neslib/DelphiGlfw 14 | 15 | uses 16 | Neslib.glfw3 in '..\deps\Neslib.glfw3.pas', 17 | Execute.CrossGL in '..\lib\Execute.CrossGL.pas', 18 | Execute.SysUtils in '..\lib\Execute.SysUtils.pas', 19 | Execute.Inflate in '..\lib\Execute.Inflate.pas', 20 | Execute.PNGLoader in '..\lib\Execute.PNGLoader.pas', 21 | Execute.Textures in '..\lib\Execute.Textures.pas', 22 | Execute.SQLite3 in '..\lib\Execute.SQLite3.pas', 23 | MarcusGeelnard.TinyCThread in 'MarcusGeelnard.TinyCThread.pas', 24 | CaseyDuncan.noise in 'CaseyDuncan.noise.pas', 25 | Craft.Main in 'Craft.Main.pas', 26 | Craft.Util in 'Craft.Util.pas', 27 | Craft.Cube in 'Craft.Cube.pas', 28 | Craft.Matrix in 'Craft.Matrix.pas', 29 | Craft.Config in 'Craft.Config.pas', 30 | Craft.Map in 'Craft.Map.pas', 31 | Craft.Sign in 'Craft.Sign.pas', 32 | Craft.db in 'Craft.db.pas', 33 | Craft.Client in 'Craft.Client.pas', 34 | Craft.Item in 'Craft.Item.pas', 35 | Craft.Ring in 'Craft.Ring.pas', 36 | Craft.Render in 'Craft.Render.pas', 37 | Craft.Chunk in 'Craft.Chunk.pas', 38 | Craft.Player in 'Craft.Player.pas', 39 | Craft.Auth in 'Craft.Auth.pas'; 40 | 41 | begin // main 42 | main(); 43 | end. 44 | -------------------------------------------------------------------------------- /src/MarcusGeelnard.TinyCThread.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tothpaul/DelphiCraft/31ed68b176ae7e347b60b1324e0c6c9221ffdb24/src/MarcusGeelnard.TinyCThread.pas --------------------------------------------------------------------------------