
  '===============================
  'CLIPBOARD TEXT TO SPEECH READER
  '===============================

    
  '04:54 25/05/2011
  '07:10 23/10/2011
  '10:49 18/10/2013
  '20:47 18/09/2017
  '14:17 16/06/2023
  'Charles Pegge


  $ FileName "Speech.exe"
  #case capital
 'uses  RTL32
 'uses  RTL64
  uses  corewin
  uses  COM\Voice
  uses  Ogl

  ISpVoice * voice

  'GLOBALS

  sys hinstance
  sys hWndMain
  sys inst=GetModuleHandle 0
  asciiz * cmdline 
  @cmdline=GetCommandLine
  string szAppName="Clip-Speak"
  string szconfirm="Confirm Quit"
 
 
 function SelectPixelFormat(sys hdc) as int
 ==========================================

  '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                         '...
  '
  int 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 Remove(string*s, sys *i)
  =================================
  byte*b=strptr s
  byte a=b[i]
  b[i]=46 : i++ 'patch in dot for brief pause
  while b[i]=a
    b[i]=32 : i++ 
  wend
  end function

  function AdaptForSpeech(string*s)
  =================================
  'itr adaptations for reading programs needed
  sys i,le=len s
  macro TruncateAny(k)
    i=1
    do
      i=instr i,s,k
      if i 
        i+=2 : remove s,i
      else
        exit do
      end if
    end do
  end macro
  TruncateAny "***"
  TruncateAny "..."
  TruncateAny "==="
  TruncateAny "___"
  end function


  function ClipSpeak(sys* pt) as sys external
  ===========================================
  finit 'clear fpu to its standard settings
  static string sa,sb,se
  static sys i,p,q,le

  sys a,b,h,k,err
  '

  dat[3]=1 'set 'busy' flag
  '
  'IF NOT PAUSED
  '
  if dat[2]=0 then sb="" : le=0
  '
  if dat[2]=0 then
    OpenClipboard 0 'hwnd
    h=GetClipboardData CF_TEXT
    k=GlobalLock h
    zstring z at k : sa=z
    AdaptForSpeech(sa)
    sb+=sa
    le=len sb
    GlobalUnlock h
    CloseClipboard 0 'hwnd
    'print sb
  end if
  '
  dat<=0,0 'clear flags 1 stop and 2 pause
  '
  if dat[64] then
    i=dat[64]     'resume after pause
    dat[64]=0     'clear pause position
  else
    i=1
  end if
  '
  while i<=le
    p=instr i,sb,"."
    q=instr i,sb,","
    if q then
      if q<p or p=0 then
        p=q
      end if
    end if
    if p=0 then p=le
    p++
    se=mid sb,i,p-i
    voice.speak se
    voice.WaitUntilDone forever
    if dat[1] then exit do               'stop at end of sentence
    if dat[2] then dat[64]=p : exit do   'pause at end of sentence
    i=p
  wend
  '
  dat[3]=0 'clear 'busy' flag
  '
  end function




  function WndProc(sys hwnd,uMsg,wParam,lParam) as sys 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
    '------------------
    '
      if dat[3]=0 then
        actc=1
      else
        dat[2]=1 'pause
      end if
    '
    '----------------
    case WM_MOUSEMOVE
    '----------------
    '
    act=1
    '
    case WM_KEYDOWN
    '--------------
    '
    select wparam
    case 27
      dat[1]=1 'Request stop speaking at end of sentence
      SendMessage hwnd, WM_DESTROY, 0, 0
    case " "
      if dat[3]=0 then
        actc=1   'start / resume
      else
        dat[2]=1 'request pause at end of sentence
      end if
    case "S"
      dat[1]=1 'request Stop speaking at end of sentence
    case "P"
      dat[2]=1 'request Pause at end of sentence
    end select
    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
      dat[1]=1 'request speech stop at the end of the sentence.
      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 current thread to end
      '
      if hWinThread then
        WaitForMultipleObjects 1, @hWinThread, 1, -1 ' -1 INFINITE wait
        CloseHandle hWinThread
      end if
      '
      'create new thread
      '
      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); 
  end function



  Function WinMain(sys inst,prevInst,asciiz*cmdline,sys show) 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 


  int 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

  UpdateWindow hWnd
  ShowWindow hWnd,show
  sys Err
  CoInitialize byval 0
  Connectvoice voice
  '
  if Err then
    print "SAPI voice COM error: " mid hex(err),-8
    jmp fwd ExitWinMain
  end if
  '
  voice.speak "Hello"
  '
  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
  DisConnect voice
  CoUninitialize
  '
  exitWinMain:
  '
  function=wm.wparam

  end function ; end of WinMain




  WinMain inst,0,cmdline,SW_NORMAL
