Procedural block world project

User projects written in or related to FreeBASIC.
Post Reply
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Procedural block world project

Post by dafhi »

my god. i'm developing a simplex noise.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

why? simplex is just smooth gradient noise
fractal or some kind of radial motion is cooler.. or the holy grail - erosion

im definitely not saying you shouldn't!
you are trying to invent a new noise? =) probably not easy, but lots to learn
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Procedural block world project

Post by dafhi »

yes a new type, based on a string of linear gradient runs. simplex is above me atm :)

Code: Select all

type myint as integer

type imagevars          '' 2018 Jun 28 - by dafhi
  '1. quick reference for ScreenInfo & ImageInfo
  '2. encapsulate standard metrics
  '3. convenient additional vars, subs and functions
  as myint              w,h,bpp,bypp,pitch,rate,  wm, hm, num_pages, flags, pitchBy, ub 'helpers
  as string             driver_name
  as any ptr            im, pixels
  as ulong ptr          p32
  declare sub           get_info(as any ptr=0)
  declare sub           create(as short, as short, as ulong=rgb(255,0,255))
  declare sub           blit(byref as imagevars ptr=0, as myint=0, as myint=0)
  declare sub           cls(as ulong=0)
  declare constructor   (as any ptr=0)
  as single             wh, hh, diagonal
  declare sub           release
  declare               destructor
end type
Destructor.imagevars:  release
End Destructor
Sub imagevars.release
  If ImageInfo(im) = 0 Then ImageDestroy im
  im = 0
End Sub
constructor.imagevars(im as any ptr) ' 2018 June 28
  if im=0 then get_info:  exit constructor
  if ImageInfo(im) = 0 then get_info im
end constructor
sub imagevars.get_info(im as any ptr)
  release
  if im=0 then:  pixels=screenptr
    ScreenInfo w,h, bpp,, pitch, rate, driver_name:  bypp=bpp\8 '2018 Jan 9
  elseif Imageinfo(im)=0 then
    ImageInfo im, w, h, bypp, pitch, pixels
    bpp = bypp * 8:  this.im = im
  endif:  pitchBy=pitch\bypp
  wm=w-1: wh=w/2:  diagonal = sqr(w*w+h*h)
  hm=h-1: hh=h/2:  p32=pixels
end sub
sub imagevars.create(w as short, h as short, col as ulong)
  get_info imagecreate(w, h, col)
END SUB
sub imagevars.blit(byref dest as imagevars ptr, _x as myint, _y as myint)
  dim as ulong ptr ps = pixels, pd = dest->pixels
  ps += _x*(_x<0) + pitchBy*(_y)*(_y<0)
  pd -= _x*(_x>0) + dest->pitchBy*_y*(_y>0)
  _x = (_x+wm-dest->wm)*((_x+wm)>dest->wm)+wm-_x*(_x<0)'' x and y repurposed to clipped width and height
  _y = (_y+hm-dest->hm)*((_y+hm)>dest->hm)+hm-_y*(_y<0)'' wm = w-1, hm = h-1
  for y as ulong ptr = pd to @pd[(_y)*dest->pitchBy] step dest->pitchBy
    dim as ulong ptr src = ps
    for x as ulong ptr = y to @y[_x]
      *x = *src:  src+=1
    next: ps += pitchBy
  next
end sub
Sub Imagevars.Cls(pColor As ulong)
  Dim As Ulong cpy_ = pitchBy * h
  Dim As Ulong Ptr dest = pixels
  ''http://www.freebasic.net/forum/viewtopic.php?t=15809&
  Asm mov eax, [pcolor]
  Asm mov edi, [dest]
  Asm mov ecx, [cpy_]
  Asm rep stosd
End Sub
'                             '
'                             '
' --------------------------- '

Const   GrayScaleARGB = 1 + 256 + 65536 + 16777216

#Define floor(x) (((x)*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))

dim shared as single tmpMod

#Macro Modulus(pValue,pModulus)
  tmpMod = pModulus
  pValue -= tmpMod * floor(pValue / tmpMod)
#EndMacro

Function Min(ByVal in1 As Single, ByVal in2 As Single) As Single
  If in1 < in2 Then  Return in1
  Return in2
End Function

' ----------------------------- '
'        GradientRibbon         '
'                               '

/' copy-paste for a quick introduction

Dim As Single       lo = 0
Dim As Single       hi = 255
Dim As Single       lenBaseUB = 0     '' base+1 = min run sample count
Dim As Single       lenVari = 5       '' base + Rnd * vari
Dim As UShort       sectsBaseUB = 4   '' 0 will equal 1 run
Dim As UShort       sectsVari = 4     '' base+1 + Rnd * vari = section count
Dim As Single       shatter = 0.0     '' 0 to 1 .. value disparity chance where runs connect
Dim As UByte        supersample = 5   '' useful for sub-pixel stuff

Dim as GradientRibbon G1
G1.Create( lo,hi,lenbase,lenvari,sectsBaseUB,sectsVari,shatter, supersample )

Dim As gPixelVal Ptr   src = @G1.result[0]
For I as integer = 0 to G1.modulus - 1 ''G1.Modulus is the actual last element, a copy of src[0]
  ? src[I]
Next

'/


'' use this to define your output
Type gPixelVal        As Short

'' GradientRibbon can be made of many small linear gradient runs

'' This defines max length of a run
Type gsLen_t          As UShort
'' The calculation for a run is: SuperSample * (lenBaseUB + lenVari),
'' So 256 * (256 + Rnd * 255) could overflow.
'' Adjust gsLen_t to UInteger if necessary.

Type GradientRibbon
  As String           result
  As Integer          modulus
  As Integer          super_samp
  As Single           userPos, userStep '' helper var to track position
  Declare Sub Create(ByVal Low As gPixelVal = 0, ByVal High As gPixelVal = 1, ByVal LenBaseUB As gsLen_t = 3, ByVal LenVari As gsLen_t = 0, ByVal SectsBaseUB As UShort = 0, ByVal SectsVari As Ushort = 0, ByVal shatter As Single = 0.2, ByVal SuperSample As UByte = 0)
End Type

Sub GradientRibbon.Create(ByVal Low As gPixelVal, ByVal High As gPixelVal, ByVal LenBaseUB As gsLen_t, ByVal LenVari As gsLen_t, ByVal SectsBaseUB As UShort, ByVal SectsVari As UShort, ByVal shatter As Single, ByVal SuperSample As UByte)

  Dim As Single   lh_delt = high - low
  Dim As Integer  Sections = SectsBaseUB+1 + Rnd * SectsVari
 
  modulus = 0
  Dim As Single   val_E(1 To sections)
  Dim As Single   val_S(1 To sections)
  Dim As gsLen_t  gLen(1 To sections)
  Dim As integer  I=Sections, J', K
  Dim As Single   sval
 
  super_samp = SuperSample + 1
  userStep = super_samp

  LenBaseUB += 1 
  LenBaseUB *= super_samp
  LenVari *= super_samp

  If sections > 1 Then
    For J = 1 To Sections
      sval = low + Rnd * lh_delt
      val_E(I) = sval
      If Rnd < shatter Then
        val_S(J) = low + Rnd * lh_delt
      Else
        val_S(J) = sval
      EndIf
      gLen(I) = LenBaseUB + Rnd * LenVari
      modulus += gLen(I)
      I = J
    Next
  Else
    modulus = LenBaseUB + Rnd * LenVari
    gLen(1) = modulus
    val_S(1) = low + Rnd * lh_delt
    val_E(1) = low + Rnd * lh_delt
  End If
 
  result = Space( (modulus+1) * Len(gPixelVal) )
 
  Dim As Integer        Q
  Dim As gPixelVal Ptr  p_pixel = @result[0]
 
  #Macro Gradiate()
 
    p_pixel[Q] = floor(sval)
    Q += 1
   
    Dim As Single sval_S = val_S(J) + 0.5
    lh_delt = val_E(J) - sval_S
    Dim As Single L = 1
    Dim As Single sLen = gLen(I)
    sval_S += 0.5
    For Q = Q To Q + gLen(I) - 2
      sval = sval_S + (L / sLen) * lh_delt
      p_pixel[Q] = floor(sval)
      L += 1
    Next
    I = J
  #EndMacro
   
  If Sections > 1 Then
    For J = 1 To Sections
      sval = 0.5 * ( val_E(I)+val_S(J) ) + 0.5
      Gradiate()
    Next
  Else
    J = 1
    sval = val_S(J) + 0.5
    Gradiate()
  End If
 
  p_pixel[Q] = p_pixel[0]
 
End Sub
'                        '
' ---------------------- '

' ---------------------- '
'                        '
#Macro ScanOut( GRAD, dest_max )

  X = 0
  src = @GRAD.result[0]
 
  While X < dest_max
    Modulus(GRAD.userPos,GRAD.modulus)
    Dim As Integer  deltaSRC = (GRAD.modulus - GRAD.userPos) \ GRAD.userStep
    Dim As Integer  deltaDST = dest_max - X
    Dim As Integer  delta = Min(deltaSRC,deltaDST)
    dest_ = dest + X
    For dest_for_next = dest_ To dest_ + delta
      *dest_for_next = src[GRAD.userPos]
      GRAD.userPos += GRAD.userStep
    Next
    X += delta
  Wend

#EndMacro
'                        '
' ---------------------- '

' ---------------
'     Main
' -------------

Dim As Integer            scale = 1, scaleM = scale-1, yHeight = 120

Dim Shared As Single      lo = 0
Dim Shared As Single      hi = 127.5
Dim Shared As Single      lenBaseUB = 5
Dim Shared As Single      lenVari = 10
Dim Shared As UShort      sectsBaseUB = 5
Dim Shared As UShort      sectsVari = 1
Dim Shared As Single      shatter = 0.0 '' 0 to 1
Dim Shared As UByte       supersample = 19
Sub QuickDef(ByRef Grad As GradientRibbon, pAry() As Single, ByVal UB_ As Integer)
  Grad.Create( lo,hi,lenBaseUB,lenvari,sectsBaseUB,sectsVari,shatter, supersample )
  ReDim pAry(UB_)
End Sub


screenres 480, 360, 32

Dim As imagevars          Img
img.get_info

Dim As GradientRibbon     XA,XB
Dim As Single             x_a(),x_b()

QuickDef XA, x_a(), Img.wm
QuickDef XB, x_b(), Img.wm

Dim As Single Ptr         dest, dest_, dest_for_next
Dim As gPixelVal Ptr      src
Dim As Integer            X

XA.userPos = 0
XB.userPos = 0
dest = @x_a(0)
ScanOut(XA, Img.wm)
dest = @x_b(0)
ScanOut(XB, Img.wm)
For x As Integer = 0 To Img.wm
  Dim As UInteger alph = ( x_a(x) + x_b(x) )
  Line (x,0)-(x,img.hm),alph
  PSet (x, img.hm - 0.2 * alph), &HFFFFFF
Next

Sleep
Last edited by dafhi on Jul 20, 2018 5:03, edited 2 times in total.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

in procedural noise, you have to work with frequencies, not "number of points"
you should create a permutation table with ie. 255 values and interpolate from it to get good _random_ infinite noise
the only improvement over gradient noise that you could make would be the ability to control the slopes, the ability to retrieve the tangents (steepness) and such... tangents are crucial.. if you could do that, the noise would be invaluable even if slow
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Procedural block world project

Post by dafhi »

alright. i'm figuring out stuff as I go. my idea is that I'm creating a LUT, and using 2 LUTS, I get a much longer sequence. I still end up creating rectangular groupings :\

i'm familiar with fractals as far as the mandelbrot set. I've also done some more exotic ones based on higher dimensional sets, but using my own arbitrary + - a*b combos.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

that is, if you intend to make gradiented noise..
there are other types also such as waveform based (gabor kernels), distance-based (voronoi/worley)
theres also octave-based noises, like you mentioned: fractals, which are very interesting
the most common one being ridged multifractals
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Post by Lachie Dazdarian »

ERROR: Your video card does not support VBO's (OpenGL 1.2+). Exiting.
This didn't happen before. :(
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

If glGenBuffersARB = NULL Then
LogAndExit("ERROR: Your video card does not support VBO's (OpenGL 1.2+). Exiting.")
EndIf

well, not much i can do about this except ask you if you have the latest drivers
glGenBuffersARB belongs to VBO's which are fundamental in opengl, and is even supported on acer craptops! with intel integrated chips... hehe

as for the next lines are that particular test, in the end the game requires opengl 3.0, and as such i dont recommend running it without at least say a mobile nvidia geforce 300M, or a stationary nvidia gtx 265+

EDIT:
try this exe, it will check and log if the window was allowed to open (or not):
http://fbcraft.fwsnet.net/testclient.exe

if it says it failed to open a HDR window, it will try to open a normal one... but any drivers not supporting hdr most likely doesn't support opengl 3.0.. its a worth a try though :)
at the very least, the window should open now, and ive also disabled the opengl 3.3 mode request
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Post by Lachie Dazdarian »

GeForce 8600 GTS
DirectX 9.0c

Pretty sure I got the right drivers. BioShock runs fine on my PC. I know it's an old game, but...it runs.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

The GeForce 8 series arrived with NVIDIA's first unified shader Direct3D 10 Shader Model 4.0 / OpenGL 2.1(later drivers have OpenGL 3.3 support)

so yes, it should work with the right drivers =)
once you get it to work, try setting sectors_axis to 32 from 48 in the config, and youll get much better fps
32 is equal to minecraft "far" setting

ok, i have updated the client with hdr-less compatibility
i have also uploaded a new (very small) world, that should function with the latest client
as usual major changes are in the pipeline and not everything works for the testers :)
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Post by Lachie Dazdarian »

That seemed to help, but now the game is loading forever.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

open config.ini and tell me what world=
it should be something like worlds\world1 or worlds\w3
also check the folder directly, and try deleting the world.ini file in that directory
if the world folder only has 1 file, world.ini, then you dont have a world :)
the launcher should give you one afaik
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Post by Lachie Dazdarian »

no world.ini in worlds directory. world1 directors was empty, only w3 had files in it.

so in config.ini I changed world=worlds\world1\ to world=worlds\w3\

no effect
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Post by Gonzo »

try 'worlds\w3' no backslash after it, probably no change but..
by loading indefinitely what do you mean? the game doesnt fully start?
if it does start, try turning postprocess off (postprocess = 0 in config.ini)
im using some funky tricks to get fade-out in the distance, but ive never had issues with nvidia before

ive also not seen anyone actually connect to the server, so, you must not be able to get past the starting point
unless you set autoconnect = 0, or using an invalid user...
guests are allowed with <any username> as long as the password is test
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Post by Lachie Dazdarian »

Didn't help.

No postprocessing in config.ini

The screen is constantly black and hangs. If I click i turnst to white and window to "not responding".

I need to force close it.

In the log I have this:

Code: Select all

09-16-2012 20:29:38:: Initializing GLFW...
09-16-2012 20:29:38:: Generating GL textures...
09-16-2012 20:29:39:: Cube map error: 1281
autologin = 1
password=test
Post Reply