Fractal mountains using DIVs

Author Message
AMBience

  • Total Posts : 31
  • Scores: 0
  • Reward points : 0
  • Joined: 7/24/2008
  • Status: offline
Fractal mountains using DIVs Friday, April 08, 2011 10:34 AM (permalink)
0
This HTA uses seeded Perlin noise (pure VBS) and 16384 DIVs to make an isometric 3D mountain. 

I first had the DIVs bolted to the floor in a diamond, and just changed their height depending on the Perlin array, but it looks better if the DIV is a constant 20 pixels in height and just change the Y position instead....sort of like a bumpy piece of cloth (sometimes you can see under it, which is cool).

The number box is for the random seed number, any none-number uses randomize timer.

I obviously can't take credit for the Perlin algorithm...(just the VBS version).

Have fun.
 
 <HTML><HEAD>
 <TITLE>Making lots of DIVs, please wait...</TITLE>
 <HTA:APPLICATION 
 MAXIMIZEBUTTON = "No"
 MINIMIZEBUTTON = "No"
 BORDER = "Thin"
 SELECTION ="No"
 />
</HEAD>

<BODY SCROLL="No" STYLE="Border:0;Margin:0" BGCOLOR="Black">
 <INPUT TYPE="Button" ID="cmdRender" VALUE="Render" STYLE="Width:80"/></BR>
 <INPUT TYPE="Text" ID="txtSeed" VALUE="23455" STYLE="Width:80"/>
 <DIV ID="divViewPort"></DIV>
</BODY>

<SCRIPT LANGUAGE="VBScript">

Option Explicit

Dim sngPerlinMap, intMapSize, objPixel

intMapSize=128  'Set to 64 if too slow 

SetupView

'---- Create DIVs
Sub SetupView()
 Dim X,Y,SX,SY,PX,PY
 Redim objPixel(intMapSize, intMapSize)
 
 SX=intMapSize*4 : SY=60 : PX=SX : PY=SY
 Self.ResizeTo (SX*2)+8,SX*1.4
 Self.MoveTo (Screen.Width/2)-SX,(Screen.Height/2)-SX*0.7
 
 For Y=0 to intMapSize-1
 For X=0 to intMapSize-1
 Set objPixel(X,Y) = Document.CreateElement("DIV")
 divViewPort.AppendChild objPixel(X,Y)
 
 With objPixel(X,Y).Style
 .Position="Absolute" ': OverFlow="Hidden" '<-Only needed if DIV height<20-ish
 .PixelWidth=4 :    .PixelHeight=20                
 .PixelLeft=PX :    .PixelTop=PY 
 .BackgroundColor = RGB(X*3, Y*2, X*2)
 End With
 PX=PX+4 : PY=PY+2
 Next
 SX=SX-4 : PX=SX : SY=SY+2 : PY=SY
 Next
 Document.Title = "DIV Fractal Mountains - By Alan Bond"
End Sub

'---- Render
Sub cmdRender_OnClick()
 Dim X,Y,SY,PY,intColour,sngRed,sngGreen,sngBlue
 
 If IsNumeric(txtSeed.Value) Then
 Rnd(-1) : Randomize ABS(txtSeed.Value)
 Else
 Randomize Timer
 End If

 Perlin 0.45, 2
 
 SY=intMapSize*2 : PY=SY
 sngRed=Rnd(1) : sngGreen=Rnd(1) : sngBlue=Rnd(1)
 For Y=0 to intMapSize-1
 For X=0 to intMapSize-1
 intColour = sngPerlinMap(X,Y)*5
 With objPixel(X,Y).Style
 .PixelTop = PY - sngPerlinMap(X,Y)*6
 .BackgroundColor = RGB(intColour*sngBlue,intColour*sngGreen,intColour*sngRed)
 End With
 PY=PY+2
 Next
 SY=SY+2 : PY=SY
 Next
End Sub

'---- Enter key in txtSeed
Sub txtSeed_OnKeyPress()
 If Window.Event.KeyCode=13 Then cmdRender_OnClick
End Sub


'---- Perlin noise 
Sub Perlin(sngScale, intMultiply)
 ReDim sngPerlinMap(intMapSize, intMapSize)
 Dim sngRandNoise : ReDim sngRandNoise(intMapSize, intMapSize)
 Dim sngCeiling, intNoiseSize, intScaleRem, sngStep
 Dim NY, NX, IY, IX, HY, HX, HTY, HTX, NA, NB, NC, ND, N1, N2, N3, N4
 
 sngCeiling=sngScale : sngCeiling=sngCeiling*intMultiply : intNoiseSize=intMapSize/2
 While intNoiseSize>1
 For NY=0 To intNoiseSize
 For NX=0 To intNoiseSize
 sngRandNoise(NX, NY)=Rnd(1)*sngCeiling
 Next
 Next
 intScaleRem=intMapSize/intNoiseSize : sngStep=1/(intScaleRem)
 For NY=0 To intNoiseSize-1
 For NX=0 To intNoiseSize-1 : IY=0
 N1=sngRandNoise(NX, NY) : N2=sngRandNoise(NX+1, NY)
 N3=sngRandNoise(NX, NY+1) : N4=sngRandNoise(NX+1, NY+1)
 HX=NX*intScaleRem : HY=NY*intScaleRem
 For HTY=0 To intScaleRem-1 : IX=0
 For HTX=0 To intScaleRem-1
 NA=N1*(1-IX) : NB=N2*IX : NC=N3*(1-IX) : ND=N4*IX
 sngPerlinMap(HX+HTX, HY+HTY)=sngPerlinMap(HX+HTX, HY+HTY)+(NA+NB)*(1-IY)+(NC+ND)*IY
 IX=IX+sngStep
 Next
 IY=IY+sngStep
 Next
 Next
 Next
 intNoiseSize=intNoiseSize/2 : sngCeiling=sngCeiling*intMultiply
 Wend
End Sub

</SCRIPT>
</HTML> 

 
#1
    hal07

    • Total Posts : 19
    • Scores: 0
    • Reward points : 0
    • Joined: 5/1/2011
    • Location: Bergen, Norway
    • Status: offline
    Re:Fractal mountains using DIVs Thursday, May 05, 2011 12:56 AM (permalink)
    0
    impressive! Thumbs up!
     
    #2
      TNO

      • Total Posts : 2094
      • Scores: 36
      • Reward points : 0
      • Joined: 12/18/2004
      • Location: Earth
      • Status: offline
      Re:Fractal mountains using DIVs Thursday, May 05, 2011 1:01 PM (permalink)
      0
      Nice work, but its terribly slow. I'll play around with it this weekend and see how much of a performance boost I can get. I'll estimate at least twice as fast at worst
      To iterate is human, to recurse divine. -- L. Peter Deutsch
       
      #3
        TNO

        • Total Posts : 2094
        • Scores: 36
        • Reward points : 0
        • Joined: 12/18/2004
        • Location: Earth
        • Status: offline
        Re:Fractal mountains using DIVs Monday, May 09, 2011 12:51 PM (permalink)
        0
        Alright, some easy stuff first. This gained about 2 seconds overall on a slower machine I have:
         
        http://pastebin.com/1M3Qq0Sh
         
        To really get a speed boost, it'll be wise to implement this in JavaScript+<canvas/>
         
        If you're interested, I'll try my hand at a port
        To iterate is human, to recurse divine. -- L. Peter Deutsch
         
        #4
          ZooBeast

          • Total Posts : 8
          • Scores: 0
          • Reward points : 0
          • Joined: 9/17/2009
          • Status: offline
          Re:Fractal mountains using DIVs Monday, December 19, 2011 8:50 AM (permalink)
          0
          This Is Impressive
           
          #5

            Online Bookmarks Sharing: Share/Bookmark

            Jump to:

            Current active users

            There are 0 members and 1 guests.

            Icon Legend and Permission

            • New Messages
            • No New Messages
            • Hot Topic w/ New Messages
            • Hot Topic w/o New Messages
            • Locked w/ New Messages
            • Locked w/o New Messages
            • Read Message
            • Post New Thread
            • Reply to message
            • Post New Poll
            • Submit Vote
            • Post reward post
            • Delete my own posts
            • Delete my own threads
            • Rate post

            2000-2012 ASPPlayground.NET Forum Version 3.9