Sorry your browser is not supported!

`Coding Challenge - Pinball Game
`Bill Robinson
`Started 7-27-06 --- Deadline 8-8-06
`All Rights Reserved for use as a published game.
`
`Launch ball with RETURN key, or left mouse button.
`The mouse y-direction controls the power of the ball launch
`The Up & Down arrow keys also control the ball launch power
`Left Flipper - use either the Z key, Left Shift, or Left CTRL
`Right Flipper - use either the / key, Right Shift, or Right CTRL
`Complete a work to blast a ball into the multi-ball hopper
`
`set display mode 1024,768,32
set display mode 1280,1024,32
sync on : sync rate 0

hide mouse
autocam off
set ambient light 15
color backdrop rgb(0,0,30)
randomize timer()
set camera range 1,20000

` Create the ODE World
ode start
ode set world gravity 0,-1.5,-3.0       :`was 0,-0.5,-1.25
ode set world step 0.08              :`was 0.3
ode set world erp (0.4)*2.5         :`error correction each step
ode set world cfm (10^-5)*2.5       :`Constriant Force Mixing
`ode set dynamic minimum 2.0

#constant MAXNUMBALLS 20
dim pocketinfo(10,10)
dim doorstatus(10)
dim ballcolor(10,3)

dim collisions(1000)
dim lflip(360,3)
dim rflip(360,3)
dim ballsinplay(MAXNUMBALLS)
dim targets(300,10)
dim targetgroups(20,10)
dim gates(10,10)


#Constant WHITE=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)
#Constant RED1=rgb(255,0,0)
#Constant CYAN=rgb(0,100,100)
#Constant MAGENTA=rgb(100,0,100)
#Constant GREEN1=rgb(0,255,0)

global numballs
global score

global screenxcenter
global screenycenter

`balls
global ballx#
global bally#
global ballz#
global maxballspeed#
global ballsatonce
global maxballs=MAXNUMBALLS
global ballcount
global nextballptr
global lastballtime
global newballtime
global balltiming=300
global ballsize=18
global ballsleft
global mx
global my
global ballinplay=0
global tiltflag=0
global tiltcount=0
global balltime=0
global safe_flag=0

`walls
global leftwall=0
global rightwall=360
global bottomwall=0
global topwall=600
global playfield=0
global playfieldglass=40
global ballchannel=328        :`rightwall-40
global shootingwall_upper=40
global wallthickness=5
global wallheight=40
global railwidth=5
global railheight=25
global channelwidth=25
global gatesize=40
global gatewidth=5

`pockets
global pocketsize
global doorsize
global pocketsopen=5
global bonusopenflag=0

`bumpers
global slotxstart=100
global slotspacing=30
global numslotbumpers=6
global slotbumperzpos=450
global kick_flag=0
global kicktime=0

`flippers
global leftflipper
global leftflipperkey=
global leftflipperangle
global leftflippergoal

global rightflipper
global rightflipperkey
global rightflipperangle

global flippermaxangle=130
global flipperminangle=50
global flipspeed=10
global flipperlength=40

global lflipx
global lflipy
global lflipz
global rflipx
global rflipy
global rflipz

`decals & targets
global decal_idstart
global decal_objid
global decal_id
global target_id
global target_idfirst
global target_idlast
global numtargets
global numtargetgroups
global targetgroup


`particles
global blastoff_flag=1
global rocketflag
global rocket_xpos#
global rocket_ypos#
global rocket_zpos#

`Camera
global camx=180
global camy=100
global camz=-100

`ODE - globals
global odeballptr



remstart
create bitmap 1,9,9                    :`make image for particles
ink rgb(255,255,255),0
dot 4,4
get image 1,1,1,9,9
set current bitmap 0
remend

_load_gatedata()
_ball_textures()              :`build textures for balls
_playfield_graphics()         :`build playfield graphics
gosub _intro

screenxcenter=screen width()/2

rem --- make LEFT wall
_make_rail(310,wallthickness*2,wallheight,topwall,YELLOW,leftwall,wallheight/2,topwall/2,0,50,1)

rem --- make RIGHT wall
_make_rail(311,wallthickness*2,wallheight,topwall,YELLOW,rightwall,wallheight/2,topwall/2,0,10,1)

rem --- make TOP wall
_make_rail(304,rightwall,wallheight,wallthickness*3,YELLOW,rightwall/2,wallheight/2,topwall,0,50,1)

rem --- make BALL CHANNEL wall
_make_rail(312,wallthickness/2,railheight,topwall-250,YELLOW,ballchannel,railheight/2,(topwall-230)/2,0,10,1)

rem --- make TOP LEFT Corner wall
_make_rail(315,50,wallheight,wallthickness*4,YELLOW,leftwall+12,wallheight/2,topwall-17,-45,10,1)
rem --- make TOP RIGHT Corner wall
_make_rail(316,50,wallheight,wallthickness*4,YELLOW,rightwall-12,wallheight/2,topwall-17,45,10,1)


rem --- make slanted rails for bottom exit
rail_length=125
_make_rail(303,rail_length,railheight,wallthickness,rgb(0,0,255),rail_length/2,railheight/2,20,15,10,1)
_make_rail(306,rail_length,railheight,wallthickness,rgb(0,0,255),ballchannel-rail_length/2,railheight/2,20,-15,100,1)

rem --- playfield board
make object box 305,rightwall,4,topwall
color object 305,rgb(100,100,0)
position object 305,rightwall/2+leftwall/2,-2,topwall/2
ode create static box 305
ode set contact fdir1 305,0
texture object 305,10
set object emissive 305,rgb(100,100,0)

remstart
rem --- make playfieldglass
make object box 307,rightwall,3,topwall
color object 307,rgb(0,0,0)
position object 307,rightwall/2+leftwall/2,playfieldglass,topwall/2
ode create static box 307
ghost object on 307
hide object 307
remend

rem --- make SLOT Bumpers
`global slotxstart=100
`global slotspacing=30


`_make_rail(objid, xsize, ysize, zsize, color, posx, posy, posz, yangle, bounce)
objid=350
for i=0 to numslotbumpers-1
   xloc=slotxstart+i*slotspacing
   _make_rail(objid,railwidth,railheight,50,YELLOW,xloc,railheight/2,slotbumperzpos,0,10,1)
   inc objid
next i

`-------------------------------------------------------------------------------------------------------
rem _make_rail(objid,xsize,ysize,zsize,color,posx,posy,posz,yangle,bounce)

rem --- make BALL KICKERS
_make_rail(360,railwidth*2,railheight,70,RED1,80,railheight/2,130,-45,100,1)
_make_rail(361,railwidth*2,railheight,70,RED1,240,railheight/2,130,45,100,1)



rem --- make FLIPPERS
flipperlength=48
lflipx=112
lflipy=railheight/2
lflipz=52
rflipx=216
rflipy=railheight/2
rflipz=52
rem --- LEFT FLIPPER
_make_rail(370,railwidth*2,railheight,flipperlength,WHITE,lflipx,lflipy,lflipz,flippermaxangle,10,1)
rem --- RIGHT FLIPPER
_make_rail(371,railwidth*2,railheight,flipperlength,WHITE,rflipx,rflipy,rflipz,flipperminangle,10,1)
leftflipperangle=flippermaxangle
rightflipperangle=flipperminangle

rem --- ODE has rotation problems if you chang the pivot point, so move position of flipper with pivot still in the middle
rem --- to simulate the flipper pivoting on the end, build curved position array for flippers
_lflipposition(lflipx,lflipy,lflipz,flipperlength/2-2)      :`radius=30, half of flipper size
_rflipposition(rflipx,rflipy,rflipz,flipperlength/2-2)      :`radius=30, half of flipper size
position object 370,lflip(leftflipperangle,1),lflip(leftflipperangle,2),lflip(leftflipperangle,3)
position object 371,rflip(rightflipperangle,1),rflip(rightflipperangle,2),rflip(rightflipperangle,3)

rem - Left Flipper guide rails
_make_rail(380,railwidth/4,railheight,40,RED1,leftwall+channelwidth+1,railheight/2,125,0,1,1)
_make_rail(381,railwidth/4,railheight,90,RED1,70,railheight/2,80,-60,1,1)

rem --- Right Flipper guide rails
_make_rail(390,railwidth/4,railheight,40,RED1,ballchannel-channelwidth+2,railheight/2,125,0,1,1)
_make_rail(391,railwidth/4,railheight,96,RED1,ballchannel-68,railheight/2,80,60,1,1)

rem --- Left Side Bump on side rail
_make_rail(400,10,railheight,10,RED1,leftwall+wallthickness/2+8,railheight/2,210,0,1,1)
rem --- Right Side Bump on side rail
_make_rail(410,10,railheight,10,RED1,ballchannel-railwidth/2-6,railheight/2,210,0,1,1)

rem --- Gates
_open_gate(1)
_open_gate(2)
_open_gate(3)

rem --- Scoreboard
_make_rail(420,wallthickness*2,200,railwidth,YELLOW,leftwall,100,topwall,0,1,0)
_make_rail(421,wallthickness*2,200,railwidth,YELLOW,rightwall,100,topwall,0,1,0)
_make_rail(422,rightwall,wallthickness,wallthickness,YELLOW,rightwall/2,200,topwall,0,1,0)

rem --- multi-ball chute
_make_rail(423,4,160,railheight*2,MAGENTA,180-railheight,100,topwall-railheight/2,0,1,1)
_make_rail(424,railheight*2,160,4,MAGENTA,180,100,topwall-railheight*2,0,1,1)
_make_rail(425,4,160,railheight*2,MAGENTA,180+railheight,100,topwall-railheight/2,0,1,1)
fade object 423,50
fade object 424,50
fade object 425,50
ghost object on 423
ghost object on 424
ghost object on 425

rem --- make objects and decals ---------------------------------------------------------------------------------------
decal_idstart=1000
decal_id=1000
decal_objid=1000

target_idfirst=900
target_id=900

rem --- read target group info into array
targetgroupinfo:
data 3
data 1,1,6
data 2,7,10
data 3,11,15

restore targetgroupinfo
read numtargetgroups
for i=1 to numtargetgroups
   read targetgroups(i,1)
   read targetgroups(i,2)
   read targetgroups(i,3)
next i

rem --- "ROCKET" targets
xsize=4
for i=0 to 5
_make_target(target_id,xsize,railheight,railheight,CYAN,leftwall+8,railheight/2,420-i*(railheight+10))
set object emissive target_id,CYAN
set object collision on target_id
set object collision to boxes target_id
inc target_id
next i

rem --- "SHIP" targets
for i=0 to 3
_make_target(target_id,xsize,railheight,railheight,CYAN,ballchannel-4,railheight/2,350-i*(railheight+10))
set object emissive target_id,CYAN
set object collision on target_id
set object collision to boxes target_id
inc target_id
next i

`remstart
rem --- "BLAST" targets
for i=0 to 4
_make_target(target_id,slotspacing-16,railheight,4,CYAN,slotxstart+slotspacing/2+i*slotspacing,railheight/2,slotbumperzpos)
set object emissive target_id,CYAN
set object collision on target_id
set object collision to boxes target_id
inc target_id
next i
`remend

target_idlast=target_id-1
numtargets=target_id-1

rem --- make ROCKET DECALS
savedecal_id=decal_id
decal_id=_make_decals(decal_id,"ROCKET",rgb(0,100,100),rgb(0,0,0),16)
temp=_make_decals(savedecal_id+100,"ROCKET",rgb(0,255,255),rgb(0,0,0),16)
for i=0 to 5
   make object plain decal_objid,railheight,railheight
   texture object decal_objid,decal_objid
   xrotate object decal_objid,-90
   position object decal_objid,leftwall+railheight,1,420-i*(railheight+10)
   set object emissive decal_objid,CYAN
   inc decal_objid
next i

rem --- make SHIP DECALS
savedecal_id=decal_id
decal_id=_make_decals(decal_id,"SHIP",rgb(50,100,100),rgb(0,0,0),16)
temp=_make_decals(savedecal_id+100,"SHIP",rgb(50,255,255),rgb(0,0,0),16)
for i=0 to 3
   make object plain decal_objid,railheight,railheight
   texture object decal_objid,decal_objid
   xrotate object decal_objid,-90
   position object decal_objid,ballchannel-railheight+4,1,350-i*(railheight+10)
   set object emissive decal_objid,CYAN
   inc decal_objid
next i

rem --- make BLAST DECALS
savedecal_id=decal_id
decal_id=_make_decals(decal_id,"BLAST",rgb(0,100,100),rgb(0,0,0),16)
temp=_make_decals(savedecal_id+100,"BLAST",rgb(0,255,255),rgb(0,0,0),16)
for i=0 to 4
   make object plain decal_objid,railheight,railheight
   texture object decal_objid,decal_objid
   xrotate object decal_objid,-90
   position object decal_objid,slotxstart+slotspacing/2+i*slotspacing,1,slotbumperzpos-60
   set object emissive decal_objid,CYAN
   inc decal_objid
next i





rem --- Create ODE pinballs --------------------------------------------------------------------
for i=1 to maxballs
   make object sphere i,ballsize,16,16          :`was i,30
   set object i,1,1,0
   set object collision off i
   position object i, 5000,5000,-5000      :`move object WAY off screen
   texnum=rnd(5)+11
   texture object i,texnum
   dec texnum,10
`   color object i,rgb(ballcolor(texnum,1),ballcolor(texnum,2),ballcolor(texnum,3))
   set object emissive i,rgb(ballcolor(texnum,1),ballcolor(texnum,2),ballcolor(texnum,3))
   hide object i
set object collision on i
set object collision to spheres i
next i


`remstart
rem --- make power bar
make object box 201,25,2,2
color object 201,rgb(255,0,255)
`position object 201,leftwall+150,1,160   :`position power bar
`remend

remstart
rem --- make firing rate bar
make object box 202,100,100,2
color object 202,rgb(255,255,0)
position object 202,rightwall-1100+100,1,160         :`was ceiling-120,160
remend

`--------------------------------------------------------

nextballptr=1           :`pointer into array - points to next ball to fire
odeballptr=1
ballcount=0             :`how many balls in use, on the screen
ballsatonce=1           :`how many balls on screen at the same time
numballs=100            :`number of balls to shoot
maxballspeed#=8         :`how fast should the balls shoot
balltiming=200          :`pause between each ball being fired
level=1                 :`start at this level

position camera 180,400,-100
point camera 180,0,300
ink rgb(255,255,255),0

set text font "Arial"
set text size 30
rem ---------------------------------------------------------------------------------------------------------------------
rem ----- main loop -----------------------------------------------------------------------------------------------------
rem --- ODE has changed pivot rotation problems, so move position of flipper with pivot still in the middle
rem --- to simulate the flipper pivoting on the end, build curved position array for flippers

ballcheck=1
blastoff_flag=0
safe_flag=1
_close_gate(2)
_close_gate(3)
balltime=timer()
do
   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
   if keypress>0
      _key_action(keypress)
   else
   endif

`if rightkey()=1 then rocketflag=1        :`right arrow key
`if rocketflag=1 and blastoff_flag=0 then _blast_off(ballinplay)

   leftflipperkey=0
   rightflipperkey=0
   if keystate(44)=1 then _left_flipper()       :`Z key
   if keystate(29)=1 then _left_flipper()       :`Left CTRL key
   if keystate(42)=1 then _left_flipper()       :`Left Shift key

   if keystate(53)=1 then _right_flipper()      :`/ key
   if keystate(157)=1 then _right_flipper()     :`Right CTRL key
   if keystate(54)=1 then _right_flipper()      :`Right Shift key

   if upkey()=1 then position mouse mousex(),mousey()-2
   if downkey()=1 then position mouse mousex(),mousey()+2

   if returnkey()=1 then gosub _fire_pinball    :`FIRE!
   if spacekey()=1 then _tilt(ballinplay)                 :`tilt machine to nudge sleeping ball

   if safe_flag=1
      if leftflipperkey=1 or rightflipperkey=1 then _close_gate(1)
   endif
   rem --- return LEFT flipper to start position
   if leftflipper=1 and leftflipperkey=0
      if leftflipperangle<flippermaxangle
         inc leftflipperangle,flipspeed
         ode destroy object 370
         position object 370,lflip(leftflipperangle,1),lflip(leftflipperangle,2),lflip(leftflipperangle,3)
         _make_ode_flipper(370,leftflipperangle,10)
      else
         leftflipper=0
      endif
   endif

   rem --- return RIGHT flipper to start position
   if rightflipper=1 AND rightflipperkey=0
      if rightflipperangle>flipperminangle
         dec rightflipperangle,flipspeed
         ode destroy object 371
         position object 371,rflip(rightflipperangle,1),rflip(rightflipperangle,2),rflip(rightflipperangle,3)
         _make_ode_flipper(371,rightflipperangle,10)
      else
         rightflipper=0
      endif
   endif

   rem --- allow 10 seconds of safe play mode, where gates close side exits
   if safe_flag=1
      if timer()-balltime>10000
         safe_flag=0
         _open_gate(2)
         _open_gate(3)
      endif
   endif

   mx#=mousex()
   my#=mousey()
   mousebutton=mouseclick()
   if mousebutton=1 then gosub _fire_pinball         :`also FIRE!

   position object 201,rightwall-20,1,150-my#/7       :`position power meter line

   rem --- has ball kicker activated, reset after a time has passed
   if kick_flag>0
      if kicktime>0
         dec kicktime
      else
         _kick_reset(kick_flag)
      endif
   endif

`  --- clear balls falling thru bottom hole
   if object position z(ballcheck)<-10
      position object ballcheck,5000,500,0
      hide object ballcheck
      ode destroy object ballcheck
      ballsinplay(ballcheck)=0
      dec ballcount
   endif

   inc ballcheck
   if ballcheck>maxballs then ballcheck=1

   for i=1 to maxballs
      if ballsinplay(i)=1
`      ode set angular velocity ballcheck,0.1,0.1,0.1
`         ode add force i,0,0,1,0,0,1.01
      endif
   next i

   if ballinplay>0
      _check_droptargethits(ballinplay)
   endif
remstart
set cursor 0,100
print "ballinplay=";ballinplay
print "rocketflag=";rocketflag
print "blastoff_flag=";blastoff_flag
print "targetgroup=";targetgroup
print "ballcount=";ballcount
remend

   if blastoff_flag=1
      goalflag=1
      if rocket_xpos#<179 then inc rocket_xpos#,0.5:goalflag=0
      if rocket_xpos#>181 then dec rocket_xpos#,0.5:goalflag=0
      if rocket_ypos#<190 then inc rocket_ypos#,0.5:goalflag=0
      if rocket_zpos#<topwall-railheight/2 then inc rocket_zpos#,0.5:goalflag=0
      if goalflag=1
         _drop_multiball(ballinplay)
         _reset_targets(targetgroup)
      else
         _move_particles(ballinplay,rocket_xpos#,rocket_ypos#,rocket_zpos#,3)
      endif
   endif

   rem --- checks for groups of targets completed
   if targetgroup=0
      targetgroup=_check_target_groups(1,6,1)
      if targetgroup>0 and blastoff_flag=0
         _blast_off(ballinplay)
      endif
   endif

   if targetgroup=0
      targetgroup=_check_target_groups(7,10,2)
      if targetgroup>0 and blastoff_flag=0
         _blast_off(ballinplay)
      endif
   endif

   if targetgroup=0
      targetgroup=_check_target_groups(11,15,3)
      if targetgroup>0 and blastoff_flag=0
         _blast_off(ballinplay)
      endif
   endif


   gosub _show_score                               :`show score on screen
   ode update                                      :`let ODE update physics
   if tiltflag>0
      ode destroy object 401
      delete object 401
      tiltflag=0
   endif
   sync
loop
rem --------------------------------------------------------------------
ode end
end


function _kick_out(objid)
if objid=360
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(360,railwidth*3,railheight,70,RED1,95,railheight/2,145,-45,100,1)
   kick_flag=360
   kicktime=20
endif
if objid=361
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(361,railwidth*3,railheight,70,RED1,225,railheight/2,145,45,100,1)
   kick_flag=361
   kicktime=20
endif
endfunction


function _kick_reset(objid)
if objid=360
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(360,railwidth*2,railheight,70,RED1,80,railheight/2,130,-45,100,1)
   kick_flag=0
endif
if objid=361
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(361,railwidth*2,railheight,70,RED1,240,railheight/2,130,45,100,1)
   kick_flag=0
endif
endfunction


function _tilt(objid)
x=object position x(objid)
y=object position y(objid)
z=object position z(objid)
make object sphere 401,ballsize,16,16
set object 401,1,1,0
set object collision off 401
position object 401, x,y+ballsize,z

ode destroy object 401
ode create dynamic sphere 401
ode set body mass 401,0.002
ode set contact bounce 401,1

ode set linear velocity 401,0,-1,0
tiltflag=401
endfunction


function _reset_targets(group)
for targetnum=targetgroups(group,2) to targetgroups(group,3)
   objid=targetnum+target_idfirst-1
   decalid=targetnum+decal_idstart-1

   move object up objid,targets(targetnum,5)
   texture object decalid,decalid
   targets(targetnum,1)=1
next targetnum
targetgroup=0
blastoff_flag=0
rocketflag=0
endfunction


function _drop_multiball(ballinplay)
blastoff_flag=0
rocketflag=0
ode create dynamic sphere ballinplay
ode set body mass ballinplay,0.002                 :`was 20, then 40
ode set contact bounce ballinplay,1

ode set contact fdir1 ballinplay,0                 :` was 30.0  Add FRICTION
ode set contact slip1 ballinplay,1000
ode set contact slip2 ballinplay,1000
ode set linear velocity ballinplay,0,-5000,0
delete particles 1
endfunction


function _check_target_groups(targetmin,targetmax,group)
rocketflag=group
for i=targetmin to targetmax
   if targets(i,1)=1 then rocketflag=0
next i
endfunction rocketflag


function _blast_off(objid)
ode destroy object objid
_make_particles()
blastoff_flag=1
rocket_xpos#=object position x(objid)
rocket_ypos#=object position y(objid)-20
rocket_zpos#=object position z(objid)
endfunction


function _make_particles()
make particles 1,1,2,30               :`rocket particles
set particle velocity 1,12       :`was 10
set particle emissions 1,20      :`was 8
set particle gravity 1,-4
set particle life 1,20
rotate particles 1,0,0,180             :`rocket exhaust particles point down
color particles 1,255,0,0
set particle chaos 1,100
endfunction


function _move_particles(objid,xpos#,ypos#,zpos#,thrust#)
   position object objid,xpos#,ypos#+20,zpos#
   position particles 1,xpos#,ypos#,zpos#
   set particle life 1,thrust#
endfunction


function _check_droptargethits(obj)
hitnum=object collision(obj,0)

      rem --- ball hitting drop targets ---
      if hitnum>=target_idfirst and hitnum<=target_idlast
         arrayindex=hitnum-899   :`targets objects start at 900, target info array starts at 1
         objid=hitnum+100        :`letter objects start at 1000
         decalid=objid+100       :`decals start at 1100

         if targets(arrayindex,1)=1
            texture object objid,decalid
            move object down hitnum,targets(arrayindex,5)
            targets(arrayindex,1)=0
            inc score,100
         endif
      endif

      if hitnum=360 or hitnum=361
         _kick_out(hitnum)
      endif
endfunction


rem --- targets(x,1=active, 2=posx, 3=posy, 4=posz, 5=downposy)
function _target_add(index,xpos,ypos,zpos,yposdown)
targets(index,1)=1
targets(index,2)=xpos
targets(index,3)=ypos
targets(index,4)=zpos
targets(index,5)=yposdown
endfunction


function _make_target(objid,xsize,ysize,zsize,color,xpos,ypos,zpos)
make object box objid,xsize,ysize,zsize
color object objid,color
position object objid,xpos,ypos,zpos
_target_add(objid-899,xpos,ypos,zpos,railheight-1)
endfunction


function _make_decals(decal_id,word$,fgcolor,bgcolor,fontsize)
set text font "Arial"
set text size fontsize
set text to bold
set text opaque
ink fgcolor,bgcolor
for i=0 to len(word$)-1
   cls bgcolor
   l$=mid$(word$,i+1)
   if l$="I"
         set cursor 9,3
   else
         set cursor 6,3
   endif
   center text 10,3,l$
   circle 10,10,8
   get image decal_id,0,0,20,20
   inc decal_id
`sync
`wait key
next i
endfunction decal_id


function _key_action(keypress)
select keypress
   `T key
   case 20
      if numballs<100
         inc numballs,100
      endif
   endcase
endselect
endfunction


function _left_flipper()
if leftflipperangle>flipperminangle
   dec leftflipperangle,flipspeed
   ode destroy object 370
   position object 370,lflip(leftflipperangle,1),lflip(leftflipperangle,2),lflip(leftflipperangle,3)
   _make_ode_flipper(370,leftflipperangle,10)
   leftflipper=1
endif
leftflipperkey=1
endfunction


function _right_flipper()
if rightflipperangle<flippermaxangle
   inc rightflipperangle,flipspeed
   ode destroy object 371
   position object 371,rflip(rightflipperangle,1),rflip(rightflipperangle,2),rflip(rightflipperangle,3)
   _make_ode_flipper(371,rightflipperangle,10)
   rightflipper=1
endif
rightflipperkey=1
endfunction


rem --- show score on screen
_show_score:
set cursor 1,1
print screen fps()
center text 100,100,"SCORE: "+str$(score)
return




rem ---------- fires pinballs --------------------------------------------------------
_fire_pinball:
if ballcount=ballsatonce then return
_open_gate(1)
_close_gate(2)
_close_gate(3)
safe_flag=1
balltime=timer()
newballtime=timer()
if newballtime-lastballtime<balltiming then return else lastballtime=newballtime    :`control firing rate of pinballs
if numballs=0                          :`out of pinballs to shoot
   retryflag=1                         :`set retry flag, do you want to try this level again?
   return                              :`sound 3 = your gun is empty
endif

ballx#=rightwall-20
bally#=15
ballz#=0

`----------- ODE STUFF -------------------------------------------------------------------
position object odeballptr,ballx#,bally#,ballz#
`position object odeballptr,180,190,topwall-railheight/2
show object odeballptr
inc ballinplay
if ballinplay>maxballs then ballinplay=1

ode destroy object odeballptr
ode create dynamic sphere odeballptr
ode set body mass odeballptr,0.002                 :`was 20, then 40
ode set contact bounce odeballptr,1

ode set linear velocity odeballptr,0,0,80.0-my#/60.0
`ode set linear velocity odeballptr,0,-5,0
ode set contact fdir1 odeballptr,0                 :` was 30.0  Add FRICTION
ode set contact slip1 odeballptr,1000
ode set contact slip2 odeballptr,1000

dec numballs
inc ballcount                                     :`one more ball on screen, one less ball you can fired

ballsinplay(odeballptr)=1
inc odeballptr
if odeballptr>maxballs
   odeballptr=1
endif
`-----------------------------------------------------------------------------------------
return


rem - gatedata(gatenum,1=gate#, 2=objid, 3=openangle, 4=closeangle, 5=open xpos, 6=zpos, 7=close xpos
gatedata:
data 3
data 1,415,0,35,328,385,338
data 2,416,0,-35,26,165,16
data 3,417,0,35,305,165,315

function _load_gatedata()
restore gatedata     :`rem - point to gate data above
read numgates
for i=1 to numgates
   for j=1 to 7
      read gates(i,j)
   next j
next i
endfunction


function _open_gate(gatenum)
objid=gates(gatenum,2)
openangle=gates(gatenum,3)
xpos=gates(gatenum,5)
zpos=gates(gatenum,6)
ode destroy object objid
if object exist(objid)=1 then delete object objid
`_make_rail(objid,railwidth,railheight,railheight*2,GREEN1,ballchannel,railheight/2,380,openangle,1,1)
_make_gate(objid,gatewidth,railheight,gatesize,GREEN1,xpos,railheight/2,zpos,openangle,1,1)
endfunction


function _close_gate(gatenum)
objid=gates(gatenum,2)
closedangle=gates(gatenum,4)
xpos=gates(gatenum,7)
zpos=gates(gatenum,6)
ode destroy object objid
if object exist(objid)=1 then delete object objid
`_make_rail(objid,railwidth,railheight,railheight*2,GREEN1,ballchannel+12,railheight/2,380,closedangle,1,1)
_make_gate(objid,gatewidth*2,railheight,gatesize,GREEN1,xpos,railheight/2,zpos,closedangle,1,1)
endfunction


function _make_gate(objid,xsize,ysize,zsize,color,posx,posy,posz,yangle,bounce,odeflag)
make object box objid,xsize,ysize,zsize
color object objid,color
if odeflag=1 and yangle<>0
   rotate object objid,0,-yangle,0
endif
position object objid,posx,posy,posz
if odeflag=1
   ode create static box objid
   ode set contact fdir1 objid,0
   ode set contact bounce objid,bounce
endif
scale object objid,25,100,100
if odeflag=1 and yangle<>0
   rotate object objid,0,yangle,0
endif
endfunction


function _Game_Over()
`set cursor 1,200
center text screen width()/2,200,"Game Over"
center text screen width()/2,250,"Play Again Y/N?"

if a$="Y"
`more code needed here
else
   print "Thanks for Playing!"
   print "Press a key to exit game - Bye!"
   sync
   wait key
   end
endif
endfunction

`remend


function _lflipposition(posx,posy,posz,radius)

for i=0 to 360
   lflip(i,1)=posx+sin(wrapvalue(i))*radius
   lflip(i,2)=railheight/2
   lflip(i,3)=posz+cos(wrapvalue(i))*radius     :`was (radius*-1)
next i
endfunction


function _rflipposition(posx,posy,posz,radius)

for i=0 to 360
   rflip(i,1)=posx+sin(wrapvalue(i+180))*radius
   rflip(i,2)=railheight/2
   rflip(i,3)=posz+cos(wrapvalue(i+180))*radius     :`was (radius*-1)
next i
endfunction



ballcolors:
data 255,0,0
data 0,255,0
data 0,0,255
data 255,255,0
data 0,255,255
data 255,0,255

function _ball_textures()
restore ballcolors
for i=1 to 6
   for j=1 to 3
      read ballcolor(i,j)
   next j
next i

for i=1 to 6
   create bitmap i,50,50
   ink rgb(10,10,10),0
   box 0,0,50,50
   if i=1 then ink rgb(255,0,0),0
   if i=2 then ink rgb(0,255,0),0
   if i=3 then ink rgb(0,0,255),0
   if i=4 then ink rgb(255,255,0),0
   if i=5 then ink rgb(0,255,255),0
   if i=6 then ink rgb(255,0,255),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      dot 25+sin(ang)*rad,25+cos(ang)*rad
   next x
   blur bitmap i,3
   get image i+10,0,0,50,50
   delete bitmap i
next i
endfunction


function _playfield_graphics()
ink rgb(255,255,255),rgb(0,0,200)
cls 0

maxx=360
maxy=600
ink rgb(255,255,255),0
line 0,0,maxx,0
line maxx,0,maxx,maxy
line maxx,maxy,0,maxy
line 0,maxy,0,0

ink rgb(255,0,255),0
label$="POWER 987654321"
ptr=1
xloc=rightwall-18
yloc=360
for y=1 to len(label$)
   set cursor xloc,yloc
   print mid$(label$,ptr)
   inc yloc,15
   inc ptr
next y

x=rightwall-25
for y=450 to 650 step 15
   line x,y,x+20,y
next y
get image 10,0,0,maxx,maxy,1
endfunction


_intro:
sync
set text font "Arial"
set text size 30
cx=screen width()/2
cy=100

introtext:
data "-green"
data "Rocket Ship Pinball"
data "   "
data "-purple"
data "Complete the target words to capture balls"
data "for multi-ball play. The ball capture trap will open."
data "The captured ball will blast off, up into the multi-ball holder."
data "   "
data "Complete all the word targets to launch all the balls!"
data ""
data "   "
data "   "
data "-cyan"
data "The LEFT mouse button Launches the pinball"
data "The Z KEY controls the LEFT Flipper"
data "The / KEY controls the RIGHT Flipper"
data ""
data "press 'T' to spend another $100 for more balls"
data "   "
data "(Press the SPACE BAR to tilt the table if balls get stuck!)"
data "   "
data "-yellow"
data "Press a key to continue"
data "999"

cls
restore introtext
read t$
while t$<>"999"
   if left$(t$,1)="-"
      if t$="-green" then ink rgb(0,255,0),0
      if t$="-purple" then ink rgb(200,0,200),0
      if t$="-yellow" then ink rgb(255,255,0),0
      if t$="-cyan" then ink rgb(0,255,255),0
   else
      center text cx,cy,t$
      inc cy,30
   endif
   read t$
endwhile

sync
wait key
ink rgb(0,255,255),0
cls
sync
return


function _make_rail(objid,xsize,ysize,zsize,color,posx,posy,posz,yangle,bounce,odeflag)
make object box objid,xsize,ysize,zsize
color object objid,color
if odeflag=1 and yangle<>0
   rotate object objid,0,-yangle,0
endif
position object objid,posx,posy,posz
if odeflag=1
   ode create static box objid
   ode set contact fdir1 objid,0
   ode set contact bounce objid,bounce
endif
if odeflag=1 and yangle<>0
   rotate object objid,0,yangle,0
endif
endfunction


function _make_ode_flipper(objid,yangle,bounce)
if yangle<>0
   rotate object objid,0,-yangle,0
endif
ode create static box objid
ode set contact fdir1 objid,0
ode set contact bounce objid,bounce
if yangle<>0
   rotate object objid,0,yangle,0
endif
endfunction


function _remove_gravity(objid)
ode set gravity objid,0
endfunction


function _add_gravity(objid)
ode set gravity objid,gravity#
endfunction


function _add_force(objid,angle,force)
x1#=object position x(objid)
y1#=object position y(objid)
z1#=object position z(objid)

x2#=x1#-50.0
y2#=y1#
z2#=z1#-50.0
ode add force objid,x1#,y1#,z1#,x2#,y2#,z2#
endfunction


function _check_collisions()
` while ODE COLLISION MESSAGE EXISTS()
`  ODE COLLISION GET MESSAGE
` endwhile

phyptr=0
while ODE COLLISION MESSAGE EXISTS()
  `
  rem collision event
   ODE COLLISION GET MESSAGE
   phya=ODE GET OBJECT A()
   phyb=ODE GET OBJECT B()
if phya>0
   collisions(ptr)=phya
   inc phyptr
endif
   phyavelocity#=abs(ODE GET OBJECT A VELOCITY X())+abs(ODE GET OBJECT A VELOCITY Y()/4)+abs(ODE GET OBJECT A VELOCITY Z())
   phybvelocity#=abs(ODE GET OBJECT B VELOCITY X())+abs(ODE GET OBJECT B VELOCITY Y()/4)+abs(ODE GET OBJECT B VELOCITY Z())
set cursor 0,20
print "VelA=";phyavelocity#
print "VelB=";phybvelocity#
endwhile
endfunction

`Coding Challenge - Pinball Game
`Bill Robinson
`Started 7-27-06 --- Deadline 8-8-06
`All Rights Reserved for use as a published game.
`
`Launch ball with RETURN key, or left mouse button.
`The mouse y-direction controls the power of the ball launch
`The Up & Down arrow keys also control the ball launch power
`Left Flipper - use either the Z key, Left Shift, or Left CTRL
`Right Flipper - use either the / key, Right Shift, or Right CTRL
`Complete a work to blast a ball into the multi-ball hopper
`
`set display mode 1024,768,32
set display mode 1280,1024,32
sync on : sync rate 0

hide mouse
autocam off
set ambient light 15
color backdrop rgb(0,0,30)
randomize timer()
set camera range 1,20000

` Create the ODE World
ode start
ode set world gravity 0,-3.5,-3.0       :`was 0,-1.5,-3.0
ode set world step 0.08              :`was 0.3
ode set world erp (0.4)*2.5         :`error correction each step
ode set world cfm (10^-5)*2.5       :`Constriant Force Mixing
`ode set dynamic minimum 2.0

#constant MAXNUMBALLS 20
dim pocketinfo(10,10)
dim doorstatus(10)
dim ballcolor(10,3)

dim collisions(1000)
dim lflip(360,3)
dim rflip(360,3)
dim ballsinplay(MAXNUMBALLS)
dim targets(300,10)
dim targetgroups(20,10)
dim gates(10,10)


#Constant WHITE=rgb(255,255,255)
#Constant YELLOW=rgb(255,255,0)
#Constant RED1=rgb(255,0,0)
#Constant CYAN=rgb(0,100,100)
#Constant MAGENTA=rgb(100,0,100)
#Constant GREEN1=rgb(0,255,0)

global numballs
global score

global screenxcenter
global screenycenter

`balls
global ballx#
global bally#
global ballz#
global maxballspeed#
global ballsatonce
global maxballs=MAXNUMBALLS
global ballcount
global nextballptr
global lastballtime
global newballtime
global balltiming=300
global ballsize=18
global ballsleft
global mx
global my
global ballinplay=0
global tiltflag=0
global tiltcount=0
global balltime=0
global safe_flag=0
global fire_flag=1
global ballsinhopper=0
global multi_ballflag=0
global hopperdoordelay=0
global ballhit

`walls
global leftwall=0
global rightwall=360
global bottomwall=0
global topwall=600
global playfield=0
global playfieldglass=40
global ballchannel=328        :`rightwall-40
global shootingwall_upper=40
global wallthickness=5
global wallheight=40
global railwidth=5
global railheight=25
global channelwidth=25
global gatesize=40
global gatewidth=5

`pockets
global pocketsize
global doorsize
global pocketsopen=5
global bonusopenflag=0

`bumpers
global slotxstart=100
global slotspacing=30
global numslotbumpers=6
global slotbumperzpos=450
global kick_flag=0
global kicktime=0

`flippers
global leftflipper
global leftflipperkey=
global leftflipperangle
global leftflippergoal

global rightflipper
global rightflipperkey
global rightflipperangle

global flippermaxangle=130
global flipperminangle=50
global flipspeed=10
global flipperlength=40

global lflipx
global lflipy
global lflipz
global rflipx
global rflipy
global rflipz

`decals & targets
global decal_idstart
global decal_objid
global decal_id
global target_id
global target_idfirst
global target_idlast
global numtargets
global numtargetgroups
global targetgroup


`particles
global blastoff_flag=1
global rocketflag
global rocket_xpos#
global rocket_ypos#
global rocket_zpos#

`Camera
global camx=180
global camy=100
global camz=-100

`ODE - globals
global odeballptr



remstart
create bitmap 1,9,9                    :`make image for particles
ink rgb(255,255,255),0
dot 4,4
get image 1,1,1,9,9
set current bitmap 0
remend

_load_gatedata()
_ball_textures()              :`build textures for balls
_playfield_graphics()         :`build playfield graphics
gosub _intro

screenxcenter=screen width()/2

rem --- make LEFT wall
_make_rail(310,wallthickness*2,wallheight,topwall,YELLOW,leftwall,wallheight/2,topwall/2,0,50,1)

rem --- make RIGHT wall
_make_rail(311,wallthickness*2,wallheight,topwall,YELLOW,rightwall,wallheight/2,topwall/2,0,50,1)

rem --- make TOP wall
_make_rail(304,rightwall,wallheight,wallthickness*3,YELLOW,rightwall/2,wallheight/2,topwall,0,50,1)

rem --- make BALL CHANNEL wall
_make_rail(312,wallthickness/2,railheight,topwall-250,YELLOW,ballchannel,railheight/2,(topwall-230)/2,0,50,1)

rem --- make TOP LEFT Corner wall
_make_rail(315,50,wallheight,wallthickness*4,YELLOW,leftwall+12,wallheight/2,topwall-17,-60,10,1)
rem --- make TOP RIGHT Corner wall
_make_rail(316,50,wallheight,wallthickness*4,YELLOW,rightwall-12,wallheight/2,topwall-17,60,10,1)


rem --- make slanted rails for bottom exit
rail_length=125
_make_rail(303,rail_length,railheight,wallthickness,rgb(0,0,255),rail_length/2,railheight/2,20,20,10,1)
_make_rail(306,rail_length,railheight,wallthickness,rgb(0,0,255),ballchannel-rail_length/2,railheight/2,20,-20,10,1)

rem --- playfield board
make object box 305,rightwall,4,topwall
color object 305,rgb(100,100,0)
position object 305,rightwall/2+leftwall/2,-2,topwall/2
ode create static box 305
ode set contact fdir1 305,0
texture object 305,10
set object emissive 305,rgb(100,100,0)

remstart
rem --- make playfieldglass
make object box 307,rightwall,3,topwall
color object 307,rgb(0,0,0)
position object 307,rightwall/2+leftwall/2,playfieldglass,topwall/2
ode create static box 307
ghost object on 307
hide object 307
remend

rem --- make SLOT Bumpers
`global slotxstart=100
`global slotspacing=30


`_make_rail(objid, xsize, ysize, zsize, color, posx, posy, posz, yangle, bounce, ODE item)
objid=350
for i=0 to numslotbumpers-1
   xloc=slotxstart+i*slotspacing
   _make_rail(objid,railwidth,railheight,50,YELLOW,xloc,railheight/2,slotbumperzpos,0,10,1)
   inc objid
next i

`-------------------------------------------------------------------------------------------------------
rem _make_rail(objid,xsize,ysize,zsize,color,posx,posy,posz,yangle,bounce)

rem --- make BALL KICKERS
_make_rail(360,railwidth*2,railheight,70,RED1,80,railheight/2,130,-45,100,1)
_make_rail(361,railwidth*2,railheight,70,RED1,240,railheight/2,130,45,100,1)



rem --- make FLIPPERS
flipperlength=48
lflipx=112
lflipy=railheight/2
lflipz=52
rflipx=216
rflipy=railheight/2
rflipz=52
rem --- LEFT FLIPPER
_make_rail(370,railwidth*2,railheight,flipperlength,WHITE,lflipx,lflipy,lflipz,flippermaxangle,10,1)
rem --- RIGHT FLIPPER
_make_rail(371,railwidth*2,railheight,flipperlength,WHITE,rflipx,rflipy,rflipz,flipperminangle,10,1)
leftflipperangle=flippermaxangle
rightflipperangle=flipperminangle

rem --- ODE has rotation problems if you chang the pivot point, so move position of flipper with pivot still in the middle
rem --- to simulate the flipper pivoting on the end, build curved position array for flippers
_lflipposition(lflipx,lflipy,lflipz,flipperlength/2-2)      :`radius=30, half of flipper size
_rflipposition(rflipx,rflipy,rflipz,flipperlength/2-2)      :`radius=30, half of flipper size
position object 370,lflip(leftflipperangle,1),lflip(leftflipperangle,2),lflip(leftflipperangle,3)
position object 371,rflip(rightflipperangle,1),rflip(rightflipperangle,2),rflip(rightflipperangle,3)

rem - Left Flipper guide rails
_make_rail(380,railwidth/4,railheight,40,RED1,leftwall+channelwidth+1,railheight/2,125,0,1,1)
_make_rail(381,railwidth/4,railheight,90,RED1,70,railheight/2,80,-60,1,1)

rem --- Right Flipper guide rails
_make_rail(390,railwidth/4,railheight,40,RED1,ballchannel-channelwidth+2,railheight/2,125,0,1,1)
_make_rail(391,railwidth/4,railheight,96,RED1,ballchannel-68,railheight/2,80,60,1,1)

rem --- Left Side Bump on side rail
_make_rail(400,12,railheight,13,RED1,leftwall+wallthickness/2+7,railheight/2,210,0,1,1)
rem --- Right Side Bump on side rail
_make_rail(410,12,railheight,13,RED1,ballchannel-railwidth/2-5,railheight/2,210,0,1,1)

rem --- Gates
_open_gate(1)
_open_gate(2)
_open_gate(3)

rem --- Scoreboard
_make_rail(420,wallthickness*2,200,railwidth,YELLOW,leftwall,100,topwall,0,1,0)
_make_rail(421,wallthickness*2,200,railwidth,YELLOW,rightwall,100,topwall,0,1,0)
_make_rail(422,rightwall,wallthickness,wallthickness,YELLOW,rightwall/2,200,topwall,0,1,0)

rem --- multi-ball chute
_make_rail(423,4,160,railheight*2,MAGENTA,180-railheight,100,topwall-railheight/2,0,1,1)
_make_rail(424,railheight*2,160,4,MAGENTA,180,100,topwall-railheight*2,0,1,1)
_make_rail(425,4,160,railheight*2,MAGENTA,180+railheight,100,topwall-railheight/2,0,1,1)
`_make_rail(426,railheight*2,4,railheight*2,MAGENTA,180,railheight,topwall-railheight/2,0,1,1)
_make_hopperdoor()
fade object 423,50
fade object 424,50
fade object 425,50
ghost object on 423
ghost object on 424
ghost object on 425

rem --- make objects and decals ---------------------------------------------------------------------------------------
decal_idstart=1000
decal_id=1000
decal_objid=1000

target_idfirst=900
target_id=900

rem --- read target group info into array
targetgroupinfo:
data 3
data 1,1,6
data 2,7,10
data 3,11,15

restore targetgroupinfo
read numtargetgroups
for i=1 to numtargetgroups
   read targetgroups(i,1)
   read targetgroups(i,2)
   read targetgroups(i,3)
next i

rem --- "ROCKET" targets
xsize=4
for i=0 to 5
_make_target(target_id,xsize,railheight,railheight,CYAN,leftwall+8,railheight/2,420-i*(railheight+10))
set object emissive target_id,CYAN
set object collision on target_id
set object collision to boxes target_id
inc target_id
next i

rem --- "SHIP" targets
for i=0 to 3
_make_target(target_id,xsize,railheight,railheight,CYAN,ballchannel-4,railheight/2,350-i*(railheight+10))
set object emissive target_id,CYAN
set object collision on target_id
set object collision to boxes target_id
inc target_id
next i

`remstart
rem --- "BLAST" targets
for i=0 to 4
_make_target(target_id,slotspacing-16,railheight,4,CYAN,slotxstart+slotspacing/2+i*slotspacing,railheight/2,slotbumperzpos)
set object emissive target_id,CYAN
set object collision on target_id
set object collision to boxes target_id
inc target_id
next i
`remend

target_idlast=target_id-1
numtargets=target_id-1

rem --- make ROCKET DECALS
savedecal_id=decal_id
decal_id=_make_decals(decal_id,"ROCKET",rgb(0,100,100),rgb(0,0,0),16)
temp=_make_decals(savedecal_id+100,"ROCKET",rgb(0,255,255),rgb(0,0,0),16)
for i=0 to 5
   make object plain decal_objid,railheight,railheight
   texture object decal_objid,decal_objid
   xrotate object decal_objid,-90
   position object decal_objid,leftwall+railheight,1,420-i*(railheight+10)
   set object emissive decal_objid,CYAN
   inc decal_objid
next i

rem --- make SHIP DECALS
savedecal_id=decal_id
decal_id=_make_decals(decal_id,"SHIP",rgb(50,100,100),rgb(0,0,0),16)
temp=_make_decals(savedecal_id+100,"SHIP",rgb(50,255,255),rgb(0,0,0),16)
for i=0 to 3
   make object plain decal_objid,railheight,railheight
   texture object decal_objid,decal_objid
   xrotate object decal_objid,-90
   position object decal_objid,ballchannel-railheight+4,1,350-i*(railheight+10)
   set object emissive decal_objid,CYAN
   inc decal_objid
next i

rem --- make BLAST DECALS
savedecal_id=decal_id
decal_id=_make_decals(decal_id,"BLAST",rgb(0,100,100),rgb(0,0,0),16)
temp=_make_decals(savedecal_id+100,"BLAST",rgb(0,255,255),rgb(0,0,0),16)
for i=0 to 4
   make object plain decal_objid,railheight,railheight
   texture object decal_objid,decal_objid
   xrotate object decal_objid,-90
   position object decal_objid,slotxstart+slotspacing/2+i*slotspacing,1,slotbumperzpos-60
   set object emissive decal_objid,CYAN
   inc decal_objid
next i





rem --- Create ODE pinballs --------------------------------------------------------------------
for i=1 to maxballs
   make object sphere i,ballsize,16,16          :`was i,30
   set object i,1,1,0
   set object collision off i
   position object i, 5000,5000,0      :`move object WAY off screen
   texnum=rnd(5)+11
   texture object i,texnum
   dec texnum,10
`   color object i,rgb(ballcolor(texnum,1),ballcolor(texnum,2),ballcolor(texnum,3))
   set object emissive i,rgb(ballcolor(texnum,1),ballcolor(texnum,2),ballcolor(texnum,3))
   hide object i
set object collision on i
set object collision to spheres i
next i


`remstart
rem --- make power bar
make object box 201,25,2,2
color object 201,rgb(255,0,255)
`position object 201,leftwall+150,1,160   :`position power bar
`remend

remstart
rem --- make firing rate bar
make object box 202,100,100,2
color object 202,rgb(255,255,0)
position object 202,rightwall-1100+100,1,160         :`was ceiling-120,160
remend

`--------------------------------------------------------

nextballptr=1           :`pointer into array - points to next ball to fire
odeballptr=1
ballcount=0             :`how many balls in use, on the screen
ballsatonce=1           :`how many balls on screen at the same time
numballs=10            :`number of balls to shoot
maxballspeed#=8         :`how fast should the balls shoot
balltiming=200          :`pause between each ball being fired
level=1                 :`start at this level

position camera 180,400,-100
point camera 180,0,300
ink rgb(255,255,255),0

set text font "Arial"
set text size 30



rem ---------------------------------------------------------------------------------------------------------------------
rem ----- main loop -----------------------------------------------------------------------------------------------------
rem --- ODE has changed pivot rotation problems, so move position of flipper with pivot still in the middle
rem --- to simulate the flipper pivoting on the end, build curved position array for flippers

ballcheck=1
blastoff_flag=0
safe_flag=1
_close_gate(2)
_close_gate(3)
balltime=timer()
do
   if fire_flag=1 and ballcount=0
      mess$="Ball #"+str$(ballinplay+1)+" - Ready to Fire!"
      size=_decal_signs(1300,mess$,rgb(255,0,255),0,16)
      if object exist(1300) then delete object 1300
      make object plain 1300,size,70
      xrotate object 1300,-90
      position object 1300,180,20,230
      texture object 1300,1300
      set text size 30
      fire_flag=0
   endif

   keypress=scancode()                             :`scan for keys pressed, subroutine to hadle keys
   if keypress>0
      _key_action(keypress)
   else
   endif

`if rightkey()=1 then rocketflag=1        :`right arrow key
`if rocketflag=1 and blastoff_flag=0 then targetgroup=1:_blast_off(ballhit)

   leftflipperkey=0
   rightflipperkey=0
   if keystate(44)=1 then _left_flipper()       :`Z key
   if keystate(29)=1 then _left_flipper()       :`Left CTRL key
   if keystate(42)=1 then _left_flipper()       :`Left Shift key

   if keystate(53)=1 then _right_flipper()      :`/ key
   if keystate(157)=1 then _right_flipper()     :`Right CTRL key
   if keystate(54)=1 then _right_flipper()      :`Right Shift key

   if upkey()=1 then position mouse mousex(),mousey()-2
   if downkey()=1 then position mouse mousex(),mousey()+2

   if returnkey()=1 then gosub _fire_pinball    :`FIRE!
   if spacekey()=1 then _tilt(ballinplay)                 :`tilt machine to nudge sleeping ball

   if safe_flag=1
      if leftflipperkey=1 or rightflipperkey=1 then _close_gate(1)
   endif
   rem --- return LEFT flipper to start position
   if leftflipper=1 and leftflipperkey=0
      if leftflipperangle<flippermaxangle
         inc leftflipperangle,flipspeed
         ode destroy object 370
         position object 370,lflip(leftflipperangle,1),lflip(leftflipperangle,2),lflip(leftflipperangle,3)
         _make_ode_flipper(370,leftflipperangle,10)
      else
         leftflipper=0
      endif
   endif

   rem --- return RIGHT flipper to start position
   if rightflipper=1 AND rightflipperkey=0
      if rightflipperangle>flipperminangle
         dec rightflipperangle,flipspeed
         ode destroy object 371
         position object 371,rflip(rightflipperangle,1),rflip(rightflipperangle,2),rflip(rightflipperangle,3)
         _make_ode_flipper(371,rightflipperangle,10)
      else
         rightflipper=0
      endif
   endif

   rem --- allow 10 seconds of safe play mode, where gates close side exits
   if safe_flag=1
      if timer()-balltime>10000
         safe_flag=0
         _open_gate(2)
         _open_gate(3)
         _close_gate(1)
      endif
   endif

   mx#=mousex()
   my#=mousey()
   mousebutton=mouseclick()
   if mousebutton=1 then gosub _fire_pinball         :`also FIRE!

   position object 201,rightwall-20,1,150-my#/7       :`position power meter line

   rem --- has ball kicker activated, reset after a time has passed
   if kick_flag>0
      if kicktime>0
         dec kicktime
      else
         _kick_reset(kick_flag)
      endif
   endif

`  --- clear balls falling thru bottom hole
   if object position z(ballcheck)<-10
      position object ballcheck,5000,500,0
      hide object ballcheck
      ode destroy object ballcheck
      ballsinplay(ballcheck)=0
      dec ballcount
      if ballcount=0 then fire_flag=1
   endif

   inc ballcheck
   if ballcheck>maxballs then ballcheck=1

remstart
   for i=1 to maxballs
      if ballsinplay(i)=1

      endif
   next i
remend

   if ballinplay>0
      for i=1 to maxballs
`         _check_droptargethits(ballinplay)
         if ballsinplay(i)>0
            _check_droptargethits(i)
         endif
      next i
   endif
remstart
set cursor 0,200
print "ballinplay=";ballinplay
print "rocketflag=";rocketflag
print "blastoff_flag=";blastoff_flag
print "targetgroup=";targetgroup
print "ballcount=";ballcount
print "ballsinhopper=";ballsinhopper
print "hopperdoordelay=";hopperdoordelay
remend

   if hopperdoordelay>0
      dec hopperdoordelay
      if hopperdoordelay=0 then _make_hopperdoor()
   endif

   if blastoff_flag=1
      goalflag=1
      if rocket_xpos#<179 then inc rocket_xpos#,0.5:goalflag=0
      if rocket_xpos#>181 then dec rocket_xpos#,0.5:goalflag=0
      if rocket_ypos#<190 then inc rocket_ypos#,0.5:goalflag=0
      if rocket_zpos#<topwall-ballsize-5 then inc rocket_zpos#,0.5:goalflag=0
      if goalflag=1
         if ballsinhopper=2
            _remove_hopperdoor()
            multi_ballflag=1
            inc ballcount,ballsinhopper
            ballsinhopper=0
            hopperdoordelay=500
         else
            inc ballsinhopper
            dec ballcount
`            dec ballinplay
         endif
`         _drop_multiball(ballinplay)
         _drop_multiball(ballhit)

`         inc ballsinhopper
`         dec ballcount

         _reset_targets(targetgroup)
         fire_flag=1
      else
`         _move_particles(ballinplay,rocket_xpos#,rocket_ypos#,rocket_zpos#,3)
         _move_particles(ballhit,rocket_xpos#,rocket_ypos#,rocket_zpos#,3)
      endif
   endif

   rem --- checks for groups of targets completed
   if targetgroup=0
      targetgroup=_check_target_groups(1,6,1)
      if targetgroup>0 and blastoff_flag=0
`         _blast_off(ballinplay)
         _blast_off(ballhit)
      endif
   endif

   if targetgroup=0
      targetgroup=_check_target_groups(7,10,2)
      if targetgroup>0 and blastoff_flag=0
`         _blast_off(ballinplay)
         _blast_off(ballhit)
      endif
   endif

   if targetgroup=0
      targetgroup=_check_target_groups(11,15,3)
      if targetgroup>0 and blastoff_flag=0
`         _blast_off(ballinplay)
         _blast_off(ballhit)
      endif
   endif


   gosub _show_score                               :`show score on screen
   ode update                                      :`let ODE update physics
   if tiltflag>0
      ode destroy object 401
      delete object 401
      tiltflag=0
   endif
   sync
loop
rem --------------------------------------------------------------------
ode end
end


function _make_hopperdoor()
_make_rail(426,railheight*2,4,railheight*2,MAGENTA,180,railheight,topwall-railheight/2,0,1,1)
endfunction

function _remove_hopperdoor()
ode destroy object 426
if object exist(426)=1 then delete object 426
endfunction


function _kick_out(objid)
if objid=360
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(360,railwidth*3,railheight,70,RED1,90,railheight/2,140,-45,100,1)
   kick_flag=360
   kicktime=20
endif
if objid=361
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(361,railwidth*3,railheight,70,RED1,230,railheight/2,140,45,100,1)
   kick_flag=361
   kicktime=20
endif
endfunction


function _kick_reset(objid)
if objid=360
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(360,railwidth*2,railheight,70,RED1,80,railheight/2,130,-45,100,1)
   kick_flag=0
endif
if objid=361
   ode destroy object objid
   if object exist(objid)=1 then delete object objid
   _make_rail(361,railwidth*2,railheight,70,RED1,240,railheight/2,130,45,100,1)
   kick_flag=0
endif
endfunction


function _tilt(objid)
x=object position x(objid)
y=object position y(objid)
z=object position z(objid)
make object sphere 401,ballsize,16,16
set object 401,1,1,0
set object collision off 401
position object 401, x,y+ballsize,z

ode destroy object 401
ode create dynamic sphere 401
ode set body mass 401,0.002
ode set contact bounce 401,1

ode set linear velocity 401,0,-1,0
tiltflag=401
endfunction


function _reset_targets(group)
for targetnum=targetgroups(group,2) to targetgroups(group,3)
   objid=targetnum+target_idfirst-1
   decalid=targetnum+decal_idstart-1

   move object up objid,targets(targetnum,5)
   texture object decalid,decalid
   targets(targetnum,1)=1
next targetnum
targetgroup=0
blastoff_flag=0
rocketflag=0
endfunction


function _drop_multiball(ball)
`while object position y(ballinplay)>ballinplay*ballsize
`   move object down ballinplay,1
`endwhile

`print "_drop_multiball(ballinplay)"
`sync
`wait key

blastoff_flag=0
rocketflag=0
ode create dynamic sphere ball
ode set body mass ball,0.002                 :`was 20, then 40
ode set contact bounce ball,1

ode set contact fdir1 ball,0                 :` was 30.0  Add FRICTION
ode set contact slip1 ball,1000
ode set contact slip2 ball,1000
ode set linear velocity ball,0,-5,0
delete particles 1
endfunction


function _check_target_groups(targetmin,targetmax,group)
rocketflag=group
for i=targetmin to targetmax
   if targets(i,1)=1 then rocketflag=0
next i
endfunction rocketflag


function _blast_off(objid)
ode destroy object objid
_make_particles()
blastoff_flag=1
rocket_xpos#=object position x(objid)
rocket_ypos#=object position y(objid)-20
rocket_zpos#=object position z(objid)
inc score,1000
`dec ballinplay
`position camera 180,500,topwall
`point camera 180,0,topwall
endfunction


function _make_particles()
make particles 1,1,2,30               :`rocket particles
set particle velocity 1,12       :`was 10
set particle emissions 1,20      :`was 8
set particle gravity 1,-4
set particle life 1,20
rotate particles 1,0,0,180             :`rocket exhaust particles point down
color particles 1,255,0,0
set particle chaos 1,100
endfunction


function _move_particles(objid,xpos#,ypos#,zpos#,thrust#)
   position object objid,xpos#,ypos#+20,zpos#
   position particles 1,xpos#,ypos#,zpos#
   set particle life 1,thrust#
endfunction


function _check_droptargethits(obj)
hitnum=object collision(obj,0)

      rem --- ball hitting drop targets ---
      if hitnum>=target_idfirst and hitnum<=target_idlast
         arrayindex=hitnum-899   :`targets objects start at 900, target info array starts at 1
         objid=hitnum+100        :`letter objects start at 1000
         decalid=objid+100       :`decals start at 1100

`         ballnum=0
         if targets(arrayindex,1)=1
            texture object objid,decalid
            move object down hitnum,targets(arrayindex,5)
            targets(arrayindex,1)=0
            inc score,100
            ballhit=obj
         endif
      endif

      if hitnum=360 or hitnum=361
         _kick_out(hitnum)
      endif
endfunction


rem --- targets(x,1=active, 2=posx, 3=posy, 4=posz, 5=downposy)
function _target_add(index,xpos,ypos,zpos,yposdown)
targets(index,1)=1
targets(index,2)=xpos
targets(index,3)=ypos
targets(index,4)=zpos
targets(index,5)=yposdown
endfunction


function _make_target(objid,xsize,ysize,zsize,color,xpos,ypos,zpos)
make object box objid,xsize,ysize,zsize
color object objid,color
position object objid,xpos,ypos,zpos
_target_add(objid-899,xpos,ypos,zpos,railheight-1)
endfunction


function _make_decals(decal_id,word$,fgcolor,bgcolor,fontsize)
set text font "Arial"
set text size fontsize
set text to bold
set text opaque
ink fgcolor,bgcolor
for i=0 to len(word$)-1
   cls bgcolor
   l$=mid$(word$,i+1)
   if l$="I"
         set cursor 9,3
   else
         set cursor 6,3
   endif
   center text 10,3,l$
   circle 10,10,8
   get image decal_id,0,0,20,20
   inc decal_id
`sync
`wait key
next i
endfunction decal_id


function _key_action(keypress)
select keypress
   `T key
   case 20
      if numballs<100
         inc numballs,100
      endif
   endcase
endselect
endfunction


function _left_flipper()
if leftflipperangle>flipperminangle
   dec leftflipperangle,flipspeed
   ode destroy object 370
   position object 370,lflip(leftflipperangle,1),lflip(leftflipperangle,2),lflip(leftflipperangle,3)
   _make_ode_flipper(370,leftflipperangle,10)
   leftflipper=1
endif
leftflipperkey=1
endfunction


function _right_flipper()
if rightflipperangle<flippermaxangle
   inc rightflipperangle,flipspeed
   ode destroy object 371
   position object 371,rflip(rightflipperangle,1),rflip(rightflipperangle,2),rflip(rightflipperangle,3)
   _make_ode_flipper(371,rightflipperangle,10)
   rightflipper=1
endif
rightflipperkey=1
endfunction


rem --- show score on screen
_show_score:
set cursor 1,1
print screen fps()
center text 100,100,"SCORE: "+str$(score)
return




rem ---------- fires pinballs --------------------------------------------------------
_fire_pinball:
if ballcount=ballsatonce then return
_open_gate(1)
_close_gate(2)
_close_gate(3)
safe_flag=1
fire_flag=0
hide object 1300
balltime=timer()
newballtime=timer()
if newballtime-lastballtime<balltiming then return else lastballtime=newballtime    :`control firing rate of pinballs
if numballs=0                          :`out of pinballs to shoot
   retryflag=1                         :`set retry flag, do you want to try this level again?
   return                              :`sound 3 = your gun is empty
endif

ballx#=rightwall-20
bally#=15
ballz#=0

`----------- ODE STUFF -------------------------------------------------------------------
position object odeballptr,ballx#,bally#,ballz#
`position object odeballptr,180,190,topwall-railheight/2
show object odeballptr
inc ballinplay
if ballinplay>maxballs then ballinplay=1

ode destroy object odeballptr
ode create dynamic sphere odeballptr
ode set body mass odeballptr,0.002                 :`was 20, then 40
ode set contact bounce odeballptr,1

ode set linear velocity odeballptr,0,0,80.0-my#/60.0
`ode set linear velocity odeballptr,0,-5,0
ode set contact fdir1 odeballptr,0                 :` was 30.0  Add FRICTION
ode set contact slip1 odeballptr,1000
ode set contact slip2 odeballptr,1000

dec numballs
inc ballcount                                     :`one more ball on screen, one less ball you can fired

ballsinplay(odeballptr)=1
inc odeballptr
if odeballptr>maxballs
   odeballptr=1
endif
`-----------------------------------------------------------------------------------------
return


rem - gatedata(gatenum,1=gate#, 2=objid, 3=openangle, 4=closeangle, 5=open xpos, 6=zpos, 7=close xpos
gatedata:
data 3
data 1,415,0,35,328,385,338
data 2,416,0,-35,26,165,16
data 3,417,0,35,305,165,315

function _load_gatedata()
restore gatedata     :`rem - point to gate data above
read numgates
for i=1 to numgates
   for j=1 to 7
      read gates(i,j)
   next j
next i
endfunction


function _open_gate(gatenum)
objid=gates(gatenum,2)
openangle=gates(gatenum,3)
xpos=gates(gatenum,5)
zpos=gates(gatenum,6)
ode destroy object objid
if object exist(objid)=1 then delete object objid
`_make_rail(objid,railwidth,railheight,railheight*2,GREEN1,ballchannel,railheight/2,380,openangle,1,1)
_make_gate(objid,gatewidth,railheight,gatesize,GREEN1,xpos,railheight/2,zpos,openangle,1,1)
endfunction


function _close_gate(gatenum)
objid=gates(gatenum,2)
closedangle=gates(gatenum,4)
xpos=gates(gatenum,7)
zpos=gates(gatenum,6)
ode destroy object objid
if object exist(objid)=1 then delete object objid
`_make_rail(objid,railwidth,railheight,railheight*2,GREEN1,ballchannel+12,railheight/2,380,closedangle,1,1)
_make_gate(objid,gatewidth*2,railheight,gatesize,GREEN1,xpos,railheight/2,zpos,closedangle,1,1)
endfunction


function _make_gate(objid,xsize,ysize,zsize,color,posx,posy,posz,yangle,bounce,odeflag)
make object box objid,xsize,ysize,zsize
color object objid,color
if odeflag=1 and yangle<>0
   rotate object objid,0,-yangle,0
endif
position object objid,posx,posy,posz
if odeflag=1
   ode create static box objid
   ode set contact fdir1 objid,0
   ode set contact bounce objid,bounce
endif
scale object objid,25,100,100
if odeflag=1 and yangle<>0
   rotate object objid,0,yangle,0
endif
endfunction


function _Game_Over()
`set cursor 1,200
center text screen width()/2,200,"Game Over"
center text screen width()/2,250,"Play Again Y/N?"

if a$="Y"
`more code needed here
else
   print "Thanks for Playing!"
   print "Press a key to exit game - Bye!"
   sync
   wait key
   end
endif
endfunction

`remend


function _lflipposition(posx,posy,posz,radius)

for i=0 to 360
   lflip(i,1)=posx+sin(wrapvalue(i))*radius
   lflip(i,2)=railheight/2
   lflip(i,3)=posz+cos(wrapvalue(i))*radius     :`was (radius*-1)
next i
endfunction


function _rflipposition(posx,posy,posz,radius)

for i=0 to 360
   rflip(i,1)=posx+sin(wrapvalue(i+180))*radius
   rflip(i,2)=railheight/2
   rflip(i,3)=posz+cos(wrapvalue(i+180))*radius     :`was (radius*-1)
next i
endfunction



ballcolors:
data 255,0,0
data 0,255,0
data 0,0,255
data 255,255,0
data 0,255,255
data 255,0,255

function _ball_textures()
restore ballcolors
for i=1 to 6
   for j=1 to 3
      read ballcolor(i,j)
   next j
next i

for i=1 to 6
   create bitmap i,50,50
   ink rgb(10,10,10),0
   box 0,0,50,50
   if i=1 then ink rgb(255,0,0),0
   if i=2 then ink rgb(0,255,0),0
   if i=3 then ink rgb(0,0,255),0
   if i=4 then ink rgb(255,255,0),0
   if i=5 then ink rgb(0,255,255),0
   if i=6 then ink rgb(255,0,255),0
   for x=1 to 1000
      ang=rnd(360)
      rad=rnd(20)
      dot 25+sin(ang)*rad,25+cos(ang)*rad
   next x
   blur bitmap i,3
   get image i+10,0,0,50,50
   delete bitmap i
next i
endfunction


function _playfield_graphics()
ink rgb(255,255,255),rgb(0,0,200)
cls 0

maxx=360
maxy=600
ink rgb(255,255,255),0
line 0,0,maxx,0
line maxx,0,maxx,maxy
line maxx,maxy,0,maxy
line 0,maxy,0,0

ink rgb(255,0,255),0
label$="POWER 987654321"
ptr=1
xloc=rightwall-18
yloc=360
for y=1 to len(label$)
   set cursor xloc,yloc
   print mid$(label$,ptr)
   inc yloc,15
   inc ptr
next y

x=rightwall-25
for y=450 to 650 step 15
   line x,y,x+20,y
next y
get image 10,0,0,maxx,maxy,1
endfunction


_intro:
sync
set text font "Arial"
set text size 30
cx=screen width()/2
cy=100

introtext:
data "-green"
data "Rocket Ship Pinball"
data "   "
data "-purple"
data "You get 5 balls per game"
data "  "
data "Complete the target words to blast balls off playfield."
data "This earns you a a BONUS score of 1000."
data "You get to launch the ball on the table again"
data "   "
data "   "
data "-cyan"
data "The mouse y-position, or UP/DOWN arrow keys to adjust power"
data "The LEFT mouse button, or RETURN key Launches the pinball"
data "The Z KEY, Left Shift, or Left CTRL key, controls the LEFT Flipper"
data "The / KEY, Right Shift, or Right CTRL key, controls the RIGHT Flipper"
data "  "
data "  "
data "  "
data "(Press the SPACE BAR to tilt the table if a balls gets stuck!)"
data "   "
data "-yellow"
data "Press a key to continue"
data "999"

cls
restore introtext
read t$
while t$<>"999"
   if left$(t$,1)="-"
      if t$="-green" then ink rgb(0,255,0),0
      if t$="-purple" then ink rgb(200,0,200),0
      if t$="-yellow" then ink rgb(255,255,0),0
      if t$="-cyan" then ink rgb(0,255,255),0
   else
      center text cx,cy,t$
      inc cy,30
   endif
   read t$
endwhile

sync
wait key
ink rgb(0,255,255),0
cls
sync
return



function _decal_signs(decal_id,word$,fgcolor,bgcolor,fontsize)
set text font "Arial"
set text size fontsize
set text to bold
set text opaque
ink fgcolor,bgcolor
signlen=len(word$)*10
cls bgcolor
center text signlen/2,3,word$
get image decal_id,0,0,signlen,fontsize+4,1
endfunction signlen


function _make_rail(objid,xsize,ysize,zsize,color,posx,posy,posz,yangle,bounce,odeflag)
make object box objid,xsize,ysize,zsize
color object objid,color
if odeflag=1 and yangle<>0
   rotate object objid,0,-yangle,0
endif
position object objid,posx,posy,posz
if odeflag=1
   ode create static box objid
   ode set contact fdir1 objid,0
   ode set contact bounce objid,bounce
endif
if odeflag=1 and yangle<>0
   rotate object objid,0,yangle,0
endif
endfunction


function _make_ode_flipper(objid,yangle,bounce)
if yangle<>0
   rotate object objid,0,-yangle,0
endif
ode create static box objid
ode set contact fdir1 objid,0
ode set contact bounce objid,bounce
if yangle<>0
   rotate object objid,0,yangle,0
endif
endfunction


function _remove_gravity(objid)
ode set gravity objid,0
endfunction


function _add_gravity(objid)
ode set gravity objid,gravity#
endfunction


function _add_force(objid,angle,force)
x1#=object position x(objid)
y1#=object position y(objid)
z1#=object position z(objid)

x2#=x1#-50.0
y2#=y1#
z2#=z1#-50.0
ode add force objid,x1#,y1#,z1#,x2#,y2#,z2#
endfunction


function _check_collisions()
` while ODE COLLISION MESSAGE EXISTS()
`  ODE COLLISION GET MESSAGE
` endwhile

phyptr=0
while ODE COLLISION MESSAGE EXISTS()
  `
  rem collision event
   ODE COLLISION GET MESSAGE
   phya=ODE GET OBJECT A()
   phyb=ODE GET OBJECT B()
if phya>0
   collisions(ptr)=phya
   inc phyptr
endif
   phyavelocity#=abs(ODE GET OBJECT A VELOCITY X())+abs(ODE GET OBJECT A VELOCITY Y()/4)+abs(ODE GET OBJECT A VELOCITY Z())
   phybvelocity#=abs(ODE GET OBJECT B VELOCITY X())+abs(ODE GET OBJECT B VELOCITY Y()/4)+abs(ODE GET OBJECT B VELOCITY Z())
set cursor 0,20
print "VelA=";phyavelocity#
print "VelB=";phybvelocity#
endwhile
endfunction

BillR, his game was complete,fun and worked well.

Insert Name Here, your game was pretty much just a start of a game.

forward 100
right 90
forward 100
right 90
forward 100
right 90
forward 100
right 90

fd 100 lt 120 fd 100 lt 120 fd 100 lt 120

repeat 6 [forward 100 right 60]

repeat 4 [pendown forward 20 penup forward 20]

repeat 8[repeat 4[pd fd 20 pu fd 20] pd fd 20 lt 45]

make "x 10
repeat 200 [make "x sum :x 1 fd 3 rt quotient 360 :x]

to pentagon
repeat 5 [forward 100 left 72]
end
pentagon

to house :size
rt 30
repeat 2[fd :size rt 120]
fd :size
repeat 3[lt 90 fd :size]
end

house 50
house 100

LogoData:
data "`Square"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data ""
data "`Multiple commands per line - Triangle"
data "fd 100 lt 120 fd 100 lt 120 fd 100 lt 120"
data ""
data "`Circle"
data "Repeat 360 [ fd 1 rt 1 ]"
data ""
data "`Repeat instructions - Hexagon"
data "repeat 6 [forward 100 right 60]"
data ""
data "`Pen Up/Down - Dashed Line"
data "repeat 4 [pendown forward 20 penup forward 20]"
data ""
data "`Nested repeat functions - Dashed Octagon"
data "repeat 8[repeat 4[pd fd 20 pu fd 20] pd fd 20 lt 45]"
data ""
data "to pentagon"
data "repeat 5 [forward 100 left 72]"
data "end"
data "pentagon"
data ""
data "`Geometric Shape#1"
data "TO NestRep"
data "REPEAT 8 [REPEAT 8 [ FD 50 RT 45 ] RT 45]"
data "END"
data ""
data "'Spirograph#1"
data "REPEAT 36 [ REPEAT 180 [ FD 2 RT 2 ] RT 10 ]"
data ""
data "'Snowflake"
data "REPEAT 12 [ REPEAT 360 [ FD 100 RT 100 ] RT 60 ]"
data ""
data "'3D Torus - Extra Hard - Extra Credit!"
data "REPEAT 45 [ REPEAT 360 [ FD 2 RT 2 ] RR 8 ]"
data "999"

sync on
create bitmap 1,2,2
ink rgb(255,0,255),0
box 0,0,15,15
get image 1,0,0,1,1
delete bitmap 1
SW=screen width():SH=screen Height()
tx=sw/2
ty=sh/2
walk =20:turn=45
type place
   xpos as integer
   ypos as integer
endtype
dim visited(-1) as place

do

sprite 1,tx,ty,1
for xx=0 to walk
move sprite 1,1
tx=sprite x(1):ty=sprite y(1)
array insert at top visited()
visited(0).xpos=tx
visited(0).ypos=ty
next xx
lock pixels
for a = 0 to array count(visited())
dot visited(a).xpos,visited(a).ypos
next a
unlock pixels

ink rgb(255,255,255),0

angle=wrapvalue(angle+turn)
rotate sprite 1,angle


sync
wait 30

loop

REM Project: Logo
REM Created: 8/10/2006 12:15:55 PM
REM
REM ***** Main Source File *****
REM
make camera 1
color backdrop 1,rgb(255,255,255)
sync on
global dim opperation(1000)
global dim number(1000)
global dim linecords(10000,4)
global dim epeat(1000,3)
global dim funct$(100)
global dim funct(100,100,2)
global dim fun(1)
fun(1)=1
global lines
global op=1
global rep
global pe
size = 1
global c
global c$
cls

restore turtle

for y = 1 to 11
   for x = 1 to 7
      read z
      if z = 1
         box x*size,y*size,(x+1)*size,(y+1)*size
      endif
   next x
next y
get image 1,0,0,8,12
sprite 1,screen width()/2-7/2,screen height()/2-11/2,1
ink 0,0
if file exist("fun")=1 then load array "fun",fun(1)
if file exist("opperations")=1 then load array "opperations",funct(1000,1000,2)
if file exist("names")=1 then load array "names",funct$(1000)

do
if scancode()=b
else
b$=b$+inkey$()
if keystate(14)=1 and len(b$)>1 then b$=left$(b$,len(b$)-2)
endif
if returnkey()=1
disect(b$)
b$=""
endif
b=scancode()
text 0,0,b$
for i=0 to lines
line linecords(i,1),linecords(i,2),linecords(i,3),linecords(i,4)
next i
sync
wait 10
if shiftkey()=1
   save array "fun",fun(1)
   save array "opperations",funct(1000,1000,2)
   save array "names",funct$(1000)
   end
endif
loop


function disect(line$)
 for i=1 to len(line$)
   c$=c$+mid$(line$,i)
   if c$="fd" or c$="forward"
      number(op-1)=c
      opperation(op)=1
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif
   if c$="bk" or c$="backward"
      number(op-1)=c
      opperation(op)=2
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif
   if c$="ri" or c$="right"
      number(op-1)=c
      opperation(op)=3
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="lt" or c$="left"
      number(op-1)=c
      opperation(op)=4
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="pe" or c$="penup"
      pe=1
      c$=""
      c=0
   endif

   if c$="pd" or c$="pendown"
      pe=0
      c$=""
      c=0
   endif

   if c$="posx"
      number(op-1)=c
      opperation(op)=6
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="posy"
      number(op-1)=c
      opperation(op)=7
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="rangle"
      number(op-1)=c
      opperation(op)=8
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="langle"
      number(op-1)=c
      opperation(op)=9
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="cs"
      number(op-1)=c
      opperation(op)=10
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$="to"
      f=1
      number(op-1)=c

      op=op+1
      lookforword=1
      c$=""
      c=0
   endif

   if c$="re"
      number(op-1)=c
      opperation(op)=5
      op=op+1
      lookfornum=1
      c$=""
      c=0
   endif

   if c$=funct$(1) and len(c$)>2
      for i=op to op+funct(1,0,0)
         opperation(i)=funct(1,i,1)
         number(i)=funct(1,i,2)
      next i
      op=funct(1,0,0)+1
      c$=""
      c=0
   endif

   if c$="["
      epeat(op-1,1)=op
      rep=op-1
      c$=""
      lookfornum=0
   endif

   if c$="]"
      epeat(rep,2)=op
      c$=""
      lookfornum=0
      c=c*10
   endif

   if c$=" "
      if c>0 then lookfornum=0
      c$=""
   else
      if lookfornum=1
         c=c*10+val(c$)
         c$=""
      endif
   endif

   if lookforword=1
      if right$(c$,1)=" " and len(c$)>1
         funct$(fun(1))=left$(c$,len(c$)-1)
         c$=""
         lookforword=0
      endif
   endif
 next i
 number(op-1)=c/10
 if f=1
   for i=1 to op-1
   funct(fun(1),i,1)=opperation(i)
   funct(fun(1),i,2)=number(i)
   next i
   funct(fun(1),0,0)=i
   fun(1)=fun(1)+1
   goto past
 endif
    for i=1 to op-1
      j=i
      if opperation(j)=5
         for k=1 to number(i)
            for j=epeat(i,1) to epeat(i,2)
      if opperation(j)=1 then forward(number(j),1)
      if opperation(j)=2 then forward(number(j),0)
      if opperation(j)=3 then right(number(j),1)
      if opperation(j)=4 then right(number(j),0)
            next j
         next k
      endif
      i=j
      if opperation(j)=1 then forward(number(j),1)
      if opperation(j)=2 then forward(number(j),0)
      if opperation(j)=3 then right(number(j),1)
      if opperation(j)=4 then right(number(j),0)
      if opperation(j)=6 then offset sprite 1,-number(j),sprite offset y(1)
      if opperation(j)=7 then offset sprite 1,sprite offset x(1),number(j)
      if opperation(j)=8 then rotate sprite 1,number(j)
      if opperation(j)=9 then rotate sprite 1,-number(j)
      if opperation(j)=10
         undim linecords(1000,4)
         dim linecords(10000,4)
         paste sprite 1,screen width()/2-7/2,screen height()/2-11/2
         offset sprite 1,0,0
      endif
    next i
    past:
 f=0
 op=1
 lookfornum=0
 c$=""
 c=0
endfunction

function forward(c,forward)
   if pe=0
      lines=lines+1
      linecords(lines,1)=sprite x(1)-sprite offset x(1)
      linecords(lines,2)=sprite y(1)-sprite offset y(1)
   endif
   if forward=1 then move sprite 1,c
   if forward=0 then move sprite 1,-c
   if pe=0
      linecords(lines,3)=sprite x(1)-sprite offset x(1)
      linecords(lines,4)=sprite y(1)-sprite offset y(1)
      line x1,y1,x2,y2
   endif
endfunction

function right(c,right)
   if right=1 then rotate sprite 1,sprite angle(1)+c
   if right=0 then rotate sprite 1,sprite angle(1)-c
endfunction





Turtle:
data 0,0,0,1,0,0,0
data 0,0,1,1,1,0,0
data 0,0,1,1,1,0,0
data 1,0,1,1,1,0,1
data 0,1,1,1,1,1,0
data 0,1,1,1,1,1,0
data 0,1,1,1,1,1,0
data 0,1,1,1,1,1,0
data 0,1,1,1,1,1,0
data 1,0,1,1,1,0,1
data 0,0,0,1,0,0,0

rem cursor's current position
global cx = 320
global cy = 240
global angle = 180
global length = 10
global isPenDown = 0

dim args$(2)

restore hello
read z$
while z$ <> "end"
   parseCommand(z$)
   gosub turtle
   read z$
endwhile






wait key


turtle:
   select args$(1)
      case "cls"     : cls                      : endcase
      case "reset"   : resetVars()              : endcase
      case "penup"   : isPenDown = 0            : endcase
      case "pendown" : isPenDown = 1            : endcase
      case "forward" : forward(val(args$(2)))   : endcase
      case "color"   : setColor(args$(2))       : endcase
      case "left"    : left(args$(2))           : endcase
      case "right"   : right(args$(2))          : endcase
   endselect
RETURN



REM
function parseCommand(cmd$)
   arg = 0
   s = 0
   for i = 1 to len(cmd$)
      if mid$(cmd$,i) = " "
         inc arg
         args$(arg) = left$(cmd$,i-1)
         args$(arg) = right$(args$(arg),len(args$(arg))-s)
         s = i
      endif
   next i
   if s <> len(cmd$)
      inc arg
      args$(arg) = right$(cmd$,len(cmd$)-s)
   endif
   for i = arg+1 to array count(args$())
      args$(i) = ""
   next
endfunction



REM
function right(degrees$)
   angle = wrapvalue(angle-val(degrees$))
endfunction



REM
function left(degrees$)
   angle = wrapvalue(angle+val(degrees$))
endfunction



REM
function forward(flength)
   if flength = 0 then flength = length
   x = sin(angle)*flength
   y = cos(angle)*flength
   if isPenDown = 1 then line cx,cy,cx+x,cy+y
   cx = cx+x
   cy = cy+y
endfunction



REM
function setColor(c$)
   local color as dword
   select c$
      case "random"  : color = rgb(rnd(255),rnd(255),rnd(255)) : endcase
      case "yellow"  : color = rgb(255,255,0)   : endcase
      case "blue"    : color = rgb(0,0,255)     : endcase
      case "red"     : color = rgb(255,0,0)     : endcase
      case "green"   : color = rgb(0,255,0)     : endcase
      case "white"   : color = rgb(255,255,255) : endcase
      case "purple"  : color = rgb(255,0,255)   : endcase
      case "orange"  : color = rgb(255,128,0)   : endcase
   endselect
   ink color, 0
endfunction



REM
function resetVars()
   cx = 120
   cy = 240
   angle = 180
   length = 10
   isPenDown = 0
endfunction



hello:
data "reset","pendown","color yellow","forward 100","right 180","forward 50","left 90"
data "forward 50","left 90","forward 50","right 180","forward 100","left 90"
data "penup","forward 25","pendown","forward 50","left 180","forward 50"
data "right 90","forward 50","right 90","forward 50","left 180","forward 50"
data "right 90","forward 50","right 90","forward 50","penup","forward 25"
data "right 90","pendown","forward 100","left 90","forward 50","penup"
data "forward 25","pendown","forward 50","left 180","forward 50","right 90"
data "forward 100","penup","right 90","forward 75","pendown","forward 50"
data "right 90","forward 100","right 90","forward 50","right 90","forward 100"
data "end"

sync on:sync rate 0
set window on
set display mode 1024,768,32
set window title "Logo Programming"

cls
global error$
global error1$
global make_function=0
dim parameter$(0)
dim edall$(0)
empty array parameter$(0)
empty array edall$(0)
ink -1,0
box 0,0,screen width(),screen height()
ink 0,0
type window_type
left
top
right
bottom
endtype
global window as window_type
window.right=screen width()
window.bottom=600
type xyz
   x as float
   y as float
   z as float
endtype
type status
   contact as boolean
   width as integer
   style as string
   heading as float
   pitch as float
   roll as float
   position as xyz
   which as integer
   visibility as boolean
   pen
   flood
   screen
   Palette_use as string
endtype
global status as status
dim part$(0)
status.contact=1
status.width=1
status.style="Normal"
status.heading=0.00
status.pitch=0.00
status.roll=0.00
status.position.x=0
status.position.y=0
status.position.z=0
status.which=0
status.visibility=1
status.pen=0
status.flood=0
status.screen=rgb(255,255,255)
status.Palette_use="N/A"
do
   read strg$
   `if len(strg$)>0 then print ">> ", strg$
   strg$=clean_up(strg$)
`   if len(strg$)>0 then print ">> ", strg$
   strg$=parse(strg$)
   `print error$,",",strg$
   rem some error handling
   if upper$(error$)="NOTINST"
      if len(first(strg$))>0
         output("You don't say what to do with "+first(strg$))
      endif
   endif
   if error$="NOTCOM" and len(strg$)>0
      output("I don't know how to "+first(strg$))
   endif
   if error$="NOLIKE"
      output(first(strg$)+" doesn't like "+error1$+" as input")
   endif
`      output("Error?: error="+error$+",return="+strg$)
   sync
loop
output("done")
sync
sync
wait key
end

function parse(strg$)
   if make_function=1
      array insert at bottom edall$(0)
      edall$(array count(edall$(0)))=strg$
   endif

   error$=""
   `if len(strg$)>0 then print "Parsing [",strg$,"]"
   `sync
   sync
  ` wait key
   base_parameter=array count(parameter$(0))
   original_command$=first(strg$)
   if is_instruction(original_command$)=0
      `print "Error: No Instruction"
      error$="NOTINST"
      `print "error:",error$
      exitfunction strg$
   endif
   if len(original_command$)<1 then exitfunction ""
   strg$=pop(strg$)
   command$=upper$(original_command$)
   if make_function=0
      array delete element part$(0),0
      if command$="FORWARD" or command$="FD"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=status.position.x+val(parameter$(base_parameter+1))*sin(status.heading)
         status.position.y=status.position.y+val(parameter$(base_parameter+1))*cos(status.heading)
         if status.contact=1 then line oldx#+screen width()/2,screen height()/2-oldy#,status.position.x+screen width()/2,screen height()/2-status.position.y
         is_command=1
      endif
      if command$="LEFT" or command$="LT"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         status.heading=status.heading-val(parameter$(base_parameter+1))
         is_command=1
      endif
      if command$="RIGHT" or command$="RT"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         status.heading=status.heading+val(parameter$(base_parameter+1))
         is_command=1
      endif
      if command$="BACK" or command$="BK"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=status.position.x-val(parameter$(base_parameter+1))*sin(status.heading)
         status.position.y=status.position.y-val(parameter$(base_parameter+1))*cos(status.heading)
         if status.contact=1 then line oldx#+screen width()/2,screen height()/2-oldy#,status.position.x+screen width()/2,screen height()/2-status.position.y
         is_command=1
      endif
      if command$="SUM"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         parameter$(base_parameter+2)=getval(parameter$(base_parameter+2))
         if error$<>"" then exitfunction
         `output("Sum: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((val(parameter$(base_parameter+1))+val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="DIFFERENCE"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         parameter$(base_parameter+2)=getval(parameter$(base_parameter+2))
         if error$<>"" then exitfunction
         `output("Difference: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((val(parameter$(base_parameter+1))-val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="PRODUCT"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         parameter$(base_parameter+2)=getval(parameter$(base_parameter+2))
         if error$<>"" then exitfunction
         `output("Product: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((val(parameter$(base_parameter+1))*val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="QUOTIENT"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         parameter$(base_parameter+2)=getval(parameter$(base_parameter+2))
         if error$<>"" then exitfunction
         `output("Quotient: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((val(parameter$(base_parameter+1))/val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="POWER"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         parameter$(base_parameter+2)=getval(parameter$(base_parameter+2))
         if error$<>"" then exitfunction
         `output("Quotient: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((val(parameter$(base_parameter+1))^val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="SQRT"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         `output("Quotient: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((sqrt(val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="ABS"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         `output("Quotient: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         build$=str$((abs(val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         is_command=1
      endif
      if command$="CLEARSCREEN" or command$="CS"
         ink -1,0
         box window.left,window.top,window.right,window.bottom
         ink 0,0
         status.position.x=0
         status.position.y=0
         status.position.z=0
         status.heading=0.00
         status.pitch=0.00
         status.roll=0.00
         is_command=1
      endif
      if command$="REPEAT"
         if upper$(first(strg$))="FOREVER"
            forever=1
            strg$=pop(strg$)
            strg$=get_parameters$(strg$,1)
         else
            strg$=get_parameters$(strg$,2)
         endif
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         `output("Repeat: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
        ` print "Repeat: Parameters [",parameter$(base_parameter+1)," ",parameter$(base_parameter+2),"]"
         if forever=0
         for n=1 to val(parameter$(base_parameter+1))
            parse(left$(right$(parameter$(base_parameter+2),len(parameter$(base_parameter+2))-1),len(parameter$(base_parameter+2))-2))
         next n
         else
         do
            parse(left$(right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1),len(parameter$(base_parameter+1))-2))
            sync
         loop
         endif
         is_command=1
      endif
      if command$="PRINT"
         strg$=get_parameters$(strg$,1)
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         output(parameter$(base_parameter+1))
         is_command=1
      endif
      if command$="PENUP" or command$="PU"
         status.contact=0
         is_command=1
      endif
      if command$="PENDOWN" or command$="PD"
         status.contact=1
         is_command=1
      endif
      if command$="SETPOS"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         if is_list(parameter$(base_parameter+1))=0 or left$(parameter$(base_parameter+1),1)<>"["
            error$="NOLIKE"
            error1$=parameter$(base_parameter+1)
            exitfunction original_command$
         endif
         if left$(parameter$(0),1)="[" then parameter$(0)=right$(parameter$(0),len(parameter$(0))-1)
         if right$(parameter$(0),1)="]" then parameter$(0)=left$(parameter$(0),len(parameter$(0))-1)
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(first(parameter$(base_parameter+1)))
         parameter$(0)=pop(parameter$(0))
         status.position.y=val(first(parameter$(base_parameter+1)))
         if status.contact=1 then line oldx#+screen width()/2,screen height()/2-oldy#,status.position.x+screen width()/2,screen height()/2-status.position.y
         is_command=1
      endif
      if command$="SETXY"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         if is_list(parameter$(base_parameter+1))=1 or left$(parameter$(base_parameter+1),1)="["
            error$="NOLIKE"
            error1$=parameter$(base_parameter+1)
            exitfunction original_command$
         endif
         if is_list(parameter$(base_parameter+2))=1 or left$(parameter$(base_parameter+2),1)="["
            error$="NOLIKE"
            error1$=parameter$(base_parameter+2)
            exitfunction original_command$
         endif
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(parameter$(base_parameter+1))
         status.position.y=val(parameter$(base_parameter+2))
         if status.contact=1 then line oldx#+screen width()/2,screen height()/2-oldy#,status.position.x+screen width()/2,screen height()/2-status.position.y
         is_command=1
      endif
      if command$="POS"
         strg$="["+str$(status.position.x)+" "+str$(status.position.y)+"] "+strg$
         is_command=1
      endif
      if command$="SETHEADING"
         strg$=get_parameters$(strg$,1)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if error$<>"" then exitfunction
         `output("Quotient: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         status.heading=val(parameter$(base_parameter+1))
         is_command=1
      endif
      if command$="HEADING"
         strg$=str$(status.heading)
         is_command=1
      endif
      if command$="MAKE"
         strg$=get_parameters$(strg$,2)
         if not_enough=1 then output("not enough inputs to "+original_command$):exitfunction
         if is_list(parameter$(base_parameter+1))=1 or left$(parameter$(base_parameter+1),1)<>chr$(34)
            error$="NOLIKE"
            error1$=parameter$(base_parameter+1)
            exitfunction original_command$
         endif
         `output("Make: "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2))
         found=0
         infunction=0
         for n=0 to array count(edall$(0))
            if upper$(left$(edall$(n),2))="TO" and infunction=0
               infunction=1
            endif
            if infunction=1 and upper$(left$(edall$(n),3))="END"
               infunction=0
            endif
            if infunction=0 and upper$(left$(edall$(n),5+len(parameter$(base_parameter+1))))="MAKE "+upper$(parameter$(base_parameter+1))
               edall$(n)="Make "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2)
               found=1
               exit
            endif
         next n
         if found=0
            array insert at bottom edall$(0)
            edall$(array count(edall$(0)))="Make "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2)
         endif
         is_command=1
      endif
      if command$="TO"
         name$=first(strg$)
         build$="TO "+name$
        for n=0 to array count(edall$(0))
            if upper$(left$(edall$(n),2))="TO"
               name1$=first(pop(edall$(n)))
               if upper$(name1$)=upper$(name$)
                  while endline=0
                     if upper$(left$(edall$(n),3))="END"
                        endline=1
                     endif
                     array delete element edall$(0),n
                  endwhile
               endif
            endif
         next n
         strg$=pop(strg$)
         while len(strg$)>0
            para$=first(strg$)
            strg$=pop(strg$)
            if left$(para$,1)<>":"
               error$="NOLIKE"
               error1$=para$
               exitfunction "[]"
            else
               build$=build$+para$
            endif
         endwhile
         array insert at bottom edall$(0)
         edall$(array count(edall$(0)))=build$
         make_function=1
         is_command=1
      endif
   endif
   if command$="END"
      if make_function=1
         make_function=0
         is_command=1
      endif
   endif
   if is_command=0 and make_function=0
      `print "Looking up command ",command$
     for n=0 to array count(edall$(0))
            `print edall$(n)
         if upper$(left$(edall$(n),2))="TO"
            name$=first(pop(edall$(n)))

            if command$=upper$(name$) and is_command=0
               is_command=1
               while endline=0
                  inc n
                  if n>array count(edall$(0))
                     exit
                  endif
                  if upper$(left$(edall$(n),3))="END"
                     endline=1
                  else
                     parse(edall$(n))
                  endif
               endwhile
            endif
         endif
      next n
   endif
   if is_command=0 and make_function=0
      error$="NOTCOM"
      exitfunction original_command$
   endif
   while array count(parameter$(0))>base_parameter
      array delete element parameter$(0), array count(parameter$(0))
   endwhile
   `print "Exiting with string:[",strg$,"]"
   if make_function=1 then strg$=""
   if len(strg$)>0 then strg$=parse(strg$)
endfunction strg$

function is_list(strg$)
n=left$(strg$,1)="["
endfunction n

function pop(strg$)
   error$=""
   if mid$(strg$,1)="+" or (mid$(strg$,1)="-" and contains_non_number(mid$(strg$,2))) or mid$(strg$,1)="*" or mid$(strg$,1)="/"
      exitfunction right$(strg$,len(strg$)-1)
   endif
   if mid$(strg$,1)="["
      char$="["
      until_close=1
      strg$=right$(Strg$,len(strg$)-1)
   endif
   if mid$(strg$,1)="{" and until_close=0
      char$="{"
      until_close=1
      strg$=right$(Strg$,len(strg$)-1)
   endif
   list$=char$
   for n=1 to len(strg$)
   if mid$(strg$,n)="[" then list$=list$+"["
   if mid$(strg$,n)="]"
      if len(list$)=0
         output("unexpected ']'")
         error$="1"
         exitfunction
      else
         if right$(list$,1)="["
            list$=left$(list$,len(list$)-1)
         else
            output("unexpected ']'")
            error$="1"
            exitfunction
         endif
      endif
   endif
   if mid$(strg$,n)="{" then list$=list$+"{"
   if mid$(strg$,n)="}"
      if len(list$)=0
         output("unexpected '}'")
         error$="1"
         exitfunction
      else
         if right$(list$,1)="{"
            list$=left$(list$,len(list$)-1)
         else
            output("unexpected '}'")
            error$="1"
            exitfunction
         endif
      endif
   endif
   if until_close=0 and (mid$(strg$,n)=" " or mid$(strg$,n)="," or mid$(strg$,n)="+" or (mid$(strg$,n)="-" and n>1) or mid$(strg$,n)="*" or mid$(strg$,n)="/")
      exitfunction right$(strg$,len(strg$)-n)
   endif
   if until_close=0 and (mid$(strg$,n)="[" or mid$(strg$,n)="]" or mid$(strg$,n)="{" or mid$(strg$,n)="}")
      exitfunction  right$(strg$,len(strg$)-n+1)
   endif
   if until_close=1 and list$=""
      exitfunction right$(strg$,len(strg$)-n)
   endif
   next n
endfunction ""

function first(strg$)
   error$=""
   if mid$(strg$,1)="+" or (mid$(strg$,1)="-" and contains_non_number(mid$(strg$,2))) or mid$(strg$,1)="*" or mid$(strg$,1)="/"
      exitfunction mid$(strg$,1)
   endif
   if mid$(strg$,1)="["
      char$="["
      until_close=1
      strg$=right$(Strg$,len(strg$)-1)
   endif
   if mid$(strg$,1)="{" and until_close=0
      char$="{"
      until_close=1
      strg$=right$(Strg$,len(strg$)-1)
   endif
   list$=char$
   for n=1 to len(strg$)
   if mid$(strg$,n)="[" then list$=list$+"["
   if mid$(strg$,n)="{" then list$=list$+"{"
   if mid$(strg$,n)="]"
      if len(list$)=0
         output("unexpected ']'")
         error$="1"
         exitfunction
      else
         if right$(list$,1)="["
            list$=left$(list$,len(list$)-1)
         else
            output("unexpected ']'")
            error$="1"
            exitfunction
         endif
      endif
   endif
   if mid$(strg$,n)="}"
      if len(list$)=0
         output("unexpected '}'")
         error$="1"
         exitfunction
      else
         if right$(list$,1)="{"
            list$=left$(list$,len(list$)-1)
         else
            output("unexpected '}'")
            error$="1"
            exitfunction
         endif
      endif
   endif
   if until_close=0 and (mid$(strg$,n)=" " or mid$(strg$,n)="," or mid$(strg$,n)="+" or (mid$(strg$,n)="-" and n>1) or mid$(strg$,n)="*" or mid$(strg$,n)="/" or mid$(strg$,n)="[" or mid$(strg$,n)="]" or mid$(strg$,n)="{" or mid$(strg$,n)="}")
      exitfunction left$(strg$,n-1)
   endif
   if until_close=1 and list$=""
      exitfunction char$+left$(strg$,n)
   endif
   next n
endfunction strg$

function get_parameters$(strg$,amount)
   if error$<>"" then exitfunction strg$
   not_enough=0
   num=0
   base_parameter=array count(parameter$(0))
   for n=1 to amount
`   print "string:",strg$
      if len(strg$)<1
         not_enough=1
         exitfunction strg$
      endif
      array insert at bottom parameter$(0)
      ac=array count(parameter$(0))
`      print "string:",`strg$;
      parameter$(ac)=first(strg$)
      strg$=pop(strg$)
 `     print ". popped ",parameter$(ac)," <- ",strg$
      if is_instruction(parameter$(ac)) or is_operator(first(strg$))
 `     print "My parameter:",parameter$(ac)
      `print is_operator(first(strg$))
         strg$=parse(parameter$(ac)+" "+strg$)
`         print "Error:",error$
         if error$<>"" and error$<>"NOTINST" then exitfunction strg$
      `   print ac
 `        print "string:",strg$
 `        sync
 `        sync
 `        wait key
         parameter$(array count(parameter$(0)))=first(strg$)
         strg$=pop(strg$)
      endif
   next n
endfunction strg$

function is_instruction(strg$)
   strg$=upper$(strg$)
   if left$(strg$,1)<>chr$(34) and left$(strg$,1)<>":" and left$(strg$,1)<>"[" and contains_non_number(strg$) and len(strg$)>0 and left$(strg$,1)<>"{" and left$(strg$,1)<>"("
      exitfunction 1
   endif
endfunction 0

function contains_alpha(strg$)
   strg$=upper$(strg$)
   for n=1 to len(strg$)
      if mid$(strg$,n)="A" or mid$(strg$,n)="B" or mid$(strg$,n)="C" or mid$(strg$,n)="D" or mid$(strg$,n)="E" or mid$(strg$,n)="F" or mid$(strg$,n)="G" or mid$(strg$,n)="H" or mid$(strg$,n)="I" or mid$(strg$,n)="J" or mid$(strg$,n)="K" or mid$(strg$,n)="L" or mid$(strg$,n)="M" or mid$(strg$,n)="N" or mid$(strg$,n)="O" or mid$(strg$,n)="P" or mid$(strg$,n)="Q" or mid$(strg$,n)="R" or mid$(strg$,n)="S" or mid$(strg$,n)="T" or mid$(strg$,n)="U" or mid$(strg$,n)="V" or mid$(strg$,n)="W" or mid$(strg$,n)="X" or mid$(strg$,n)="Y" or mid$(strg$,n)="Z"
         exitfunction 1
      endif
   next n
endfunction 0

function contains_non_number(strg$)
   strg$=upper$(Strg$)
   for n=1 to len(strg$)
      if mid$(strg$,n)<>"0" and mid$(strg$,n)<>"1" and mid$(strg$,n)<>"2" and mid$(strg$,n)<>"3" and mid$(strg$,n)<>"4" and mid$(strg$,n)<>"5" and mid$(strg$,n)<>"6" and mid$(strg$,n)<>"7" and mid$(strg$,n)<>"8" and mid$(strg$,n)<>"9" and mid$(strg$,n)<>"." and mid$(strg$,n)<>"-"
         exitfunction 1
      endif
   next n
endfunction 0
function is_operator(strg$)
   if strg$="+" or strg$="-" or strg$="*" or strg$="/"
      exitfunction 1
   endif
endfunction 0

function split(strg$)
empty array part$(0)
bracket=0
for n=1 to len(strg$)
   if mid$(strg$,n)="[" then inc bracket
   if mid$(strg$,n)="]" then dec bracket
   if bracket<1
      if mid$(strg$,n)=" " or mid$(strg$,n)=","
         array insert at bottom part$(0)
         part$(array count(part$(0)))=left$(strg$,n-1)
         strg$=right$(strg$,len(strg$)-n)
         n=0
      endif
   endif
next n
if len(strg$)>0
         array insert at bottom part$(0)
         part$(array count(part$(0)))=strg$
endif
endfunction


function clean_up(strg$)
   build$=""
   last_char=-1
   list$=""
   for n=1 to len(strg$)

   if mid$(strg$,n)="[" then list$=list$+"["
   if mid$(strg$,n)="{" then list$=list$+"{"
   if mid$(strg$,n)="]"
      if len(list$)=0
         output("unexpected ']'")
         error$="1"
         exitfunction
      else
         if right$(list$,1)="["
            list$=left$(list$,len(list$)-1)
         else
            output("unexpected ']'")
            error$="1"
            exitfunction
         endif
      endif
   endif
   if mid$(strg$,n)="}"
      if len(list$)=0
         output("unexpected '}'")
         error$="1"
         exitfunction
      else
         if right$(list$,1)="{"
            list$=left$(list$,len(list$)-1)
         else
            output("unexpected '}'")
            error$="1"
            exitfunction
         endif
      endif
   endif
      if mid$(strg$,n)=" "
         if last_char=n-1 or instring=1
            if (mid$(strg$,n+1)<>"," and mid$(strg$,n+1)<>"+" and mid$(strg$,n+1)<>"*" and mid$(strg$,n+1)<>"/" and mid$(strg$,n+1)<>"[" and mid$(strg$,n+1)<>"]" and mid$(strg$,n-1)<>"," and mid$(strg$,n-1)<>"+"  and mid$(strg$,n-1)<>"*" and mid$(strg$,n-1)<>"/" and mid$(strg$,n-1)<>"[" and mid$(strg$,n-1)<>"]") or instring=1
               build$=build$+mid$(strg$,n)
            endif
         endif
      else
         if mid$(strg$,n)=";" or mid$(strg$,n)="`" then goto end0
         last_char=n
         build$=build$+mid$(strg$,n)
      endif
   next n
   end0:
   if right$(build$,1)=" " then build$=left$(build$,len(build$)-1)
   while len(list$)>0
      build$=build$+mirror(right$(list$,1))
      list$=left$(list$,len(list$)-1)
   endwhile

endfunction build$

function mirror(char$)
if char$="{" then exitfunction "}"
if char$="[" then exitfunction "]"
if char$="(" then exitfunction ")"
endfunction ""
function output(strg$)
   if len(strg$)>0
      if left$(strg$,1)="["
         strg$=right$(strg$,len(strg$)-1)
         if right$(strg$,1)="]" then strg$=left$(strg$,len(strg$)-1)
      endif
   print "<< ",strg$
   sync
   endif
endfunction

function infixs(char$)
   if char$="*" or char$="/" or char$="+" or char$="-" or char$="=" or char$="<" or char$=">" then exitfunction 1
endfunction 0

function getval(part$)
   error$=""
   if contains_non_number(part$)
      if left$(part$,1)=":"
         found=0
         infunction=0
         name$=right$(part$,len(part$)-1)
         for n=0 to array count(edall$(0))
            if upper$(left$(edall$(n),2))="TO" and infunction=0
               infunction=1
            endif
            if infunction=1 and upper$(left$(edall$(n),3))="END"
               infunction=0
            endif
            if infunction=0 and upper$(left$(edall$(n),6+len(name$)))="MAKE "+chr$(34)+upper$(name$)
               found=1
               p$=pop(pop(edall$(n)))
               exitfunction p$
            endif
         next n
         if found=0
            output(name$+" has no value")
            error$="UNDEF"
            exitfunction strg$
         endif
      else
         if left$(part$,1)=chr$(34)
            strg$=right$(part$,len(part$)-1)
            exitfunction strg$
         endif
      endif
   endif
endfunction part$

LogoData:
rem I used several setpos commands to spread out all the shapes (for less overlap)
data "`Square"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data ""
data "pu setpos [-30 0] pd"
data ""
data "`Multiple commands per line - Triangle"
data "fd 100 lt 120 fd 100 lt 120 fd 100 lt 120"
data ""
data "pu setpos [0 0] pd"
data ""
data "`Circle"
data "Repeat 360 [ fd 1 rt 1 ]"
data ""
data "pu setpos [320 -200] pd"
data ""
data "`Repeat instructions - Hexagon"
data "repeat 6 [forward 100 right 60]"
data ""
data "pu setpos [300 0] pd"
data ""
data "`Pen Up/Down - Dashed Line"
data "repeat 4 [pendown forward 20 penup forward 20]"
data ""
data "pu setpos [200 -50] pd"
data ""
data "`Nested repeat functions - Dashed Octagon"
data "repeat 8[repeat 4[pd fd 20 pu fd 20] pd fd 20 lt 45]"
data ""
data "pu setpos [0 0] pd"
data ""
data "to pentagon"
data "repeat 5 [forward 100 left 72]"
data "end"
data "pentagon"
data ""
data "pu setpos [-280 -200] pd"
data ""
data "`Geometric Shape#1"
data "TO NestRep"
data "REPEAT 8 [REPEAT 8 [ FD 50 RT 45 ] RT 45]"
data "END"
data "`I added this to show that you can define and manipulate variables."
data "TO spiral"
data "make "x 10 repeat 450 [make "x sum :x 1 fd 3 rt quotient 360 :x]"
data "END"
data "pu setxy -240 150 pd spiral"
data "NestRep"
data "`Spirograph#1"
data "REPEAT 72 [ REPEAT 360 [ FD 1 RT 1 ] RT 5 ]"
data ""
data "pu setxy 280 200 pd"
data ""
data "`Snowflake"
data "REPEAT 12 [ REPEAT 360 [ FD 100 RT 100 ] RT 60 ]"

forward, fd
left, lt
right, rt
back, bk
sum
difference
product
quotient
power
sqrt
abs
clearscreen, cs
repeat
print
penup, pu
pendown, pd
setpos
setxy
pos
setheading
heading
make
to/end

I'm pretty much adding every command I find in the FMSLogo documentation.
Data Structure Commands
   Data Structure Predicates
      Word? thing
      List? thing
      Array? thing
      Empty? thing
      Equal? thing thing

Communication
   Transmitters
      Print string
      Type string
      Show string

   Keyboard and Mouse Access
      MousePos

Arithmetic
   Numeric Operations
      Sum number number
      Difference number number
      Product number number
      Quotient number number
      Remainder integer integer
      Modulo integer integer
      Int number
      Round number
      Abs number
      Sign number
      Sqrt number
      Minus number
      Power number number
      Exp number
      Log10 number
      Ln number
      PI
      Tan number
      Sin number
      Cos number
      Arctan number
      Arcsin number
      Arccos number

   Arithmetic Predicates
      Less? number number
      Greater? number number

   Random Numbers
      Random integer

Logical Operations
   And boolean boolean
   Or boolean boolean
   Not boolean

Graphics
   Turtle Motion
      Forward number, FD number
      Back number, BK number
      Left number, LT number
      Right number, RT number
      SetPos list
      SetPosXYZ list
      SetXY number number
      SetXYZ number number number
      SetX number
      SetY number
      SetZ number
      Home
      SetHeading number, SetH number

   Turtle Motion Queries
      Pos
      PosXYZ
      XCor
      YCor
      ZCor
      Heading
      Towards
      Distance

   Turtle and Window Control
      Clean
      Clearscreen, CS

   Pen Control
      PenDown, PD
      PenUp, PU
      PenPaint, PPT
      PenErase, PE
      PenReverse, PX
      PenNormal
      SetPenColor, SETPC
      SetFloodColor, SETFC
      SetScreenColor, SETSC

   Pen Queries
      PenDown?
      PenMode
      PenColor
      FloodColor
      ScreenColor

Workspace Management
   Procedure Definition
      To string
      End

   Variable Definition
      Make string number

Control Structures
   Control Commands
      Run
      Repeat
      If
      Ifelse
      True
      False
      Wait number
      Bye

sync on:sync rate 0
set window on
set display mode 1024,768,32
set window title "Logo Programming"


remstart
Logo Parser created by Lowerlogic
remend

cls
global error$
global error1$
global make_function=0
dim parameter$(0)
dim edall$(0)
empty array parameter$(0)
empty array edall$(0)
ink -1,0
box 0,0,screen width(),screen height()
ink 0,0
type window_type
left
top
right
bottom
endtype
global window as window_type
window.right=screen width()
window.bottom=screen height()
type xyz
   x as float
   y as float
   z as float
endtype
type status
   contact as boolean
   width as integer
   penmode as string
   heading as float
   pitch as float
   roll as float
   position as xyz
   which as integer
   visibility as boolean
   pencolor
   floodcolor
   screencolor
   Palette_use as string
endtype
global status as status
dim part$(0)
status.contact=1
status.width=1
status.penmode="paint"
status.heading=0.00
status.pitch=0.00
status.roll=0.00
status.position.x=0
status.position.y=0
status.position.z=0
status.which=0
status.visibility=1
status.pencolor=rgb(0,0,0)
status.floodcolor=rgb(0,0,0)
status.screencolor=rgb(255,255,255)
status.Palette_use="N/A"

dim color(15)
color(0)=rgb(0,0,0)           `black
color(1)=rgb(0,0,255)         `blue
color(2)=rgb(0,255,0)         `green
color(3)=rgb(0,255,255)       `cyan
color(4)=rgb(255,0,0)         `red
color(5)=rgb(255,0,255)       `magenta
color(6)=rgb(255,255,0)       `yellow
color(7)=rgb(255,255,255)     `white
color(8)=rgb(155,96,59)       `brown
color(9)=rgb(197,136,18)      `tan
color(10)=rgb(100,162,64)     `olive
color(11)=rgb(120,187,187)    `sky blue
color(12)=rgb(255,149,119)    `salmon
color(13)=rgb(144,113,208)    `medium purple
color(14)=rgb(255,163,0)      `orange
color(15)=rgb(183,183,183)    `gray
do
   read strg$
   `if len(strg$)>0 then print ">> ", strg$
   strg$=clean_up(strg$)
   `if len(strg$)>0 then print ">> ", strg$
   strg$=parse(strg$)
   `print error$,",",strg$
   rem ome error handling
   error$=upper$(error$)
   if len(strg$)>0
      if error$="NOTINST"
         output("You don't say what to do with "+first(strg$))
      endif
      if error$="NOTCOM" and len(strg$)>0
         output("I don't know how to "+first(strg$))
      endif
      if error$="NOLIKE"
         output(first(strg$)+" doesn't like "+error1$+" as input")
      endif
      if error$="NOTENOUGH"
         output("not enough inputs to "+first(strg$))
      endif
      if error$="NOOUTPUT"
         output(first(strg$)+" did not output to "+error1$)
      endif
   endif
   sync
loop
output("done")
sync
sync
wait key
end

function parse(strg$)
   while left$(strg$,1)=" "
      strg$=right$(strg$,len(strg$)-1)
   endwhile
   while right$(strg$,1)=" "
      strg$=left$(strg$,len(strg$)-1)
   endwhile
   if make_function=1
      array insert at bottom edall$(0)
      edall$(array count(edall$(0)))=strg$
   endif

   error$=""
`if len(strg$)>0 then output("Parsing ["+strg$+"]")
`sync
   sync
`wait key
   base_parameter=array count(parameter$(0))
   original_command$=first(strg$)
   if is_instruction(original_command$)=0
      error$="NOTINST"
      exitfunction strg$
   endif
   if len(original_command$)<1 then exitfunction ""
   strg$=pop(strg$)
   command$=upper$(original_command$)
   if make_function=0
      array delete element part$(0),0
      if command$="CLEARSCREEN" or command$="CS"
         ink -1,0
         box window.left,window.top,window.right,window.bottom
         ink 0,0
         status.position.x=0
         status.position.y=0
         status.position.z=0
         status.heading=0.00
         status.pitch=0.00
         status.roll=0.00
         goto done_command
      endif
      if command$="CLEAN"
         ink -1,0
         box window.left,window.top,window.right,window.bottom
         ink 0,0
         goto done_command
      endif
      if command$="HOME"
         status.position.x=0
         status.position.y=0
         status.position.z=0
         goto done_command
      endif
      if command$="PI"
         build$="3.1415926535897932384626433832795"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="PENUP" or command$="PU"
         status.contact=0
         goto done_command
      endif
      if command$="PENDOWN" or command$="PD"
         status.contact=1
         goto done_command
      endif
      if command$="PENDOWN?" or command$="PENDOWNP"
         build$="false"
         if status.contact=1
            build$="true"
         endif
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="PENPAINT" or command$="PPT"
         status.contact=1
         status.penmode="paint"
         goto done_command
      endif
      if command$="PENERASE" or command$="PE"
         status.contact=1
         status.penmode="erase"
         goto done_command
      endif
      if command$="PENREVERSE" or command$="PX"
         status.contact=1
         status.penmode="reverse"
         goto done_command
      endif
      if command$="PENNORMAL"
         status.contact=1
         status.penmode="paint"
         goto done_command
      endif
      if command$="PENMODE"
         build$=status.penmode
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="PENCOLOR" or command$="PENCOLOUR" or command$="PC"
         build$="["+str$(rgbr(status.pencolor))+" "+str$(rgbg(status.pencolor))+" "+str$(rgbb(status.pencolor))+"]"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="FLOODCOLOR" or command$="FLOODCOLOUR"
         build$="["+str$(rgbr(status.floodcolor))+" "+str$(rgbg(status.floodcolor))+" "+str$(rgbb(status.floodcolor))+"]"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="SCREENCOLOR" or command$="SCREENCOLOUR"
         build$="["+str$(rgbr(status.screencolor))+" "+str$(rgbg(status.screencolor))+" "+str$(rgbb(status.screencolor))+"]"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="MOUSEPOS"
         strg$="["+str$(mousex()-screen width()/2)+" "+str$(screen height()/2-mousey())+"] "+strg$
         goto done_command
      endif
      if command$="POS"
         strg$="["+str$(status.position.x)+" "+str$(status.position.y)+"] "+strg$
         goto done_command
      endif
      if command$="POSXYZ"
         strg$="["+str$(status.position.x)+" "+str$(status.position.y)+" "+str$(status.position.z)+"] "+strg$
         goto done_command
      endif
      if command$="XCOR"
         if len(strg$)>0
            strg$=str$(status.position.x)+" "+strg$
         else
            strg$=str$(status.position.x)
         endif
         goto done_command
      endif
      if command$="YCOR"
         if len(strg$)>0
            strg$=str$(status.position.y)+" "+strg$
         else
            strg$=str$(status.position.y)
         endif
         goto done_command
      endif
      if command$="ZCOR"
         if len(strg$)>0
            strg$=str$(status.position.z)+" "+strg$
         else
            strg$=str$(status.position.z)
         endif
         goto done_command
      endif
      if command$="HEADING"
         strg$=str$(wrapvalue(status.heading))
         goto done_command
      endif
      if command$="WORD?" or command$="WORDP"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if left$(parameter$(base_parameter+1),1)=chr$(34) then build$="true"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="LIST?" or command$="LISTP"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if is_list(parameter$(base_parameter+1)) then build$="true"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="ARRAY?" or command$="ARRAYP"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if is_array(parameter$(base_parameter+1)) then build$="true"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="EMPTY?" or command$="EMPTYP"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
         parameter$(base_parameter+1)=getval(parameter$(base_parameter+1))
         if len(parameter$(base_parameter+1))=1
            if is_number(parameter$(base_parameter+1))=0 then build$="true"
         else
            if len(parameter$(base_parameter+1))=2 and left$(parameter$(base_parameter+1),1)="[" then build$="true"
         endif
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="SETX"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(parameter$(base_parameter+1))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="SETY"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.y=val(parameter$(base_parameter+1))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="SETZ"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.z=val(parameter$(base_parameter+1))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="FORWARD" or command$="FD"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=status.position.x+val(parameter$(base_parameter+1))*sin(status.heading)
         status.position.y=status.position.y+val(parameter$(base_parameter+1))*cos(status.heading)
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="LEFT" or command$="LT"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         status.heading=status.heading-val(parameter$(base_parameter+1))
         goto done_command
      endif
      if command$="RIGHT" or command$="RT"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         status.heading=status.heading+val(parameter$(base_parameter+1))
         goto done_command
      endif
      if command$="BACK" or command$="BK"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=status.position.x-val(parameter$(base_parameter+1))*sin(status.heading)
         status.position.y=status.position.y-val(parameter$(base_parameter+1))*cos(status.heading)
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="SQRT"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((sqrt(val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="ABS"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((abs(val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="INT"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((int(val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="ROUND"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((int(0.5+val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="MINUS"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((0-(val(parameter$(base_parameter+1)))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="SIGN"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="0"
         if val(parameter$(base_parameter+1))<0 then build$="-1"
         if val(parameter$(base_parameter+1))>0 then build$="1"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="LOG10"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(log(val(parameter$(base_parameter+1)),10,6))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="LN"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(log(val(parameter$(base_parameter+1)),2.71828183,6))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="TAN"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(tan(val(parameter$(base_parameter+1))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="SIN"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(sin(val(parameter$(base_parameter+1))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="COS"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(cos(val(parameter$(base_parameter+1))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="ARCTAN"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(atan(val(parameter$(base_parameter+1))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="ARCSIN"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(asin(val(parameter$(base_parameter+1))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="ARCCOS"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(acos(val(parameter$(base_parameter+1))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="NOT"
         strg$=get_parameters$(original_command$,strg$,"B")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if parameter$(base_parameter+1)="FALSE" then build$="true" else build$="false"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="RANDOM"
         strg$=get_parameters$(original_command$,strg$,"I")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if val(parameter$(base_parameter+1))<1 then parameter$(base_parameter+1)="1"
         build$=str$(rnd(val(parameter$(base_parameter+1))-1))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="EXP"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$(2.71828183^val(parameter$(base_parameter+1)))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="WAIT"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         sleep val(parameter$(base_parameter+1))/60.0*1000.0
         goto done_command
      endif
      if command$="BYE"
         end
         `goto done_command
      endif
      if command$="PRINT" or command$="SHOW" or command$="TYPE"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if command$="PRINT" or command$="TYPE"
            if left$(parameter$(base_parameter+1),1)="["
               parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
               if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            endif
         endif
         if command$="PRINT" or command$="SHOW"
            output(parameter$(base_parameter+1))
         else
            type0(parameter$(base_parameter+1))
         endif
         goto done_command
      endif
      if command$="SETPOS"
         strg$=get_parameters$(original_command$,strg$,"L")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(getval(first(parameter$(base_parameter+1))))
         parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
         status.position.y=val(getval(first(parameter$(base_parameter+1))))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="TOWARDS"
         strg$=get_parameters$(original_command$,strg$,"L")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         targetx#=val(getval(first(parameter$(base_parameter+1))))
         parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
         targety#=val(getval(first(parameter$(base_parameter+1))))
         targetangle#=wrapvalue(atanfull(-(targetx#-status.position.x),targety#-status.position.y))
         angle#=wrapvalue(status.heading)
         turn#=angle#-targetangle#
         while turn#<0
            inc turn#,360
         endwhile
         while turn#>=360
            dec turn#,360
         endwhile
         build$=str$(turn#)
         strg$=build$+" "+strg$
         goto done_command
      endif
      if command$="DISTANCE"
         strg$=get_parameters$(original_command$,strg$,"L")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         targetx#=val(getval(first(parameter$(base_parameter+1))))
         parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
         targety#=val(getval(first(parameter$(base_parameter+1))))
         distance#=sqrt((targetx#-status.position.x)^2+(targety#-status.position.y)^2)
         build$=str$(distance#)
         strg$=build$+" "+strg$
         goto done_command
      endif
      if command$="SETPOSXYZ"
         strg$=get_parameters$(original_command$,strg$,"L")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(getval(first(parameter$(base_parameter+1))))
         parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
         status.position.y=val(getval(first(parameter$(base_parameter+1))))
         parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
         status.position.z=val(getval(first(parameter$(base_parameter+1))))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="SETPENCOLOR" or command$="SETPENCOLOUR" or command$="SETPC"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if is_list(parameter$(base_parameter+1))=1
            if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            red=val(getval(first(parameter$(base_parameter+1))))
            parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
            green=val(getval(first(parameter$(base_parameter+1))))
            parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
            blue=val(getval(first(parameter$(base_parameter+1))))
            status.pencolor=rgb(red,green,blue)
         else
            c$=getval(parameter$(base_parameter+1))
            if is_integer(c$)=1
               c=val(c$)
               status.pencolor=color(c)
            endif
         endif
         goto done_command
      endif
      if command$="SETFLOODCOLOR" or command$="SETFLOODCOLOUR" or command$="SETFC"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if is_list(parameter$(base_parameter+1))=1
            if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            red=val(getval(first(parameter$(base_parameter+1))))
            parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
            green=val(getval(first(parameter$(base_parameter+1))))
            parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
            blue=val(getval(first(parameter$(base_parameter+1))))
            status.floodcolor=rgb(red,green,blue)
         else
            c$=getval(parameter$(base_parameter+1))
            if is_integer(c$)=1
               c=val(c$)
               status.floodcolor=color(c)
            endif
         endif
         goto done_command
      endif
      if command$="SETSCREENCOLOR" or command$="SETSCREENCOLOUR" or command$="SETSC"
         strg$=get_parameters$(original_command$,strg$,"S")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if is_list(parameter$(base_parameter+1))=1
            if left$(parameter$(base_parameter+1),1)="[" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            if right$(parameter$(base_parameter+1),1)="]" then parameter$(base_parameter+1)=left$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
            red=val(getval(first(parameter$(base_parameter+1))))
            parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
            green=val(getval(first(parameter$(base_parameter+1))))
            parameter$(base_parameter+1)=pop(parameter$(base_parameter+1))
            blue=val(getval(first(parameter$(base_parameter+1))))
            status.screencolor=rgb(red,green,blue)
            ink status.screencolor,0
            box window.left, window.top, window.right, window.bottom
         else
            c$=getval(parameter$(base_parameter+1))
            if is_integer(c$)=1
               c=val(c$)
               status.screencolor=color(c)
               ink status.screencolor,0
               box window.left, window.top, window.right, window.bottom
            endif
         endif
         goto done_command
      endif
      if command$="SETHEADING" or command$="SETH"
         strg$=get_parameters$(original_command$,strg$,"N")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         status.heading=val(parameter$(base_parameter+1))
         goto done_command
      endif
      if command$="REPEAT"
         if upper$(first(strg$))="FOREVER"
            forever=1
            strg$=pop(strg$)
            strg$=get_parameters$(original_command$,strg$,"L")
         else
            strg$=get_parameters$(original_command$,strg$,"NL")
         endif
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if forever=0
            lock pixels
            for n=1 to val(parameter$(base_parameter+1))
               parse(left$(right$(parameter$(base_parameter+2),len(parameter$(base_parameter+2))-1),len(parameter$(base_parameter+2))-2))
            next n
            unlock pixels
         else
            do
               parse(left$(right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1),len(parameter$(base_parameter+1))-2))
               sync
            loop
         endif
         goto done_command
      endif
      if command$="IF"
         strg$=get_parameters$(original_command$,strg$,"BL")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if upper$(parameter$(base_parameter+1))="TRUE"
            parse(left$(right$(parameter$(base_parameter+2),len(parameter$(base_parameter+2))-1),len(parameter$(base_parameter+2))-2))
         endif
         goto done_command
      endif
      if command$="IFELSE"
         strg$=get_parameters$(original_command$,strg$,"BLL")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if upper$(parameter$(base_parameter+1))="TRUE"
            parse(left$(right$(parameter$(base_parameter+2),len(parameter$(base_parameter+2))-1),len(parameter$(base_parameter+2))-2))
         else
            parse(left$(right$(parameter$(base_parameter+3),len(parameter$(base_parameter+3))-1),len(parameter$(base_parameter+3))-2))
         endif
         goto done_command
      endif
      if command$="RUN"
         strg$=get_parameters$(original_command$,strg$,"L")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         parse(left$(right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1),len(parameter$(base_parameter+1))-2))
         goto done_command
      endif
      if command$="AND"
         strg$=get_parameters$(original_command$,strg$,"BB")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if parameter$(base_parameter+1)="TRUE" and parameter$(base_parameter+2)="TRUE" then build$="true" else build$="false"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="LIST"
         strg$=get_parameters$(original_command$,strg$,"SS")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         for n=1 to 2
            if left$(parameter$(base_parameter+n),1)=chr$(34)
               parameter$(base_parameter+n)=right$(parameter$(base_parameter+n),len(parameter$(base_parameter+n))-1)
            else
               if left$(parameter$(base_parameter+n),1)=":"
                  parameter$(base_parameter+n)=getval(parameter$(base_parameter+n))
               endif
            endif
         next n
         build$="["
         for n=1 to 1
            build$=build$+parameter$(base_parameter+1)+" "
         next n
         build$=build$+parameter$(base_parameter+n)+"]"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="OR"
         strg$=get_parameters$(original_command$,strg$,"BB")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         if parameter$(base_parameter+1)="TRUE" or parameter$(base_parameter+2)="TRUE" then build$="true" else build$="false"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="SUM"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((val(parameter$(base_parameter+1))+val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="DIFFERENCE"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((val(parameter$(base_parameter+1))-val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="PRODUCT"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((val(parameter$(base_parameter+1))*val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="QUOTIENT"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((val(parameter$(base_parameter+1))/val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="POWER"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$=str$((val(parameter$(base_parameter+1))^val(parameter$(base_parameter+2))))
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="LESS?" or command$="LESSP"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
        ` output("<"+parameter$(base_parameter+1)+">")
        ` output("<"+parameter$(base_parameter+2)+">")
         if val(parameter$(base_parameter+1))<val(parameter$(base_parameter+2)) then build$="true"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="GREATER?" or command$="GREATERP"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
         if val(parameter$(base_parameter+1))>val(parameter$(base_parameter+2)) then build$="true"
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="EQUAL?" or command$="EQUALP"
         strg$=get_parameters$(original_command$,strg$,"SS")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         build$="false"
         if parameter$(base_parameter+1)=parameter$(base_parameter+2) then build$="true"
         if build$="false"
            if getval(parameter$(base_parameter+1))=getval(parameter$(base_parameter+2)) then build$="true"
         endif
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="REMAINDER" or command$="MODULO"
         strg$=get_parameters$(original_command$,strg$,"II")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         negative=0
         if (command$="REMAINDER" and left$(parameter$(base_parameter+1),1)="-") or (command$="MODULO" and left$(parameter$(base_parameter+2),1)="-") then negative=1
         if left$(parameter$(base_parameter+1),1)="-" then parameter$(base_parameter+1)=right$(parameter$(base_parameter+1),len(parameter$(base_parameter+1))-1)
         if left$(parameter$(base_parameter+2),1)="-" then parameter$(base_parameter+2)=right$(parameter$(base_parameter+2),len(parameter$(base_parameter+2))-1)
         tempx=int(val(parameter$(base_parameter+1))/val(parameter$(base_parameter+2)))
         build$=str$(val(parameter$(base_parameter+1))-val(parameter$(base_parameter+2))*tempx)
         if negative=1 then build$="-"+build$
         if len(strg$)>0
            strg$=build$+" "+strg$
         else
            strg$=build$
         endif
         goto done_command
      endif
      if command$="SETXY"
         strg$=get_parameters$(original_command$,strg$,"NN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(parameter$(base_parameter+1))
         status.position.y=val(parameter$(base_parameter+2))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="SETXYZ"
         strg$=get_parameters$(original_command$,strg$,"NNN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         oldx#=status.position.x
         oldy#=status.position.y
         oldz#=status.position.z
         status.position.x=val(parameter$(base_parameter+1))
         status.position.y=val(parameter$(base_parameter+2))
         status.position.z=val(parameter$(base_parameter+3))
         if status.contact=1 then drawline(oldx#,oldy#,status.position.x,status.position.y)
         goto done_command
      endif
      if command$="MAKE"
         strg$=get_parameters$(original_command$,strg$,"SN")
         if error$<>"" then prepareexit(base_parameter):exitfunction strg$
         found=0
         infunction=0
         for n=0 to array count(edall$(0))
            if upper$(left$(edall$(n),2))="TO" and infunction=0
               infunction=1
            endif
            if infunction=1 and upper$(left$(edall$(n),3))="END"
               infunction=0
            endif
            if infunction=0 and upper$(left$(edall$(n),5+len(parameter$(base_parameter+1))))="MAKE "+upper$(parameter$(base_parameter+1))
               edall$(n)="Make "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2)
               found=1
               exit
            endif
         next n
         if found=0
            array insert at bottom edall$(0)
            edall$(array count(edall$(0)))="Make "+parameter$(base_parameter+1)+" "+parameter$(base_parameter+2)
         endif
         goto done_command
      endif
      if command$="TO"
         name$=first(strg$)
         build$="TO "+name$
        for n=0 to array count(edall$(0))
            if upper$(left$(edall$(n),2))="TO"
               name1$=first(pop(edall$(n)))
               if upper$(name1$)=upper$(name$)
                  while endline=0
                     if upper$(left$(edall$(n),3))="END"
                        endline=1
                     endif
                     array delete element edall$(0),n
                  endwhile
               endif
            endif
         next n
         strg$=pop(strg$)
         while len(strg$)>0
            para$=first(strg$)
            strg$=pop(strg$)
            if left$(para$,1)<>":"
               error$="NOLIKE"
               error1$=para$
               prepareexit(base_parameter):exitfunction "[]"
            else
               build$=build$+para$
            endif
         endwhile
         array insert at bottom edall$(0)
         edall$(array count(edall$(0)))=build$
         make_function=1
         is_command=1
         goto done_command
      endif
   endif
   if command$="END"
      if make_function=1
         make_function=0
         goto done_command
      endif
   endif
   if make_function=0
      `print "Looking up command ",command$
     for n=0 to array count(edall$(0))
            `print edall$(n)
         if upper$(left$(edall$(n),2))="TO"
            name$=first(pop(edall$(n)))

            if command$=upper$(name$) and is_command=0
               is_command=1
               while endline=0
                  inc n
                  if n>array count(edall$(0))
                     exit
                  endif
                  if upper$(left$(edall$(n),3))="END"
                     endline=1
                  else
                     parse(edall$(n))
                  endif
               endwhile
            endif
         endif
      next n
   endif
   if is_command=0 and make_function=0
      error$="NOTCOM"
      prepareexit(base_parameter):exitfunction original_command$
   endif
   done_command:
   prepareexit(base_parameter)
   `print "Exiting with string:[",strg$,"]"
   if make_function=1 then strg$=""
   if len(strg$)>0 then strg$=parse(strg$)
endfunction strg$

function prepareexit(b)
   while array count(parameter$(0))>b
      array delete element parameter$(0), array count(parameter$(0))
   endwhile
endfunction

function pop(strg$)
   while left$(strg$,1)=" "
      strg$=right$(strg$,len(strg$)-1)
   endwhile
   while right$(strg$,1)=" "
      strg$=left$(strg$,len(strg$)-1)
   endwhile
   if mid$(strg$,1)="+" or (mid$(strg$,1)="-" and contains_non_number(mid$(strg$,2))) or mid$(strg$,1)="*" or mid$(strg$,1)="/"
      exitfunction right$(strg$,len(strg$)-1)
   endif
   if mid$(strg$,1)="["
      char$="["
      until_close=1
      strg$=right$(strg$,len(strg$)-1)
   endif
   if mid$(strg$,1)="{" and until_close=0
      char$="{"
      until_close=1
      strg$=right$(Strg$,len(strg$)-1)
   endif
   list$=char$
   for n=1 to len(strg$)
      if mid$(strg$,n)="["
         list$=list$+"["
      else
         if mid$(strg$,n)="{"
            list$=list$+"{"
         else
            if mid$(strg$,n)="]"
               if len(list$)=0
                  output("unexpected ']'")
                  error$="1"
                  exitfunction
               else
                  if right$(list$,1)="["
                     list$=left$(list$,len(list$)-1)
                  else
                     output("unexpected ']'")
                     error$="1"
                     exitfunction
                  endif
               endif
            else
               if mid$(strg$,n)="}"
                  if len(list$)=0
                     output("unexpected '}'")
                     error$="1"
                     exitfunction
                  else
                     if right$(list$,1)="{"
                        list$=left$(list$,len(list$)-1)
                     else
                        output("unexpected '}'")
                        error$="1"
                        exitfunction
                     endif
                  endif
               endif
            endif
         endif
      endif
      if until_close=0
         if mid$(strg$,n)=" " or mid$(strg$,n)="," or mid$(strg$,n)="+" or (mid$(strg$,n)="-" and n>1) or mid$(strg$,n)="*" or mid$(strg$,n)="/"
            exitfunction right$(strg$,len(strg$)-n)
         endif
         if mid$(strg$,n)="[" or mid$(strg$,n)="]" or mid$(strg$,n)="{" or mid$(strg$,n)="}"
            exitfunction  right$(strg$,len(strg$)-n+1)
         endif
      else
         if list$=""
            exitfunction right$(strg$,len(strg$)-n)
         endif
      endif
   next n
endfunction ""

function first(strg$)
   while left$(strg$,1)=" "
      strg$=right$(strg$,len(strg$)-1)
   endwhile
   while right$(strg$,1)=" "
      strg$=left$(strg$,len(strg$)-1)
   endwhile
   error$=""
   if mid$(strg$,1)="+" or (mid$(strg$,1)="-" and contains_non_number(mid$(strg$,2))) or mid$(strg$,1)="*" or mid$(strg$,1)="/"
      exitfunction mid$(strg$,1)
   endif
   if mid$(strg$,1)="["
      char$="["
      until_close=1
      strg$=right$(Strg$,len(strg$)-1)
   else
      if mid$(strg$,1)="{" and until_close=0
         char$="{"
         until_close=1
         strg$=right$(Strg$,len(strg$)-1)
      endif
   endif
   list$=char$
   for n=1 to len(strg$)
      if mid$(strg$,n)="["
         list$=list$+"["
      else
         if mid$(strg$,n)="{"
            list$=list$+"{"
         else
            if mid$(strg$,n)="]"
               if len(list$)=0
                  output("unexpected ']'")
                  error$="1"
                  exitfunction
               else
                  if right$(list$,1)="["
                     list$=left$(list$,len(list$)-1)
                  else
                     output("unexpected ']'")
                     error$="1"
                     exitfunction
                  endif
               endif
            else
               if mid$(strg$,n)="}"
                  if len(list$)=0
                     output("unexpected '}'")
                     error$="1"
                     exitfunction
                  else
                     if right$(list$,1)="{"
                        list$=left$(list$,len(list$)-1)
                     else
                        output("unexpected '}'")
                        error$="1"
                        exitfunction
                     endif
                  endif
               endif
            endif
         endif
      endif
      if until_close=0
         if (mid$(strg$,n)=" " or mid$(strg$,n)="," or mid$(strg$,n)="+" or (mid$(strg$,n)="-" and n>1) or mid$(strg$,n)="*" or mid$(strg$,n)="/" or mid$(strg$,n)="[" or mid$(strg$,n)="]" or mid$(strg$,n)="{" or mid$(strg$,n)="}")
            exitfunction left$(strg$,n-1)
         endif
      else
         if list$=""
            exitfunction char$+left$(strg$,n)
         endif
      endif
   next n
endfunction strg$

function get_parameters$(command$,strg$,mylist$)
   if error$<>"" then exitfunction strg$
   not_enough=0
   num=0
   base_parameter=array count(parameter$(0))
   for n=1 to len(mylist$)
      if len(strg$)<1
         not_enough=1
         error$="NOTENOUGH"
         exitfunction
      endif
      array insert at bottom parameter$(0)
      ac=array count(parameter$(0))
      parameter$(ac)=first(strg$)
      `output("STRING:"+strg$)
      strg$=pop(strg$)
      com$=parameter$(ac)
      `output("STRING:"+strg$)
      if is_instruction(parameter$(ac)) or is_operator(first(strg$))
         strg$=parse(parameter$(ac)+" "+strg$)
         if error$="NOTINST" then error$=""
         if error$<>"" then exitfunction strg$
         parameter$(array count(parameter$(0)))=first(strg$)
         strg$=pop(strg$)
         if len(parameter$(array count(parameter$(0))))=0
            error$="NOOUTPUT"
            error1$=command$
            exitfunction com$
         endif
      endif
      if mid$(mylist$,n)="N" rem the instruction wants a number here
         parameter$(array count(parameter$(0)))=getval(parameter$(array count(parameter$(0))))
         if is_number(parameter$(array count(parameter$(0))))=0
            error$="NOLIKE"
            error1$=parameter$(array count(parameter$(0)))
            exitfunction command$
         endif
      endif
      if mid$(mylist$,n)="I" rem the instruction wants an integer here
         parameter$(array count(parameter$(0)))=getval(parameter$(array count(parameter$(0))))
         if is_integer(parameter$(array count(parameter$(0))))=0
            error$="NOLIKE"
            error1$=parameter$(array count(parameter$(0)))
            exitfunction command$
         endif
      endif
      if mid$(mylist$,n)="L" rem the instruction wants a list here
         if is_list(parameter$(array count(parameter$(0))))=0
            error$="NOLIKE"
            error1$=parameter$(array count(parameter$(0)))
            exitfunction command$
         endif
      endif
      if mid$(mylist$,n)="B" rem the instruction wants a list here
         if is_boolean(parameter$(array count(parameter$(0))))=0
            error$="NOLIKE"
            error1$=parameter$(array count(parameter$(0)))
            exitfunction command$
         else
            parameter$(array count(parameter$(0)))=upper$(parameter$(array count(parameter$(0))))
         endif
      endif
`      if mid$(mylist$,n)="S" rem the instruction wants a string here
`         if left$(parameter$(array count(parameter$(0))),5)="$str$"
`            parameter$(array count(parameter$(0)))=right$(parameter$(array count(parameter$(0))),len(parameter$(array count(parameter$(0))))-5)
`         endif
`      endif

   next n
endfunction strg$

function is_instruction(strg$)
   strg$=upper$(strg$)
   if left$(strg$,1)<>chr$(34) and left$(strg$,1)<>":" and left$(strg$,1)<>"[" and contains_non_number(strg$) and len(strg$)>0 and left$(strg$,1)<>"{" and left$(strg$,1)<>"(" and strg$<>"TRUE" and strg$<>"FALSE" and left$(strg$,5)<>"$STR$"
      exitfunction 1
   endif
endfunction 0

function contains_alpha(strg$)
   strg$=upper$(strg$)
   for n=1 to len(strg$)
      if mid$(strg$,n)="A" or mid$(strg$,n)="B" or mid$(strg$,n)="C" or mid$(strg$,n)="D" or mid$(strg$,n)="E" or mid$(strg$,n)="F" or mid$(strg$,n)="G" or mid$(strg$,n)="H" or mid$(strg$,n)="I" or mid$(strg$,n)="J" or mid$(strg$,n)="K" or mid$(strg$,n)="L" or mid$(strg$,n)="M" or mid$(strg$,n)="N" or mid$(strg$,n)="O" or mid$(strg$,n)="P" or mid$(strg$,n)="Q" or mid$(strg$,n)="R" or mid$(strg$,n)="S" or mid$(strg$,n)="T" or mid$(strg$,n)="U" or mid$(strg$,n)="V" or mid$(strg$,n)="W" or mid$(strg$,n)="X" or mid$(strg$,n)="Y" or mid$(strg$,n)="Z"
         exitfunction 1
      endif
   next n
endfunction 0

function contains_non_number(strg$)
   strg$=upper$(Strg$)
   for n=1 to len(strg$)
      if mid$(strg$,n)<>"0" and mid$(strg$,n)<>"1" and mid$(strg$,n)<>"2" and mid$(strg$,n)<>"3" and mid$(strg$,n)<>"4" and mid$(strg$,n)<>"5" and mid$(strg$,n)<>"6" and mid$(strg$,n)<>"7" and mid$(strg$,n)<>"8" and mid$(strg$,n)<>"9" and mid$(strg$,n)<>"." and mid$(strg$,n)<>"-"
         exitfunction 1
      endif
   next n
endfunction 0
function is_operator(strg$)
   if strg$="+" or strg$="-" or strg$="*" or strg$="/"
      exitfunction 1
   endif
endfunction 0

function clean_up(strg$)
   build$=""
   last_char=-1
   list$=""
   for n=1 to len(strg$)
      if mid$(strg$,n)="["
         list$=list$+"["
      else
         if mid$(strg$,n)="{"
            list$=list$+"{"
         else
            if mid$(strg$,n)="]"
               if len(list$)=0
                  output("unexpected ']'")
                  error$="1"
                  exitfunction
               else
                  if right$(list$,1)="["
                     list$=left$(list$,len(list$)-1)
                  else
                     output("unexpected ']'")
                     error$="1"
                     exitfunction
                  endif
               endif
            else
               if mid$(strg$,n)="}"
                  if len(list$)=0
                     output("unexpected '}'")
                     error$="1"
                     exitfunction
                  else
                     if right$(list$,1)="{"
                        list$=left$(list$,len(list$)-1)
                     else
                        output("unexpected '}'")
                        error$="1"
                        exitfunction
                     endif
                  endif
               endif
            endif
         endif
      endif
      if mid$(strg$,n)=" "
         if last_char=n-1 or instring=1
            if (mid$(strg$,n+1)<>"," and mid$(strg$,n+1)<>"+" and mid$(strg$,n+1)<>"*" and mid$(strg$,n+1)<>"/" and mid$(strg$,n+1)<>"[" and mid$(strg$,n+1)<>"]" and mid$(strg$,n-1)<>"," and mid$(strg$,n-1)<>"+"  and mid$(strg$,n-1)<>"*" and mid$(strg$,n-1)<>"/" and mid$(strg$,n-1)<>"[" and mid$(strg$,n-1)<>"]") or instring=1
               build$=build$+mid$(strg$,n)
            endif
         endif
      else
         if mid$(strg$,n)=";" or mid$(strg$,n)="`" then goto end0
         last_char=n
         build$=build$+mid$(strg$,n)
      endif
   next n
   end0:
   if right$(build$,1)=" " then build$=left$(build$,len(build$)-1)
   while len(list$)>0
      build$=build$+mirror(right$(list$,1))
      list$=left$(list$,len(list$)-1)
   endwhile
endfunction build$

function mirror(char$)
  if char$="{" then exitfunction "}"
  if char$="[" then exitfunction "]"
  if char$="(" then exitfunction ")"
endfunction char$

function output(strg$)
   if left$(strg$,1)=chr$(34) then strg$=right$(strg$,len(strg$)-1)
   ink rgb(255-rgbr(status.screencolor),255-rgbg(status.screencolor),255-rgbb(status.screencolor)),0
`   ink 0,0
   if len(strg$)>0
   print strg$
   sync
   endif
endfunction

function type0(strg$)
   if left$(strg$,1)=chr$(34) then strg$=right$(strg$,len(strg$)-1)
   ink rgb(255-rgbr(status.screencolor),255-rgbg(status.screencolor),255-rgbb(status.screencolor)),0
   if len(strg$)>0
   print strg$;
   sync
   endif
endfunction

function infixs(char$)
   if char$="*" or char$="/" or char$="+" or char$="-" or char$="=" or char$="<" or char$=">" then exitfunction 1
endfunction 0

function getval(part$)
   error$=""
   if contains_non_number(part$)
      if left$(part$,1)=":"
         found=0
         infunction=0
         name$=right$(part$,len(part$)-1)
         for n=0 to array count(edall$(0))
            if upper$(left$(edall$(n),2))="TO" and infunction=0
               infunction=1
            endif
            if infunction=1 and upper$(left$(edall$(n),3))="END"
               infunction=0
            endif
            if infunction=0 and upper$(left$(edall$(n),6+len(name$)))="MAKE "+chr$(34)+upper$(name$)
               found=1
               p$=pop(pop(edall$(n)))
               exitfunction p$
            endif
         next n
         if found=0
            output(name$+" has no value")
            error$="UNDEF"
            exitfunction strg$
         endif
      else
         if left$(part$,1)=chr$(34)
            strg$=right$(part$,len(part$)-1)
            exitfunction strg$
         endif
      endif
   endif
endfunction part$

function is_integer(num$)
   if left$(num$,1)="-" then num$=right$(num$,len(num$)-1)
   for n=1 to len(num$)
      isint=0
      if mid$(num$,n)="0" or val(mid$(num$,n))>0 then isint=1
      if isint=0 then exitfunction 0
   next n
endfunction 1

function is_number(num$)
   if left$(num$,1)="-" then num$=right$(num$,len(num$)-1)
   if val(num$)>0 then exitfunction 1
   for n=1 to len(num$)
      isnum=0
      if mid$(num$,n)="0" or val(mid$(num$,n))>0 or mid$(num$,n)="." then isnum=1
      if isnum=0 then exitfunction 0
   next n
endfunction 1

function is_boolean(strg$)
   strg$=upper$(strg$)
   if strg$="TRUE" or strg$="FALSE" then exitfunction 1
endfunction 0

function is_list(strg$)
   if left$(strg$,1)="[" then exitfunction 1
endfunction 0

function is_array(strg$)
   if left$(strg$,1)="{" then exitfunction 1
endfunction 0

function drawline(x#,y#,x1#,y1#)
   if status.penmode="paint"
      ink status.pencolor,0
   endif
   if status.penmode="erase"
      ink status.screencolor,0
   endif
   line screen width()/2+x#,screen height()/2-y#,screen width()/2+x1#,screen height()/2-y1#
endfunction

function log(nr#, base#,acc)

   result# = 0.00

   for c = 0 to acc
      repeat
         inc result#, base#^(c*-1)
      until base#^result# >= nr#
      if base#^result# = nr#
         exitfunction result#
      else
         dec result#, base#^(c*-1)
      endif
   next c

endfunction result#

LogoData:
rem I used several setpos commands to spread out all the shapes (for less overlap)
rem red ink black background
data "run [setpencolor [255 0 0] setscreencolor 0]"
rem data "repeat 120 [type random 10]"
data "`Square"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data "forward 100"
data "right 90"
data ""
data "pu setpos [-30 0] pd"
data ""
data "`Multiple commands per line - Triangle"
data "fd 100 lt 120 fd 100 lt 120 fd 100 lt 120"
data ""
data "pu setpos [0 0] pd"
data ""
data "`Circle"
data "Repeat 360 [ fd 1 rt 1 ]"
data ""
data "pu setpos [320 -200] pd"
data ""
data "`Repeat instructions - Hexagon"
data "repeat 6 [forward 100 right 60]"
data ""
data "pu setpos [300 0] pd"
data ""
data "`Pen Up/Down - Dashed Line"
data "repeat 4 [pendown forward 20 penup forward 20]"
data ""
data "pu setpos [200 -50] pd"
data ""
data "`Nested repeat functions - Dashed Octagon"
data "repeat 8[repeat 4[pd fd 20 pu fd 20] pd fd 20 lt 45]"
data ""
data "pu setpos [0 0] pd"
data ""
data "to pentagon"
data "repeat 5 [forward 100 left 72]"
data "end"
data "pentagon"
data ""
data "pu setpos [-280 -200] pd"
data ""
data "`Geometric Shape#1"
data "TO NestRep"
data "REPEAT 8 [REPEAT 8 [ FD 50 RT 45 ] RT 45]"
data "END"
data "`I added this to show that you can define and manipulate variables."
data "TO spiral"
data "make "x 10 repeat 225 [make "x sum :x 2 fd 6 rt quotient 720 :x]"
data "END"
data "pu setxy -240 150 pd spiral"
data "NestRep"
data "`Spirograph#1"
data "REPEAT 36 [ REPEAT 180 [ FD 2 RT 2 ] RT 10 ]"
data ""
data "pu setxy 280 200 pd"
data ""
data "`Snowflake"
data "REPEAT 6 [ REPEAT 360 [ FD 100 RT 100 ] RT 60 ]"
data "setpencolor 2 pu setpos mousepos pd repeat forever [ifelse less? distance mousepos 300[setheading 0 right towards mousepos] [right difference random 21 10] fd 3]"

Data Structure Commands
   Data Structure Constructors
      Word word word
      List thing thing
      Sentence thing thing

   Data Structure Selectors
      First thing
      ButFirst thing
      Last thing
      ButLast thing

   Data Structure Predicates
      Word? thing
      List? thing
      Array? thing
      Empty? thing
      Equal? thing thing

   Data Structure Queries
      Char number
      Lowercase word
      Uppercase word

Communication
   Transmitters
      Print string
      Type string
      Show string

   Keyboard and Mouse Access
      MousePos

Arithmetic
   Numeric Operations
      Sum number number
      Difference number number
      Product number number
      Quotient number number
      Remainder integer integer
      Modulo integer integer
      Int number
      Round number
      Abs number
      Sign number
      Sqrt number
      Minus number
      Power number number
      Exp number
      Log10 number
      Ln number
      PI
      Tan number
      Sin number
      Cos number
      Arctan number
      Arcsin number
      Arccos number

   Arithmetic Predicates
      Less? number number
      Greater? number number

   Random Numbers
      Random integer

Logical Operations
   And boolean boolean
   Or boolean boolean
   Not boolean

Graphics
   Turtle Motion
      Forward number, FD number
      Back number, BK number
      Left number, LT number
      Right number, RT number
      SetPos list
      SetPosXYZ list
      SetXY number number
      SetXYZ number number number
      SetX number
      SetY number
      SetZ number
      Home
      SetHeading number, SetH number

   Turtle Motion Queries
      Pos
      PosXYZ
      XCor
      YCor
      ZCor
      Heading
      Towards
      Distance

   Turtle and Window Control
      Clean
      Clearscreen, CS

   Pen Control
      PenDown, PD
      PenUp, PU
      PenPaint, PPT
      PenErase, PE
      PenNormal
      SetPenColor, SETPC
      SetFloodColor, SETFC
      SetScreenColor, SETSC

   Pen Queries
      PenDown?
      PenMode
      PenColor
      FloodColor
      ScreenColor

Workspace Management
   Procedure Definition
      To string
      End

   Variable Definition
      Make varname value
      Name value varname
      Thing varname

Control Structures
   Control Commands
      Run
      Repeat
      If
      Ifelse
      True
      False
      Wait number
      Bye

LOWER LOGIC!

Your entry was amazing!
You were the only entry that included my data statements, turtle graphics code.
Your LOGO program also rendered all of my 2D turtle graphics code, the only one that could.
You also added a wealth of other commands, making yours the clear winner!
Well Done!