General FreeBASIC programming questions.
dafhi
Posts: 1470
Joined: Jun 04, 2005 9:51

2 patterns found while attempting a RNG

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
``````
More to come