Thanks BN2.
THE LEVEL EDITOR SAVING IS COMPLETE!!!!!
It works perfectly!
I'll be putting loading in next.
+
Any changes anybody wants to do to my editor, go ahead.
Next, we need to put Nano's GUI into the game screen. (We need the code for the ingame GUI you showed us 1 or 2 pages back Nano.)
You can put it in yourself, or I, or another member, will do it gladly.
After that is complete, the game levels need to be saved. I'm no expert on that. BN2, your load screen is fine, it just needs to be larger, so more text can fit in.
I think that's everything. Other touches I'll put in. If you make any changes, BE SURE TO POST THEM AS SOON AS POSSIBLE. Otherwise, it will be hard to incorporate in, if someone else made big changes.
We are so close to being finished with our final project.
ALSO:
The guy doesn't get squished! All you have to do is detect the guy getting squished. Just have it print "PLAYER HIT" or something, and I'll put it to the game over screen.
If you can't think of anything better to do, think of what the next project will be. We should allow a one week period, that which we shall advertise for us, so we can get some members.
We should post the finished project in the Program Announcements forum part, for some great publicity.
As always, make sure to post everything!
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
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
rem - end of the anim if you will-
rem makes the darkNOOB in a grey text, and fades it out.
fadeout=255
set text size 200
ink rgb(100,100,100),0
center text 320,240,"DarkNOOB"
wait 1000
ink rgb(155,0,0),0
center text 320,100,"Games"
`wait 100
stop music 2
repeat
set gamma fadeout,fadeout,fadeout
dec fadeout,1
until fadeout=0
cls
rem Resetting.
set text size 20
set gamma 255,255,255
set text font "system"
cls
rem MainMenu Program Section
rem Setting Up
sync on:sync rate 0:hide mouse
ink rgb(255,255,255),0
center text 320,240,"Loading please wait..."
wait 1
sync
load music "Music/themea.mid",1
remake:
hide mouse
cls
rem Making the arrow
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
rem Getting the arrow
get image 100,0,0,100,40
cls
rem This makes the background pattern for y=1 to 100 step 1
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
cls
rem Setting the default Brightness
bright=255
rem Reset allows this Menu area to be returned to.
reset:
hide mouse
r=0
x=0
y=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 Making the Onscreen text.
set text font "arabic_charset"
set text size 60
ink rgb(255,255,255),0
center text (screen width()/2)+1,100,"Furious Pickaxe"
ink rgb(155,155,155),0
center text screen width()/2,100,"Furious Pickaxe"
set text size 40
ink rgb(255,255,255),0
center text screen width()/2,230,"Play"
ink rgb(100,100,100),0
center text screen width()/2,229,"Play"
ink rgb(255,255,255),0
center text screen width()/2,280,"Extras"
ink rgb(100,100,100),0
center text screen width()/2,278,"Extras"
ink rgb(255,255,255),0
center text screen width()/2,330,"Exit"
ink rgb(80,80,80),0
center text screen width()/2,328,"Exit"
rem Making the 'sun'
repeat
inc r,1
ink rgb(5*r,5*r,0),0
circle -55,0,r
until r=100
rem Setting Values
y=230
x#=screen width()/1.6
play music 1
loop music 1
do
sprite 100,x#,y+area,100
sprite 101,x#,y+1+area,100
sprite 102,x#,y+2+area,100
if downkey()=1 and y<325 and pause=0 then inc y,58:pause=1
if upkey()=1 and y>230 and pause=0 then dec y,58:pause=1
rem Timer.
if pause>=1 then inc pause,1
if pause=40 then pause=0
rem Makes the moving arrow animation.
if round=1 then inc x#,extra#/7
if round=1 then extra#=extra#+.01
if extra#>=1 and round=1 then extra#=0:round=0
if round=0 then dec x#,extra#/7
if round=0 then extra#=extra#+.01
if extra#>=1 and round=0 then extra#=0:round=1
rem Dims and Goes to the menu selection
if spacekey()=1 or returnkey()=1
fade=bright
repeat
dec fade,1
set gamma fade*1.1,fade*1.1,fade*1.1
wait 5
until fade=0
if y=230 then gosub play
if y=288 then gosub extras
if y=346 then gosub exit
endif
if y=288 then area=2
if y=230 then area=10
if y=346 then area=-4
wait 1
sync
loop
extras:
cls
delete sprite 100
delete sprite 101
delete sprite 102
set gamma bright,bright,bright
rem Re-texture
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 Making the selections
set text size 60
ink rgb(255,255,255),0
center text screen width()/2,40,"Extras"
ink rgb(155,155,155),0
center text screen width()/2+1,42,"Extras"
set text size 40
ink rgb(255,255,255),0
center text screen width()/2,180,"Level Editor"
ink rgb(155,155,155),0
center text screen width()/2+1,180,"Level Editor"
ink rgb(255,255,255),0
center text screen width()/2,240,"Credits"
ink rgb(155,155,155),0
center text screen width()/2+1,241,"Credits"
ink rgb(255,255,255),0
center text screen width()/2,300,"Instructions"
ink rgb(155,155,155),0
center text screen width()/2+1,301,"Instructions"
ink rgb(255,255,255),0
center text screen width()/2,360,"System"
ink rgb(155,155,155),0
center text screen width()/2+1,361,"System"
rem Setting Values
y=300
x#=screen width()/2+100
do
sprite 100,x#,y+10,100
sprite 101,x#,y+11,100
sprite 102,x#,y+12,100
if downkey()=1 and y<360 and pause=0 then inc y,60:pause=1
if upkey()=1 and y>180 and pause=0 then dec y,60:pause=1
if spacekey()=1 or returnkey()=1
fade=bright
repeat
dec fade,1
set gamma fade*1.1,fade*1.1,fade*1.1
wait 5
until fade=0
if y=300 then gosub Instructions
if y=240 then gosub Credits
if y=360 then gosub System
if y=180 then gosub Level_Editor
endif
if pause>=1 then inc pause,1
if pause=40 then pause=0
if round=1 then inc x#,extra#/7
if round=1 then extra#=extra#+.01
if extra#>=1 and round=1 then extra#=0:round=0
if round=0 then dec x#,extra#/7
if round=0 then extra#=extra#+.01
if extra#>=1 and round=0 then extra#=0:round=1
if scancode()=14 then gosub reset
wait 1
sync
loop
wait key
gosub reset
end
exit:
delete sprite 100
delete sprite 101
delete sprite 102
set gamma bright,bright,bright
cls
end
Instructions:
delete sprite 100
delete sprite 101
delete sprite 102
set gamma bright,bright,bright
cls
rem Re-texture
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
set text size 60
ink rgb(100,100,100),0
center text screen width()/2,10,"Instructions"
set text size 20
ink rgb(200,200,200),0
center text screen width()/2,100,"Dig the ground to get gems!"
center text screen width()/2,120,"Collect as many as possible."
center text screen width()/2,140,"But be forwarned! Don't dig underneath rocks!"
center text screen width()/2,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 rgb(100,100,100),0
center text screen width()/2,220,"Menu Instructions"
ink rgb(200,200,200),0
set text size 18
center text screen width()/2,300,"Use up and down keys to move cursor. Enter or spacebar is to select, backspace is to go back."
wait key
gosub extras
cls
end
Credits:
delete sprite 100
delete sprite 101
delete sprite 102
cls
set text size 60
rem Making the Credits. Changes will be made.
ink rgb(100,100,0),0
center text screen width()/2,40,"Credits"
ink rgb(200,100,0),0
set text size 20
center text screen width()/2,100,"Program Manager and Designer: BN2 Productions"
ink rgb(210,80,0),0
center text screen width()/2,150,"Music and Images: Sinisterstuf"
ink rgb(220,60,0),0
center text screen width()/2,200,"Rock Control: Sinani201"
ink rgb(230,40,0),0
center text screen width()/2,250,"Menu, Partial Ingame Design, and Level Editor Maker: Irojo"
ink rgb(240,20,10),0
center text screen width()/2,300,"Textures: NanoGamez Guy"
ink rgb(250,40,30),0
set text size 17
center text screen width()/2,350,"Thanks Also to OBese87 , Latch, TDK, and many others not mentioned."
for fadein=1 to bright
set gamma fadein,fadein,fadein
wait 1
next fadein
wait key
gosub extras
cls
end
System:
set text to normal
cls
delete sprite 100
delete sprite 101
delete sprite 102
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
set text size 60
ink rgb(255,255,255),0
center text screen width()/2,40,"System"
ink rgb(100,100,100),0
center text screen width()/2+1,42,"System"
set text size 40
ink rgb(255,255,255),0
center text screen width()/2,240,"Brightness"
ink rgb(100,100,100),0
center text screen width()/2,241,"Brightness"
set gamma bright,bright,bright
y=255
do
sprite 100,x#,y-1,100
sprite 101,x#,y,100
sprite 102,x#,y+1,100
` if downkey()=1 and pause=0 then inc y,60:pause=1
` if upkey()=1 and pause=0 then dec y,60:pause=1
if spacekey()=1 or returnkey()=1
if y=255 then gosub Brightness
endif
if pause>=1 then inc pause,1
if pause=40 then pause=0
if round=1 then inc x#,extra#/7
if round=1 then extra#=extra#+.01
if extra#>=1 and round=1 then extra#=0:round=0
if round=0 then dec x#,extra#/7
if round=0 then extra#=extra#+.01
if extra#>=1 and round=0 then extra#=0:round=1
if scancode()=14 then wait 150:gosub extras
wait 1
sync
loop
end
Brightness:
show mouse
delete sprite 100
delete sprite 101
delete sprite 102
set gamma bright,bright,bright
sync on:sync rate 0
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
x=0
y=0
paste image 10,x,y
ink rgb(255,0,0),0
box x,y,x+150,y+15
ink rgb(255,255,255),0
set text size 15
set text to bold
set text font "Arial"
center text x+75,y,"Brightness"
set text to normal
set text font "Times New Roman"
center text x+75,y+25,"Use the arrow keys to control"
get image 11,0,0,150,150
cls
set text font "system"
set text to bold
text 0,0,"|"
get image 12,0,0,10,20
cls
text 0,0,"_______"
get image 13,0,0,50,20
x3=50
cls
`-------------------------------------------------------------
x111=320
y111=240
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
set text font "arabic_charset"
set text size 60
ink rgb(255,255,255),0
center text screen width()/2,40,"System"
ink rgb(100,100,100),0
center text screen width()/2+1,42,"System"
x333=50
set sprite 11,1,0
do
sprite 11,x111,y111,11
sprite 12,x222,y222+50,12
sprite 13,x111+51,y222+45,13
if rightkey()=1 and timedwait=0 and x333<50 then inc x333,1:timedwait=1
if leftkey()=1 and timedwait=0 and x333>0 then dec x333,1:timedwait=1
x222=x111+50+x333
y222=y111
if mouseclick()=1
x111=mousex():y111=mousey()
endif
if timedwait>=1 and timedwait<10 then inc timedwait,1 else timedwait=0
x4444=x222+x111
if x333+x333<255 then set gamma rrrr+x333+x333+155,rrrr+x333+x333+155,rrrr+x333+x333+155
if returnkey()=1 or spacekey()=1 or controlkey()=1 or scancode()=14 then exit
sync
loop
delete sprite 11
delete sprite 12
delete sprite 13
y111=0
y222=0
bright=rrrr+x333+x333+155
wait 1000
hide mouse
delete image 12
delete image 11
delete image 10
delete image 13
set text font "arabic_charset"
gosub System
return
play:
set text font "Arial"
set text size 12
cls
delete sprite 100
delete sprite 101
delete sprite 102
set gamma bright,bright,bright
REM GAME CODE!---------------------------------------------------------------
gemst=0
randomize timer()
sync on:sync rate 0
REM Create an array
dim terrain(14,14)
dim offset(2)
dim rocks(200,3)
offset(1)=100
offset(2)=10
dir=1
current=1
load music "Music/Jeopardy Theme.mp3",32
play music 32
rem Image List
rem 1 Ground Variation
rem 2 Ground Variation
rem 3 Ground Variation
rem 4 Ground Variation
rem 5 Ground Variation
rem 6 Ground Variation
rem 7 Ground Variation
rem 8 Ground Variation
rem 9 Ground Variation
rem 10 Ground Variation
rem 11 Ground Variation
rem 12 Ground Variation
rem 13 Ground Variation
rem 14 Ground Variation
rem 15 Ground Variation
rem 16 Gem Variation
rem 17 Gem Variation
rem 18 Gem Variation
rem 19 Gem Variation
rem 20 Gem Variation
rem 21 Gem Variation
rem 22 Rock Variation
rem 23 Rock Variation
rem 24 Rock Variation
rem 25 Rock Variation
rem 26 Rock Variation
rem 27 Rock Variation
rem 28 Rock Variation
rem 29 Rock Variation
rem 30 Wall Variation
rem 31 Wall Variation
rem 32 Wall Variation
rem 33 Player Down 1
rem 34 Player Down 2
rem 35 Player Down 3
rem 36 Player Up 1
rem 37 Player Up 2
rem 38 Player Up 3
rem 39 Player Right 1
rem 40 Player Right 2
rem 41 Player Right 3
rem 42 Player Left 1
rem 43 Player Left 2
rem 44 Player Left 3
rem ---------------------------------
rem Music List
rem 1 Boss
rem 2 Boss Rock
rem 3 Credits
rem 4 Theme A
rem 5 Theme B
rem Specify Array Size
gridwidth=400
gridheight=40
rem Make Array
dim grid(gridwidth+20,gridheight+20)
rem Specify rock peramiters
startvalue=50
maxvalue=100
minvalue=0
variation=50
if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue)
rem Fill Array
for x=1 to gridwidth+20
for y=1 to gridheight+20
grid(x,y)=startvalue
next y
next x
rem Make Random Points
for i=1 to (gridwidth+20)*(gridheight+20)/10
feild=abs(maxvalue-minvalue)
x=rnd(gridwidth)
y=rnd(gridheight)
value=rnd(feild)
grid(x,y)=value
next i
rem For Loops to Generate Texture
for x=1 to gridwidth+20
for y=1 to gridheight+20
rem Get surrounding pixels
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
rem Get average of other points
if otherpoints>0
o#=otherpoints
t#=totalofothers
average#=t#/o#
else
average#=startvalue
endif
rem Assaing the point in the array based on the average plus a variation
gridvalue=average#+(rnd(variation)-(variation/2))
if gridvalue<minvalue then gridvalue=minvalue
if gridvalue>maxvalue then gridvalue=maxvalue
grid(x,y)=gridvalue
next y
next x
rem Soften Noise
for x=1 to gridwidth+20
for y=1 to gridheight+20
gv#=grid(x,y)
gv#=gv#+(maxvalue-gv#)/2
grid(x,y)=gv#
if grid(x,y)>maxvalue then grid(x,y)=maxvalue
next y
next x
cls
ink rgb(155,0,0),0
hide mouse
center text 320,140,"Loading..."
ink rgb(0,55,0),0
box 169,239,471,281
ink rgb(0,0,0),0
box 170,240,470,280
rem Set amount of noise
noise=0
ink rgb(255,255,255),0
RockBox(170,240,175,280,noise)
rem Ground
load image "Ground/ground01.png",1
RockBox(170,240,180,280,noise)
load image "Ground/ground02.png",2
RockBox(170,240,185,280,noise)
load image "Ground/ground03.png",3
RockBox(170,240,190,280,noise)
load image "Ground/ground04.png",4
RockBox(170,240,195,280,noise)
load image "Ground/ground05.png",5
RockBox(170,240,200,280,noise)
load image "Ground/ground06.png",6
RockBox(170,240,205,280,noise)
load image "Ground/ground07.png",7
RockBox(170,240,210,280,noise)
load image "Ground/ground08.png",8
RockBox(170,240,215,280,noise)
load image "Ground/ground09.png",9
RockBox(170,240,220,280,noise)
load image "Ground/ground10.png",10
RockBox(170,240,225,280,noise)
load image "Ground/ground11.png",11
RockBox(170,240,230,280,noise)
load image "Ground/ground12.png",12
RockBox(170,240,235,280,noise)
load image "Ground/ground13.png",13
RockBox(170,240,240,280,noise)
load image "Ground/ground14.png",14
RockBox(170,240,245,280,noise)
load image "Ground/ground15.png",15
rem Music
RockBox(170,240,255,280,noise)
load music "Music/Boss.mid",1
RockBox(170,240,255,280,noise)
load music "Music/Boss (Rock Version).mid",2
RockBox(170,240,265,280,noise)
load music "Music/credits.mid",3
RockBox(170,240,275,280,noise)
load music "Music/themeA.mid",4
RockBox(170,240,285,280,noise)
load music "Music/themeB.mid",5
RockBox(170,240,295,280,noise)
rem Gems
load image "Jems/jem1.png",16
RockBox(170,240,300,280,noise)
load image "Jems/jem2.png",17
RockBox(170,240,305,280,noise)
load image "Jems/jem3.png",18
RockBox(170,240,310,280,noise)
load image "Jems/jem4.png",19
RockBox(170,240,315,280,noise)
load image "Jems/jem5.png",20
RockBox(170,240,320,280,noise)
load image "Jems/jem6.png",21
RockBox(170,240,325,280,noise)
rem Rocks
load image "Rocks/rock1.png",22
RockBox(170,240,330,280,noise)
load image "Rocks/rock2.png",23
RockBox(170,240,335,280,noise)
load image "Rocks/rock3.png",24
RockBox(170,240,340,280,noise)
load image "Rocks/rock4.png",25
RockBox(170,240,345,280,noise)
load image "Rocks/rock5.png",26
RockBox(170,240,350,280,noise)
load image "Rocks/rock6.png",27
RockBox(170,240,355,280,noise)
load image "Rocks/rock7.png",28
RockBox(170,240,360,280,noise)
load image "Rocks/rock8.png",29
RockBox(170,240,370,280,noise)
rem Walls
load image "Walls/wall1.png",30
RockBox(170,240,375,280,noise)
load image "Walls/wall2.png",31
RockBox(170,240,380,280,noise)
load image "Walls/wall3.png",32
rem Player
load image "Player/down1.png",33
RockBox(170,240,385,280,noise)
load image "Player/down2.png",34
RockBox(170,240,390,280,noise)
load image "Player/down3.png",35
RockBox(170,240,400,280,noise)
load image "Player/up1.png",36
RockBox(170,240,410,280,noise)
load image "Player/up2.png",37
RockBox(170,240,415,280,noise)
load image "Player/up3.png",38
RockBox(170,240,420,280,noise)
load image "Player/right1.png",39
RockBox(170,240,430,280,noise)
load image "Player/right2.png",40
RockBox(170,240,440,280,noise)
load image "Player/right3.png",41
RockBox(170,240,450,280,noise)
load image "Player/left1.png",42
RockBox(170,240,460,280,noise)
load image "Player/left2.png",43
RockBox(170,240,470,280,noise)
load image "Player/left3.png",44
sync
px=1:py=1
`wait 2800
stop music 32
delete music 32
re:
gemst=0
px=0
py=0
set text size 8
REM Set the arrays random. This is only for the example, and will not be kept.
show mouse
filename$=Open(200,200)
sync rate 100
open to read 1,filename$
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
remstart
REM Increasing the y so no images are overlapped. Mainly making it a 14x14 grid
for y=0 to 13
REM taking care of the 14 square row, while also pasting the images
for x=0 to 13
if image exist(terrain(x,y))
paste image terrain(x,y),x*32,y*32
endif
next x
next y
remend
hide mouse
terrain(0,0)=999
position mouse 500,240
cls
sync
set text opaque
do
if delay=5
frame=nextimg(30+dir*3,31+dir*3,30+dir*3,32+dir*3,current)
paste image frame,offset(1)+px*32,offset(2)+py*32
inc current
if current=5 then current=1
delay=0
else
inc delay
endif
REM FPS Display
` center text 500,240," Screen Fps:"+str$(screen fps())+" "
REM FPS Display - remove from final
REM Set the ink to white
ink rgb(255,255,255),0
REM Show the Gems Collected:
` center text 240,450," Gems Collected:"+str$(gemsc)+"/"+str$(gemst)
REM Make 'Barriers'.
` line 0,448,448,448
` line 448,448,448,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
REM remstart
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
` center text 500,240,"Screen Fps:"+str$(screen fps())
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 spacekey()=1 then gosub re
REM ^^^^^^^^^^^^^^ - remove from final
if gemsc=gemst then exit
redraw()
sync
loop
REM |Main Loop|
REM Delete all images, and display them being deleted for effects.
`cls
set text size 40
set text font "times new roman"
center text 220,130,"Gem Count:"+str$(gemsc)+"/"+str$(gemst)
for y=0 to 13*32 step 32
REM Removing Images
for x=0 to 13*32 step 32
for shrink#=1 to 32 step .5
ink rgb(0,0,0),0
box x,y,x+shrink#,y+shrink#
sync
next shrink
next x
next t
sync rate 30
REM |Delete all images, and display them being deleted for effects.|
wait key
REM |wait for a key press. - remove from final
return
end
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=y 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
endcase
` case 1
`play sound 3
` rocks(rock,3)=0
` inc rock
` endcase
case 22
if rocks(rock,3)=1
` play sound 3
fdir=direction(rock)
if fdir=0
inc rock
rocks(rock,3)=0
else
if fdir=5 and rocks(rock,3)=1 then goto 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
` play sound 3
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:
play sound 53
return
Level_Editor:
stop music 1
load music "Music/themeb.mid",5
play music 5
loop music 5
cls
delete sprite 100
delete sprite 101
delete sprite 102
sync on
show mouse
set gamma bright,bright,bright
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
Return:
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
do
redrawit()
px=mousex()/32*32
py=mousey()/32*32
if px>416 then px=416
if py>416 then py=416
ink rgb(255,255,255),0
set text size 20
set text font "System"
text 490,200,"Selection"
set text font "Arial"
set text size 25
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),0
center text 600,80,"Menu"
if mousex()>=570 and mousex()=<630 and mousey()>=80 and mousey()=<100
ink rgb(100,35,10),0
box 570,80,630,100
ink rgb(25,17,5),0
center text 600,80,"Menu"
if mouseclick()=1 then gosub Menu
endif
set text font "System"
set text size 20
set text to normal
set text opaque
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
if mouseclick()=1 and mousex()<448 and select>0 then paste image select,px,py
if mouseclick()=1 and mousex()<448 and select>0
terrain_editor(px/32,py/32)=select
endif
ink rgb(0,100,0),0
set text transparent
box 500,400,639,479
ink rgb(200,100,50),0
box 505,405,634,474
set text to bold
ink rgb(150,20,105),0
center text (500+screen width())/2,380,"Instructions"
ink rgb(100,100,100),0
center text (500+screen width())/2,380,"_________"
set text to normal
ink rgb(150,25,20),0
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. "
sync
loop
delete music 5
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),0
set text to bold
set text font "Arial"
set text size 15
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 20
center text 100,50,"Menu"
do
if mouseclick()=1 and mousex()>44 and mousex()<155 and mousey()>144 and mousey()<166
gosub Save
endif
if mouseclick()=1 and mousex()>44 and mousex()<155 and mousey()>194 and mousey()<216
gosub Load
endif
if mouseclick()=1 and mousex()>44 and mousex()<155 and mousey()>244 and mousey()<266
repeat
until mouseclick()=0
gosub Return
endif
if mouseclick()=1 and mousex()>44 and mousex()<155 and mousey()>294 and mousey()<316
repeat:until mouseclick()=0
stop music 5
play music 1
delete music 5
gosub remake
endif
sync
loop
end
Save:
cls
if file exist("Maps")=0 then make file "Maps"
ink rgb(50,50,50),0
box 215,195,405,305
ink rgb(100,100,100),0
box 220,200,400,300
ink rgb(250,210,10),0
set text font "Arial"
set text size 20
set text to normal
center text 320,200,"Enter Filename"
ink rgb(0,0,0),0
box 240,240,380,255
set cursor 240,240
ink rgb(255,255,255),0
sync
Name$=""
input Name2$
Name$=Name$+Name2$
for check=1 to len(Name$)
if mid$(Name$,check)="/" then goto error
next check
Name$=Name$+".map"
print Name$
wait key
if file exist(Name$)=0 then open to write 1,Name$ else goto error
if filename$<>".map"
for y=0 to 14
REM This loop creates the line of text to be written
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
REM Once the line of text to write has been assembled, put it in the file
write string 1,line$
line$=""
next y
endif
if file open(1)
close file 1
endif
cls
center text 320,240,"File Saved"
wait 100
cls
goto Menu
error:
sync on
rem ****************************************
rem ************MAKE ROCK TEXTURE***********
rem ****************************************
rem *(MUST be at the start of all programs)*
rem ****************************************
rem Specify Array Size
gridwidth=700
gridheight=500
rem Make Array
dim grid(gridwidth+20,gridheight+20)
rem Specify rock peramiters
startvalue=50
maxvalue=100
minvalue=0
variation=50
if variation>abs(maxvalue-minvalue) then variation=abs(maxvalue-minvalue)
rem Fill Array
for x=1 to gridwidth+20
for y=1 to gridheight+20
grid(x,y)=startvalue
next y
next x
rem Make Random Points
for i=1 to (gridwidth+20)*(gridheight+20)/10
feild=abs(maxvalue-minvalue)
x=rnd(gridwidth)
y=rnd(gridheight)
value=rnd(feild)
grid(x,y)=value
next i
rem For Loops to Generate Texture
for x=1 to gridwidth+20
for y=1 to gridheight+20
rem Get surrounding pixels
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
rem Get average of other points
if otherpoints>0
o#=otherpoints
t#=totalofothers
average#=t#/o#
else
average#=startvalue
endif
rem Assaing the point in the array based on the average plus a variation
gridvalue=average#+(rnd(variation)-(variation/2))
if gridvalue<minvalue then gridvalue=minvalue
if gridvalue>maxvalue then gridvalue=maxvalue
grid(x,y)=gridvalue
next y
next x
rem Darken areas
for x=494 to 650
for y=36 to 70
grid(x,y)=grid(x,y)-30
if grid(x,y)<minvalue then grid(x,y)=minvalue
next y
next x
for x=494 to 650
for y=80 to 180
grid(x,y)=grid(x,y)-30
if grid(x,y)<minvalue then grid(x,y)=minvalue
next y
next x
rem Soften Noise
for x=1 to gridwidth+20
for y=1 to gridheight+20
gv#=grid(x,y)
gv#=gv#+(maxvalue-gv#)/2
grid(x,y)=gv#
if grid(x,y)>maxvalue then grid(x,y)=maxvalue
next y
next x
rem ****************************************
rem ***********END OF ROCK TEXTURE**********
rem ****************************************
x1=100
y1=100
x2=440
y2=220
Titletext$="Error with Entry!"
Message$="The title failed to have the required text. OR your filename already exists."
Buttons$="Re-enter,160,180,250,205;Cancel,280,180,370,205"
buttonpressed$=MessageBox(x1,y1,x2,y2,Titletext$,Message$,Buttons$)
cls
if buttonpressed$="Re-enter" then gosub Save
if buttonpressed$="Cancel" then gosub Menu
suspend for key
end
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$
Load:
print "LOAD"
repeat
until mouseclick()=0
return
end
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()
for y=0 to 13
for x=0 to 13
REM Since the terrain array contains all info and the tile codes are 1 less
REM than there respective images, there is no point in using if-thens
if terrain(x,y)=999 then goto skip
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
skip:
next x
next t
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
Function Open(x,y)
SET TEXT FONT "Arial"
REM The initial box
INK RGB(127,127,127),0
BOX x,y,x+14*16,y+13*14
INK RGB(0,0,127),0
REM The top bar
BOX x,y,x+14*16,y+14
REM Places and offsets the word "OPEN" at the top, to give a windows feel
SET TEXT SIZE 14
INK RGB(56,56,56),0
TEXT x+5,y,"Open"
INK RGB(255,255,255),0
TEXT x+4,y-1,"Open"
SET TEXT SIZE 12
INK RGB(56,56,56),0
BOX x+2,y+16,x+14*16-2,y+26
REM Shades the corners so that it looks windows-ish
INK 0,0
LINE x,y+28,x+14*16,y+28
INK RGB(57,57,57),0
BOX x+14,y+42,x+14*15,y+14*9
INK RGB(255,255,255),0
LINE x,y,x+14*16,y
LINE x,y,x,y+13*14
INK RGB(32,32,32),0
LINE x,y+14*13,x+14*16,y+14*13
LINE x+14*16,y,x+14*16,y+14*13
INK RGB(57,57,57),0
LINE x+1,(y+(14*13))-1,(x+(14*16))-1,(y+(14*13))-1
LINE (x+(14*16))-1,y+1,(x+(14*16))-1,(y+(14*13))-1
REM Grabs the screen
GET IMAGE 44+4,0,0,640,480
REM Creates the mouse sprite
BOX 0,0,1,1
GET IMAGE 44+3,0,0,1,1
SPRITE 3,MouseX(),MouseY(),44+3
SET SPRITE 3,1,0
REM Creates the Buttons
Button(x+14,y+14*10,1,"Open",1)
Button(x+135,y+14*10,1,"Cancel",2)
SYNC ON : SYNC RATE 0
REM Places the screen sprite offscreen, for pasting later
SPRITE 4,800,0,44+4
REM Generates the file list
CreateFiles(offset,selected)
REM Places the file list offscreen, for pasting
SPRITE 25,800,0,44+25
REM Creates the text showing the directory
location$=GET DIR$()
limit=50
size=LEN(location$)
difference=size-limit
REM Checks to see if it would make it shorter to abbreviate it
if difference>3
location$=LEFT$(location$,(limit/2)-3)+"..."+RIGHT$(lOCATION$,(limit/2)-5)
endif
TEXT x+4,y+16,location$
REM Main Loop
REPEAT
SET CURRENT BITMAP 0
IF MouseClick()=0
oldselect=selected
ENDIF
IF MouseX()>x+14 and MouseY()<x+14*16 and MouseY()>y+28 and MouseY()<y+9*14
IF MouseClick()=1
selected=((MouseY()-(y+28))/14)
IF selected=oldselect and oldselect>0
changeflag=1
ENDIF
ENDIF
ENDIF
IF MouseClick()=0 and changeflag=1
selectedname$=CreateFiles(offset,selected)
if Directory_Exist(selectedname$)=1
CD selectedname$
selected=0
offset=0
changeflag=0
ENDIF
ENDIF
CreateFiles(offset,selected)
PASTE SPRITE 4,0,0
SPRITE 3,MouseX(),MouseY(),44+3
IF UpKey()=1
scroll=-1
ENDIF
IF DownKey()=1
scroll=1
ENDIF
IF UpKey()=0 and DownKey()=0
inc offset,scroll
scroll=0
ENDIF
IF offset<0 THEN offset=0
IF Sprite Collision(3,1) and MouseClick()=1
Button(x+14,y+14*10,0,"Open",1)
button=1
ELSE
Button(x+14,y+14*10,1,"Open",1)
ENDIF
IF Sprite Collision(3,2) and MouseClick()=1
Button(x+135,y+14*10,0,"Cancel",2)
button=2
ELSE
Button(x+135,y+14*10,1,"Cancel",2)
ENDIF
PASTE SPRITE 25,x+14,y+42
IF MouseClick()=0 and button<>0
IF button=1
selectname$=CreateFiles(offset,selected)
IF Directory_Exist(selectname$)=1
CD selectname$
selected=0
ELSE
exitflag=1
ENDIF
ENDIF
IF button=2
print "Cancel"
ENDIF
button=0
ENDIF
location$=Get Dir$()
limit=50
size=LEN(location$)
difference=size-limit
IF difference>3
location$=LEFT$(Location$,(limit/2)-3)+"..."+RIGHT$(LOCATION$,(limit/2)-5)
ENDIF
TEXT x+4,y+16,location$
SYNC
UNTIL exitflag=1
for i=1 to 5
if sprite exist(i)
delete sprite i
endif
next i
cls
ENDFUNCTION selectname$
FUNCTION Button(x,y,flag,string$,sprite)
INK RGB(127,127,127),0
BOX x,y,x+75,y+25
INK RGB(255,255,255),0
IF flag=1
LINE x,y,x+75,y
LINE x,y,x,y+25
INK RGB(32,32,32),0
LINE x,y+25,x+75,y+25
LINE x+75,y,x+75,y+25
INK RGB(57,57,57),0
LINE x+1,y+24,x+74,y+24
LINE x+74,y+1,x+74,y+24
ELSE
INK RGB(32,32,32),0
LINE x,y,x+75,y
LINE x,y,x,y+24
INK RGB(255,255,255),0
LINE x,y+25,x+75,y+25
LINE x+75,y,x+75,y+25
INK RGB(57,57,57),0
LINE x+1,y+1,x+74,y+1
LINE x+1,y+1,x+1,y+24
ENDIF
x2=x+(75)/2
y2=y+5
INK RGB(57,57,57),0
CENTER TEXT x2,y2+2,string$
INK RGB(255,255,255),0
CENTER TEXT x2-1,y2+1,string$
GET IMAGE sprite+44,x,y,x+75,y+25
SPRITE sprite,x,y,sprite+44
ENDFUNCTION
FUNCTION CreateFiles(offset,selected)
IF Bitmap Exist(15)=1 THEN DELETE BITMAP 15
CREATE BITMAP 15,640,480
INK RGB(255,0,0),RGB(0,255,255)
CLS
INK RGB(255,0,0),RGB(0,255,255)
BOX 0,(offset+selected-1)*14,639,(offset+selected)*14
INK 0,RGB(0,255,255)
PERFORM CHECKLIST FOR FILES
FIND FIRST
filecount=0
FOR i=1 to Checklist Quantity()
FIND NEXT
IF Get File Name$()=".." or Right$(Get File Name$(),3)="map" or Get File Type()=1
INC filecount
name$=Get File Name$()
IF Len(name$)>10
name$=Left$(name$,6)+".."+Right$(name$,3)
ENDIF
string$=name$
TEXT 0,((filecount-1)*14)+1,string$
TEXT 196-Text Width(Get File Date$()),((filecount-1)*14)+1,Get File Date$()
INK 0,0
LINE 0,((filecount)*14),640,((filecount)*14)
LINE 0,((filecount-1)*14),640,((filecount-1)*14)
IF filecount=selected+offset then filename$=Get File Name$()
ENDIF
NEXT i
GET IMAGE 44+25,0,offset*14,196,(6*14)+(offset*14)
SET CURRENT BITMAP 0
INK RGB(255,255,255),0
ENDFUNCTION filename$
Function Directory_Exist(name$)
FIND FIRST
filename$=Get File Name$()
IF filename$<>name$
REPEAT
FIND NEXT
filename$=Get File Name$()
UNTIL filename$=name$ or Get File Type()=-1
ENDIF
IF Get File Type()=1
value=1
ELSE
value=0
ENDIF
ENDFUNCTION value
I download memory.
