ok i ALMOST got it to work.
But the text is acting weird.
THIS problem I can't figure out..
Rem Project: fps
Rem Created: Sunday, August 01, 2010
Rem ***** Main Source File *****
d3d_init
d3d_font 1,"Arial",10,0,0,1
color backdrop 0
set ambient light 100
sync on
sync rate 60
autocam off
make matrix 1,1000,1000,20,20
position camera 0,1,0
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)
position object 1,0,1,0
make object cube 2, 10
color object 1,rgb(0,0,255)
position object 2,0,1,4
make object cube 3,1
position object 3,0,1,20
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 3,1,0
sc_setupobject 11,1,0
global coll
set shadow shading on 1
set shadow shading on 2
set shadow shading on 3
set shadow shading on 11
set object 1,1,0,0,0,0,0
Do
color object 2,0xFFFFFFFF
sc_updateobject 1
sc_updateobject 2
sc_updateobject 3
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
`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
`if textmode = 0
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#
`endif
`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
coll=SlidingCollision(OX#,OY#,OZ#,X#,Y#,Z#,object size x(1)/2,1,2)
if coll<>0
color object 2,rgb(255,0,0)
endif
position object 3,object position x(1),object position y(1),object position z(1)
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()
d3d_starttext
d3d_Text 1,10,10,1,"Simulated Framerate of " + Str$(1000.0 / FrameTimeLength#) + "fps. Frame length is " + str$(FrameTimeLength#) + "ms."
d3d_Text 1,10,20,1,"-----------------------------"
d3d_Text 1,10,30,1,"Mage's Multiplier FrameX#"
d3d_Text 1,10,40,1,Str$(FrameX#)
d3d_Text 1,10,60,1,"KISTech's Multiplier Factor#"
d3d_Text 1,10,70,1,Str$(Factor#)
d3d_Text 1,10,90,1,"Factor# times 6.0"
d3d_Text 1,10,100,1,Str$(Factor# * 6.0)
d3d_Text 1,10,110,1,"FPS:"+str$(screen fps())
d3d_endtext
Sync
Loop
function HealthBar(x, y, width, height, P#)
P# = P#/100
if P#<0.0 then P#=0.0
rem gradient bar
seg = width / 3
d3d_box x, y, x+seg, y+height, rgb(255,0,0),rgb(255,0,0),rgb(170,85,0),rgb(170,85,0)
d3d_box x+seg, y, x+seg+seg, y+height, rgb(170,85,0),rgb(170,85,0),rgb(85,170,0),rgb(85,170,0)
d3d_box x+seg+seg, y, x+width, y+height, rgb(85,170,0),rgb(85,170,0),rgb(0,255,0),rgb(0,255,0)
rem empty bit
d3d_color 92,92,92,0
d3d_box x+width*P#, y, x+width, y+height
rem highlight
c1 = 0xCCFFFFFF
c2 = 0x33FFFFFF
d3d_box x, y, x+width, y+height*0.5, c2,c1,c2,c1
endfunction
function RotateCamera()
MX# as float
MX#=MOUSEMOVEX()
MY# as float
MY#=MOUSEMOVEY()
AngleY#=wrapvalue(AngleY#+(MX#/5.0))
AngleX#=(AngleX#+(MY#/5.0))
if AngleX#>70.0 then AngleX#=70.0
if AngleX#<-70.0 then AngleX#=-70.0
MouseScroll=-mousemovez()
CameraDistance#=CameraDistance#+MouseScroll
if CameraDistance#>8000.0 then CameraDistance#=8000.0
if CameraDistance#<10.0 then CameraDistance#=10.0
position camera 0,300,0 `the lookat point
rotate camera AngleX#,AngleY#,0.0
move camera -CameraDistance#
endfunction
`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 C
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)
d3d_color 0x88888888,0x88888888,0x88888888,0x0000FF
XPos = (screen width() / 2) - (TeleType.XPos / 2)
YPos = (screen height() / 2) - (TeleType.YPos / 2)
d3d_box TeleType.XPos, TeleType.YPos, TeleType.XPos + TeleType.XSize, TeleType.YPos + (d3d_gettextheight(1,"|")+2) * (d3d_gettextwidth(1,TeleType.Text$) / TeleType.XSize + 3)
display_text(TeleType.XPos, TeleType.YPos, TeleType.XSize, Show$, 0xFFFFFFFF,0xFFFFFFFF,0xFFFFFFFF,0x0000FF,68,207,0,0x0000FF)
d3d_color 0xFFFFFFFF,0xFFFFFFFF,0xFFFFFFFF,0x0000FF
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
d3d_starttext
d3d_Text 1,TeleType.XSize/2-d3d_gettextwidth(1,"Press Enter To Continue")/2,TeleType.YPos+d3d_gettextheight(1,"Press Enter To Continue")*2.5,1,"Press Enter To Continue"
d3d_endtext
EndIf
If Counter = 2
d3d_starttext
d3d_Text 1,TeleType.XSize/2-d3d_gettextwidth(1,"Press Enter To Close")/2,TeleType.YPos+d3d_gettextheight(1,"Press Enter To Close")*2.5,1,"Press Enter To Close"
d3d_endtext
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$,r1,g1,b1,a1,r,g,b,a)
d3d_starttext
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 = d3d_gettextheight(1,"|") + 2 ` maximum text height + margin of 2 pixels
d3d_color r1,g1,b1,a1
d3d_font 1,"Arial",10,0,0,1
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"
d3d_font 1,"Arial",10,1,0,1
mode = 2
Endcase
case "i"
d3d_font 1,"Arial",10,0,1,1
mode = 2
Endcase
case "c"
d3d_color r,g,b,a
mode = 2
Endcase
case "s"
nobreak = 1
mode = 2
Endcase
case "\"
t$ = "\"
nobreak = 1
Endcase
Endselect
else
mode = 2
endif
w = 0
else
w = d3d_gettextwidth(1,t$)
endif
if (cur_x + w > x_size) and (nobreak = 0)
cur_y = cur_y + h
cur_x = x_pos
endif
if mode < 2
d3d_text 1,cur_x, cur_y,1,t$
cur_x = cur_x + w + d3d_gettextwidth(1," ")
endif
If mode > 0 Then dec mode
If mode = 0
d3d_color r1,g1,b1,a1
set text to normal
if t$<>"\" then nobreak = 0
endif
next i
d3d_endtext
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/
