[futurebasic] Knock, knock!

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : May 2002 : Group Archive : Group : All Groups

From: Alain Pastor <pixmix@...>
Date: Sun, 26 May 2002 21:57:33 +0200
Anybody's home?
This place looks so silent that's a bit scary.
YEEEEEEEAAAAAAAAAHHHHHH!!!!!!!
I can shout or say silly things, nobody would notice...

I am stuck with a couple of nasty things. Not that I have any use of
them at the moment, but who knows?



1 - How do you get the QDColors?
The piece of code below doesn't work correctly whether I use XREF or XREF@:

Toolbox Fn LMGetQDColors = Handle   `0x2EB8, 0x08B0
Toolbox LMSetQDColors( Handle value ) `0x21DF, 0x08B0

Window 1
Dim i As Long
Dim s As Str15
Dim r As Rect

Xref@ QDColors(7) As RGBColor

QDColors = Fn LMGetQDColors

SetRect(r,10,10,30,30)

For i = 0 To 7
  Select i
    Case 0 : s = "Black"
    Case 1 : s = "Yellow"
    Case 2 : s = "Magenta"
    Case 3 : s = "Red"
    Case 4 : s = "Cyan"
    Case 5 : s = "Green"
    Case 6 : s = "Blue"
    Case 7 : s = "White"
  End Select

  RGBForeColor( QDColors(i) ) : PaintRect( r )
  RGBForeColor( QDColors(0) ) : FrameRect( r )
  MoveTo( r.left, r.bottom + 10 )
  DrawString( s )
  OffsetRect( r, 50, 0 )
Next

Do
  Handleevents
Until Fn Button


2 - How do you set properly a SpeechDone callback Proc with the Speech Manager?
Caution: the prog below crashes with a hard reboot required.

Include "Tlbx SpeechSynthesis.Incl"

/*
     Missing Toolbox declarations
*/
Toolbox Fn SetCurrentA5 = Long `0x200D, 0x2A78, 0x0904

_gestaltSpeechMgrPresent = 0
_kTextToSpeechSynthType  = _"ttsc"
_soCurrentA5             = _"myA5"
_soSpeechDoneCallBack    = _"sdcb"
_soCurrentVoice          = _"cvox"
_soRefCon                = _"refc"
_incompatibleVoice       = -245

#If CarbonLib = 0
Library "SpeechLib"
#EndIf
Toolbox Fn NewSpeechDoneUPP( Ptr userRoutine ) = Ptr
Toolbox DisposeSpeechDoneUPP( Ptr userUPP )
#If CarbonLib = 0
Library
#EndIf

/*
     A custom record
*/
Begin Record Character
Dim name    As Str63
Dim gender  As Short
Dim age     As Short
Dim comment As Str255
Dim voice   As VoiceSpec
End Record

/*
     Too much global variables to my taste. 
*/
Begin Globals
Dim gCurrentCharacter As Int
Dim gCharacterCount   As Int
Dim gSpeechChannel    As SpeechChannel
Dim gSpeechDoneUPP    As Proc
Dim Dynamic gCharacters( _maxInt ) As Character
End Globals

/*
     Check for the Speech Manager
*/
Local Mode
Local Fn hasSpeechMgr : Dim @ speechAttr As Long
'~'9
End Fn = Fn Gestalt( _kTextToSpeechSynthType, speechAttr ) = _noErr ¬
      And ¬
        ( speechAttr And _gestaltSpeechMgrPresent% )


/*
     Set a dynamic array of characters, scanning
     the available voices.
     Return the number of items in the dynamic array.
*/
Clear Local
Local Fn GrabCharacters
'~'9
Dim   i     As Int
Dim @ chan  As Ptr
Dim @ count As Int
Dim   info  As VoiceDescription

Long If Fn CountVoices( count ) = _noErr
While count
Long If Fn GetIndVoice( count, info.voice ) = _noErr
Long If Fn GetVoiceDescription( info.voice, ¬
                                   info, ¬
                           Sizeof( info ) ) = _noErr
i++
gCharacters.name( i )    = info.name
gCharacters.gender( i )  = info.gender
gCharacters.age( i )     = info.age
gCharacters.comment( i ) = info.comment
gCharacters.voice( i )   = info.voice
End if
End if
count--
Wend
Compress Dynamic gCharacters
End if

End Fn = [@gCharacters + _AutoXREFCurr] - 1


/*
     Create a new channel with the specified voice
*/
Local Fn CreateSpeechChannel( voice As .VoiceSpec )
'~'9
Dim err      As OSErr
Dim @ curA5  As Long

err = Fn NewSpeechChannel( #voice, gSpeechChannel )

/*
     Attempt to install the callback proc
     Rem out the stuff below for no crash on speech done
*/

Long If err = _noErr

Long If gSpeechDoneUPP = _nil
gSpeechDoneUPP = Proc "SpeechDoneUPP"

#if CarbonLib
gSpeechDoneUPP = ¬
Fn NewSpeechDoneUPP( [gSpeechDoneUPP + _FBprocToProcPtrOffset] )
#Endif
End if

#If CarbonLib
curA5 = Fn SetCurrentA5
#Else
curA5 = [_currenta5]
#Endif

Long If Fn SetSpeechInfo( gSpeechChannel, ¬
                         _soCurrentA5, ¬
                                curA5 ) = _noErr
Long If Fn SetSpeechInfo( gSpeechChannel, ¬
                _soSpeechDoneCallBack, ¬
                       gSpeechDoneUPP ) = _noErr

End If
End If
End If

End Fn = err

/*
     Toying with the Speech Manager
*/
Clear Local
Local Fn IntroduceCharacter( index As Int )
'~'9
Dim @ spokenTextH   As Handle
Dim   err           As OSErr
Dim   msg           As Str255

/*
     Try to set the voice to the existing speech channel
*/
err = Fn SetSpeechInfo ( gSpeechChannel, ¬
                        _soCurrentVoice, ¬
               gCharacters.voice( index ) )
/*
     If we get an incompatibleVoice error we dispose of
     the existing channel and create a new one.
*/
Long If err = _incompatibleVoice
err = Fn DisposeSpeechChannel( gSpeechChannel )
Long If err = _noErr
err = Fn CreateSpeechChannel( gCharacters.voice( index ) )
End If
End If

If err Then Exit "Abort IntroduceCharacter"

/*
     build a string with embedded commands
*/
msg  = "[[rset 0]]My name is [[emph +]]" ¬
       + gCharacters.name( index )
msg += ".[[rate -10]] [[char LTRL]]"
msg += gCharacters.name( index ) + "[[char NORM]] "

Select gCharacters.gender( index )
Case _kNeuter : msg += "(neutral)."
Case _kMale   : msg += "(male)."
Case _kFemale : msg += "(female)."
End Select

msg +=  "[[slnc 500; pmod +1; pbas +1]]I am" ¬
      + Str$( gCharacters.age( Index ) ) ¬
      + " [[emph -]]years old. "

/*
     Create a text handle to speak
*/
err = Fn PtrToHand( @msg[1], spokenTextH, msg[0] )
If err Then "Abort IntroduceCharacter"

/*
     Append the built-in voice's comment to the handle
*/
msg = gCharacters.comment( index )
err = Fn PtrAndHand( @msg[1], spokenTextH, msg[0] )
If err Then "Abort IntroduceCharacter"

/*
     Lock the text handle
*/
HLock( spokenTextH )
err = Fn MemError
If err Then "Abort IntroduceCharacter"

/*
     Set the refCon of the speech channel to the
     text handle in hope we can dispose of it later
*/
err = Fn SetSpeechInfo( gSpeechChannel, _soRefCon, spokenTextH )
If err Then "Abort IntroduceCharacter"

/*
     Speak the text
*/
err = Fn SpeakText( gSpeechChannel, ¬
                     [spokenTextH], ¬
    Fn GetHandleSize( spokenTextH ) )
If err Then "Abort IntroduceCharacter"

/*
     Who's speaking?
*/
Print gCharacters.name( index )

/*
     All OK we can leave the fn
*/
Exit Fn

/*
     Something went bad, get rid of the text handle
*/
"Abort IntroduceCharacter"
Long If spokenTextH
HUnlock( spokenTextH )
DisposeHandle( spokenTextH )
spokenTextH = _nil
End If
End Fn


/*
     Function called by the SpeechDone callback proc
     will receive the refCon.
*/
Local Fn doSpeechDone( textH As Handle )
'~'9

Long If textH != _nil And Fn HGetState( textH ) != -1
HUnlock( textH )
DisposeHandle( textH )
textH = _nil
End if

End Fn

'~Main

Window 1
// Is Speech Manager here?
Long If Fn hasSpeechMgr
// Create a default speech channel
Long if Fn CreateSpeechChannel( _nil ) = _noErr
// Grab the available voices
gCharacterCount = Fn GrabCharacters
Print gCharacterCount; " available voices"
// line below to avoid a long boring speech during test
gCurrentCharacter = gCharacterCount - 2
Do
Handleevents
// Don't speak in background
Long If System( _aplActive ) > -1
// Wait our turn
Long If Fn SpeechBusySystemWide = _false
// Still actors to come into play?
Long If gCurrentCharacter < gCharacterCount
Delay _sec
gCurrentCharacter++
Fn IntroduceCharacter( gCurrentCharacter )
Xelse
// no more characters so quit the prog
Exit do
End If

End If
End If
Until _nil

Kill Dynamic gCharacters
Xelse
Print "Sorry you've got an aphonic computer today."
End If
End If

Do
Until Fn Button
End

"SpeechDoneUPP"
Enterproc ( chan As SpeechChannel, refCon As long )
Fn doSpeechDone( refCon )
Exitproc

-- 
Cheers,

Alain