(*
 * FPMs-TCTS SOFTWARE LIBRARY
 *
 * File    : mbrola.pas
 * Purpose : Mbrola interface with the MBROLA synthesizer DLL
 * Author  : Alain Ruelle
 * Email   : ruelle@multitel.be
 *
 * Copyright (c) 1997 Faculte Polytechnique de Mons (TCTS lab)
 * All rights reserved.
 *
 * translated to Delphi by Antonio Borges
 *               NCE/UFRJ - The Dosvox Project - 2007
 *)

unit mbrola;

interface
uses
  Windows, Messages, SysUtils;

function load_MBR: boolean;
procedure unload_MBR;
function loaded_MBR: boolean;

(*---------------------------------------------------------*)

const
  PITCH_SWITCH = ';; F = ';
  TIME_SWITCH  = ';; T = ';

type
  AudioType = (
    LIN16 = 0,    // same as intern computation format: 16 bits linear
    LIN8,         // unsigned linear 8 bits, worse than telephone
    ULAW,         // MU law -> 8bits, telephone. Roughly equ. to 12bits
    ALAW          // A law  -> 8bits, equivallent to mulaw
  );

type
  PParser = Pointer;
  LPPHONE = Pointer;

var
  hinstDllMBR: THandle;

  init_MBR:            function (dbaname: PChar): Integer; stdcall;
  init_rename_MBR:     function (dbaname, replacing, cloning: PChar): Integer; stdcall;
  write_MBR:           function (buffer_in: PChar): Integer; stdcall;
  flush_MBR:           function: Integer; stdcall;
  read_MBR:            function (buffer_out: PShortInt; nb_wanted: Integer): Integer; stdcall;
  readType_MBR:        function (buffer_out: PShortInt; nb_wanted: Integer; filter: AudioType): Integer; stdcall;
  close_MBR:           procedure; stdcall;
  reset_MBR:           procedure; stdcall;

  lastError_MBR:       function: Integer; stdcall;
  lastErrorStr_MBR:    function (buffer_err: PChar; nb_wanted: Integer): PChar; stdcall;
  setNoError_MBR:      procedure (ignoreErrors: Integer); stdcall;
  getNoError_MBR:      function: Integer; stdcall;

  setFreq_MBR:         procedure (nFreq: Integer); stdcall;
  getFreq_MBR:         function: Integer; stdcall;
  setVolumeRatio_MBR:  procedure (fVol: Real); stdcall;
  getVolumeRatio_MBR:  function: Real; stdcall;

  getVersion_MBR:      function (buffer: PChar; nb_wanted: Integer): Integer; stdcall;
  getDatabaseInfo_MBR: function (buffer: PChar; nb_wanted, idx: Integer): Integer; stdcall;

  setParser_MBR:       procedure (parser: PParser); stdcall;
  init_Phone:          function  (phone: PChar; fDur: Real): LPPHONE; stdcall;
  reset_Phone:         procedure (hPhoneme: LPPHONE); stdcall;
  close_Phone:         procedure (hPhoneme: LPPHONE); stdcall;
  appendf0_Phone:      procedure (hPhoneme: LPPHONE; percent, pitch: Real); stdcall;

(*---------------------------------------------------------*)

implementation

uses uttsUtils;

function load_MBR: boolean;
begin
  hinstDllMBR := LoadLibrary(PChar(getDllPath_MBR + '\mbrola.dll'));
  if hinstDllMBR = 0 then
  begin
    Result := False;
    Exit;
  end;

  Pointer(@init_MBR)             := GetProcAddress(hinstDllMBR, 'init_MBR');
  Pointer(@init_rename_MBR)      := GetProcAddress(hinstDllMBR, 'init_rename_MBR');
  Pointer(@write_MBR)            := GetProcAddress(hinstDllMBR, 'write_MBR');
  Pointer(@flush_MBR)            := GetProcAddress(hinstDllMBR, 'flush_MBR');
  Pointer(@read_MBR)             := GetProcAddress(hinstDllMBR, 'read_MBR');
  Pointer(@readType_MBR)         := GetProcAddress(hinstDllMBR, 'readtype_MBR');
  Pointer(@close_MBR)            := GetProcAddress(hinstDllMBR, 'close_MBR');
  Pointer(@reset_MBR)            := GetProcAddress(hinstDllMBR, 'reset_MBR');
  Pointer(@lastError_MBR)        := GetProcAddress(hinstDllMBR, 'lastError_MBR');
  Pointer(@lastErrorStr_MBR)     := GetProcAddress(hinstDllMBR, 'lastErrorStr_MBR');
  Pointer(@setNoError_MBR)       := GetProcAddress(hinstDllMBR, 'setNoError_MBR');
  Pointer(@getNoError_MBR)       := GetProcAddress(hinstDllMBR, 'getNoError_MBR');
  Pointer(@setFreq_MBR)          := GetProcAddress(hinstDllMBR, 'setFreq_MBR');
  Pointer(@getFreq_MBR)          := GetProcAddress(hinstDllMBR, 'getFreq_MBR');
  Pointer(@setVolumeRatio_MBR)   := GetProcAddress(hinstDllMBR, 'setVolumeRatio_MBR');
  Pointer(@getVolumeRatio_MBR)   := GetProcAddress(hinstDllMBR, 'getVolumeRatio_MBR');
  Pointer(@getVersion_MBR)       := GetProcAddress(hinstDllMBR, 'getVersion_MBR');
  Pointer(@getDatabaseInfo_MBR)  := GetProcAddress(hinstDllMBR, 'getDatabaseInfo_MBR');
  Pointer(@setParser_MBR)        := GetProcAddress(hinstDllMBR, 'setParser_MBR');
  Pointer(@init_Phone)           := GetProcAddress(hinstDllMBR, 'init_Phone');
  Pointer(@reset_Phone)          := GetProcAddress(hinstDllMBR, 'reset_Phone');
  Pointer(@close_Phone)          := GetProcAddress(hinstDllMBR, 'close_Phone');
  Pointer(@appendf0_Phone)       := GetProcAddress(hinstDllMBR, 'appendf0_Phone');

  if (@init_MBR = nil) or (@init_rename_MBR = nil) or
     (@write_MBR = nil) or (@flush_MBR = nil) or
     (@read_MBR = nil) or (@readType_MBR = nil) or
     (@close_MBR = nil) or (@reset_MBR = nil) or
     (@lastError_MBR = nil) or (@lastErrorStr_MBR = nil) or
     (@setNoError_MBR = nil) or (@getNoError_MBR = nil) or
     (@setFreq_MBR = nil) or (@getFreq_MBR = nil) or
     (@setVolumeRatio_MBR = nil) or (@getVolumeRatio_MBR = nil) or
     (@getVersion_MBR = nil) or (@getDatabaseInfo_MBR = nil) or
     (@setParser_MBR = nil) or (@init_Phone = nil) or
     (@reset_Phone = nil) or (@close_Phone = nil) or
     (@appendf0_Phone = nil) then
  begin
    FreeLibrary(hinstDllMBR);
    hinstDllMBR := 0;
    Result := False;
    Exit;
  end;

  Result := True;
end;

(*---------------------------------------------------------*)

procedure unload_MBR;
begin
  if hinstDllMBR <> 0 then
  begin
    FreeLibrary(hinstDllMBR);
    hinstDllMBR := 0;
  end;
end;

function loaded_MBR: boolean;
begin
  Result := hinstDllMBR <> 0;
end;

end.
