Perlin Noise routine is not tesselating

Started by _PJ_, August 01, 2023, 21:11:20

Previous topic - Next topic
Print
Go Down Pages1
User actions

_PJ_

August 01, 2023, 21:11:20
I shamelessly stole this Perlin routine from Blitzcoder by RonTek (unsure if they are still around?)
https://www.blitzcoder.org/forum/topic.php?id=558

But it is not tessselating. I have tried to add modulo to the Lerp functions, but nothing I try seems to work...

Any clues?


My BMax NG modified version
Code Select
'==========================================
'           CLASS
'   main perlin noise class
'==========================================
Type CPerlinNoise

    Field sizeX = 512
    Field sizeY = 512

    'first random noise table
    Field noiseArr:Double[,] = New Double[sizeX, sizeY]
    'output table
    Field terrainArr:Double[,] = New Double[sizeX, sizeY]
    'output bitmap
    Field bitmapOut:TPixmap = TPixmap.Create(sizeX, sizeY, PF_RGBA8888)

    'frequency, the lower the larger terrains of same level
    Field frequency:Double = 1.0
    'starting amplitude
    Field amplitude:Double = 1.0
    'change of amplitude of next octave
    Field persistance:Double = 0.6
    'number of octaves
    Field octaves = 8

    'min and max colors
    Field colMin:CColor = CColor.Create(0, 0, 0)
    Field colMax:CColor = CColor.Create(0, 0, 0)

    '==========================================
    '    to init perlin noise values
    '==========================================
    Method ChangeParams(fre:Double, amp:Double, pers:Double, oct)

        frequency = fre
        amplitude = amp
        persistance = pers
        octaves = oct

    End Method

    '==========================================
    '       single field noise generation
    '=========================================
    Method GetRandomNoise:Double(x:Double, y:Double)

        Local fre:Double = frequency
        Local amp:Double = amplitude
        Local finalValue:Double = 0.0

        For Local i:Int = 0 To octaves
            finalValue = finalValue + LinearFIlterNoise(x * fre, y * fre) * amp
            fre = fre * 2.0
            amp = amp * persistance
        Next

        If(finalValue < - 1.0) finalValue = -1.0
        If(finalValue > 1.0) finalValue = 1.0

        finalValue = finalValue * 0.5 + 0.5

        Return finalValue

    End Method

    '==========================================
    '      create output terrain array
    '==========================================
    Method MakeTerrainMap()

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY
                terrainArr[x, y] = GetRandomNoise(x, y)
            Next
        Next

    End Method

    '==========================================
    '   process bitmap to file
    '==========================================
    Method MakeBitmap()

        bitmapOut.ClearPixels($FFFFFFFF)

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY

                Local val:Double = terrainArr[x, y]
                Local R:Int = colMax.R * val + colMin.R * (1 - val)
                Local G:Int = colMax.G * val + colMin.G * (1 - val)
                Local B:Int = colMax.B * val + colMin.B * (1 - val)

                SetColor(R, G, B)
                bitmapOut.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next

    End Method

    '============================================
    '    perlin noise with linear interpolation
    '===========================================
    Method LinearFilterNoise:Double(x:Double, y:Double)

        Local fractionX:Double = Double(X) - Int(X)
        Local fractionY:Double = Double(Y) - Int(Y)

        Local x1 = (Int(x) + sizeX) Mod sizeX
        Local y1 = (Int(y) + sizeY) Mod sizeY
        Local x2 = ((Int(x) -1 ) + sizeX)Mod sizeX
        Local y2 = ((Int(y) -1 ) + sizeY )Mod sizeY

' If(x1 < 0) x1 = (sizeX - x1) Mod sizeX
' If(x2 < 0) x2 = (sizeX - x2) Mod sizeX
' If(y1 < 0) y1 = (sizeY - y1) Mod sizeY
' If(y2 < 0) y2 = (sizeY - y2) Mod sizeY

        Local finVal:Double = 0

        finVal = finVal + fractionX * fractionY * noiseArr[x1, y1]
        finVal = finVal + fractionX * (1 - fractionY) * noiseArr[x1, y2]
        finVal = finVal + (1 - fractionX) * fractionY * noiseArr[x2, y1]
        finVal = finVal + (1 - fractionX) * (1 - fractionY) * noiseArr[x2, y2]

        Return finVal

    End Method

    '===========================================
    '     to fill noise array with white noise
    '===========================================
    Method InitNoise(Seed:Double=0)
If Seed=0 Then Seed=MilliSecs()

SeedRnd Seed

        noiseArr = New Double[sizeX, sizeY]
        For Local y:Int = 0 Until sizeY-1
            For Local x:Int = 0 Until sizeX-1
                noiseArr[x, y] = (RndDouble() - 0.5) * 2.0
            Next
' noiseArr[sizex-1, y]=noiseArr[0,y]
        Next

' For Local x:Int = 0 Until sizeX
' noiseArr[x, sizey-1]=noiseArr[x,0]
' Next
    End Method

    '===========================================
    Method terrainSinus(p:Double)

        For Local y:Int = 0 Until sizeY
            For Local x:Int = 0 Until sizeX

                Local md:Double = Sin(y * 180.0 / sizeY) * 2 - 1
                terrainArr[x, y] = md * p + terrainArr[x, y] * (1.0 - p)

If (terrainArr[x,y]<0.0) Then terrainArr[x,y]=0.0

            Next
        Next

    End Method

    '============================================
    '      start process
    '===========================================
    Function Calculate(Seed:Double=0)

        'create altitude map
        Local highMap:CPerlinNoise = New CPerlinNoise
        highMap.ChangeParams(0.02, 0.95, 0.6, 6)
        highMap.colMin = CColor.Create(0, 120, 0)
        highMap.colMax = CColor.Create(100, 220, 100)
        highMap.InitNoise(Seed)
        highMap.MakeTerrainMap()
        highMap.MakeBitmap()
        SavePixmapPNG(highMap.bitmapOut, "high1.png")

        'creat humitidy map
        Local humMap:CPerlinNoise = New CPerlinNoise
        humMap.ChangeParams(0.04, 0.99, 0.6, 6)
        humMap.colMin = CColor.Create(0, 0, 20)
        humMap.colMax = CColor.Create(0, 50, 120)
        humMap.InitNoise(Seed)
        humMap.MakeTerrainMap()
        humMap.MakeBitmap()
        SavePixmapPNG(humMap.bitmapOut, "high2.png")

        'create temperature map
        Local tempMap:CPerlinNoise = New CPerlinNoise
        tempMap.ChangeParams(0.04, 0.99, 0.6, 6)
        tempMap.colMin = CColor.Create(60, 0, 0)
        tempMap.colMax = CColor.Create(240, 0, 0)
        tempMap.InitNoise(Seed)
        tempMap.MakeTerrainMap()
        tempMap.terrainSinus(0.6)
        tempMap.MakeBitmap()
        SavePixmapPNG(tempMap.bitmapOut, "high3.png")

        'generate additional world map
        GenerateWorldMap(highMap, humMap, tempMap)

    End Function

    '=============================================
    '      generate simple world map
    '=============================================
    Function GenerateWorldMap(highMap:CPerlinNoise,humMap:CPerlinNoise,tempMap:CPerlinNoise)

        Local pixies:TPixmap = TPixmap.Create(tempMap.sizeX, tempMap.sizeY, PF_RGBA8888)

        For Local y:Int = 0:Int Until tempMap.sizeY
            For Local x:Int = 0 Until tempMap.sizeX

                Local T:Double = tempMap.terrainArr[x, y] * 2 - 1.0
                Local H:Double = humMap.terrainArr[x, y] * 2 - 1.0
                Local A:Double = highMap.terrainArr[x, y] * 2 - 1.0

                Local R, G, B

                'water
                If(A < 0)
                    R = 0
                    G = 60 + A * 60
                    B = 120 + A * 100
                'land
                Else

                    'altitude
                    R = 60 + A * 180
                    G = 60 + A * 180
                    B = 60 + A * 180

                    'temperature
                    If(T >= 0)
                        G = G * (1.0 - T * 0.3)
                        B = B * (1.0 - T * 0.3)
                    Else
                        R = R * (1.0 + T * 0.3)
                    End If

                    'high humidity
                    If(H >= 0)
                        R = R * (1.0 - H * 0.3)
                        B = B * (1.0 - H * 0.3)
                    Else
                        G = G * (1.0 + H * 0.3)
                    End If

                End If

                'some final quantizations

                R = (R / 15) * 15
                G = (G / 15) * 15
                B = (B / 15) * 15


                pixies.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next
        SavePixmapPNG(pixies, "worldMap.png")

    End Function

End Type



'==================================
'           CLASS
'just simple class To help colors
'==================================
Type CColor

    Field R = 0
    Field G = 0
    Field B = 0

    '==================================
    Function Create:CColor(r, g, b)
        Local aa:CColor = New CColor

        aa.R = r
        aa.g = g
        aa.b = b

        Return aa
    End Function

    '==================================
    Function Process:CColor(f:Long)
        Local aa:CColor = New CColor

        aa.R = f & $00FF0000
        aa.R = aa.R / $10000
        aa.G = f & $0000FF00
        aa.G = aa.G / $100
        aa.B = f & $000000FF

        Return aa
    End Function

End Type


'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================

'some simple Setup
SetGraphicsDriver(GLMax2DDriver ())
Graphics(1920,1080, 0, 60)

'run perlin noise
CPerlinNoise.Calculate()

Global img:TImage = LoadImage("worldMap.png")

SetColor(255, 255, 255)

While Not KeyHit(KEY_ESCAPE) And Not AppTerminate()
    Cls

    DrawImage(img,0,0)

    Flip
Wend

Baggey

#1
August 06, 2023, 10:10:25
Quote from: _PJ_ on August 01, 2023, 21:11:20I shamelessly stole this Perlin routine from Blitzcoder by RonTek (unsure if they are still around?)
https://www.blitzcoder.org/forum/topic.php?id=558

But it is not tessselating. I have tried to add modulo to the Lerp functions, but nothing I try seems to work...

Any clues?


My BMax NG modified version
Code Select
'==========================================
'           CLASS
'   main perlin noise class
'==========================================
Type CPerlinNoise

    Field sizeX = 512
    Field sizeY = 512

    'first random noise table
    Field noiseArr:Double[,] = New Double[sizeX, sizeY]
    'output table
    Field terrainArr:Double[,] = New Double[sizeX, sizeY]
    'output bitmap
    Field bitmapOut:TPixmap = TPixmap.Create(sizeX, sizeY, PF_RGBA8888)

    'frequency, the lower the larger terrains of same level
    Field frequency:Double = 1.0
    'starting amplitude
    Field amplitude:Double = 1.0
    'change of amplitude of next octave
    Field persistance:Double = 0.6
    'number of octaves
    Field octaves = 8

    'min and max colors
    Field colMin:CColor = CColor.Create(0, 0, 0)
    Field colMax:CColor = CColor.Create(0, 0, 0)

    '==========================================
    '    to init perlin noise values
    '==========================================
    Method ChangeParams(fre:Double, amp:Double, pers:Double, oct)

        frequency = fre
        amplitude = amp
        persistance = pers
        octaves = oct

    End Method

    '==========================================
    '       single field noise generation
    '=========================================
    Method GetRandomNoise:Double(x:Double, y:Double)

        Local fre:Double = frequency
        Local amp:Double = amplitude
        Local finalValue:Double = 0.0

        For Local i:Int = 0 To octaves
            finalValue = finalValue + LinearFIlterNoise(x * fre, y * fre) * amp
            fre = fre * 2.0
            amp = amp * persistance
        Next

        If(finalValue < - 1.0) finalValue = -1.0
        If(finalValue > 1.0) finalValue = 1.0

        finalValue = finalValue * 0.5 + 0.5

        Return finalValue

    End Method

    '==========================================
    '      create output terrain array
    '==========================================
    Method MakeTerrainMap()

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY
                terrainArr[x, y] = GetRandomNoise(x, y)
            Next
        Next

    End Method

    '==========================================
    '   process bitmap to file
    '==========================================
    Method MakeBitmap()

        bitmapOut.ClearPixels($FFFFFFFF)

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY

                Local val:Double = terrainArr[x, y]
                Local R:Int = colMax.R * val + colMin.R * (1 - val)
                Local G:Int = colMax.G * val + colMin.G * (1 - val)
                Local B:Int = colMax.B * val + colMin.B * (1 - val)

                SetColor(R, G, B)
                bitmapOut.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next

    End Method

    '============================================
    '    perlin noise with linear interpolation
    '===========================================
    Method LinearFilterNoise:Double(x:Double, y:Double)

        Local fractionX:Double = Double(X) - Int(X)
        Local fractionY:Double = Double(Y) - Int(Y)

        Local x1 = (Int(x) + sizeX) Mod sizeX
        Local y1 = (Int(y) + sizeY) Mod sizeY
        Local x2 = ((Int(x) -1 ) + sizeX)Mod sizeX
        Local y2 = ((Int(y) -1 ) + sizeY )Mod sizeY

'        If(x1 < 0) x1 = (sizeX - x1) Mod sizeX
'        If(x2 < 0) x2 = (sizeX - x2) Mod sizeX
'        If(y1 < 0) y1 = (sizeY - y1) Mod sizeY
'        If(y2 < 0) y2 = (sizeY - y2) Mod sizeY

        Local finVal:Double = 0

        finVal = finVal + fractionX * fractionY * noiseArr[x1, y1]
        finVal = finVal + fractionX * (1 - fractionY) * noiseArr[x1, y2]
        finVal = finVal + (1 - fractionX) * fractionY * noiseArr[x2, y1]
        finVal = finVal + (1 - fractionX) * (1 - fractionY) * noiseArr[x2, y2]

        Return finVal

    End Method

    '===========================================
    '     to fill noise array with white noise
    '===========================================
    Method InitNoise(Seed:Double=0)
        If Seed=0 Then Seed=MilliSecs()
       
        SeedRnd Seed
       
        noiseArr = New Double[sizeX, sizeY]
        For Local y:Int = 0 Until sizeY-1
            For Local x:Int = 0 Until sizeX-1
                noiseArr[x, y] = (RndDouble() - 0.5) * 2.0               
            Next
'                noiseArr[sizex-1, y]=noiseArr[0,y]
        Next

'        For Local x:Int = 0 Until sizeX
'            noiseArr[x, sizey-1]=noiseArr[x,0]
'        Next
    End Method

    '===========================================
    Method terrainSinus(p:Double)

        For Local y:Int = 0 Until sizeY
            For Local x:Int = 0 Until sizeX

                Local md:Double = Sin(y * 180.0 / sizeY) * 2 - 1
                terrainArr[x, y] = md * p + terrainArr[x, y] * (1.0 - p)

                If (terrainArr[x,y]<0.0) Then terrainArr[x,y]=0.0

            Next
        Next

    End Method

    '============================================
    '      start process
    '===========================================
    Function Calculate(Seed:Double=0)

        'create altitude map
        Local highMap:CPerlinNoise = New CPerlinNoise
        highMap.ChangeParams(0.02, 0.95, 0.6, 6)
        highMap.colMin = CColor.Create(0, 120, 0)
        highMap.colMax = CColor.Create(100, 220, 100)
        highMap.InitNoise(Seed)
        highMap.MakeTerrainMap()
        highMap.MakeBitmap()
        SavePixmapPNG(highMap.bitmapOut, "high1.png")

        'creat humitidy map
        Local humMap:CPerlinNoise = New CPerlinNoise
        humMap.ChangeParams(0.04, 0.99, 0.6, 6)
        humMap.colMin = CColor.Create(0, 0, 20)
        humMap.colMax = CColor.Create(0, 50, 120)
        humMap.InitNoise(Seed)
        humMap.MakeTerrainMap()
        humMap.MakeBitmap()
        SavePixmapPNG(humMap.bitmapOut, "high2.png")

        'create temperature map
        Local tempMap:CPerlinNoise = New CPerlinNoise
        tempMap.ChangeParams(0.04, 0.99, 0.6, 6)
        tempMap.colMin = CColor.Create(60, 0, 0)
        tempMap.colMax = CColor.Create(240, 0, 0)
        tempMap.InitNoise(Seed)
        tempMap.MakeTerrainMap()
        tempMap.terrainSinus(0.6)
        tempMap.MakeBitmap()
        SavePixmapPNG(tempMap.bitmapOut, "high3.png")

        'generate additional world map
        GenerateWorldMap(highMap, humMap, tempMap)

    End Function

    '=============================================
    '      generate simple world map
    '=============================================
    Function GenerateWorldMap(highMap:CPerlinNoise,humMap:CPerlinNoise,tempMap:CPerlinNoise)

        Local pixies:TPixmap = TPixmap.Create(tempMap.sizeX, tempMap.sizeY, PF_RGBA8888)

        For Local y:Int = 0:Int Until tempMap.sizeY
            For Local x:Int = 0 Until tempMap.sizeX

                Local T:Double = tempMap.terrainArr[x, y] * 2 - 1.0
                Local H:Double = humMap.terrainArr[x, y] * 2 - 1.0
                Local A:Double = highMap.terrainArr[x, y] * 2 - 1.0

                Local R, G, B

                'water
                If(A < 0)
                    R = 0
                    G = 60 + A * 60
                    B = 120 + A * 100
                'land
                Else

                    'altitude
                    R = 60 + A * 180
                    G = 60 + A * 180
                    B = 60 + A * 180

                    'temperature
                    If(T >= 0)
                        G = G * (1.0 - T * 0.3)
                        B = B * (1.0 - T * 0.3)
                    Else
                        R = R * (1.0 + T * 0.3)
                    End If

                    'high humidity
                    If(H >= 0)
                        R = R * (1.0 - H * 0.3)
                        B = B * (1.0 - H * 0.3)
                    Else
                        G = G * (1.0 + H * 0.3)
                    End If

                End If

                'some final quantizations

                R = (R / 15) * 15
                G = (G / 15) * 15
                B = (B / 15) * 15


                pixies.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next
        SavePixmapPNG(pixies, "worldMap.png")

    End Function

End Type



'==================================
'           CLASS
'just simple class To help colors
'==================================
Type CColor

    Field R = 0
    Field G = 0
    Field B = 0

    '==================================
    Function Create:CColor(r, g, b)
        Local aa:CColor = New CColor

        aa.R = r
        aa.g = g
        aa.b = b

        Return aa
    End Function

    '==================================
    Function Process:CColor(f:Long)
        Local aa:CColor = New CColor

        aa.R = f & $00FF0000
        aa.R = aa.R / $10000
        aa.G = f & $0000FF00
        aa.G = aa.G / $100
        aa.B = f & $000000FF

        Return aa
    End Function

End Type


'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================

'some simple Setup
SetGraphicsDriver(GLMax2DDriver ())
Graphics(1920,1080, 0, 60)

'run perlin noise
CPerlinNoise.Calculate()

Global img:TImage = LoadImage("worldMap.png")

SetColor(255, 255, 255)

While Not KeyHit(KEY_ESCAPE) And Not AppTerminate()
    Cls

    DrawImage(img,0,0)

    Flip
Wend

I had to look up Tessalation which i think means tiled image?

if i understand what you mean here is the code to tile it crudly onto the screen. Note your image isn't the correct size for the screen your using. But this could be pre calculated and altered to fit! Anyway here's the idea.

if i completely mis-understood you, then simply ignore it! Add this to your code. ::)

Code Select
'some simple Setup
SetGraphicsDriver(GLMax2DDriver ())
Graphics(1920,1080, 0, 60)

'run perlin noise
CPerlinNoise.Calculate()

Global img:TImage = LoadImage("worldMap.png")

SetColor(255, 255, 255)

While Not KeyHit(KEY_ESCAPE) And Not AppTerminate()
    Cls

    DrawImage(img,0,0)

    Local width:Int=ImageWidth(img) ' gets images width
    Local height:Int=ImageHeight(img) ' gets image height

    Local acrossimages:Int=GraphicsWidth()/width ' Worksout how many fit in the screen
    Local downimages:Int=GraphicsHeight()/height
 
    Local posX:Int, posY

    For Local x:Int=0 To acrossimages  ' Could use "until" instead of "To"

        For Local y:Int=0 To downimages

            DrawImage(img,posX,posY)
            posY:+height

        Next

        ' Reset posY

        posY=0

        posX:+width

    Next

    Flip(0) ' flips the screen as fast as it can go!

Wend
Kind Regards Baggey
Running a PC that just Aint fast enough!? i7 4Ghz Quad core 24GB ram 1TB SSD and NVIDIA Quadro K1200 . DID Technology stop! Or have we been assimulated!

ZX Spectrum 48k, C64, ORIC Atmos 48K, Enterprise 128K, The SID chip. Im Misunderstood!

_PJ_

#2
August 06, 2023, 13:49:38
Hi Baggey, thanks for the input.
Sorry, maybe "tesselation" was the wrong word in context. I did nto want to tile the images onscreen. What I actually hoped to achieve was a toroidal wrap-around (( or at the least a cylindrical x-dimension wraparound )) where the "opposing edges" have equivalent values (i.e. Dirichlet boundary condition) so they may be applied to a cylindrical, spherical or toroidal surface "seamlessly"

An example is here:
https://docs.unrealengine.com/udk/Three/rsrc/Three/TerrainAdvancedTextures/UE3MacroTexture.gif

________


In the code I originally posted above, there is a harsh and noticable difference which is evident in your tiling display as the edges of each "tile" do not match up.


To my understanding of gradient noise algorithm, the solution ought to be to ensure the range maps to exactly integer wavenumber (or presumably half-integer may be viable) so the periodicity of the function aligns exactly with whatever arbitrary pixel sized bitmap - or the calculated "Maximum" interpolation matches that with the 0th value...
But I wasn't completely able to follow exactly RonTek's original code in trying to achieve this effect.

Baggey

#3
August 07, 2023, 10:34:52
So you want to create wall paper :-X . So when you join the sides they were the same to start with.

Well im interested in Pixel manipulation so ive had another Stab idea for you.

my idea is start 12 pixels in from the end ie Pixel 499 until 512

get the first Pixel ie 0 and the last pixel 499. Now we want to in 12 steps go from pixel 0 RGB to pixel 499 RGB

So when where finished we will change from what pixel 499 is back to pixel 0 the origonal. So when we draw the pixel Maps they should Blend.

i choose 12 at random i suppose this could be altered so the image blend/tear's back to the original Pixel color so it may be Hash or more visually pleasing!

So here's my Crude Stab at it for you, although somethings not quite working right  ::)

There are probably mathematical equations to do this which ive entirely forgotten over the years! :-X

Code Select
SuperStrict

Const PerlinXwidth:Int=512

'==========================================
'           CLASS
'   main perlin noise class
'==========================================
Type CPerlinNoise

    Field sizeX:Int = PerlinXwidth
    Field sizeY:Int = 512

    'first random noise table
    Field noiseArr:Double[,] = New Double[sizeX, sizeY]
    'output table
    Field terrainArr:Double[,] = New Double[sizeX, sizeY]
    'output bitmap
    Field bitmapOut:TPixmap = TPixmap.Create(sizeX, sizeY, PF_RGBA8888)

    'frequency, the lower the larger terrains of same level
    Field frequency:Double = 1.0
    'starting amplitude
    Field amplitude:Double = 1.0
    'change of amplitude of next octave
    Field persistance:Double = 0.6
    'number of octaves
    Field octaves:Int = 8

    'min and max colors
    Field colMin:CColor = CColor.Create(0, 0, 0)
    Field colMax:CColor = CColor.Create(0, 0, 0)

    '==========================================
    '    to init perlin noise values
    '==========================================
    Method ChangeParams(fre:Double, amp:Double, pers:Double, oct:Int)

        frequency = fre
        amplitude = amp
        persistance = pers
        octaves = oct

    End Method

    '==========================================
    '       single field noise generation
    '=========================================
    Method GetRandomNoise:Double(x:Double, y:Double)

        Local fre:Double = frequency
        Local amp:Double = amplitude
        Local finalValue:Double = 0.0

        For Local i:Int = 0 To octaves
            finalValue = finalValue + LinearFIlterNoise(x * fre, y * fre) * amp
            fre = fre * 2.0
            amp = amp * persistance
        Next

        If(finalValue < - 1.0) finalValue = -1.0
        If(finalValue > 1.0) finalValue = 1.0

        finalValue = finalValue * 0.5 + 0.5

        Return finalValue

    End Method

    '==========================================
    '      create output terrain array
    '==========================================
    Method MakeTerrainMap()

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY
                terrainArr[x, y] = GetRandomNoise(x, y)
            Next
        Next

    End Method

    '==========================================
    '   process bitmap to file
    '==========================================
    Method MakeBitmap()

        bitmapOut.ClearPixels($FFFFFFFF)

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY

                Local val:Double = terrainArr[x, y]
                Local R:Int = colMax.R * val + colMin.R * (1 - val)
                Local G:Int = colMax.G * val + colMin.G * (1 - val)
                Local B:Int = colMax.B * val + colMin.B * (1 - val)

                SetColor(R, G, B)
                bitmapOut.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next

    End Method

    '============================================
    '    perlin noise with linear interpolation
    '===========================================
    Method LinearFilterNoise:Double(x:Double, y:Double)

        Local fractionX:Double = Double(X) - Int(X)
        Local fractionY:Double = Double(Y) - Int(Y)

        Local x1:Int = (Int(x) + sizeX) Mod sizeX
        Local y1:Int = (Int(y) + sizeY) Mod sizeY
        Local x2:Int = ((Int(x) -1 ) + sizeX)Mod sizeX
        Local y2:Int = ((Int(y) -1 ) + sizeY )Mod sizeY

' If(x1 < 0) x1 = (sizeX - x1) Mod sizeX
' If(x2 < 0) x2 = (sizeX - x2) Mod sizeX
' If(y1 < 0) y1 = (sizeY - y1) Mod sizeY
' If(y2 < 0) y2 = (sizeY - y2) Mod sizeY

        Local finVal:Double = 0

        finVal = finVal + fractionX * fractionY * noiseArr[x1, y1]
        finVal = finVal + fractionX * (1 - fractionY) * noiseArr[x1, y2]
        finVal = finVal + (1 - fractionX) * fractionY * noiseArr[x2, y1]
        finVal = finVal + (1 - fractionX) * (1 - fractionY) * noiseArr[x2, y2]

        Return finVal

    End Method

    '===========================================
    '     to fill noise array with white noise
    '===========================================
    Method InitNoise(Seed:Double=0)
If Seed=0 Then Seed=MilliSecs()

SeedRnd Int(Seed)

        noiseArr = New Double[sizeX, sizeY]
        For Local y:Int = 0 Until sizeY-1
            For Local x:Int = 0 Until sizeX-1
                noiseArr[x, y] = (RndDouble() - 0.5) * 2.0
            Next
' noiseArr[sizex-1, y]=noiseArr[0,y]
        Next

' For Local x:Int = 0 Until sizeX
' noiseArr[x, sizey-1]=noiseArr[x,0]
' Next
    End Method

    '===========================================
    Method terrainSinus(p:Double)

        For Local y:Int = 0 Until sizeY
            For Local x:Int = 0 Until sizeX

                Local md:Double = Sin(y * 180.0 / sizeY) * 2 - 1
                terrainArr[x, y] = md * p + terrainArr[x, y] * (1.0 - p)

If (terrainArr[x,y]<0.0) Then terrainArr[x,y]=0.0

            Next
        Next

    End Method

    '============================================
    '      start process
    '===========================================
    Function Calculate(Seed:Double=0)

        'create altitude map
        Local highMap:CPerlinNoise = New CPerlinNoise
        highMap.ChangeParams(0.02, 0.95, 0.6, 6)
        highMap.colMin = CColor.Create(0, 120, 0)
        highMap.colMax = CColor.Create(100, 220, 100)
        highMap.InitNoise(Seed)
        highMap.MakeTerrainMap()
        highMap.MakeBitmap()
        SavePixmapPNG(highMap.bitmapOut, "high1.png")

        'creat humitidy map
        Local humMap:CPerlinNoise = New CPerlinNoise
        humMap.ChangeParams(0.04, 0.99, 0.6, 6)
        humMap.colMin = CColor.Create(0, 0, 20)
        humMap.colMax = CColor.Create(0, 50, 120)
        humMap.InitNoise(Seed)
        humMap.MakeTerrainMap()
        humMap.MakeBitmap()
        SavePixmapPNG(humMap.bitmapOut, "high2.png")

        'create temperature map
        Local tempMap:CPerlinNoise = New CPerlinNoise
        tempMap.ChangeParams(0.04, 0.99, 0.6, 6)
        tempMap.colMin = CColor.Create(60, 0, 0)
        tempMap.colMax = CColor.Create(240, 0, 0)
        tempMap.InitNoise(Seed)
        tempMap.MakeTerrainMap()
        tempMap.terrainSinus(0.6)
        tempMap.MakeBitmap()
        SavePixmapPNG(tempMap.bitmapOut, "high3.png")

        'generate additional world map
        GenerateWorldMap(highMap, humMap, tempMap)

    End Function

    '=============================================
    '      generate simple world map
    '=============================================
    Function GenerateWorldMap(highMap:CPerlinNoise,humMap:CPerlinNoise,tempMap:CPerlinNoise)

        Local pixies:TPixmap = TPixmap.Create(tempMap.sizeX, tempMap.sizeY, PF_RGBA8888)

        'pixies.clearpixels
       
        Local x:Int

        For Local y:Int = 0:Int Until tempMap.sizeY
            For x:Int = 0 Until tempMap.sizeX

                '''''''''''''''''''''''''''''''''''''''''''
                If x=tempMap.sizeX-12 Then Exit  ' <- Force a blend to origonal values
                '''''''''''''''''''''''''''''''''''''''''''

                Local T:Double = tempMap.terrainArr[x, y] * 2 - 1.0
                Local H:Double = humMap.terrainArr[x, y] * 2 - 1.0
                Local A:Double = highMap.terrainArr[x, y] * 2 - 1.0

                Local R:Int, G:Int, B:Int

                'water
                If(A < 0)
                    R = 0
                    G = 60 + A * 60
                    B = 120 + A * 100
                'land
                Else

                    'altitude
                    R = 60 + A * 180
                    G = 60 + A * 180
                    B = 60 + A * 180

                    'temperature
                    If(T >= 0)
                        G = G * (1.0 - T * 0.3)
                        B = B * (1.0 - T * 0.3)
                    Else
                        R = R * (1.0 + T * 0.3)
                    End If

                    'high humidity
                    If(H >= 0)
                        R = R * (1.0 - H * 0.3)
                        B = B * (1.0 - H * 0.3)
                    Else
                        G = G * (1.0 + H * 0.3)
                    End If

                End If

                'some final quantizations

                R = (R / 15) * 15
                G = (G / 15) * 15
                B = (B / 15) * 15


                pixies.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next

        SavePixmapPNG(pixies, "worldMap.png")

        blend(x, pixies)

    End Function


    Function Blend(xBlend:Int, pixies:TPixmap)

        ' We should return here with 12 Pixels missing in the x-Plane or i-vector
        Print "PerlinX-xBlend="+(PerlinXwidth-xBlend)
        Print "PerlinX width="+PerlinXwidth
        Print "xBlend="+xBlend

        Print "pixies="+pixies.width
       
        'DrawPixmap(pixies,0,0) ; Flip(0) ; waitkey

        ' lets do first 10 values!
        Local x:Int

        For Local y:Int=0 Until 512

              
               'Print "START RGB = "+0+",y pixel is "+(pixies.ReadPixel(0,y)&65535)
               'Print "END RGB = "+499+",y pixel is "+(pixies.ReadPixel(499,y)&65535)
             
               'lets take the relevent parts out the R G B components
               ' ie Rstart must change to Rend etc...
               Local Rstart:Int=pixies.ReadPixel(0,y)&$00FF0000
               Local Gstart:Int=pixies.ReadPixel(0,y)&$0000FF00
               Local Bstart:Int=pixies.ReadPixel(0,y)&$000000FF

               Local Rend:Int=pixies.ReadPixel(499,y)&$00FF0000
               Local Gend:Int=pixies.ReadPixel(499,y)&$0000FF00
               Local Bend:Int=pixies.ReadPixel(499,y)&$000000FF

               ' Create the blend gradient ie how many steps to get to origonal value
               ' This is where i think it's going wrong
               Local RBlendGradient:Int=((Rstart - Rend)/xBlend)
               Local GBlendGradient:Int=((Gstart - Gend)/xBlend)
               Local BBlendGradient:Int=((Bstart - Bend)/xBlend)

               ' Create initial value so we can then and the gradient's
               Local PixelR:Int=Rstart
               Local PixelG:Int=Gstart
               Local PixelB:Int=Bstart

               ' So lets do the 12 steps
               For x=499 Until 512

                   ' When the gradient is run 12 times we should have the origonal value?
                   PixelR = PixelR + RBlendGradient
                   PixelG = PixelG + GBlendGradient
                   PixelB = PixelB + BBlendGradient

                   pixies.WritePixel(x,y,($FF000000 + PixelR + PixelG + PixelB))
          

               Next

        Next

        ' Use this to see alterations befor doing tiling to see wrap
        ' DrawPixmap(pixies,0,0) ; Flip(0) ; WaitKey

        SavePixmapPNG(pixies, "worldMap.png")
       
End Function

End Type



'==================================
'           CLASS
'just simple class To help colors
'==================================
Type CColor

    Field R:Int = 0
    Field G:Int = 0
    Field B:Int = 0

    '==================================
    Function Create:CColor(r:Int, g:Int, b:Int)
        Local aa:CColor = New CColor

        aa.R = r
        aa.g = g
        aa.b = b

        Return aa
    End Function

    '==================================
    Function Process:CColor(f:Long)
        Local aa:CColor = New CColor

        aa.R = f & $00FF0000
        aa.R = aa.R / $10000
        aa.G = f & $0000FF00
        aa.G = aa.G / $100
        aa.B = f & $000000FF

        Return aa
    End Function

End Type




'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================

'some simple Setup
SetGraphicsDriver(GLMax2DDriver ())
Graphics(1920,1080, 0, 60)

'run perlin noise
CPerlinNoise.Calculate()



Global img:TImage = LoadImage("worldMap.png")

SetColor(255, 255, 255)

While Not KeyHit(KEY_ESCAPE) And Not AppTerminate()
    Cls

    DrawImage(img,0,0)

    Local width:Int=ImageWidth(img) ' gets images width
    Local height:Int=ImageHeight(img) ' gets image height

    'Print"Width="+width ; Print"height="+height

    Local acrossimages:Int=GraphicsWidth()/width ' Worksout how many fit in the screen
    Local downimages:Int=GraphicsHeight()/height
 
    Local posX:Int, posY:Int

    For Local x:Int=0 Until 2 'acrossimages  ' Could use "until" instead of "To"

        For Local y:Int=0 Until 2 'downimages

            DrawImage(img,posX,posY)
            posY:+height

        Next

        ' Reset posY

        posY=0

        posX:+width

    Next

    Flip(0) ' flips the screen as fast as it can go!

Wend
Kind Regards Baggey
Running a PC that just Aint fast enough!? i7 4Ghz Quad core 24GB ram 1TB SSD and NVIDIA Quadro K1200 . DID Technology stop! Or have we been assimulated!

ZX Spectrum 48k, C64, ORIC Atmos 48K, Enterprise 128K, The SID chip. Im Misunderstood!

Baggey

#4
August 07, 2023, 19:24:19
Hi, Ive had another go using each RGB value of each pixel then in 12 steps get back to the exact RGB value of the Starting pixels on the Map.

In Theory if i know the Starting pixel color and the last pixel color. I blend them in 12 steps to the original.

if you see the printouts its working in Math but somethings going wrong with the Pixel Writing back to the image.

Anyway here's another for you.

Code Select
SuperStrict

Const PerlinXwidth:Int=512

'==========================================
'           CLASS
'   main perlin noise class
'==========================================
Type CPerlinNoise

    Field sizeX:Int = PerlinXwidth
    Field sizeY:Int = 512

    'first random noise table
    Field noiseArr:Double[,] = New Double[sizeX, sizeY]
    'output table
    Field terrainArr:Double[,] = New Double[sizeX, sizeY]
    'output bitmap
    Field bitmapOut:TPixmap = TPixmap.Create(sizeX, sizeY, PF_RGBA8888)

    'frequency, the lower the larger terrains of same level
    Field frequency:Double = 1.0
    'starting amplitude
    Field amplitude:Double = 1.0
    'change of amplitude of next octave
    Field persistance:Double = 0.6
    'number of octaves
    Field octaves:Int = 8

    'min and max colors
    Field colMin:CColor = CColor.Create(0, 0, 0)
    Field colMax:CColor = CColor.Create(0, 0, 0)

    '==========================================
    '    to init perlin noise values
    '==========================================
    Method ChangeParams(fre:Double, amp:Double, pers:Double, oct:Int)

        frequency = fre
        amplitude = amp
        persistance = pers
        octaves = oct

    End Method

    '==========================================
    '       single field noise generation
    '=========================================
    Method GetRandomNoise:Double(x:Double, y:Double)

        Local fre:Double = frequency
        Local amp:Double = amplitude
        Local finalValue:Double = 0.0

        For Local i:Int = 0 To octaves
            finalValue = finalValue + LinearFIlterNoise(x * fre, y * fre) * amp
            fre = fre * 2.0
            amp = amp * persistance
        Next

        If(finalValue < - 1.0) finalValue = -1.0
        If(finalValue > 1.0) finalValue = 1.0

        finalValue = finalValue * 0.5 + 0.5

        Return finalValue

    End Method

    '==========================================
    '      create output terrain array
    '==========================================
    Method MakeTerrainMap()

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY
                terrainArr[x, y] = GetRandomNoise(x, y)
            Next
        Next

    End Method

    '==========================================
    '   process bitmap to file
    '==========================================
    Method MakeBitmap()

        bitmapOut.ClearPixels($FFFFFFFF)

        For Local x:Int = 0 Until sizeX
            For Local y:Int = 0 Until sizeY

                Local val:Double = terrainArr[x, y]
                Local R:Int = colMax.R * val + colMin.R * (1 - val)
                Local G:Int = colMax.G * val + colMin.G * (1 - val)
                Local B:Int = colMax.B * val + colMin.B * (1 - val)

                SetColor(R, G, B)
                bitmapOut.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next

    End Method

    '============================================
    '    perlin noise with linear interpolation
    '===========================================
    Method LinearFilterNoise:Double(x:Double, y:Double)

        Local fractionX:Double = Double(X) - Int(X)
        Local fractionY:Double = Double(Y) - Int(Y)

        Local x1:Int = (Int(x) + sizeX) Mod sizeX
        Local y1:Int = (Int(y) + sizeY) Mod sizeY
        Local x2:Int = ((Int(x) -1 ) + sizeX)Mod sizeX
        Local y2:Int = ((Int(y) -1 ) + sizeY )Mod sizeY

' If(x1 < 0) x1 = (sizeX - x1) Mod sizeX
' If(x2 < 0) x2 = (sizeX - x2) Mod sizeX
' If(y1 < 0) y1 = (sizeY - y1) Mod sizeY
' If(y2 < 0) y2 = (sizeY - y2) Mod sizeY

        Local finVal:Double = 0

        finVal = finVal + fractionX * fractionY * noiseArr[x1, y1]
        finVal = finVal + fractionX * (1 - fractionY) * noiseArr[x1, y2]
        finVal = finVal + (1 - fractionX) * fractionY * noiseArr[x2, y1]
        finVal = finVal + (1 - fractionX) * (1 - fractionY) * noiseArr[x2, y2]

        Return finVal

    End Method

    '===========================================
    '     to fill noise array with white noise
    '===========================================
    Method InitNoise(Seed:Double=0)
If Seed=0 Then Seed=MilliSecs()

SeedRnd Int(Seed)

        noiseArr = New Double[sizeX, sizeY]
        For Local y:Int = 0 Until sizeY-1
            For Local x:Int = 0 Until sizeX-1
                noiseArr[x, y] = (RndDouble() - 0.5) * 2.0
            Next
' noiseArr[sizex-1, y]=noiseArr[0,y]
        Next

' For Local x:Int = 0 Until sizeX
' noiseArr[x, sizey-1]=noiseArr[x,0]
' Next
    End Method

    '===========================================
    Method terrainSinus(p:Double)

        For Local y:Int = 0 Until sizeY
            For Local x:Int = 0 Until sizeX

                Local md:Double = Sin(y * 180.0 / sizeY) * 2 - 1
                terrainArr[x, y] = md * p + terrainArr[x, y] * (1.0 - p)

If (terrainArr[x,y]<0.0) Then terrainArr[x,y]=0.0

            Next
        Next

    End Method

    '============================================
    '      start process
    '===========================================
    Function Calculate(Seed:Double=0)

        'create altitude map
        Local highMap:CPerlinNoise = New CPerlinNoise
        highMap.ChangeParams(0.02, 0.95, 0.6, 6)
        highMap.colMin = CColor.Create(0, 120, 0)
        highMap.colMax = CColor.Create(100, 220, 100)
        highMap.InitNoise(Seed)
        highMap.MakeTerrainMap()
        highMap.MakeBitmap()
        SavePixmapPNG(highMap.bitmapOut, "high1.png")

        'creat humitidy map
        Local humMap:CPerlinNoise = New CPerlinNoise
        humMap.ChangeParams(0.04, 0.99, 0.6, 6)
        humMap.colMin = CColor.Create(0, 0, 20)
        humMap.colMax = CColor.Create(0, 50, 120)
        humMap.InitNoise(Seed)
        humMap.MakeTerrainMap()
        humMap.MakeBitmap()
        SavePixmapPNG(humMap.bitmapOut, "high2.png")

        'create temperature map
        Local tempMap:CPerlinNoise = New CPerlinNoise
        tempMap.ChangeParams(0.04, 0.99, 0.6, 6)
        tempMap.colMin = CColor.Create(60, 0, 0)
        tempMap.colMax = CColor.Create(240, 0, 0)
        tempMap.InitNoise(Seed)
        tempMap.MakeTerrainMap()
        tempMap.terrainSinus(0.6)
        tempMap.MakeBitmap()
        SavePixmapPNG(tempMap.bitmapOut, "high3.png")

        'generate additional world map
        GenerateWorldMap(highMap, humMap, tempMap)

    End Function

    '=============================================
    '      generate simple world map
    '=============================================
    Function GenerateWorldMap(highMap:CPerlinNoise,humMap:CPerlinNoise,tempMap:CPerlinNoise)

        Local pixies:TPixmap = TPixmap.Create(tempMap.sizeX, tempMap.sizeY, PF_RGBA8888)

        'pixies.clearpixels
      
        Local x:Int

        For Local y:Int = 0:Int Until tempMap.sizeY
            For x:Int = 0 Until tempMap.sizeX

                '''''''''''''''''''''''''''''''''''''''''''
                If x=tempMap.sizeX-12 Then Exit  ' <- Force a blend to origonal values
                '''''''''''''''''''''''''''''''''''''''''''

                Local T:Double = tempMap.terrainArr[x, y] * 2 - 1.0
                Local H:Double = humMap.terrainArr[x, y] * 2 - 1.0
                Local A:Double = highMap.terrainArr[x, y] * 2 - 1.0

                Local R:Int, G:Int, B:Int

                'water
                If(A < 0)
                    R = 0
                    G = 60 + A * 60
                    B = 120 + A * 100
                'land
                Else

                    'altitude
                    R = 60 + A * 180
                    G = 60 + A * 180
                    B = 60 + A * 180

                    'temperature
                    If(T >= 0)
                        G = G * (1.0 - T * 0.3)
                        B = B * (1.0 - T * 0.3)
                    Else
                        R = R * (1.0 + T * 0.3)
                    End If

                    'high humidity
                    If(H >= 0)
                        R = R * (1.0 - H * 0.3)
                        B = B * (1.0 - H * 0.3)
                    Else
                        G = G * (1.0 + H * 0.3)
                    End If

                End If

                'some final quantizations

                R = (R / 15) * 15
                G = (G / 15) * 15
                B = (B / 15) * 15


                pixies.WritePixel(x, y, $FF000000 + (R * $10000 + G * $100 + B))

            Next
        Next

        SavePixmapPNG(pixies, "worldMap.png")

        blend(x, pixies)

    End Function


    Function Blend(xBlend:Int, pixies:TPixmap)


        ' We should return here with 12 Pixels missing in the x-Plane or i-vector
        Print "PerlinX-xBlend="+(PerlinXwidth-xBlend)
        Print "PerlinX width="+PerlinXwidth
        Print "xBlend="+xBlend

        Print "pixies="+pixies.width
      
        'DrawPixmap(pixies,0,0) ; Flip(0) ; waitkey

        ' lets do first 10 values!
        Local x:Int

        For Local y:Int=0 Until 512

       
               'lets take the relevent parts out the R G B components
               ' ie Rstart must change to Rend etc...
               Local Rstart:Float=(pixies.ReadPixel(0,y)&$00FF0000) Shr 16
               Local Gstart:Float=(pixies.ReadPixel(0,y)&$0000FF00) Shr 8
               Local Bstart:Float=(pixies.ReadPixel(0,y)&$000000FF)

               Local Rend:Float=(pixies.ReadPixel(499,y)&$00FF0000) Shr 16
               Local Gend:Float=(pixies.ReadPixel(499,y)&$0000FF00) Shr 8
               Local Bend:Float=(pixies.ReadPixel(499,y)&$000000FF)

               Local RBlendGradient:Float
               Local GBlendGradient:Float
               Local BBlendGradient:Float

               ' Create initial Pixels to Grade
               Local PixelR:Float'=Rend
               Local PixelG:Float'=Gend
               Local PixelB:Float'=Bend
              

               ' Create the blend gradient ie how many steps to get to origonal value
               ' This is where i think it's going wrong

              
               If Rend>=Rstart Then ' Larger
                      RBlendGradient=(Rstart - Rend)/12
                  Else
                      RBlendGradient=-(Rend - Rstart) / 12
               End If
 
               If Gend>=Gstart Then ' Larger
                      GBlendGradient=(Gstart - Gend) / 12
                  Else
                      GBlendGradient=-(Gend - Gstart) / 12
               End If

                If Bend>=Bstart Then ' Larger
                      BBlendGradient=(Bstart - Bend) / 12
                  Else
                      BBlendGradient=-(Bend - Bstart) / 12
               End If 

               Print "Rstart="+Rstart+"   Rend="+Rend+"   Gradient is "+RBlendGradient
               Print "Gstart="+Gstart+"   Rend="+Gend+"   Gradient is "+GBlendGradient
               Print "Bstart="+Bstart+"   Rend="+Bend+"   Gradient is "+BBlendGradient
               Print
       
               PixelR=Rend
               PixelG=Gend
               PixelB=Bend

               ' Test
              
               Print "PixelR="+PixelR
               For Local counter:Int = 0 Until 12
                     PixelR:+RBlendGradient
               Next
               Print "After  RBlendGradient "+RBlendGradient+" Becomes PixelR="+PixelR
               Print

               Print "PixelG="+PixelG
               For Local counter:Int = 0 Until 12
                     PixelG:+GBlendGradient
               Next
               Print "After  GBlendGradient "+GBlendGradient+" Becomes PixelG="+PixelG
               Print

               Print "PixelB="+PixelB  
               For Local counter:Int = 0 Until 12
                     PixelB:+BBlendGradient
               Next
               Print "After  BBlendGradient "+BBlendGradient+" Becomes PixelB="+PixelB
               Print


               Local RStarter:Long=pixies.ReadPixel(x,y)

               Local RFinish:Long=($FF000000 + (PixelR Shl 16) + (PixelG Shl 8) + (PixelB))

               Print "Pixel at Start"+pixies.ReadPixel(x,y)+" =  "+RFinish
               Print

              
               ' So lets do the 12 steps
               For x=500 Until 512

                   ' When the gradient is run 12 times we should have the origonal value?
                         
                           PixelR = PixelR + RBlendGradient  
                           PixelG = PixelG + GBlendGradient
                           PixelB = PixelB + BBlendGradient

                   ' so for first test just write same pixels
                   'pixies.WritePixel(x,y,copy) ''($FF000000 + PixelR + PixelG + PixelB))
                   pixies.WritePixel(x,y,($FF000000 + (PixelR Shl 16) + (PixelG Shl 8) + PixelB))
                

               Next

        Next

        ' Use this to see alterations befor doing tiling to see wrap
        ' DrawPixmap(pixies,0,0) ; Flip(0) ; WaitKey

        SavePixmapPNG(pixies, "worldMap.png")
      
End Function

End Type



'==================================
'           CLASS
'just simple class To help colors
'==================================
Type CColor

    Field R:Int = 0
    Field G:Int = 0
    Field B:Int = 0

    '==================================
    Function Create:CColor(r:Int, g:Int, b:Int)
        Local aa:CColor = New CColor

        aa.R = r
        aa.g = g
        aa.b = b

        Return aa
    End Function

    '==================================
    Function Process:CColor(f:Long)
        Local aa:CColor = New CColor

        aa.R = f & $00FF0000
        aa.R = aa.R / $10000
        aa.G = f & $0000FF00
        aa.G = aa.G / $100
        aa.B = f & $000000FF

        Return aa
    End Function

End Type




'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================
'===========================================================

'some simple Setup
SetGraphicsDriver(GLMax2DDriver ())
Graphics(1920,1080, 0, 60)

'run perlin noise
CPerlinNoise.Calculate()



Global img:TImage = LoadImage("worldMap.png")

SetColor(255, 255, 255)

While Not KeyHit(KEY_ESCAPE) And Not AppTerminate()
    Cls

    DrawImage(img,0,0)

    Local width:Int=ImageWidth(img) ' gets images width
    Local height:Int=ImageHeight(img) ' gets image height

    'Print"Width="+width ; Print"height="+height

    Local acrossimages:Int=GraphicsWidth()/width ' Worksout how many fit in the screen
    Local downimages:Int=GraphicsHeight()/height
 
    Local posX:Int, posY:Int

    For Local x:Int=0 Until 4 'acrossimages  ' Could use "until" instead of "To"

        For Local y:Int=0 Until 1 'downimages

            DrawImage(img,posX,posY)
            posY:+height

        Next

        ' Reset posY

        posY=0

        posX:+width

    Next

    Flip(0) ' flips the screen as fast as it can go!

Wend 
I cant believe how interestingly Geeky this is! As i said i like manipulating pixels! :-[

Ive just realized computer games generate Terrain using this sort of stuff. Is that what your trying todo?

There are far more cleverer people than me on here maybe someone will help soon 8)

Kind Regards Baggey

Running a PC that just Aint fast enough!? i7 4Ghz Quad core 24GB ram 1TB SSD and NVIDIA Quadro K1200 . DID Technology stop! Or have we been assimulated!

ZX Spectrum 48k, C64, ORIC Atmos 48K, Enterprise 128K, The SID chip. Im Misunderstood!

_PJ_

#5
August 09, 2023, 15:46:38
Assuming the format is correct ( which looks to be aRGB high-endian ) then I think the issue with the pixel writing is most likely due to the interpretation of the float values when parsing them as Byte

I think this can be solved by keeping the float values for RPixel etc. separate as they increment/decrement gradually, but have another variable declared as Byte(Int(Floor(RPixel)) & 255) to retrieve a valid 8-bit value...
Print
Go Up Pages1
User actions