Quote: "It ONLY works with functions"
Thanks, I didn't know it only works with functions.
@Irojo
How come your map editor dont have a selection 3 "Player"? I can insert one if you want. Anyways your editor is fully operational now everthing works from save - load - exiting.
Here's the codes, a few things changed, actually alot of things changed but test it out. I mostly just rearanged the codes.
sync on
sync rate 0
hide mouse
State = 0
REM >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
REM Main Loop
do
if State = 0 then gosub State0
if State = 1 then gosub State1
if State = 2 then gosub State2
if State = 3 then gosub State3
if State = 4 then gosub State4
sync
loop
REM Main Loop
REM >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
REM Intro & Loading
State0:
load image "game over.bmp",65535
dim gframe(1)
gframe(1)=34
load image "DNGIngameGUI.bmp",65534
#include "filesys.dba"
REM MENU CODE
hide mouse
sync on
sync rate 100
load music "Music/Boss.mid",2
set text font "Impact"
REM This is for the beginning x.
xxxx=120
play music 2
for fadein=1 to 255 step 2
cls 0
set text size fadein
set=rnd(4)
if set=1 then white=0
if set=0 then white=1
if white=1 then ink rgb(255,255,255),0
if white=0 then ink rgb(255,0,0),0
center text xxxx,240,"DarkNOOB Games"
inc xxxx,5
set gamma fadein,fadein,fadein
sync
next fadein
cls 0
wait 10
sync
REM - end of the animation if you will-
REM makes the darkNOOB in a grey text, and fades it out.
fadeout=255
set text size 100
ink rgb(100,100,100),0
center text 320,240,"DarkNOOB"
wait 1000
ink rgb(155,0,0),0
center text 320,100,"Games"
stop music 2
repeat
set gamma fadeout,fadeout,fadeout
dec fadeout,5
until fadeout=0
cls 0
wait 10
sync
REM Resetting.
set text size 20
set gamma 255,255,255
set text font "system"
cls 0
REM Changes to State1
State = 1
return
REM Main menu
State1:
REM Check1 checks state1 if it's first time run.
if Check1 = 0
Check1 = 1
ink rgb(255,255,255),0 : center text 320,240,"Loading please wait..."
wait 10
sync
load music "Music/themea.mid",4
REM Making the arrow
cls 0
ink rgb(140,140,140),0
print "<";
for locate=1 to 40
ink rgb(60*locate,60*locate,0),0
text 5+locate,0,"-"
next locate
get image 100,0,0,100,40
REM This makes the background pattern for y=1 to 100 step 1
cls 0
for x=1 to 100 step 1
for y=1 to 100 step 1
ink rgb(x*y^2,x,y),0
dot x,y
next x
next y
get image 1,0,0,100,100
REM Drawing the background
cls 0
for y=1 to screen height() step 100
for x=1 to screen width() step 100
paste image 1,x,y
next x
next y
REM Setting up the Onscreen text variables.
c1 = rgb(255,255,255)
c2 = rgb(155,155,155)
c3 = rgb(100,100,100)
c4 = rgb(200,200,200)
MenuX = screen width()/2
MenuY = 0
REM Making the 'sun'
repeat
inc r,1
ink rgb(5*r,5*r,0),0
circle -55,0,r
until r=100
get image 65533,0,0,640,480
REM Setting Values
bright = 255
x#=screen width()/1.6
m = 4
play music m
REM Main Menu
paste image 65533,0,0
set text font "system"
set text size 60
ink c1,0 : center text MenuX+1,100,"Furious Pickaxe"
ink c2,0 : center text MenuX,100,"Furious Pickaxe"
set text size 40
ink c1,0
center text MenuX,230,"Play"
center text MenuX,280,"Extras"
center text MenuX,330,"Exit"
ink c3,0
center text MenuX,229,"Play"
center text MenuX,278,"Extras"
center text MenuX,328,"Exit"
get image 65532,0,0,640,480
REM Selections
paste image 65533,0,0
set text size 60
ink c1,0 : center text MenuX,40,"Extras"
ink c2,0 : center text MenuX+1,42,"Extras"
set text size 40
ink c1,0
center text MenuX,180,"Level Editor"
center text MenuX,240,"Credits"
center text MenuX,300,"Instructions"
center text MenuX,360,"System"
ink c2,0
center text MenuX+1,180,"Level Editor"
center text MenuX+1,241,"Credits"
center text MenuX+1,301,"Instructions"
center text MenuX+1,361,"System"
get image 65531,0,0,640,480
REM Instructions
paste image 65533,0,0
set text size 40
ink c1,0 : center text MenuX,40,"Instructions"
set text size 15
ink c4,0
center text MenuX,100,"Dig the ground to get gems!"
center text MenuX,120,"Collect as many as possible."
center text MenuX,140,"But be forwarned! Don't dig underneath rocks!"
center text MenuX,160,"They'll land on your head and squish you!"
ink rgb(200,200,0),0
for bar=1 to screen width()
text bar,185,"-"
next bar
set text size 40
ink c1,0
center text MenuX,220,"Menu Instructions"
ink rgb(200,200,200),0
set text size 15
center text MenuX,300,"Use up and down keys to move cursor. Enter or spacebar is to select, backspace is to go back."
get image 65530,0,0,640,480
REM Making the Credits. Changes will be made.
paste image 65533,0,0
set text size 60
ink rgb(100,100,0),0
center text MenuX,40,"Credits"
ink rgb(200,100,0),0
set text size 15
center text MenuX,100,"Program Manager and Designer: BN2 Productions"
ink rgb(210,80,0),0
center text MenuX,150,"Music and Images: Sinisterstuf"
ink rgb(220,60,0),0
center text MenuX,200,"Rock Control: Sinani201"
ink rgb(230,40,0),0
center text MenuX,250,"Menu, Partial Ingame Design, and Level Editor Maker: Irojo"
ink rgb(240,20,10),0
center text MenuX,300,"Textures: NanoGamez Guy"
ink rgb(250,40,30),0
center text MenuX,350,"Thanks also to OBese87, Latch, TDK, and many others not mentioned."
get image 65529,0,0,640,480
REM System
paste image 65533,0,0
set text size 60
ink c1,0 : center text MenuX,40,"System"
ink c2,0 : center text MenuX+1,42,"System"
set text size 40
ink c1,0 : center text MenuX,240,"Brightness"
ink c2,0 : center text MenuX,241,"Brightness"
get image 65528,0,0,640,480
endif
paste image 65533,0,0
paste image 65532,0,0
REM Arrow
paste image 100,x#,230+MenuY*58,1
REM Checks for Key pressed
if upkey()=1
if KeyU = 0 then MenuY = MenuY - 1
KeyU = 1
else
KeyU = 0
endif
if downkey()=1
if KeyD = 0 then MenuY = MenuY + 1
KeyD = 1
else
KeyD = 0
endif
if MenuY > 2 then MenuY = 0
if MenuY < 0 then MenuY = 2
REM Fades to the menu selected
if spacekey()=1 or returnkey()=1
if KeyR = 0
KeyR = 1
for f = bright to 0 step -50
set gamma f,f,f
wait 10
next f
cls 0
sync
wait 10
set gamma bright,bright,bright
if MenuY=0 then State = 2
if MenuY=1 then State = 3
if MenuY=2 then gosub Exit
MenuY = 0
endif
KeyR = 1
else
KeyR = 0
endif
return
State3:
paste image 65533,0,0
paste image 65531,0,0
REM Arrow
paste image 100,x#+100,180+MenuY*60,1
REM Checks for Key pressed
if inkey$() = "" then KeyA = 0
if upkey()=1
if KeyU = 0 then MenuY = MenuY - 1
KeyU = 1
else
KeyU = 0
endif
if downkey()=1
if KeyD = 0 then MenuY = MenuY + 1
KeyD = 1
else
KeyD = 0
endif
if MenuY < 0 then MenuY = 3
if MenuY > 3 then MenuY = 0
if spacekey()=1 or returnkey()=1
if KeyR = 0
KeyR = 1
for f = bright to 0 step -50
set gamma f,f,f
wait 10
next f
cls 0
sync
wait 10
set gamma bright,bright,bright
if MenuY=0 then State = 4 : return
if MenuY=1 then gosub Credits
if MenuY=2 then gosub Instructions
if MenuY=3 then gosub System
endif
KeyR = 1
else
KeyR = 0
endif
if scancode() = 14 then State = 1
return
Exit:
for lp = 1 to 65534
if sprite exist(lp) then delete sprite lp
if image exist(lp) then delete image lp
next lp
set gamma 255,255,255
cls 0
end
return
Instructions:
esc = 0
repeat
paste image 65533,0,0
paste image 65530,0,0
sync
if returnkey() or spacekey()
if KeyR = 0 then esc = 1
KeyR = 1
else
KeyR = 0
endif
if scancode() = 14 then esc = 1
until esc = 1
return
Credits:
esc = 0
repeat
paste image 65533,0,0
paste image 65529,0,0
sync
if returnkey() or spacekey()
if KeyR = 0 then esc = 1
KeyR = 1
else
KeyR = 0
endif
if scancode() = 14 then esc = 1
until esc = 1
return
System:
esc = 0
repeat
paste image 65533,0,0
paste image 65528,0,0
REM Arrow
paste image 100,x#+100,260,1
if spacekey()=1 or returnkey()=1
if KeyR = 0 then gosub Brightness
KeyR = 1
else
KeyR = 0
endif
if scancode() = 14 then esc = 1
sync
until esc = 1
return
Brightness:
create bitmap 2,200,200
gridwidth=150
gridheight=150
dim grid(gridwidth,gridheight)
startvalue=50
maxvalue=100
minvalue=0
variation=30
if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue)
for x=1 to gridwidth
for y=1 to gridheight
grid(x,y)=startvalue
next y
next x
for i=1 to gridwidth*gridheight/10
feild=abs(maxvalue-minvalue)
x=rnd(gridwidth)
y=rnd(gridheight)
value=rnd(feild)
grid(x,y)=value
next i
for x=1 to gridwidth step 1
for y=1 to gridheight
otherpoints=0
totalofothers=0
if x>0
value=grid(x-1,y)
if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value
endif
if y>0
value=grid(x,y-1)
if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value
endif
if x<gridwidth
value=grid(x+1,y)
if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value
endif
if y<gridheight
value=grid(x,y+1)
if value<>startvalue then otherpoints=otherpoints+1 : totalofothers=totalofothers+value
endif
if otherpoints>0
o#=otherpoints
t#=totalofothers
average#=t#/o#
else
average#=startvalue
endif
gridvalue=average#+(rnd(variation)-(variation/2))
if gridvalue<minvalue then gridvalue=minvalue
if gridvalue>maxvalue then gridvalue=maxvalue
ink rgb(255,255,255),0
grid(x,y)=gridvalue
gv#=gridvalue
rg#=gv#/100*90
ink rgb(rg#,rg#,gridvalue),0
dot x,y
next y
next x
get image 10,0,0,150,150
set current bitmap 0
delete bitmap 2
do
REM Background
paste image 65533,0,0
REM Textured Menu Box
paste image 10,MenuX-75,240-75
REM Texts
set text font "arabic_charset"
set text size 60
ink c1,0 : center text MenuX,40,"System"
ink c2,0 : center text MenuX+1,42,"System"
set cursor MenuX-75,240-75 : print "Control with arrow keys."
set cursor MenuX-25,240-25 : print "< "+str$(bright)+" >"
box MenuX-35,240,MenuX+35,240
box MenuX+(bright-100)/2-40,240-5,MenuX+(bright-100)/2-35,240+6
if leftkey()
if bright > 100 then bright = bright - 1
set gamma bright,bright,bright
endif
if rightkey()
if bright < 255 then bright = bright + 1
set gamma bright,bright,bright
endif
if scancode() = 14 or returnkey() or spacekey() then return
sync
loop
return
REM ------------------------------------------------------------------------
REM GAME CODE!
State2:
REM First time check for State2. Loads up system.
if Check2 = 0
Check2 = 1
randomize timer()
REM Create an array
dim terrain(14,14)
dim offset(2)
dim rocks(200,3)
gemst=0
offset(1)=14
offset(2)=14
set text font "Arial"
set text size 12
dir=1
current=1
ink rgb(155,0,0),0 : center text 320,140,"Loading..."
sync
wait 10
load music "Music/Jeopardy Theme.mp3",32
play music 32
REM Ground
load image "Ground/ground01.png",1
load image "Ground/ground02.png",2
load image "Ground/ground03.png",3
load image "Ground/ground04.png",4
load image "Ground/ground05.png",5
load image "Ground/ground06.png",6
load image "Ground/ground07.png",7
load image "Ground/ground08.png",8
load image "Ground/ground09.png",9
load image "Ground/ground10.png",10
load image "Ground/ground11.png",11
load image "Ground/ground12.png",12
load image "Ground/ground13.png",13
load image "Ground/ground14.png",14
load image "Ground/ground15.png",15
REM Music
load music "Music/Boss.mid",1
load music "Music/Boss (Rock Version).mid",2
load music "Music/credits.mid",3
load music "Music/themeA.mid",4
load music "Music/themeB.mid",5
REM Gems
load image "Jems/jem1.png",16
load image "Jems/jem2.png",17
load image "Jems/jem3.png",18
load image "Jems/jem4.png",19
load image "Jems/jem5.png",20
load image "Jems/jem6.png",21
REM Rocks
load image "Rocks/rock1.png",22
load image "Rocks/rock2.png",23
load image "Rocks/rock3.png",24
load image "Rocks/rock4.png",25
load image "Rocks/rock5.png",26
load image "Rocks/rock6.png",27
load image "Rocks/rock7.png",28
load image "Rocks/rock8.png",29
REM Walls
load image "Walls/wall1.png",30
load image "Walls/wall2.png",31
load image "Walls/wall3.png",32
REM Player
load image "Player/down1.png",33
load image "Player/down2.png",34
load image "Player/down3.png",35
load image "Player/up1.png",36
load image "Player/up2.png",37
load image "Player/up3.png",38
load image "Player/right1.png",39
load image "Player/right2.png",40
load image "Player/right3.png",41
load image "Player/left1.png",42
load image "Player/left2.png",43
load image "Player/left3.png",44
m = 32
px=1
py=1
set text opaque
endif
if Check2 = 1
Check2 = 2
filename$=FileIO(2)
if filename$ = "" then State = 1 : Check2 = 1:return
gosub LoadFile
KeyR = 1
endif
if music playing(m) = 0 then m = rnd(4)+1 : play music m
if delay=5
gframe(1)=nextimg(30+dir*3,31+dir*3,30+dir*3,32+dir*3,current)
paste image gframe(1),offset(1)+px*32,offset(2)+py*32
inc current
if current=5 then current=1
delay=0
else
inc delay
endif
ink rgb(255,255,255),0
REM Control the player
if upkey()=1 and py>0 and disable=0
direct=4
REM Makes sure that there are no walls above the player
REM note that this if then must be contained in the previous one,
REM to stop getting an array bounds error when on the edges of the map
if terrain(px,py-1)<22 or terrain(px,py-1)>32
if terrain(px,py-1)>=16 and terrain(px,py-1)<=21
inc gemsc
endif
REM Makes the previous position cleared
terrain(px,py)=0
dec py
disable=1
REM The new position is occupied by the player
terrain(px,py)=400
endif
gosub droprocks
endif
if downkey()=1 and py<13 and disable=0
direct=3
if terrain(px,py+1)<22 or terrain(px,py+1)>32
if terrain(px,py+1)>=16 and terrain(px,py+1)<=21
inc gemsc
endif
terrain(px,py)=0
inc py
disable=1
terrain(px,py)=400
endif
gosub droprocks
endif
if rightkey()=1 and px<13 and disable=0
if terrain(px+1,py)>=22 and terrain(px+1,py)<=29 and terrain(px+2,py)=0 and playerx<12
for frock=0 to 200
if rocks(frock,1)=px+1 and rocks(frock,2)=py then exit
next frock
rocks(frock,1)=rocks(frock,1)+1
terrain(px+2,py)=terrain(px+1,py)
terrain(px+1,py)=0
endif
if terrain(px+1,py)<22 or terrain(px+1,py)>32
direct=2
if terrain(px+1,py)>=16 and terrain(px+1,py)<=21
inc gemsc
endif
terrain(px,py)=0
inc px:disable=1
terrain(px,py)=400
endif
gosub droprocks
ENDIF
if leftkey()=1 and px>0 and disable=0
if terrain(px-1,py)>=22 and terrain(px-1,py)<=29 and terrain(px-2,py)=0 and playerx>1
terrain(px-2,py)=terrain(px-1,py)
terrain(px-1,py)=0
gosub droprocks
endif
if terrain(px-1,py)<22 or terrain(px-1,py)>32
direct=1
if terrain(px-1,py)<22 or terrain(px-1,py)>32 or terrain(px-1,py)=999
if terrain(px-1,py)>=16 and terrain(px-1,py)<=21
inc gemsc
endif
terrain(px,py)=0
dec px
disable=1
terrain(px,py)=400
endif
endif
gosub droprocks
endif
if upkey()=1 then dir=2
if downkey()=1 then dir=1
if leftkey()=1 then dir=4
if rightkey()=1 then dir=3
REM FPS Display - remove from final
REM Handling timer to slow the player down.
if disable=1 then inc wait,1
if wait=8 then disable=0:wait=0
REM ---------------------------------------
if scancode() = 14
if music playing(m) = 1 then stop music m
m = 4
play music m
gosub ClearRocks
Check2 = 1
State = 1
return
endif
if spacekey()
gosub ClearRocks
gosub LoadFile
return
endif
if returnkey()
gosub ClearRocks
filename$=FileIO(2)
gosub LoadFile
return
endif
if gemsc=gemst
cls 0
set text size 40
ink c1,0 : center text MenuX,40,"Stage Cleared"
sync
wait 1000
gosub ClearRocks
filename$=FileIO(2)
gosub LoadFile
return
endif
redraw()
return
ClearRocks:
REM Clear Rocks
for lpy = 0 to 3
for lpx = 0 to 200
rocks(lpx,lpy) = 0
next lpx
next lpy
return
droprocks:
rock=1
repeat
dropped=0
repeat
if rocks(rock,2)+1<14
pos=terrain(rocks(rock,1),rocks(rock,2)+1)
if rocks(rock,1)=px and rocks(rock,2)+1=py and rocks(rock,3)=1 then goto death
select pos
case 0
terrain(rocks(rock,1),rocks(rock,2))=0
terrain(rocks(rock,1),rocks(rock,2)+1)=22
rocks(rock,2)=rocks(rock,2)+1
rocks(rock,3)=1
dropped=1
redraw()
sync
endcase
case 22
if rocks(rock,3)=1
fdir=direction(rock)
if fdir=0
inc rock
rocks(rock,3)=0
else
if fdir=5 and rocks(rock,3)=1 then gosub death
terrain(rocks(rock,1),rocks(rock,2))=0
terrain(rocks(rock,1)+fdir,rocks(rock,2)+1)=22
rocks(rock,1)=rocks(rock,1)+fdir
rocks(rock,2)=rocks(rock,2)+1
dropped=1
endif
else
inc rock
endif
endcase
case default
rocks(rock,3)=0
inc rock
endcase
else
inc rock
endif
endselect
until rock=ttlrocks+1
redraw()
sync
cls
for i=1 to rock
rocks(i,3)=0
next i
rock=1
until dropped=0
return
death:
r=255
g=255
b=255
for i=1 to 127
dec r : dec g : dec b
set gamma r,g,b
next i
sprite 65535,320,0,65535
y=0
for i=1 to 120
sprite 65535,320-(sprite width(65535)/2),y,65535
inc y
sync
next i
wait key
set gamma 255,255,255
delete sprite 65535
undim terrain(14,14)
dim terrain(14,14)
gosub ClearRocks
filename$=FileIO(2)
gosub LoadFile
return
LoadFile:
if music playing(m) then stop music m
ttlrocks=0
gemst=0
gemsc=0
px=0
py=0
open to read 1,filename$
for i=0 to 14
for j=0 to 14
terrain(i,j)=22
next j
next i
for y=0 to 13
read string 1,string$
for x=0 to 13
select lower$(mid$(string$,x+1))
case "x" : terrain(x,y)=rnd(14)+1 : endcase
case "z" : terrain(x,y)=rnd(2)+30 : endcase
case "o" : terrain(x,y)=rnd(5)+16 : inc gemst,1 : endcase
case "s" : terrain(x,y)=400 : px=x : py=y : endcase
case "r" : terrain(x,y)=22 : inc ttlrocks : rocks(ttlrocks,1)=x : rocks(ttlrocks,2)=y : endcase
endselect
next x
next y
close file 1
return
REM ------------------------------------------------------------------------
REM Level Editor
State4:
if Check4 = 0
Check4 = 1
if music playing(m) then stop music m
load music "Music/themeb.mid",5
cls 0
show mouse
dim terrain_editor(14,14)
ink rgb(100,100,100),0
for r=1 to 15
z=rnd(r)
ink rgb(z+100,z+100,z+100),0
circle 16,16,r
next r
get image 1,0,0,32,32
cls
ink rgb(69,60,35),0 : box 0,0,32,32
get image 2,0,0,32,32
cls
ink rgb(255,255,255),0 : box 0,0,32,32
ink rgb(20,20,20),0 : box 1,1,31,31
get image 3,0,0,32,32
cls
ink rgb(144,19,119),0 : box 0,0,32,32
get image 4,0,0,32,32
cls
ink rgb(50,30,40),0 : box 0,0,32,32
for brick=1 to 32 step 5
for y=1 to 32 step 2
ink rgb(140,120,120),0
box brick-1,y-1,brick,y
next y
next brick
get image 5,0,0,32,32
for x=0 to 13
for y=0 to 13
paste image 3,x*32,y*32
next y
next x
set text opaque
ink rgb(255,255,255),0
line 448,0,448,448
line 0,448,448,448
ink rgb(255,255,255),0
set text size 15
set text font "System"
text 490,200,"Selection"
set text font "Arial"
set text size 15
set text to bold
center text 520,20,"DarkNOOB"
ink rgb(50,50,50),0
center text 520,50,"Level Editor"
ink rgb(200,70,20),0
box 570,80,630,100
ink rgb(100,35,10),rgb(200,70,20)
center text 600,80,"Menu"
ink rgb(0,100,0),0 : box 500,400,639,479
ink rgb(200,100,50),0 : box 505,405,634,474
set text size 10
ink rgb(100,100,100),rgb(200,100,50) : center text (500+screen width())/2,380,"_________"
ink rgb(150,20,105),rgb(200,100,50) : center text (500+screen width())/2,380,"Instructions"
set text to normal : ink rgb(150,25,20),rgb(200,100,50)
center text (500+screen width())/2,410,"Left Click "
center text (500+screen width())/2,425,"to select terrain."
center text (500+screen width())/2,440,"Left Click "
center text (500+screen width())/2,455,"to place terrain. "
set text font "System"
set text size 20
set text to normal
set text opaque
get image 65527,0,0,640,480
endif
REM Draws background
paste image 65527,0,0
REM Draws Map
redrawit()
REM Mouse Input
mx = mousex()
my = mousey()
mc = mouseclick()
px=mousex()/32*32
py=mousey()/32*32
if px>416 then px=416
if py>416 then py=416
REM Click on menu
if mx>570 & mx<630 & my>80 & my<100 & mc = 1 then gosub Menu
REM Draw selectable Tiles
ink rgb(100,100,100),0
if select=1 then paste image 1,490,120:text 530,120,"Rock "
if select=2 then paste image 2,490,120:text 530,120,"Dirt "
if select=4 then paste image 4,490,120:text 530,120,"Gem "
if select=5 then paste image 5,490,120:text 530,120,"Wall "
if buttonz(500,238,1,1,"Rock")=1 then select=1
if buttonz(500,272,2,2,"Dirt")=2 then select=2
if buttonz(500,306,4,4,"Gem")=4 then select=4
if buttonz(500,340,5,5,"Wall")=5 then select=5
REM Place Tile
if mc=1 & mx<448 & select>0 then paste image select,px,py
if mc=1 & mx<448 & select>0 then terrain_editor(px/32,py/32)=select
return
Menu:
ink rgb(100,100,140),0:box 0,0,200,350
for rand=1 to 200
for y=1 to 350
z=rnd(3)
k=rnd(100)
ink rgb(k,k,k),0
if z=1 then box rand-1,y-1,rand,y
next y
next rand
ink rgb(255,255,255),0
box 44,144,156,166
box 44,194,156,216
box 44,244,156,266
box 44,294,156,316
ink rgb(100,100,140),0
box 45,145,155,165
box 45,195,155,215
box 45,245,155,265
box 45,295,155,315
ink rgb(125,50,0),rgb(100,100,140)
set text to bold
set text font "Arial"
set text size 10
center text 100,150,"Save"
center text 100,200,"Load"
center text 100,250,"Return to Editor"
center text 100,300,"Go to main menu"
ink rgb(255,255,255),0
set text size 10
center text 100,50,"Menu"
do
mx = mousex()
my = mousey()
mc = mouseclick()
if mc=1 & mx>44 & mx<155
if my>144 & my<166 then gosub Save:return
if my>194 & my<216 then gosub Load:return
if my>244 & my<266 then return
if my>294 & my<316
if music playing(5) = 1 then stop music 5
play music 4
State = 1
return
endif
endif
sync
loop
return
Load:
filename$ = FileIO(0)
open to read 1,filename$
for i=0 to 14
for j=0 to 14
terrain(i,j)=22
next j
next i
for y=0 to 13
read string 1,string$
for x=0 to 13
select lower$(mid$(string$,x+1))
case "x" : terrain_editor(x,y)=2 : endcase
case "z" : terrain_editor(x,y)=5 : endcase
case "o" : terrain_editor(x,y)=4 : endcase
case "s" : terrain_editor(x,y)=3 : px=x : py=y : endcase
case "r" : terrain_editor(x,y)=1 : endcase
endselect
next x
next y
close file 1
return
Save:
Name$ = FileIO(1)
if file exist(Name$)=0 then delete file Name$
open to write 1,Name$
for y=0 to 14
for x=0 to 14
select terrain_editor(x,y)
case 2 : line$=line$+"x" : endcase
case 5 : line$=line$+"z" : endcase
case 4 : line$=line$+"o" : endcase
case 1 : line$=line$+"r" : endcase
case default : line$=line$+"x" : endcase
endselect
next x
write string 1,line$
line$=""
next y
close file 1
return
function MessageBox(x1,y1,x2,y2,Titletext$,Message$,Buttons$)
rem Find out how many bottons there are by searching for semicolons
semicolons=0
for i=1 to len(Buttons$)
if mid$(Buttons$,i)=";" then semicolons=semicolons+1
next i
buttons=semicolons+1
rem Make Button arrays
dim buttontext$(buttons)
dim buttonx1(buttons)
dim buttony1(buttons)
dim buttonx2(buttons)
dim buttony2(buttons)
dim buttonpress(buttons)
rem Find Button Name$,x1,y1,x2,y2 from button string
stage=1
word$=""
button=1
for i=1 to len(Buttons$)
character$=mid$(Buttons$,i)
if character$=";" or character$=","
if stage=1 then buttontext$(button)=word$
if stage=2 then buttonx1(button)=val(word$)
if stage=3 then buttony1(button)=val(word$)
if stage=4 then buttonx2(button)=val(word$)
if stage=5 then buttony2(button)=val(word$)
stage=stage+1
if stage=6 then stage=1
if character$=";" then button=button+1
word$=""
else
word$=word$+character$
endif
next i
buttony2(button)=val(word$)
rem Copy base Rock Texture Array to tempArray
gridwidth=x2-x1
gridheight=y2-y1
minvalue=0
dim grid2(gridwidth+20,gridheight+20)
for x=1 to gridwidth+20
for y=1 to gridheight+20
grid2(x,y)=grid(x,y)
next y
next x
rem Darken areas for buttons
for i=1 to buttons
for x=((buttonx1(i)-x1)+21) to ((buttonx2(i)-x1)+19)
for y=((buttony1(i)-y1)+21) to ((buttony2(i)-y1)+19)
gv#=grid2(x,y)
gv#=gv#+(minvalue-gv#)/5
grid2(x,y)=gv#
if grid2(x,y)<minvalue then grid2(x,y)=minvalue
next y
next x
next i
rem Wrap Text
dim line$(100000)
maxtextwidth=(x2-x1)-10
maxlinesize=maxtextwidth/7
thislinemaxsize=maxlinesize
word$=""
linesize=0
lineon=1
bytesread=0
charaters=len(message$)
charon=1
rem Wrap Text Loop
repeat
rem Get Ascii of current character
ascii=asc(mid$(message$,charon))
charon=charon+1
if chr$(ascii)<>" " and ascii<>91 and ascii<>42 and ascii<>9
rem Add character to word
word$=word$+chr$(ascii)
wordthisline=1
linesize=linesize+1
wordsize=len(word$)
rem If the line size is more than the maximum line size
if linesize>=maxlinesize
if len(word$)=thislinemaxsize
line$(lineon)=line$(lineon)+left$(word$,thislinemaxsize-len(line$(lineon)))
lineon=lineon+1
thislinemaxsize=maxlinesize
word$=""
linesize=0
wordthisline=0
else
lineon=lineon+1
thislinemaxsize=maxlinesize
linesize=len(word$)
wordthisline=1
endif
endif
else
rem Check to see if it should go to next line
if ascii=91 then entera=1
if ascii=42 and entera=1
if linesize>maxlinesize
lineon=lineon+1
linesize=0
wordthisline=0
endif
line$(lineon)=line$(lineon)+word$
lineon=lineon+1
thislinemaxsize=maxlinesize
word$=""
linesize=0
wordthisline=0
else
rem Handle a space
linefullofspaces=0
if wordthisline=0
thislinemaxsize=thislinemaxsize-1
if thislinemaxsize=0
linefullofspaces=1
endif
endif
linesize=linesize+1
if linesize>maxlinesize and word$<>""
lineon=lineon+1
thislinemaxsize=maxlinesize
linesize=len(word$)
wordthisline=1
endif
if linefullofspaces=1
line$(lineon)=line$(lineon)+" "
lineon=lineon+1
thislinemaxsize=maxlinesize
linesize=0
else
line$(lineon)=line$(lineon)+word$+" "
endif
word$=""
endif
if ascii<>91 then entera=0
endif
rem If loop is about to end then wrap the final word
if charon>charaters
linesize=linesize+1
if linesize>maxlinesize
lineon=lineon+1
thislinemaxsize=maxlinesize
linesize=len(word$)
wordthisline=1
endif
line$(lineon)=line$(lineon)+word$+" "
word$=""
endif
until charon>charaters
set text font "courier new"
rem Draw the Texture to the screen and get the image
for x=20 to gridwidth+20
for y=20 to gridheight+20
gridvalue=grid2(x,y)
gv#=gridvalue
if y<45
g#=gv#/180*130
ink rgb(gv#*1.2,g#*1.2,0),0
else
rg#=gv#/100*90
ink rgb(rg#*1.2,rg#*1.2,gv#*1.2),0
endif
dot (x-20)+x1,(y-20)+y1
next y
next x
get image 6999,x1,y1,x2,y2
rem Draw each button's text and get the image
set text size 18
for j=1 to buttons
bx1=buttonx1(j)
by1=buttony1(j)
bx2=buttonx2(j)
by2=buttony2(j)
ink rgb(96,96,108),0
center text ((bx2-bx1)/2)+bx1-1,((by2-by1)/2)+by1-11,buttontext$(j)
ink rgb(120,120,138),0
center text ((bx2-bx1)/2)+bx1+1,((by2-by1)/2)+by1-9,buttontext$(j)
ink rgb(36,36,36),0
center text ((bx2-bx1)/2)+bx1,((by2-by1)/2)+by1-10,buttontext$(j)
get image 6999+j,bx1,by1,bx2-1,by2-1
next j
buttonpressed=0
rem Message Box loop
while buttonpressed=0
cls
rem check to see if any button is being pressed
if mouseclick()=1
for j=1 to buttons
bx1=buttonx1(j)
by1=buttony1(j)
bx2=buttonx2(j)
by2=buttony2(j)
rem If it is pressed, store it in an array
if mousex()>bx1 and mousey()>by1 and mousex()<bx2 and mousey()<by2 then buttonpress(j)=1 else buttonpress(j)=0
next j
else
for j=1 to buttons
bx1=buttonx1(j)
by1=buttony1(j)
bx2=buttonx2(j)
by2=buttony2(j)
rem Check if button was previously pressed and then mouse is not clicked and the mouse is still inside the button
if mousex()>bx1 and mousey()>by1 and mousex()<bx2 and mousey()<by2 and buttonpress(j)=1
buttonpressed=1
buttonstring$=buttontext$(j)
endif
rem Reset the press array to 0
buttonpress(j)=0
next j
endif
rem Paste the Background Textue
paste image 6999,x1,y1
set text to bold
rem Draw the Title Text
set text size 20
ink rgb(96,48,0),0
text x1+4,y1+2,Titletext$
ink rgb(132,72,0),0
text x1+6,y1+4,Titletext$
ink rgb(36,12,0),0
text x1+5,y1+3,Titletext$
set text to normal
rem Draw the wrapped message
set text size 15
for i=1 to lineon
ink rgb(96,96,108),0
text x1+4,y1+14+i*15,line$(i)
ink rgb(120,120,138),0
text x1+6,y1+16+i*15,line$(i)
ink rgb(36,36,36),0
text x1+5,y1+15+i*15,line$(i)
next i
rem Draw each button
set text size 18
for j=1 to buttons
bx1=buttonx1(j)
by1=buttony1(j)
bx2=buttonx2(j)
by2=buttony2(j)
pressed=buttonpress(j)
rem Paste Background for button
paste image 6999+j,bx1+pressed,by1+pressed
rem Draw button sides
if pressed=0 then ink rgb(120,120,138),0 else ink rgb(96,96,108),0
for i=1 to 2
line bx1+i,by1+i,bx2-i,by1+i
line bx1+i,by1+i,bx1+i,by2-i
next i
if pressed=0 then ink rgb(96,96,108),0 else ink rgb(120,120,138),0
for i=1 to 2
line bx2-i,by1+i,bx2-i,by2-i
line bx1+i,by2-i,bx2-i,by2-i
next i
next j
sync
endwhile
rem Delete Function Arrays
undim line$(10000)
undim grid2(1,1)
set text size 18
endfunction buttonstring$
function redrawit()
for x = 0 to 13
for y = 0 to 13
if terrain_editor(x,y) > 0
paste image terrain_editor(x,y),x*32,y*32
endif
next y
next x
endfunction
function buttonz(x,y,image,num,b$)
pressed=0
push=0
if mousex()>x and mousex()<x+32 and mousey()>y and mousey()<y+32
pressed=num
ink rgb(100,100,50),0
box x-1,y-1,x+32,y+32
endif
paste image image,x,y
if pressed=num and mouseclick()=1
ink rgb(255,255,255),0
box x-1,y-1,x+32,y+32
push=num
endif
if pressed=num
ink rgb(100,100,100),0
box x-1,y-1,x+32,y+32
endif
if pressed=0
ink rgb(0,0,0),0
box x-1,y-1,x+32,y+32
endif
paste image image,x,y
text x+40,y,b$
if mouseclick()=1 and pressed=num
ink rgb(100,100,100),0
box x,y,x+32,y+32
endif
set text size 18
endfunction push
rem -----------------FUNCTIONS--------------------
`This will determine which direction a rock will fall when it hits
`another object
function direction(rock)
`resets the flag
fflag=0
`checks to see if the spot below and to the left is open. If it is,
`set the flag to 1 and the direction variable (d) to -1
if terrain(rocks(rock,1)-1,rocks(rock,2))=0
if terrain(rocks(rock,1)-1,rocks(rock,2)+1)=0
d=-1
fflag=1
endif
endif
`ditto but for the right
`returns a direction of 1, so that it will go to the right
if terrain(rocks(rock,1)+1,rocks(rock,2))=0
if terrain(rocks(rock,1)+1,rocks(rock,2)+1)=0
d=1
fflag=1
endif
endif
if terrain(rocks(rock,1)+d,rocks(rock,2)+1)=5
d=5
fflag=1
endif
`if neither the left nor the right is open, return 0
if fflag=0
d=0
endif
endfunction d
function redraw()
paste image 65534,0,0
for y = 0 to 13
for x = 0 to 13
if terrain(x,y)<>400 and terrain(x,y)>0 then paste image terrain(x,y),offset(1)+x*32,offset(2)+y*32
if terrain(x,y)=0 then ink 0,0:box offset(1)+x*32,offset(2)+y*32,offset(1)+x*32+31,offset(2)+y*32+31:ink rgb(255,255,255),0
if terrain(x,y)=400 then paste image gframe(1),offset(1)+x*32,offset(2)+y*32
next x
next y
endfunction
function RockBox(x1,y1,x2,y2,noise)
rem Calculate Difference between corners
xdiff=x2-x1
ydiff=y2-y1
if noise>100 then noise=100
rem Draw Texture
for x=20 to xdiff+20
for y=20 to ydiff+20
rem Determine colour based on gridvalue()
gridvalue=grid(x,y)
gv#=gridvalue
if noise>0
multiply#=rnd(noise)+100-(noise/2)
multiply#=multiply#/100
else
multiply#=1
endif
rg#=gv#/100*90
ink rgb(rg#*1.2*multiply#,rg#*1.2*multiply#,gv#*1.2*multiply#),0
dot (x-20)+x1,(y-20)+y1
next y
next x
sync
endfunction
function nextimg(a,b,c,d,current)
if current=1 then frame=b
if current=2 then frame=c
if current=3 then frame=d
if current=4 then frame=a
endfunction frame
