/* OCaml-Win32
 * win32_error.c
 * Copyright (c) 2002-2004 by Harry Chomsky
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License as published by the Free Software Foundation; either
 * version 2 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Library General Public License for more details.
 *
 * You should have received a copy of the GNU Library General Public
 * License along with this library; if not, write to the Free
 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include "win32.h"

/********************************************************************/
/* System Services: Debugging and Error Handling: SDK Documentation: Debugging and Error Handling: Error Handling */

CAMLprim value beep(value frequency, value duration)
{
    CAMLparam2(frequency, duration);
    BOOL result;

    enter_blocking_section();
    result = Beep(Int_val(frequency), Int_val(duration));
    leave_blocking_section();
    if (!result)
        raise_last_error();
    CAMLreturn(Val_unit);
}

CAMLprim value fatal_app_exit(value message)
{
    FatalAppExit(0, String_val(message));
    return Val_unit;
}

CAMLprim value flash_window(value wnd, value invert)
{
    CAMLparam2(wnd, invert);
    HWND hwnd;
    BOOL result;

    hwnd = Handle_val(wnd);
    enter_blocking_section();
    result = FlashWindow(hwnd, Bool_val(invert));
    leave_blocking_section();
    CAMLreturn(Val_bool(result));
}

CAMLprim value format_message(value source, value width, value args)
{
    CAMLparam3(source, width, args);
    DWORD flags;
    LPCVOID src;
    DWORD message_id;
    char* buffer;
    DWORD* a;
    int n, i;
    DWORD result;
    CAMLlocal2(val, v);

    flags = FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_ARGUMENT_ARRAY;
    if (Tag_val(source) == 0) {
        flags |= FORMAT_MESSAGE_FROM_STRING;
        src = (LPCVOID)String_val(Field(source, 0));
        message_id = 0;
    } else if (Tag_val(source) == 1) {
        flags |= FORMAT_MESSAGE_FROM_HMODULE;
        src = (LPCVOID)Handle_val(Field(source, 0));
        message_id = Int_val(Field(source, 1));
    } else {
        flags |= FORMAT_MESSAGE_FROM_SYSTEM;
        src = NULL;
        message_id = Int_val(Field(source, 0));
    }
    if (Is_block(width))
        flags |= Int_val(Field(width, 0));
    else if (Int_val(width) == 1)
        flags |= Int_val(FORMAT_MESSAGE_MAX_WIDTH_MASK);
    if (Is_some(args)) {
        val = Value_of(args);
        n = Wosize_val(val);
        a = malloc(n);
        for (i = 0; i < n; ++i) {
            v = Field(val, i);
            if (Tag_val(v) == 0 || Tag_val(v) == 1)
                a[i] = Int_val(Field(v, 0));
            else
                a[i] = (DWORD)String_val(Field(v, 0));
        }
    } else {
        flags |= FORMAT_MESSAGE_IGNORE_INSERTS;
        a = NULL;
    }
    result = FormatMessage(
        flags,
        src,
        message_id,
        0,
        (LPTSTR)&buffer,
        0,
        (va_list*)a);
    if (a)
        free(a);
    val = copy_string(buffer);
    LocalFree(buffer);
    CAMLreturn(val);
}

CAMLprim value get_last_error(value unit)
{
    return Val_int(GetLastError());
}

CAMLprim value message_beep(value beep_type)
{
    CAMLparam1(beep_type);
    DWORD type;
    BOOL result;

    if (Is_some(beep_type))
        type = Constant_val(Value_of(beep_type), message_box_options);
    else
        type = 0xFFFFFFFF;
    enter_blocking_section();
    result = MessageBeep(type);
    leave_blocking_section();
    if (!result)
        raise_last_error();
    CAMLreturn(Val_unit);
}

CAMLprim value set_error_mode(value options)
{
    DWORD result;

    result = SetErrorMode(flags_val(options, error_mode_options));
    return Alloc_flags(result, error_mode_options);
}

CAMLprim value set_last_error(value code)
{
    SetLastError(Int_val(code));
    return Val_unit;
}
