Code:
Set display mode 1280,1024,16
gosub titlescreen
ink rgb(255,255,255), rgb(0,0,0)
Loadornew:
show mouse
loadornew$ = Inputbox("Do you want to (L)oad a map or make a (N)ew map?","Prompt")
hide mouse
loadornew$ = upper$(loadornew$)
cls
If loadornew$ = "L" then gosub loadmap
If loadornew$ = "N" then gosub newmap
If loadornew$ <> "L" and loadornew$ <> "N"
Print "Please choose one of the options"
goto loadornew
endif
gosub datastuff
MainLoop:
Do :`**************MAIN LOOP!!!*****************
If int(mousex()/tilesize) < xsize then mousex = int(mousex()/tilesize)
If int(mousey()/tilesize) < ysize then mousey = int(mousey()/tilesize)
If scancode() = 2 then selectedtile = 1
If scancode() = 3 then selectedtile = 2
If scancode() = 4 then selectedtile = 3
If scancode() = 5 then selectedtile = 4
If scancode() = 6 then selectedtile = 5
If scancode() = 7 then selectedtile = 6
If scancode() = 8 then selectedtile = 7
If scancode() = 9 then selectedtile = 8
If scancode() = 10 then selectedtile = 9
If scancode() = 11 then selectedtile = 10
If mouseclick() = 1 and box(1) = 0 and spritevisible = 1
map(mousex+1,mousey+1) = selectedtile
paste image selectedtile,mousex*tilesize,mousey*tilesize
endif
If mouseclick() = 1 and box(1) = 1 and spritevisible = 1
box(2) = mousex+1
box(3) = mousey+1
box(1) = 2
Paste image 20,box(2)*tilesize - tilesize,box(3)*tilesize - tilesize
endif
If mouseclick() = 0 and box(1) = 2
box(4) = mousex+1
box(5) = mousey+1
box(1) = 3
endif
If box(1) = 3 then gosub makebox
If box(1) = 0 and sprite exist(2) = 1 then hide sprite 2
Sprite 1,int(mousex()/tilesize)*tilesize,int(mousey()/tilesize)*tilesize,20
If mousex() > 1120
show mouse
hide sprite 1
spritevisible = 0
endif
If mousex() < 1120
hide mouse
show sprite 1
spritevisible = 1
endif
Sprite 10,1167,42,33
If mousex() > 1167 and mousex() < 1167 + sprite width(10) and mousey() > 42 and mousey() < 42 + sprite height(10) then sprite 10,1167,42,34
If mousex() > 1167 and mousex() < 1167 + sprite width(10) and mousey() > 42 and mousey() < 42 + sprite height(10) and mouseclick() = 1
Sprite 10,1167,84,35
gosub hidesprites
gosub newmap
endif
Sprite 11,1167,126,39
If mousex() > 1167 and mousex() < 1167 + sprite width(11) and mousey() > 126 and mousey() < 126 + sprite height(11) then sprite 11,1167,126,40
If mousex() > 1167 and mousex() < 1167 + sprite width(11) and mousey() > 126 and mousey() < 126 + sprite height(11) and mouseclick() = 1
Sprite 11,1167,126,41
gosub hidesprites
gosub savemap
endif
Sprite 12,1167,210,30
If mousex() > 1167 and mousex() < 1167 + sprite width(12) and mousey() > 210 and mousey() < 210 + sprite height(12) then sprite 12,1167,210,31
If mousex() > 1167 and mousex() < 1167 + sprite width(12) and mousey() > 210 and mousey() < 210 + sprite height(12) and mouseclick() = 1
Sprite 12,1167,210,32
gosub hidesprites
gosub loadmap
endif
Sprite 13,1167,294,36
If mousex() > 1167 and mousex() < 1167 + sprite width(13) and mousey() > 294 and mousey() < 294 + sprite height(13) then sprite 13,1167,294,37
If mousex() > 1167 and mousex() < 1167 + sprite width(13) and mousey() > 294 and mousey() < 294 + sprite height(13) and mouseclick() = 1
Sprite 13,1167,294,38
gosub hidesprites
gosub chngchar
endif
Sprite 14,1167,378,24
If mousex() > 1167 and mousex() < 1167 + sprite width(14) and mousey() > 378 and mousey() < 378 + sprite height(14) then sprite 14,1167,378,25
If mousex() > 1167 and mousex() < 1167 + sprite width(14) and mousey() > 378 and mousey() < 378 + sprite height(14) and mouseclick() = 1
Sprite 14,1167,378,26
gosub hidesprites
box(1) = 1
endif
Sprite 15,1167,462,27
If mousex() > 1167 and mousex() < 1167 + sprite width(15) and mousey() > 462 and mousey() < 462 + sprite height(15) then sprite 15,1167,462,28
If mousex() > 1167 and mousex() < 1167 + sprite width(15) and mousey() > 462 and mousey() < 462 + sprite height(15) and mouseclick() = 1
Sprite 15,1167,462,29
end
endif
Set cursor 1140,544
Print "Tile 1="+color$(1)
Set cursor 1140,586
Print "Tile 2="+color$(2)
Set cursor 1140,628
Print "Tile 3="+color$(3)
Set cursor 1140,670
Print "Tile 4="+color$(4)
Set cursor 1140,712
Print "Tile 5="+color$(5)
Set cursor 1140,754
Print "Tile 6="+color$(6)
Set cursor 1140,796
Print "Tile 7="+color$(7)
Set cursor 1140,838
Print "Tile 8="+color$(8)
Set cursor 1140,880
Print "Tile 9="+color$(9)
Set cursor 1140,922
Print "Tile 10="+color$(10)
gosub datastuff
sync
Loop :`**********MAIN LOOP!!!***********
`Make Tiles:
MAKETILES:
ink rgb(255,255,255), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0) :`Tile 1 -White
line 1,1,tilesize,tilesize
line 1,tilesize,tilesize,1
get image 1,1,1,tilesize,tilesize
ink rgb(255,255,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0) :`Tile 2 -Yellow
line 1,1,tilesize,tilesize
line 1,tilesize,tilesize,1
get image 2,1,1,tilesize,tilesize
ink rgb(255,0,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0) :`Tile 3 -Red
line 1,1,tilesize,tilesize
line 1,tilesize,tilesize,1
get image 3,1,1,tilesize,tilesize
ink rgb(0,0,255), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0) :`Tile 4 -blue
line 1,1,tilesize,tilesize
line 1,tilesize,tilesize,1
get image 4,1,1,tilesize,tilesize
ink rgb(0,255,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0) :`Tile 5 -Green
line 1,1,tilesize,tilesize
line 1,tilesize,tilesize,1
get image 5,1,1,tilesize,tilesize
ink rgb(255,128,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0)
line 1,1,tilesize,tilesize :`Tile 6 - Orange
line 1,tilesize,tilesize,1
get image 6,1,1,tilesize,tilesize
ink rgb(255,0,255), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0)
line 1,1,tilesize,tilesize :`Tile 7 -Purple
line 1,tilesize,tilesize,1
get image 7,1,1,tilesize,tilesize
ink rgb(111,0,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0)
line 1,1,tilesize,tilesize :`Tile 8 -Brown
line 1,tilesize,tilesize,1
get image 8,1,1,tilesize,tilesize
ink rgb(128,128,128), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0)
line 1,1,tilesize,tilesize :`Tile 9 -Grey
line 1,tilesize,tilesize,1
get image 9,1,1,tilesize,tilesize
ink rgb(255,171,255), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(0,0,0), rgb(0,0,0)
line 1,1,tilesize,tilesize :`Tile 10 -Pink
line 1,tilesize,tilesize,1
get image 10,1,1,tilesize,tilesize
ink rgb(0,0,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Ink rgb(50,50,50), rgb(0,0,0)
line 1,1,tilesize,1
line 1,1,1,tilesize
line tilesize - 1,tilesize - 1,tilesize - 1,1
line tilesize - 1,tilesize - 1,1,tilesize - 1
ink rgb(255,255,255), rgb(0,0,0)
line 1,1,tilesize,tilesize
line 1,tilesize,tilesize,1
get image 20,1,1,tilesize,tilesize
ink rgb(0,0,0), rgb(0,0,0)
box 1,1,tilesize,tilesize
Return
`Draw Map:
DRAWMAP:
cls
For y = 1 to ysize
For x = 1 to xsize
Paste image Map(x,y), x*tilesize - tilesize, y*tilesize - tilesize
next x
next y
Paste image 22,1120,0
sync
Return
`Save map
SAVEMAP:
cd "Map Files"
show mouse
ink rgb(255,255,255), rgb(0,0,0)
filename$ = Inputbox("Filename","Prompt")
if File exist(filename$) = 1 then delete file filename$
open to write 1,filename$
write string 1,str$(xsize)
write string 1,str$(ysize)
For I = 1 to numoftiles
Write string 1,character$(I)
Next I
For y = 1 to ysize
For x = 1 to xsize
thing = map(x,y)
write string 1,character$(thing)
next x
next y
close file 1
cls
hide mouse
cd ".."
gosub drawmap
return
`Load map
LOADMAP:
cd "Map Files"
show mouse
ink rgb(255,255,255), rgb(0,0,0)
yesorno$ = Inputbox("Show files in directory? Y or N","Prompt")
yesorno$ = upper$(yesorno$)
If yesorno$ = "Y"
cls
dir
sleep 1000
Print "Press any key to continue..."
suspend for key
endif
filename$ = Inputbox("Filename","Prompt")
If file exist(filename$) = 1
Open to read 1,filename$
read string 1,xsize$
read string 1,ysize$
xsize = val(xsize$)
ysize = val(ysize$)
dim map(xsize,ysize)
For I = 1 to numoftiles
read string 1,Character$(I)
next I
For y = 1 to ysize
For x = 1 to xsize
Map(x,y) = 1
next x
next y
For y = 1 to ysize
For x = 1 to xsize
read string 1,map$
For I = 1 to numoftiles
If character$(I) = map$ then map(x,y) = I
next I
next x
next y
close file 1
endif
If file exist(filename$) = 0
fail$ = Inputbox("(T)ry again, or (Q)uit?","File does not exist")
fail$ = upper$(fail$)
If fail$ = "T" then goto loadmap
If fail$ = "Q" then goto loadornew
If fail$ <> "T" and fail$ <> "Q" then goto loadmap
endif
cls
hide mouse
cd ".."
gosub drawmap
return
`Change characters
CHNGCHAR:
show mouse
Ink rgb(255,255,255), rgb(0,0,0)
response$ = Inputbox("Change (c)haracters, (s)ize(has bugs, don't use!) or (N)ever mind?","Prompt")
response$ = upper$(response$)
If response$ = "C"
For I = 1 to numoftiles
character$ = Inputbox("enter character for tile "+str$(I)+":","Prompt")
character$(I) = character$
next I
cls
gosub drawmap
endif
If response$ = "S"
oldxsize = xsize
oldysize = ysize
xsize$ = Inputbox("Xsize","Prompt")
ysize$ = Inputbox("Ysize","Prompt")
xsize = val(xsize$)
ysize = val(ysize$)
Dim newmap(xsize,ysize)
If oldxsize > xsize
If oldysize > ysize
For y = 1 to ysize
For x = 1 to xsize
newmap(x,y) = map(x,y)
next x
next y
Dim map(xsize,ysize)
For y = 1 to ysize
For x = 1 to xsize
map(x,y) = newmap(x,y)
next x
next y
endif
If oldysize < ysize
For y = 1 to oldysize
For x = 1 to xsize
newmap(x,y) = map(x,y)
next x
next y
Dim map(xsize,ysize)
For y = 1 to ysize
For x = 1 to xsize
map(x,y) = newmap(x,y)
next x
next y
endif
endif
If oldxsize < xsize
If oldysize < ysize
For y = 1 to oldysize
For x = 1 to oldxsize
newmap(x,y) = map(x,y)
next x
next y
Dim map(xsize,ysize)
For y = 1 to ysize
For x = 1 to xsize
map(x,y) = newmap(x,y)
next x
next y
endif
If oldysize < ysize
For y = 1 to oldysize
For x = 1 to oldxsize
newmap(x,y) = map(x,y)
next x
next y
Dim map(xsize,ysize)
For y = 1 to ysize
For x = 1 to xsize
map(x,y) = newmap(x,y)
next x
next y
endif
endif
For y = 1 to ysize
For x = 1 to xsize
If map(x,y) = 0 then map(x,y) = 1
next x
next y
cls
gosub drawmap
endif
If response$ <> "S" and response$ <> "C" and response$ <> "N"
goto chngchar
endif
cls
hide mouse
gosub drawmap
return
`Make Box
MAKEBOX:
If box(2) < box(4) and box(3) < box(5)
For x = box(2) to box(4)
For y = box(3) to box(5)
map(x,y) = selectedtile
next y
next x
endif
If box(2) > box(4) and box(3) > box(5)
For x = box(2) to box(4) step -1
For y = box(3) to box(5) step -1
map(x,y) = selectedtile
next y
next x
endif
If box(2) < box(4) and box(3) > box(5)
For x = box(2) to box(4)
For y = box(3) to box(5) step -1
map(x,y) = selectedtile
next y
next x
endif
If box(2) > box(4) and box(3) < box(5)
For x = box(2) to box(4) step -1
For y = box(3) to box(5)
map(x,y) = selectedtile
next y
next x
endif
gosub drawmap
box(1) = 0
return
`Datastuff
DATASTUFF:
Paste image 23,0,1000
set cursor 0,1000
Ink rgb(255,255,255), rgb(0,0,0)
Print "X:"+str$(mousex+1)+" Y:"+str$(mousey+1)+" ";
Print "Selected Tile: "+str$(selectedtile)+" Color: "+Color$(selectedtile)+" ";
If box(1)>0 then Print "Box Mode: " + str$(box(1))+" ";
sync
return
`NewMap
NEWMAP:
show mouse
Ink rgb(255,255,255), rgb(0,0,0)
xsize$ = Inputbox("x size","Prompt")
ysize$ = Inputbox("y size","Prompt")
xsize = val(xsize$)
ysize = val(ysize$)
DefaultorManual:
Response$ = Inputbox("(D)efault or (M)anual Character values?","Prompt")
Response$ = upper$(response$)
If response$ = "M"
For I = 1 to numoftiles
character$ = Inputbox("enter character for tile "+str$(I)+":","Prompt")
character$(I) = character$
next I
endif
If response$ = "D"
For I = 1 to numoftiles
Character$(I) = str$(I)
next I
endif
If response$ <> "M" and response$ <> "D" then goto Defaultormanual
Dim Map(xsize,ysize)
For y = 1 to ysize
For x = 1 to xsize
Map(x,y) = 1
next x
next y
hide mouse
gosub Drawmap
return
`TitleScreen
TITLESCREEN:
cd "media"
Load image "Title.jpg",21
Paste image 21,1280/2-500,1024/2-400
center text 640,1000,"Loading will begin in a few seconds..."
sleep 3000
ink rgb(0,0,0), rgb(0,0,0)
box 0,1000,1279,1023
ink rgb(255,255,255), rgb(0,0,0)
center text 640,1000,"Loading Variables and Arrays"
Numoftiles = 10
Dim character$(numoftiles)
Tilesize = 20
Selectedtile = 1
dim box(5)
box(1) = 0
Dim color$(numoftiles)
color$(1) = "White"
color$(2) = "Yellow"
color$(3) = "Red"
color$(4) = "Blue"
color$(5) = "Green"
color$(6) = "Orange"
color$(7) = "Purple"
color$(8) = "Brown"
color$(9) = "Grey"
color$(10) = "Pink"
ink rgb(0,0,0), rgb(0,0,0)
box 0,1000,1279,1023
ink rgb(255,255,255), rgb(0,0,0)
Center text 640,1000,"Loading System stuff"
Sync on
sync rate 0
ink rgb(0,0,0), rgb(0,0,0)
box 0,1000,1279,1023
ink rgb(255,255,255), rgb(0,0,0)
Center text 640,1000,"Loading Tiles"
gosub maketiles
ink rgb(0,0,0), rgb(0,0,0)
box 0,1000,1279,1023
ink rgb(255,255,255), rgb(0,0,0)
Center text 640,1000,"Loading Toolbar"
Load image "Toolbar.jpg",22
Load image "Toolbar-bottom.jpg",23
Load image "Box1.bmp",24
Load image "Box2.bmp",25
Load image "Box3.bmp",26
Load image "Exit1.bmp",27
Load image "Exit2.bmp",28
Load image "Exit3.bmp",29
Load image "Load1.bmp",30
Load image "Load2.bmp",31
Load image "Load3.bmp",32
Load image "new1.bmp",33
Load image "new2.bmp",34
Load image "new3.bmp",35
Load image "opt1.bmp",36
Load image "opt2.bmp",37
Load image "opt3.bmp",38
Load image "save1.bmp",39
Load image "save2.bmp",40
Load image "save3.bmp",41
cd ".."
ink rgb(0,0,0), rgb(0,0,0)
box 0,1000,1279,1023
ink rgb(255,255,255), rgb(0,0,0)
center text 640,1000,"Press Any Key To Continue..."
suspend for key
cls
return
`HIDE SPRITES!!!!
HIDESPRITES:
For I = 1 to 30
If sprite exist(I)
sprite I,1281,1023,1
endif
next I
return
function inputbox(prompt$,title$) :`*******FUNCTION INPUTBOX*********
cls
Paste image 21,1280/2-500,1024/2-400
sleep 1000
boxlength=200
if text width(title$) > boxlength
boxlength = text width(title$) + 10
endif
if text width(prompt$) > boxlength
boxlength = text width(prompt$) + 10
endif
startx = (screen width()/2) - (boxlength / 2)
starty = (screen height()/2) - 50
endx = (screen width()/2) + (boxlength/2)
endy = starty + 100
do
sync
ink 0,0
box startx,starty,endx,endy
ink rgb(123,123,123),0
box startx+1,starty+1,endx-1,endy-1
ink rgb(0,0,200),0
box startx+1,starty+1,endx-1,starty+20
ink 0,0
line startx+1,starty+21,endx-1,starty+21
text startx+2,(screen height()/2)-47,Title$
text startx+5,(screen height()/2)-20,prompt$
box startx+5,(screen height()/2)+20,endx-40,(screen height()/2)+40
ink rgb(255,255,255),0
box startx+6,(screen height()/2)+21,endx-41,(screen height()/2)+39
ink 0,0
text startx+7,(screen height()/2)+22,line$
box endx-35,(screen height()/2)+20,endx-5,(screen height()/2)+40
ink rgb(144,144,144),0
box endx-34,(screen height()/2)+21,endx-6,(screen height()/2)+39
ink 0,0
text endx-29,(screen height()/2)+22,"Ok"
if mousex() > endx-35
if mousex() < endx-5
if mousey() < (screen height()/2)+40
if mousey() > (screen height()/2)+20
if mouseclick()=1
okbutton=1
endif
endif
endif
endif
endif
if bla < 0
if scancode()<>14
if returnkey()=0
if okbutton=0
If Len(line$) < 30
line$=line$+inkey$()
bla=3
key = 1
endif
endif
endif
endif
endif
dec bla
if scancode()=14
if bla < 0
line$=left$(line$,len(line$)-1)
bla=3
endif
endif
if returnkey() =1 or okbutton=1
okbutton=0
endstring$ = line$
line$ = ""
goto eindefunctie
endif
loop
eindefunctie:
ink rgb(255,255,255), rgb(0,0,0)
endfunction endstring$
I also attached a sample file to load with this program.
