Rem Project: grassland
Rem Created: 3/2/2006 4:37:04 PM
Rem ***** Main Source File *****
sync on : sync rate 40
autocam off : hide mouse
set camera range 1,10000
backdrop on : color backdrop rgb(45,160,00)
`Menu type declaration
type menuItem
name$ as string
ID as integer
endtype
`Initialize the menu components
InitMenu()
`Tile Type Declaration
type tile
ght# as float `grass height
typ as integer `tile type
veg as integer `vegetable growing here
ang as integer `tile angle
flg as integer `flag (this could be anything) ;)
wlv# as float `water level
nlv# as float `nutrient level
Xsc# as float `X scale vector
Ysc# as float `Y scale vector
Zsc# as float `Z scale vector
endtype
` if you need more info held per tile, put it in the type decl. : update the save/load func.
`they must be global for the functions to recognize them... this isnt C++; no pointers :'(
global MAPWIDTH = 10 `the length of the map in the x dimension in tiles
global MAPDEPTH = 10 `the length of the map in the z dimension in tiles
global TILEDIM = 20 `the dimensions of the tiles in sceneUnits. tiles are square, btw
global MAP_XOFF# = -60.0 `the offset in the x dimension, so you can reposition the origin
global MAP_ZOFF# = -60.0 `the offset in the z dimension
`Our main map array
global dim map(MAPWIDTH,MAPDEPTH) as tile
`the beginning numbers for the scene objects
global SCENE_OBJECTS = 400
global COT : COT = SCENE_OBJECTS `the cottage
global SHD : SHD = SCENE_OBJECTS + 1
global SKY : SKY = SCENE_OBJECTS + 2 `the skydome
global TRE : TRE = SCENE_OBJECTS + 3 `the tree parent object
global CUR : CUR = SCENE_OBJECTS + 4 `the cursor object
global PLN : PLN = SCENE_OBJECTS + 5 `the invisible ground box ~ I had to use it ~ so sue me.
global DSY : DSY = SCENE_OBJECTS + 6 `the daisy parent object
global DAF : DAF = SCENE_OBJECTS + 7 `the daffadil parent object
global sceneobjcount = 7
`the beginning numbers for the tile and vegetable objects
global TILE_INST = 600 :`start of the tile_uids
global VEG_INST = : VEG_INST = TILE_INST + MAPWIDTH*MAPDEPTH :`start of the veg_uids
global DSY_INST = : DSY_INST = VEG_INST + MAPWIDTH*MAPDEPTH :`start of the dsy_uids
global DAF_INST = : DAF_INST = DSY_INST + MAPWIDTH*MAPDEPTH :`start of the daf_uids
`speed to move
spd#=0.5
`wait time
teatime = 20
`initial cursor position
ox = 1 : oz = 1
`Timer stuff
n=2 : o=3500 : g=100 : s=0 : m=0
steps=20
`current object and copy object and object count
co=1 : cp=50 : oc = 6
`air height / initial camera position actually
airht# = 50
`to make the mouse reposition correctly when we switch to mouse-look mode
must_reset=1
`the rate for changing values
adjust=1
`this is where you set each tile to the initial
for x=0 to MAPWIDTH
for z=0 to MAPDEPTH
map(x,z).ght# = g `grass height
map(x,z).typ = 0 `tile type
map(x,z).veg = 0 `vegetable growing here
map(x,z).ang = 0 `tile angle
map(x,z).flg = 0 `flag (this could be anything) ;)
map(x,z).wlv# = 1 `water level
map(x,z).nlv# = 1 `nutrient level
map(x,z).Xsc# = 0 `X scale vector
map(x,z).Ysc# = 0 `Y scale vector
map(x,z).Zsc# = 0 `Z scale vector
next z
next x
`Load all the decor parents objects
load object "models/daisy.x",DSY : set object light DSY,0 : set object DSY,1,0,0,1 : hide object DSY
load object "models/cottage.x",COT : set object light COT,0 : set object COT,1,0,0,1 : position object COT,80,0,225
load object "models/skydome.x",SKY : set object light SKY,0 : set object SKY,1,0,0,1 : position object SKY,60,0,60
load object "models/tree.x",TRE : set object light TRE,0 : set object TRE,1,0,0,1 : position object TRE,-20,0,20
foo = instance_tree( -20, 0, 120, 0, -45, 0 )
foo = instance_tree( 180, 0, 20, 0, 90, 0 )
foo = instance_tree( 180, 0, 120, 0, 180, 0 )
`the cursor...
make object box CUR, TILEDIM, 2, TILEDIM : color object CUR, rgb(20,20,200) : ghost object on CUR
`the invisible ground object
make object box PLN, 1024, 0.2, 1024 : position object PLN, 0, -0.1, 0 : ghost object on PLN : fade object PLN, 0
`load all the tile types now
load object "models/grass.x",1
load object "models/gn.x",2
load object "models/gs.x",3
load object "models/gc.x",4
load object "models/gcb.x",5
load object "models/ge.x",6
`this number must match the highest number for a tile object you have loaded
oc = 6 :`object count, must be integral & less than SCENE_OBJECTS, ei. [0-399]
`make the empty parts of the image that are green, disappear
set image colorkey 45, 160, 00
position camera 2000,75,2000
point camera 2000,0,2000
`setup the tile objects
for l = 1 to oc
if object exist(l)
position object l,2000,0,2000
set object light l,0
set object l,1,0,0,1
s$ = s$ + "."
text 0,20,"Generating Tile Images" + s$ : sync
`Unfortunately for this to work we must call sync before grabbing the image... heck, it was
` easy to make, and will be easy when you add more tiles. ;) change it if you like...
get image l,265,185,screen width()-263,screen height()-183,1
```Here you can draw a loading screen if you want.`````
`
```````````````````````````````````````````````````````
sprite l,-700,-700,l
hide object l
endif
next l
`load all the tile types now
load object "models/cabbage.x",7
load object "models/carrot.x",8
load object "models/foxglove.x",9
load object "models/onion.x",10
load object "models/poppy.x",11
load object "models/radish.x",12
load object "models/springonion.x",13
`this number must match the highest number for a tile object you have loaded
vos = 7 :`veg object start, must be integral & less than SCENE_OBJECTS, ei. [0-399]
voe = 13 :`veg object end
position camera 2020,75,2020
point camera 2000,0,2000
`setup the tile objects
for l = vos to voe
if object exist(l)
position object l,2000,0,2000
set object light l,0
set object l,1,0,0,1
s$ = s$ + "."
text 0,20,"Generating Veggie Images" + s$ : sync
`Unfortunately for this to work we must call sync before grabbing the image... heck, it was
` easy to make, and will be easy when you add more tiles. ;) change it if you like...
get image l,265,185,screen width()-263,screen height()-183,1
```Here you can draw a loading screen if you want.`````
`
```````````````````````````````````````````````````````
sprite l,-700,-700,l
hide object l
endif
next l
`oc=13
`set initial camera position, and rotation
position camera 80,airht#,-80 : rotate camera 0,0,0
t=timer()
`main loop
do
s=(timer()-t)/1000
m=s/60
`position Listener
position listener camera position x(),camera position y(),camera position z()
rotate listener camera angle x(),camera angle y(),camera angle z()
` if keystate(16) then charht#=charht#+100
` if keystate(18) then charht#=charht#-100
`press + or - to change anim speed
if keystate(12) then o=o-50
if keystate(13) then o=o+50
`reset anim speed
if o<0 then o=0
`press F keys to change gfx mode
if keystate(59) then set object 1,0,0,0,0 : ghost object off 1
if keystate(60) then set object 1,1,1,1,1
if keystate(61) then ghost object on 1
`a perhaps extraneous exit path.
if escapekey() then exit
save = keystate(25)
load = keystate(38)
`Please call the file somthing else... <*.ext> is stupid :)
if save=1 then save_map( "testfile.ext" )
if load=1 then load_map( "testfile.ext" )
select mode
case 1
` TODO: play mode code goes here```````
`correct the text color. (stupid menu ...)
ink rgb(255,255,255),0
`Hit F10 to bring up the main menu
if keystate(68) then mode=0
`Record some common values
mc=mouseclick() : mx# = mousex() : my# = mousey()
if mc=2
`Popup a menu
show mouse
choice=-1
if ovr=-1 then PositionMenu( mx#, my# )
else
if ovr=-1 then PositionMenu( -5000, -5000 )
endif
` realtime scaling of grass
for x=1 to MAPWIDTH
for z=1 to MAPDEPTH
`Determine how fast the grass can grow.
GrowthValue = elapsedTime * (map(x,z).wlv# * map(x,z).nlv#)
map(x,z).ght# = map(x,z).ght# + ( GrowthValue )
`Make sure the map reflects the change.
update_tile(x,z)
next z
next x
`Menu, always there, not always visible or clickable
AddMenuItem( "test Option 1", 2 )
AddMenuItem( "Exit", 1 )
ovr = ShowMenu()
if mouseclick()=1
if mouseclick()=0
choice = ovr
endif
select ovr
case 1
mode = 0
endcase
case 2
`Action Goes Here
PositionMenu( -5000, -5000 )
endcase
case default
`do nothing
endcase
endselect
endif
DelMenuItem( "test Option 1", 2 )
DelMenuItem( "Exit", 1 )
```````````````````````````````````````````
` This is the end of the <Play Game> code `
```````````````````````````````````````````
endcase
case 2
`This is the edit mode code.
`Hit F10 to bring up the menu
if keystate(68) then mode=0
ink rgb(255,255,255),0
`commonly used mouse-related
mc=mouseclick() : mx# = mousex() : my# = mousey()
`Right mouse to popup the menu
if mc=2
`Popup a menu
show mouse
choice=-1
if ovr=-1 then PositionMenu( mx#, my# )
else
if ovr=-1 then PositionMenu( -5000, -5000 )
endif
if mc=1 and ovr=-1
`click on the cursor to perform edit action
if CUR = pick object( mx#, my#, CUR, CUR )
`Mouse has been clicked, so use the edit flag to figure out what to do.
select edit
case 1
`Change / place the map tile
map(ox,oz).typ = co : update_tile( ox, oz ) : wait teatime/4
endcase
case 2
`Rotate the map tile
map(ox,oz).ang = wrapvalue(map(ox,oz).ang+90) : update_tile(ox,oz) : wait teatime
endcase
case default
`If edit by chance, becomes some obscure number... set it to 1
edit=1
endcase
endselect
endif
`click on a tile to place the cursor
if PLN = pick object( mx#, my#, PLN, PLN )
thx# = (camera position x() + get pick vector x()) : ox = -MAP_XOFF#+thx# + (0.5*TILEDIM)
thz# = (camera position z() + get pick vector z()) : oz = -MAP_ZOFF#+thz# + (0.5*TILEDIM)
ox = ox / TILEDIM : oz = oz / TILEDIM : wait teatime
endif
else
if mc=1
`menu stuff...
if mouseclick()=0
choice = ovr
wait teatime
endif
select ovr
case 1
mode=0
endcase
case 2
edit = 1
PositionMenu( -5000, -5000 )
endcase
case 3
edit = 2
PositionMenu( -5000, -5000 )
endcase
case 4
edit = 3
PositionMenu( -5000, -5000 )
endcase
case 5
edit = 4
PositionMenu( -5000, -5000 )
endcase
case 6
edit = 5
PositionMenu( -5000, -5000 )
endcase
case default
`do nothing
endcase
endselect
endif
endif
if mc=4 then mouse_look=1 else mouse_look=0
` position mapblock / cursor with the arrow keys
if keystate(200) and oz< MAPDEPTH then oz=oz+1 : wait teatime
if keystate(208) and oz> 1 then oz=oz-1 : wait teatime
if keystate(203) and ox> 1 then ox=ox-1 : wait teatime
if keystate(205) and ox< MAPWIDTH then ox=ox+1 : wait teatime
if ox>MAPWIDTH then ox=MAPWIDTH
if ox<1 then ox=1
if oz>MAPDEPTH then oz=MAPDEPTH
if oz<1 then oz=1
`put the cursor there
position object CUR, MAP_XOFF#+(ox*TILEDIM), 0, MAP_ZOFF#+(oz*TILEDIM)
`if tab is pressed switch the editmode
if keystate(15)
if edit<6 then edit=edit+1 else edit=1
wait teatime
endif
`if pgup or down is pressed change current object
if keystate(201) then co=co+1 : wait teatime
if keystate(209) then co=co-1 : wait teatime
`mousewheel to change the object
co=co+mousemovez()/100
if co<0 then co=0
if co>(oc) then co=(oc)
`if space is pressed set that tile to the current object's id
if keystate(57)
if edit=1 then map(ox,oz).typ = co
if edit=2 then map(ox,oz).ang = wrapvalue(map(ox,oz).ang + 90)
wait teatime
update_tile( ox, oz )
endif
`change grassheight, <g> & <h>
if keystate(34)
map(ox,oz).ght# = map(ox,oz).ght# + adjust : update_tile( ox, oz )
endif
if keystate(35)
map(ox,oz).ght# = map(ox,oz).ght# - adjust : update_tile( ox, oz )
endif
`press j key to change grass scale to default (100)
if keystate(36) then map(ox,oz).ght#=100 : update_tile( ox, oz )
`roam with wasd, q and e to raise / lower
oldx#=camera position x()
oldz#=camera position z()
cx#=camera position x()
cy#=camera position y()
cz#=camera position z()
ca#=camera angle y()
`store the keystates as on or off(1 or 0)
forward = keystate(17)
left = keystate(30)
back = keystate(31)
right = keystate(32)
up = keystate(18)
down = keystate(16)
if right = 1
cx#=newxvalue(cx#,wrapvalue(ca#+90),spd#)
cz#=newzvalue(cz#,wrapvalue(ca#+90),spd#)
position camera cx#,cy#,cz#
endif
if left = 1
cx#=newxvalue(cx#,wrapvalue(ca#-90),spd#)
cz#=newzvalue(cz#,wrapvalue(ca#-90),spd#)
position camera cx#,cy#,cz#
endif
if forward = 1
cx#=newxvalue(cx#,ca#,spd#)
cz#=newzvalue(cz#,ca#,spd#)
position camera cx#,cy#,cz#
endif
if back = 1
cx#=newxvalue(cx#,wrapvalue(ca#-180),spd#)
cz#=newzvalue(cz#,wrapvalue(ca#-180),spd#)
position camera cx#,cy#,cz#
endif
if up = 1
airht# = airht# + spd#
if airht# >= 200.0 then airht# = 0.5
position camera cx#,airht#,cz#
endif
if down = 1
airht# = airht# - spd#
if airht# <= 0.5 then airht# = 0.5
position camera cx#,airht#,cz#
endif
`mouse look
if mouse_look=1
hide mouse
`must_reset was created to offset the mousemove() problem, anytime the mousemoves, but you
` dont want the camera too, set the must_reset to true. its a correction layer.
mousemox# = mousemovex()
mousemoy# = mousemovey()
if must_reset = 1
mousemox# = 0.0
mousemoy# = 0.0
must_reset = 0
endif
momox_val# = mousemox#
momoy_val# = mousemoy#
xrotate camera wrapvalue( camera angle x() + momoy_val# / 2.0 )
if camera angle x()>80 and camera angle x()<180 then xrotate camera 80
if camera angle x()<270 and camera angle x()>180 then xrotate camera 270
yrotate camera wrapvalue( camera angle y() + momox_val# / 2.0 )
position mouse mx#, my#
else
show mouse
must_reset=1
endif :`mouse_look
`hud
`display a picture of the current object
if (co>0) then if sprite exist(co) then paste sprite co, 490, 73
set text size 18 : set text font "Impact"
text 400,2,"roystonstew@hotmail.com"
text 350,16,"Left + Right mouse to change camera angle"
text 490,32,"A=Left D=Right"
text 490,44,"S=Back W=Forward"
text 490,56,"Q=Up E=Down"
text 5,5,"FPS: " + str$(screen fps())
text 5,18,"ANIMSPEED=" + str$(o)
text 5,30,"+ or - to change anim speed"
text 5,44,"Press F1 to F3 for gfx mode"
text 10,70,"CamX=" + str$ (camera position x())
text 10,82,"Camy=" + str$ (camera position y())
text 10,94,"Camz=" + str$ (camera position z())
text 10,106,"CamAx" + str$ (camera angle x())
text 10,118,"CamAy" + str$ (camera angle y())
text 10,130,"chr=" + str$ (scancode())
text 10,140,"grassheight=" + str$ ( map(ox,oz).ght# )
text 10,150,"tile angle=" + str$( map(ox,oz).ang )
text 10,175,"seconds=" + str$ (s)
text 10,190,"mins=" + str$ (m)
text 580,190,"ox=" + str$ (ox)
text 580,210,"oz=" + str$ (oz)
text 580,240,"co=" + str$ (co)
text 580,255,"cp=" + str$ (cp)
text 580,275,"oc=" + str$ (oc)
`Menu, Always there, not always visible or clickable.
AddMenuItem( "Place tile", 2 )
AddMenuItem( "Rotate tile", 3 )
AddMenuItem( "Place Veggie", 4 )
AddMenuItem( "Edit Nutrient Level", 5 )
AddMenuItem( "Edit Water Level", 6 )
AddMenuItem( "Exit", 1 )
ovr = ShowMenu()
DelMenuItem( "Place tile", 2 )
DelMenuItem( "Rotate tile", 3 )
DelMenuItem( "Place Veggie", 4 )
DelMenuItem( "Edit Nutrient Level", 5 )
DelMenuItem( "Edit Water Level", 6 )
DelMenuItem( "Exit", 1 )
`case 2 <- Design mode
endcase
case default
`Show The Main Menu
show mouse
AddMenuItem( "Play Game", 2 )
AddMenuItem( "Design Mode", 3 )
AddMenuItem( "Exit", 1 )
PositionMenu( screen width()/2-64, screen height()/2-64 )
ovr = ShowMenu()
if mouseclick()=1
choice = -1
if mouseclick()=0
choice = ovr
endif
select ovr
case 1
foo = ShutdownMenu() : end
endcase
case 2
mode = 1
hide object CUR
load_map( "testfile.ext" )
PositionMenu( -5000, -5000 )
endcase
case 3
mode = 2
edit=1
show object CUR
PositionMenu( -5000, -5000 )
endcase
case default
`do nothing
endcase
endselect
endif
DelMenuItem( "Play Game", 2 )
DelMenuItem( "Design Mode", 3 )
DelMenuItem( "Exit", 1 )
endcase
endselect :`mode
fastsync
elapsedTime = ( (timer()-t)/1000 ) - s
loop
`This will take three floats for the position, three floats for the angles, and instance
` a tree, then position and rotate it there, if there are not enough object holders, it will
` return -1. otherwise it will be successful and return the object id.
function instance_tree( x#, y#, z#, ax#, ay#, az# )
sceneobjcount = sceneobjcount + 1
if sceneobjcount < TILE_INST
obj = SCENE_OBJECTS + sceneobjcount
instance object obj, TRE : position object obj, x#, y#, z# : rotate object obj, ax#, ay#, az#
else
obj = -1
endif
endfunction obj
function update_map()
` this is a slow way to do it, but i cant find an easier way... it just hit me, only call
` this function when you know the map needs updated... duh.
for x=1 to MAPWIDTH
for z=1 to MAPDEPTH
obj = map(x,z).typ
uid = ( MAPWIDTH * z ) + x
tile_uid = TILE_INST + uid
dsy_uid = DSY_INST + uid
daf_uid = DAF_INST + uid
veg_uid = VEG_ISNT + uid
if obj>0
if object exist(obj) and tile_uid>0
if object exist(tile_uid)
` a tile is there already, but it might not be of the right type, so first delete
` it. then instance it with the right type... this is the slow part. if we could
` figure out what type it is, we could bypass this extraneous bit ... ill work
` on it. ~ if only there was a OBJECT PARENT() function...
delete object tile_uid
instance object tile_uid, obj
position object tile_uid, MAP_XOFF#+(x*TILEDIM), 0, MAP_ZOFF#+(z*TILEDIM)
if obj=1
scale object tile_uid, 100, map(x,z).ght#, 100
if object exist(dsy_uid)
position object dsy_uid, object position x(dsy_uid), map(x,z).ght#/100, object position z(dsy_uid)
endif
else
if object exist(dsy_uid) then delete object dsy_uid
endif
yrotate object tile_uid, map(x,z).ang
else :`object exist(num)
` there isnt a tile there, and there needs to be one of type <obj> so instance it.
instance object tile_uid, obj
position object tile_uid, MAP_XOFF#+(x*TILEDIM), 0, MAP_ZOFF#+(z*TILEDIM)
if obj=1
if object exist(dsy_uid) then delete object dsy_uid
if rnd(3)=1
instance object dsy_uid, DSY
position object dsy_uid, MAP_XOFF#+(x*TILEDIM)+(rnd(TILEDIM)-(TILEDIM/2)), map(x,z).ght#/100,MAP_ZOFF#+(z*TILEDIM)+(rnd(TILEDIM)-(TILEDIM/2))
endif
scale object tile_uid, 100, map(x,z).ght#, 100
endif
yrotate object tile_uid, map(x,z).ang
endif :`object exist(num)
else :`object exist(obj) and num>0
`the requested object does not exist, or the map location is invalid
endif :`object exist(obj) and num>0
else :`obj>0
` a tile type of zero means there isnt supposed to be a tile here. so delete it
` if there is one.
if obj=0 and object exist(tile_uid) then delete object tile_uid
if obj<>1 and object exist(dsy_uid) then delete object dsy_uid
endif
next z
next x
endfunction
function update_tile( tileX as integer, tileZ as integer )
`this does the exact same thing as <update_map()> except just for the tile specified.~faster
x = tileX : z = tileZ
obj = map(x,z).typ
uid = ( MAPWIDTH * z ) + x
tile_uid = TILE_INST + uid
dsy_uid = DSY_INST + uid
daf_uid = DAF_INST + uid
veg_uid = VEG_ISNT + uid
if obj>0
if object exist(obj) and tile_uid>0
if object exist(tile_uid)
` a tile is there already, but it might not be of the right type, so first delete
` it. then instance it with the right type... this is the slow part. if we could
` figure out what type it is, we could bypass this extraneous bit ... ill work
` on it. ~ if only there was a OBJECT PARENT() function...
delete object tile_uid
instance object tile_uid, obj
position object tile_uid, MAP_XOFF#+(x*TILEDIM), 0, MAP_ZOFF#+(z*TILEDIM)
if obj=1
scale object tile_uid, 100, map(x,z).ght#, 100
if object exist(dsy_uid)
position object dsy_uid, object position x(dsy_uid), map(x,z).ght#/100, object position z(dsy_uid)
endif
else
if object exist(dsy_uid) then delete object dsy_uid
endif
yrotate object tile_uid, map(x,z).ang
else :`object exist(num)
` there isnt a tile there, and there needs to be one of type <obj> so instance it.
instance object tile_uid, obj
position object tile_uid, MAP_XOFF#+(x*TILEDIM), 0, MAP_ZOFF#+(z*TILEDIM)
if obj=1
if object exist(dsy_uid) then delete object dsy_uid
if rnd(3)=1
instance object dsy_uid, DSY
position object dsy_uid, MAP_XOFF#+(x*TILEDIM)+(rnd(TILEDIM)-(TILEDIM/2)), map(x,z).ght#/100,MAP_ZOFF#+(z*TILEDIM)+(rnd(TILEDIM)-(TILEDIM/2))
endif
scale object tile_uid, 100, map(x,z).ght#, 100
endif
yrotate object tile_uid, map(x,z).ang
endif :`object exist(num)
else :`object exist(obj) and num>0
`the requested object does not exist, or the map location is invalid
endif :`object exist(obj) and num>0
else :`obj>0
` a tile type of zero means there isnt supposed to be a tile here. so delete it
` if there is one.
if obj=0 and object exist(tile_uid) then delete object tile_uid
if obj<>1 and object exist(dsy_uid) then delete object dsy_uid
endif
endfunction
function save_map( filename$ as string )
if not file exist( filename$ )
open to write 1, filename$
`We want to record these dimensions so we can open the file later and figure
` out how big it is.
write word 1,MAPWIDTH
write word 1,MAPDEPTH
`Now Parse the array and place each vital data into the file.
for x=0 to MAPWIDTH
for z=0 to MAPDEPTH
write float 1,map(x,z).ght#
write word 1,map(x,z).typ
write word 1,map(x,z).veg
write word 1,map(x,z).ang
write word 1,map(x,z).flg
write float 1,map(x,z).wlv#
write float 1,map(x,z).nlv#
write float 1,map(x,z).Xsc#
write float 1,map(x,z).Ysc#
write float 1,map(x,z).Zsc#
next z
next x
close file 1
else
`TODO: The File already exists, Write code to prompt the user what to do.
`Now overwrite it.
delete file filename$
open to write 1, filename$
`We want to record these dimensions so we can open the file later and figure
` out how big it is.
write word 1,MAPWIDTH
write word 1,MAPDEPTH
`Parse the array and place each vital data into the file.
for x=0 to MAPWIDTH
for z=0 to MAPDEPTH
write float 1,map(x,z).ght#
write word 1,map(x,z).typ
write word 1,map(x,z).veg
write word 1,map(x,z).ang
write word 1,map(x,z).flg
write float 1,map(x,z).wlv#
write float 1,map(x,z).nlv#
write float 1,map(x,z).Xsc#
write float 1,map(x,z).Ysc#
write float 1,map(x,z).Zsc#
next z
next x
close file 1
endif
endfunction
function load_map( filename$ as string )
if file exist( filename$ )
open to read 1, filename$
`We want to record these dimensions so we can open the file later and figure
` out how big it is.
read word 1, MAPWIDTH
read word 1, MAPDEPTH
TILE_INST = 600 :`start of the tile_uids
VEG_INST = TILE_INST + MAPWIDTH*MAPDEPTH :`start of the veg_uids
DSY_INST = VEG_INST + MAPWIDTH*MAPDEPTH :`start of the dsy_uids
DAF_INST = DSY_INST + MAPWIDTH*MAPDEPTH :`start of the daf_uids
undim map(0,0)
global dim map(MAPWIDTH,MAPDEPTH) as tile
`Parse the array and place each vital data into the file.
for x=0 to MAPWIDTH
for z=0 to MAPDEPTH
read float 1,ht#
map(x,z).ght# = ht#
read word 1,map(x,z).typ
read word 1,map(x,z).veg
read word 1,map(x,z).ang
read word 1,map(x,z).flg
read float 1,map(x,z).wlv#
read float 1,map(x,z).nlv#
read float 1,map(x,z).Xsc#
read float 1,map(x,z).Ysc#
read float 1,map(x,z).Zsc#
next z
next x
````````````````
update_map()
````````````````
close file 1
else
`TODO: The File doesn't exist, Write code to prompt the user what to do.
endif
endfunction
````````````````````````````````````````````````````````````````````````````````````````````
` A menu, and some required functions for them.
````````````````````````````````````````````````````````````````````````````````````````````
function InitMenu()
`if MenuIsActive=0
global dim menu() as menuItem
global MenuIsActive as boolean
global mnuPosx# as float
global mnuPosy# as float
MenuIsActive=1
`endif
endfunction 0
function MoveMenu( x#, y# )
if MenuIsActive
mnuPosx# = mnuPosx#+x# : mnuPosy# = mnuPosy#+y#
endif
endfunction
function PositionMenu( Posx#, Posy# )
if MenuIsActive
mnuPosx# = Posx# : mnuPosy# = Posy#
endif
endfunction
function MakeAlphaImage( ImgNum, Width, Height, R, G, B, Alpha )
`http://forum.thegamecreators.com/?m=forum_view&t=49923&b=6
if Width > 0 and Height > 0
Depth = screen depth()
make memblock 255, Width*Height*4+12
write memblock dword 255, 0, Width
write memblock dword 255, 4, Height
write memblock dword 255, 8, Depth
for i=12 to (Width*Height*4+11) step 4
write memblock byte 255, i, R :`Blue
write memblock byte 255, i+1, G :`Green
write memblock byte 255, i+2, B :`Red
write memblock byte 255, i+3, Alpha :`Alpha
next i
make image from memblock ImgNum, 255
delete memblock 255
else
text mousex(), mousey(), "Image Dimensions are illegal"
endif
endfunction
` -1, and 0, 1 are internal IDs, that mean: nothing chosen, menu border chosen, and escape,
` respectively ~~ these are easily customizable, just set choice value on escape & choice on
` MenuIsActive fail.
` Want the menu items smaller? -Set the text size smaller...
function ShowMenu()
if MenuIsActive
MaxWidth=150 :`The maximum desired width of our menu
imgItems = 400 :`The Number used to load the Item's sprite
imgMenu = 401 :`The Number used to load the Menu's sprite
ovr = 0 : choice = -1
cnt = array count( menu(0) )
itmHeight = text height( "|" )+6 :`Make it a tad higher than the actual string
`Here is our rect for the Menu's Box
t# = mnuPosy# - 3 :`Top
l# = mnuPosx# - 3 :`Left
b# = (t# + (itmHeight*(cnt+1)) ) + 3 :`Bottom
r# = (l# + MaxWidth) + 3 :`Right
`We want to be able to see through the menu, so we will make an alphaed image
MakeAlphaImage( imgMenu, r#-l#+2, b#-t#+2, 128, 128, 128, 50 )
sprite imgMenu, -7000, -7000, imgMenu
`This box function rocks!!!
box l#-2, t#-2, r#+4, b#+4, rgb(0,0,0), 2048, rgb(0,0,0), 2048
if ( mousex() > l#-2 ) and ( mousex() < r#+2 ) and ( mousey() > t#-2 ) and ( mousey() < b#+2 )
` The users mouse is over the menu as a whole
choice = 0
paste sprite imgMenu, l#, t#
`I decided to use sprites, because they are much easier to make alphaed, hence whats above
`box l#, t#, r#, b#, rgb(212, 208, 200),rgb(212, 208, 200),rgb(212, 208, 200),rgb(212, 208, 200)
endif
`Begin drawing the items in the menu
for n = 0 to cnt
`Find out how far in the x-dimension we should draw to
` NOTE: this could be stripped out, cause it makes a button the size of the string
itmWidth = text width( menu(n).name$ )+6
if itmWidth > MaxWidth-3
`itmWidth = MaxWidth-3
maxchars = MaxWidth / text width( "_" )
disp$ = left$( menu(n).name$, maxchars )
else
disp$ = menu(n).name$
endif
`Rect for the items (read buttons)
t# = mnuPosy# + (n*itmHeight) :`Top
l# = mnuPosx# :`Left
b# = t# + itmHeight :`Bottom
r# = l# + MaxWidth - 2 :`Right
`See if mouse is over this one... within the item rect's, boundaries
if ( mousex() > l# ) and ( mousex() < r# ) and ( mousey() > t# ) and ( mousey() < b# )
choice = menu(n).ID : ovr = 1
else
ovr = 0
endif
`Draw The items
if sprite exist(imgItems)=0
` The DarkGame Lang is probably smart enough to not create it again if it already
` exists, but lets just make sure... remember we do once this for every item in the
` menu. So this also improves performance for larger menus
MakeAlphaImage( imgItems, r#-l#, b#-t#, 128, 128, 128, 50 )
sprite imgItems, -7000, -7000, imgItems
endif
if ovr
`Set the text color to a bright color 'cause the mouse is over this item
ink RGB(0,0,255),0
box l#, t#, r#, b#, rgb(128,128,128),rgb(212, 208, 200),rgb(128,128,128),rgb(212, 208, 200)
prevTxtSize = text size()
if prevTxtSize < 12 then set text size 12
text l#+3, t#+3, menu(n).name$
set text size prevTxtSize
else
`Set the text color to a dull color
ink rgb(128,128,128),0
paste sprite imgItems, l#, t#
text l#+3, t#+3, disp$
endif
`End Drawing of items
next n :`Continue on to the next menu Item
`Poll the escape key to find out if the user wants to exit our menu
if escapekey()=1 then choice = 1
else
choice = 99999
endif
`CleanUp ~ dont want them images soliciting on our property, now do we ;)
`You may want to delete these lines if your experiencing performance issues, but know that
` you will have the images eating up memory, so further management is required.
if image exist(imgMenu) then delete image imgMenu : delete sprite imgMenu
if image exist(imgItems) then delete image imgItems : delete sprite imgItems
`NOTE: please pardon my graphical ignorance, 'alphaed' isn't a real word I'm sure...
`btw, its pronounced alf-ide, last syllable as in hide
endfunction choice
function AddMenuItem( name$ as string, ID as integer )
if MenuIsActive
if ID <> -1
cnt = array count( menu(0) )
array insert at bottom menu(0)
menu(cnt+1).name$ = name$
menu(cnt+1).ID = ID
else
result = 1
endif
else
result = 2
endif
endfunction result
function DelMenuItem( name$ as string, ID as integer )
if MenuIsActive
cnt = array count( menu(0) )
for n = 0 to cnt
if name$ = menu(n).name$ and ID = menu(n).ID then Item = n
next n
array delete element menu(0), Item
else
result = 2
endif
endfunction result
function ShutdownMenu()
undim menu()
MenuIsActive = 0
endfunction result
