Skeleton Animatronic Software

                                                  by Chuck Rice



                                                     [Image]

                  This is a simple project I created to test the operation of the Animatronic.
                 It uses simple sliders to manually control the animatronic, or if you press one
           or both of the buttons, it will generate seperate threads to randomly control the skeleton.





   Main Routines

  Main.Open:
  Sub Open()
    dim r as boolean
    dim i,rc as integer

    bugLog = new debugWindow
    bugLog.write "Surveyor Startup"

    appPrefs= New prefFileItem
    appPrefs.fileInfo= new folderItem
    rc=appPrefs.getText("Surveyor.prf")
    if rc=1 then  'create default prefs
      appPrefs.setCreatorType "smpl","pref"
      appPrefs.writeitem "Surveyor","SerialPortName",str(1)
      appPrefs.writeitem "Surveyor","MaxDelay",str(100)
      appPrefs.putText
    end if

    SerialPortName.listindex = val(appPrefs.readItem("Surveyor","SerialPortName"))
    MaxDelay.text = appPrefs.readItem("Surveyor","MaxDelay")

    'me.top     = screen(0).top  + 23
    'me.left    = screen(0).left + 10
    'me.width   = 685
    'me.height  = 200
    me.visible = true


    me.show
    me.refresh

    ft.servoinit(1)
    ft.servoinit(2)
    ft.servoMove(0,neck,75)
    ft.servoMove(0,jaw,0)
    ft.servoMove(0,arm,150)
    MoviePlayer1.play
  End Sub

  Main.SerialPortName.Open:
  Sub Open()
    dim count,i as integer
    dim x as string

    count = System.SerialPortCount

    if count <> 0 then
      for i = 0 to count-1
        me.addrow System.SerialPort(i).Name
      next
    end

  End Sub

  Main.SerialPortName.Change:
  Sub Change()
    dim r as boolean
    dim i,rc as integer

    appPrefs.writeitem "Surveyor","SerialPortName",str(SerialPortName.listindex)
    appPrefs.putText

    if sp <> nil then
      sp.close
      sp = nil
    end if

    thePort.SerialPort = System.SerialPort(SerialPortName.listindex)

    r = thePort.open
    sp = thePort

    if r then
      bugLog.write System.SerialPort(SerialPortName.listindex).name + " opened ------------*"

      ft = new FerretTronics(sp)

      me.refresh


    else
      msgbox "Could not open Serial Port"
      //quit
    end if

  End Sub

  Main.JawSlider.ValueChanged:
  Sub ValueChanged()
    ft.servoMove(0,jaw,me.Value)
  End Sub

  Main.HeadTurn.ValueChanged:
  Sub ValueChanged()
    ft.servoMove(0,neck,me.Value)
  End Sub

  Main.RunSkel1Head.Action:
  Sub Action()
    ft.servoinit(1)
    ft.servoMove(1,neck,75)
    ft.servoMove(1,jaw,0)
    if SkeletonThread = nil then
      bugLog.write me.name + " started"
      SkeletonThread = new SkeletonThreadClass
      SkeletonThread.run
      me.caption = "Stop"
    else
      SkeletonThread.notDone = false
      SkeletonThread = nil
      bugLog.write me.name + " stopped"
      me.caption = "Run"
    end if
  End Sub

  Main.MaxDelay.KeyDown:
  Function KeyDown(Key As String) As Boolean
    if val(me.text) > 6000 then
      beep
      me.text = "6000"
    end
    'appPrefs.writeitem "Surveyor","MaxDelay",me.text
    'appPrefs.putText

  End Function

  Main.ArmSlider.ValueChanged:
  Sub ValueChanged()
    ft.servoMove(1,arm,me.Value)
  End Sub

  Main.RunSkel1Arm.Action:
  Sub Action()
    ft.servoinit(1)
    ft.servoMove(1,arm,150)
    if Skel1RightArmThread = nil then
      bugLog.write me.name + " started"
      Skel1RightArmThread = new Skel1RightArmClass
      Skel1RightArmThread.run
      me.caption = "Stop"
    else
      Skel1RightArmThread.notDone = false
      Skel1RightArmThread = nil
      bugLog.write me.name + " stopped"
      me.caption = "Run"
    end if
  End Sub

  Main.MoviePlayer1.Open:
  Sub Open()
    dim f as folderItem
    f=New FolderItem
    f=GetFolderItem("Cauldron.mov")
    MoviePlayer1.movie=f.OpenAsMovie
    MoviePlayer1.play

  End Sub



   FerretTronics Subroutines



  FerretTronics.FerretTronics:
  Sub FerretTronics(serialPort as serial)
    '---------------------------------------------------------------
    'Constructor - Inits the FerretTronics Class
    '---------------------------------------------------------------

    dim r as boolean
    dim i as integer

    cCHIPSELECT = 239

    cACTIVE = 117
    cLONGPULSE = 90
    cSHORTPULSE = 85
    cHEADER = 96
    cSETUP = 122

    '----------------------------------------------------------------------

    sp = serialPort

    bugLog.write "FerretTronics Object Initialized - Copyright 1999, FerretTronics Inc."

  End Sub

  FerretTronics.servoMove:
  Sub servoMove(chip as integer,servo as integer, position as integer)
    '------------------------------------------------------------------
    'sends the bytes required to move a servo (FT639) to a new position
    '------------------------------------------------------------------
    DIM uV  as integer
    DIM lV  as integer

    me.routeChipSelect(chip)

    uV = position / 16
    lV = position - (uV * 16)
    uV = uV + 128 + (servo - 1) * 16
    lV = lV + (servo - 1) * 16

    sp.write chr(lV) + chr(uV)
    'waitTicks(10)
    bugLog.write "Moving Servo " + str(servo) + " to " + str(position)

  End Sub

  FerretTronics.routeChipSelect:
  Sub routeChipSelect(chip as integer)
    '---------------------------------------------------------------
    'Sends a chip select signal to the FT649 to select one of five
    'attached FT609 or FT639 chips
    '---------------------------------------------------------------
    dim xchip as integer

    xchip = chip 'copy so we can modify it

    if (xchip < 0) or (xchip > 5) then
      msgbox "The selected chip (" + str(chip) + ") is out of range (0 to 5)"
      xchip = 0
      beep
    end if

    if xchip <> 0 then
      sp.write chr(cCHIPSELECT+xchip)
      buglog.write "Chip " + str(xchip) + " selected"
    end if


  End Sub

  FerretTronics.servoLongPulse:
  Sub servoLongPulse()
    '---------------------------------------------------------------
    'Sets FT639 Longpules mode
    '---------------------------------------------------------------
    sp.write chr(cSETUP) + chr(cLONGPULSE) + chr(cACTIVE)
  End Sub

  FerretTronics.servoShortPluse:
  Sub servoShortPluse()
    '---------------------------------------------------------------
    'Sets FT639 ShortPulse mode
    '---------------------------------------------------------------
    sp.write chr(cSETUP) + chr(cSHORTPULSE) + chr(cACTIVE)
  End Sub

  FerretTronics.servoSetHeader:
  Sub servoSetHeader(head as integer)
    '---------------------------------------------------------------
    'Sets FT639 Header value
    '---------------------------------------------------------------
    sp.write chr(cSETUP) + chr(cHEADER+head) + chr(cACTIVE)
  End Sub

  FerretTronics.servoInit:
  Sub servoInit(chip as integer)
    '---------------------------------------------------------------
    'Sets FT639 chip to a known state
    '---------------------------------------------------------------
    me.routeChipSelect(chip)
    me.servoLongPulse
    me.servoSetHeader(4)
    bugLog.write "Initialization commands sent to Servo " + str(chip)
  End Sub

  FerretTronics.waitTicks:
  Sub waitTicks(delayticks as double)
    dim targetTick as double
    targetTick = Ticks + delayTicks

    while targetTick > Ticks

    wend

  End Sub

  FerretTronics.DataAvailable:
  Sub DataAvailable()
    '---------------------------------------------------------------
    'Reads incoming data from the FT629 and stores the switch states
    'array. To access, use ft.switch(n)
    '---------------------------------------------------------------
    dim n,i as integer
    dim buffer as string
    beep
    buffer = sp.readAll
    n = len(buffer)
    while n > 0
      for i = 0 to 4   'Check each of the five switch values
        if bitwiseAnd(asc(mid(buffer,n,1)),pow(2,i) ) <> 0 then
          switch(i) = true   'Switch is on
        else
          switch(i) = false  'Switch is off
        end if
      next
      n = n - 1
    wend
  End Sub



   Skeleton Thread

   SkeletonThreadClass.Run:

  Sub Run()
    dim i,r,r2 as integer
    dim arm,narm as integer

    me.notDone = true

    while me.notDone
      ft.servoinit(1)

      r = (rnd*val(main.MaxDelay.text))+1
      bugLog.write "delay " + str(r)
      ft.waitTicks r

      if me.notDone and (rnd>.50) Then
        bugLog.write "Left Head to center"

        r = (rnd*30)+1
        for i = 25 to 90 step r
          ft.servoMove(0,neck,i)
          'ft.waitTicks 1
        next
      end if

      if me.notDone and (rnd>.60) Then
        bugLog.write "Talk"
        r = (rnd*5)+1
        for i = 1 to r
          r2 = (rnd*20)+20
          ft.waitTicks (r2/3)
          ft.servoMove(0,jaw,r2)
          ft.waitTicks (r2/3)
          ft.servoMove(0,jaw,0)

          'ft.waitTicks 30
          'ft.servoMove(0,jaw,r2)
          'ft.waitTicks (r2/3)
          'ft.servoMove(0,jaw,0)
        next
      end if

      if me.notDone and (rnd>.50) Then
        bugLog.write "Center Head to right"
        r = (rnd*30)+1
        for i = 90 to 170 step r
          ft.servoMove(0,neck,i)
          'ft.waitTicks 1
        next
      end if


      if me.notDone and (rnd>.50) Then
        bugLog.write "Right Head to Left"
        r = (rnd*30)+1
        for i = 170 downto 25 step r
          ft.servoMove(0,neck,i)
          'ft.waitTicks 1
        next
      end if


    wend
    ft.servoMove(0,neck,75)
    ft.servoMove(0,jaw,1)

  End Sub



   Skel1RightArmClass



  Skel1RightArmClass.Run:
  Sub Run()
    dim i,r,r2 as integer
    dim armP,narm,armstep as integer
    dim b as string

    me.notDone = true
    b = " "
    for i = 1 to 8
      b = b+b
    next

    ft.servoinit(1)
    armP = 75
    ft.servoMove(0,arm,armP)

    while me.notDone
      r = (rnd*val(main.MaxDelay.text))+1
      ft.waitTicks r

      if me.notDone and (rnd>.10) Then
        'bugLog.write "Arm"
        r  = (rnd*20)+40
        r2 = (rnd*4)+1.1
        r2 = r2 - 2.5

        if rnd>.9 then
          narm = 90
        else
          narm = armP + (r2*r)
        end if

        if narm > 200 then
          narm = 200
        end if

        if narm < 0 then
          narm = 0
        end if

        armstep = rnd*5 +1


        While armP > narm
          armP = armP-armstep
          ft.servoMove(0,arm,armP)
          bugLog.write "Arm " +str(armP) + " " + str(r2) + Right(b +"*",armP/5)
        wend

        While armP < narm
          armP = armP+armstep
          ft.servoMove(0,arm,armP)
          bugLog.write "Arm " +str(armP) + " " + str(r2) + Right(b +"*",armP/5)
        wend
      end if

    wend
    ft.servoMove(0,arm,75)

  End Sub



   Preferences Subroutines

  Many thanks to D. Zouras for this module. Unfortunately, I have lost the link to his page. If anyone knows
  where it is, let me know.



  prefFileItem.writeItem:
  Sub writeItem(sectionName as string, itemName as string, itemValue as string)
    'this sub will either update the value of itemName with itemValue if it exists
    'or it will create itemName and assign itemValue to it if it doesn't exist
    'if the sectionName does not exist, that will be created also

    dim temp, itemText as string
    dim sectionHeading,itemLabel as String
    dim sectionPos,nextSectionPos,itemPos,itemEndPos as integer
    dim headingLen,itemsLen,labelLen as integer
    dim beforeItem, afterItem as string


    temp=me.fileText
    sectionHeading="["+sectionName+"]"
    headingLen=len(sectionHeading)+1  'add 1 for return at end of line
    itemLabel=itemName+"="
    labelLen=len(itemLabel)

    sectionPos=instr(temp,sectionHeading)
    if sectionPos>0 then
      nextSectionPos=instr(sectionPos+headingLen,temp,"[")
      if nextSectionPos<>0 then
        itemsLen=nextSectionPos-(sectionPos+headingLen)
        itemText=mid(temp,sectionPos+headingLen,itemsLen)
        itemPos=instr(itemText,itemLabel)
        itemEndPos=instr(itemPos,itemText,CHR(13))
      else  'no next section
        itemText=mid(temp,sectionPos+headingLen)
        itemPos=instr(itemText,itemLabel)
        'itemEndPos=len(itemText)+1
        itemEndPos=instr(itemPos,itemText,CHR(13))
      end if

      if itemPos>0 then 'exists
        'breaking item string apart to insert itemValue
        beforeItem=mid(itemText,1,itemPos+labelLen-1)
        afterItem=mid(itemText,itemEndPos)
        itemText=beforeItem+itemValue+afterItem
      else  'item does not exist
        itemText=itemText+itemName+"="+itemValue+CHR(13)
      end if
      'breaking entire prefs string apart to reinsert the updated itemText
      beforeItem=mid(temp,1,sectionPos+headingLen-1)
      if nextSectionPos=0 then
        afterItem=""
      else
        afterItem=mid(temp,nextSectionPos)
      end if
      temp=beforeItem+itemText+afterItem
      me.fileText=temp
    else  'section not found
      me.fileText=me.fileText+CHR(13)+sectionHeading+CHR(13)+itemName+"="+itemValue+CHR(13)  'add section & item
    end if
    me.saved=false
  End Sub

  prefFileItem.readItem:
  Function readItem(sectionName as string, itemName as string) As String
    'returns value for itemName if found, else returns null

    dim temp, itemText as string
    dim itemValue As String
    dim sectionHeading,itemLabel as String
    dim sectionPos,nextSectionPos,itemPos,itemEndPos as integer
    dim headingLen,itemsLen,labelLen as integer

    temp=me.fileText
    sectionHeading="["+sectionName+"]"
    headingLen=len(sectionHeading)+1  'add 1 for return at end of line
    itemLabel=itemName+"="
    labelLen=len(itemLabel)

    sectionPos=instr(temp,sectionHeading)
    if sectionPos>0 then
      nextSectionPos=instr(sectionPos+headingLen,temp,"[")
      if nextSectionPos<>0 then
        itemsLen=nextSectionPos-(sectionPos+headingLen)
        itemText=mid(temp,sectionPos+headingLen,itemsLen)
        itemPos=instr(itemText,itemLabel)
        itemEndPos=instr(itemPos,itemText,CHR(13))
      else  'no next section
        itemText=mid(temp,sectionPos+headingLen)
        itemPos=instr(itemText,itemLabel)
        'itemEndPos=len(itemText)+1
        itemEndPos=instr(itemPos,itemText,CHR(13))
      end if

      if itemPos>0 then 'exists
        ItemValue=mid(itemText,itemPos+labelLen,itemEndPos-(itemPos+labelLen))
      else  'no item to read
        itemValue=""
      end if
    else  'section not found
      itemValue=""
    end if

    return itemValue

  End Function

  prefFileItem.deleteItem:
  Sub deleteItem(sectionName as string, itemName as string)
    'deletes itemName and its itemValue if it exists

    dim temp, itemText as string
    dim sectionHeading,itemLabel as String
    dim sectionPos,nextSectionPos,itemPos,itemEndPos as integer
    dim headingLen,itemsLen,labelLen as integer
    dim beforeItem, afterItem as string


    temp=me.fileText
    sectionHeading="["+sectionName+"]"
    headingLen=len(sectionHeading)+1  'add 1 for return at end of line
    itemLabel=itemName+"="
    labelLen=len(itemLabel)

    sectionPos=instr(temp,sectionHeading)
    if sectionPos>0 then
      nextSectionPos=instr(sectionPos+headingLen,temp,"[")
      if nextSectionPos<>0 then
        itemsLen=nextSectionPos-(sectionPos+headingLen)
        itemText=mid(temp,sectionPos+headingLen,itemsLen)
        itemPos=instr(itemText,itemLabel)
        itemEndPos=instr(itemPos,itemText,CHR(13))
      else  'no next section
        itemText=mid(temp,sectionPos+headingLen)
        itemPos=instr(itemText,itemLabel)
        'itemEndPos=len(itemText)+1
        itemEndPos=instr(itemPos,itemText,CHR(13))
      end if

      if itemPos>0 then 'exists
        'breaking item string apart to delete item
        beforeItem=mid(itemText,1,itemPos-1)
        afterItem=mid(itemText,itemEndPos+1)
        itemText=beforeItem+afterItem
      else  'item does not exist
        'do nothing
      end if
      'breaking entire prefs string apart to reinsert the updated itemText
      beforeItem=mid(temp,1,sectionPos+headingLen-1)
      if nextSectionPos=0 then
        afterItem=""
      else
        afterItem=mid(temp,nextSectionPos)
      end if
      temp=beforeItem+itemText+afterItem
      me.fileText=temp
    else  'section not found
      'do nothing, can't find item in nonexistent section
    end if
    me.saved=false
  End Sub

  prefFileItem.deleteSection:
  Sub deleteSection(sectionName as string)
    'deletes the entire section and related items under sectionName

    dim temp, itemText as string
    dim sectionHeading,itemLabel as String
    dim sectionPos,nextSectionPos as integer
    dim headingLen,itemsLen as integer
    dim beforeItem, afterItem as string

    temp=me.fileText
    sectionHeading="["+sectionName+"]"
    headingLen=len(sectionHeading)+1  'add 1 for return at end of line

    sectionPos=instr(temp,sectionHeading)
    if sectionPos>0 then
      nextSectionPos=instr(sectionPos+headingLen,temp,"[")
      if nextSectionPos<>0 then
        itemsLen=nextSectionPos-(sectionPos+headingLen)
        itemText=mid(temp,sectionPos+headingLen,itemsLen)
      else  'no next section
        itemText=mid(temp,sectionPos+headingLen)
      end if

      'breaking entire prefs string apart to delete the itemText
      if nextSectionPos=0 then
        beforeItem=mid(temp,1,sectionPos-2)
        afterItem=""
        msgBox itemText
      else
        beforeItem=mid(temp,1,sectionPos-1)
        afterItem=mid(temp,nextSectionPos)
      end if
      temp=beforeItem+afterItem
      me.fileText=temp
    else  'section not found
      'nothing to delete
    end if
    me.saved=false
  End Sub

  prefFileItem.clear:
  Sub clear()
    'reset the fileText property
    'still need to putText if you want to clear the file on disk

    me.fileText="This file created with Pref Maker class.  ©D. Zouras 1998"+CHR(13)
    me.saved=false
  End Sub

  prefFileItem.getText:
  Function getText(prefFile as string) As integer
    'reads the folderItem with name prefFile in the systemFolder:PreferencesFolder
    '0=success  1=file did not exist, created blank

    dim inStream As TextInputStream
    dim outStream as textoutputstream
    dim prefFolder as folderitem
    dim rc as integer

    prefFolder=preferencesFolder
    //assign the path
     me.fileInfo= getfolderItem(prefFolder.absolutepath+prefFile)
    //see if we need to create a new prefs file or not
    if me.fileInfo.exists then
      inStream=me.fileInfo.OpenAsTextFile
      me.fileText=inStream.readAll
      me.fileText=mid(me.fileText,1,len(me.fileText)-1)
      inStream.close
      rc=0
    else  'create new pref file
      me.fileText="This file created with Pref Maker class.  ©D. Zouras 1998"+CHR(13)
      outStream=me.fileInfo.CreateTextFile
      outStream.WriteLine me.fileText
      outStream.Close
      rc=1
    end
    me.saved=true

    return rc
  End Function

  prefFileItem.putText:
  Sub putText()
    'writes the text in the fileText property to the folderItem of this object

    dim outStream As TextOutputStream
    dim type,creator as string

    creator=me.fileInfo.MacCreator
    type=me.fileInfo.MacType

    outStream=me.fileInfo.CreateTextFile
    outStream.WriteLine me.fileText
    outStream.Close
    setCreatorType creator,type
    me.saved=true  'just wrote to disk

  End Sub

  prefFileItem.setCreatorType:
  Sub setCreatorType(creator as string,type as string)
    'set the creator and type for the prefFile object
    'if a parameter is not 4 chars long then no change will be made
    'to it, but the other is independently tested

    if len(creator)=4 then
      me.fileInfo.MacCreator=creator
    end if
    if len(type)=4 then
      me.fileInfo.MacType=type
    end if
  End Sub



   Debugging Log

                                                     [Image]





  debugWindow.write:
  Sub write(line as string)
    dim d as date

    if me.debugLog.Listcount > 2000 then
      me.debugLog.DeleteAllRows
    end

    d = new date
    me.debugLog.addRow d.LongTime + "   " + line
    me.debugLog.ListIndex = me.debugLog.LastIndex
    me.refresh
  End Sub

  debugWindow.Open:
  Sub Open()

    '--------------------------------
    ' In your main routine add:
    '   bugLog = new debugWindow
    '   bugLog.write "BugLog Startup"
    ' In your global properties, add:
    '   bugLog as debugWindow
    '--------------------------------

    //me.write "Debug Mode Activated"
    me.top = screen(0).height - (me.height+1)
    me.left = screen(0).left + 10
    //me.width = 500
    me.visible = true
  End Sub