Code: Select all
/' -- gamma checkerboard - 2021 Sep 26, by dafhi
'/
type statelit as ubyte '' hash state
''
#define def #define
#undef int
def int As integer
def sng as single
def flo(x) (((x)*2.0-0.5)shr 1) ' replaces int() - http://www.freebasic.net/forum/viewtopic.php?p=118633
const lenx8 = len(statelit) * 8
const as ubyte sh2 = lenx8 / 2
const as ubyte sh4 = lenx8 / 4
const as ubyte sh8 = lenx8 / 8
const as statelit mask = -1
const as statelit mask4 = 2^sh4 - 1
const as statelit mask2 = 2^sh2 - 1
const as ubyte shm = lenx8 - 1
const as ubyte sh2m = sh2 - 1
const as ubyte sh4m = sh4 - 1
const as ubyte sh8m = sh8 - 1
const int roshl = 3 + log(len(statelit)) / log(2) '' for example, 5 mask bits to rotate 32 bits
const int roshr = lenx8 - roshl
const int romask = 2 ^ roshl - 1
'' xorshift
sub xs( byref q as statelit, sh int = 1) ' param 2 negative shifts right
q xor= ((q shr -sh) * -(sh < 0)) or ((q shl sh) * -(sh > 0))
end sub
namespace myhash
dim as statelit a,b,c,d,e,f '' states
dim as ulongint addA = 1
dim as ulongint mulA = 4
dim int shA=1, shB=1, shC=1, shd=1
function warmup(i as ulongint = 0) as statelit '' hash function
a = i
i xor= a * &b1000100101
a xor= i shr shm
i xor= a * mulA
a += i shr shm
return a
end function
End Namespace
def rng myhash.warmup '' non-float
const w = 256 * 3, _
h = 256 * 2
sub show_pattern( ix0 int = 0, iy0 int = 0)
static int _w, _h, bpp, bypp, pitch, rate, pitchBy
static as any ptr pixels
static as ulong ptr p32
ScreenInfo _w,_h, bpp, bypp, pitch, rate: pixels = screenptr
pitchBy = pitch \ 4
dim as ulong c
for x int = 0 to w - 1
p32 = pixels
p32 += x
var ix = (ix0+x) * h + iy0
for y int = ix to ix + h - 1
select case as const lenx8
case 8
c = rng(y) * (1 + 256 + 65536)
case 16
c = ( rng(y)shl 8 ) xor rng(y+1)
case else
c = rng(y)
end select
*p32 = c
p32 += pitchBy
Next
Next
end sub
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif
sub Main
windowtitle "procedural 2d opalescent wood"
screenres w, h, 32
var demo_seconds = 50
var intro_seconds = 2.5
var help_seconds = 5
var t = timer, t_end = t + demo_seconds
var t_intro_end = t + intro_seconds
var t_help_end = t_intro_end + help_seconds
dim sng angle, rad = 5000
dim sng cx = 0
dim sng cy = 0
var p0 = @myhash.a
dim as long _k
do
screenlock
show_pattern cx + rad * cos(angle), cy + rad * sin(angle)
locate 2,5
var s = _
iif( t<t_intro_end, _
"movement ends after " + str(demo_seconds) + " seconds", _
iif( t<t_help_end, _
" 1 byte state ftw!", _
"") )
? s
screenunlock
angle += .0001
sleep 15
var k = inkey
select case lcase(k)
case chr(27), " "
exit do
End Select
t = timer
if t > t_end then exit do
loop
?
? "demo finished."
sleep
End sub
Main
Code: Select all
/' -- procedural opalescent wood (RNG artifact) - 2021 Sep 14, by dafhi
it should be noted: pattern depends upon render resolution
'/
type statelit as ulong '' generator
/' util
'/
#define def #define
#undef int
def int As integer
def sng as single
def flo(x) (((x)*2.0-0.5)shr 1) '' replaces int() - http://www.freebasic.net/forum/viewtopic.php?p=118633
''
const lenx8 = len(statelit) * 8
const int roshl = 3 + log(len(statelit)) / log(2) '' for example, 5 mask bits to rotate 32 bits
const int roshr = lenx8 - roshl
const int romask = 2 ^ roshl - 1
namespace myhash
dim as statelit a,b,c,d,e,f '' states
const sh2 = lenx8 / 2
const sh3 = lenx8 / 3
const sh4 = lenx8 / 4
const sh6 = lenx8 / 6
const mask = lenx8 - 1
const mask4 = sh4 - 1
const mask2 = sh2 - 1
'' hash function
function warmup(i as ulongint = 0) as statelit
a = i
a *= 3
a xor= i shr 1
a *= 5
a xor= a shr 19
a *= 7
a xor= a shr sh2
a += a shl (a and mask)
return a
end function
End Namespace
def rng myhash.warmup '' non-float
const w = 256 * 3, _
h = 256 * 2
sub show_pattern( ix0 int = 0, iy0 int = 0)
static int _w, _h, bpp, bypp, pitch, rate, pitchBy
static as any ptr pixels
static as ulong ptr p32
ScreenInfo _w,_h, bpp, bypp, pitch, rate: pixels = screenptr
pitchBy = pitch \ 4
const int density = (2 ^ lenx8) / 320
dim as ulong c
for x int = 0 to w - 1
p32 = pixels: p32 += x
var ix = (ix0+x) * h + iy0
for y int = 0 to h-1
var i = y + ix
select case as const lenx8
case 8
c = rng(i) * (1 + 256 + 65536)
case 16
c = ( rng(i)shl 8 ) xor rng(i+1)
case else
c = rng(i)
end select
'c *= rng(c) < density
*p32 = c
p32 += pitchBy
'pset (x, y), c
Next
Next
end sub
#include "fbgfx.bi"
#if __FB_LANG__ = "fb"
Using FB '' Scan code constants are stored in the FB namespace in lang FB
#endif
sub Main
windowtitle "procedural 2d opalescent wood"
screenres w, h, 32
var demo_seconds = 50
var intro_seconds = 2.5
var help_seconds = 5
var t = timer, t_end = t + demo_seconds
var t_intro_end = t + intro_seconds
var t_help_end = t_intro_end + help_seconds
dim sng angle, rad = 5000
dim sng cx = 0
dim sng cy = 0
var p0 = @myhash.a
dim as long _k
do
screenlock
show_pattern cx + rad * cos(angle), cy + rad * sin(angle)
locate 2,5
var s = iif( t < t_intro_end, _
"auto-quit after " + str(demo_seconds) + " seconds", _
iif( t < t_help_end, " opalescent wood pattern found .." + chr(10) _
+ ".. while developing hash function", "") _
)
? s
screenunlock
angle += .0001
sleep 15
var k = inkey
select case lcase(k)
case chr(27), " "
exit do
End Select
t = timer
if t > t_end then exit do
loop
?
? "demo finished. exiting .."
sleep 1500
End sub
Main