Another update.
This time, you can choose between !70! tiles. Wich means you can use images and tile them with a max of 7*10.
here is the code:
REM Project: map-maker
REM Created: 6/07/2005 14:33:20
REM
REM ***** Main Source File *****
REM
standard_dir$ = get dir$()
restart:
sync on : sync rate 0
`reset vars
ctile = 2
menu = 0 : menu_range = 1
width = 40
height = 40
zoom# = 10
tool$ = "freehand"
mapx = 20
mapy = 20
tilemode = 1
`make an array
undim map_data()
dim map_data(width,height)
`text layout
set text font "Comic Sans MS"
set text size 18
`tile array
undim tile()
dim tile(70,2)
for i = 1 to 10
tile(i,1) = i-1
tile(i,2) = (i-1) * 50000
next i
for i = 11 to 36
tile(i,1) = i - 1
tile(i,2) = (i-1) * 50000
next i
for i = 37 to 70
tile(i,1) = i-1
tile(i,2) = (i-1) * 50000
next i
tiles = 70
`*****************
` MAIN LOOP
`*****************
do
cls
`update map
for y = 1 to height
for x = 1 to width
for i = 1 to tiles
if map_data(x,y) = tile(i,1)
ink tile(i,2),0
box mapx + (zoom# * (x-1) + 1),mapy + ((y-1) * zoom# + 1), mapx + (x*zoom#), mapy + (y*zoom#)
`handle tile display
if tilemode = 1 and zoom# >= 10.0
gosub render_tiles
else
spritenr = 1 + ((y-1) * height) + (x-1)
if sprite exist(spritenr) > 0
delete sprite spritenr
endif
endif
endif
next i
next x
next y
`check for tool
if hold = 0
if tool$ = "freehand"
if mouseclick() = 1 and menu = 0
for y = 1 to height
for x = 1 to width
if mousex() < mapx + (zoom# * x) and mousex() > mapx + (zoom# * (x-1))
if mousey() < mapy + (zoom# * y) and mousey() > mapy + (zoom# * (y-1))
map_data(x,y) = tile(ctile,1)
endif
endif
next x
next y
endif
endif
if tool$ = "rectangle"
if mouseclick() = 1 and menu = 0
if started = 0
started = 1
cstartx = int((mousex() - mapx) / zoom#) + 1
cstarty = int((mousey() - mapy) / zoom#) + 1
`start boundries
if cstartx < 1 then cstartx = 1
if cstarty < 1 then cstarty = 1
if cstartx > width then cstartx = width
if cstarty > height then cstarty = height
else
if int((mousex() - mapx) / zoom#) + 1 < cstartx
startx = int((mousex() - mapx) / zoom#) + 1
endx = cstartx
else
startx = cstartx
endx = int((mousex() - mapx) / zoom#) + 1
endif
if int(mousey() / zoom#) + 1 < cstarty
starty = int((mousey() - mapy) / zoom#) + 1
endy = cstarty
else
starty = cstarty
endy = int((mousey() - mapy) / zoom#) + 1
endif
`end boundries
if endx < 1 then endx = 1
if endy < 1 then endy = 1
if endx > width then endx = width
if endy > height then endy = height
ink tile(ctile,2),0
box mapx + ((startx-1) * zoom#), mapy + ((starty-1) * zoom#), mapx + (endx * zoom#), mapy + (endy * zoom#)
endif
else
if started = 1
started = 0
for x = startx to endx
for y = starty to endy
map_data(x,y) = tile(ctile,1)
next y
next x
endif
endif
endif
if tool$ = "line" and menu = 0
if mouseclick() = 1
if started = 0
started = 1
startx = int((mousex() - mapx) / zoom#) + 1
starty = int((mousey() - mapy) / zoom#) + 1
`start boundries
if startx < 1 then startx = 1
if starty < 1 then starty = 1
if startx > width then startx = width
if starty > height then starty = height
else
endx = int((mousex() - mapx) / zoom#) + 1
endy = int((mousey() - mapy) / zoom#) + 1
`end boundries
if endx < 1 then endx = 1
if endy < 1 then endy = 1
if endx > width then endx = width
if endy > height then endy = height
`here comes the rendering
if startx = endx and starty = endy
ink tile(ctile,2),0
box mapx + startx*zoom# - zoom#, mapy + starty*zoom# - zoom#, mapx + startx*zoom#, mapy + starty*zoom#
else
ink tile(ctile,2),0
box mapx + startx*zoom# - zoom#, mapy + starty*zoom# - zoom#, mapx + startx*zoom#, mapy + starty*zoom#
`get distance between points
dx# = abs(endx - startx)
dy# = abs(endy - starty)
if endx > startx then xi = 1 else xi = -1
if endy > starty then yi = 1 else yi = -1
if dx# > dy#
for i = 0 to dx#*xi step xi
posx = startx + abs(i) * xi
posy = starty + abs(int(dy# / dx# * i)) * yi
ink tile(ctile,2),0
box mapx + posx*zoom# - zoom#, mapy + posy*zoom# - zoom#, mapx + posx*zoom#, mapy + posy*zoom#
next i
else
for i = 0 to dy#*yi step yi
posx = startx + abs(int(dx# / dy# * i)) * xi
posy = starty + abs(i) * yi
ink tile(ctile,2),0
box mapx + posx*zoom# - zoom#, mapy + posy*zoom# - zoom#, mapx + posx*zoom#, mapy + posy*zoom#
next i
endif
endif
endif
else
if started = 1
started = 0
`here comes the rendering to the map
if startx = endx and starty = endy
map_data(startx,starty) = tile(ctile,1)
else
`get distance between points
dx# = abs(endx - startx)
dy# = abs(endy - starty)
if endx > startx then xi = 1 else xi = -1
if endy > starty then yi = 1 else yi = -1
if dx# > dy#
for i = 0 to dx#*xi step xi
posx = startx + abs(i) * xi
posy = starty + abs(int(dy# / dx# * i)) * yi
map_data(posx,posy) = tile(ctile,1)
next i
else
for i = 0 to dy#*yi step yi
posx = startx + abs(int(dx# / dy# * i)) * xi
posy = starty + abs(i) * yi
map_data(posx,posy) = tile(ctile,1)
next i
endif
endif
endif
endif
endif
if mouseclick() = 2
getx = int((mousex() - mapx) / zoom#)
gety = int((mousey() - mapy) / zoom#)
ctile = map_data(getx+1,gety+1) + 1
endif
endif
`draw grid
ink rgb(75,75,75),0
for x = 0 to width
line mapx + (x*zoom#),mapy, mapx + (x*zoom#), mapy + (height*zoom#)
next x
for y = 0 to height
line mapx, mapy + (y*zoom#), mapx + (zoom#*width), mapy + (y*zoom#)
next y
`display menu strokes
ink rgb(150,150,150),0
box screen width() - 3, 0, screen width(), screen height()
ink rgb(175,175,175),0
box 0,screen height() - 3,screen width()-3,screen height()
if mousex() > screen width() - 3
menu = 1
else
if mousey() > screen height() - 3
menu = 2
endif
endif
`if the menu on the right is activated
if menu = 1
if mousex() < screen width() - 110 then menu = 0
ink rgb(150,150,150),0
box screen width() - 110,0,screen width(),screen height()
`toggle menu ranges
if textbutton(screen width() - 100, 5, "<") > 0 and hold = 0 then hold = 1 : dec menu_range
if textbutton(screen width() - 10 , 5, ">") > 0 and hold = 0 then hold = 1 : inc menu_range
if menu_range < 1 then menu_range = 7
if menu_range > 7 then menu_range = 1
ink rgb(255,255,255),0 : center text screen width() - 55, 1, str$(menu_range)
`display menu ranges
select menu_range
case 1
for i = 1 to 10
pres = button(screen width() - 55, 30*i,"tile nr: " + str$(tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
next i
endcase
case 2
for i = 11 to 20
pres = button(screen width() - 55, 30*(i-10), "tile nr: " + chr$(55 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
next i
endcase
case 3
for i = 21 to 30
pres = button(screen width() - 55, 30*(i-20), "tile nr: " + chr$(55 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
next i
endcase
case 4
for i = 31 to 40
if i <= 36
pres = button(screen width() - 55, 30*(i-30), "tile nr: " + chr$(55 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
else
pres = button(screen width() - 55, 30*(i-30), "tile nr: " + chr$(61 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
endif
next i
endcase
case 5
for i = 41 to 50
pres = button(screen width() - 55, 30*(i-40), "tile nr: " + chr$(61 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
next i
endcase
case 6
for i = 51 to 60
pres = button(screen width() - 55, 30*(i-50), "tile nr: " + chr$(61 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
next i
endcase
case 7
for i = 61 to 70
if i <= 62
pres = button(screen width() - 55, 30*(i-60), "tile nr: " + chr$(61 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
else
pres = button(screen width() - 55, 30*(i-60), "tile nr: " + chr$(-22 + tile(i,1)),tile(i,2))
if pres > 0 then pres = mouseclick()
if pres = 1 then ctile = i
if pres = 2 then gosub change_color
endif
next i
endcase
endselect
if button(screen width() - 55, screen height() - 140, "New", rgb(150,0,0)) > 0 and hold = 0 then hold = 1 : goto restart
if button(screen width() - 55, screen height() - 110, "Load", rgb(150,0,0)) > 0 and hold = 0 then hold = 1 : gosub load_map
if button(screen width() - 55, screen height() - 80 , "Resize map", rgb(150,0,0)) > 0 and hold = 0 then hold = 1 : gosub resize_map
if button(screen width() - 55, screen height() - 50 , "Export txt", rgb(150,0,0)) > 0 and hold = 0 then hold = 1 : gosub export_txt
if button(screen width() - 55, screen height() - 20 , "Exit", rgb(150,0,0)) > 0 and hold = 0 then end
endif
`if the menu on the bottom is activated
if menu = 2
if mousex() > screen width()-3 or mousey() < screen height() - 30 then menu = 0
ink rgb(175,175,175),0
box 0,screen height() - 40,screen width()-3,screen height()
if button(55, screen height() - 20,"Freehand tool" ,rgb(200,200,200)) > 0 then tool$ = "freehand"
if button(165,screen height() - 20,"Rectangle tool",rgb(200,200,200)) > 0 then tool$ = "rectangle"
if button(275,screen height() - 20,"Line tool" ,rgb(200,200,200)) > 0 then tool$ = "line"
if button(385,screen height() - 20,"Toggle tiles" ,rgb(200,200,200)) > 0 and hold = 0
hold = 1
if tilemode = 1 then tilemode = 0 else tilemode = 1
endif
endif
`control zoom#ing
if upkey() = 1 and hold = 0
hold = 1
inc zoom#,0.2
endif
if downkey() = 1 and hold = 0
hold = 1
dec zoom#,0.2
endif
if zoom# < 3 then zoom# = 3
if zoom# > 30 then zoom# = 30
`deactivate lock
if mouseclick() = 0 and scancode() = 0 then hold = 0
`show cursor position
ink rgb(100,100,100),0
if mousex() < mapx + (width * zoom#) and mousey() < mapy + (height * zoom#)
if mousex() > mapx and mousey() > mapy
text 5,screen height() - 25,str$(int((mousex() - mapx) / zoom#)+1) + " : " + str$(int((mousey() - mapy) / zoom#)+1)
endif
endif
`allow player to move grid
if controlkey() = 1
if mapmove = 0
mapmove = 1
distx = mousex() - mapx
disty = mousey() - mapy
else
mapx = mousex() - distx
mapy = mousey() - disty
endif
else
if mapmove = 1 then mapmove = 0
endif
sync
loop
`****************************************** EXPORT TXT **************************************
export_txt:
`wait
wait 200
for y = 1 to height
for x = 1 to width
spritenr = 1 + ((y-1) * height) + (x-1)
if sprite exist(spritenr) > 0
delete sprite spritenr
endif
next x
next y
`clear screen and turn sync off
cls
sync off
`ask for filename
ink rgb(255,255,255),0
print "Please input filenmame (do not use existing filenames, type exit to quit)"
input "Filename: ",filename$
print "..."
if filename$ = "exit" then return
`create file to export
if file exist(filename$ + ".txt") = 0
open to write 1,filename$ + ".txt"
`write data
for y = 1 to height
string$ = ""
for x = 1 to width
if map_data(x,y) < 10 then char$ = str$(map_data(x,y))
if map_data(x,y) >= 10 and map_data(x,y) < 37
char$ = chr$(map_data(x,y) + 55)
endif
if map_data(x,y) >= 37 and map_data(x,y) < 63
char$ = chr$(map_data(x,y) + 61)
endif
if map_data(x,y) >= 63
char$ = chr$(map_data(x,y) - 22)
endif
string$ = string$ + char$
next x
write string 1,string$
next y
close file 1
`confirm
print "Data saved"
print "Press any key to continue"
else
print "Data not saved, file exists..."
print "Press any key to continue"
endif
`wait for user
suspend for key
`clear screen
cls
`restart the application
return
resize_map:
`clear screen and turn sync off
cls
sync off
`ask for both dimensions
ink rgb(255,255,255),0
print "Enter both values"
input "x: ",width
input "y: ",height
`redim map_data
undim map_data()
dim map_data(width,height)
` clear screen and turn sync back on
cls
sync on
`return to main
return
`***************************************** LOAD MAP *********************************************
load_map:
`delete all tiles
for y = 1 to height
for x = 1 to width
spritenr = 1 + ((y-1) * height) + (x-1)
if sprite exist(spritenr) > 0
delete sprite spritenr
endif
next x
next y
cls
dir$ = standard_dir$
set dir dir$
perform checklist for files
quantity = checklist quantity()
y = 10
do
`clear screen
cls
`make quit button
if button(screen width() - 55, screen height() - 20,"Quit",rgb(150,0,0)) > 0 and hold = 0 then hold = 1 : return
`make parent folder
find first : find next
if textbutton(5,y,"Parent folder") > 0 and hold = 0
hold = 1
name$ = get file name$()
if path exist(dir$ + "/" + name$)
set dir dir$ + "/" + name$
dir$ = get dir$()
set dir dir$
perform checklist for files
quantity = checklist quantity()
endif
endif
`create all other folders
for i = 2 to quantity - 1
find next
name$ = get file name$()
`create a button
if textbutton(5,y + ((i-1)*20),name$) > 0 and hold = 0
hold = 1
`check file type, and if 1, open directory
if get file type() = 1
name$ = get file name$()
if path exist(dir$ + "/" + name$)
dir$ = dir$ + "/" + name$
set dir dir$
dir$ = get dir$()
set dir dir$
perform checklist for files
quantity = checklist quantity()
endif
else
length = len(name$)
`if the extension = ".txt", open map
ext$ = lower$(mid$(name$,length-3) + mid$(name$,length-2)+mid$(name$,length-1)+mid$(name$,length))
if ext$ = ".txt"
open to read 1,name$
`get width and height data (width = string with the most chars)
width = 0 : height = 0
do
read string 1,string$
if len(string$) > width then width = len(string$)
inc height
if file end(1) = 1 then exit
loop
dec height
`redim map_data()
undim map_data()
dim map_data(width,height)
`reset the start of the file to read
close file 1
open to read 1,name$
`store map_data()
for y = 1 to height
read string 1,string$
for x = 1 to len(string$)
if asc(mid$(string$,x)) >= 48 and asc(mid$(string$,x)) <= 58
map_data(x,y) = val(mid$(string$,x))
endif
if asc(mid$(string$,x)) >= 65 and asc(mid$(string$,x)) <= 91
map_data(x,y) = asc(mid$(string$,x)) - 55
endif
if asc(mid$(string$,x)) >= 97 and asc(mid$(string$,x)) <= 123
map_data(x,y) = asc(mid$(string$,x)) - 61
endif
if asc(mid$(string$,x)) >= 40 and asc(mid$(string$,x)) <= 47
map_data(x,y) = asc(mid$(string$,x)) + 22
endif
next x
next y
`return to map editor
close file 1
cls
hold = 1
return
endif
if ext$ = ".bmp" or ext$ = ".jpg" or ext$ = ".png"
`here comes the loading image part
cls
`get size
load bitmap name$,1 : bx# = bitmap width(1) : by# = bitmap height(1) : delete bitmap 1
`get the image
load image name$,1000
paste image 1000,100,2
`ask information
ink rgb(255,255,255),0
input "tiles across: ", tilesx
input "tiles down: ", tilesy
`get all tiles
if tilesx > 0 and tilesy > 0 and tilesx*tilesy <= 70
cls
paste image 1000,0,0
one_tile_x = int(bx# / tilesx)
one_tile_y = int(by# / tilesy)
for y = 1 to tilesy
for x = 1 to tilesx
imagenr = 1 + ((y-1) * tilesy) + (x-1)
paste image 1000,0 - (x-1)*one_tile_x, 0 - (y-1) * one_tile_y
get image imagenr,0,0,one_tile_x,one_tile_y
next x
next y
delete image 1000
return
else
cls
print "Invalid tile values"
wait 100
suspend for key
delete image 1000
cls
return
endif
endif
endif
endif
next i
`unlock mouse
if mouseclick() = 0 then hold = 0
sync
loop
return
`**************************** change color **********************************
change_color:
red_value = rgbr(tile(i,2))
green_value = rgbg(tile(i,2))
blue_value = rgbb(tile(i,2))
do
`clear screen
cls
`make 3 boxes
`-> red
ink rgb(255,0,0),0
box 5,5,5 + red_value,25
ink rgb(255,255,255),0 : text 270,5,str$(red_value)
`-> green
ink rgb(0,255,0),0
box 5,30,5 + green_value,50
ink rgb(255,255,255),0 : text 270,30,str$(green_value)
`-> blue
ink rgb(0,0,255),0
box 5,55,5 + blue_value,75
ink rgb(255,255,255),0 : text 270,55,str$(blue_value)
`change color values
if mousex() > 5 and mousex() < 261 and mouseclick() = 1
`red value
if mousey() > 5 and mousey() < 25 then red_value = mousex() - 5
`green value
if mousey() > 30 and mousey() < 50 then green_value = mousex() - 5
`blue value
if mousey() > 55 and mousey() < 75 then blue_value = mousex() - 5
endif
`display final color
ink rgb(red_value,green_value,blue_value),0
box 320,5,390,75
`make buttons
if button(screen width() - 55, screen height() - 20, "Quit", rgb(150,0,0)) > 0 and hold = 0 then hold = 1 : return
if button(screen width() - 55, screen height() - 50, "Save color", rgb(150,0,0)) > 0 and hold = 0
hold = 1
tile(i,2) = rgb(red_value,green_value,blue_value)
return
endif
if mouseclick() = 0 then hold = 0
sync
loop
return
`********************************* Render Tiles *******************************
render_tiles:
image = map_data(x,y) + 1
spritenr = 1 + ((y-1) * height) + (x-1)
if image exist(image) = 1
sprite spritenr,(x+1)*zoom# + 1,(y+1)*zoom# + 1,image
size sprite spritenr,zoom# - 1.0,zoom# - 1.0
endif
return
`************
`functions
`************
function button(x,y,text$,background)
color = background
ink rgb(255,255,255),0
box x - 50, y - 15, x + 50, y + 15
ink color,0
box x - 49 , y - 14, x + 49 , y + 14
ty = text height(text$)/2
pressed = 0
if mousex() < x + 50 and mousex() > x - 50
if mousey() < y + ty and mousey() > y - ty
pressed = 1
endif
endif
if pressed = 1 then ink rgb(255,0,0),0 else ink rgb(255,255,255),0
center text x, y - (text size()/2), text$
if mouseclick() = 0 then pressed = 0
endfunction pressed
function textbutton(x,y,text$)
pressed = 0
tx = text width(text$)
ty = text height(text$)/2
if mousex() < x + tx and mousex() > x
if mousey() < y + ty and mousey() > y -ty
pressed = 1
endif
endif
if pressed = 1 then ink rgb(255,0,0),0 else ink rgb(255,255,255),0
text x,y-(text size()/2), text$
if mouseclick() = 0 then pressed = 0
endfunction pressed
Any requests?
Immunity and Annihalation makes Immunihalation...