Here you go Evil stick.
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 = 1
menu = 0 : menu_range = 1
width = 40
height = 40
zoom# = 10
tool$ = "freehand"
mapx = 20
mapy = 20
tilemode = 1
refresh = 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. You can change "tiles = 100" to whatever you want.
tiles = 100
undim tile()
dim tile(tiles,3)
for i = 0 to tiles
tile(i,1) = 48 + i
tile(i,2) = i * 50000
tile(i,3) = i + 1
next i
maxrange = int(tiles/10)
`*****************
` MAIN LOOP
`*****************
do
color backdrop rgb(0,0,0)
`update map
if refresh <> 0
cls
for y = 1 to height
for x = 1 to width
ink tile(map_data(x,y),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
next x
next y
`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
refresh = 0
endif
`show cursor position
ink 0,0
box 3,screen height() - 30,320,screen height() - 5
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,tool$ + " ; tile " + str$(ctile) + " ; " + str$(int((mousex() - mapx) / zoom#)+1) + " : " + str$(int((mousey() - mapy) / zoom#)+1)
endif
endif
`check for tool
if hold = 0
if mousex() > mapx and mousex() < mapx + (width*zoom#)
if mousey() > mapy and mousey() < mapy + (height*zoom#)
if tool$ = "freehand"
if mouseclick() = 1 and menu = 0
startx = int((mousex() - mapx) / zoom#) + 1
starty = int((mousey() - mapy) / zoom#) + 1
map_data(startx,starty) = ctile
refresh = 1
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) = ctile
next y
next x
refresh = 1
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) = ctile
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) = ctile
next i
endif
refresh = 1
endif
endif
endif
endif
if mouseclick() = 2
getx = int((mousex() - mapx) / zoom#)
gety = int((mousey() - mapy) / zoom#)
ctile = map_data(getx+1,gety+1)
endif
endif
endif
endif
`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
refresh = 1
else
if mousey() > screen height() - 3
menu = 2
refresh = 1
endif
endif
`if the menu on the right is activated
if menu = 1
if mousex() < screen width() - 110 then menu = 0 : refresh = 1
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 = maxrange
if menu_range > maxrange then menu_range = 1
ink rgb(255,255,255),0 : center text screen width() - 55, 1, str$(menu_range)
`display menu ranges
for m = 1 to maxrange
if menu_range = m
for i = ((m-1)*10) to m*10 - 1
pres = button(screen width() - 55, 32 + ((i - ((m-1)*10))*30),"tile nr: " + chr$(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
endif
next m
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", 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 : refresh = 1
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
refresh = 1
tilemode = 0
else
refresh = 1
tilemode = 1
endif
endif
endif
`control zooming
if upkey() = 1 and hold = 0
hold = 1
inc zoom#,0.2
refresh = 1
endif
if downkey() = 1 and hold = 0
hold = 1
dec zoom#,0.2
refresh = 1
endif
if zoom# < 3 then zoom# = 3
if zoom# > 30 then zoom# = 30
`deactivate lock
if mouseclick() = 0 and scancode() = 0 then hold = 0
`allow player to move grid
if controlkey() = 1
refresh = 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
`************************** specially for Evil stick ********************************
focus = 1
filename$ = "a"
fileext$ = ".txt"
t = 1 : y = 1
clear entry buffer
`make a little browser
perform checklist for files
`var setup
mousez() = oldmousez
do
cls
`make a background
ink rgb(50,50,50),0
box 0,0,screen width()-1,30
`input
if asc(inkey$()) = 8
if focus = 1
filename$ = left$(filename$,len(filename$) - 1)
endif
if focus = 2 and len(fileext$) > 1
fileext$ = left$(fileext$,len(fileext$) - 1)
endif
endif
if focus = 1
filename$ = filename$ + entry$()
endif
if focus = 2 and t = 1
fileext$ = fileext$ + entry$()
endif
if t = 2 then fileext$ = ".bmp"
`work out what should be displayed
if focus = 1 then filenamed$ = filename$ + "_" else filenamed$ = filename$
if focus = 2 then fileextd$ = fileext$ + "_" else fileextd$ = fileext$
if t = 1 then td$ = "Text"
if t = 2 then td$ = "Bitmap"
`display
ink rgb(255,255,255),0
if textbutton(10,15,"filename: " + filenamed$) > 0 then focus = 1 : targetl = len(filename$)
ink rgb(255,255,255),0
if textbutton(screen width()/2,15,"file extension: " + fileextd$) > 0 then focus = 2 : targetl = len(fileext$)
ink rgb(255,255,255),0
if textbutton(screen width() - 50,15,td$) > 0 and hold = 0 then hold = 1 : t = abs(t - 3)
if button(screen width() - 55, screen height() - 20,"Export",rgb(150,0,0)) > 0 then goto export
if button(screen width() - 165,screen height() - 20, "Quit",rgb(150,0,0)) > 0 then return
`list files
find first
find next
if y > 0
if get file type() = 1
ink rgb(255,255,255),0
if textbutton(2,40 + y,"Parent") > 0 and hold = 0
hold = 1
cd get file name$()
perform checklist for files
y = 1
endif
else
ink rgb(150,150,150),0
text 2,40+y - (text height("Parent")/2),"Parent"
endif
endif
for f = 3 to checklist quantity()
if get file type() <> -1
find next
if y + ((f-2)*20) > 0
if get file type() = 1
ink rgb(255,255,255),0
if textbutton(2,40 + y + ((f-2)*20),get file name$()) > 0 and hold = 0
cd get file name$()
y = 1
perform checklist for files
endif
else
ink rgb(150,150,150),0
text 2,40+y+((f-2)*20) - (text height(get file name$())/2),get file name$()
endif
endif
endif
next f
if mouseclick() = 0 then hold = 0
clear entry buffer
`scroll
if mousez() <> oldmousez
inc y,(mousez() - oldmousez)/30
oldmousez = mousez()
endif
sync
loop
`create file to export
export:
cls
if t = 1
if file exist(filename$ + fileext$) = 0
open to write 1,filename$ + fileext$
`write data
for y = 1 to height
string$ = ""
for x = 1 to width
char$ = chr$(tile(map_data(x,y),1))
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
else
if t = 2
cls
for y = 1 to height
for x = 1 to width
ink tile(map_data(x,y),2),0
box x,y,x+1,y+1
next x
next y
get image 65535,1,1,width+1,height+1,1
save image filename$ + ".bmp",65535
set cursor 0,height + 20 : ink rgb(255,255,255),0
print "Data saved."
print "press any key to continue."
else
print "Data not saved. type is not 1 or 2."
print "Press any key to continue."
endif
endif
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 get file type() = 1
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
`if the extension = ".txt", open map
ext$ = lower$(right$(name$,4))
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()
worktile = 0
for y = 1 to height
read string 1,string$
for x = 1 to len(string$)
char$ = mid$(string$,x)
check = 0
for i = 0 to worktile
if char$ = chr$(tile(i,1))
check = i+1
endif
next i
if check = 0
inc worktile
tile(worktile,1) = asc(char$)
check = worktile + 1
endif
map_data(x,y) = check - 1
next x
next y
`return to map editor
close file 1
cls
hold = 1
return
endif
if ext$ = ".bmp"
cls
ink rgb(255,255,255),0
input "Load map(1) - Load tiles(2): ",l
endif
if ext$ = ".jpg" or ext$ = ".png" then l = 2
if l = 1
`******************************************************************
`******************************************************************
endif
if l = 2
`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
refresh = 1
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 15,5,15 + red_value,25
ink rgb(255,255,255),0 : text 290,5,str$(red_value)
`-> green
ink rgb(0,255,0),0
box 15,30,15 + green_value,50
ink rgb(255,255,255),0 : text 290,30,str$(green_value)
`-> blue
ink rgb(0,0,255),0
box 15,55,15 + blue_value,75
ink rgb(255,255,255),0 : text 290,55,str$(blue_value)
`change color values
if mousex() > 14 and mousex() < 271 and mouseclick() = 1
`red value
if mousey() > 5 and mousey() < 25 then red_value = mousex() - 15
`green value
if mousey() > 30 and mousey() < 50 then green_value = mousex() - 15
`blue value
if mousey() > 55 and mousey() < 75 then blue_value = mousex() - 15
endif
if textbutton(5,10,"<") > 0 and hold = 0 then dec red_value : hold = 1
if textbutton(5,40,"<") > 0 and hold = 0 then dec green_value : hold = 1
if textbutton(5,70,"<") > 0 and hold = 0 then dec blue_value : hold = 1
if textbutton(275,10,">") > 0 and hold = 0 then inc red_value : hold = 1
if textbutton(275,40,">") > 0 and hold = 0 then inc green_value : hold = 1
if textbutton(275,70,">") > 0 and hold = 0 then inc blue_value : hold = 1
`color boundries (0 -> 255)
if red_value < 0 then red_value = 0
if red_value > 255 then red_value = 255
if green_value < 0 then green_value = 0
if green_value > 255 then green_value = 255
if blue_value < 0 then blue_value = 0
if blue_value > 255 then blue_value = 255
`change tile value
if button(60,350,"<",rgb(75,75,75)) > 0 and hold = 0
hold = 1
if tile(i,1) > 1 then dec tile(i,1)
endif
if button(200,350,">",rgb(75,75,75)) > 0 and hold = 0
hold = 1
inc tile(i,1)
endif
ink rgb(255,255,255),0
center text 130,340,chr$(tile(i,1))
`display final color
ink rgb(red_value,green_value,blue_value),0
box 420,5,490,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 = tile(map_data(x,y),3)
spritenr = 1 + ((y-1) * height) + (x-1)
if image exist(image) > 0
sprite spritenr,mapx + ((x-1)*zoom#), mapy + ((y-1)*zoom#),image
size sprite spritenr,zoom#,zoom#
select menu
case 1
if mapx + (x*zoom#) > screen width() - 110 then hide sprite spritenr
endcase
case 2
if mapy + (y*zoom#) > screen height() - 40 then hide sprite spritenr
endcase
case default
show sprite spritenr
endcase
endselect
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
When exporting, you should have now a file browser. (I couldn't get the backspace to slow down though). You can change focus by clicking on filename or file extension. Note that images always keep the same extension.
Immunity and Annihalation makes Immunihalation...
