Ok heres the code.........
AppTitle "Isometric"
Graphics 800,600,8,2
SetBuffer BackBuffer()
Dim heightmap(100,100,2) ;x,y,0=height... x,y,1=image-angle... x,y,2=terrain
Global screenwidth=800,screenheight=600
Global tileset
Global mapoffsetx=-320,mapoffsety=-100,mx=-1,my=-1
Global terrainraise
Global mapwidth=20,mapheight=20
Global brushsize=0,brushtype=0,tilesel=0
Global imgButtons
Dim tiles(10,15)
Dim linex#(3)
Dim liney#(3)
Dim linez#(3)
Const TOTAL_TILES=5
Const TILE_HEIGHT=12
LoadTiles()
;Now figure out the slopes of each tile
;A slope will just be an index number pointing to the correct frame
;in the array of tiles. The array is pre-loaded at the beginning.
For y=0 To mapwidth-1
For x=0 To mapheight-1
GetSlope(x,y)
Next
Next
imgButtons=LoadAnimImage("editbuttons.png",40,40,0,2)
MidHandle imgButtons
MaskImage imgButtons,255,0,255
MainProggy()
End
Function mainproggy()
While KeyHit(1)=0
mouseon=0
If MouseHit(1) Then mouseon=1
If MouseHit(2) Then mouseon=2
If KeyDown(203) Then mapoffsetx=mapoffsetx-15
If KeyDown(200) Then mapoffsety=mapoffsety-15
If KeyDown(205) Then mapoffsetx=mapoffsetx+15
If KeyDown(208) Then mapoffsety=mapoffsety+15
;Find the tile that the mouse is within
mx=-1:my=-1
For x=0 To 100
For y=0 To 100
If ImageRectCollide(tiles(heightmap(x,y,2),heightmap(x,y,1)),x*32-y*32,y*16+x*16-heightmap(x,y,0)*TILE_HEIGHT,0,MouseX()+mapoffsetx,MouseY()+mapoffsety,1,1) Then
mx=x:my=y
End If
Next
Next
If RectsOverlap(0,20,screenwidth,screenheight-80,MouseX(),MouseY(),1,1)
If mouseon=1 Then
If terrainraise=-1 Then terrainraise=heightmap(mx,my,0)+1
If mx>-1 And my>-1 And mx<mapheight And my<mapheight
If brushsize=-1 And heightmap(mx,my,2)<>tilesel
recur_fill(mx,my)
End If
End If
End If
If MouseDown(1) Then
;Find the tile square that the mouse is within
If mx>-1 And my>-1 And mx<mapwidth And my<mapheight Then
If terrainraise=-1 Then terrainraise=heightmap(mx,my,0)+1
If brushsize>-1 Then
For j=-brushsize To brushsize:For i=-brushsize To brushsize
If mx+i>-1 And my+j>-1 And mx+i<mapwidth And my+j<mapheight
If brushtype=0 Then recur_TerraForm(mx+i,my+j,terrainraise)
If brushtype=1 Then heightmap(mx+i,my+j,2)=tilesel
End If
Next:Next
End If
End If
ElseIf MouseDown(2) Then
;Find the tile square that the mouse is within
If mx>-1 And my>-1 And mx<mapwidth And my<mapheight Then
If terrainraise=-1 Then terrainraise=heightmap(mx,my,0)-1
If brushsize>-1 Then
For j=-brushsize To brushsize:For i=-brushsize To brushsize
If mx+i>-1 And my+j>-1 And mx+i<mapwidth And my+j<mapheight
If brushtype=0 Then recur_TerraForm(mx+i,my+j,terrainraise)
End If
Next:Next
End If
End If
Else
;Mouse-up?
terrainraise=-1
End If
End If
If brushtype=1 And RectsOverlap(screenwidth-180-25,screenheight-30-25,50,50,MouseX(),MouseY(),1,1) And mouseon=1 Then
brushsize=-1
ElseIf RectsOverlap(screenwidth-130-25,screenheight-30-25,50,50,MouseX(),MouseY(),1,1) And mouseon=1 Then
brushsize=0
ElseIf RectsOverlap(screenwidth-80-25,screenheight-30-25,50,50,MouseX(),MouseY(),1,1) And mouseon=1 Then
brushsize=1
ElseIf RectsOverlap(screenwidth-30-25,screenheight-30-25,50,50,MouseX(),MouseY(),1,1) And mouseon=1 Then
brushsize=3
ElseIf RectsOverlap(30-25,screenheight-30-25,50,50,MouseX(),MouseY(),1,1) And mouseon=1
brushtype=0
ElseIf RectsOverlap(100-35,screenheight-30-25,70,50,MouseX(),MouseY(),1,1) And mouseon=1
brushtype=1
End If
If brushtype=1 And mouseon=2 Then
tilesel=tilesel+1:If tilesel=>TOTAL_TILES Then tilesel=0
End If
If KeyDown(74) And mapwidth>10 Then mapwidth=mapwidth-1:mapheight=mapheight-1
If KeyDown(78) And mapwidth<50 Then mapwidth=mapwidth+1:mapheight=mapheight+1
If brushsize=-1 And brushtype<>1 Then brushsize=0
drawtiles()
Wend
End Function
Function drawtiles()
Cls
Color 80,80,80
Rect 0,0,screenwidth,screenheight
Origin -mapoffsetx,-mapoffsety
Viewport 0,20,screenwidth,screenheight-80
Cls
For x=0 To mapwidth-1
For y=0 To mapheight-1
;Draw the tile, as referred from HeightMap(x,y,type)
DrawImage tiles(heightmap(x,y,2),heightmap(x,y,1)),x*32-y*32,y*16+x*16-heightmap(x,y,0)*TILE_HEIGHT
Next
Next
Origin 0,0
Color 0,255,0
Viewport 0,0,screenwidth,screenheight
Text 20,10,mx,True,True
Text 40,10,",",True,True
Text 60,10,my,True,True
Text 120,10,mapwidth + " , " + mapheight,True,True
Color 0,0,0
Line 80,0,80,20
Line 160,0,160,20
Select brushtype
Case 0
Color 0,0,0
Rect 30-25,screenheight-30-25,50,50,0
Color 0,128,0
Rect 30-24,screenheight-30-24,48,48
Case 1
Color 0,0,0
Rect 100-35,screenheight-30-25,70,50,0
Color 0,128,0
Rect 100-34,screenheight-30-24,68,48
End Select
Select brushsize
Case -1
Color 0,0,0
Rect screenwidth-180-25,screenheight-30-25,50,50,0
Color 0,128,0
Rect screenwidth-180-24,screenheight-30-24,48,48
Case 0
Color 0,0,0
Rect screenwidth-130-25,screenheight-30-25,50,50,0
Color 0,128,0
Rect screenwidth-130-24,screenheight-30-24,48,48
Case 1
Color 0,0,0
Rect screenwidth-80-25,screenheight-30-25,50,50,0
Color 0,128,0
Rect screenwidth-80-24,screenheight-30-24,48,48
Case 3
Color 0,0,0
Rect screenwidth-30-25,screenheight-30-25,50,50,0
Color 0,128,0
Rect screenwidth-30-24,screenheight-30-24,48,48
End Select
Color 255,255,255
Oval screenwidth-130-2,screenheight-30-2,4,4
Oval screenwidth-80-8,screenheight-30-8,16,16
Oval screenwidth-30-15,screenheight-30-15,30,30
DrawImage imgbuttons,30,screenheight-30,0
DrawImage tiles(tilesel,0),100,screenheight-30,0
If brushtype=1 Then DrawImage imgbuttons,screenwidth-180,screenheight-30,1
Flip
End Function
Function recur_terraform(x,y,dist)
;This function takes the x,y of the block and how much the height's going to change
If dist<10 And dist>-1 Then
heightmap(x,y,0)=dist
;Now do all the squares around it
If x=0 Then i=0 Else i=-1
While i<2
If y=0 Then j=0 Else j=-1
While j<2
If x+i>-1 And y+j>-1 And x+i<mapwidth And y+j<mapheight Then
;Raise/lower if the height difference is greater than 1
If heightmap(x,y,0)-heightmap(x+i,y+j,0)>1 Then
recur_terraform(x+i,y+j,heightmap(x,y,0)-1)
ElseIf heightmap(x,y,0)-heightmap(x+i,y+j,0)<-1 Then
recur_terraform(x+i,y+j,heightmap(x,y,0)+1)
End If
End If
GetSlope(x+i,y+j)
j=j+1:If y=mapheight And j=1 Then Exit
Wend
i=i+1:If x=mapwidth And i=1 Then Exit
Wend
End If
End Function
Function recur_fill(x,y)
a=heightmap(x,y,2)
heightmap(x,y,2)=tilesel
For j=-1 To 1
If y+j>-1 And y+j<mapheight
If heightmap(x,y+j,2)=a Then recur_fill(x,y+j)
End If
Next
For i=-1 To 1
If x+i>-1 And x+i<mapwidth
If heightmap(x+i,y,2)=a Then recur_fill(x+i,y)
End If
Next
End Function
Function SquareX(x#,y#)
;SquareX(x,y) and SquareY(x,y)
;Take an x,y coordinate and return the Map Square that it lies inside.
Return Int((y-16)/32+(x+32)/64)
End Function
Function SquareY(x#,y#)
Return Int((y+16)/32-(x+32)/64)
End Function
Function LoadTiles()
;---- LOAD TILES AND CREATE ----
tileset=LoadImage("tileset.png")
For j=0 To TOTAL_TILES-1
SetBuffer BackBuffer()
Cls
Color 0,255,0
Text 10,10,"Loading... " + (100*(j*16+a))/TOTAL_TILES/16 + "%"
Flip
For a=0 To 15
linex(0)=32:liney(0)=16
linex(1)=0:liney(1)=32
linex(2)=64:liney(2)=32
linex(3)=32:liney(3)=48
;To go through all the possible combinations of slopes, it looks
;like we're going to use Binary. There are 4 points, and they are
;either 1 (up) or 0 (down). Makes sense.. So 0000 is 0 and 1111 is 15
thisbin$=Bin(a)
For i=1 To 4
If Mid(thisbin$,i+Len(thisbin$)-4,1)="1" Then linez(i-1)=TILE_HEIGHT Else linez(i-1)=0
Next
gloss#=2 ;To get the brightness of the tile
If linez(1)>0 Then gloss=gloss-2
If linez(2)>0 Then gloss=gloss+2
If linez(0)>0 Or linez(3)>0 Then
If gloss<2 Then gloss=gloss+0.7
If gloss>2 Then gloss=gloss-0.7
If linez(0)>0 Then gloss=gloss-0.5
If linez(3)>0 Then gloss=gloss+0.5
End If
tiles(j,a)=CreateImage(64,64)
SetBuffer ImageBuffer(tiles(j,a))
DrawBlockRect tileset,0,0,0,j*64,64,64
Color 0,0,0
;What I am doing is finding the points of each corner of the tile and
;then cutting out the parts I don't need. Then, each time round I
;take the bits of the binary number and raise the corner by TILE_HEIGHT
;if the bit is a 1. That way I have a tile for every combination. 1111 = 15 tiles
For i=0 To 3:liney(i)=liney(i)-linez(i):Next
yy#=liney(1)
yy2#=liney(1)
Color 0,0,0
For xx#=linex(1) To linex(0)
Line xx,yy-1,xx,0
Line xx,yy2+1,xx,64
yy=yy-(liney(1)-liney(0))/32
yy2=yy2+(liney(3)-liney(1))/32
Next
yy=liney(0):yy2=liney(3)
For xx#=linex(0) To linex(2)
Line xx,yy-1,xx,0
Line xx,yy2+1,xx,64
yy=yy+(liney(2)-liney(0))/32
yy2=yy2-(liney(3)-liney(2))/32
Next
;We need to lighten or darken the tile depending on the value of 'gloss'
;So let's lock the buffer and start pixeling FAST
If gloss<>2 Then
LockBuffer
imwid=ImageWidth(tiles(j,a)):imhgt=ImageHeight(tiles(j,a))
For x=0 To imwid-1
For y=0 To imhgt-1
pix=ReadPixelFast(x,y)
r=getR(pix)
g=getG(pix)
b=getB(pix)
If r<>0 Or g<>0 Or b<>0 Then
;lighten or darken the tile
r=r*1.12^(gloss-2)
g=g*1.12^(gloss-2)
b=b*1.12^(gloss-2)
If r>255 Then r=255
If g>255 Then g=255
If b>255 Then b=255
WritePixelFast x,y,ARGB(255,r,g,b)
End If
Next
Next
UnlockBuffer
End If
MidHandle tiles(j,a)
Next
Next
SetBuffer BackBuffer()
End Function
Function GetSlope(x,y)
For i=0 To 3:linez(i)=0:Next
If x=0 Then i=0 Else i=-1
While i<=1
If y=0 Then j=0 Else j=-1
While j<=1
If heightmap(x+i,y+j,0)>heightmap(x,y,0)
If j<1 And i<1 Then linez(0)=1
If j>-1 And i<1 Then linez(1)=1
If j<1 And i>-1 Then linez(2)=1
If j>-1 And i>-1 Then linez(3)=1
End If
j=j+1:If y+j=mapheight Then Exit
Wend
i=i+1:If x+i=mapwidth Then Exit
Wend
;It creates a binary number depending on which tiles next to
;it are raised, and then uses the bits to figure out which
;tile in the array it is.
heightmap(x,y,1)=linez(3)*1+linez(2)*2+linez(1)*4+linez(0)*8
End Function
;These commands are used for WritePixel and ReadPixel
Function ARGB(a,r,g,b)
Return b Or (g Shl 8) Or (r Shl 16) Or (a Shl 24)
End Function
Function GetR(rgb)
Return rgb Shr 16 And %11111111
End Function
Function GetG(rgb)
Return rgb Shr 8 And %11111111
End Function
Function GetB(rgb)
Return rgb And %11111111
End Function
And for those who want to download it here is the zip with images and .exe etc.
