CodeBase Entries
Welcome to our CodeBase where you can search through DarkBASIC, DarkBASIC Professional and AppGameKit source code covering a wide range of topics from full games to demo effects to object loaders.
All registered users can submit their own code from their account page, so why not contribute?
CodeBase Description | Category | |
---|---|---|
This is a small example of what code you need to use for different mouse buttons. Version: 1.0
Created: 4th Mar 2005 03:31
|
Input | |
pretty self explanatory - just lots and lots of text functions and perhaps more accessible bin and hex functions... Version: 1.0
Created: 3rd Mar 2005 17:19
|
Text | |
Utility which draws clickable '3D-look' buttons on a 2D screen. Version: 1.0
Created: 2nd Mar 2005 19:01
|
2D Effects | |
A simple but great FullScreen Motion Blur Effect. Version: 1.0
Created: 2nd Mar 2005 12:01
|
Graphics | |
Learn what RGB is all about, and how to use it in your 2D and 3D programs. Version: 1.0
Created: 2nd Mar 2005 08:07
|
Basic 2D | |
Allows you to load and fade in or out any fullscreen-sized image to or from the previous screen. The function automatically determines the fade direction by your start and stop alpha values. (Takes advantage of SYNC function) Version: 1.0
Created: 2nd Mar 2005 01:48
|
2D Effects | |
Finally, a code base entry that can help the newcommers get what they want. Simple jumping up and down, moving around, and that all important gravitational pull! Version: 1.0
Created: 1st Mar 2005 20:07
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com ` WaterSnake by Neil Houlden ` I haven't finished this yet, but take a look: `Show the title screen: center text screen width()/2,6, " __ ____ ___ __ " center text screen width()/2,18, "========== / / /_/ / /_ /_/ ==========" center text screen width()/2,30, "========== /_/_/ / / / /__ / | ==========" center text screen width()/2,40, " " center text screen width()/2,50, " ###### ## ## ### ## ## #######" center text screen width()/2,60, "## ## ### ## ## ## ## ## ## " center text screen width()/2,70, "## #### ## ## ## ## ## ## " center text screen width()/2,80, " ###### ## ## ## ## ## #### #######" center text screen width()/2,90, " ## ## #### ######### ## ## ## " center text screen width()/2,100, "## ## ## ### ## ## ## ## ## " center text screen width()/2,110, " ###### ## ## ## ## ## ## #######" center text screen width()/2,120, " " center text screen width()/2,130, " ============================================= " center text screen width()/2,150, " By Neil Houlden www.neilsdemo.tk " center text screen width()/2,170, " ============================================= " center text screen width()/2,280, "Use you're mouse to control the Water Snake." center text screen width()/2,290, "Press any key to Continue" center text screen width()/2,400, " - neilio_omnipotent@yahoo.co.uk -" wait key cls input "enter the length of the snake (I usually use 300): " ,bodylength `set Frame Rate sync rate 20 `hide the mouse hide mouse `make ground (So I can see how fast I'm going) make object plain 1,100,100 xrotate object 1,90 set object wireframe 1,1 `make the head make object sphere 2,4 color object 2,rgb(0,255,50) `Prepare to make body parts t=3 partcolor=1 `The body part making loop for t=3 to bodylength `Make a body part make object sphere t,3 ` color it if partcolor=1 partcolor=2 color object t,rgb(0,100,0) else partcolor=1 color object t,rgb(0,255,50) endif next t ` game loop do `Control the way the head faces by moving the mouse yrotate object 2,object angle y(2)+ (mousemovex()/2) xrotate object 2,object angle x(2)+ (mousemovey()/2) if object angle x(2)<-90 xrotate object 2,object angle x(2)-object angle x(2) xrotate object 2,-90 endif if object angle x(2)>90 xrotate object 2,object angle x(2)-object angle x(2) xrotate object 2,90 endif ` position the bits t=bodylength for a=4 to bodylength position object t,object position x(t-1),object position y(t-1),object position z(t-1) t=t-1 next a `this want's to be outside the loop because the last body part has to be attatched to the head. position object 3, object position x(2),object position y(2),object position z(2) `move the head in the direction it's facing move object 2,1 `put the camera in the right place. set camera to follow object position x(2),object position y(2),object position z(2),object angle y(2),50,object position y(2)+10,5,1 point camera object position x(2),object position y(2),object position z(2) loop Version: 1.0
Created: 1st Mar 2005 00:36
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com `--------------------------- `Limit Rush `Lesson 19 `--------------------------- `http://www.binarymoon.co.uk `Ben aka Mop `--------------------------- `-------- `INCLUDES `-------- `include the MatEdit LoadMatrix files #include "LoadMatrix.dba" `include the 3D sprite library #include "sprite.dba" `------ `ARRAYS `------ `declare the MatEdit variables Dim BigMatrix(600,600,1) Dim StartLoc_X(1): Dim StartLoc_Z(1):Dim Info(2) Dim TArrayX(1): Dim TArrayZ(1): Dim FKey(10,1) Dim ColData(100): Dim ZoneData(100): Dim Tiles(500,500) Dim OverTexture$(100): Dim OverName$(20): Dim ReplaceTex(100) Dim MOffsetX(25): Dim MOffsetY(25) Dim MWire(20): Dim MGhost(20): Dim Lock(20) Dim MatX#(20): Dim MatY#(20): Dim MatZ#(20) Dim MatWidth#(20): Dim MatHeight#(20) Dim TilesX(20): Dim TilesZ(20) Dim MatHi#(20): Dim MatLo#(20) `-------------- ` Hot Spot Data `-------------- Dim HotSpot(0) Dim oldHotSpot(0) `-------- ` Gravity `-------- Dim gravity#(0): gravity#(0) = 0.1 `--------- `Player Movement Arrays `--------- Dim xSpeed#(4) Dim ySpeed#(4) Dim zSpeed#(4) Dim friction#(4) Dim moveDist#(4) Dim targetCount(4) `---------- `Initialize Variables `---------- ArenaXZ_SF = 15000 `Arena Scaling Factor ArenaY_SF = 15000 LightXZ_SF# = .46 LightY_SF# = .55 `set up the program sync on sync rate 30 hide mouse autocam off `load the matrix LoadMatrix("map",1) `temporary load level info load object "media/arena.x",100 load object "media/arena_light.x",101 `scale the arena scale object 100, ArenaXZ_SF, ArenaY_SF, ArenaXZ_SF scale object 101, ArenaXZ_SF*LightXZ_SF#, ArenaY_SF*LightY_SF#, ArenaXZ_SF*LightXZ_SF# `position arena position object 100,247,189,247 position object 101,247,189,247 `add mip-mapping set matrix texture 1,2,1 set object texture 100,0,1 set object texture 101,2,1 `set fake light properties set object 101,1,1,0,1,0,0,1 ghost object on 101 `set fog properties fog on fog distance 2000 fog color RGB(128,0,0) `set ambient light amount set ambient light 10 `colour main light color light 0,RGB(0,0,160) `make a light make light 1 set point light 1,250,200,250 color light 1,RGB(255,255,100) `============================== `make a temporary player object `============================== restore data_player_positions for id = 1 to 4 make object cube id,3 hide limb id,0 `load hovercraft model load object "media/hovercraft.x",10+id load image "media/hovercraft_"+str$(id)+".bmp",40+id texture object 10+id,40+id scale object 10+id,95,95,95 set object texture 10+id,0,1 glue object to limb 10+id,id,0 ` load players starting position read xPos# read zPos# yPos# = get ground height(1,xPos#,zPos#) ` load angle read yAng# ` update the players position position object id,xPos#,yPos#,zPos# yrotate object id,yAng# `load players characteristics read friction#(id) read moveDist#(id) xSpeed#(id) = 0 zSpeed#(id) = 0 make object collision box id,-6.5,0,-6.5,7,6.5,0,0 next id for id = 1 to 4 targetCount(id)=0 next id `================================== `load target object (beam of light) `================================== load object "media/light_beam.x",200 load object "media/light_beam2.x",201 make object plain 202,15,15 load image "media/light_3.bmp",300 texture object 202,300 scale object 200,500,1500,500 scale object 201,500,750,500 ghost object on 200 ghost object on 201 `ghost object on 202 set object 200,1,1,0,1,0,0,1 set object 201,1,1,0,1,0,0,1 set object 202,1,1,0,1,0,0,1 `target light make light 3 set point light 3,0,0,0 set light range 3,1000 color light 3,RGB(0,128,255) show light 3 `--------------- `data statements `--------------- data_player_positions: `value 1 = x position `value 2 = z position `value 3 = y angle `value 4 = friction `value 5 = move distance data 262.5,212.5,0,0.974,0.075 data 212.5,262.5,90,0.98,0.055 data 262.5,312.5,180,0.975,0.06 data 312.5,262.5,270,0.965,0.07 `=================== ` Turn OFF collision `=================== set object collision off 200 `lights set object collision off 201 set object collision off 202 set object collision off 100 `arena set object collision off 101 `============================================= ` Score Board Sprites ` - using commands in sprite.dba include file `============================================= make_3d_sprite(31,6.8,6.8) make_3d_sprite(61,6.8,3.4) make_3d_sprite(32,6.8,6.8) make_3d_sprite(62,6.8,3.4) make_3d_sprite(33,6.8,6.8) make_3d_sprite(63,6.8,3.4) make_3d_sprite(34,6.8,6.8) make_3d_sprite(64,6.8,3.4) `load sprite textures for i=0 to 10 load image "media/score"+str$(i)+".bmp",30+i next i for i = 1 to 4 load image "media/name"+str$(i)+".bmp",60+i next i texture object 31,30 texture object 61,61 texture object 32,30 texture object 62,62 texture object 33,30 texture object 63,63 texture object 34,30 texture object 64,64 ghost object on 31 ghost object on 32 ghost object on 33 ghost object on 34 ghost object on 61 ghost object on 62 ghost object on 63 ghost object on 64 `--------- `MAIN LOOP `--------- main: ` set target new_target() do yAng# = object angle y(1) `the following is temporary. There will be more but it will made later `get keyboard input for movement if upkey()=1 then forward = 1 else forward = 0 if downkey()=1 then backward = 1 else backward = 0 if leftkey()=1 then left = 1 else left = 0 if rightkey()=1 then right = 1 else right = 0 `update the player move_player(1, forward, backward, left, right) `move bots for id = 2 to 4 control_player_bots(id) next id `update chase camera chase_cam(1) `check for collisions gosub update_collision `display current frame rate `text 5,5, "FPS = " + str$(screen fps()) `text 5,45, "Hot Spot = " + str$(CheckHotSpot(1)) ` create new target if player reaches target for id = 1 to 4 if checkHotspot(id)=hotSpot(0) new_target() targetCount(id)= targetCount(id) + 1 `update score board texture object 30+id,30+targetCount(id) `check to see if match is over if targetCount(id) = 10 if id = 1 then gosub player_wins else gosub player_lose endif endif next id `update taret animation gosub update_target ` draw scoreboard position_3d_sprite(61,3,1) `score indicator (car color) position_3d_sprite(31,3,4) `score position_3d_sprite(62,10,1) `score position_3d_sprite(32,10,4) `score indicator (car color) position_3d_sprite(63,17,1) `score position_3d_sprite(33,17,4) `score indicator (car color) position_3d_sprite(64,24,1) `score position_3d_sprite(34,24,4) `score indicator (car color) `update the screen sync loop `========================== ` Artificial Intelligence `========================== function control_player_bots(id) `set the movement values forward =1 backward = 0 left = 0 right = 0 `get current bot posistions xPos# = object position x(id) zPos# = object position z(id) yAng# = object angle y(id) `work out target position targetXPos#=(FKey(hotspot(0),0)*info(0))-(info(0)/2) targetZPos#=(Fkey(hotspot(0),1)*info(1))-(info(1)/2) `work out angle between payer and target angle#=atanfull(xPos#-targetXPos#,zPos#-targetZPos#)-yAng# `work out direction to turn if angle#<-180 left=1 else right=1 endif move_player(id,forward,backward,left,right) endfunction `========================== ` End the Game `========================== function End_Game() repeat text 25,50 ,"Congratulation!" text 25,60, "Press Space Key to Exit" sync until spacekey() = 1 end endfunction `=========================== ` Pick a new target location `=========================== function new_target() ` create new hot spot target repeat HotSpot(0) = rnd(7) + 1 until HotSpot(0) <> OldHotSpot(0) ` save new hot spot as old hot spot OldHotSpot(0) = HotSpot(0) `locate the center of the hot spot tile xPos# = (FKey(HotSpot(0),0) * Info(0) - Info(0)/2) zPos# = (FKey(HotSpot(0),1) * Info(1) - Info(1)/2) `locate the height of the hot spot tile yPos# = get ground height(1,xPos#,zPos#) `position beam of light position object 200, xPos#,yPos#,zPos# position object 201, xPos#,yPos#,zPos# position object 202, xPos#,yPos#,zPos# ` Positon lighting position light 3,xPos#,yPos#+10,zPos# endfunction `====================================================== ` Work out the current hotspot the player is on (if any) `====================================================== function CheckHotSpot(id) ` reset the currentHotSpot return variable currentHotSpot = 0 `work out the current tile position of the player tileX = int(object position x(id)/Info(0)) + 1 tileZ = int(object position z(id)/Info(1)) + 1 `check for a hot spot match for hotSpot =1 to 10 if tileX = FKey(hotSpot,0) and tileZ = FKey(hotSpot,1) currentHotSpot = hotSpot exit endif next hotSpot endfunction currentHotSpot `============= `chase cam `============= function chase_cam(id) `work out the angle of the object being chased yAng#= wrapvalue(object angle y(id)+180) `grab the objects current position xPos# = object position x(id) yPos# = object position y(id) zPos# = object position z(id) `other variables camDist = 15 camHeight = 1 `work out new position xCamPos# = newxvalue(xPos#,yAng#,camDist) zCamPos# = newzvalue(zPos#,yAng#,camDist) `camera collision if xCamPos#>485 then xCamPos#=485 if zCamPos#>485 then zCamPos#=485 if xCamPos#<15 then XCamPos#=15 if zCamPos#<15 then zCamPos#=15 `work out camera height yCamPos# = get ground height (1,xCamPos#,zCamPos#)+camHeight if yCamPos# < yPos#+camHeight then yCamPos# = yPos#+camHeight `smooth out the camera effects xCamPos#=curvevalue(xCamPos#,camera position x(),4) yCamPos#=curvevalue(yCamPos#,camera position y(),4) zCamPos#=curvevalue(zCamPos#,camera position z(),4) `update camera position position camera xCamPos#,yCamPos#+camHeight,zCamPos# point camera xPos#, yPos#+camHeight, zPos# endfunction `-------------------------- ` move the specified player `-------------------------- function move_player(id, forward, backward, left, right) `---------------------------------- ` set object floor offset `---------------------------------- floor_offset# = 2.0 `----------------------------------- ` get the required object properties `----------------------------------- xPos# = object position x(id) yPos# = object position y(id) zPos# = object position z(id) yAng# = object angle y(id) `----------------------------- ` Sort out the basic movements `----------------------------- if forward = 1 `move forward code here xSpeed#(id) = xSpeed#(id) + newxvalue(0,yAng#,moveDist#(id)) zSpeed#(id) = zSpeed#(id) + newzvalue(0,yAng#,moveDist#(id)) endif if backward = 1 `move backward code here xSpeed#(id) = xSpeed#(id) + newxvalue(0,yAng#,moveDist#(id) * -1) zSpeed#(id) = zSpeed#(id) + newzvalue(0,yAng#,moveDist#(id) * -1) endif if left = 1 `move left code here yrotate object id, wrapvalue(yAng#-4) endif if right = 1 ` move right code here yrotate object id, wrapvalue(yAng#+4) endif `--------------------------------------------------- ` sort out friction and other physics related things `--------------------------------------------------- ` Work out value with friction and gravity xSpeed#(id) = xSpeed#(id) * friction#(id) zSpeed#(id) = zSpeed#(id) * friction#(id) ySpeed#(id) = ySpeed#(id) + gravity#(0) ` Work out the new position xPos# = xPos# + xSpeed#(id) zPos# = zPos# + zSpeed#(id) yPos# = yPos# - ySpeed#(id) `collision if xPos#>490 then xPos#=490 if zPos#>490 then zPos#=490 if xPos#<5 then xPos#=5 if zPos#<5 then zPos#=5 ` Work out the height of the character if yPos# < get ground height(1, xPos#, zPos#)+ floor_offset# ySpeed#(id) = ySpeed#(id) = (yPos# - get ground height(1, xPos#, zPos#)) yPos# = get ground height(1, xPos#, zPos#) + floor_offset# `------------------------------ `tilt the vehicle to the ground `------------------------------ distVal#=1 `work out the positions of the front, back, left and right of the vehicle ang#=yAng# frontX#=newxvalue(xPos#,ang#,distVal#) frontZ#=newzvalue(zPos#,ang#,distVal#) ang#=yAng#+180 backX#=newxvalue(xPos#,ang#,distVal#) backZ#=newzvalue(zPos#,ang#,distVal#) ang#=yAng#+90 leftX#=newxvalue(xPos#,ang#,distVal#) leftZ#=newzvalue(zPos#,ang#,distVal#) ang#=yAng#-90 rightX#=newxvalue(xPos#,ang#,distVal#) rightZ#=newzvalue(zPos#,ang#,distVal#) `work out the different heights frontHeight# = get ground height(1,frontX#,frontZ#) backHeight# = get ground height(1,backX#,backZ#) leftHeight# = get ground height(1,leftX#,leftZ#) rightHeight# = get ground height(1,rightX#,rightZ#) `Work out tilt values xAng#=wrapvalue((frontHeight#-backHeight#)*30) zAng#=wrapvalue((leftHeight#-rightHeight#)*30) `Work out tilt values xAng#=curveangle((frontHeight#-backHeight#)*30,object angle x(id+10),5) zAng#=curveangle((leftHeight#-rightHeight#)*30,object angle z(id+10),5) `----------------- `slide down slopes `----------------- xMoveDist#=(backHeight#-frontHeight#)/30 zMoveDist#=(leftHeight#-rightHeight#)/30 `adjust forward/ backward momentum xSpeed#(id)=xSpeed#(id)+newxvalue(0,yAng#,xMoveDist#) zSpeed#(id)=zSpeed#(id)+newzvalue(0,yAng#,xMoveDist#) `adjust left/ right momentum xSpeed#(id)=xSpeed#(id)+newxvalue(0,yAng#-90,zMoveDist#) zSpeed#(id)=zSpeed#(id)+newzvalue(0,yAng#-90,zMoveDist#) `update the vehicle rotation rotate object id+10,xAng#,180,zAng# endif angle#=atanfull(xPos#-targetXPos,zPos#-targetZPos)-yAng ` Reposition the player object position object id, xPos#, yPos# , zPos# `display camera object postition for player 1 if id = 1 `text 5,15, "X Position = " + str$(xPos#) `text 5,25, "Y Position = " + str$(yPos#) `text 5,35, "Z Position = " + str$(zPos#) endif endfunction `================= ` rotate the taget `================= update_target: yrotate object 200, wrapvalue(object angle y(200)+2) yrotate object 201, wrapvalue(object angle y(201)-2) yrotate object 202, wrapvalue(object angle y(202)-60) return `====================== ` update collision data `====================== update_collision: `---------------------------------- ` set object floor offset `---------------------------------- floor_offset# = 2.0 for id = 1 to 4 xPos# = object position x(id) zPos# = object position z(id) yPos# = get ground height(1,xPos#,zPos#) + floor_offset# pCollision = object collision(id,0) if pCollision > 0 xPos# = xPos# - (get object collision x()/2) zPos# = zPos# - (get object collision z()/2) endif position object id,xPos#,yPos#,zPos# next id return `============ ` Player Wins `============ player_wins: yAng# = object angle y(1) do for id = 1 to 4 control_player_bots(id) if CheckHotSpot(id) = hotspot(0) then new_target() next id `update camera position yAng# = yAng# + 2 xCamPos# = newxvalue(object position x(1),yAng#,25) zCamPos# = newzvalue(object position z(1),yAng#,25) yCamPos# = get ground height(1, xCamPos#, zCamPos#) position camera xCamPos#,yCamPos#+20,zCamPos# point camera object position x(1), object position y(1)+ 2, object position z(1) gosub update_target gosub update_collision sync loop return `============ ` Player Lose `============ player_lose: end return Version: 1.0
Created: 1st Mar 2005 00:30
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com `--------------------------- `Limit Rush `Lesson 13 `Level Complete `--------------------------- `http://www.binarymoon.co.uk `Ben aka Mop `--------------------------- `-------- `INCLUDES `-------- `include the MatEdit LoadMatrix files #include "LoadMatrix.dba" `------ `ARRAYS `------ `declare the MatEdit variables Dim BigMatrix(600,600,1) Dim StartLoc_X(1): Dim StartLoc_Z(1):Dim Info(2) Dim TArrayX(1): Dim TArrayZ(1): Dim FKey(10,1) Dim ColData(100): Dim ZoneData(100): Dim Tiles(500,500) Dim OverTexture$(100): Dim OverName$(20): Dim ReplaceTex(100) Dim MOffsetX(25): Dim MOffsetY(25) Dim MWire(20): Dim MGhost(20): Dim Lock(20) Dim MatX#(20): Dim MatY#(20): Dim MatZ#(20) Dim MatWidth#(20): Dim MatHeight#(20) Dim TilesX(20): Dim TilesZ(20) Dim MatHi#(20): Dim MatLo#(20) `-------------- ` Hot Spot Data `-------------- Dim HotSpot(0) Dim oldHotSpot(0) `-------- ` Gravity `-------- Dim gravity#(0): gravity#(0) = 0.1 `--------- `Player Movement Arrays `--------- Dim xSpeed#(4) Dim ySpeed#(4) Dim zSpeed#(4) Dim friction#(4) Dim moveDist#(4) Dim targetCount(4) `---------- `Initialize Variables `---------- ArenaXZ_SF = 15000 `Arena Scaling Factor ArenaY_SF = 15000 LightXZ_SF# = .46 LightY_SF# = .55 `set up the program sync on sync rate 30 hide mouse autocam off `load the matrix LoadMatrix("map",1) `temporary load level info load object "media/arena.x",100 load object "media/arena_light.x",101 `scale the arena scale object 100, ArenaXZ_SF, ArenaY_SF, ArenaXZ_SF scale object 101, ArenaXZ_SF*LightXZ_SF#, ArenaY_SF*LightY_SF#, ArenaXZ_SF*LightXZ_SF# `position arena position object 100,247,189,247 position object 101,247,189,247 `add mip-mapping set matrix texture 1,2,1 set object texture 100,0,1 set object texture 101,2,1 `set fake light properties set object 101,1,1,0,1,0,0,1 ghost object on 101 `set fog properties fog on fog distance 2000 fog color RGB(128,0,0) `set ambient light amount set ambient light 10 `colour main light color light 0,RGB(0,0,160) `make a light make light 1 set point light 1,250,200,250 color light 1,RGB(255,255,100) `============================== `make a temporary player object `============================== restore data_player_positions id = 1 make object cube id,3 hide limb id,0 `load hovercraft model load object "media/hovercraft.x",10+id load image "media/hovercraft_"+str$(id)+".bmp",40+id texture object 10+id,40+id scale object 10+id,95,95,95 set object texture 10+id,0,1 glue object to limb 10+id,id,0 ` load position read xPos# read zPos# yPos# = get ground height(1,xPos#,zPos#) ` load angle read yAng# ` update the players position position object id,xPos#,yPos#,zPos# yrotate object id,yAng# id = 1 friction#(id) = .97 moveDist#(id) = .065 xSpeed#(id) = 0 zSpeed#(id) = 0 `================================== `load target object (beam of light) `================================== load object "media/light_beam.x",200 load object "media/light_beam2.x",201 make object plain 202,15,15 load image "media/light_3.bmp",30 texture object 202,30 scale object 200,500,1500,500 scale object 201,500,750,500 ghost object on 200 ghost object on 201 `ghost object on 202 set object 200,1,1,0,1,0,0,1 set object 201,1,1,0,1,0,0,1 set object 202,1,1,0,1,0,0,1 `target light make light 3 set point light 3,0,0,0 set light range 3,1000 color light 3,RGB(0,128,255) show light 3 `--------------- `data statements `--------------- data_player_positions: data 262.5,212.5,0 data 212.5,262.5,90 data 262.5,312.5,180 data 312.5,262.5,270 `--------- `MAIN LOOP `--------- main: ` set target new_target() do yAng# = object angle y(1) `the following is temporary. There will be more but it will made later `get keyboard input for movement if upkey()=1 then forward = 1 else forward = 0 if downkey()=1 then backward = 1 else backward = 0 if leftkey()=1 then left = 1 else left = 0 if rightkey()=1 then right = 1 else right = 0 `update the player move_player(1, forward, backward, left, right) `update chase camera chase_cam(1) `display current frame rate text 5,5, "FPS = " + str$(screen fps()) text 5,45, "Hot Spot = " + str$(CheckHotSpot(1)) ` create new target if player reaches target if checkHotspot(1)=hotSpot(0) new_target() targetCount(1)= targetCount(1) + 1 if targetCount(1) = 10 then End_Game() endif `update taret animation gosub update_target `update the screen sync loop `========================== ` End the Game `========================== function End_Game() repeat text 25,50 ,"Congratulation!" text 25,60, "Press Space Key to Exit" sync until spacekey() = 1 end endfunction `=========================== ` Pick a new target location `=========================== function new_target() ` create new hot spot target repeat HotSpot(0) = rnd(7) + 1 until HotSpot(0) <> OldHotSpot(0) ` save new hot spot as old hot spot OldHotSpot = HotSpot `locate the center of the hot spot tile xPos# = (FKey(HotSpot(0),0) * Info(0) - Info(0)/2) zPos# = (FKey(HotSpot(0),1) * Info(1) - Info(1)/2) `locate the height of the hot spot tile yPos# = get ground height(1,xPos#,zPos#) `position beam of light position object 200, xPos#,yPos#,zPos# position object 201, xPos#,yPos#,zPos# position object 202, xPos#,yPos#,zPos# ` Positon lighting position light 3,xPos#,yPos#+10,zPos# endfunction `====================================================== ` Work out the current hotspot the player is on (if any) `====================================================== function CheckHotSpot(id) ` reset the currentHotSpot return variable currentHotSpot = 0 `work out the current tile position of the player tileX = int(object position x(id)/Info(0)) + 1 tileZ = int(object position z(id)/Info(1)) + 1 `check for a hot spot match for hotSpot =1 to 10 if tileX = FKey(hotSpot,0) and tileZ = FKey(hotSpot,1) currentHotSpot = hotSpot exit endif next hotSpot endfunction currentHotSpot `============= `chase cam `============= function chase_cam(id) `work out the angle of the object being chased yAng#= wrapvalue(object angle y(id)+180) `grab the objects current position xPos# = object position x(id) yPos# = object position y(id) zPos# = object position z(id) `other variables camDist = 15 camHeight = 1 `work out new position xCamPos# = newxvalue(xPos#,yAng#,camDist) zCamPos# = newzvalue(zPos#,yAng#,camDist) `camera collision if xCamPos#>485 then xCamPos#=485 if zCamPos#>485 then zCamPos#=485 if xCamPos#<15 then XCamPos#=15 if zCamPos#<15 then zCamPos#=15 `work out camera height yCamPos# = get ground height (1,xCamPos#,zCamPos#)+camHeight if yCamPos# < yPos#+camHeight then yCamPos# = yPos#+camHeight `smooth out the camera effects xCamPos#=curvevalue(xCamPos#,camera position x(),4) yCamPos#=curvevalue(yCamPos#,camera position y(),4) zCamPos#=curvevalue(zCamPos#,camera position z(),4) `update camera position position camera xCamPos#,yCamPos#+camHeight,zCamPos# point camera xPos#, yPos#+camHeight, zPos# endfunction `-------------------------- ` move the specified player `-------------------------- function move_player(id, forward, backward, left, right) `---------------------------------- ` set object floor offset `---------------------------------- floor_offset# = 2.0 `----------------------------------- ` get the required object properties `----------------------------------- xPos# = object position x(id) yPos# = object position y(id) zPos# = object position z(id) yAng# = object angle y(id) `----------------------------- ` Sort out the basic movements `----------------------------- if forward = 1 `move forward code here xSpeed#(id) = xSpeed#(id) + newxvalue(0,yAng#,moveDist#(id)) zSpeed#(id) = zSpeed#(id) + newzvalue(0,yAng#,moveDist#(id)) endif if backward = 1 `move backward code here xSpeed#(id) = xSpeed#(id) + newxvalue(0,yAng#,moveDist#(id) * -1) zSpeed#(id) = zSpeed#(id) + newzvalue(0,yAng#,moveDist#(id) * -1) endif if left = 1 `move left code here yrotate object id, wrapvalue(yAng#-4) endif if right = 1 ` move right code here yrotate object id, wrapvalue(yAng#+4) endif `--------------------------------------------------- ` sort out friction and other physics related things `--------------------------------------------------- ` Work out value with friction and gravity xSpeed#(id) = xSpeed#(id) * friction#(id) zSpeed#(id) = zSpeed#(id) * friction#(id) ySpeed#(id) = ySpeed#(id) + gravity#(0) ` Work out the new position xPos# = xPos# + xSpeed#(id) zPos# = zPos# + zSpeed#(id) yPos# = yPos# - ySpeed#(id) `collision if xPos#>490 then xPos#=490 if zPos#>490 then zPos#=490 if xPos#<5 then xPos#=5 if zPos#<5 then zPos#=5 ` Work out the height of the character if yPos# < get ground height(1, xPos#, zPos#)+ floor_offset# ySpeed#(id) = ySpeed#(id) = (yPos# - get ground height(1, xPos#, zPos#)) yPos# = get ground height(1, xPos#, zPos#) + floor_offset# `------------------------------ `tilt the vehicle to the ground `------------------------------ distVal#=1 `work out the positions of the front, back, left and right of the vehicle ang#=yAng# frontX#=newxvalue(xPos#,ang#,distVal#) frontZ#=newzvalue(zPos#,ang#,distVal#) ang#=yAng#+180 backX#=newxvalue(xPos#,ang#,distVal#) backZ#=newzvalue(zPos#,ang#,distVal#) ang#=yAng#+90 leftX#=newxvalue(xPos#,ang#,distVal#) leftZ#=newzvalue(zPos#,ang#,distVal#) ang#=yAng#-90 rightX#=newxvalue(xPos#,ang#,distVal#) rightZ#=newzvalue(zPos#,ang#,distVal#) `work out the different heights frontHeight# = get ground height(1,frontX#,frontZ#) backHeight# = get ground height(1,backX#,backZ#) leftHeight# = get ground height(1,leftX#,leftZ#) rightHeight# = get ground height(1,rightX#,rightZ#) `Work out tilt values xAng#=wrapvalue((frontHeight#-backHeight#)*30) zAng#=wrapvalue((leftHeight#-rightHeight#)*30) `Work out tilt values xAng#=curveangle((frontHeight#-backHeight#)*30,object angle x(id+10),5) zAng#=curveangle((leftHeight#-rightHeight#)*30,object angle z(id+10),5) `----------------- `slide down slopes `----------------- xMoveDist#=(backHeight#-frontHeight#)/30 zMoveDist#=(leftHeight#-rightHeight#)/30 `adjust forward/ backward momentum xSpeed#(id)=xSpeed#(id)+newxvalue(0,yAng#,xMoveDist#) zSpeed#(id)=zSpeed#(id)+newzvalue(0,yAng#,xMoveDist#) `adjust left/ right momentum xSpeed#(id)=xSpeed#(id)+newxvalue(0,yAng#-90,zMoveDist#) zSpeed#(id)=zSpeed#(id)+newzvalue(0,yAng#-90,zMoveDist#) `update the vehicle rotation rotate object id+10,xAng#,180,zAng# endif ` Reposition the player object position object id, xPos#, yPos# , zPos# `display camera object postition for player 1 if id = 1 text 5,15, "X Position = " + str$(xPos#) text 5,25, "Y Position = " + str$(yPos#) text 5,35, "Z Position = " + str$(zPos#) endif endfunction `================= ` rotate the taget `================= update_target: yrotate object 200, wrapvalue(object angle y(200)+2) yrotate object 201, wrapvalue(object angle y(201)-2) yrotate object 202, wrapvalue(object angle y(202)-60) return Version: 1.0
Created: 1st Mar 2005 00:29
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com `--------------------------- `Limit Rush `Lesson 03 `--------------------------- `http://www.binarymoon.co.uk `Ben aka Mop `--------------------------- `-------- `INCLUDES `-------- `include the MatEdit LoadMatrix files #include "LoadMatrix.dba" `------ `ARRAYS `------ `declare the MatEdit variables Dim BigMatrix(600,600,1) Dim StartLoc_X(1): Dim StartLoc_Z(1):Dim Info(2) Dim TArrayX(1): Dim TArrayZ(1): Dim FKey(10,1) Dim ColData(100): Dim ZoneData(100): Dim Tiles(500,500) Dim OverTexture$(100): Dim OverName$(20): Dim ReplaceTex(100) Dim MOffsetX(25): Dim MOffsetY(25) Dim MWire(20): Dim MGhost(20): Dim Lock(20) Dim MatX#(20): Dim MatY#(20): Dim MatZ#(20) Dim MatWidth#(20): Dim MatHeight#(20) Dim TilesX(20): Dim TilesZ(20) Dim MatHi#(20): Dim MatLo#(20) `---------- `Initialize Variables `---------- ArenaXYZ_SF = 15000 LightXZ_SF# = .46 LightY_SF# = .55 `set up the program sync on sync rate 40 hide mouse autocam off `load the matrix LoadMatrix("map",1) `temporary load level info load object "media/arena.x",100 load object "media/arena_light.x",101 `scale the arena scale object 100, ArenaXYZ_SF, ArenaXYZ_SF, ArenaXYZ_SF scale object 101, ArenaXYZ_SF*LightXZ_SF#, ArenaXYZ_SF*LightY_SF#, ArenaXYZ_SF*LightXZ_SF# `position arena position object 100,247,189,247 position object 101,247,189,247 `add mip-mapping set matrix texture 1,2,1 set object texture 100,0,1 set object texture 101,2,1 `set fake light properties set object 101,1,1,0,1,0,0,1 ghost object on 101 `set fog properties fog on fog distance 2000 fog color RGB(128,0,0) `set ambient light amount set ambient light 10 `colour main light color light 0,RGB(0,0,160) `make a light make light 1 set point light 1,250,200,250 color light 1,RGB(255,255,100) `make a temporary player object make object cube 1,5 position object 1,250,1,250 `--------- `MAIN LOOP `--------- main: do yAng# = object angle y(1) `the following is temporary. There will be more but it will made later `get keyboard input for movement if upkey()=1 then move object 1, 4 if downkey()=1 then move object 1, -4 if leftkey()=1 then yrotate object 1, wrapvalue(yAng# - 4) if rightkey()=1 then yrotate object 1, wrapvalue(yAng# + 4) `sort out the camera height xPos#= object position x(1) zPos#= object position z(1) yPos#= get ground height(1,xPos#,zPos#) `update the objexts position position object 1, xPos#,yPos#,zPos# `update chase camera chase_cam(1) `display camera object postition text 5,5, "X Position = " + str$(xPos#) text 5,25, "Y Position = " + str$(yPos#) text 5,45, "Z Position = " + str$(zPos#) `update the screen sync loop `============= `chase cam `============= function chase_cam(id) `work out the angle of the object being chased yAng#= wrapvalue(object angle y(id)+180) `grab the objects current position xPos# = object position x(id) yPos# = object position y(id) zPos# = object position z(id) `other variables camDist = 15 camHeight = 5 `work out new position xCamPos# = newxvalue(xPos#,yAng#,camDist) zCamPos# = newzvalue(zPos#,yAng#,camDist) `work out camera height yCamPos# = get ground height (1,xCamPos#,zCamPos#)+camHeight if yCamPos# < yPos#+camHeight then yCamPos# = yPos#+camHeight `update camera position position camera xCamPos#,yCamPos#+camHeight,zCamPos# point camera xPos#, yPos#+camHeight, zPos# endfunction Version: 1.0
Created: 1st Mar 2005 00:28
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com `--------------------------- `Limit Rush `Lesson 02 `--------------------------- `http://www.binarymoon.co.uk `Ben aka Mop `--------------------------- `-------- `INCLUDES `-------- `include the MatEdit LoadMatrix files #include "LoadMatrix.dba" `------ `ARRAYS `------ `declare the MatEdit variables Dim BigMatrix(600,600,1) Dim StartLoc_X(1): Dim StartLoc_Z(1):Dim Info(2) Dim TArrayX(1): Dim TArrayZ(1): Dim FKey(10,1) Dim ColData(100): Dim ZoneData(100): Dim Tiles(500,500) Dim OverTexture$(100): Dim OverName$(20): Dim ReplaceTex(100) Dim MOffsetX(25): Dim MOffsetY(25) Dim MWire(20): Dim MGhost(20): Dim Lock(20) Dim MatX#(20): Dim MatY#(20): Dim MatZ#(20) Dim MatWidth#(20): Dim MatHeight#(20) Dim TilesX(20): Dim TilesZ(20) Dim MatHi#(20): Dim MatLo#(20) `---------------------------------- `Initialize Arena Scaling Variables `---------------------------------- ArenaXYZ_SF = 15000 LightXZ_SF# = .46 LightY_SF# = .55 `set up the program sync on sync rate 40 hide mouse autocam off `load the matrix LoadMatrix("map",1) `temporary load level info load object "media/arena.x",100 load object "media/arena_light.x",101 `scale the arena scale object 100, ArenaXYZ_SF, ArenaXYZ_SF, ArenaXYZ_SF scale object 101, ArenaXYZ_SF*LightXZ_SF#, ArenaXYZ_SF*LightY_SF#, ArenaXYZ_SF*LightXZ_SF# `position arena position object 100,247,188,247 position object 101,247,188,247 `add mip-mapping set matrix texture 1,2,1 set object texture 100,0,1 set object texture 101,2,1 `set fake light properties set object 101,1,1,0,1,0,0,1 ghost object on 101 `set fog properties fog on fog distance 2000 fog color RGB(128,0,0) `set amobient light amount set ambient light 10 `colour main light color light 0,RGB(0,0,160) `make a light make light 1 set point light 1,250,200,250 color light 1,RGB(255,255,100) `--------- `MAIN LOOP `--------- main: do `the following is temporary. There will be more but it will made later `get keyboard input for movement if upkey()=1 then move camera 4 if downkey()=1 then move camera -4 if leftkey()=1 then yrotate camera wrapvalue(camera angle y()-4) if rightkey()=1 then yrotate camera wrapvalue(camera angle y()+4) `sort out the camera height x#=camera position x() z#=camera position z() y#=get ground height(1,x#,z#)+10 ` debug code - show the position of the camera position camera x#,y#,z# text 5,5, "X Position = " + str$(x#) text 5,25, "Y Position = " + str$(y#) text 5,45, "Z Position = " + str$(z#) `update the screen sync loop Version: 1.0
Created: 1st Mar 2005 00:27
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com `--------------------------- `Limit Rush `Lesson 01 `--------------------------- `http://www.binarymoon.co.uk `Ben aka Mop `--------------------------- `-------- `INCLUDES `-------- `include the MatEdit LoadMatrix files #include "LoadMatrix.dba" `------ `ARRAYS `------ `declare the MatEdit variables Dim BigMatrix(600,600,1) Dim StartLoc_X(1): Dim StartLoc_Z(1):Dim Info(2) Dim TArrayX(1): Dim TArrayZ(1): Dim FKey(10,1) Dim ColData(100): Dim ZoneData(100): Dim Tiles(500,500) Dim OverTexture$(100): Dim OverName$(20): Dim ReplaceTex(100) Dim MOffsetX(25): Dim MOffsetY(25) Dim MWire(20): Dim MGhost(20): Dim Lock(20) Dim MatX#(20): Dim MatY#(20): Dim MatZ#(20) Dim MatWidth#(20): Dim MatHeight#(20) Dim TilesX(20): Dim TilesZ(20) Dim MatHi#(20): Dim MatLo#(20) `set up the program sync on sync rate 40 hide mouse `load the matrix LoadMatrix("map",1) `--------- `MAIN LOOP `--------- main: do `the following is temporary. There will be more but it will made later `get keyboard input for movement if upkey()=1 then move camera 4 if downkey()=1 then move camera -4 if leftkey()=1 then yrotate camera wrapvalue(camera angle y()-4) if rightkey()=1 then yrotate camera wrapvalue(camera angle y()+4) `sort out the camera height x#=camera position x() z#=camera position z() y#=get ground height(1,x#,z#)+10 `position the camera position camera x#,y#,z# `update the screen sync loop Version: 1.0
Created: 1st Mar 2005 00:26
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com Rem Project: MatrixMaster Rem Created: 5/6/04 4:25:55 PM Rem ***** Main Source File ***** rem this program written by Richard Sardini Jr rem my e-mail:noramdia@adelphia.net rem my phone:814-504-6033 rem check end of program for code snippet to load matrix into your dark basic programs set display mode 800,600,16 create bitmap 1,50,50 ink RGB(128,128,0),0:for x=0 to 50:line x,0,x,50:next x ink RGB(0,128,0),0:for x=0 to 200:dot rnd(50),rnd(50):next x ink RGB(255,128,0),0:for x=0 to 50:dot rnd(50),rnd(50):next x ink RGB(128,128,255),0:for x=0 to 90:dot rnd(50),rnd(50):next x ink RGB(255,255,255),0:for x=0 to 20:dot rnd(50),rnd(50):next x get image 1,0,0,50,50 delete bitmap 1 hint=1:hints=21:hintdelay=750 dim hint$(21):hintc1=50:ghost=-1 hint$(1)="Green marker=unselected coordinate Red marker=selected coordinate." hint$(2)="Press ' w ' to toggle wireframe on and off." hint$(3)="Press ' s ' to select all visible coordinate markers." hint$(4)="Press ' t ' to toggle or invert all visible coordinate markers." hint$(5)="Press ' u ' to un-select all visible coordinate markers that are currently selected." hint$(6)="Press ' + ' or ' - ' to zoom in and out or turn the mouse wheel." hint$(7)="Press arrow keys to pan your view or press and hold mouse botton 2 and move mouse." hint$(8)="Press and hold both mouse buttons 1 and 2 and move mouse to rotate camera view." hint$(9)="Left click and drag mouse-(top left to bottom right)-and red box will appear to select markers in box." hint$(10)="Left click and drag mouse-(bottom right to top left)-and yellow box will appear to toggle or invert selected markers in box." hint$(11)="Press ' h ' to hide all unselected markers-this is handy to isolate work areas." hint$(12)="Press ' h ' again to show all hidden markers. Use this feature to hide and prevent selecting backround markers." hint$(13)="Press and hold mouse wheel button 3 and move mouse up and down to lower or raise selected markers respectively." hint$(14)="Or use keyboard less than ' < ' or greater than ' > ' to lower or raise selected markers respectively." hint$(15)="Press ' n ' anytime to start a new matrix." hint$(16)="Set the cross hairs on your destination point and then zoom in." hint$(17)="Press ' z ' to zip to the next hint." hint$(18)="Press ' L ' to level the matrix back to zero." hint$(19)="Left click on marker to toggle coordinate marker selection." hint$(20)="Press ' g ' to toggle ghost matrix on and off" hint$(21)="Press ' escape ' key anytime to exit MATRIX MASTER" startover: set text size 16 set current bitmap 0 load=0 cls rgb(0,0,0):ink RGB(255,255,0),0 set cursor screen width()/2-20,0 print "MATRIX-MASTER Matrix Editor" ink rgb(255,255,255),0 print redomatrix: input "Give your matrix a name and press enter>";matname$:sleep 200 redoinput: print "Is this matrix name ";:ink rgb(0,255,0),0:print matname$;:ink rgb(255,255,255),0:print " correct?(y/n)>" redoinkey: g$=inkey$() if g$<>"n" and g$<>"y" and g$<>"" then print "Please confirm your matrix name>":sleep 500:goto redoinput if g$="n" then goto redomatrix if g$="y" then goto redoxsize goto redoinkey redoxsize: print "Matrix name accepted":sleep 1000:cls rgb(0,0,0):ink RGB(255,255,0),0 set cursor screen width()/2-20,0 print "MATRIX-MASTER Matrix Editor" ink rgb(255,255,255),0 print input "Input matrix size X and press enter>";matsizex if matsizex<1 or matsizex>10000 then print "Bad input-try again>":sleep 500:goto redoxsize matsizex=int(matsizex) redozsize: input "Input matrix size Z and press enter>";matsizez if matsizez<1 or matsizez>10000 then print "Bad input-try again>":sleep 500:goto redozsize matsizez=int(matsizez) redoxseg: input "Input matrix segment X and press enter>";matsegx if matsegx<1 or matsegx>matsizex/2 then print "Bad input-try again>":sleep 500:goto redoxseg matsegx=int(matsegx) redozseg: input "Input matrix segment Z and press enter>";matsegz if matsegz<1 or matsegz>matsizez/2 then print "Bad input-try again>":sleep 500:goto redozseg matsegz=int(matsegz) print "Matrix parameters accepted" print "Working..."; sleep 500 backdrop on dim height((matsegx+1)*(matsegz+1)) dim xpos((matsegx+1)*(matsegz+1)):dim zpos((matsegz+1)*(matsegx+1)) loaded: if matsizex>500 and matsizez>500 then size=6 else size=2 if matsizex>2000 and matsizez>2000 then size=10 if matsizex>5000 and matsizez>5000 then size=30 dim objstat((matsegx+1)*(matsegz+1)) matsegx1=matsizex/matsegx:matsegz1=matsizez/matsegz banding=0:mx1=0:mx2=0:my1=0:my2=0:hide=-1 objnum=1 for z=0 to matsegz for x=0 to matsegx objstat(objnum)=-1 finalcount=objnum inc objnum next x print "."; next z sync on autocam off make matrix 1,matsizex,matsizez,matsegx,matsegz prepare matrix texture 1,1,1,1 update matrix 1 make object cube 50000,10:position object 50000,-10,0,-10:color object 50000,RGB(0,255,255) if load=1 for x=1 to finalcount read long 1,xpos(x) read long 1,zpos(x) read long 1,height(x) next x close file 1 endif load=0 objnum=1 for z=0 to matsegz for x=0 to matsegx make object sphere objnum,size:color object objnum,rgb(0,255,0) position object objnum,x*matsegx1,height(objnum),z*matsegz1 set matrix height 1,x,z,height(objnum) if load=1 then goto skipassign xpos(objnum)=x:zpos(objnum)=z skipassign: inc objnum next x next z update matrix 1 set camera range 1,100000 position camera 0,200,0 point camera 0,0,200 mousexold#=mousex():mouseyold#=mousey() mainloop: do dec hintdelay if hintdelay<0 then hintdelay=850:inc hint if hint>hints then hint=1 if inkey$()="z" inc hint if hint>hints then hint=1 hintdelay=1200 sleep 200 endif if inkey$()="n" sync off:backdrop off:set matrix wireframe on 1 set cursor 0,0:cls rgb(0,0,0):ink RGB(255,255,255),0 print "Confirm! Do you want to start a new matrix?(y/n)" print "You may want to answer no and save this matrix first lest it be lost." sleep 500 getagain5: g$=inkey$() if g$<>"y" and g$<>"n" then goto getagain5 if g$="y" for x=1 to finalcount:delete object x:next x:delete object 50000 delete matrix 1 undim xpos(finalcount):undim zpos(finalcount) undim height(finalcount):undim objstat(finalcount) sleep 200 goto startover endif if g$="n" sync on:backdrop on endif sleep 500 set matrix wireframe off 1 endif if inkey$()="g" ghost=ghost*-1 if ghost=1 ghost matrix on 1 endif if ghost=-1 ghost matrix off 1 endif sleep 200 endif if inkey$()="l" sync off:backdrop off cls rgb(0,0,0):ink rgb(255,255,255),0 print "Are you sure you want to level your matrix back to zero?(y/n)" sleep 200 getagain6: g$=inkey$() if g$<>"y" and g$<>"n" then goto getagain6 if g$="y" for x=1 to finalcount height(x)=0 set matrix height 1,xpos(x),zpos(x),height(x) position object x,xpos(x)*matsegx1,height(x),zpos(x)*matsegz1 objstat(x)=-1:color object x,rgb(0,255,0) next x update matrix 1 endif sync on:backdrop on endif if inkey$()="1" then goto savematrix if inkey$()="2" then goto loadmatrix base=get ground height(1,0,0):position object 50000,-10,base,-10 mousexnew#=mousexold#-mousex():mouseynew#=mouseyold#-mousey() if upkey()=1 or mouseclick()=2 and mouseynew#>0 pitch camera down 2 endif if downkey()=1 or mouseclick()=2 and mouseynew#<0 pitch camera up 2 endif if leftkey()=1 or mouseclick()=2 and mousexnew#>0 turn camera left 2 endif if rightkey()=1 or mouseclick()=2 and mousexnew#<0 turn camera right 2 endif if mousezold<mousez() or inkey$()="+" move camera 20*size endif if mousezold>mousez() or inkey$()="-" move camera -20*size endif if banding=1 then goto skiptilt if mouseclick()=3 and mousexnew#>0 roll camera left 2 endif if mouseclick()=3 and mousexnew#<0 roll camera right 2 endif skiptilt: if banding=1 then goto skipfirst if mouseclick()=1 mx1=mousex():my1=mousey():banding=1 endif skipfirst: if banding=1 then mx2=mousex():my2=mousey() if mx1>mx2 and my1<my2 or mx1<mx2 and my1>my2 then banding=0 if banding=1 and mouseclick()=0 if mx1<mx2 for x=1 to finalcount ox=object screen x(x):oy=object screen y(x) if object visible(x)=1 if ox>mx1 and ox<mx2 and oy>my1 and oy<my2 objstat(x)=1:color object x,rgb(255,0,0) endif endif next x endif if mx1>mx2 for x=1 to finalcount ox=object screen x(x):oy=object screen y(x) if object visible(x)=1 if ox<mx1 and ox>mx2 and oy<my1 and oy>my2 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) endif endif next x endif banding=0 endif if banding=1 and mx1<>mx2 and my1<>my2 then goto skipselect if mousexnew#=0 and mouseynew#=0 if mouseclick()=1 and mx1=mx2 and banding=1 and mx1=mx2 and my1=my2 for x=1 to finalcount if object in screen(x)=1 if object visible(x)=1 sx=object screen x(x):sy=object screen y(x) if mousex()>sx-5 and mousex()<sx+5 and mousey()>sy-5 and mousey()<sy+5 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) sleep 200 x=finalcount:banding=0 endif endif endif next x sleep 200 endif endif skipselect: if mouseclick()=4 and mouseynew#>0 or inkey$()="." for x=1 to finalcount if objstat(x)=1 gh#=get matrix height(1,xpos(x),zpos(x)) inc height(x),(size/2+1) set matrix height 1,xpos(x),zpos(x),height(x) position object x,xpos(x)*matsegx1,height(x),zpos(x)*matsegz1 endif next x update matrix 1 endif if mouseclick()=4 and mouseynew#<0 or inkey$()="," for x=1 to finalcount if objstat(x)=1 dec height(x),(size/2+1) set matrix height 1,xpos(x),zpos(x),height(x) position object x,xpos(x)*matsegx1,height(x),zpos(x)*matsegz1 endif next x update matrix 1 endif if inkey$()="u" for x=1 to finalcount if objstat(x)=1 objstat(x)=-1 color object x,rgb(0,255,0) endif next x endif if inkey$()="s" for x=1 to finalcount if object visible(x)=1 then objstat(x)=1:color object x,rgb(255,0,0) next x endif if inkey$()="t" for x=1 to finalcount if object visible(x)=1 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) endif next x sleep 200 endif if inkey$()="h" hide=hide*-1 if hide=1 for x=1 to finalcount if objstat(x)=-1 hide object x endif next x endif if hide=-1 for x=1 to finalcount if objstat(x)=-1 if object visible(x)=0 then show object x endif next x endif sleep 200 endif mousexold#=mousex():mouseyold#=mousey():mousezold=mousez() if inkey$()="w" if matrix wireframe state(1)=1 then set matrix wireframe off 1 else set matrix wireframe on 1 sleep 200 endif ink RGB(0,255,255),0 set cursor screen width()/2-120,0 print "MATRIX MASTER - by Richard Sardini" ink RGB(0,128,255),0 set cursor screen width()/2-80,40 print "You are editing matix> ";:ink rgb(255,255,0),0:print matname$:ink rgb(255,255,255),0 xl=screen width()/2:yl=screen height()/2 ink RGB(192,192,192),0 line xl,200,xl,screen height()-200 line 250,yl,screen width()-250,yl ink rgb(255,255,255),0 if banding=1 if mx1<mx2 then ink RGB(255,0,128),0 else ink RGB(255,255,0),0 line mx1,my1,mx2,my1:line mx1,my2,mx1,my1 line mx2,my1,mx2,my2:line mx1,my2,mx2,my2 ink rgb(255,255,255),0 endif cnt1=0 for x=1 to finalcount if objstat(x)=1 print "X->";xpos(x);" Z->";zpos(x);" Height->";height(x) inc cnt1 if cnt1>15 then x=finalcount endif next x inc hintc1,8:if hintc1>255 then hintc1=100 hintcolor=rgb(0,hintc1,0) ink hintcolor,0 text int(screen width()/30),screen height()-100,hint$(hint) set cursor screen width()/5,screen height()-60 ink rgb(255,255,255),0 print "Press: 1-Save, 2-Load, Z-Zip to next hint" sync loop savematrix: backdrop off sync off:cls rgb(0,0,0) ink rgb(255,255,255),0 savematrix1: if file exist(matname$)=1 sleep 500 print "File already exist - Would you like to overwrite this file or rename your matrix?" print "Press 2 to overwrite or 3 to rename this matrix" getagain: g$=inkey$() if g$<>"2" and g$<>"3" then sleep 200:goto getagain if g$="3" sleep 200 print "What is the new file name?";:input matname$ sleep 200 goto savematrix1 endif if g$="2" then delete file matname$:sleep 200 endif open to write 1,matname$ write long 1,matsizex:write long 1,matsizez:write long 1,matsegx:write long 1,matsegz write long 1,finalcount for x=1 to finalcount write long 1,xpos(x) write long 1,zpos(x) write long 1,height(x) next x close file 1 print "File saved: Press any key to return to editor" sleep 500 wait key sleep 200 sync on backdrop on goto mainloop loadmatrix: backdrop off sync off:cls rgb(0,0,0) ink rgb(255,255,255),0 print "Current matrix will be lost. Proceed(Y/N)?" getinput: g$=inkey$() if g$="n" or g$="N" then sync on:backdrop on:goto mainloop if g$<>"y" then goto getinput delete matrix 1 for x=1 to finalcount delete object x next x delete object 50000 undim xpos(finalcount):undim zpos(finalcount) undim height(finalcount):undim objstat(finalcount) redomatrixname: input "File name to load?";matname$ if matname$="exit" then goto startover if file exist(matname$)=0 print "File does not exist: Try again or type exit" sleep 500 goto redomatrixname endif if file exist(matname$)=1 open to read 1,matname$ read long 1,matsizex:read long 1,matsizez read long 1,matsegx:read long 1,matsegz read long 1,finalcount dim height(finalcount):dim xpos(finalcount):dim zpos(finalcount) load=1 endif sync on backdrop on goto loaded remstart This is the code snippet you will need to re-load your matrix into your DB programs open to read 1,<filenamehere> read long 1,matsizex:read long 1,matsizez read long 1,matsegx:read long 1,matsegz read long 1,finalcount dim height(finalcount):dim xpos(finalcount):dim zpos(finalcount) for x=1 to finalcount read long 1,xpos(x) read long 1,zpos(x) read long 1,height(x) next x close file 1 make matrix 1,matsizex,matsizez,matsegx,matsegz for x=1 to finalcount set matrix height 1,xpos(x),zpos(x),height(x) next x update matrix 1 endrem Version: 1.0
Created: 28th Feb 2005 17:58
|
Complete Applications | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com Rem Project: MATRIX MASTER PRO Rem Created: 5/17/04 4:36:23 PM Rem ***** Main Source File ***** rem this program written by Richard Sardini Jr rem my e-mail:noramdia@adelphia.net rem my phone:814-504-6033 rem check end of program for code snippet to load matrix into your dark basic programs set display mode 800,600,16 create bitmap 1,65,161 rem texture 1 (green) ink RGB(128,128,0),0:for x=0 to 31:line x,0,x,32:next x ink RGB(0,128,0),0:for x=0 to 200:dot rnd(32)-1,rnd(32)-1:next x ink RGB(255,128,0),0:for x=0 to 50:dot rnd(32)-1,rnd(32)-1:next x ink RGB(128,128,255),0:for x=0 to 90:dot rnd(32)-1,rnd(32)-1:next x ink RGB(255,255,255),0:for x=0 to 20:dot rnd(32)-1,rnd(32)-1:next x rem texture 2 (medium grey) ink RGB(128,128,128),0:for x=31 to 64:line x,0,x,32:next x ink RGB(192,192,192),0:for x=0 to 200:dot rnd(32)+33,rnd(32)-1:next x ink RGB(60,81,66),0:for x=0 to 50:dot rnd(32)+33,rnd(32)-1:next x ink RGB(48,74,167),0:for x=0 to 90:dot rnd(32)+33,rnd(32)-1:next x ink RGB(255,255,255),0:for x=0 to 20:dot rnd(32)+33,rnd(32)-1:next x rem texture 3 (dark grey) ink RGB(82,82,82),0:for x=0 to 31:line x,32,x,65:next x ink RGB(0,0,0),0:for x=0 to 200:dot rnd(32)-1,rnd(32)+33:next x ink RGB(128,128,128),0:for x=0 to 50:dot rnd(32)-1,rnd(32)+33:next x ink RGB(57,36,159),0:for x=0 to 90:dot rnd(32)-1,rnd(32)+33:next x ink RGB(192,192,192),0:for x=0 to 20:dot rnd(32)-1,rnd(32)+33:next x rem texture 4 (light brown) ink RGB(194,160,114),0:for x=32 to 64:line x,32,x,65:next x ink RGB(255,209,164),0:for x=0 to 200:dot rnd(32)+33,rnd(32)+33:next x ink RGB(190,126,126),0:for x=0 to 50:dot rnd(32)+33,rnd(32)+33:next x ink RGB(255,230,204),0:for x=0 to 90:dot rnd(32)+33,rnd(32)+33:next x ink RGB(128,64,64),0:for x=0 to 20:dot rnd(32)+33,rnd(32)+33:next x rem texture 5 (medium brown) ink RGB(217,108,0),0:for x=0 to 31:line x,65,x,97:next x ink RGB(128,64,64),0:for x=0 to 200:dot rnd(32)-1,rnd(32)+65:next x ink RGB(185,92,0),0:for x=0 to 50:dot rnd(32)-1,rnd(32)+65:next x ink RGB(210,105,0),0:for x=0 to 90:dot rnd(32)-1,rnd(32)+65:next x ink RGB(255,197,138),0:for x=0 to 20:dot rnd(32)-1,rnd(32)+65:next x rem texture 6 (Black) ink RGB(0,0,0),0:for x=32 to 64:line x,65,x,98:next x rem texture 7 (Blue 1) ink RGB(0,0,255),0:for x=0 to 31:line x,97,x,130:next x ink RGB(0,128,255),0:for x=0 to 200:dot rnd(31)-1,rnd(32)+95:next x ink RGB(0,128,192),0:for x=0 to 50:dot rnd(31)-1,rnd(32)+95:next x ink RGB(255,255,255),0:for x=0 to 90:dot rnd(31)-1,rnd(32)+95:next x ink RGB(128,0,255),0:for x=0 to 20:dot rnd(31)-1,rnd(32)+95:next x rem texture 8 (Lt. Blue) ink RGB(0,255,255),0:for x=31 to 64:line x,96,x,130:next x ink RGB(128,255,255),0:for x=0 to 200:dot rnd(32)+33,rnd(31)+96:next x ink RGB(0,230,230),0:for x=0 to 50:dot rnd(32)+33,rnd(31)+96:next x ink RGB(151,255,255),0:for x=0 to 90:dot rnd(32)+33,rnd(31)+96:next x ink RGB(0,206,206),0:for x=0 to 20:dot rnd(32)+33,rnd(31)+96:next x rem texture 9 (White) ink rgb(255,255,255),0:for x=0 to 34:line x,127,x,161:next x ink RGB(218,218,218),0:for x=0 to 200:dot rnd(33)-1,rnd(31)+126:next x rem texture 10 (orange) ink RGB(255,128,0),0:for x=33 to 64:line x,128,x,161:next x ink RGB(255,128,64),0:for x=0 to 200:dot rnd(32)+33,rnd(31)+129:next x rem get matrix texture blur bitmap 1,3 get image 1,1,1,64,160 delete bitmap 1 create bitmap 1,50,50 ink RGB(0,0,255),0:for x=0 to 50:line x,0,x,50:next x ink rgb(0,255,255),0:for x=0 to 200:dot rnd(50),rnd(50):next x ink RGB(128,255,255),0:for x=0 to 70:dot rnd(50),rnd(50):next x ink RGB(255,255,255),0:for x=0 to 75:dot rnd(50),25+rnd(10):next x blur bitmap 1,3 get image 2,0,0,50,50 delete bitmap 1 hint=1:hints=36:hintdelay=750:hintspeed=0 dim hint$(40):hintc1=50:ghost=-1:ghost1=-1 hint$(1)="Press ' w ' to toggle wireframe on and off." hint$(2)="Press and hold mouse wheel button 3 and move mouse up and down to lower or raise selected markers respectively." hint$(3)="Or use keyboard less than ' < ' or greater than ' > ' to lower or raise selected markers respectively." hint$(4)="Press ' L ' to level the matrix back to zero." hint$(5)="Press Shift and 'L' to level select markers." hint$(6)="Press ' b ' to set maximum bottom sea depth. Use this to raise sea floor after smoothing lowers it too deep. Shift 5 to undo." hint$(7)="Press ' m ' to toggle wave flow off and back on." hint$(8)="Shift ' G ' to toggle ghost water on." hint$(9)="Press ' d ' to change the direction the waves are facing." hint$(10)="Press Shift and ' D ' to change the direction the waves are flowing." hint$(11)="Press ' n ' anytime in elevation mode to start a new matrix." hint$(12)="Press ' 5 ' to smooth matrix 1 time. Can be undone only 1 time. Thanks to ReD_eYe(and inspired by David89)." hint$(13)="Press Shift and ' 5 ' to undo smooth matrix once. Do this to save final smoothing for when your whole matrix is done." hint$(14)="Click on up and down arrows at the top right of the screen to set elevation change rate or wave settings." hint$(15)="Press ' q ' to raise the water level or ' a ' to lower the water level." hint$(16)="Press ' s ' to select all visible coordinate markers and ' u ' to un-select all visible markers." hint$(17)="Press ' v ' to slow down hints and shift + ' v ' to speed up hints." hint$(18)="Press ' t ' to toggle or invert all visible coordinate markers." hint$(19)="Press arrow keys to pan your view or press and hold mouse botton 2 and move mouse." hint$(20)="Press and hold both mouse buttons 1 and 2 and move mouse to rotate camera view." hint$(21)="Left click and drag mouse-(top left to bottom right)-and red box will appear to select markers in box." hint$(22)="Left click and drag mouse-(bottom right to top left)-and yellow box will appear to toggle or invert selected markers in box." hint$(23)="Press ' h ' to hide all unselected markers-this is handy to isolate work areas." hint$(24)="Press ' h ' again to show all hidden markers. Use this feature to hide and prevent selecting backround markers." hint$(25)="Green marker=unselected coordinate - Red marker=selected coordinate." hint$(26)="Press ' + ' or ' - ' to zoom in and out or turn the mouse wheel." hint$(27)="Set the cross hairs on your destination point and then zoom in." hint$(28)="Press ' z ' to zip to the next hint." hint$(29)="Press 'shift' and ' z ' to zip back one hint." hint$(30)="Left click on marker to toggle coordinate marker selection." hint$(31)="Press ' g ' to toggle ghost matrix on and off. This helps you see and avoid selecting markers behind hills." hint$(32)="Press ' o ' to toggle hints off and back on." hint$(33)="Press ' escape ' key anytime to exit MATRIX MASTER." hint$(34)="Hiding unnecessary markers increases program funtion and speed." hint$(35)="To hide more markers, select markers you want to keep in view and press ' h ' or hide twice." hint$(36)="Press ' i ' to apply an image to your matrix. This is nice to sculp terrain around your landscape drawings.Texture mode is disabled." hint$(37)="Your mouse functions are all the same as Elevation mode except raise elevation and wireframe." hint$(38)="Select tile markers and then click on the texture at the top right of the screen that you want to apply." hint$(39)="I had a hard time with the texture image for the matrix texture. If you can help,fix it and e-mail to:noramdia@adelphia.net." startover: set text size 16 set current bitmap 0 load=0:o=1 cls rgb(0,0,0):ink RGB(255,255,0),0 set cursor screen width()/2-24,0 print "MATRIX-MASTER Pro Matrix Editor v1.9" ink rgb(255,255,255),0 print redomatrix: input "Give your matrix a name and press enter>";matname$:sleep 200 if matname$="" then goto redomatrix redoinput: print "Is this matrix name ";:ink rgb(0,255,0),0:print matname$;:ink rgb(255,255,255),0:print " correct?(y/n)>" redoinkey: g$=inkey$() if g$<>"n" and g$<>"y" and g$<>"" then print "Please confirm your matrix name>":sleep 500:goto redoinput if g$="n" then goto redomatrix if g$="y" then goto redoxsize goto redoinkey print "Matrix name accepted":sleep 1000:cls rgb(0,0,0):ink RGB(255,255,0),0 set cursor screen width()/2-24,0 print "MATRIX-MASTER Pro Matrix Editor v1.9" ink rgb(255,255,255),0 print redoxsize: input "Input matrix size X and press enter>";matsizex if matsizex<10 or matsizex>100000 then print "Bad input-try again>":sleep 500:goto redoxsize matsizex=int(matsizex) redozsize: input "Input matrix size Z and press enter>";matsizez if matsizez<10 or matsizez>100000 then print "Bad input-try again>":sleep 500:goto redozsize matsizez=int(matsizez) redoxseg: input "Input matrix segment X and press enter>";matsegx if matsegx<2 or matsegx>250 then print "Bad input-try again>":sleep 500:goto redoxseg matsegx=int(matsegx) redozseg: input "Input matrix segment Z and press enter>";matsegz if matsegz<2 or matsegz>250 then print "Bad input-try again>":sleep 500:goto redozseg matsegz=int(matsegz) print "Matrix parameters accepted" print "Working..."; sleep 500 backdrop on dim height#((matsegx+1)*(matsegz+1)):dim heightold#((matsegx+1)*(matsegz+1)) dim xpos((matsegx+1)*(matsegz+1)):dim zpos((matsegz+1)*(matsegx+1)) dim tile((matsegx+1)*(matsegz+1)):for x=0 to ((matsegx+1)*(matsegz+1)):tile(x)=1:next x undo=0:wh=0:wl=0:wv=-1:wm=-1:wd=0:ms=0:wspeed=10:wc=0:numchng=0:numchng1=0 wd2=0 loaded: if matsizex>500 and matsizez>500 then size=6 else size=2 if matsizex>2000 and matsizez>2000 then size=10 if matsizex>5000 and matsizez>5000 then size=30 if matsizex>8000 and matsizez>8000 then size=40 if matsizex>9999 and matsizez>9999 then size=50 if matsizex>20000 and matsizez>20000 then size=75 if matsizex>50000 and matsizez>50000 then size=100 if matsizex>70000 and matsizez>70000 then size=200 dim objstat((matsegx+1)*(matsegz+1)) matsegx1=matsizex/matsegx:matsegz1=matsizez/matsegz banding=0:mx1=0:mx2=0:my1=0:my2=0:hide=-1:raiselower#=1 objnum=1 for z=0 to matsegz for x=0 to matsegx objstat(objnum)=-1 finalcount=objnum inc objnum next x next z if finalcount>2500 cls:backdrop off:ink rgb(0,255,0),0 print "!!WARNING!!" Print "Because of excessive markers, markers will be hidden. Navigate to the area you want" print "to work with, hit h to show all markers, then select markers in desired work area. Then hit" print "h again to hide unselected markers. Repeat this process when changing work areas." print "Doing this will speed up the editing process." print "Press any key to continue..." wait key print "Hang on, this could be a minute!!" sleep 500 backdrop on ink rgb(255,255,255),0 endif sync on autocam off make matrix 1,matsizex,matsizez,matsegx,matsegz position matrix 1,0,0,0 prepare matrix texture 1,1,2,5 update matrix 1 make object cube 70000,10:position object 70000,-10,0,-10:color object 70000,RGB(0,255,255) if load=1 for x=1 to finalcount read long 1,xpos(x) read long 1,zpos(x) read float 1,height#(x) read long 1,tile(x) next x close file 1 endif load=0 objnum=1 for z=0 to matsegz for x=0 to matsegx make object sphere objnum,size:color object objnum,rgb(0,255,0) position object objnum,x*matsegx1,height#(objnum),z*matsegz1 if finalcount>2500 hide object objnum endif set matrix height 1,x,z,height#(objnum) if x<matsegx and z<matsegz set matrix tile 1,x,z,tile(objnum) endif if load=1 then goto skipassign xpos(objnum)=x:zpos(objnum)=z skipassign: inc objnum next x next z if finalcount>2500 then hide=1 update matrix 1 set camera range 1,1000000 position camera 0,500,0 point camera 200,0,200 mousexold#=mousex():mouseyold#=mousey() gtx=0 wh=50:wd=1:wm=1 mainloop: do if inkey$()="i" backdrop off:sync off:cls redoimagename: print "Input image name to apply as matrix texture or type exit to abort.>";:input gtx$ if gtx$="exit" then sleep 200:backdrop on:sync on:goto aborttexture if file exist(gtx$)=0 print "File invalid. Make sure to include the file extension, e.g. .bmp. Try again or type exit.>":sleep 200 goto redoimagename endif load image gtx$,10 tile=1:gtx=1 prepare matrix texture 1,10,matsegx,matsegz for z=matsegz-1 to 0 step -1 for x=0 to matsegx-1 set matrix tile 1,x,z,tile inc tile next x next z update matrix 1 sync on:backdrop on sleep 200 endif aborttexture: dec hintdelay if hintdelay<0 then hintdelay=500+hintspeed:inc hint if hint>hints then hint=1 if inkey$()="v" then inc hintspeed,50 if inkey$()="V" then dec hintspeed,50 if hintspeed<-400 then hintspeed=-400 if inkey$()="z" inc hint if hint>hints then hint=1 hintdelay=1500 sleep 200 endif if inkey$()="Z" dec hint if hint<1 then hint=hints hintdelay=1500 sleep 200 endif if inkey$()<>"q" then htinc=0 if inkey$()="q" inc htinc if htinc>100 then htinc=100 if wv=1 inc wl,1+int(htinc/10) position matrix 2,0,wl,0 sleep 20 endif endif if inkey$()<>"a" then htdec=0 if inkey$()="a" inc htdec if htdec>100 then htdec=100 if wv=1 dec wl,1+int(htdec/10) position matrix 2,0,wl,0 sleep 20 endif endif if inkey$()="n" sync off:backdrop off:set matrix wireframe on 1 set cursor 0,0:cls rgb(0,0,0):ink RGB(255,255,255),0 print "Confirm! Do you want to start a new matrix?(y/n)" print "You may want to answer no and save this matrix first lest it be lost." sleep 500 getagain5: g$=inkey$() if g$<>"y" and g$<>"n" then goto getagain5 if g$="y" for x=1 to finalcount:delete object x:next x:delete object 70000 delete matrix 1 undim xpos(finalcount):undim zpos(finalcount) undim height(finalcount):undim objstat(finalcount) sleep 200 goto startover endif if g$="n" sync on:backdrop on endif sleep 500 set matrix wireframe off 1 endif if inkey$()="g" ghost=ghost*-1 if ghost=1 ghost matrix on 1 endif if ghost=-1 ghost matrix off 1 endif sleep 200 endif if inkey$()="G" ghost1=ghost1*-1 if ghost1=1 if matrix exist(2)=1 ghost matrix on 2 endif endif if ghost1=-1 if matrix exist(2)=1 ghost matrix off 2 endif endif sleep 200 endif if inkey$()="L" for x=1 to finalcount heightold#(x)=height#(x) next x:undo=1 for x=1 to finalcount if objstat(x)=1 height#(x)=0 set matrix height 1,xpos(x),zpos(x),height#(x) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 endif next x update matrix 1 sleep 200 endif if inkey$()="l" sync off:backdrop off cls rgb(0,0,0):ink rgb(255,255,255),0 print "Are you sure you want to level your matrix back to zero?(y/n)" print "If you answer yes, you can press shift and ' 5 ' to undo level." sleep 200 getagain6: g$=inkey$() if g$<>"y" and g$<>"n" then goto getagain6 if g$="y" for x=1 to finalcount heightold#(x)=height#(x) next x:undo=1 for x=1 to finalcount height#(x)=0 set matrix height 1,xpos(x),zpos(x),height#(x) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 objstat(x)=-1:color object x,rgb(0,255,0) next x update matrix 1 endif sync on:backdrop on endif if inkey$()="b" sync off:backdrop off:cls rgb(0,0,0) ink rgb(255,255,255),0:print "Please input value you want to set for maximum sea bottom depth(0=abort)?"; getbottom: input bot bot=int(bot):if bot=0 then sync on:backdrop on:goto donebot for x=1 to finalcount heightold#(x)=height#(x) next x:undo=1 if bot<0 then bot=bot*-1 for x=1 to finalcount if height#(x)<0-bot or height#(x)<wl height#(x)=((bot)*-1) set matrix height 1,xpos(x),zpos(x),height#(x) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 endif next x update matrix 1 sync on:backdrop on endif donebot: rem watermatrix if inkey$()="6" wv=wv*-1 if wv=1 if matrix exist(2)=0 make matrix 2,matsizex,matsizez,matsegx,matsegz prepare matrix texture 2,2,1,1 position matrix 2,0,wl,0 if wh>0 if wd=1 flip=1 for z=0 to matsegz-1 step int(matsegz/10)+1 for x=0 to matsegx-1 if flip=1 set matrix height 2,x,z,int(matsegz/5)+1+wh endif if flip=-1 set matrix height 2,x,z,-int(matsegz/5)+1+wh endif next x flip=flip*-1 next z endif if wd=2 flip=1 for x=0 to matsegx-1 step int(matsegx/10)+1 for z=0 to matsegz-1 if flip=1 set matrix height 2,x,z,int(matsegz/5)+1+wh endif if flip=-1 set matrix height 2,x,z,-int(matsegz/5)+1+wh endif next z flip=flip*-1 next x endif for x=1 to matsegx-1 for z=1 to matsegz-1 a=get matrix height(2,x-1,z+1) b=get matrix height(2,x,z+1) c=get matrix height(2,x+1,z+1) d=get matrix height(2,x+1,z) e=get matrix height(2,x+1,z-1) f=get matrix height(2,x,z-1) g=get matrix height(2,x-1,z-1) h=get matrix height(2,x-1,z) total=a+b+c+d+e+f+g+h av#=total/8 set matrix height 2,x,z,av# next z next x for x=0 to matsegx set matrix height 2,x,0,get matrix height(2,x,1) next x for x=0 to matsegx set matrix height 2,x,tilez,get matrix height(2,x,matsegz-1) next x for z=0 to matsegz set matrix height 2,0,z,get matrix height(2,1,z) next z for z=0 to matsegz set matrix height 2,tilex,z,get matrix height(2,matsegx-1,z) next z endif update matrix 2 if ghost1=1 then ghost matrix on 2 endif endif if wv=-1 if matrix exist(2)=1 delete matrix 2 endif endif sleep 200 endif if inkey$()="d" if wd=1 then wd=2 else wd=1 dc=1 sleep 200 endif if inkey$()="D" if wd1=0 then wd1=1 else wd1=0 sleep 200 endif if inkey$()="m" wm=wm*-1 sleep 200 endif inc ms if ms>wspeed ms=0 if wm=1 if wv=1 if wd=1 if matrix exist(2)=1 if wd1=0 then shift matrix up 2 if wd1=1 then shift matrix down 2 update matrix 2 endif endif if wd=2 if matrix exist(2)=1 if wd1=0 then shift matrix right 2 if wd1=1 then shift matrix left 2 update matrix 2 endif endif endif endif endif if whc=1 and mousex()<screen width()-58 or dc=1 or wc=1 if whc=1 then whc=0 if dc=1 then dc=0 if wc=1 then wc=0 if matrix exist(2)=1 then delete matrix 2 make matrix 2,matsizex,matsizez,matsegx,matsegz prepare matrix texture 2,2,1,1 position matrix 2,0,wl,0 if wd=1 flip=1 for z=0 to matsegz-1 step int(matsegz/10)+1 for x=0 to matsegx-1 if flip=1 set matrix height 2,x,z,int(matsegz/5)+1+wh endif if flip=-1 set matrix height 2,x,z,-int(matsegz/5)+1+wh endif next x flip=flip*-1 next z endif if wd=2 flip=1 for x=0 to matsegx-1 step int(matsegx/10)+1 for z=0 to matsegz-1 if flip=1 set matrix height 2,x,z,int(matsegz/5)+1+wh endif if flip=-1 set matrix height 2,x,z,-int(matsegz/5)+1+wh endif next z flip=flip*-1 next x endif rem smooth water for x=1 to matsegx-1 for z=1 to matsegz-1 a=get matrix height(2,x-1,z+1) b=get matrix height(2,x,z+1) c=get matrix height(2,x+1,z+1) d=get matrix height(2,x+1,z) e=get matrix height(2,x+1,z-1) f=get matrix height(2,x,z-1) g=get matrix height(2,x-1,z-1) h=get matrix height(2,x-1,z) total=a+b+c+d+e+f+g+h av#=total/8 set matrix height 2,x,z,av# next z next x for x=0 to matsegx set matrix height 2,x,0,get matrix height(2,x,1) next x for x=0 to matsegx set matrix height 2,x,tilez,get matrix height(2,x,matsegz-1) next x for z=0 to matsegz set matrix height 2,0,z,get matrix height(2,1,z) next z for z=0 to matsegz set matrix height 2,tilex,z,get matrix height(2,matsegx-1,z) next z update matrix 2 if ghost1=1 then ghost matrix on 2 endif if inkey$()="1" then goto savematrix if inkey$()="2" then goto loadmatrix if gtx=1 then goto skiptexturemode if inkey$()="3" then gosub texture skiptexturemode: base=get ground height(1,0,0):position object 70000,-10,base,-10 mousexnew#=mousexold#-mousex():mouseynew#=mouseyold#-mousey() if upkey()=1 or mouseclick()=2 and mouseynew#>0 pitch camera down 2 endif if downkey()=1 or mouseclick()=2 and mouseynew#<0 pitch camera up 2 endif if leftkey()=1 or mouseclick()=2 and mousexnew#>0 turn camera left 2 endif if rightkey()=1 or mouseclick()=2 and mousexnew#<0 turn camera right 2 endif if mousezold<mousez() or inkey$()="+" move camera 10*size ghty=get ground height(1,camera position x(),camera position z()) ghty1=camera position y()-ghty if ghty1<10 then move camera -10*size endif if mousezold>mousez() or inkey$()="-" move camera -10*size ghty=get ground height(1,camera position x(),camera position z()) ghty1=camera position y()-ghty if ghty1<10 then move camera 10*size endif if banding=1 then goto skiptilt if mouseclick()=3 and mousexnew#>0 roll camera left 2 endif if mouseclick()=3 and mousexnew#<0 roll camera right 2 endif skiptilt: if banding=1 then goto skipfirst if mouseclick()=1 mx1=mousex():my1=mousey():banding=1 endif skipfirst: if banding=1 then mx2=mousex():my2=mousey() if mx1>mx2 and my1<my2 or mx1<mx2 and my1>my2 then banding=0 if mousex()>screen width()-58 and mousex()<screen width()-42 and mousey()<250 then banding=0 if banding=1 and mouseclick()=0 if mx1<mx2 for x=1 to finalcount if object visible(x)=1 ox=object screen x(x):oy=object screen y(x) if ox>mx1 and ox<mx2 and oy>my1 and oy<my2 objstat(x)=1:color object x,rgb(255,0,0) endif endif next x endif if mx1>mx2 for x=1 to finalcount if object visible(x)=1 ox=object screen x(x):oy=object screen y(x) if ox<mx1 and ox>mx2 and oy<my1 and oy>my2 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) endif endif next x endif banding=0 endif if banding=1 and mx1<>mx2 or my1<>my2 then goto skipselect if mousex()>screen width()-58 and mousex()<screen width()-42 and mousey()<250 then goto skipselect if mousexnew#=0 and mouseynew#=0 if mouseclick()=1 and mx1=mx2 and banding=1 and mx1=mx2 and my1=my2 for x=1 to finalcount if object visible(x)=1 if object in screen(x)=1 sx=object screen x(x):sy=object screen y(x) if mousex()>sx-5 and mousex()<sx+5 and mousey()>sy-5 and mousey()<sy+5 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) sleep 200 x=finalcount:banding=0 endif endif endif next x sleep 200 endif endif skipselect: if banding=1 then goto skipnumchng if mouseclick()=0 then numchng=0:numchng1=0 if mouseclick()=1 if mousex()>screen width()-58 and mousex()<screen width()-42 inc numchng if numchng>100 then numchg=100 oset=int(numchng/10) if numchng=100 then inc numchng1 if numchng1>20 then numchng1=20 if numchng1=20 then oset=oset*10 if mousey()>29 and mousey()<44 inc raiselower#,1+oset sleep 20 endif if mousey()>70 and mousey()<85 dec raiselower#,1+oset if raiselower#<1 then raiselower#=1 sleep 20 endif if mousey()>100 and mousey()<120 dec wspeed,1+oset if wspeed<0 then wspeed=0 endif if mousey()>135 and mousey()<155 inc wspeed,1+oset endif if mousey()>180 and mousey()<205 inc wh,1+oset whc=1 endif if mousey()>215 and mousey()<235 dec wh,1+oset if wh<0 then wh=0 whc=1 endif sleep 50 endif endif skipnumchng: if mouseclick()=4 and mouseynew#>0 or inkey$()="." for x=1 to finalcount if objstat(x)=1 gh#=get matrix height(1,xpos(x),zpos(x)) inc height#(x),raiselower# set matrix height 1,xpos(x),zpos(x),height#(x) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 endif next x update matrix 1 endif if mouseclick()=4 and mouseynew#<0 or inkey$()="," for x=1 to finalcount if objstat(x)=1 dec height#(x),raiselower# set matrix height 1,xpos(x),zpos(x),height#(x) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 endif next x update matrix 1 endif if inkey$()="u" for x=1 to finalcount if objstat(x)=1 objstat(x)=-1 color object x,rgb(0,255,0) endif next x endif if inkey$()="s" for x=1 to finalcount if object visible(x)=1 then objstat(x)=1:color object x,rgb(255,0,0) next x endif if inkey$()="t" for x=1 to finalcount if object visible(x)=1 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) endif next x sleep 200 endif if inkey$()="h" hide=hide*-1 if hide=1 for x=1 to finalcount if objstat(x)=-1 hide object x endif next x endif if hide=-1 for x=1 to finalcount if objstat(x)=-1 if object visible(x)=0 then show object x endif next x endif sleep 200 endif if inkey$()="o" then o=o*-1:sleep 200 if inkey$()="%" if undo=1 for x=1 to finalcount height#(x)=heightold#(x) set matrix height 1,xpos(x),zpos(x),height#(x) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 next x update matrix 1 undo=0 sleep 200 endif endif Rem Smooth matrix if inkey$()="5" for x=1 to finalcount heightold#(x)=height#(x) next x undo=1 for x=1 to matsegx-1 for z=1 to matsegz-1 a=get matrix height(1,x-1,z+1) b=get matrix height(1,x,z+1) c=get matrix height(1,x+1,z+1) d=get matrix height(1,x+1,z) e=get matrix height(1,x+1,z-1) f=get matrix height(1,x,z-1) g=get matrix height(1,x-1,z-1) h=get matrix height(1,x-1,z) total=a+b+c+d+e+f+g+h av#=total/8 set matrix height 1,x,z,av# next z next x for x=0 to matsegx set matrix height 1,x,0,get matrix height(1,x,1) next x for x=0 to matsegx set matrix height 1,x,tilez,get matrix height(1,x,matsegz-1) next x for z=0 to matsegz set matrix height 1,0,z,get matrix height(1,1,z) next z for z=0 to matsegz set matrix height 1,tilex,z,get matrix height(1,matsegx-1,z) next z update matrix 1 for x=1 to finalcount height#(x)=get matrix height(1,xpos(x),zpos(x)) position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 next x sleep 500 endif mousexold#=mousex():mouseyold#=mousey():mousezold=mousez() if inkey$()="w" if matrix wireframe state(1)=1 then set matrix wireframe off 1 else set matrix wireframe on 1 sleep 200 endif ink RGB(0,255,255),0 set cursor 0,0:Print "Matrix properties" set cursor screen width()/2-124,0 print "MATRIX MASTER Pro v1.9 - by Richard Sardini" ink RGB(0,128,255),0 print "X-size->";matsizex;"->Z-size->";matsizez print "X-segment->";matsegx;"->Z-segment->";matsegz print "Water level->";wl set cursor screen width()/2-80,40 print "You are editing matix> ";:ink rgb(255,255,0),0:print matname$:ink rgb(255,255,255),0 set cursor screen width()/2-80,80:print "You are in Elevation mode.":ink rgb(255,255,255),0 print "Mousex->";mousex();" Mousey->";mousey() xl=screen width()/2:yl=screen height()/2 ink RGB(192,192,192),0 line xl,200,xl,screen height()-200 line 250,yl,screen width()-250,yl ink rgb(255,255,255),0 if banding=1 if mx1<mx2 then ink RGB(255,0,128),0 else ink RGB(255,255,0),0 line mx1,my1,mx2,my1:line mx1,my2,mx1,my1 line mx2,my1,mx2,my2:line mx1,my2,mx2,my2 ink rgb(255,255,255),0 endif cnt1=0 print "First 16 markers selected/height" for x=1 to finalcount if objstat(x)=1 print "X->";xpos(x);" Z->";zpos(x);" Height->";height#(x) inc cnt1 if cnt1>15 then x=finalcount endif next x if o=-1 then goto skiphints inc hintc1,8:if hintc1>255 then hintc1=100 hintcolor=rgb(0,hintc1,0) ink hintcolor,0 text 0,screen height()-75,hint$(hint) skiphints: set cursor screen width()/5,screen height()-50 ink rgb(255,255,255),0 print "Press: 1-Save, 2-Load, 3-Enter texture mode, Z-Zip to next hint, Shift Z-Zip back one hint." set cursor screen width()/5,screen height()-25 print "Press: 5-Smooth matrix one time, Shif 5-undo last smoothing, 6-Toggle water on and back off" set cursor screen width()-160,50 print "Elevation change->";raiselower# ink rgb(255,0,0),0 line screen width()-54,44,screen width()-46,44 line screen width()-54,44,screen width()-50,34 line screen width()-46,44,screen width()-50,34 line screen width()-54,70,screen width()-46,70 line screen width()-54,70,screen width()-50,80 line screen width()-46,70,screen width()-50,80 ink rgb(255,255,255),0 if wv=1 set cursor screen width()-140,120 print "Wave speed->";wspeed set cursor screen width()-150,200 print "Wave height->";wh ink rgb(255,0,0),0 line screen width()-54,114,screen width()-46,114 line screen width()-54,114,screen width()-50,104 line screen width()-46,114,screen width()-50,104 line screen width()-54,140,screen width()-46,140 line screen width()-54,140,screen width()-50,150 line screen width()-46,140,screen width()-50,150 line screen width()-54,194,screen width()-46,194 line screen width()-54,194,screen width()-50,184 line screen width()-46,194,screen width()-50,184 line screen width()-54,220,screen width()-46,220 line screen width()-54,220,screen width()-50,230 line screen width()-46,220,screen width()-50,230 endif ink RGB(236,237,173),0 line mousex()-9,mousey()-9,mousex()+10,mousey()+10 line mousex()-9,mousey()+9,mousex()+10,mousey()-10 ink rgb(255,255,255),0 sync loop savematrix: backdrop off sync off:cls rgb(0,0,0) ink rgb(255,255,255),0 savematrix1: if file exist(matname$)=1 sleep 500 print "File already exist - Would you like to overwrite this file or rename your matrix?" print "Press 2 to overwrite or 3 to rename this matrix" getagain: g$=inkey$() if g$<>"2" and g$<>"3" then sleep 200:goto getagain if g$="3" sleep 200 print "What is the new file name?";:input matname$ sleep 200 goto savematrix1 endif if g$="2" then delete file matname$:sleep 200 endif open to write 1,matname$ write long 1,matsizex:write long 1,matsizez:write long 1,matsegx:write long 1,matsegz write long 1,finalcount for x=1 to finalcount write long 1,xpos(x) write long 1,zpos(x) write float 1,height#(x) write long 1,tile(x) next x close file 1 print "File saved as:";:ink rgb(0,255,0),0:print matname$;:ink rgb(255,255,255),0:print ", Press any key to return to editor" sleep 500 wait key sleep 200 sync on backdrop on goto mainloop loadmatrix: if matrix exist(2)=1 then delete matrix 2 backdrop off sync off:cls rgb(0,0,0) ink rgb(255,255,255),0 print "Current matrix will be lost. Proceed(Y/N)?" getinput: g$=inkey$() if g$="n" or g$="N" then sync on:backdrop on:goto mainloop if g$<>"y" then goto getinput delete matrix 1 for x=1 to finalcount delete object x next x delete object 70000 undim xpos(finalcount):undim zpos(finalcount) undim height#(finalcount):undim objstat(finalcount) undim tile(finalcount):undim heightold#(finalcount) redomatrixname: input "File name to load?";matname$ print "If nothing happens, press enter again." if matname$="exit" then goto startover if file exist(matname$)=0 print "File does not exist: Try again or type exit" sleep 500 goto redomatrixname endif if file exist(matname$)=1 open to read 1,matname$ read long 1,matsizex:read long 1,matsizez read long 1,matsegx:read long 1,matsegz read long 1,finalcount dim height#(finalcount):dim xpos(finalcount):dim zpos(finalcount) dim tile(finalcount):dim heightold#(finalcount) load=1 endif sync on backdrop on goto loaded texture: objnum=1:wc=0 if matrix wireframe state(1)=1 then set matrix wireframe off 1 for z=0 to matsegz for x=0 to matsegx if object visible(objnum)=0 then show object objnum color object objnum,rgb(0,255,0):objstat(objnum)=-1 if xpos(objnum)=matsegx or zpos(objnum)=matsegz then hide object objnum height1=int(get ground height(1,(x*matsegx1)+(matsegx1/2),(z*matsegz1)+(matsegz1/2))) position object objnum,(x*matsegx1)+(matsegx1/2),height1,(z*matsegz1)+(matsegz1/2) inc objnum next x next z for x=1 to finalcount if xpos(x)=matsegx or zpos(x)=matsegz then hide object x next x rval=0 if matrix exist(2)=1 then delete matrix 2:rval=1 hint=36:hintdelay=1000 tile=1 do dec hintdelay if hintdelay<0 then hintdelay=500+hintspeed:inc hint if hint>39 then hint=16 if inkey$()="z" inc hint if hint>39 then hint=16 hintdelay=1500 sleep 200 endif if inkey$()="Z" dec hint if hint<16 then hint=39 hintdelay=1500 sleep 200 endif if inkey$()="v" then inc hintspeed,50 if inkey$()="V" then dec hintspeed,50 if hintspeed<-400 then hintspeed=-400 if mouseclick()=1 and banding=0 if mousex()>699 and mousey()<250 if mousex()<732 and mousey()<30 then tile=1 if mousex()>732 and mousey()<30 then tile=2 if mousex()<732 and mousey()>30 and mousey()<64 then tile=3 if mousex()>732 and mousey()>30 and mousey()<64 then tile=4 if mousex()<732 and mousey()>64 and mousey()<96 then tile=5 if mousex()>732 and mousey()>64 and mousey()<96 then tile=6 if mousex()<732 and mousey()>96 and mousey()<128 then tile=7 if mousex()>732 and mousey()>96 and mousey()<128 then tile=8 if mousex()<732 and mousey()>128 and mousey()<160 then tile=9 if mousex()>732 and mousey()>128 and mousey()<160 then tile=10 for x=1 to finalcount if objstat(x)=1 set matrix tile 1,xpos(x),zpos(x),tile tile(x)=tile endif next x update matrix 1 endif endif if inkey$()="4" for x=1 to finalcount position object x,xpos(x)*matsegx1,height#(x),zpos(x)*matsegz1 objstat(x)=-1:color object x,rgb(0,255,0) if object visible(x)=0 then show object x next x hint=1 if rval=1 wc=1 endif return endif base=get ground height(1,0,0):position object 70000,-10,base,-10 mousexnew#=mousexold#-mousex():mouseynew#=mouseyold#-mousey() if upkey()=1 or mouseclick()=2 and mouseynew#>0 pitch camera down 2 endif if downkey()=1 or mouseclick()=2 and mouseynew#<0 pitch camera up 2 endif if leftkey()=1 or mouseclick()=2 and mousexnew#>0 turn camera left 2 endif if rightkey()=1 or mouseclick()=2 and mousexnew#<0 turn camera right 2 endif if mousezold<mousez() or inkey$()="+" move camera 20*size ghty=get ground height(1,camera position x(0),camera position z(0)) ghty1=camera position y()-ghty if ghty1<50 then move camera -20*size endif if mousezold>mousez() or inkey$()="-" move camera -20*size ghty=get ground height(1,camera position x(0),camera position z(0)) ghty1=camera position y()-ghty if ghty1<50 then move camera 20*size endif if banding=1 then goto skiptilt2 if mouseclick()=3 and mousexnew#>0 roll camera left 2 endif if mouseclick()=3 and mousexnew#<0 roll camera right 2 endif skiptilt2: if banding=1 then goto skipfirst2 if mouseclick()=1 mx1=mousex():my1=mousey():banding=1 endif skipfirst2: if banding=1 then mx2=mousex():my2=mousey() if mx1>mx2 and my1<my2 or mx1<mx2 and my1>my2 then banding=0 if banding=1 and mouseclick()=0 if mx1<mx2 for x=1 to finalcount if object visible(x)=1 ox=object screen x(x):oy=object screen y(x) if ox>mx1 and ox<mx2 and oy>my1 and oy<my2 objstat(x)=1:color object x,rgb(255,0,0) endif endif next x endif if mx1>mx2 for x=1 to finalcount if object visible(x)=1 ox=object screen x(x):oy=object screen y(x) if ox<mx1 and ox>mx2 and oy<my1 and oy>my2 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) endif endif next x endif banding=0 endif if banding=1 and mx1<>mx2 and my1<>my2 then goto skipselect22 if mousexnew#=0 and mouseynew#=0 if mouseclick()=1 and mx1=mx2 and banding=1 and mx1=mx2 and my1=my2 for x=1 to finalcount if object visible(x)=1 if object in screen(x)=1 sx=object screen x(x):sy=object screen y(x) if mousex()>sx-5 and mousex()<sx+5 and mousey()>sy-5 and mousey()<sy+5 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) sleep 200 x=finalcount:banding=0 endif endif endif next x sleep 200 endif endif skipselect22: if inkey$()="u" for x=1 to finalcount if object visible(x)=1 if objstat(x)=1 objstat(x)=-1 color object x,rgb(0,255,0) endif endif next x endif if inkey$()="g" ghost=ghost*-1 if ghost=1 ghost matrix on 1 endif if ghost=-1 ghost matrix off 1 endif sleep 200 endif if inkey$()="s" for x=1 to finalcount if object visible(x)=1 then objstat(x)=1:color object x,rgb(255,0,0) next x endif if inkey$()="t" for x=1 to finalcount if object visible(x)=1 objstat(x)=objstat(x)*-1 if objstat(x)=1 then color object x,rgb(255,0,0) if objstat(x)=-1 then color object x,rgb(0,255,0) endif next x sleep 200 endif if inkey$()="h" hide=hide*-1 if hide=1 for x=1 to finalcount if objstat(x)=-1 and xpos(x)<matsegx and zpos(x)<matsegz hide object x endif next x endif if hide=-1 for x=1 to finalcount if objstat(x)=-1 and xpos(x)<matsegx and zpos(x)<matsegz if object visible(x)=0 then show object x endif next x endif sleep 200 endif if inkey$()="o" then o=o*-1:sleep 200 mousexold#=mousex():mouseyold#=mousey():mousezold=mousez() ink RGB(0,255,255),0 set cursor screen width()/2-120,0 print "MATRIX MASTER v1.9 - by Richard Sardini" ink RGB(0,128,255),0 print "X-size=";matsizex;"->Z-size=";matsizez print "X-segment=";matsegx;"->Z-segment=";matsegz set cursor screen width()/2-80,40 print "You are editing matix> ";:ink rgb(255,255,0),0:print matname$ set cursor screen width()/2-80,80:print "You are in Texture mode.":ink rgb(255,255,255),0 print "Mousex->";mousex();" Mousey->";mousey() xl=screen width()/2:yl=screen height()/2 ink RGB(192,192,192),0 line xl,200,xl,screen height()-200 line 250,yl,screen width()-250,yl ink rgb(255,255,255),0 if banding=1 if mx1<mx2 then ink RGB(255,0,128),0 else ink RGB(255,255,0),0 line mx1,my1,mx2,my1:line mx1,my2,mx1,my1 line mx2,my1,mx2,my2:line mx1,my2,mx2,my2 ink rgb(255,255,255),0 endif cnt1=0 print "First 16 markers selected/tile" for x=1 to finalcount if objstat(x)=1 print "X->";xpos(x);" Z->";zpos(x);" Tile->";tile(x) inc cnt1 if cnt1>15 then x=finalcount endif next x if o=-1 then goto skiphints1 inc hintc1,8:if hintc1>255 then hintc1=100 hintcolor=rgb(0,hintc1,0) ink hintcolor,0 text 0,screen height()-75,hint$(hint) skiphints1: set cursor screen width()/5,screen height()-50 ink RGB(236,237,173),0 line mousex()-9,mousey()-9,mousex()+10,mousey()+10 line mousex()-9,mousey()+9,mousex()+10,mousey()-10 ink rgb(255,255,255),0 print "Press: 4-Exit texture mode, Z-Zip to next hint, Shift Z-Zip back one hint." paste image 1,700,0 sync loop remstart This is the code snippet you will need to re-load your matrix into your DB programs open to read 1,<filenamehere> read long 1,matsizex:read long 1,matsizez read long 1,matsegx:read long 1,matsegz read long 1,finalcount dim height#(finalcount):dim xpos(finalcount):dim zpos(finalcount):dim tile(finalcount) for x=1 to finalcount read long 1,xpos(x) read long 1,zpos(x) read float 1,height#(x) read long 1,tile(x) next x close file 1 make matrix 1,matsizex,matsizez,matsegx,matsegz rem insert matrix texure here if tiling, otherwise delete marked line for x=1 to finalcount set matrix height 1,xpos(x),zpos(x),height#(x) if xpos(x)<matsegx and zpos(x)<matsegz `delete this line if not using texture set matrix tile 1,xpos(x),zpos(x),tile(x) `delete this line if not using texture endif `delete this line if not using texture next x update matrix 1 endrem Version: 1.0
Created: 28th Feb 2005 17:44
|
Complete Applications | |
A short demo showing how to create a muzzel flash effect while shooting a gun. Version: 1.0
Created: 28th Feb 2005 12:55
|
3D Effects | |
` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com remstart ------------------------------------------------------------------- program: Function to build + normalise matrix from height map ------------------------------------------------------------------- written by: James Barker [FROGGIE!] date: 10/02/05 ------------------------------------------------------------------- remend ` height map - Height map must be in BMP format. Width and height must be divisible by 2 ` function parametres needed: ` filename of bitmap, matrix number, matrix size x, matrix size z, maximum height of the matrix ` MATRIX MUST NOT EXIST! FUNCTION map_matrix(file_name$, mtx_number, mtx_x, mtx_z, mtx_max_height) ` load the file LOAD BITMAP file_name$,1 ` set a couple of variables map_x = BITMAP WIDTH(1) map_y = BITMAP HEIGHT(1) DEC map_x DEC map_y ` build the matrix MAKE MATRIX mtx_number,mtx_x,mtx_z,map_x,map_y ` set the heights of the matrix according to bitmap ` black (0,0,0) = height of 0 ` white (255,255,255) = maximum height FOR z = 0 TO map_y FOR x = 0 TO map_x col_value AS DWORD SET CURRENT BITMAP 1 col_value = (RGBR(POINT(x,z)))*255 map_percent = (col_value/255)*100 mtx_height# = (mtx_max_height/100)*map_percent SET MATRIX HEIGHT mtx_number,x,z,(mtx_height#/255) NEXT x NEXT z ` normalise the matrix FOR z_normal = 1 To map_y FOR x_normal = 1 To map_x height_8# = GET MATRIX HEIGHT(mtx_number,x_normal,z_normal-1) height_4# = GET MATRIX HEIGHT(mtx_number,x_normal-1,z_normal) height_0# = GET MATRIX HEIGHT(mtx_number,x_normal,z_normal) height_2# = GET MATRIX HEIGHT(mtx_number,x_normal,z_normal) x1# = (x_normal-1)*25.0 : y1# = height_0# x2# = (x_normal+0)*25.0 : y2# = height_4# dx# = x2#-x1# : dy# = y2#-y1# ax# = ATANFULL(dx#,dy#) ax# = WRAPVALUE(90-ax#) z1# = (z_normal-1)*25.0 : y1# = height_2# z2# = (z_normal+0)*25.0 : y2# = height_8# dz# = z2#-z1# : dy# = y2#-y1# az# = ATANFULL(dz#,dy#) az# = WRAPVALUE(90-az#) nx# = SIN(ax#) : ny# = COS(ax#) : nz#=SIN(az#) SET MATRIX NORMAL mtx_number,x_normal,z_normal,nx#,ny#,nz# NEXT x_normal NEXT z_normal ` refresh DELETE BITMAP 1 SET CURRENT BITMAP 0 UPDATE MATRIX mtx_number ENDFUNCTION Version: 1.0
Created: 28th Feb 2005 11:34
|
Complete Applications | |
The second installment of my Simple Box Movement. This one cover's the usage of angles to turn the box in the direction you wish to aim at. Version: 1.0
Created: 27th Feb 2005 20:20
|
Complete Applications | |
shows animtion one by one Version: 1.0
Created: 26th Feb 2005 07:20
|
Complete Applications | |
Functions that read a file. Version: 1.0
Created: 25th Feb 2005 17:27
|
Complete Applications | |
This is a function i created that creates a simple scrolling text Version: 1.0
Created: 25th Feb 2005 14:05
|
Text | |
zooms, finds distances, cooks e.t.c. :) Version: 1.0
Created: 25th Feb 2005 07:52
|
Complete Applications | |
zooms,finds distance,cooks e.t.c. :) Version: 1.0
Created: 25th Feb 2005 07:48
|
3D Maths | |
Texp(), Max(), Min(), Between(), Betwixt(), Range(), Mod(), Even(), Odd(), Sign(), Pi#, Circ(). I have migrated from a different Basic language on an ancient Amiga to DarkBASIC Professional on the PC. Dismayed to find several of my favourite Math functions absent I resolved to create my own. Version: 1.0
Created: 24th Feb 2005 10:09
|
Math / Physics | |
Instr(), Cut$(), Insert$(), Replace$(), Count(), ReplaceAll$(), Itemstr$(), String$(), RightAdjust$(), Flip$(), Alpha$(), Match$(). I have migrated from a different Basic language on an ancient Amiga to DarkBASIC Professional on the PC. Dismayed to find several of my favourite Text functions absent I resolved to create my own. Version: 1.0
Created: 23rd Feb 2005 17:38
|
Text | |
Adds commas to numbers where fit. Version: 1.0
Created: 22nd Feb 2005 22:26
|
Text | |
Prints a checklist of display modes and depth. Version: 1.0
Created: 22nd Feb 2005 14:26
|
Complete Applications | |
A really dumb example of what some people do in their spare time. Version: 1.0
Created: 21st Feb 2005 17:16
|
Text | |
Yet Another Zombie AI Code Thing With Worse AI, and really bad car physics! But you CAN run the zombies down! he he he Version: 1.0
Created: 21st Feb 2005 16:07
|
Complete Applications | |
Just a command from each section. Version: 1.0
Created: 21st Feb 2005 15:26
|
Complete Applications |