Sorry your browser is not supported!

sync on

input "Enter text: ",text$

sleep 500

set text font getfont()

sleep 500

input "Enter text size: ",Tsize
set text size Tsize

sleep 500

colour=getcolour()
ink colour,0

cls

text 0,0,text$

xsize=text width(text$)
ysize=text height(text$)

dim image(xsize,ysize)

set text transparent
set text font "system"
set text size 10

for x=1 to xsize
	for y=1 to ysize
		image(x,y)=point(x,y)
		count1=count1+1
		ink rgb(0,0,0),0
		box 520,1,639,15
		ink rgb(255,0,0),0
		temp#=count1/(xsize*ysize)
		text 520,0,str$(count1)+"/"+str$(xsize*ysize)+" pixels"
		sync
	next y
next i

backdrop on
color backdrop rgb(255-rgbr(colour),255-rgbg(colour),255-rgbb(colour))

make object cube 1,0.1
make mesh from object 1,1

for x=1 to xsize
	for y=1 to ysize
		if image(x,y)>0
			count=count+1
			add limb 1,count,1
			scale limb 1,count,10000,10000,10000
			offset limb 1,count,((xsize-x)-(xsize/2))*10,((ysize-y)-(ysize/2))*10,0
			color limb 1,count,image(x,y)
		endif
	next y
next x

position camera 0,0,0-ysize*50

do
	yrotate object 1,wrapvalue(object angle y(1)+1)
	if mouseclick()=1
		move camera 0-mousemovey()
	endif
	sync
loop

function getfont()

	perform checklist for fonts

	font=1
	list=1
	select=1

	while returnkey()=0

		cls

		if upkey()=1 and font>1
			if upK=0
				upK=1
				font=font-1
				if select=1 and list>1 then list=list-1
				if select>1 then select=select-1
				Ucount=40
			endif
			Ucount=Ucount-1
			if Ucount<0
				font=font-1
				if select=1 and list>1 then list=list-1
				if select>1 then select=select-1
				Ucount=2
			endif
		else
			upK=0
		endif

		if downkey()=1 and font<checklist quantity()
			if dnK=0
				dnK=1
				font=font+1
				if select=10 and list<checklist quantity() then list=list+1
				if select<10 then select=select+1
				Dcount=40
			endif
			Dcount=Dcount-1
			if Dcount<0
				font=font+1
				if select=10 and list<checklist quantity() then list=list+1
				if select<10 then select=select+1
				Dcount=2
			endif
		else
			dnK=0
		endif

		set text font "system"
		for i=1 to 10
			if select=i
				ink rgb(0,0,255),0
				box 10,i*15+20,210,(i+1)*15+20
			endif
			ink rgb(255,255,255),0
			set text font checklist string$(list+i-1)
			text 10,i*15+20,checklist string$(list+i-1)
		next i

		ink 0,0
		box 210,35,250,185

		ink rgb(255,255,255),0
		linebox(9,34,211,186)

		sync

	endwhile

	cls

endfunction checklist string$(font)

function getcolour()

	while returnkey()=0
	
		cls

		for bx=1 to 255 step 4
			for by=1 to 255 step 4
				ink rgb(r,bx,by),0
				dot bx/4+10,by/4+10
			next by
		next bx
		ink rgb(255,255,255),0
		linebox(9,9,74,74)

		for i=1 to 255 step 4
			ink rgb(i,0,0),0
			line i/4+10,85,i/4+10,95
		next i
		ink rgb(255,255,255),0
		linebox(9,84,74,96)

		ink rgb(155,155,155),0
		linebox(r/4+10-2,83,r/4+10+2,97)

		ink rgb(r,g,b),0
		box 10,105,40,125
		ink rgb(255,255,255),0
		linebox(9,104,41,126)
		ink rgb(rpoint,gpoint,bpoint),0
		box 44,105,74,125
		ink rgb(255,255,255),0
		linebox(44,104,75,126)

		if mousewithin(10,85,73,95)=1 and mouseclick()=1 then r=(mousex()-10)*4

		if mousewithin(10,10,(255/4)+10,(255/4)+10)=1
			if mouseclick()=1
				temp=point(mousex(),mousey())
				g=rgbg(temp)
				b=rgbb(temp)
			endif
			temp=point(mousex(),mousey())
			rpoint=r
			gpoint=rgbg(temp)
			bpoint=rgbb(temp)
		endif

		sync

	endwhile

endfunction rgb(r,g,b)

function linebox(x1,y1,x2,y2)

	line x1,y1,x1,y2
	line x1,y2,x2,y2
	line x2,y2,x2,y1
	line x2,y1,x1,y1

endfunction

function mousewithin(x1,y1,x2,y2)
  if mousex()>x1 and mousex()<x2 and mousey()>y1 and mousey()<y2 then exitfunction 1
endfunction 0

Rem Text In 3D Hard Version by TDK_Man Feb 2007

Text 0,0,"Note: Program Takes A Few Seconds To Initialise..."
Text 0,28,"Please Press A Key To Start"
Wait Key

Gosub ScreenSetup
TextString$ = "Shaded 3D Text!":Rem <<<<< Change this to whatever
Gosub Decode

Do
  Gosub RotateCamera
  Sync
Loop
End

ScreenSetup:
  Set Display Mode 800,600,16
  Sync On: Sync Rate 0: CLS 0
  AutoCam Off
  BackDrop On: Color Backdrop 0
  Set Text Font "Verdana"
  Set Text Size 16
  Ink RGB(255,255,255),0
  Hide Mouse
Return

Decode:
  Create Bitmap 1,320,200
  TH=Text Height("A")
  Ob=1: Kern=0
  For I = 1 To Len(TextString$)
    ThisChar$=Mid$(TextString$,I)
    CLS: Text 0,0,ThisChar$
    TW=Text Width(ThisChar$)
    For Ny = 0 To TH-1
      For Nx = 0 To TW-1
        C = Point(Nx,Ny)
        If C <> 0
          Make Object Sphere Ob,1.5
          Color Object Ob, RGB(0,Ny*16,0)
          Position Object Ob,(Nx*.8)+Kern,0-(Ny*.8),0
        Endif
        Inc Ob
      Next Nx
    Next Ny
    Inc Kern,TW
    Sync
  Next I
  Set Current Bitmap 0
  Delete Bitmap 1
  Position Camera Text Width(TextString$)/2,5,0-Text Width(TextString$)*1.5
  Point Camera Text Width(TextString$)/2,0,0
Return

RotateCamera:
  X# = WrapValue(X# + 1.0)
  Z# = WrapValue(Z# + 1.0)
  Position Camera NewXValue(0,X#,Text Width(TextString$)*1.5),0.0,NewZValue(0,Z#,Text Width(TextString$)*1.5)
  Point Camera Text Width(TextString$)/2,0,0
Return

remstart
   ==============================================================
   =  Title  : matrix letters
   =  Author : Latch Grapple
   =  Date   : 02/18/2007
   =  Update :
   =  Version:
   ==============================================================
   Comments
   ==============================================================
remend


   autocam off
   set display mode 800,600,32
   hide mouse
   sync on
   sync rate 60
   gosub _init
   do
      text 0,0,"Press Y to enter some text"
      if keystate(21)=1
         wait 100
         cls
         gosub _enter_text
      endif
      gosub _move_camera
      sync
   loop
   end
   _enter_text:
      backdrop off
      for n=1 to mat
         if matrix exist(n) then delete matrix n
         if matrix exist(n+300) then delete matrix n+300
      next n
      oldmatx=0
      set text font "arial"
      set text size 20
      input "Enter some text    :";string$
      backdrop on
      for n = 1 to len(string$)
         letter$=mid$(string$,n)
         tilex=text width(letter$)
         tilez=text height(letter$)
         matx=tilex*10
         matz=tilez*10
         mat=avail_mat(n)
         posx=matx+oldmatx
         make matrix mat,matx,matz,tilex,tilez
         position matrix mat,oldmatx,0,0
         oldmatx=posx
         gosub _save_bitmap
         gosub _handle_bitmap
      next n
      position camera 200,200,-100
      xrotate camera 45
   return
   _init:
      dim letter$(255)
      position camera 100,200,-100
      xrotate camera 45
   return
   _save_bitmap:
      create bitmap 1,tilex+1,tilez+1
      text 0,0,letter$
      save bitmap "zzz_hello.bmp",1
      delete bitmap 1
      fsize=file size("zzz_hello.bmp")
      bmapsize=fsize-53-1
      pad1=3*(tilex+1)*(tilez+1)
      pad2=bmapsize-pad1
      padding=pad2/(tilez+1)
   return
   _handle_bitmap:
      open to read 1,"zzz_hello.bmp"
      for skip = 1 to 53
         read byte 1,a
      next skip
      for z=0 to tilez
         for x=0 to tilex
            read byte 1,b
            read byte 1,g
            read byte 1,r
            a=rgb(r,g,b)
            if a <> 0
               set matrix height mat,x,z,20
            endif
         next x
         for pad=1 to padding
            read byte 1,skip
         next pad
      next z
      update matrix mat
      close file 1
   return
   _move_camera:
      camangy#=wrapvalue(camera angle y()+mousemovex())
      camangx#=wrapvalue(camera angle x()+mousemovey())
      rotate camera camangx#,camangy#,0
      if mouseclick()=1
         move camera +5
      endif
      if mouseclick()=2
         move camera -5
      endif
   return
   function avail_mat(num)
      while matrix exist(num)=1
         inc num
      endwhile
   endfunction num

TDK

Well made in such small code-Latch

remstart
   ==============================================================
   =  Title  : Maze Challenge
   =  Author : latch
   =  Date   : 2/19/2007
   =  Update : 02/20/2007
   =  Version:
   ==============================================================
   Comments: Create AI to get through maze and move cones to other side
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,16
   sync on
   sync rate 40

   gosub _init

rem =============================================================
rem = MAIN
rem =============================================================
   _main:
   do


      rem can't change these ************
      gosub _move_robot
      `gosub _move_friends
      gosub _timer
      text 0,0,str$(screen fps() )
      rem *******************************

      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      gosub _plot_maze
      gosub _karol_the_robot

      rem camera vars
      camx#=matx/2
      camy#=300
      camz#=-100

      position camera camx#,camy#,camz#
      point camera camx#,0,matz/2

      rem timer variables
      timestart=0

      repeat
         center text screen width()/2,0,"Press CONTROL key to begin"
         rem wait here for control key
         sync
      until controlkey()=1

   return

`----------------------------------------------------------------
   _plot_maze:
      rem maze variables
      mazex=11
      mazez=10
      dim grid(mazex,mazez)
      rem read coordinates into an array
      for z=1 to mazez
         for x=1 to mazex
            read grid(x,z)
         next x
      next z
      restore

      matx=mazex*25
      matz=mazez*25
      across=0
      up=0
      obj=0
      size=mazez*mazex

      rem make matrix as a floor
      make matrix 1,matx,matz,mazex,mazez

      rem draw walls x direction
      x=0
      for z= 1 to mazez
         repeat
            inc x
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallx,25
            else
               if obflag=1
                  inc obj
                  make object box obj,wallx,25,25
                  position object obj,(x*25)-(wallx/2)-25,12.5,((z-1)*25)+12.5
                  wallx=0
                  obflag=0
               endif
            endif
         until x = mazex
         if obflag=1
            inc obj
            make object box obj,wallx,25,25
            position object obj,(x*25)-(wallx/2),12.5,((z-1)*25)+12.5
            wallx=0
            obflag=0
            x=0
         endif
      next z

      rem draw walls z direction
      z=0
      for x= 1 to 11
         repeat
            inc z
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallz,25
            else
               if obflag=1
                  inc obj
                  make object box obj,25,25,wallz
                  position object obj,((x-1)*25)+12.5,12.5,(((z-1)*25)-(wallz/2))
                  wallz=0
                  obflag=0
               endif
            endif
         until z =mazez
         if obflag=1
            inc obj
            make object box obj,25,25,wallz
            position object obj,((x-1)*25)+12.5,12.5,(z*25)-(wallz/2)
            wallz=0
            obflag=0
            z=0
         else
            wallz=0
            obflag=0
            z=0
         endif
      next x

      rem cleanup individual box items and set collision for remaining objects (walls)
      for n=1 to obj
         set object collision to boxes n
         if object size z(n)=25 and object size x(n)=25
            delete object n
         endif
      next n


   return
`----------------------------------------------------------------
   _karol_the_robot:
      robot=avail_obj(1)
      dim friend(3)

      rem create robot
      make object cone robot,10
      set object collision to boxes robot
      position object robot,0,5,-20
      color object robot,rgb(0,255,0)
      xrotate object robot,90
      fix object pivot robot
      turn object right robot,90

      rem create robot friends
      for n=1 to 3
         friend(n)=avail_obj(1)
         make object cone friend(n),16
         position object friend(n),n*70,8,130+matz
         color object friend(n),rgb(n*50,n*50,n*50)
         set object collision to boxes friend(n)
      next n

      rem create target
      make matrix 2,75,25,3,1
      position matrix 2,210,0,-50

   return
`----------------------------------------------------------------
   _collision_with_walls:
      rem check for wall collision
      bang=object collision(robot,0)
      if bang = friend(1) or bang = friend(2) or bang = friend(3) or bang=0
         rem do nothing
      else
         turn object left robot,180
      endif
   return
`----------------------------------------------------------------
   _move_robot:
      move object robot,2
      gosub _collision_with_walls
   return
`----------------------------------------------------------------
   _timer:

      if timestart=0
         thetimer=timer()
         timestart=1
      endif
      if timestart=1
         current_time=timer()-thetimer
         text 0,20,str$(current_time)
      endif

      rem find out if friends have been moved to the end matrix
      f1_x#=object position x(friend(1))
      f1_z#=object position z(friend(1))
      f2_x#=object position x(friend(2))
      f2_z#=object position z(friend(2))
      f3_x#=object position x(friend(3))
      f3_z#=object position z(friend(3))

      if f1_x# > 209 and f1_x# < 210+25 and f1_z# >-51 and f1_z# < -50+25
         goal_1=1
      else
         goal_1=0
      endif
      if f2_x# > 209+25 and f2_x# < 210+50 and f2_z# >-51 and f2_z# < -50+25
         goal_2=1
      else
         goal_2=0
      endif
      if f3_x# > 209+50 and f3_x# < 210+75 and f3_z# >-51 and f3_z# < -50+25
         goal_3=1
      else
         goal_3=0
      endif

      finalgoal=goal_1+goal_2+goal_3

      if finalgoal=3
         set text size 100
         set text opaque
         repeat
            center text screen width()/2,screen height()/2,"DONE! Time: "+str$(current_time)
            sync
         until scancode()>0
         end
      endif

   return
`----------------------------------------------------------------
   _move_friends:
      if current_time >= 6*1000
         for n = 1 to 3
            position object friend(n),210+((n*25)-12.5),object position y(friend(n)),-37.5
         next n
      endif
   return

rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function avail_obj(num)
      while object exist(num)=1
         inc num
      endwhile
   endfunction num

rem =============================================================
rem = DATA STATEMENTS
rem =============================================================

   data 1,1,0,1,1,1,1,1,1,1,1
   data 1,0,0,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,1,0,0,1
   data 1,0,0,0,1,0,0,0,0,0,1
   data 1,1,1,0,1,0,1,0,1,1,1
   data 1,0,1,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,0,1,0,1
   data 1,0,0,0,0,0,1,0,1,0,1
   data 1,0,0,1,0,0,0,0,1,0,1
   data 1,1,0,1,1,1,1,1,1,0,1

      rem timer variables
      timestart=0

      repeat
         center text screen width()/2,0,"Press CONTROL key to begin"
         rem wait here for control key
         sync
      until controlkey()=1

remstart
   ==============================================================
   =  Title  : Maze Challenge
   =  Author : latch
   =  Date   : 2/19/2007
   =  Update : 02/20/2007
   =  Version:
   ==============================================================
   Comments: Create AI to get through maze and move cones to other side
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,16
   sync on
   sync rate 40

   gosub _init

rem =============================================================
rem = MAIN
rem =============================================================
   _main:
   do


      rem can't change these ************
      gosub _move_robot
      `gosub _move_friends
      gosub _timer
      text 0,0,str$(screen fps() )
      rem *******************************

      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      gosub _plot_maze
      gosub _karol_the_robot

      rem camera vars
      camx#=matx/2
      camy#=300
      camz#=-100

      position camera camx#,camy#,camz#
      point camera camx#,0,matz/2

      rem timer variables
      timestart=0

      repeat
         center text screen width()/2,0,"Press CONTROL key to begin"
         rem wait here for control key
         sync
      until controlkey()=1

   return

`----------------------------------------------------------------
   _plot_maze:
      rem maze variables
      mazex=11
      mazez=10
      dim grid(mazex,mazez)
      rem read coordinates into an array
      for z=1 to mazez
         for x=1 to mazex
            read grid(x,z)
         next x
      next z
      restore

      matx=mazex*25
      matz=mazez*25
      across=0
      up=0
      obj=0
      size=mazez*mazex

      rem make matrix as a floor
      make matrix 1,matx,matz,mazex,mazez

      rem draw walls x direction
      x=0
      for z= 1 to mazez
         repeat
            inc x
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallx,25
            else
               if obflag=1
                  inc obj
                  make object box obj,wallx,25,25
                  position object obj,(x*25)-(wallx/2)-25,12.5,((z-1)*25)+12.5
                  wallx=0
                  obflag=0
               endif
            endif
         until x = mazex
         if obflag=1
            inc obj
            make object box obj,wallx,25,25
            position object obj,(x*25)-(wallx/2),12.5,((z-1)*25)+12.5
            wallx=0
            obflag=0
            x=0
         endif
      next z

      rem draw walls z direction
      z=0
      for x= 1 to 11
         repeat
            inc z
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallz,25
            else
               if obflag=1
                  inc obj
                  make object box obj,25,25,wallz
                  position object obj,((x-1)*25)+12.5,12.5,(((z-1)*25)-(wallz/2))
                  wallz=0
                  obflag=0
               endif
            endif
         until z =mazez
         if obflag=1
            inc obj
            make object box obj,25,25,wallz
            position object obj,((x-1)*25)+12.5,12.5,(z*25)-(wallz/2)
            wallz=0
            obflag=0
            z=0
         else
            wallz=0
            obflag=0
            z=0
         endif
      next x

      rem cleanup individual box items and set collision for remaining objects (walls)
      for n=1 to obj
         set object collision to boxes n
         if object size z(n)=25 and object size x(n)=25
            delete object n
         endif
      next n


   return
`----------------------------------------------------------------
   _karol_the_robot:
      robot=avail_obj(1)
      dim friend(3)

      rem create robot
      make object cone robot,10
      set object collision to boxes robot
      position object robot,0,5,-20
      color object robot,rgb(0,255,0)
      xrotate object robot,90
      fix object pivot robot
      turn object right robot,90

      rem create robot friends
      for n=1 to 3
         friend(n)=avail_obj(1)
         make object cone friend(n),16
         position object friend(n),n*70,8,130+matz
         color object friend(n),rgb(n*50,n*50,n*50)
         set object collision to boxes friend(n)
      next n

      rem create target
      make matrix 2,75,25,3,1
      position matrix 2,210,0,-50

   return
`----------------------------------------------------------------
   _collision_with_walls:
      rem check for wall collision
      bang=object collision(robot,0)
      if bang = friend(1) or bang = friend(2) or bang = friend(3) or bang=0
         rem do nothing
      else
         turn object left robot,180
      endif
   return
`----------------------------------------------------------------
   _move_robot:
      move object robot,2
      gosub _collision_with_walls
   return
`----------------------------------------------------------------
   _timer:

      if timestart=0
         thetimer=timer()
         timestart=1
      endif
      if timestart=1
         current_time=timer()-thetimer
         text 0,20,str$(current_time)
      endif

      rem find out if friends have been moved to the end matrix
      f1_x#=object position x(friend(1))
      f1_z#=object position z(friend(1))
      f2_x#=object position x(friend(2))
      f2_z#=object position z(friend(2))
      f3_x#=object position x(friend(3))
      f3_z#=object position z(friend(3))

      if f1_x# > 209 and f1_x# < 210+25 and f1_z# >-51 and f1_z# < -50+25
         goal_1=1
      else
         goal_1=0
      endif
      if f2_x# > 209+25 and f2_x# < 210+50 and f2_z# >-51 and f2_z# < -50+25
         goal_2=1
      else
         goal_2=0
      endif
      if f3_x# > 209+50 and f3_x# < 210+75 and f3_z# >-51 and f3_z# < -50+25
         goal_3=1
      else
         goal_3=0
      endif

      finalgoal=goal_1+goal_2+goal_3

      if finalgoal=3
         set text size 100
         set text opaque
         repeat
            center text screen width()/2,screen height()/2,"DONE! Time: "+str$(current_time)
            sync
         until scancode()>0
         end
      endif

   return
`----------------------------------------------------------------
   _move_friends:
      if current_time >= 6*1000
         for n = 1 to 3
            position object friend(n),210+((n*25)-12.5),object position y(friend(n)),-37.5
         next n
      endif
   return

rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function avail_obj(num)
      while object exist(num)=1
         inc num
      endwhile
   endfunction num

rem =============================================================
rem = DATA STATEMENTS
rem =============================================================

   data 1,1,0,1,1,1,1,1,1,1,1
   data 1,0,0,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,1,0,0,1
   data 1,0,0,0,1,0,0,0,0,0,1
   data 1,1,1,0,1,0,1,0,1,1,1
   data 1,0,1,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,0,1,0,1
   data 1,0,0,0,0,0,1,0,1,0,1
   data 1,0,0,1,0,0,0,0,1,0,1
   data 1,1,0,1,1,1,1,1,1,0,1

 
objang=object angle y(obj)
point object obj,object position x(unit),0,object position z(unit)
destang=object angle y(obj)
rotate object obj,0,objang,0

POINT OBJECT robot,OBJECT POSITION X(BLOCK),OBJECT POSITION Y(robot),OBJECT POSITION Z(BLOCK)

test = object collision(1,0)
if test = friend(1) or test = friend(2) or test = friend(3) or test =0
rem do friend or empty space stuff
else
change direction of object (i.e. rotate object or turn object)
and then keep moving until hit something else.

rotate object
xrotate object
yrotate object
zrotate object

turn object left
turn object right

remstart
   ==============================================================
   =  Title  : Maze Challenge
   =  Author : latch
   =  Date   : 2/19/2007
   =  Update : 02/20/2007
   =  Version:
   ==============================================================
   Comments: Create AI to get through maze and move cones to other side
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,16
   sync on
   sync rate 0

   gosub _init

rem =============================================================
rem = MAIN
rem =============================================================
   _main:
   do

      rem can't change these ************
      gosub _move_robot
      `gosub _move_friends
      gosub _timer
      text 0,0,str$(screen fps() )
      rem *******************************

      gosub _teach_robot
      gosub _collect_friends
      gosub _deposit_friends


      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      gosub _plot_maze
      gosub _karol_the_robot

      rem camera vars
      camx#=matx/2
      camy#=300
      camz#=-100

      position camera camx#,camy#,camz#
      point camera camx#,0,matz/2

      rem timer variables
      timestart=0

      rem flags for completed robot actions
      f1_flag=0
      f2_flag=0
      f3_flag=0
      l_count=0
      s_count=0
      up_flag=1
      fnum=0

      repeat
         center text screen width()/2,0,"Press CONTROL key to begin"
         rem wait here for control key
         sync
      until controlkey()=1

      hide mouse

   return

`----------------------------------------------------------------
   _plot_maze:
      rem maze variables
      mazex=11
      mazez=10
      dim grid(mazex,mazez)
      rem read coordinates into an array
      for z=1 to mazez
         for x=1 to mazex
            read grid(x,z)
         next x
      next z
      restore

      matx=mazex*25
      matz=mazez*25
      across=0
      up=0
      obj=0
      size=mazez*mazex

      rem make matrix as a floor
      make matrix 1,matx,matz,mazex,mazez

      rem draw walls x direction
      x=0
      for z= 1 to mazez
         repeat
            inc x
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallx,25
            else
               if obflag=1
                  inc obj
                  make object box obj,wallx,25,25
                  position object obj,(x*25)-(wallx/2)-25,12.5,((z-1)*25)+12.5
                  wallx=0
                  obflag=0
               endif
            endif
         until x = mazex
         if obflag=1
            inc obj
            make object box obj,wallx,25,25
            position object obj,(x*25)-(wallx/2),12.5,((z-1)*25)+12.5
            wallx=0
            obflag=0
            x=0
         endif
      next z

      rem draw walls z direction
      z=0
      for x= 1 to 11
         repeat
            inc z
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallz,25
            else
               if obflag=1
                  inc obj
                  make object box obj,25,25,wallz
                  position object obj,((x-1)*25)+12.5,12.5,(((z-1)*25)-(wallz/2))
                  wallz=0
                  obflag=0
               endif
            endif
         until z =mazez
         if obflag=1
            inc obj
            make object box obj,25,25,wallz
            position object obj,((x-1)*25)+12.5,12.5,(z*25)-(wallz/2)
            wallz=0
            obflag=0
            z=0
         else
            wallz=0
            obflag=0
            z=0
         endif
      next x

      rem cleanup individual box items and set collision for remaining objects (walls)
      for n=1 to obj
         set object collision to boxes n
         if object size z(n)=25 and object size x(n)=25
            delete object n
         endif
      next n


   return
`----------------------------------------------------------------
   _karol_the_robot:
      robot=avail_obj(1)
      dim friend(3)

      rem create robot
      make object cone robot,10
      set object collision to boxes robot
      position object robot,0,5,-20
      color object robot,rgb(0,255,0)
      xrotate object robot,90
      fix object pivot robot
      turn object right robot,90

      rem create robot friends
      for n=1 to 3
         friend(n)=avail_obj(1)
         make object cone friend(n),16
         position object friend(n),n*70,8,130+matz
         color object friend(n),rgb(n*50,n*50,n*50)
         set object collision to boxes friend(n)
      next n

      rem create target
      make matrix 2,75,25,3,1
      position matrix 2,210,0,-50

   return
`----------------------------------------------------------------
   _collision_with_walls:
      rem check for wall collision
      bang=object collision(robot,0)
      if bang = friend(1) or bang = friend(2) or bang = friend(3) or bang=0
         rem do nothing
      else
         turn object left robot,180
      endif
   return
`----------------------------------------------------------------
   _move_robot:
      move object robot,2
      gosub _collision_with_walls
   return
`----------------------------------------------------------------
   _timer:

      if timestart=0
         thetimer=timer()
         timestart=1
      endif
      if timestart=1
         current_time=timer()-thetimer
         text 0,20,str$(current_time)
      endif

      rem find out if friends have been moved to the end matrix
      f1_x#=object position x(friend(1))
      f1_z#=object position z(friend(1))
      f2_x#=object position x(friend(2))
      f2_z#=object position z(friend(2))
      f3_x#=object position x(friend(3))
      f3_z#=object position z(friend(3))

      if f1_x# > 209 and f1_x# < 210+25 and f1_z# >-51 and f1_z# < -50+25
         goal_1=1
      else
         goal_1=0
      endif
      if f2_x# > 209+25 and f2_x# < 210+50 and f2_z# >-51 and f2_z# < -50+25
         goal_2=1
      else
         goal_2=0
      endif
      if f3_x# > 209+50 and f3_x# < 210+75 and f3_z# >-51 and f3_z# < -50+25
         goal_3=1
      else
         goal_3=0
      endif

      finalgoal=goal_1+goal_2+goal_3

      if finalgoal=3
         set text size 100
         set text opaque
         repeat
            center text screen width()/2,screen height()/2,"DONE! Time: "+str$(current_time)
            sync
         until scancode()>0
         end
      endif

   return
`----------------------------------------------------------------
   _move_friends:
      if current_time >= 6*1000
         for n = 1 to 3
            position object friend(n),210+((n*25)-12.5),object position y(friend(n)),-37.5
         next n
      endif
   return
`----------------------------------------------------------------
   _teach_robot:
      rem get top and bottom of maze
      top=matz
      bottom=0

      rem current robot position
      rx#=object position x(robot)
      rz#=object position z(robot)

      rem test if robot is below maze and is starting or delivered a friend
      if up_flag=1 and rz# <= bottom
         if object angle y(robot) <> 0
            gosub _move_robot
            turn object left robot,90
         endif
      endif

      rem straighten robot out in maze
      if up_flag=0 and rz#=top then yrotate object robot,180

      rem test distance robot has traveled between wall collisions
      span#=sqrt((rx#-oldx#)^2+(rz#-oldz#)^2)

      rem get old position bewteen turns
      rem use bang from collision test
      if bang = friend(1) or bang = friend(2) or bang = friend(3) or bang=0
         rem do nothing
      else
         if span# >=25
            gosub _move_robot
            turn object left robot,270
            inc l_count
            pass=0
         else
            inc s_count
            l_count=0
         endif

         rem is robot going in a circle
         if l_count = 5
            gosub _move_robot
            turn object right robot,90
            l_count=0
            s_count=0
         endif

         rem turn if cornered
         if s_count >= 3
            `gosub _move_robot
            turn object right robot,90
            inc pass
            if pass > 4
               xfact=round_whole(rx#/25)
               zfact=round_whole(rz#/25)
               xgrid#=(xfact*25.0)-12.5
               zgrid#=(zfact*25.0)-12.5
               position object robot,xgrid#,object position y(robot),zgrid#
               pass = 0
            endif
            s_count=0
         endif

         oldx#=object position x(robot)
         oldz#=object position z(robot)
      endif

      rem has the robot reached the bottom opening?
      if up_flag=0 and object angle y(robot) <> 0
         if rx#> 55 and rx# < 70 and rz# > 25 and rz# <50
            yrotate object robot,0
         endif
      endif

   return
`----------------------------------------------------------------
   _collect_friends:
      rem has robot reached the top and is still going up?
      rem then go grab a friend
      if rz# >= top and up_flag=1
         if f1_flag=0 and f2_flag=0 and f3_flag=0
            point object robot,f1_x#,object position y(robot),f1_z#
            if bang=friend(1)
               glue object to limb friend(1),robot,0
               point object robot,62.5,object position y(robot),top
               turn object left robot,180
               up_flag=0
               fnum=1
            endif
         endif
         if f1_flag=1 and f2_flag=0 and f3_flag=0
            point object robot,f2_x#,object position y(robot),f2_z#
            if bang=friend(2)
               glue object to limb friend(2),robot,0
               point object robot,62.5,object position y(robot),top
               `turn object left robot,180
               up_flag=0
               fnum=2
            endif
         endif
         if f1_flag=1 and f2_flag=1 and f3_flag=0
            point object robot,f3_x#,object position y(robot),f3_z#
            if bang=friend(3)
               glue object to limb friend(3),robot,0
               point object robot,62.5,object position y(robot),top
               `turn object left robot,180
               up_flag=0
               fnum=3
            endif
         endif
      endif
   return

`----------------------------------------------------------------
   _deposit_friends:
      rem do we have a friend and want to place him?
      if up_flag=0 and rz# < bottom and fnum > 0
         point object robot,210+((fnum*25)-12.5),object position y(robot),-37.5

         rem drop him off and turn around
         if rx# >= 210+((fnum*25)-12.5) and rz# < 36 and fnum > 0
            unglue object friend(fnum)
            point object robot,0,object position y(robot),0
            select fnum
               case 1 : f1_flag=1 : endcase
               case 2 : f2_flag=1 : endcase
               case 3 : f3_flag=1 : endcase
            endselect
            fnum=0
         endif
      else
         if object position x(robot) < 30 and up_flag=0
            yrotate object robot,90
            turn object left robot,360
            up_flag=1
         endif
      endif

   return
`----------------------------------------------------------------


rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function avail_obj(num)
      while object exist(num)=1
         inc num
      endwhile
   endfunction num
`----------------------------------------------------------------
   function round_whole(num#)
      newnum=int(num#+1.0)
   endfunction newnum

rem =============================================================
rem = DATA STATEMENTS
rem =============================================================

   data 1,1,0,1,1,1,1,1,1,1,1
   data 1,0,0,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,1,0,0,1
   data 1,0,0,0,1,0,0,0,0,0,1
   data 1,1,1,0,1,0,1,0,1,1,1
   data 1,0,1,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,0,1,0,1
   data 1,0,0,0,0,0,1,0,1,0,1
   data 1,0,0,1,0,0,0,0,1,0,1
   data 1,1,0,1,1,1,1,1,1,0,1

remstart
   ==============================================================
   =  Title  : Maze Challenge
   =  Author : latch
   =  Date   : 2/19/2007
   =  Update : 02/20/2007
   =  Version:
   ==============================================================
   Comments: Create AI to get through maze and move cones to other side
   ==============================================================
remend

rem =============================================================
rem = SET UP DISPLAY
rem =============================================================
   autocam off
   set display mode 800,600,16
   sync on
   sync rate 40

   gosub _init

   rem MY ADDITION TO PROGRAM ********
   gosub _init2
   rem *******************************

rem =============================================================
rem = MAIN
rem =============================================================
   _main:
   do

      rem MY ADDITION TO PROGRAM ********
      gosub Point_Karol
      rem *******************************

      rem can't change these ************
      gosub _move_robot
      `gosub _move_friends
      gosub _timer
      text 0,0,str$(screen fps() )
      rem *******************************

      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      gosub _plot_maze
      gosub _karol_the_robot

      rem camera vars
      camx#=matx/2
      camy#=300
      camz#=-100

      position camera camx#,camy#,camz#
      point camera camx#,0,matz/2

      rem timer variables
      timestart=0

      repeat
         center text screen width()/2,0,"Press CONTROL key to begin"
         rem wait here for control key
         sync
      until controlkey()=1

   return

`----------------------------------------------------------------
   _plot_maze:
      rem maze variables
      mazex=11
      mazez=10
      dim grid(mazex,mazez)
      rem read coordinates into an array
      for z=1 to mazez
         for x=1 to mazex
            read grid(x,z)
         next x
      next z
      restore

      matx=mazex*25
      matz=mazez*25
      across=0
      up=0
      obj=0
      size=mazez*mazex

      rem make matrix as a floor
      make matrix 1,matx,matz,mazex,mazez

      rem draw walls x direction
      x=0
      for z= 1 to mazez
         repeat
            inc x
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallx,25
            else
               if obflag=1
                  inc obj
                  make object box obj,wallx,25,25
                  position object obj,(x*25)-(wallx/2)-25,12.5,((z-1)*25)+12.5
                  wallx=0
                  obflag=0
               endif
            endif
         until x = mazex
         if obflag=1
            inc obj
            make object box obj,wallx,25,25
            position object obj,(x*25)-(wallx/2),12.5,((z-1)*25)+12.5
            wallx=0
            obflag=0
            x=0
         endif
      next z

      rem draw walls z direction
      z=0
      for x= 1 to 11
         repeat
            inc z
            `read block
            if grid(x,z)=1
               obflag=1
               inc wallz,25
            else
               if obflag=1
                  inc obj
                  make object box obj,25,25,wallz
                  position object obj,((x-1)*25)+12.5,12.5,(((z-1)*25)-(wallz/2))
                  wallz=0
                  obflag=0
               endif
            endif
         until z =mazez
         if obflag=1
            inc obj
            make object box obj,25,25,wallz
            position object obj,((x-1)*25)+12.5,12.5,(z*25)-(wallz/2)
            wallz=0
            obflag=0
            z=0
         else
            wallz=0
            obflag=0
            z=0
         endif
      next x

      rem cleanup individual box items and set collision for remaining objects (walls)
      for n=1 to obj
         set object collision to boxes n
         if object size z(n)=25 and object size x(n)=25
            delete object n
         endif
      next n


   return
`----------------------------------------------------------------
   _karol_the_robot:
      robot=avail_obj(1)
      dim friend(3)

      rem create robot
      make object cone robot,10
      set object collision to boxes robot
      position object robot,0,5,-20
      color object robot,rgb(0,255,0)
      xrotate object robot,90
      fix object pivot robot
      turn object right robot,90

      rem create robot friends
      for n=1 to 3
         friend(n)=avail_obj(1)
         make object cone friend(n),16
         position object friend(n),n*70,8,130+matz
         color object friend(n),rgb(n*50,n*50,n*50)
         set object collision to boxes friend(n)
      next n

      rem create target
      make matrix 2,75,25,3,1
      position matrix 2,210,0,-50

   return
`----------------------------------------------------------------
   _collision_with_walls:
      rem check for wall collision
      bang=object collision(robot,0)
      if bang = friend(1) or bang = friend(2) or bang = friend(3) or bang=0
         rem do nothing
      else
         turn object left robot,180
      endif
   return
`----------------------------------------------------------------
   _move_robot:
      move object robot,2
      gosub _collision_with_walls
   return
`----------------------------------------------------------------
   _timer:

      if timestart=0
         thetimer=timer()
         timestart=1
      endif
      if timestart=1
         current_time=timer()-thetimer
         text 0,20,str$(current_time)
      endif

      rem find out if friends have been moved to the end matrix
      f1_x#=object position x(friend(1))
      f1_z#=object position z(friend(1))
      f2_x#=object position x(friend(2))
      f2_z#=object position z(friend(2))
      f3_x#=object position x(friend(3))
      f3_z#=object position z(friend(3))

      if f1_x# > 209 and f1_x# < 210+25 and f1_z# >-51 and f1_z# < -50+25
         goal_1=1
      else
         goal_1=0
      endif
      if f2_x# > 209+25 and f2_x# < 210+50 and f2_z# >-51 and f2_z# < -50+25
         goal_2=1
      else
         goal_2=0
      endif
      if f3_x# > 209+50 and f3_x# < 210+75 and f3_z# >-51 and f3_z# < -50+25
         goal_3=1
      else
         goal_3=0
      endif

      finalgoal=goal_1+goal_2+goal_3

      if finalgoal=3
         set text size 100
         set text opaque
         repeat
            center text screen width()/2,screen height()/2,"DONE! Time: "+str$(current_time)
            sync
         until scancode()>0
         end
      endif

   return
`----------------------------------------------------------------
   _move_friends:
      if current_time >= 6*1000
         for n = 1 to 3
            position object friend(n),210+((n*25)-12.5),object position y(friend(n)),-37.5
         next n
      endif
   return

   _init2:

      ` Dimension Pathfind Arrays
      Dim OpenList(198,3)
      Dim ClosedList(198,1)
      Dim Waypoint#(100,1)
      Dim Hval(198)
      Dim Gval(198)
      Dim Fval(198)

      ` Dimension Grid Array
      Dim Grid2(11,18)

      ` Set Grid To All Walkable
      for x=1 to 11
         for y=1 to 18
            Grid2(x,y)=1
         next y
      next x

      ` Set Robot Start Position
      DestX#=12.5
      DestZ#=-12.5
      CurrX#=1
      CurrZ#=2

      ` Set High Hval for sort
      Fval(0)=10000

      ` Create Collision Cube
      Impact_Obj=100
      make object cube Impact_Obj,20
      set object collision to boxes Impact_Obj
      hide object Impact_Obj

      rem Find Where Friends Are Located
      x1=object position x(friend(1))
      z1=object position z(friend(1))
      x2=object position x(friend(2))
      z2=object position z(friend(2))
      x3=object position x(friend(3))
      z3=object position z(friend(3))

      ` Set destination to friend 1
      DestX=x1/25+1
      DestZ=(z1+50)/25

      ` Set State Counter
      State=1

      ` Get Start Path
      gosub Find_New_Path

   return

   Point_Karol:

      point object robot,Waypoint#(CurrWay,0),object position y(robot),Waypoint#(CurrWay,1)
      set cursor 0,60 : print CurrWay
      set cursor 0,75 : print Waypoint#(CurrWay,0),"   ",Waypoint#(CurrWay,1)
      for x=CurrWay to WaypointMax
         if x=1 then ink rgb(0,0,0),0 else ink rgb(255,255,255),0
         set cursor 700,x*15-15
         print ClosedList(x,0),"   ",ClosedList(x,1)
      next x
      set cursor 500,0
      for x=2 to 11
         for z=1 to 18
            print Grid2(x,z)
         next z
      next x
      if sqrt((Waypoint#(CurrWay,0)-object position x(robot))^2+(Waypoint#(CurrWay,1)-object position z(robot))^2)<=1
        gosub Sensory_Input
        gosub Inc_Waypoint
      endif

   return

   Inc_Waypoint:

   Waypoints=Waypoints-1
   if Waypoints=1
      gosub Inc_State
      gosub Find_New_Path
   else
      for x=1 to Counter2-1
         if Grid2(ClosedList(x,0),ClosedList(x,1))=0 then ReCalc=1
      next x
      CurrWay=WaypointMax-Waypoints
   endif

   return

   Sensory_Input:

      ` Have Robot Check for Walls Around it
      for x=-1 to 1
         for y=-1 to 1
            position object Impact_Obj,Waypoint#(CurrWay,0)+(x*25),object position y(Impact_Obj),Waypoint#(CurrWay,1)+(y*25)
            TileX=CurrX+x
            TileY=CurrZ+y
            if TileX>0 and TileY>0 and TileX<12 and TileY<19
               bang=object collision(Impact_Obj,0)
               if bang<>friend(1) and bang<>robot and bang<>friend(2) and bang<>friend(3) and bang<>0
                  Grid2(TileX,TileY)=0
               endif
            endif
         next x
      next x

   return

   Inc_State:

   inc State

   if State=2
      glue object to limb friend(1),robot,0
      DestX=9
      DestZ=1
   endif

   if State=3
      unglue object friend(1)
      DestX=x2/25
      DestZ=(z2+50)/25
   endif

   if State=4
      glue object to limb friend(2),robot,0
      DestX=10
      DestZ=1
   endif

   if State=5
      unglue object friend(2)
      DestX=x3/25
      DestZ=(z3+50)/25
   endif

   if State=6
      glue object to limb friend(3),robot,0
      DestX=11
      DestZ=1
   endif

   if State=7
      unglue object friend(3)
   endif

   return

Find_New_Path:

` Initialize values
StartX=((object position x(Robot)+12.5)/25)
StartY=((object position z(Robot)+62.5)/25)

Counter1=1
Counter2=1

CurrX=StartX
CurrZ=StartZ

OpenList(1,0)=CurrX
OpenList(1,1)=CurrZ

Finish=0
Fval(1)=1

repeat

   ` Find Lowest F-Cost Square
   for x=1 to Counter1-1
      Skip=0
      for y=1 to Counter2-1
         if OpenList(x,0)=ClosedList(y,0) and OpenList(x,1)=ClosedList(y,1) then Skip=1
      next y
      if Skip=0
         if Fval(x)<Fval(BestTile)
            BestTile=x
         endif
      endif
   next x

   ` Add it to the Closed List
   ClosedList(Counter2,0)=OpenList(BestTile,0)
   ClosedList(Counter2,1)=OpenList(BestTile,1)
   inc Counter2

   ` Set Current Tile
   CurrX=ClosedList(Counter2-1,0)
   CurrZ=ClosedList(Counter2-1,1)

   ` Set Current Tile as Parent
   ParentX=CurrX
   ParentZ=CurrZ

   ` Add Adjacent Squares to Open List
   for x=-1 to 1
      for y=-1 to 1
         Run=1
         Skip=0
         TileX=CurrX+x
         TileY=CurrZ+y
         if TileX>0 and TileX<12 and TileY>0 and TileY<19
         if Grid2(TileX,TileY)=1
            if TileX<>CurrX or TileY<>CurrZ
               for z=0 to Counter2-1
                  if ClosedList(z,0)=TileX and ClosedList(z,1)=TileY then Run=0
               next z
               if Run=1
                  for z=1 to Counter1
                     if OpenList(z,0)=TileX and OpenList(z,1)=TileY
                        Skip=1
                        Zval=z
                     endif
                  next z
                  if Skip=0
                     OpenList(Counter1,0)=TileX : OpenList(Counter1,1)=TileY
                     OpenList(Counter1,2)=ParentX : OpenList(Counter1,3)=ParentY
                     ValX=abs(TileX-DestX)
                     ValZ=abs(TileY-DestZ)
                     Hval(Counter1)=(ValX+ValZ)*10
                     if y=0 or x=0 then Gval(Counter1)=Gval(BestTile)+G2 else Gval(Counter1)=Gval(BestTile)+G1
                     Fval(Counter1)=Hval(Counter1)+Gval(Counter1)
                     inc Counter1
                  else
                     if y=0 or x=0 then Gval=Gval(BestTile)+G2 else Gval=Gval(BestTile)+G1
                     if Gval<Gval(Zval)
                        ValX=abs(TileX-DestX)
                        ValZ=abs(TileY-DestZ)
                        Hval=(ValX+ValZ)*10
                        OpenList(Zval,2)=ParentX : OpenList(Zval,3)=ParentZ
                        Gval(Zval)=Gval : Hval(Zval)=Hval
                        Fval(Zval)=Gval+Hval
                     endif
                  endif
               endif
            endif
         endif
         endif
      next y
   next x

   rem Reset BestTile
   BestTile=0

   ` Check for Dest on OpenList
   for x=0 to Counter1-1
      if OpenList(x,0)=DestX and OpenList(x,1)=DestZ
         Finish=1
         Value=x
      endif
   next x

until Finish=1

   Waypoint#(Counter2-1,0)=OpenList(Value,0)*25-12.5
   Waypoint#(Counter2-1,1)=OpenList(Value,1)*25-62.5

for x=1 to Counter2-2
   Waypoint#(x,0)=ClosedList(x,0)*25-12.5
   Waypoint#(x,1)=ClosedList(x,1)*25-62.5
next x

Waypoints=Counter2-1
WaypointMax=Waypoints
CurrWay=2

return

rem =============================================================
rem = FUNCTIONS
rem =============================================================
   function avail_obj(num)
      while object exist(num)=1
         inc num
      endwhile
   endfunction num

rem =============================================================
rem = DATA STATEMENTS
rem =============================================================

   data 1,1,0,1,1,1,1,1,1,1,1
   data 1,0,0,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,1,0,0,1
   data 1,0,0,0,1,0,0,0,0,0,1
   data 1,1,1,0,1,0,1,0,1,1,1
   data 1,0,1,0,0,0,1,0,0,0,1
   data 1,0,1,1,1,0,1,0,1,0,1
   data 1,0,0,0,0,0,1,0,1,0,1
   data 1,0,0,1,0,0,0,0,1,0,1
   data 1,1,0,1,1,1,1,1,1,0,1