Sorry your browser is not supported!

Pacman - that ol' favourite.

sync on
set display mode 1024,768,32
autocam off
color backdrop 0

make_pacman()

do
sprite 1,200,200,30
play sprite 1,1,10,50
sync
loop

function make_pacman()

get image 1,0,0,1,1
ink rgb(255,255,0),0
box 0,0,1,1
get image 2,0,0,1,1
cls
make object sphere 1,1,30,30
position object 1,0,0,3
texture object 1,2
a=int(screen width()/3.0)
b=int(screen height()/3.0)
c=int(screen width()*2/3.0)
d=int(screen height()*2/3.0)
make object sphere 2,0.1
position object 2,.1,.2,2
texture object 2,1
create bitmap 1,screen width(),screen height()
set current bitmap 1
for n=1 to 10
make object triangle n+10,0,0,2,20,2*n,2,20,-2*n,2
texture object n+10,1
sync
get image 2+n,a,b,c,d,1
delete object n+10
next n
set current bitmap 0
delete object 1
delete object 2
cls
for n=1 to 10
sprite n,0,0,2+n
scale sprite n,30
paste sprite n,(sprite width(n)*n)-sprite width(n),0
if n=1 then size=sprite width(1)
delete sprite n
next n
get image 20,0,0,(size*10),size,1
save image "pacman.bmp",20
create animated sprite 1,"pacman.bmp",10,1,30
cls
endfunction

sync on
set display mode 1024,768,32
autocam off
color backdrop 0

make_pacman()

do
sprite 1,200,200,30
play sprite 1,1,10,50
sync
loop

function make_pacman()

get image 1,0,0,1,1
ink rgb(255,255,0),0
box 0,0,1,1
get image 2,0,0,1,1
cls
make object sphere 1,1,30,30
position object 1,0,0,3
texture object 1,2
a=int(screen width()/3.0)
b=int(screen height()/3.0)
c=int(screen width()*2/3.0)
d=int(screen height()*2/3.0)
make object sphere 2,0.1
position object 2,.1,.2,2
texture object 2,1
create bitmap 1,screen width(),screen height()
set current bitmap 1
for n=1 to 10
make object triangle n+10,0,0,2,20,2*n,2,20,-2*n,2
texture object n+10,1
sync
get image 2+n,a,b,c,d,1
delete object n+10
next n
set current bitmap 0
delete object 1
delete object 2
cls
for n=1 to 10
sprite n,0,0,2+n
scale sprite n,30
paste sprite n,(sprite width(n)*n)-sprite width(n),0
if n=1 then size=sprite width(1)
delete sprite n
next n
get image 20,0,0,(size*10),size,1
save image "pacman.bmp",20
create animated sprite 1,"pacman.bmp",10,1,30
cls
endfunction

Sync on:Sync Rate 60:Autocam Off

autocam off
Type Coordinates
   x as float
   y as float
   z as float
endtype


Type pacstuff
   pos as coordinates
   facing as coordinates
   mouth_ang as float
   mouth_dir as float
Endtype
Global PacMan as pacstuff
Global Object as Coordinates
Global Target as Coordinates
Global AI as Coordinates
Global Camera As Coordinates
Global Limb As Coordinates



PacMan.mouth_ang=0
PacMan.mouth_dir=3

Make_PacMan()
Clean_AI()

Position Object 2,0,0,50
For i=101 to 151
   Make Object Sphere i,1
   Set_Object(i)
   Turn Object Left 2,rnd(21)-11
   Move Object 2,20
Next i


Do
   Move Object 1000,Upkey()
   Turn Object Left 1000,(LeftKey()-RightKey())*3
   Loop_PacMan()
   Move_Camera()
   Sync
Loop

Function Move_Camera()
   Set_AI(1000)
   Move Object 2,-20
   Move Object Up 2,15
   Return_AI()
   Set Camera to Follow AI.x,AI.y,AI.z,0,5,0,25,0
   Point Camera Object.x,Object.y,Object.z
Endfunction


Function Loop_PacMan()
   PacMan.mouth_ang=PacMan.mouth_ang+PacMan.mouth_dir
   If PacMan.mouth_ang>60.0 Then PacMan.mouth_dir=-3
   If PacMan.mouth_ang<1.0 Then PacMan.mouth_dir=3
   Rotate Limb 1000,0,PacMan.mouth_ang,0,0
   Rotate Limb 1000,1,180-PacMan.mouth_ang,0,0
Endfunction




Function Make_PacMan()
   Make_HemiSphere(1000,10)
   Set Object Cull 1000,0
   Position object 1000,0,-5,50
   Make Mesh From Object 1000,1000
   Add Limb 1000,1,1000
   Rotate Limb 1000,1,180,0,0
   Make Object Sphere 1001,1
   Make Mesh From Object 1001,1001
   Delete Object 1001
   Add limb 1000,2,1001
   Add Limb 1000,3,1001
   Offset Limb 1000,2,3.2,3.3,-1.3
   Offset Limb 1000,3,-3.2,3.3,-1.3
   Color Object 1000,RGB(255,255,0)
   Set Object Emissive 1000,RGB(80,80,0)
   Color Limb 1000,2,0
   Color Limb 1000,3,0
   Turn Object Right 1000,180
   Fix Object Pivot 1000
   Position Object 1000,0,0,0
Endfunction


Function Make_HemiSphere(ObjectID,Size as Float)
Make Object Sphere ObjectID,Size
verts=vertices(ObjectID)
sy#=Object Size Y(ObjectID)
for vertex=1 to verts
   vx#=vertexx(ObjectID,vertex)
   vy#=vertexy(ObjectID,vertex)
   vz#=vertexz(ObjectID,vertex)
   If vy#<-sy#/10.0 Then Position_Vertex(ObjectID,vertex,0,0,0)
next vertex
EndFunction


Function Vertices(ObjNo)
`Returns number of Vertices
`Vars
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make your meshes and memblocks
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
`Tidy
delete memblock 1
`delete mesh meshno
endfunction NoVerts



Function VertexX(ObjNo,VertexNo)
`Returns X position of specified vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
ValueX#=memblock float(1,12+((VertexNo*32)-32))
endif
`Tidy Up
delete memblock 1
`delete mesh meshno
endfunction ValueX#



Function VertexY(ObjNo,VertexNo)
`Returns Y position of specified vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
ValueY#=memblock float(1,16+((VertexNo*32)-32))
endif
`Tidy Up
delete memblock 1
`delete mesh meshno
endfunction ValueY#



Function VertexZ(ObjNo,VertexNo)
`Returns Z position of specified vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
ValueZ#=memblock float(1,20+((VertexNo*32)-32))
endif
`Tidy Up
delete memblock 1
`delete mesh meshno
endfunction ValueZ#


Function Position_Vertex(ObjNo,VertexNo,X#,Y#,Z#)
`Moves the Vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
write memblock float 1,12+((VertexNo*32)-32),X#
write memblock float 1,16+((VertexNo*32)-32),Y#
write memblock float 1,20+((VertexNo*32)-32),Z#
`Change the mesh
change mesh from memblock MeshNo,1
endif
`Tidy Up
change mesh ObjNo,0,MeshNo
delete memblock 1
`delete mesh meshno
endfunction

` This function shortens the Object Postion X/Y/Z() functions.
Function Return_Object(ObjectID)
   If Object Exist (ObjectID)
      Object.x=Object Position X(ObjectID):Object.y=Object Position Y(ObjectID):Object.z=Object Position Z(ObjectID)
   Endif
Endfunction

` This function shortens the Object Postion X/Y/Z() functions.
Function Return_Target(TargetID)
   If Object Exist (TargetID)
      Target.x=Object Position X(TargetID):Target.y=Object Position Y(TargetID):Target.z=Object Position Z(TargetID)
   Endif
EndFunction

` This function shortens the Object Postion X/Y/Z() functions for object #2
Function Return_AI()
   If Object Exist (2)
      AI.x=Object Position X(2):AI.y=Object Position Y(2):AI.z=Object Position Z(2)
   Endif
EndFunction

` This function shortens the Camera Postion X/Y/Z() functions.
Function Return_Camera()
Camera.x=Camera Position X():Camera.y=Camera Position Y():Camera.z=Camera Position Z()
EndFunction

` This function positions the AI object (#2) at ObjectID's position and set the AI to the ObjectID's orientation
Function Set_AI(ObjectID)
If Object Exist(ObjectID) And Object Exist(2)
   Return_Object(ObjectID)
   Position Object 2,Object.x,Object.y,Object.z
   Set Object To Object Orientation 2,ObjectID
Endif
EndFunction

` This function deletes an old AI object and creates a new "clean" AI object.
Function Clean_AI()
   If Object Exist(2) Then Delete Object 2
   Make Object Sphere 2,1,6,6
   Hide Object 2
   Set Object Collision To Boxes 2
   Set Object Collision Off 2
EndFunction


`This function places ObjectID at the AI position. It does not set the ObjectID's orientation
Function Set_Object(ObjectID)
If Object Exist(ObjectID)
   If Object Exist(2)=0 Then Clean_AI()
   Return_AI()
   Position Object ObjectID,AI.x,AI.y,AI.z
Endif
EndFunction

`This function places the CameraID at the AI position. It does not orient the camera.
Function Set_Camera()
Return_AI()
Position Camera AI.x,AI.y,AI.z
EndFunction

`This function shortens the Limb Position X/Y/Z() functions
Function Return_Limb(ObjectID,LimbID)
If Object Exist(ObjectID)
   If Limb Exist(ObjectID,LimbID)
      Limb.x=Limb Position X(ObjectID,LimbID):Limb.y=Limb Position Y(ObjectID,LimbID):Limb.z=Limb Position Z(ObjectID,LimbID)
   Endif
Endif
EndFunction

autocam off
set display mode 1024,768,32
color backdrop 0
position camera 0,2,-15
point camera 0,0,0
get image 1,0,0,1,1,1
ink rgb(255,255,0),0
box 0,0,600,300
get image 2,0,0,600,600,1
cls
make object sphere 1,1,20,20
texture object 1,2
set object transparency 1,5
yrotate object 1,90
fix object pivot 1
make object sphere 2,1,20,20
texture object 2,2
set object transparency 2,5
xrotate object 2,180
fix object pivot 2
position object 2,0,0.0,0.0
glue object to limb 2,1,0
make object sphere 3,.1
texture object 3,1
position object 3,.2,.4,.4
glue object to limb 3,1,0
make object sphere 4,.1
texture object 4,1
position object 4,-.2,.4,.4
glue object to limb 4,1,0

do
xrotate object 1,-30*sin(angle#)
xrotate object 2,abs(45*sin(angle#*2))
yrotate object 1,angle#
position object 1,5*sin(angle#),0,5*cos(angle#)
angle#=wrapvalue(angle#)+1
loop

Sync on:Sync Rate 60:Autocam Off

autocam off
Type Coordinates
   x as float
   y as float
   z as float
endtype

Type Direction
   Up as Boolean
   Down as Boolean
   Left as Boolean
   Right as Boolean
Endtype

Type pacstuff
   pos as coordinates
   facing as coordinates
   mouth_ang as float
   mouth_dir as float
Endtype

Type Colors
   Red as DWord
   Green as DWord
   Blue as DWord
   Yellow as DWord
   Pink as DWord
Endtype

Global Color as Colors
Color.red=rgb(255,0,0)
Color.green=Rgb(0,255,0)
Color.blue=rgb(0,0,255)
Color.yellow=rgb(255,255,0)
Color.pink=rgb(255,128,255)

Global IPacMan as pacstuff
Global Object as Coordinates
Global Target as Coordinates
Global AID as Coordinates
Global Camera As Coordinates
Global Limb As Coordinates
Global Clear as Direction
Global Score as Integer
Global Glow as Integer
Global GlowDir as Integer
#Constant AI=6
#Constant PacMan=1000


IPacMan.mouth_ang=0
IPacMan.mouth_dir=3

Make_PacMan():Scale Object PacMan,80,80,80;Set Object Collision To Boxes PacMan
Position Object PacMan,80,5,20
Make Object Cube PacMan+1,7.5:Set Object Collision To Boxes PacMan+1:Hide Object PacMan+1

Make_Ghost(1010)
Scale Object 1010,80,80,80
Color Object 1010,Color.red:Color Limb 1010,2,Rgb(200,200,255):Color Limb 1010,3,Rgb(200,200,255)
Position Object 1010,80,7.5,80

Clean_AI()


Make Object Sphere 1,1,8,8
Make Object Sphere 2,2,8,8
Color Object 2,RGB(255,255,0)
Set Object Emissive 2,Rgb(150,150,0)
Make Object Box 3,10,8,10
Color Object 3,Rgb(0,0,255)
Set Object Emissive 3,Rgb(0,0,50)
Make Object Box 4,10,8,5
Color Object 4,Rgb(200,100,0)
Ghost Object On 4

Create Bitmap 1,256,256
Ink RGB(100,100,100),0
Box 0,0,255,255
Ink RGB(255,255,255),0
Get Image 1,0,0,255,255
Set Current Bitmap 0
Delete Bitmap 1

Make Matrix 1,150,150,15,15
Prepare Matrix Texture 1,1,1,1
Fill Matrix 1,0,1
Position Matrix 1,5,0,5

Restore Maze
Obj=1
For y=1 to 15
   For x=1 to 15
      Read obj_type
      If Object Exist(obj_type)
         new=Obj+(obj_type)*2000
         Clone Object new,obj_type
         Position Object new,x*10,5,y*10
         Set Object Collision To Boxes new
         obj=obj+1
      Endif
   Next x
Next y
For i = 1 to 4
   Delete Object i
Next i

Score=0
Do
   Glow_Dots()
   Move_PacMan()
   Move_Camera()
   Set Cursor 0,0:Print Score
   Sync
Loop

Function Move_Camera()
   Set_AI(PacMan)
   Rotate Object AI,0,0,0
   Move Object AI,-30
   Move Object Up AI,70
   Return_AI()
   Set Camera to Follow AID.x,AID.y,AID.z,0,5,0,5,0
   Point Camera Object.x,Object.y,Object.z
Endfunction

Function Move_PacMan()
   Dot_Collision(0)
   Check_Direction()
   If Upkey() And Clear.up
      Rotate Object PacMan,0,0,0
      Clip_Position_X()
   Endif
   If Downkey() And Clear.down
      Rotate Object PacMan,0,180,0
      Clip_Position_X()
   Endif
   If Leftkey() And Clear.left
      Rotate Object PacMan,0,270,0
      Clip_Position_Z()
   Endif
   If RightKey() And Clear.right
      Rotate Object PacMan,0,90,0
      Clip_Position_Z()
   Endif
   Dot_Collision(1)
   Move Object PacMan,.5
   col_obj=Object Collision (PacMan,0)
   If col_obj>2000 And col_obj<3000
      Delete Object col_obj
      Score=Score+1
   Endif
   If col_obj>4000 And col_obj<5000
      Delete Object col_obj
      Score=Score+10
   Endif
   If col_obj>6000 And col_obj<9000 then Move Object PacMan,-.5
   Return_Object(PacMan)
   If Object.x>150 Then Position Object PacMan,5,Object.y,Object.z
   If Object.x<5 Then Position Object PacMan,150,Object.y,Object.z
   Loop_PacMan()
Endfunction

Function Dot_Collision(on as boolean)
   For i = 2000 to 2300
      If Object Exist(i)
         If on
            Set Object Collision On i
         Else
            Set Object Collision off i
         Endif
      Endif
      j=i+2000
      If Object Exist(j)
         If on
            Set Object Collision On j
         Else
            Set Object Collision off j
         Endif
      Endif
   Next i
EndFunction

Function Glow_Dots()
   Glow=Glow+GlowDir
   For i = 4000 to 5000
      If Object Exist(i)
         Set Object Emissive i,rgb(Glow,Glow,0)
      Endif
   Next i
   If Glow>200 Then GlowDir=-10:Glow=200
   If Glow<10 Then GlowDir=10:Glow=10
Endfunction


Function Clip_Position_X()
   Return_Object(PacMan)
   new_pos=Int(Object.x/10.0+0.5)*10
   Position Object PacMan,new_pos,Object.y,Object.z
EndFunction

Function Clip_Position_Z()
   Return_Object(PacMan)
   new_pos=Int(Object.z/10.0+0.5)*10
   Position Object PacMan,Object.x,Object.y,new_pos
EndFunction

Function Loop_PacMan()
   IPacMan.mouth_ang=IPacMan.mouth_ang+IPacMan.mouth_dir
   If IPacMan.mouth_ang>60.0 Then IPacMan.mouth_dir=-3
   If IPacMan.mouth_ang<1.0 Then IPacMan.mouth_dir=3
   Rotate Limb PacMan,0,IPacMan.mouth_ang,0,0
   Rotate Limb PacMan,1,180-IPacMan.mouth_ang,0,0
Endfunction

Function Check_Direction()
   Clear.up=1:Clear.down=1:Clear.left=1:Clear.right=1
   Return_Object(PacMan)
   test=PacMan+1
   Set Object Collision On test
   Position Object test,Object.x,Object.y,Object.z
   Rotate Object test,0,0,0
   Move Object test,10
   obj_col=Object Collision(test,0)
   If obj_col>6000 and obj_col<9000
      Clear.up=0
   Endif
   Position Object test,Object.x,Object.y,Object.z
   Rotate Object test,0,180,0
   Move Object test,10
   obj_col=Object Collision(test,0)
   If obj_col>6000 and obj_col<9000
      Clear.down=0
   Endif
   Position Object test,Object.x,Object.y,Object.z
   Rotate Object test,0,270,0
   Move Object test,10
   obj_col=Object Collision(test,0)
   If obj_col>6000 and obj_col<9000
      Clear.left=0
   Endif
   Position Object test,Object.x,Object.y,Object.z
   Rotate Object test,0,90,0
   Move Object test,10
   obj_col=Object Collision(test,0)
   If obj_col>6000 and obj_col<9000
      Clear.right=0
   Endif
   Set Object Collision Off test
Endfunction

Function Make_PacMan()
   Make_HemiSphere(PacMan,10)
   Set Object Cull PacMan,0
   Position object PacMan,0,-5,50
   Make Mesh From Object PacMan,PacMan
   Add Limb PacMan,1,PacMan
   Rotate Limb PacMan,1,180,0,0
   Make Object Sphere PacMan+1,1
   Make Mesh From Object PacMan+1,PacMan+1
   Delete Object PacMan+1
   Add limb PacMan,2,PacMan+1
   Add Limb PacMan,3,PacMan+1
   Offset Limb PacMan,2,3.2,3.3,-1.3
   Offset Limb PacMan,3,-3.2,3.3,-1.3
   Color Object PacMan,RGB(255,255,0)
   Set Object Emissive PacMan,RGB(80,80,0)
   Color Limb PacMan,2,0
   Color Limb PacMan,3,0
   Turn Object Right PacMan,180
   Fix Object Pivot PacMan
   Position Object PacMan,0,0,0
Endfunction

Function Make_Ghost(ObjectID)
   Make Object Cylinder ObjectID,10
   Make Mesh From Object ObjectID,1010
   Delete Object ObjectID
   Make Object Sphere ObjectID,10
   Add Limb ObjectID,1,ObjectID
   OffSet Limb ObjectID,1,0,-5,0
   Make Object Sphere ObjectID+1,2
   Make Mesh from Object ObjectID+1,ObjectID+1
   Delete Object ObjectID+1
   Add limb ObjectID,2,ObjectID+1
   Add Limb ObjectID,3,ObjectID+1
   Offset Limb ObjectID,2,2.2,.5,-4.2
   Offset Limb ObjectID,3,-2.2,.5,-4.2
EndFunction



Function Make_HemiSphere(ObjectID,Size as Float)
Make Object Sphere ObjectID,Size
verts=vertices(ObjectID)
sy#=Object Size Y(ObjectID)
for vertex=1 to verts
   vx#=vertexx(ObjectID,vertex)
   vy#=vertexy(ObjectID,vertex)
   vz#=vertexz(ObjectID,vertex)
   If vy#<-sy#/10.0 Then Position_Vertex(ObjectID,vertex,0,0,0)
next vertex
EndFunction


Function Vertices(ObjNo)
`Returns number of Vertices
`Vars
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make your meshes and memblocks
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
`Tidy
delete memblock 1
`delete mesh meshno
endfunction NoVerts



Function VertexX(ObjNo,VertexNo)
`Returns X position of specified vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
ValueX#=memblock float(1,12+((VertexNo*32)-32))
endif
`Tidy Up
delete memblock 1
`delete mesh meshno
endfunction ValueX#



Function VertexY(ObjNo,VertexNo)
`Returns Y position of specified vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
ValueY#=memblock float(1,16+((VertexNo*32)-32))
endif
`Tidy Up
delete memblock 1
`delete mesh meshno
endfunction ValueY#



Function VertexZ(ObjNo,VertexNo)
`Returns Z position of specified vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
ValueZ#=memblock float(1,20+((VertexNo*32)-32))
endif
`Tidy Up
delete memblock 1
`delete mesh meshno
endfunction ValueZ#


Function Position_Vertex(ObjNo,VertexNo,X#,Y#,Z#)
`Moves the Vertex
MeshNo=100
make mesh from object MeshNo,ObjNo
NoVerts=0
`Make Memblock
make memblock from mesh 1,MeshNo
`Calculate no of vertices
NoVerts=memblock dword(1,8)
If VertexNo<NoVerts
`Get values of vertex cords
write memblock float 1,12+((VertexNo*32)-32),X#
write memblock float 1,16+((VertexNo*32)-32),Y#
write memblock float 1,20+((VertexNo*32)-32),Z#
`Change the mesh
change mesh from memblock MeshNo,1
endif
`Tidy Up
change mesh ObjNo,0,MeshNo
delete memblock 1
`delete mesh meshno
endfunction

` This function shortens the Object Postion X/Y/Z() functions.
Function Return_Object(ObjectID)
   If Object Exist (ObjectID)
      Object.x=Object Position X(ObjectID):Object.y=Object Position Y(ObjectID):Object.z=Object Position Z(ObjectID)
   Endif
Endfunction

` This function shortens the Object Postion X/Y/Z() functions.
Function Return_Target(TargetID)
   If Object Exist (TargetID)
      Target.x=Object Position X(TargetID):Target.y=Object Position Y(TargetID):Target.z=Object Position Z(TargetID)
   Endif
EndFunction

` This function shortens the Object Postion X/Y/Z() functions for object #2
Function Return_AI()
   If Object Exist (AI)
      AID.x=Object Position X(AI):AID.y=Object Position Y(AI):AID.z=Object Position Z(AI)
   Endif
EndFunction

` This function shortens the Camera Postion X/Y/Z() functions.
Function Return_Camera()
Camera.x=Camera Position X():Camera.y=Camera Position Y():Camera.z=Camera Position Z()
EndFunction

` This function positions the AI object (#2) at ObjectID's position and set the AI to the ObjectID's orientation
Function Set_AI(ObjectID)
If Object Exist(ObjectID) And Object Exist(AI)
   Return_Object(ObjectID)
   Position Object AI,Object.x,Object.y,Object.z
   Set Object To Object Orientation AI,ObjectID
Endif
EndFunction

` This function deletes an old AI object and creates a new "clean" AI object.
Function Clean_AI()
   If Object Exist(AI) Then Delete Object AI
   Make Object Sphere AI,1,6,6
   Hide Object AI
   Set Object Collision To Boxes AI
   Set Object Collision Off AI
EndFunction


`This function places ObjectID at the AI position. It does not set the ObjectID's orientation
Function Set_Object(ObjectID)
If Object Exist(ObjectID)
   If Object Exist(2)=0 Then Clean_AI()
   Return_AI()
   Position Object ObjectID,AID.x,AID.y,AID.z
Endif
EndFunction

`This function places the CameraID at the AI position. It does not orient the camera.
Function Set_Camera()
Return_AI()
Position Camera AID.x,AID.y,AID.z
EndFunction

`This function shortens the Limb Position X/Y/Z() functions
Function Return_Limb(ObjectID,LimbID)
If Object Exist(ObjectID)
   If Limb Exist(ObjectID,LimbID)
      Limb.x=Limb Position X(ObjectID,LimbID):Limb.y=Limb Position Y(ObjectID,LimbID):Limb.z=Limb Position Z(ObjectID,LimbID)
   Endif
Endif
EndFunction



Maze:
Data 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
Data 3,2,1,1,1,3,1,1,1,3,1,1,1,2,3
Data 3,1,3,3,1,3,1,3,1,3,1,3,3,1,3
Data 3,1,3,1,1,1,1,1,1,1,1,1,3,1,3
Data 3,1,3,1,3,3,1,3,1,3,3,1,3,1,3
Data 3,1,1,1,3,1,1,1,1,1,3,1,1,1,3
Data 3,3,3,1,3,1,3,4,3,1,3,1,3,3,3
Data 5,5,5,1,1,1,3,5,3,1,1,1,5,5,5
Data 3,3,3,1,3,1,3,3,3,1,3,1,3,3,3
Data 3,1,1,1,3,1,1,1,1,1,3,1,1,1,3
Data 3,1,3,1,3,3,1,3,1,3,3,1,3,1,3
Data 3,1,3,1,1,1,1,1,1,1,1,1,3,1,3
Data 3,1,3,3,1,3,1,3,1,3,1,3,3,1,3
Data 3,2,1,1,1,3,1,1,1,3,1,1,1,2,3
Data 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3

Sync On:Sync Rate 60:Autocam Off

Type parser
   word as string
   id as integer
Endtype

#Constant MaxVerbs=20
#Constant MaxNouns=20

Dim verbs(MaxVerbs) as parser
Dim nouns(MaxNouns) as parser
Dim Objects(500)
Global txt as string
Global verb as parser
Global noun as parser
Global Object_Count as Integer
Object_Count=0

Restore D_Verbs
For i = 1 to MaxVerbs
   Read w$
   if w$="last999" then Exit
   read v
   verbs(i).word=w$:verbs(i).id=v
Next i
Restore D_Nouns
For i = 1 to MaxVerbs
   Read w$
   if w$="last999" then Exit
   read v
   nouns(i).word=w$:nouns(i).id=v
Next i

Make Object Cube 1,10
Hide Object 1
Make Object Sphere 2,10
Hide Object 2
Make Object Cylinder 3,10
Hide Object 3
Make Object Plain 4,10,10
Hide Object 4

Set Cursor 0,0
Print "Commands are basic object commands."
Print "Use a verb and a noun and an object designation."
Print "Example: 'Make a sphere number 20"
Print "Example: 'Object 15, turn left."
Sync
Wait key

Do
   Set Cursor 0,0
   Input "Enter command: ",txt
   Sync
   C_Parser()
   Label_Objects()
Loop

Function C_Parser()
   Find_Verb(txt)
   Find_Noun(txt)
   o=Get_Number(txt)
   o=o+10
   Select verb.id
      Case 1:Make_Object(o):Endcase
      Case 2:Move_Object(o):EndCase
      Case 3,4:Object_Size(o):Endcase
      Case 5,6:Turn_Object(o):Endcase
   Endselect
Endfunction

Function Label_Objects()
   For i = 10 to 510
      If Object Exist(i)
         i$="# "+str$(i-10)
         Center Text Object Screen X(i),Object Screen Y(i)-20,i$
      Endif
   Next i
Endfunction

Function Make_Object(obj)
   source=noun.id
   If Object Exist(obj) Then Delete Object obj
   Clone Object obj,source
   Show Object obj
   Position Object obj,0,-5,30
Endfunction

Function Move_Object(obj)
   If Object Exist(obj) Then Move Object obj,1
EndFunction

Function Object_Size(obj)
   If verb.id=3 then size=80 else size=120
   If Object Exist(obj) Then Scale Object obj,size,size,size
Endfunction

Function Turn_Object(obj)
   If verb.id=5 then direction=-20 else direction=20
   If Object Exist(obj) Then Turn Object Right obj,direction
Endfunction

Function Find_Verb(t$)
   verb.word="":verb.id=0
   v=0
   For i = 1 to MaxVerbs
      If Find_Text(Verbs(i).word,t$)
         verb.word=Verbs(i).word
         verb.id=Verbs(i).id
         Exit
      Endif
   Next i
Endfunction

Function Find_Noun(t$)
   Noun.word="":Noun.id=0
   v=0
   For i = 1 to MaxNouns
      If Find_Text(Nouns(i).word,t$)
         Noun.word=Nouns(i).word
         Noun.id=Nouns(i).id
         Exit
      Endif
   Next i
Endfunction

Function Find_Text(text$, in_text$)
   text$=Lower$(text$):in_text$=Lower$(in_text$)
   L1=Len(text$)
   L2=Len(in_text$)
   e=L2-L1
   f=0
   For i = 0 to e
      test$=Left$(Right$(in_text$,L2-i),L1)
      if text$=test$ then f=i+1:Exit
   Next i
Endfunction f

Function Get_Number(t$)
   L1=Len(t$)
   num$=""
   For i = 1 to L1
      If Val(Mid$(t$,i))>0 Or Mid$(t$,i)="0"
         If i>1
            If mid$(t$,i-1)="-" Then num$=num$+"-"
         Endif
         num$=num$+Mid$(t$,i)
      Endif
   Next i
   n=val(num$)
Endfunction n

D_Verbs:
Data "create",1
data "make",1
Data "forward",2
Data "move",2
Data "shrink",3
Data "expand",4
Data "grow",4
Data "turn left",5
data "turn right",6
Data "last999",999

D_Nouns:
Data "cube",1
Data "box",1
Data "sphere",2
Data "cylinder",3
Data "plain",4
Data "last999",999

Global delimiter$ as string
Global string$ as string
Global token$ as string
Global stringLength as integer
Global startingPosition as integer
Global delimiterLength as integer
delimiter$= " "
startingPosition = 1
delimiterLength = len(delimiter$)

string$ = "if ( thing = true ) then"
token$ = ""
stringLength = len(string$)


dim arrayA$(0)
dim arrayB$(0)
dim symbols$(0)

restore array1
read a$
while a$ <> "."
   array insert at top arrayA$()
   arrayA$(0) = a$
   read a$
endwhile

restore array2
read a$
while a$ <> "."
   array insert at top arrayB$()
   arrayB$(0) = a$
   read a$
endwhile

restore symbols
read a$
while a$ <> "."
   array insert at top symbols$()
   symbols$(0) = a$
   read a$
endwhile



rem text file to display
filename$ = "c:\parseExample.txt"
rem array list to hold text from file
dim words$(0) as string

rem check to see if file specified is a text file
if lower$(right$(filename$, 4)) = ".txt"
  rem check if file exists
  if file exist(filename$)
      rem open file for reading
      open to read 1, filename$
      rem add text from file to array list
      while file end(1) = 0
        read string 1, temp$
        array insert at bottom words$(0)
        words$(array count(words$(0))) = temp$
      endwhile
  endif
endif
rem close the file
close file 1


   parse()
repeat
until spacekey()


function parse()
   for t = 1 to array count(words$())
      parseString(t*14,words$(t))
   next t


endfunction


function parseString(v,txt$)
   token$ = ""
   startingPosition = 1
   string$ = txt$
   stringLength = len(string$)

   color as dword
   x = 10
   y = v
   width = 0

   while hasMoreTokens() = 1
      color = rgb(255,255,255)
      word$ = nextToken$()
      flag = 0
      for i=0 to array count(arrayA$())
         if arrayA$(i) = word$
            color = rgb(255,0,0)
            flag = 1
            exit
         endif
      next i

      if flag = 0
         for i=0 to array count(arrayB$())
            if arrayB$(i) = word$
               color = rgb(205,180,0)
               flag = 1
               exit
            endif
         next i
      endif

      if flag = 0
         for i=0 to array count(symbols$())
            if symbols$(i) = word$
               color = rgb(120,0,210)
               flag = 1
               exit
            endif
         next i
      endif

      ink color,0
      text x+width,y,word$+" "

      width = width + text width(word$+" ")

   endwhile

endfunction




REM Returns the next token from the string
function nextToken$()
  flag = 0

  if delimiter$ = ""
      startingPosition = stringLength
      token$ = string$
  endif

  for i = startingPosition to stringLength-1
      for x = 1 to delimiterLength
        if mid$(delimiter$,x) = mid$(string$,i)
            token$ = subString(string$, startingPosition-1, i-1)
            startingPosition = i+1
            flag = 1
            sp = startingPosition
            repeat
               hit = 0
               for x = 1 to delimiterLength
                  if mid$(delimiter$,x) = mid$(string$,sp) then hit = 1
               next x
               if hit = 1 then inc sp, 1
            until hit = 0
            startingPosition = sp
            exit
        endif
        if (i = stringLength-1)
            token$ = subString(string$, startingPosition-1, i+1)
            startingPosition = i+1
            flag = 1
        endif
      next x

      if flag = 1 then exit
  next i
endfunction token$



REM Returns true(1) if the string has more tokens left
function hasMoreTokens()
  if startingPosition <= stringLength-1 then exitfunction 1
endfunction 0



REM Returns a chunk of a whole string
REM starp - is the starting position of the substring that
REM        you want to be returned. The character at that
REM        position is not included in the returned result.
REM endp - is the position of the last character in the string
REM        you want to be returned.
function subString(s$ as string, startp as integer, endp as integer)
  l = len(s$)
  s$ = right$(s$,l-startp)
  s$ = left$(s$, endp-startp)
endfunction s$






array1:
data "if","else","then","endif","while","endwhile","type","endtype","integer","float","dword","."

array2:
data """","(",")","as","."

symbols:
data "+","-","*","/","<>","=","<",">","."

function LoadDrawing(offset_x, offset_y, scale_x, scale_y, filenumber, filename$)
   open to read filenumber, filename$

   do
      if file end(filenumber) = 1 then exit

      read string filenumber, line$

      if left$(line$, 4) = "ink "
         line$ = right$(line$, len(line$) - 4)

         parameter = 0

         foreground_color$ = ""
         background_color$ = ""

         for n = 1 to len(line$)
            a$ = mid$(line$, n)
            if a$ = ","
               parameter = parameter + 1
            else
               if a$ = " "
                  `Do nothing
               else
                  select parameter
                     case 0
                        foreground_color$ = foreground_color$ + a$
                     endcase
                     case 1
                        background_color$ = background_color$ + a$
                     endcase
                  endselect
               endif
            endif
         next n

         foreground_color = val(foreground_color$)
         background_color = val(background_color$)

         ink foreground_color, background_color
      endif

      if left$(line$, 4) = "dot "
         line$ = right$(line$, len(line$) - 4)

         parameter = 0

         x$ = ""
         y$ = ""

         for n = 1 to len(line$)
            a$ = mid$(line$, n)
            if a$ = ","
               parameter = parameter + 1
            else
               if a$ = " "
                  `Do nothing
               else
                  select parameter
                     case 0
                        x$ = x$ + a$
                     endcase
                     case 1
                        y$ = y$ + a$
                     endcase
                  endselect
               endif
            endif
         next n

         x = (val(x$) * scale_x) / 100 + offset_x
         y = (val(y$) * scale_y) / 100 + offset_y

         dot x, y
      endif

      if left$(line$, 5) = "line "
         line$ = right$(line$, len(line$) - 5)

         parameter = 0

         x_1$ = ""
         y_1$ = ""
         x_2$ = ""
         y_2$ = ""

         for n = 1 to len(line$)
            a$ = mid$(line$, n)
            if a$ = ","
               parameter = parameter + 1
            else
               if a$ = " "
                  `Do nothing
               else
                  select parameter
                     case 0
                        x_1$ = x_1$ + a$
                     endcase
                     case 1
                        y_1$ = y_1$ + a$
                     endcase
                     case 2
                        x_2$ = x_2$ + a$
                     endcase
                     case 3
                        y_2$ = y_2$ + a$
                     endcase
                  endselect
               endif
            endif
         next n

         x_1 = (val(x_1$) * scale_x) / 100 + offset_x
         y_1 = (val(y_1$) * scale_y) / 100 + offset_y
         x_2 = (val(x_2$) * scale_x) / 100 + offset_x
         y_2 = (val(y_2$) * scale_y) / 100 + offset_y

         line x_1, y_1, x_2, y_2
      endif

      if left$(line$, 4) = "box "
         line$ = right$(line$, len(line$) - 4)

         parameter = 0

         _left$ = ""
         top$ = ""
         _right$ = ""
         bottom$ = ""

         for n = 1 to len(line$)
            a$ = mid$(line$, n)
            if a$ = ","
               parameter = parameter + 1
            else
               if a$ = " "
                  `Do nothing
               else
                  select parameter
                     case 0
                        _left$ = _left$ + a$
                     endcase
                     case 1
                        top$ = top$ + a$
                     endcase
                     case 2
                        _right$ = _right$ + a$
                     endcase
                     case 3
                        bottom$ = bottom$ + a$
                     endcase
                  endselect
               endif
            endif
         next n

         left = (val(_left$) * scale_x) / 100 + offset_x
         top = (val(top$) * scale_y) / 100 + offset_y
         right = (val(_right$) * scale_x) / 100 + offset_x
         bottom = (val(bottom$) * scale_y) / 100 + offset_y

         box left, top, right, bottom
      endif

      if left$(line$, 7) = "circle "
         line$ = right$(line$, len(line$) - 7)

         parameter = 0

         x$ = ""
         y$ = ""
         radius$ = ""

         for n = 1 to len(line$)
            a$ = mid$(line$, n)
            if a$ = ","
               parameter = parameter + 1
            else
               if a$ = " "
                  `Do nothing
               else
                  select parameter
                     case 0
                        x$ = x$ + a$
                     endcase
                     case 1
                        y$ = y$ + a$
                     endcase
                     case 2
                        radius$ = radius$ + a$
                     endcase
                  endselect
               endif
            endif
         next n

         x = (val(x$) * scale_x) / 100 + offset_x
         y = (val(y$) * scale_y) / 100 + offset_y
         x_radius = (val(radius$) * scale_x) / 100
         y_radius = (val(radius$) * scale_y) / 100

         ellipse x, y, x_radius, y_radius
      endif

      if left$(line$, 8) = "ellipse "
         line$ = right$(line$, len(line$) - 8)

         parameter = 0

         x$ = ""
         y$ = ""
         x_radius$ = ""
         y_radius$ = ""

         for n = 1 to len(line$)
            a$ = mid$(line$, n)
            if a$ = ","
               parameter = parameter + 1
            else
               if a$ = " "
                  `Do nothing
               else
                  select parameter
                     case 0
                        x$ = x$ + a$
                     endcase
                     case 1
                        y$ = y$ + a$
                     endcase
                     case 2
                        x_radius$ = x_radius$ + a$
                     endcase
                     case 3
                        y_radius$ = y_radius$ + a$
                     endcase
                  endselect
               endif
            endif
         next n

         x = (val(x$) * scale_x) / 100 + offset_x
         y = (val(y$) * scale_y) / 100 + offset_y
         x_radius = (val(x_radius$) * scale_x) / 100
         y_radius = (val(y_radius$) * scale_y) / 100

         ellipse x, y, x_radius, y_radius
      endif
   loop

   close file filenumber
endfunction

if ( thing = 42 ) then bar = "foo"

while ( this <> crap ) :
	print "something goes here"
endwhile

type junk
     x as integer
     y as integer
endtype