procedural graphics thread

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

procedural graphics thread

Postby dafhi » Sep 15, 2021 5:31

First (of many?) which I can't help but share

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(intro_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

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests