updated with basic run-time text
Code: Select all
/' -- wamu hash - 2021 Aug 31, by dafhi
keyboard: Q, W, arrows
Wamu is a hash-based RNG, shorthand for Warmup Multiplexer. My brain posted the name ;)
algo highlights:
1. stable period
2. many even multipliers produce good results
3. developed for procedural graphics
[ updates ]
Aug 31
---
- added
intro loop
Aug 30
---
- added
run-time text
- renamed
mul0, add0 -> mulA, addA
- removed
min(), max(), ROTL() [unused defines], small_mask, bucket test and algo name info
'/
type statelit as ulong '' generator size
/' hash util
'/
const lenx8 = len(statelit) * 8
/' util
'/
#define def #define
/' less typing
'/
#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
''
namespace myhash
dim as statelit a,b,c,d,e,f '' states
dim as statelit mulA = 1
dim as statelit addA = 1
/' output function -- populate "a" quickly given likelihood of small input "i"
'/
function warmup(i as ulongint = 0) as statelit
const m = lenx8 / 2 - 1
f = mulA * (i + addA) '' future iterative stream RNG will use states (a d e f)
f xor= (i shr 1) '' stabilizes period for some reason
e = f + f shr (f mod m)
d = e xor (f shr 1)
a = d + d shl m
return a
end function
End Namespace
def rng myhash.warmup '' non-float
function bpp_col(i as statelit = 0) as ulongint
dim as ubyte c
def q rng
select case as const lenx8
case 8
return q(i)*(1+256+65536)
case 16
return (q(i) shl 8) xor q(i+0)
case 32
return q(i)
case 64
return q(i)
End Select
End Function
const COLOR_ON = rgb(165,195,235)
const COLOR_OFF = rgb(40,110,210)
sub PixelBits( x as short, y as short, i as statelit = 0, pix_size as statelit = 4)
var lenm = pix_size - 1
var valu = bpp_col(i)
for shift as long = lenx8-1 to 0 step -1
dim as ulong col = IIF( (valu shr shift)and 1, COLOR_ON, COLOR_OFF )
line (x,y)-(x+lenm, y+lenm),col, bf
x += pix_size
Next
End Sub
const w = 256 * 3, _
h = 256 * 2
sub raw_pattern( pel_size int = 1, cols int = 0, rows int = 0, bit_level as boolean = false)
var magnify = cols or rows
var _x = iif( cols = 0, 0, 2)
var _y = iif( rows = 0, 0, 2)
var stepx = lenx8*pel_size
if magnify or bit_level then
line (_x-1, _y-1) - (_x + cols * stepx, _y + rows * pel_size), rgb(0,0,0), bf
if cols=0 then cols = w \ stepx
if rows=0 then rows = h \ pel_size
dim as statelit i
for x int = _x to _x + (cols-1) * stepx step stepx
for y int = _y to _y + (rows-1) * pel_size step pel_size
PixelBits x, y, i, pel_size
i += 1
next
next
else
for y int = _y to h - 1
for x int = _x to w - 1
var i = (bpp_col((x-_x)*h+(y-_y)) and &HFFFFFF)
pset (x, y), i
Next
Next
EndIf
end sub
function variable_name( p as any ptr) as string
select case p
case @myhash.addA
return "addA"
case @myhash.mulA
return "mulA"
End Select
End Function
sub graphics_page(byref p0 as statelit ptr)
screenlock
var bit_level = false
raw_pattern 1, 0,0, bit_level
var cols = 1
var rows = 64
var pixel_size = 6
raw_pattern pixel_size, cols, rows
locate 51,1
? "adjusting "; variable_name(p0);": "; *p0
screenunlock
End Sub
sub graphics_intro(byref p0 as statelit ptr)
var mulA = 1f
dim int sleepval = 100
for i int = 1 to 9
myhash.mulA = mulA
graphics_page p0
mulA *= 3
sleep sleepval
sleepval *= .6
Next
End Sub
sub Main
screenres w, h, 32
var intro_message_key_tick = 60
var p0 = @myhash.mulA
graphics_intro p0
dim as long _k
do
graphics_page p0
if intro_message_key_tick then
locate 46,1
? " keys: Q, W, arrows"
intro_message_key_tick -= 1
endif
_k = getkey
dim as string k = chr(_k and 255)
if k=chr(27) then exit do
if k = " " then exit do
select case ucase(k)
case "Q"
p0 = @myhash.mulA
case "W"
p0 = @myhash.addA
End Select
k = chr(_k shr 8)
'' up down
if k[0] = 72 then *p0 *= 1.75
if k[0] = 80 then *p0 *= .67
'' left right
if k[0] = 75 then *p0 -= 1
if k[0] = 77 then *p0 += 1
loop
End sub
Main
