Oxygen Basic
		Programming => Example Code => Utility => Topic started by: Charles Pegge on May 24, 2011, 07:49:27 PM
		
			
			- 
				I have a text-to-speech reader 'Digalo', which I nicknamed Smokey Gordon. I have had him since Windows Millenium so he is very old and by the timbre of his voice he is obviously a heavy smoker. In Vista he is rather unstable and cannot cope with PC hibernation. Smokey Gordon does about 95% of my web reading and I have found TTS an indispensable aid to covering large amounts of material and proof reading.
 
 So I thought I would have a go at making a new clipboard speaker now that we can access all the necessary components. This example is a combination of COM/SAPI 5, Opengl threading and Clipboard. Unfortunately  some of the components of SAPI are not available under Wine, and also the Windows-XP voice 'Sam' is very rough. So this is only suitable for Vista and Windows 7.
 
 
 The is example is minimal. when you click on it, the text contents of the clipboard will be spoken by the 'Anna' voice.
 
 I include this in examples/sound (Oxygen in-progress version)
 
 
 
 
 '$ FileName "t.exe"
 'include "..\..\inc\RTL32.inc"
 
 
 
 '===============================
 'CLIPBOARD TEXT TO SPEECH READER
 '===============================
 
 
 '04:54 25/05/2011
 'Charles Pegge
 
 #case capital
 #include "../../inc/minwin.inc"
 #include "../../inc/COM/Voice.inc"
 
 s=error()
 '
 if s then
 print s
 goto endprog
 end if
 
 #define WINGDIAPI
 #define APIENTRY
 #define const
 
 typedef word wchar_t
 typedef sys ptrdiff_t
 
 includepath +"../../inc/glo2/"
 library "opengl32.dll"
 include once "gl/gl.h"
 'include once "gl/glext.h"
 library "glu32.dll"
 include once "gl/glu.h"
 include once "gl/wgl.inc"
 library ""
 
 
 '=====================================
 
 
 'GLOBAL VARIABLES
 '----------------
 
 sys hinstance
 sys hWndMain
 
 
 
 sys inst=GetModuleHandle 0
 asciiz * cmdline
 &cmdline=GetCommandLine
 string szAppName="Clip-Speak"
 string szconfirm="Confirm Quit"
 
 '=====================================
 
 
 '---------------------------------------------------
 function SelectPixelFormat(byval hdc as long) as sys
 '===================================================
 
 'setup pixel format
 
 
 PIXELFORMATDESCRIPTOR pfd
 '
 pfd.nSize           = sizeof PIXELFORMATDESCRIPTOR 'Size of UDT structure
 pfd.nVersion        = 1                            'Version. Always set to 1.
 pfd.dwFlags         = PFD_DRAW_TO_WINDOW or _      'Support Window
 PFD_SUPPORT_OPENGL or _      'Support OpenGL
 PFD_DOUBLEBUFFER             'Support Double Buffering
 pfd.iPixelType      = PFD_TYPE_RGBA                'Red, Green, Blue, & Alpha Mode
 pfd.cColorBits      = 32                           '32-Bit Color Mode
 pfd.cRedBits        = NULL                         'Ignore Color and Shift Bits...
 pfd.cRedShift       = NULL                         '...
 pfd.cGreenBits      = NULL                         '...
 pfd.cGreenShift     = NULL                         '...
 pfd.cBlueBits       = NULL                         '...
 pfd.cBlueShift      = NULL                         '...
 pfd.cAlphaBits      = NULL                         'No Alpha Buffer
 pfd.cAlphaShift     = NULL                         'Ignore Shift Bit.
 pfd.cAccumBits      = NULL                         'No Accumulation Buffer
 pfd.cAccumRedBits   = NULL                         'Ignore Accumulation Bits...
 pfd.cAccumGreenBits = NULL                         '...
 pfd.cAccumBlueBits  = NULL                         '...
 pfd.cAccumAlphaBits = NULL                         '... Good Cereal! ;)
 pfd.cDepthBits      = 16                           ' bits z-buffer depth 8 16 24
 pfd.cStencilBits    = 1                            'Stencil Buffer
 pfd.cAuxBuffers     = NULL                         'No Auxiliary Buffer
 pfd.iLayerType      = PFD_MAIN_PLANE               'Main Drawing Plane
 pfd.bReserved       = NULL                         'Reserved
 pfd.dwLayerMask     = NULL                         'Ignore Layer Masks...
 pfd.dwVisibleMask   = NULL                         '...
 pfd.dwDamageMask    = NULL                         '...
 '
 nPixelFormat = ChoosePixelFormat(hDC, &pfd) 'First without multisampling
 '
 SetPixelFormat(hDC, nPixelFormat, &pfd)
 return nPixelFormat
 '
 end function
 
 
 
 'STANDARD CHILD WINDOWS STYLES
 '=============================
 '
 'Button	The class for a button.
 'ComboBox	The class for a combo box.
 'Edit	        The class for an edit control.
 'ListBox	The class for a list box.
 'MDIClient	The class for an MDI client window.
 'ScrollBar	The class for a scroll bar.
 'Static	The class for a static control.
 
 
 sys hDC,hRC,act,actc
 sys dat[100]
 
 '
 '------------------------------------------
 function ClipSpeak(sys*dat) as sys external
 '==========================================
 '
 OpenClipboard 0 'hwnd
 h = GetClipboardData CF_TEXT
 k = GlobalLock h
 zstring z at k : wstring s=z
 GlobalUnlock h
 CloseClipboard 0 'hwnd
 'print s
 '
 incl VoiceMacros
 Connect voice
 voice.Speak s
 ErrorHandler return 0
 voice.WaitUntilDone forever
 DisConnect voice
 '
 end function
 
 
 
 '------------------------------------------------------------------------------------
 function WndProc(dword hwnd, dword uMsg, dword wParam, dword lParam) as long callback
 '====================================================================================
 {
 static single ang1,ang2,angi1=-2,angi2=1
 static sys hWinThread, hWinThreadId
 static sys i,h,k
 
 select umsg
 
 case WM_CREATE
 '-------------
 '
 'SETUP DEVICE CONTEXT AND RENDER CONTEXT
 '
 hDC=GetDC hwnd
 selectpixelformat hdc
 hRC = wglCreateContext hDC
 wglMakeCurrent hDC, hRC
 return 0
 '
 '
 '
 case WM_TIMER
 '------------
 '
 act=1
 
 case WM_LBUTTONDOWN
 '------------------
 '
 actc=1
 '
 '----------------
 case WM_MOUSEMOVE
 '----------------
 '
 act=1
 '
 case WM_KEYDOWN
 '--------------
 '
 if wparam=27 then SendMessage hwnd, WM_DESTROY, 0, 0
 if wparam=32 then actc=1
 return 0
 '
 case WM_SIZE
 '
 act=1
 '
 case WM_CLOSE
 '------------
 '
 'Create the message box. If the user clicks
 'the Yes button, destroy the main window.
 '
 'if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES)
 DestroyWindow(hwndMain);
 'end if
 return 0
 '
 case WM_ERASEBKGND
 '-----------------
 '
 return 0
 '
 case WM_DESTROY
 '--------------
 '
 if hWinThread then
 WaitForMultipleObjects 1, @hWinThread, 1, -1 ' -1 INFINITE wait
 CloseHandle hWinThread
 end if
 wglMakeCurrent hDC, NULL
 wglDeleteContext hRC
 ReleaseDC hWnd,hDC
 PostQuitMessage(0);
 return 0
 '
 '
 end select
 '
 '
 '--------------------
 'CREATE SPEECH THREAD
 '====================
 '
 if actc then
 actc=0
 'wait for previous to end
 if hWinThread then
 WaitForMultipleObjects 1, @hWinThread, 1, -1 ' -1 INFINITE wait
 CloseHandle hWinThread
 end if
 hWinThread=CreateThread 0, 0, @ClipSpeak, @dat, 0, @hWinThreadId
 '
 end if
 '
 '
 static RECT crect
 static single s1,s2,s3,s4
 '
 '
 '
 if act then
 act=0
 '
 '-----------------------------------
 'CREATE SCENE FRAME AND SWAP BUFFERS
 '===================================
 '
 'SET THE VIEWPORT AND PERSPECTIVE
 '
 GetClientRect  hwnd,&cRect
 glViewport 0, 0, crect.right, crect.bottom
 double aspect=crect.right/crect.bottom
 '
 glMatrixMode   GL_PROJECTION
 glLoadIdentity
 gluPerspective 45, aspect, 1.0, 100
 glMatrixMode   GL_MODELVIEW
 glLoadIdentity
 '
 glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
 glClearColor 0.5, 0, 0, 0
 '
 '
 'SHAPE
 '
 s1=.2    'x y
 s2=-1    'z
 s3=0.5   'color
 s4=s3*.2 'color
 '
 glrotatef ang1, 0,0,1
 '
 glbegin GL_QUADS
 glcolor4f   00,  s3,  s3, 1 : glvertex3f -s1, -s1,  s2
 glcolor4f   s3,  s3,  00, 1 : glvertex3f  s1, -s1,  s2
 glcolor4f   s4,   0,  s3, 1 : glvertex3f  s1,  s1,  s2
 glcolor4f   s4,   0,  s3, 1 : glvertex3f -s1,  s1,  s2
 glend
 '
 glfinish
 swapBuffers hdc
 '
 '
 'UPDATE ROTATION ANGLES
 '----------------------
 '
 ang1+=angi1
 '
 return 0 'done
 '
 end if 'act
 '----------
 '
 '
 'for unprocessed messages:
 '
 return DefWindowProc(hwnd, uMsg, wParam, lParam);
 }
 
 
 
 '------------------------------------------------------------
 Function WinMain(byval inst as long ,byval prevInst as long,
 byval cmdline as asciiz , byval show as long) as long
 '===========================================================
 '
 ; window handle
 
 dim a,b,c,hWnd as long
 dim wc as WNDCLASS
 dim wm as MSG
 
 with wc.                 '
 style=CS_HREDRAW or CS_VREDRAW
 lpfnWndProc=&WndProc '#long#long#long#long
 cbClsExtra=0
 cbWndExtra=0
 hInstance=inst
 hIcon=LoadIcon 0, IDI_APPLICATION
 hCursor=LoadCursor 0,IDC_ARROW
 hbrBackground=GetStockObject BLACK_BRUSH '
 lpszMenuName=0
 lpszClassName="graphic"
 end with
 
 hinstance=inst
 
 if not RegisterClass &wc
 MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
 exit function
 end if
 
 
 style=WS_OVERLAPPEDWINDOW
 'style=WS_OVERLAPPEDWINDOW | 'overlapped window
 '      WS_HSCROLL |          'horizontal scroll bar
 '      WS_VSCROLL            'vertical scroll bar
 
 
 'Create the main window.
 
 hwndMain = CreateWindowEx(
 0,                      'no extended styles
 "graphic",              'class name
 *szAppName,             'window title
 style,                  '
 CW_USEDEFAULT,          'default horizontal position
 CW_USEDEFAULT,          'default vertical position
 200,                    'default width
 100,                    'default height
 NULL,                   'no parent or owner window
 NULL,                   'class menu used
 hinstance,              'instance handle
 NULL);                  'no window creation data
 
 
 'Show the window using the flag specified by the program
 'that started the application, and send the application
 'a WM_PAINT message.
 
 hwnd=hwndMain
 
 if not hWnd then
 MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
 exit function
 end if
 
 ShowWindow hWnd,show
 UpdateWindow hWnd
 '
 SetTimer hWnd,1,30,NULL
 '
 '
 'MESSAGE LOOP
 '------------
 '
 sys bRet
 '
 do while bRet := GetMessage (&wm, 0, 0, 0)
 if bRet == -1 then
 'show an error message?
 else
 TranslateMessage &wm
 DispatchMessage &wm
 end if
 wend
 '
 killTimer hwnd, 1
 '
 function=wm.wparam
 
 end function ; end of WinMain
 
 
 
 
 WinMain inst,0,cmdline,SW_NORMAL
 
 
 '=================
 endprog: 'CLEAN UP
 '=================
 
 FreeMinWinLibraries
 
 Charles