diff options
Diffstat (limited to 'ocaml-binary-annot/otherlibs/win32graph/open.c')
| -rw-r--r-- | ocaml-binary-annot/otherlibs/win32graph/open.c | 364 |
1 files changed, 364 insertions, 0 deletions
diff --git a/ocaml-binary-annot/otherlibs/win32graph/open.c b/ocaml-binary-annot/otherlibs/win32graph/open.c new file mode 100644 index 0000000000..2797bc669a --- /dev/null +++ b/ocaml-binary-annot/otherlibs/win32graph/open.c @@ -0,0 +1,364 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Developed by Jacob Navia, based on code by J-M Geffroy and X Leroy */ +/* Copyright 2001 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License, with */ +/* the special exception on linking described in file ../../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <fcntl.h> +#include <signal.h> +#include "mlvalues.h" +#include "fail.h" +#include "libgraph.h" +#include "callback.h" +#include <windows.h> + +static value gr_reset(void); +static long tid; +static HANDLE threadHandle; +HWND grdisplay = NULL; +int grscreen; +COLORREF grwhite, grblack; +COLORREF grbackground; +int grCurrentColor; +struct canvas grbstore; +BOOL grdisplay_mode; +BOOL grremember_mode; +int grx, gry; +int grcolor; +extern HFONT * grfont; +MSG msg; + +static char *szOcamlWindowClass = "OcamlWindowClass"; +static BOOL gr_initialized = 0; +CAMLprim value caml_gr_clear_graph(void); +HANDLE hInst; + +HFONT CreationFont(char *name) +{ + LOGFONT CurrentFont; + memset(&CurrentFont, 0, sizeof(LOGFONT)); + CurrentFont.lfCharSet = ANSI_CHARSET; + CurrentFont.lfWeight = FW_NORMAL; + CurrentFont.lfHeight = grwindow.CurrentFontSize; + CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN); + strcpy(CurrentFont.lfFaceName, name); /* Courier */ + return (CreateFontIndirect(&CurrentFont)); +} + +void SetCoordinates(HWND hwnd) +{ + RECT rc; + + GetClientRect(hwnd,&rc); + grwindow.width = rc.right; + grwindow.height = rc.bottom; + gr_reset(); +} + +void ResetForClose(HWND hwnd) +{ + DeleteDC(grwindow.tempDC); + DeleteDC(grwindow.gcBitmap); + DeleteObject(grwindow.hBitmap); + memset(&grwindow,0,sizeof(grwindow)); + gr_initialized = 0; +} + + + +static LRESULT CALLBACK GraphicsWndProc(HWND hwnd,UINT msg,WPARAM wParam,LPARAM lParam) +{ + PAINTSTRUCT ps; + HDC hdc; + + switch (msg) { + // Create the MDI client invisible window + case WM_CREATE: + break; + case WM_PAINT: + hdc = BeginPaint(hwnd,&ps); + BitBlt(hdc,0,0,grwindow.width,grwindow.height, + grwindow.gcBitmap,0,0,SRCCOPY); + EndPaint(hwnd,&ps); + break; + // Move the child windows + case WM_SIZE: + // Position the MDI client window between the tool and status bars + if (wParam != SIZE_MINIMIZED) { + SetCoordinates(hwnd); + } + + return 0; + // End application + case WM_DESTROY: + ResetForClose(hwnd); + break; + } + caml_gr_handle_event(msg, wParam, lParam); + return DefWindowProc(hwnd, msg, wParam, lParam); +} + +int DoRegisterClass(void) +{ + WNDCLASS wc; + + memset(&wc,0,sizeof(WNDCLASS)); + wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS|CS_OWNDC ; + wc.lpfnWndProc = (WNDPROC)GraphicsWndProc; + wc.hInstance = hInst; + wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1); + wc.lpszClassName = szOcamlWindowClass; + wc.lpszMenuName = 0; + wc.hCursor = LoadCursor(NULL,IDC_ARROW); + wc.hIcon = 0; + return RegisterClass(&wc); +} + +static value gr_reset(void) +{ + RECT rc; + int screenx,screeny; + + screenx = GetSystemMetrics(SM_CXSCREEN); + screeny = GetSystemMetrics(SM_CYSCREEN); + GetClientRect(grwindow.hwnd,&rc); + grwindow.gc = GetDC(grwindow.hwnd); + grwindow.width = rc.right; + grwindow.height = rc.bottom; + if (grwindow.gcBitmap == (HDC)0) { + grwindow.hBitmap = CreateCompatibleBitmap(grwindow.gc,screenx,screeny); + grwindow.gcBitmap = CreateCompatibleDC(grwindow.gc); + grwindow.tempDC = CreateCompatibleDC(grwindow.gc); + SelectObject(grwindow.gcBitmap,grwindow.hBitmap); + SetMapMode(grwindow.gcBitmap,MM_TEXT); + MoveToEx(grwindow.gcBitmap,0,grwindow.height-1,0); + BitBlt(grwindow.gcBitmap,0,0,screenx,screeny, + grwindow.gcBitmap,0,0,WHITENESS); + grwindow.CurrentFontSize = 15; + grwindow.CurrentFont = CreationFont("Courier"); + } + grwindow.CurrentColor = GetSysColor(COLOR_WINDOWTEXT); + grwindow.grx = 0; + grwindow.gry = 0; + grwindow.CurrentPen = SelectObject(grwindow.gc,GetStockObject(WHITE_PEN)); + SelectObject(grwindow.gc,grwindow.CurrentPen); + SelectObject(grwindow.gcBitmap,grwindow.CurrentPen); + grwindow.CurrentBrush = SelectObject(grwindow.gc,GetStockObject(WHITE_BRUSH)); + SelectObject(grwindow.gc,grwindow.CurrentBrush); + SelectObject(grwindow.gcBitmap,grwindow.CurrentBrush); + caml_gr_set_color(Val_long(0)); + SelectObject(grwindow.gc,grwindow.CurrentFont); + SelectObject(grwindow.gcBitmap,grwindow.CurrentFont); + grdisplay_mode = grremember_mode = 1; + MoveToEx(grwindow.gc,0,grwindow.height-1,0); + MoveToEx(grwindow.gcBitmap,0,grwindow.height-1,0); + SetTextAlign(grwindow.gcBitmap,TA_BOTTOM); + SetTextAlign(grwindow.gc,TA_BOTTOM); + return Val_unit; +} + +void SuspendGraphicThread(void) +{ + SuspendThread(threadHandle); +} + +void ResumeGraphicThread(void) +{ + ResumeThread(threadHandle); +} + +/* For handshake between the event handling thread and the main thread */ +static char * open_graph_errmsg; +static HANDLE open_graph_event; + +static DWORD WINAPI gr_open_graph_internal(value arg) +{ + RECT rc; + int ret; + int event; + int x, y, w, h; + int screenx,screeny; + int attributes; + static int registered; + MSG msg; + + gr_initialized = TRUE; + hInst = GetModuleHandle(NULL); + x = y = w = h = CW_USEDEFAULT; + sscanf(String_val(arg), "%dx%d+%d+%d", &w, &h, &x, &y); + + /* Open the display */ + if (grwindow.hwnd == NULL || !IsWindow(grwindow.hwnd)) { + if (!registered) { + registered = DoRegisterClass(); + if (!registered) { + open_graph_errmsg = "Cannot register the window class"; + SetEvent(open_graph_event); + return 1; + } + } + grwindow.hwnd = CreateWindow(szOcamlWindowClass, + WINDOW_NAME, + WS_OVERLAPPEDWINDOW, + x,y, + w,h, + NULL,0,hInst,NULL); + if (grwindow.hwnd == NULL) { + open_graph_errmsg = "Cannot create window"; + SetEvent(open_graph_event); + return 1; + } +#if 0 + if (x != CW_USEDEFAULT) { + rc.left = 0; + rc.top = 0; + rc.right = w; + rc.bottom = h; + AdjustWindowRect(&rc,GetWindowLong(grwindow.hwnd,GWL_STYLE),0); + MoveWindow(grwindow.hwnd,x,y,rc.right-rc.left,rc.bottom-rc.top,1); + } +#endif + } + gr_reset(); + ShowWindow(grwindow.hwnd,SW_SHOWNORMAL); + + /* Position the current point at origin */ + grwindow.grx = 0; + grwindow.gry = 0; + + caml_gr_init_event_queue(); + + /* The global data structures are now correctly initialized. + Restart the Caml main thread. */ + open_graph_errmsg = NULL; + SetEvent(open_graph_event); + + /* Enter the message handling loop */ + while (GetMessage(&msg,NULL,0,0)) { + TranslateMessage(&msg); // Translates virtual key codes + DispatchMessage(&msg); // Dispatches message to window + if (!IsWindow(grwindow.hwnd)) + break; + } + return 0; +} + +CAMLprim value caml_gr_open_graph(value arg) +{ + long tid; + if (gr_initialized) return Val_unit; + open_graph_event = CreateEvent(NULL, FALSE, FALSE, NULL); + threadHandle = + CreateThread(NULL,0, + (LPTHREAD_START_ROUTINE)gr_open_graph_internal,(void **)arg, + 0, + &tid); + WaitForSingleObject(open_graph_event, INFINITE); + CloseHandle(open_graph_event); + if (open_graph_errmsg != NULL) gr_fail("%s", open_graph_errmsg); + return Val_unit; +} + +CAMLprim value caml_gr_close_graph(void) +{ + if (gr_initialized) { + PostMessage(grwindow.hwnd, WM_CLOSE, 0, 0); + WaitForSingleObject(threadHandle, INFINITE); + } + return Val_unit; +} + +CAMLprim value caml_gr_clear_graph(void) +{ + gr_check_open(); + if(grremember_mode) { + BitBlt(grwindow.gcBitmap,0,0,grwindow.width,grwindow.height, + grwindow.gcBitmap,0,0,WHITENESS); + } + if(grdisplay_mode) { + BitBlt(grwindow.gc,0,0,grwindow.width,grwindow.height, + grwindow.gc,0,0,WHITENESS); + } + return Val_unit; +} + +CAMLprim value caml_gr_size_x(void) +{ + gr_check_open(); + return Val_int(grwindow.width); +} + +CAMLprim value caml_gr_size_y(void) +{ + gr_check_open(); + return Val_int(grwindow.height); +} + +CAMLprim value caml_gr_resize_window (value vx, value vy) +{ + gr_check_open (); + + /* FIXME TODO implement this function... */ + + return Val_unit; +} + +CAMLprim value caml_gr_synchronize(void) +{ + gr_check_open(); + BitBlt(grwindow.gc,0,0,grwindow.width,grwindow.height, + grwindow.gcBitmap,0,0,SRCCOPY); + return Val_unit ; +} + +CAMLprim value caml_gr_display_mode(value flag) +{ + grdisplay_mode = (Int_val(flag)) ? 1 : 0; + return Val_unit ; +} + +CAMLprim value caml_gr_remember_mode(value flag) +{ + grremember_mode = (Int_val(flag)) ? 1 : 0; + return Val_unit ; +} + +CAMLprim value caml_gr_sigio_signal(value unit) +{ + return Val_unit; +} + +CAMLprim value caml_gr_sigio_handler(void) +{ + return Val_unit; +} + + +/* Processing of graphic errors */ + +static value * graphic_failure_exn = NULL; +void gr_fail(char *fmt, char *arg) +{ + char buffer[1024]; + + if (graphic_failure_exn == NULL) { + graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); + if (graphic_failure_exn == NULL) + invalid_argument("Exception Graphics.Graphic_failure not initialized, must link graphics.cma"); + } + sprintf(buffer, fmt, arg); + raise_with_string(*graphic_failure_exn, buffer); +} + +void gr_check_open(void) +{ + if (!gr_initialized) gr_fail("graphic screen not opened", NULL); +} |