collision update.
Rem Project: fps
Rem Created: Sunday, August 01, 2010
Rem ***** Main Source File *****
sync on
autocam off
make matrix 1,1000,1000,20,20
position camera 0,1,0
set ambient light 100
Type tTeletype
Text$
XPos
YPos
XSize
Delay
Time
Char
Show
EndType
// here are the important vars
Counter = -1
global maxmsg=4
Dim Msg$(maxmsg) as String
global textmode
global id
Global TeleType As tTeleType
global dim g_temp_wordArray() as string
null=make vector3(1)
global Flast# as float
global Diff# as float
global Ideal# as float
global Factor# as float
global mysync as integer
Dim factors(30) as float
global movetimer as integer
global thisMove as float
global moveTotal as float
global moved as float
Global FrameX#
Global FrameLast
Global DelayPeriod#
Global MoreAcurateFPS#
Global TurnStartTime#
GLobal TurnTimeTaken#
Global UseAlternateTiming
Global FrameTimeLength#
Make Object Cube 1, 10
color object 1,rgb(0,255,0)
make object cube 2, 10
color object 1,rgb(0,0,255)
make object cube 11, 1
hide object 11
FrameTimeLength# = 16.6666666666666
FrameTimer()
tm_Update()
sc_setupobject 1,1,0
sc_setupobject 2,1,0
sc_setupobject 11,1,0
Do
sc_updateobject 1
sc_updateobject 2
sc_updateobject 11
select id
case 2
Msg$(0) = "\bThis is the first message!"
Msg$(1) = "\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2.\cGuess what? Number 2."
Msg$(2) = "\iI think we're somewhere at #3..."
Msg$(3) = "Last one for now."
endcase
endselect
set camera to follow object position x(1),object position y(1),object position z(1),0,80,4,20,1
`if textmode = 0
`Store the user's old position on the xyz axis
OX# = OBJECT POSITION X(1)
OY# = OBJECT POSITION Y(1)
OZ# = OBJECT POSITION Z(1)
`Handle the player movement/orientation
move object 1, (keystate(17)-keystate(31) or upkey()-downkey())*4*Factor#
turn object left 1, (keystate(30)-keystate(32) or leftkey()-rightkey())*4*Factor#
`Store the player's new position on the xyz axis, after they've moved.
X# = OBJECT POSITION X(1)
Y# = OBJECT POSITION Y(1)
Z# = OBJECT POSITION Z(1)
`Call the sliding collision function, filling in the necassary variables
SlidingCollision(OX#,OY#,OZ#,X#,Y#,Z#,object size x(1)/2,1,2)
`endif
if GetDist(0,0,1,2)<=20 || GetDist(0,0,2,1)<=20
id=2
else
id=0
endif
if id>0
// Here is the important stuff ---->
If Spacekey() And Counter = -1 `Space to start the messages. Counter = -1 means it wasn't started yet.
textmode=1
Width = screen width()
Height = 100
XPos = 0 `(screen width() / 2) - (Width / 2)
YPos = (screen height())-(Height/2) `(screen height() / 2) - (Height / 2)
Counter = 0
SetTeleType( Msg$(0), XPos,YPos, Width, Height )
endif
If TeleType.Char >= Len(Teletype.Text$) ` <- checking if all is typed out.
If Returnkey()
If (Counter >= 0) and (Counter < 3) ` <- if you still have Messages
Counter = Counter + 1 ` <- increase your counter!
SetTeleType( Msg$(Counter), XPos,YPos, Width, Height )
Else ` <- all messages were shown: stop Teletype or reset it.
id=0
textmode=0
Teletype.Show = 0
Counter = -1
Endif
Endif
endif
endif
DisplayTeleType()
Text 10,10, "Simulated Framerate of " + Str$(1000.0 / FrameTimeLength#) + "fps. Frame length is " + str$(FrameTimeLength#) + "ms."
Text 10,20,"-----------------------------"
Text 10,30,"Mage's Multiplier FrameX#"
Text 10,40, Str$(FrameX#)
Text 10,60,"KISTech's Multiplier Factor#"
Text 10,70,Str$(Factor#)
Text 10,90,"Factor# times 6.0"
Text 10,100,Str$(Factor# * 6.0)
Sync
Loop
`Sliding Collision Function
FUNCTION SlidingCollision(X1#,Y1#,Z1#,X2#,Y2#,Z2#,Radius#,Dyn,Obj)
`X1#-Z1# : The starting XYZ position of the intersection ray
`X2#-Z2# : The ending XYZ position of the intersection ray
`Radius# : The radius of the sliding collision sphere, usually you'd set this
` to the player's object's z sixe divided by 2. Our cube is 20 units thick,
` so we use 10 in the example.
`Dyn : The player object
`Obj : The map object that we want the player object to slide on
`Call the sc_SphereSlide command, using our variables.
`This command will create a mathematical intersection "Ray",
`this basically means that it'll make a 3D line starting from X1#,Y1#,Z1#,
`and ending at X2#,Y2#,Z2#. It'll then check if any of the polygons on the
`map object are inbetween these 2 points, if there is then it'll return a 1,
`if not, it'll return 0.
`What Sparky has done for us however is added in a few handy functions
`that are carried out inside of the SphereSlide command. Basically,
`once it detects an intersection, it'll get the angle the intersection
`occured at and using trigonometry (sin, cos and tan), it'll determine
`the logical position for an object to be if it were to "slide" along
`the polygon it hit. To make the system even more accurate however,
`Sparky's dll goes one step further by doing another intersection check on the
`new mathematical coordinates it just obtained, and checks that there wont be
`a collision there either. `It'll keep doing this until it reaches it's max
`iteration or until it finds a free, empty 3d location where the player's object
`can go. All this for free, sheesh!
C = sc_SphereSlide(Obj,X1#,Y1#,Z1#,X2#,Y2#,Z2#,Radius#,0)
`Now, sparky's dll will return the 3d position it thinks you should position your
`player object at AS WELL. These positions are returned using the sc_getCollisionSlideXYZ()
`commands. Basicaly the next code checks if an intersection occured in the first place
` (if C > 0), and if one did, then it retrieves the new XYZ location that the player should be
`placed at, and then positions the player object there accordingly.
IF C > 0
cx# = sc_getCollisionSlideX()
cy# = sc_getCollisionSlideY()
cz# = sc_getCollisionSlideZ()
POSITION OBJECT Dyn, cx#, cy#, cz#
ENDIF
ENDFUNCTION
function GetDist(camon,cam,obj1,obj2)
select camon
case 0
if obj1<>0 and obj2<>0
x1#=Object Position X(obj2)
y1#=Object Position Y(obj2)
z1#=Object Position Z(obj2)
x2#=Object Position X(obj1)
y2#=Object Position Y(obj1)
z2#=Object Position Z(obj1)
endif
endcase
case 1
if obj1<>0
x1#=Camera Position X(cam)
y1#=Camera Position Y(cam)
z1#=Camera Position Z(cam)
x2#=Object Position X(obj1)
y2#=Object Position Y(obj1)
z2#=Object Position Z(obj1)
endif
endcase
endselect
dist# = Dist(x1#,x2#,y1#,y2#,z1#,z2#)
endfunction dist#
Function Dist(x1#,x2#,y1#,y2#,z1#,z2#)
Set Vector3 1,x1#-x2#,y1#-y2#,z1#-z2#
rdist#=Length Vector3(1)
EndFunction rdist#
function objfacing(obj,ang#)
ang# = object angle y(obj)
if ang#=-0 then ang#=0
endfunction ang#
function camfacing(cam,ang#)
ang# = camera angle y(cam)
if ang#=-0 then ang#=0
endfunction ang#
`Mages Timing Solution
Function FrameTimer()
`Diff# = (Timer() - FrameLast) `replaced for this demo
Diff# = FrameTimeLength# `Added for this demo.
Ideal# = 1000.0 / 60.0
FrameX# = Diff# / Ideal#
If Diff# > 1000 then FrameX# = 0
FrameLast = Timer()
EndFunction
`KISTech's Timing Solution
function tm_Update()
Diff# as float
`Diff# = timer() - Flast# `replaced for this demo
Diff# = FrameTimeLength# `Added for this demo
If Diff# > 1000 then Diff# = 0
Flast# = timer()
factor# = 0.0
for tx = 1 to 29
factors(tx) = factors(tx+1)
factor# = factor# + factors(tx)
next tx
factors(30) = Diff# / 100.0
`factor# = factor# + factors(30) `removed for this demo
factor# = factors(30) `Added for this demo (this removes the timing averaging)
`factor# = factor# / 30.0 `removed for this demo (this removes the timing averaging)
endfunction
Function DisplayTeleType()
`Only show the TeleType if set to 'on'
If TeleType.Show = 0 Then ExitFunction
`If the time is greater than the timeout then...
If Timer() >= ( TeleType.Time + TeleType.Delay )
`Reset the timeout variable
TeleType.Time = Timer()
`If the number of letters to be displayed is less than the total number of letters, show another letter.
If TeleType.Char < Len( TeleType.Text$ )
If mid$(TeleType.Text$,TeleType.Char) = "\" Then TeleType.Char = TeleType.Char + 1
If mid$(TeleType.Text$,TeleType.Char + 1) = "\" Then TeleType.Char = TeleType.Char + 2
TeleType.Char = TeleType.Char + 1
If mid$(TeleType.Text$,TeleType.Char) = " " Then TeleType.Char = TeleType.Char + 1
Endif
EndIf
`Display the text string.
Show$ = Left$(TeleType.Text$,TeleType.Char)
Ink 0x88888888,0
XPos = (screen width() / 2) - (TeleType.XPos / 2)
YPos = (screen height() / 2) - (TeleType.YPos / 2)
box TeleType.XPos, TeleType.YPos, TeleType.XPos + TeleType.XSize, TeleType.YPos + (Text Height("|")+2) * (Text Width(TeleType.Text$) / TeleType.XSize + 3)
display_text(TeleType.XPos, TeleType.YPos, TeleType.XSize, Show$, 0xFFFFFFFF, rgb(68,207,0))
Ink 0xFFFFFFFF,0
If TeleType.Char >= Len(Teletype.Text$) ` <- checking if all is typed out.
If (Counter < 2) ` <- if you still have Messages
` <- if you still have Messages
Text TeleType.XSize/2-Text Width("Press Enter To Continue")/2,TeleType.YPos+Text Height("Press Enter To Continue")*2.5,"Press Enter To Continue"
EndIf
If Counter = 2
Text TeleType.XSize/2-Text Width("Press Enter To Close")/2,TeleType.YPos+Text Height("Press Enter To Close")*2.5,"Press Enter To Close"
Endif
EndIf
EndFunction
Function SetTeleType( Text$, X, Y, XSize, Delay)
`Set all the variables.
TeleType.Text$ = trim(Text$)
TeleType.Delay = Delay
TeleType.Time = Timer()
TeleType.XPos = X
TeleType.YPos = Y
TeleType.XSize = XSize
TeleType.Char = 0
TeleType.Show = 1
EndFunction
` Display some text, word wrapped, with special coloring
function display_text(x_pos, y_pos, x_size, value$, normalColor, specialColor)
x_size = x_size + x_pos
__build_word_array(trim(value$))
cnt = array count(g_temp_wordArray())
cur_x = x_pos
cur_y = y_pos
mode = 0
nobreak = 0
h = text height("|") + 2 ` maximum text height + margin of 2 pixels
ink normalColor,0
Set Text To Normal
for i=0 to cnt
t$ = g_temp_wordArray(i)
if (mid$(t$,1) = "\")
if i<cnt
select mid$(t$,2)
case "n"
cur_x = x_pos
cur_y = cur_y + h
mode = 2
endcase
case "b"
Set Text To Bold
mode = 2
Endcase
case "i"
Set Text To Italic
mode = 2
Endcase
case "c"
Ink specialColor,0
mode = 2
Endcase
case "s"
nobreak = 1
mode = 2
Endcase
case "\"
t$ = "\"
nobreak = 1
Endcase
Endselect
else
mode = 2
endif
w = 0
else
w = text width(t$)
endif
if (cur_x + w > x_size) and (nobreak = 0)
cur_y = cur_y + h
cur_x = x_pos
endif
if mode < 2
text cur_x, cur_y, t$
cur_x = cur_x + w + text width(" ")
endif
If mode > 0 Then dec mode
If mode = 0
ink normalColor,0
Set Text To Normal
if t$<>"\" then nobreak = 0
endif
next i
endfunction
` INTERNAL FUNCTION, DO NOT USE
function __build_word_array(value$)
l = len(value$)
base$ = ""
empty array g_temp_wordArray()
for i=1 to l
c$ = mid$(value$, i)
if c$=" "
if len(trim(base$)) > 0
array insert at bottom g_temp_wordArray()
g_temp_wordArray() = trim(base$)
endif
base$ = free string$()
else
If (c$="\") and (i+1 <= l)
if len(trim(base$)) > 0
array insert at bottom g_temp_wordArray()
g_temp_wordArray() = trim(base$)
endif
i = i + 1
array insert at bottom g_temp_wordArray()
g_temp_wordArray() = "\" + mid$(value$, i)
base$ = free string$()
else
base$ = base$ + trim(c$)
endif
endif
next i
if (len(base$) > 0) and base$ <> " "
array insert at bottom g_temp_wordArray()
g_temp_wordArray() = trim(base$)
Endif
base$ = free string$()
endfunction
function trim(a$)
if a$=" " then exitfunction ""
while mid$(a$,1)=" "
a$=right$(a$,len(a$)-1)
endwhile
while mid$(a$,len(a$))=" "
a$=left$(a$,len(a$)-1)
endwhile
endfunction a$
CHECK OUT SOME MUSIC FROM MY NEW TECHNO CD! TECHNOKINESIS
http://www.youtube.com/watch?v=4a8KedfgVv0
ALSO, CHECK OUT MY NEW TECHNO CD! http://www.imageposeidon.com/
