Procedural block world project

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

Re: Procedural block world project

Postby dafhi » Sep 07, 2012 23:47

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

Re: Procedural block world project

Postby Gonzo » Sep 08, 2012 0:10

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: 866
Joined: Jun 04, 2005 9:51

Re: Procedural block world project

Postby dafhi » Sep 08, 2012 2:05

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

Code: Select all

' ------------------------------- '
'           ImageInfo             '
'                                 '

Type ImageInfo
  As Any ptr                      img = 0
  As Any ptr                      pixels
  As Any ptr                      botleft
  As Integer                      pitchm
  As Integer                      pitch
  As Integer                      wid
  As Integer                      hgt
  As Integer                      widM
  As Integer                      hgtM
  As single                       midx
  As single                       midy
  As Single                       diagonal
  As Integer                      bypp
  As Integer                      pitchBy4
  As Integer                      UB1D
  As Integer                      w_plus_h
  Declare Operator Cast ()        As Any Ptr
  Declare Function Create(ByVal pWid As UShort=1,ByVal pHgt As UShort=1,ByVal bpp_ as UInteger=32,ByVal pRed As UByte=127,ByVal pGrn As UByte=127,ByVal pBlu As UByte=127,ByVal pAph As UByte=255,ByVal NoImage As Integer=0) As Any ptr
  Declare Function ResInf(ByVal pWid As UShort=1,ByVal pHgt As UShort=1,ByVal bpp_ as UInteger=32,ByVal pRed As UByte=127,ByVal pGrn As UByte=127,ByVal pBlu As UByte=127,ByVal pAph As UByte=255) As Any Ptr
  Declare Sub ScrInfo
  Declare Sub Cls( ByVal pColor As UInteger=RGBA(0,0,0,0) )
  Declare Sub Destroy
  Declare Sub varsCommon
  'Declare Constructor (ByVal pWid As UShort=1,ByVal pHgt As UShort=1,ByVal pRed As UByte=127,ByVal pGrn As UByte=127,ByVal pBlu As UByte=127,ByVal pAph As UByte=255,ByVal bpp_ as UInteger=32)
  Declare Destructor
'  Private:
End Type
'Constructor ImageInfo(ByVal pWid As UShort,ByVal pHgt As UShort,ByVal bpp_ as UInteger,ByVal pRed As UByte,ByVal pGrn As UByte,ByVal pBlu As UByte,ByVal pAph As UByte)
'  img = Create(pWid,pHgt,pRed,pGrn,pBlu,pAph,bpp_)
'End Constructor
Operator ImageInfo.cast () As Any Ptr
  Return img
End Operator
Destructor ImageInfo
  Destroy
End Destructor
Sub ImageInfo.varsCommon
  widM = wid - 1
  hgtM = hgt - 1
  midx = widM * 0.5
  midy = hgtM * 0.5
  UB1D = wid * hgt - 1
  pitchm = pitch - 1
  pitchBy4 = pitch \ 4
  botleft = pixels + pitch * hgtm
  w_plus_h = wid + hgt
  diagonal = Sqr(widM * widM + hgtM * hgtM)
End Sub
Function ImageInfo.Create(ByVal pWid As UShort, ByVal pHgt As UShort, _
  ByVal bpp_ as UInteger, _
  ByVal pRed As UByte, _
  ByVal pGrn As UByte, _
  ByVal pBlu As UByte, _
  ByVal pAph As UByte, _
  ByVal NoImage As Integer) As Any Ptr
 
  If NoImage Then
    wid = pWid
    hgt = pHgt
  Else
    img = ImageCreate( pWid, pHgt, RGBA(pRed,pGrn,pBlu,pAph), bpp_ )
    ImageInfo img, wid, hgt, bypp, pitch, pixels
  EndIf
  varsCommon
  Return img

End Function
Sub ImageInfo.ScrInfo
  ScreenInfo wid ,hgt  , , bypp, pitch
  pixels = ScreenPtr
  varsCommon
End Sub
Function ImageInfo.ResInf(ByVal pWid As UShort,ByVal pHgt As UShort,ByVal bpp_ as UInteger,ByVal pRed As UByte,ByVal pGrn As UByte,ByVal pBlu As UByte,ByVal pAph As UByte) As Any Ptr
  ScreenRes pWid,pHgt,bpp_
  ScrInfo
  Return pixels
End Function
Sub ImageInfo.Destroy()
  If img = 0 Then Exit Sub
  ImageDestroy img
  img = 0
End Sub
Sub ImageInfo.Cls( ByVal pColor As UInteger)
  Dim As UInteger cpy_ = (pitch * hgt) Shr 2
  Dim As UInteger 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
'                             '
'                             '
' --------------------------- '

#Ifndef FALSE
Const FALSE = 0
Const TRUE = not FALSE

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
  Else
    Return in2
  EndIf
End Function

  #EndIf

' ----------------------------- '
'        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

Dim As ImageInfo          Img
Img.ResInf  480,360

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

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

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.widm)
dest = @x_b(0)
ScanOut(XB, Img.widm)
For x As Integer = 0 To Img.widm
  Dim As UInteger alph = ( x_a(x) + x_b(x) )
  Line (x,0)-(x,img.hgtm),alph
  PSet (x, img.hgtm - 0.2 * alph), &HFFFFFF
Next

Sleep
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Procedural block world project

Postby Gonzo » Sep 08, 2012 13:29

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: 866
Joined: Jun 04, 2005 9:51

Re: Procedural block world project

Postby dafhi » Sep 08, 2012 13:48

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

Postby Gonzo » Sep 08, 2012 16:15

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: 2230
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Postby Lachie Dazdarian » Sep 16, 2012 14:12

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

Postby Gonzo » Sep 16, 2012 16:33

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: 2230
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Postby Lachie Dazdarian » Sep 16, 2012 16:46

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

Postby Gonzo » Sep 16, 2012 16:50

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: 2230
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Postby Lachie Dazdarian » Sep 16, 2012 18:00

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

Postby Gonzo » Sep 16, 2012 18:04

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: 2230
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Postby Lachie Dazdarian » Sep 16, 2012 18:27

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

Postby Gonzo » Sep 16, 2012 18:31

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: 2230
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Procedural block world project

Postby Lachie Dazdarian » Sep 16, 2012 18:35

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

Return to “Projects”

Who is online

Users browsing this forum: Bing [Bot] and 2 guests