Sorry your browser is not supported!

sync on : sync 0 : sync 

remstart

ref: TheCodingTrain
ref YT video : https://www.youtube.com/watch?v=0ZONMNUKTfU&list=PLRqwX-V7Uu6bVafiIHN-8LR3MUFDboJdU
In computer graphics, marching squares is an algorithm that generates contours for a two-dimensional scalar field 
(rectangular array of individual numerical values). A similar method can be used to contour 2D triangle meshes.

The contours can be of two kinds:

    Isolines – lines following a single data level, or isovalue.
    Isobands – filled areas between isolines.

Typical applications include the contour lines on topographic maps or the generation of isobars for weather maps.

Marching squares takes a similar approach to the 3D marching cubes algorithm:

    Process each cell in the grid independently.
    Calculate a cell index using comparisons of the contour level(s) with the data values at the cell corners.
    Use a pre-built lookup table, keyed on the cell index, to describe the output geometry for the cell.
    Apply linear interpolation along the boundaries of the cell to calculate the exact contour position.

Basic algorithm

Here are the steps of the algorithm:

Apply a threshold to the 2D field to make a binary image containing:

    1 where the data value is above the isovalue
    0 where the data value is below the isovalue

Note: Data equal to the isovalue has to be treated as above or below in a consistent way.

Every 2x2 block of pixels in the binary image forms a contouring cell, so the whole image is represented by a grid of 
such cells (shown in green in the picture below). Note that this contouring grid is one cell smaller in each direction 
than the original 2D field.

For each cell in the contouring grid:

    Compose the 4 bits at the corners of the cell to build a binary index: walk around the cell in a clockwise direction
     appending the bit to the index, using bitwise OR and left-shift, from most significant bit at the top left, to least
      significant bit at the bottom left. The resulting 4-bit index can have 16 possible values in the range 0–15.
    Use the cell index to access a pre-built lookup table with 16 entries listing the edges needed to represent the cell
     (shown in the lower right part of the picture below).
    Apply linear interpolation between the original field data values to find the exact position of the contour line 
    along the edges of the cell.
    
remend

set display mode 640,480,32
`set display mode screen width(),screen height(),32


rez = 10
cols as integer
rows as integer 

cols = 1 + screen width() / rez
rows = 1 + screen height() / rez
dim field(cols,rows)

cls rgb(127,127,127) 

for i = 0 to cols
	for j = 0 to rows
		field(i,j) = rnd(1)
	next j
next i

for i = 0 to cols
	for j = 0 to rows
		field(i,j) = rnd(1)
		colour = field(i,j)*255
		dot i*rez,j*rez,rgb(colour,colour,colour)
	next j
next i

make vector2(1)
make vector2(2)
make vector2(3)
make vector2(4)
a=1 : b=2 : c=3 : d=4

x as float
y as float

for i = 0 to cols-1
	for j = 0 to rows-1
		x = i * rez
		y = j * rez

		set vector2 a, x + rez*0.5  , y
		set vector2 b, x + rez      , y+rez*0.5
		set vector2 c, x + rez*0.5  , y+rez
		set vector2 d, x            , y+rez*0.5

		state = getState( field(i,j),field(i+1,j),field(i+1,j+1),field(i,j+1) )

		select state
			case 0
				`do nothing
			endcase
		
			case 1
				lline(c , d )
			endcase

			case 2
				lline(b , c )
			endcase

			case 3
				lline(b , d )
			endcase

			case 4
				lline(a , b )
			endcase

			case 5
				lline(a , d )
				lline(b , c )
			endcase

			case 6
				lline(a , c )
			endcase

			case 7
				lline(a , d )
			endcase

			case 8
				lline(a , d )
			endcase

			case 9
				lline(a , c )
 			endcase

			case 10
				lline(a , b )
				lline(c , d )
			endcase

			case 11
				lline(a , b )
			endcase

			case 12
				lline(b , d )
			endcase

			case 13
				lline(b , c )
			endcase

			case 14
				lline(c , d )
			endcase

			case 15
				`do nothing
			endcase
			
		endselect
	next j
next i

sync
wait key

end

function lline(v1 , v2  )
	line x vector2(v1),y vector2(v1),x vector2(v2),y vector2(v2)
endfunction

function getState(a,b,c,d)
	r = a * 8 + b * 4 + c * 2 + d * 1
endfunction r

sync on : sync rate 60 : sync
backdrop off
rez as integer 
rez = 10
cols as integer 
rows as integer
increment as float 
increment = 0.1
zoff as float 
zoff = 0.0
noise as float
xoff as float
yoff as float

set display mode 640,480,32 
width = screen width()
height = screen height()
noise# = 0.1
cols = 1 + width / rez
rows = 1 + height / rez
dim field#(cols,rows)
For i = 0 to cols
	For j = 0 to rows
		field#(i,j) = 0.0
	next j
next i

do
  cls rgb(127,127,127) 

  xoff = 0.0
  For i = 0 to cols
    inc xoff,increment
    yoff = 0.0
    For j = 0 to rows
	   	`field#(i,j) = SIMPLEX NOISE 3D(3,0.5,0.2,xoff, yoff, zoff)
   		`field#(i,j) = rnd(2)
   		`field#(i,j) = SIMPLEX NOISE 3D(1.0,0.75,0.51,xoff, yoff, zoff)
    	field#(i,j) =fn noise 3d(xoff, yoff, zoff)
    	`field#(i,j) = simplex scaled 3d( 1, 1.0, 0.02, 0.0, 3.0, xoff, yoff, zoff )
    	`field#(i,j) = simplex scaled 2d( 3, 1.0, 0.01, 0.0, 255.0,xoff, yoff )
      inc yoff, increment
    next j
  next i
  
  inc zoff,0.02

  For i = 0 to cols - 1
    For j = 0 to rows - 1
      x = i * rez
      y = j * rez

      state = getState(ceil(field#(i,j)),ceil(field#(i + 1,j)),ceil(field#(i + 1,j + 1)),ceil(field#(i,j + 1)) )

      a_val# = field#(i,j) + 1
      b_val# = field#(i + 1,j) + 1
      c_val# = field#(i + 1,j + 1) + 1
      d_val# = field#(i,j + 1) + 1

      v = make vector2(1)
      amt# = (1 - a_val#) / (b_val# - a_val#)
      `a.x = lerp(x, x + rez, amt#)
      `a.y = y
        set vector2 1, lerp2(x, x + rez, amt#), y  
        
      v = make vector2(2)
      amt# = (1 - b_val#) / (c_val# - b_val#)
      `b.x = x + rez
      `b.y = lerp(y, y + rez, amt#)
        set vector2 2, x + rez, lerp2(y, y + rez, amt#)

      v = make vector2(3)
      amt# = (1 - d_val#) / (c_val# - d_val#)
      `c.x = lerp(x, x + rez, amt#)
      `c.y = y + rez
        set vector2 3, lerp2(x, x + rez, amt#), y + rez 

      v = make vector2(4)
      amt# = (1 - a_val#) / (d_val# - a_val#)
      `d.x = x
      `d.y = lerp(y, y + rez, amt#)
      set vector2 4, x, lerp2(y, y + rez, amt#)
      a=1 : b=2 : c=3 : d=4
      select (state) 
        Case 1
          dLine(c, d)
        endcase
        Case 2
          dLine(b, c)
        endcase 
        Case 3
          dLine(b, d)
        endcase
        Case 4
          dLine(a, b)
        endcase
        Case 5
          dLine(a, d)
          dLine(b, c)
        endcase
        Case 6
          dLine(a, c)
        endcase
        Case 7
          dLine(a, d)
        endcase
        Case 8
          dLine(a, d)
        endcase
        Case 9
          dLine(a, c)
        endcase
        Case 10
          dLine(a, b)
          dLine(c, d)
        endcase
        Case 11
          dLine(a, b)
        endcase
        Case 12
          dLine(b, d)
        endcase
        Case 13
          dLine(b, c)
        endcase
        Case 14
          dLine(c, d)
        endcase
       endselect
      next j
next i

sync
loop
wait key
end

function getState(a, b, c, d)
  r = a * 8 + b * 4 + c * 2 + d * 1
endfunction r

function dLine(v1, v2) 
      line x vector2(v1),y vector2(v1),x vector2(v2),y vector2(v2)
endfunction

Function Lerp2(p1#,p2#,i#)
    r# = p1#*(1-i#)+p2#*i#
EndFunction r#

sync on : sync rate 60 : sync
backdrop off
autocam off
#constant NULL 0
#constant width 100
#constant height 100
global useRandomSeed 
useRandomSeed=1
global seed
global randomFillPercent 

global dur_fOnDrawGizmos
set display mode 640,480,32

MapGenerator()

position camera 0,0,50,0
rotate camera 0,0,0,0
pitch camera down 0,90
camx# = camera angle x() 
camy# = camera angle y()
camz# = camera angle z()
do
		text 0,0,"dur_fOnDrawGizmos: "+str$(dur_fOnDrawGizmos)
		if scancode()=17
			levelMoveCameraUp(0, 1.0) 
 		endif
 		
 		`S key
		if scancode()=31
			levelMoveCameraDown(0, 1.0) 
 		endif
	
		`A key
		if scancode()=30
			levelMoveCameraLeft(0, 1.0) 
 		endif
 		
 		`D key
		if scancode()=32
			levelMoveCameraRight(0, 1.0) 
 		endif

	control camera using arrowkeys 0,2.0,2.0

    if mouseclick() = 1 and mouseAlreadyClicked = 0
        mouseAlreadyClicked = 1
		GenerateMap()
    endif
    
    if mouseclick() = 0 and mouseAlreadyClicked = 1
        mouseAlreadyClicked = 0
    endif

	if inkey$()=","
		dec camz#, 2.0
	endif
	
	if inkey$()="."
		inc camz#, 2.0
	endif
	
	if inkey$()="n"
		dec camx#, 2.0
	endif
	
	if inkey$()="m"
		inc camx#, 2.0
	endif


	rotate camera 0,camx#,camy#,camz#
sync
loop
wait key
end

function MapGenerator()

	seed as string 
	useRandomSeed as boolean 

	randomFillPercent as integer 
	dim map(,) as integer 			

	GenerateMap()
endfunction

function GenerateMap() 
	dim map(width,height)
	
	RandomFillMap()
	for i = 0 to 5
		SmoothMap()
	next i

	st=timer()
	OnDrawGizmos()
	dur_fOnDrawGizmos = timer() - st
endfunction

function RandomFillMap() 
		if (useRandomSeed) 
			randomize timer()
			seed = rnd(100) 
			randomFillPercent = 50 

			text 0,0,str$(seed)
		endif 

		randomize timer()
		pseudoRandom = rnd(100)
		
		for x = 0 to width 
			for y = 0 to height
				if ((x = 0 or x = width-1) or (y = 0 or y = height -1) ) 
					map(x,y) = 1
				else 
					pseudoRandom = rnd(100)
					if pseudoRandom < randomFillPercent
						map(x,y) = 1
					else
						map(x,y) = 0
					endif
				endif
			next y 
		next x
endfunction 

function SmoothMap() 
	neighbourWallTiles as integer 
		for x = 0 to width 
			for y = 0 to height
				neighbourWallTiles = GetSurroundingWallCount(x,y)

				if (neighbourWallTiles > 4)
					map(x,y) = 1
				else 
					if (neighbourWallTiles < 4)
						map(x,y) = 0
					endif 
				endif 
			next y
		next x
endfunction

function GetSurroundingWallCount(gridX as integer , gridY as integer )
		wallCount as integer 
		wallCount = 0
		for neighbourX = gridX - 1 to gridX + 1 
			for neighbourY = gridY - 1 to gridY + 1 
				if (neighbourX >= 0 and neighbourX < width and neighbourY >= 0 and neighbourY < height) 
					if (neighbourX <> gridX or neighbourY <> gridY) 
						inc wallCount, map(neighbourX,neighbourY)
					endif 
				else
					inc wallCount
				endif
			next neighbourY
		next neighbourX

endfunction wallCount

function OnDrawGizmos()
nx as float : ny as float : nz as float
	pos = 0 : o = 1
		for x = 0 to width 
			for y = 0 to height 
				inc pos
				if object exist(o)=1
				else
					v = make vector3(pos)
					`make object cube o,1
					make object box o,1,1,1
				endif

				nw = -width/2 : nh = -height/2
				nx = x vector3(pos) : ny = y vector3(pos) : nz = z vector3(pos) 
				set vector3 pos,nw + x + .5,0, nh + y+.5
				position object o,x vector3(pos),y vector3(pos), z vector3(pos)

				if map(x,y)=1
					color object o,rgb(0,0,0)
				else
					color object o,rgb(255,255,255)
				endif
				
				inc o   
			next y
		next x
endfunction

function levelMoveCameraUp(camID as integer, dist as float)
   local sx as float
   local sy as float
   local sz as float
 
   sx = camera angle x(camID)
   sy = camera angle y(camID)
   sz = camera angle z(camID)
 
   rotate camera camID, wrapvalue(sz-90), 0 , 0 
   move camera camID, dist
   rotate camera camID, sx, sy, sz
endfunction

function levelMoveCameraDown(camID as integer, dist as float)
   local sx as float
   local sy as float
   local sz as float
 
   sx = camera angle x(camID)
   sy = camera angle y(camID)
   sz = camera angle z(camID)
 
   rotate camera camID, wrapvalue(sx+90), 0, 0
   move camera camID, dist
   rotate camera camID, sx, sy, sz
endfunction

function levelMoveCameraRight(camID as integer, dist as float)
   local sx as float
   local sy as float
   local sz as float
 
   sx = camera angle x(camID)
   sy = camera angle y(camID)
   sz = camera angle z(camID)
 
   rotate camera camID, 0, wrapvalue(sy+90), 0
   move camera camID, dist
   rotate camera camID, sx, sy, sz
endfunction
 
function levelMoveCameraLeft(camID as integer, dist as float)
   local sx as float
   local sy as float
   local sz as float
 
   sx = camera angle x(camID)
   sy = camera angle y(camID)
   sz = camera angle z(camID)
 
   rotate camera camID, 0, wrapvalue(sy-90), 0
   move camera camID, dist
   rotate camera camID, sx, sy, sz
endfunction

sync on : sync rate 60 : sync
randomize timer()
type bubble
	r as float
	x as float
	y as float
	randx 
	randy
	directx as integer
	directy as integer
	col as dword
endtype 

`set display mode 640,480,32
set display mode screen width(),screen height(),32

bubblenum = 15
dim bubbles(bubblenum) as bubble

SetUp()

do

Draw()
sync
loop

end

function drwline(v1 , v2  )
	line x vector2(v1),y vector2(v1),x vector2(v2),y vector2(v2)
endfunction

function getState(a,b,c,d)
	r = a * 8 + b * 4 + c * 2 + d * 1
endfunction r

function setup() 
  global rez 
  rez = 10
  global cols 
  cols = 1 + screen width() / rez
  global rows
  rows = 1 + screen height() / rez
  dim field(cols,rows)
  for i = 0 to cols
    for j = 0 to rows
	    field(i,j)=0
    next j
  next i
  
  for i = 0 to array count(bubbles())
  	bubbles(i).r=rnd(60)+30
  	bubbles(i).x=rnd((screen width()))
  	bubbles(i).y=rnd((screen height()))
  	bubbles(i).directx=rnd(6)
  	bubbles(i).directy=rnd(6)
 	bubbles(i).col = rgb(255,rnd(165)+160,0) 	
  	fill circle bubbles(i).x,bubbles(i).y,bubbles(i).r,bubbles(i).col
  next i

  make vector2(1)
  make vector2(2)
  make vector2(3)
  make vector2(4)

endfunction

function draw()
  cls 0
  for i = 0 to cols
    for j = 0 to rows
	  sum = 0
      x = i * rez
      y = j * rez

      for bub = 0 to array count(bubbles())
      	inc sum, (bubbles(bub).r * bubbles(bub).r) / ((x - bubbles(bub).x) * (x - bubbles(bub).x) + (y - bubbles(bub).y) * (y - bubbles(bub).y)) 
      	field(i,j) = sum
      next bub
      
    next j
  next i

  a=1 : b=2 : c=3 : d=4


for bbl = 0 to array count(bubbles())
	bubbles(bbl).randx=rnd(50) : bubbles(bbl).randy = rnd(50)
	if bubbles(bbl).randx=3 
		bubbles(bbl).directx = -1
	else
		if bubbles(bbl).randx=4
			bubbles(bbl).directx= 1
		else
			bubbles(bbl).directx= bubbles(bbl).directx
		endif
	endif
	
	if bubbles(bbl).randy=3 
		bubbles(bbl).directy = -1
	else
		if bubbles(bbl).randy=4
			bubbles(bbl).directy= 1
		else
			bubbles(bbl).directy= bubbles(bbl).directy
		endif
	endif

   	bubbles(bbl).x = bubbles(bbl).x + bubbles(bbl).directx
    bubbles(bbl).y = bubbles(bbl).y + bubbles(bbl).directy
   	fill circle bubbles(bbl).x,bubbles(bbl).y,bubbles(bbl).r, bubbles(bbl).col 
 next bbl
  
  for i = 0 to cols - 1
    for j = 0 to rows - 1
      x = i * rez
      y = j * rez

	  set vector2 a, x + rez*0.5  , y
	  set vector2 b, x + rez      , y+rez*0.5
	  set vector2 c, x + rez*0.5  , y+rez
	  set vector2 d, x            , y+rez*0.5

      threshold = 1
      
      if field(i,j) < threshold
      	c1 = 0
      else 
      	c1 = 1
      endif

      if field(i + 1,j) < threshold
      	c2 = 0
      else 
      	c2 = 1
      endif

      if field(i + 1, j + 1) < threshold
      	c3 = 0
      else 
      	c3 = 1
      endif

      if field(i, j + 1) < threshold
      	c4 = 0
      else 
      	c4 = 1
      endif

      state = getState(c1, c2, c3, c4)

      select (state) 
        case 1
          drwline(c, d)
        endcase 
        case 2
          drwLine(b, c)
		endcase
		case 3
          drwLine(b, d)
        endcase
        case 4
          drwLine(a, b)
        endcase
        case 5
          drwLine(a, d)
          drwLine(b, c)
        endcase
        case 6
          drwLine(a, c)
        endcase
        case 7
          drwLine(a, d)
        endcase
        case 8
          drwLine(a, d)
        endcase
        case 9
          drwLine(a, c)
        endcase
        case 10
          drwLine(a, b)
          drwLine(c, d)
        endcase
        case 11
          drwLine(a, b)
        endcase
        case 12
          drwLine(b, d)
        endcase
        case 13
          drwLine(b, c)
        endcase
        case 14
          drwLine(c, d)
        endcase
      endselect
      next j
    next i
endfunction