|
Skeleton Animatronic Software by Chuck Rice
This is a simple project I created to test the operation of
the Animatronic. |
| 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 
|
|
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
|
