TGC Codebase Backup



Grab the time make it a sprite and the balance it on a line by HowDo

25th Sep 2003 5:51
Summary

This bit of code lets to grab the time and make into a sprite which you can then balance on a line.



Description

You can then balance line with the keys "A Z ' ?" which is part of the laws of physics
most of it has remstatments saying what does what where and why.



Code
                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    rem Balance Time demo
rem by HowDo
rem with thanks to Mento and ChipOne who got the clock ticking
rem and Wastisname for getting the balance leveling.
sync on : sync rate 20: draw to back
set text font "arial" : set text size 12
set text to bold
set text opaque
rem makes a bitmap to change to
create bitmap 1,640,480
rem puts the time into varable the_time$
the_time$=get time$()
rem put time() into intsecondtimer
intsecondtimer=timer()
rem puts us in bitmap 0
a=0 : b=0 :c=0
set current bitmap 0
rem shows the time
updatesecondsimage(get time$(),roll#,height#)
rem sets up where the line starts
a=480
b=480
rem sets where the sprite is on the line
roll#=340
rem set the start speed
speed# = 0.0

do
cls
rem looks for the key or keys you have pressed
if keystate(30)=1 then a=a-1
if keystate(44)=1 then a=a+1
if keystate(40)=1 then b=b-1
if keystate(53)=1 then b=b+1
rem stop's the line from begin draw out side the screen
if a<0 then a=0
if a>480 then a=480
if b<0 then b=0
if b>480 then b=480
line 0,a,640,b

rem 680.0 here is screen width in pixels (I think)
frac# = roll#/640.0
height# = frac#*b + (1.0 - frac#)*a

rem the bit that keeps the sprite on the line
if height#<a or height#>b then speed# = speed# - (a-b)*00000.1
if height#>a or height#<b then speed# = speed# + (b-a)*00000.1
rem update roll
roll# = roll# + speed#

rem make sure circle or sprite doesn't leave screen
if speed#<0 and roll#<20 then speed# = 0.0: roll# = 20
if speed#>0 and roll#>620 then speed# = 0.0: roll# = 620

rem see if it time to get a new time value and make it a sprite
if timer()>(intsecondtimer+1000)
   rem if it is jump to function with value get Time$()
   updatesecondsimage(get time$(),roll#,height#)
   rem return from function and give intsecondtimer new timer() to check.
   intsecondtimer=timer()
endif

rem circle roll#,height# - 20,20

rem put the now time on the screen
sprite 1,roll#-text width(the_time$),height#-10,1

rem update everything
sync

loop

function updatesecondsimage(the_time$,roll#,height#)
rem change to bitmap 1
set current bitmap 1
rem set text color
ink RGB(255,255,255),0
rem put the text on bitmap screen 1
text 0,0,the_time$+"  "
rem grab the text
get image 1,0,0,text width(the_time$)+150,text height(the_time$),1
rem switch back to main screen
set current bitmap 0
rem put sprite on the screen
sprite 1,roll#-text width(the_time$),height#-10,1
rem as below
endfunction a