Sorry your browser is not supported!

OK - the new deadline is:

Midnight GMT on Wednesday 4 July.

NinJA999:

The idea is to create a program that you can talk to - just like a human - though I'm not expecting any of your programs to pass the Turing Test...

It should respond to whatever anyone types in - regardless of the subject - by examining what the user types. So, if the user types 'Hello' then the program should respond with 'Hello' back.

If the user types 'What is your name?' then the program should recognize that it's been asked a question, (by the question mark on the end) and try to answer the question.

You can scan for basic keywords at the start of the question to identify questions too - like How, Why, When, Can and so on.

The save idea is optional to build up a database of subjects the program knows something about. (Anyone remember that old computer game from years ago where the computer had to guess the animal you were thinking of by asking questions about it when it guessed wrong)?

If your program cannot figure out what the user has typed, you can always have it say one of a set of 'Sorry I don't understand you' phrases chosen at random.

Oh yes - I forgot to mention...

In your game, you would scan for swear words and respond accordingly. In this challenge, we can assume that the 'user' won't be typing any swear words in...

So, it's basically creating fake AI to make your computer have a meaningful conversation with whoever is using it - and as mentioned before, what you end up with could be applied to any game which requires conversations with NPC's).

TDK_Man

dim array$(100)

do
   input "You Say   :";comment$
   comment$=trimstr(comment$)
   comment$=removespcstr(comment$)
   count=wordcount(comment$)

   rem look in the string for specific key words
   iyou=instr(upper$(comment$),"I ",1)
   if iyou > 0
      computer$="So you say, you "+midstr(comment$,iyou+2,len(comment$)-iyou)
   else
      youi=instr(upper$(comment$),"YOU ",1)
      if youi > 0
         computer$="You mean I "+midstr(comment$,youi+4,len(comment$)-youi)+"?"
      endif
   endif


   _response:
   print computer$

loop


end
Rem Dark Basic String Function Collection (c) TDK_Man September 2002
Rem Free to use - a mention would be nice if you do use it, but not compulsory

Function Instr(MainStr$,Search$,StartPos)
  Rem Instr Function By TDK_Man

  Rem Usage Examples:
  Rem NumVar=Instr("Main String","SubString",StartPos)
  Rem NumVar=Instr(Main$,Search$,StartPos)
  Rem Print Instr("The Rain In Spain","Rain",1)

  Rem Description:
  Rem INSTR is a function giving you the INSTRing capabilities supplied with many
  Rem versions of BASIC. Given the string which you are searching, a substring to
  Rem search for and the position within the main string to start, INSTR returns
  Rem an integer value for the start position of the substring in the main string.

  Rem For example, INSTR("ABCDEFGHIJK","DEF",1) will return 4 as the 'D' of 'DEF'
  Rem is found starting at the 4th character in the string being searched. The value
  Rem 0 is returned if the substring is not found.

  N=StartPos-1: StartFound=0: FoundPos=0: Build$=""
  Repeat
    Inc N
    If Mid$(MainStr$,N)=Left$(Search$,1): Rem if current char is same as first char of search$
      StartFound=N
    Else
      StartFound=0
    Endif
    If StartFound>0
      For N2=StartFound To StartFound+(Len(Search$)-1)
        Build$=Build$+Mid$(MainStr$,N2)
      Next N2
      If Build$=Search$
        FoundPos=StartFound
      Else
        Build$=""
      Endif
    Endif
  Until N=Len(MainStr$) or Build$=Search$
EndFunction FoundPos


Function MidStr(MainStr$,Start,SLen)
  Rem MidStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=Midstr("Main String",StartPos,NumChars)
  Rem StringVar=Midstr(Main$,StartPos,NumChars)
  Rem Print Midstr("The Rain In Spain",5,4)

  Rem Description:
  Rem MIDSTR is a function giving you the proper multiple character returning MIDSTRing
  Rem (MID$) capabilities supplied with many versions of BASIC. Given the string which
  Rem you are searching, a start position and the number of characters to extract, MIDSTR
  Rem returns a substring of characters from the main string.

  Rem For example, MIDSTR("ABCDEFGHIJK",4,3) will return the string 'DEF' - being the
  Rem 3 characters in the main string starting at the 4th character.

  Rem If the supplied value 'Numchars' exceeds the length of the main string, then only
  Rem the remaining characters are returned.

  Build$=""
  For N=Start To Start+SLen-1
    Build$=Build$+Mid$(MainStr$,N)
  Next N
EndFunction Build$


Function MirrorStr(MainStr$)
  Rem MirrorStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=MirrorStr(Main$)
  Rem Print MirrorStr("The Rain In Spain")

  Rem Description:
  Rem MIRRORSTR is a function which returns a string with the original strings' contents
  Rem mirrored (reversed). No parameters are required other than the string to mirror.

  Rem For example, MIRRORSTR("ABCDEFGHIJK") will return the string 'KJIHGFEDCBA'.

  Build$=""
  For N=Len(MainStr$) To 1 Step-1
    Build$=Build$+Mid$(MainStr$,N)
  Next N
EndFunction Build$


Function TrimStr(MainStr$)
  Rem TrimStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=TrimStr(Main$)
  Rem Print TrimStr("   The Rain In Spain  ")

  Rem Description:
  Rem TRIMSTR is a function which returns a string with the original string's
  Rem leading and trailing spaces removed (trimmed). No parameters are required other
  Rem than the string to trim.

  Rem For example, TRIMSTR("    ABC  ") will return the string 'ABC'.

  Build$="": N=1
  While Mid$(MainStr$,N)=" "
    Inc N
  EndWhile
  Spos=N
  N=Len(MainStr$)
  While Mid$(MainStr$,N)=" "
    Dec N
  EndWhile
  Epos=N
  For N=Spos To Epos
    Build$=Build$+Mid$(MainStr$,N)
  Next N
EndFunction Build$


Function LeftTrimStr(MainStr$)
  Rem LeftTrimStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=LeftTrimStr(Main$)
  Rem Print LeftTrimStr("   The Rain In Spain  ")

  Rem Description:
  Rem LEFTTRIMSTR is a function which returns a string with the original string's
  Rem leading spaces removed (trimmed). No parameters are required other than
  Rem the string to trim.

  Rem For example, LEFTTRIMSTR("    ABC  ") will return the string 'ABC  '.

  Build$="": N=1
  While Mid$(MainStr$,N)=" "
    Inc N
  EndWhile
  For N2=N To Len(MainStr$)
    Build$=Build$+Mid$(MainStr$,N2)
  Next N2
EndFunction Build$


Function RightTrimStr(MainStr$)
  Rem RightTrimStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=RightTrimStr(Main$)
  Rem Print RightTrimStr("   The Rain In Spain  ")

  Rem Description:
  Rem RIGHTTRIMSTR is a function which returns a string with the original string's
  Rem trailing spaces removed (trimmed). No parameters are required other than
  Rem the string to trim.

  Rem For example, RIGHTTRIMSTR("    ABC  ") will return the string '    ABC'.

  Build$="": N=Len(MainStr$)
  While Mid$(MainStr$,N)=" "
    Dec N
  EndWhile
  For N2=1 To N
    Build$=Build$+Mid$(MainStr$,N2)
  Next N2
EndFunction Build$


Function AcronymStr(MainStr$)
  Rem AcronymStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=AcronymStr(Main$)
  Rem Print AcronymStr("this is a lower case sentence")

  Rem Description:
  Rem ACRONYMSTR is a function which returns the capitalised initals from the words
  Rem in the original sentence.

  Rem For example, ACRONYMSTR("beginners all-purpose symbolic instruction code") will return 'BASIC'.

  Build$=Upper$(Mid$(MainStr$,1))
  For N=2 To Len(MainStr$)
    If Mid$(MainStr$,N-1)=" "
      Build$=Build$+Upper$(Mid$(MainStr$,N))
    Endif
  Next N
EndFunction Build$


Function LCapStr(MainStr$)
  Rem LCapStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=LCapStr(Main$)
  Rem Print LCapStr("this is a lower case sentence")

  Rem Description:
  Rem LCAPSTR is a function which returns the original string's words with leading
  Rem capitals. No parameters are required other than the string to capitalise.

  Rem For example, LCAPSTR("this is lower case") will return 'This Is Lower Case'.

  Build$=Upper$(Mid$(MainStr$,1))
  For N=2 To Len(MainStr$)
    If Mid$(MainStr$,N-1)=" "
      Build$=Build$+Upper$(Mid$(MainStr$,N))
    Else
      Build$=Build$+Mid$(MainStr$,N)
    Endif
  Next N
EndFunction Build$


Function ReplaceStr(MainStr$,Substr1$,Substr2$)
  Rem ReplaceStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=ReplaceStr(Main$,find$,replace$,1)
  Rem Print ReplaceStr("one two three","two","six",3)

  Rem Description:
  Rem REPLACESTR replaces all occurences of the first substring with the second in the main string.
  Rem If substr1 does not exist in the main string then the function returns an empty string ("").

  Rem For example, REPLACESTR("Here is a red book", "red", "green") will return 'Here is a green book'.

  Build$="": StartChar=1: Found=1
  Repeat
    Spos=Instr(MainStr$,Substr1$,StartChar)
    If Spos>=StartChar
      LineBegin$=Left$(MainStr$,Spos-1)
      X=(Len(MainStr$)-Spos)-Len(Substr1$)
      If X>=1
        LineEnd$=Right$(MainStr$,X+1)
      Else
        LineEnd$=""
      Endif
      Build$=""
      Build$=LineBegin$ + Substr2$ + LineEnd$
      StartChar=Spos+Len(Substr2$)
      MainStr$=Build$
      If StartChar>=Len(MainStr$) Then Spos=0
      Inc Found
    Else
      Build$=MainStr$
    Endif
  Until Spos=0
EndFunction Build$


Function WordCount(MainStr$)
  Rem WordCount Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=WordCount(Main$)
  Rem Print WordCount("Count these words please")

  Rem Description:
  Rem WORDCOUNT simply returns the number of words in the supplied string, assuming that the
  Rem string contains no leading or trailing spaces. Use TRIMSTR if necessary to remove them
  Rem before calling this function.

  Rem For example, WORDCOUNT("The cat sat on the mat") will return the value 6.

  Words=1
  For N=1 To Len(MainStr$)
    If Mid$(MainStr$,N)=" " Then Inc Words
  Next N
EndFunction Words


Function MakeStr(String$,NumCount)
  Rem MakeStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=MakeStr(String$,NumCount)
  Rem Print MakeStr("X",32)

  Rem Description:
  Rem MAKESTR creates a string containing 'NumCount' occurences of String$. Note that
  Rem the value of NumCount does not automatically represent the length of the newly
  Rem created string as String$ can be greater than 1 character in size.

  Rem For example, MAKESTR("0",8) will create the string '00000000' - Length 8.
  Rem and MAKESTR("ABC",4) will create the string 'ABCABCABCABC' - Length NOT 4!

  Build$=""
  For N=1 To NumCount
    Build$=Build$+String$
  Next N
EndFunction Build$


Function SortStr(String$,Case)
  Rem SortStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=SortStr(String$)
  Rem Print SortStr("The Cat Sat On the Mat")

  Rem Description:
  Rem SORTSTR creates a string containing all the characters in String$ organised
  Rem into alphabetical order, ignoring all spaces. If 'Case' is set to 0 then upper
  Rem and lower case are treated the same. If 'Case' is set to 1 then capitals and lower
  Rem case are sorted separately in their ASCII value order.

  Rem For example, SORTSTR("Hello World") will create the string 'deHllloorW' and
  Rem SORTSTR("FEACBD") will create the string 'ABCDEF'.

  StrLen=Len(String$)
  Dim Array(StrLen)
  For N=1 To StrLen
    If Mid$(String$,N)<>" " Then Array(N)=Asc(Mid$(String$,N))
  Next N
  Repeat
    Swap=0
    For N=1 To StrLen-1
      Rem a=97 (-32)
      If Case=0
        C1=Array(N): If C1<97 Then C1=C1+32
        C2=Array(N+1): If C2<97 Then C2=C2+32
      Else
        C1=Array(N): C2=Array(N+1)
      Endif
      If C1>C2
        Temp=Array(N)
        Array(N)=Array(N+1)
        Array(N+1)=Temp
        Swap=1
      Endif
    Next N
  Until Swap=0
  Build$=""
  For N=1 To StrLen
    Build$=Build$+Chr$(Array(N))
  Next N
  UnDim Array()
EndFunction Build$


Function ArrayStr(String$)
  Rem ArrayStr Function By TDK_Man

  Rem Usage Examples:
  Rem NumVar=ArrayStr(String$)
  Rem Print ArrayStr("The Cat Sat On the Mat")

  Rem Description:
  Rem ARRAYSTR creates an array containing all the words in String$ and returns the
  Rem number of words stored to the calling function variable. The array MUST be DIM'ed
  Rem in the main program before calling the function.

  Rem For example, after using Words=ArrayStr("Once upon a time"), the variable words
  Rem will contain the value 4 (4 words) and the array will hold the four words in
  Rem Array$(1), Array$(2), Array$(3) and Array$(4) where they can easily be worked on.

  Words=1
  For N=1 To Len(String$)
    If Mid$(MainStr$,N)=" " Then Inc Words
  Next N

  Spos=1: WordCount=0: Build$=""
  For N=1 To Len(String$)
    If Mid$(String$,N)=" "
      For N2=Spos to N-1
        Build$=Build$+Mid$(String$,N2)
      Next N2
      Inc WordCount
      Array$(WordCount)=Build$
      Build$=""
      Spos=N+1
    Endif
    If N=Len(String$)
      For N2=Spos to N
        Build$=Build$+Mid$(String$,N2)
      Next N2
      Inc WordCount
      Array$(WordCount)=Build$
    Endif
  Next N
EndFunction WordCount


Function RemoveStr(MainStr$,Substr1$)
  Rem RemoveStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=RemoveStr(Main$,find$)
  Rem Print RemoveStr("one two three","two ")

  Rem Description:
  Rem REMOVESTR removes the first occurence of the substr1 from the main string.
  Rem If words are being removed from a sentence, you must remember to include the space.

  Rem For example, REMOVESTR("Here is a red book", "red ") will return 'Here is a book'.

  Build$="": Start=1
  Repeat
    Spos=Instr(MainStr$,Substr1$,Start)
    LineBegin$=Left$(MainStr$,Spos-1)
    X=Len(MainStr$)-Spos-Len(Substr1$)
    Start=X+1
    LineEnd$=Right$(MainStr$,X+1)
    If Spos>0
      Build$=LineBegin$ + LineEnd$
    Endif
  Until Spos=0
EndFunction Build$


Function RemoveSpcStr(MainStr$)
  Rem RemoveSpcStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=RemoveSpcStr(Main$)
  Rem Print RemoveSpcStr("one     two     three")

  Rem Description:
  Rem REMOVESPCSTR removes all multiple occurences of spaces from the main string and
  Rem replaces them with a single one. For example:
  Rem REMOVESPCSTR("I got     a    duff keyboard") will return 'I got a duff keyboard'.

  Build$=""
  For N=1 To Len(MainStr$)
    Build$=Build$+Mid$(MainStr$,N)
    If Mid$(MainStr$,N)=" "
      If Mid$(MainStr$,N+1)=" "
        Repeat
          Inc N
        Until Mid$(MainStr$,N)<>" "
        Dec N
      Endif
    Endif
  Next N
EndFunction Build$


Function GetWordStr(MainStr$,WordNum)
  Rem GetWordStr Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=GetWordStr(Main$,N)
  Rem Print GetWordStr("one two three",2)

  Rem Description:
  Rem GETWORDSTR returns the nth word from the supplied main string.
  Rem If n is gretaer than the number of words in the string, a NULL string ("") is returned.

  Rem For example, GETWORDSTR("Here is a red book",4) will return 'red'.

  Words=1
  For N=1 To Len(MainStr$)
    If Mid$(MainStr$,N)=" " Then Inc Words
  Next N

  If WordNum<=Words
    Spos=1: WordCount=0: Build$=""
    For N=1 To Len(MainStr$)
      If Mid$(MainStr$,N)=" "
        For N2=Spos to N-1
          B$=B$+Mid$(MainStr$,N2)
        Next N2
        Inc WordCount
        If WordCount=WordNum
          Build$=B$
          N=Len(MainStr$)+1
        Else
          B$=""
          Spos=N+1
        Endif
      Endif
      If N=Len(MainStr$)
        For N2=Spos to N
          B$=B$+Mid$(MainStr$,N2)
        Next N2
        Inc WordCount
        If WordCount=WordNum
          Build$=B$
        Endif
      Endif
    Next N
  Else
    Build$=""
  Endif
EndFunction Build$


Function ColorText(X,Y,MainStr$)
  Rem ColorText Function By TDK_Man

  Rem Usage Examples:
  Rem StringVar=ColorText(XPos,YPos,FormattedString$)
  Rem Print ColorText(100,100,"[R255G0B0]All[/RGB] different [R0G0B255]colours[/RGB]")

  Rem Description:
  Rem COLORTEXT prints a formatted string in multiple colours. Used the same way as DB's Text
  Rem command, it needs the X and Y screen positions of the string to print, along with the
  Rem string itself.

  Rem The string must be formatted in a fashion similar to HTML tags, but using square brackets
  Rem ([ and ]). When you wish to turn a certain colour on, you use [RnumGnumBnum] where 'num'
  Rem is the respective colour value for the R, G and B colour registers. Tags are not printed.

  Rem So, the tag to turn text red would be [R255G0B0].
  Rem The tag to turn text green would be [R0G255B0].
  Rem The tag to turn text blue would be [R0G0B255] and so on.

  Rem The selected colour remains on until the 'turn off' tag is reached, which is [/RGB].
  Rem There must always be a matching [/RGB] 'off' tag for every 'on' tag and at the moment you
  Rem cannot nest colour tags, (an off tag must always follow an on tag).

  Rem All text not enclosed by colour tags is printed in the currently selected colour as
  Rem defined by the last INK command.

  Rem For example, COLORTEXT("Here is a [R255G0B0]red[/RGB] book",4) will print:
  Rem 'Here is a red book' in the current colour, but the word 'red' will be in red ink.

  rem Set Cursor X,Y
  XPos=X: YPos=Y
  CREATE BITMAP 31,10,10
  Set Current Bitmap 31
  Box 1,1,9,9
  CurrColVal=Point(5,5)
  Set Current Bitmap 0
  Delete Bitmap 31
  For N=1 To Len(MainStr$)
    If Mid$(MainStr$,N)="[" and Mid$(MainStr$,N+1)<>"/"
      N2=N
      Repeat
        Inc N2
        If Mid$(MainStr$,N2)="R" Then Rs=N2+1
        If Mid$(MainStr$,N2)="G" Then Gs=N2+1:Re=N2-1
        If Mid$(MainStr$,N2)="B" Then Bs=N2+1:Ge=N2-1
      Until Mid$(MainStr$,N2)="]"
      Be=N2-1
      C$=""
      For N3=Rs To Re
        C$=C$+Mid$(MainStr$,N3)
      Next N3
      Red=Val(C$)
      C$=""
      For N3=Gs To Ge
        C$=C$+Mid$(MainStr$,N3)
      Next N3
      Green=Val(C$)
      C$=""
      For N3=Bs To Be
        C$=C$+Mid$(MainStr$,N3)
      Next N3
      Blue=Val(C$)
      Ink RGB(Red,Green,Blue),0
      N=N2+1
    Endif
    If Mid$(MainStr$,N)="[" and Mid$(MainStr$,N+1)="/"
      N2=N
      Repeat
        Inc N2
      Until Mid$(MainStr$,N2)="]"
      Ink CurrColVal,0
      N=N2+1
    Endif
    Text XPos,YPos, Mid$(MainStr$,N)
    Inc XPos,TEXT WIDTH( Mid$(MainStr$,N))
  Next N
EndFunction

Function Instr(MainStr$,Search$,StartPos)
  Rem Instr Function By TDK_Man

  N=StartPos-1: StartFound=0: FoundPos=0: Build$=""
  Repeat
    Inc N
    If Mid$(MainStr$,N)=Left$(Search$,1): Rem if current char is same as first char of search$
      StartFound=N
    Else
      StartFound=0
    Endif
    If StartFound>0
remstart
The TDK way:
      For N2=StartFound To StartFound+(Len(Search$)-1)
        Build$=Build$+Mid$(MainStr$,N2)
      Next N2
remend
      Midstr(Mainstr$,StartFound,StartFound+(Len(Search$)-1) : OBese's suggestion
      If Build$=Search$
        FoundPos=StartFound
      Else
        Build$=""
      Endif
    Endif
  Until N=Len(MainStr$) or Build$=Search$
EndFunction FoundPos

REM - The name of my talking program.

Database Tree Structure

REM'S current knowledge of animals:

Animals (All animals eat, sleep, breath, reproduce, move)
	^ Mammals (all mammals are warm-blooded)
		^ Dogs (can be domesticated as pets, eats small mammals)
	^ Reptiles
	^ Birds
	^ Fish
		^ Sardines

The following is an idea of how REM could work:

User: "I have a cat."
	REM breaks up the sentence: he finds an unknown word "cat", to understand the statement 
	he must first determine what "cat" means.
REM: "What is a cat?"
User: "A cat is an animal."
	REM checks his database and finds the Animals branch, since this branch has sub-categories he will need
	find out which category "cat" goes into or whether "cat" is a entirely new group of animals.
REM: "Is a cat a MAMMAL, REPTILE, BIRD or FISH?"
User: "Mammal."
	REM stores "cat" in the Mammals branch.

	Animals (All animals eat, sleep, breath, reproduce, move)
		^ Mammals (all mammals are warm-blooded)
			^ Cats
			^ Dogs (can be domesticated as pets, eats small mammals)

	Now that REM knows what a cat is, he can respond to the original statement "I have a cat."
	REM interprets "I" to mean the user, and "have" to declare ownership. I cannot work out how REM would know
	that a human owning an animal would mean it was their pet :(. But let's say he does.

	Animals (All animals eat, sleep, breath, reproduce, move)
		^ Mammals (all mammals are warm-blooded)
			^ Cats (can be domesticated as pets)
			^ Dogs (can be domesticated as pets, eats small mammals)

	Now REM knows that both dogs and cats can be kept as pets, this would prompt him to either make a sub-group
	called "domestic", or to edit Mammals/Animals associated words to include "domestic".
REM: "Can all animals be domesticated?"
User: "No."
REM: "Can all mammals be domesticated?"
User: "No."
	REM will have to make a new sub-category as neither of the categories can accomodate "domestic".
	He will now call all animal types to try and work out at what level the sub-category "domestic" can be made.
REM: "Can some animals from all groups be domesticated? MAMMALS, BIRDS, REPTILES, FISH."
User: "Yes."
	REM will now try to assertain which other animals can be domesticated.
REM: "Can sardines be domesticated?"
User: "No."
	Now that REM has found an animal that can't be domesticated he needs to categorize it with an alternative.
REM: "What is the opposite of domesticated?"
User: "Wild."
REM: "Are some animals from all groups wild? MAMMALS, BIRDS, REPTILES, FISH."
User: "Yes."
	With this new information about "wild" and "domesticated" animals, REM can create two sub-groups.

	Animals (All animals eat, sleep, breath, reproduce, move)
		^ Domesticated
			^ Mammals (all mammals are warm-blooded)
				^ Dogs (eats small mammals)
				^ Cats
			^ Reptiles
			^ Birds
			^ Fish
		^ Wild
			^ Mammals (all mammals are warm-blooded)
			^ Reptiles
			^ Birds
			^ Fish
				^ Sardines

	This is probably a bad example to use but it shows the way that REM could restructure his database.
	
	Now that everything is in order, REM will start seeking knowledge by asking questions based on information he
	already knows: i.e. REM knows that all animals eat, but he currently has no data on what cats eat.
REM: "What do cats eat?"
User: "Sardines"
	The cat entity is now linked to the sardines by two values: the first value points to the entity number of the sardines
	and the second to the entity that connects them (eat).

Entity Parameters "name", ID, parent group ID, number of sub-ordinates, number of links

Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,N*(YSize+1)+YPosition,Columns*(XSize+1)+XPosition,N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,YPosition,N*(XSize+1)+XPosition,Rows*(YSize+1)+YPosition
  Next N
Endfunction

`--- creating a grid using the mouse ---

sync on

DO

`store stable mouse positions
if mousex() > xpos then mx = mousex()
if mousey() > ypos then my = mousey()

if mouseclick() = 1
   `prime release switch
   release_switch = 1
endif

if release_switch = 1 and mouseclick() = 0
   `reset release_switch
   release_switch = 0
   `next phase
   inc drag_switch
endif

Select drag_switch
   Case 1
      `set grid origin
      xpos= mx : ypos= my
      `go straight to width
      inc drag_switch
   endcase
   Case 2
      `grid width
      xsize = mx - xpos
      width = xsize
   endcase
   Case 3
      `grid height
      ysize= my - ypos
      length = ysize
   endcase
   Case 4
      `printing variable
      check = col
      `segment x
      col = (mx-xpos)/(width-xpos) * 20 : if col < 1 then col = 1
      `adjust cell width to keep grid width the same
      xsize = width/col
   endcase
   Case 5
      `segment y
      row = (my-ypos)/(length-ypos) * 20 : if row < 1 then row = 1
      `adjust cell width to keep grid width the same
      ysize = length/row
   endcase
   case >0
      if mx < xpos then mx = xpos
      if my < ypos then my = ypos
   endcase
   case 0
      `reset from previous grid
      xpos= 0 : ypos= 0 : col= 1 : row= 1 : xsize= 0 : ysize= 0
   endcase
   case default : drag_switch= 0 : endcase
Endselect

cls
set cursor 0,0
print check
position mouse mx,my
Grid(xpos,ypos,col,row,xsize,ysize,rgb(255,255,255),rgb(100,0,100))
sync
LOOP

END

Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
  Next N
Endfunction

`Grid Screensaver
`07/05/07
`Nick Aldwin aka NinJA999

sync on
sync rate 0

width = screen width()
height = screen height()
up = 1
col = 0

cls
do
if col<256 and up=1 then inc col
if col>255 and up=1 then up=0
if col>0 and up=0 then dec col
if col<1 and up=0 then up=1
for i=0 to height-10
for j=0 to width-10
Grid(j+rnd(10),i+rnd(10),2,2,10,10,rgb(255-col,0,0),rgb(rnd(col),0,0))
inc j,20
next j
inc i,20
next i
sync
if scancode()<>0 or mousemovex()<>0 or mousemovey()<>0 or mouseclick()<>0 then end
loop




Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
  Next N
Endfunction

for j=0 to width-10
  Grid(j+rnd(10),i+rnd(10),2,2,10,10,rgb(255-col,0,0),rgb(rnd(col),0,0))
  inc j,20
next j

for i=0 to height-10 Step 20
  for j=0 to width-10 Step 20
    Grid(j+rnd(10),i+rnd(10),2,2,10,10,rgb(255-col,0,0),rgb(rnd(col),0,0))
  next j
next i

if col<256 and up=1 then inc col
if col>255 and up=1 then up=0
if col>0 and up=0 then dec col
if col<1 and up=0 then up=1

inc c,1
col = sin(c)*255

hide mouse
sync on
sync rate 0
ink rgb(250,225,205),1
box 0,0,639,479

ink rgb(246,221,200),1
do
v=rnd(615)
z=rnd(465)
x=v+rnd(25)
y=z+rnd(25)
box v,z,x,y
done=done+1
if done=200 then goto next
sync
loop


next:
blur bitmap 0,6

ink rgb(50,25,10),1
box 100,98,220,224



Grid(100,100,2,2,60,60,RGB(50,25,10),RGB(150,150,250))

ink rgb(50,25,10),1
box 220,98,260,224

box 60,98,100,224

ink rgb(100,75,30),1
box 223,103,257,219

box 63,103,97,220

ink rgb(50,25,10),1
box 400,200,550,479
ink rgb(100,75,30),1

box 410,210,470,469

box 480,210,540,469

ink rgb(255,205,95),1

circle 520,340,10
circle 520,340,9
circle 520,340,8
circle 520,340,7
circle 520,340,6
circle 520,340,5
circle 520,340,4
circle 520,340,3
circle 520,340,2
circle 520,340,1

blur bitmap 0,1


do
if mousemovex()<>0 or mousemovey()<>0 then blur bitmap 0,8
sync
loop





`TDK's function
Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,N*(YSize+1)+YPosition,Columns*(XSize+1)+XPosition,N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,YPosition,N*(XSize+1)+XPosition,Rows*(YSize+1)+YPosition
  Next N
Endfunction

`--- creating a grid using the mouse ---

sync on

DO

`store stable mouse positions
if mousex() > xpos then mx = mousex()
if mousey() > ypos then my = mousey()

if mouseclick() = 1
   `prime release switch
   release_switch = 1
endif

if release_switch = 1 and mouseclick() = 0
   `reset release_switch
   release_switch = 0
   `next phase
   inc drag_switch
endif

Select drag_switch
   Case 1
      `set grid origin
      xpos= mx : ypos= my
      `go straight to width
      inc drag_switch
   endcase
   Case 2
      `grid width
      xsize = mx - xpos
      width = xsize
   endcase
   Case 3
      `grid height
      ysize= my - ypos
      length = ysize
   endcase
   Case 4
      `printing variable
      check = col
      `segment x
      col = (mx-xpos)/(width-xpos) * 20 : if col < 1 then col = 1
      `adjust cell width to keep grid width the same
      xsize = width/col
   endcase
   Case 5
      `segment y
      row = (my-ypos)/(length-ypos) * 20 : if row < 1 then row = 1
      `adjust cell width to keep grid width the same
      ysize = length/row
   endcase
   case >0
      if mx < xpos then mx = xpos
      if my < ypos then my = ypos
   endcase
   case 0
      `reset from previous grid
      xpos= 0 : ypos= 0 : col= 1 : row= 1 : xsize= 0 : ysize= 0
   endcase
   case default : drag_switch= 0 : endcase
Endselect

cls
set cursor 0,0
print check
position mouse mx,my
Grid(xpos,ypos,col,row,xsize,ysize,rgb(255,255,255),rgb(100,0,100))
sync
LOOP

END

Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
  Next N
Endfunction

`Grid Screensaver
`07/05/07
`Nick Aldwin aka NinJA999

sync on
sync rate 0

width = screen width()
height = screen height()
up = 1
col = 0

cls
do
col=rnd(255)
col1=rnd(255)
col2=rnd(255)
col3=rnd(255)
col4=rnd(255)
col5=rnd(255)


for i=0 to height-10
for j=0 to width-10
Grid(j+rnd(10),i+rnd(10),2,2,10,10,rgb(col,col1,col2),rgb(col3,col4,col5))
inc j,20
next j
inc i,20
next i
sync
if scancode()<>0 or mousemovex()<>0 or mousemovey()<>0 or mouseclick()<>0 then end
loop




Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
  Next N
Endfunction

`Grid Screensaver
`07/05/07
`Nick Aldwin aka NinJA999

sync on
sync rate 0: CLS 0: Sync
Hide Mouse

width = screen width()
height = screen height()
up = 1
col = 0
Rows=2
Columns=2
CellSize=10

Do
  If Up = 1
    If col<256
      Inc col
    Else
      up=0
    Endif
  Else
    If col>0
      dec col
    Else
      up=1
    Endif
  Endif
  For Y=0 to Height-34 Step 20
    GridXPos = X+Rnd(10): GridYPos = Y+Rnd(10)
    Grid(GridXPos,GridYPos,Rows,Columns,CellSize,CellSize,RGB(255-col,0,0),RGB(Rnd(col),0,0))
    Get Image 1,GridXPos,GridYPos,GridXPos+(Columns*(CellSize+2))+1,GridYPos+(Rows*(CellSize+2))+1
    For X=0 to Width-34 Step 20
      Paste Image 1,X+Rnd(10),Rnd(height)
    Next X
    X=0
  Next Y
  If scancode()<>0 or mousemovex()<>0 or mousemovey()<>0 or mouseclick()<>0 then end
  sync
loop


Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
  Next N
Endfunction

rem drag mouse grid creator
rem latch
rem 07/08/2007
sync on
sync rate 60

_get_cells:
input "Number of grid squares?  ";squares

do

   if mouseclick()=1 and drag_switch=0
      upx=mousex()
      upy=mousey()
      drag_switch=1
   endif

   if mouseclick()=1
      box upx,upy,mousex(),mousey()
   endif

   if mouseclick()=0 and drag_switch=1
      cls
      drag_switch=0
      xsize=((mousex()-upx)/squares)
      ysize=((mousey()-upy)/squares)
      if mousex() < upx
         oldx=upx
         upx=mousex()
         xsize=((oldx-upx)/squares)
      endif
      if mousey() < upy
         oldy=upy
         upy=mousey()
         ysize=((oldy-upy)/squares)
      endif
      grid(upx,upy,squares,squares,xsize,ysize,rgb(255,0,0),rgb(0,255,0))
   endif

   text 0,20,"Right Click to choose number of grid spaces"
   if mouseclick()=2
      cls
      gosub _get_cells:
   endif

   sync

loop


end

Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
  Next N
Endfunction

if done=200 then goto next

remstart
   ==============================================================
   =  Title  : Matrix Waypoint Creator
   =  Author : latch grapple
   =  Date   : 07/07/2007
   =  Update :
   =  Version: v.01
   ==============================================================
   Comments    Create waypoints for something to travel on
               on a matrix by clicking the grid squares on
               the green grid.  You can see the path that is traveled
               on the map (blue grid) and the camera will move on
               the matrix in the camera window.
   ==============================================================
remend

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

rem =============================================================
rem = MAIN
rem =============================================================
   gosub _init
   gosub _make_grids
   count=0                 : rem this is the number of set waypoints
   do
      gosub _set_waypoint
      gosub _map
      gosub _move_camera

      rem run through the waypoints
      gosub _run_through_waypoints

      rem clear grids and reset
      text 5,560,"Right Click to Reset Camera on new map"
      if mouseclick()=2
         delete matrix 1
         gosub _make_grids
         count=0
      endif

      text 600,60,"FPS  : "+str$(screen fps())

      sync
   loop

   end

rem =============================================================
rem = SUBROUTINES - PROCEDURES
rem =============================================================
   _init:
      randomize timer()

      rem matrix size
      matx=10000
      matz=10000
      tilex=25
      tilez=25
      xpertile#=matx/tilex
      zpertile#=matz/tilez

      rem way point grid size (use tilex and tilez for number of cells)
      xpos=0
      ypos=0
      xsize=10
      ysize=10

      rem array to hold all 625 (25x25) matrix locations x and z
      dim cell(625,1)
      n=0
      for z=1 to tilez
         for x=1 to tilex
            inc n
            rem centers of cells
            cell(n,0)=(x*xpertile#)-(xpertile#/2)
            cell(n,1)=(z*zpertile#)-(zpertile#/2)
         next x
      next z

      rem array to hold the waypoints.  Cells can be repeated
      rem dimension this to the maximum waypoints to record
      maxway=2000
      dim waypoints(maxway)

      rem get matrix textures
      gosub _textures

      gosub _lighting

   return
`-----------------------------------------------------------------
   _textures:
      rem create two bitmaps to draw textures on
      create bitmap 3,screen width(),screen height()
      create bitmap 4,screen width(),screen height()
      rem stone tile
      tiles=100
      while image exist(tiles)=1
         inc stone
      endwhile
      grid(0,0,1,1,128,128,rgb(255,255,255),rgb(100,100,100))
      for n=1 to 5
         blur bitmap 4,3
      next n
      get image tiles,0,0,274,137

      rem grass
      set current bitmap 3
      grass=tiles
      while image exist(grass)
         inc grass
      endwhile
      cls rgb(0,32,0)
      for n=0 to 10000
         ink rgb(20,rnd(80)+20,10),0
      dot rnd(137),rnd(137)
      next n
      blur bitmap 3,2
      get image grass,0,0,137,137
      set current bitmap 4
      paste image grass,137,0
      rem matrix textures
      get image tiles,0,0,274,137

      rem cleanup
      delete bitmap 3
      delete bitmap 4
      for n=1 to 51
      read a
      a$=a$+chr$(a)
      next n
      paste image tiles,0,0

   return
`-----------------------------------------------------------------
   _make_grids:
      rem matrix and camera
      `set camera view 281,1,790,511
      make matrix 1,matx,matz,tilex,tilez
      prepare matrix texture 1,tiles,2,1
      fill matrix 1,0,2
      randomize matrix 1,1000

      rem put in tiled walkway
      for x=11 to 13
         for z=0 to tilez-1
            set matrix tile 1,x,z,1
            set matrix height 1,x+1,z,0
            set matrix height 1,x,z,0
            set matrix height 1,x,z+1,0
            set matrix height 1,x+1,z+1,0
         next z
      next x
      for x=0 to tilex-1
         for z=11 to 13
            set matrix tile 1,x,z,1
            set matrix height 1,x+1,z,0
            set matrix height 1,x,z,0
            set matrix height 1,x,z+1,0
            set matrix height 1,x+1,z+1,0
         next z
      next x
      update matrix 1
      calc_mat_normals(1,tilex,tilez,matx/50.0,matz/50.0)

      color backdrop 0

      rem overhead map
      camy#=camera position y()
      position camera camera position x(),8700,camera position z()
      rotate camera 90,0,0
      set camera view 0,0,screen width(),screen height()
      fog off
      sync
      overhead=200
      get image overhead,110,12,701,600
      sprite overhead,0,0,overhead
      size sprite overhead,280,279
      set sprite overhead,0,0
      hide sprite overhead
      sync
      cls
      set camera view 281,1,790,511
      position camera camera position x(),camy#,camera position z()
      rotate camera 0,0,0
      fog on

      rem green grid
      grid(0,0,tilex,tilez,xsize,ysize,rgb(0,255,0),0)

      rem create a blue grid on bitmap 1
      create bitmap 1,276,276
      cls
      grid(0,0,tilex,tilez,xsize,ysize,255,0)
      overlay=overhead+1
      while image exist(overlay)=1
         inc overlay
      endwhile
      get image overlay,0,0,276,276
      sync
      sprite overlay,0,280,overlay
      hide sprite overlay
      set sprite overlay,0,1
      cls
      sync
      paste sprite overhead,0,0
      set current bitmap 0

      rem create a green grid on bitmap 2 for cell selection
      create bitmap 2,276,276
      cls
      grid(0,0,tilex,tilez,xsize,ysize,rgb(0,255,0),0)
      set current bitmap 0

      rem yellow border around camera window
      grid(280,0,1,1,510,510,RGB(255,255,0),0)

   return
`----------------------------------------------------------------
   _map:
      rem show movement path
      set current bitmap 1
      ink RGB(128,255,255),0
      mapx#=camera position x()/(matx/275)
      mapy#=275-(camera position z()/(matz/275))
      dot mapx#,mapy#
      get image 1,0,0,276,276
      set current bitmap 0
      paste image 1,0,280

      rem put overlay grid ontop of map
      text 381,560,"Press [CTRL] to toggle overlay grid on map"
      ink rgb(32,32,32),0
      text 0,580,a$
      ink RGB(128,255,255),0
      if controlkey()=1 then ctoggle=1-ctoggle
      repeat
         rem wait for control key to be released
      until controlkey()=0
      if ctoggle = 1
         paste sprite overlay,0,280
      endif
   return
`----------------------------------------------------------------
   _move_camera:
      curyang#=camera angle y()
      cy#=get ground height(1,camera position x(),camera position z())
      position camera camera position x(),cy#+50,camera position z()
      if upkey()=1 then move camera 10
      if leftkey()=1 then curyang#=wrapvalue(curyang#-2)
      if rightkey()=1 then curyang#=wrapvalue(curyang#+2)
      yrotate camera curyang#
   return
`----------------------------------------------------------------
   _set_waypoint:
      rem check for a way point
      wayset=mouse_cell(tilex,tilez,xsize,ysize)
      rem add the cell number to the list of waypoints
      if wayset > 0
         inc count
         if count > maxway then return
         waypoints(count)=wayset
      endif

   return
`------------------------------------------------------------------
   _run_through_waypoints:
      rem run through the waypoints
      text 381,520,"Press [ENTER] to move camera through waypoints"
      text 381,540,"Press [SPACE] to halt camera"
      if returnkey()=1
         if count > 0
            wayflag=0
            for n=1 to count

               repeat
                  rem get angle for smooth camera turning
                  cangy#=camera angle y()
                  point camera cell(waypoints(n),0),camera position y(),cell(waypoints(n),1)
                  newcangy#=camera angle y()
                  yrotate camera cangy#
                  cy#=get ground height(1,camera position x(),camera position z())
                  position camera camera position x(),cy#+50,camera position z()

                  wx=cell(waypoints(n),0)
                  wz=cell(waypoints(n),1)
                  rem is the camera within 50 units of the waypoint?
                  if camera position x() >= wx-25 and camera position x() <= wx+25
                     if camera position z() >= wz-25 and camera position z() <= wz+25
                        wayflag=1
                     endif
                  endif
                  rem start angle interpolation
                  final#=curveangle(newcangy#,cangy#,30)
                  yrotate camera final#
                  move camera 5
                  gosub _map
                  sync

                  rem check for space key to stop
                  if spacekey()=1 then return

               until wayflag=1
               wayflag=0
            next n
         endif
      endif
   return
`----------------------------------------------------------------
   _lighting:
      set ambient light 0
      set directional light 0,1,-1,1
      fog distance 8000
      fog on
      fog color RGB(32,32,64)
      set camera range 1,20000
   return
`----------------------------------------------------------------

`----------------------------------------------------------------
rem =============================================================
rem = FUNCTIONS
rem =============================================================
   Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
      Ink CellColourB,0
      Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
      Ink CellColourF,0
      For N=0 To Rows
         Line XPosition,  N*(YSize+1)+YPosition,  Columns*(XSize+1)+XPosition,  N*(YSize+1)+YPosition
      Next N
      For N=0 To Columns
         Line N*(XSize+1)+XPosition,  YPosition,  N*(XSize+1)+XPosition,  Rows*(YSize+1)+YPosition
      Next N
   Endfunction
`----------------------------------------------------------------
   function mouse_cell(horz,vert,cellsizex,cellsizey)
      result=0
      rem find actual cell
      cellx=int(mousex()/(cellsizex+1))+1
      celly=int(mousey()/(cellsizey+1))+1
      celly=(vert-celly)+1
      if (cellx > horz or cellx < 1) or (celly > vert or celly < 1)
         cellx=0
         celly=0
      endif
      curcell=((celly-1)*horz)+cellx
      if curcell <= 0 then curcell=0
      text 281,0,"Left Click Green Grid to set waypoint at:"
      text 600,0,"Horizontal cell # :"+str$(cellx)
      text 600,20,"Vertical cell #: "+str$(celly)
      `text 500,40,"Current Cell in grid: "+str$((horz*(celly-1))+cellx)
      text 600,40,"Current Cell in grid: "+str$(curcell)

      rem selected cell red
      if mouseclick()=1 and curcell > 0
         if point(mousex(),mousey())=rgb(255,0,0) or point(mousex(),mousey())=rgb(192,192,192)
            ink RGB(192,192,192),0
         else
            ink RGB(255,0,0),0
         endif
         set current bitmap 2
         box (cellx-1)*(cellsizex+1)+1,(celly-1)*(cellsizey+1)+1,((cellx-1)*(cellsizex+1)+1)+cellsizex-1,((celly-1)*(cellsizey+1)+1)+cellsizey-1
         flip bitmap 2
         get image 2,0,0,276,276
         flip bitmap 2
         set current bitmap 0
         paste image 2,0,0
         ink RGB(128,255,255),0
         repeat
            rem wait for mouse click release
         until mouseclick()=0
         result=curcell
      endif
   endfunction result
`----------------------------------------------------------------
   function calc_mat_normals(mat,tilex,tilez,sizex#,sizez#)
   Rem By Lee Bamber From DB Example - Adds shaded areas to matrix to give depth
   rem added tile and tile size factor for normal depth adjustment - latch
      for z=1 to tilez
         for x=1 to tilex

            rem Get matrix heights
            h8#=get matrix height(mat,x,z-1)
            h4#=get matrix height(mat,x-1,z)
            h#=get matrix height(mat,x,z)
            h2#=get matrix height(mat,x,z)

            rem Calculate projected angle X using heights
            x1#=(x-1)*sizex# : y1#=h#
            x2#=(x+0)*sizex# : y2#=h4#
            dx#=x2#-x1#
            dy#=y2#-y1#
            ax#=atanfull(dx#,dy#)
            ax#=wrapvalue(90-ax#)

            rem Calculate projected angle Z using heights
            z1#=(z-1)*sizez# : y1#=h2#
            z2#=(z+0)*sizez# : y2#=h8#
            dz#=z2#-z1#
            dy#=y2#-y1#
            az#=atanfull(dz#,dy#)
            az#=wrapvalue(90-az#)

            rem Make normal from projected angle
            nx#=sin(ax#)
            ny#=cos(ax#)
            nz#=sin(az#)

            rem Setting matrix normal for smoothness
            set matrix normal mat,x,z,nx#,ny#,nz#

         next x
      next z
      update matrix mat
   EndFunction

rem =============================================================
rem = DATA STATEMENTS
rem =============================================================
data 77,97,116,114,105,120,32,87,97,121,112,111,105
data 110,116,32,68,101,109,111,32,45,32,67,111,112
data 121,114,105,103,104,116,32,50,48,48,55,32,76
data 97,116,99,104,32,71,114,97,112,112,108,101

For N=1 To 10
  Circle 520,340,N
Next N

Gosub Setup

Rem Main Program Loop
Do
  If mousemovex()<>0 or mousemovey()<>0 then Blur Bitmap 0,6
  Sync
Loop
End


Rem **********************************************************************
Rem ***                           PROCEDURES                           ***
Rem **********************************************************************

Setup:
  Set Display Mode 640,480,32
  Sync On: Sync Rate 0
  CLS 0
  Hide Mouse

  ink rgb(250,225,205),0
  box 0,0,639,479
  ink rgb(246,221,200),0

  For N=1 To 200
    v=rnd(615)
    z=rnd(465)
    x=v+rnd(25)
    y=z+rnd(25)
    box v,z,x,y
  Next N
  Sync

  Blur Bitmap 0,6
  ink rgb(50,25,10),1
  box 100,98,220,224
  Grid(100,100,2,2,60,60,RGB(50,25,10),RGB(150,150,250))
  ink rgb(50,25,10),1
  box 220,98,260,224
  box 60,98,100,224
  ink rgb(100,75,30),1
  box 223,103,257,219
  box 63,103,97,220
  ink rgb(50,25,10),1
  box 400,200,550,479
  ink rgb(100,75,30),1
  box 410,210,470,469
  box 480,210,540,469
  ink rgb(255,205,95),1

  For N=1 To 10
    Circle 520,340,N
  Next N
  Blur Bitmap 0,1
Return


Rem **********************************************************************
Rem ***                            FUNCTIONS                           ***
Rem **********************************************************************

`TDK's function
Function Grid(XPosition,YPosition,Columns,Rows,XSize,YSize,CellColourF,CellColourB)
  Ink CellColourB,0
  Box XPosition,YPosition,XPosition+(Columns*(XSize+1)),YPosition+(Rows*(YSize+1))
  Ink CellColourF,0
  For N=0 To Rows
    Line XPosition,N*(YSize+1)+YPosition,Columns*(XSize+1)+XPosition,N*(YSize+1)+YPosition
  Next N
  For N=0 To Columns
    Line N*(XSize+1)+XPosition,YPosition,N*(XSize+1)+XPosition,Rows*(YSize+1)+YPosition
  Next N
Endfunction