How fast can you type?!
Thought I'd stick this in here for the hell of it. Nothing mindblowing, just a fun and slightly addictive game.
No media, just copy and paste the code:
` *** N.B. This program requires DBPro5.8 because of the memblock format
createsound("laser",1,1500,500,5000,0.01,0.2,0,0,0,0)
createsound("explosion",2,6200,700,2000,20,0.2,0,0,0,0)
createsound("explosion2",3,1200,1400,3000,10,0.1,0,0,0,0)
createsound("powerup",4,800,700,8000,-0.02,0.2,0,0,0,0)
createsound("warning",5,800,1000,3000,0.5,0.1,0,0,0,0)
createsound("vibrato1",6,500,2000,8000,0,0.1,0.05,0.2,0,0)
createsound("vibrato2",7,400,2000,8000,0,0.1,0.05,0.2,0,0)
createsound("vibrato3",8,600,2000,8000,0,0.1,0.05,0.2,0,0)
createsound("bass hit",9,20,200,14000,0.00,1.2,.0,0,0,0)
createsound("hihat",10,800,200,5000,60.06,2.2,.1,0,0,0)
createsound("door knock",11,200,200,8000,.1,4.0,2.1,10,9.2,9.2)
createsound("vinyl scratch",12,500,200,8000,0.06,0.2,.1,0,0,0)
createsound("cb1",13,250,500,2500,0.00001,0.2,4.0,0.4,0,0)
createsound("cb2",14,500,500,2500,0.00001,0.2,4.0,0.4,0,0)
createsound("cb3",15,437.5,1500,1500,0.0001,0.2,0.0,4.0,0.4,0)
createsound("cb4",16,573.75,1500,1500,0.0,0.2,4.0,0.4,0,0)
createsound("bubble burst",17,100,800,6000,-.4,2.0,0.1,10,1.2,0.2)
autocam off
position camera 0,0,-10
color backdrop rgb(255,255,255)
make object cube 5000,1
hide object 5000
set text font "times new roman"
set text size 100
ink rgb(200,200,255),0
text 0,60,"Word Panic! "
get image 1000,0,0,450,200
ink rgb(255,255,255),0
box 0,0,10,10
ink rgb(0,0,250),0
line 0,0,0,10
line 0,0,10,0
get image 2000,0,0,10,10
ink rgb(250,0,0),0
line 0,0,0,10
line 0,0,10,0
get image 3000,0,0,10,10
make object plain 1000,14,3
texture object 1000,1000
make object plain 2000,14,3
texture object 2000,1000
position object 2000,0.1,-0.1,-0.01
set object transparency 1000,3
set object transparency 2000,3
set alpha mapping on 2000,50
make object plain 3000,14,3
texture object 3000,1000
position object 3000,0.1,-0.1,-0.01
set object transparency 3000,3000
set alpha mapping on 3000,30
make object plain 4000,15,3
`texture object 4,3
scale object texture 4000,50,10
position object 4000,0,0,0
`set object light 4,0
set object emissive 4000,rgb(0,0,250)
`set image colorkey 255,255,255
`set object transparency 4,1
ghost object on 4000,2
make object sphere 6000,-100,30,30
texture object 6000,2000
scale object texture 6000,50,50
sync on
color backdrop 0
read disallowedcharacterlist$
numberofdisallowedcharacters=len(disallowedcharacterlist$)
dim disallowedcharacter$(numberofdisallowedcharacters)
for checkdisallowedcharacters=1 to numberofdisallowedcharacters
disallowedcharacter$(checkdisallowedcharacters)=right$(left$(disallowedcharacterlist$,checkdisallowedcharacters),1)
next checkdisallowedcharacters
read wordbank$
numberofwords=1
dim word$(numberofwords)
length=len(wordbank$)
for checkforspaces=1 to length
checkcharacter$=right$(left$(wordbank$,checkforspaces),1)
if checkcharacter$=" "
inc numberofwords
dim word$(numberofwords)
else
proceed=1
for checkdisallowedcharacters=1 to numberofdisallowedcharacters
if checkcharacter$=disallowedcharacter$(checkdisallowedcharacters)
proceed=0
endif
next checkdisallowedcharacters
if proceed=1
word$(numberofwords)=word$(numberofwords)+checkcharacter$
endif
endif
next checkforspaces
restart:
total=0
score=0
correct=2
inputword$=""
undim randomword$(500)
undim stackedboxes(500)
dim randomword$(500)
dim stackedboxes(500)
currentword=1
nextword=1
topstackedbox=0
target=10
for image=1 to 200
if image exist (image) then delete image image
if object exist (image) then delete object image
next image
set text size 26
create bitmap 1,screen width(),screen height()
set current bitmap 0
firsttime=1
starttime=timer()
set text size 50
do
time=(timer()-starttime)/1000
if time>6
newword=1
starttime=timer()
endif
if firsttime=1
firsttime=0
newword=1
endif
scroll object texture 1000,0.001,0.0007
scroll object texture 2000,0.0008,0.0002
scroll object texture 3000,-0.0005,-0.0002
scroll object texture 6000,0,0.02
if newword=1
do
randomword$(nextword)=lower$(word$(rnd(numberofwords-1)+1))
if len(randomword$(nextword))>3 then exit
loop
set current bitmap 1
cls
ink rgb(255,255,255),0
box 0,0,300,60
ink rgb(0,0,255),0
text 0,0,randomword$(nextword)
get image nextword,0,0,300,60
set current bitmap 0
make object box nextword,6,1,1
position object nextword,0,5,0
if (nextword-1)>0
if object position y(nextword-1)>4 then position object nextword,0,object position y(nextword-1)+1,0
endif
texture object nextword,nextword
inc total
inc nextword
newword=0
endif
`text 0,0,randomword$(nextword-1)
for object=1 to total
if object exist(object)
if stackedboxes(object)=0 or stackedboxes(object)=2 then position object object,0,object position y(object)-0.011,-0.5
if object position y(currentword)<-5
stackedboxes(currentword)=1
topstackedbox=currentword
play sound 1
inc currentword
endif
if topstackedbox>0
if stackedboxes(object)=0
if object position y(currentword)<object position y(topstackedbox)+1
stackedboxes(currentword)=1
topstackedbox=currentword
play sound 1
inc currentword
endif
endif
endif
if object=currentword then set object emissive object,rgb(255,50,50) else set object emissive object,rgb(10,10,10)
endif
next object
if topstackedbox>0
set object emissive topstackedbox,rgb(55,50,250)
if object position y(topstackedbox)>5 then goto gameover
endif
if score>target
play sound 4
inc target,10
for stacked=1 to topstackedbox
stackedboxes(stacked)=2
next stacked
endif
newletter$=inkey$()
if returnkey()=0 then lockreturnkey=0
if newletter$=oldletter$
else
if returnkey()=0
inputletter$=inkey$()
oldletter$=inputletter$
inputword$=inputword$+inputletter$
endif
if returnkey()=1 and lockreturnkey=0
lockreturnkey=1
if inputword$=randomword$(currentword)
newword=1
inc score,1
inc currentword
inputword$=""
correct=1
play sound 17
else
correct=0
play sound 2
inputword$=""
endif
endif
endif
if currentword>=nextword then newword=1
ink rgb(255,255,255),0
text 0,150,inputword$
if correct=1
text 0,60,"Correct"
endif
if correct=0
text 0,60,"Incorrect"
endif
text 0,90,"Score: "+str$(score)
sync
loop
gameover:
wait 1000
cls
ink rgb(0,0,255),0
print "Game over. You scored ",score," points."
sync
wait 2000
cls
print "Game over. You scored ",score," points."
print "Press any key to restart"
sync
wait key
goto restart
data ".,:;1234567890/?!£$%^&*()-=+_{}[]#@<>"
data "In key stage 3, in accordance with the whole school ICT policy, and in order to fulfil the requirements for the key stage 3 ICT curriculum, the emphasis of using ICT in science is to provide pupils with opportunities to make use of datalogging devices. Pupils in key stage 3 are to be assessed on their ability to use such apparatus, to manipulate and analyse the data recorded using computer software, and to evaluate the effectiveness of such methods, culminating in an ICT level being awarded to all year 9 pupils in accordance with the ICT marking policy . In key stages 3 and 4 and at AS and A level, pupils are to be provided with opportunities where possible to make use of all forms of ICT which may assist in their learning and presentation of science."
function createsound(name$,soundnumber,frequency#,length#,loudness#,bend#,decay#,vibratospeed#,vibratodepth#,tremelospeed#,tremelodepth#)
outWord as word
dword1 as dword: dword2 as dword: dword3 as dword: dword4 as dword
dword5 as dword: dword6 as dword: dword7 as dword
samples=int((length#/1000)*44100)
if memblock exist(1) then delete memblock 1
make memblock 1,samples*2+28
` write 28 memblock header bytes
dword1=1 ` gg query: is this the number of channels?
dword2=2 ` gg query: is this the number of bytes per sample?
dword3=22050 ` gg query: seems to be half the number of samples per second - why?
dword4=88200 ` gg query: is this the number of bytes per second?
dword5=4 ` gg query: what does this represent?
dword6=16 ` gg query: (ditto) ?
dword7=0 ` gg query: (ditto) ?
position=0
write memblock dword 1, position, dword1 : inc position,4
write memblock dword 1, position, dword2 : inc position,4
write memblock dword 1, position, dword3 : inc position,4
write memblock dword 1, position, dword4 : inc position,4
write memblock dword 1, position, dword5 : inc position,4
write memblock dword 1, position, dword6 : inc position,4
write memblock dword 1, position, dword7 : inc position,4
rem generate and write wave
for x=1 to samples
outInteger=int(sin((x/122.5)*(frequency#+vibratodepth#*sin(theta#)))*(loudness#+tremelodepth#*sin(phi#)))*3.0
if outInteger <-32767 then outInteger=-32767 ` gg query: is this the valid range?
if outInteger>32767 then outInteger=32767 ` gg query: (ditto) ?
outWord=outInteger
inc theta#,vibratospeed#
inc phi#,tremelospeed#
dec frequency#,bend#
if loudness#>0 then dec loudness#,decay#
write memblock word 1, position, outWord : inc position,2
next x
make sound from memblock 999, 1 ` assumes you won't need sound number 999!
clone sound soundnumber, 999
delete sound 999
` memblock no longer required
delete memblock 1
endfunction
The aim of the game? Type the words as fast as you can before they stack up to the top of the screen. Every 10 words you type correctly will clear the stack of words.
Enjoy.
