## Island Generator

rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

### Island Generator

Came across the tutorial listed in source and hacked his together. Needs a lot of improvement though.

Code: Select all

`'Island Generator'Based on tutorial at:'http://www.robot-frog.com/3d/index.html'Richard D. Clark'Public Domain'Space to regen, esc to exit'+++++++++++++++++++++++++++++++++++++++++++#define sw 320#define sh 240#define hiter 400dim shared hm(sw * sh) as integerdim shared thm(sw * sh) as integerdim shared nhm(sw * sh) as singledim shared palmap(sw * sh) as integerdim shared pal(0 to 255) as uintegerdim shared as integer max = 0, min = 100000dim key as stringFunction Rand(lowerbound As Integer, upperbound As Integer) As Integer    Return Int((upperbound - lowerbound + 1) * Rnd + lowerbound) End Function sub GeneratePalette    dim as integer i, r, g, b        '0 to 50    r = 0    g = 0    b = 100    for i = 0 to 50        pal(i) = RGB(r, g, b)        b += 1    next    '51 to 100    r = 100    g = 100    b = 0    for i = 51 to 100        pal(i) = RGB(r, g, b)        r += 1        g += 1        b += 1    next    '101 to 150    for i = 101 to 150        pal(i) = RGB(r, g, b)        r += 1        g += 1    next    '151 to 200    r = 255    g = 199    b = 122    for i = 151 to 240        pal(i) = RGB(r, g, b)        r -= 1        g -= 1        b -= 1    next    '241 to 255    r = 158    g = 158    b = 158    for i = 241 to 255        pal(i) = RGB(r, g, b)        r += 2        g += 2        b += 2    next    end subsub GenerateHM    dim as integer i, x, y, r, cx, cy        for i = 1 to hiter        r = Rand(5, 60)        cx = Rand(0, sw - 1)        cy = Rand(0, sh - 1)        for x = 0 to sw - 1            for y = 0 to sh - 1                thm(x + y * sw) = (r * r) -((x - cx) * (x - cx) + (y - cy) * (y - cy))                if thm(x + y * sw) < 0 then thm(x + y * sw) = 0                hm(x + y * sw) = hm(x + y * sw) + thm(x + y * sw)                 if hm(x + y * sw) >= max then max = hm(x + y * sw)                if hm(x + y * sw) <= min then min = hm(x + y * sw)            next        next    next    end subsub Normalize    dim as integer x, y         'Normalize    for x = 0 to sw - 1        for y = 0 to sh - 1            nhm(x + y * sw) = (hm(x + y * sw) - min) / (max - min)            'Flatten            nhm(x + y * sw) = nhm(x + y * sw) * nhm(x + y * sw)            'Generate palmap            palmap(x + y * sw) =  nhm(x + y * sw) * 255        next    next    end subsub ShowMap    dim as integer x, y        screenlock    for x = 0 to sw - 1        for y = 0 to sh - 1            pset (x, y), pal(palmap(x + y * sw))        next    next    screenunlockend subrandomize timerscreenres sw, sh, 32GeneratePaletteGenerateHMNormalizeShowMapdo    key = inkey    if key = chr(32) then        cls        Erase hm        erase thm        erase nhm        erase palmap        GenerateHM        Normalize        ShowMap    end if    loop until key = chr(27)`
steven522
Posts: 265
Joined: May 27, 2005 13:02
Location: Alabama, USA
Contact:
Interesting. Some of the "island" edges seem to actually go off the edge of the window. It would look better if it were always completely surrounded by water.
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Yeah, that is in the tutorial, but I didn't add it in. It is pretty slow as it is right now. This was just a quickie to see how the algo worked. Feel free to improve and use.
tinram
Posts: 88
Joined: Nov 30, 2006 13:35
Location: UK
Nice colour palette.
Yes it is quite slow for a 320 x 240 window with screenlock (using a P4 3.2) (and it maxes the processor between plots).

I tried it with 8bpp to see how much faster it might be...

Code: Select all

`screenres sw, sh, 8`

...didn't make much difference, but did produce psychedelic colours.

groovy!
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
It's the large 32-bit element (integer) arrays which make it slow. It spends most of it's time in the "GenerateHM" function.
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Actually, I did this for an ascii game I am working on, so it is fast enough for my purposes:

cha0s
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:
Nice, thanks for that
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Thanks man. What stuck me about this was the simplicity of the algo. I have seen other methods that were much more complicated, but didn't produce much better results. This would probably work much better using OGL since you wouldn't have to work with such a big array.
cha0s
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Code: Select all

`'Island Generator'Based on tutorial at:'http://www.robot-frog.com/3d/index.html'Richard D. Clark and cha0s'Public Domain'Space to regen, esc to exit'+++++++++++++++++++++++++++++++++++++++++++#define sw 400#define sh 400#define hiter 300#define rad_low 10#define rad_high 40#define minsize (sh*.5)Dim Shared hm(sw * sh) As IntegerDim Shared nhm(sw * sh) As SingleDim Shared palmap(sw * sh) As IntegerDim Shared pal(0 To 255) As UintegerDim Shared As Integer max = 0, min = 100000Dim Key As StringFunction Rand(byref lowerbound As double, byref upperbound As double) As double   function = ((upperbound - lowerbound + 1) * Rnd + lowerbound)End FunctionSub GeneratePalette    Dim As Integer i, r, g, b       '0 to 50    r = 0    g = 0    b = 100    For i = 0 To 50        pal(i) = RGB(r, g, b)        if (i and 1) = 0 then            b += 1          end if    Next    '51 to 100    r = 100    g = 100    b = 0    For i = 51 To 100        pal(i) = RGB(r, g, b)        r += 1        g += 1        b += 1    Next    '101 to 150    For i = 101 To 150        pal(i) = RGB(r, g, b)        r += 1        g += 1    Next    '151 to 200    r = 255    g = 199    b = 122    For i = 151 To 240        pal(i) = RGB(r, g, b)        r -= 1        g -= 1        b -= 1    Next    '241 to 255    r = 158    g = 158    b = 158    For i = 241 To 255        pal(i) = RGB(r, g, b)        r += 2        g += 2        b += 2    Next   End SubSub GenerateHM   dim as double ox, oy, cx, cy, bx, by    dim as double r, theta, distance, ti    dim as integer tmp       For i as integer = 1 To hiter        r = Rand(rad_low, rad_high)       theta = rand(0, atn(1) * 8)       distance = rand((rad_high-rad_low)*1, minsize - r)        r *= r        ox = 0-((sw/2) + cos(theta) * distance)        oy = 0-((sh/2) + sin(theta) * distance)        cy = oy          by = oy * oy        for row as integer = 0 to sw*sh-1 step sw             cx = ox           bx = cx * cx           For loc_ as integer ptr = @hm(row) To @hm(row) + (sw) - 1              tmp = *loc_              ti = r -(bx + by)               If ti < 0 Then ti = 0               tmp += ti               max = iif( tmp > max, tmp, max )               min = iif( tmp < min, tmp, min )               *loc_ = tmp              bx += cx              cx += 1              bx += cx           Next           by += cy           cy += 1           by += cy       next    Next   End SubSub Normalize    Dim As Integer x, y, idx       'Normalize    For x = 0 To sw - 1        For y = 0 To sh - 1           idx = x + y * sw            nhm(idx) = (hm(idx) - min) / (max - min)            'Flatten            'nhm(idx) = nhm(idx) * nhm(idx)            'Generate palmap            palmap(idx) =  nhm(idx) * 255        Next    Next   End SubSub ShowMap    Dim As Integer x, y       screenlock    For x = 0 To sw - 1        For y = 0 To sh - 1            Pset (x, y), pal(palmap(x + y * sw))        Next    Next    screenunlockEnd SubRandomize Timerscreenres sw, sh, 32', , 1var t = timerGeneratePaletteGenerateHMNormalizeShowMap? timer - tDo    Key = Inkey    If Key = Chr(32) Then        Cls        Erase hm        Erase nhm        Erase palmap        GenerateHM        Normalize        ShowMap    End If   Loop Until Key = Chr(27)`

Some optimizations and added the polar coordinates calculation to make them true islands ^^. Enjoy, but beware I made the code pretty weird to try to make it faster.
redcrab
Posts: 618
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:
I've just change the palette a little bit
-coast and low deep water
-High altitude little bit more snowy

That's fun

Code: Select all

`'Island Generator'Based on tutorial at:'http://www.robot-frog.com/3d/index.html'Richard D. Clark and cha0s'Public Domain'Space to regen, esc to exit'+++++++++++++++++++++++++++++++++++++++++++#define sw 400#define sh 400#define hiter 300#define rad_low 10#define rad_high 40#define minsize (sh*.5)Dim Shared hm(sw * sh) As IntegerDim Shared nhm(sw * sh) As SingleDim Shared palmap(sw * sh) As IntegerDim Shared pal(0 To 255) As UintegerDim Shared As Integer max = 0, min = 100000Dim Key As StringFunction Rand(Byref lowerbound As Double, Byref upperbound As Double) As Double   Function = ((upperbound - lowerbound + 1) * Rnd + lowerbound)End FunctionSub GeneratePalette    Dim As Integer i, r, g, b       '0 to 50    r = 0    g = 0    b = 100    For i = 0 To 50        pal(i) = RGB(r, g, b)        If (i And 1) = 0 Then                 If i >40 Then                    r += 30 : g +=30                      b += 1                 Else                    b+= 1                 End If        End If            Next    '51 to 100    r = 50    g = 50    b = 0    For i = 51 To 100        pal(i) = RGB(r, g, b)        r += 2        g += 2        b += 1    Next    '101 to 150    For i = 101 To 150        pal(i) = RGB(r, g, b)        r += 1        g += 1        b -= 1    Next    '151 to 240    r = 255    g = 200 '199    b = 122    For i = 151 To 240        pal(i) = RGB(r, g, b)        r -= 1        g -= 1        b -= 1    Next    '241 to 255    r = 194    g = 194    b = 194    For i = 241 To 255        pal(i) = RGB(r, g, b)        r += 4        g += 4        b += 4    Next   End SubSub GenerateHM        Dim As Double ox, oy, cx, cy, bx, by    Dim As Double r, theta, distance, ti    Dim As Integer tmp           For i As Integer = 1 To hiter        r = Rand(rad_low, rad_high)            theta = rand(0, Atn(1) * 8)            distance = rand((rad_high-rad_low)*1, minsize - r)        r *= r        ox = 0-((sw/2) + Cos(theta) * distance)        oy = 0-((sh/2) + Sin(theta) * distance)        cy = oy               by = oy * oy        For row As Integer = 0 To sw*sh-1 Step sw                       cx = ox                bx = cx * cx                For loc_ As Integer Ptr = @hm(row) To @hm(row) + (sw) - 1                        tmp = *loc_                        ti = r -(bx + by)                    If ti < 0 Then ti = 0                    tmp += ti                    max = iif( tmp > max, tmp, max )                    min = iif( tmp < min, tmp, min )                    *loc_ = tmp                        bx += cx                        cx += 1                        bx += cx                Next                by += cy                cy += 1                by += cy            Next    Next   End SubSub Normalize    Dim As Integer x, y, idx       'Normalize    For x = 0 To sw - 1        For y = 0 To sh - 1                idx = x + y * sw            nhm(idx) = (hm(idx) - min) / (max - min)            'Flatten            'nhm(idx) = nhm(idx) * nhm(idx)            'Generate palmap            palmap(idx) =  nhm(idx) * 255        Next    Next   End SubSub ShowMap    Dim As Integer x, y       screenlock    For x = 0 To sw - 1        For y = 0 To sh - 1            Pset (x, y), pal(palmap(x + y * sw))        Next    Next    screenunlockEnd SubRandomize Timerscreenres sw, sh, 32', , 1var t = TimerGeneratePaletteGenerateHMNormalizeShowMap? Timer - tDo    Key = Inkey    If Key = Chr(32) Then        Cls        Erase hm        Erase nhm        Erase palmap        GenerateHM        Normalize        ShowMap    End If   Loop Until Key = Chr(27)`
cha0s
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:
It looks very good, my friend. ;)
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
cha0s: Excellent work. That is much faster, and looks quite a bit better.

redcrab: Very nice color scheme. Looks very realistic.
redcrab
Posts: 618
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:
It's quick and dirty
but I'm not experimented with OpenGL

I pray Dr_D or Relsoft gods to forgive me of my horrible OGL usage

When a Island is nice enough for you press "o" key to see the island in 3D
(3D accelerated card needed: 80000 triangles !)

then press Z or z to rotate the island (you may press X-x or Y-y as well)
if you wanna a new island just press ESC then press space or "o" when desired.

Don't know if it will works on all 3D cards ...

Enjoy !

Code: Select all

`'option explicit#include once "GL/gl.bi"#include once "GL/glu.bi"#define SC_ESCAPE &h01#define SC_1 &h02#define SC_2 &h03#define SC_3 &h04#define SC_4 &h05#define SC_5 &h06#define SC_6 &h07#define SC_7 &h08#define SC_8 &h09#define SC_9 &h0A#define SC_0 &h0B#define SC_MINUS &h0C#define SC_EQUALS &h0D#define SC_BACKSPACE &h0E#define SC_TAB &h0F#define SC_Q &h10#define SC_W &h11#define SC_E &h12#define SC_R &h13#define SC_T &h14#define SC_Y &h15#define SC_U &h16#define SC_I &h17#define SC_O &h18#define SC_P &h19#define SC_LEFTBRACKET &h1A#define SC_RIGHTBRACKET &h1B#define SC_ENTER &h1C#define SC_CONTROL &h1D#define SC_A &h1E#define SC_S &h1F#define SC_D &h20#define SC_F &h21#define SC_G &h22#define SC_H &h23#define SC_J &h24#define SC_K &h25#define SC_L &h26#define SC_SEMICOLON &h27#define SC_QUOTE &h28#define SC_TILDE &h29#define SC_LSHIFT &h2A#define SC_BACKSLASH &h2B#define SC_Z &h2C#define SC_X &h2D#define SC_C &h2E#define SC_V &h2F#define SC_B &h30#define SC_N &h31#define SC_M &h32#define SC_COMMA &h33#define SC_PERIOD &h34#define SC_SLASH &h35#define SC_RSHIFT &h36#define SC_MULTIPLY &h37#define SC_ALT &h38#define SC_SPACE &h39#define SC_CAPSLOCK &h3A#define SC_F1 &h3B#define SC_F2 &h3C#define SC_F3 &h3D#define SC_F4 &h3E#define SC_F5 &h3F#define SC_F6 &h40#define SC_F7 &h41#define SC_F8 &h42#define SC_F9 &h43#define SC_F10 &h44#define SC_NUMLOCK &h45#define SC_SCROLLLOCK &h46#define SC_HOME &h47#define SC_UP &h48#define SC_PAGEUP &h49#define SC_LEFT &h4B#define SC_RIGHT &h4D#define SC_PLUS &h4E#define SC_END &h4F#define SC_DOWN &h50#define SC_PAGEDOWN &h51#define SC_INSERT &h52#define SC_DELETE &h53#define SC_F11 &h57#define SC_F12 &h58#define sw 400#define sh 400#define hiter 300#define rad_low 10#define rad_high 40#define minsize (sh*.5)Dim Shared palmap(sw * sh) As IntegerDim Shared pal(0 To 255) As UintegerDim Shared colormap(0 To 65536*3-1) As UByteDim Shared texture (0 To 0) As UIntegerSub Init()   screen 18, 16, , 3   dim LightAmbient(0 to 3) as single => {0.1, 0.1, 0.1, 1.0}     dim LightDiffuse(0 to 3) as single => {1.0, 1.0, 1.0, 1.0}    dim LightPosition(0 to 3) as single => {0.0, 0.0, -3.0, 1.0}   dim as single LightSpc(0 to 3) => {0, 0, 0, 1.0}      dim as single MatAmb(0 to 3) => {0.1, 0.1, 0.1, 1.0}   dim as single MatDif(0 to 3) => {1.0, 1.0, 1.0, 1.0}   dim as single MatSpc(0 to 3) => {1.0, 1.0, 1.0, 1.0}   dim as single MatShn(0) => {0}     Dim As UInteger x,y,c    ' create color map   For y = 0 To 127      For x = 0 To 255         c = x or (y Shl 8)         colormap(c*3 + 0) = Cast(UByte,(c and &h00007c00) Shr 7)  'red         colormap(c*3 + 1) = Cast(UByte,(c And &h000003e0) Shr 2) ' green          colormap(c*3 + 2) = Cast(UByte,(c And &h0000001f) Shl 3) ' blue       Next x   Next y                             glViewport 0, 0, 640, 480                         glMatrixMode GL_PROJECTION                        glLoadIdentity                                    gluPerspective 22.0, 640.0/480.0, 0.1, 100.0      glMatrixMode GL_MODELVIEW                         glLoadIdentity                                       glGenTextures 1, @texture(0)                    '' Create The Texture      ' Create Nearest Filtered Texture   glBindTexture GL_TEXTURE_2D, texture(0)   glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER, GL_NEAREST   glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER, GL_NEAREST   glTexImage2D GL_TEXTURE_2D, 0, 3, 256, 256, 0, GL_RGB, GL_UNSIGNED_BYTE, @colormap(0) ' TextureImage(0)->buffer   glShadeModel GL_SMOOTH      glEnable GL_TEXTURE_2D                         '' Enable Texture Mapping   glClearColor 0.2, 0.2, 0.2, 0.5                   glClearDepth 1.0                                  glEnable GL_DEPTH_TEST                            glDepthFunc GL_LEQUAL                             glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST       glLightfv GL_LIGHT1, GL_AMBIENT, @LightAmbient(0)   glLightfv GL_LIGHT1, GL_DIFFUSE, @LightDiffuse(0)    glLightfv GL_LIGHT1, GL_POSITION, @LightPosition(0)   glLightfv(GL_LIGHT1, GL_SPECULAR, @LightSpc(0))   glEnable GL_LIGHT1    glEnable(GL_LIGHTING)        glMaterialfv(GL_FRONT, GL_AMBIENT, @MatAmb(0))   glMaterialfv(GL_FRONT, GL_DIFFUSE, @MatDif(0))   glMaterialfv(GL_FRONT, GL_SPECULAR, @MatSpc(0))   glMaterialfv(GL_FRONT, GL_SHININESS, @MatShn(0))   'glCullFace(GL_BACK)   'glEnable(GL_CULL_FACE)    'glPolygonMode GL_FRONT, GL_LINE end sub'************* DATA ****************type t_vector   as single x,y,zend typetype t_face    as t_vector p1,p2,p3,pn    as single red,green,blueend typeType t_model  faces as t_face ptr  nbfaces as integerEnd Type' MESH DATA for landdim shared land(1 to  80000) as t_face enum modelID   _land_ = 1end enumdim shared models(1 to 1) as t_modelmodels(_land_).faces = @land(1)models(_land_).nbfaces = ubound(land)  sub DrawModel(aModel as t_model)dim as uinteger index,c,ubDim As Single u,vub = aModel.nbfaces-1glBegin(GL_TRIANGLES)for index = 0 to ub    with aModel.faces[index]      c = int(.red*31.0) Shl 10 + Int(.green*31.0) Shl 5 + int(.blue*31.0)      u = Cast(Single,c And &h0ff)/256.0       v = Cast(Single, (c Shr 8) And &h0ff)/256.0      glNormal3f(.pn.x,.pn.y,.pn.z)      glTexCoord2f u,v      glVertex3f(.p1.x,.p1.y,.p1.z)      glVertex3f(.p2.x,.p2.y,.p2.z)      glVertex3f(.p3.x,.p3.y,.p3.z)   end withnext indexglEnd()end subsub DrawObject(aModel as t_model,x as single ,y as single , z as single, byval rx as single, byval ry as single ,byval  rz as single)   dim as GLUquadricObj ptr q   glPushMatrix   glTranslatef x, y, z    'glRotatef 1, rx, ry, rz    ' 1st : rotation gisement (perpendicular axis from the ground)   ' 2nd : rotation azimut   (axis paralle to the ground )   ' 3rd : rotation for vertical adjustement   glRotatef ry, 0.0, 1.0, 0.0    glRotatef rx, 1.0, 0.0, 0.0    glRotatef rz, 0.0, 0.0, 1.0    DrawModel(aModel)   glPopMatrixend sub#Define __Point(x,y)  palmap((x) + (y) * sw)'************* Show me the land ****sub OGLmain   dim as single rx,ry,rz,coefxy,coefz,xu,yu,zu,xv,yv,zv,xn,yn,zn,length   dim as integer i,j,k,ub,xs,ys,r,g,b,p,p2,p3,p4,t   dim kb as string   dim m as Integer      coefxy = 1.0/200.0   coefz = 1.0/512   t = 1   For ys = 0 To 399 Step 2      For xs = 0 To 399 Step 2         p = __Point(xs,ys) : p2 = __Point(xs,ys+2) : p3 = __Point(xs+2,ys+2): : p4 = __Point(xs+2,ys)         r = (pal(p) And &hFF0000) Shr 16         g =  (pal(p) And &hFF00) Shr 8         b =  pal(p) And &hFF         'Palette Get p,r,g,b         'r = 255:g= 255: b= 255         p = p -50 : p = IIf(p<0 ,0,p)          p2 = p2 - 50 : p2 = IIf(p2<0 ,0,p2)         p3 = p3 - 50 : p3 = IIf(p3<0 ,0,p3)         p4 = p4 - 50 : p4 = IIf(p4<0 ,0,p4)         land(t).p1.x = (xs - 200)*coefxy         land(t).p1.y = (ys - 200)*coefxy         land(t).p1.z = (p - 128)*coefz         land(t).p3.x = (xs - 200)*coefxy         land(t).p3.y = (ys+2 -200)*coefxy         land(t).p3.z = (p2 - 128)*coefz         land(t).p2.x = (xs + 2 - 200)*coefxy         land(t).p2.y = (ys + 2 - 200)*coefxy         land(t).p2.z = (p3 - 128)*coefz         With land(t)          xu = .p1.x - .p2.x : yu = .p1.y - .p2.y : zu = .p1.z - .p2.z          xv = .p2.x - .p3.x : yv = .p2.y - .p3.y : zv = .p2.z - .p3.z          xn = yu * zv - zu * yv : yn = zu * xv - xu * zv : zn = xu * yv - yu * xv          length = sqr(xn^2 + yn^2 + zn^2)          if length = 0.0f then length = 1.0f          xn /= length : yn /= length : zn /= length          .pn.x = xn : .pn.y = yn : .pn.z = zn         End with         land(t).red = csng(r)/255.0         land(t).green = csng(g)/255.0         land(t).blue = CSng(b)/255.0         t +=1         land(t).p1.x = land(t-1).p1.x         land(t).p1.y = land(t-1).p1.y         land(t).p1.z = land(t-1).p1.z         land(t).p3.x = land(t-1).p2.x         land(t).p3.y = land(t-1).p2.y         land(t).p3.z = land(t-1).p2.z         land(t).p2.x = (xs +2 - 200)*coefxy         land(t).p2.y = (ys - 200) * coefxy         land(t).p2.z = (p4 - 128)*coefz         With land(t)          xu = .p1.x - .p2.x : yu = .p1.y - .p2.y : zu = .p1.z - .p2.z          xv = .p2.x - .p3.x : yv = .p2.y - .p3.y : zv = .p2.z - .p3.z          xn = yu * zv - zu * yv : yn = zu * xv - xu * zv : zn = xu * yv - yu * xv          length = sqr(xn^2 + yn^2 + zn^2)          if length = 0.0f then length = 1.0f          xn /= length : yn /= length : zn /= length          .pn.x = xn : .pn.y = yn : .pn.z = zn         End with         land(t).red = csng(r)/255.0         land(t).green = csng(g)/255.0         land(t).blue = CSng(b)/255.0         t +=1      Next xs   Next ys   init   rx = -75 : ry = 0 : rz = 0   m = 1   ub = ubound(models)       do      kb = inkey\$      sleep 1      'While Inkey <> "": Wend      glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT      k = 0      if kb = chr(255)+"k" then kb = chr(27)      if multikey(SC_X) then rx+=1      if multikey(SC_Y) then ry+=1      if multikey(SC_Z) then rz+=1      if multikey(SC_X) and (multikey(SC_LSHIFT) or multikey(SC_RSHIFT)) then rx-=2      if multikey(SC_Y) and (multikey(SC_LSHIFT) or multikey(SC_RSHIFT)) then ry-=2      if multikey(SC_Z) and (multikey(SC_LSHIFT) or multikey(SC_RSHIFT)) then rz-=2      if multikey(SC_M) and (multikey(SC_LSHIFT) or multikey(SC_RSHIFT)) then         m-=1 : Sleep 100,1         'while multikey(SC_M) : sleep 1,1 :kb = inkey: wend      Else         if multikey(SC_M) then            m+=1 : Sleep 100,1            'while multikey(SC_M) : sleep 1,1 : kb = InKey : wend         end If      End If            if multikey(SC_SPACE) then         rx = 0 : ry = 0 : rz = 0      end if      if multikey(SC_ESCAPE) then kb = chr(27)      if m > ub then m = lbound(models)      if m < 1 then m = ub      'end if          for i = -0 to 0         for j = -0 to 0            drawObject(models(m),i*2, j*2, -5.0 ,rx,ry,rz)         next j      next i      flip   loop while kb <> chr(27)end sub 'Island Generator'Based on tutorial at:'http://www.robot-frog.com/3d/index.html'Richard D. Clark and cha0s'Public Domain'Space to regen, esc to exit'+++++++++++++++++++++++++++++++++++++++++++Dim Shared hm(sw * sh) As IntegerDim Shared nhm(sw * sh) As SingleDim Shared As Integer max = 0, min = 100000Dim Key As StringFunction Rand(Byref lowerbound As Double, Byref upperbound As Double) As Double   Function = ((upperbound - lowerbound + 1) * Rnd + lowerbound)End FunctionSub GeneratePalette    Dim As Integer i, r, g, b       '0 to 50    r = 0    g = 0    b = 100    For i = 0 To 50        pal(i) = RGB(r, g, b)        If (i And 1) = 0 Then                 If i >40 Then                    r += 30 : g +=30                      b += 1                 Else                    b+= 1                 End If        End If            Next    '51 to 100    r = 50    g = 50    b = 0    For i = 51 To 100        pal(i) = RGB(r, g, b)        r += 2        g += 2        b += 1    Next    '101 to 150    For i = 101 To 150        pal(i) = RGB(r, g, b)        r += 1        g += 1        b -= 1    Next    '151 to 240    r = 255    g = 200 '199    b = 122    For i = 151 To 240        pal(i) = RGB(r, g, b)        r -= 1        g -= 1        b -= 1    Next    '241 to 255    r = 194    g = 194    b = 194    For i = 241 To 255        pal(i) = RGB(r, g, b)        r += 4        g += 4        b += 4    Next   End SubSub GenerateHM        Dim As Double ox, oy, cx, cy, bx, by    Dim As Double r, theta, distance, ti    Dim As Integer tmp           For i As Integer = 1 To hiter        r = Rand(rad_low, rad_high)            theta = rand(0, Atn(1) * 8)            distance = rand((rad_high-rad_low)*1, minsize - r)        r *= r        ox = 0-((sw/2) + Cos(theta) * distance)        oy = 0-((sh/2) + Sin(theta) * distance)        cy = oy               by = oy * oy        For row As Integer = 0 To sw*sh-1 Step sw                       cx = ox                bx = cx * cx                For loc_ As Integer Ptr = @hm(row) To @hm(row) + (sw) - 1                        tmp = *loc_                        ti = r -(bx + by)                    If ti < 0 Then ti = 0                    tmp += ti                    max = iif( tmp > max, tmp, max )                    min = iif( tmp < min, tmp, min )                    *loc_ = tmp                        bx += cx                        cx += 1                        bx += cx                Next                by += cy                cy += 1                by += cy            Next    Next   End SubSub Normalize    Dim As Integer x, y, idx       'Normalize    For x = 0 To sw - 1        For y = 0 To sh - 1                idx = x + y * sw            nhm(idx) = (hm(idx) - min) / (max - min)            'Flatten            'nhm(idx) = nhm(idx) * nhm(idx)            'Generate palmap            palmap(idx) =  nhm(idx) * 255        Next    Next   End SubSub ShowMap    Dim As Integer x, y       screenlock    For x = 0 To sw - 1        For y = 0 To sh - 1            Pset (x, y), pal(palmap(x + y * sw))        Next    Next    screenunlockEnd SubRandomize Timerscreenres sw, sh, 32', , 1var t = TimerGeneratePaletteGenerateHMNormalizeShowMap? int((Timer - t)*100.0)/100.0;? " press O to get OGL ! "Do    Key = InKey    If Key = "o" Then       OGLmain         key = inkey       screenres sw, sh, 32', , 1       GeneratePalette       Key = Chr(32)    EndIf    If Key = Chr(32) Then        Cls        Erase hm        Erase nhm        Erase palmap        GenerateHM        Normalize        ShowMap    End If   Loop Until Key = Chr(27)`
Peter
Posts: 66
Joined: May 29, 2006 22:16
That looks great Redcrab!
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14