Logo Search packages:      
Sourcecode: ocaml version File versions

open.c

/***********************************************************************/
/*                                                                     */
/*                           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: open.c,v 1.8.2.2 2004/06/21 15:44:17 xleroy Exp $ */

#include <fcntl.h>
#include <signal.h>
#include "mlvalues.h"
#include "fail.h"
#include "libgraph.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_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 */

value * caml_named_value (char * name);
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);
}


Generated by  Doxygen 1.6.0   Back to index