TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 17th Jul 2005 15:48

Modified: 1st Jan 1970 01:00

Author: RiiDii

Summary

Ummm... a pinball game.

Full Description

Left/Right Control Keys operate flippers<br /> Enter to launch the ball<br /> Space Bar to 'shake' the table<br /> 5 Balls per game<br /> No quarters needed

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

Rem Project: PinBall

Rem Created: 7/7/2005 6:35:40 PM

Rem Created by RiiDii

Rem ***** Main Source File *****

Sync On: Sync Rate 60:Autocam Off

Global n#

Global cFlag as Integer

Global LimbMatrix As Integer

Global EyeVector As Integer

Global LookAtVector As Integer

Global LookUpVector As Integer

Global DropDown as Integer

Global dd as Integer

Global tx#

Global ty#

Global tz#

Global Score as Integer

Dim KickFlag(1) as Float

Dim mm(2) as Float

Dim Kick(5)

Dim cFlag(0) as Integer

Dim fpos(0,2) as Float

Dim n(0) as Float

LimbMatrix=10

EyeVector=11

LookAtVector=12

LookUpVector=13

r = Make Matrix4( LimbMatrix )

r = Make Vector3(1)

r = Make Vector3(2)

r = Make Vector3(EyeVector)

r = Make Vector3(LookAtVector)

r = Make Vector3(LookUpVector)

Make Object Sphere 1,6,8,8

Prepare_Limb(1,0,3)

Delete Object 1

Make Object Sphere 1,6,15,15

Set Object Collision To Spheres 1

Make Object Box 2,100,5,120

`Flippers

Make Object Box 3,20,11,5

Offset Limb 3,0,8,0,0

Make Mesh From Object 3,3

Delete Object 3

Add Limb 2,1,3

Prepare_Limb(2,1,.001)

Offset Limb 2,1,-20,2.6,-50

Rotate Limb 2,1,0,30,0

Color Limb 2,1,Rgb(50,50,100)

Add Limb 2,2,3

Prepare_Limb(2,2,.001)

Offset Limb 2,2,20,2.6,-50

Rotate Limb 2,2,0,-210,0

Color Limb 2,2,Rgb(50,50,100)

`Side Walls

Add_Limb(2,7,10,120,-50,3,0,0,0,0)

Add_Limb(2,7,10,120,50,3,0,0,0,0)

`Top Wall

Add_Limb(2,100,10,7,0,3,60,0,0,0)

`Center Kickers

Add_Limb(2,4,6,4,0,3,30,0,42,0)

Add_Limb(2,4,6,4,-9,3,20,0,45,0)

Add_Limb(2,4,6,4,9,3,20,0,48,0)

`Side runners for flippers

Add_Limb(2,18,8,4,-30,3,-45,0,20,0)

Add_Limb(2,18,8,4,30,3,-45,0,-200,0)

`Side drain knobs

Add_Limb(2,6,6,6,-47,3,-30,0,45,0)

Add_Limb(2,6,6,6,47,3,-30,0,45,0)

`Top-right rollover guide-bars

rr=Add_Limb(2,2,8,7,20,3,35,0,0,0)

Add_Limb(2,2,8,7,29,3,34,0,0,0)

Add_Limb(2,2,8,7,38,3,33,0,0,0)

`Side Kickers

Add_Limb(2,21,8,3,-31,3,-27,0,40,0)

Add_Limb(2,21,8,3,31,3,-27,0,-220,0)

`Top-left drop-down target bar

dd=Add_Limb(2,20,8,4,-30,2.4,53,0,0,0)

`Side runner knobs

Add_Limb(2,5,7,5,-36,3,-41,0,20,0)

Add_Limb(2,5,7,5,36,3,-41,0,-200,0)

`Glass top

l=Add_Limb(2,100,.1,120,0,8.5,0,0,0,0)

Hide Limb 2,l

Color Limb 2,0,RGB(100,100,254)

Set Object Collision Off 2

Position Camera 0,70,-80

Point Camera 0,0,0

Make Object Sphere 3,9

Scale Object 3,100,40,100

Make Mesh From Object 3,3

Delete Object 3

Pitch Object Up 2,3

For i = 0 to 2

Make Object 11+i,3,0

Position Object 11+i,Limb Position X(2,6+i),Limb Position Y(2,6+i)+2.0,Limb Position Z(2,6+i)

Set Object Collision To Spheres 11+i

Color Object 11+i,Rgb(255,0,0)

Next i

Make Object Box 14,17,7,1

Position Object 14,Limb Position X(2,16)+1.2,Limb Position Y(2,16)+.1,Limb Position Z(2,16)+1.2

Rotate Object 14,0,40,0

Set Object Collision To Boxes 14

Color Object 14,rgb(255,0,0)

Clone Object 15,14

Position Object 15,Limb Position X(2,17)-1.2,Limb Position Y(2,17)+.1,Limb Position Z(2,17)+1.2

Rotate Object 15,0,-220,0

Set Object Collision To Boxes 15

Color Object 15,rgb(255,0,0)

For i = 1 to 3

Make Object Box 15+i,.5,.5,4

Position Object 15+i,16+(i*9),Limb Position Y(2,rr+(i-1))+1,36-i

Color Object 15+i,0

Set Object Collision To Boxes 15+i

Next i

For i = 1 to 3

Make Object Box 18+i,4,6.5,2

Position Object 18+i,-40+(i*5),Limb Position Y(2,dd),51

Color Object 18+i,Rgb(255,0,0)

Set Object Collision To Boxes 18+i

Next i

Position Object 1,0,-20,40

Balls=0

Score=0

If ReturnKey() And Object Position Y(1)<-20

Balls=Balls+1

Position Object 1,35,5,40

mm(0)=-(Rnd(20.0)/10.0)-.5

mm(1)=0

mm(2)=0

Endif

tx#=Object Position X(1)

ty#=Object Position Y(1)

tz#=Object Position Z(1)

If SpaceKey()

Position Object 2,0,0,.5

Else

Position Object 2,0,0,0

Endif

Set Vector3 2,mm(0),mm(1),mm(2)

LV3#=Length Vector3(2)

If LV3#>2.9

Scale Vector3 2,2,2.9/LV3#

mm(0)=X Vector3(2)

mm(1)=Y Vector3(2)

mm(2)=Z Vector3(2)

Endif

Position Object 1,Object Position X(1)+mm(0),Object Position Y(1)+mm(1)-.2,Object Position Z(1)+mm(2)

Kickers()

c=Check_Collision(1,0,2,1,0)

Position Object 1,fpos( 20 , 0 ), fpos( 20 , 1),fpos( 20 , 2)

mm(0)=(Object Position X(1)-tx#)

mm(1)=(Object Position Y(1)-ty#)

mm(2)=(Object Position Z(1)-tz#)

Flipper(1)

Flipper(2)

Sync_Flag=(Sync_Flag<3)+(Sync_Flag<2)+(SyncFlag<1)

If Sync_Flag=1

Set Cursor 0,0

Print "Score: ";Score

Print "Ball:  ";Balls

Sync

Endif

if Balls=5 And Object Position Y(1)<-19

Exit

Endif

Loop

Wait 300

Clear Entry Buffer

Set Cursor 0,0

Print "Score: ";Score

Print "Ball:  ";Balls

Print "Game Over. Press Any Key"

If Inkey$()<>"" Then Exit

Sync

Loop

Function Flipper(side)

ks=(side=1)*29+(side=2)*157

ang#=(side=1)*30+(side=2)*-210

If KickFlag(side-1)<60 and (KeyState(ks) or KickFlag(side-1)>0)

KickFlag(side-1)=KickFlag(side-1)+7

Rotate Limb 2,side,0,ang#-KickFlag(side-1)*((side=1)-(side=2)),0

c=Check_Collision(2,side,1,1,0)

If c

mm(2)=.5+(mm(2)*(mm(2)>0))

Position Object 1,Object Position X(1)+mm(0)*.15,Object Position Y(1)+mm(1)*.15,Object Position Z(1)+mm(2)

Endif

If KickFlag(side-1)>59 and KeyState(ks)=0

KickFlag(side-1)=0

Rotate Limb 2,side,0,ang#,0

Endif

Endfunction

Function Kickers()

k=Object Collision(1,0)

Select k

Case 11,12,13

If Kick(k-11)<1

dx#=(Object Position X(1)-Object Position X(k))*.2+mm(0)*.1

dy#=(Object Position Y(1)-Object Position Y(k))*.2+mm(1)*.15

dz#=(Object Position Z(1)-Object Position Z(k))*.2+mm(2)*.1

Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#

tx#=Object Position X(1)

ty#=Object Position Y(1)

tz#=Object Position Z(1)

Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#

Kick(k-11)=7

Score=Score+10

Set Object Emissive k,Rgb(255,100,100)

Endif

EndCase

Case 14

dx#=1.5+mm(0)*.2

dy#=0

dz#=1.5+mm(2)*.2

Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#

tx#=Object Position X(1)

ty#=Object Position Y(1)

tz#=Object Position Z(1)

Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#

Set Object Emissive 14,Rgb(255,100,100)

Kick(3)=7

Score = Score + 1

EndCase

Case 15

dx#=-1.5+mm(0)*.2

dy#=0

dz#=1.5+mm(2)*.2

Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#

tx#=Object Position X(1)

ty#=Object Position Y(1)

tz#=Object Position Z(1)

Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#

Set Object Emissive 15,Rgb(255,100,100)

Kick(4)=7

Score = Score + 1

EndCase

Case 16,17,18

Score = Score + 2

EndCase

Case 19,20,21

dx#=0

dy#=0

dz#=-1.5-mm(2)*.2

Position Object 1,Object Position X(1)-dx#,Object Position Y(1)-dy#,Object Position Z(1)-dz#

tx#=Object Position X(1)

ty#=Object Position Y(1)

tz#=Object Position Z(1)

Position Object 1,Object Position X(1)+dx#,Object Position Y(1)+dy#,Object Position Z(1)+dz#

Position Object k,0,-10,0

DropDown=DropDown+1

Kick(4)=7

Score = Score + 10

EndCase

EndSelect

For i = 11 to 15

Kick(i-11)=Kick(i-11)-(Kick(i-11)>0)

If Kick(i-11)=1

Set Object Emissive i,0

Endif

Next i

If DropDown>2

DropDown=DropDown+1

If DropDown>10

Score=Score + 100

DropDown=0

For i = 1 to 3

Position Object 18+i,-40+(i*5),Limb Position Y(2,dd),51

Next i

Endif

EndFunction

Function Add_Limb(ObjectID,sx#,sy#,sz#,px#,py#,pz#,ax#,ay#,az#)

Make Object Box 3,sx#,sy#,sz#

Make Mesh From Object 3,3

Delete Object 3

i=1

If Limb Exist(ObjectID,i)=0

Exit

Endif

i=i+1

Loop

Add Limb ObjectID,i,3

Offset Limb ObjectID,i,px#,py#,pz#

Rotate Limb ObjectID,i,ax#,ay#,az#

EndFunction i

Function Prepare_Limb(ObjectID,LimbID,C_Factor#)

Local tx#

Local ty#

Local tz#

Local ac as Integer

Local n as Integer

Local max as Integer

arry=ObjectID*20+LimbID

ac=Array Count(PreLimb())

max=1

If ac>1

For i = 1 to ac

If max<PreLimb(i)

max=PreLimb(i)

Endif

Next i

Endif

If ac<arry

Dim PreLimb(arry) as Integer

PreLimb(arry)=1

Dim LMX(arry,max) as Float

Dim LMY(arry,max) as Float

Dim LMZ(arry,max) as Float

Endif

Lock VertexData for Limb ObjectID,LimbID

VIC=Get Vertexdata Index Count()

n=0

LMX(arry,n)=Get VertexData Position X(Get IndexData(0))

LMY(arry,n)=Get VertexData Position Y(Get IndexData(0))

LMZ(arry,n)=Get VertexData Position Z(Get IndexData(0))

c#=C_Factor#*C_Factor#

n=1

For i = 1 to VIC

tx#=Get VertexData Position X(Get IndexData(i))

ty#=Get VertexData Position Y(Get IndexData(i))

tz#=Get VertexData Position Z(Get IndexData(i))

flag=0

For j=1 to n

d#=((tx#-LMX(array,j))*(tx#-LMX(array,j))+(ty#-LMY(array,j))*(ty#-LMY(array,j))+(tz#-LMZ(array,j))*(tz#-LMZ(array,j)))

if d#<c# or (tx#=LMX(arry,0) and ty#=LMY(arry,0) and tz#=LMZ(arry,0))

flag=1

Exit

Endif

Next j

If flag=0

n=n+1

If n>max

max=n

PreLimb(arry)=n

Dim LMX(arry,n) as Float

Dim LMY(arry,n) as Float

Dim LMZ(arry,n) as Float

Endif

LMX(arry,n)=tx#

LMY(arry,n)=ty#

LMZ(arry,n)=tz#

Endif

Next i

PreLimb(arry)=n

Unlock VertexData

Endfunction

Function Check_Collision(ObjectID as DWord,LimbID as DWord,TargetID as DWord,accuracy#,cycles)

arry=ObjectID*20+LimbID

if Array Count(cflag(0))<arry

Dim cFlag(arry) as Integer

Dim fpos(arry,2) as Float

Dim n(arry) as Float

Endif

LimbMatrix4(LimbMatrix, ObjectID, LimbID)

ox#=Limb Position X(ObjectID,LimbID)

oy#=Limb Position Y(ObjectID,LimbID)

oz#=Limb Position Z(ObjectID,LimbID)

st=1.0/accuracy#

MC=PreLimb(arry)

If cFlag(arry)=0

n(arry)=1

fpos(arry,0)=ox#

fpos(arry,1)=oy#

fpos(arry,2)=oz#

Else

if n(arry)>1

n(arry)=2

fpos(arry,0)=fpos(arry,0)+ox#

fpos(arry,1)=fpos(arry,1)+oy#

fpos(arry,2)=fpos(arry,2)+oz#

Endif

For i = 0+cFlag(arry) to MC step st

If Array Index Valid(LMZ(arry,i))=0

Exit Prompt Str$(arry)+" : "+Str$(i) , ""

End

Endif

Set Vector3 1,LMX(arry,i),LMY(arry,i),LMZ(arry,i)

Transform Coords Vector3 1, 1, LimbMatrix

d#=Intersect Object(TargetID,ox#,oy#,oz#,X Vector3(1),Y Vector3(1),Z Vector3(1))

if d#>0

Set Vector3 1,X Vector3(1)-ox#,Y Vector3(1)-oy#,Z Vector3(1)-oz#

d2#=Length Vector3(1)

id2#=d2#-d#

Multiply Vector3 1,-(id2#/d2#)

fpos(arry,0)=fpos(arry,0)+(ox#+X Vector3(1))*id2#

fpos(arry,1)=fpos(arry,1)+(oy#+Y Vector3(1))*id2#

fpos(arry,2)=fpos(arry,2)+(oz#+Z Vector3(1))*id2#

n(arry)=n(arry)+id2#

Endif

Next i

cFlag(arry)=cFlag(arry)+1

if cFlag(arry)>cycles

cFlag(arry)=0

Endif

fpos(arry,0)=fpos(arry,0)/n(arry)

fpos(arry,1)=fpos(arry,1)/n(arry)

fpos(arry,2)=fpos(arry,2)/n(arry)

Hit=(n(arry)>1)

EndFunction Hit

`Thanks to Dmitry K for this function!

Function LimbMatrix4(ResultMatrix, Object, Limb)

AX#=Limb Direction X( Object, Limb ) : AY#=Limb Direction Y( Object, Limb ) : AZ#=Limb Direction Z( Object, Limb )

CX#=Cos(AX#) : SX#=Sin(AX#) : CY#=Cos(AY#) : SY#=Sin(AY#) : CZ#=Cos(AZ#) : SZ#=Sin(AZ#)

Set Vector3 EyeVector, Limb Position X( Object, Limb), Limb Position Y( Object, Limb), Limb Position Z( Object, Limb)

Set Vector3 LookAtVector, -1.0*SZ#*(-1.0*SX#)+CZ#*SY#*CX#+Limb Position X(Object,Limb), CZ#*(-1.0*SX#)+SZ#*SY#*CX#+Limb Position Y(Object,Limb), CY#*CX#+Limb Position Z(Object,Limb)

CodeBase - PinBall

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	RiiDii
CodeBase Entries:	8