procedural graphics thread

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

procedural graphics thread

Post by dafhi »

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
Post Reply