diff options
113 files changed, 22742 insertions, 0 deletions
diff --git a/Linux_C_12/Clean.h b/Linux_C_12/Clean.h new file mode 100644 index 0000000..d92e1a0 --- /dev/null +++ b/Linux_C_12/Clean.h @@ -0,0 +1,28 @@ +
+#define Clean(a)
+
+typedef struct clean_string *CleanString;
+
+/* a string in Clean is:
+ struct clean_string {
+ int clean_string_length;
+ char clean_string_characters[clean_string_length];
+ };
+ The string does not end with a '\0' !
+*/
+
+/* CleanStringLength(clean_string) returns length of the clean_string in characters */
+#define CleanStringLength(clean_string) (*(unsigned int *)(clean_string))
+
+/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */
+#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned int *)(clean_string)))
+
+/* CleanStringSizeInts(string_length) return size of CleanString in integers */
+#define CleanStringSizeInts(string_length) (1+(((unsigned int)(string_length)+3)>>2))
+
+/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,
+ before using the clean_string variable, cast to CleanString, except for the macros above */
+#define CleanStringVariable(clean_string,string_length) unsigned int clean_string[CleanStringSizeInts(string_length)]
+
+/* CleanStringSizeBytes(string_length) return size of CleanString in bytes */
+#define CleanStringSizeBytes(string_length) (4+(((unsigned int)(string_length)+3) & -4))
diff --git a/Linux_C_12/cCCallSystem_121.c b/Linux_C_12/cCCallSystem_121.c new file mode 100644 index 0000000..cab13a8 --- /dev/null +++ b/Linux_C_12/cCCallSystem_121.c @@ -0,0 +1,106 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to system handling that is not part of standard cross call handling.
+********************************************************************************************/
+#include "cCCallSystem_121.h"
+#include <time.h>
+#include <sys/time.h>
+#include <unistd.h>
+
+OS WinBeep (OS ios)
+{
+ rprintf("WinBeep\n");
+ gdk_beep();
+ return ios;
+}
+
+void WinGetBlinkTime(OS ios, int* blinktime, OS *oos)
+{
+/* return (int) GetCaretBlinkTime(); */
+ rprintf("WinGetBlinkTime -> not implemented\n");
+ *oos = ios;
+}
+
+void WinGetTickCount (OS ios, int *tickCount, OS *oos)
+{
+ static struct timeval s;
+ static gboolean f = TRUE;
+ struct timeval r;
+
+ rprintf("WinGetTickCount\n");
+ if (f)
+ {
+ gettimeofday(&s,NULL);
+ f = FALSE;
+ *oos = ios;
+ *tickCount = 0;
+ return;
+ }
+
+ gettimeofday(&r,NULL);
+ *tickCount = (r.tv_sec-s.tv_sec)*1000 + (r.tv_usec-s.tv_usec)/1000;
+ *oos = ios;
+}
+
+void WinPlaySound (CLEAN_STRING filename, OS ios, Bool *ook, OS *oos)
+{
+/* return PlaySound(filename, NULL, SND_FILENAME | SND_SYNC); */
+ rprintf("WinPlaySound -> not implemented");
+ *ook = FALSE;
+ *oos = ios;
+}
+
+OS WinWait (int delay, OS ios)
+{
+ rprintf("WinWait: %d\n", delay);
+ sleep(delay);
+ return ios;
+}
+
+void WinGetTime (OS ios, int *hr, int *min, int *second, OS *oos)
+{
+ struct timeval t;
+ struct tm theTime;
+
+ printf("WinGetTime\n");
+
+ gettimeofday(&t,NULL);
+ gmtime_r(&t.tv_sec,&theTime);
+
+ *hr = theTime.tm_hour;
+ *min = theTime.tm_min;
+ *second = theTime.tm_sec;
+
+ printf("Time: %d:%d:%d\n", *hr, *min, *second);
+
+ *oos = ios;
+}
+
+void WinGetDate (OS ios, int *year, int *month, int *day,
+ int *weekday, OS *oos)
+{
+ struct timeval t;
+ struct tm theTime;
+
+ printf("WinGetDate\n");
+
+ gettimeofday(&t,NULL);
+ gmtime_r(&t.tv_sec,&theTime);
+ *year = 1900 + theTime.tm_year;
+ *month = 1 + theTime.tm_mon;
+ *day = theTime.tm_mday;
+ /* Clean treats 1 == Weekend, 2 == Weekday */
+ *weekday = ((theTime.tm_wday == 0) || (theTime.tm_wday == 6)) ? 1 : 2;
+
+ printf("Date: %d-%d-%d\n",*month, *day, *year);
+ *oos = ios;
+}
+
+
+
diff --git a/Linux_C_12/cCCallSystem_121.h b/Linux_C_12/cCCallSystem_121.h new file mode 100644 index 0000000..4b49928 --- /dev/null +++ b/Linux_C_12/cCCallSystem_121.h @@ -0,0 +1,10 @@ +#include "intrface_121.h"
+#include "util_121.h"
+
+extern OS WinBeep (OS);
+extern void WinGetTime (OS,int*,int*,int*,OS*);
+extern void WinGetDate (OS,int*,int*,int*,int*,OS*);
+extern OS WinWait (int,OS);
+extern void WinGetBlinkTime (OS,int*,OS*);
+extern void WinGetTickCount (OS,int*,OS*);
+extern void WinPlaySound (CLEAN_STRING,OS,Bool*,OS*);
diff --git a/Linux_C_12/cCCallWindows_121.c b/Linux_C_12/cCCallWindows_121.c new file mode 100644 index 0000000..b6d521e --- /dev/null +++ b/Linux_C_12/cCCallWindows_121.c @@ -0,0 +1,182 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to window/dialog handling.
+********************************************************************************************/
+#include "cCCallWindows_121.h"
+#include "cCrossCallWindows_121.h"
+
+OS WinInvalidateWindow (GtkWidget *widget, OS ios)
+{
+ rprintf("WinInvalidateWindow\n");
+ gtk_widget_queue_draw(widget);
+ return ios;
+}
+
+OS WinInvalidateRect (GtkWidget *widget, int left, int top, int right,
+ int bottom, OS ios)
+{
+ /* rprintf("WinInvalidateRect\n"); */
+ gint temp;
+ GdkRectangle* rect = g_new(GdkRectangle,1);
+ if (top > bottom) {
+ temp = top;
+ top = bottom;
+ bottom = top;
+ }
+ rect->x = (gint)left;
+ rect->y = (gint)top;
+ rect->width = (gint)(right - left);
+ rect->height = (gint)(bottom - top);
+ gdk_window_invalidate_rect(GDK_WINDOW(widget),rect, 1);
+ /* FIXME: destroy the Rectangle here? */
+ return ios;
+}
+
+OS WinValidateRect (GtkWidget *widget, int left, int top, int right, int bottom,
+ OS ios)
+{
+ /* GTK Automatically calculates valid regions. */
+ return ios;
+}
+
+OS WinValidateRgn (GtkWidget *widget, GdkRegion *region, OS ios)
+{
+ /* GTK Automatically calculates valid regions. */
+ return ios;
+}
+
+/* Win(M/S)DIClientToOuterSizeDims returns the width and height needed to add/subtract
+ from the client/outer size to obtain the outer/client size.
+ These values must be the same as used by W95AdjustClean(M/S)DIWindowDimensions!
+*/
+void WinMDIClientToOuterSizeDims (int styleFlags, OS ios, int *dw, int *dh, OS* oos)
+{
+/* if ((styleFlags&WS_THICKFRAME) != 0)
+ { // resizable window
+ *dw = 2 * GetSystemMetrics (SM_CXSIZEFRAME);
+ *dh = 2 * GetSystemMetrics (SM_CYSIZEFRAME) + GetSystemMetrics (SM_CYCAPTION);
+ } else
+ { // fixed size window
+ *dw = 2 * GetSystemMetrics (SM_CXFIXEDFRAME);
+ *dh = 2 * GetSystemMetrics (SM_CYFIXEDFRAME) + GetSystemMetrics (SM_CYCAPTION);
+ }
+*/
+ *dw = 0;
+ *dh = 0;
+ printf("WinMDIClientOuterSizeDims -> not implemented\n");
+ *oos = ios;
+}
+
+void WinSDIClientToOuterSizeDims (int styleFlags, OS ios, int *dw, int *dh, OS *oos)
+{
+ *dw = 0; //2 * GetSystemMetrics (SM_CXSIZEFRAME);
+ *dh = 0; //2 * GetSystemMetrics (SM_CYSIZEFRAME) + GetSystemMetrics (SM_CYCAPTION);
+ printf("WinSDIClientOuterSizeDims -> not implemented\n");
+ *oos = ios;
+}
+
+
+/* UpdateWindowScrollbars updates any window scrollbars and non-client area if present.
+ Uses the following access procedures to the GWL_STYLE of a windowhandle:
+ GetGWL_STYLE (hwnd) returns the GWL_STYLE value of hwnd;
+ WindowHasHScroll (hwnd) returns TRUE iff hwnd has a horizontal scrollbar;
+ WindowHasVScroll (hwnd) returns TRUE iff hwnd has a vertical scrollbar;
+*/
+
+void UpdateWindowScrollbars (GtkWidget *widget)
+{
+/* int w,h;
+ RECT rect;
+
+ GetWindowRect (hwnd, &rect);
+ w = rect.right -rect.left;
+ h = rect.bottom-rect.top;
+
+ if (WindowHasHScroll (hwnd))
+ {
+ rect.left = 0;
+ rect.top = h-GetSystemMetrics (SM_CYHSCROLL);
+ rect.right = w;
+ rect.bottom = h;
+ InvalidateRect (hwnd,&rect,FALSE);
+ RedrawWindow (hwnd,&rect,NULL,RDW_FRAME | RDW_VALIDATE | RDW_UPDATENOW | RDW_NOCHILDREN);
+ ValidateRect (hwnd,&rect);
+ }
+ if (WindowHasVScroll (hwnd))
+ {
+ rect.left = w-GetSystemMetrics (SM_CXVSCROLL);
+ rect.top = 0;
+ rect.right = w;
+ rect.bottom = h;
+ InvalidateRect (hwnd,&rect,FALSE);
+ RedrawWindow (hwnd,&rect,NULL,RDW_FRAME | RDW_VALIDATE | RDW_UPDATENOW | RDW_NOCHILDREN);
+ ValidateRect (hwnd,&rect);
+ }
+*/
+ printf("UpdateWindowScrollbars -> not implemented\n");
+}
+
+
+void WinScreenYSize (OS ios, int *py, OS *oos)
+{
+ rprintf("WinScreenYSize\n");
+ *py = gdk_screen_height();
+ *oos = ios;
+}
+
+void WinScreenXSize (OS ios, int *px, OS *oos)
+{
+ rprintf("WinScreenXSize\n");
+ *px = gdk_screen_width();
+ *oos = ios;
+}
+
+void WinMinimumWinSize (int *mx, int *my)
+{
+ rprintf("WinMinimumWinSize\n");
+ *mx = 48;
+ *my = 0;
+}
+
+/* WinScrollbarSize determines system metrics of width and height of scrollbars.
+*/
+void WinScrollbarSize (OS ios, int *width, int *height, OS *oos)
+{
+ GtkRequisition req;
+ GtkWidget *vbar, *hbar;
+ printf ("WinScrollbarSize\n");
+
+ vbar = gtk_vscrollbar_new(NULL);
+ hbar = gtk_hscrollbar_new(NULL);
+
+
+ gtk_widget_size_request(vbar, &req);
+ *width = req.width; /* Width of the vertical arrow */
+ gtk_widget_size_request(hbar, &req);
+ *height = req.height; /* Height of the horizontal bar */
+
+ gtk_widget_destroy(vbar);
+ gtk_widget_destroy(hbar);
+
+ *oos = ios;
+}
+
+void WinMaxFixedWindowSize (int *mx, int *my)
+{
+ rprintf("WinMaxFixedWindowSize\n");
+ *mx = gdk_screen_width();
+ *my = gdk_screen_height();
+}
+
+void WinMaxScrollWindowSize (int *mx, int *my)
+{
+ rprintf("WinMaxScrollWindowSize\n");
+ *mx = gdk_screen_width();
+ *my = gdk_screen_height();
+}
diff --git a/Linux_C_12/cCCallWindows_121.h b/Linux_C_12/cCCallWindows_121.h new file mode 100644 index 0000000..45823ab --- /dev/null +++ b/Linux_C_12/cCCallWindows_121.h @@ -0,0 +1,28 @@ +#include "util_121.h"
+
+extern OS WinInvalidateWindow (OSWindowPtr wnd, OS ios);
+extern OS WinInvalidateRect (OSWindowPtr wnd, int left, int top, int right,
+ int bottom, OS ios);
+extern OS WinValidateRect (OSWindowPtr wnd, int left, int top, int right,
+ int bottom, OS ios);
+extern OS WinValidateRgn (OSWindowPtr wnd, OSRgnHandle rgn, OS ios);
+
+/* Win(M/S)DIClientToOuterSizeDims returns the width and height needed to add/subtract
+ from the client/outer size to obtain the outer/client size.
+ These values must be the same as used by W95AdjustClean(M/S)DIWindowDimensions!
+*/
+extern void WinMDIClientToOuterSizeDims (int styleFlags, OS ios, int *dw, int *dh, OS *oos);
+extern void WinSDIClientToOuterSizeDims (int styleFlags, OS ios, int *dw, int *dh, OS *oos);
+
+/* UpdateWindowScrollbars updates any window scrollbars and non-client area if present.
+*/
+extern void UpdateWindowScrollbars (OSWindowPtr hwnd);
+
+/* Access procedures to dimensions:
+*/
+extern void WinScreenYSize (OS,int*,OS*);
+extern void WinScreenXSize (OS,int*,OS*);
+extern void WinMinimumWinSize (int *mx, int *my);
+extern void WinScrollbarSize (OS ios, int *width, int *height, OS *oos);
+extern void WinMaxFixedWindowSize (int *mx, int *my);
+extern void WinMaxScrollWindowSize (int *mx, int *my);
diff --git a/Linux_C_12/cCrossCallClipboard_121.c b/Linux_C_12/cCrossCallClipboard_121.c new file mode 100644 index 0000000..bc7e2df --- /dev/null +++ b/Linux_C_12/cCrossCallClipboard_121.c @@ -0,0 +1,62 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to clipboard handling.
+********************************************************************************************/
+#include "cCrossCallClipboard_121.h"
+#include "cCrossCall_121.h"
+
+
+/* Cross call procedure implementations.
+ Eval<nr> corresponds with a CrossCallEntry generated by NewCrossCallEntry (nr,Eval<nr>).
+*/
+
+void EvalCcRqCLIPBOARDHASTEXT (CrossCallInfo *pcci) /* no arguments; bool result. */
+{
+ printf("EvalCcRqCLIPBOARDHASTEXT\n");
+ MakeReturn1Cci (pcci,(int) gtk_clipboard_wait_is_text_available(gtk_clipboard_get(GDK_NONE)));
+}
+
+void EvalCcRqSETCLIPBOARDTEXT (CrossCallInfo *pcci) /* textptr; no result. */
+{
+ const gchar *text = (const gchar *) pcci->p1;
+
+ printf("EvalCcRqSETCLIPBOARDTEXT\n");
+ gtk_clipboard_set_text (gtk_clipboard_get(GDK_NONE),
+ text, strlen(text));
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqGETCLIPBOARDTEXT (CrossCallInfo *pcci) /* no params; string result. */
+{
+ gchar *text, *result;
+ printf("EvalCcRqGETCLIPBOARDTEXT\n");
+
+ text = gtk_clipboard_wait_for_text(gtk_clipboard_get(GDK_NONE));
+ result = g_strdup(text);
+ g_free(text);
+
+ MakeReturn1Cci (pcci, (int) result);
+}
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+OS InstallCrossCallClipboard (OS ios)
+{
+ CrossCallProcedureTable newTable;
+
+ printf("InstallCrossCallClipboard\n");
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqCLIPBOARDHASTEXT, EvalCcRqCLIPBOARDHASTEXT);
+ AddCrossCallEntry (newTable, CcRqSETCLIPBOARDTEXT, EvalCcRqSETCLIPBOARDTEXT);
+ AddCrossCallEntry (newTable, CcRqGETCLIPBOARDTEXT, EvalCcRqGETCLIPBOARDTEXT);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+
+ return ios;
+}
diff --git a/Linux_C_12/cCrossCallClipboard_121.h b/Linux_C_12/cCrossCallClipboard_121.h new file mode 100644 index 0000000..d9bb1f4 --- /dev/null +++ b/Linux_C_12/cCrossCallClipboard_121.h @@ -0,0 +1,5 @@ +#include "util_121.h"
+
+// InstallCrossCallClipboard adds the proper cross call procedures to the
+// cross call procedures managed by cCrossCall_13.c.
+extern OS InstallCrossCallClipboard (OS);
diff --git a/Linux_C_12/cCrossCallFileSelectors_121.c b/Linux_C_12/cCrossCallFileSelectors_121.c new file mode 100644 index 0000000..c36e6d8 --- /dev/null +++ b/Linux_C_12/cCrossCallFileSelectors_121.c @@ -0,0 +1,173 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to standard file selector dialogues.
+********************************************************************************************/
+#include "cCrossCallFileSelectors_121.h"
+#include "util_121.h"
+#include "cCrossCall_121.h"
+
+extern GtkWidget *gActiveTopLevelWindow;
+
+void EvalCcRqDIRECTORYDIALOG (CrossCallInfo *pcci) /* no params; bool, textptr result; */
+{
+ GtkWidget *file_selector;
+ printf("EvalCcRqDIRECTORYDIALOG\n");
+ file_selector = gtk_file_selection_new("Select directory");
+
+ if (gActiveTopLevelWindow)
+ {
+ gtk_window_set_transient_for(GTK_WINDOW(file_selector), GTK_WINDOW(gActiveTopLevelWindow));
+ }
+
+ for (;;)
+ {
+ if (gtk_dialog_run(GTK_DIALOG(file_selector)) == GTK_RESPONSE_OK)
+ {
+ gchar *file_name;
+ G_CONST_RETURN gchar *fname = gtk_file_selection_get_filename(GTK_FILE_SELECTION(file_selector));
+ if (!g_file_test(fname, G_FILE_TEST_EXISTS | G_FILE_TEST_IS_DIR))
+ {
+ GtkWidget *dialog =
+ gtk_message_dialog_new (GTK_WINDOW(file_selector),
+ GTK_DIALOG_DESTROY_WITH_PARENT,
+ GTK_MESSAGE_ERROR,
+ GTK_BUTTONS_OK,
+ "%s directory not found",
+ fname);
+ gtk_dialog_run (GTK_DIALOG (dialog));
+ gtk_widget_destroy (dialog);
+ continue;
+ }
+
+ file_name = g_strdup(fname);
+ gtk_widget_destroy(file_selector);
+ MakeReturn2Cci(pcci, gtk_true(), (int) file_name);
+ return;
+ }
+ else
+ {
+ gtk_widget_destroy(file_selector);
+ MakeReturn2Cci(pcci, gtk_false(), (int) NULL);
+ return;
+ }
+ }
+}
+
+void EvalCcRqFILEOPENDIALOG (CrossCallInfo *pcci) /* no params; bool, textptr result; */
+{
+ GtkWidget *file_selector;
+ printf("EvalCcFILEOPENDIALOG\n");
+ file_selector = gtk_file_selection_new("Open");
+
+ if (gActiveTopLevelWindow)
+ {
+ gtk_widget_set_parent(file_selector, gActiveTopLevelWindow);
+ gtk_window_set_transient_for(GTK_WINDOW(file_selector), GTK_WINDOW(gActiveTopLevelWindow));
+ }
+
+ for (;;)
+ {
+ if (gtk_dialog_run(GTK_DIALOG(file_selector)) == GTK_RESPONSE_OK)
+ {
+ gchar *file_name;
+ G_CONST_RETURN gchar *fname = gtk_file_selection_get_filename(GTK_FILE_SELECTION(file_selector));
+ if (!g_file_test(fname, G_FILE_TEST_EXISTS))
+ {
+ GtkWidget *dialog =
+ gtk_message_dialog_new (GTK_WINDOW(file_selector),
+ GTK_DIALOG_DESTROY_WITH_PARENT,
+ GTK_MESSAGE_ERROR,
+ GTK_BUTTONS_OK,
+ "%s file not found",
+ fname);
+ gtk_dialog_run (GTK_DIALOG (dialog));
+ gtk_widget_destroy (dialog);
+ continue;
+ }
+
+ file_name = g_strdup(fname);
+ gtk_widget_destroy(file_selector);
+ MakeReturn2Cci(pcci, gtk_true(), (int) file_name);
+ return;
+ }
+ else
+ {
+ gtk_widget_destroy(file_selector);
+ MakeReturn2Cci(pcci, gtk_false(), (int) NULL);
+ return;
+ }
+ }
+}
+
+void EvalCcRqFILESAVEDIALOG (CrossCallInfo *pcci) /* promptptr, nameptr; bool, textptr result; */
+{
+ GtkWidget *file_selector;
+ printf("EvalCcFILESAVEDDIALOG\n");
+ file_selector = gtk_file_selection_new((gchar *) pcci->p1);
+
+ if (gActiveTopLevelWindow)
+ {
+ gtk_widget_set_parent(file_selector, gActiveTopLevelWindow);
+ gtk_window_set_transient_for(GTK_WINDOW(file_selector), GTK_WINDOW(gActiveTopLevelWindow));
+ }
+
+ gtk_file_selection_set_filename(file_selector, (gchar *) pcci->p2);
+
+ for (;;)
+ {
+ if (gtk_dialog_run(GTK_DIALOG(file_selector)) == GTK_RESPONSE_OK)
+ {
+ gchar *file_name;
+ G_CONST_RETURN gchar *fname = gtk_file_selection_get_filename(GTK_FILE_SELECTION(file_selector));
+ if (g_file_test(fname, G_FILE_TEST_EXISTS))
+ {
+ gint res;
+ GtkWidget *dialog =
+ gtk_message_dialog_new (GTK_WINDOW(file_selector),
+ GTK_DIALOG_DESTROY_WITH_PARENT,
+ GTK_MESSAGE_WARNING,
+ GTK_BUTTONS_YES_NO,
+ "%s already exists. Do you want to replace id?",
+ fname);
+ res = gtk_dialog_run (GTK_DIALOG (dialog));
+ gtk_widget_destroy (dialog);
+
+ if (res == GTK_RESPONSE_NO) continue;
+ }
+
+ file_name = g_strdup(fname);
+ gtk_widget_destroy(file_selector);
+ MakeReturn2Cci(pcci, gtk_true(), (int) file_name);
+ return;
+ }
+ else
+ {
+ gtk_widget_destroy(file_selector);
+ MakeReturn2Cci(pcci, gtk_false(), (int) NULL);
+ return;
+ }
+ }
+}
+
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+OS InstallCrossCallFileSelectors(OS ios)
+{
+ CrossCallProcedureTable newTable;
+ printf("InstallCrossCallFileSelectors\n");
+
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqDIRECTORYDIALOG,EvalCcRqDIRECTORYDIALOG);
+ AddCrossCallEntry (newTable, CcRqFILEOPENDIALOG, EvalCcRqFILEOPENDIALOG);
+ AddCrossCallEntry (newTable, CcRqFILESAVEDIALOG, EvalCcRqFILESAVEDIALOG);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+
+ return ios;
+}
diff --git a/Linux_C_12/cCrossCallFileSelectors_121.h b/Linux_C_12/cCrossCallFileSelectors_121.h new file mode 100644 index 0000000..792409b --- /dev/null +++ b/Linux_C_12/cCrossCallFileSelectors_121.h @@ -0,0 +1,6 @@ +#include "util_121.h"
+
+
+// InstallCrossCallFileSelectors adds the proper cross call procedures to the
+// cross call procedures managed by cCrossCall_121.c.
+extern OS InstallCrossCallFileSelectors(OS);
diff --git a/Linux_C_12/cCrossCallFont_121.c b/Linux_C_12/cCrossCallFont_121.c new file mode 100644 index 0000000..c0e1cd3 --- /dev/null +++ b/Linux_C_12/cCrossCallFont_121.c @@ -0,0 +1,87 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to font handling.
+********************************************************************************************/
+#include "cCrossCallFont_121.h"
+#include "cCrossCall_121.h"
+
+/*
+
+static int CALLBACK EnumFontNameProc (ENUMLOGFONT FAR * lpelf, // pointer to logical-font data
+ NEWTEXTMETRIC FAR * lpntm, // pointer to physical-font data
+ int fontType, // type of font
+ LPARAM lParam // address of application-defined data
+ )
+{
+ SendMessage1ToClean (CcCbFONTNAME, lpelf->elfLogFont.lfFaceName);
+
+ return 1;
+}
+
+static int CALLBACK EnumFontSizeProc (ENUMLOGFONT FAR * lpelf, // pointer to logical-font data
+ NEWTEXTMETRIC FAR * lpntm, // pointer to physical-font data
+ int fontType, // type of font
+ LPARAM lParam // address of application-defined data
+ )
+{
+ SendMessage2ToClean (CcCbFONTSIZE,lpntm->tmHeight - lpntm->tmInternalLeading, fontType == TRUETYPE_FONTTYPE);
+
+ if (fontType == TRUETYPE_FONTTYPE)
+ return 0;
+ else
+ return 1;
+}
+
+*/
+
+/* Cross call procedure implementations.
+ Eval<nr> corresponds with a CrossCallEntry generated by NewCrossCallEntry (nr,Eval<nr>).
+*/
+void EvalCcRqGETFONTNAMES (CrossCallInfo *pcci) // no params; no result.
+{
+/* HDC hdc;
+
+ hdc = GetDC (ghMainWindow);
+ EnumFontFamilies (hdc, NULL, (FONTENUMPROC) EnumFontNameProc, 0);
+ ReleaseDC (ghMainWindow, hdc);
+ MakeReturn0Cci (pcci);
+*/
+ printf("EvalCcRqGETFONTNAMES -> not implemented");
+ MakeReturn0Cci(pcci);
+}
+
+void EvalCcRqGETFONTSIZES (CrossCallInfo *pcci) // textptr; no result.
+{
+/* HDC hdc;
+
+ hdc = GetDC (ghMainWindow);
+ EnumFontFamilies (hdc, (char *) pcci->p1, (FONTENUMPROC) EnumFontSizeProc, 0);
+ ReleaseDC (ghMainWindow, hdc);
+ rfree ((char *) pcci->p1);
+ MakeReturn0Cci (pcci);
+*/
+ printf("EvalCcRqGETFONTSIZES -> not implemented");
+ MakeReturn0Cci(pcci);
+}
+
+
+// InstallCrossCallFont adds the proper cross call procedures to the
+// cross call procedures managed by cCrossCall_121.c.
+OS InstallCrossCallFont (OS ios)
+{
+ CrossCallProcedureTable newTable;
+
+ printf("InstallCrossCallFont\n");
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqGETFONTNAMES,EvalCcRqGETFONTNAMES);
+ AddCrossCallEntry (newTable, CcRqGETFONTSIZES,EvalCcRqGETFONTSIZES);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+
+ return ios;
+}
diff --git a/Linux_C_12/cCrossCallFont_121.h b/Linux_C_12/cCrossCallFont_121.h new file mode 100644 index 0000000..ba17c00 --- /dev/null +++ b/Linux_C_12/cCrossCallFont_121.h @@ -0,0 +1,6 @@ +#include "util_121.h"
+
+
+// InstallCrossCallFont adds the proper cross call procedures to the
+// cross call procedures managed by cCrossCall_121.c.
+extern OS InstallCrossCallFont (OS);
diff --git a/Linux_C_12/cCrossCallMenus_121.c b/Linux_C_12/cCrossCallMenus_121.c new file mode 100644 index 0000000..c59e9ca --- /dev/null +++ b/Linux_C_12/cCrossCallMenus_121.c @@ -0,0 +1,477 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to menu handling.
+********************************************************************************************/
+#include "cCrossCallMenus_121.h"
+#include "cCrossCall_121.h"
+
+
+/* Cross call procedure implementations.
+ Eval<nr> corresponds with a CrossCallEntry generated by NewCrossCallEntry (nr,Eval<nr>).
+*/
+/* Remove a shortkey from a framewindow shortkey table. */
+
+static gboolean dummy_find_accel(GtkAccelKey *key, GClosure *closure, gpointer data)
+{
+ printf("dummy_find_accel\n");
+ return gtk_true();
+}
+
+void EvalCcRqREMOVEMENUSHORTKEY (CrossCallInfo *pcci) /* frameptr, cmd; no result. */
+{
+ GtkWidget *frame;
+ GtkWidget *box;
+ GtkWidget *menu_item;
+ GtkAccelGroup *accel_group;
+
+ printf("EvalCcRqREMOVEMENUSHORTKEY\n");
+ frame = GTK_WIDGET(pcci->p1);
+ menu_item = GTK_WIDGET(pcci->p2);
+
+ accel_group = ((GtkAccelGroup*)gtk_accel_groups_from_object(G_OBJECT(frame))->data);
+
+ for (;;)
+ {
+ GtkAccelKey *key = gtk_accel_group_find(accel_group, dummy_find_accel, NULL);
+ if (!key) break;
+
+ gtk_widget_remove_accelerator(menu_item,
+ accel_group,
+ key->accel_key,
+ key->accel_mods);
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqMODIFYMENUITEM (CrossCallInfo *pcci) /* hitem, hmenu, textptr; no result. */
+{
+ GtkWidget *menu, *menu_item, *label;
+ gchar *title;
+
+ printf("EvalCcRqMODIFYMENUITEM\n");
+ title = createMnemonicString((gchar *) pcci->p3);
+
+ menu = GTK_WIDGET(pcci->p2);
+ menu_item = GTK_WIDGET(pcci->p1);
+ label = gtk_bin_get_child(GTK_BIN(menu_item));
+ gtk_label_set_text_with_mnemonic(GTK_LABEL(label), title);
+
+ rfree(title);
+
+ MakeReturn0Cci (pcci);
+}
+
+static int in_handler_flag = 0;
+
+static void menuitem_activate_handler(GtkMenuItem *menu_item)
+{
+ printf("menuitem_activate_handler\n");
+ if (in_handler_flag == 0)
+ {
+ in_handler_flag = 1;
+ gtk_check_menu_item_set_active(GTK_CHECK_MENU_ITEM(menu_item), !(GTK_CHECK_MENU_ITEM(menu_item)->active));
+ SendMessage2ToClean (CcWmCOMMAND, GTK_WIDGET(menu_item), GetModifiers ());
+ in_handler_flag = 0;
+ }
+}
+
+void EvalCcRqINSERTMENUITEM (CrossCallInfo *pcci)
+{
+ gchar *title;
+ GtkWidget *menu, *menu_item, *label;
+ GtkAccelGroup *accel_group;
+ guint graystate, checkstate;
+
+ printf("EvalCcRqINSERTMENUITEM\n");
+ printf("Inserting item with position %d and name %s\n", pcci->p5, (char*)pcci->p3);
+
+ printf("Checking graystate: ");
+ if (pcci->p1)
+ {
+ graystate = 1; // MF_ENABLED
+ } else {
+ graystate = 0; // MF_GRAYED;
+ }
+ printf("%s\n", (graystate ? "enabled" : "grayed"));
+
+ printf("Checking checkstate: ");
+ if (pcci->p4)
+ {
+ checkstate = 1; // MF_CHECKED
+ } else {
+ checkstate = 0; // MF_UNCHECKED
+ }
+ printf("%s\n", (checkstate ? "checked" : "unchecked"));
+
+ printf("Calling Make Mnemonic string with: %s\n", (gchar*)pcci->p3);
+ title = createMnemonicString((gchar *) pcci->p3);
+ printf("Got title: %s\n", title);
+
+ menu = GTK_WIDGET(pcci->p2);
+ printf("Menu widget: %s\n", gtk_menu_get_title(GTK_MENU(menu)));
+
+ printf("Creating new menu item\n");
+ menu_item = gtk_menu_item_new_with_mnemonic(title);
+ gtk_menu_shell_insert( GTK_MENU_SHELL (menu), menu_item, (gint) pcci->p5);
+ //gtk_accel_label_set_accel_widget(GTK_ACCEL_LABEL(label), menu_item);
+ //gtk_check_menu_item_set_active(GTK_CHECK_MENU_ITEM(menu_item), ((pcci->p1 & 1) != 0));
+ //gtk_widget_set_sensitive(menu_item, ((pcci->p1 & 2) != 0));
+
+ gtk_signal_connect_object (GTK_OBJECT (menu_item), "activate",
+ GTK_SIGNAL_FUNC (menuitem_activate_handler), menu_item);
+
+ gtk_widget_show(menu_item);
+
+ printf("About to free title: %s\n", title);
+ rfree(title);
+ printf("Freed title\n");
+
+
+/* if (key != 0)
+ {
+ printf("Creating accellerators\n");
+ accel_group = ((GtkAccelGroup *) gtk_accel_groups_from_object (G_OBJECT(frame))->data);
+
+ gtk_widget_add_accelerator(menu_item, "activate",
+ accel_group,
+ key,
+ GDK_CONTROL_MASK,
+ GTK_ACCEL_VISIBLE);
+ gtk_widget_add_accelerator(menu_item, "activate",
+ accel_group,
+ key,
+ GDK_CONTROL_MASK | GDK_SHIFT_MASK,
+ 0);
+ gtk_widget_add_accelerator(menu_item, "activate",
+ accel_group,
+ key,
+ GDK_CONTROL_MASK | GDK_MOD1_MASK,
+ 0);
+ gtk_widget_add_accelerator(menu_item, "activate",
+ accel_group,
+ key,
+ GDK_CONTROL_MASK | GDK_MOD1_MASK | GDK_SHIFT_MASK,
+ 0);
+ }
+*/
+ printf("Creating return Cci\n");
+ MakeReturn1Cci (pcci, (int) menu_item);
+}
+
+/* Cross call procedure implementations.
+ Eval<nr> corresponds with a CrossCallEntry generated by NewCrossCallEntry (nr,Eval<nr>).
+*/
+
+/* Add a shortkey to a framewindow shortkey table. */
+void EvalCcRqADDMENUSHORTKEY (CrossCallInfo *pcci) /* frameptr, cmd, key; no result. */
+{
+/* ProcessShortcutTable table;
+ HWND frameptr;
+ int cmd, key;
+
+ frameptr = (HWND) pcci->p1;
+ cmd = pcci->p2;
+ key = pcci->p3;
+
+ table = (ProcessShortcutTable) GetWindowLong (frameptr,0);
+ table = AddProcessShortcut (key, cmd, table);
+ SetWindowLong (frameptr, 0, (long)table);
+
+ if (gAcceleratorTableIsUpToDate)
+ gAcceleratorTableIsUpToDate = !(ghActiveFrameWindow==frameptr);
+ }
+*/
+ printf("EvalCcRqADDMENUSHORTKEY\n");
+ MakeReturn0Cci (pcci);
+}
+
+static void find_item_callback(GtkWidget *menu_item, gpointer data)
+{
+ printf("find_item_callback\n");
+ if (GTK_IS_MENU_ITEM(menu_item) && GTK_MENU_ITEM (menu_item)->submenu == ((GtkWidget *) data))
+ *((GtkWidget **) data) = menu_item;
+}
+
+void EvalCcRqITEMENABLE (CrossCallInfo *pcci) /* parent, HITEM, onoff; no result. */
+{
+ GtkWidget *menu, *menu_item;
+ printf("EvalCcRqITEMENABLE\n");
+
+ menu = GTK_WIDGET(pcci->p1);
+ menu_item = GTK_WIDGET(pcci->p2);
+
+ printf("Menu widget: %s\n", gtk_menu_get_title((GtkMenu*)menu));
+ printf("EvalCcRqITEMENABLE\n");
+ gtk_widget_set_sensitive(menu_item, (gboolean) pcci->p3);
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Destroy a menu 'physically' */
+void EvalCcRqDESTROYMENU (CrossCallInfo *pcci) /* HMENU; no result. */
+{
+ printf("EvalCcRqDESTROYMENU\n");
+
+ /*
+ * This is handled behind-the-scenes by GTK
+ */
+ MakeReturn0Cci (pcci);
+}
+
+/* Remove a menu logically */
+void EvalCcRqDELETEMENU (CrossCallInfo *pcci) /* HMENU, HITEM; no result. */
+{
+ GtkWidget *menu, *menu_item;
+ printf("EvalCcRqDELETEMENU\n");
+
+ menu = GTK_WIDGET(pcci->p1);
+ menu_item = GTK_WIDGET(pcci->p2);
+
+ gtk_container_foreach(GTK_CONTAINER(menu), find_item_callback, (gpointer) &menu_item);
+ if (menu_item != GTK_WIDGET(pcci->p2))
+ {
+ gtk_menu_item_remove_submenu(GTK_MENU_ITEM(menu_item));
+ gtk_widget_destroy(menu_item);
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqREMOVEMENUITEM (CrossCallInfo *pcci) /* menu, HITEM; no result. */
+{
+ GtkWidget *menu, *menu_item;
+ printf("EvalCcRqREMOVEMENUITEM\n");
+
+ menu = GTK_WIDGET(pcci->p1);
+ menu_item = GTK_WIDGET(pcci->p2);
+
+ gtk_menu_item_remove_submenu(GTK_MENU_ITEM(menu_item));
+ gtk_widget_destroy(menu_item);
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqINSERTSEPARATOR (CrossCallInfo *pcci) /* hmenu, pos no result. */
+{
+ GtkWidget *menu, *menu_item;
+ printf("EvalCcRqINSERTSEPARATOR\n");
+
+ menu = GTK_WIDGET(pcci->p1);
+ menu_item = gtk_menu_item_new();
+
+ gtk_menu_insert(GTK_MENU(menu), menu_item, (gint) pcci->p2);
+ gtk_widget_show_all(menu_item);
+
+ MakeReturn1Cci (pcci, (int) menu_item);
+}
+
+void EvalCcRqMODIFYMENU (CrossCallInfo *pcci) /* hitem, hmenu, textptr; no result. */
+{
+ gint i;
+ GtkWidget *menu, *menu_item, *label;
+ gchar *title;
+
+ printf("EvalCcRqMODIFYMENU\n");
+ title = createMnemonicString((gchar *) pcci->p3);
+
+ menu = GTK_WIDGET(pcci->p2);
+ menu_item = GTK_WIDGET(pcci->p1);
+ label = gtk_bin_get_child(GTK_BIN(menu_item));
+ gtk_label_set_text_with_mnemonic(GTK_LABEL(label), title);
+
+ rfree(title);
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Insert a menu into the menu bar. */
+void EvalCcRqINSERTMENU (CrossCallInfo *pcci)
+{
+ gint i;
+ gchar *title;
+ GtkWidget *parent_menu, *root_menu, *sub_menu;
+ GtkAccelGroup *accel_group;
+ printf("EvalCcRqINSERTMENU\n");
+
+ title = createMnemonicString((gchar *) pcci->p3);
+ parent_menu = GTK_WIDGET(pcci->p2);
+ sub_menu = GTK_WIDGET(pcci->p4);
+
+ if (GTK_IS_MENU_BAR(parent_menu))
+ {
+ printf("Adding to a menu bar.\n");
+ printf("Menu Bar Name: %s\n", gtk_menu_get_title((GtkMenu*)parent_menu));
+ GtkWidget *frame = gtk_widget_get_parent(gtk_widget_get_parent(parent_menu));
+ accel_group = ((GtkAccelGroup*)gtk_accel_groups_from_object (G_OBJECT(frame))->data);
+ }
+ else
+ {
+ printf("We're not adding to a menu bar!?!\n");
+ printf("Parent Menu widget: %s\n", gtk_menu_get_title((GtkMenu*)parent_menu));
+ accel_group = gtk_menu_get_accel_group (GTK_MENU(parent_menu));
+ }
+
+ gtk_menu_set_accel_group (GTK_MENU(sub_menu), accel_group);
+
+ root_menu = gtk_menu_item_new_with_mnemonic(title);
+ gtk_widget_set_sensitive(root_menu, (gboolean) pcci->p1);
+ gtk_widget_show_all (root_menu);
+
+ gtk_menu_item_set_submenu (GTK_MENU_ITEM (root_menu), sub_menu);
+
+ printf("Inserting menu called %s at position %d (%s)\n",
+ gtk_menu_get_title(GTK_MENU(root_menu)), (gint) pcci->p5, title);
+ if (GTK_IS_MENU_BAR(parent_menu))
+ {
+ gtk_menu_shell_insert(GTK_MENU_SHELL(parent_menu), root_menu, (gint) pcci->p5);
+ } else {
+ gtk_menu_insert(GTK_MENU(parent_menu), root_menu, (gint) pcci->p5);
+ }
+
+ rfree(title);
+
+ printf("New menu is called: %s\n", gtk_menu_get_title((GtkMenu*)root_menu));
+ MakeReturn1Cci (pcci, (int) sub_menu);
+}
+
+static void enable_menu_callback(GtkWidget *menu_item, gpointer data)
+{
+ printf("enable_menu_callback\n");
+ gint *val = (gint*) data;
+ printf("Checking: %d\n", *val);
+ if (GTK_IS_MENU_ITEM(menu_item)
+ && (*val == 0))
+ {
+ gtk_widget_set_sensitive(menu_item, gtk_true());
+ }
+ else
+ {
+ *val = *val - 1;
+ }
+}
+
+static void disable_menu_callback(GtkWidget *menu_item, gpointer data)
+{
+ printf("disable_menu_callback\n");
+ gint *val = (gint*) data;
+
+ printf("Checking: %d\n", *val);
+ if (GTK_IS_MENU_ITEM(menu_item)
+ && (*val == 0))
+ {
+ gtk_widget_set_sensitive(menu_item, gtk_false());
+ }
+ else
+ {
+ *val = *val - 1;
+ }
+}
+
+void EvalCcRqMENUENABLE (CrossCallInfo *pcci) /* parent, zero based position of menu, onoff; no result. */
+{
+ GtkWidget *parent_menu, *sub_menu;
+ printf("EvalCcRqMENUENABLE\n");
+ gint index = pcci->p2;
+
+ if (pcci->p1 && GTK_IS_CONTAINER(pcci->p1))
+ {
+ printf("We have a container. Checking the widget.\n");
+ parent_menu = GTK_WIDGET(pcci->p1);
+ printf("Parent Menu widget: %s\n",
+ gtk_menu_get_title(GTK_MENU(parent_menu)));
+ gtk_container_foreach(GTK_CONTAINER(parent_menu), pcci->p3 ?
+ enable_menu_callback : disable_menu_callback,
+ (gpointer) (&index));
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqDRAWMBAR (CrossCallInfo *pcci) /* framePtr, clientPtr; no result. */
+{
+ printf("EvalCcRqDRAWMBAR\n");
+ MakeReturn0Cci (pcci);
+}
+
+/* Track pop up menu. */
+void EvalCcRqTRACKPOPMENU (CrossCallInfo *pcci) /* popupmenu,framePtr; BOOL result. */
+{
+ printf("EvalCcRqTRACKPOPMENU\n");
+ if (GTK_IS_MENU(pcci->p1))
+ {
+ GtkWidget *popup_menu = GTK_WIDGET(pcci->p1);
+ GtkWidget *frame = GTK_WIDGET(pcci->p2);
+
+ GdkEvent *event = gtk_get_current_event();
+ gtk_menu_popup(GTK_MENU(popup_menu),NULL,NULL,NULL,NULL,
+ (event->type == GDK_BUTTON_PRESS) ?
+ ((GdkEventButton *) event)->button : 0,
+ gdk_event_get_time(event));
+ }
+
+ MakeReturn1Cci (pcci,(int)gtk_true());
+}
+
+void EvalCcRqCREATEPOPMENU (CrossCallInfo *pcci) /* no params; MENU result. */
+{
+ /*
+ * Establish a new meta-menu that will be used to hold the individual
+ * menu entries later.
+ *
+ * This menu should be added to a menu bar.
+ */
+ printf("EvalCcRqCREATEPOPMENU\n");
+ MakeReturn1Cci (pcci, (int) gtk_menu_new());
+}
+
+void EvalCcRqCHECKMENUITEM (CrossCallInfo *pcci) /* menu, HITEM, on/off; no result. */
+{
+ printf("EvalCcRqCHECKMENUITEM\n");
+ if (GTK_IS_MENU(pcci->p1))
+ {
+ GtkWidget *menu = GTK_WIDGET(pcci->p1);
+ GtkWidget *menu_item = GTK_WIDGET(pcci->p2);
+
+ gtk_check_menu_item_set_active(GTK_CHECK_MENU_ITEM(menu_item),
+ (gboolean) pcci->p3);
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+OS InstallCrossCallMenus (OS ios)
+{
+ CrossCallProcedureTable newTable;
+
+ printf("InstallCrossCallMenus\n");
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqADDMENUSHORTKEY, EvalCcRqADDMENUSHORTKEY);
+ AddCrossCallEntry (newTable, CcRqREMOVEMENUSHORTKEY, EvalCcRqREMOVEMENUSHORTKEY);
+ AddCrossCallEntry (newTable, CcRqMODIFYMENUITEM, EvalCcRqMODIFYMENUITEM);
+ AddCrossCallEntry (newTable, CcRqINSERTMENUITEM, EvalCcRqINSERTMENUITEM);
+ AddCrossCallEntry (newTable, CcRqITEMENABLE, EvalCcRqITEMENABLE);
+ AddCrossCallEntry (newTable, CcRqDELETEMENU, EvalCcRqDELETEMENU);
+ AddCrossCallEntry (newTable, CcRqDESTROYMENU, EvalCcRqDESTROYMENU);
+ AddCrossCallEntry (newTable, CcRqREMOVEMENUITEM, EvalCcRqREMOVEMENUITEM);
+ AddCrossCallEntry (newTable, CcRqINSERTSEPARATOR, EvalCcRqINSERTSEPARATOR);
+ AddCrossCallEntry (newTable, CcRqMODIFYMENU, EvalCcRqMODIFYMENU);
+ AddCrossCallEntry (newTable, CcRqINSERTMENU, EvalCcRqINSERTMENU);
+ AddCrossCallEntry (newTable, CcRqMENUENABLE, EvalCcRqMENUENABLE);
+ AddCrossCallEntry (newTable, CcRqDRAWMBAR, EvalCcRqDRAWMBAR);
+ AddCrossCallEntry (newTable, CcRqTRACKPOPMENU, EvalCcRqTRACKPOPMENU);
+ AddCrossCallEntry (newTable, CcRqCREATEPOPMENU, EvalCcRqCREATEPOPMENU);
+ AddCrossCallEntry (newTable, CcRqCHECKMENUITEM, EvalCcRqCHECKMENUITEM);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+
+ return ios;
+}
diff --git a/Linux_C_12/cCrossCallMenus_121.h b/Linux_C_12/cCrossCallMenus_121.h new file mode 100644 index 0000000..8b567ef --- /dev/null +++ b/Linux_C_12/cCrossCallMenus_121.h @@ -0,0 +1,5 @@ +#include "util_121.h"
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+extern OS InstallCrossCallMenus (OS);
diff --git a/Linux_C_12/cCrossCallPrinter_121.c b/Linux_C_12/cCrossCallPrinter_121.c new file mode 100644 index 0000000..593d736 --- /dev/null +++ b/Linux_C_12/cCrossCallPrinter_121.c @@ -0,0 +1,121 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to printer handling.
+********************************************************************************************/
+
+#include "cCrossCallPrinter_121.h"
+
+#if 0
+
+#include "cCrossCall_121.h"
+#include "cprinter_121.h"
+
+extern BOOL bUserAbort;
+extern HWND hDlgPrint; /* MW: hDlgPrint is the handle of the "Cancel Printing" dialog. */
+extern HWND hwndText; /* MW: hwndText is the handle of the page count text in the dialog. */
+
+
+/* Cross call procedure implementations.
+ Eval<nr> corresponds with a CrossCallEntry generated by NewCrossCallEntry (nr,Eval<nr>).
+*/
+void EvalCcRqDO_PRINT_SETUP (CrossCallInfo *pcci)
+{ int ok;
+ PRINTDLG *pdPtr;
+ printSetup(0, pcci->p1,
+ (char*) pcci->p2, (char*) pcci->p3, (char*) pcci->p4, (char*) pcci->p5,
+ &ok, &pdPtr);
+ MakeReturn2Cci (pcci, ok, (int) pdPtr);
+}
+
+void EvalCcRqGET_PRINTER_DC (CrossCallInfo *pcci)
+{ int doDialog,emulateScreenRes,
+ err,first,last,copies,pPrintDlg,deviceContext;
+
+ // unpack doDialog and emulateScreenRes
+ doDialog = (pcci->p1) & 1;
+ emulateScreenRes = (pcci->p1) & 2;
+
+ getDC( doDialog,emulateScreenRes,FALSE,pcci->p2,
+ (char*) pcci->p3,(char*) pcci->p4,(char*) pcci->p5,(char*) pcci->p6,
+ &err,&first,&last,&copies,(PRINTDLG**)&pPrintDlg,&deviceContext);
+ MakeReturn6Cci (pcci,err,first,last,copies,pPrintDlg,deviceContext);
+}
+
+void EvalCcRqSTARTDOC (CrossCallInfo *pcci)
+{
+ HDC hdc = (HDC) pcci->p1;
+ int err;
+
+ EnableWindow (ghMainWindow, FALSE) ;
+ hDlgPrint = CreateCancelDialog ();
+ SetAbortProc (hdc, AbortProc) ;
+ err = startDoc((int) hdc);
+ if (err<=0 && ghMainWindow!=NULL && !bUserAbort)
+ {
+ EnableWindow (ghMainWindow, TRUE) ;
+ DestroyWindow (hDlgPrint) ;
+ };
+ MakeReturn1Cci (pcci,err);
+}
+
+void EvalCcRqENDDOC (CrossCallInfo *pcci)
+{
+ HDC hdc = (HDC) pcci->p1;
+
+ endDoc((int) hdc);
+ if (ghMainWindow!=NULL && !bUserAbort)
+ {
+ EnableWindow (ghMainWindow, TRUE) ;
+ DestroyWindow (hDlgPrint) ;
+ };
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqDISPATCH_MESSAGES_WHILE_PRINTING (CrossCallInfo *pcci)
+{
+ MSG msg ;
+ char *pageMessage= (char *) (pcci->p1);
+
+ SetWindowText(hwndText,pageMessage);
+
+ while (!bUserAbort && PeekMessage (&msg, NULL, 0, 0, PM_REMOVE))
+ {
+ if (!hDlgPrint || !IsDialogMessage (hDlgPrint, &msg))
+ {
+ TranslateMessage (&msg) ;
+ DispatchMessage (&msg) ;
+ }
+ }
+ MakeReturn0Cci (pcci);
+}
+
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+void InstallCrossCallPrinter ()
+{
+ CrossCallProcedureTable newTable;
+
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqDO_PRINT_SETUP, EvalCcRqDO_PRINT_SETUP);
+ AddCrossCallEntry (newTable, CcRqGET_PRINTER_DC, EvalCcRqGET_PRINTER_DC);
+ AddCrossCallEntry (newTable, CcRqSTARTDOC, EvalCcRqSTARTDOC);
+ AddCrossCallEntry (newTable, CcRqENDDOC, EvalCcRqENDDOC);
+ AddCrossCallEntry (newTable, CcRqDISPATCH_MESSAGES_WHILE_PRINTING, EvalCcRqDISPATCH_MESSAGES_WHILE_PRINTING);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+}
+
+#else
+
+OS InstallCrossCallPrinter (OS ios)
+{
+ return ios;
+}
+
+#endif
diff --git a/Linux_C_12/cCrossCallPrinter_121.h b/Linux_C_12/cCrossCallPrinter_121.h new file mode 100644 index 0000000..3ace0bd --- /dev/null +++ b/Linux_C_12/cCrossCallPrinter_121.h @@ -0,0 +1,6 @@ +#include "util_121.h"
+
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+extern OS InstallCrossCallPrinter (OS);
diff --git a/Linux_C_12/cCrossCallProcedureTable_121.c b/Linux_C_12/cCrossCallProcedureTable_121.c new file mode 100644 index 0000000..9e15e26 --- /dev/null +++ b/Linux_C_12/cCrossCallProcedureTable_121.c @@ -0,0 +1,192 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Implementation of cross call procedure table.
+ In this table a linked list of cross call entries is kept.
+ A cross call entry is a pair of a cross call code (CcRq...) number (see intrface_121.h)
+ and a pointer to a cross call procedure.
+ Routines related to printer handling.
+********************************************************************************************/
+#include "cCrossCallProcedureTable_121.h"
+#include <stdlib.h>
+
+/*
+ * A CrossCallEntry contains a CcRq number and a pointer to a
+ * CrossCallProcedure.
+ */
+struct _crosscallentry
+{
+ int cce_code; /* CcRq... number */
+ CrossCallProcedure cce_proc; /* The procedure to be called in case of
+ cce_code */
+ CrossCallEntry cce_next; /* The next entry in the list */
+};
+
+/*
+ * A CrossCallProcedureTable contains a linked list of CrossCallEntries.
+ */
+struct _crosscallproceduretable
+{ int ccpt_size; // nr of entries
+ CrossCallEntry ccpt_first; // first entry
+ CrossCallEntry ccpt_last; // last entry
+};
+
+
+/* NewCrossCallEntry creates a CrossCallEntry with cce_next field NULL. */
+CrossCallEntry NewCrossCallEntry (int cce_code, CrossCallProcedure cce_proc)
+{
+ CrossCallEntry cce;
+ /* printf("NewCrossCallEntry\n"); */
+ cce = rmalloc (sizeof (struct _crosscallentry));
+
+ cce->cce_code = cce_code;
+ cce->cce_proc = cce_proc;
+ cce->cce_next = NULL;
+
+ return cce;
+}
+
+/* FreeCrossCallEntry frees a CrossCallEntry. */
+void FreeCrossCallEntry (CrossCallEntry cce)
+{
+ /* printf("FreeCrossCallEntry\n"); */
+ rfree (cce);
+}
+
+/* EmptyCrossCallProcedureTable creates an empty table. */
+CrossCallProcedureTable EmptyCrossCallProcedureTable (void)
+{
+ CrossCallProcedureTable ccpt;
+ /* printf("EmptyCrossCallProcedureTable\n"); */
+ ccpt = rmalloc (sizeof (struct _crosscallproceduretable));
+
+ ccpt->ccpt_size = 0;
+ ccpt->ccpt_first = NULL;
+ ccpt->ccpt_last = NULL;
+
+ return ccpt;
+}
+
+/*
+ * GetCrossCallProcedureTableSize returns the current number of installed
+ * cross call procedures.
+ */
+int GetCrossCallProcedureTableSize (CrossCallProcedureTable ccpt)
+{
+ /* printf("GetCrossCallProcedureTableSize\n"); */
+ return ccpt->ccpt_size;
+}
+
+/* FreeCrossCallProcedureTable frees a CrossCallProcedureTable. */
+void FreeCrossCallProcedureTable (CrossCallProcedureTable ccpt)
+{
+ /* printf("FreeCrossCallProcedureTable\n"); */
+ rfree (ccpt);
+}
+
+/* SearchCrossCallEntry (nr,entry) returns the first CrossCallEntry
+ following/including entry that either:
+ matches nr, or
+ is the entry after which a new entry with nr should be added, or
+ NULL in case nr should be placed before entry.
+*/
+static CrossCallEntry SearchCrossCallEntry (int nr,CrossCallEntry entry)
+{
+ /* printf("SearchCrossCallEntry\n"); */
+ if (nr == entry->cce_code)
+ return entry; // entry found
+ if (nr < entry->cce_code)
+ return NULL; // no entry found
+ if (entry->cce_next == NULL)
+ return entry; // last entry; should insert new entry after this one
+ if (nr < entry->cce_next->cce_code)
+ return entry; // next entry exceeds nr; should insert new entry after this one
+ return SearchCrossCallEntry (nr,entry->cce_next);
+}
+
+/*
+ * AddCrossCallEntry (table,nr,proc) adds a new entry (nr,proc) if an entry
+ * with nr is not already present.
+ */
+void AddCrossCallEntry (CrossCallProcedureTable ccpt, int cce_code,
+ CrossCallProcedure cce_proc)
+{
+ CrossCallEntry entry;
+ /* printf("AddCrossCallEntry\n"); */
+ entry = NewCrossCallEntry (cce_code,cce_proc);
+
+ if (ccpt->ccpt_size == 0)
+ { /* table is empty; create entry and add it */
+ ccpt->ccpt_size = 1;
+ ccpt->ccpt_first = entry;
+ ccpt->ccpt_last = entry;
+ }
+ else if (cce_code < ccpt->ccpt_first->cce_code)
+ { /* entry should be inserted before first entry */
+ ccpt->ccpt_size += 1;
+ entry->cce_next = ccpt->ccpt_first;
+ ccpt->ccpt_first= entry;
+ }
+ else if (cce_code > ccpt->ccpt_first->cce_code)
+ { /* entry could be in table; look for it and add it if not present */
+ CrossCallEntry searchCCE;
+ searchCCE = SearchCrossCallEntry (cce_code,ccpt->ccpt_first);
+
+ if (searchCCE == NULL)
+ {
+ /* printf("\'AddCrossCallEntry\' SearchCrossCallEntry returned NULL CrossCallEntry"); */
+ exit(1);
+ }
+ if (searchCCE->cce_code != cce_code)
+ { /* entry not in table but should be linked after searchCCE */
+ gboolean appendLast = (ccpt->ccpt_last == searchCCE);
+ ccpt->ccpt_size += 1;
+ entry->cce_next = searchCCE->cce_next;
+ searchCCE->cce_next = entry;
+
+ if (appendLast)
+ ccpt->ccpt_last = entry; // adjust last if entry is appended at end
+ }
+ }
+}
+
+/* AddCrossCallEntries (table,entries) adds the entries to table */
+void AddCrossCallEntries (CrossCallProcedureTable theTable, CrossCallProcedureTable entries)
+{
+ CrossCallEntry cce;
+ /* printf("AddCrossCallEntries\n"); */
+ cce = entries->ccpt_first;
+
+ while (cce != NULL)
+ {
+ AddCrossCallEntry (theTable, cce->cce_code, cce->cce_proc);
+ cce = cce->cce_next;
+ }
+}
+
+/*
+ * FindCrossCallEntry returns the found CrossCallProcedure or NULL if not found.
+ */
+CrossCallProcedure FindCrossCallEntry (CrossCallProcedureTable ccpt, int cce_code)
+{
+ /* printf("FindCrossCallEntry\n"); */
+ if (ccpt->ccpt_size == 0)
+ { /* table is empty, return NULL */
+ return NULL;
+ }
+ else
+ {
+ CrossCallEntry searchCCE;
+ searchCCE = SearchCrossCallEntry (cce_code,ccpt->ccpt_first);
+ if (searchCCE && searchCCE->cce_code == cce_code)
+ return searchCCE->cce_proc;
+ else
+ return NULL;
+ }
+}
+
diff --git a/Linux_C_12/cCrossCallProcedureTable_121.h b/Linux_C_12/cCrossCallProcedureTable_121.h new file mode 100644 index 0000000..6be6d2d --- /dev/null +++ b/Linux_C_12/cCrossCallProcedureTable_121.h @@ -0,0 +1,41 @@ +/* Implementation of cross call procedure table.
+ In this table a linked list of cross call entries is kept.
+ A cross call entry is a pair of a cross call code (CcRq...) number (see intrface_121.h)
+ and a pointer to a cross call procedure.
+*/
+#ifndef CROSSCALLPROCEDURETABLE_H
+#define CROSSCALLPROCEDURETABLE_H
+
+#include "util_121.h"
+
+/* A CrossCallProcedure is a procedure that modifies a CrossCallInfo struct. */
+typedef void (*CrossCallProcedure)(CrossCallInfo *);
+
+typedef struct _crosscallentry *CrossCallEntry;
+typedef struct _crosscallproceduretable *CrossCallProcedureTable;
+
+/* NewCrossCallEntry creates a CrossCallEntry with cce_next field NULL. */
+extern CrossCallEntry NewCrossCallEntry (int cce_code, CrossCallProcedure cce_proc);
+
+/* FreeCrossCallEntry frees a CrossCallEntry. */
+extern void FreeCrossCallEntry (CrossCallEntry cce);
+
+/* EmptyCrossCallProcedureTable creates an empty table. */
+extern CrossCallProcedureTable EmptyCrossCallProcedureTable (void);
+
+/* GetCrossCallProcedureTableSize returns the current number of installed cross call procedures. */
+extern int GetCrossCallProcedureTableSize (CrossCallProcedureTable ccpt);
+
+/* FreeCrossCallProcedureTable frees a CrossCallProcedureTable. */
+extern void FreeCrossCallProcedureTable (CrossCallProcedureTable ccpt);
+
+/* AddCrossCallEntry adds the given entry if not already present. */
+extern void AddCrossCallEntry (CrossCallProcedureTable ccpt, int cce_code, CrossCallProcedure cce_proc);
+
+/* AddCrossCallEntries (table,entries) adds the entries to table. */
+extern void AddCrossCallEntries (CrossCallProcedureTable theTable, CrossCallProcedureTable entries);
+
+/* FindCrossCallEntry returns the found CrossCallProcedure or NULL if not found.*/
+extern CrossCallProcedure FindCrossCallEntry (CrossCallProcedureTable ccpt, int cce_code);
+
+#endif
diff --git a/Linux_C_12/cCrossCallWindows_121.c b/Linux_C_12/cCrossCallWindows_121.c new file mode 100644 index 0000000..93509c2 --- /dev/null +++ b/Linux_C_12/cCrossCallWindows_121.c @@ -0,0 +1,2482 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to window/dialog handling.
+********************************************************************************************/
+
+#include "cCrossCallWindows_121.h"
+#include "cCCallWindows_121.h"
+#include "cCCallSystem_121.h"
+#include "cCrossCall_121.h"
+#include "cCrossCallxDI_121.h"
+#include <gdk/gdkkeysyms.h>
+
+/* Global data:
+*/
+
+extern GtkWidget *gActiveTopLevelWindow;
+
+//static PAINTSTRUCT gPaintStruct;
+//static LONG stdEditCallback = 0; /* The standard internal Windows callback routine of edit controls. */
+//static LONG stdPopUpCallback = 0; /* The standard internal Windows callback routine of pop up controls. */
+
+//HWND ghCaretWnd = NULL;
+
+GdkCursor *gArrowCursor = NULL;
+GdkCursor *gBusyCursor = NULL;
+GdkCursor *gIBeamCursor = NULL;
+GdkCursor *gCrossCursor = NULL;
+GdkCursor *gFatCrossCursor = NULL;
+GdkCursor *gHiddenCursor = NULL;
+
+GtkWidget *gFirstRadioButton = NULL;
+
+const gchar* SCROLL_SIZE_KEY = "scrollbar-size";
+const gchar* SCROLL_VALUE_CHANGED = "value-changed";
+const gchar* SCROLL_POS_KEY = "current-scroll-position";
+
+/* Some macros needed to support windows-ish scrollbars */
+#define SB_CTL 2
+#define SB_LINEUP 0
+#define SB_LINELEFT 0
+#define SB_LINEDOWN 1
+#define SB_LINERIGHT 1
+#define SB_PAGEUP 2
+#define SB_PAGEDOWN 3
+#define SB_THUMBPOSITION 4
+#define SB_TOP 6
+#define SB_BOTTOM 7
+
+/* Find the first non CompoundControl parent window of the argument. */
+static GtkWidget *GetControlParent (GtkWidget *widget)
+{
+ GtkWidget *parent = widget, *res = NULL, *last = NULL;
+ printf("GetControlParent\n");
+
+ while (parent != NULL)
+ {
+ if (GTK_IS_SCROLLED_WINDOW(parent))
+ res = parent;
+
+ last = parent;
+ parent = gtk_widget_get_parent (parent);
+ }
+
+ return (GTK_IS_DIALOG(last)) ? last : res;
+}
+
+static GtkFixed *GetFixed (GtkWidget *widget)
+{
+ printf("GetFixed\n");
+ if (GTK_IS_DIALOG(widget))
+ {
+ return GTK_FIXED(
+ GTK_WIDGET(gtk_container_children(
+ GTK_CONTAINER(GTK_DIALOG(widget)->vbox))->data));
+ }
+ else
+ {
+ return GTK_FIXED(GTK_BIN(GTK_BIN(widget)->child)->child);
+ }
+}
+
+
+/*********************************************************************************************
+ The callback routine for a compound control.
+*********************************************************************************************/
+#if 0
+static LRESULT CALLBACK CompoundControlProcedure (HWND hwnd, UINT uMess, WPARAM wParam, LPARAM lParam)
+{
+ switch (uMess)
+ {
+ case WM_COMMAND:
+ {
+ switch (HIWORD (wParam))
+ {
+ case BN_CLICKED:
+ {
+ if (lParam != 0)
+ {
+ /* Send also modifiers to Clean */
+ SendMessage4ToClean (CcWmBUTTONCLICKED, GetControlParent (hwnd), lParam, GetModifiers (), LOWORD (wParam));
+ }
+ return 0;
+ }
+ break;
+ case CBN_SETFOCUS:
+ {
+ gComboSelection = SendMessage ((HWND) lParam, CB_GETCURSEL, 0, 0);
+ return 0;
+ }
+ break;
+ case CBN_KILLFOCUS:
+ {
+ gComboSelection = -1;
+ return 0;
+ }
+ break;
+ case CBN_SELENDOK:
+ {
+ char text[256];
+ int newsel;
+ HWND combo;
+
+ combo = (HWND) lParam;
+ newsel = SendMessage (combo, CB_GETCURSEL, 0, 0);
+ SendMessage (combo, CB_GETLBTEXT, newsel, (LPARAM) text);
+ if (!SendMessage (combo, CB_GETITEMDATA, newsel, 0))
+ {
+ SendMessage (combo, CB_SETCURSEL, gComboSelection, (LPARAM) text);
+ MessageBeep (0xFFFFFFFF);
+ return 0;
+ }
+ else
+ {
+ gComboSelection = newsel;
+ if (newsel!=CB_ERR)
+ SendMessage3ToClean (CcWmITEMSELECT, GetControlParent (hwnd), combo, newsel);
+ return 1;
+ }
+ }
+ break;
+ }
+ return 0;
+ } break;
+ case WM_PAINT:
+ {
+ HWND parentwindow;
+ HDC hdc;
+ PAINTSTRUCT ps;
+
+ if (GetUpdateRect(hwnd,NULL,FALSE)) // determine if there is really an update area.
+ {
+ parentwindow = GetControlParent (hwnd);
+ hdc = BeginPaint (hwnd, &ps);
+ SendMessage3ToClean (CcWmDRAWCONTROL, parentwindow, hwnd, hdc);
+ EndPaint (hwnd, &ps);
+ }
+ return 0;
+ } break;
+ case WM_HSCROLL:
+ {
+ int nPos,nScrollCode,controlkind;
+ HWND parentwindow, hwndScrollBar;
+
+ nScrollCode = LOWORD (wParam);
+
+ if (nScrollCode != SB_ENDSCROLL) /* Do not send the SB_ENDSCROLL to Clean. */
+ {
+ nPos = (short int) HIWORD (wParam);
+ parentwindow = GetControlParent (hwnd);
+ hwndScrollBar = (HWND) lParam;
+
+ if (hwndScrollBar==0)
+ {
+ controlkind = SB_HORZ; /* lParam==0 in case of Compound scrollbars. */
+ hwndScrollBar = hwnd; /* pass the compound control handle to Clean. */
+ UpdateWindow (hwnd); /* but first ensure that compound control is updated. */
+ }
+ else
+ {
+ controlkind = SB_CTL; /* lParam!==0 in case of SliderControls. */
+ }
+ SendMessage5ToClean (CcWmSCROLLBARACTION, parentwindow, hwndScrollBar, controlkind, nScrollCode, nPos);
+ }
+ return 0;
+ }
+ break;
+ case WM_VSCROLL:
+ {
+ int nPos,nScrollCode,controlkind;
+ HWND parentwindow, hwndScrollBar;
+
+ nScrollCode = LOWORD (wParam);
+
+ if (nScrollCode != SB_ENDSCROLL) /* Do not send the SB_ENDSCROLL to Clean. */
+ {
+ nPos = (short int) HIWORD (wParam);
+ parentwindow = GetControlParent (hwnd);
+ hwndScrollBar = (HWND) lParam;
+
+ if (hwndScrollBar==0)
+ {
+ controlkind = SB_VERT; /* lParam==0 in case of Compound scrollbars. */
+ hwndScrollBar = hwnd; /* pass the compound control handle to Clean. */
+ UpdateWindow (hwnd); /* but first ensure that compound control is updated. */
+ }
+ else
+ {
+ controlkind = SB_CTL; /* lParam!==0 in case of SliderControls. */
+ }
+ SendMessage5ToClean (CcWmSCROLLBARACTION, parentwindow, hwndScrollBar, controlkind, nScrollCode, nPos);
+ }
+ return 0;
+ }
+ break;
+ /* The following cases concerning mouse events
+ (WM_LBUTTONDOWN upto WM_TIMER) have been copied from CustomControlProcedure.
+ */
+ case WM_LBUTTONDOWN:
+ {
+/* SendMouseDownToClean (GetControlParent (hwnd), hwnd, SIGNEDLOWORD (lParam), SIGNEDHIWORD (lParam));*/
+ return 0;
+ } break;
+ case WM_MOUSEMOVE:
+ {
+ if (gInMouseDown)
+ {
+/* SendMouseStillDownToClean (GetControlParent (hwnd), hwnd, SIGNEDLOWORD (lParam), SIGNEDHIWORD (lParam)); */
+ }
+ else
+ {
+/* SendMouseStillUpToClean (GetControlParent (hwnd), hwnd, SIGNEDLOWORD (lParam), SIGNEDHIWORD (lParam)); */
+ }
+ return 0;
+ } break;
+ case WM_LBUTTONUP:
+ {
+ if (gInMouseDown)
+ {
+ ReleaseCapture (); /* rely on WM_CAPTURECHANGED to send the mouseUp event */
+ }
+ return 0;
+ } break;
+ case WM_CANCELMODE:
+ {
+ if (gInMouseDown)
+ {
+ ReleaseCapture (); /* rely on WM_CAPTURECHANGED to send the mouseUp event */
+ }
+ return DefWindowProc (hwnd, uMess, wParam, lParam);
+ } break;
+ case WM_CAPTURECHANGED:
+ {
+ if (gInMouseDown)
+ {
+ POINT p;
+ GetCursorPos (&p);
+ ScreenToClient (hwnd, &p);
+/* SendMouseUpToClean (GetControlParent (hwnd), hwnd, p.x, p.y); */
+ }
+ return 0;
+ } break;
+ /* The following cases concerning key events and focus events
+ (WM_SYSKEYDOWN upto WM_GETDLGCODE) have been copied from CustomControlProcedure.
+ */
+ case WM_SYSKEYDOWN:
+ case WM_KEYDOWN:
+ {
+ int c = 0;
+ HWND hwndParent;
+
+ c = CheckVirtualKeyCode ((int) wParam);
+
+ if (!c)
+ /* Ignore non-virtual keys, because they arrive as WM_SYSCHAR and WM_CHAR. */
+ {
+ return DefWindowProc (hwnd, uMess, wParam, lParam);
+ }
+ /* Handle virtual keys analogously to keys received as WM_SYSCHAR and WM_CHAR. */
+ hwndParent = GetControlParent (hwnd);
+/* if (gInKey)
+ {
+ if (gCurChar == c)
+ SendKeyStillDownToClean (hwndParent, hwnd, gCurChar);
+ else
+ {
+ SendKeyUpToClean (hwndParent, hwnd, gCurChar);
+ gCurChar = c;
+ SendKeyDownToClean (hwndParent, hwnd, gCurChar);
+ }
+ }
+ else
+ {
+ gCurChar = c;
+ SendKeyDownToClean (hwndParent, hwnd, gCurChar);
+ gInKey = TRUE;
+ }
+*/
+ return 0;
+ }
+ break;
+ case WM_SYSCHAR:
+ case WM_CHAR:
+ {
+ HWND hwndParent = GetControlParent (hwnd);
+
+/* if (gInKey)
+ {
+ if (gCurChar == (int) wParam)
+ SendKeyStillDownToClean (hwndParent, hwnd, gCurChar);
+ else
+ {
+ SendKeyUpToClean (hwndParent, hwnd, gCurChar);
+ gCurChar = wParam;
+ SendKeyDownToClean (hwndParent, hwnd, gCurChar);
+ }
+ }
+ else
+ {
+ gCurChar = wParam;
+ SendKeyDownToClean (hwndParent, hwnd, gCurChar);
+ gInKey = TRUE;
+ }
+*/
+ return 0;
+ }
+ break;
+ case WM_SYSKEYUP:
+ case WM_KEYUP:
+ {
+ if (gInKey)
+ SendKeyUpToClean (GetControlParent (hwnd), hwnd, gCurChar);
+ gInKey = FALSE;
+ gCurChar = 0;
+ return DefWindowProc (hwnd, uMess, wParam, lParam);
+ }
+ break;
+ case WM_KILLFOCUS:
+ {
+ HWND hwndParent = GetControlParent (hwnd);
+ if (gInKey)
+ SendKeyUpToClean (hwndParent, hwnd, gCurChar);
+ gInKey = FALSE;
+ gCurChar = 0;
+ /* WM_KILLFOCUS now also sends the CcWmKILLFOCUS message to
+ Clean (because of the ControlDeactivate attribute).
+ */
+ SendMessage2ToClean (CcWmKILLFOCUS, hwndParent, hwnd);
+ return 0;
+ }
+ break;
+ case WM_SETFOCUS:
+ {
+ /* WM_SETFOCUS sends the CcWmSETFOCUS message to Clean because
+ of the ControlActivate attribute.
+ */
+ SendMessage2ToClean (CcWmSETFOCUS, GetControlParent (hwnd), hwnd);
+ return 0;
+ }
+ break;
+ /* The WM_CLOSE event is generated when a user presses escape inside an EditControl that exists
+ within the CompoundControl which exists within a Dialog.
+ */
+ case WM_CLOSE:
+ {
+ SendMessage1ToClean (CcWmCLOSE, GetControlParent (hwnd));
+ return 0;
+ }
+ break;
+ case WM_GETDLGCODE: /* Inform dialog procedure to pass all keyboard input to the control. */
+ return (DLGC_WANTCHARS | DLGC_WANTARROWS);
+ break;
+ case WM_DRAWITEM:
+ {
+ LPDRAWITEMSTRUCT lpdis;
+ lpdis = (LPDRAWITEMSTRUCT) lParam;
+
+ switch (lpdis->CtlType)
+ {
+ case ODT_COMBOBOX:
+ {
+ char text[256];
+ COLORREF forecolor, bkcolor;
+ SendMessage (lpdis->hwndItem, CB_GETLBTEXT, lpdis->itemID, (LPARAM) text);
+ if (lpdis->itemState & ODS_DISABLED)
+ {
+ forecolor = SetTextColor (lpdis->hDC, GetSysColor (COLOR_GRAYTEXT));
+ bkcolor = SetBkColor (lpdis->hDC, GetSysColor (COLOR_3DFACE));
+ }
+ else if (lpdis->itemState & ODS_SELECTED)
+ {
+ if (lpdis->itemData)
+ {
+ forecolor = SetTextColor (lpdis->hDC, GetSysColor (COLOR_HIGHLIGHTTEXT));
+ bkcolor = SetBkColor (lpdis->hDC, GetSysColor (COLOR_HIGHLIGHT));
+ }
+ else
+ {
+ forecolor = SetTextColor (lpdis->hDC, GetSysColor (COLOR_GRAYTEXT));
+ bkcolor = SetBkColor (lpdis->hDC, GetSysColor (COLOR_WINDOW));
+ }
+ }
+ else
+ {
+ if (lpdis->itemData)
+ forecolor = SetTextColor (lpdis->hDC, GetSysColor (COLOR_WINDOWTEXT));
+ else
+ forecolor = SetTextColor (lpdis->hDC, GetSysColor (COLOR_GRAYTEXT));
+ bkcolor = SetBkColor (lpdis->hDC, GetSysColor (COLOR_WINDOW));
+ }
+
+ ExtTextOut (lpdis->hDC, /* device context */
+ lpdis->rcItem.left + 2, /* ref point x */
+ lpdis->rcItem.top + 1, /* ref point y */
+ ETO_CLIPPED | ETO_OPAQUE, /* options */
+ &lpdis->rcItem, /* clipping rect */
+ text, /* text to draw */
+ lstrlen (text), /* length of text to draw */
+ NULL /* no kerning array */
+ );
+
+ SetTextColor (lpdis->hDC, forecolor);
+ SetBkColor (lpdis->hDC, bkcolor);
+
+ if (lpdis->itemState & ODS_FOCUS)
+ DrawFocusRect (lpdis->hDC, &lpdis->rcItem);
+ return 0;
+ } break;
+ case ODT_BUTTON:
+ {
+ HWND parentwindow;
+ parentwindow = GetControlParent (hwnd);
+
+ SendMessage3ToClean (CcWmDRAWCONTROL, parentwindow, lpdis->hwndItem, lpdis->hDC);
+
+ if (lpdis->itemState & ODS_SELECTED)
+ InvertRect (lpdis->hDC, &lpdis->rcItem);
+
+ if (lpdis->itemState & ODS_FOCUS)
+ DrawFocusRect (lpdis->hDC, &lpdis->rcItem);
+ return 0;
+ } break;
+ }
+ return 0;
+ }
+ break;
+ default:
+ return DefWindowProc (hwnd, uMess, wParam, lParam);
+ break;
+ }
+ ErrorExit ("Fatal error: case leak in CompoundControlProcedure (%d).",uMess);
+} /* CompoundControlProcedure */
+#endif
+
+/*********************************************************************************************
+ Cross call procedure implementations.
+ Eval<nr> corresponds with a CrossCallEntry generated by NewCrossCallEntry (nr,Eval<nr>).
+*********************************************************************************************/
+void EvalCcRqBEGINPAINT (CrossCallInfo *pcci) /* hwnd; HDC result. */
+{
+/* HDC hdc;
+ hdc = BeginPaint ((HWND) pcci->p1, &gPaintStruct);
+*/
+
+ rprintf("EvalCcRqBEGINPAINT -> not implemented\n");
+ MakeReturn1Cci (pcci, (int) NULL /*hdc*/);
+}
+
+void EvalCcRqENDPAINT (CrossCallInfo *pcci) /* hwnd; no result. */
+{
+/* EndPaint ((HWND) pcci->p1, &gPaintStruct); */
+ rprintf("EvalCcRqEndPaint -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqFAKEPAINT (CrossCallInfo *pcci) /* hwnd; no result. */
+{
+/* HWND hwnd = (HWND) pcci->p1;
+
+ BeginPaint (hwnd, &gPaintStruct);
+ EndPaint (hwnd,&gPaintStruct);
+ InvalidateRect (hwnd, NULL, FALSE);
+*/
+
+ printf("EvalCcRqFAKEPAINT -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqDESTROYMODALDIALOG (CrossCallInfo *pcci) /* hwnd; no result. */
+{
+ GtkWidget *dialog;
+ printf("EvalCcRqDESTROYMODALDIALOG\n");
+ dialog = GTK_WIDGET(pcci->p1);
+ gtk_dialog_response (GTK_DIALOG(dialog), 0);
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqDESTROYMDIDOCWINDOW (CrossCallInfo *pcci) /* hwndFrame, hwndClient, wPtr; no result. */
+{
+ gint page_num;
+ GtkWidget *frame, *client, *window;
+
+ printf("EvalCcRqDESTROYMDIDOCWINDOW\n");
+ frame = GTK_WIDGET(pcci->p1);
+ client = GTK_WIDGET(pcci->p2);
+ window = GTK_WIDGET(pcci->p3);
+
+ page_num = gtk_notebook_page_num(GTK_NOTEBOOK(client), window);
+ gtk_notebook_remove_page(GTK_NOTEBOOK(client), page_num);
+
+ MakeReturn0Cci (pcci);
+}
+
+static gint client_expose_handler(GtkWidget *widget, GdkEventExpose *event, gpointer user_data)
+{
+ printf("client_expose_handler\n");
+ SendMessage6ToClean(CcWmPAINT, (int)gtk_widget_get_parent(gtk_widget_get_parent(widget)),
+ event->area.x,
+ event->area.y,
+ event->area.x+event->area.width,
+ event->area.y+event->area.height,
+ (int) GDK_DRAWABLE(event->window));
+
+ return GTK_WIDGET_GET_CLASS(widget)->expose_event(widget,event);
+}
+
+static void sw_focus_out_handler(GtkWidget *widget, GdkEventFocus *event, gpointer user_data)
+{
+ printf("sw_focus_out_handler\n");
+ if (gInKey)
+ {
+ SendKeyUpToClean (widget, widget, gCurChar);
+ }
+
+ gInKey = gtk_false();
+ gCurChar = 0;
+}
+
+static gboolean sw_button_press_handler(GtkWidget *widget, GdkEventButton *event, gpointer user_data)
+{
+ printf("sw_button_press_handler\n");
+ if (event->button == 1)
+ {
+ GtkWidget *client = gtk_widget_get_parent(widget);
+
+ gInMouseDown = TRUE;
+
+ switch (event->type)
+ {
+ case GDK_BUTTON_PRESS:
+ SendMessage6ToClean (CcWmMOUSE, client, client, BUTTONDOWN, event->x, event->y, GetModifiers());
+ break;
+ case GDK_2BUTTON_PRESS:
+ SendMessage6ToClean (CcWmMOUSE, client, client, BUTTONDOUBLEDOWN, event->x, event->y, GetModifiers());
+ break;
+ case GDK_3BUTTON_PRESS:
+ SendMessage6ToClean (CcWmMOUSE, client, client, BUTTONTRIPLEDOWN, event->x, event->y, GetModifiers());
+ break;
+ }
+ return gtk_true();
+ }
+ return gtk_false();
+}
+
+static gboolean sw_button_release_handler(GtkWidget *widget, GdkEventButton *event, gpointer user_data)
+{
+ printf("sw_button_release_handler\n");
+ if (event->button == 1)
+ {
+ GtkWidget *client = gtk_widget_get_parent(widget);
+
+ gInMouseDown = FALSE;
+ SendMessage6ToClean (CcWmMOUSE, client, client, BUTTONUP, event->x, event->y, GetModifiers());
+ return gtk_true();
+ }
+ return gtk_false();
+}
+
+static gboolean sw_motion_notify_handler(GtkWidget *widget, GdkEventMotion *event, gpointer user_data)
+{
+ GtkWidget *client;
+ printf("sw_motion_notify_handler\n");
+ client = gtk_widget_get_parent(widget);
+
+ if (gInMouseDown)
+ {
+ SendMessage6ToClean(CcWmMOUSE, client, client, BUTTONSTILLDOWN, event->x, event->y, GetModifiers());
+ } else {
+ SendMessage6ToClean (CcWmMOUSE, client, client, BUTTONSTILLUP, event->x, event->y, GetModifiers());
+ }
+ return gtk_true();
+}
+
+static void client_size_allocate(GtkWidget *widget, GtkAllocation *allocation, gpointer user_data)
+{
+ GtkWidget *sw;
+ printf("client_size_allocate\n");
+ sw = GTK_WIDGET(user_data);
+ SendMessage4ToClean (CcWmSIZE, sw, allocation->width, allocation->height, (int)FALSE);
+}
+
+static void client_size_request(GtkWidget *widget, GtkRequisition *requisition, gpointer user_data)
+{
+ printf("client_size_request\n");
+ *requisition = *((GtkRequisition *) user_data);
+ printf("client_size_request(%d,%d)\n", requisition->width, requisition->height);
+}
+
+static gboolean client_delete_handler(GtkWidget *widget, GdkEvent *event, gpointer user_data)
+{
+ printf("client_delete_handler(%d,%d)\n", ((GtkRequisition *) user_data)->width, ((GtkRequisition *) user_data)->height);
+ g_free(((GtkRequisition*)user_data));
+ return gtk_true();
+}
+
+static void compute_height(GtkWidget *widget, gpointer data)
+{
+ GtkRequisition requisition;
+ printf("compute_height\n");
+ gtk_widget_size_request(widget,&requisition);
+ *((int *) data) += requisition.height;
+}
+
+/* Create a SDI document window. */
+void EvalCcRqCREATESDIDOCWINDOW (CrossCallInfo *pcci) /* textptr, frameptr, packed pos, w,h, flags; client ptr result. */
+{
+ GtkWidget *window, *fixed, *box, *sw;
+ const gchar *pwintitle;
+ gint left, top, width, height;
+ GtkRequisition *requisition;
+
+ printf("EvalCcRqCREATESDIDOCWINDOW\n");
+ pwintitle = (const gchar *) pcci->p1;
+ window = GTK_WIDGET(pcci->p2);
+ left = pcci->p3>>16;
+ top = (pcci->p3<<16)>>16;
+ width = pcci->p4;
+ height = pcci->p5;
+
+ requisition = g_new(GtkRequisition, 1);
+ requisition->width = 0;
+ requisition->height = 0;
+
+ /* Adjust the pos and size of the frame window. */
+ gtk_widget_set_uposition(window, left, top);
+
+ if (pwintitle)
+ {
+ gtk_window_set_title(GTK_WINDOW(window), pwintitle);
+ }
+
+ /* Create a Scrolled Window */
+ sw = gtk_scrolled_window_new (NULL, NULL);
+ gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (sw),
+ GTK_POLICY_AUTOMATIC,
+ GTK_POLICY_AUTOMATIC);
+ box = gtk_bin_get_child(GTK_BIN(window));
+ gtk_box_pack_end (GTK_BOX (box), sw, TRUE, TRUE, 0);
+
+ /* Create a Fixed Container */
+ fixed = gtk_fixed_new();
+ gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(sw), fixed);
+
+ /* Signals */
+ gtk_signal_connect (GTK_OBJECT(fixed), "expose-event",
+ GTK_SIGNAL_FUNC(client_expose_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "focus-out-event",
+ GTK_SIGNAL_FUNC(sw_focus_out_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "button-press-event",
+ GTK_SIGNAL_FUNC(sw_button_press_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "button-release-event",
+ GTK_SIGNAL_FUNC(sw_button_release_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "motion_notify_event",
+ GTK_SIGNAL_FUNC(sw_motion_notify_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(fixed), "size-allocate",
+ GTK_SIGNAL_FUNC(client_size_allocate),
+ sw);
+ gtk_signal_connect (GTK_OBJECT(fixed), "size-request",
+ GTK_SIGNAL_FUNC(client_size_request),
+ requisition);
+ gtk_signal_connect (GTK_OBJECT(fixed), "delete-event",
+ GTK_SIGNAL_FUNC(client_delete_handler),
+ requisition);
+
+ g_object_set_data(G_OBJECT(sw), SCROLL_SIZE_KEY, (gpointer)requisition);
+
+ SendMessage1ToClean (CcWmCREATE, sw);
+
+ gtk_widget_realize(window);
+
+ {
+ gint depth;
+ GdkRectangle ext_rect, rect;
+
+ gdk_window_get_geometry(window->window, &rect.x, &rect.y, &rect.width, &rect.height, &depth);
+ gdk_window_get_frame_extents (window->window,&ext_rect);
+
+ gtk_container_foreach(GTK_CONTAINER(GTK_BIN(window)->child), compute_height, &ext_rect.height);
+
+ gtk_window_set_default_size(GTK_WINDOW(window), width+(ext_rect.width - rect.width), height+(ext_rect.height - rect.height));
+ }
+
+ gtk_widget_show_all(window);
+
+ gdk_window_set_events(GTK_BIN(sw)->child->window,
+ gdk_window_get_events(GTK_BIN(sw)->child->window) | GDK_BUTTON_RELEASE_MASK | GDK_POINTER_MOTION_MASK);
+ fprintf(stderr,"EvalCcRqCREATESDIDOCWINDOW - window: %d sw: %d\n",window,sw);
+ MakeReturn1Cci (pcci, (int) sw);
+}
+
+/* Create MDI child window. */
+void EvalCcRqCREATEMDIDOCWINDOW (CrossCallInfo *pcci) /* textptr, clientPtr, behindPtr, packed pos, packed size, flags; HWND result. */
+{
+ GtkWidget *window, *fixed, *client, *behind, *sw;
+ const gchar *pwintitle;
+ gint left, top, width, height;
+ GtkRequisition *requisition;
+ gint index;
+
+ printf("EvalCcRqCREATEMDIDOCWINDOW\n");
+ pwintitle = (const gchar *) pcci->p1;
+ client = GTK_WIDGET(pcci->p2);
+ behind = GTK_WIDGET(pcci->p3);
+ left = pcci->p4>>16;
+ top = (pcci->p4<<16)>>16;
+ width = pcci->p5>>16;
+ height = (pcci->p5<<16)>>16;
+
+ window = gtk_widget_get_parent(gtk_widget_get_parent(client));
+
+ requisition = g_new(GtkRequisition, 1);
+ requisition->width = 0;
+ requisition->height = 0;
+
+ /* Create a Scrolled Window */
+ sw = gtk_scrolled_window_new (NULL, NULL);
+ gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (sw),
+ GTK_POLICY_AUTOMATIC,
+ GTK_POLICY_AUTOMATIC);
+ index = gtk_notebook_page_num(GTK_NOTEBOOK(client), behind);
+ gtk_notebook_insert_page(GTK_NOTEBOOK(client), sw,
+ pwintitle ? gtk_label_new(pwintitle) : NULL,
+ index);
+
+ /* Create a Fixed Container */
+ fixed = gtk_fixed_new();
+ gtk_scrolled_window_add_with_viewport(GTK_SCROLLED_WINDOW(sw), fixed);
+
+ /* Signals */
+ gtk_signal_connect (GTK_OBJECT(fixed), "expose-event",
+ GTK_SIGNAL_FUNC(client_expose_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "focus-out-event",
+ GTK_SIGNAL_FUNC(sw_focus_out_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "button-press-event",
+ GTK_SIGNAL_FUNC(sw_button_press_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "button-release-event",
+ GTK_SIGNAL_FUNC(sw_button_release_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(GTK_BIN(sw)->child), "motion_notify_event",
+ GTK_SIGNAL_FUNC(sw_motion_notify_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(fixed), "size-allocate",
+ GTK_SIGNAL_FUNC(client_size_allocate),
+ sw);
+ gtk_signal_connect (GTK_OBJECT(fixed), "size-request",
+ GTK_SIGNAL_FUNC(client_size_request),
+ requisition);
+ gtk_signal_connect (GTK_OBJECT(fixed), "delete-event",
+ GTK_SIGNAL_FUNC(client_delete_handler),
+ requisition);
+
+ g_object_set_data(G_OBJECT(sw), SCROLL_SIZE_KEY, (gpointer)requisition);
+
+ SendMessage1ToClean (CcWmCREATE, sw);
+
+ gtk_widget_show_all(sw);
+ gtk_notebook_set_current_page(GTK_NOTEBOOK(client), gtk_notebook_page_num(GTK_NOTEBOOK(client),sw));
+
+ gdk_window_set_events(GTK_BIN(sw)->child->window,
+ gdk_window_get_events(GTK_BIN(sw)->child->window) | GDK_BUTTON_RELEASE_MASK | GDK_POINTER_MOTION_MASK);
+
+ MakeReturn1Cci (pcci, (int) sw);
+}
+
+void EvalCcRqSETWINDOWTITLE (CrossCallInfo *pcci) /* hwnd, textptr no result. */
+{
+ GtkWidget *window;
+ gchar *title = (gchar *) pcci->p2;
+
+ printf("EvalCcRqSETWINDOWTITLE\n");
+ window = GTK_WIDGET(pcci->p1);
+ if (GTK_IS_WINDOW(window))
+ {
+ gtk_window_set_title(GTK_WINDOW(window), title);
+ }
+ else
+ {
+ if (GTK_IS_LABEL(window))
+ {
+ gtk_label_set_text(GTK_LABEL(window), title);
+ }
+ else
+ {
+ if (GTK_IS_BUTTON(window))
+ {
+ title = createMnemonicString(title);
+ gtk_button_set_label(GTK_BUTTON(window), title);
+ rfree(title);
+ }
+ else
+ {
+ if (GTK_IS_ENTRY(window))
+ {
+ gtk_entry_set_text(GTK_ENTRY(window), title);
+ }
+ else
+ {
+ if (GTK_IS_TEXT_VIEW(window))
+ {
+ GtkTextBuffer *buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(window));
+ gtk_text_buffer_set_text (buffer, title, strlen(title));
+ }
+ else
+ {
+ printf("EvalCcRqSETWINDOWTITLE -> unknown widget type");
+ }
+ }
+ }
+ }
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqGETWINDOWTEXT (CrossCallInfo *pcci) /* hwnd; textptr result. */
+{
+ G_CONST_RETURN gchar *title = NULL;
+ GtkWidget *window;
+ gchar *textptr;
+
+ printf("EvalCcRqGETWINDOWTEXT\n");
+ window = GTK_WIDGET(pcci->p1);
+
+ if (GTK_IS_WINDOW(window))
+ {
+ title = gtk_window_get_title(GTK_WINDOW(window));
+ }
+ else
+ {
+ if (GTK_IS_LABEL(window))
+ {
+ title = gtk_label_get_text(GTK_LABEL(window));
+ }
+ else
+ {
+ if (GTK_IS_BUTTON(window))
+ {
+ title = gtk_button_get_label(GTK_BUTTON(window));
+ }
+ else
+ {
+ if (GTK_IS_ENTRY(window))
+ {
+ title = gtk_entry_get_text(GTK_ENTRY(window));
+ }
+ else
+ {
+ if (GTK_IS_TEXT_VIEW(window))
+ {
+ GtkTextBuffer *buffer = gtk_text_view_get_buffer(GTK_TEXT_VIEW(window));
+ GtkTextIter start, end;
+
+ gtk_text_buffer_get_start_iter(buffer, &start);
+ gtk_text_buffer_get_end_iter(buffer, &end);
+ title = gtk_text_buffer_get_text (buffer, &start, &end, gtk_true());
+ }
+ else
+ {
+ printf("EvalCcRqSETWINDOWTITLE -> unknown widget type");
+ }
+ }
+ }
+ }
+ }
+
+ if (GTK_IS_BUTTON(window))
+ {
+ textptr = createMnemonicString(title);
+ } else {
+ textptr = g_strdup(title);
+ }
+
+ MakeReturn1Cci (pcci, (gint) textptr);
+}
+
+/* Update rect part of a window. */
+void EvalCcRqUPDATEWINDOWRECT (CrossCallInfo *pcci) /* hwnd, left,top,right,bottom; no result. */
+{
+/* RECT rect;
+ HWND hwnd;
+
+ hwnd = (HWND) pcci->p1;
+ rect.left = pcci->p2;
+ rect.top = pcci->p3;
+ rect.right = pcci->p4;
+ rect.bottom= pcci->p5;
+
+ InvalidateRect (hwnd,&rect,FALSE);
+ UpdateWindow (hwnd);
+ RedrawWindow (hwnd,&rect,NULL,RDW_FRAME | RDW_VALIDATE | RDW_UPDATENOW | RDW_NOCHILDREN);
+*/
+ printf("EvalCcRqUPDATEWINDOWRECT -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+/* Set the ClientRect. */
+void EvalCcRqSETCLIENTSIZE (CrossCallInfo *pcci) /* hwnd, width, height; no result. */
+{
+/* HWND hwnd;
+ int w,h,curw,curh,clientw,clienth;
+ UINT flags;
+ RECT clientRect,windowRect;
+
+ hwnd = (HWND) pcci->p1;
+ w = pcci->p2;
+ h = pcci->p3;
+ flags = SWP_NOMOVE // retain position
+ | SWP_NOZORDER; // retain Z order
+
+ GetClientRect (hwnd, &clientRect);
+ GetWindowRect (hwnd, &windowRect);
+ clientw = clientRect.right - clientRect.left;
+ clienth = clientRect.bottom- clientRect.top;
+ curw = windowRect.right - windowRect.left;
+ curh = windowRect.bottom- windowRect.top;
+
+ SetWindowPos (hwnd, HWND_TOP, 0,0, curw+w-clientw,curh+h-clienth, flags);*/
+ printf("EvalCcRqSETCLIENTSIZE -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+/* (En/Dis)able windows/dialogues. */
+void EvalCcRqSETSELECTWINDOW (CrossCallInfo *pcci) /* hwnd, hasHScroll, hasVScroll, toAble, modalContext; no result. */
+{
+#if 0
+ HWND window;
+ BOOL hasHScroll, hasVScroll, toAble, modalContext;
+
+ window = (HWND) pcci->p1;
+ hasHScroll = (BOOL) pcci->p2;
+ hasVScroll = (BOOL) pcci->p3;
+ toAble = (BOOL) pcci->p4;
+ modalContext = (BOOL) pcci->p5;
+
+ if (modalContext) /* if not a modal context, then do not disable window */
+ EnableWindow (window,toAble); /* because it can't be moved, or closed. */
+ if (hasHScroll)
+ EnableScrollBar (window,SB_HORZ,toAble ? ESB_ENABLE_BOTH : ESB_DISABLE_BOTH);
+ if (hasVScroll)
+ EnableScrollBar (window,SB_VERT,toAble ? ESB_ENABLE_BOTH : ESB_DISABLE_BOTH);
+#endif
+ printf("EvalCcRqSETSELECTWINDOW -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+/* Set the position of windows/controls. */
+void EvalCcRqSETWINDOWPOS (CrossCallInfo *pcci) /* hwnd, x,y, update, include scrollbars ; no result. */
+{
+ GtkWidget *widget, *parent;
+ int x,y;
+ gboolean update,inclScrollbars;
+
+ printf("EvalCcRqSETWINDOWPOS\n");
+ widget = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ update = pcci->p4;
+ inclScrollbars = pcci->p5;
+ parent = gtk_widget_get_parent(widget);
+
+ if (parent)
+ {
+ gtk_fixed_move(GTK_FIXED(parent), widget, x, y);
+ } else {
+ gtk_widget_set_uposition(widget, x, y);
+ }
+
+ if (GTK_WIDGET_VISIBLE(widget) && update!=0)
+ { // only if window is visible and update is requested, proceed to enforce update.
+ if (inclScrollbars)
+ {
+ }
+ else
+ {
+ gtk_widget_queue_draw(widget);
+ }
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Get the size of the bounding rectangle of windows/controls. */
+void EvalCcRqGETWINDOWSIZE (CrossCallInfo *pcci) /* hwnd; width,height result. */
+{
+ GtkAllocation *alloc;
+ printf("EvalCcRqGETWINDOWSIZE\n");
+ alloc = &((GTK_WIDGET(pcci->p1))->allocation);
+ MakeReturn2Cci (pcci, alloc->width, alloc->height);
+}
+
+/* Set the size of windows/controls. */
+void EvalCcRqSETWINDOWSIZE (CrossCallInfo *pcci) /* hwnd, w,h, update; no result. */
+{
+ GtkWindow *window;
+ gint width, height;
+ gboolean update,inclScrollbars;
+
+ /* printf("EvalCcRqSETWINDOWSIZE\n"); */
+ window = GTK_WINDOW(pcci->p1);
+ width = pcci->p2;
+ height = pcci->p3;
+ update = pcci->p4;
+ gtk_window_resize(window, width, height);
+#if 0
+ if (update!=0) /* still, updates are not sufficient using SetWindowPos only. */
+ UpdateWindowScrollbars (hwnd);
+#endif
+ MakeReturn0Cci (pcci);
+}
+
+/* Activate control. */
+void EvalCcRqACTIVATECONTROL (CrossCallInfo *pcci) /* controlPtr; no result. */
+{
+ printf("EvalCcRqACTIVATERCONTROL\n");
+ gtk_widget_grab_focus(GTK_WIDGET(pcci->p1));
+ MakeReturn0Cci (pcci);
+}
+
+/* Activate window. */
+void EvalCcRqACTIVATEWINDOW (CrossCallInfo *pcci) /* isMDI, clientPtr, thisWindow; no result. */
+{
+ gboolean isMDI;
+ GtkWidget *client, *thisWindow;
+
+ printf("EvalCcRqACTIVATEWINDOW\n");
+ isMDI = (gboolean) pcci->p1;
+ client = GTK_WIDGET(pcci->p2);
+ thisWindow = GTK_WIDGET(pcci->p3);
+
+ if (isMDI)
+ {
+ gtk_notebook_set_page(GTK_NOTEBOOK(client), gtk_notebook_page_num(GTK_NOTEBOOK(client), thisWindow));
+ }
+ else
+ {
+ gtk_window_activate_focus (GTK_WINDOW(thisWindow));
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+static unsigned char hidden_cursor_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+
+static GdkColor black_color = { 0, 0, 0, 0 };
+
+void EvalCcRqCHANGEWINDOWCURSOR (CrossCallInfo *pcci) /* hwnd, cursor code; no result. It is assumed that the hwnd argument */
+ /* corresponds to either a SDI/MDI window (and not frame). */
+{
+ GtkWidget *widget;
+ int cursorcode;
+
+ printf("EvalCcRqCHANGEWINDOWCURSOR\n");
+ widget = GTK_BIN(GTK_BIN(GTK_WIDGET(pcci->p1))->child)->child;
+ cursorcode = pcci->p2;
+
+ switch (cursorcode)
+ {
+ case CURSARROW:
+ if (!gArrowCursor)
+ {
+ gArrowCursor = gdk_cursor_new(GDK_ARROW);
+ };
+
+ gdk_window_set_cursor(widget->window, gArrowCursor);
+ break;
+ case CURSBUSY:
+ if (!gBusyCursor)
+ {
+ gBusyCursor = gdk_cursor_new(GDK_CLOCK);
+ };
+
+ gdk_window_set_cursor(widget->window, gBusyCursor);
+ break;
+ case CURSIBEAM:
+ if (!gIBeamCursor)
+ {
+ gIBeamCursor = gdk_cursor_new(GDK_XTERM);
+ };
+
+ gdk_window_set_cursor(widget->window, gIBeamCursor);
+ break;
+ case CURSCROSS:
+ if (!gCrossCursor)
+ {
+ gCrossCursor = gdk_cursor_new(GDK_CROSSHAIR);
+ };
+
+ gdk_window_set_cursor(widget->window, gCrossCursor);
+ break;
+ case CURSFATCROSS:
+ if (!gFatCrossCursor)
+ {
+ gFatCrossCursor = gdk_cursor_new(GDK_CROSS);
+ };
+
+ gdk_window_set_cursor(widget->window, gFatCrossCursor);
+ break;
+ case CURSHIDDEN:
+ if (!gHiddenCursor)
+ {
+ GdkPixmap *pixmap;
+
+ pixmap = gdk_bitmap_create_from_data (NULL, hidden_cursor_bits, 16, 16);
+ gHiddenCursor = gdk_cursor_new_from_pixmap (pixmap, pixmap, &black_color, &black_color, 8, 8);
+ gdk_pixmap_unref (pixmap);
+ };
+
+ gdk_window_set_cursor(widget->window, gHiddenCursor);
+ break;
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqOBSCURECURSOR (CrossCallInfo *pcci) /* no params; no result. */
+{
+ GtkWidget *widget;
+
+ printf("EvalCcRqOBSCURECURSOR\n");
+ widget = GTK_WIDGET(pcci->p1);
+
+ if (!gHiddenCursor)
+ {
+ GdkPixmap *pixmap;
+
+ pixmap = gdk_bitmap_create_from_data (NULL, hidden_cursor_bits, 16, 16);
+ gHiddenCursor = gdk_cursor_new_from_pixmap (pixmap, pixmap, &black_color, &black_color, 8, 8);
+ gdk_pixmap_unref (pixmap);
+ };
+
+ gdk_window_set_cursor(widget->window, gHiddenCursor);
+ MakeReturn0Cci (pcci);
+}
+
+void DeleteCursors()
+{
+ printf("DeleteCursors\n");
+ if (gArrowCursor)
+ {
+ gdk_cursor_destroy(gArrowCursor);
+ gArrowCursor = NULL;
+ }
+
+ if (gBusyCursor)
+ {
+ gdk_cursor_destroy(gBusyCursor);
+ gIBeamCursor = NULL;
+ }
+
+ if (gIBeamCursor)
+ {
+ gdk_cursor_destroy(gIBeamCursor);
+ gIBeamCursor = NULL;
+ }
+
+ if (gCrossCursor)
+ {
+ gdk_cursor_destroy(gCrossCursor);
+ gCrossCursor = NULL;
+ }
+
+ if (gFatCrossCursor)
+ {
+ gdk_cursor_destroy(gFatCrossCursor);
+ gFatCrossCursor = NULL;
+ }
+
+ if (gHiddenCursor)
+ {
+ gdk_cursor_destroy(gHiddenCursor);
+ gHiddenCursor = NULL;
+ }
+}
+
+/* Set range of scrollbars. */
+void EvalCcRqSETSCROLLRANGE (CrossCallInfo *pcci) /* hwnd, iBar, min, max, redraw, no result */
+{
+ GtkWidget *widget, *parent;
+ GtkAdjustment *adj;
+ GtkRequisition *requisition;
+ gint iBar, min, max;
+ gboolean redraw;
+
+ printf("EvalCcRqSETSCROLLRANGE\n");
+ widget = GTK_WIDGET(pcci->p1);
+ iBar = pcci->p2;
+ min = pcci->p3;
+ max = pcci->p4;
+ redraw = pcci->p5;
+
+ parent = GTK_SCROLLED_WINDOW(
+ gtk_widget_get_ancestor(widget, GTK_TYPE_SCROLLED_WINDOW));
+
+ if (GTK_IS_SCROLLED_WINDOW(widget))
+ {
+ if (GTK_IS_SCROLLED_WINDOW(parent))
+ {
+ /* If a parent exists, it has to hold a requisition object to
+ * represent the size of this scrollbar. Otherwise the layout
+ * manager can't figure out the right size to make things.
+ */
+ requisition = (GtkRequisition *)g_object_get_data(G_OBJECT(parent),
+ SCROLL_SIZE_KEY);
+
+ if (iBar == 0) /* Horizontal */
+ {
+ requisition->width = max-min;
+ adj = gtk_scrolled_window_get_hadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ } else { /* Vertical */
+ requisition->height = max-min;
+ adj = gtk_scrolled_window_get_vadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ }
+ printf("client_size_request(%d,%d)\n", requisition->width,
+ requisition->height);
+ } else {
+ /* This widget has no parent, so no requisition is available
+ * (or needed).
+ */
+ if (iBar == 0) /* Horizontal */
+ {
+ adj = gtk_scrolled_window_get_hadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ } else { /* Vertical */
+ adj = gtk_scrolled_window_get_vadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ }
+ }
+ } else {
+ adj = gtk_range_get_adjustment(GTK_RANGE(widget));
+ }
+
+ if (adj)
+ {
+ adj->lower = min;
+ adj->upper = max;
+ adj->step_increment = 1;
+ adj->page_increment = (int)((max - min) / 10);
+ gtk_adjustment_changed(adj);
+ } else {
+ printf("No adjustment to change.\n");
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Set pos of scrollbars. */
+void EvalCcRqSETSCROLLPOS (CrossCallInfo *pcci) /* hwnd, iBar, thumb, maxx, maxy, extent, no result */
+{
+ GtkWidget *widget;
+ GtkAdjustment *adj;
+ gint thumb, iBar, maxx, maxy, extent;
+
+ widget = GTK_WIDGET(pcci->p1);
+ iBar = pcci->p2;
+ thumb = pcci->p3;
+ maxx = pcci->p4; // maxx is the right-most x coordinate of the enclosing rectangle of the scrollbar
+ maxy = pcci->p5; // maxy is the bottom-most y coordinate of the enclosing rectangle of the scrollbar
+ extent = pcci->p6; // extent is the width (height) of the vertical (horizontal) scrollbar
+
+ printf("EvalCcRqSETSCROLLPOS: %d\n", thumb);
+ if (GTK_IS_SCROLLED_WINDOW(widget))
+ {
+ if (iBar == 0) /* Horizontal */
+ {
+ adj = gtk_scrolled_window_get_hadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ } else { /* Vertical */
+ adj = gtk_scrolled_window_get_vadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ }
+ } else {
+ adj = gtk_range_get_adjustment(GTK_RANGE(widget));
+ }
+
+ gtk_adjustment_set_value(adj, (gdouble)thumb);
+ gtk_adjustment_value_changed(adj);
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Set thumb size of scrollbars. */
+void EvalCcRqSETSCROLLSIZE (CrossCallInfo *pcci) /* hwnd, iBar, size, maxx, maxy, extent, no result */
+{
+ GtkWidget *widget, *parent;
+ GtkAdjustment *adj;
+ int size, iBar, maxx, maxy, extent;
+
+ printf("EvalCcRqSETSCROLLSIZE\n");
+ widget = GTK_WIDGET(pcci->p1);
+ iBar = pcci->p2;
+ size = pcci->p3;
+ maxx = pcci->p4; // maxx is the right-most x coordinate of the enclosing rectangle of the scrollbar
+ maxy = pcci->p5; // maxy is the bottom-most y coordinate of the enclosing rectangle of the scrollbar
+ extent = pcci->p6; // extent is the width (height) of the vertical (horizontal) scrollbar
+
+ if (GTK_IS_SCROLLED_WINDOW(widget))
+ {
+ if (iBar == 0) /* Horizontal */
+ {
+ adj = gtk_scrolled_window_get_hadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ } else { /* Vertical */
+ adj = gtk_scrolled_window_get_vadjustment(
+ GTK_SCROLLED_WINDOW(widget));
+ }
+ } else {
+ adj = gtk_range_get_adjustment(GTK_RANGE(widget));
+ }
+
+ adj->page_size = size;
+ gtk_adjustment_changed(adj);
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Set selection of edit controls. */
+void EvalCcRqSETEDITSELECTION (CrossCallInfo *pcci) /* hwnd, first, last, no result. */
+{
+/* HWND hwnd;
+ int first,last;
+
+ hwnd = (HWND) pcci->p1;
+ first = pcci->p2;
+ last = pcci->p3;
+
+ SendMessage (hwnd, EM_SETSEL, (WPARAM) first, (LPARAM) last); // Set the selection of the edit control.
+ SendMessage (hwnd, EM_SCROLLCARET, 0,0); // Let the caret be displayed - (w/l)Param MUST be 0.
+*/
+ printf("EvalCcRqSETEDITSELECTION -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+static void dialog_focus_in_handler(GtkWidget *widget, GdkEventFocus *event, gpointer user_data)
+{
+ printf("dialog_focus_in_handler\n");
+ SendMessage1ToClean (CcWmACTIVATE, widget);
+ GTK_WIDGET_GET_CLASS(widget)->focus_in_event(widget, event);
+ gActiveTopLevelWindow = widget;
+}
+
+static void dialog_focus_out_handler(GtkWidget *widget, GdkEventFocus *event, gpointer user_data)
+{
+ printf("dialog_focus_out_handler\n");
+ SendMessage1ToClean (CcWmDEACTIVATE, widget);
+ GTK_WIDGET_GET_CLASS(widget)->focus_out_event(widget, event);
+ gActiveTopLevelWindow = NULL;
+}
+
+static gboolean dialog_close_handler(GtkWidget *dialog, GdkEvent *event, gpointer user_data)
+{
+ printf("dialog_close_handler\n");
+ SendMessage1ToClean(CcWmCLOSE, (int) dialog);
+ gtk_signal_emit_stop_by_name(GTK_OBJECT(dialog), "delete-event");
+ return gtk_true();
+}
+
+/* EvalCcRqCREATEDIALOG is now restricted to modeless dialogues only. */
+void EvalCcRqCREATEDIALOG (CrossCallInfo *pcci) // textptr,parentptr,behindPtr; HWND result.
+{
+ GtkWidget *dialog, *fixed, *defctrl;
+ const gchar *pwintitle;
+ gint x, y, w, h;
+
+ printf("EvalCcRqCREATEDIALOG\n");
+ pwintitle = (const gchar *) pcci->p1;
+
+ dialog = gtk_dialog_new();
+ gtk_dialog_set_has_separator(GTK_DIALOG(dialog), gtk_false());
+ gtk_window_set_resizable(GTK_WINDOW(dialog), gtk_false());
+ gtk_signal_connect (GTK_OBJECT(dialog), "delete-event",
+ GTK_SIGNAL_FUNC(dialog_close_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(dialog), "focus-in-event",
+ GTK_SIGNAL_FUNC(dialog_focus_in_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(dialog), "focus-out-event",
+ GTK_SIGNAL_FUNC(dialog_focus_out_handler),
+ NULL);
+
+ if (pwintitle)
+ {
+ gtk_window_set_title(GTK_WINDOW(dialog), pwintitle);
+ }
+
+ /* Create a Fixed Container */
+ fixed = gtk_fixed_new();
+ gtk_box_pack_start(GTK_BOX(GTK_DIALOG(dialog)->vbox), fixed, TRUE, TRUE, 0);
+ gtk_widget_show(fixed);
+
+ SendMessage1ToClean (CcWmINITDIALOG, (int) dialog);
+
+ x = gCci.p1;
+ y = gCci.p2;
+ w = gCci.p3;
+ h = gCci.p4;
+ defctrl = GTK_WIDGET(gCci.p5);
+
+ w += GTK_WINDOW(dialog)->frame_left + GTK_WINDOW(dialog)->frame_right;
+ h += GTK_WINDOW(dialog)->frame_top + GTK_WINDOW(dialog)->frame_bottom;
+
+ /* Adjust the pos and size of the frame window. */
+ gtk_widget_set_size_request(dialog, w, h);
+ if (x == -1 && y == -1)
+ {
+ gtk_window_set_position(GTK_WINDOW(dialog), GTK_WIN_POS_CENTER);
+ }
+ else
+ {
+ gtk_window_set_position(GTK_WINDOW(dialog), GTK_WIN_POS_NONE);
+ gtk_widget_set_uposition(dialog, x, y);
+ }
+
+ if (defctrl != NULL)
+ {
+ printf("EvalCcRqCREATEDIALOG -- grab focus call\n");
+ gtk_widget_grab_focus(defctrl);
+ }
+
+ gtk_widget_show(dialog);
+
+ printf("Dialog width: %d\n", w);
+
+ MakeReturn1Cci (pcci, (int) dialog);
+}
+
+// Create modal dialogues.
+void EvalCcRqCREATEMODALDIALOG (CrossCallInfo *pcci) /* textptr,parentptr; error code result. */
+{
+ GtkWidget *dialog, *fixed, *defctrl, *parent;
+ const gchar *pwintitle;
+ gint x, y, w, h;
+ guint delete_handler;
+
+ printf("EvalCcRqCREATEMODALDIALOG\n");
+ pwintitle = (const gchar *) pcci->p1;
+ parent = GTK_WIDGET(pcci->p2);
+
+ dialog = gtk_dialog_new();
+ gtk_dialog_set_has_separator(GTK_DIALOG(dialog), gtk_false());
+ gtk_window_set_resizable(GTK_WINDOW(dialog), gtk_false());
+ gtk_signal_connect (GTK_OBJECT(dialog), "focus-in-event",
+ GTK_SIGNAL_FUNC(dialog_focus_in_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(dialog), "focus-out-event",
+ GTK_SIGNAL_FUNC(dialog_focus_out_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(dialog), "delete-event",
+ GTK_SIGNAL_FUNC(dialog_close_handler),
+ NULL);
+
+ if (pwintitle)
+ {
+ gtk_window_set_title(GTK_WINDOW(dialog), pwintitle);
+ }
+
+ /* Create a Fixed Container */
+ fixed = gtk_fixed_new();
+ gtk_box_pack_start(GTK_BOX(GTK_DIALOG(dialog)->vbox), fixed, TRUE, TRUE, 0);
+ gtk_widget_show(fixed);
+
+ SendMessage1ToClean (CcWmINITDIALOG, (int) dialog);
+
+ x = gCci.p1;
+ y = gCci.p2;
+ w = gCci.p3;
+ h = gCci.p4;
+ defctrl = GTK_WIDGET(gCci.p5);
+
+ w += GTK_WINDOW(dialog)->frame_left + GTK_WINDOW(dialog)->frame_right;
+ h += GTK_WINDOW(dialog)->frame_top + GTK_WINDOW(dialog)->frame_bottom;
+
+ /* Adjust the pos and size of the frame window. */
+ gtk_widget_set_size_request(dialog, w, h);
+ if (x == -1 && y == -1)
+ {
+ gtk_window_set_position(GTK_WINDOW(dialog), GTK_WIN_POS_CENTER);
+ }
+ else
+ {
+ gtk_window_set_position(GTK_WINDOW(dialog), GTK_WIN_POS_NONE);
+ gtk_widget_set_uposition(dialog, x, y);
+ }
+
+ if (defctrl != NULL)
+ {
+ printf("EvalCcRqCREATEMODALDIALOG -- grab focus call\n");
+ gtk_widget_grab_focus(defctrl);
+ }
+
+ while (gtk_dialog_run(GTK_DIALOG(dialog)) == GTK_RESPONSE_DELETE_EVENT);
+ gtk_widget_destroy(dialog);
+
+ MakeReturn1Cci (pcci,0/*errorcode*/);
+}
+
+static gboolean widget_focus_in_handler(GtkWidget *widget, GdkEventFocus *event, gpointer user_data)
+{
+ GtkWidget *my_widget;
+ printf("widget_focus_in_handler\n");
+ my_widget = GTK_WIDGET(user_data);
+ GTK_WIDGET_GET_CLASS(widget)->focus_in_event(widget, event);
+ SendMessage2ToClean (CcWmSETFOCUS, GetControlParent(my_widget), my_widget);
+ return gtk_true();
+}
+
+static gboolean widget_focus_out_handler(GtkWidget *widget, GdkEventFocus *event, gpointer user_data)
+{
+ GtkWidget *my_widget, *parent;
+ printf("widget_focus_out_handler\n");
+
+ my_widget = GTK_WIDGET(user_data);
+ parent = GetControlParent(my_widget);
+ GTK_WIDGET_GET_CLASS(widget)->focus_in_event(widget, event);
+
+ if (gInKey)
+ {
+ SendKeyUpToClean (parent, my_widget, gCurChar);
+ gInKey = FALSE;
+ gCurChar = 0;
+ }
+
+ SendMessage2ToClean (CcWmKILLFOCUS, parent, my_widget);
+ return gtk_true();
+}
+
+static gboolean widget_key_press_handler(GtkWidget *widget, GdkEventKey *event, gpointer user_data)
+{
+ GtkWidget *my_widget, *parent;
+ gint c;
+ printf("widget_key_press_handler\n");
+
+ my_widget = GTK_WIDGET(user_data);
+ parent = GetControlParent(my_widget);
+ c = (event->length > 0) ?
+ event->string[0] : CheckVirtualKeyCode (event->keyval);
+
+ if (!c)
+ {
+ return gtk_false();
+ }
+
+ if (event->keyval == GDK_Tab)
+ {
+ return gtk_false();
+ }
+
+ GTK_WIDGET_GET_CLASS(widget)->key_press_event(widget, event);
+
+ if (gInKey)
+ {
+ if (gCurChar == c)
+ {
+ SendKeyStillDownToClean (parent, my_widget, gCurChar);
+ }
+ else
+ {
+ SendKeyUpToClean (parent, my_widget, gCurChar);
+ gCurChar = c;
+ SendKeyDownToClean (parent, my_widget, gCurChar);
+ }
+ }
+ else
+ {
+ gCurChar = c;
+ SendKeyDownToClean (parent, my_widget, gCurChar);
+ gInKey = TRUE;
+ }
+
+ return gtk_true();
+}
+
+static gboolean widget_key_release_handler(GtkWidget *widget, GdkEventKey *event, gpointer user_data)
+{
+ GtkWidget *my_widget;
+ printf("widget_key_release_handler\n");
+
+ my_widget = GTK_WIDGET(user_data);
+
+ if (event->keyval == GDK_Tab)
+ {
+ return gtk_false();
+ }
+
+ GTK_WIDGET_GET_CLASS(widget)->key_press_event(widget, event);
+
+ if (gInKey)
+ {
+ SendKeyUpToClean (GetControlParent(my_widget), my_widget, gCurChar);
+ gInKey = FALSE;
+ gCurChar = 0;
+ }
+
+ return gtk_true();
+}
+
+static gboolean widget_button_press_handler(GtkWidget *widget, GdkEventButton *event, gpointer user_data)
+{
+ printf("widget_button_press_handler\n");
+ if (event->button == 1)
+ {
+ GtkWidget *parent = GetControlParent(widget);
+
+ printf("Widget_button_press_handler -- grab focus call\n");
+ gtk_widget_grab_focus(widget);
+
+ gInMouseDown = TRUE;
+
+ switch (event->type)
+ {
+ case GDK_BUTTON_PRESS:
+ SendMessage6ToClean (CcWmMOUSE, parent, widget, BUTTONDOWN, event->x, event->y, GetModifiers());
+ break;
+ case GDK_2BUTTON_PRESS:
+ SendMessage6ToClean (CcWmMOUSE, parent, widget, BUTTONDOUBLEDOWN, event->x, event->y, GetModifiers());
+ break;
+ case GDK_3BUTTON_PRESS:
+ SendMessage6ToClean (CcWmMOUSE, parent, widget, BUTTONTRIPLEDOWN, event->x, event->y, GetModifiers());
+ break;
+ }
+ return gtk_true();
+ }
+ return gtk_false();
+}
+
+static gboolean widget_button_release_handler(GtkWidget *widget, GdkEventButton *event, gpointer user_data)
+{
+ printf("widget_button_release_handler\n");
+ if (event->button == 1)
+ {
+ GtkWidget *parent = GetControlParent(widget);
+
+ gInMouseDown = FALSE;
+ SendMessage6ToClean (CcWmMOUSE, parent, widget, BUTTONUP, event->x, event->y, GetModifiers());
+ return gtk_true();
+ }
+
+ return gtk_false();
+}
+
+static gboolean widget_motion_notify_handler(GtkWidget *widget, GdkEventMotion *event, gpointer user_data)
+{
+ GtkWidget *parent;
+ printf("widget_motion_notify_handler\n");
+
+ parent = GetControlParent(widget);
+
+ if (gInMouseDown)
+ {
+ SendMessage6ToClean(CcWmMOUSE, parent, widget, BUTTONSTILLDOWN, event->x, event->y, GetModifiers());
+ } else {
+ SendMessage6ToClean (CcWmMOUSE, parent, widget, BUTTONSTILLUP, event->x, event->y, GetModifiers());
+ }
+
+ return gtk_true();
+}
+
+/* Create compound controls (window in window) */
+void EvalCcRqCREATECOMPOUND (CrossCallInfo *pcci) /* hwnd, packed pos,w,h, scrollbars, transparent; HWND result. */
+{
+#if 0
+ HWND parentwindow, compoundhandle;
+ int left,top, width,height;
+ int compoundstyle;
+ BOOL transparent;
+ DWORD compoundExStyle;
+
+ parentwindow = (HWND) pcci->p1;
+ left = pcci->p2>>16;
+ top = (pcci->p2<<16)>>16;
+ width = pcci->p3;
+ height = pcci->p4;
+ compoundstyle = pcci->p5;
+ transparent = (BOOL) pcci->p6;
+
+ compoundExStyle = WS_EX_CONTROLPARENT;
+ if (transparent)
+ compoundExStyle |= WS_EX_TRANSPARENT;
+
+ compoundstyle |= WS_CHILD;// | WS_CLIPSIBLINGS;
+
+ /* create the compound window */
+ compoundhandle
+ = CreateWindowEx (compoundExStyle, /* Extended style */
+ CompoundControlClassName, /* Class name */
+ "", /* Window title */
+ compoundstyle, /* style flags */
+ left, top, /* x, y */
+ width, height, /* width, height */
+ parentwindow, /* Parent window */
+ NULL, /* menu handle */
+ (HANDLE) ghInst, /* Instance that owns the window */
+ 0);
+ SetWindowPos (compoundhandle, HWND_BOTTOM, 0,0,0,0, SWP_NOMOVE+SWP_NOSIZE); // This should implement control stack
+#endif
+ printf("EvalCcRqCREATECOMPOUND -> not implemented\n");
+ MakeReturn1Cci (pcci, (int) NULL /*compoundhandle*/);
+}
+
+static void scrollbar_value_changed(GtkRange *range, gpointer user_data)
+{
+ gint scrollCode, controlKind, discr, position, *val;
+ GdkWindow *parent_window;
+ GtkWidget *parent, *widget;
+ GtkAdjustment *adjustment;
+ /* printf("scrollbar_value_changed\n"); */
+
+ parent_window = gtk_widget_get_parent_window(GTK_WIDGET(range));
+ parent = gtk_widget_get_parent(GTK_WIDGET(range));
+ adjustment = gtk_range_get_adjustment(range);
+ position = (gint)gtk_adjustment_get_value(adjustment);
+ val = g_object_get_data(G_OBJECT(range), SCROLL_POS_KEY);
+
+ /* printf("Value: %d -- Old Value: %d\n", (int)position, (int) *val); */
+
+ discr = position - *val;
+ /* printf("discr = %d", (int) discr); */
+
+
+ /*
+ * GTK Handles a lot of the scrollbar plumbing internally. We have to fool the ObjectIO
+ * event loop a bit here. So, we just report a "SB_THUMBPOSITION" message, so it runs around
+ * notifying changes, but does not try to modify the scrollbar itself.
+ */
+ scrollCode = SB_THUMBPOSITION;
+
+ /*
+ * If there is a parent, this is a slider (not a scrollbar)
+ */
+ if (GTK_IS_SCROLLED_WINDOW(parent_window))
+ {
+ /* printf("Not a slider.\n"); */
+ controlKind = (GTK_IS_HSCROLLBAR(range) ?
+ GTK_ORIENTATION_HORIZONTAL : GTK_ORIENTATION_VERTICAL);
+ widget = GTK_WIDGET(parent_window);
+ parent = GTK_WIDGET(parent_window);
+ } else {
+ /* printf("Hey -- it's a slider!\n"); */
+ controlKind = SB_CTL;
+ widget = GTK_WIDGET(range);
+ parent = GetControlParent(widget);
+ }
+
+ *val = position;
+ g_object_set_data(G_OBJECT(range), SCROLL_POS_KEY, (gpointer)val);
+
+ /*
+ * Force redraw of changed widget, but only during times when the
+ * scrollbar was moved by the user.
+ */
+ if (discr != 0) {
+ SendMessage5ToClean(CcWmSCROLLBARACTION, parent, (int)widget,
+ controlKind, scrollCode, position);
+ }
+
+ gtk_widget_queue_draw(widget);
+}
+
+/* Create scrollbars. */
+void EvalCcRqCREATESCROLLBAR (CrossCallInfo *pcci) /* hwnd, x,y,w,h bool; HWND result. */
+{
+ gint x, y, w, h;
+ gint *val;
+ GtkWidget *scroll;
+ GtkWidget *parent;
+ gboolean ishorizontal;
+
+ /* printf("EvalCcRqCREATESCROLLBAR\n"); */
+ if (pcci->p1 == 0)
+ {
+ MakeReturn0Cci (pcci);
+ }
+
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ ishorizontal = pcci->p6;
+
+ if (ishorizontal)
+ {
+ scroll = gtk_hscrollbar_new(NULL);
+ } else {
+ scroll = gtk_vscrollbar_new(NULL);
+ }
+
+ g_signal_connect(GTK_OBJECT(scroll), SCROLL_VALUE_CHANGED, G_CALLBACK(scrollbar_value_changed), parent);/*NULL);*/
+ val = g_new(gint,1);
+ gtk_widget_set_size_request(scroll, w, h);
+ gtk_fixed_put(GetFixed(parent), scroll, x, y);
+ *val = 0;
+ g_object_set_data(G_OBJECT(scroll), SCROLL_POS_KEY, (gpointer)val);
+
+ printf("EvalCcRqCREATESCROLLBAR - %p,%p\n",parent,scroll);
+ MakeReturn1Cci (pcci, (int) scroll);
+}
+
+static void button_clicked (GtkButton *button, gpointer user_data)
+{
+ GtkWidget *wbutton, *window;
+ printf("button_clicked\n");
+
+ wbutton = GTK_WIDGET(button);
+ window = GetControlParent(wbutton);
+
+ switch (GPOINTER_TO_INT(user_data))
+ {
+ case ISOKBUTTON:
+ SendMessage2ToClean (CcWmSPECIALBUTTON, window, ISOKBUTTON);
+ return;
+ case ISCANCELBUTTON:
+ SendMessage2ToClean (CcWmSPECIALBUTTON, window, ISCANCELBUTTON);
+ return;
+ default:
+ SendMessage4ToClean (CcWmBUTTONCLICKED, window, wbutton, GetModifiers (), 0);
+ return;
+ }
+}
+
+static gint button_expose_handler(GtkWidget *widget, GdkEventExpose *event, gpointer user_data)
+{
+ GtkWidget *button, *parent;
+ printf("button_expose_handler\n");
+
+ button = gtk_widget_get_parent(widget);
+ parent = gtk_widget_get_parent(gtk_widget_get_parent(gtk_widget_get_parent(button)));
+ SendMessage3ToClean(CcWmDRAWCONTROL, (int) parent, (int) button, (int) GDK_DRAWABLE(event->window));
+ return 0;
+}
+
+void EvalCcRqCREATEBUTTON (CrossCallInfo *pcci) /* hwnd, x,y,w,h, kind; HWND result. */
+{
+ GtkWidget *button, *parent;
+ GtkRequisition asked;
+ gint x, y, w, h, kind;
+
+ printf("EvalCcRqCREATEBUTTON\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ kind = pcci->p6;
+
+ if (kind==ISOKBUTTON)
+ {
+ button = gtk_button_new_from_stock("gtk-ok");
+ }
+ else
+ {
+ if (kind==ISCANCELBUTTON)
+ {
+ button = gtk_button_new_from_stock("gtk-quit");
+ }
+ else
+ {
+ button = gtk_button_new();
+ gtk_button_set_use_underline(GTK_BUTTON(button), gtk_true());
+ }
+ }
+
+ gtk_signal_connect (GTK_OBJECT (button), "clicked",
+ GTK_SIGNAL_FUNC(button_clicked),
+ GINT_TO_POINTER(kind));
+ gtk_widget_set_size_request(button, w, h);
+ gtk_fixed_put (GetFixed(parent), button, x, y);
+
+ MakeReturn1Cci (pcci, (int) button);
+}
+
+void EvalCcRqCREATEICONBUT (CrossCallInfo *pcci) /* hwnd, x,y,w,h,kind; HWND result. */
+{
+ GtkWidget *button, *parent, *drawing_area;
+ gint x, y, w, h, kind;
+
+ printf("EvalCcRqCREATEICONBUT\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ kind = pcci->p6;
+
+ button = gtk_button_new();
+ drawing_area = gtk_drawing_area_new();
+ gtk_container_add(GTK_CONTAINER(button), drawing_area);
+ gtk_signal_connect(GTK_OBJECT (button), "clicked",
+ GTK_SIGNAL_FUNC(button_clicked),
+ GINT_TO_POINTER(kind));
+ gtk_signal_connect (GTK_OBJECT(drawing_area), "expose-event",
+ GTK_SIGNAL_FUNC(button_expose_handler),
+ NULL);
+
+ gtk_widget_set_size_request(button, w, h);
+ gtk_fixed_put(GetFixed(parent), button, x, y);
+
+ MakeReturn1Cci(pcci, (int) button);
+}
+
+static gint custom_expose_handler(GtkWidget *widget, GdkEventExpose *event, gpointer user_data)
+{
+ GtkWidget *parent;
+ printf("custom_expose_handler\n");
+
+ parent = gtk_widget_get_parent(gtk_widget_get_parent(gtk_widget_get_parent(widget)));
+ SendMessage3ToClean(CcWmDRAWCONTROL, (int) parent, (int) widget, (int) GDK_DRAWABLE(event->window));
+ return 0;
+}
+
+void EvalCcRqCREATECUSTOM (CrossCallInfo *pcci) /* hwnd, x,y,w,h; HWND result. */
+{
+ GtkWidget *ctrl, *parent;
+ gint x, y, w, h;
+
+ printf("EvalCcRqCREATECUSTOM\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+
+ ctrl = gtk_drawing_area_new();
+ GTK_WIDGET_SET_FLAGS(ctrl, GTK_CAN_FOCUS);
+ gtk_signal_connect(GTK_OBJECT(ctrl), "expose-event",
+ GTK_SIGNAL_FUNC(custom_expose_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "focus-in-event",
+ GTK_SIGNAL_FUNC(widget_focus_in_handler),
+ ctrl);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "focus-out-event",
+ GTK_SIGNAL_FUNC(widget_focus_out_handler),
+ ctrl);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "key-press-event",
+ GTK_SIGNAL_FUNC(widget_key_press_handler),
+ ctrl);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "key-release-event",
+ GTK_SIGNAL_FUNC(widget_key_release_handler),
+ ctrl);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "button-press-event",
+ GTK_SIGNAL_FUNC(widget_button_press_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "button-release-event",
+ GTK_SIGNAL_FUNC(widget_button_release_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(ctrl), "motion_notify_event",
+ GTK_SIGNAL_FUNC(widget_motion_notify_handler),
+ NULL);
+ gtk_widget_set_size_request(ctrl, w, h);
+ gtk_fixed_put (GetFixed(parent), ctrl, x, y);
+
+ gtk_widget_realize(ctrl);
+ gtk_widget_add_events(ctrl, GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK | GDK_POINTER_MOTION_MASK | GDK_KEY_PRESS_MASK | GDK_KEY_RELEASE_MASK);
+
+ MakeReturn1Cci (pcci, (int) ctrl);
+}
+
+void EvalCcRqCREATESTATICTXT (CrossCallInfo *pcci) /* hwnd, x,y,w,h; HWND result. */
+{
+ int x, y, w, h;
+ GtkWidget *parent, *label;
+
+ printf("EvalCcRqCREATESTATICTXT\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+
+ printf("Width: %d\n", w);
+
+ label = gtk_label_new(NULL);
+ gtk_widget_set_size_request(label, w, h);
+ gtk_fixed_put (GetFixed(parent), label, x, y);
+
+ MakeReturn1Cci (pcci, (int) label);
+}
+
+void EvalCcRqCREATEEDITTXT (CrossCallInfo *pcci) /* hwnd, x,y,w,h, flags; HWND result. */
+{
+ GtkWidget *edit;
+ GtkWidget *parent;
+ int x, y, w, h, flags;
+
+ printf("EvalCcRqCREATEEDITTXT\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ flags = pcci->p6;
+
+ if (flags & EDITISMULTILINE)
+ edit = gtk_text_view_new();
+ else
+ edit = gtk_entry_new();
+
+ printf("Edit Control: %ld\n", edit);
+ printf("Dimensions: x=%d, y=%d, w=%d, h=%d\n", x, y, w, h);
+
+ gtk_widget_set_size_request(edit, w, h);
+ gtk_fixed_put (GetFixed(parent), edit, x, y);
+
+
+ gtk_signal_connect (GTK_OBJECT(edit), "focus-in-event",
+ GTK_SIGNAL_FUNC(widget_focus_in_handler),
+ edit);
+ gtk_signal_connect (GTK_OBJECT(edit), "focus-out-event",
+ GTK_SIGNAL_FUNC(widget_focus_out_handler),
+ edit);
+ if (flags & EDITISKEYSENSITIVE)
+ {
+ gtk_signal_connect (GTK_OBJECT(edit), "key-press-event",
+ GTK_SIGNAL_FUNC(widget_key_press_handler),
+ edit);
+ gtk_signal_connect (GTK_OBJECT(edit), "key-release-event",
+ GTK_SIGNAL_FUNC(widget_key_release_handler),
+ edit);
+ }
+
+ MakeReturn1Cci (pcci, (int) edit);
+}
+
+static void radio_button_clicked (GtkButton *button, gpointer user_data)
+{
+ GtkWidget *wbutton, *window;
+ printf("radio_button_clicked\n");
+
+ wbutton = GTK_WIDGET(button);
+ window = GetControlParent(wbutton);
+
+ if (gtk_toggle_button_get_active(GTK_TOGGLE_BUTTON(wbutton)))
+ SendMessage4ToClean (CcWmBUTTONCLICKED, window, wbutton, GetModifiers (), 0);
+
+}
+
+void EvalCcRqCREATERADIOBUT (CrossCallInfo *pcci) /* hwnd, x,y,w,h, isfirst; HWND result. */
+{
+ GtkWidget *radio_btn;
+ GtkWidget *parent;
+ int x, y, w, h, first;
+
+ printf("EvalCcRqCREATERADIOBUT\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ first = pcci->p6;
+
+ if (first || !gFirstRadioButton)
+ {
+ radio_btn = gtk_radio_button_new(NULL);
+ gFirstRadioButton = radio_btn;
+ }
+ else
+ {
+ radio_btn = gtk_radio_button_new_from_widget(GTK_RADIO_BUTTON(gFirstRadioButton));
+ }
+
+ gtk_button_set_use_underline(GTK_BUTTON(radio_btn), gtk_true());
+ gtk_widget_set_size_request(radio_btn, w, h);
+ gtk_fixed_put (GetFixed(parent), radio_btn, x, y);
+
+ gtk_signal_connect (GTK_OBJECT (radio_btn), "clicked",
+ GTK_SIGNAL_FUNC(radio_button_clicked),
+ NULL);
+
+ MakeReturn1Cci (pcci, (int) radio_btn);
+}
+
+void EvalCcRqCREATECHECKBOX (CrossCallInfo *pcci) /* hwnd, x,y,w,h, isfirst; HWND result. */
+{
+ GtkWidget *check_btn;
+ GtkWidget *parent;
+ int x, y, w, h, first;
+
+ printf("EvalCcRqCREATECHECKBOX\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ first = pcci->p6;
+
+
+ check_btn = gtk_check_button_new();
+ gtk_button_set_use_underline(GTK_BUTTON(check_btn), gtk_true());
+ gtk_widget_set_size_request(check_btn, w, h);
+ gtk_fixed_put (GetFixed(parent), check_btn, x, y);
+
+ gtk_signal_connect (GTK_OBJECT (check_btn), "toggled",
+ GTK_SIGNAL_FUNC(button_clicked),
+ NULL);
+
+ MakeReturn1Cci (pcci, (int) check_btn);
+}
+
+void EvalCcRqSETITEMCHECK (CrossCallInfo *pcci) /* hwnd, bool; no result. */
+{
+ GtkWidget *widget;
+ gboolean on;
+
+ printf("EvalCcRqSETITEMCHECK\n");
+ widget = GTK_WIDGET(pcci->p1);
+ on = (gboolean) pcci->p2;
+
+ gtk_toggle_button_set_active(GTK_TOGGLE_BUTTON(widget), on);
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqENABLECONTROL (CrossCallInfo *pcci) /* hwnd, bool; no result. */
+{
+ GtkWidget *widget;
+ gboolean newSelect;
+ printf("EvalCcRqENABLECONTROL\n");
+
+ widget = GTK_WIDGET(pcci->p1);
+ newSelect = (gboolean) pcci->p2;
+
+ gtk_widget_set_sensitive(widget, newSelect);
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqSHOWCONTROL (CrossCallInfo *pcci) // hwnd, bool; no result.
+{
+ GtkWidget *control;
+ gboolean show;
+
+ printf("EvalCcRqSHOWCONTROL\n");
+ control = GTK_WIDGET(pcci->p1);
+ printf("Control: %ld\n", control);
+
+ if (control)
+ {
+ show = (gboolean) pcci->p2;
+
+ if (!show)
+ gtk_widget_hide(control);
+ else
+ gtk_widget_show(control);
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Hide/show windows. */
+void EvalCcRqSHOWWINDOW (CrossCallInfo *pcci) /* hwnd, show, activate; no result. */
+{
+ GtkWidget *window;
+ gboolean show, activate;
+
+ printf("EvalCcRqSHOWWINDOW\n");
+ window = GTK_WIDGET(pcci->p1);
+ show = (gboolean) pcci->p2;
+ activate = (gboolean) pcci->p3;
+
+ if (!show)
+ gtk_widget_hide(window);
+ else
+ gtk_widget_show(window);
+
+ if (activate)
+ gtk_window_activate_default(GTK_WINDOW(window));
+
+ MakeReturn0Cci (pcci);
+}
+
+static void combo_changed_handler(GtkWidget *entry, gpointer user_data)
+{
+ gint newsel = 0;
+ GtkWidget *combo;
+ GList *child;
+ printf("combo_changed_handler\n");
+
+ combo = GTK_WIDGET(user_data);
+ child = GTK_LIST(GTK_COMBO(combo)->list)->children;
+
+ while (child)
+ {
+ GtkWidget *item = GTK_WIDGET(child->data);
+ if (item->state == GTK_STATE_SELECTED)
+ {
+ SendMessage3ToClean (CcWmITEMSELECT, (int) GetControlParent(combo), (int) combo, newsel);
+ return;
+ }
+
+ child = child->next;
+ newsel++;
+ }
+}
+
+void EvalCcRqCREATEPOPUP (CrossCallInfo *pcci) /* hwnd, x,y,w,h,isEditable; HWND hwndPopUp,hwndEdit (if isEditable). */
+{
+ GtkWidget *combo;
+ GtkWidget *parent;
+ int x, y, w, h;
+ gboolean isEditable;
+
+ printf("EvalCcRqCREATEPOPUP\n");
+ parent = GTK_WIDGET(pcci->p1);
+ x = pcci->p2;
+ y = pcci->p3;
+ w = pcci->p4;
+ h = pcci->p5;
+ isEditable = (gboolean) pcci->p6;
+
+ combo = gtk_combo_new();
+ gtk_combo_set_use_arrows_always(GTK_COMBO(combo), gtk_true());
+ gtk_widget_set_size_request(combo, w, h);
+
+ gtk_fixed_put (GetFixed(parent), combo, x, y);
+
+ gtk_signal_connect(GTK_OBJECT(GTK_COMBO(combo)->entry), "changed",
+ GTK_SIGNAL_FUNC(combo_changed_handler),
+ combo);
+
+ if (isEditable)
+ {
+ gtk_signal_connect (GTK_OBJECT (GTK_COMBO(combo)->entry), "focus-in-event",
+ GTK_SIGNAL_FUNC(widget_focus_in_handler),
+ combo);
+
+ gtk_signal_connect (GTK_OBJECT (GTK_COMBO(combo)->entry), "focus-out-event",
+ GTK_SIGNAL_FUNC(widget_focus_out_handler),
+ combo);
+
+ gtk_signal_connect (GTK_OBJECT (GTK_COMBO(combo)->entry), "key-press-event",
+ GTK_SIGNAL_FUNC(widget_key_press_handler),
+ combo);
+
+ gtk_signal_connect (GTK_OBJECT (GTK_COMBO(combo)->entry), "key-release-event",
+ GTK_SIGNAL_FUNC(widget_key_release_handler),
+ combo);
+ }
+ else
+ {
+ gtk_entry_set_editable(GTK_ENTRY(GTK_COMBO(combo)->entry), gtk_false());
+ }
+
+ MakeReturn2Cci (pcci, (int) combo, (int) GTK_COMBO(combo)->entry);
+}
+
+void EvalCcRqADDTOPOPUP (CrossCallInfo *pcci) /* hwnd, textptr, enabled, selected, index; Pos result. */
+{
+ gint pos;
+ GtkWidget *combo, *li;
+ gchar *text;
+ gboolean selected;
+
+ printf("EvalCcRqADDTOPOPUP\n");
+ combo = GTK_WIDGET(pcci->p1);
+ text = (gchar *) pcci->p2;
+ selected = (gboolean) pcci->p3;
+
+ li = gtk_list_item_new_with_label(text);
+ gtk_widget_show (li);
+ gtk_container_add(GTK_CONTAINER(GTK_COMBO(combo)->list), li);
+
+ pos = gtk_list_child_position(GTK_LIST(GTK_COMBO(combo)->list), li);
+
+ if (selected)
+ {
+ gtk_list_select_item(GTK_LIST(GTK_COMBO(combo)->list), pos);
+ }
+
+ MakeReturn1Cci (pcci, pos);
+}
+
+void EvalCcRqSELECTPOPUPITEM (CrossCallInfo *pcci) /* hwnd, pos; no result */
+{
+ GtkWidget *combo;
+ gint pos;
+
+ printf("EvalCcRqSELECTPOPUP\n");
+ combo = GTK_WIDGET(pcci->p1);
+ pos = pcci->p2;
+
+ gtk_list_select_item(GTK_LIST(GTK_COMBO(combo)->list), pos);
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqRESTACKWINDOW (CrossCallInfo *pcci) /* thewindow,behind; no result. */
+{
+/* HWND thePtr, behindPtr;
+ UINT uflags = SWP_NOMOVE + SWP_NOSIZE; // Do not change current size or location
+
+ thePtr = (HWND) pcci->p1;
+ behindPtr = (HWND) pcci->p2;
+
+ SetWindowPos (thePtr, behindPtr, 0, 0, 0, 0, uflags);
+*/
+ printf("EvalCcRqRESTACKWINDOW -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+/* Add controls to tooltip area. */
+void EvalCcRqADDCONTROLTIP (CrossCallInfo *pcci) /* parentPtr, controlPtr, textPtr; no result. */
+{
+ GtkWidget *parent, *control;
+ gchar *text;
+ printf("EvalCcRqADDCONTROLTIP\n");
+
+ parent = GTK_WIDGET(pcci->p1);
+ control = GTK_WIDGET(pcci->p2);
+ text = (gchar *)pcci->p3;
+
+ gtk_tooltips_set_tip(GTK_TOOLTIPS(gTooltip), control, text, text);
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Remove controls from tooltip area. */
+void EvalCcRqDELCONTROLTIP (CrossCallInfo *pcci) /* parentPtr, controlPtr; no result. */
+{
+ GtkWidget *parent, *control;
+ printf("EvalCcRqDELCONTROLTIP\n");
+
+ parent = GTK_WIDGET(pcci->p1);
+ control = GTK_WIDGET(pcci->p2);
+
+ gtk_tooltips_set_tip(GTK_TOOLTIPS(gTooltip), control, NULL, NULL);
+
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqCREATECARET(CrossCallInfo *pcci)
+{
+/*
+ HWND hWnd = (HWND) pcci->p1;
+ int nWidth = max(max(GetSystemMetrics(SM_CYBORDER), GetSystemMetrics(SM_CXBORDER)) * 2, pcci->p2);
+ int nHeight = pcci->p3;
+
+ ghCaretWnd = hWnd;
+ CreateCaret(hWnd, NULL, nWidth, nHeight);
+ ShowCaret(hWnd);
+*/
+ printf("EvalCcRqCREATECARET -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqSETCARETPOS(CrossCallInfo *pcci)
+{
+// if (ghCaretWnd == (HWND) pcci->p1)
+// {
+// SetCaretPos(pcci->p2, pcci->p3);
+// };
+ printf("EvalCcRqSETCARETPOS -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqDESTROYCARET(CrossCallInfo *pcci)
+{
+// HWND hWnd = (HWND) pcci->p1;
+//
+/// HideCaret(hWnd);
+// DestroyCaret();
+// ghCaretWnd = NULL;
+ printf("EvalCcRqDESTROYCARET -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqSHOWCARET(CrossCallInfo *pcci)
+{
+// ShowCaret((HWND) pcci->p1);
+ printf("EvalCcRqSHOWCARET -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqHIDECARET(CrossCallInfo *pcci)
+{
+// HideCaret((HWND) pcci->p1);
+ printf("EvalCcRqHIDECARET -> not implemented\n");
+ MakeReturn0Cci (pcci);
+}
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+OS InstallCrossCallWindows (OS ios)
+{
+ CrossCallProcedureTable newTable;
+
+ printf("InstallCrossCallWindows\n");
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqBEGINPAINT, EvalCcRqBEGINPAINT);
+ AddCrossCallEntry (newTable, CcRqENDPAINT, EvalCcRqENDPAINT);
+ AddCrossCallEntry (newTable, CcRqFAKEPAINT, EvalCcRqFAKEPAINT);
+ AddCrossCallEntry (newTable, CcRqDESTROYMODALDIALOG, EvalCcRqDESTROYMODALDIALOG);
+ AddCrossCallEntry (newTable, CcRqDESTROYMDIDOCWINDOW, EvalCcRqDESTROYMDIDOCWINDOW);
+ AddCrossCallEntry (newTable, CcRqCREATESDIDOCWINDOW, EvalCcRqCREATESDIDOCWINDOW);
+ AddCrossCallEntry (newTable, CcRqCREATEMDIDOCWINDOW, EvalCcRqCREATEMDIDOCWINDOW);
+ AddCrossCallEntry (newTable, CcRqSETWINDOWTITLE, EvalCcRqSETWINDOWTITLE);
+ AddCrossCallEntry (newTable, CcRqGETWINDOWTEXT, EvalCcRqGETWINDOWTEXT);
+ AddCrossCallEntry (newTable, CcRqUPDATEWINDOWRECT, EvalCcRqUPDATEWINDOWRECT);
+ AddCrossCallEntry (newTable, CcRqSETCLIENTSIZE, EvalCcRqSETCLIENTSIZE);
+ AddCrossCallEntry (newTable, CcRqSETSELECTWINDOW, EvalCcRqSETSELECTWINDOW);
+ AddCrossCallEntry (newTable, CcRqSETWINDOWPOS, EvalCcRqSETWINDOWPOS);
+ AddCrossCallEntry (newTable, CcRqGETWINDOWSIZE, EvalCcRqGETWINDOWSIZE);
+ AddCrossCallEntry (newTable, CcRqSETWINDOWSIZE, EvalCcRqSETWINDOWSIZE);
+ AddCrossCallEntry (newTable, CcRqACTIVATECONTROL, EvalCcRqACTIVATECONTROL);
+ AddCrossCallEntry (newTable, CcRqACTIVATEWINDOW, EvalCcRqACTIVATEWINDOW);
+ AddCrossCallEntry (newTable, CcRqCHANGEWINDOWCURSOR, EvalCcRqCHANGEWINDOWCURSOR);
+ AddCrossCallEntry (newTable, CcRqOBSCURECURSOR, EvalCcRqOBSCURECURSOR);
+ AddCrossCallEntry (newTable, CcRqSETSCROLLRANGE, EvalCcRqSETSCROLLRANGE);
+ AddCrossCallEntry (newTable, CcRqSETSCROLLPOS, EvalCcRqSETSCROLLPOS);
+ AddCrossCallEntry (newTable, CcRqSETSCROLLSIZE, EvalCcRqSETSCROLLSIZE);
+ AddCrossCallEntry (newTable, CcRqSETEDITSELECTION, EvalCcRqSETEDITSELECTION);
+ AddCrossCallEntry (newTable, CcRqCREATEDIALOG, EvalCcRqCREATEDIALOG);
+ AddCrossCallEntry (newTable, CcRqCREATEMODALDIALOG, EvalCcRqCREATEMODALDIALOG);
+ AddCrossCallEntry (newTable, CcRqCREATECOMPOUND, EvalCcRqCREATECOMPOUND);
+ AddCrossCallEntry (newTable, CcRqCREATESCROLLBAR, EvalCcRqCREATESCROLLBAR);
+ AddCrossCallEntry (newTable, CcRqCREATEBUTTON, EvalCcRqCREATEBUTTON);
+ AddCrossCallEntry (newTable, CcRqCREATEICONBUT, EvalCcRqCREATEICONBUT);
+ AddCrossCallEntry (newTable, CcRqCREATECUSTOM, EvalCcRqCREATECUSTOM);
+ AddCrossCallEntry (newTable, CcRqCREATESTATICTXT, EvalCcRqCREATESTATICTXT);
+ AddCrossCallEntry (newTable, CcRqCREATEEDITTXT, EvalCcRqCREATEEDITTXT);
+ AddCrossCallEntry (newTable, CcRqCREATERADIOBUT, EvalCcRqCREATERADIOBUT);
+ AddCrossCallEntry (newTable, CcRqCREATECHECKBOX, EvalCcRqCREATECHECKBOX);
+ AddCrossCallEntry (newTable, CcRqSETITEMCHECK, EvalCcRqSETITEMCHECK);
+ AddCrossCallEntry (newTable, CcRqENABLECONTROL, EvalCcRqENABLECONTROL);
+ AddCrossCallEntry (newTable, CcRqSHOWCONTROL, EvalCcRqSHOWCONTROL);
+ AddCrossCallEntry (newTable, CcRqSHOWWINDOW, EvalCcRqSHOWWINDOW);
+ AddCrossCallEntry (newTable, CcRqCREATEPOPUP, EvalCcRqCREATEPOPUP);
+ AddCrossCallEntry (newTable, CcRqADDTOPOPUP, EvalCcRqADDTOPOPUP);
+ AddCrossCallEntry (newTable, CcRqSELECTPOPUPITEM, EvalCcRqSELECTPOPUPITEM);
+ AddCrossCallEntry (newTable, CcRqRESTACKWINDOW, EvalCcRqRESTACKWINDOW);
+ AddCrossCallEntry (newTable, CcRqADDCONTROLTIP, EvalCcRqADDCONTROLTIP);
+ AddCrossCallEntry (newTable, CcRqDELCONTROLTIP, EvalCcRqDELCONTROLTIP);
+ AddCrossCallEntry (newTable, CcRqCREATECARET, EvalCcRqCREATECARET);
+ AddCrossCallEntry (newTable, CcRqSETCARETPOS, EvalCcRqSETCARETPOS);
+ AddCrossCallEntry (newTable, CcRqDESTROYCARET, EvalCcRqDESTROYCARET);
+ AddCrossCallEntry (newTable, CcRqHIDECARET, EvalCcRqHIDECARET);
+ AddCrossCallEntry (newTable, CcRqSHOWCARET, EvalCcRqSHOWCARET);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+
+ return ios;
+}
+
+int GetUpdateRect(OSWindowPtr hwnd, GdkRectangle *updateRect, gboolean ok)
+{
+ printf("GetUpdateRect\n");
+ return 0;
+}
diff --git a/Linux_C_12/cCrossCallWindows_121.h b/Linux_C_12/cCrossCallWindows_121.h new file mode 100644 index 0000000..9963e28 --- /dev/null +++ b/Linux_C_12/cCrossCallWindows_121.h @@ -0,0 +1,13 @@ +#include "util_121.h"
+extern OSWindowPtr ghCaretWnd;
+
+extern void DeleteCursors(); /* Delete all created mouse cursors */
+
+/*
+ * InstallCrossCallFileSelectors adds the proper cross call procedures to the
+ * cross call procedures managed by cCrossCall_121.c.
+ */
+extern OS InstallCrossCallWindows (OS);
+
+/* GetUpdateRect */
+extern int GetUpdateRect(OSWindowPtr, GdkRectangle*, gboolean);
diff --git a/Linux_C_12/cCrossCall_121.c b/Linux_C_12/cCrossCall_121.c new file mode 100644 index 0000000..d4477e9 --- /dev/null +++ b/Linux_C_12/cCrossCall_121.c @@ -0,0 +1,729 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ cCrossCall_121 defines the infrastructure required by the Object I/O library to call
+ system procedures that interact with the Windows callback mechanism.
+
+ The basic principle in cCrossCall_121 is to have a minimal cross call kernel. If Clean
+ code requires extension of the functionality of the OS thread, then this functionality
+ must be registered before being applicable.
+
+ In this version the request codes are still statically fixed and are assumed to be
+ globally available both in the OS thread and the Clean thread. In a future version this
+ will probably be replaced by a dynamic allocation of cross call request codes.
+********************************************************************************************/
+
+
+/********************************************************************************************
+ Include section.
+********************************************************************************************/
+
+#include "cCrossCall_121.h"
+#include "cCrossCallWindows_121.h" /* Contains the implementation of cursors. */
+#include <gdk/gdkkeysyms.h>
+#include <pthread.h>
+#include <unistd.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <stdlib.h>
+
+char** global_argv;
+int global_argc = 0;
+
+#define _MAX_PATH 255
+
+/**********************************************************************************************
+ External global data section.
+**********************************************************************************************/
+CrossCallInfo gCci; /* The global cross call information struct. */
+GtkTooltips *gTooltip = NULL; /* The tooltip control. */
+CrossCallProcedureTable gCrossCallProcedureTable;
+
+/**********************************************************************************************
+ Internal global data section.
+**********************************************************************************************/
+
+static pthread_mutex_t gCleanMutex;
+static pthread_mutex_t gOSMutex;
+static pthread_t gOSThread;
+static gboolean gOSThreadIsRunning = FALSE;
+static gboolean gEventsInited = FALSE; /* What is this? */
+
+static CrossCallInfo *MakeQuitCci (CrossCallInfo * pcci);
+
+
+/* GetModifiers returns the modifiers that are currently pressed.
+*/
+int GetModifiers (void)
+{
+ int mods = 0;
+ GdkModifierType state;
+
+ /*printf("GetModifiers\n");*/
+
+ gdk_event_get_state(gtk_get_current_event(), &state);
+
+ if (state & GDK_SHIFT_MASK) {
+ mods |= SHIFTBIT;
+ }
+ if (state & GDK_CONTROL_MASK) {
+ mods |= CTRLBIT;
+ }
+ if (state & GDK_MOD1_MASK) {
+ mods |= ALTBIT;
+ }
+
+ return mods;
+}
+
+
+/* Translate virtual key codes to the codes shared with Clean.
+ This procedure has been filtered from TranslateKeyboardMessage.
+ If the keycode could not be translated, zero is returned.
+*/
+int CheckVirtualKeyCode (int keycode)
+{
+ int c = 0;
+ /* printf("CheckVirtualKeyCode\n");*/
+ switch (keycode)
+ {
+ case GDK_Up:
+ c = WinUpKey;
+ break;
+ case GDK_Down:
+ c = WinDownKey;
+ break;
+ case GDK_Left:
+ c = WinLeftKey;
+ break;
+ case GDK_Right:
+ c = WinRightKey;
+ break;
+ case GDK_Page_Up:
+ c = WinPgUpKey;
+ break;
+ case GDK_Page_Down:
+ c = WinPgDownKey;
+ break;
+ case GDK_End:
+ c = WinEndKey;
+ break;
+ case GDK_Begin:
+ c = WinBeginKey;
+ break;
+ case GDK_BackSpace:
+ c = WinBackSpKey;
+ break;
+ case GDK_Delete:
+ c = WinDelKey;
+ break;
+ case GDK_Tab:
+ c = WinTabKey;
+ break;
+ case GDK_Return:
+ c = WinReturnKey;
+ break;
+ case GDK_Escape:
+ c = WinEscapeKey;
+ break;
+ case GDK_Help:
+ c = WinHelpKey;
+ break;
+ case GDK_F1:
+ c = WinF1Key;
+ break;
+ case GDK_F2:
+ c = WinF2Key;
+ break;
+ case GDK_F3:
+ c = WinF3Key;
+ break;
+ case GDK_F4:
+ c = WinF4Key;
+ break;
+ case GDK_F5:
+ c = WinF5Key;
+ break;
+ case GDK_F6:
+ c = WinF6Key;
+ break;
+ case GDK_F7:
+ c = WinF7Key;
+ break;
+ case GDK_F8:
+ c = WinF8Key;
+ break;
+ case GDK_F9:
+ c = WinF9Key;
+ break;
+ case GDK_F10:
+ c = WinF10Key;
+ break;
+ case GDK_F11:
+ c = WinF11Key;
+ break;
+ case GDK_F12:
+ c = WinF12Key;
+ break;
+ }
+ return c;
+}
+
+static gboolean TimerCallback (gpointer data)
+{
+ /*printf("TimerCallback\n");*/
+ SendMessage0ToClean (CcWmIDLETIMER);
+ return TRUE;
+}
+
+void HandleCleanRequest (CrossCallInfo * pcci)
+{
+ /*printf("HandleCleanRequest: Message = %d\n", pcci->mess);*/
+ switch (pcci->mess)
+ {
+ case CcRqDOMESSAGE: /* idleTimerOn, sleeptime; no result. */
+ {
+ gboolean gIdleTimerOn = (gboolean) pcci->p1;
+ gint interval = (gint) pcci->p2;
+ /*printf("CcRqDOMESSAGE\n");*/
+
+ if (gIdleTimerOn)
+ {
+ GSource *source = g_timeout_source_new(interval);
+ g_source_set_callback(source,TimerCallback,NULL,NULL);
+ g_source_attach(source,NULL);
+
+ gtk_main_iteration();
+
+ g_source_destroy(source);
+ }
+ else
+ {
+ gtk_main_iteration();
+ }
+
+ MakeReturn0Cci (pcci);
+ }
+ break;
+ default:
+ {
+ CrossCallProcedure action;
+
+ action = FindCrossCallEntry (gCrossCallProcedureTable, pcci->mess);
+ /*printf("Handle Request for action logged for: %d\n", pcci->mess);*/
+
+ if (action == NULL)
+ { /* Cross call request code not installed. */
+ /*printf("\'HandleCleanRequest\' got uninstalled CcRq request code from Haskell: %d\n", pcci->mess);*/
+ exit(1);
+ }
+ else
+ { /* Cross call request code found. Apply it to pcci. */
+ /*printf("Action Requested: %d\n", pcci->mess);*/
+ action (pcci);
+ }
+ }
+ }
+ KickCleanThread (pcci);
+} /* HandleCleanRequest */
+
+void InitGTK()
+{
+ static gboolean gInitiated = FALSE;
+
+ /*printf("InitGTK\n"); */
+ if (!gInitiated)
+ {
+ gtk_set_locale();
+ gtk_init(&global_argc,&global_argv);
+ gInitiated = TRUE;
+ };
+} /* InitGTK */
+
+static gpointer OsThreadFunction (gpointer param);
+
+OS WinStartOsThread(OS os)
+{
+ pthread_attr_t attr;
+ /* rprintf ("WinStartOSThread\n"); */
+
+ InitGTK();
+
+ /* The cross call procedure table is set to the empty table. */
+ gCrossCallProcedureTable = EmptyCrossCallProcedureTable ();
+ /* rprintf ("Created CC Table\n"); */
+
+ pthread_mutex_init(&gCleanMutex,NULL);
+ pthread_mutex_lock(&gCleanMutex);
+ pthread_mutex_init(&gOSMutex,NULL);
+ pthread_mutex_lock(&gOSMutex);
+ gOSThreadIsRunning = TRUE;
+ /* rprintf ("OS is running.\n"); */
+
+ pthread_attr_init(&attr);
+ pthread_create(&gOSThread,&attr,OsThreadFunction,NULL);
+ pthread_attr_destroy(&attr);
+ /* rprintf ("Exiting initializer.\n"); */
+
+ return os;
+} /* WinStartOsThread */
+
+OS WinKillOsThread (OS os)
+{
+ /* printf("WinKillOsThread\n"); */
+ if (gOSThread != FALSE)
+ {
+ gOSThreadIsRunning = FALSE;
+ gOSThread = FALSE;
+
+ DeleteCursors();
+
+ if (gCrossCallProcedureTable)
+ FreeCrossCallProcedureTable (gCrossCallProcedureTable);
+ }
+ return os;
+} /*WinKillOsThread*/
+
+#undef PRINTCROSSCALLS
+
+void WinKickOsThread (int imess,
+ int ip1, int ip2, int ip3,
+ int ip4, int ip5, int ip6,
+ OS ios,
+ int *omess,
+ int *op1, int *op2, int *op3,
+ int *op4, int *op5, int *op6,
+ OS *oos
+ )
+{
+#ifdef PRINTCROSSCALLS
+ rprintf("WinKickOsThread (");
+ printCCI (&gCci);
+ rprintf(")\n");
+#endif
+ gCci.mess = imess;
+ gCci.p1 = ip1;
+ gCci.p2 = ip2;
+ gCci.p3 = ip3;
+ gCci.p4 = ip4;
+ gCci.p5 = ip5;
+ gCci.p6 = ip6;
+
+ if (gOSThread != FALSE)
+ {
+#ifdef PRINTCROSSCALLS
+ rprintf("Unlocking Clean mutex.\n");
+#endif
+ pthread_mutex_unlock(&gCleanMutex);
+#ifdef PRINTCROSSCALLS
+ rprintf("Locking OS mutex.\n");
+#endif
+ pthread_mutex_lock(&gOSMutex);
+#ifdef PRINTCROSSCALLS
+ rprintf("OS mutex locked.\n");
+#endif
+
+ *omess = gCci.mess;
+ *op1 = gCci.p1;
+ *op2 = gCci.p2;
+ *op3 = gCci.p3;
+ *op4 = gCci.p4;
+ *op5 = gCci.p5;
+ *op6 = gCci.p6;
+ *oos = ios;
+ /* printf("Data: %d, %d, %d, %d, %d, %d, %d",
+ gCci.p1, gCci.p2, gCci.p3, gCci.p4,
+ gCci.p5, gCci.p6, ios); */
+ }
+ else
+ {
+ *omess = CcWASQUIT;
+ *op1 = 0;
+ *op2 = 0;
+ *op3 = 0;
+ *op4 = 0;
+ *op5 = 0;
+ *op6 = 0;
+ *oos = ios;
+ }
+} /* WinKickOsThread */
+
+
+#ifdef PRINTCROSSCALLS
+static CrossCallInfo osstack[10];
+static CrossCallInfo clstack[10];
+static int ossp = -1;
+static int clsp = -1;
+#endif
+
+void KickCleanThread (CrossCallInfo * pcci)
+{
+ /* rprintf("KickCleanThread\n"); */
+#ifdef PRINTCROSSCALLS
+ if (ossp == -1)
+ {
+ for (ossp = 0; ossp < 10; ossp++)
+ {
+ osstack[ossp].mess = -1;
+ }
+ ossp = 1;
+ osstack[ossp].mess = -2;
+ }
+
+ if (clsp == -1)
+ {
+ for (clsp = 0; clsp < 10; clsp++)
+ {
+ clstack[clsp].mess = -1;
+ }
+ clsp = 1;
+ clstack[clsp].mess = -2;
+ }
+#endif
+
+ if (pcci != &gCci)
+ {
+ gCci = *pcci;
+ }
+
+#ifdef PRINTCROSSCALLS
+ rprintf ("KCT: started\n");
+ if (gCci.mess < 20)
+ {
+ rprintf (" -- %d --> OS returning <", clsp + ossp - 2);
+ printCCI (&gCci);
+ rprintf ("> from <");
+ printCCI (&(clstack[clsp]));
+ rprintf (">\n");
+ clsp--;
+ }
+ else
+ {
+ ossp++;
+ osstack[ossp] = gCci;
+ rprintf (" -- %d --> OS calling with <", clsp + ossp - 2);
+ printCCI (&gCci);
+ rprintf (">\n");
+ }
+
+ rprintf ("KCT: setting event\n");
+#endif
+ pthread_mutex_unlock(&gOSMutex);
+#ifdef PRINTCROSSCALLS
+ rprintf ("KCT: starting wait\n");
+#endif
+ pthread_mutex_lock(&gCleanMutex);
+#ifdef PRINTCROSSCALLS
+ rprintf ("KCT: wait done.\n");
+#endif
+
+ if (pcci != &gCci)
+ *pcci = gCci;
+
+#ifdef PRINTCROSSCALLS
+ if (gCci.mess < 20)
+ {
+ rprintf (" <-- %d -- Clean returning <", clsp + ossp - 2);
+ printCCI (&gCci);
+ rprintf ("> from <");
+ printCCI (&(osstack[ossp]));
+ rprintf (">\n");
+ ossp--;
+ }
+ else
+ {
+ clsp++;
+ clstack[clsp] = gCci;
+ rprintf (" <-- %d -- Clean calling with <", clsp + ossp - 2);
+ printCCI (&gCci);
+ rprintf (">\n");
+ }
+#endif
+} /* KickCleanThread */
+
+void SendMessageToClean (int mess, int p1, int p2, int p3, int p4, int p5, int p6)
+{
+ /* printf("SendMessageToClean -- Message: %d\n", mess); */
+ gCci.mess = mess;
+ gCci.p1 = p1;
+ gCci.p2 = p2;
+ gCci.p3 = p3;
+ gCci.p4 = p4;
+ gCci.p5 = p5;
+ gCci.p6 = p6;
+
+ KickCleanThread (&gCci);
+ while (!IsReturnCci (&gCci))
+ {
+ HandleCleanRequest (&gCci);
+ }
+}
+
+CrossCallInfo *MakeReturn0Cci (CrossCallInfo * pcci)
+{
+ pcci->mess = CcRETURN0;
+ return pcci;
+}
+
+CrossCallInfo *MakeReturn1Cci (CrossCallInfo * pcci, int v1)
+{
+ pcci->mess = CcRETURN1;
+ pcci->p1 = v1;
+ return pcci;
+}
+
+CrossCallInfo *MakeReturn2Cci (CrossCallInfo * pcci, int v1, int v2)
+{
+ pcci->mess = CcRETURN2;
+ pcci->p1 = v1;
+ pcci->p2 = v2;
+ return pcci;
+}
+
+CrossCallInfo *MakeReturn3Cci (CrossCallInfo * pcci, int v1, int v2, int v3)
+{
+ pcci->mess = CcRETURN3;
+ pcci->p1 = v1;
+ pcci->p2 = v2;
+ pcci->p3 = v3;
+ return pcci;
+}
+
+CrossCallInfo *MakeReturn4Cci (CrossCallInfo * pcci, int v1, int v2, int v3, int v4)
+{
+ pcci->mess = CcRETURN4;
+ pcci->p1 = v1;
+ pcci->p2 = v2;
+ pcci->p3 = v3;
+ pcci->p4 = v4;
+ return pcci;
+}
+
+CrossCallInfo *MakeReturn5Cci (CrossCallInfo * pcci, int v1, int v2, int v3, int v4, int v5)
+{
+ pcci->mess = CcRETURN5;
+ pcci->p1 = v1;
+ pcci->p2 = v2;
+ pcci->p3 = v3;
+ pcci->p4 = v4;
+ pcci->p5 = v5;
+ return pcci;
+}
+
+CrossCallInfo *MakeReturn6Cci (CrossCallInfo * pcci, int v1, int v2, int v3, int v4, int v5, int v6)
+{
+ pcci->mess = CcRETURN6;
+ pcci->p1 = v1;
+ pcci->p2 = v2;
+ pcci->p3 = v3;
+ pcci->p4 = v4;
+ pcci->p5 = v5;
+ pcci->p6 = v6;
+ return pcci;
+}
+
+gboolean IsReturnCci (CrossCallInfo * pcci)
+{
+ /* printf("Checking message %d: ", pcci->mess);*/
+ if (pcci->mess >= CcRETURNmin && pcci->mess <= CcRETURNmax)
+ {
+ return TRUE;
+ }
+ return FALSE;
+}
+
+
+static gpointer OsThreadFunction (gpointer param)
+{
+ /* printf("OsThreadFunction\n"); */
+ gTooltip = gtk_tooltips_new();
+
+ pthread_mutex_lock(&gCleanMutex);
+
+ while (gOSThreadIsRunning)
+ {
+ HandleCleanRequest (&gCci);
+ }
+
+ pthread_mutex_unlock(&gCleanMutex);
+
+ pthread_mutex_destroy(&gOSMutex);
+ pthread_mutex_destroy(&gCleanMutex);
+
+ return NULL;
+} /* OsThreadFunction */
+
+void WinInitOs (Bool* ok, OS* os)
+{
+ /* printf("WinInitOs\n"); */
+ if (gEventsInited)
+ {
+ *ok = FALSE;
+ rprintf ("WIO: *ok = FALSE\n");
+ }
+ else
+ {
+ *ok = TRUE;
+ gEventsInited = TRUE;
+ rprintf ("WIO: *ok = TRUE\n");
+ }
+ *os = 54321;
+} /* WinInitOs */
+
+Bool WinCloseOs (OS os)
+ {
+ if (gEventsInited)
+ {
+ rprintf ("WCO: return TRUE\n");
+ gEventsInited = FALSE;
+ return TRUE;
+ }
+ else
+ {
+ rprintf ("WCO: return FALSE\n");
+ return FALSE;
+ }
+} /* WinCloseOs */
+
+void WinCallProcess (char* commandline, char* env, char* dir, char* in,
+ char* out, char* err, OS ios, Bool* success, int* exitcode,
+ OS* oos)
+{
+ printf("WinCallProcess --> Not Implemented\n");
+ *oos = ios;
+}
+
+void WinLaunchApp2 (CLEAN_STRING commandline, CLEAN_STRING pathname,
+ BOOL console, OS ios, Bool *success, OS *oos)
+{
+ pid_t pi;
+ BOOL fsuccess;
+ char path[_MAX_PATH];
+ char *cl, *exname, *thepath;
+ int i;
+ int error;
+
+ rprintf ("WLA: starting...\n");
+
+ *success = FALSE;
+ *oos = ios;
+
+ rprintf ("WLA: step 2.\n");
+
+ exname = cstring(pathname);
+ cl = cstring (commandline);
+ strcpy (path, cl);
+ for (i = strlen (path); path[i] != '\\' && i >= 0; i--)
+ {
+ path[i] = 0;
+ }
+
+ if (i == 0)
+ {
+ thepath = NULL;
+ }
+ else
+ { /* path[i] = '\"'; */
+ thepath = path + 1;
+ }
+
+ rprintf ("WLA: step 2a: directory = <%s>\n", thepath);
+
+ rprintf ("WLA: step 3: calling process \"%s\".\n", cl);
+ pi = fork();
+ if (pi == 0)
+ {
+ /* I'm a child -- launch the desired program. */
+ execlp(exname, cl);
+ } else if (pi == -1) {
+ /* Error condition */
+ error = errno;
+ rprintf ("WLA: failure %d\n", error);
+ fsuccess = FALSE;
+ } else {
+ rprintf ("WLA: success\n");
+ fsuccess = TRUE;
+ }
+
+ rprintf ("WLA: step 5: returning\n");
+ *success = fsuccess;
+ *oos = ios;
+ rprintf ("WLA: done...\n");
+}
+
+void WinLaunchApp (CLEAN_STRING commandline, BOOL console, OS ios,
+ Bool *success, OS *oos)
+{
+ printf("WinLaunchApp --> Not implemented\n");
+ *oos = ios;
+}
+
+char* WinGetAppPath (void)
+{
+ int idx, length;
+ char *path = rmalloc(261);
+ char *search = rmalloc(261);
+ pid_t pid = getpid();
+
+ /* printf("WinGetAppPath\n"); */
+
+ /*
+ * NOTE: LINUX Only
+ *
+ * Path to current executable is found by:
+ *
+ * /proc/<pid>/exe (symlink to actual executable
+ *
+ * stat this symlink to get the path
+ */
+ sprintf(search, "/proc/%d/exe", pid);
+ length = readlink(search, path, 261);
+ path[length] = 0x00;
+
+ for (idx = length - 1;
+ path[idx] != '/' && path[idx] != '\\' &&
+ path[idx] != ':';
+ idx--)
+ ;
+
+ path[idx + 1] = 0;
+
+ /* printf("App Path: %s\n", path); */
+
+ return path;
+ /* relying on the calling clean function to de-allocate path. */
+} /* WinGetAppPath */
+
+CLEAN_STRING WinGetModulePath (void)
+{
+ char path[255 + 1];
+
+ printf("WinGetModulePath -- Not Implemented.\n");
+
+ return cleanstring(WinGetAppPath());
+}
+
+void WinFileModifiedDate (CLEAN_STRING name, gboolean* exists, int *yy,
+ int *mm, int *dd, int *h, int *m, int *s)
+{
+ printf("WinFileModifiedDate --> Not implemented.\n");
+ *exists = FALSE;
+ *yy = 0;
+ *mm = 0;
+ *dd = 0;
+ *h = 0;
+ *m = 0;
+ *s = 0;
+}
+
+gboolean WinFileExists (CLEAN_STRING string)
+{
+ printf("WinFileExists --> Not implemented\n");
+ return FALSE;
+}
+
diff --git a/Linux_C_12/cCrossCall_121.h b/Linux_C_12/cCrossCall_121.h new file mode 100644 index 0000000..6bd2ed1 --- /dev/null +++ b/Linux_C_12/cCrossCall_121.h @@ -0,0 +1,87 @@ +#include "util_121.h"
+#include "cCrossCallProcedureTable_121.h"
+#include "cTCP_121.h"
+
+
+/* Global data with external references: */
+extern CrossCallInfo gCci; /* The global cross call information struct. */
+extern int gClipboardCount; /* Keeps track of changes of clipboard. */
+extern CrossCallProcedureTable gCrossCallProcedureTable; /* The cross call procedure table. */
+extern GtkTooltips *gTooltip; /* The tooltip control. */
+
+#if defined(mingw32_TARGET_OS)
+extern char *gAppName; /* The application name. */
+extern HINSTANCE ghInst; /* The handle to the instance of the OS thread. */
+extern HWND ghMainWindow; /* The handle to the main HWND of the OS thread. */
+extern HACCEL gAcceleratorTable; /* Refers to the accelerator table of the active frame. */
+extern BOOL gAcceleratorTableIsUpToDate; /* Flag: TRUE iff accelerator table corresponds with active frame. */
+extern HWND ghActiveFrameWindow; /* The currently active frame window (MDI/SDI). */
+extern HWND ghActiveClientWindow; /* The currently active client window (MDI). */
+extern HWND gActiveDialog; /* The currently active dialogue. */
+extern HWND ghwndLastModalDialog; /* Keeps track of last modal dialog. */
+extern HFONT gDlogFont; /* The handle to the logical FONT that is used in dialogs. */
+extern HFONT gControlFont; /* The handle to the logical FONT that is used in all controls. */
+extern HWND ghTCPWindow; /* The handle to the TCP HWND of the OS thread. */
+
+
+/* Menu(item)IDs are not allowed to exceed OSMenuIDEnd.
+ This is because window ids start at (OSMenuIDEnd+5), and need to be distinct from menu ids
+ in case of MDI processes.
+ The global gMenuItemID (initially 0) is incremented by NextMenuItemID each time a new
+ menu(item)ID is required.
+ This implementation does not reuse freed ids and is therefore not adequate!!
+*/
+#define OSMenuIDEnd 10000
+extern UINT NextMenuItemID (void);
+#endif
+
+
+/* GetModifiers returns the modifiers that are currently pressed.
+*/
+extern int GetModifiers (void);
+
+/* Translate virtual key codes to the codes shared with Clean.
+ If the keycode could not be translated, zero is returned.
+*/
+extern int CheckVirtualKeyCode (int keycode);
+
+
+extern void HandleCleanRequest( CrossCallInfo *pcci );
+extern OS WinStartOsThread (OS);
+extern OS WinKillOsThread (OS);
+extern void WinKickOsThread (int,int,int,int,int,int,int,OS,int*,int*,int*,
+ int*,int*,int*,int*,OS*);
+extern void KickCleanThread( CrossCallInfo *pcci );
+
+extern void SendMessageToClean( int mess, int p1,int p2,int p3, int p4,int p5,int p6 );
+
+/* Shorthands for SendMessageToClean: */
+#define SendMessage0ToClean(mess) SendMessageToClean((mess), 0,0,0,0,0,0)
+#define SendMessage1ToClean(mess, p1) SendMessageToClean((mess), (int)(p1),0,0,0,0,0)
+#define SendMessage2ToClean(mess, p1,p2) SendMessageToClean((mess), (int)(p1),(int)(p2),0,0,0,0)
+#define SendMessage3ToClean(mess, p1,p2,p3) SendMessageToClean((mess), (int)(p1),(int)(p2),(int)(p3),0,0,0)
+#define SendMessage4ToClean(mess, p1,p2,p3,p4) SendMessageToClean((mess), (int)(p1),(int)(p2),(int)(p3),(int)(p4),0,0)
+#define SendMessage5ToClean(mess, p1,p2,p3,p4,p5) SendMessageToClean((mess), (int)(p1),(int)(p2),(int)(p3),(int)(p4),(int)(p5),0)
+#define SendMessage6ToClean(mess, p1,p2,p3,p4,p5,p6) SendMessageToClean((mess), (int)(p1),(int)(p2),(int)(p3),(int)(p4),(int)(p5),(int)(p6))
+
+/* Prototypes of convenience functions that fill CrossCallInfo struct. */
+extern CrossCallInfo *MakeReturn0Cci (CrossCallInfo * pcci);
+extern CrossCallInfo *MakeReturn1Cci (CrossCallInfo * pcci, int v);
+extern CrossCallInfo *MakeReturn2Cci (CrossCallInfo * pcci, int v1, int v2);
+extern CrossCallInfo *MakeReturn3Cci (CrossCallInfo * pcci, int v1, int v2, int v3);
+extern CrossCallInfo *MakeReturn4Cci (CrossCallInfo * pcci, int v1, int v2, int v3, int v4);
+extern CrossCallInfo *MakeReturn5Cci (CrossCallInfo * pcci, int v1, int v2, int v3, int v4, int v5);
+extern CrossCallInfo *MakeReturn6Cci (CrossCallInfo * pcci, int v1, int v2, int v3, int v4, int v5, int v6);
+
+extern BOOL IsReturnCci( CrossCallInfo *pcci );
+
+extern void WinInitOs (gboolean*, OS*);
+extern gboolean WinCloseOs (OS os);
+extern char* WinGetAppPath (void);
+extern CLEAN_STRING WinGetModulePath (void);
+extern void WinFileModifiedDate (CLEAN_STRING name, gboolean* exists, int *yy, int *mm, int *dd, int *h, int *m, int *s);
+extern gboolean WinFileExists (CLEAN_STRING);
+
+extern void WinCallProcess(char*,char*,char*,char*,char*,char*,OS,Bool*,int*,OS*);
+extern void WinLaunchApp(CLEAN_STRING,BOOL,OS,Bool*,OS*);
+extern void WinLaunchApp2(CLEAN_STRING,CLEAN_STRING,BOOL,OS,Bool*,OS*);
diff --git a/Linux_C_12/cCrossCallxDI_121.c b/Linux_C_12/cCrossCallxDI_121.c new file mode 100644 index 0000000..2426cff --- /dev/null +++ b/Linux_C_12/cCrossCallxDI_121.c @@ -0,0 +1,616 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ This module contains the cross call implementations required for
+ NDI, SDI, and MDI document interfaces.
+********************************************************************************************/
+#include "util_121.h"
+#include <gdk/gdkkeysyms.h>
+#include "cCrossCallxDI_121.h"
+#include "cCrossCall_121.h"
+#include "cCCallWindows_121.h"
+
+
+/* Global data with external references:
+*/
+GtkWidget *gActiveTopLevelWindow = NULL;
+gboolean gInMouseDown = FALSE;
+gboolean gInKey = FALSE;
+gint gCurChar;
+
+
+/* GetSDIClientWindow finds the first SDI client window of the argument hwnd.
+ This procedure assumes that hwnd is the handle of a SDI frame window.
+ If no SDI client window could be found then GetSDIClientWindow returns NULL.
+*/
+/*
+static HWND GetSDIClientWindow (HWND hwndFrame)
+{
+ HWND client;
+ char *clientclassname;
+ int classnamelength;
+
+ client = GetWindow (hwndFrame,GW_CHILD);
+ classnamelength = strlen (SDIWindowClassName) + 1;
+ clientclassname = rmalloc (classnamelength);
+ GetClassName (client, clientclassname, classnamelength);
+
+ while (client != NULL && strcmp(clientclassname, SDIWindowClassName) != 0)
+ {
+ client = GetWindow (client,GW_HWNDNEXT);
+ GetClassName (client,clientclassname,classnamelength);
+ }
+ rfree (clientclassname);
+ return client;
+}
+*/
+
+/* Sending keyboard events to Clean thread:
+*/
+void SendKeyDownToClean (GtkWidget *parent, GtkWidget *child, gint c)
+{
+ printf("SendKeyDownToClean\n");
+ SendMessage5ToClean (CcWmKEYBOARD, parent, child, c, KEYDOWN,
+ GetModifiers());
+}
+
+void SendKeyStillDownToClean (GtkWidget *parent, GtkWidget *child, gint c)
+{
+ printf("SendKeyStillDownToClean\n");
+ SendMessage5ToClean (CcWmKEYBOARD, parent, child, c, KEYREPEAT,
+ GetModifiers());
+}
+
+void SendKeyUpToClean (GtkWidget *parent, GtkWidget *child, gint c)
+{
+ printf("SendKeyUpToClean\n");
+ SendMessage5ToClean (CcWmKEYBOARD, parent, child, c, KEYUP, GetModifiers());
+}
+
+static void prcs(GtkWidget *widget, gpointer data)
+{
+ printf("prcs\n");
+ if (GTK_IS_SCROLLED_WINDOW(widget))
+ {
+ *((GtkWidget **) data) = widget;
+ }
+}
+
+static GtkWidget *get_client(GtkWidget *widget)
+{
+ GtkWidget *box;
+ printf("get_client\n");
+
+ box = gtk_bin_get_child(GTK_BIN(widget));
+ if (box)
+ {
+ GtkWidget *client = NULL;
+ gtk_container_foreach(GTK_CONTAINER(box), prcs, (gpointer) &client);
+ return client;
+ }
+
+ return NULL;
+}
+
+static void frame_focus_in_handler(GtkWidget *widget, GdkEventFocus *event,
+ gpointer user_data)
+{
+ printf("frame_focus_in_handler\n");
+ SendMessage1ToClean (CcWmACTIVATE, get_client(widget));
+ GTK_WIDGET_GET_CLASS(widget)->focus_in_event(widget, event);
+ gActiveTopLevelWindow = widget;
+}
+
+static void frame_focus_out_handler(GtkWidget *widget, GdkEventFocus *event,
+ gpointer user_data)
+{
+ GtkWidget *client;
+ printf("frame_focus_out_handler\n");
+
+ client = get_client(widget);
+ if (gInKey)
+ {
+ SendKeyUpToClean (client, client, gCurChar);
+ }
+
+ SendMessage1ToClean (CcWmDEACTIVATE, client);
+ GTK_WIDGET_GET_CLASS(widget)->focus_out_event(widget, event);
+ gActiveTopLevelWindow = NULL;
+}
+
+
+static gboolean frame_delete_handler(GtkWidget *widget, GdkEvent *event,
+ gpointer user_data)
+{
+ printf("frame_delete_handler\n");
+ if (gActiveTopLevelWindow == widget)
+ {
+ gActiveTopLevelWindow = NULL;
+ }
+
+ if (gtk_object_get_data(GTK_OBJECT (widget), "gtk-drag-dest") != NULL)
+ {
+ gtk_drag_dest_unset(widget);
+ }
+
+ SendMessage1ToClean (CcWmPROCESSCLOSE, widget);
+ return gtk_true();
+}
+
+static void frame_drag_data_handler
+ (GtkWidget *widget,
+ GdkDragContext *context,
+ gint x,
+ gint y,
+ GtkSelectionData *data,
+ guint info,
+ guint time)
+{
+ printf("frame_drag_data_handler\n");
+ if ((data->length >= 0) && (data->format == 8))
+ {
+ char *filenames = rmalloc(data->length);
+ if (filenames)
+ {
+ guchar *s = data->data;
+ guchar *e = s + data->length - 2;
+ gchar *d = filenames;
+
+ while (s < e)
+ {
+ if (*s != '\r') *(d++) = *s;
+ s++;
+ }
+ *d = 0;
+
+ gtk_drag_finish (context, TRUE, FALSE, time);
+ SendMessage2ToClean (CcWmPROCESSDROPFILES, (gint) widget,
+ (gint) filenames);
+ }
+ }
+ else
+ {
+ gtk_drag_finish (context, FALSE, FALSE, time);
+ }
+}
+
+static gboolean frame_key_press_handler(GtkWidget *widget, GdkEventKey *event,
+ gpointer user_data)
+{
+ GtkWidget *client;
+ gint c;
+ printf("frame_key_press_handler\n");
+
+ client = get_client(widget);
+
+ c = (event->length > 0) ?
+ event->string[0] : CheckVirtualKeyCode (event->keyval);
+ if (!c)
+ {
+ return gtk_false();
+ }
+
+ if (event->keyval == GDK_Tab)
+ {
+ return gtk_false();
+ }
+
+ GTK_WIDGET_GET_CLASS(widget)->key_press_event(widget, event);
+
+ if (gInKey)
+ {
+ if (gCurChar == c)
+ {
+ SendKeyStillDownToClean (client, client, gCurChar);
+ }
+ else
+ {
+ SendKeyUpToClean (client, client, gCurChar);
+ gCurChar = c;
+ SendKeyDownToClean (client, client, gCurChar);
+ }
+ }
+ else
+ {
+ gCurChar = c;
+ SendKeyDownToClean (client, client, gCurChar);
+ gInKey = TRUE;
+ }
+
+ return gtk_true();
+}
+
+static gboolean frame_key_release_handler(GtkWidget *widget, GdkEventKey *event,
+ gpointer user_data)
+{
+ GtkWidget *client;
+ printf("frame_key_release_handler\n");
+
+ client = get_client(widget);
+ if (event->keyval == GDK_Tab)
+ return gtk_false();
+
+ GTK_WIDGET_GET_CLASS(widget)->key_press_event(widget, event);
+
+ if (gInKey)
+ {
+ SendKeyUpToClean (client, client, gCurChar);
+ gInKey = FALSE;
+ gCurChar = 0;
+ }
+
+ return gtk_true();
+}
+
+/* Create a SDI frame window. */
+void EvalCcRqCREATESDIFRAMEWINDOW (CrossCallInfo *pcci) /* accept file open; frame ptr, menubar results. */
+{
+ GtkWidget *window, *menuBar, *box;
+
+ printf("EvalCcRqCREATESDIFRAMEWINDOW\n");
+
+ /* Create the menubar. */
+ menuBar = gtk_menu_bar_new();
+
+ /* Create the window. */
+ window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+ gtk_signal_connect (GTK_OBJECT (window), "focus-in-event",
+ GTK_SIGNAL_FUNC(frame_focus_in_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT (window), "focus-out-event",
+ GTK_SIGNAL_FUNC(frame_focus_out_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT (window), "delete-event",
+ GTK_SIGNAL_FUNC(frame_delete_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(window), "key-press-event",
+ GTK_SIGNAL_FUNC(frame_key_press_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(window), "key-release-event",
+ GTK_SIGNAL_FUNC(frame_key_release_handler),
+ NULL);
+
+ if ((gboolean) pcci->p1) /* respond to file open events. */
+ {
+ static GtkTargetEntry target_table = { "text/uri-list", 0, 0 };
+
+ gtk_drag_dest_set (window,
+ GTK_DEST_DEFAULT_ALL,
+ &target_table, 1, /* no rootwin */
+ GDK_ACTION_COPY | GDK_ACTION_MOVE);
+
+ gtk_signal_connect(GTK_OBJECT(window), "drag_data_received",
+ GTK_SIGNAL_FUNC(frame_drag_data_handler), NULL);
+ }
+
+ gtk_window_add_accel_group (GTK_WINDOW (window), gtk_accel_group_new());
+
+ box = gtk_vbox_new(FALSE, 0);
+ gtk_container_add(GTK_CONTAINER(window), box);
+ gtk_box_pack_start(GTK_BOX(box), menuBar, FALSE, FALSE, 0);
+ gtk_widget_show(menuBar);
+
+ MakeReturn2Cci (pcci, (int) window, (int) menuBar);
+}
+
+static void frame_close_page_handler(GtkWidget *client)
+{
+ GtkWidget *window;
+ printf("frame_close_page_handler\n");
+
+ window = gtk_notebook_get_nth_page(GTK_NOTEBOOK(client), gtk_notebook_get_current_page(GTK_NOTEBOOK(client)));
+ SendMessage1ToClean(CcWmCLOSE, window);
+}
+
+static void frame_notebook_top_handler(GtkWidget *client)
+{
+ printf("frame_notebook_top_handler\n");
+ gtk_notebook_set_tab_pos(GTK_NOTEBOOK(client), GTK_POS_TOP);
+}
+
+static void frame_notebook_bottom_handler(GtkWidget *client)
+{
+ printf("frame_notebook_bottom_handler\n");
+ gtk_notebook_set_tab_pos(GTK_NOTEBOOK(client), GTK_POS_BOTTOM);
+}
+
+static void frame_notebook_left_handler(GtkWidget *client)
+{
+ printf("frame_notebook_left_handler\n");
+ gtk_notebook_set_tab_pos(GTK_NOTEBOOK(client), GTK_POS_LEFT);
+}
+
+static void frame_notebook_right_handler(GtkWidget *client)
+{
+ printf("frame_notebook_right_handler\n");
+ gtk_notebook_set_tab_pos(GTK_NOTEBOOK(client), GTK_POS_RIGHT);
+}
+
+static void frame_switch_page_handler(GtkNotebook *notebook,
+ GtkNotebookPage *page, gint page_num, gpointer user_data)
+{
+ /* send deactivate message for old */
+ gint old_page_num;
+ printf("frame_switch_page_handler\n");
+ old_page_num = g_list_index(notebook->children, notebook->cur_page);
+
+ SendMessage1ToClean (CcWmDEACTIVATE, gtk_notebook_get_nth_page(notebook,
+ old_page_num));
+
+ /* send activate message for new */
+ SendMessage1ToClean (CcWmACTIVATE, gtk_notebook_get_nth_page(notebook,
+ page_num));
+ gActiveTopLevelWindow = gtk_widget_get_parent(
+ gtk_widget_get_parent(GTK_WIDGET(notebook)));
+
+}
+
+/* Create MDI frame window. */
+void EvalCcRqCREATEMDIFRAMEWINDOW (CrossCallInfo *pcci) /* show, accept file open; frame ptr, client ptr, menubar, windowmenu results. */
+{
+ GtkWidget *window, *client, *menuBar, *box;
+ GtkWidget *notebook_menu, *menu_item, *pages_menu;
+ GtkAccelGroup *accel_group;
+ GSList *group;
+
+ printf("EvalCcRqCREATEMDIFRAMEWINDOW\n");
+ /* Create the window. */
+
+ window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+ gtk_signal_connect (GTK_OBJECT(window), "delete-event",
+ GTK_SIGNAL_FUNC(frame_delete_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(window), "key-press-event",
+ GTK_SIGNAL_FUNC(frame_key_press_handler),
+ NULL);
+ gtk_signal_connect (GTK_OBJECT(window), "key-release-event",
+ GTK_SIGNAL_FUNC(frame_key_release_handler),
+ NULL);
+
+
+ if ((gboolean) pcci->p2) /* respond to file open events. */
+ {
+ static GtkTargetEntry target_table = { "text/uri-list", 0, 0 };
+
+ gtk_drag_dest_set (window,
+ GTK_DEST_DEFAULT_ALL,
+ &target_table, 1, /* no rootwin */
+ GDK_ACTION_COPY | GDK_ACTION_MOVE);
+
+ gtk_signal_connect(GTK_OBJECT(window), "drag_data_received",
+ GTK_SIGNAL_FUNC(frame_drag_data_handler), NULL);
+ }
+
+ /* Create accel_group */
+ accel_group = gtk_accel_group_new();
+ gtk_window_add_accel_group (GTK_WINDOW (window), accel_group);
+
+ box = gtk_vbox_new(FALSE, 0);
+ gtk_container_add(GTK_CONTAINER(window), box);
+
+ /* Create the menubar. */
+ menuBar = gtk_menu_bar_new();
+ gtk_box_pack_start(GTK_BOX(box), menuBar, FALSE, FALSE, 0);
+
+ /* Create client(notebook) */
+ client = gtk_notebook_new();
+ gtk_notebook_set_scrollable(GTK_NOTEBOOK(client), gtk_true());
+ gtk_signal_connect (GTK_OBJECT(client), "switch-page",
+ GTK_SIGNAL_FUNC(frame_switch_page_handler),
+ NULL);
+ gtk_box_pack_end(GTK_BOX(box), client, TRUE, TRUE, 0);
+
+ if ((gboolean) pcci->p1)
+ gtk_window_maximize(GTK_WINDOW(window));
+ gtk_widget_show_all(window);
+
+ /* Create "Pages" menu */
+ pages_menu = gtk_menu_new();
+ gtk_menu_set_accel_group(GTK_MENU(pages_menu), accel_group);
+
+ menu_item = gtk_menu_item_new_with_label("Pages");
+ gtk_menu_item_set_submenu(GTK_MENU_ITEM (menu_item), pages_menu);
+ gtk_widget_show_all(menu_item);
+
+ gtk_menu_bar_insert(GTK_MENU_BAR(menuBar), menu_item, 0);
+
+ notebook_menu = gtk_menu_new();
+ gtk_menu_set_accel_group(GTK_MENU(notebook_menu), accel_group);
+
+ menu_item = gtk_radio_menu_item_new_with_label(NULL, "Top");
+ gtk_check_menu_item_set_active(GTK_CHECK_MENU_ITEM(menu_item), gtk_true());
+ group = gtk_radio_menu_item_group(GTK_RADIO_MENU_ITEM(menu_item));
+ gtk_signal_connect_object (GTK_OBJECT (menu_item), "activate",
+ GTK_SIGNAL_FUNC (frame_notebook_top_handler), client);
+ gtk_menu_append(GTK_MENU(notebook_menu), menu_item);
+
+ menu_item = gtk_radio_menu_item_new_with_label(group, "Bottom");
+ group = gtk_radio_menu_item_group(GTK_RADIO_MENU_ITEM(menu_item));
+ gtk_signal_connect_object (GTK_OBJECT (menu_item), "activate",
+ GTK_SIGNAL_FUNC (frame_notebook_bottom_handler), client);
+ gtk_menu_append(GTK_MENU(notebook_menu), menu_item);
+
+ menu_item = gtk_radio_menu_item_new_with_label(group, "Left");
+ group = gtk_radio_menu_item_group(GTK_RADIO_MENU_ITEM(menu_item));
+ gtk_signal_connect_object (GTK_OBJECT (menu_item), "activate",
+ GTK_SIGNAL_FUNC (frame_notebook_left_handler), client);
+ gtk_menu_append(GTK_MENU(notebook_menu), menu_item);
+
+ menu_item = gtk_radio_menu_item_new_with_label(group, "Right");
+ group = gtk_radio_menu_item_get_group(GTK_RADIO_MENU_ITEM(menu_item));
+ gtk_signal_connect_object (GTK_OBJECT (menu_item), "activate",
+ GTK_SIGNAL_FUNC (frame_notebook_right_handler), client);
+ gtk_menu_append(GTK_MENU(notebook_menu), menu_item);
+
+ menu_item = gtk_menu_item_new_with_label("Notebook");
+ gtk_menu_item_set_submenu(GTK_MENU_ITEM (menu_item), notebook_menu);
+ gtk_menu_append(GTK_MENU(pages_menu), menu_item);
+
+ menu_item = gtk_menu_item_new();
+ gtk_menu_append(GTK_MENU(pages_menu), menu_item);
+
+ menu_item = gtk_menu_item_new_with_label("Close page");
+ gtk_signal_connect_object (GTK_OBJECT (menu_item), "activate",
+ GTK_SIGNAL_FUNC (frame_close_page_handler), client);
+ gtk_menu_append(GTK_MENU(pages_menu), menu_item);
+
+ gtk_widget_show(menuBar);
+ gtk_widget_show_all(pages_menu);
+
+ MakeReturn4Cci (pcci, (int) window, (int) client, (int) menuBar, (int) pages_menu);
+}
+
+void EvalCcRqDESTROYWINDOW (CrossCallInfo *pcci)
+{
+ printf("EvalCcRqDESTROYWINDOW\n");
+ gtk_widget_destroy(GTK_WIDGET(pcci->p1));
+ MakeReturn0Cci (pcci);
+}
+
+void EvalCcRqGETWINDOWPOS (CrossCallInfo *pcci)
+{
+ /* hwnd; width, heigth result */
+ gint left, top;
+
+ printf("EvalCcRqGETWINDOWPOS\n");
+ gtk_window_get_position(GTK_WINDOW(pcci->p1), &left, &top);
+ MakeReturn2Cci (pcci, left, top);
+}
+
+void EvalCcRqGETCLIENTSIZE (CrossCallInfo *pcci)
+{
+ /* hwnd; width, height result. */
+ printf("EvalCcRqGETCLIENTSIZE\n");
+
+ if (pcci->p1 && (pcci->p1 != OS_NO_WINDOW_PTR))
+ {
+ GtkRequisition requisition;
+ GtkWidget *frame = GTK_WIDGET(pcci->p1);
+ gtk_widget_size_request(frame, &requisition);
+ MakeReturn2Cci (pcci, requisition.width, requisition.height);
+ } else {
+ MakeReturn2Cci (pcci, 0, 0);
+ }
+}
+
+static void toolbar_handler(GtkWidget *widget, gpointer data)
+{
+ GtkWidget *toolbar, *parent;
+
+ printf("toolbar_handler\n");
+ toolbar = gtk_widget_get_parent(widget);
+ parent = gtk_widget_get_parent(gtk_widget_get_parent(toolbar));
+ SendMessage4ToClean (CcWmBUTTONCLICKED, parent, toolbar, GetModifiers(),
+ (int) data);
+}
+
+/* Create a toolbar in a window. */
+void EvalCcRqCREATEMDITOOLBAR (CrossCallInfo *pcci)
+{
+ /* hwnd, width, height; toolbarptr, full toolbar height result; */
+ GtkWidget *parent,*box,*toolbar;
+
+ printf("EvalCcRqCREATEMDITOOLBAR\n");
+ if (pcci->p1 && (pcci->p1 != OS_NO_WINDOW_PTR))
+ {
+ parent = GTK_WIDGET(pcci->p1);
+
+ box = gtk_bin_get_child(GTK_BIN(parent));
+ toolbar = gtk_toolbar_new();
+
+ gtk_box_pack_start (GTK_BOX (box), toolbar, FALSE, FALSE, 0);
+ gtk_widget_show(toolbar);
+
+ gtk_window_maximize(GTK_WINDOW(parent));
+ MakeReturn2Cci (pcci, (int) toolbar, pcci->p3);
+ }
+}
+
+/* Create a toolbar in a SDI window. */
+void EvalCcRqCREATESDITOOLBAR (CrossCallInfo *pcci)
+{
+ GtkWidget *parent,*box,*toolbar;
+ printf("EvalCcRqCREATESDITOOLBAR\n");
+
+ if (pcci->p1 && (pcci->p1 != OS_NO_WINDOW_PTR))
+ {
+ parent = GTK_WIDGET(pcci->p1);
+
+ box = gtk_bin_get_child(GTK_BIN(parent));
+ toolbar = gtk_toolbar_new();
+
+ gtk_box_pack_start (GTK_BOX(box), toolbar, FALSE, FALSE, 0);
+ gtk_widget_show(toolbar);
+
+ MakeReturn2Cci (pcci, (int)toolbar, pcci->p3);
+ }
+}
+
+/* Create a bitmap toolbar item. */
+void EvalCcRqCREATETOOLBARITEM (CrossCallInfo *pcci)
+{
+ GtkWidget *toolbar;
+ GdkPixbuf *pixbuf;
+ gint index;
+
+ printf("EvalCcRqCREATETOOLBARITEM\n");
+ if (pcci->p1 && (pcci->p1 != OS_NO_WINDOW_PTR))
+ {
+ toolbar = GTK_WIDGET(pcci->p1);
+ pixbuf = GDK_PIXBUF(pcci->p2);
+ index = pcci->p3;
+
+ gtk_toolbar_append_item(GTK_TOOLBAR(toolbar), NULL, NULL, NULL,
+ gtk_image_new_from_pixbuf(pixbuf),
+ GTK_SIGNAL_FUNC(toolbar_handler), (gpointer) index);
+ }
+ MakeReturn0Cci (pcci);
+}
+
+/* Create a separator toolbar item. */
+void EvalCcRqCREATETOOLBARSEPARATOR (CrossCallInfo *pcci)
+{
+ GtkWidget *toolbar;
+
+ printf("EvalCcRqCREATETOOLBARSEPARATOR\n");
+ if (pcci->p1 && (pcci->p1 != OS_NO_WINDOW_PTR))
+ {
+ toolbar = GTK_WIDGET(pcci->p1);
+ gtk_toolbar_append_space(GTK_TOOLBAR(toolbar));
+ }
+
+ MakeReturn0Cci (pcci);
+}
+
+/* Install the cross call procedures in the gCrossCallProcedureTable of cCrossCall_121.
+*/
+OS InstallCrossCallxDI (OS ios)
+{
+ CrossCallProcedureTable newTable;
+ printf("InstallCrossCallxDI\n");
+
+ newTable = EmptyCrossCallProcedureTable ();
+ AddCrossCallEntry (newTable, CcRqCREATESDIFRAMEWINDOW, EvalCcRqCREATESDIFRAMEWINDOW);
+ AddCrossCallEntry (newTable, CcRqCREATEMDIFRAMEWINDOW, EvalCcRqCREATEMDIFRAMEWINDOW);
+ AddCrossCallEntry (newTable, CcRqDESTROYWINDOW, EvalCcRqDESTROYWINDOW);
+ AddCrossCallEntry (newTable, CcRqGETWINDOWPOS, EvalCcRqGETWINDOWPOS);
+ AddCrossCallEntry (newTable, CcRqGETCLIENTSIZE, EvalCcRqGETCLIENTSIZE);
+ AddCrossCallEntry (newTable, CcRqCREATEMDITOOLBAR, EvalCcRqCREATEMDITOOLBAR);
+ AddCrossCallEntry (newTable, CcRqCREATESDITOOLBAR, EvalCcRqCREATESDITOOLBAR);
+ AddCrossCallEntry (newTable, CcRqCREATETOOLBARITEM, EvalCcRqCREATETOOLBARITEM);
+ AddCrossCallEntry (newTable, CcRqCREATETOOLBARSEPARATOR, EvalCcRqCREATETOOLBARSEPARATOR);
+ AddCrossCallEntries (gCrossCallProcedureTable, newTable);
+
+ return ios;
+}
+
+OS WinSetDoubleDownDist (int dd, OS ios)
+{
+ printf("WinSetDoubleDownDist --> Not Implemented\n");
+ return ios;
+}
diff --git a/Linux_C_12/cCrossCallxDI_121.h b/Linux_C_12/cCrossCallxDI_121.h new file mode 100644 index 0000000..fa75407 --- /dev/null +++ b/Linux_C_12/cCrossCallxDI_121.h @@ -0,0 +1,39 @@ +#include "util_121.h"
+
+
+/* Global data with external references: */
+extern OSWindowPtr ghTopDocWindow;
+extern int gComboSelection;
+extern BOOL gInMouseDown;
+extern BOOL gInKey;
+extern int gCurChar;
+
+/* Registered Windows class names:
+*/
+extern char SDIFrameClassName[]; /* Class for SDI frames. */
+extern char MDIFrameClassName[]; /* Class for MDI frames. */
+extern char SDIWindowClassName[]; /* Class for SDI windows (must have same length as MDIWindowClassName). */
+extern char MDIWindowClassName[]; /* Class for MDI windows (must have same length as SDIWindowClassName). */
+
+/* Managing the double down distance.
+*/
+extern OS WinSetDoubleDownDist (int dd, OS ios);
+
+/* Sending keyboard events to Clean thread:
+*/
+extern void SendKeyDownToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int c);
+extern void SendKeyStillDownToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int c);
+extern void SendKeyUpToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int c);
+
+/* Sending mouse events to Clean thread:
+*/
+extern void SendMouseUpToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int x, int y);
+extern void SendMouseStillDownToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int x, int y);
+extern void SendMouseStillUpToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int x, int y);
+extern void SendMouseDownToClean (OSWindowPtr hwndParent, OSWindowPtr hwndChild, int x, int y);
+
+/*
+ * InstallCrossCallxDI adds the proper cross call procedures to the
+ * cross call procedures managed by cCrossCall_121.c.
+ */
+extern OS InstallCrossCallxDI (OS ios);
diff --git a/Linux_C_12/cTCP_121.c b/Linux_C_12/cTCP_121.c new file mode 100644 index 0000000..e880b82 --- /dev/null +++ b/Linux_C_12/cTCP_121.c @@ -0,0 +1,781 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to printing.
+********************************************************************************************/
+//#define FD_SETSIZE "maximal number of sockets to select on" (default is 64)
+
+#include <winsock.h>
+#include "util_121.h"
+#include "Clean.h"
+#include "cTCP_121.h"
+#define trace(x)
+
+/*
+------------------------ THE FUNCTION PROTOTYPES ------------------------------------------
+
+Naming convention: functions, which are called from Clean end with a "C". Function's that
+*/
+
+//************************************************
+// functions, which are called from Clean (semantic is explained in tcp.icl or ostcp.icl)
+
+int os_eom(SOCKET endpointRef);
+int os_disconnected(SOCKET endpointRef);
+int os_connectrequestavailable(SOCKET endpointRef);
+void abortedHost_syncC(CleanString inetAddr, int *errCode, int *ipAddr);
+void abortedHost_asyncC(CleanString inetAddr, int *errCode, HANDLE *endpointRef);
+void openTCP_ListenerC(int portNum, int *pErrCode, SOCKET *pEndpointRef);
+void acceptC(SOCKET endpointRef, int *pErrCode, int *pInetHost, SOCKET *pEndpointRef);
+void os_connectTCPC(int isIOProg, int block, int doTimeout, unsigned int stopTime,
+ int ipAddr, int portnum,
+ int *errCode, int *timeoutExpiredP, int *endpointRefP
+ );
+void sendC(SOCKET endpointRef, CleanString data, int begin, int nBytes, int *pErrCode, int *pSentBytes);
+void receiveC(SOCKET endpointRef, int maxSize, CleanString *data);
+int getRcvBuffSizeC();
+void resizeStringC(CleanString string, int newSize);
+int data_availableC(SOCKET endpointRef);
+void disconnectGracefulC(SOCKET endpointRef);
+void disconnectBrutalC(SOCKET endpointRef);
+void garbageCollectEndpointC(SOCKET endpointRef);
+void os_select_inetevents(SOCKET endpointRef, int receiverCategory,
+ int referenceCount, int getReceiveEvents, int getSendEvents,
+ int aborted
+ );
+void selectChC(int justForMac, int nonBlocking, int doTimeout, unsigned int stopTime,
+ SOCKET *pRChannels, int *justForMac2, SOCKET *pSChannels,
+ int *pErrCode
+ );
+int tcpPossibleC(void);
+
+//************************************************
+// other functions
+
+void StartUp(int abort);
+ // initialize winsock (if not started yet. uses global "tcpStartedUp")
+ // if succesful: tcpStartedUp==TRUE afterwards
+ // if not succesful && abort: aborts
+ // if not succesful && !abort: tcpStartedUp==FALSE afterwards
+void CleanUp(void);
+
+//************************************************
+// functions to deal with the endpoint dictionary:
+
+int insertNewDictionaryItem(SOCKET endpointRef);
+ // allocates memory for new dictionary item, initializes it as far as possible and
+ // adds it to the dictionary. returns error code: 0==ok, 1==not ok
+dictitem* lookup(SOCKET endpointRef);
+ // lookup entry (CFN)
+void setEndpointDataC(int endpointRef, int referenceCount,
+ int hasReceiveNotifier, int hasSendableNotifier, int aborted);
+ // set the corresponding fields of the entry
+void getEndpointDataC(int endpointRef, int *referenceCount,
+ int *hasReceiveNotifier, int *hasSendableNotifier, int *aborted);
+ // returns the corresponding fields of the entry
+void removeDictionaryItem(SOCKET endpointRef);
+ // remove one item via pointer manipulations (must not be called from notifier)
+
+//--------------------- GLOBAL VARIABLES ------------------------------------------
+
+// The inetEventQueue: To append easily a new item to the end of the list, "toLastNext" points
+// to the "next" field of the last list element (or to &inetEventQueue)
+
+
+dictitem *endpointDict = NULL;
+
+int tcpStartedUp = FALSE;
+int rcvBuffSize; // contains the size of the sockets internal buffer for receiving data.
+CleanString pRcvBuff;
+
+extern DNSInfo *DNSInfoList;
+extern HWND ghMainWindow;
+extern void (*exit_tcpip_function)(); // the function will be called, when the Clean
+ // program terminates
+
+//--------------------- FUNCTION IMPLEMENTATION -----------------------------------
+
+int tcpPossibleC(void)
+{
+ printf("tcpPossibleC\n");
+ StartUp(FALSE);
+ return tcpStartedUp;
+}
+
+int os_eom(SOCKET endpointRef)
+{
+ int err, err2;
+ char dummyBuffer[1];
+ dictitem *pDictitem;
+ printf("os_eom\n");
+
+ err = recv( endpointRef, dummyBuffer, 1, MSG_PEEK);
+ err2 = WSAGetLastError();
+ if (err>0)
+ return FALSE;
+ if (err<0 && err2==WSAEWOULDBLOCK)
+ return FALSE;
+ pDictitem = lookup(endpointRef);
+ trace( if (!pDictitem)
+ rMessageBox(NULL, MB_APPLMODAL, "in os_eom", "ERROR");)
+ if (pDictitem->availByteValid)
+ return FALSE;
+ if (err==0)
+ return TRUE;
+ return TRUE;
+}
+
+int os_disconnected(SOCKET endpointRef)
+{
+ int err;
+ char string[1];
+ dictitem *pDictitem;
+ printf("os_disconnected\n");
+
+ pDictitem = lookup(endpointRef);
+ trace( if (!pDictitem)
+ rMessageBox(NULL, MB_APPLMODAL, "in os_disconnected", "ERROR");)
+ if (pDictitem->disconnected)
+ return TRUE;
+ err = send( endpointRef, string, 0, 0);
+ if (err!=SOCKET_ERROR)
+ return FALSE;
+ else
+ return WSAGetLastError()!=WSAEWOULDBLOCK;
+ // only this error can happen with sockets that can still send
+}
+
+int os_connectrequestavailable(SOCKET endpointRef)
+{
+ FD_SET readSet;
+ TIMEVAL timeout;
+ int nr;
+ printf("os_connectrequestavailable\n");
+
+ FD_ZERO(&readSet);
+ FD_SET(endpointRef,&readSet);
+
+ timeout.tv_sec = 0; // Timeout in sec's
+ timeout.tv_usec = 0; // Timeout in microsec's
+ nr = select(0,&readSet,NULL,NULL,&timeout);
+ return nr>0 && FD_ISSET(endpointRef,&readSet);
+}
+
+#define majorVrs 1
+#define minorVrs 1
+
+void StartUp(int abort)
+{
+ printf("StartUp\n");
+ if (!tcpStartedUp)
+ {
+ WORD wVersionRequested;
+ WSADATA wsaData;
+ int err, four=4;
+ SOCKET s;
+
+ wVersionRequested = MAKEWORD(majorVrs, minorVrs);
+ err = WSAStartup(wVersionRequested, &wsaData);
+ if (err != 0) {
+ if (abort) {
+ rMessageBox(NULL, MB_APPLMODAL, "ERROR", "can't start up winsock"
+ "\nprogram aborts");
+ ExitProcess (255);
+ }
+ else
+ return;
+ }
+
+ /* Confirm that the Windows Sockets DLL supports version mj.mi.*/
+ /* Note that if the DLL supports versions greater */
+ /* than mj.mi in addition to mj.mi, it will still return */
+ /* mj.mi in wVersion since that is the version we */
+ /* requested. */
+
+ if ( LOBYTE( wsaData.wVersion ) != majorVrs ||
+ HIBYTE( wsaData.wVersion ) != minorVrs ) {
+ WSACleanup();
+ if (abort) {
+ rMessageBox(NULL, MB_APPLMODAL, "ERROR", "winsock 1.1 or higher not available"
+ "\nprogram aborts");
+ ExitProcess (255);
+ }
+ else
+ return;
+ };
+
+ // initialize rcvBuffSize
+ s = socket(PF_INET, SOCK_STREAM, 0);
+ if (s==INVALID_SOCKET) {
+ rMessageBox(NULL, MB_APPLMODAL, "ERROR", "can't create a socket"
+ "\nprogram aborts");
+ ExitProcess (255);
+ };
+ if (getsockopt(s, SOL_SOCKET, SO_RCVBUF, (char*) &rcvBuffSize, &four)) {
+ rMessageBox(NULL, MB_APPLMODAL, "ERROR", "can't call getsockopt"
+ "\nprogram aborts");
+ ExitProcess (255);
+ };
+
+ pRcvBuff = (CleanString) LocalAlloc(LMEM_FIXED, rcvBuffSize+4);
+ if (pRcvBuff==NULL) {
+ rMessageBox(NULL, MB_APPLMODAL, "ERROR", "out of memory"
+ "\nprogram aborts");
+ ExitProcess (255);
+ };
+ exit_tcpip_function = CleanUp;
+ tcpStartedUp = TRUE;
+ };
+}
+
+
+void lookupHost_syncC(CleanString inetAddr, int *errCode, int *ipAddrP)
+// error code: 0 ok, 1 error (also: addr doesn't exist)
+{
+ HOSTENT *hostentP;
+ unsigned long ipAddr;
+ printf("lookupHost_syncC\n");
+
+ StartUp(TRUE);
+ ipAddr = inet_addr(CleanStringCharacters(inetAddr));
+ if (ipAddr!=INADDR_NONE)
+ {
+ *errCode = 0;
+ *ipAddrP = ntohl(ipAddr);
+ return;
+ };
+ *errCode = 1;
+ hostentP = gethostbyname(CleanStringCharacters(inetAddr)); // string is alphanumerical
+ if (hostentP!=NULL)
+ { *ipAddrP = ntohl(((DWORD *)(*(hostentP->h_addr_list)))[0]);
+ if (*ipAddrP!=0)
+ *errCode = 0;
+ };
+}
+
+void lookupHost_asyncC(CleanString inetAddr, int *errCode, HANDLE *endpointRef)
+// errCode: 0 ok, 1 not ok
+{
+ DNSInfo *newPtr;
+ HANDLE dnsHdl;
+ printf("lookupHost_asyncC\n");
+
+ StartUp(TRUE);
+
+ *errCode = 1;
+ newPtr = (DNSInfo*) LocalAlloc(LMEM_FIXED,sizeof(DNSInfo));
+ if (newPtr==NULL) {
+ *errCode = 1;
+ return;
+ };
+
+ newPtr->next = DNSInfoList;
+ DNSInfoList = newPtr;
+
+ // and fill the fields and initiate DNS lookup.
+ dnsHdl = WSAAsyncGetHostByName(ghMainWindow,PM_DNS_EVENT,CleanStringCharacters(inetAddr),
+ DNSInfoList->junion.freeSpace,
+ MAXGETHOSTSTRUCT);
+ // this will cause the sending of a PM_DNS_EVENT message to the main window.
+ // The wParam value of that message will be equal to dnsHdl so that
+ // the ipAdress of the lookedup host can be retrieved then.
+ // The element of the List should be deallocated then
+ if (dnsHdl==0)
+ return;
+
+ DNSInfoList->dnsHdl = dnsHdl;
+ *errCode = 0;
+ *endpointRef = dnsHdl;
+}
+
+void openTCP_ListenerC(int portNum, int *pErrCode, SOCKET *pEndpointRef)
+// errCode: 0:ok; otherwise:not ok
+{
+ SOCKET s;
+ SOCKADDR_IN srvAdr;
+ printf("openTCP_ListenerC\n");
+
+ StartUp(TRUE);
+
+ *pErrCode = 1;
+
+ s = socket(PF_INET, SOCK_STREAM, 0);
+ if (s==INVALID_SOCKET)
+ return;
+
+ srvAdr.sin_family = AF_INET; // of course internet adress family
+ srvAdr.sin_addr.s_addr = INADDR_ANY; // internet address will be given after "accept"
+ srvAdr.sin_port = htons((short int)portNum);
+
+ *pErrCode = bind(s, (LPSOCKADDR) &srvAdr, sizeof(srvAdr));
+ if (*pErrCode) {
+ closesocket(s);
+ return;
+ };
+
+ *pErrCode = listen(s,5);
+ if (*pErrCode) {
+ closesocket(s);
+ return;
+ };
+ *pEndpointRef = s;
+
+ *pErrCode = insertNewDictionaryItem(s);
+ if (*pErrCode)
+ return;
+
+ setEndpointDataC(s, 1,0,0,0);
+}
+
+void acceptC(SOCKET listener, int *pErrCode, int *pInetHost, SOCKET *pEndpointRef)
+// errCode: 0:ok; otherwise:not ok
+{
+ SOCKET endpointRef;
+ SOCKADDR_IN clientAdr;
+ int clientAdrSize, tru;
+ printf("acceptC\n");
+
+ clientAdrSize = sizeof(clientAdr);
+ endpointRef = accept(listener,(LPSOCKADDR) &clientAdr, &clientAdrSize);
+ tru = TRUE;
+ ioctlsocket(endpointRef, FIONBIO, &tru); // set mode to non blocking
+ *pErrCode = endpointRef==INVALID_SOCKET;
+ if (*pErrCode)
+ return;
+
+ *pInetHost = ntohl(clientAdr.sin_addr.s_addr);
+ *pEndpointRef = endpointRef;
+
+ *pErrCode = insertNewDictionaryItem(endpointRef);
+ if (*pErrCode)
+ return;
+
+ setEndpointDataC(endpointRef,2,0,0,0);
+}
+
+void os_connectTCPC(int onlyForMac, int block, int doTimeout, unsigned int stopTime,
+ int ipAddr, int portnum,
+ int *errCodeP, int *timeoutExpiredP, int *endpointRefP)
+// errCode: 0 ok; 1 not ok
+{
+ SOCKET client;
+ SOCKADDR_IN srvAdr,clientAdr;
+ int err, tru;
+ printf("os_connectTCPC\n");
+
+ *errCodeP = 1;
+ *timeoutExpiredP = FALSE;
+
+ client = socket(PF_INET, SOCK_STREAM, 0);
+ if (client==INVALID_SOCKET)
+ return;
+
+ clientAdr.sin_family = AF_INET; // of course internet adress family
+ clientAdr.sin_addr.s_addr = INADDR_ANY; // internet adress will be given after "connect"
+ clientAdr.sin_port = 0; // the winsock library will choose a free number between 1024 and 5000
+
+ err = bind(client, (LPSOCKADDR) &clientAdr, sizeof(clientAdr));
+ if (err)
+ {
+ closesocket(client);
+ return;
+ };
+
+ srvAdr.sin_family = AF_INET; // of course internet adress family
+ srvAdr.sin_addr.s_addr = htonl(ipAddr);
+ srvAdr.sin_port = htons((short int)portnum);
+
+ tru = TRUE;
+
+ //////////////////////////////////////////////////////////////////////////
+ if (block && doTimeout)
+ {
+ ioctlsocket(client, FIONBIO, &tru); // set mode to non blocking
+ err = connect(client, (LPSOCKADDR) &srvAdr, sizeof(srvAdr));
+ if (!err) {
+ *errCodeP = 0;
+ *timeoutExpiredP = FALSE;
+ *endpointRefP = client;
+ }
+ else if (WSAGetLastError()!=WSAEWOULDBLOCK) {
+ closesocket(client);
+ return;
+ }
+ else
+ {
+ FD_SET writeSet, exptnSet;
+ TIMEVAL timeout;
+ unsigned int now;
+ int noOfWritableSockets, timeoutTicks;
+ FD_ZERO(&writeSet);
+ FD_SET(client,&writeSet);
+ FD_ZERO(&exptnSet);
+ FD_SET(client,&exptnSet);
+
+ now = GetTickCount();
+ timeoutTicks = ((int)stopTime) - ((int)now);
+ if (timeoutTicks<=0)
+ { // timeout expired
+ closesocket(client);
+ *timeoutExpiredP = TRUE;
+ return;
+ };
+ timeout.tv_sec = timeoutTicks / 1000; // Timeout in sec's
+ timeout.tv_usec = (timeoutTicks % 1000)*1000; // Timeout in microsec's
+ noOfWritableSockets = select(0,NULL,&writeSet,&exptnSet,&timeout);
+ *errCodeP = noOfWritableSockets<0
+ || (noOfWritableSockets>0 && FD_ISSET(client,&exptnSet));
+ *timeoutExpiredP = noOfWritableSockets==0;
+ *endpointRefP = client;
+ if (*errCodeP || *timeoutExpiredP) {
+ closesocket(client);
+ return;
+ };
+ };
+ };
+ ///////////////////////////////////////////////////////////////////////////
+ if (block && !doTimeout)
+ {
+ err = connect(client, (LPSOCKADDR) &srvAdr, sizeof(srvAdr));
+ if (err)
+ {
+ closesocket(client);
+ return;
+ };
+
+ ioctlsocket(client, FIONBIO, &tru); // set mode to non blocking
+
+ *errCodeP = 0;
+ *timeoutExpiredP = FALSE;
+ *endpointRefP = client;
+ };
+ ////////////////////////////////////////////////////////////////////////////
+ if (!block)
+ {
+
+ err = WSAAsyncSelect(client,ghMainWindow,PM_SOCKET_EVENT,FD_CONNECT);
+ if (err)
+ {
+ closesocket(client);
+ return;
+ };
+
+ err = connect(client, (LPSOCKADDR) &srvAdr, sizeof(srvAdr));
+ if (err==SOCKET_ERROR)
+ {
+ err = WSAGetLastError(); // a WSAEWOULDBLOCK error is a pretty harmless thing
+ if (err!=WSAEWOULDBLOCK)
+ {
+ closesocket(client);
+ return;
+ };
+ };
+ *errCodeP = 0;
+ *timeoutExpiredP = FALSE;
+ *endpointRefP = client;
+ };
+ //////////////////////////////////////////////////////////////////////////////
+
+ *errCodeP = insertNewDictionaryItem(client);
+ if (*errCodeP)
+ {
+ closesocket(client);
+ return;
+ };
+ if (block)
+ setEndpointDataC(client,2,0,0,0);
+ else
+ {
+ dictitem *ptr;
+ ptr = lookup(client);
+ ptr->referenceCount = 1;
+ ptr->hasReceiveNotifier = 0;
+ ptr->hasSendableNotifier = 1;
+ ptr->aborted = 0;
+ };
+}
+
+void sendC(SOCKET endpointRef, CleanString data, int begin, int nBytes,
+ int *pErrCode, int *pSentBytes)
+{
+ int sentBytes;
+ printf("sendC\n");
+
+ *pErrCode = 0;
+ sentBytes = send(endpointRef, CleanStringCharacters(data)+begin,nBytes, 0);
+ if (sentBytes==SOCKET_ERROR) {
+ int err;
+ sentBytes = 0;
+ err = WSAGetLastError();
+ if (err!=WSAEWOULDBLOCK) {
+ dictitem *pDictitem;
+ pDictitem = lookup(endpointRef);
+ trace( if (!pDictitem)
+ rMessageBox(NULL, MB_APPLMODAL, "in sendC", "ERROR");)
+ pDictitem->disconnected =1;
+ *pErrCode = 1;
+ }
+ };
+ *pSentBytes = sentBytes;
+}
+
+
+void receiveC(SOCKET endpointRef, int maxSize, CleanString *pReceived)
+{
+ int size, received;
+ dictitem *pDictitem;
+ printf("receiveC\n");
+
+ *pReceived = (CleanString) pRcvBuff;
+ size = maxSize<=0 ? rcvBuffSize : maxSize;
+ received = recv( endpointRef, CleanStringCharacters(pRcvBuff), size, 0);
+ pDictitem = lookup(endpointRef);
+ trace( if (!pDictitem)
+ rMessageBox(NULL, MB_APPLMODAL, "in receiveC", "ERROR");)
+ if (received>0) {
+ pDictitem->availByteValid = 0;
+ CleanStringLength(pRcvBuff) = received;
+ }
+ else if (pDictitem->availByteValid) {
+ CleanStringCharacters(pRcvBuff)[0] = pDictitem->availByte;
+ pDictitem->availByteValid = 0;
+ CleanStringLength(pRcvBuff) = 1;
+ }
+ else
+ CleanStringLength(pRcvBuff) = 0;
+}
+
+int data_availableC(SOCKET endpointRef)
+{
+ dictitem *pDictitem;
+ int err;
+ printf("data_availableC\n");
+
+ pDictitem = lookup(endpointRef);
+ trace( if (!pDictitem)
+ rMessageBox(NULL, MB_APPLMODAL, "in data_availableC",
+ "ERROR\nendpoint %i not found", endpointRef);)
+ if (pDictitem->availByteValid)
+ return TRUE;
+ err = recv( endpointRef, &pDictitem->availByte, 1, MSG_PEEK);
+ if (err>0) {
+ pDictitem->availByteValid = 1;
+ return TRUE;
+ };
+ return FALSE;
+}
+
+void disconnectGracefulC(SOCKET endpointRef)
+{
+ printf("disconnecteGracefulC\n");
+ shutdown(endpointRef,1); // 1: graceful
+}
+
+void disconnectBrutalC(SOCKET endpointRef)
+{
+ LINGER linger;
+ printf("disconnectBrutalC\n");
+
+ linger.l_onoff = 1;
+ linger.l_linger = 0;
+ setsockopt(endpointRef, SOL_SOCKET, SO_LINGER, (char*) &linger, sizeof(linger));
+}
+
+void garbageCollectEndpointC(SOCKET endpointRef)
+{
+ dictitem *pDictitem;
+ printf("garbageCollectEndpointC\n");
+
+ pDictitem = lookup(endpointRef);
+ if (pDictitem!=NULL && pDictitem->referenceCount==0) {
+ closesocket(endpointRef);
+ removeDictionaryItem(endpointRef);
+ };
+}
+
+
+void os_select_inetevents( SOCKET endpointRef, int receiverCategory,
+ int referenceCount, int getReceiveEvents, int getSendEvents,
+ int aborted)
+{
+ printf("os_select_inetevents\n");
+ setEndpointDataC(endpointRef, referenceCount, getReceiveEvents, getSendEvents, aborted);
+}
+
+void initFD_SET(FD_SET **ppSet, SOCKET sockets[], int n)
+{
+ int i;
+ FD_SET *pSet;
+ printf("initFD_SET\n");
+
+ pSet = (FD_SET*) LocalAlloc(LMEM_FIXED | LMEM_ZEROINIT, n*sizeof(SOCKET)+sizeof(u_int));
+ for(i=0; i<n; i++)
+ FD_SET(sockets[i], pSet);
+ *ppSet = pSet;
+}
+
+void selectChC( int justForMac, int nonBlocking, int doTimeout, unsigned int stopTime,
+ SOCKET *pRChannels, int *justForMac2, SOCKET *pSChannels,
+ int *pErrCode)
+// error code: 0=ok; 1=timeout expired, 3=other errors
+{
+ int nRChannels, nSChannels, i;
+ FD_SET *pReadSet, *pWriteSet;
+ TIMEVAL timeout;
+ unsigned int now;
+ int n, timeoutTicks;
+ printf("selectChC\n");
+
+ nRChannels = (int) pRChannels[-2];
+ nSChannels = (int) pSChannels[-2];
+ if (doTimeout)
+ {
+ now = GetTickCount();
+ timeoutTicks = nonBlocking ? 0 : ((int)stopTime) - ((int)now);
+ if (timeoutTicks<0)
+ {
+ *pErrCode = 1;
+ return;
+ };
+ timeout.tv_sec = timeoutTicks / 1000; // Timeout in sec's
+ timeout.tv_usec = (timeoutTicks % 1000)*1000; // Timeout in microsec's
+ };
+ initFD_SET(&pReadSet, pRChannels, nRChannels);
+ initFD_SET(&pWriteSet, pSChannels, nSChannels);
+ n = select(0,pReadSet,pWriteSet,NULL, doTimeout ? &timeout : NULL);
+ if (n==0)
+ { // timeout expired
+ *pErrCode = 1;
+ return;
+ };
+ if (n<0)
+ {
+ *pErrCode = 3;
+ return;
+ };
+ for(i=0; i<nRChannels; i++)
+ if (FD_ISSET(pRChannels[i], pReadSet))
+ pRChannels[i] = 0;
+ for(i=0; i<nSChannels; i++)
+ if (FD_ISSET(pSChannels[i], pWriteSet))
+ pSChannels[i] = 0;
+ *pErrCode = 0;
+}
+
+// this function is called from Cleans runtime system via *exit_tcpip_function
+void CleanUp(void)
+{
+ dictitem *pDictitem, *pTemp;
+ int referenceCount;
+ pDictitem = endpointDict;
+ printf("CleanUp\n");
+
+ while (pDictitem) {
+ referenceCount = pDictitem->referenceCount;
+ if (referenceCount!=0) {
+ if (referenceCount==1 && pDictitem->aborted) {
+ disconnectBrutalC(pDictitem->endpointRef);
+ }
+ else
+ disconnectGracefulC(pDictitem->endpointRef);
+ closesocket(pDictitem->endpointRef);
+ };
+ pTemp = pDictitem;
+ pDictitem = pDictitem->next;
+ GlobalFree((char*) pTemp);
+ };
+ WSACleanup();
+}
+
+
+//------------------------ FUNCTION IMPLEMENTATIONS FOR THE ENDPOINT DICTIONARY -------
+
+int insertNewDictionaryItem(SOCKET endpointRef)
+{
+ dictitem *newItem;
+ printf("insertNewDictionaryItem\n");
+
+ newItem = (dictitem*) GlobalAlloc(LMEM_FIXED, sizeof(dictitem));
+ if (newItem==NULL)
+ return 1;
+
+ newItem->endpointRef = endpointRef;
+ newItem->next = endpointDict;
+ newItem->availByteValid = 0;
+ newItem->aborted = 0;
+ newItem->disconnected = 0;
+ endpointDict = newItem;
+
+ return 0;
+}
+
+dictitem* lookup(SOCKET endpointRef)
+{
+ dictitem *ptr=endpointDict;
+ printf("lookup\n");
+ while (ptr!=NULL && (ptr->endpointRef!=endpointRef))
+ ptr = ptr->next;
+
+ return ptr;
+}
+
+void setEndpointDataC( int endpointRef, int referenceCount,
+ int hasReceiveNotifier, int hasSendableNotifier, int aborted)
+{
+ dictitem *ptr;
+ printf("setEndpointDataC\n");
+ ptr = lookup((SOCKET) endpointRef);
+
+ if (ptr!=NULL)
+ { ptr->referenceCount = referenceCount;
+ ptr->hasReceiveNotifier = hasReceiveNotifier ? 1 : 0;
+ ptr->hasSendableNotifier = hasSendableNotifier ? 1 : 0;
+ ptr->aborted = aborted ? 1 : 0;
+ };
+ WSAAsyncSelect(endpointRef, ghMainWindow, PM_SOCKET_EVENT,
+ (hasReceiveNotifier ? FD_READ | FD_OOB | FD_ACCEPT | FD_CLOSE : 0)
+ | (hasSendableNotifier ? FD_WRITE | FD_CLOSE : 0));
+}
+
+
+void getEndpointDataC( int endpointRef, int *referenceCount,
+ int *hasReceiveNotifier, int *hasSendableNotifier, int *aborted)
+{
+ dictitem *ptr;
+ printf("getEndpointDataC\n");
+ ptr = lookup((SOCKET) endpointRef);
+
+ if (ptr!=NULL)
+ { *referenceCount = ptr->referenceCount;
+ *hasReceiveNotifier = ptr->hasReceiveNotifier!=0;
+ *hasSendableNotifier = ptr->hasSendableNotifier!=0;
+ *aborted = ptr->aborted!=0;
+ };
+}
+
+
+void removeDictionaryItem(SOCKET endpointRef)
+// the dictionary MUST contain a valid item with the endpointRef
+{
+ dictitem **ptr, *temp;
+ int notRemoved;
+ printf("removeDictionaryItem\n");
+
+ ptr = &endpointDict;
+ notRemoved = TRUE;
+ while(notRemoved)
+ if ((*ptr)->endpointRef==endpointRef)
+ {
+ temp = *ptr;
+ *ptr = (*ptr)->next;
+ GlobalFree((char*) temp);
+ notRemoved = FALSE;
+ }
+ else
+ ptr = &((*ptr)->next);
+}
diff --git a/Linux_C_12/cTCP_121.h b/Linux_C_12/cTCP_121.h new file mode 100644 index 0000000..0707781 --- /dev/null +++ b/Linux_C_12/cTCP_121.h @@ -0,0 +1,59 @@ +#ifndef __CTCP__
+#define __CTCP__
+
+#if defined(mingw32_TARGET_OS)
+#include <winsock.h>
+
+typedef int DNSHdl;
+
+struct DNSInfo
+ { struct DNSInfo *next;
+ HANDLE dnsHdl;
+ union { struct hostent Hostent;
+ char freeSpace[MAXGETHOSTSTRUCT];
+ }
+ junion;
+ };
+typedef struct DNSInfo DNSInfo;
+
+/* the dictionary items */
+struct dictitem
+ { SOCKET endpointRef;
+ struct dictitem *next;
+ char availByte;
+ unsigned availByteValid : 1;
+ unsigned referenceCount : 2;
+ unsigned hasReceiveNotifier : 1;
+ /*
+ * three kinds of receivers: receivers for established connections,
+ * receivers for dns requests, receivers for asynchronous connect
+ */
+ unsigned hasSendableNotifier : 1;
+ unsigned aborted : 1;
+ unsigned disconnected : 1;
+ };
+typedef struct dictitem dictitem;
+
+#define IE_CONNECTREQUEST 0x0001
+#define IE_RECEIVED 0x0004
+#define IE_EOM 0x0010
+#define IE_SENDABLE 0x0100
+#define IE_DISCONNECTED 0x0011
+#define IE_IPADDRESSFOUND 0x2000000F
+#define IE_IPADDRESSNOTFOUND 0x20000010
+#define IE_ASYNCCONNECTCOMPLETE 0x0002
+#define IE_ASYNCCONNECTFAILED 0x0003
+
+#define ListenerReceiver 0
+#define RChanReceiver 1
+#define SChanReceiver 2
+#define DNSReceiver 3
+#define ConnectReceiver 4
+
+/* PA: InitSockets has no definition.
+void InitSockets();
+*/
+extern dictitem* lookup(SOCKET endpointRef);
+#endif
+
+#endif
diff --git a/Linux_C_12/cdebug_121.c b/Linux_C_12/cdebug_121.c new file mode 100644 index 0000000..9b4a438 --- /dev/null +++ b/Linux_C_12/cdebug_121.c @@ -0,0 +1,39 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines useful for debugging.
+********************************************************************************************/
+#include "cdebug_121.h"
+#include "time.h"
+
+int Rand (void)
+{
+ static int holdrand;
+ static int randinited = 0;
+ printf("Rand\n");
+
+ if (!randinited)
+ {
+ holdrand = (int) 0; //GetTickCount ();
+ randinited = -1;
+ }
+
+ holdrand = holdrand * 214013 + 2531011;
+
+ return ((holdrand >> 16) & 0x7fff);
+}
+
+OS ConsolePrint (CLEAN_STRING cleanstr, OS os)
+{
+ char *cstr;
+ printf("ConsolePrint\n");
+
+ cstr = cstring (cleanstr);
+ rprintf (cstr);
+ return os;
+}
diff --git a/Linux_C_12/cdebug_121.h b/Linux_C_12/cdebug_121.h new file mode 100644 index 0000000..f8b830f --- /dev/null +++ b/Linux_C_12/cdebug_121.h @@ -0,0 +1,5 @@ +#include "util_121.h"
+#include "clean_types.h"
+
+extern int Rand (void);
+extern OS ConsolePrint (CLEAN_STRING,OS);
diff --git a/Linux_C_12/clean_types.h b/Linux_C_12/clean_types.h new file mode 100644 index 0000000..d4e9b93 --- /dev/null +++ b/Linux_C_12/clean_types.h @@ -0,0 +1,37 @@ +# undef DEBUG
+#include <stdio.h>
+#if 0
+typedef struct clean_string
+{
+ int length;
+#ifdef SOLARIS
+ char characters[4];
+#else
+ char characters[0];
+#endif
+} *CLEAN_STRING;
+#endif
+
+typedef struct clean_file
+{
+ int number;
+ int position;
+} CLEAN_FILE;
+
+struct file {
+ FILE *file;
+ unsigned long position;
+ unsigned long file_length;
+ char *file_name;
+ long file_number;
+ int device_number;
+ short mode;
+ short filler_1;
+ long filler_2;
+};
+
+#define CLOSED_FILE 0
+#define READ_FILE 1
+#define WRITE_FILE 2
+
+extern struct file file_table[];
diff --git a/Linux_C_12/config.h b/Linux_C_12/config.h new file mode 100644 index 0000000..57baec8 --- /dev/null +++ b/Linux_C_12/config.h @@ -0,0 +1,1080 @@ +/* mk/config.h. Generated automatically by configure. */
+/* mk/config.h.in. Generated automatically from configure.in by autoheader. */
+/* acconfig.h
+
+ Descriptive text for the C preprocessor macros that
+ the fptools configuration script can define.
+ The current version may not use all of them; autoheader copies the ones
+ your configure.in uses into your configuration header file templates.
+
+ The entries are in sort -df order: alphabetical, case insensitive,
+ ignoring punctuation (such as underscores). Although this order
+ can split up related entries, it makes it easier to check whether
+ a given entry is in the file.
+
+ Leave the following blank line there!! Autoheader needs it. */
+
+
+
+
+/* Define to alignment constraint on chars */
+#define ALIGNMENT_CHAR 1
+
+/* Define to alignment constraint on doubles */
+#define ALIGNMENT_DOUBLE 4
+
+/* Define to alignment constraint on floats */
+#define ALIGNMENT_FLOAT 4
+
+/* Define to alignment constraint on ints */
+#define ALIGNMENT_INT 4
+
+/* Define to alignment constraint on longs */
+#define ALIGNMENT_LONG 4
+
+/* Define to alignment constraint on long longs */
+#define ALIGNMENT_LONG_LONG 4
+
+/* Define to alignment constraint on shorts */
+#define ALIGNMENT_SHORT 2
+
+/* Define to alignment constraint on unsigned chars */
+#define ALIGNMENT_UNSIGNED_CHAR 1
+
+/* Define to alignment constraint on unsigned ints */
+#define ALIGNMENT_UNSIGNED_INT 4
+
+/* Define to alignment constraint on unsigned longs */
+#define ALIGNMENT_UNSIGNED_LONG 4
+
+/* Define to alignment constraint on unsigned long longs */
+#define ALIGNMENT_UNSIGNED_LONG_LONG 4
+
+/* Define to alignment constraint on unsigned shorts */
+#define ALIGNMENT_UNSIGNED_SHORT 2
+
+/* Define to alignment constraint on void pointers */
+#define ALIGNMENT_VOID_P 4
+
+/* The value of E2BIG. */
+#define CCONST_E2BIG 7
+
+/* The value of EACCES. */
+#define CCONST_EACCES 13
+
+/* The value of EADDRINUSE. */
+#define CCONST_EADDRINUSE 98
+
+/* The value of EADDRNOTAVAIL. */
+#define CCONST_EADDRNOTAVAIL 99
+
+/* The value of EADV. */
+#define CCONST_EADV 68
+
+/* The value of EAFNOSUPPORT. */
+#define CCONST_EAFNOSUPPORT 97
+
+/* The value of EAGAIN. */
+#define CCONST_EAGAIN 11
+
+/* The value of EALREADY. */
+#define CCONST_EALREADY 114
+
+/* The value of EBADF. */
+#define CCONST_EBADF 9
+
+/* The value of EBADMSG. */
+#define CCONST_EBADMSG 74
+
+/* The value of EBADRPC. */
+#define CCONST_EBADRPC -1
+
+/* The value of EBUSY. */
+#define CCONST_EBUSY 16
+
+/* The value of ECHILD. */
+#define CCONST_ECHILD 10
+
+/* The value of ECOMM. */
+#define CCONST_ECOMM 70
+
+/* The value of ECONNABORTED. */
+#define CCONST_ECONNABORTED 103
+
+/* The value of ECONNREFUSED. */
+#define CCONST_ECONNREFUSED 111
+
+/* The value of ECONNRESET. */
+#define CCONST_ECONNRESET 104
+
+/* The value of EDEADLK. */
+#define CCONST_EDEADLK 35
+
+/* The value of EDESTADDRREQ. */
+#define CCONST_EDESTADDRREQ 89
+
+/* The value of EDIRTY. */
+#define CCONST_EDIRTY -1
+
+/* The value of EDOM. */
+#define CCONST_EDOM 33
+
+/* The value of EDQUOT. */
+#define CCONST_EDQUOT 122
+
+/* The value of EEXIST. */
+#define CCONST_EEXIST 17
+
+/* The value of EFAULT. */
+#define CCONST_EFAULT 14
+
+/* The value of EFBIG. */
+#define CCONST_EFBIG 27
+
+/* The value of EFTYPE. */
+#define CCONST_EFTYPE -1
+
+/* The value of EHOSTDOWN. */
+#define CCONST_EHOSTDOWN 112
+
+/* The value of EHOSTUNREACH. */
+#define CCONST_EHOSTUNREACH 113
+
+/* The value of EIDRM. */
+#define CCONST_EIDRM 43
+
+/* The value of EILSEQ. */
+#define CCONST_EILSEQ 84
+
+/* The value of EINPROGRESS. */
+#define CCONST_EINPROGRESS 115
+
+/* The value of EINTR. */
+#define CCONST_EINTR 4
+
+/* The value of EINVAL. */
+#define CCONST_EINVAL 22
+
+/* The value of EIO. */
+#define CCONST_EIO 5
+
+/* The value of EISCONN. */
+#define CCONST_EISCONN 106
+
+/* The value of EISDIR. */
+#define CCONST_EISDIR 21
+
+/* The value of ELOOP. */
+#define CCONST_ELOOP 40
+
+/* The value of EMFILE. */
+#define CCONST_EMFILE 24
+
+/* The value of EMLINK. */
+#define CCONST_EMLINK 31
+
+/* The value of EMSGSIZE. */
+#define CCONST_EMSGSIZE 90
+
+/* The value of EMULTIHOP. */
+#define CCONST_EMULTIHOP 72
+
+/* The value of ENAMETOOLONG. */
+#define CCONST_ENAMETOOLONG 36
+
+/* The value of ENETDOWN. */
+#define CCONST_ENETDOWN 100
+
+/* The value of ENETRESET. */
+#define CCONST_ENETRESET 102
+
+/* The value of ENETUNREACH. */
+#define CCONST_ENETUNREACH 101
+
+/* The value of ENFILE. */
+#define CCONST_ENFILE 23
+
+/* The value of ENOBUFS. */
+#define CCONST_ENOBUFS 105
+
+/* The value of ENODATA. */
+#define CCONST_ENODATA 61
+
+/* The value of ENODEV. */
+#define CCONST_ENODEV 19
+
+/* The value of ENOENT. */
+#define CCONST_ENOENT 2
+
+/* The value of ENOEXEC. */
+#define CCONST_ENOEXEC 8
+
+/* The value of ENOLCK. */
+#define CCONST_ENOLCK 37
+
+/* The value of ENOLINK. */
+#define CCONST_ENOLINK 67
+
+/* The value of ENOMEM. */
+#define CCONST_ENOMEM 12
+
+/* The value of ENOMSG. */
+#define CCONST_ENOMSG 42
+
+/* The value of ENONET. */
+#define CCONST_ENONET 64
+
+/* The value of ENOPROTOOPT. */
+#define CCONST_ENOPROTOOPT 92
+
+/* The value of ENOSPC. */
+#define CCONST_ENOSPC 28
+
+/* The value of ENOSR. */
+#define CCONST_ENOSR 63
+
+/* The value of ENOSTR. */
+#define CCONST_ENOSTR 60
+
+/* The value of ENOSYS. */
+#define CCONST_ENOSYS 38
+
+/* The value of ENOTBLK. */
+#define CCONST_ENOTBLK 15
+
+/* The value of ENOTCONN. */
+#define CCONST_ENOTCONN 107
+
+/* The value of ENOTDIR. */
+#define CCONST_ENOTDIR 20
+
+/* The value of ENOTEMPTY. */
+#define CCONST_ENOTEMPTY 39
+
+/* The value of ENOTSOCK. */
+#define CCONST_ENOTSOCK 88
+
+/* The value of ENOTTY. */
+#define CCONST_ENOTTY 25
+
+/* The value of ENXIO. */
+#define CCONST_ENXIO 6
+
+/* The value of EOPNOTSUPP. */
+#define CCONST_EOPNOTSUPP 95
+
+/* The value of EPERM. */
+#define CCONST_EPERM 1
+
+/* The value of EPFNOSUPPORT. */
+#define CCONST_EPFNOSUPPORT 96
+
+/* The value of EPIPE. */
+#define CCONST_EPIPE 32
+
+/* The value of EPROCLIM. */
+#define CCONST_EPROCLIM -1
+
+/* The value of EPROCUNAVAIL. */
+#define CCONST_EPROCUNAVAIL -1
+
+/* The value of EPROGMISMATCH. */
+#define CCONST_EPROGMISMATCH -1
+
+/* The value of EPROGUNAVAIL. */
+#define CCONST_EPROGUNAVAIL -1
+
+/* The value of EPROTO. */
+#define CCONST_EPROTO 71
+
+/* The value of EPROTONOSUPPORT. */
+#define CCONST_EPROTONOSUPPORT 93
+
+/* The value of EPROTOTYPE. */
+#define CCONST_EPROTOTYPE 91
+
+/* The value of ERANGE. */
+#define CCONST_ERANGE 34
+
+/* The value of EREMCHG. */
+#define CCONST_EREMCHG 78
+
+/* The value of EREMOTE. */
+#define CCONST_EREMOTE 66
+
+/* The value of EROFS. */
+#define CCONST_EROFS 30
+
+/* The value of ERPCMISMATCH. */
+#define CCONST_ERPCMISMATCH -1
+
+/* The value of ERREMOTE. */
+#define CCONST_ERREMOTE -1
+
+/* The value of ESHUTDOWN. */
+#define CCONST_ESHUTDOWN 108
+
+/* The value of ESOCKTNOSUPPORT. */
+#define CCONST_ESOCKTNOSUPPORT 94
+
+/* The value of ESPIPE. */
+#define CCONST_ESPIPE 29
+
+/* The value of ESRCH. */
+#define CCONST_ESRCH 3
+
+/* The value of ESRMNT. */
+#define CCONST_ESRMNT 69
+
+/* The value of ESTALE. */
+#define CCONST_ESTALE 116
+
+/* The value of ETIME. */
+#define CCONST_ETIME 62
+
+/* The value of ETIMEDOUT. */
+#define CCONST_ETIMEDOUT 110
+
+/* The value of ETOOMANYREFS. */
+#define CCONST_ETOOMANYREFS 109
+
+/* The value of ETXTBSY. */
+#define CCONST_ETXTBSY 26
+
+/* The value of EUSERS. */
+#define CCONST_EUSERS 87
+
+/* The value of EWOULDBLOCK. */
+#define CCONST_EWOULDBLOCK 11
+
+/* The value of EXDEV. */
+#define CCONST_EXDEV 18
+
+/* Define if time.h or sys/time.h define the altzone variable */
+/* #undef HAVE_ALTZONE */
+
+/* Define if you have /bin/sh */
+#define HAVE_BIN_SH 1
+
+/* Define if the HaskellSupport.framework is installed (Mac OS X only) */
+/* #undef HAVE_FRAMEWORK_HASKELLSUPPORT */
+
+/* Define if gcc supports -mno-omit-leaf-frame-pointer */
+#define HAVE_GCC_MNO_OMIT_LFPTR 1
+
+/* Define if you have the GetModuleFileName function. */
+/* #undef HAVE_GETMODULEFILENAME */
+
+/* Define if in_addr_t is available */
+#define HAVE_IN_ADDR_T 1
+
+/* Define if you need -ldl to get dlopen() */
+#define HAVE_LIBDL 1
+
+/* Define if you have the mingwex library. */
+/* #undef HAVE_MINGWEX */
+
+/* Define if struct msghdr contains msg_accrights field */
+/* #undef HAVE_MSGHDR_MSG_ACCRIGHTS */
+
+/* Define if struct msghdr contains msg_control field */
+#define HAVE_MSGHDR_MSG_CONTROL 1
+
+/* Define if RTLD_GLOBAL is available */
+#define HAVE_RTLDGLOBAL 1
+
+/* Define if RTLD_LOCAL is available */
+#define HAVE_RTLDLOCAL 1
+
+/* Define if we can see RTLD_NEXT in dlfcn.h */
+/* #undef HAVE_RTLDNEXT */
+
+/* Define if we can see RTLD_NOW in dlfcn.h */
+#define HAVE_RTLDNOW 1
+
+/* Define if usleep returns void */
+/* #undef USLEEP_RETURNS_VOID */
+
+/* Define if it looks like a Linux sendfile(2) implementation */
+#define HAVE_LINUX_SENDFILE 1
+
+/* Define if it looks like a BSDish sendfile(2) implementation */
+/* #undef HAVE_BSD_SENDFILE */
+
+/* Define if C compiler supports long long types */
+#define HAVE_LONG_LONG 1
+
+/* Define if fcntl.h defines O_BINARY */
+/* #undef HAVE_O_BINARY */
+
+/* Define if compiler supports prototypes. */
+#define HAVE_PROTOTYPES 1
+
+/* Define if readline/readline.h and readline/history.h exist */
+#define HAVE_READLINE_HEADERS 1
+
+/* Define if readline plus any additional libs needed for it exist */
+#define HAVE_READLINE_LIBS 1
+
+/* Define if readline has version >= 4.0. */
+#define HAVE_READLINE_4 1
+
+/* Define if readline has version >= 4.2. */
+#define HAVE_READLINE_4_2 1
+
+/* Define if <unistd.h> defines _SC_GETGR_R_SIZE_MAX */
+/* #undef HAVE_SC_GETGR_R_SIZE_MAX */
+
+/* Define if <unistd.h> defines _SC_GETPW_R_SIZE_MAX */
+/* #undef HAVE_SC_GETPW_R_SIZE_MAX */
+
+/* Define if you have the sigpoll() function */
+#define HAVE_SIGPOLL 1
+
+/* Define if time.h or sys/time.h define the timezone variable */
+#define HAVE_TIMEZONE 1
+
+/* Define if you support the production (and use) of Win32 DLLs. */
+/* #undef HAVE_WIN32_DLL_SUPPORT */
+
+/* Define if you have the WinExec function. */
+/* #undef HAVE_WINEXEC */
+
+/* Define to Haskell type for blkcnt_t */
+#define HTYPE_BLKCNT_T Int32
+
+/* Define to Haskell type for cc_t */
+#define HTYPE_CC_T Word8
+
+/* Define to Haskell type for char */
+#define HTYPE_CHAR Int8
+
+/* Define to Haskell type for clock_t */
+#define HTYPE_CLOCK_T Int32
+
+/* Define to Haskell type for dev_t */
+#define HTYPE_DEV_T Word64
+
+/* Define to Haskell type for signed double */
+#define HTYPE_DOUBLE Double
+
+/* Define to Haskell type for float */
+#define HTYPE_FLOAT Float
+
+/* Define to Haskell type for gid_t */
+#define HTYPE_GID_T Word32
+
+/* Define to Haskell type for GLbitfield */
+/* #undef HTYPE_GLBITFIELD */
+
+/* Define to Haskell type for GLboolean */
+/* #undef HTYPE_GLBOOLEAN */
+
+/* Define to Haskell type for GLbyte */
+/* #undef HTYPE_GLBYTE */
+
+/* Define to Haskell type for GLclampd */
+/* #undef HTYPE_GLCLAMPD */
+
+/* Define to Haskell type for GLclampf */
+/* #undef HTYPE_GLCLAMPF */
+
+/* Define to Haskell type for GLdouble */
+/* #undef HTYPE_GLDOUBLE */
+
+/* Define to Haskell type for GLenum */
+/* #undef HTYPE_GLENUM */
+
+/* Define to Haskell type for GLfloat */
+/* #undef HTYPE_GLFLOAT */
+
+/* Define to Haskell type for GLint */
+/* #undef HTYPE_GLINT */
+
+/* Define to Haskell type for GLshort */
+/* #undef HTYPE_GLSHORT */
+
+/* Define to Haskell type for GLsizei */
+/* #undef HTYPE_GLSIZEI */
+
+/* Define to Haskell type for GLubyte */
+/* #undef HTYPE_GLUBYTE */
+
+/* Define to Haskell type for GLuint */
+/* #undef HTYPE_GLUINT */
+
+/* Define to Haskell type for GLushort */
+/* #undef HTYPE_GLUSHORT */
+
+/* Define to Haskell type for int */
+#define HTYPE_INT Int32
+
+/* Define to Haskell type for ino_t */
+#define HTYPE_INO_T Word32
+
+/* Define to Haskell type for long */
+#define HTYPE_LONG Int32
+
+/* Define to Haskell type for long long */
+#define HTYPE_LONG_LONG Int64
+
+/* Define to Haskell type for mode_t */
+#define HTYPE_MODE_T Word32
+
+/* Define to Haskell type for nlink_t */
+#define HTYPE_NLINK_T Word32
+
+/* Define to Haskell type for off_t */
+#define HTYPE_OFF_T Int32
+
+/* Define to Haskell type for pid_t */
+#define HTYPE_PID_T Int32
+
+/* Define to Haskell type for ptrdiff_t */
+#define HTYPE_PTRDIFF_T Int32
+
+/* Define to Haskell type for short */
+#define HTYPE_SHORT Int16
+
+/* Define to Haskell type for sig_atomic_t */
+#define HTYPE_SIG_ATOMIC_T Int32
+
+/* Define to Haskell type for signed char */
+#define HTYPE_SIGNED_CHAR Int8
+
+/* Define to Haskell type for size_t */
+#define HTYPE_SIZE_T Word32
+
+/* Define to Haskell type for speed_t */
+#define HTYPE_SPEED_T Word32
+
+/* Define to Haskell type for ssize_t */
+#define HTYPE_SSIZE_T Int32
+
+/* Define to Haskell type for time_t */
+#define HTYPE_TIME_T Int32
+
+/* Define to Haskell type for tcflag_t */
+#define HTYPE_TCFLAG_T Word32
+
+/* Define to Haskell type for uid_t */
+#define HTYPE_UID_T Word32
+
+/* Define to Haskell type for unsigned char */
+#define HTYPE_UNSIGNED_CHAR Word8
+
+/* Define to Haskell type for unsigned int */
+#define HTYPE_UNSIGNED_INT Word32
+
+/* Define to Haskell type for unsigned long */
+#define HTYPE_UNSIGNED_LONG Word32
+
+/* Define to Haskell type for unsigned long long */
+#define HTYPE_UNSIGNED_LONG_LONG Word64
+
+/* Define to Haskell type for unsigned short */
+#define HTYPE_UNSIGNED_SHORT Word16
+
+/* Define to Haskell type for wchar_t */
+#define HTYPE_WCHAR_T Int32
+
+/* Define if C Symbols have a leading underscore added by the compiler */
+/* #undef LEADING_UNDERSCORE */
+
+/* Define to the type of the timezone variable (usually long or time_t) */
+#define TYPE_TIMEZONE time_t
+
+/* Define if signal handlers have type void (*)(int)
+ * (Otherwise, they're assumed to have type int (*)(void).)
+ */
+#define VOID_INT_SIGNALS 1
+
+
+/* Leave that blank line there!! Autoheader needs it.
+ If you're adding to this file, keep in mind:
+ The entries are in sort -df order: alphabetical, case insensitive,
+ ignoring punctuation (such as underscores). */
+
+
+/* autoheader doesn't grok AC_CHECK_LIB_NOWARN so we have to add them
+ manually. */
+
+
+/* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP
+ systems. This function is required for `alloca.c' support on those systems.
+ */
+/* #undef CRAY_STACKSEG_END */
+
+/* Define if using `alloca.c'. */
+/* #undef C_ALLOCA */
+
+/* Define if you have the `access' function. */
+#define HAVE_ACCESS 1
+
+/* Define if you have `alloca', as a function or macro. */
+#define HAVE_ALLOCA 1
+
+/* Define if you have <alloca.h> and it should be used (not on Ultrix). */
+#define HAVE_ALLOCA_H 1
+
+/* Define if you have the <arpa/inet.h> header file. */
+#define HAVE_ARPA_INET_H 1
+
+/* Define if you have the <assert.h> header file. */
+#define HAVE_ASSERT_H 1
+
+/* Define if you have the <bfd.h> header file. */
+#define HAVE_BFD_H 1
+
+/* Define if you have the <conio.h> header file. */
+/* #undef HAVE_CONIO_H */
+
+/* Define if you have the <console.h> header file. */
+/* #undef HAVE_CONSOLE_H */
+
+/* Define if you have the <ctype.h> header file. */
+#define HAVE_CTYPE_H 1
+
+/* Define if you have the <dirent.h> header file. */
+#define HAVE_DIRENT_H 1
+
+/* Define if you have the <dlfcn.h> header file. */
+#define HAVE_DLFCN_H 1
+
+/* Define if you have the `dlopen' function. */
+#define HAVE_DLOPEN 1
+
+/* Define if you have the <dl.h> header file. */
+/* #undef HAVE_DL_H */
+
+/* Define if you have the <dos.h> header file. */
+/* #undef HAVE_DOS_H */
+
+/* Define if you have the <errno.h> header file. */
+#define HAVE_ERRNO_H 1
+
+/* Define if you have the `farcalloc' function. */
+/* #undef HAVE_FARCALLOC */
+
+/* Define if you have the <fcntl.h> header file. */
+#define HAVE_FCNTL_H 1
+
+/* Define if you have the `fgetpos' function. */
+#define HAVE_FGETPOS 1
+
+/* Define if you have the <Files.h> header file. */
+/* #undef HAVE_FILES_H */
+
+/* Define if you have the <float.h> header file. */
+#define HAVE_FLOAT_H 1
+
+/* Define if you have the `fseek' function. */
+#define HAVE_FSEEK 1
+
+/* Define if you have the `fsetpos' function. */
+#define HAVE_FSETPOS 1
+
+/* Define if you have the `ftell' function. */
+#define HAVE_FTELL 1
+
+/* Define if you have the `ftime' function. */
+#define HAVE_FTIME 1
+
+/* Define if you have the <ftw.h> header file. */
+#define HAVE_FTW_H 1
+
+/* Define if you have the `getclock' function. */
+/* #undef HAVE_GETCLOCK */
+
+/* Define if you have the `getgrgid_r' function. */
+#define HAVE_GETGRGID_R 1
+
+/* Define if you have the `getgrnam_r' function. */
+#define HAVE_GETGRNAM_R 1
+
+/* Define if you have the `getpagesize' function. */
+#define HAVE_GETPAGESIZE 1
+
+/* Define if you have the `getpwnam_r' function. */
+#define HAVE_GETPWNAM_R 1
+
+/* Define if you have the `getpwuid_r' function. */
+#define HAVE_GETPWUID_R 1
+
+/* Define if you have the `getrusage' function. */
+#define HAVE_GETRUSAGE 1
+
+/* Define if you have the `gettimeofday' function. */
+#define HAVE_GETTIMEOFDAY 1
+
+/* Define if you have the <GL/gl.h> header file. */
+#define HAVE_GL_GL_H 1
+
+/* Define if you have the `gmtime_r' function. */
+#define HAVE_GMTIME_R 1
+
+/* Define if you have the <grp.h> header file. */
+#define HAVE_GRP_H 1
+
+/* Define if you have the <ieee754.h> header file. */
+#define HAVE_IEEE754_H 1
+
+/* Define if you have the <inttypes.h> header file. */
+#define HAVE_INTTYPES_H 1
+
+/* Define if you have the <io.h> header file. */
+/* #undef HAVE_IO_H */
+
+/* Define if you have the `lchown' function. */
+#define HAVE_LCHOWN 1
+
+/* Define if you have the `bfd' library (-lbfd). */
+#define HAVE_LIBBFD 1
+
+/* Define if you have the `iberty' library (-liberty). */
+#define HAVE_LIBIBERTY 1
+
+/* Define if you have the <limits.h> header file. */
+#define HAVE_LIMITS_H 1
+
+/* Define if you have the `localtime_r' function. */
+#define HAVE_LOCALTIME_R 1
+
+/* Define if you have the `lstat' function. */
+#define HAVE_LSTAT 1
+
+/* Define if you have the `macsystem' function. */
+/* #undef HAVE_MACSYSTEM */
+
+/* Define if you have the <malloc.h> header file. */
+#define HAVE_MALLOC_H 1
+
+/* Define if you have the <memory.h> header file. */
+#define HAVE_MEMORY_H 1
+
+/* Define if you have the `mktime' function. */
+#define HAVE_MKTIME 1
+
+/* Define if you have the `mprotect' function. */
+#define HAVE_MPROTECT 1
+
+/* Define if you have the <netdb.h> header file. */
+#define HAVE_NETDB_H 1
+
+/* Define if you have the <netinet/in.h> header file. */
+#define HAVE_NETINET_IN_H 1
+
+/* Define if you have the <netinet/tcp.h> header file. */
+#define HAVE_NETINET_TCP_H 1
+
+/* Define if you have the <nlist.h> header file. */
+/* #undef HAVE_NLIST_H */
+
+/* Define if you have the <pascal.h> header file. */
+/* #undef HAVE_PASCAL_H */
+
+/* Define if you have the `PBHSetVolSync' function. */
+/* #undef HAVE_PBHSETVOLSYNC */
+
+/* Define if you have the `pclose' function. */
+#define HAVE_PCLOSE 1
+
+/* Define if you have the `popen' function. */
+#define HAVE_POPEN 1
+
+/* Define if you have the <pthread.h> header file. */
+#define HAVE_PTHREAD_H 1
+
+/* Define if you have the <pwd.h> header file. */
+#define HAVE_PWD_H 1
+
+/* Define if you have the `readdir_r' function. */
+#define HAVE_READDIR_R 1
+
+/* Define if you have the `readlink' function. */
+#define HAVE_READLINK 1
+
+/* Define if you have the `realpath' function. */
+#define HAVE_REALPATH 1
+
+/* Define if you have the `setitimer' function. */
+#define HAVE_SETITIMER 1
+
+/* Define if you have the <sgtty.h> header file. */
+#define HAVE_SGTTY_H 1
+
+/* Define if you have the <siginfo.h> header file. */
+/* #undef HAVE_SIGINFO_H */
+
+/* Define if you have the <signal.h> header file. */
+#define HAVE_SIGNAL_H 1
+
+/* Define if you have the `snprintf' function. */
+#define HAVE_SNPRINTF 1
+
+/* Define if you have the `stat' function. */
+#define HAVE_STAT 1
+
+/* Define if you have the <stat.h> header file. */
+/* #undef HAVE_STAT_H */
+
+/* Define if you have the <stdarg.h> header file. */
+#define HAVE_STDARG_H 1
+
+/* Define if you have the <stddef.h> header file. */
+#define HAVE_STDDEF_H 1
+
+/* Define if you have the <stdint.h> header file. */
+#define HAVE_STDINT_H 1
+
+/* Define if you have the <stdlib.h> header file. */
+#define HAVE_STDLIB_H 1
+
+/* Define if you have the <std.h> header file. */
+/* #undef HAVE_STD_H */
+
+/* Define if you have the `strcasecmp' function. */
+#define HAVE_STRCASECMP 1
+
+/* Define if you have the `strcmp' function. */
+#define HAVE_STRCMP 1
+
+/* Define if you have the `strcmpi' function. */
+/* #undef HAVE_STRCMPI */
+
+/* Define if you have the `stricmp' function. */
+/* #undef HAVE_STRICMP */
+
+/* Define if you have the <strings.h> header file. */
+/* #undef HAVE_STRINGS_H */
+
+/* Define if you have the <string.h> header file. */
+#define HAVE_STRING_H 1
+
+/* Define if `st_blksize' is member of `struct stat'. */
+/* #undef HAVE_STRUCT_STAT_ST_BLKSIZE */
+
+/* Define if `tm_zone' is member of `struct tm'. */
+/* #undef HAVE_STRUCT_TM_TM_ZONE */
+
+/* Define if your `struct stat' has `st_blksize'. Deprecated, use
+ `HAVE_STRUCT_STAT_ST_BLKSIZE' instead. */
+#define HAVE_ST_BLKSIZE 1
+
+/* Define if you have the `symlink' function. */
+#define HAVE_SYMLINK 1
+
+/* Define if you have the `sysconf' function. */
+#define HAVE_SYSCONF 1
+
+/* Define if you have the <sys/fault.h> header file. */
+/* #undef HAVE_SYS_FAULT_H */
+
+/* Define if you have the <sys/file.h> header file. */
+#define HAVE_SYS_FILE_H 1
+
+/* Define if you have the <sys/ioctl.h> header file. */
+#define HAVE_SYS_IOCTL_H 1
+
+/* Define if you have the <sys/limits.h> header file. */
+/* #undef HAVE_SYS_LIMITS_H */
+
+/* Define if you have the <sys/mman.h> header file. */
+#define HAVE_SYS_MMAN_H 1
+
+/* Define if you have the <sys/param.h> header file. */
+#define HAVE_SYS_PARAM_H 1
+
+/* Define if you have the <sys/procfs.h> header file. */
+#define HAVE_SYS_PROCFS_H 1
+
+/* Define if you have the <sys/resource.h> header file. */
+#define HAVE_SYS_RESOURCE_H 1
+
+/* Define if you have the <sys/signal.h> header file. */
+#define HAVE_SYS_SIGNAL_H 1
+
+/* Define if you have the <sys/socket.h> header file. */
+#define HAVE_SYS_SOCKET_H 1
+
+/* Define if you have the <sys/stat.h> header file. */
+#define HAVE_SYS_STAT_H 1
+
+/* Define if you have the <sys/syscall.h> header file. */
+#define HAVE_SYS_SYSCALL_H 1
+
+/* Define if you have the <sys/timeb.h> header file. */
+#define HAVE_SYS_TIMEB_H 1
+
+/* Define if you have the <sys/timers.h> header file. */
+/* #undef HAVE_SYS_TIMERS_H */
+
+/* Define if you have the <sys/times.h> header file. */
+#define HAVE_SYS_TIMES_H 1
+
+/* Define if you have the <sys/time.h> header file. */
+#define HAVE_SYS_TIME_H 1
+
+/* Define if you have the <sys/types.h> header file. */
+#define HAVE_SYS_TYPES_H 1
+
+/* Define if you have the <sys/uio.h> header file. */
+#define HAVE_SYS_UIO_H 1
+
+/* Define if you have the <sys/un.h> header file. */
+#define HAVE_SYS_UN_H 1
+
+/* Define if you have the <sys/utsname.h> header file. */
+#define HAVE_SYS_UTSNAME_H 1
+
+/* Define if you have the <sys/vadvise.h> header file. */
+/* #undef HAVE_SYS_VADVISE_H */
+
+/* Define if you have the <sys/wait.h> header file. */
+#define HAVE_SYS_WAIT_H 1
+
+/* Define if you have the <termios.h> header file. */
+#define HAVE_TERMIOS_H 1
+
+/* Define if you have the <termio.h> header file. */
+#define HAVE_TERMIO_H 1
+
+/* Define if you have the `timelocal' function. */
+#define HAVE_TIMELOCAL 1
+
+/* Define if you have the `times' function. */
+#define HAVE_TIMES 1
+
+/* Define if you have the <time.h> header file. */
+#define HAVE_TIME_H 1
+
+/* Define if your `struct tm' has `tm_zone'. Deprecated, use
+ `HAVE_STRUCT_TM_TM_ZONE' instead. */
+#define HAVE_TM_ZONE 1
+
+/* Define if you have the <types.h> header file. */
+/* #undef HAVE_TYPES_H */
+
+/* Define if you don't have `tm_zone' but do have the external array `tzname'.
+ */
+/* #undef HAVE_TZNAME */
+
+/* Define if you have the <unistd.h> header file. */
+#define HAVE_UNISTD_H 1
+
+/* Define if you have the <utime.h> header file. */
+#define HAVE_UTIME_H 1
+
+/* Define if you have the `vadvise' function. */
+/* #undef HAVE_VADVISE */
+
+/* Define if you have the `valloc' function. */
+#define HAVE_VALLOC 1
+
+/* Define if you have the <values.h> header file. */
+#define HAVE_VALUES_H 1
+
+/* Define if you have the `vfork' function. */
+#define HAVE_VFORK 1
+
+/* Define if you have the <vfork.h> header file. */
+/* #undef HAVE_VFORK_H */
+
+/* Define if you have the `vsnprintf' function. */
+#define HAVE_VSNPRINTF 1
+
+/* Define if you have the <windows.h> header file. */
+/* #undef HAVE_WINDOWS_H */
+
+/* Define if you have the <winsock.h> header file. */
+/* #undef HAVE_WINSOCK_H */
+
+/* Define if you have the `_fullpath' function. */
+/* #undef HAVE__FULLPATH */
+
+/* Define if you have the `_pclose' function. */
+/* #undef HAVE__PCLOSE */
+
+/* Define if you have the `_popen' function. */
+/* #undef HAVE__POPEN */
+
+/* Define if you have the `_snprintf' function. */
+/* #undef HAVE__SNPRINTF */
+
+/* Define if you have the `_stricmp' function. */
+/* #undef HAVE__STRICMP */
+
+/* Define if you have the `_vsnprintf' function. */
+/* #undef HAVE__VSNPRINTF */
+
+/* Define as the return type of signal handlers (`int' or `void'). */
+#define RETSIGTYPE void
+
+/* The size of a `char', as computed by sizeof. */
+#define SIZEOF_CHAR 1
+
+/* The size of a `double', as computed by sizeof. */
+#define SIZEOF_DOUBLE 8
+
+/* The size of a `float', as computed by sizeof. */
+#define SIZEOF_FLOAT 4
+
+/* The size of a `int', as computed by sizeof. */
+#define SIZEOF_INT 4
+
+/* The size of a `long', as computed by sizeof. */
+#define SIZEOF_LONG 4
+
+/* The size of a `long long', as computed by sizeof. */
+#define SIZEOF_LONG_LONG 8
+
+/* The size of a `short', as computed by sizeof. */
+#define SIZEOF_SHORT 2
+
+/* The size of a `unsigned char', as computed by sizeof. */
+#define SIZEOF_UNSIGNED_CHAR 1
+
+/* The size of a `unsigned int', as computed by sizeof. */
+#define SIZEOF_UNSIGNED_INT 4
+
+/* The size of a `unsigned long', as computed by sizeof. */
+#define SIZEOF_UNSIGNED_LONG 4
+
+/* The size of a `unsigned long long', as computed by sizeof. */
+#define SIZEOF_UNSIGNED_LONG_LONG 8
+
+/* The size of a `unsigned short', as computed by sizeof. */
+#define SIZEOF_UNSIGNED_SHORT 2
+
+/* The size of a `void *', as computed by sizeof. */
+#define SIZEOF_VOID_P 4
+
+/* If using the C implementation of alloca, define if you know the
+ direction of stack growth for your system; otherwise it will be
+ automatically deduced at run-time.
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown */
+/* #undef STACK_DIRECTION */
+
+/* Define if you have the ANSI C header files. */
+#define STDC_HEADERS 1
+
+/* Define if you can safely include both <sys/time.h> and <time.h>. */
+#define TIME_WITH_SYS_TIME 1
+
+/* Define if your <sys/time.h> declares `struct tm'. */
+/* #undef TM_IN_SYS_TIME */
+
+/* Define if the system headers declare usleep to return void. */
+/* #undef USLEEP_RETURNS_VOID */
+
+/* Define if your processor stores words with the most significant byte first
+ (like Motorola and SPARC, unlike Intel and VAX). */
+/* #undef WORDS_BIGENDIAN */
+
+/* Define if the X Window System is missing or not being used. */
+/* #undef X_DISPLAY_MISSING */
+
+/* Define to empty if `const' does not conform to ANSI C. */
+/* #undef const */
diff --git a/Linux_C_12/cpicture_121.c b/Linux_C_12/cpicture_121.c new file mode 100644 index 0000000..c036587 --- /dev/null +++ b/Linux_C_12/cpicture_121.c @@ -0,0 +1,1910 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to drawing.
+********************************************************************************************/
+#include "util_121.h"
+#include <pango/pango.h>
+#include <pango/pangoft2.h>
+#include "cpicture_121.h"
+#include "cCrossCall_121.h"
+#include "cCrossCallWindows_121.h"
+
+extern void InitGTK();
+
+const gchar* PEN_POS_KEY = "current-pen-position";
+
+void WinGetDC (GtkWidget *widget, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ GdkWindow *window;
+ printf("WinGetDC\n");
+ window = GTK_BIN(GTK_BIN(widget)->child)->child->window;
+
+ gdk_window_ref(window);
+ *outDraw = GDK_DRAWABLE(window);
+ *oos = ios;
+} /* WinGetDC */
+
+OS WinReleaseDC(GtkWidget *widget, GdkDrawable *drawable, OS ios)
+{
+ printf("WinReleaseDC\n");
+ gdk_window_unref(GDK_WINDOW(drawable));
+ return ios;
+} /* WinReleaseDC */
+
+gint OsMMtoVPixels(double mm)
+
+{
+ printf("OsMMtoVPixels\n");
+ InitGTK();
+ return (int) ((mm*gdk_screen_height())/gdk_screen_height_mm());
+}
+
+gint OsMMtoHPixels(double mm)
+{
+ printf("OsMMtoHPixels\n");
+ InitGTK();
+ return (int) ((mm*gdk_screen_width())/gdk_screen_width_mm());
+}
+
+/*------------------------------------*\
+| |
+| Helper functions |
+| |
+\*------------------------------------*/
+
+static GdkGC *theDrawGC, *theEraseGC, *theInvertGC;
+static GdkFont *theFont;
+static PangoFontDescription *theFontDesc;
+static gint penSize;
+static gint penPat;
+static gint penMode;
+static GdkColor penColor;
+static GdkColor backColor;
+static GdkPoint *thePolygon;
+static gint thePolygonIndex;
+static GdkRegion *theClipRgn = NULL;
+
+
+void WinInitPicture (gint size, gint mode, gint pr, gint pg, gint pb,
+ gint br, gint bg, gint bb, gint x, gint y,
+ CLEAN_STRING fname, gint fstyle, gint fsize,
+ gint ox, gint oy, GdkDrawable *inDraw, OS os,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinInitPicture\n");
+ penColor.pixel = 0;
+ penColor.red = pr*257;
+ penColor.green = pg*257;
+ penColor.blue = pb*257;
+
+ backColor.pixel = 0;
+ backColor.red = br*257;
+ backColor.green = bg*257;
+ backColor.blue = bb*257;
+
+ penSize = size;
+ penMode = mode;
+
+ if (inDraw)
+ {
+ printf("inDraw non-null\n");
+ gdk_colormap_alloc_color(gdk_drawable_get_colormap(inDraw), &penColor, FALSE, FALSE);
+ gdk_colormap_alloc_color(gdk_drawable_get_colormap(inDraw), &backColor, FALSE, FALSE);
+
+ theDrawGC = gdk_gc_new(inDraw);
+ gdk_gc_set_foreground(theDrawGC, &penColor);
+ gdk_gc_set_background(theDrawGC, &backColor);
+ gdk_gc_set_clip_origin(theDrawGC, 0, 0);
+ gdk_gc_set_line_attributes(theDrawGC, size, GDK_LINE_SOLID, GDK_CAP_ROUND, GDK_JOIN_ROUND);
+
+ theEraseGC = gdk_gc_new(inDraw);
+ gdk_gc_set_foreground(theEraseGC, &backColor);
+ gdk_gc_set_background(theEraseGC, &penColor);
+ gdk_gc_set_clip_origin(theEraseGC, 0, 0);
+ gdk_gc_set_line_attributes(theEraseGC, size, GDK_LINE_SOLID, GDK_CAP_ROUND, GDK_JOIN_ROUND);
+
+ theInvertGC = gdk_gc_new(inDraw);
+ gdk_gc_set_foreground(theInvertGC, &penColor);
+ gdk_gc_set_background(theInvertGC, &backColor);
+ gdk_gc_set_function(theInvertGC, GDK_INVERT);
+ gdk_gc_set_clip_origin(theInvertGC, 0, 0);
+ }
+ else
+ {
+ theDrawGC = NULL;
+ theEraseGC = NULL;
+ theInvertGC = NULL;
+ }
+
+ theFontDesc = pango_font_description_new();
+ pango_font_description_set_family(theFontDesc,cstring(fname));
+ pango_font_description_set_weight(theFontDesc,(fstyle & iBold) ? PANGO_WEIGHT_BOLD : PANGO_WEIGHT_NORMAL);
+ pango_font_description_set_style(theFontDesc,(fstyle & iItalic) ? PANGO_STYLE_ITALIC : PANGO_STYLE_NORMAL);
+ /* plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE; */
+ /* plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE; */
+ pango_font_description_set_size(theFontDesc, fsize*PANGO_SCALE);
+ theFont = gdk_font_from_description(theFontDesc);
+
+ /*
+ theClipRgn = NULL;
+ if (clipRgn)
+ {
+ theClipRgn = gdk_region_copy(clipRgn);
+ if (theDrawGC) gdk_gc_set_clip_region(theDrawGC, theClipRgn);
+ if (theEraseGC) gdk_gc_set_clip_region(theEraseGC, theClipRgn);
+ if (theInvertGC) gdk_gc_set_clip_region(theInvertGC, theClipRgn);
+ }
+ */
+
+ /* Remember the pen position */
+ InternalSetPenPos(inDraw, x, y);
+
+ *outDraw = inDraw;
+ *oos = os;
+ printf("WinInitPicture -- returning\n");
+} /* WinInitPicture */
+
+void WinDonePicture (GdkDrawable *inDraw, OS ios,
+ gint *size, gint *mode, gint *pr, gint *pg, gint *pb, gint *br,
+ gint *bg, gint *bb, gint *x, gint *y, CLEAN_STRING *fname,
+ gint *fstyle, gint *fsize, GdkDrawable **outDraw, OS* oos)
+{
+ GdkPoint *p;
+ PangoContext *pc;
+ PangoFontDescription *fontDesc;
+ gchar *fontDescString;
+ GtkWidget *widget;
+ gboolean inDrawIsWidget;
+
+ printf("WinDonePicture\n");
+ inDrawIsWidget = GTK_IS_WIDGET(inDraw);
+
+ if (inDraw)
+ {
+ printf("inDraw non-null\n");
+ gdk_colormap_free_colors(gdk_drawable_get_colormap(inDraw), &penColor, 1);
+ gdk_colormap_free_colors(gdk_drawable_get_colormap(inDraw), &backColor, 1);
+ }
+
+ if (theFont)
+ {
+ gdk_font_unref(theFont);
+ theFont = NULL;
+ }
+ if (theFontDesc)
+ {
+ pango_font_description_free(theFontDesc);
+ theFontDesc = NULL;
+ }
+
+ if (theDrawGC) gdk_gc_unref(theDrawGC);
+ if (theEraseGC) gdk_gc_unref(theEraseGC);
+ if (theInvertGC) gdk_gc_unref(theInvertGC);
+
+ if (theClipRgn)
+ {
+ gdk_region_destroy(theClipRgn);
+ theClipRgn = NULL;
+ }
+
+ *size = penSize;
+ *mode = penMode;
+
+ *pr = penColor.red/257;
+ *pg = penColor.green/257;
+ *pb = penColor.blue/257;
+
+ *br = backColor.red/257;
+ *bg = backColor.green/257;
+ *bb = backColor.blue/257;
+
+ /* inDraw may not have font context */
+ *outDraw = inDraw;
+ if (! inDrawIsWidget)
+ {
+ widget = gtk_label_new(NULL);
+ }
+ else
+ {
+ widget = GTK_WIDGET(inDraw);
+ }
+
+ pc = gtk_widget_get_pango_context(widget);
+
+ fontDesc = pango_context_get_font_description(pc);
+
+ InternalGetPenPos(inDraw, x, y);
+
+ *fname = cleanstring(pango_font_description_get_family(fontDesc));
+ *fstyle= pango_font_description_get_style(fontDesc);
+ *fsize = pango_font_description_get_size(fontDesc);
+
+ g_object_unref(G_OBJECT(pc));
+ if (! inDrawIsWidget)
+ {
+ gtk_widget_destroy(widget);
+ }
+
+ *oos = ios;
+ printf("WinDonePicture -- returning\n");
+} /* WinDonePicture */
+
+/* PA: Set and get the clipping region of a picture:
+ WinClipRgnPicture takes the intersection of the argument clipRgn with the current clipping region.
+ WinSetClipRgnPicture sets the argument clipRgn as the new clipping region.
+ WinGetClipRgnPicture gets the current clipping region.
+*/
+void WinClipRgnPicture (GdkRegion *region, GdkDrawable *drawable, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ GdkRectangle *rectangles;
+ gint n_rectangles, i;
+
+ printf("WinClipRgnPicture\n");
+ if (theClipRgn != NULL)
+ {
+ gdk_region_intersect(theClipRgn, region);
+ }
+ else
+ {
+ if (region)
+ theClipRgn = gdk_region_copy(region);
+ }
+
+ if (theDrawGC) gdk_gc_set_clip_region(theDrawGC, theClipRgn);
+ if (theEraseGC) gdk_gc_set_clip_region(theEraseGC, theClipRgn);
+ if (theInvertGC) gdk_gc_set_clip_region(theInvertGC, theClipRgn);
+
+ *outDraw = drawable;
+ *oos = ios;
+} /* WinClipRgnPicture */
+
+void WinSetClipRgnPicture (GdkRegion *region, GdkDrawable *drawable, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ GdkRectangle *rectangles;
+ gint n_rectangles, i;
+
+ printf("WinSetClipRgnPicture\n");
+ if (theClipRgn != NULL)
+ {
+ gdk_region_destroy(theClipRgn);
+ }
+
+ theClipRgn = region ? gdk_region_copy(region) : NULL;
+
+ if (theDrawGC) gdk_gc_set_clip_region(theDrawGC, theClipRgn);
+ if (theEraseGC) gdk_gc_set_clip_region(theEraseGC, theClipRgn);
+ if (theInvertGC) gdk_gc_set_clip_region(theInvertGC, theClipRgn);
+ *outDraw = drawable;
+ *oos = ios;
+} /* WinSetClipRgnPicture */
+
+void WinGetClipRgnPicture (GdkDrawable *drawable,OS ios,
+ GdkRegion **outRegion, GdkDrawable **outDraw, OS* oos)
+{
+ GdkRegion *r = NULL;
+
+ printf("WinGetClipRgnPicture\n");
+ if (theClipRgn)
+ {
+ r = gdk_region_copy(theClipRgn);
+ }
+
+ *outRegion = r;
+ *outDraw = drawable;
+ *oos = ios;
+} /* WinGetClipRgnPicture */
+
+
+/* Operations to create, modify, and destroy polygon shapes.
+*/
+
+void WinAllocPolyShape (gint size, OS ios, GdkPoint **outPoint, OS *oos)
+{
+ printf("WinAllocPolyShape\n");
+ *outPoint = g_new(GdkPoint,1);
+ *oos = ios;
+} /* WinAllocPolyShape */
+
+OS WinSetPolyPoint (gint i, gint x, gint y, GdkPoint *shape, OS os)
+{
+ printf("WinSetPolyPoint\n");
+ shape[i].x = x;
+ shape[i].y = y;
+
+ return (os);
+} /* WinSetPolyPoint */
+
+OS WinFreePolyShape (GdkPoint *shape, OS os)
+{
+ printf("WinFreePolyShape\n");
+ gdk_drawable_unref(GDK_DRAWABLE(shape));
+ return (os);
+} /* WinFreePolyShape */
+
+
+/*
+ * Operations to create, modify and destroy regions.
+ */
+GdkRegion *WinCreateEmptyRgn()
+{
+ printf("WinCreateEmptyRgn\n");
+ return gdk_region_new();
+} /* WinCreateEmptyRgn */
+
+void WinCreateRectRgn (gint nLeftRect, gint nTopRect, gint nRightRect,
+ gint nBottomRect, OS ios, GdkRegion **rgn, OS *oos)
+{
+ GdkRectangle rectangle;
+ printf("WinCreateRectRgn\n");
+ rectangle.x = nLeftRect;
+ rectangle.y = nTopRect;
+ rectangle.width = nRightRect-nLeftRect;
+ rectangle.height = nBottomRect-nTopRect;
+ *rgn = gdk_region_rectangle(&rectangle);
+ *oos = ios;
+} /* WinCreateRectRgn */
+
+void WinCreatePolygonRgn (GdkPoint *points, gint nPoints,
+ gint fnPolyFillMode, OS ios, GdkRegion **rgn, OS *oos)
+{
+ printf("WinCreatePolygonRgn\n");
+ *rgn = gdk_region_polygon(points,nPoints, fnPolyFillMode == 1 ? GDK_EVEN_ODD_RULE : GDK_WINDING_RULE);
+ *oos = ios;
+} /* WinCreatePolygonRgn */
+
+GdkRegion *WinUnionRgn (GdkRegion *src1, GdkRegion *src2)
+{
+ GdkRegion *dst = NULL;
+ printf("WinUnionRgn\n");
+
+ if (src1)
+ {
+ dst = gdk_region_copy(src1);
+ gdk_region_union(dst, src2);
+ }
+
+ return dst;
+} /* WinUnionRgn */
+
+GdkRegion *WinSectRgn (GdkRegion *src1, GdkRegion *src2)
+{
+ GdkRegion *dst = src2;
+ printf("WinSectRgn\n");
+
+ if (src1)
+ {
+ dst = gdk_region_copy(src1);
+ gdk_region_intersect(dst, src2);
+ }
+
+ return dst;
+} /* WinSectRgn */
+
+GdkRegion *WinDiffRgn (GdkRegion *src1, GdkRegion *src2)
+{
+ GdkRegion *dst = NULL;
+ printf("WinDiffRgn\n");
+
+ if (src1)
+ {
+ dst = gdk_region_copy(src1);
+ gdk_region_subtract(dst, src2);
+ };
+
+ return dst;
+} /* WinDiffRgn */
+
+GdkRegion *WinXorRgn (GdkRegion *src1, GdkRegion *src2)
+{
+ GdkRegion *dst = NULL;
+ printf("WinXorRgn\n");
+
+ if (src1)
+ {
+ dst = gdk_region_copy(src1);
+ gdk_region_xor(dst, src2);
+ }
+
+ return dst;
+} /* WinXorRgn */
+
+void WinGetRgnBox (GdkRegion *region, OS ios, gint *left, gint *top, gint *right,
+ gint *bottom, gboolean *isrect, gboolean *isempty, OS *oos)
+{
+ GdkRegion *tempRegion;
+ GdkRectangle rectangle;
+ printf("WinGetRgnBox\n");
+
+ gdk_region_get_clipbox(region,&rectangle);
+ tempRegion = gdk_region_rectangle(&rectangle);
+
+ *left = rectangle.x;
+ *top = rectangle.y;
+ *right = rectangle.x+rectangle.width;
+ *bottom = rectangle.y+rectangle.height;
+ *isrect = gdk_region_equal(region, tempRegion);
+
+ gdk_region_destroy(tempRegion);
+
+ *oos = ios;
+} /* WinGetRgnBox */
+
+gboolean WinIsEmptyRgn(GdkRegion *region)
+{
+ printf("WinIsEmptyRgn\n");
+ return gdk_region_empty(region);
+}
+
+void WinDisposeRgn (GdkRegion *region)
+{
+ printf("WinDisposeRgn\n");
+ gdk_region_destroy(region);
+}
+
+/*------------------------------------*\
+| Interface functions |
+\*------------------------------------*/
+
+void WinSetPenSize (gint size, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetPenSize\n");
+ if (theDrawGC) gdk_gc_set_line_attributes(theDrawGC, size, GDK_LINE_SOLID, GDK_CAP_ROUND, GDK_JOIN_ROUND);
+ if (theEraseGC) gdk_gc_set_line_attributes(theEraseGC, size, GDK_LINE_SOLID, GDK_CAP_ROUND, GDK_JOIN_ROUND);
+ penSize = size;
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinSetPenSize */
+
+void WinSetPenColor (gint red, gint green, gint blue, GdkDrawable *inDraw,
+ OS ios, GdkDrawable **outDraw, OS* oos)
+{
+ printf("WinSetPenColor\n");
+ if (inDraw)
+ {
+ gdk_colormap_free_colors(gdk_drawable_get_colormap(inDraw), &backColor, 1);
+ penColor.pixel = 0;
+ penColor.red = red*257;
+ penColor.green = green*257;
+ penColor.blue = blue*257;
+ gdk_colormap_alloc_color(gdk_drawable_get_colormap(inDraw), &penColor, FALSE, FALSE);
+
+ gdk_gc_set_foreground(theDrawGC, &penColor);
+ gdk_gc_set_background(theEraseGC, &penColor);
+ gdk_gc_set_foreground(theInvertGC, &penColor);
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinSetPenColor */
+
+void WinSetBackColor (gint red, gint green, gint blue, GdkDrawable *inDraw,
+ OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetBackColor\n");
+ if (inDraw)
+ {
+ gdk_colormap_free_colors(gdk_drawable_get_colormap(inDraw), &backColor, 1);
+ backColor.pixel = 0;
+ backColor.red = red*257;
+ backColor.green = green*257;
+ backColor.blue = blue*257;
+ gdk_colormap_alloc_color(gdk_drawable_get_colormap(inDraw), &backColor, FALSE, FALSE);
+
+ gdk_gc_set_background(theDrawGC, &backColor);
+ gdk_gc_set_foreground(theEraseGC, &backColor);
+ gdk_gc_set_background(theInvertGC, &backColor);
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinSetBackColor */
+
+void WinSetMode (gint mode, GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+ printf("WinSetMode\n");
+ switch (mode)
+ {
+ case iModeCopy:
+ penMode = iModeCopy;
+ if (theDrawGC) gdk_gc_set_function(theDrawGC, GDK_COPY);
+ if (theEraseGC) gdk_gc_set_function(theEraseGC, GDK_COPY);
+ if (theInvertGC) gdk_gc_set_function(theInvertGC, GDK_COPY);
+ break;
+ case iModeXor:
+ penMode = iModeXor;
+ if (theDrawGC) gdk_gc_set_function(theDrawGC, GDK_XOR);
+ if (theEraseGC) gdk_gc_set_function(theEraseGC, GDK_XOR);
+ if (theInvertGC) gdk_gc_set_function(theInvertGC, GDK_XOR);
+ break;
+ case iModeOr:
+ default:
+ if (theDrawGC) gdk_gc_set_function(theDrawGC, GDK_OR);
+ if (theEraseGC) gdk_gc_set_function(theEraseGC, GDK_OR);
+ if (theInvertGC) gdk_gc_set_function(theInvertGC, GDK_OR);
+ break;
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinSetMode */
+
+void WinSetPattern (gint pattern, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetPattern --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinSetPattern */
+
+
+/* changed by MW */
+void WinDrawPoint (gint x, gint y, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawPoint\n");
+ if (inDraw) gdk_draw_point(inDraw, theDrawGC, x, y);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawPoint */
+
+void WinDrawLine (gint startx, gint starty, gint endx, gint endy,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawLine\n");
+ if (inDraw) gdk_draw_line(inDraw, theDrawGC, startx, starty, endx, endy);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawLine */
+
+void WinUndrawLine (gint startx, gint starty, gint endx, gint endy,
+ GdkDrawable *inDraw)
+{
+ printf("WinUndrawLine\n");
+ if (inDraw) gdk_draw_line(inDraw, theEraseGC, startx, starty, endx, endy);
+} /* WinDrawLine */
+
+static gfloat PI = 3.1415926535897932384626433832795;
+
+void WinDrawCurve (gint left, gint top, gint right, gint bottom, gint startradx,
+ gint startrady, gint endradx, gint endrady, GdkDrawable *inDraw,
+ OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ gint x = left;
+ gint y = top;
+ gint rx = right;
+ gint ry = bottom;
+ gfloat from = startradx;
+ gfloat to = endradx;
+ gboolean clockwise = TRUE;
+ gint cx, cy;
+
+ printf("WinDrawCurve\n");
+ if (inDraw)
+ {
+ cx = x - floor(cos(from)* abs(rx));
+ cy = y + floor(sin(from)* abs(ry));
+
+ from = (32*360*from)/PI;
+ to = (32*360*to)/PI;
+
+ if (clockwise)
+ gdk_draw_arc(inDraw, theDrawGC, FALSE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(from-PI/2),floor(from-to));
+ else
+ gdk_draw_arc(inDraw, theDrawGC, FALSE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(to-PI/2),floor(to-from));
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawCurve */
+
+void WinUndrawCurve(gint x, gint y, gint rx, gint ry, gfloat from, gfloat to,
+ gboolean clockwise,GdkDrawable *drawable)
+{
+ gint cx, cy;
+
+ printf("WinUndrawCurve\n");
+ if (drawable)
+ {
+ cx = x - floor(cos(from)* abs(rx));
+ cy = y + floor(sin(from)* abs(ry));
+
+ from = (32*360*from)/PI;
+ to = (32*360*to)/PI;
+
+ if (clockwise)
+ gdk_draw_arc(drawable, theEraseGC, FALSE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(from-PI/2),floor(from-to));
+ else
+ gdk_draw_arc(drawable, theEraseGC, FALSE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(to-PI/2),floor(to-from));
+ }
+} /* WinDrawCurve */
+
+void WinDrawChar (gchar c, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ gint x, y;
+ printf("WinDrawChar\n");
+
+ InternalGetPenPos(inDraw, &x, &y);
+ if (inDraw) gdk_draw_text(inDraw, theFont, theDrawGC, x, y, &c, 1);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawChar */
+
+void WinUndrawChar(gint x, gint y, gchar c, GdkDrawable *drawable)
+{
+ printf("WinUndrawChar\n");
+ if (drawable) gdk_draw_text(drawable,theFont,theEraseGC,x,y,&c,1);
+} /* WinDrawChar */
+
+/*void WinDrawString (int x, int y, CLEAN_STRING string, GdkDrawable *inDraw, */
+void WinDrawString (CLEAN_STRING string, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ gint x, y;
+ printf("WinDrawString\n");
+
+ InternalGetPenPos(inDraw, &x, &y);
+ if (inDraw)
+ {
+ printf("Drawing %s\n", cstring(string));
+ gdk_draw_string(inDraw, theFont, theDrawGC, x, y, cstring(string));
+ }
+
+ *outDraw = inDraw;
+ *oos = ios;
+ printf("Leaving drawstring.\n");
+} /* WinDrawString */
+
+void WinUndrawString (gint x, gint y, gchar *string, GdkDrawable *drawable)
+{
+ printf("WinUndrawString\n");
+ if (drawable) gdk_draw_string(drawable,theFont,theEraseGC,x,y,string);
+} /* WinUndrawString */
+
+void WinDrawRectangle (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawRectangle\n");
+ if (inDraw)
+ gdk_draw_rectangle(inDraw, theDrawGC, FALSE,
+ left, top,
+ right-left-1,
+ bot-top-1);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawRectangle */
+
+void WinUndrawRectangle (gint left, gint top, gint right, gint bot,
+ GdkDrawable *drawable)
+{
+ printf("WinUndrawRectangle\n");
+ if (drawable)
+ {
+ gdk_draw_rectangle(drawable, theEraseGC, FALSE,
+ left, top,
+ right-left-1,
+ bot-top-1);
+ }
+} /* WinDrawRectangle */
+
+void WinFillRectangle (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinFillRectangle\n");
+ if (inDraw)
+ {
+ gdk_draw_rectangle(inDraw, theDrawGC, TRUE,
+ left, top,
+ right-left,
+ bot-top);
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinFillRectangle */
+
+void WinEraseRectangle (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinEraseRectangle\n");
+ if (inDraw)
+ {
+ gdk_draw_rectangle(inDraw, theEraseGC, TRUE,
+ left, top,
+ right-left,
+ bot-top);
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinEraseRectangle */
+
+void WinInvertRectangle (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinInvertRectangle\n");
+ if (inDraw)
+ {
+ gdk_draw_rectangle(inDraw, theInvertGC, TRUE,
+ left, top,
+ right-left,
+ bot-top);
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinInvertRectangle */
+
+void WinMoveRectangleTo (gint left, gint top, gint right, gint bot, gint x,
+ gint y, GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+ printf("WinMoveRectangleTo is not implemented\n");
+ WinMoveRectangle (left,top, right,bot, x-left, y-top, inDraw,ios,
+ outDraw,oos);
+} /* WinMoveRectangleTo */
+
+void WinMoveRectangle (gint left, gint top, gint right, gint bot, gint dx,
+ gint dy, GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+ printf("WinMoveRectangle is not implemented\n");
+/* int w, h;
+ HWND hwnd;
+
+ hwnd = WindowFromDC (ihdc);
+ if (hwnd != NULL)
+ {
+ RECT r;
+ POINT p;
+
+ GetClientRect (hwnd, &r);
+ GetWindowOrgEx (ihdc, &p);
+ left = max (left, r.left + p.x);
+ top = max (top, r.top + p.y);
+ right = min (right, r.right + p.x);
+ bot = min (bot, r.bottom + p.y);
+ }
+
+ w = right - left;
+ h = bot - top;
+
+ WinCopyRectangle (left, top, right, bot, dx, dy, ihdc);
+
+// StartErasing (ihdc);
+
+ if (dx > w || dy > h)
+ {
+ Rectangle (ihdc, left, top, right + 1, bot + 1);
+ return;
+ }
+
+ if (dx < 0)
+ Rectangle (ihdc, right - dx, top, right + 1, bot + 1);
+ else
+ Rectangle (ihdc, left, top, left + dx + 1, bot + 1);
+
+ if (dy < 0)
+ Rectangle (ihdc, left, bot - dy, right + 1, bot + 1);
+ else
+ Rectangle (ihdc, left, top, right + 1, top + dy + 1);*/
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinMoveRectangle */
+
+void WinCopyRectangleTo (gint left, gint top, gint right, gint bot, gint x,
+ gint y, GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+/* WinCopyRectangle (left,top, right,bot, x-left,y-top, ihdc); */
+ printf("WinCopyRectangleTo is not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinCopyRectangleTo */
+
+void WinCopyRectangle (gint left, gint top, gint right, gint bottom, gint dx,
+ gint dy, GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+/* RECT scrollRect;
+
+ scrollRect.left = left;
+ scrollRect.top = top;
+ scrollRect.right = right;
+ scrollRect.bottom = bottom;
+
+ if (!ScrollDC (ihdc, dx,dy, &scrollRect, &scrollRect, NULL, NULL))
+ {
+ rMessageBox (NULL,MB_APPLMODAL,"WinCopyRectangle","ScrollDC failed");
+ }*/
+ printf("WinCopyRectangle is not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinCopyRectangle */
+
+/* PA: new routine to scroll part of the content of a window.
+ It is assumed that scrolling happens in one direction only (dx<>0 && dy==0 || dx==0 && dy<>0).
+ The result rect (oleft,otop,oright,obottom) is the bounding box of the update area that
+ remains to be updated. If all are zero, then nothing needs to be updated.
+*/
+void WinScrollRectangle (gint left, gint top, gint right, gint bottom, gint dx,
+ gint dy, GdkDrawable *inDraw, OS ios, gint *oleft, gint *otop,
+ gint *oright, gint *obottom, GdkDrawable **outDraw, OS *oos)
+{
+/* RECT scrollRect;
+ HRGN hrgnUpdate, hrgnRect;
+
+ scrollRect.left = left;
+ scrollRect.top = top;
+ scrollRect.right = right;
+ scrollRect.bottom = bottom;
+
+ if (dx<0)
+ {
+ hrgnRect = CreateRectRgn (right+dx-1,top-1,right+1,bottom+1);
+ }
+ else if (dx>0)
+ {
+ hrgnRect = CreateRectRgn (left-1,top-1,left+dx+1,bottom+1);
+ }
+ else if (dy<0)
+ {
+ hrgnRect = CreateRectRgn (left-1,bottom+dy-1,right+1,bottom+1);
+ }
+ else if (dy>0)
+ {
+ hrgnRect = CreateRectRgn (left-1,top-1,right+1,top+dy+1);
+ }
+ else
+ {
+ hrgnRect = CreateRectRgn (0,0,0,0);
+ }
+ hrgnUpdate = CreateRectRgn (0,0,1,1);
+
+ if (!ScrollDC (ihdc, dx,dy, &scrollRect, &scrollRect, hrgnUpdate, NULL))
+ {
+ rMessageBox (NULL,MB_APPLMODAL,"WinScrollRectangle","ScrollDC failed");
+ }
+ else
+ {
+ if (CombineRgn (hrgnUpdate, hrgnUpdate, hrgnRect, RGN_DIFF) == NULLREGION)
+ {
+ *oleft = 0;
+ *otop = 0;
+ *oright = 0;
+ *obottom = 0;
+ }
+ else
+ {
+ RECT box;
+ GetRgnBox (hrgnUpdate,&box);
+ *oleft = box.left;
+ *otop = box.top;
+ *oright = box.right;
+ *obottom = box.bottom;
+ }
+ }
+ DeleteObject (hrgnUpdate);
+ DeleteObject (hrgnRect);
+*/
+ printf("WinScrollRectangle is not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinScrollRectangle */
+
+
+void WinUndrawOval (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinUndrawOval\n");
+ if (inDraw) gdk_draw_arc(inDraw,theEraseGC,FALSE,left,top,right-left,bot-top,0,64*360);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawOval */
+
+void WinDrawOval (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawOval\n");
+ if (inDraw) gdk_draw_arc(inDraw,theDrawGC,FALSE,left,top,right-left,bot-top,0,64*360);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawOval */
+
+void WinFillOval (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinFillOval\n");
+ if (inDraw) gdk_draw_arc(inDraw,theDrawGC,TRUE,left,top,right-left,bot-top,0,64*360);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinFillOval */
+
+void WinEraseOval (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinEraseOval\n");
+ if (inDraw) gdk_draw_arc(inDraw,theEraseGC,TRUE,left,top,right-left,bot-top,0,64*360);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinEraseOval */
+
+void WinInvertOval (gint left, gint top, gint right, gint bot,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinInvertOval\n");
+ if (inDraw) gdk_draw_arc(inDraw,theInvertGC,TRUE,left,top,right-left,bot-top,0,64*360);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinInvertOval */
+
+
+void WinFillWedge (gint left, gint top, gint right, gint bottom, gint startradx,
+ gint startrady, gint endradx, gint endrady, GdkDrawable *inDraw,
+ OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ gint cx, cy;
+ gint x = left;
+ gint y = top;
+ gint rx = right;
+ gint ry = bottom;
+ gfloat from = startradx;
+ gfloat to = startrady;
+ gboolean clockwise = TRUE;
+
+ printf("WinFillWedge\n");
+ if (inDraw)
+ {
+ cx = x - floor(cos(from)* abs(rx));
+ cy = y + floor(sin(from)* abs(ry));
+
+ from = (32*360*from)/PI;
+ to = (32*360*to)/PI;
+
+ if (clockwise)
+ gdk_draw_arc(inDraw, theDrawGC, TRUE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(from-PI/2),floor(from-to));
+ else
+ gdk_draw_arc(inDraw, theDrawGC, TRUE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(to-PI/2),floor(to-from));
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinFillWedge */
+
+void WinEraseWedge (gint left, gint top, gint right, gint bottom,
+ gint startradx, gint startrady, gint endradx, gint endrady,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ gint cx, cy;
+ gint x = left;
+ gint y = top;
+ gint rx = right;
+ gint ry = bottom;
+ gfloat from = startradx;
+ gfloat to = startrady;
+ gboolean clockwise = TRUE;
+
+ printf("WinEraseWedge\n");
+ if (inDraw)
+ {
+ cx = x - floor(cos(from)* abs(rx));
+ cy = y + floor(sin(from)* abs(ry));
+
+ from = (32*360*from)/PI;
+ to = (32*360*to)/PI;
+
+ if (clockwise)
+ gdk_draw_arc(inDraw, theEraseGC, TRUE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(from-PI/2),floor(from-to));
+ else
+ gdk_draw_arc(inDraw, theEraseGC, TRUE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(to-PI/2),floor(to-from));
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinEraseWedge */
+
+void WinInvertWedge (gint left, gint top, gint right, gint bottom,
+ gint startradx, gint startrady, gint endradx, gint endrady,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ gint cx, cy;
+ gint x = left;
+ gint y = top;
+ gint rx = right;
+ gint ry = bottom;
+ gfloat from = startradx;
+ gfloat to = startrady;
+ gboolean clockwise = TRUE;
+
+ printf("WinInvertWedge\n");
+ if (inDraw)
+ {
+ cx = x - floor(cos(from)* abs(rx));
+ cy = y + floor(sin(from)* abs(ry));
+
+ from = (32*360*from)/PI;
+ to = (32*360*to)/PI;
+
+ if (clockwise)
+ gdk_draw_arc(inDraw, theInvertGC, TRUE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(from-PI/2),floor(from-to));
+ else
+ gdk_draw_arc(inDraw, theInvertGC, TRUE,
+ cx-rx, cy-ry, 2*rx, 2*ry,
+ floor(to-PI/2),floor(to-from));
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinInvertWedge */
+
+
+OS WinStartPolygon (gint size, OS ios)
+{
+ printf("WinStartPolygon\n");
+ thePolygon = g_new(GdkPoint, size);
+ thePolygonIndex = 0;
+
+ return ios;
+} /* WinStartPolygon */
+
+OS WinEndPolygon (OS ios)
+{
+ printf("WinEndPolygon\n");
+ rfree (thePolygon);
+ thePolygon = NULL;
+
+ return ios;
+} /* WinEndPolygon */
+
+OS WinAddPolygonPoint (gint x, gint y, OS ios)
+{
+ printf("WinAddPolygonPoint\n");
+ thePolygon[thePolygonIndex].x = x;
+ thePolygon[thePolygonIndex].y = y;
+ thePolygonIndex++;
+
+ return ios;
+} /* WinAddPolygonPoint */
+
+void WinDrawPolygon(GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawPolygon\n");
+ if (inDraw) gdk_draw_polygon(inDraw,theDrawGC,FALSE,thePolygon,thePolygonIndex);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawPolygon */
+
+void WinUndrawPolygon (GdkDrawable *drawable)
+{
+ printf("WinUndrawPolygon\n");
+ if (drawable) gdk_draw_polygon(drawable,theEraseGC,FALSE,thePolygon,thePolygonIndex);
+} /* WinUndrawPolygon */
+
+void WinFillPolygon (GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinFillPolygon\n");
+ if (inDraw) gdk_draw_polygon(inDraw,theDrawGC,TRUE,thePolygon,thePolygonIndex);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinFillPolygon */
+
+void WinErasePolygon (GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinErasePolygon\n");
+ if (inDraw) gdk_draw_polygon(inDraw,theEraseGC,TRUE,thePolygon,thePolygonIndex);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinErasePolygon */
+
+void WinInvertPolygon (GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinInvertPolygon\n");
+ if (inDraw) gdk_draw_polygon(inDraw,theInvertGC,TRUE,thePolygon,thePolygonIndex);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinInvertPolygon */
+
+void WinCreateScreenHDC(OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ GdkWindow* theWindow;
+ GdkScreen* theScreen;
+
+ printf("WinCreateScreenHDC\n");
+ InitGTK();
+ theScreen = gdk_screen_get_default();
+ theWindow = gdk_screen_get_root_window(theScreen);
+
+ *oos = ios;
+ *outDraw = GDK_DRAWABLE(theWindow);
+ printf("WinCreateScreenHDC - %d\n",theWindow);
+} /* WinCreateScreenHDC */
+
+OS WinDestroyScreenHDC (GdkDrawable *drawable, OS os)
+{
+ printf("WinDestroyScreenHDC - %d\n",drawable);
+/* g_object_unref(drawable); */
+ return os;
+} /* WinDestroyScreenHDC */
+
+
+/* WinDrawResizedBitmap draws a bitmap on screen. For reasons of efficiency it uses an
+ already created bitmap handle.
+*/
+void WinDrawResizedBitmap (gint sourcew, gint sourceh, gint destx, gint desty,
+ gint destw, gint desth, GdkPixbuf *pixbuf, GdkDrawable *inDraw,
+ OS ios, GdkDrawable **outDraw, OS *oos)
+{
+/* HDC compatibleDC;
+ POINT sourcesize, destsize, dest, origin;
+ HGDIOBJ prevObj;
+
+ sourcesize.x = sourcew;
+ sourcesize.y = sourceh;
+ origin.x = 0;
+ origin.y = 0;
+ destsize.x = destw;
+ destsize.y = desth;
+ dest.x = destx;
+ dest.y = desty;
+
+ // Create a compatible device context
+ compatibleDC = CreateCompatibleDC (hdc);
+ if (compatibleDC == NULL)
+ rMessageBox (NULL,MB_APPLMODAL,"WinDrawResizedBitmap","CreateCompatibleDC failed");
+
+ // Select bitmap into compatible device context
+ prevObj = SelectObject (compatibleDC, hbmp);
+ SetMapMode (compatibleDC, GetMapMode (hdc));
+ DPtoLP (hdc, &destsize, 1);
+ DPtoLP (hdc, &dest, 1);
+ DPtoLP (compatibleDC, &sourcesize, 1);
+ DPtoLP (compatibleDC, &origin, 1);
+
+ if (!StretchBlt (hdc, dest.x, dest.y, destsize.x, destsize.y, compatibleDC, origin.x, origin.y, sourcesize.x, sourcesize.y, SRCCOPY))
+ rMessageBox (NULL,MB_APPLMODAL,"WinDrawResizedBitmap","StretchBlt failed");
+
+ SelectObject (compatibleDC, prevObj);
+ DeleteDC (compatibleDC);*/
+ printf("WinDrawResizedBitmap is not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawResizedBitmap */
+
+/* ... MW */
+void WinDrawBitmap (gint w, gint h, gint destx, gint desty, GdkPixbuf *pixbuf,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawBitmap\n");
+ /* if (drawable) gdk_draw_drawable(drawable,theDrawGC,GDK_DRAWABLE(pixbuf),0,0,destx,desty,w,h); */
+ if (inDraw)
+ {
+ gdk_pixbuf_render_to_drawable (pixbuf, inDraw, theDrawGC, 0, 0, destx,
+ desty, w, h, GDK_RGB_DITHER_NONE, 0, 0);
+ }
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinDrawBitmap */
+
+void WinCreateBitmap (gint width, gchar *filename, GdkDrawable *inDraw,OS ios,
+ GdkPixbuf **bitmap, OS* oos)
+{
+ GError *err = NULL;
+
+ printf("WinCreateBitmap\n");
+ InitGTK();
+ *bitmap = gdk_pixbuf_new_from_file(filename, &err);
+
+ /*
+ *pWidth = gdk_pixbuf_get_width(pixbuf);
+ *pHeight = gdk_pixbuf_get_height(pixbuf);
+ */
+
+ *oos = ios;
+} /* WinCreateBitmap */
+
+void WinDisposeBitmap (GdkPixbuf *pixbuf)
+{
+ printf("WinDisposeBitmap\n");
+ gdk_pixbuf_unref(pixbuf);
+}
+
+
+/*-----------------------------
+ Font stuff
+ -----------------------------*/
+
+void WinSetFont (CLEAN_STRING fontName, gint style, gint size,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetFont\n");
+ if (theFont) gdk_font_unref(theFont);
+
+ pango_font_description_set_family(theFontDesc,cstring(fontName));
+ pango_font_description_set_weight(theFontDesc,(style & iBold) ? PANGO_WEIGHT_BOLD : PANGO_WEIGHT_NORMAL);
+ pango_font_description_set_style(theFontDesc,(style & iItalic) ? PANGO_STYLE_ITALIC : PANGO_STYLE_NORMAL);
+ /* plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE; */
+ /* plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE; */
+ pango_font_description_set_size(theFontDesc, size*PANGO_SCALE);
+ theFont = gdk_font_from_description(theFontDesc);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinSetFont */
+
+void WinGetFontInfo (CLEAN_STRING fontName, gint style, gint size,
+ gint drawablePassed, GdkDrawable *drawable, OS ios,
+ gint *ascent, gint *descent, gint *maxwidth,
+ gint *leading, OS* oos )
+{
+ PangoContext *pc;
+ PangoFontset *fontset;
+ PangoFontMetrics *metrics;
+ PangoFontDescription *fontDesc;
+ GtkWidget *widget;
+ gchar *fName;
+ gboolean inDrawIsWidget;
+ printf("WinGetFontInfo\n");
+
+ fName = cstring(fontName);
+ inDrawIsWidget = GTK_IS_WIDGET(drawable);
+
+ printf("WinGetFontInfo - %d\n",drawable);
+ if (! inDrawIsWidget)
+ {
+ widget = gtk_label_new(NULL);
+ drawablePassed = 0;
+ } else {widget=GTK_WIDGET(drawable);}
+ pc = gtk_widget_get_pango_context(widget);
+ fontDesc = pango_font_description_new();
+
+ printf("Font Name: %s\n", fName);
+ pango_font_description_set_family(fontDesc,fName);
+ pango_font_description_set_weight(fontDesc,(style & iBold) ? PANGO_WEIGHT_BOLD : PANGO_WEIGHT_NORMAL);
+ pango_font_description_set_style(fontDesc,(style & iItalic) ? PANGO_STYLE_ITALIC : PANGO_STYLE_NORMAL);
+ /* plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE; */
+ /* plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE; */
+ pango_font_description_set_size(fontDesc, size*PANGO_SCALE);
+
+ pango_context_set_font_description(pc, fontDesc);
+ metrics = pango_context_get_metrics (pc, fontDesc,
+ pango_context_get_language(pc));
+
+
+ *ascent = PANGO_PIXELS(pango_font_metrics_get_ascent(metrics));
+ *descent = PANGO_PIXELS(pango_font_metrics_get_descent(metrics));
+ *maxwidth = PANGO_PIXELS(pango_font_metrics_get_approximate_char_width(metrics));
+ *leading = 2; /* FIXME */
+
+ /* Pango gets the heights a bit wrong, so fudge it. */
+ *ascent = (*ascent) + 1;
+ *descent = (*descent) + 1;
+
+ printf("About to free font description\n");
+ g_object_unref(G_OBJECT(pc));
+ if (! inDrawIsWidget)
+ {
+ gtk_widget_destroy(widget);
+ }
+ pango_font_metrics_unref(metrics);
+ pango_font_description_free(fontDesc);
+ printf("Freed it.\n");
+ /* Connect the input and output */
+ *oos = ios;
+} /* WinGetFontInfo */
+
+void WinGetPicFontInfo (GdkDrawable *inDraw, OS ios, gint *ascent,
+ gint *descent, gint *maxwidth, gint *leading,
+ GdkDrawable **outDraw, OS *oos)
+{
+ PangoFontset *fontset;
+ PangoFontMetrics *metrics;
+
+ printf("WinGetPicFontInfo\n");
+ fontset = pango_font_map_load_fontset
+ (pango_ft2_font_map_for_display(),
+ gdk_pango_context_get(),
+ theFontDesc,
+ pango_language_from_string("EN"));
+ metrics = pango_fontset_get_metrics(fontset);
+ *ascent = pango_font_metrics_get_ascent(metrics);
+ *descent = pango_font_metrics_get_descent(metrics);
+ *maxwidth = pango_font_metrics_get_approximate_char_width(metrics);
+ *leading = 2; /* FIXME */
+ pango_font_metrics_unref(metrics);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinGetPicFontInfo */
+
+void WinGetPicStringWidth (CLEAN_STRING string, GdkDrawable *inDraw, OS ios,
+ gint *width, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinGetPicStringWidth\n");
+ *width = gdk_string_width(theFont, cstring(string));
+ printf("Width: %d, String: %s\n", *width, cstring(string));
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinGetPicStringWidth */
+
+void WinGetPicCharWidth (gchar ch, GdkDrawable *inDraw, OS ios, gint *width,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinGetPicCharWidth\n");
+ *width = gdk_char_width(theFont, ch);
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinGetPicCharWidth */
+
+void WinGetStringWidth (CLEAN_STRING string, CLEAN_STRING fontName, gint style,
+ gint size, gint drawablePassed, GdkDrawable *drawable, OS ios,
+ gint *width, OS *oos)
+{
+ GdkFont *font;
+ PangoFontDescription *fontDesc;
+ PangoContext *pc;
+ PangoLayout *pl;
+ GtkWidget *widget;
+ gchar* fName;
+ gboolean inDrawIsWidget;
+ printf("WinGetStringWidth\n");
+
+ fName = cstring(fontName);
+ inDrawIsWidget = GTK_IS_WIDGET(drawable);
+
+ if (! inDrawIsWidget)
+ {
+ widget = gtk_label_new(NULL);
+ }
+ else
+ {
+ widget = GTK_WIDGET(drawable);
+ }
+
+ pc = gtk_widget_get_pango_context(widget);
+ fontDesc = pango_font_description_new();
+
+ printf("Font Name: %s\n", fName);
+ pango_font_description_set_family(fontDesc,fName);
+ pango_font_description_set_weight(fontDesc,(style & iBold) ? PANGO_WEIGHT_BOLD : PANGO_WEIGHT_NORMAL);
+ pango_font_description_set_style(fontDesc,(style & iItalic) ? PANGO_STYLE_ITALIC : PANGO_STYLE_NORMAL);
+ /* plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE; */
+ /* plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE; */
+ pango_font_description_set_size(fontDesc, size*PANGO_SCALE);
+
+ pango_context_set_font_description(pc, fontDesc);
+ pl = pango_layout_new(pc);
+ pango_layout_set_text(pl, string->characters, string->length);
+ pango_layout_get_pixel_size(pl, width, NULL);
+
+ g_object_unref(G_OBJECT(pl));
+ g_object_unref(G_OBJECT(pc));
+ if (! inDrawIsWidget)
+ {
+ gtk_widget_destroy(GTK_WIDGET(widget));
+ }
+ pango_font_description_free(fontDesc);
+
+ /* HACK: Pango seems to generate overly narrow widths based on
+ * the font settings.
+ * a bit too small. So fudge it.
+ */
+ *width = *width * 1.25;
+ printf("Width: %d, String: %s\n", *width, cstring(string));
+
+ *oos = ios;
+} /* WinGetStringWidth */
+
+void WinGetCharWidth (gchar ch, CLEAN_STRING fontName, gint style, gint size,
+ gint drawablePassed, GdkDrawable *drawable, OS ios, gint* width,
+ OS *oos)
+{
+ GdkFont *font;
+ PangoFontDescription *fontDesc;
+ PangoContext *pc;
+ PangoLanguage *lang;
+ PangoFontMetrics *metrics;
+ GtkWidget *widget;
+ gchar *fName;
+ gboolean inDrawIsWidget;
+ printf("WinGetCharWidth\n");
+
+ fName = cstring(fontName);
+ inDrawIsWidget = GTK_IS_WIDGET(drawable);
+
+ if (! inDrawIsWidget)
+ {
+ widget = gtk_label_new(NULL);
+ }
+ else
+ {
+ widget = GTK_WIDGET(drawable);
+ }
+
+ pc = gtk_widget_get_pango_context(widget);
+ fontDesc = pango_font_description_new();
+ printf("Font Name: %s\n", fName);
+
+ pango_font_description_set_family(fontDesc,cstring(fontName));
+ pango_font_description_set_weight(fontDesc,(style & iBold) ? PANGO_WEIGHT_BOLD : PANGO_WEIGHT_NORMAL);
+ pango_font_description_set_style(fontDesc,(style & iItalic) ? PANGO_STYLE_ITALIC : PANGO_STYLE_NORMAL);
+ /* plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE; */
+ /* plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE; */
+ pango_font_description_set_size(fontDesc, size*PANGO_SCALE);
+ lang = pango_context_get_language(pc);
+ metrics = pango_context_get_metrics(pc, fontDesc, lang);
+
+ *width = pango_font_metrics_get_approximate_char_width(metrics);
+
+ pango_font_description_free(fontDesc);
+ pango_font_metrics_unref(metrics);
+ g_object_unref(G_OBJECT(pc));
+ if (! inDrawIsWidget)
+ {
+ gtk_widget_destroy(widget);
+ }
+
+ *oos = ios;
+} /* WinGetCharWidth */
+
+
+void getResolutionC(GdkDrawable *drawable, int *xResP, int *yResP)
+{
+ printf("getResolutionC\n");
+ *xResP = gdk_screen_width();
+ *yResP = gdk_screen_height();
+} /* getResolutionC */
+
+void WinGetPictureScaleFactor(GdkDrawable* inDraw, OS ios, gint *nh, gint *dh,
+ gint *nv, gint *dv, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinGetPictureScaleFactor\n");
+ *nh = 1;
+ *dh = 1;
+ *nv = 1;
+ *dv = 1;
+ *outDraw = inDraw;
+ *oos = ios;
+} /* WinGetPictureScaleFactor */
+
+void WinDefaultFontDef(gchar **fname, gint *fstyle, gint *fsize)
+{
+ printf("WinDefaultFontDef\n");
+ *fname = "helvetica";
+ *fstyle = 0;
+ *fsize = 12;
+}
+
+void WinDialogFontDef(gchar **fname, gint *fstyle, gint *fsize)
+{
+ printf("WinDialogFontDef\n");
+ *fname = "helvetica";
+ *fstyle = 0;
+ *fsize = 12;
+}
+
+void WinSerifFontDef(gchar **fname, gint *fstyle, gint *fsize)
+
+{
+ printf("WinSerifFontDef\n");
+ *fname = "times";
+ *fstyle = 0;
+ *fsize = 10;
+}
+
+void WinSansSerifFontDef(gchar **fname, gint *fstyle, gint *fsize)
+
+{
+ printf("WinSansSerifFontDef\n");
+ *fname = "helvetica";
+ *fstyle = 0;
+ *fsize = 10;
+}
+
+void WinSmallFontDef(gchar **fname, gint *fstyle, gint *fsize)
+{
+ printf("WinSmallFontDef\n");
+ *fname = "helvetica";
+ *fstyle = 0;
+ *fsize = 7;
+}
+
+void WinNonProportionalFontDef(gchar **fname, gint *fstyle, gint *fsize)
+{
+ printf("WinNonProportionalFontDef\n");
+ *fname = "fixed";
+ *fstyle = 0;
+ *fsize = 10;
+}
+
+void WinSymbolFontDef(gchar **fname, gint *fstyle, gint *fsize)
+{
+ printf("WinSymbolFontDef\n");
+ *fname = "adobe-symbol";
+ *fstyle = 0;
+ *fsize = 10;
+}
+
+void WinCombineRgn (GdkRegion *dest, GdkRegion *src1, GdkRegion *src2,
+ gint fnCombineMode, OS ios, GdkRegion **outDest, OS *oos)
+{
+ printf("WinCombineRgn\n");
+ dest = gdk_region_copy(src1);
+
+ switch(fnCombineMode)
+ {
+ case RGN_AND:
+ printf("RGN_AND\n");
+ gdk_region_intersect(dest, src2);
+ break;
+ case (RGN_OR):
+ printf("RGN_OR\n");
+ gdk_region_union(dest, src2);
+ break;
+ case (RGN_DIFF):
+ printf("RGN_DIFF\n");
+ gdk_region_subtract(dest, src2);
+ break;
+ case (RGN_XOR):
+ printf("RGN_XOR\n");
+ gdk_region_xor(dest, src2);
+ break;
+ case (RGN_COPY):
+ default:
+ /* We already copied the region, so just return it */
+ printf("RGN_COPY\n");
+ break;
+ }
+
+ *outDest = dest;
+ *oos = ios;
+}
+
+void WinSetRgnToRect (gint left, gint top, gint right, gint bottom,
+ GdkRegion *rgn, OS ios, GdkRegion **orgn, OS *oos)
+{
+ GdkRegion* r = NULL;
+ printf("WinSetRgnToRect --> Not Implemented\n");
+ *orgn = rgn;
+ *oos = ios;
+}
+
+/*
+ * Review of source indicates this is always called on a GdkRegion*
+ */
+OS WinDeleteObject (GdkRegion* region, OS ios)
+{
+ printf("WinDeleteObject\n");
+ if (region)
+ {
+ gdk_region_destroy(region);
+ }
+ return ios;
+}
+
+void WinClipPicture (gint left, gint top, gint right, gint bot,
+ GdkDrawable *drawable, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+ printf("WinClipPicture\n");
+
+ /* Do something here */
+
+ *outDraw = drawable;
+ *oos = ios;
+}
+
+void InternalGetPenPos (GdkDrawable *context, gint *x, gint *y)
+{
+ GdkPoint *p;
+ printf("InternalGetPenPos: ");
+ p = (GdkPoint*)(g_object_get_data(G_OBJECT(context), PEN_POS_KEY));
+ if (p)
+ {
+ *x = p->x;
+ *y = p->y;
+ rprintf("Pen Pos: (%d, %d)\n", *x, *y);
+ } else {
+ rprintf("No data for current-pen-position.\n");
+ }
+}
+
+void InternalSetPenPos (GdkDrawable *context, gint x, gint y)
+{
+ GdkPoint *p;
+ printf("InternalSetPenPos\n");
+
+ p = g_new(GdkPoint,1);
+ printf("InternalSetPenPos: (%d, %d)\n", x, y);
+
+ p->x = x;
+ p->y = y;
+ g_object_set_data(G_OBJECT(context), PEN_POS_KEY, (gpointer)p);
+}
+
+void WinGetPenPos (GdkDrawable *inDraw, OS ios, gint *x, gint *y,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinGetPenPos\n");
+
+ InternalGetPenPos(inDraw, x, y);
+
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinMovePenTo (gint x, gint y, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinMovePenTo\n");
+
+ InternalSetPenPos(inDraw, x, y);
+
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinMovePen (gint dx, gint dy, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ gint x, y;
+
+ printf("WinMovePen\n");
+ InternalGetPenPos(inDraw, &x, &y);
+ x += dx;
+ y += dy;
+
+ InternalSetPenPos(inDraw, x, y);
+
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinDrawCPoint (gint x, gint y, gint red, gint green, gint blue,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawCPoint --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinDrawCLine (gint startX, gint startY, gint endX, gint endY, gint red,
+ gint green, gint blue, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawCLine --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinDrawCCurve (gint left, gint top, gint right, gint bot, gint startradx,
+ gint startrady, gint endradx, gint endrady, gint red,
+ gint green, gint blue, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS * oos)
+{
+ printf("WinDrawCCurve --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinScrollRectangle2 (gint left, gint top, gint right, gint bot, gint width,
+ gint height, GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw,
+ OS *oos)
+{
+ printf("WinScrollRectangle2 --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinDrawRoundRectangle (gint left, gint top, gint right, gint bottom,
+ gint width, gint height, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawRoundRectangle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinFillRoundRectangle (gint left, gint top, gint right, gint bot,
+ gint width, gint height, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinFillRoundRectangle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinEraseRoundRectangle (gint left, gint top, gint right, gint bot,
+ gint width, gint height, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinEraseRoundRectangle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinInvertRoundRectangle (gint left, gint top, gint right, gint bot,
+ gint width, gint height, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinInvertRoundRectangle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinDrawCircle (gint centerx, gint centery, gint radius,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinDrawCircle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinFillCircle (gint centerx, gint centery, gint radius,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinFillCircle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinEraseCircle (gint centerx, gint centery, gint radius,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinEraseCircle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinInvertCircle (gint centerx, gint centery, gint radius,
+ GdkDrawable *inDraw, OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinInvertCircle --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinDrawWedge (gint left, gint top, gint right, gint bottom, gint startradx,
+ gint startrady, gint endradx, gint endrady, GdkDrawable *inDraw,
+ OS ios, GdkDrawable **outDraw, OS *oos)
+{
+ gint cx, cy;
+ gint x = left;
+ gint y = top;
+ gint rx = right;
+ gint ry = bottom;
+ gfloat from = startradx;
+ gfloat to = startrady;
+ gboolean clockwise = TRUE;
+
+ printf("WinDrawWedge --> Not Implemented\n");
+
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinPrintResizedBitmap (gint sz2, gint sy2, gint dx1, gint dy1, gint dw,
+ gint dh, gchar* ptr, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinPrintResizedBitmap --> Not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinSetFontName (CLEAN_STRING fontName, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetFontName --> Not Implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinSetFontSize (gint size, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetFontSize: %d\n", size);
+ pango_font_description_set_size(theFontDesc, size*PANGO_SCALE);
+ theFont = gdk_font_from_description(theFontDesc);
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinSetFontStyle (gint style, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinSetFontStyle: %d\n", style);
+ pango_font_description_set_style(theFontDesc,(style & iItalic) ? PANGO_STYLE_ITALIC : PANGO_STYLE_NORMAL);
+ /* plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE; */
+ /* plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE; */
+ theFont = gdk_font_from_description(theFontDesc);
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+gint WinGetVertResolution (void)
+{
+ static gint res = 0;
+ printf("WinGetVertResolution\n");
+
+ InitGTK();
+
+ if (res == 0)
+ {
+ GdkScreen* screen;
+ GdkWindow* window;
+ GdkRectangle rect;
+
+ InitGTK();
+ screen = gdk_screen_get_default();
+ window = gdk_screen_get_root_window(screen);
+ gdk_window_get_frame_extents(window, &rect);
+
+ res = rect.height;
+ g_object_unref(window);
+ }
+
+ return res;
+}
+
+gint WinGetHorzResolution (void)
+{
+ static gint res = 0;
+ printf("WinGetHorzResolution\n");
+
+ InitGTK();
+
+ if (res == 0)
+ {
+ GdkScreen* screen;
+ GdkWindow* window;
+ GdkRectangle rect;
+
+ screen = gdk_screen_get_default();
+ window = gdk_screen_get_root_window(screen);
+ gdk_window_get_frame_extents(window, &rect);
+
+ res = rect.width;
+ g_object_unref(window);
+ }
+
+ return res;
+}
+
+void WinLinePen (gint x, gint y, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinLinePen --> Not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinLinePenTo (gint x, gint y, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos)
+{
+ printf("WinLinePenTo --> Not implemented\n");
+ *outDraw = inDraw;
+ *oos = ios;
+}
+
+void WinCreateEllipseRgn(gint nLeftRect, gint nTopRect, gint nRightRect,
+ gint nBottomRect, OS ios, GdkRegion* rgn, OS* oos)
+{
+ printf("WinCreateEllipseRgn --> Not Implemented\n");
+ *oos = ios;
+}
diff --git a/Linux_C_12/cpicture_121.h b/Linux_C_12/cpicture_121.h new file mode 100644 index 0000000..d6b564a --- /dev/null +++ b/Linux_C_12/cpicture_121.h @@ -0,0 +1,191 @@ +#include "util_121.h"
+#include "intrface_121.h"
+#include <math.h>
+
+#define RGN_AND 1 /* Creates the intersection of the two regions */
+#define RGN_OR 2 /* creates the union of the two regions */
+#define RGN_DIFF 3 /* Returns the parts of region1 not in region2 */
+#define RGN_XOR 4 /* creates the union (not including overlap) */
+#define RGN_COPY 5 /* Creates a copy of the region */
+
+extern void WinGetDC (OSWindowPtr, OS, OSPictContext*, OS*);
+extern OS WinReleaseDC (OSWindowPtr,OSPictContext,OS);
+extern int OsMMtoVPixels(double);
+extern int OsMMtoHPixels(double);
+
+void WinInitPicture (int size, int mode, int pr, int pg, int pb,
+ int br, int bg, int bb, int x, int y,
+ CLEAN_STRING fname, int fstyle, int fsize,
+ int ox, int oy, OSPictContext inDraw, OS os,
+ OSPictContext *outDraw, OS *oos);
+extern void WinDonePicture (OSPictContext,OS,int*,int*,int*,int*,int*,
+ int*,int*,int*,int*,int*,CLEAN_STRING*,int*,int*,
+ OSPictContext*,OS*);
+
+extern void WinClipRgnPicture(OSRgnHandle,OSPictContext,OS,
+ OSPictContext*,OS*);
+extern void WinClipPicture (int,int,int,int,OSPictContext,OS,
+ OSPictContext*,OS*);
+extern void WinSetClipRgnPicture (OSRgnHandle,OSPictContext,OS,
+ OSPictContext*,OS*);
+extern void WinGetClipRgnPicture (OSPictContext,OS,OSRgnHandle*,OSPictContext*,OS*);
+
+/* Operations to create, modify, and destroy polygon shapes.
+*/
+extern void WinAllocPolyShape (int,OS,PointsArray*,OS*);
+extern OS WinSetPolyPoint (int,int,int,PointsArray, OS);
+extern OS WinFreePolyShape (PointsArray,OS);
+
+/* Operations to create, modify and destroy regions.
+*/
+extern OSRgnHandle WinCreateEmptyRgn();
+extern void WinCreateRectRgn(int,int,int,int,OS,OSRgnHandle*,OS*);
+extern void WinCreatePolygonRgn(PointsArray,int,int,OS,OSRgnHandle*,OS*);
+extern void WinSetRgnToRect(int,int,int,int,OSRgnHandle,OS,OSRgnHandle*,OS*);
+/* extern OSRgnHandle WinCombineRgn (HRGN,HRGN,HRGN,int,OS,HRGN*,OS*); */
+extern void WinCombineRgn (OSRgnHandle,OSRgnHandle,OSRgnHandle,int,OS,
+ OSRgnHandle*,OS*);
+extern OSRgnHandle WinUnionRgn(OSRgnHandle rgn1, OSRgnHandle rgn2);
+extern OSRgnHandle WinSectRgn(OSRgnHandle rgn1, OSRgnHandle rgn2);
+extern OSRgnHandle WinDiffRgn(OSRgnHandle rgn1, OSRgnHandle rgn2);
+extern OSRgnHandle WinXorRgn (OSRgnHandle rgn1, OSRgnHandle rgn2);
+extern void WinGetRgnBox(OSRgnHandle,OS,int*,int*,int*,int*,BOOL*,BOOL*,OS*);
+extern BOOL WinIsEmptyRgn(OSRgnHandle rgn);
+extern void WinDisposeRgn(OSRgnHandle rgn);
+
+extern void WinSetPenSize (int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinSetPenColor (int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinSetBackColor (int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinSetMode (int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinSetPattern (int,OSPictContext,OS,OSPictContext*,OS*);
+
+extern void WinDrawPoint (int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinDrawLine (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinUndrawLine(int,int,int,int,OSPictContext);
+extern void WinDrawCurve (int,int,int,int,int,int,int,int,OSPictContext,OS,
+ OSPictContext*,OS*);
+extern void WinUndrawCurve (int,int,int,int,float,float,BOOL,OSPictContext);
+
+extern void WinDrawChar (char,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinUndrawChar (int,int,char,OSPictContext);
+extern void WinDrawString (CLEAN_STRING,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinUndrawString (int,int,char*,OSPictContext);
+
+extern void WinDrawRectangle (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinUndrawRectangle (int,int,int,int,OSPictContext);
+extern void WinFillRectangle (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinEraseRectangle (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinInvertRectangle (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinMoveRectangleTo (int,int,int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinMoveRectangle (int,int,int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinCopyRectangleTo (int,int,int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinCopyRectangle (int,int,int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinScrollRectangle (int,int,int,int,int,int,OSPictContext,OS,int*,int*,int*,int*,OSPictContext*,OS*);
+
+extern void WinDrawOval (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinUndrawOval (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinFillOval (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinEraseOval (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinInvertOval (int,int,int,int,OSPictContext,OS,OSPictContext*,OS*);
+
+extern void WinFillWedge (int,int,int,int,int,int,int,int,OSPictContext,
+ OS,OSPictContext*,OS*);
+extern void WinEraseWedge (int,int,int,int,int,int,int,int,OSPictContext,
+ OS,OSPictContext*,OS*);
+extern void WinInvertWedge (int,int,int,int,int,int,int,int,OSPictContext,
+ OS,OSPictContext*,OS*);
+
+extern OS WinStartPolygon (int,OS);
+extern OS WinEndPolygon (OS);
+extern OS WinAddPolygonPoint (int,int,OS);
+extern void WinDrawPolygon (OSPictContext,OS,OSPictContext*,OS*);
+extern void WinUndrawPolygon (OSPictContext);
+extern void WinFillPolygon (OSPictContext,OS,OSPictContext*,OS*);
+extern void WinErasePolygon (OSPictContext,OS,OSPictContext*,OS*);
+extern void WinInvertPolygon (OSPictContext,OS,OSPictContext*,OS*);
+
+/*
+ * Routines that temporarily create and destroy a DISPLAY OSPictContext. Use
+ * this OSPictContext only locally.
+ */
+extern void WinCreateScreenHDC (OS,OSPictContext*,OS*);
+extern OS WinDestroyScreenHDC (OSPictContext,OS);
+
+extern void WinDrawResizedBitmap (int,int,int,int,int,int,OSBmpHandle,
+ OSPictContext,OS,OSPictContext*,OS*);
+extern void WinDrawBitmap (int,int,int,int,OSBmpHandle,OSPictContext,OS,
+ OSPictContext*,OS*);
+extern void WinCreateBitmap (int, char*,OSPictContext,OS,OSBmpHandle*,OS*);
+extern void WinDisposeBitmap(OSBmpHandle);
+
+extern void WinSetFont (CLEAN_STRING,int,int,OSPictContext,OS,OSPictContext*,OS*);
+extern void WinGetFontInfo (CLEAN_STRING,int,int,int,OSPictContext,OS,
+ int*,int*,int*,int*,OS*);
+extern void WinGetPicFontInfo (OSPictContext,OS,int*,int*,int*,int*,
+ OSPictContext*,OS*);
+
+extern void WinGetPicStringWidth (CLEAN_STRING,OSPictContext,OS,int*,OSPictContext*,OS*);
+extern void WinGetPicCharWidth (char,OSPictContext,OS,int*,OSPictContext*,OS*);
+extern void WinGetStringWidth (CLEAN_STRING,CLEAN_STRING,int,int,int,
+ OSPictContext,OS,int*,OS*);
+extern void WinGetCharWidth (char,CLEAN_STRING,int,int,int,OSPictContext,
+ OS,int*,OS*);
+
+/* Get the resolution of a picture */
+extern void getResolutionC(OSPictContext,int*,int*);
+
+/*
+ * Get scaling factors, which have to be applied to coordinates for clipping
+ * regions in case of emulating the screen resolution for printing
+ * (MM_ISOTROPIC)
+ */
+extern void WinGetPictureScaleFactor(OSPictContext,OS,int*,int*,int*,int*,
+ OSPictContext*,OS*);
+
+void WinDialogFontDef(char **fname, int *fstyle, int *fsize);
+void WinDefaultFontDef(char **fname, int *fstyle, int *fsize);
+void WinSerifFontDef(char **fname, int *fstyle, int *fsize);
+void WinSansSerifFontDef(char **fname, int *fstyle, int *fsize);
+void WinSmallFontDef(char **fname, int *fstyle, int *fsize);
+void WinNonProportionalFontDef(char **fname, int *fstyle, int *fsize);
+void WinSymbolFontDef(char **fname, int *fstyle, int *fsize);
+
+extern void WinLinePen (int x, int y, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos);
+extern void WinLinePenTo (int x, int y, GdkDrawable *inDraw, OS ios,
+ GdkDrawable **outDraw, OS *oos);
+
+extern int WinGetVertResolution (void);
+extern int WinGetHorzResolution (void);
+
+extern void WinCreateEllipseRgn (int,int,int,int,OS,GdkRegion*,OS*);
+extern OS WinDeleteObject (GdkRegion*,OS);
+extern void WinGetPenPos(GdkDrawable*, OS, int*, int*, GdkDrawable**, OS* );
+extern void WinMovePenTo (int,int,GdkDrawable*,OS,GdkDrawable**,OS*);
+extern void WinMovePen (int,int,GdkDrawable*,OS,GdkDrawable**,OS*);
+extern void WinDrawCPoint (int,int,int,int,int,GdkDrawable*,
+ OS,GdkDrawable**,OS*);
+extern void WinDrawCLine (int,int,int,int,int,int,int,GdkDrawable*,OS,
+ GdkDrawable**,OS*);
+extern void WinDrawCCurve (int,int,int,int,int,int,int,int,int,int,int,
+ GdkDrawable*,OS,GdkDrawable**,OS*);
+extern void WinDrawRoundRectangle (int,int,int,int,int,int,GdkDrawable*,
+ OS,GdkDrawable**,OS*);
+extern void WinFillRoundRectangle (int,int,int,int,int,int,GdkDrawable*,
+ OS,GdkDrawable**,OS*);
+extern void WinEraseRoundRectangle (int,int,int,int,int,int,GdkDrawable*,
+ OS,GdkDrawable**,OS*);
+extern void WinInvertRoundRectangle (int,int,int,int,int,int,GdkDrawable*,
+ OS,GdkDrawable**,OS*);
+extern void WinDrawCircle (int,int,int,GdkDrawable*,OS,GdkDrawable**,OS*);
+extern void WinFillCircle (int,int,int,GdkDrawable*,OS,GdkDrawable**,OS*);
+extern void WinEraseCircle (int,int,int,GdkDrawable*,OS,GdkDrawable**,OS*);
+extern void WinInvertCircle (int,int,int,GdkDrawable*,OS,GdkDrawable**,OS*);
+
+extern void WinDrawWedge (int,int,int,int,int,int,int,int,GdkDrawable*,
+ OS,GdkDrawable**,OS*);
+extern void WinPrintResizedBitmap (int,int,int,int,int,int,char*,GdkDrawable*,
+ int,GdkDrawable**,int*);
+
+static void InternalGetPenPos( GdkDrawable*, int*, int*);
+static void InternalSetPenPos( GdkDrawable*, int, int);
diff --git a/Linux_C_12/cprinter_121.c b/Linux_C_12/cprinter_121.c new file mode 100644 index 0000000..8e635a3 --- /dev/null +++ b/Linux_C_12/cprinter_121.c @@ -0,0 +1,602 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library and Clean 0.8 I/O library
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Routines related to printing.
+********************************************************************************************/
+
+#include "util_121.h"
+#include "cpicture_121.h"
+
+#include "cprinter_121.h"
+
+BOOL bUserAbort;
+int semaphor=0;
+
+#if 0
+HWND hDlgPrint;
+HWND hwndButton,hwndText;
+
+extern HWND ghMainWindow;
+extern HINSTANCE ghInst;
+#else
+#define CALLBACK
+#define APIENTRY
+typedef void* HANDLE;
+typedef void* HWND;
+typedef void* DEVMODE;
+typedef void* PRINTDLG;
+typedef void** LPHANDLE;
+typedef char* LPCTSTR;
+#endif
+
+
+#define tachtig 80
+void getDevmodeSizeC(int *size, HANDLE *phPrinter,
+ char **device, char **driver, char **output)
+{
+#if 0
+ char szPrinter[80];
+ char *szDevice, *szDriver, *szOutput;
+
+ GetProfileString("windows", "device", ",,,", szPrinter, 80);
+ szDevice = strtok(szPrinter,",");
+ szDriver = strtok(NULL,", ");
+ szOutput = strtok(NULL,", ");
+ *device = g_strdup(szDevice);
+ *driver = g_strdup(szDriver);
+ *output = g_strdup(szOutput);
+ if (*szDevice=='\0' || *szDriver=='\0' || *szOutput=='\0')
+ {
+ *size = 0;
+ return;
+ };
+ OpenPrinter(szDevice,phPrinter,NULL);
+ *size = DocumentProperties(NULL,*phPrinter,szDevice,NULL,NULL,0);
+#endif
+}
+
+void getDefaultDevmodeC(char *printSetup, LPHANDLE phPrinter, char **device)
+{
+#if 0
+ int size,r1;
+
+ size = ((int*)printSetup)[0];
+ printSetup +=4;
+ r1 = DocumentProperties(NULL,phPrinter,((char*)device)+4,
+ (DEVMODE*)printSetup,NULL,DM_OUT_BUFFER);
+ ClosePrinter(phPrinter);
+#endif
+}
+
+#if 0
+static HDC myCreateIC(LPCTSTR driver, LPCTSTR device, DEVMODE *devmode)
+{
+ HDC icPrint;
+
+ icPrint = CreateIC(driver,device,NULL,devmode);
+ if (!icPrint)
+ icPrint = CreateIC(driver,device,NULL,devmode);
+ /* try once again. Adobe printer drivers sometimes need to be told everything twice */
+ return icPrint;
+}
+#endif
+
+#define GetDeviceCapsWithDefault(icPrint, index, defaullt) (icPrint ? GetDeviceCaps(icPrint, index) : defaullt)
+
+void os_getpagedimensionsC( DEVMODE *devmode, char *device, char *driver,
+ int emulateScreenRes,
+ int *maxX, int *maxY,
+ int *leftPaper, int *topPaper,
+ int *rightPaper, int *bottomPaper,
+ int *xRes, int *yRes
+ )
+{
+#if 0
+ HDC icPrint;
+ int horPaperPixels, verPaperPixels,
+ xResolution,yResolution,
+ scNX, scNY, scDX, scDY;
+
+
+ icPrint = myCreateIC(driver,device, devmode);
+
+ xResolution = GetDeviceCapsWithDefault(icPrint, LOGPIXELSX, 300);
+ yResolution = GetDeviceCapsWithDefault(icPrint, LOGPIXELSY, 300);
+ if (emulateScreenRes) /* for emulation of the screen resolution */
+ {
+ scNX = WinGetHorzResolution(); /* all the deviceCaps will be scaled */
+ scNY = WinGetVertResolution();
+ scDX = xResolution;
+ scDY = yResolution;
+ }
+ else
+ { scNX = 1; scNY = 1; scDX = 1; scDY = 1; };
+
+ horPaperPixels = (GetDeviceCapsWithDefault(icPrint, PHYSICALWIDTH, 2246)*scNX)/scDX;
+ verPaperPixels = (GetDeviceCapsWithDefault(icPrint, PHYSICALHEIGHT, 3250)*scNY)/scDY;
+
+ *maxX = (GetDeviceCapsWithDefault(icPrint, HORZRES, 2241)*scNX)/scDX;
+ *maxY = (GetDeviceCapsWithDefault(icPrint, VERTRES, 3254)*scNY)/scDY;
+
+ *leftPaper = (-GetDeviceCapsWithDefault(icPrint, PHYSICALOFFSETX, 116)*scNX)/scDX;
+ *topPaper = (-GetDeviceCapsWithDefault(icPrint, PHYSICALOFFSETY, 129)*scNY)/scDY;
+ *rightPaper = horPaperPixels - *leftPaper;
+ *bottomPaper = verPaperPixels - *topPaper;
+
+ if (emulateScreenRes)
+ { *xRes = scNX; *yRes = scNY; }
+ else
+ { *xRes = xResolution ; *yRes = yResolution; };
+ DeleteDC(icPrint);
+#endif
+}
+
+static HANDLE setupDevnames(int deviceLength,int driverLength,int outputLength,
+ char *device,char *driver,char *output)
+{
+ HANDLE hDevnames;
+#if 0
+ DEVNAMES *pDevnames;
+ hDevnames = (HANDLE) LocalAlloc(LMEM_MOVEABLE, 16+deviceLength+driverLength+outputLength);
+ pDevnames = LocalLock(hDevnames);
+ pDevnames->wDriverOffset = 16;
+ pDevnames->wDeviceOffset = 16+driverLength;
+ pDevnames->wOutputOffset = 16+driverLength+deviceLength;
+ pDevnames->wDefault = 0;
+ strcpy(((char*)pDevnames)+pDevnames->wDriverOffset, driver);
+ strcpy(((char*)pDevnames)+pDevnames->wDeviceOffset, device);
+ strcpy(((char*)pDevnames)+pDevnames->wOutputOffset, output);
+ LocalUnlock(hDevnames);
+#endif
+ return hDevnames;
+}
+
+static HANDLE setupDevmode(int size, char *pData)
+{
+ HANDLE hDevmode;
+#if 0
+ DEVMODE *pDevmode;
+
+ hDevmode = (HANDLE) LocalAlloc(LMEM_MOVEABLE, size);
+ pDevmode = LocalLock(hDevmode);
+ memcpy((char*)pDevmode, pData, size);
+ LocalUnlock(hDevmode);
+#endif
+ return hDevmode;
+}
+
+void get_printSetup_with_PRINTDLG(PRINTDLG *pd, char **o_devmode,
+ char **o_device, char **o_driver, char **o_output)
+{
+#if 0
+ char *newDriver, *newDevice, *newOutput;
+ DEVMODE *pDevmode;
+ DEVNAMES *pDevnames;
+
+ pDevmode = LocalLock(pd->hDevMode);
+ *o_devmode = g_strdup(pDevmode->dmDeviceName);
+ LocalUnlock(pd->hDevMode);
+ pDevnames = LocalLock(pd->hDevNames);
+ newDriver = ((char*)pDevnames)+(pDevnames->wDriverOffset);
+ newDevice = ((char*)pDevnames)+(pDevnames->wDeviceOffset);
+ newOutput = ((char*)pDevnames)+(pDevnames->wOutputOffset);
+ *o_driver = g_strdup(newDriver);
+ *o_device = g_strdup(newDevice);
+ *o_output = g_strdup(newOutput);
+ LocalUnlock(pd->hDevNames);
+#endif
+}
+
+/* PA: called in Clean. */
+int release_memory_handles(PRINTDLG *pd, int os) {
+#if 0
+ LocalFree(pd->hDevNames);
+ LocalFree(pd->hDevMode);
+#endif
+ return os;
+ }
+
+/*
+ * This function hooks the Print dialog. It's purpose is to set the dialog in
+ * the foreground.
+ */
+static UINT APIENTRY DialogToFrontHook(HWND hdl, UINT msg, WPARAM wParam, LPARAM lParam)
+{
+#if 0
+ if (msg==WM_INITDIALOG)
+ { SetForegroundWindow(hdl);
+ };
+#endif
+ return FALSE;
+}
+
+void printSetup(int calledFromCleanThread, int devmodeSize,
+ char *devmode, char *device, char *driver, char *output,
+ int *ok, PRINTDLG **pdPtr)
+{
+#if 0
+ int deviceLength, driverLength, outputLength;
+ HANDLE hDevnames,hDevmode;
+ static PRINTDLG pd;
+
+ /* Set up DEVNAMES structure */
+
+ /*rMessageBox(NULL, MB_APPLMODAL, "in printSetup", ""); */
+ deviceLength = strlen(device)+1;
+ driverLength = strlen(driver)+1;
+ outputLength = strlen(output)+1;
+
+ hDevnames = setupDevnames(deviceLength,driverLength,outputLength,device,driver,output);
+
+ /* Set up DEVMODE structure */
+ hDevmode = setupDevmode(devmodeSize,devmode);
+
+ /* Set up print dialog record */
+ pd.lStructSize = sizeof(PRINTDLG);
+ pd.hwndOwner = calledFromCleanThread ? NULL : ghMainWindow; /* (NULL = desktop) */
+/* pd.hwndOwner = NULL; // (NULL = desktop) */
+ /*
+ * The handle must belong to the active thread, otherwise PrintDlg
+ * will crash. When this function is called from the Clean thread,
+ * ghMainWindow will not belong to the active thread.
+ */
+ pd.hDevMode = hDevmode;
+ pd.hDevNames = hDevnames;
+ pd.hDC = NULL;
+ pd.Flags = PD_PRINTSETUP | PD_ENABLESETUPHOOK;
+ pd.nFromPage = 1;
+ pd.nToPage = 1;
+ pd.nMinPage = 1;
+ pd.nMaxPage = USHRT_MAX;
+ pd.nCopies = 1;
+ pd.hInstance = NULL;
+ pd.lCustData = 0L;
+ pd.lpfnPrintHook = NULL;
+ pd.lpfnSetupHook = DialogToFrontHook;
+ pd.lpPrintTemplateName = NULL;
+ pd.lpSetupTemplateName = NULL;
+ pd.hPrintTemplate = NULL;
+ pd.hSetupTemplate = NULL;
+
+ /* Open print dialog */
+ *ok = PrintDlg(&pd);
+ *pdPtr = &pd;
+
+ if (hDevnames!=pd.hDevNames) LocalFree(hDevnames);
+ if (hDevmode!=pd.hDevMode) LocalFree(hDevmode);
+#endif
+}
+
+
+int startPage(int hdc)
+{
+#if 0
+ /*rMessageBox(NULL, MB_APPLMODAL, "in startPage", ""); */
+ return StartPage((HDC) hdc) > 0;
+#else
+ return 0;
+#endif
+}
+
+int endPage(int hdc)
+{
+#if 0
+ /*rMessageBox(NULL, MB_APPLMODAL, "in endPage", ""); */
+ return EndPage((HDC) hdc) > 0;
+#else
+ return 0;
+#endif
+}
+
+int startDoc(int hdc)
+ /* err code: >0:no error, <=0: user cancelled file dialog */
+{
+#if 0
+ static DOCINFO docInfo = { sizeof (DOCINFO), "Clean", NULL, NULL, 0 } ;
+
+ /*rMessageBox(NULL, MB_APPLMODAL, "in startDoc", "");*/
+ bUserAbort = FALSE ;
+
+ return StartDoc((HDC) hdc, &docInfo);
+#else
+ return 0;
+#endif
+}
+
+void endDoc(int hdc)
+{
+#if 0
+ /*rMessageBox(NULL, MB_APPLMODAL, "in endDoc", ""); */
+ if (bUserAbort)
+ AbortDoc((HDC) hdc);
+ else
+ EndDoc((HDC) hdc);
+#endif
+}
+
+void deleteDC(int hdc)
+{
+#if 0
+ /*rMessageBox(NULL, MB_APPLMODAL, "in deleteDC", ""); */
+ DeleteDC((HDC) hdc);
+#endif
+}
+
+int wasCanceled(void)
+{
+#if 0
+ /*rMessageBox(NULL, MB_APPLMODAL, "in wasCanceled", ""); */
+ return bUserAbort;
+#else
+ return 0;
+#endif
+}
+
+/* getDC opens the print job dialog and
+ * lets the user change various settings or gets the default printer
+ */
+
+/* c-strings are passed to this function ! */
+void getDC( int doDialog, int emulateScreen, int calledFromCleanThread, int devmodeLength,
+ char *devmode,char *device,char *driver,char *output,
+ int *err,
+ int *first, int *last, int *copies,
+ PRINTDLG **ppPrintDlg,
+ int *deviceContext
+ )
+ /* err code: -1:no error, others: non fatal error */
+{
+#if 0
+ static PRINTDLG pd;
+ HDC hdcPrint;
+ int ok;
+
+ *err = -1;
+
+ if (doDialog)
+ { /* Set up print dialog record */
+ HANDLE hDevnames, hDevmode;
+ int deviceLength,driverLength,outputLength;
+
+ deviceLength = strlen(device)+1;
+ driverLength = strlen(driver)+1;
+ outputLength = strlen(output)+1;
+
+ hDevnames = setupDevnames(deviceLength,driverLength,outputLength,
+ device,driver,output);
+ hDevmode = setupDevmode(devmodeLength,devmode);
+
+ pd.lStructSize = sizeof(PRINTDLG);
+ pd.hwndOwner = calledFromCleanThread ? NULL : ghMainWindow; /* (NULL = desktop) */
+ /*
+ * The handle must belong to the active thread, otherwise PrintDlg
+ * will crash. When this function is called from the Clean thread,
+ * ghMainWindow will not belong to the active thread.
+ */
+ pd.hDevMode = hDevmode;
+ pd.hDevNames = hDevnames;
+ pd.hDC = NULL;
+ pd.Flags = PD_ALLPAGES | PD_COLLATE | PD_RETURNDC | PD_NOSELECTION
+ | PD_ENABLEPRINTHOOK;
+ /* hide some options from print dialog */
+ pd.nFromPage = 1;
+ pd.nToPage = 1;
+ pd.nMinPage = 1;
+ pd.nMaxPage = USHRT_MAX;
+ pd.nCopies = 1;
+ pd.hInstance = NULL;
+ pd.lCustData = 0L;
+ pd.lpfnPrintHook = DialogToFrontHook;
+ pd.lpfnSetupHook = NULL;
+ pd.lpPrintTemplateName = NULL;
+ pd.lpSetupTemplateName = NULL;
+ pd.hPrintTemplate = NULL;
+ pd.hSetupTemplate = NULL;
+
+ /* Open print dialog */
+
+ ok = PrintDlg(&pd);
+
+ if (hDevnames!=pd.hDevNames) LocalFree(hDevnames);
+ if (hDevmode!=pd.hDevMode) LocalFree(hDevmode);
+
+ if (!ok)
+ {
+ *err = CommDlgExtendedError(); /* will return 0 iff user canceled, otherwise positive value */
+ release_memory_handles(&pd, 0);
+ return;
+ }
+
+
+ if (pd.Flags & PD_PAGENUMS)
+ { *first = pd.nFromPage;
+ *last = pd.nToPage;
+ }
+ else
+ { *first = 1;
+ *last = 9999;
+ };
+ *copies = pd.nCopies;
+ *ppPrintDlg = &pd;
+ hdcPrint = pd.hDC;
+ }
+
+ else
+
+ {
+ hdcPrint = CreateDC(driver, device, output, NULL);
+ if (hdcPrint==NULL)
+ { *err = 0; /* non fatal error, iff e.g. no printer driver is installed */
+ return;
+ };
+ *first = 1;
+ *last = 9999;
+ *copies = 1;
+ *ppPrintDlg = NULL;
+ };
+
+ if (emulateScreen)
+ { int pXdpi,pYdpi,sXdpi,sYdpi;
+ pXdpi = GetDeviceCaps(hdcPrint, LOGPIXELSX);
+ pYdpi = GetDeviceCaps(hdcPrint, LOGPIXELSY);
+ sXdpi = WinGetHorzResolution();
+ sYdpi = WinGetVertResolution();
+ SetMapMode(hdcPrint, MM_ISOTROPIC);
+ SetWindowExtEx (hdcPrint,sXdpi, sYdpi, NULL);
+ SetViewportExtEx(hdcPrint,pXdpi, pYdpi, NULL);
+ };
+
+ *deviceContext = (int) hdcPrint;
+ /*rMessageBox(NULL, MB_APPLMODAL, "leaving getDC","");*/
+#endif
+}
+
+
+#if 0
+BOOL CALLBACK PrintDlgProc (HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam)
+ {
+ switch (msg)
+ {
+ case WM_INITDIALOG :
+ EnableMenuItem (GetSystemMenu (hDlg, FALSE), SC_CLOSE,
+ MF_GRAYED) ;
+ return TRUE ;
+ case WM_COMMAND :
+ bUserAbort = TRUE ;
+ EnableWindow (ghMainWindow, TRUE) ;
+ DestroyWindow (hDlg) ;
+ hDlgPrint = 0 ;
+ return TRUE ;
+ }
+ return FALSE;
+ }
+
+BOOL CALLBACK AbortProc (HDC hdcPrn, int iCode)
+ {
+ MSG msg ;
+
+ while (!bUserAbort && PeekMessage (&msg, NULL, 0, 0, PM_REMOVE))
+ {
+ if (!hDlgPrint || !IsDialogMessage (hDlgPrint, &msg))
+ {
+ TranslateMessage (&msg) ;
+ DispatchMessage (&msg) ;
+ }
+ }
+ return !bUserAbort ;
+ }
+#endif
+
+
+#define DIALOG_WIDTH 100
+#define DIALOG_HEIGHT 60
+ /* in dialog units */
+
+#if 0
+HWND CreateCancelDialog(void)
+{
+ HWND hwndButton,dlgHdl;
+
+ WORD *p, *pdlgtemplate,baseunitX,baseunitY;
+ int nchar;
+ int scrnWidth,scrnHeight;
+ int buttonX, buttonY, buttonWidth, buttonHeight;
+ int textX, textY, textWidth, textHeight;
+ DWORD lStyle,baseunits;
+ HDC screen;
+ LOGFONT lf;
+
+ /* allocate some memory to play with */
+ pdlgtemplate = p = (PWORD) rmalloc (1000);
+
+ screen = CreateDC ("DISPLAY", NULL, NULL, NULL);
+ scrnWidth = GetDeviceCaps (screen, HORZRES);
+ scrnHeight = GetDeviceCaps (screen, VERTRES);
+ DeleteDC (screen);
+ baseunits = GetDialogBaseUnits();
+
+ /* start to fill in the dlgtemplate information. addressing by WORDs */
+ lStyle = WS_CAPTION | DS_MODALFRAME | WS_SYSMENU;
+
+ baseunitX=LOWORD(baseunits);
+ baseunitY=HIWORD(baseunits);
+
+ *p++ = LOWORD (lStyle);
+ *p++ = HIWORD (lStyle);
+ *p++ = 0; /* LOWORD (lExtendedStyle) */
+ *p++ = 0; /* HIWORD (lExtendedStyle) */
+ *p++ = 0; /* NumberOfItems */
+ *p++ = ((scrnWidth*4)/3)/baseunitX; /* x */
+ *p++ = ((scrnHeight*8)/3)/baseunitY; /* y */
+ *p++ = DIALOG_WIDTH; /* cx */
+ *p++ = DIALOG_HEIGHT; /* cy */
+ *p++ = 0; /* Menu */
+ *p++ = 0; /* Class */
+
+ /* copy the title of the dialog */
+ nchar = NULL; /*nCopyAnsiToWideChar (p, (char *) "Printing in Progress");*/
+ p += nchar;
+
+ dlgHdl = CreateDialogIndirectParam (ghInst, (LPDLGTEMPLATE) pdlgtemplate, ghMainWindow,
+ (DLGPROC) PrintDlgProc, (LPARAM) 0);
+
+ rfree(pdlgtemplate);
+
+ /* Add a text field */
+ textWidth = 19*baseunitX;
+ textHeight = baseunitY;
+ textX = (((DIALOG_WIDTH*baseunitX)/4) - textWidth)
+ / 2;
+ textY = (((DIALOG_HEIGHT*baseunitY)/8) - textHeight)
+ / 4;
+ hwndText = CreateWindow ("static", "",WS_VISIBLE | WS_CHILD | SS_CENTER,
+ textX, textY, textWidth, textHeight,
+ dlgHdl, (HMENU) 0, ghInst, 0);
+
+
+ /* Add a Cancel button: */
+ buttonWidth = 10*baseunitX;
+ buttonHeight = (3*baseunitY)/2;
+ buttonX = (((DIALOG_WIDTH*baseunitX)/4) - buttonWidth)
+ / 2;
+ buttonY = (3 * (((DIALOG_HEIGHT*baseunitY)/8) - buttonHeight))
+ / 5;
+ hwndButton = CreateWindow ("button", "Cancel", WS_VISIBLE | WS_CHILD | BS_PUSHBUTTON,
+ buttonX, buttonY, buttonWidth, buttonHeight,
+ dlgHdl, (HMENU) 0, ghInst, 0);
+/* WinSetFont (&lf,"MS Sans Serif",0,8); */
+ SendMessage(hwndButton,WM_SETFONT,(WPARAM)CreateFontIndirect (&lf),MAKELPARAM (TRUE,0));
+ SendMessage(hwndText,WM_SETFONT,(WPARAM)CreateFontIndirect (&lf),MAKELPARAM (TRUE,0));
+
+ ShowWindow (dlgHdl,SW_SHOWNORMAL);
+ return dlgHdl;
+}
+#endif
+
+/* PA: Called in Clean. */
+int addSemaphor(int add)
+{
+ int old=semaphor;
+ semaphor+=add;
+ return old;
+}
+
+int os_printsetupvalidC(DEVMODE *devmode, char *device, char *driver)
+{
+#if 0
+ HDC icPrint;
+
+ icPrint = myCreateIC(driver,device,devmode);
+ if (icPrint)
+ DeleteDC(icPrint);
+ return icPrint!=NULL;
+#else
+ return 0;
+#endif
+}
+
diff --git a/Linux_C_12/cprinter_121.h b/Linux_C_12/cprinter_121.h new file mode 100644 index 0000000..384abe1 --- /dev/null +++ b/Linux_C_12/cprinter_121.h @@ -0,0 +1,39 @@ +#ifndef _CPRINTER
+#define _CPRINTER
+
+#if defined(mingw32_TARGET_OS)
+/* PA: all made extern */
+extern int startPage(int hdc);
+extern int endPage (int hdc);
+extern int startDoc (int hdc);
+ /* returns err code: >0:no error, <=0: user cancelled file dialog */
+extern void endDoc (int hdc);
+extern void deleteDC(int hdc);
+extern int wasCanceled(void);
+extern void printSetup (int calledFromCleanThread, int devmodeSize,
+ char *devmode, char *device, char *driver, char *output,
+ int *ok, PRINTDLG **pdPtr
+ );
+extern void getDC( int doDialog, int emulateScreen, int calledFromCleanThread, int devmodeLength,
+ char *devmode,char *device,char *driver,char *output,
+ int *err,
+ int *first, int *last, int *copies,
+ PRINTDLG **ppPrintDlg,
+ int *deviceContext
+ );
+ /* err code: -1:no error, others: non fatal error */
+extern void get_printSetup_with_PRINTDLG(PRINTDLG *pd, char **o_devmode,
+ char **o_device, char **o_driver, char **o_output);
+extern void getCaps(HDC hdcPrint, int unq,
+ int *maxX, int *maxY,
+ int *leftPaper, int *topPaper,
+ int *rightPaper, int *bottomPaper,
+ int *unqReturn
+ );
+
+extern BOOL CALLBACK AbortProc (HDC hdcPrn, int iCode);
+extern BOOL CALLBACK PrintDlgProc (HWND hDlg, UINT msg, WPARAM wParam, LPARAM lParam);
+extern HWND CreateCancelDialog(void);
+#endif
+
+#endif
diff --git a/Linux_C_12/intrface_121.h b/Linux_C_12/intrface_121.h new file mode 100644 index 0000000..5b30d28 --- /dev/null +++ b/Linux_C_12/intrface_121.h @@ -0,0 +1,260 @@ +/* C module intrface */
+
+#include "util_121.h"
+
+#define MaxRand 32767
+#define iWhitePattern 4
+#define iLtGreyPattern 3
+#define iGreyPattern 2
+#define iDkGreyPattern 1
+#define iBlackPattern 0
+#define iModeNotBic 7
+#define iModeNotXor 6
+#define iModeNotOr 5
+#define iModeNotCopy 4
+#define iModeBic 3
+#define iModeXor 2
+#define iModeOr 1
+#define iModeCopy 0
+#define iStrikeOut 8
+#define iUnderline 4
+#define iItalic 2
+#define iBold 1
+
+#define WinEscapeKey 27
+#define WinReturnKey 13
+#define WinTabKey 9
+#define WinBackSpKey 8
+#define WinF1Key 1001
+#define WinF2Key 1002
+#define WinF3Key 1003
+#define WinF4Key 1004
+#define WinF5Key 1005
+#define WinF6Key 1006
+#define WinF7Key 1007
+#define WinF8Key 1008
+#define WinF9Key 1009
+#define WinF10Key 1010
+#define WinF11Key 1011
+#define WinF12Key 1012
+#define WinHelpKey 1013
+#define WinDelKey 1014
+#define WinEndKey 1015
+#define WinBeginKey 1016
+#define WinPgDownKey 1017
+#define WinPgUpKey 1018
+#define WinRightKey 1019
+#define WinLeftKey 1020
+#define WinDownKey 1021
+#define WinUpKey 1022
+
+#define CTRLBIT 4
+#define ALTBIT 2
+#define SHIFTBIT 1
+#define KEYREPEAT 4
+#define KEYUP 2
+#define KEYDOWN 1
+#define BUTTONSTILLUP 0 /* PA: new constant for mouse handling. */
+#define BUTTONUP 50
+#define BUTTONSTILLDOWN 40
+#define BUTTONTRIPLEDOWN 3
+#define BUTTONDOUBLEDOWN 2
+#define BUTTONDOWN 1
+#define EDITISMULTILINE 1 /* PA: flag value: edit control is multi-line. */
+#define EDITISKEYSENSITIVE 2 /* PA: flag value: edit control sends keyboard events to Clean. */
+
+/* Constants that are passed when creating (custom)button controls.
+*/
+#define ISNORMALBUTTON 0 /* The button is a normal button. */
+#define ISOKBUTTON 1 /* The button is the OK button. */
+#define ISCANCELBUTTON 2 /* The button is the CANCEL button. */
+
+/* Game cross call codes. */
+#define CcRqUSERGAMEEVENT 1905 /* send user event to other objects */
+#define CcRqCREATEGAMEOBJECT 1904 /* create a new game object */
+#define CcRqPLAYSOUNDSAMPLE 1903 /* initialize sound sample */
+#define CcRqRUNGAME 1901 /* run the game engine */
+#define CcRqCREATEGAMEWINDOW 1900 /* create a game window */
+
+/* Print cross call codes. */
+#define CcRqDO_PRINT_SETUP 1828
+#define CcRqDO_HTML_HELP 1827
+#define CcRqGET_PRINTER_DC 1824
+#define CcRqDISPATCH_MESSAGES_WHILE_PRINTING 1823
+#define CcRqENDDOC 1822
+#define CcRqSTARTDOC 1821
+
+#define CcRqCREATETCPWINDOW 1820 /* create TCP window */
+#define CcRqDESTROYMDIDOCWINDOW 1817 /* destroy MDI document window */
+#define CcRqCREATESDIDOCWINDOW 1816 /* create SDI document window */
+#define CcRqCREATEMDIDOCWINDOW 1815 /* create MDI document window */
+#define CcRqCREATEMDIFRAMEWINDOW 1814 /* create MDI frame window */
+#define CcRqCREATESDIFRAMEWINDOW 1813 /* create SDI frame window */
+#define CcRqCLIPBOARDHASTEXT 1812
+#define CcRqGETCLIPBOARDTEXT 1811
+#define CcRqSETCLIPBOARDTEXT 1810
+#define CcRqDIRECTORYDIALOG 1802 /* create directory selector dialog. */
+#define CcRqFILESAVEDIALOG 1801
+#define CcRqFILEOPENDIALOG 1800
+#define CcRqSHOWCONTROL 1755
+#define CcRqSELECTPOPUPITEM 1754
+#define CcRqENABLEPOPUPITEM 1753
+#define CcRqADDTOPOPUP 1752
+#define CcRqSETITEMCHECK 1751
+#define CcRqENABLECONTROL 1750
+#define CcRqCREATECOMPOUND 1729
+#define CcRqCREATESCROLLBAR 1728
+#define CcRqCREATECUSTOM 1727
+#define CcRqCREATEICONBUT 1726
+#define CcRqCREATEPOPUP 1725
+#define CcRqCREATECHECKBOX 1724
+#define CcRqCREATERADIOBUT 1723
+#define CcRqCREATEEDITTXT 1722
+#define CcRqCREATESTATICTXT 1721
+#define CcRqCREATEBUTTON 1720
+#define CcRqCREATEMODALDIALOG 1701 /* create modal dialog. */
+#define CcRqCREATEDIALOG 1700
+#define CcRqCREATETOOLBARSEPARATOR 1603 /* create a toolbar separator item. */
+#define CcRqCREATETOOLBARITEM 1602 /* create a toolbar bitmap item. */
+#define CcRqCREATEMDITOOLBAR 1601 /* create a toolbar for a MDI process. */
+#define CcRqCREATESDITOOLBAR 1600 /* create a toolbar. */
+#define CcCbFONTSIZE 1530
+#define CcCbFONTNAME 1520
+#define CcRqGETFONTSIZES 1510
+#define CcRqGETFONTNAMES 1500
+
+#define CcRqSETCLIENTSIZE 1438 /* set client size. */
+#define CcRqDELCONTROLTIP 1437 /* remove controls from tooltip areas. */
+#define CcRqADDCONTROLTIP 1436 /* add controls to tooltip areas. */
+#define CcRqGETWINDOWSIZE 1435
+#define CcRqRESTACKWINDOW 1434
+#define CcRqSHOWWINDOW 1433
+#define CcRqSETWINDOWSIZE 1432
+#define CcRqSETSELECTWINDOW 1431
+#define CcRqSETWINDOWPOS 1430
+#define CcRqSETEDITSELECTION 1428
+#define CcRqSETSCROLLSIZE 1427
+#define CcRqSETSCROLLPOS 1426
+#define CcRqSETSCROLLRANGE 1425
+#define CcRqOBSCURECURSOR 1422
+#define CcRqCHANGEWINDOWCURSOR 1421
+#define CcRqACTIVATEWINDOW 1420 /* activating window. */
+#define CcRqACTIVATECONTROL 1419 /* activating controls. */
+#define CcRqCREATECARET 1610
+#define CcRqSETCARETPOS 1611
+#define CcRqDESTROYCARET 1612
+#define CcRqHIDECARET 1613
+#define CcRqSHOWCARET 1614
+#define CcRqGETWINDOWPOS 1416
+#define CcRqGETCLIENTSIZE 1415
+#define CcRqUPDATEWINDOWRECT 1412 /* updating rect part of a window/control. */
+#define CcRqGETWINDOWTEXT 1411
+#define CcRqSETWINDOWTITLE 1410
+#define CcRqFAKEPAINT 1405 /* combination of BeginPaint; EndPaint; InvalidateRect; */
+#define CcRqENDPAINT 1404
+#define CcRqBEGINPAINT 1403
+#define CcRqDESTROYWINDOW 1402
+#define CcRqDESTROYMODALDIALOG 1401 /* destroy modal dialog. */
+#define CcRqDRAWMBAR 1265
+#define CcRqTRACKPOPMENU 1256 /* handling pop up menu. */
+#define CcRqCREATEPOPMENU 1255
+#define CcRqINSERTSEPARATOR 1245
+#define CcRqMENUENABLE 1235
+#define CcRqMODIFYMENU 1230
+#define CcRqINSERTMENU 1226 /* inserting a menu in the menu bar. */
+#define CcRqITEMENABLE 1220
+#define CcRqREMOVEMENUSHORTKEY 1217 /* removing a shortkey of a menu item. */
+#define CcRqADDMENUSHORTKEY 1216 /* adding a shortkey of a menu item. */
+#define CcRqMODIFYMENUITEM 1215
+#define CcRqDESTROYMENU 1214
+#define CcRqDELETEMENU 1213 /* deleting a menu */
+#define CcRqREMOVEMENUITEM 1212
+#define CcRqCHECKMENUITEM 1210
+#define CcRqINSERTMENUITEM 1205
+#define CcRqCREATELISTBOX 1206
+#define CcRqADDTOLISTBOX 1207
+#define CcRqSELECTLISTBOXITEM 1208
+#define CcRqMARKLISTBOXITEM 1209
+#define CcRqDOMESSAGE 1100
+
+
+/* Game OS to Clean codes: 500-599 */
+#define CcWmCHECKQUIT 513 /* check user's quit function */
+#define CcWmUSEREVENT 512 /* user defined event */
+#define CcWmSTATISTICS 511 /* request for statistics */
+#define CcWmOBJECTKEYUP 510 /* key released */
+#define CcWmOBJECTKEYDOWN 509 /* key pressed for object */
+#define CcWmOBJECTTIMER 508 /* framecounter reached 0 */
+#define CcWmANIMATION 507 /* animation sequence ended */
+#define CcWmCOLLISION 506 /* collision of two objects */
+#define CcWmTOUCHBOUND 505 /* object touches bound */
+#define CcWmOBJECTDONE 504 /* object is destroyed */
+#define CcWmMOVEOBJECT 503 /* move object */
+#define CcWmINITOBJECT 502 /* initialize new object */
+#define CcWmSCROLL 501 /* calculate layer positions */
+#define CcWmGAMEKEYBOARD 500 /* keyboard input for game */
+
+/* TCP OS to Clean codes: */
+#define CcWmINETEVENT 140
+
+#define CcWmSPECIALBUTTON 133 /* info about OK/CANCEL button selected. */
+#define CcWmPROCESSDROPFILES 132 /* requesting opening of files. */
+#define CcWmGETTOOLBARTIPTEXT 131 /* getting tooltip text. */
+#define CcWmSETFOCUS 130 /* notifying obtaining keyboard input focus. */
+#define CcWmKILLFOCUS 129 /* notifying loss of keyboard input focus. */
+#define CcWmPROCESSCLOSE 127 /* requesting closing of process. */
+#define CcWmDRAWCLIPBOARD 126 /* clipboard handling. Copied from Ronny. */
+#define CcWmGETSCROLLBARINFO 125 /* info about scrollbars. */
+#define CcWmSCROLLBARACTION 124 /* scrollbar handling. */
+#define CcWmDDEEXECUTE 123
+#define CcWmIDLEDIALOG 121 /* initialising modal dialogues. */
+#define CcWmDRAWCONTROL 120
+#define CcWmITEMSELECT 119
+#define CcWmBUTTONCLICKED 118
+#define CcWmINITDIALOG 117
+#define CcWmIDLETIMER 116
+#define CcWmTIMER 115
+#define CcWmNEWVTHUMB 114
+#define CcWmNEWHTHUMB 113
+#define CcWmGETVSCROLLVAL 112
+#define CcWmGETHSCROLLVAL 111
+#define CcWmSIZE 110 /* resize information. */
+#define CcWmMOUSE 109
+#define CcWmKEYBOARD 108
+#define CcWmDEACTIVATE 107
+#define CcWmACTIVATE 106
+#define CcWmCLOSE 105
+#define CcWmCOMMAND 103
+#define CcWmCHAR 102
+#define CcWmCREATE 101
+#define CcWmPAINT 100
+#define CcWmNOTIFY 78 /* notify events. */
+#define CcWINMESSmax 999
+#define CcWINMESSmin 100
+#define CcRETURN6 16
+#define CcRETURN5 15
+#define CcRETURN4 14
+#define CcRETURN3 13
+#define CcRETURN2 12
+#define CcRETURN1 11
+#define CcRETURN0 10
+#define CcRETURNmax 19
+#define CcRETURNmin 10
+#define CcWASQUIT 1
+
+/*
+ * MW: new convention: messages that are passed within the OS thread
+ * begin with PM. They can be in range WM_USER (currently 0x0400)
+ * to 0x7FFF.
+ */
+
+#define PM_SOCKET_EVENT 0x0405
+#define PM_DNS_EVENT 0x0406
+
+/* Cursor types */
+#define CURSHIDDEN 6
+#define CURSARROW 5
+#define CURSFATCROSS 4
+#define CURSCROSS 3
+#define CURSIBEAM 2
+#define CURSBUSY 1
diff --git a/Linux_C_12/util_121.c b/Linux_C_12/util_121.c new file mode 100644 index 0000000..388819c --- /dev/null +++ b/Linux_C_12/util_121.c @@ -0,0 +1,1614 @@ +/********************************************************************************************
+ Clean OS Windows library module version 1.2.1.
+ This module is part of the Clean Object I/O library, version 1.2.1,
+ for the Windows platform.
+********************************************************************************************/
+
+/********************************************************************************************
+ About this module:
+ Generally applicable utility routines.
+********************************************************************************************/
+#include "util_121.h"
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <sys/malloc.h>
+
+
+/* Convenience procedure to fill in LOGFONT struct. */
+/*
+void SetLogFontData (LOGFONT * plf, char *fname, int style, int size)
+{
+ plf->lfHeight = -size;
+ plf->lfWeight = (style & iBold) ? 700 : 400;
+ plf->lfItalic = (style & iItalic) ? TRUE : FALSE;
+ plf->lfUnderline = (style & iUnderline) ? TRUE : FALSE;
+ plf->lfStrikeOut = (style & iStrikeOut) ? TRUE : FALSE;
+
+ rscopy (plf->lfFaceName, fname);
+
+ plf->lfWidth = 0;
+ plf->lfEscapement = 0;
+ plf->lfOrientation = 0;
+ plf->lfCharSet = DEFAULT_CHARSET;
+ plf->lfOutPrecision = OUT_DEFAULT_PRECIS;
+ plf->lfClipPrecision = CLIP_DEFAULT_PRECIS;
+ plf->lfQuality = DEFAULT_QUALITY;
+ plf->lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
+}*/ /* SetLogFontData */
+
+
+/* since we don't use the C runtime library, here are some simple
+ routines that would normally come from the C runtime lib.
+*/
+HGLOBAL rmalloc (DWORD bytes)
+{
+ HGLOBAL ptr;
+ printf("rmalloc\n");
+ ptr = malloc(bytes);
+
+ if (!ptr)
+ {
+ rprintf("Out of memory\n");
+ exit(1);
+ }
+
+ return ptr;
+} /* rmalloc */
+
+void rfree (HGLOBAL ptr)
+{
+ printf("rfree\n");
+ free(ptr);
+} /* rfree */
+
+int rstrlen (char *s)
+{
+ int l;
+ printf("rstrlen\n");
+
+ for (l = 0; s[l] != 0; l++)
+ ;
+ return l;
+} /* rstrlen */
+
+void rsncopy (char *d, const char *s, int n)
+{
+ int i;
+ printf("rsncopy\n");
+ for (i = 0; i < n; i++)
+ {
+ d[i] = s[i];
+ }
+} /* rsncopy */
+
+void rscopy (char *d, const char *s)
+{
+ int i;
+ printf("rscopy\n");
+ for (i = 0; s[i] != 0; i++)
+ {
+ d[i] = s[i];
+ }
+ d[i] = s[i];
+} /* rscopy */
+
+BOOL strequal (char *s1, char *s2)
+{
+ int i = 0;
+ printf("strequal\n");
+ while (s1[i] == s2[i])
+ {
+ if (s1[i] == 0)
+ return TRUE;
+ i++;
+ }
+ return FALSE;
+} /* strequal */
+
+BOOL nstrequal (int length, char *s1, char *s2)
+{
+ int i = 0;
+ printf("nstrequal\n");
+ while (s1[i] == s2[i])
+ {
+ if (i >= length)
+ return TRUE;
+ i++;
+ }
+ return FALSE;
+} /* nstrequal */
+
+int rabs (int i)
+{
+ printf("rabs\n");
+ if (i < 0)
+ return -i;
+ else
+ return i;
+} /* rabs */
+
+
+/* clean_strings don't have to end with 0, so we have to make
+ copy the clean string and end it with a 0.
+ global variables used for conversion from c strings to clean strings
+*/
+
+char * cstring (CLEAN_STRING s)
+{
+ static char *cstr = (char *) NULL;
+
+ rprintf("{cstring");
+ if (cstr)
+ {
+ rfree (cstr);
+ }
+
+ cstr = (char *) rmalloc ((s->length) + 1);
+ rsncopy (cstr, s->characters, s->length);
+ cstr[s->length] = 0;
+/* rprintf("}\n"); */
+ return cstr;
+} /* cstring */
+
+
+CLEAN_STRING cleanstring (char *s)
+{
+ static CLEAN_STRING result_clean_string = NULL;
+ rprintf("[cleanstring: ");
+ if (result_clean_string)
+ rfree (result_clean_string);
+ if (! s)
+ {
+ return NULL;
+ }
+
+ result_clean_string = (CLEAN_STRING) rmalloc (sizeof (int) + rstrlen (s) +1);
+ result_clean_string->length = rstrlen (s);
+ rsncopy (result_clean_string->characters, s, rstrlen (s) + 1);
+ rprintf("%s", s);
+ rprintf("]\n");
+ return result_clean_string;
+} /* cleanstring */
+
+OS WinReleaseCString (PSTR cs, OS ios)
+{
+ rprintf("(RCS: \"%s\"", cs);
+
+ if (cs)
+ {
+ rfree (cs);
+ }
+
+ rprintf(")\n");
+
+ return ios;
+} /* WinReleaseCString */
+
+void WinGetCString (PSTR cs, OS ios, CLEAN_STRING * cls, OS * oos)
+{
+ rprintf("<Gcs");
+
+ *cls = cleanstring (cs);
+ *oos = ios;
+ rprintf(">\n");
+} /* WinGetCString */
+
+void WinGetCStringAndFree (PSTR cs, OS ios, CLEAN_STRING * cls, OS * oos)
+{
+ rprintf("{GcsF");
+ *cls = cleanstring (cs);
+ *oos = ios;
+ rfree (cs);
+ rprintf("}\n");
+} /* WinGetCStringAndFree */
+
+
+void WinMakeCString (CLEAN_STRING s, OS ios, PSTR * cs, OS * oos)
+{
+ rprintf("(MCS: \"");
+ *cs = (char *) rmalloc ((s->length) + 1);
+
+ rsncopy (*cs, s->characters, s->length);
+ (*cs)[s->length] = 0;
+
+ *oos = ios;
+ rprintf("\"%s)\n",*cs);
+} /* WinMakeCString */
+
+
+int nCopyAnsiToWideChar (LPWORD lpWCStr, LPSTR lpAnsiIn)
+{
+ int nChar = 0;
+ printf("nCopyAnsiToWideChar\n");
+ do
+ {
+ *lpWCStr++ = (WORD) * lpAnsiIn;
+ nChar++;
+ } while (*lpAnsiIn++);
+
+ return nChar;
+} /* nCopyAnsiToWideChar */
+
+
+/* The following routines are used to write to the console, or convey runtime errors
+ with message boxes.
+*/
+
+static char mbuff[_RPRINTBUFSIZE];
+
+#ifdef LOGFILE
+static BOOL LogFileInited = FALSE;
+static HANDLE hLogFile = NULL;
+
+void rprintf (char *format,...)
+{
+ va_list arglist;
+ int len;
+ int cWritten;
+
+ if (!LogFileInited)
+ {
+ hLogFile = CreateFile (LOGFILE, /* filename */
+ GENERIC_WRITE, /* acces mode */
+ 0, /* share mode */
+ NULL, /* security */
+ CREATE_ALWAYS, /* how to create */
+ FILE_ATTRIBUTE_NORMAL, /* file attributes */
+ NULL); /* template file */
+ if (hLogFile == INVALID_HANDLE_VALUE)
+ {
+ MessageBox (NULL, "Could not open logfile.", NULL, MB_OK | MB_ICONSTOP);
+ ExitProcess (1);
+ };
+ LogFileInited = TRUE;
+ }
+
+ va_start (arglist, format);
+ len = sprintf (mbuff, format, arglist);
+ va_end (arglist);
+
+ if (!WriteFile (hLogFile, /* output handle */
+ mbuff, /* prompt string */
+ len, /* string length */
+ &cWritten, /* bytes written */
+ NULL)) /* not overlapped */
+ {
+ MessageBox (NULL, "Cannot write to stdout --write error.", NULL, MB_OK | MB_ICONSTOP);
+ return;
+ };
+} /* rprintf */
+#endif
+
+/*
+ * void rMessageBox (HWND owner, UINT style, char *title, char *format,...)
+{
+ va_list arglist;
+
+ va_start (arglist, format);
+ wvsprintf (mbuff, format, arglist);
+ va_end (arglist);
+
+ MessageBox (owner, mbuff, title, style);
+}*/ /* rMessageBox */
+
+void CheckF (BOOL theCheck, char *checkText, char *checkMess,
+ char *filename, int linenum)
+{
+ printf("CheckF\n");
+ if (!theCheck)
+ {
+/* rMessageBox (NULL, MB_OK | MB_ICONSTOP,
+ "Internal check failed", "%s\n\ncheck: %s\nfile: %s\nline: %d",
+ checkMess, checkText, filename, linenum);
+ */
+ exit (1);
+ }
+} /* CheckF */
+
+void ErrorExit (char *format,...)
+{
+ va_list arglist;
+
+ va_start (arglist, format);
+ sprintf (mbuff, format, arglist);
+ va_end (arglist);
+
+ /*MessageBox (NULL, mbuff, NULL, MB_OK | MB_ICONSTOP);*/
+ rprintf("%s", mbuff);
+ exit (1);
+} /* ErrorExit */
+
+void DumpMem (int *ptr, int lines)
+{
+ char *cp;
+ int i, j, k;
+
+ rprintf ("DUMP FROM %d\n", ptr);
+
+ for (i = 0; i < lines; i++)
+ {
+ /*rprintf ("%4d: ", i);*/
+ cp = (char *) ptr;
+ for (j = 0; j < 4; j++)
+ {
+ /*rprintf ("%08x ", *ptr);*/
+ ptr++;
+ };
+ /*rprintf ("- ");*/
+ for (j = 0; j < 4; j++)
+ {
+ for (k = 0; k < 4; k++)
+ {
+ char c;
+ c = *cp;
+ if (c < 32 || c > 127)
+ c = '.';
+ /*rprintf ("%C", c);*/
+ cp++;
+ };
+ /*rprintf (" ");*/
+ };
+ /*rprintf ("\n");*/
+ }
+} /* DumpMem */
+
+/*-----------------------------------
+ * support for printing messages
+ *-----------------------------------*/
+char * BOOLstring (BOOL b)
+{
+ if (b)
+ return "TRUE";
+ else
+ return "FALSE";
+} /* BOOLstring */
+
+void printCCI (CrossCallInfo * pcci)
+{
+ switch (pcci->mess)
+ {
+ case CcRETURN0:
+ {
+ rprintf ("CcRETURN0");
+ } break;
+ case CcRETURN1:
+ {
+ rprintf ("CcRETURN1");
+ } break;
+ case CcRETURN2:
+ {
+ rprintf ("CcRETURN2");
+ } break;
+ case CcRETURN3:
+ {
+ rprintf ("CcRETURN3");
+ } break;
+ case CcRETURN4:
+ {
+ rprintf ("CcRETURN4");
+ } break;
+ case CcRETURN5:
+ {
+ rprintf ("CcRETURN5");
+ } break;
+ case CcWmPAINT: /* hwnd, t,l,r,b; no return value. */
+ {
+ rprintf ("CcWmPAINT");
+ } break;
+ case CcWmCREATE: /* hwnd; no return value. */
+ {
+ rprintf ("CcWmCREATE");
+ } break;
+ case CcWmCHAR:
+ {
+ rprintf ("CcWmCHAR");
+ } break;
+ case CcWmCOMMAND: /* HITEM; no return value. */
+ {
+ rprintf ("CcWmCOMMAND");
+ } break;
+ case CcWmCLOSE: /* hwnd; no return value. */
+ {
+ rprintf ("CcWmCLOSE");
+ } break;
+ case CcWmACTIVATE: /* hwnd; no return value. */
+ {
+ rprintf ("CcWmACTIVATE");
+ } break;
+ case CcWmDEACTIVATE: /* hwnd; no return value. */
+ {
+ rprintf ("CcWmDEACTIVATE");
+ } break;
+ case CcWmKEYBOARD: /* hwnd, charcode, keystate, mods; no return
+ value. */
+ {
+ rprintf ("CcWmKEYBOARD");
+ } break;
+ case CcWmMOUSE: /* hwnd, mousestate, x, y, mods; no return
+ value. */
+ {
+ rprintf ("CcWmMOUSE");
+ } break;
+ case CcWmSIZE: /* width, heigth; */
+ {
+ rprintf ("CcWmSIZE");
+ } break;
+ case CcWmGETHSCROLLVAL: /* hwnd; scroll value return. */
+ {
+ rprintf ("CcWmGETHSCROLLVAL");
+ } break;
+ case CcWmGETVSCROLLVAL: /* hwnd; scroll value return. */
+ {
+ rprintf ("CcWmGETVSCROLLVAL");
+ } break;
+ case CcWmNEWHTHUMB: /* hwnd, hthumb; no return value. */
+ {
+ rprintf ("CcWmNEWHTHUMB");
+ } break;
+ case CcWmNEWVTHUMB: /* hwnd, vthumb; no return value. */
+ {
+ rprintf ("CcWmNEWVTHUMB");
+ } break;
+ case CcWmTIMER: /* HITEM, tickcount; no return value. */
+ {
+ rprintf ("CcWmTIMER");
+ } break;
+ case CcWmIDLETIMER: /* no params; no return value. */
+ {
+ rprintf ("CcWmIDLETIMER");
+ } break;
+ case CcWmINITDIALOG: /* hdlg; x y w h hwnd result. */
+ {
+ rprintf ("CcWmINITDIALOG");
+ } break;
+ case CcWmBUTTONCLICKED: /* hdlg, hbut; no return value. */
+ {
+ rprintf ("CcWmBUTTONCLICKED");
+ } break;
+ /* case CcWmCOMBOSELECT: */ /* hwnd, combo, newsel; no return value. */
+ /* {
+ rprintf ("CcWmCOMBOSELECT");
+ } break;*/
+ case CcWmDRAWCONTROL: /* hdlog, hctrl, hdc, x,y, enabled; no return
+ value. */
+ {
+ rprintf ("CcWmDRAWCONTROL");
+ } break;
+ /*case CcWmSETCURSOR:*/ /* hwnd; cursor code return. */
+ /* {
+ rprintf ("CcWmSETCURSOR");
+ } break;*/
+ /* case CcWmLOSEMODELESSDLOG:*/ /* hwnd; bool return value. */
+ /* {
+ rprintf ("CcWmLOSEMODELESSDLOG");
+ } break;*/
+ /* case CcRqBEEP: */ /* no params; no result. */
+ /* {
+ rprintf ("CcRqBEEP");
+ } break; */
+ case CcRqDOMESSAGE: /* no params; no result */
+ {
+ rprintf ("CcRqDOMESSAGE");
+ } break;
+ case CcRqINSERTMENUITEM: /* on/off, hmenu, textptr, marked,
+ pos; HITEM result. */
+ {
+ rprintf ("CcRqINSERTMENUITEM");
+ } break;
+ case CcRqCHECKMENUITEM: /* menu, HITEM, on/off; no result. */
+ {
+ rprintf ("CcRqCHECKMENUITEM");
+ } break;
+ case CcRqREMOVEMENUITEM: /* menu, HITEM; no result. */
+ {
+ rprintf ("CcRqREMOVEMENUITEM");
+ } break;
+ case CcRqMODIFYMENUITEM: /* HITEM, on/off, hmenu, textptr,
+ marked; no result. */
+ {
+ rprintf ("CcRqMODIFYMENUITEM");
+ } break;
+ case CcRqITEMENABLE: /* parent, HITEM, onoff; no result. */
+ {
+ rprintf ("CcRqITEMENABLE");
+ } break;
+ case CcRqMODIFYMENU: /* on/off, hmenu, textptr, hsubmenu, pos; no
+ result. */
+ {
+ rprintf ("CcRqMODIFYMENU");
+ } break;
+ case CcRqMENUENABLE: /* parent, pos, onoff; no result. */
+ {
+ rprintf ("CcRqMENUENABLE");
+ } break;
+ case CcRqINSERTSEPARATOR: /* hmenu, pos; no result. */
+ {
+ rprintf ("CcRqINSERTSEPARATOR");
+ } break;
+ case CcRqCREATEPOPMENU: /* no params; HMENU result. */
+ {
+ rprintf ("CcRqCREATEPOPMENU");
+ } break;
+ case CcRqDRAWMBAR: /* no params; no result. */
+ {
+ rprintf ("CcRqDRAWMBAR");
+ } break;
+ case CcRqDESTROYWINDOW: /* hwnd; no result. */
+ {
+ rprintf ("CcRqDESTROYWINDOW");
+ } break;
+ case CcRqBEGINPAINT: /* hwnd; HDC result. */
+ {
+ rprintf ("CcRqBEGINPAINT");
+ } break;
+ case CcRqENDPAINT: /* hwnd, hdc; no result. */
+ {
+ rprintf ("CcRqENDPAINT");
+ } break;
+ case CcRqSETSCROLLPOS:
+ {
+ rprintf("CcRqSETSCROLLPOS");
+ } break;
+ case CcRqSETSCROLLRANGE:
+ {
+ rprintf("CcRqSETSCROLLRANGE");
+ } break;
+ case CcRqSETSCROLLSIZE:
+ {
+ rprintf("CcRqSETSCROLLSIZE");
+ } break;
+ /*case CcRqGETDC:*/ /* hwnd; HDC result. */
+ /* {
+ rprintf ("CcRqGETDC");
+ } break; */
+ /*case CcRqRELEASEDC: */ /* hwnd, hdc; no result. */
+ /* {
+ rprintf ("CcRqRELEASEDC");
+ } break; */
+ /* case CcRqINVALIDATEWINDOW: */ /* hwnd; no result. */
+ /* {
+ rprintf ("CcRqINVALIDATEWINDOW");
+ } break; */
+ case CcRqSETWINDOWTITLE: /* hwnd, textptr; no result. */
+ {
+ rprintf ("CcRqSETWINDOWTITLE");
+ } break;
+ case CcRqGETWINDOWTEXT: /* hwnd; textptr result. */
+ {
+ rprintf ("CcRqGETWINDOWTEXT");
+ } break;
+ case CcRqGETCLIENTSIZE: /* hwnd; width, height result. */
+ {
+ rprintf ("CcRqGETCLIENTSIZE");
+ } break;
+ case CcRqGETWINDOWPOS: /* hwnd; left, top result. */
+ {
+ rprintf ("CcRqGETWINDOWPOS");
+ } break;
+ case CcRqCHANGEWINDOWCURSOR: /* hwnd, cursor code; no result. */
+ {
+ rprintf ("CcRqCHANGEWINDOWCURSOR");
+ } break;
+ case CcRqOBSCURECURSOR: /* no params; no result. */
+ {
+ rprintf ("CcRqOBSCURECURSOR");
+ } break;
+ /*case CcRqSETGLOBALCURSOR:*/ /* cursorcode; no result. */
+ /* {
+ rprintf ("CcRqSETGLOBALCURSOR");
+ } break;*/
+ /*case CcRqRESETCURSOR:*/ /* no params; no result. */
+ /* {
+ rprintf ("CcRqRESETCURSOR");
+ } break; */
+ case CcRqGETFONTNAMES: /* no params; no result. */
+ {
+ rprintf ("CcRqGETFONTNAMES");
+ } break;
+ case CcRqGETFONTSIZES: /* textptr; no result. */
+ {
+ rprintf ("CcRqGETFONTSIZES");
+ } break;
+ case CcCbFONTNAME: /* textptr; no result. */
+ {
+ rprintf ("CcCbFONTNAME");
+ } break;
+ case CcCbFONTSIZE: /* size, isTrueType; no result. */
+ {
+ rprintf ("CcCbFONTSIZE");
+ } break;
+ /*case CcRqGETCURTIME:*/ /* no params; hours, minutes, seconds. */
+ /* {
+ rprintf ("CcRqGETCURTIME");
+ } break;*/
+ /*case CcRqGETCURDATE:*/ /* no params; year, month, day, weekday. */
+ /* {
+ rprintf ("CcRqGETCURDATE");
+ } break; */
+ /*case CcRqWAIT:*/ /* milliseconds; no result. */
+ /* {
+ rprintf ("CcRqWAIT");
+ } break;*/
+ /*case CcRqGETBLINKTIME:*/ /* no params; millisec result. */
+ /* {
+ rprintf ("CcRqGETBLINKTIME");
+ } break;*/
+ case CcRqCREATEDIALOG: /* textptr; HWND result. */
+ {
+ rprintf ("CcRqCREATEDIALOG");
+ } break;
+ case CcRqCREATEBUTTON: /* hwnd, x,y,w,h, isdefbut; HWND result. */
+ {
+ rprintf ("CcRqCREATEBUTTON");
+ } break;
+ case CcRqCREATESTATICTXT: /* hwnd, x,y,w,h; HWND result. */
+ {
+ rprintf ("CcRqCREATESTATICTXT");
+ } break;
+ case CcRqCREATEEDITTXT: /* hwnd, x,y,w,h, ismultiline; HWND
+ result. */
+ {
+ rprintf ("CcRqCREATEEDITTXT");
+ } break;
+ case CcRqCREATERADIOBUT: /* hwnd, x,y,w,h, isselected; HWND
+ result. */
+ {
+ rprintf ("CcRqCREATERADIOBUT");
+ } break;
+ case CcRqCREATECHECKBOX: /* hwnd, x,y,w,h, isselected; HWND
+ result. */
+ {
+ rprintf ("CcRqCREATECHECKBOX");
+ } break;
+ case CcRqCREATEPOPUP: /* hwnd, x,y,w,h; HWND result. */
+ {
+ rprintf ("CcRqCREATEPOPUP");
+ } break;
+ case CcRqCREATEICONBUT: /* hwnd, x,y,w,h; HWND result. */
+ {
+ rprintf ("CcRqCREATEICONBUT");
+ } break;
+ case CcRqCREATECUSTOM: /* hwnd, x,y,w,h; HWND result. */
+ {
+ rprintf ("CcRqCREATECUSTOM");
+ } break;
+ case CcRqENABLECONTROL: /* hwnd, bool; no result. */
+ {
+ rprintf ("CcRqENABLECONTROL");
+ } break;
+ case CcRqSETITEMCHECK: /* hwnd, bool; no result. */
+ {
+ rprintf ("CcRqSETITEMCHECK");
+ } break;
+ case CcRqADDTOPOPUP: /* hwnd, textptr, enabled, selected; Pos
+ result. */
+ {
+ rprintf ("CcRqADDTOPOPUP");
+ } break;
+ case CcRqENABLEPOPUPITEM: /* hwnd, pos, enabled; no result. */
+ {
+ rprintf ("CcRqENABLEPOPUPITEM");
+ } break;
+ case CcRqSELECTPOPUPITEM: /* hwnd, pos; no result. */
+ {
+ rprintf ("CcRqSELECTPOPUPITEM");
+ } break;
+ case CcRqFILEOPENDIALOG: /* no params; bool, textptr result; */
+ {
+ rprintf ("CcRqFILEOPENDIALOG");
+ } break;
+ case CcRqFILESAVEDIALOG: /* promptptr, nameptr; bool, textptr
+ result; */
+ {
+ rprintf ("CcRqFILESAVEDIALOG");
+ } break;
+ case CcRqSETCLIPBOARDTEXT: /* textptr; no result. */
+ {
+ rprintf ("CcRqSETCLIPBOARDTEXT");
+ } break;
+ case CcRqGETCLIPBOARDTEXT: /* no params; textptr result. */
+ {
+ rprintf ("CcRqGETCLIPBOARDTEXT");
+ } break;
+ case CcRqCLIPBOARDHASTEXT: /* no params; bool result. */
+ {
+ rprintf ("CcRqCLIPBOARDHASTEXT");
+ } break;
+ default:
+ {
+ rprintf ("Unknown CCI: %d", pcci->mess);
+ } break;
+ }
+} /* printCCI */
+
+#ifdef LOGFILE
+void printMessage (char *fname, HWND hWin, UINT uMess, WPARAM wPara, LPARAM lPara)
+{
+ switch (uMess)
+ {
+ case WM_ACTIVATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d, ", fname, "WM_ACTIVATE", hWin);
+ switch (LOWORD (wPara)) /* activation flag */
+ {
+ case WA_ACTIVE:
+ rprintf ("fActive = WA_ACTIVE, ");
+ break;
+ case WA_CLICKACTIVE:
+ rprintf ("fActive = WA_CLICKACTIVE, ");
+ break;
+ case WA_INACTIVE:
+ rprintf ("fActive = WA_INACTIVE, ");
+ break;
+ }
+ /*rprintf ("fMinimized = %s, ", BOOLstring ((BOOL) HIWORD (wPara))); minimized flag */
+ rprintf ("other_hwnd = %d\n", lPara); /* window handle */
+ } break;
+ case WM_ACTIVATEAPP:
+ {
+ rprintf ("== %s got %s, hwnd = %d, fActive = %s, other_thread = %d\n", fname, "WM_ACTIVATEAPP", hWin, BOOLstring ((BOOL) wPara), lPara);
+ } break;
+ case WM_NCHITTEST:
+ {
+ } break;
+ case WM_SETCURSOR:
+ {
+ } break;
+ case WM_MOVE:
+ {
+ rprintf ("== %s got %s, hwnd = %d, x = %d, y = %d\n", fname, "WM_MOVE", hWin, LOWORD (lPara), HIWORD (lPara));
+ } break;
+ case WM_SIZE:
+ {
+ rprintf ("== %s got %s, hwnd = %d, wPara = ", fname, "WM_SIZE", hWin);
+ switch (wPara)
+ {
+ case SIZE_MAXHIDE:
+ rprintf ("SIZE_MAXHIDE");
+ break;
+ case SIZE_MAXIMIZED:
+ rprintf ("SIZE_MAXIMIZED");
+ break;
+ case SIZE_MAXSHOW:
+ rprintf ("SIZE_MAXSHOW");
+ break;
+ case SIZE_MINIMIZED:
+ rprintf ("SIZE_MINIMIZED");
+ break;
+ case SIZE_RESTORED:
+ rprintf ("SIZE_RESTORED");
+ break;
+ default:
+ rprintf ("unknown");
+ break;
+ }
+ rprintf (", width =%d, height = %d\n", LOWORD (lPara), HIWORD (lPara));
+ } break;
+ case WM_HSCROLL:
+ {
+ rprintf ("== %s got %s, hwnd = %d, ", fname, "WM_HSCROLL", hWin);
+ switch ((int) LOWORD (wPara))
+ {
+ case SB_BOTTOM:
+ rprintf ("scrollcode = SB_BOTTOM\n");
+ break;
+ case SB_ENDSCROLL:
+ rprintf ("scrollcode = SB_ENDSCROLL\n");
+ break;
+ case SB_LINELEFT:
+ rprintf ("scrollcode = SB_LINELEFT\n");
+ break;
+ case SB_LINERIGHT:
+ rprintf ("scrollcode = SB_LINERIGHT\n");
+ break;
+ case SB_PAGELEFT:
+ rprintf ("scrollcode = SB_PAGELEFT\n");
+ break;
+ case SB_PAGERIGHT:
+ rprintf ("scrollcode = SB_PAGERIGHT\n");
+ break;
+ case SB_THUMBPOSITION:
+ rprintf ("scrollcode = SB_THUMBPOSITION, nPos = %d\n", HIWORD (wPara));
+ break;
+ case SB_THUMBTRACK:
+ rprintf ("scrollcode = SB_THUMBTRACK, nPos = %d\n", HIWORD (wPara));
+ break;
+ case SB_TOP:
+ rprintf ("scrollcode = SB_TOP\n");
+ break;
+ }
+ } break;
+ case WM_VSCROLL:
+ {
+ rprintf ("== %s got %s, hwnd = %d, ", fname, "WM_VSCROLL", hWin);
+
+ switch (LOWORD (wPara))
+ {
+ case SB_BOTTOM:
+ rprintf ("scrollcode = SB_BOTTOM\n");
+ break;
+ case SB_ENDSCROLL:
+ rprintf ("scrollcode = SB_ENDSCROLL\n");
+ break;
+ case SB_LINEDOWN:
+ rprintf ("scrollcode = SB_LINEDOWN\n");
+ break;
+ case SB_LINEUP:
+ rprintf ("scrollcode = SB_LINEUP\n");
+ break;
+ case SB_PAGEDOWN:
+ rprintf ("scrollcode = SB_PAGEDOWN\n");
+ break;
+ case SB_PAGEUP:
+ rprintf ("scrollcode = SB_PAGEUP\n");
+ break;
+ case SB_THUMBPOSITION:
+ rprintf ("scrollcode = SB_THUMBPOSITION, nPos = %d\n", HIWORD (wPara));
+ break;
+ case SB_THUMBTRACK:
+ rprintf ("scrollcode = SB_THUMBTRACK, nPos = %d\n", HIWORD (wPara));
+ break;
+ case SB_TOP:
+ rprintf ("scrollcode = SB_TOP\n");
+ break;
+ }
+ } break;
+ case WM_TIMER:
+ { /* rprintf("== %s got %s, hwnd = %d, wParam = %d\n", fname,
+ "WM_TIMER", hWin, wPara); */
+ } break;
+ case WM_ENABLE:
+ {
+ rprintf ("== %s got %s, hwnd = %d, wParam = %s\n", fname, "WM_ENABLE", hWin, BOOLstring ((BOOL) wPara));
+ } break;
+ case WM_ENTERIDLE:
+ { /* rprintf("== %s got %s, hwnd = %d\n", fname,
+ "WM_ENTERIDLE", hWin); */
+ } break;
+ case WM_CHAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d, char = \'%c\'[%d]\n", fname, "WM_CHAR", hWin, wPara, wPara);
+ } break;
+/*--------------------------------------------- */
+ case WM_NULL:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NULL", hWin);
+ } break;
+ case WM_CREATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CREATE", hWin);
+ } break;
+ case WM_DESTROY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DESTROY", hWin);
+ } break;
+ case WM_SETFOCUS:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETFOCUS", hWin);
+ } break;
+ case WM_KILLFOCUS:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_KILLFOCUS", hWin);
+ } break;
+ case WM_SETREDRAW:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETREDRAW", hWin);
+ } break;
+ case WM_SETTEXT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETTEXT", hWin);
+ } break;
+ case WM_GETTEXT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETTEXT", hWin);
+ } break;
+ case WM_GETTEXTLENGTH:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETTEXTLENGTH", hWin);
+ } break;
+ case WM_PAINT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PAINT", hWin);
+ } break;
+ case WM_CLOSE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CLOSE", hWin);
+ } break;
+ case WM_QUERYENDSESSION:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_QUERYENDSESSION", hWin);
+ } break;
+ case WM_QUIT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_QUIT", hWin);
+ } break;
+ case WM_QUERYOPEN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_QUERYOPEN", hWin);
+ } break;
+ case WM_ERASEBKGND:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_ERASEBKGND", hWin);
+ } break;
+ case WM_SYSCOLORCHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SYSCOLORCHANGE", hWin);
+ } break;
+ case WM_ENDSESSION:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_ENDSESSION", hWin);
+ } break;
+ case WM_SHOWWINDOW:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SHOWWINDOW", hWin);
+ } break;
+ case WM_SETTINGCHANGE: /* WM_WININICHANGE on NT */
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETTINGCHANGE", hWin);
+ } break;
+ case WM_DEVMODECHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DEVMODECHANGE", hWin);
+ } break;
+ case WM_FONTCHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_FONTCHANGE", hWin);
+ } break;
+ case WM_TIMECHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_TIMECHANGE", hWin);
+ } break;
+ case WM_CANCELMODE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CANCELMODE", hWin);
+ } break;
+ case WM_MOUSEACTIVATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MOUSEACTIVATE", hWin);
+ } break;
+ case WM_CHILDACTIVATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CHILDACTIVATE", hWin);
+ } break;
+ case WM_QUEUESYNC:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_QUEUESYNC", hWin);
+ } break;
+ case WM_GETMINMAXINFO:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETMINMAXINFO", hWin);
+ } break;
+ case WM_PAINTICON:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PAINTICON", hWin);
+ } break;
+ case WM_ICONERASEBKGND:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_ICONERASEBKGND", hWin);
+ } break;
+ case WM_NEXTDLGCTL:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NEXTDLGCTL", hWin);
+ } break;
+ case WM_SPOOLERSTATUS:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SPOOLERSTATUS", hWin);
+ } break;
+ case WM_DRAWITEM:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DRAWITEM", hWin);
+ } break;
+ case WM_MEASUREITEM:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MEASUREITEM", hWin);
+ } break;
+ case WM_DELETEITEM:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DELETEITEM", hWin);
+ } break;
+ case WM_VKEYTOITEM:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_VKEYTOITEM", hWin);
+ } break;
+ case WM_CHARTOITEM:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CHARTOITEM", hWin);
+ } break;
+ case WM_SETFONT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETFONT", hWin);
+ } break;
+ case WM_GETFONT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETFONT", hWin);
+ } break;
+ case WM_SETHOTKEY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETHOTKEY", hWin);
+ } break;
+ case WM_GETHOTKEY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETHOTKEY", hWin);
+ } break;
+ case WM_QUERYDRAGICON:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_QUERYDRAGICON", hWin);
+ } break;
+ case WM_COMPAREITEM:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_COMPAREITEM", hWin);
+ } break;
+ case WM_COMPACTING:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_COMPACTING", hWin);
+ } break;
+ case WM_COMMNOTIFY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_COMMNOTIFY", hWin);
+ } break;
+ case WM_WINDOWPOSCHANGING:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_WINDOWPOSCHANGING", hWin);
+ } break;
+ case WM_WINDOWPOSCHANGED:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_WINDOWPOSCHANGED", hWin);
+ } break;
+ case WM_POWER:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_POWER", hWin);
+ } break;
+ case WM_COPYDATA:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_COPYDATA", hWin);
+ } break;
+ case WM_CANCELJOURNAL:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CANCELJOURNAL", hWin);
+ } break;
+ case WM_NOTIFY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NOTIFY", hWin);
+ } break;
+ case WM_INPUTLANGCHANGEREQUEST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_INPUTLANGCHANGEREQUEST", hWin);
+ } break;
+ case WM_INPUTLANGCHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_INPUTLANGCHANGE", hWin);
+ } break;
+ case WM_TCARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_TCARD", hWin);
+ } break;
+ case WM_HELP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_HELP", hWin);
+ } break;
+ case WM_USERCHANGED:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_USERCHANGED", hWin);
+ } break;
+ case WM_NOTIFYFORMAT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NOTIFYFORMAT", hWin);
+ } break;
+ case WM_CONTEXTMENU:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CONTEXTMENU", hWin);
+ } break;
+ case WM_STYLECHANGING:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_STYLECHANGING", hWin);
+ } break;
+ case WM_STYLECHANGED:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_STYLECHANGED", hWin);
+ } break;
+ case WM_DISPLAYCHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DISPLAYCHANGE", hWin);
+ } break;
+ case WM_GETICON:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETICON", hWin);
+ } break;
+ case WM_SETICON:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SETICON", hWin);
+ } break;
+ case WM_NCCREATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCCREATE", hWin);
+ } break;
+ case WM_NCDESTROY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCDESTROY", hWin);
+ } break;
+ case WM_NCCALCSIZE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCCALCSIZE", hWin);
+ } break;
+ case WM_NCPAINT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCPAINT", hWin);
+ } break;
+ case WM_NCACTIVATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCACTIVATE", hWin);
+ } break;
+ case WM_GETDLGCODE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_GETDLGCODE", hWin);
+ } break;
+ case WM_NCMOUSEMOVE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCMOUSEMOVE", hWin);
+ } break;
+ case WM_NCLBUTTONDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCLBUTTONDOWN", hWin);
+ } break;
+ case WM_NCLBUTTONUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCLBUTTONUP", hWin);
+ } break;
+ case WM_NCLBUTTONDBLCLK:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCLBUTTONDBLCLK", hWin);
+ } break;
+ case WM_NCRBUTTONDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCRBUTTONDOWN", hWin);
+ } break;
+ case WM_NCRBUTTONUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCRBUTTONUP", hWin);
+ } break;
+ case WM_NCRBUTTONDBLCLK:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCRBUTTONDBLCLK", hWin);
+ } break;
+ case WM_NCMBUTTONDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCMBUTTONDOWN", hWin);
+ } break;
+ case WM_NCMBUTTONUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCMBUTTONUP", hWin);
+ } break;
+ case WM_NCMBUTTONDBLCLK:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NCMBUTTONDBLCLK", hWin);
+ } break;
+ case WM_KEYDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_KEYDOWN", hWin);
+ } break;
+ case WM_KEYUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_KEYUP", hWin);
+ } break;
+ case WM_DEADCHAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DEADCHAR", hWin);
+ } break;
+ case WM_SYSKEYDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SYSKEYDOWN", hWin);
+ } break;
+ case WM_SYSKEYUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SYSKEYUP", hWin);
+ } break;
+ case WM_SYSCHAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SYSCHAR", hWin);
+ } break;
+ case WM_SYSDEADCHAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SYSDEADCHAR", hWin);
+ } break;
+ case WM_IME_STARTCOMPOSITION:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_STARTCOMPOSITION", hWin);
+ } break;
+ case WM_IME_ENDCOMPOSITION:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_ENDCOMPOSITION", hWin);
+ } break;
+ case WM_IME_COMPOSITION:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_COMPOSITION", hWin);
+ } break;
+ case WM_INITDIALOG:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_INITDIALOG", hWin);
+ } break;
+ case WM_COMMAND:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_COMMAND", hWin);
+ } break;
+ case WM_SYSCOMMAND:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SYSCOMMAND", hWin);
+ } break;
+ case WM_INITMENU:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_INITMENU", hWin);
+ } break;
+ case WM_INITMENUPOPUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_INITMENUPOPUP", hWin);
+ } break;
+ case WM_MENUSELECT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MENUSELECT", hWin);
+ } break;
+ case WM_MENUCHAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MENUCHAR", hWin);
+ } break;
+ case WM_CTLCOLORMSGBOX:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLORMSGBOX", hWin);
+ } break;
+ case WM_CTLCOLOREDIT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLOREDIT", hWin);
+ } break;
+ case WM_CTLCOLORLISTBOX:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLORLISTBOX", hWin);
+ } break;
+ case WM_CTLCOLORBTN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLORBTN", hWin);
+ } break;
+ case WM_CTLCOLORDLG:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLORDLG", hWin);
+ } break;
+ case WM_CTLCOLORSCROLLBAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLORSCROLLBAR", hWin);
+ } break;
+ case WM_CTLCOLORSTATIC:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CTLCOLORSTATIC", hWin);
+ } break;
+ case WM_MOUSEMOVE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MOUSEMOVE", hWin);
+ } break;
+ case WM_LBUTTONDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_LBUTTONDOWN", hWin);
+ } break;
+ case WM_LBUTTONUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_LBUTTONUP", hWin);
+ } break;
+ case WM_LBUTTONDBLCLK:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_LBUTTONDBLCLK", hWin);
+ } break;
+ case WM_RBUTTONDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_RBUTTONDOWN", hWin);
+ } break;
+ case WM_RBUTTONUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_RBUTTONUP", hWin);
+ } break;
+ case WM_RBUTTONDBLCLK:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_RBUTTONDBLCLK", hWin);
+ } break;
+ case WM_MBUTTONDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MBUTTONDOWN", hWin);
+ } break;
+ case WM_MBUTTONUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MBUTTONUP", hWin);
+ } break;
+ case WM_MBUTTONDBLCLK:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MBUTTONDBLCLK", hWin);
+ } break;
+ case WM_PARENTNOTIFY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PARENTNOTIFY", hWin);
+ } break;
+ case WM_ENTERMENULOOP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_ENTERMENULOOP", hWin);
+ } break;
+ case WM_EXITMENULOOP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_EXITMENULOOP", hWin);
+ } break;
+ case WM_NEXTMENU:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_NEXTMENU", hWin);
+ } break;
+ case WM_SIZING:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SIZING", hWin);
+ } break;
+ case WM_CAPTURECHANGED:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CAPTURECHANGED", hWin);
+ } break;
+ case WM_MOVING:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MOVING", hWin);
+ } break;
+ case WM_POWERBROADCAST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_POWERBROADCAST", hWin);
+ } break;
+ case WM_DEVICECHANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DEVICECHANGE", hWin);
+ } break;
+ case WM_IME_SETCONTEXT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_SETCONTEXT", hWin);
+ } break;
+ case WM_IME_NOTIFY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_NOTIFY", hWin);
+ } break;
+ case WM_IME_CONTROL:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_CONTROL", hWin);
+ } break;
+ case WM_IME_COMPOSITIONFULL:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_COMPOSITIONFULL", hWin);
+ } break;
+ case WM_IME_SELECT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_SELECT", hWin);
+ } break;
+ case WM_IME_CHAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_CHAR", hWin);
+ } break;
+ case WM_IME_KEYDOWN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_KEYDOWN", hWin);
+ } break;
+ case WM_IME_KEYUP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_IME_KEYUP", hWin);
+ } break;
+ case WM_MDICREATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDICREATE", hWin);
+ } break;
+ case WM_MDIDESTROY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIDESTROY", hWin);
+ } break;
+ case WM_MDIACTIVATE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIACTIVATE", hWin);
+ } break;
+ case WM_MDIRESTORE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIRESTORE", hWin);
+ } break;
+ case WM_MDINEXT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDINEXT", hWin);
+ } break;
+ case WM_MDIMAXIMIZE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIMAXIMIZE", hWin);
+ } break;
+ case WM_MDITILE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDITILE", hWin);
+ } break;
+ case WM_MDICASCADE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDICASCADE", hWin);
+ } break;
+ case WM_MDIICONARRANGE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIICONARRANGE", hWin);
+ } break;
+ case WM_MDIGETACTIVE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIGETACTIVE", hWin);
+ } break;
+ case WM_MDISETMENU:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDISETMENU", hWin);
+ } break;
+ case WM_ENTERSIZEMOVE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_ENTERSIZEMOVE", hWin);
+ } break;
+ case WM_EXITSIZEMOVE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_EXITSIZEMOVE", hWin);
+ } break;
+ case WM_DROPFILES:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DROPFILES", hWin);
+ } break;
+ case WM_MDIREFRESHMENU:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_MDIREFRESHMENU", hWin);
+ } break;
+ case WM_CUT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CUT", hWin);
+ } break;
+ case WM_COPY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_COPY", hWin);
+ } break;
+ case WM_PASTE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PASTE", hWin);
+ } break;
+ case WM_CLEAR:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CLEAR", hWin);
+ } break;
+ case WM_UNDO:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_UNDO", hWin);
+ } break;
+ case WM_RENDERFORMAT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_RENDERFORMAT", hWin);
+ } break;
+ case WM_RENDERALLFORMATS:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_RENDERALLFORMATS", hWin);
+ } break;
+ case WM_DESTROYCLIPBOARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DESTROYCLIPBOARD", hWin);
+ } break;
+ case WM_DRAWCLIPBOARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_DRAWCLIPBOARD", hWin);
+ } break;
+ case WM_PAINTCLIPBOARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PAINTCLIPBOARD", hWin);
+ } break;
+ case WM_VSCROLLCLIPBOARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_VSCROLLCLIPBOARD", hWin);
+ } break;
+ case WM_SIZECLIPBOARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_SIZECLIPBOARD", hWin);
+ } break;
+ case WM_ASKCBFORMATNAME:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_ASKCBFORMATNAME", hWin);
+ } break;
+ case WM_CHANGECBCHAIN:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_CHANGECBCHAIN", hWin);
+ } break;
+ case WM_HSCROLLCLIPBOARD:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_HSCROLLCLIPBOARD", hWin);
+ } break;
+ case WM_QUERYNEWPALETTE:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_QUERYNEWPALETTE", hWin);
+ } break;
+ case WM_PALETTEISCHANGING:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PALETTEISCHANGING", hWin);
+ } break;
+ case WM_PALETTECHANGED:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PALETTECHANGED", hWin);
+ } break;
+ case WM_HOTKEY:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_HOTKEY", hWin);
+ } break;
+ case WM_PRINT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PRINT", hWin);
+ } break;
+ case WM_PRINTCLIENT:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PRINTCLIENT", hWin);
+ } break;
+ case WM_HANDHELDFIRST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_HANDHELDFIRST", hWin);
+ } break;
+ case WM_HANDHELDLAST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_HANDHELDLAST", hWin);
+ } break;
+ case WM_AFXFIRST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_AFXFIRST", hWin);
+ } break;
+ case WM_AFXLAST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_AFXLAST", hWin);
+ } break;
+ case WM_PENWINFIRST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PENWINFIRST", hWin);
+ } break;
+ case WM_PENWINLAST:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_PENWINLAST", hWin);
+ } break;
+ case WM_APP:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_APP", hWin);
+ } break;
+ case WM_USER:
+ {
+ rprintf ("== %s got %s, hwnd = %d\n", fname, "WM_USER", hWin);
+ } break;
+ default:
+ {
+ rprintf ("== %s got UNKOWN MESSAGE %d, hwin = %d\n", fname, uMess, hWin);
+ } break;
+ }
+} /* printMessage */
+#endif
+
+gchar *createMnemonicString(gchar *source)
+{
+ gchar *dest;
+ gchar *s;
+ printf("createMnemonicString\n");
+
+ if (source == NULL)
+ {
+ dest = rmalloc(1);
+ dest[0] = 0x00;
+ return dest;
+ }
+
+ dest = (gchar *) rmalloc(rstrlen(source)*2+1);
+ s = dest;
+
+ printf("Making Mnemonic for: %s\n", source);
+
+ while (*source)
+ {
+ switch (*source)
+ {
+ case '&':
+ *(dest++) = '_';
+ break;
+ case '_':
+ *(dest++) = '_';
+ *(dest++) = '_';
+ default:
+ *(dest++) = *source;
+ }
+
+ source++;
+ }
+
+ *dest = 0;
+ printf("Generated Mnemonic: %s\n", s);
+ return s;
+}
+
+
diff --git a/Linux_C_12/util_121.h b/Linux_C_12/util_121.h new file mode 100644 index 0000000..69e47ca --- /dev/null +++ b/Linux_C_12/util_121.h @@ -0,0 +1,122 @@ +#ifndef _UTILH
+#define _UTILH
+
+#include "config.h"
+#include <stdio.h>
+#include <gtk/gtk.h>
+#include <gdk/gdk.h>
+
+#undef LOG_CROSSCALL
+#define LOG_MEMORY 1
+
+typedef GtkWidget *OSWindowPtr;
+typedef GdkDrawable *OSPictContext;
+typedef GdkRegion *OSRgnHandle;
+typedef GdkPixbuf *OSBmpHandle;
+typedef GdkPoint *PointsArray;
+
+typedef gboolean BOOL;
+typedef unsigned int UINT;
+typedef unsigned int WORD;
+typedef unsigned int WPARAM;
+typedef unsigned long LPARAM;
+typedef int OS;
+typedef char* PSTR;
+typedef char* LPSTR;
+typedef int* LPWORD;
+
+#define SIGNEDLOWORD(i) ((short) i)
+#define SIGNEDHIWORD(i) ((short) ((i)>>16))
+
+#define OS_NO_WINDOW_PTR -1
+
+/* OS type, threading all calls from Clean.
+*/
+
+typedef int Bool;
+typedef int HITEM;
+typedef void* HGLOBAL;
+typedef unsigned long DWORD;
+
+typedef struct
+{ int mess;
+ int p1;
+ int p2;
+ int p3;
+ int p4;
+ int p5;
+ int p6;
+} CrossCallInfo;
+
+typedef struct clean_string
+ { int length;
+ char characters[1];
+ } *CLEAN_STRING;
+
+
+#include "intrface_121.h"
+
+/* extern void SetLogFontData (LOGFONT*, char*, int, int); */
+
+/* since we don't use the C runtime library, here are some simple
+ routines that would normally come from the C runtime lib.
+*/
+/* PA: extern added */
+extern void rfree( HGLOBAL ptr );
+extern HGLOBAL rmalloc( DWORD bytes );
+
+extern int rstrlen(char *s);
+extern void rsncopy(char *d, const char *s, int n);
+extern void rscopy(char *d, const char *s);
+extern BOOL strequal( char *s1, char *s2 );
+extern BOOL nstrequal( int length, char *s1, char *s2 );
+extern int rabs(int i);
+
+/* clean_strings don't have to end with 0, so we have to make
+ copy the clean string and end it with a 0.
+ global variables used for conversion from c strings to clean strings
+*/
+
+extern char *cstring (CLEAN_STRING s);
+extern CLEAN_STRING cleanstring (char *s);
+/* PA: up to here */
+
+extern OS WinReleaseCString (PSTR,OS);
+extern void WinGetCString (PSTR,OS,CLEAN_STRING*,OS*);
+extern void WinGetCStringAndFree (PSTR,OS,CLEAN_STRING*,OS*);
+extern void WinMakeCString (CLEAN_STRING,OS,PSTR*,OS*);
+
+/* PA: extern added to the end */
+extern int nCopyAnsiToWideChar (LPWORD, LPSTR);
+
+/* The following routines are used to write to the console, or convey runtime errors
+ with message boxes.
+*/
+
+#ifndef _RPRINTBUFSIZE
+#define _RPRINTBUFSIZE 512
+#endif
+
+/*extern void rMessageBox(HWND owner, UINT style, char *title, char *format, ... );*/
+extern void CheckF(BOOL theCheck, char *checkText, char *checkMess, char *filename, int linenum);
+extern void ErrorExit(char *format, ...);
+extern char *BOOLstring( BOOL b );
+
+#define Check(check,mess) CheckF((check),(#check),(mess),__FILE__,__LINE__)
+
+extern void DumpMem( int *ptr, int lines);
+
+/* #define LOGFILE "debuglog.txt" */
+# undef LOGFILE
+
+#ifdef LOGFILE
+extern void rprintf(char *format, ... );
+extern void printCCI( CrossCallInfo *pcci );
+extern void printMessage( char* fname, HWND hWin, UINT uMess, WPARAM wPara, LPARAM lPara);
+#else
+# define rprintf printf
+extern void printCCI( CrossCallInfo *pcci );
+# define printMessage( fname, hWin, uMess, wPara, lPara);
+#endif
+
+#endif
diff --git a/clCCall_12.dcl b/clCCall_12.dcl new file mode 100644 index 0000000..53e11de --- /dev/null +++ b/clCCall_12.dcl @@ -0,0 +1,103 @@ +definition module clCCall_12
+
+// Clean Object I/O library, version 1.2
+
+from StdIOCommon import :: Modifiers
+from ostoolbox import :: OSToolbox
+
+
+:: CSTR :== Int
+:: ACCLPTR :== Int
+
+MaxRand :== 32767
+
+WinHelpKey :== 5
+WinEscapeKey :== 27
+WinReturnKey :== 13
+WinTabKey :== 9
+WinDelKey :== 127
+WinBackSpKey :== 8
+WinEndKey :== 4
+WinBeginKey :== 1
+WinPgDownKey :== 12
+WinPgUpKey :== 11
+WinRightKey :== 29
+WinLeftKey :== 28
+WinDownKey :== 31
+WinUpKey :== 30
+WinF1Key :== 1001
+WinF2Key :== 1002
+WinF3Key :== 1003
+WinF4Key :== 1004
+WinF5Key :== 1005
+WinF6Key :== 1006
+WinF7Key :== 1007
+WinF8Key :== 1008
+WinF9Key :== 1009
+WinF10Key :== 1010
+WinF11Key :== 1011
+WinF12Key :== 1012
+
+CTRLBIT :== 4
+ALTBIT :== 2
+SHIFTBIT :== 1
+
+KEYREPEAT :== 4
+KEYUP :== 2
+KEYDOWN :== 1
+
+BUTTONUP :== 50
+BUTTONSTILLDOWN :== 40
+BUTTONTRIPLEDOWN :== 3
+BUTTONDOUBLEDOWN :== 2
+BUTTONDOWN :== 1
+BUTTONSTILLUP :== 0 /* PA: new constant for passing mouse move events. */
+
+
+// PA: moved from windowevent.icl because also used by menuCrossCall_12
+toModifiers :: !Int -> Modifiers
+
+winLaunchApp :: !{#Char} !Bool !*OSToolbox -> (!Bool,!*OSToolbox)
+winLaunchApp2 :: !{#Char} !{#Char} !Bool !*OSToolbox -> (!Bool,!*OSToolbox)
+winCallProcess :: !CSTR !CSTR !CSTR !CSTR !CSTR !CSTR !*OSToolbox -> (!Bool,!Int,!*OSToolbox)
+
+winGetModulePath :: {#Char}
+winFileModifiedDate :: !{#Char} -> (!Bool,!Int,!Int,!Int,!Int,!Int,!Int)
+winFileExists :: !{#Char} -> Bool
+
+winBeep :: !*OSToolbox -> *OSToolbox
+
+rand :: Int
+
+winReleaseCString :: !CSTR !*OSToolbox -> *OSToolbox
+winGetCStringAndFree :: !CSTR !*OSToolbox -> (!{#Char},!*OSToolbox)
+winGetCString :: !CSTR !*OSToolbox -> (!{#Char},!*OSToolbox)
+winMakeCString :: !{#Char} !*OSToolbox -> (!CSTR,!*OSToolbox)
+
+winGetAppPath :: CSTR
+
+winSetDoubleDownDist :: !Int !*OSToolbox -> *OSToolbox
+
+winGetHorzResolution :: Int
+winGetVertResolution :: Int
+
+winMaxFixedWindowSize :: (!Int,!Int)
+winMaxScrollWindowSize :: (!Int,!Int)
+
+// PA: interfaces added for determining screen width and height.
+winScreenYSize :: !*OSToolbox -> (!Int,!*OSToolbox)
+winScreenXSize :: !*OSToolbox -> (!Int,!*OSToolbox)
+
+winMinimumWinSize :: (!Int,!Int)
+
+// PA: function added to get system metrics for width and height of scrollbars.
+winScrollbarSize :: !*OSToolbox -> (!Int,!Int,!*OSToolbox)
+
+/* PA: two new routines (win(M/S)DIClientToOuterSizeDims added to convert between the
+ client and outer size of (M/S)DI windows. The Int argument contains the style flags
+ of the window.
+*/
+winMDIClientToOuterSizeDims :: !Int !*OSToolbox -> (!Int,!Int,!*OSToolbox)
+winSDIClientToOuterSizeDims :: !Int !*OSToolbox -> (!Int,!Int,!*OSToolbox)
+
+winPlaySound :: !{#Char} !*OSToolbox -> (!Bool,!*OSToolbox)
diff --git a/clCCall_12.icl b/clCCall_12.icl new file mode 100644 index 0000000..f307960 --- /dev/null +++ b/clCCall_12.icl @@ -0,0 +1,308 @@ +implementation module clCCall_12
+
+import StdClass, StdInt
+from StdIOCommon import :: Modifiers{..}
+from ostoolbox import :: OSToolbox
+import code from "cCCallSystem_121.o",
+ "cCCallWindows_121.o",
+ "cCrossCallWindows_121.o",
+ "cCrossCall_121.o",
+ "cdebug_121.o",
+ "cpicture_121.o",
+ "util_121.o"
+
+
+:: CSTR :== Int
+:: ACCLPTR :== Int
+
+MaxRand :== 32767
+
+WinHelpKey :== 5
+WinEscapeKey :== 27
+WinReturnKey :== 13
+WinTabKey :== 9
+WinDelKey :== 127
+WinBackSpKey :== 8
+WinEndKey :== 4
+WinBeginKey :== 1
+WinPgDownKey :== 12
+WinPgUpKey :== 11
+WinRightKey :== 29
+WinLeftKey :== 28
+WinDownKey :== 31
+WinUpKey :== 30
+WinF1Key :== 1001
+WinF2Key :== 1002
+WinF3Key :== 1003
+WinF4Key :== 1004
+WinF5Key :== 1005
+WinF6Key :== 1006
+WinF7Key :== 1007
+WinF8Key :== 1008
+WinF9Key :== 1009
+WinF10Key :== 1010
+WinF11Key :== 1011
+WinF12Key :== 1012
+
+CTRLBIT :== 4
+ALTBIT :== 2
+SHIFTBIT :== 1
+
+KEYREPEAT :== 4
+KEYUP :== 2
+KEYDOWN :== 1
+
+BUTTONUP :== 50
+BUTTONSTILLDOWN :== 40
+BUTTONTRIPLEDOWN :== 3
+BUTTONDOUBLEDOWN :== 2
+BUTTONDOWN :== 1
+BUTTONSTILLUP :== 0 /* PA: new constant for passing mouse move events. */
+
+
+// PA: moved from windowevent.icl because also used by menuCrossCall_12
+toModifiers :: !Int -> Modifiers
+toModifiers i
+ = { shiftDown = shifton
+ , optionDown = alton
+ , commandDown = ctrlon
+ , controlDown = ctrlon
+ , altDown = alton
+ }
+where
+ shifton = i bitand SHIFTBIT <> 0
+ alton = i bitand ALTBIT <> 0
+ ctrlon = i bitand CTRLBIT <> 0
+
+
+winLaunchApp :: !{#Char} !Bool !*OSToolbox -> ( !Bool, !*OSToolbox)
+winLaunchApp _ _ _
+ = code
+ {
+ .inline WinLaunchApp
+ ccall WinLaunchApp "SII-II"
+ .end
+ }
+
+winLaunchApp2 :: !{#Char} !{#Char} !Bool !*OSToolbox -> ( !Bool, !*OSToolbox)
+winLaunchApp2 _ _ _ _
+ = code
+ {
+ .inline WinLaunchApp2
+ ccall WinLaunchApp2 "SSII-II"
+ .end
+ }
+
+winCallProcess :: !CSTR !CSTR !CSTR !CSTR !CSTR !CSTR !*OSToolbox -> ( !Bool, !Int, !*OSToolbox)
+winCallProcess _ _ _ _ _ _ _
+ = code
+ {
+ .inline WinCallProcess
+ ccall WinCallProcess "IIIIIII-III"
+ .end
+ }
+
+winGetModulePath :: {#Char}
+winGetModulePath
+ = code
+ {
+ .inline WinGetModulePath
+ ccall WinGetModulePath "-S"
+ .end
+ }
+
+winFileModifiedDate :: !{#Char} -> ( !Bool, !Int, !Int, !Int, !Int, !Int, !Int)
+winFileModifiedDate _
+ = code
+ {
+ .inline WinFileModifiedDate
+ ccall WinFileModifiedDate "S-IIIIIII"
+ .end
+ }
+
+winFileExists :: !{#Char} -> Bool
+winFileExists _
+ = code
+ {
+ .inline WinFileExists
+ ccall WinFileExists "S-I"
+ .end
+ }
+
+winBeep :: !*OSToolbox -> *OSToolbox
+winBeep tb
+ = code
+ {
+ .inline WinBeep
+ ccall WinBeep "I-I"
+ .end
+ }
+
+rand :: Int
+rand
+ = code
+ {
+ .inline Rand
+ ccall Rand "-I"
+ .end
+ }
+
+winReleaseCString :: !CSTR !*OSToolbox -> *OSToolbox
+winReleaseCString _ _
+ = code
+ {
+ .inline WinReleaseCString
+ ccall WinReleaseCString "II-I"
+ .end
+ }
+
+winGetCStringAndFree :: !CSTR !*OSToolbox -> ( !{#Char}, !*OSToolbox)
+winGetCStringAndFree _ _
+ = code
+ {
+ .inline WinGetCStringAndFree
+ ccall WinGetCStringAndFree "II-SI"
+ .end
+ }
+
+winGetCString :: !CSTR !*OSToolbox -> ( !{#Char}, !*OSToolbox)
+winGetCString _ _
+ = code
+ {
+ .inline WinGetCString
+ ccall WinGetCString "II-SI"
+ .end
+ }
+
+winMakeCString :: !{#Char} !*OSToolbox -> ( !CSTR, !*OSToolbox)
+winMakeCString _ _
+ = code
+ {
+ .inline WinMakeCString
+ ccall WinMakeCString "SI-II"
+ .end
+ }
+
+winGetAppPath :: CSTR
+winGetAppPath
+ = code
+ {
+ .inline WinGetAppPath
+ ccall WinGetAppPath "-I"
+ .end
+ }
+
+winSetDoubleDownDist :: !Int !*OSToolbox -> *OSToolbox
+winSetDoubleDownDist _ _
+ = code
+ {
+ .inline WinSetDoubleDownDist
+ ccall WinSetDoubleDownDist "II-I"
+ .end
+ }
+
+winGetHorzResolution :: Int
+winGetHorzResolution
+ = code
+ {
+ .inline WinGetHorzResolution
+ ccall WinGetHorzResolution "-I"
+ .end
+ }
+
+winGetVertResolution :: Int
+winGetVertResolution
+ = code
+ {
+ .inline WinGetVertResolution
+ ccall WinGetVertResolution "-I"
+ .end
+ }
+
+winMaxFixedWindowSize :: ( !Int, !Int)
+winMaxFixedWindowSize
+ = code
+ {
+ .inline WinMaxFixedWindowSize
+ ccall WinMaxFixedWindowSize "-II"
+ .end
+ }
+
+winMaxScrollWindowSize :: ( !Int, !Int)
+winMaxScrollWindowSize
+ = code
+ {
+ .inline WinMaxScrollWindowSize
+ ccall WinMaxScrollWindowSize "-II"
+ .end
+ }
+
+// PA: interface added for determining screen width and height.
+winScreenYSize :: !*OSToolbox -> (!Int,!*OSToolbox)
+winScreenYSize _
+ = code
+ {
+ .inline WinScreenYSize
+ ccall WinScreenYSize "I-II"
+ .end
+ }
+
+winScreenXSize :: !*OSToolbox -> (!Int,!*OSToolbox)
+winScreenXSize _
+ = code
+ {
+ .inline WinScreenXSize
+ ccall WinScreenXSize "I-II"
+ .end
+ }
+
+winMinimumWinSize :: ( !Int, !Int)
+winMinimumWinSize
+ = code
+ {
+ .inline WinMinimumWinSize
+ ccall WinMinimumWinSize "-II"
+ .end
+ }
+
+// PA: function added to get system metrics for width and height of scrollbars.
+winScrollbarSize :: !*OSToolbox -> ( !Int, !Int, !*OSToolbox )
+winScrollbarSize _
+ = code
+ {
+ .inline WinScrollbarSize
+ ccall WinScrollbarSize "I-III"
+ .end
+ }
+
+/* PA: two new routines (win(M/S)DIClientToOuterSizeDims added to convert between the
+ client and outer size of (M/S)DI windows. The Int argument contains the style flags
+ of the window.
+*/
+winMDIClientToOuterSizeDims :: !Int !*OSToolbox -> (!Int,!Int,!*OSToolbox)
+winMDIClientToOuterSizeDims _ _
+ = code
+ {
+ .inline WinMDIClientToOuterSizeDims
+ ccall WinMDIClientToOuterSizeDims "II-III"
+ .end
+ }
+
+winSDIClientToOuterSizeDims :: !Int !*OSToolbox -> (!Int,!Int,!*OSToolbox)
+winSDIClientToOuterSizeDims _ _
+ = code
+ {
+ .inline WinSDIClientToOuterSizeDims
+ ccall WinSDIClientToOuterSizeDims "II-III"
+ .end
+ }
+
+
+winPlaySound :: !{#Char} !*OSToolbox -> (!Bool,!*OSToolbox)
+winPlaySound _ _
+ = code
+ {
+ .inline WinPlaySound
+ ccall WinPlaySound "SI-II"
+ .end
+ }
diff --git a/clCrossCall_12.dcl b/clCrossCall_12.dcl new file mode 100644 index 0000000..3140714 --- /dev/null +++ b/clCrossCall_12.dcl @@ -0,0 +1,281 @@ +definition module clCrossCall_12
+
+// Clean Object I/O library, version 1.2
+
+import StdOverloaded, StdString
+import ostoolbox
+
+ //----------------------------------------------//
+ // Crosscall infrastructure //
+//----------------------------------------------//
+
+// CrossCallInfo is the basic record that is passed between the Clean thread and the OS thread:
+:: CrossCallInfo
+ = { ccMsg :: !Int // The message nr: Clean->OS use ccRq...; OS->Clean use ccWm...
+ , p1 :: !Int
+ , p2 :: !Int
+ , p3 :: !Int
+ , p4 :: !Int
+ , p5 :: !Int
+ , p6 :: !Int
+ }
+
+// Crosscall with state parameter:
+errorCallback :: !String !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
+issueCleanRequest :: !(CrossCallInfo -> .(.s -> .(*OSToolbox -> *(.CrossCallInfo,.s,*OSToolbox))))
+ !.CrossCallInfo
+ !.s
+ !*OSToolbox
+ -> (!CrossCallInfo,!.s,!*OSToolbox)
+
+// Crosscall without state parameter:
+errorCallback2 :: !String !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+issueCleanRequest2 :: !(CrossCallInfo -> .(*OSToolbox -> *(.CrossCallInfo,*OSToolbox)))
+ !.CrossCallInfo
+ !*OSToolbox
+ -> (!CrossCallInfo,!*OSToolbox)
+
+consolePrint :: !{#Char} !*OSToolbox -> *OSToolbox
+iprint :: !String !.a -> .a
+iprint` :: !String !.a -> .a
+
+Rq0Cci msg :== {ccMsg=msg,p1=0,p2=0,p3=0,p4=0,p5=0,p6=0}
+Rq1Cci msg v1 :== {ccMsg=msg,p1=v1,p2=0,p3=0,p4=0,p5=0,p6=0}
+Rq2Cci msg v1 v2 :== {ccMsg=msg,p1=v1,p2=v2,p3=0,p4=0,p5=0,p6=0}
+Rq3Cci msg v1 v2 v3 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=0,p5=0,p6=0}
+Rq4Cci msg v1 v2 v3 v4 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=0,p6=0}
+Rq5Cci msg v1 v2 v3 v4 v5 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=v5,p6=0}
+Rq6Cci msg v1 v2 v3 v4 v5 v6 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=v5,p6=v6}
+
+return0Cci :: CrossCallInfo
+return1Cci :: !Int -> CrossCallInfo
+return2Cci :: !Int !Int -> CrossCallInfo
+return3Cci :: !Int !Int !Int -> CrossCallInfo
+return4Cci :: !Int !Int !Int !Int -> CrossCallInfo
+return5Cci :: !Int !Int !Int !Int !Int -> CrossCallInfo
+return6Cci :: !Int !Int !Int !Int !Int !Int -> CrossCallInfo
+
+
+ //---------------------------------------------------------------------//
+ // Synchronisation operations between the Clean thread and OS thread //
+//---------------------------------------------------------------------//
+winKickOsThread :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+winKillOsThread :: !*OSToolbox -> *OSToolbox
+winStartOsThread :: !*OSToolbox -> *OSToolbox
+
+winCloseOs :: !*OSToolbox -> Bool
+winInitOs :: (!Bool,!*OSToolbox)
+
+
+ //------------------------------------------------------------------------//
+ // The message numbers for communication from Clean to OS (ccMsg field) //
+//------------------------------------------------------------------------//
+// Mike //
+CcRqUSERGAMEEVENT :== 1905
+CcRqCREATEGAMEOBJECT :== 1904
+CcRqPLAYSOUNDSAMPLE :== 1903
+
+CcRqRUNGAME :== 1901
+CcRqCREATEGAMEWINDOW :== 1900
+///
+// MW...
+CcRqDO_PRINT_SETUP :== 1828 // MW11++
+CcRqDO_HTML_HELP :== 1827
+
+CcRqGET_PRINTER_DC :== 1824
+CcRqDISPATCH_MESSAGES_WHILE_PRINTING
+ :== 1823
+CcRqENDDOC :== 1822
+CcRqSTARTDOC :== 1821
+// ... MW
+CcRqCREATETCPWINDOW :== 1820 /* create TCP window */
+
+CcRqDESTROYMDIDOCWINDOW :== 1817 // PA: added to destroy MDI document window
+CcRqCREATESDIDOCWINDOW :== 1816 // PA: added to create SDI document window
+CcRqCREATEMDIDOCWINDOW :== 1815 // PA: added to create MDI document window
+CcRqCREATEMDIFRAMEWINDOW :== 1814 // PA: added to create MDI frame window
+CcRqCREATESDIFRAMEWINDOW :== 1813 // PA: added to create SDI frame window
+CcRqCLIPBOARDHASTEXT :== 1812
+CcRqGETCLIPBOARDTEXT :== 1811
+CcRqSETCLIPBOARDTEXT :== 1810
+CcRqGETCLIPBOARDCOUNT :== 1809 /* PA: added to retrieve clipboard count. */
+
+CcRqDIRECTORYDIALOG :== 1802 /* PA: added to create directory selector dialog. */
+CcRqFILESAVEDIALOG :== 1801
+CcRqFILEOPENDIALOG :== 1800
+
+CcRqSHOWCONTROL :== 1755 /* PA: added */
+CcRqSELECTPOPUPITEM :== 1754
+CcRqENABLEPOPUPITEM :== 1753
+CcRqADDTOPOPUP :== 1752
+CcRqSETITEMCHECK :== 1751
+CcRqENABLECONTROL :== 1750
+
+CcRqCREATECOMPOUND :== 1729 /* PA: added */
+CcRqCREATESCROLLBAR :== 1728 /* PA: added */
+CcRqCREATECUSTOM :== 1727
+CcRqCREATEICONBUT :== 1726
+CcRqCREATEPOPUP :== 1725
+CcRqCREATECHECKBOX :== 1724
+CcRqCREATERADIOBUT :== 1723
+CcRqCREATEEDITTXT :== 1722
+CcRqCREATESTATICTXT :== 1721
+CcRqCREATEBUTTON :== 1720
+
+CcRqCREATEMODALDIALOG :== 1701 /* PA: added to create modal dialog. */
+CcRqCREATEDIALOG :== 1700
+
+CcRqCREATETOOLBARSEPARATOR :== 1603 /* PA: added to create a toolbar separator item. */
+CcRqCREATETOOLBARITEM :== 1602 /* PA: added to create a toolbar bitmap item. */
+CcRqCREATEMDITOOLBAR :== 1601 /* PA: added to create a toolbar for a MDI process. */
+CcRqCREATESDITOOLBAR :== 1600 /* PA: added to create a toolbar. */
+
+CcCbFONTSIZE :== 1530
+
+CcCbFONTNAME :== 1520
+
+CcRqGETFONTSIZES :== 1510
+
+CcRqGETFONTNAMES :== 1500
+
+CcRqSETCLIENTSIZE :== 1438 /* PA: added to set client size. */
+CcRqDELCONTROLTIP :== 1437 /* PA: added to remove controls from tooltip areas. */
+CcRqADDCONTROLTIP :== 1436 /* PA: added to add controls to tooltip areas. */
+CcRqGETWINDOWSIZE :== 1435 /* PA: added to retrieve bounding size of windows. */
+CcRqRESTACKWINDOW :== 1434 /* PA: added to restack windows. */
+CcRqSHOWWINDOW :== 1433 /* PA: added to (hide/show) windows. */
+CcRqSETWINDOWSIZE :== 1432 /* PA: added to resize windows/controls. */
+CcRqSETSELECTWINDOW :== 1431 /* PA: added to (en/dis)able windows. */
+CcRqSETWINDOWPOS :== 1430 /* PA: added to move windows/controls. */
+
+CcRqSETEDITSELECTION :== 1428 /* PA: added for handling edit control selections. */
+CcRqSETSCROLLSIZE :== 1427 /* PA: added for setting thumb size of scrollbar. */
+CcRqSETSCROLLPOS :== 1426 /* PA: added for setting thumb of scrollbar. */
+CcRqSETSCROLLRANGE :== 1425 /* PA: added for setting range of scrollbar. */
+CcRqRESETCURSOR :== 1424
+CcRqSETGLOBALCURSOR :== 1423
+CcRqOBSCURECURSOR :== 1422
+CcRqCHANGEWINDOWCURSOR :== 1421
+CcRqACTIVATEWINDOW :== 1420 /* PA: added for activating window. */
+CcRqACTIVATECONTROL :== 1419 /* PA: added for activating controls. */
+
+CcRqGETWINDOWPOS :== 1416
+CcRqGETCLIENTSIZE :== 1415
+
+CcRqUPDATEWINDOWRECT :== 1412 /* PA: added for updating rect part of a window/control. */
+CcRqGETWINDOWTEXT :== 1411
+CcRqSETWINDOWTITLE :== 1410
+
+CcRqFAKEPAINT :== 1405 /* PA: added combination of BeginPaint; EndPaint; InvalidateRect; */
+CcRqENDPAINT :== 1404
+CcRqBEGINPAINT :== 1403
+CcRqDESTROYWINDOW :== 1402
+CcRqDESTROYMODALDIALOG :== 1401 /* PA: added to destroy modal dialog. */
+
+CcRqDRAWMBAR :== 1265
+
+CcRqTRACKPOPMENU :== 1256 /* PA: added for handling pop up menu. */
+CcRqCREATEPOPMENU :== 1255
+
+CcRqINSERTSEPARATOR :== 1245
+
+CcRqMENUENABLE :== 1235
+
+CcRqMODIFYMENU :== 1230
+
+CcRqINSERTMENU :== 1226 // PA: new constant for inserting a new menu into the menu bar
+
+CcRqITEMENABLE :== 1220
+
+CcRqREMOVEMENUSHORTKEY :== 1217 // PA: new constant for removing a shortkey of a menu item
+CcRqADDMENUSHORTKEY :== 1216 // PA: new constant for adding a shortkey of a menu item
+CcRqMODIFYMENUITEM :== 1215
+CcRqDESTROYMENU :== 1214 // PA: new constant for destroying a menu 'physically'
+CcRqDELETEMENU :== 1213 // PA: new constant for deleting a menu logically
+CcRqREMOVEMENUITEM :== 1212
+
+CcRqCHECKMENUITEM :== 1210
+
+CcRqINSERTMENUITEM :== 1205
+
+CcRqDOMESSAGE :== 1100
+
+ //------------------------------------------------------------------------//
+ // The message numbers for communication from OS to Clean (CcMsg field) //
+//------------------------------------------------------------------------//
+CcWINMESSmax :== 999
+
+// Mike: Convention for OS to Clean requests: 500-599 //
+CcWmCHECKQUIT :== 513 /* Mike: check user's quit function */
+CcWmUSEREVENT :== 512 /* Mike: user defined event */
+CcWmSTATISTICS :== 511 /* Mike: request for statistics */
+CcWmOBJECTKEYUP :== 510 /* Mike: key released */
+CcWmOBJECTKEYDOWN :== 509 /* Mike: key pressed for object */
+CcWmOBJECTTIMER :== 508 /* Mike: framecounter reached 0 */
+CcWmANIMATION :== 507 /* Mike: animation sequence ended */
+CcWmCOLLISION :== 506 /* Mike: collision of two objects */
+CcWmTOUCHBOUND :== 505 /* Mike: object touches bound or code */
+CcWmOBJECTDONE :== 504 /* Mike: object is destroyed */
+CcWmMOVEOBJECT :== 503 /* Mike: move object */
+CcWmINITOBJECT :== 502 /* Mike: initialize new object */
+CcWmSCROLL :== 501 /* Mike: calculate layer position */
+CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
+///
+CcWmINETEVENT :== 140 /* MW11 */
+
+CcWmZEROTIMER :== 136 /* PA: new constant for sequence of zero timer events (generated only by Clean). */
+CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */
+CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */
+CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */
+CcWmPROCESSDROPFILES :== 132 /* PA: new constant for requesting opening of files. */
+CcWmGETTOOLBARTIPTEXT :== 131 /* PA: new constant for getting tooltip text. */
+CcWmSETFOCUS :== 130 /* PA: new constant for notifying obtaining keyboard input focus. */
+CcWmKILLFOCUS :== 129 /* PA: new constant for notifying loss of keyboard input focus. */
+
+CcWmPROCESSCLOSE :== 127 /* PA: new constant for requesting closing of process. */
+CcWmDRAWCLIPBOARD :== 126 /* PA: new constant for clipboard handling. Copied from Ronny. */
+CcWmGETSCROLLBARINFO :== 125 /* PA: new constant for info about scrollbars. */
+CcWmSCROLLBARACTION :== 124 /* PA: new constant for scrollbar handling. */
+CcWmDDEEXECUTE :== 123
+
+CcWmIDLEDIALOG :== 121 /* PA: old constant reused for initialising modal dialogues. */
+CcWmDRAWCONTROL :== 120
+CcWmCOMBOSELECT :== 119
+CcWmBUTTONCLICKED :== 118
+CcWmINITDIALOG :== 117
+CcWmIDLETIMER :== 116
+CcWmTIMER :== 115
+CcWmNEWVTHUMB :== 114
+CcWmNEWHTHUMB :== 113
+CcWmGETVSCROLLVAL :== 112
+CcWmGETHSCROLLVAL :== 111
+CcWmSIZE :== 110 /* PA: old constant reused for passing resize information. */
+CcWmMOUSE :== 109
+CcWmKEYBOARD :== 108
+CcWmDEACTIVATE :== 107
+CcWmACTIVATE :== 106
+CcWmCLOSE :== 105
+CcWmCOMMAND :== 103
+CcWmCHAR :== 102
+CcWmCREATE :== 101
+CcWmPAINT :== 100
+
+CcWINMESSmin :== 100
+
+CcWmNOTIFY :== 78
+
+CcRETURNmax :== 19
+
+CcRETURN6 :== 16
+CcRETURN5 :== 15
+CcRETURN4 :== 14
+CcRETURN3 :== 13
+CcRETURN2 :== 12
+CcRETURN1 :== 11
+CcRETURN0 :== 10
+
+CcRETURNmin :== 10
+
+CcWASQUIT :== 1
+
+instance toInt Bool
diff --git a/clCrossCall_12.icl b/clCrossCall_12.icl new file mode 100644 index 0000000..8b331f3 --- /dev/null +++ b/clCrossCall_12.icl @@ -0,0 +1,427 @@ +implementation module clCrossCall_12
+
+import StdBool, StdClass, StdInt, StdMisc, StdString, StdTuple
+import ostoolbox
+import code from //"cAcceleratorTable_121.o",
+ "cCCallWindows_121.o",
+ "cCCallSystem_121.o",
+ "cCrossCall_121.o",
+ //"cCrossCallCursor_121.o",
+ "cCrossCallProcedureTable_121.o",
+ "cCrossCallWindows_121.o"
+/*
+import code from library "advapi32_library",
+ library "comctl32_library",
+ library "kernel32_library",
+ library "ole32_library",
+ library "shell32_library",
+ library "winmm_library",
+ library "winspool_library",
+ // library "wsock_library", // PA: should not be necessary
+ library "kernelExt_library",
+ library "gdiExt_library",
+ library "userExt_library"
+*/
+//import StdDebug, tracetypes
+
+ //----------------------------------------------//
+ // Crosscall infrastructure //
+//----------------------------------------------//
+
+// CrossCallInfo is the basic record that is passed between the Clean thread and the OS thread:
+:: CrossCallInfo
+ = { ccMsg :: !Int // The message nr: Clean->OS use CcRq...; OS->Clean use CcWm...
+ , p1 :: !Int
+ , p2 :: !Int
+ , p3 :: !Int
+ , p4 :: !Int
+ , p5 :: !Int
+ , p6 :: !Int
+ }
+
+
+// PA: restructured issueCleanRequest for readability.
+// 2 versions: first without Iprint statements, second with Iprint statements.
+// In both cases the Bool result has also been eliminated as it is never used.
+issueCleanRequest :: !(CrossCallInfo -> .(.s -> .(*OSToolbox -> *(.CrossCallInfo,.s,*OSToolbox))))
+ !.CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
+issueCleanRequest callback cci s tb
+// # tb = trace_n ("issueCleanRequest :"+++toOSCrossCallInfoString cci) tb
+ # (reply,tb) = winKickOsThread cci tb
+ = handleCallBacks callback reply s tb
+where
+ handleCallBacks :: !(CrossCallInfo -> .(.s -> .(*OSToolbox -> *(.CrossCallInfo,.s,*OSToolbox))))
+ !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
+ handleCallBacks callback cci=:{ccMsg} s tb
+ | ccMsg>2000
+ = abort ("handleCallBacks "+++toString ccMsg)
+// # tb = trace_n ("issueCleanRequest <-- "+++toCleanCrossCallInfoString cci) tb
+ | isReturnOrQuitCci ccMsg
+// # tb = trace_n "issueCleanRequest." tb
+ = (cci,s,tb)
+ | otherwise
+ # (returnCci,s,tb) = callback cci s tb
+// # tb = trace_n ("issueCleanRequest --> "+++toOSCrossCallInfoString returnCci) tb
+ # (replyCci,tb) = winKickOsThread returnCci tb
+ = handleCallBacks callback replyCci s tb
+
+/* PA: version of issueCleanRequest that has no state parameter.
+*/
+issueCleanRequest2 :: !(CrossCallInfo -> .(*OSToolbox -> *(.CrossCallInfo,*OSToolbox))) !.CrossCallInfo !*OSToolbox
+ -> (!CrossCallInfo,!*OSToolbox)
+issueCleanRequest2 callback cci tb
+// # tb = trace_n ("issueCleanRequest2 :"+++toOSCrossCallInfoString cci) tb
+ # (reply,tb) = winKickOsThread cci tb
+ = handleCallBacks callback reply tb
+where
+ handleCallBacks :: !(CrossCallInfo -> .(*OSToolbox -> *(.CrossCallInfo,*OSToolbox))) !CrossCallInfo !*OSToolbox
+ -> (!CrossCallInfo,!*OSToolbox)
+ handleCallBacks callback cci=:{ccMsg} tb
+ | ccMsg>2000
+ = abort ("HandleCallBacks "+++toString ccMsg)
+// # tb = trace_n ("issueCleanRequest2 <-- "+++toCleanCrossCallInfoString cci) tb
+ | isReturnOrQuitCci ccMsg
+// # tb = trace_n "issueCleanRequest2." tb
+ = (cci,tb)
+ | otherwise
+ # (returnCci,tb) = callback cci tb
+// # tb = trace_n ("issueCleanRequest2 --> "+++toOSCrossCallInfoString returnCci) tb
+ # (replyCci, tb) = winKickOsThread returnCci tb
+ = handleCallBacks callback replyCci tb
+
+// PA: macros for returning proper number of arguments within a CrossCallInfo.
+Rq0Cci msg :== {ccMsg=msg,p1=0,p2=0,p3=0,p4=0,p5=0,p6=0}
+Rq1Cci msg v1 :== {ccMsg=msg,p1=v1,p2=0,p3=0,p4=0,p5=0,p6=0}
+Rq2Cci msg v1 v2 :== {ccMsg=msg,p1=v1,p2=v2,p3=0,p4=0,p5=0,p6=0}
+Rq3Cci msg v1 v2 v3 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=0,p5=0,p6=0}
+Rq4Cci msg v1 v2 v3 v4 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=0,p6=0}
+Rq5Cci msg v1 v2 v3 v4 v5 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=v5,p6=0}
+Rq6Cci msg v1 v2 v3 v4 v5 v6 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=v5,p6=v6}
+
+return0Cci :: CrossCallInfo
+return0Cci = Rq0Cci CcRETURN0
+
+return1Cci :: !Int -> CrossCallInfo
+return1Cci v = Rq1Cci CcRETURN1 v
+
+return2Cci :: !Int !Int -> CrossCallInfo
+return2Cci v1 v2 = Rq2Cci CcRETURN2 v1 v2
+
+return3Cci :: !Int !Int !Int -> CrossCallInfo
+return3Cci v1 v2 v3 = Rq3Cci CcRETURN3 v1 v2 v3
+
+return4Cci :: !Int !Int !Int !Int -> CrossCallInfo
+return4Cci v1 v2 v3 v4 = Rq4Cci CcRETURN4 v1 v2 v3 v4
+
+return5Cci :: !Int !Int !Int !Int !Int -> CrossCallInfo
+return5Cci v1 v2 v3 v4 v5 = Rq5Cci CcRETURN5 v1 v2 v3 v4 v5
+
+return6Cci :: !Int !Int !Int !Int !Int !Int -> CrossCallInfo
+return6Cci v1 v2 v3 v4 v5 v6 = Rq6Cci CcRETURN6 v1 v2 v3 v4 v5 v6
+
+isReturnOrQuitCci :: !Int -> Bool
+isReturnOrQuitCci mess
+ = mess==CcWASQUIT || (mess<=CcRETURNmax && mess>=CcRETURNmin)
+
+instance toInt Bool where
+ toInt :: !Bool -> Int
+ toInt True = -1
+ toInt _ = 0
+
+errorCallback :: !String !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo, !.s, !*OSToolbox)
+errorCallback source cci s tb
+ = (return0Cci, s, iprint msgtext tb)
+where
+ msgtext = " *** [" +++ source +++ "] did not expect a callback: " +++ toString cci.ccMsg
+
+// PA: version of errorCallback without state parameter (use with IssueCleanRequest2).
+errorCallback2 :: !String !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+errorCallback2 source cci tb
+ = (return0Cci,iprint msgtext tb)
+where
+ msgtext = " *** [" +++ source +++ "] did not expect a callback: " +++ toString cci.ccMsg
+
+iprint :: !String !.a -> .a
+iprint s a
+ | not (printresult == 0) = a
+ = abort ("Print failed: " +++ s)
+where
+ printresult = consolePrint ("## " +++ s +++ "\n") 999
+
+iprint` :: !String !.a -> .a
+iprint` s a
+ | not (printresult == 0) = a
+ = abort ("Print failed: " +++ s)
+where
+ printresult = consolePrint s 999
+
+consolePrint :: !{#Char} !*OSToolbox -> *OSToolbox
+consolePrint _ _
+ = code
+ {
+ .inline ConsolePrint
+ ccall ConsolePrint "SI-I"
+ .end
+ }
+
+
+ //---------------------------------------------------------------------//
+ // Synchronisation operations between the Clean thread and OS thread //
+//---------------------------------------------------------------------//
+
+winKickOsThread :: !CrossCallInfo !*OSToolbox -> ( !CrossCallInfo, !*OSToolbox)
+winKickOsThread _ _
+ = code
+ {
+ .inline WinKickOsThread
+ ccall WinKickOsThread "IIIIIIII-IIIIIIII"
+ .end
+ }
+
+winKillOsThread :: !*OSToolbox -> *OSToolbox
+winKillOsThread _
+ = code
+ {
+ .inline WinKillOsThread
+ ccall WinKillOsThread "I-I"
+ .end
+ }
+
+winStartOsThread :: !*OSToolbox -> *OSToolbox
+winStartOsThread _
+ = code
+ {
+ .inline WinStartOsThread
+ ccall WinStartOsThread "I-I"
+ .end
+ }
+
+winCloseOs :: !*OSToolbox -> Bool
+winCloseOs _
+ = code
+ {
+ .inline WinCloseOs
+ ccall WinCloseOs "I-I"
+ .end
+ }
+
+winInitOs :: ( !Bool, !*OSToolbox)
+winInitOs
+ = code
+ {
+ .inline WinInitOs
+ ccall WinInitOs "-II"
+ .end
+ }
+
+
+ //------------------------------------------------------------------------//
+ // The message numbers for communication from Clean to OS (ccMsg field) //
+//------------------------------------------------------------------------//
+// Mike //
+CcRqUSERGAMEEVENT :== 1905
+CcRqCREATEGAMEOBJECT :== 1904
+CcRqPLAYSOUNDSAMPLE :== 1903
+
+CcRqRUNGAME :== 1901
+CcRqCREATEGAMEWINDOW :== 1900
+///
+// MW...
+CcRqDO_PRINT_SETUP :== 1828 // MW11++
+CcRqDO_HTML_HELP :== 1827
+
+CcRqGET_PRINTER_DC :== 1824
+CcRqDISPATCH_MESSAGES_WHILE_PRINTING
+ :== 1823
+CcRqENDDOC :== 1822
+CcRqSTARTDOC :== 1821
+// ... MW
+CcRqCREATETCPWINDOW :== 1820 /* create TCP window */
+
+CcRqDESTROYMDIDOCWINDOW :== 1817 // PA: added to destroy MDI document window
+CcRqCREATESDIDOCWINDOW :== 1816 // PA: added to create SDI document window
+CcRqCREATEMDIDOCWINDOW :== 1815 // PA: added to create MDI document window
+CcRqCREATEMDIFRAMEWINDOW :== 1814 // PA: added to create MDI frame window
+CcRqCREATESDIFRAMEWINDOW :== 1813 // PA: added to create SDI frame window
+CcRqCLIPBOARDHASTEXT :== 1812
+CcRqGETCLIPBOARDTEXT :== 1811
+CcRqSETCLIPBOARDTEXT :== 1810
+CcRqGETCLIPBOARDCOUNT :== 1809 /* PA: added to retrieve clipboard count. */
+
+CcRqDIRECTORYDIALOG :== 1802 /* PA: added to create directory selector dialog. */
+CcRqFILESAVEDIALOG :== 1801
+CcRqFILEOPENDIALOG :== 1800
+
+CcRqSHOWCONTROL :== 1755 /* PA: added */
+CcRqSELECTPOPUPITEM :== 1754
+CcRqENABLEPOPUPITEM :== 1753
+CcRqADDTOPOPUP :== 1752
+CcRqSETITEMCHECK :== 1751
+CcRqENABLECONTROL :== 1750
+
+CcRqCREATECOMPOUND :== 1729 /* PA: added */
+CcRqCREATESCROLLBAR :== 1728 /* PA: added */
+CcRqCREATECUSTOM :== 1727
+CcRqCREATEICONBUT :== 1726
+CcRqCREATEPOPUP :== 1725
+CcRqCREATECHECKBOX :== 1724
+CcRqCREATERADIOBUT :== 1723
+CcRqCREATEEDITTXT :== 1722
+CcRqCREATESTATICTXT :== 1721
+CcRqCREATEBUTTON :== 1720
+
+CcRqCREATEMODALDIALOG :== 1701 /* PA: added to create modal dialog. */
+CcRqCREATEDIALOG :== 1700
+
+CcRqCREATETOOLBARSEPARATOR :== 1603 /* PA: added to create a toolbar separator item. */
+CcRqCREATETOOLBARITEM :== 1602 /* PA: added to create a toolbar bitmap item. */
+CcRqCREATEMDITOOLBAR :== 1601 /* PA: added to create a toolbar for a MDI process. */
+CcRqCREATESDITOOLBAR :== 1600 /* PA: added to create a toolbar. */
+
+CcCbFONTSIZE :== 1530
+
+CcCbFONTNAME :== 1520
+
+CcRqGETFONTSIZES :== 1510
+
+CcRqGETFONTNAMES :== 1500
+
+CcRqSETCLIENTSIZE :== 1438 /* PA: added to set client size. */
+CcRqDELCONTROLTIP :== 1437 /* PA: added to remove controls from tooltip areas. */
+CcRqADDCONTROLTIP :== 1436 /* PA: added to add controls to tooltip areas. */
+CcRqGETWINDOWSIZE :== 1435 /* PA: added to retrieve bounding size of windows. */
+CcRqRESTACKWINDOW :== 1434 /* PA: added to restack windows. */
+CcRqSHOWWINDOW :== 1433 /* PA: added to (hide/show) windows. */
+CcRqSETWINDOWSIZE :== 1432 /* PA: added to resize windows/controls. */
+CcRqSETSELECTWINDOW :== 1431 /* PA: added to (en/dis)able windows. */
+CcRqSETWINDOWPOS :== 1430 /* PA: added to move windows/controls. */
+
+CcRqSETEDITSELECTION :== 1428 /* PA: added for handling edit control selections. */
+CcRqSETSCROLLSIZE :== 1427 /* PA: added for setting thumb size of scrollbar. */
+CcRqSETSCROLLPOS :== 1426 /* PA: added for setting thumb of scrollbar. */
+CcRqSETSCROLLRANGE :== 1425 /* PA: added for setting range of scrollbar. */
+CcRqRESETCURSOR :== 1424
+CcRqSETGLOBALCURSOR :== 1423
+CcRqOBSCURECURSOR :== 1422
+CcRqCHANGEWINDOWCURSOR :== 1421
+CcRqACTIVATEWINDOW :== 1420 /* PA: added for activating window. */
+CcRqACTIVATECONTROL :== 1419 /* PA: added for activating controls. */
+
+CcRqGETWINDOWPOS :== 1416
+CcRqGETCLIENTSIZE :== 1415
+
+CcRqUPDATEWINDOWRECT :== 1412 /* PA: added for updating rect part of a window/control. */
+CcRqGETWINDOWTEXT :== 1411
+CcRqSETWINDOWTITLE :== 1410
+
+CcRqFAKEPAINT :== 1405 /* PA: added combination of BeginPaint; EndPaint; InvalidateRect; */
+CcRqENDPAINT :== 1404
+CcRqBEGINPAINT :== 1403
+CcRqDESTROYWINDOW :== 1402
+CcRqDESTROYMODALDIALOG :== 1401 /* PA: added to destroy modal dialog. */
+
+CcRqDRAWMBAR :== 1265
+
+CcRqTRACKPOPMENU :== 1256 /* PA: added for handling pop up menu. */
+CcRqCREATEPOPMENU :== 1255
+
+CcRqINSERTSEPARATOR :== 1245
+
+CcRqMENUENABLE :== 1235
+
+CcRqMODIFYMENU :== 1230
+
+CcRqINSERTMENU :== 1226 // PA: new constant for inserting a new menu into the menu bar
+
+CcRqITEMENABLE :== 1220
+
+CcRqREMOVEMENUSHORTKEY :== 1217 // PA: new constant for removing a shortkey of a menu item
+CcRqADDMENUSHORTKEY :== 1216 // PA: new constant for adding a shortkey of a menu item
+CcRqMODIFYMENUITEM :== 1215
+CcRqDESTROYMENU :== 1214 // PA: new constant for destroying a menu 'physically'
+CcRqDELETEMENU :== 1213 // PA: new constant for deleting a menu logically
+CcRqREMOVEMENUITEM :== 1212
+
+CcRqCHECKMENUITEM :== 1210
+
+CcRqINSERTMENUITEM :== 1205
+
+CcRqDOMESSAGE :== 1100
+
+ //------------------------------------------------------------------------//
+ // The message numbers for communication from OS to Clean (CcMsg field) //
+//------------------------------------------------------------------------//
+CcWINMESSmax :== 999
+
+// Mike: Convention for OS to Clean requests: 500-599 //
+CcWmCHECKQUIT :== 513 /* Mike: check user's quit function */
+CcWmUSEREVENT :== 512 /* Mike: user defined event */
+CcWmSTATISTICS :== 511 /* Mike: request for statistics */
+CcWmOBJECTKEYUP :== 510 /* Mike: key released */
+CcWmOBJECTKEYDOWN :== 509 /* Mike: key pressed for object */
+CcWmOBJECTTIMER :== 508 /* Mike: framecounter reached 0 */
+CcWmANIMATION :== 507 /* Mike: animation sequence ended */
+CcWmCOLLISION :== 506 /* Mike: collision of two objects */
+CcWmTOUCHBOUND :== 505 /* Mike: object touches bound or code */
+CcWmOBJECTDONE :== 504 /* Mike: object is destroyed */
+CcWmMOVEOBJECT :== 503 /* Mike: move object */
+CcWmINITOBJECT :== 502 /* Mike: initialize new object */
+CcWmSCROLL :== 501 /* Mike: calculate layer position */
+CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
+///
+CcWmINETEVENT :== 140 /* MW11 */
+
+CcWmZEROTIMER :== 136 /* PA: new constant for sequence of zero timer events (generated only by Clean). */
+CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */
+CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */
+CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */
+CcWmPROCESSDROPFILES :== 132 /* PA: new constant for requesting opening of files. */
+CcWmGETTOOLBARTIPTEXT :== 131 /* PA: new constant for getting tooltip text. */
+CcWmSETFOCUS :== 130 /* PA: new constant for notifying obtaining keyboard input focus. */
+CcWmKILLFOCUS :== 129 /* PA: new constant for notifying loss of keyboard input focus. */
+
+CcWmPROCESSCLOSE :== 127 /* PA: new constant for requesting closing of process. */
+CcWmDRAWCLIPBOARD :== 126 /* PA: new constant for clipboard handling. Copied from Ronny. */
+CcWmGETSCROLLBARINFO :== 125 /* PA: new constant for info about scrollbars. */
+CcWmSCROLLBARACTION :== 124 /* PA: new constant for scrollbar handling. */
+CcWmDDEEXECUTE :== 123
+
+CcWmIDLEDIALOG :== 121 /* PA: old constant reused for initialising modal dialogues. */
+CcWmDRAWCONTROL :== 120
+CcWmCOMBOSELECT :== 119
+CcWmBUTTONCLICKED :== 118
+CcWmINITDIALOG :== 117
+CcWmIDLETIMER :== 116
+CcWmTIMER :== 115
+CcWmNEWVTHUMB :== 114
+CcWmNEWHTHUMB :== 113
+CcWmGETVSCROLLVAL :== 112
+CcWmGETHSCROLLVAL :== 111
+CcWmSIZE :== 110 /* PA: old constant reused for passing resize information. */
+CcWmMOUSE :== 109
+CcWmKEYBOARD :== 108
+CcWmDEACTIVATE :== 107
+CcWmACTIVATE :== 106
+CcWmCLOSE :== 105
+CcWmCOMMAND :== 103
+CcWmCHAR :== 102
+CcWmCREATE :== 101
+CcWmPAINT :== 100
+
+CcWINMESSmin :== 100
+
+CcWmNOTIFY :== 78
+
+CcRETURNmax :== 19
+
+CcRETURN6 :== 16
+CcRETURN5 :== 15
+CcRETURN4 :== 14
+CcRETURN3 :== 13
+CcRETURN2 :== 12
+CcRETURN1 :== 11
+CcRETURN0 :== 10
+
+CcRETURNmin :== 10
+
+CcWASQUIT :== 1
diff --git a/clipboardCrossCall_12.dcl b/clipboardCrossCall_12.dcl new file mode 100644 index 0000000..16b0fab --- /dev/null +++ b/clipboardCrossCall_12.dcl @@ -0,0 +1,26 @@ +definition module clipboardCrossCall_12
+
+import clCrossCall_12
+
+// Predefined Clipboard Formats.
+CF_TEXT :== 1
+CF_BITMAP :== 2
+CF_METAFILEPICT :== 3
+CF_SYLK :== 4
+CF_DIF :== 5
+CF_TIFF :== 6
+CF_OEMTEXT :== 7
+CF_DIB :== 8
+CF_PALETTE :== 9
+CF_PENDATA :== 10
+CF_RIFF :== 11
+CF_WAVE :== 12
+CF_UNICODETEXT :== 13
+CF_ENHMETAFILE :== 14
+
+
+winInitialiseClipboard :: !*OSToolbox -> *OSToolbox
+winGetClipboardText :: !*OSToolbox -> (!String,!*OSToolbox)
+winSetClipboardText :: !String !*OSToolbox -> *OSToolbox
+winHasClipboardText :: !*OSToolbox -> (!Bool, !*OSToolbox)
+winGetClipboardCount :: !*OSToolbox -> (!Int, !*OSToolbox)
diff --git a/clipboardCrossCall_12.icl b/clipboardCrossCall_12.icl new file mode 100644 index 0000000..01e3c0c --- /dev/null +++ b/clipboardCrossCall_12.icl @@ -0,0 +1,65 @@ +implementation module clipboardCrossCall_12
+
+
+import StdBool, StdClass, StdInt, StdMisc
+import clCrossCall_12
+from clCCall_12 import winMakeCString, winGetCStringAndFree, winReleaseCString, :: CSTR
+import code from "cCrossCallClipboard_121.o"
+
+
+// Predefined Clipboard Formats.
+CF_TEXT :== 1
+CF_BITMAP :== 2
+CF_METAFILEPICT :== 3
+CF_SYLK :== 4
+CF_DIF :== 5
+CF_TIFF :== 6
+CF_OEMTEXT :== 7
+CF_DIB :== 8
+CF_PALETTE :== 9
+CF_PENDATA :== 10
+CF_RIFF :== 11
+CF_WAVE :== 12
+CF_UNICODETEXT :== 13
+CF_ENHMETAFILE :== 14
+
+
+winInitialiseClipboard :: !*OSToolbox -> *OSToolbox
+winInitialiseClipboard _
+ = code
+ {
+ .inline InstallCrossCallClipboard
+ ccall InstallCrossCallClipboard "I-I"
+ .end
+ }
+
+winGetClipboardText :: !*OSToolbox -> (!String,!*OSToolbox)
+winGetClipboardText tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winGetClipboardText") (Rq0Cci CcRqGETCLIPBOARDTEXT) tb
+ rmsg = rcci.ccMsg
+ | rmsg==CcRETURN1 = winGetCStringAndFree rcci.p1 tb
+ | rmsg==CcWASQUIT = ("",tb)
+ | otherwise = abort "[winGetClipboardText] expected CcRETURN1 value.\n"
+
+winSetClipboardText :: !String !*OSToolbox -> *OSToolbox
+winSetClipboardText text tb
+ # (textptr,tb) = winMakeCString text tb
+ # (_,tb) = issueCleanRequest2 (errorCallback2 "winSetClipboardText") (Rq1Cci CcRqSETCLIPBOARDTEXT textptr) tb
+ # tb = winReleaseCString textptr tb
+ = tb
+
+winHasClipboardText :: !*OSToolbox -> (!Bool,!*OSToolbox)
+winHasClipboardText tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winHasClipboardText") (Rq0Cci CcRqCLIPBOARDHASTEXT) tb
+ rmsg = rcci.ccMsg
+ | rmsg==CcRETURN1 = (rcci.p1<>0,tb)
+ | rmsg==CcWASQUIT = (False, tb)
+ | otherwise = abort "[winHasClipboardText] expected CcRETURN1 value."
+
+winGetClipboardCount :: !*OSToolbox -> (!Int,!*OSToolbox)
+winGetClipboardCount tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winGetClipboardCount") (Rq0Cci CcRqGETCLIPBOARDCOUNT) tb
+ rmsg = rcci.ccMsg
+ | rmsg==CcRETURN1 = (rcci.p1,tb)
+ | rmsg==CcWASQUIT = (0, tb)
+ | otherwise = abort "[winGetClipboardCount] expected CcRETURN1 value.\n"
diff --git a/menuCCall_12.dcl b/menuCCall_12.dcl new file mode 100644 index 0000000..7f12a12 --- /dev/null +++ b/menuCCall_12.dcl @@ -0,0 +1,5 @@ +definition module menuCCall_12
+
+import ostoolbox
+
+winInitialiseMenus :: !*OSToolbox -> *OSToolbox
diff --git a/menuCCall_12.icl b/menuCCall_12.icl new file mode 100644 index 0000000..19d6680 --- /dev/null +++ b/menuCCall_12.icl @@ -0,0 +1,13 @@ +implementation module menuCCall_12
+
+import ostoolbox
+import code from "cCrossCallMenus_121.o"
+
+winInitialiseMenus :: !*OSToolbox -> *OSToolbox
+winInitialiseMenus _
+ = code
+ {
+ .inline InstallCrossCallMenus
+ ccall InstallCrossCallMenus "I-I"
+ .end
+ }
diff --git a/menuCrossCall_12.dcl b/menuCrossCall_12.dcl new file mode 100644 index 0000000..a4e2340 --- /dev/null +++ b/menuCrossCall_12.dcl @@ -0,0 +1,29 @@ +definition module menuCrossCall_12
+
+
+import StdString
+from StdIOCommon import :: Modifiers
+from ostoolbox import :: OSToolbox
+from ostypes import :: HWND
+
+
+:: HITEM :== Int
+:: HMENU :== Int
+
+
+winCreatePopupMenuHandle:: !*OSToolbox -> (!HMENU, !*OSToolbox)
+winTrackPopupMenu :: !HMENU !HWND !*OSToolbox -> (!Int,!Modifiers,!*OSToolbox)
+winInsertMenu :: !String !Bool !HMENU !HMENU !Int !*OSToolbox -> *OSToolbox
+winInsertMenuItem :: !String !Bool !Bool !HMENU !Int !*OSToolbox -> (!HITEM, !*OSToolbox)
+winInsertSeparator :: !HMENU !Int !*OSToolbox -> *OSToolbox
+winChangeMenuItemCheck :: !HMENU !HITEM !Bool !*OSToolbox -> *OSToolbox
+winModifyMenu :: !String !HMENU !HMENU !*OSToolbox -> *OSToolbox
+winModifyMenuItem :: !String !HITEM !HMENU !*OSToolbox -> *OSToolbox
+winDestroyMenu :: !HMENU !*OSToolbox -> *OSToolbox
+winDeleteMenu :: !HMENU !HITEM !*OSToolbox -> *OSToolbox
+winRemoveMenuItem :: !HMENU !HITEM !*OSToolbox -> *OSToolbox
+winChangeItemAbility :: !HMENU !HITEM !Bool !*OSToolbox -> *OSToolbox
+winChangeMenuAbility :: !HMENU !Int !Bool !*OSToolbox -> *OSToolbox
+winDrawMenuBar :: !HWND !HWND !*OSToolbox -> *OSToolbox
+winAddMenuShortKey :: !HWND !Int !Char !*OSToolbox -> *OSToolbox
+winRemoveMenuShortKey :: !HWND !Int !*OSToolbox -> *OSToolbox
diff --git a/menuCrossCall_12.icl b/menuCrossCall_12.icl new file mode 100644 index 0000000..5f13588 --- /dev/null +++ b/menuCrossCall_12.icl @@ -0,0 +1,101 @@ +implementation module menuCrossCall_12
+
+
+import StdInt, StdMisc, StdTuple
+from StdIOCommon import :: Modifiers
+import clCrossCall_12
+from clCCall_12 import winMakeCString, winReleaseCString, :: CSTR, toModifiers
+from ostypes import :: HWND
+
+
+:: HITEM :== Int
+:: HMENU :== Int
+
+
+winCreatePopupMenuHandle :: !*OSToolbox -> (!HMENU,!*OSToolbox) // PA: check if this can be a C call
+winCreatePopupMenuHandle tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winCreatePopupMenuHandle") (Rq0Cci CcRqCREATEPOPMENU) tb
+ menu = case rcci.ccMsg of
+ CcRETURN1 -> rcci.p1
+ CcWASQUIT -> 0
+ otherwise -> abort "[winCreatePopupMenuHandle] expected CcRETURN1 value."
+ = (menu,tb)
+
+winTrackPopupMenu :: !HMENU !HWND !*OSToolbox -> (!Int,!Modifiers,!*OSToolbox)
+winTrackPopupMenu menu framePtr tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winTrackPopupMenu") (Rq2Cci CcRqTRACKPOPMENU menu framePtr) tb
+ (menuItemID,mods) = case rcci.ccMsg of
+ CcRETURN2 -> (rcci.p1,rcci.p2)
+ CcWASQUIT -> (0, 0)
+ otherwise -> abort "[winTrackPopupMenu] expected CcRETURN2 value."
+ = (menuItemID,toModifiers mods,tb)
+
+winInsertMenu :: !String !Bool !HMENU !HMENU !Int !*OSToolbox -> *OSToolbox
+winInsertMenu text state submenu menu pos tb
+ # (textptr,tb) = winMakeCString text tb
+ # (_,tb) = issueCleanRequest2 (errorCallback2 "winInsertMenu") (Rq5Cci CcRqINSERTMENU (toInt state) menu textptr submenu pos) tb
+ = winReleaseCString textptr tb
+
+winInsertMenuItem :: !String !Bool !Bool !HMENU !Int !*OSToolbox -> (!HITEM,!*OSToolbox)
+winInsertMenuItem text ablestate markstate menu pos tb
+ # (textptr,tb) = winMakeCString text tb
+ insertCci = Rq5Cci CcRqINSERTMENUITEM (toInt ablestate) menu textptr (toInt markstate) pos
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winInsertMenuItem") insertCci tb
+ hitem = case rcci.ccMsg of
+ CcRETURN1 -> rcci.p1
+ CcWASQUIT -> 0
+ other -> abort "[winInsertMenuItem] expected CcRETURN1 value."
+ # tb = winReleaseCString textptr tb
+ = (hitem,tb)
+
+winInsertSeparator :: !HMENU !Int !*OSToolbox -> *OSToolbox
+winInsertSeparator menu pos tb
+ = snd (issueCleanRequest2 (errorCallback2 "winInsertSeparator") (Rq2Cci CcRqINSERTSEPARATOR menu pos) tb)
+
+winChangeMenuItemCheck :: !HMENU !HITEM !Bool !*OSToolbox -> *OSToolbox
+winChangeMenuItemCheck menu hitem state tb
+ = snd (issueCleanRequest2 (errorCallback2 "winChangeMenuItemCheck") (Rq3Cci CcRqCHECKMENUITEM menu hitem (toInt state)) tb)
+
+winModifyMenu :: !String !HMENU !HMENU !*OSToolbox -> *OSToolbox
+winModifyMenu text submenu menu tb
+ # (textptr,tb) = winMakeCString text tb
+ # (_,tb) = issueCleanRequest2 (errorCallback2 "winModifyMenu") (Rq3Cci CcRqMODIFYMENU submenu menu textptr) tb
+ = winReleaseCString textptr tb
+
+winModifyMenuItem :: !String !HITEM !HMENU !*OSToolbox -> *OSToolbox
+winModifyMenuItem text hitem menu tb
+ # (textptr,tb) = winMakeCString text tb
+ # (_,tb) = issueCleanRequest2 (errorCallback2 "winModifyMenuItem") (Rq3Cci CcRqMODIFYMENUITEM hitem menu textptr) tb
+ = winReleaseCString textptr tb
+
+winDestroyMenu :: !HMENU !*OSToolbox -> *OSToolbox
+winDestroyMenu menu tb
+ = snd (issueCleanRequest2 (errorCallback2 "winDestroyMenu") (Rq1Cci CcRqDESTROYMENU menu) tb)
+
+winDeleteMenu :: !HMENU !HITEM !*OSToolbox -> *OSToolbox
+winDeleteMenu menu hitem tb
+ = snd (issueCleanRequest2 (errorCallback2 "winDeleteMenu") (Rq2Cci CcRqDELETEMENU menu hitem) tb)
+
+winRemoveMenuItem :: !HMENU !HITEM !*OSToolbox -> *OSToolbox
+winRemoveMenuItem menu hitem tb
+ = snd (issueCleanRequest2 (errorCallback2 "winRemoveMenuItem") (Rq2Cci CcRqREMOVEMENUITEM menu hitem) tb)
+
+winChangeItemAbility :: !HMENU !HITEM !Bool !*OSToolbox -> *OSToolbox
+winChangeItemAbility parent hitem onoff tb
+ = snd (issueCleanRequest2 (errorCallback2 "winChangeItemAbility") (Rq3Cci CcRqITEMENABLE parent hitem (toInt onoff)) tb)
+
+winChangeMenuAbility :: !HMENU !Int !Bool !*OSToolbox -> *OSToolbox
+winChangeMenuAbility parent zIndex onoff tb
+ = snd (issueCleanRequest2 (errorCallback2 "winChangeMenuAbility") (Rq3Cci CcRqMENUENABLE parent zIndex (toInt onoff)) tb)
+
+winDrawMenuBar :: !HWND !HWND !*OSToolbox -> *OSToolbox
+winDrawMenuBar framePtr clientPtr tb
+ = snd (issueCleanRequest2 (errorCallback2 "winDrawMenuBar") (Rq2Cci CcRqDRAWMBAR framePtr clientPtr) tb)
+
+winAddMenuShortKey :: !HWND !Int !Char !*OSToolbox -> *OSToolbox
+winAddMenuShortKey framePtr cmd key tb
+ = snd (issueCleanRequest2 (errorCallback2 "winAddMenuShortKey") (Rq3Cci CcRqADDMENUSHORTKEY framePtr cmd (toInt key)) tb)
+
+winRemoveMenuShortKey :: !HWND !Int !*OSToolbox -> *OSToolbox
+winRemoveMenuShortKey framePtr cmd tb
+ = snd (issueCleanRequest2 (errorCallback2 "winRemoveMenuShortKey") (Rq2Cci CcRqREMOVEMENUSHORTKEY framePtr cmd) tb)
diff --git a/menuevent.dcl b/menuevent.dcl new file mode 100644 index 0000000..540520b --- /dev/null +++ b/menuevent.dcl @@ -0,0 +1,23 @@ +definition module menuevent
+
+
+// Clean Object I/O library, version 1.2
+
+/* menuevent defines the DeviceEventFunction for the menu device.
+ This function is placed in a separate module because it is platform dependent.
+*/
+
+
+import deviceevents, devicesystemstate, menuhandle
+from iostate import :: PSt
+from osmenu import :: OSTrackPopUpMenu
+
+
+menuEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+
+/* For pop up menu's an alternative way to determine the DeviceEvent is required:
+*/
+popUpMenuEvent :: !OSTrackPopUpMenu !(MenuStateHandle .ps) !*OSToolbox -> (!Maybe DeviceEvent, !MenuStateHandle .ps, !*OSToolbox)
+
+//menuHandlesGetMenuStateHandles :: !(MenuHandles .pst) -> (![MenuStateHandle .pst], !MenuHandles .pst)
+// PA: not used
diff --git a/menuevent.icl b/menuevent.icl new file mode 100644 index 0000000..7bd96b6 --- /dev/null +++ b/menuevent.icl @@ -0,0 +1,321 @@ +implementation module menuevent
+
+
+import StdBool, StdList, StdMisc
+import clCrossCall_12
+from clCCall_12 import winMakeCString, :: CSTR, toModifiers
+from osmenu import osMenuItemCheck, :: OSTrackPopUpMenu{..}, :: OSTrackPopUpMenuResult(..)
+import commondef, deviceevents, iostate
+from menuaccess import menuStateHandleGetHandle, menuStateHandleGetMenuId
+from processstack import topShowProcessShowState
+from StdProcessAttribute import getProcessToolbarAtt, isProcessToolbar
+from StdPSt import accPIO
+
+
+menueventFatalError :: String String -> .x
+menueventFatalError function error
+ = fatalError function "menuevent" error
+
+
+/* menuEvent filters the scheduler events that can be handled by this menu device.
+ For the time being no timer menu elements are added, so these events are ignored.
+ menuEvent assumes that it is not applied to an empty IOSt and that its device is
+ present.
+*/
+menuEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+menuEvent schedulerEvent pState
+ # (hasMenuDevice,pState) = accPIO (ioStHasDevice MenuDevice) pState
+ | not hasMenuDevice // This condition should never hold
+ = menueventFatalError "menuEvent" "MenuDevice.dEvent applied while MenuDevice not present in IOSt"
+ | otherwise
+ = menuEvent schedulerEvent pState
+where
+ menuEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+ menuEvent schedulerEvent=:(ScheduleOSEvent osEvent=:{ccMsg} _) pState=:{io=ioState}
+ | isToolbarOSEvent ccMsg
+ # (osdInfo,ioState) = ioStGetOSDInfo ioState
+ # (myEvent,replyToOS,deviceEvent,ioState)
+ = filterToolbarEvent osdInfo osEvent ioState
+ # pState = {pState & io=ioState}
+ schedulerEvent = if (isJust replyToOS) (ScheduleOSEvent osEvent (fromJust replyToOS)) schedulerEvent
+ = (myEvent,deviceEvent,schedulerEvent,pState)
+ | isMenuOSEvent ccMsg
+ # (processStack,ioState) = ioStGetProcessStack ioState
+ (found,systemId) = topShowProcessShowState processStack
+ # (ioId,ioState) = ioStGetIOId ioState
+ # (tb,ioState) = getIOToolbox ioState
+ # (found,mDevice,ioState) = ioStGetDevice MenuDevice ioState
+ # menus = menuSystemStateGetMenuHandles mDevice
+ # (myEvent,replyToOS,deviceEvent,menus,tb)
+ = filterOSEvent osEvent (found && systemId==ioId) menus tb
+ # ioState = ioStSetDevice (MenuSystemState menus) ioState
+ # ioState = setIOToolbox tb ioState
+ # pState = {pState & io=ioState}
+ schedulerEvent = if (isJust replyToOS) (ScheduleOSEvent osEvent (fromJust replyToOS)) schedulerEvent
+ = (myEvent,deviceEvent,schedulerEvent,pState)
+ | otherwise
+ = (False,Nothing,schedulerEvent,pState)
+ where
+ isMenuOSEvent :: !Int -> Bool
+ isMenuOSEvent CcWmCOMMAND = True
+ isMenuOSEvent _ = False
+
+ isToolbarOSEvent :: !Int -> Bool
+ isToolbarOSEvent CcWmBUTTONCLICKED = True
+ isToolbarOSEvent CcWmGETTOOLBARTIPTEXT = True
+ isToolbarOSEvent _ = False
+
+ menuEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
+ # (ioId,ioState) = ioStGetIOId ioState
+ | ioId<>recLoc.rlIOId || recLoc.rlDevice<>MenuDevice
+ = (False,Nothing,schedulerEvent,{pState & io=ioState})
+ | otherwise
+ # (found,mDevice,ioState) = ioStGetDevice MenuDevice ioState
+ menus = menuSystemStateGetMenuHandles mDevice
+ (found,menus) = hasMenuHandlesMenu recLoc.rlParentId menus
+ deviceEvent = if found (Just (ReceiverEvent msgEvent)) Nothing
+ # ioState = ioStSetDevice (MenuSystemState menus) ioState
+ = (found,deviceEvent,schedulerEvent,{pState & io=ioState})
+ where
+ recLoc = getMsgEventRecLoc msgEvent
+
+ hasMenuHandlesMenu :: !Id !*(MenuHandles .pst) -> (!Bool,!*MenuHandles .pst)
+ hasMenuHandlesMenu menuId mHs=:{mMenus}
+ # (found,mMenus)= ucontains (eqMenuId menuId) mMenus
+ = (found,{mHs & mMenus=mMenus})
+ where
+ eqMenuId :: !Id !*(MenuStateHandle .pst) -> *(!Bool,!*MenuStateHandle .pst)
+ eqMenuId theId msH
+ # (mId,msH) = menuStateHandleGetMenuId msH
+ = (theId==mId,msH)
+
+ menuEvent schedulerEvent pState
+ = (False,Nothing,schedulerEvent,pState)
+
+
+/* filterToolbarEvent filters the OSEvents that can be handled by this menu device.
+*/
+filterToolbarEvent :: !OSDInfo !OSEvent !(IOSt .l) -> (!Bool,!Maybe [Int],!Maybe DeviceEvent,!IOSt .l)
+
+/* CcWmBUTTONCLICKED is a menu event in case of a toolbar selection.
+*/
+filterToolbarEvent osdInfo {ccMsg=CcWmBUTTONCLICKED,p2=toolbarPtr,p4=toolbarIndex} ioState
+ | isToolbarEvent osdInfo toolbarPtr
+ = (True,Nothing,Just (ToolbarSelection {tbsItemNr=toolbarIndex}),ioState)
+ | otherwise
+ = (False,Nothing,Nothing,ioState)
+
+/* CcWmGETTOOLBARTIPTEXT does not continue platform independent event handling, but returns the
+ String associated with the requested toolbar item.
+*/
+filterToolbarEvent osdInfo {ccMsg=CcWmGETTOOLBARTIPTEXT,p1=toolbarPtr,p2=toolbarIndex} ioState
+ | isToolbarEvent osdInfo toolbarPtr
+ # (atts,ioState) = ioStGetProcessAttributes ioState
+ (found,att) = cselect isProcessToolbar undef atts
+ | not found
+ = (True,Nothing,Nothing,ioState)
+ # maybe_tip = gettooltip toolbarIndex (getProcessToolbarAtt att)
+ | isNothing maybe_tip
+ = (True,Nothing,Nothing,ioState)
+ // otherwise
+ # (textptr,ioState) = accIOToolbox (winMakeCString (fromJust maybe_tip)) ioState
+ = (True,Just [textptr],Nothing,ioState)
+ | otherwise
+ = (False,Nothing,Nothing,ioState)
+where
+ gettooltip :: !Int ![ToolbarItem .pst] -> Maybe String
+ gettooltip i [item:items]
+ | i==1 && isItem = tip
+ | otherwise = gettooltip i` items
+ where
+ (isItem,i`,tip) = case item of
+ ToolbarItem _ tip _ -> (True,i-1,tip)
+ ToolbarSeparator -> (False,i,Nothing)
+ gettooltip _ _
+ = Nothing
+
+filterToolbarEvent _ _ _
+ = menueventFatalError "filterToolbarEvent" "unmatched OSEvent"
+
+
+/* filterOSEvent filters the OSEvents that can be handled by this menu device.
+ The Bool argument is True iff the parent process is visible and active.
+*/
+filterOSEvent :: !OSEvent !Bool !(MenuHandles .pst) !*OSToolbox -> (!Bool,!Maybe [Int],!Maybe DeviceEvent,!MenuHandles .pst,!*OSToolbox)
+
+/* CcWmCOMMAND returns the selected menu item.
+ This item is identified by:
+ - the top level menu Id,
+ - a possibly empty list of parent sub menus. This list is given by zero based indices starting from the top level menu.
+ - in the parent (sub) menu, the zero based index of the item.
+ Only MenuItemHandle and SubMenuHandle elements increase the index; all other elements don't.
+*/
+filterOSEvent {ccMsg=CcWmCOMMAND,p1=item,p2=mods} _ menus=:{mEnabled,mMenus=mHs} tb
+ | not mEnabled
+ = (False,Nothing,Nothing,menus,tb)
+ | otherwise
+ # (found,deviceEvent,mHs,tb)= getSelectedMenuStateHandlesItem item (toModifiers mods) mHs tb
+ = (found,Nothing,deviceEvent,{menus & mMenus=mHs},tb)
+where
+ getSelectedMenuStateHandlesItem :: !Int !Modifiers !*[*MenuStateHandle .pst] !*OSToolbox
+ -> (!Bool,!Maybe DeviceEvent,!*[*MenuStateHandle .pst],!*OSToolbox)
+ getSelectedMenuStateHandlesItem item modifiers msHs tb
+ # (empty,msHs) = uisEmpty msHs
+ | empty
+ = (False,Nothing,msHs,tb)
+ # (msH,msHs) = hdtl msHs
+ # (found,menuEvent,msH,tb) = getSelectedMenuStateHandleItem item modifiers msH tb
+ | found
+ = (found,menuEvent,[msH:msHs],tb)
+ | otherwise
+ # (found,menuEvent,msHs,tb) = getSelectedMenuStateHandlesItem item modifiers msHs tb
+ = (found,menuEvent,[msH:msHs],tb)
+filterOSEvent _ _ _ _
+ = menueventFatalError "filterOSEvent" "unmatched OSEvent"
+
+
+/* popUpMenuEvent returns the proper DeviceEvent for PopUpMenu selections (determined by the OSTrackPopUpMenu result; see osmenu).
+*/
+popUpMenuEvent :: !OSTrackPopUpMenu !(MenuStateHandle .ps) !*OSToolbox -> (!Maybe DeviceEvent, !MenuStateHandle .ps, !*OSToolbox)
+popUpMenuEvent {ospupItem=PopUpTrackedByItemId item,ospupModifiers=mods} msH tb
+ # (_,menuEvent,msH,tb) = getSelectedMenuStateHandleItem item mods msH tb
+ = (menuEvent,msH,tb)
+popUpMenuEvent _ _ _
+ = menueventFatalError "popUpMenuEvent" "PopUpTrackedByIndex not expected"
+
+
+/* getSelectedMenuStateHandleItem item mods msH
+ determines if there is a menu item identified by item in msh. If so, the corresponding abstract device event is returned.
+ This function is used by (filterOSEvent {ccMsg=CcWmCOMMAND}) and popUpMenuEvent.
+*/
+getSelectedMenuStateHandleItem :: !Int !Modifiers !*(MenuStateHandle .pst) !*OSToolbox
+ -> (!Bool,!Maybe DeviceEvent, !*MenuStateHandle .pst, !*OSToolbox)
+getSelectedMenuStateHandleItem item mods msH=:(MenuLSHandle mlsH=:{mlsHandle=mH=:{mSelect,mHandle,mMenuId,mItems}}) tb
+ | not mSelect
+ = (False,Nothing,msH,tb)
+ | otherwise
+ # (found,menuEvent,_,_,itemHs,tb) = getSelectedMenuElementHandlesItem item mHandle mMenuId mods [] 0 mItems tb
+ = (found,menuEvent,MenuLSHandle {mlsH & mlsHandle={mH & mItems=itemHs}},tb)
+where
+ getSelectedMenuElementHandlesItem :: !Int !OSMenu !Id !Modifiers ![Int] !Int !*[*MenuElementHandle .ls .pst] !*OSToolbox
+ -> (!Bool,!Maybe DeviceEvent,![Int],!Int,!*[*MenuElementHandle .ls .pst],!*OSToolbox)
+ getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ # (empty,itemHs) = uisEmpty itemHs
+ | empty
+ = (False,Nothing,parents,zIndex,itemHs,tb)
+ # (itemH,itemHs) = hdtl itemHs
+ # (found,menuEvent,parents,zIndex,itemH,tb) = getSelectedMenuElementHandle item mH menuId mods parents zIndex itemH tb
+ | found
+ = (found,menuEvent,parents,zIndex,[itemH:itemHs],tb)
+ | otherwise
+ # (found,menuEvent,parents,zIndex,itemHs,tb)= getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ = (found,menuEvent,parents,zIndex,[itemH:itemHs],tb)
+ where
+ getSelectedMenuElementHandle :: !Int !OSMenu !Id !Modifiers ![Int] !Int !*(MenuElementHandle .ls .pst) !*OSToolbox
+ -> (!Bool,!Maybe DeviceEvent,![Int],!Int, !*MenuElementHandle .ls .pst, !*OSToolbox)
+
+ getSelectedMenuElementHandle item mH menuId mods parents zIndex itemH=:(MenuItemHandle {mOSMenuItem,mItemId}) tb
+ | item==mOSMenuItem
+ = (True,Just (MenuTraceEvent {mtId=menuId,mtParents=parents,mtItemNr=zIndex,mtModifiers=mods}),parents,zIndex+1,itemH,tb)
+ | otherwise
+ = (False,Nothing,parents,zIndex+1,itemH,tb)
+
+ getSelectedMenuElementHandle item mH menuId mods parents zIndex itemH=:(SubMenuHandle submenuH=:{mSubSelect,mSubHandle,mSubItems}) tb
+ | not mSubSelect
+ = (False,Nothing,parents,zIndex+1,itemH,tb)
+ | otherwise
+ # (found,menuEvent,parents1,_,itemHs,tb)
+ = getSelectedMenuElementHandlesItem item mSubHandle menuId mods (parents++[zIndex]) 0 mSubItems tb
+ itemH = SubMenuHandle {submenuH & mSubItems=itemHs}
+ parents = if found parents1 parents
+ = (found,menuEvent,parents,zIndex+1,itemH,tb)
+
+ /* getSelectedMenuElementHandle item mH menuId mods parents zIndex (RadioMenuHandle rH=:{mRadioSelect,mRadioItems=itemHs,mRadioIndex}) tb
+ # (nrRadios,itemHs) = Ulength itemHs
+ | not mRadioSelect
+ = (False,Nothing,parents,zIndex+nrRadios,RadioMenuHandle {rH & mRadioItems=itemHs},tb)
+ # (found,menuEvent,parents,zIndex1,itemHs,tb) = getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ | not found
+ = (found,menuEvent,parents,zIndex1,RadioMenuHandle {rH & mRadioItems=itemHs},tb)
+ # curIndex = mRadioIndex
+ newIndex = zIndex1-zIndex
+ | curIndex==newIndex
+ = (found,menuEvent,parents,zIndex1,RadioMenuHandle {rH & mRadioItems=itemHs},tb)
+ | otherwise
+ # curH = getMenuItemOSMenuItem (itemHs!!(curIndex-1))
+ newH = getMenuItemOSMenuItem (itemHs!!(newIndex-1))
+ # tb = OSMenuItemCheck False mH curH tb
+ # tb = OSMenuItemCheck True mH newH tb
+ = (found,menuEvent,parents,zIndex1,RadioMenuHandle {rH & mRadioItems=itemHs,mRadioIndex=newIndex},tb)
+ where
+ getMenuItemOSMenuItem :: !(MenuElementHandle .ls .pst) -> OSMenuItem
+ getMenuItemOSMenuItem (MenuItemHandle {mOSMenuItem}) = mOSMenuItem
+ */
+ getSelectedMenuElementHandle item mH menuId mods parents zIndex (RadioMenuHandle rH=:{mRadioSelect,mRadioItems=itemHs,mRadioIndex}) tb
+ # (nrRadios,itemHs) = ulength itemHs
+ | not mRadioSelect
+ = (False,Nothing,parents,zIndex+nrRadios,RadioMenuHandle {rH & mRadioItems=itemHs},tb)
+ # (found,menuEvent,parents,zIndex1,itemHs,tb) = getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ | not found
+ = (found,menuEvent,parents,zIndex1,RadioMenuHandle {rH & mRadioItems=itemHs},tb)
+ # curIndex = mRadioIndex
+ newIndex = zIndex1-zIndex
+ | curIndex==newIndex
+ = (found,menuEvent,parents,zIndex1,RadioMenuHandle {rH & mRadioItems=itemHs},tb)
+ | otherwise
+ # (before,[itemH:after])= splitAt (curIndex-1) itemHs
+ # (curH,itemH) = getMenuItemOSMenuItem itemH
+ # (before,[itemH:after])= splitAt (newIndex-1) (before ++ [itemH:after])
+ # (newH,itemH) = getMenuItemOSMenuItem itemH
+ # tb = osMenuItemCheck False mH curH 0 0 tb // 0 0 added: dummy on Windows
+ # tb = osMenuItemCheck True mH newH 0 0 tb // 0 0 added: dummy on Windows
+ = (found,menuEvent,parents,zIndex1,RadioMenuHandle {rH & mRadioItems=before ++ [itemH:after],mRadioIndex=newIndex},tb)
+ where
+ getMenuItemOSMenuItem :: !*(MenuElementHandle .ls .pst) -> (!OSMenuItem,!MenuElementHandle .ls .pst)
+ getMenuItemOSMenuItem itemH=:(MenuItemHandle {mOSMenuItem}) = (mOSMenuItem,itemH)
+
+ getSelectedMenuElementHandle item mH menuId mods parents zIndex itemH=:(MenuSeparatorHandle _) tb
+ = (False,Nothing,parents,zIndex+1,itemH,tb)
+
+ getSelectedMenuElementHandle item mH menuId mods parents zIndex (MenuListLSHandle itemHs) tb
+ # (found,menuEvent,parents,zIndex,itemHs,tb) = getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ = (found,menuEvent,parents,zIndex,MenuListLSHandle itemHs,tb)
+
+ getSelectedMenuElementHandle item mH menuId mods parents zIndex (MenuExtendLSHandle mExH=:{mExtendItems=itemHs}) tb
+ # (found,menuEvent,parents,zIndex,itemHs,tb) = getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ = (found,menuEvent,parents,zIndex,MenuExtendLSHandle {mExH & mExtendItems=itemHs},tb)
+
+ getSelectedMenuElementHandle item mH menuId mods parents itemNr (MenuChangeLSHandle mChH=:{mChangeItems=itemHs}) tb
+ # (found,menuEvent,parents,zIndex,itemHs,tb) = getSelectedMenuElementHandlesItem item mH menuId mods parents zIndex itemHs tb
+ = (found,menuEvent,parents,zIndex,MenuChangeLSHandle {mChH & mChangeItems=itemHs},tb)
+
+ getSelectedMenuElementHandle _ _ _ _ parents zIndex itemH tb
+ = (False,Nothing,parents,zIndex,itemH,tb)
+
+/* PA: this function is now defined in clCCall_12.
+toModifiers :: !Int -> Modifiers
+toModifiers i
+ = { shiftDown = shifton
+ , optionDown = alton
+ , commandDown = ctrlon
+ , controlDown = ctrlon
+ , altDown = alton
+ }
+where
+ shifton = i bitand SHIFTBIT <> 0
+ alton = i bitand ALTBIT <> 0
+ ctrlon = i bitand CTRLBIT <> 0
+*/
+// isToolbarEvent checks whether the toolbar equals the OSDInfo toolbar.
+isToolbarEvent :: !OSDInfo !OSWindowPtr -> Bool
+isToolbarEvent osdInfo toolbarPtr
+ | isNothing maybeToolbar = False
+ | otherwise = (fromJust maybeToolbar).toolbarPtr==toolbarPtr
+where
+ maybeToolbar = getOSDInfoOSToolbar osdInfo
+
+/* PA: not used. Instead use menuHandlesGetMenus/menuHandlesSetMenus.
+menuHandlesGetMenuStateHandles :: !(MenuHandles .pst) -> (![MenuStateHandle .pst],!MenuHandles .pst)
+menuHandlesGetMenuStateHandles mHs=:{mMenus}
+ = (mMenus,{mHs & mMenus=[]})
+*/
diff --git a/menuwindowmenu.dcl b/menuwindowmenu.dcl new file mode 100644 index 0000000..46090c1 --- /dev/null +++ b/menuwindowmenu.dcl @@ -0,0 +1,19 @@ +definition module menuwindowmenu
+
+
+// Clean object I/O library, version 1.2
+
+// The definition and implementation of the WindowMenu.
+
+
+from iostate import :: PSt, :: IOSt
+import windowhandle
+
+
+openWindowMenu :: !( PSt .l) -> PSt .l
+addWindowToWindowMenu :: !Id !Title !( PSt .l) -> PSt .l
+removeWindowFromWindowMenu :: !Id !(IOSt .l) -> IOSt .l
+validateWindowActivateForWindowMenu` :: !Id !Bool ![WindowAttribute *(.ls,PSt .p)] -> [WindowAttribute *(.ls,PSt .p)]
+//validateWindowActivateForWindowMenu :: !Id !(WindowLSHandle .ls (PSt .l)) !(IOSt .l)
+// -> (!WindowLSHandle .ls (PSt .l), ! IOSt .l)
+changeWindowInWindowMenu :: !Id !String !(IOSt .l) -> IOSt .l
diff --git a/menuwindowmenu.icl b/menuwindowmenu.icl new file mode 100644 index 0000000..e61707a --- /dev/null +++ b/menuwindowmenu.icl @@ -0,0 +1,51 @@ +implementation module menuwindowmenu
+
+// The definition and implementation of the WindowMenu.
+// PA: implementation not required on Windows platform.
+
+from iostate import :: IOSt, :: PSt
+import windowhandle
+
+
+/* openWindowMenu creates the WindowMenu. This menu contains atleast the following elements:
+ - MenuItem "&Cascade":
+ Reorder the current list of windows from left-top to right-bottom.
+ - MenuItem "Tile &Horizontally":
+ Reorder the current list of windows from top to bottom.
+ - MenuItem "&Tile Vertically":
+ Reorder the current list of windows from left to right.
+ - MenuSeparator
+ - RadioMenu:
+ Display all current open windows (hidden and shown). Selection activates and
+ shows the indicated window.
+*/
+openWindowMenu :: !(PSt .l) -> PSt .l
+openWindowMenu pState = pState
+
+/* addWindowToWindowMenu adds a new item to the RadioMenu of the WindowMenu if present.
+ The Id argument is the id of the window that should be added, and the Title argument its title.
+*/
+addWindowToWindowMenu :: !Id !Title !(PSt .l) -> PSt .l
+addWindowToWindowMenu windowId windowTitle pState = pState
+
+/* removeWindowFromWindowMenu removes the window entry from the WindowMenu if present.
+*/
+removeWindowFromWindowMenu :: !Id !(IOSt .l) -> IOSt .l
+removeWindowFromWindowMenu wId ioState = ioState
+
+changeWindowInWindowMenu :: !Id !String !(IOSt .l) -> IOSt .l
+changeWindowInWindowMenu wId title ioState = ioState
+
+/* validateWindowActivateForWindowMenu takes care that if this interactive process is an MDI process,
+ and the WindowLSHandle represents a Windows instance that the WindowActivate function of the
+ WindowLSHandle will select the proper RadioMenuItem of the WindowMenu if present before any other
+ actions are taken.
+*/
+validateWindowActivateForWindowMenu` :: !Id !Bool ![WindowAttribute *(.ls,PSt .p)] -> [WindowAttribute *(.ls,PSt .p)]
+validateWindowActivateForWindowMenu` wId isMDI atts = atts
+
+/* PA: apparantly this function is not required.
+validateWindowActivateForWindowMenu :: !Id !(WindowLSHandle .ls (PSt .l)) !(IOSt .l)
+ -> (!WindowLSHandle .ls (PSt .l), !IOSt .l)
+validateWindowActivateForWindowMenu wId dlsH=:{wlsHandle=dH=:{whAtts,whKind}} ioState = (dlsH,ioState)
+*/
diff --git a/osactivaterequests.dcl b/osactivaterequests.dcl new file mode 100644 index 0000000..95be141 --- /dev/null +++ b/osactivaterequests.dcl @@ -0,0 +1,6 @@ +definition module osactivaterequests
+
+// Clean Object I/O library, version 1.2
+
+:: OSActivateRequest
+
diff --git a/osactivaterequests.icl b/osactivaterequests.icl new file mode 100644 index 0000000..c3397ae --- /dev/null +++ b/osactivaterequests.icl @@ -0,0 +1,3 @@ +implementation module osactivaterequests
+
+:: OSActivateRequest = OSActivateRequest
diff --git a/osbeep.dcl b/osbeep.dcl new file mode 100644 index 0000000..8884f12 --- /dev/null +++ b/osbeep.dcl @@ -0,0 +1,7 @@ +definition module osbeep
+
+// Clean Object I/O library, version 1.2
+
+from ostoolbox import :: OSToolbox
+
+osBeep :: !*OSToolbox -> *OSToolbox
diff --git a/osbeep.icl b/osbeep.icl new file mode 100644 index 0000000..aac27a8 --- /dev/null +++ b/osbeep.icl @@ -0,0 +1,8 @@ +implementation module osbeep
+
+from clCCall_12 import winBeep
+from ostoolbox import :: OSToolbox
+
+osBeep :: !*OSToolbox -> *OSToolbox
+osBeep toolbox
+ = winBeep toolbox
diff --git a/osbitmap.dcl b/osbitmap.dcl new file mode 100644 index 0000000..cad7651 --- /dev/null +++ b/osbitmap.dcl @@ -0,0 +1,36 @@ +definition module osbitmap
+
+// Clean object I/O library, version 1.2
+
+import ospicture
+
+:: Bitmap
+:: OSBitmap
+
+toBitmap :: !OSBitmap -> Bitmap
+fromBitmap :: !Bitmap -> OSBitmap
+
+// osReadBitmap reads a bitmap from a file.
+osReadBitmap :: !*File -> (!Bool,!OSBitmap,!*File)
+
+// osGetBitmapSize returns the size of the bitmap
+osGetBitmapSize :: !OSBitmap -> (!Int,!Int)
+
+// osGetBitmapContent returns the content string of the bitmap
+osGetBitmapContent :: !OSBitmap -> {#Char}
+
+// osGetBitmapHandle returns the handle of the bitmap
+osGetBitmapHandle :: !OSBitmap -> Int
+
+/* osResizeBitmap (w,h) bitmap
+ resizes the argument bitmap to the given size.
+ It is assumed that w and h are not negative.
+*/
+osResizeBitmap :: !(!Int,!Int) !OSBitmap -> OSBitmap
+
+/* osDrawBitmap bitmap pos origin isScreenOutput pictContext
+ draws the argument bitmap with the left top corner at pos, given the current origin and drawing context.
+ The isScreenOutput MUST be False when producing printer output. For screen output this is not the case,
+ but setting it to True is much more efficient.
+*/
+osDrawBitmap :: !OSBitmap !(!Int,!Int) !(!Int,!Int) !Bool !OSPictContext !*OSToolbox -> (!OSPictContext,!*OSToolbox)
diff --git a/osbitmap.icl b/osbitmap.icl new file mode 100644 index 0000000..3074b8f --- /dev/null +++ b/osbitmap.icl @@ -0,0 +1,89 @@ +implementation module osbitmap
+
+
+// PA: other version of bitmaps: create a bitmap handle instead of continuesly copying String to OS
+
+import StdArray, StdBool, StdChar, StdClass, StdInt, StdFile, StdTuple
+import ospicture, ostoolbox, pictCCall_12
+
+
+:: Bitmap
+ = OSBitmap !OSBitmap
+:: OSBitmap
+ = { originalSize :: !(!Int,!Int) // The size of the bitmap
+ , reSize :: !(!Int,!Int) // to store values passed to resizeBitmap
+ , bitmapContents :: !{#Char} // The (device independent) bitmap information (for printing)
+ , bitmapHandle :: !Int // The handle to the screen bitmap (for screen)
+ }
+
+toBitmap :: !OSBitmap -> Bitmap
+toBitmap osBitmap = OSBitmap osBitmap
+
+fromBitmap :: !Bitmap -> OSBitmap
+fromBitmap (OSBitmap osBitmap) = osBitmap
+
+// osReadBitmap reads a bitmap from a file. See page 176 of Programming Windows 95 (Charles Petzold)
+osReadBitmap :: !*File -> (!Bool,!OSBitmap,!*File)
+osReadBitmap file
+ # (_, c1,file) = freadc file
+ # (ok,c2,file) = freadc file // read first two bytes
+ | not ok || c1<>'B' || c2<>'M' // are they "BM"?
+ = (False,noBitmap,file)
+ # (_, fileSize,file) = freadi file // read file size
+ # (_, _, file) = freadi file // skip bfReserved1 & 2
+ # (_, _, file) = freadi file // skip bfOffBits
+ # (_, _, file) = freadi file // skip biSize
+ # (_, w, file) = freadi file // read width
+ # (ok1,h, file) = freadi file // read height
+ # (ok2, file) = fseek file 0 FSeekSet
+ | not ok1 || not ok2
+ = (False,noBitmap,file)
+ # (data,file) = freads file fileSize
+ | size data <> fileSize
+ = (False,noBitmap,file)
+ | otherwise
+ # (hdc, tb) = winCreateScreenHDC OSNewToolbox
+ # (hbmp,tb) = winCreateBitmap w data hdc tb
+ # tb = winDestroyScreenHDC (hdc,tb)
+ = (if (tb==OSDummyToolbox) True True,{originalSize=(w,h),reSize=(w,h),bitmapContents=data,bitmapHandle=hbmp},file)
+where
+ noBitmap = {originalSize=(0,0),reSize=(0,0),bitmapContents={},bitmapHandle=0}
+
+// osGetBitmapSize returns the size of the bitmap.
+osGetBitmapSize :: !OSBitmap -> (!Int,!Int)
+osGetBitmapSize {reSize}
+ = reSize
+
+// osGetBitmapContent returns the content string of the bitmap
+osGetBitmapContent :: !OSBitmap -> {#Char}
+osGetBitmapContent {bitmapContents}
+ = bitmapContents
+
+// osGetBitmapHandle returns the handle of the bitmap
+osGetBitmapHandle :: !OSBitmap -> Int
+osGetBitmapHandle {bitmapHandle}
+ = bitmapHandle
+
+
+/* osResizeBitmap (w,h) bitmap
+ resizes the argument bitmap to the given size.
+ It is assumed that w and h are not negative.
+*/
+osResizeBitmap :: !(!Int,!Int) !OSBitmap -> OSBitmap
+osResizeBitmap size bitmap
+ = {bitmap & reSize=size}
+
+/* osDrawBitmap bitmap pos origin pictContext
+ draws the argument bitmap with the left top corner at pos, given the current origin and drawing context.
+*/
+osDrawBitmap :: !OSBitmap !(!Int,!Int) !(!Int,!Int) !Bool !OSPictContext !*OSToolbox -> (!OSPictContext,!*OSToolbox)
+osDrawBitmap {originalSize,reSize,bitmapContents,bitmapHandle} pos=:(px,py) origin=:(ox,oy) isScreenOutput pictContext tb
+ | isScreenOutput
+ | originalSize==reSize
+ = winDrawBitmap originalSize destination bitmapHandle (pictContext,tb)
+ // otherwise
+ = winDrawResizedBitmap originalSize destination reSize bitmapHandle (pictContext,tb)
+ | otherwise
+ = winPrintResizedBitmap originalSize destination reSize bitmapContents (pictContext,tb)
+where
+ destination = (px-ox,py-oy)
diff --git a/osclipboard.dcl b/osclipboard.dcl new file mode 100644 index 0000000..49fe1b0 --- /dev/null +++ b/osclipboard.dcl @@ -0,0 +1,33 @@ +definition module osclipboard
+
+// Clean Object I/O library, version 1.2
+
+// Clipboard operations.
+
+import ostoolbox
+from clipboardCrossCall_12 import CF_TEXT
+
+
+:: OSClipboardItemType
+ :== Int
+OSClipboardText
+ :== CF_TEXT
+
+osInitialiseClipboard :: !*OSToolbox -> *OSToolbox
+// osInitialiseClipboard should be evaluated before any of the functions below.
+
+osHasClipboardText :: !*OSToolbox -> (!Bool,!*OSToolbox)
+// osHasClipboardText checks whether the clipboard currently contains a text item.
+
+osSetClipboardText :: !{#Char} !*OSToolbox -> *OSToolbox
+// osSetClipboardText empties the clipboard and sets the text to the clipboard.
+// The return Int is the new version number.
+
+osGetClipboardText :: !*OSToolbox -> (!{#Char},!*OSToolbox)
+// osGetClipboardText retrieves the current clipboard text item, which is empty if not present.
+
+osGetClipboardContent :: !*OSToolbox -> (![OSClipboardItemType],!*OSToolbox)
+// osGetClipboardContent retrieves the current item types that are stored in the clipboard.
+
+osGetClipboardVersion :: !Int !*OSToolbox -> (!Int,!*OSToolbox)
+// osGetClipboardVersion given the previous version number returns the new, current version number.
diff --git a/osclipboard.icl b/osclipboard.icl new file mode 100644 index 0000000..2a57358 --- /dev/null +++ b/osclipboard.icl @@ -0,0 +1,36 @@ +implementation module osclipboard
+
+// Clipboard operations.
+
+import StdInt
+import clipboardCrossCall_12
+
+:: OSClipboardItemType
+ :== Int
+OSClipboardText
+ :== CF_TEXT
+
+osInitialiseClipboard :: !*OSToolbox -> *OSToolbox
+osInitialiseClipboard tb
+ = winInitialiseClipboard tb
+
+osHasClipboardText :: !*OSToolbox -> (!Bool,!*OSToolbox)
+osHasClipboardText tb
+ = winHasClipboardText tb
+
+osSetClipboardText :: !{#Char} !*OSToolbox -> *OSToolbox
+osSetClipboardText text tb
+ = winSetClipboardText text tb
+
+osGetClipboardText :: !*OSToolbox -> (!{#Char},!*OSToolbox)
+osGetClipboardText tb
+ = winGetClipboardText tb
+
+osGetClipboardContent :: !*OSToolbox -> (![OSClipboardItemType],!*OSToolbox)
+osGetClipboardContent tb
+ # (hasText,tb) = winHasClipboardText tb
+ = (if hasText [OSClipboardText] [],tb)
+
+osGetClipboardVersion :: !Int !*OSToolbox -> (!Int,!*OSToolbox)
+osGetClipboardVersion nr tb
+ = winGetClipboardCount tb
diff --git a/osdocumentinterface.dcl b/osdocumentinterface.dcl new file mode 100644 index 0000000..c674537 --- /dev/null +++ b/osdocumentinterface.dcl @@ -0,0 +1,76 @@ +definition module osdocumentinterface
+
+// Clean object I/O library, version 1.2
+
+import StdIOCommon
+from menuCrossCall_12 import :: HMENU
+import ostoolbar, ostoolbox, ostypes
+
+:: OSDInfo
+ = OSMDInfo !OSMDInfo
+ | OSSDInfo !OSSDInfo
+ | OSNoInfo
+:: OSMDInfo
+ = { osmdOSInfo :: !OSInfo // The general document interface infrastructure
+ , osmdWindowMenu :: !HMENU // The Window menu in the MDI menu bar
+ }
+:: OSSDInfo
+ = { ossdOSInfo :: !OSInfo // The general document interface infrastructure
+ }
+:: OSInfo
+ = { osFrame :: !HWND // The frame window of the (M/S)DI frame window
+ , osToolbar :: !Maybe OSToolbar // The toolbar of the (M/S)DI frame window (Nothing if no toolbar)
+ , osClient :: !HWND // The client window of the (M/S)DI frame window
+ , osMenuBar :: !HMENU // The menu bar of the (M/S)DI frame window
+ }
+:: OSMenuBar
+ = { menuBar :: !HMENU
+ , menuWindow :: !HWND
+ , menuClient :: !HWND
+ }
+
+/* Before using osOpenMDI, osOpenSDI, or osCloseOSDInfo evaluate osInitialiseDI.
+*/
+osInitialiseDI :: !*OSToolbox -> *OSToolbox
+
+/* emptyOSDInfo creates a OSDInfo with dummy values for the argument document interface.
+*/
+emptyOSDInfo :: !DocumentInterface -> OSDInfo
+
+/* getOSDInfoDocumentInterface returns the DocumentInterface of the argument OSDInfo.
+*/
+getOSDInfoDocumentInterface :: !OSDInfo -> DocumentInterface
+
+/* getOSDInfoOSMenuBar returns the OSMenuBar info from the argument OSDInfo.
+ setOSDInfoOSMenuBar sets the OSMenuBar info in the OSDInfo.
+*/
+getOSDInfoOSMenuBar :: !OSDInfo -> Maybe OSMenuBar
+setOSDInfoOSMenuBar :: !OSMenuBar !OSDInfo -> OSDInfo
+
+/* getOSDInfoOSInfo returns the OSInfo from the argument OSDInfo if present.
+ setOSDInfoOSInfo sets the OSInfo in the OSDInfo.
+*/
+getOSDInfoOSInfo :: !OSDInfo -> Maybe OSInfo
+setOSDInfoOSInfo :: !OSInfo !OSDInfo -> OSDInfo
+
+/* osOpenMDI creates the infrastructure of a MDI process.
+ If the first Bool argument is True, then the frame window is shown, otherwise it is hidden.
+ The second Bool indicates whether the process accepts file open events.
+ osOpenSDI creates the infrastructure of a SDI process.
+ The Bool argument indicates whether the process accepts file open events.
+ osOpenNDI creates the infrastructure of a NDI process.
+ osCloseOSDInfo destroys the infrastructure.
+*/
+osOpenMDI :: !Bool !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox)
+osOpenSDI :: !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox)
+osOpenNDI :: !*OSToolbox -> (!OSDInfo,!*OSToolbox)
+osCloseOSDInfo:: !OSDInfo !*OSToolbox -> *OSToolbox
+
+/* getOSDInfoOSToolbar retrieves the OSToolbar, if any.
+*/
+getOSDInfoOSToolbar :: !OSDInfo -> Maybe OSToolbar
+
+/* osOSDInfoIsActive tests if the given OSDInfo represents the interactive process with the
+ active menu system. (Always True on Windows; use menu bar on Mac.)
+*/
+osOSDInfoIsActive :: !OSDInfo !*OSToolbox -> (!Bool, !*OSToolbox)
diff --git a/osdocumentinterface.icl b/osdocumentinterface.icl new file mode 100644 index 0000000..e01ee6c --- /dev/null +++ b/osdocumentinterface.icl @@ -0,0 +1,191 @@ +implementation module osdocumentinterface
+
+
+import StdMaybe, StdOverloaded, StdString, StdTuple
+import clCrossCall_12, ostoolbar, ossystem, ostypes, windowCrossCall_12
+from commondef import fatalError
+from StdIOCommon import :: DocumentInterface(..)
+import code from "cCrossCallxDI_121.o"
+
+
+:: OSDInfo
+ = OSMDInfo !OSMDInfo
+ | OSSDInfo !OSSDInfo
+ | OSNoInfo
+:: OSMDInfo
+ = { osmdOSInfo :: !OSInfo // The general document interface infrastructure
+ , osmdWindowMenu :: !HMENU // The Window menu in the MDI menu bar
+ }
+:: OSSDInfo
+ = { ossdOSInfo :: !OSInfo // The general document interface infrastructure
+ }
+:: OSInfo
+ = { osFrame :: !HWND // The frame window of the (M/S)DI frame window
+ , osToolbar :: !Maybe OSToolbar // The toolbar of the (M/S)DI frame window (Nothing if no toolbar)
+ , osClient :: !HWND // The client window of the (M/S)DI frame window
+ , osMenuBar :: !HMENU // The menu bar of the (M/S)DI frame window
+ }
+:: OSMenuBar
+ = { menuBar :: !HMENU
+ , menuWindow :: !HWND
+ , menuClient :: !HWND
+ }
+
+
+osdocumentinterfaceFatalError :: String String -> .x
+osdocumentinterfaceFatalError function error
+ = fatalError function "osdocumentinterface" error
+
+osInitialiseDI :: !*OSToolbox -> *OSToolbox
+osInitialiseDI _
+ = code
+ {
+ .inline InstallCrossCallxDI
+ ccall InstallCrossCallxDI "I-I"
+ .end
+ }
+
+/* emptyOSDInfo creates a OSDInfo with dummy values for the argument document interface.
+*/
+emptyOSDInfo :: !DocumentInterface -> OSDInfo
+emptyOSDInfo di
+ = case di of
+ MDI -> OSMDInfo {osmdOSInfo=emptyOSInfo,osmdWindowMenu=(-1)}
+ SDI -> OSSDInfo {ossdOSInfo=emptyOSInfo}
+ NDI -> OSNoInfo
+where
+ emptyOSInfo = {osFrame=(-1),osToolbar=Nothing,osClient=(-1),osMenuBar=(-1)}
+
+
+/* getOSDInfoDocumentInterface returns the DocumentInterface of the argument OSDInfo.
+*/
+getOSDInfoDocumentInterface :: !OSDInfo -> DocumentInterface
+getOSDInfoDocumentInterface (OSMDInfo _) = MDI
+getOSDInfoDocumentInterface (OSSDInfo _) = SDI
+getOSDInfoDocumentInterface OSNoInfo = NDI
+
+
+/* getOSDInfoOSMenuBar returns the OSMenuBar info from the argument OSDInfo.
+ setOSDInfoOSMenuBar sets the OSMenuBar info in the OSDInfo.
+*/
+getOSDInfoOSMenuBar :: !OSDInfo -> Maybe OSMenuBar
+getOSDInfoOSMenuBar osdInfo
+ = case osdInfo of
+ OSMDInfo {osmdOSInfo} -> get osmdOSInfo
+ OSSDInfo {ossdOSInfo} -> get ossdOSInfo
+ osnoinfo -> Nothing
+where
+ get {osFrame,osClient,osMenuBar} = Just {menuBar=osMenuBar,menuWindow=osFrame,menuClient=osClient}
+
+setOSDInfoOSMenuBar :: !OSMenuBar !OSDInfo -> OSDInfo
+setOSDInfoOSMenuBar {menuBar,menuWindow,menuClient} osdInfo
+ = case osdInfo of
+ OSMDInfo mdi=:{osmdOSInfo=info} -> OSMDInfo {mdi & osmdOSInfo=set info}
+ OSSDInfo sdi=:{ossdOSInfo=info} -> OSSDInfo {sdi & ossdOSInfo=set info}
+ osnoinfo -> osnoinfo
+where
+ set info = {info & osMenuBar=menuBar,osFrame=menuWindow,osClient=menuClient}
+
+
+/* getOSDInfoOSInfo returns the OSInfo from the argument OSDInfo if present.
+ setOSDInfoOSInfo sets the OSInfo in the OSDInfo.
+*/
+getOSDInfoOSInfo :: !OSDInfo -> Maybe OSInfo
+getOSDInfoOSInfo (OSMDInfo {osmdOSInfo}) = Just osmdOSInfo
+getOSDInfoOSInfo (OSSDInfo {ossdOSInfo}) = Just ossdOSInfo
+getOSDInfoOSInfo osnoinfo = Nothing
+
+setOSDInfoOSInfo :: !OSInfo !OSDInfo -> OSDInfo
+setOSDInfoOSInfo osinfo (OSMDInfo osm) = OSMDInfo {osm & osmdOSInfo=osinfo}
+setOSDInfoOSInfo osinfo (OSSDInfo oss) = OSSDInfo {oss & ossdOSInfo=osinfo}
+setOSDInfoOSInfo _ osnoinfo = osnoinfo
+
+
+/* osOpenMDI creates the infrastructure of an MDI process.
+ If the first Bool argument is True, then the frame window is shown, otherwise it is hidden.
+ The second Bool indicates whether the process accepts file open events.
+*/
+osOpenMDI :: !Bool !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox)
+osOpenMDI show acceptFileOpen tb
+ # createCci = Rq2Cci CcRqCREATEMDIFRAMEWINDOW (toInt show) (toInt acceptFileOpen)
+ # (returncci,tb) = issueCleanRequest2 osCreateMDIWindowCallback createCci tb
+ (framePtr,clientPtr,menuBar,windowMenu)
+ = case returncci.ccMsg of
+ CcRETURN4 -> (returncci.p1,returncci.p2,returncci.p3,returncci.p4)
+ CcWASQUIT -> (OSNoWindowPtr,OSNoWindowPtr,OSNoWindowPtr,OSNoWindowPtr)
+ msg -> osdocumentinterfaceFatalError "OSopenMDI" ("CcRETURN4 expected instead of "+++toString msg)
+ # osmdinfo = { osmdOSInfo = { osFrame = framePtr
+ , osToolbar = Nothing
+ , osClient = clientPtr
+ , osMenuBar = menuBar
+ }
+ , osmdWindowMenu = windowMenu
+ }
+ = (OSMDInfo osmdinfo,tb)
+where
+ osCreateMDIWindowCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+ osCreateMDIWindowCallback {ccMsg=CcWmDEACTIVATE} tb
+ = (return0Cci,tb)
+ osCreateMDIWindowCallback {ccMsg=CcWmACTIVATE} tb
+ = (return0Cci,tb)
+ osCreateMDIWindowCallback {ccMsg=CcWmKILLFOCUS} tb /* PA: added. Shouldn't ControlDeactivate be delayed? */
+ = (return0Cci,tb)
+ osCreateMDIWindowCallback {ccMsg} tb
+ = osdocumentinterfaceFatalError "osCreateMDIWindowCallback" ("received message nr:"+++toString ccMsg)
+
+osOpenSDI :: !Bool !*OSToolbox -> (!OSDInfo,!*OSToolbox)
+osOpenSDI acceptFileOpen tb
+ # createCci = Rq1Cci CcRqCREATESDIFRAMEWINDOW (toInt acceptFileOpen)
+ # (returncci,tb) = issueCleanRequest2 osCreateSDIWindowCallback createCci tb
+ (framePtr,menuBar)= case returncci.ccMsg of
+ CcRETURN2 -> (returncci.p1,returncci.p2)
+ CcWASQUIT -> (OSNoWindowPtr,OSNoWindowPtr)
+ msg -> osdocumentinterfaceFatalError "OSopenSDI" ("CcRETURN2 expected instead of "+++toString msg)
+ # ossdinfo = { ossdOSInfo = {osFrame=framePtr,osToolbar=Nothing,osClient=OSNoWindowPtr,osMenuBar=menuBar} }
+ = (OSSDInfo ossdinfo,tb)
+where
+ osCreateSDIWindowCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+ osCreateSDIWindowCallback {ccMsg=CcWmDEACTIVATE} tb
+ = (return0Cci,tb)
+ osCreateSDIWindowCallback {ccMsg=CcWmACTIVATE} tb
+ = (return0Cci,tb)
+ osCreateSDIWindowCallback {ccMsg=CcWmKILLFOCUS} tb /* PA: added. Shouldn't ControlDeactivate be delayed? */
+ = (return0Cci,tb)
+ osCreateSDIWindowCallback {ccMsg} tb
+ = osdocumentinterfaceFatalError "osCreateSDIWindowCallback" ("received message nr:"+++toString ccMsg)
+
+osOpenNDI :: !*OSToolbox -> (!OSDInfo,!*OSToolbox) // PA: added. Dummy on Windows.
+osOpenNDI tb
+ = (OSNoInfo,tb)
+
+osCloseOSDInfo :: !OSDInfo !*OSToolbox -> *OSToolbox
+osCloseOSDInfo (OSMDInfo {osmdOSInfo={osFrame}}) tb
+ = snd (issueCleanRequest2 (osDestroyProcessWindowCallback "osCloseMDI") (Rq1Cci CcRqDESTROYWINDOW osFrame) tb)
+osCloseOSDInfo (OSSDInfo {ossdOSInfo={osFrame}}) tb
+ = snd (issueCleanRequest2 (osDestroyProcessWindowCallback "osCloseSDI") (Rq1Cci CcRqDESTROYWINDOW osFrame) tb)
+osCloseOSDInfo _ tb
+ = tb
+
+osDestroyProcessWindowCallback :: String !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+osDestroyProcessWindowCallback _ {ccMsg=CcWmDEACTIVATE} tb
+ = (return0Cci,tb)
+osDestroyProcessWindowCallback _ {ccMsg=CcWmACTIVATE} tb
+ = (return0Cci,tb)
+osDestroyProcessWindowCallback _ {ccMsg=CcWmKEYBOARD} tb
+ = (return0Cci,tb)
+osDestroyProcessWindowCallback _ {ccMsg=CcWmPAINT,p1=hwnd} tb
+ = (return0Cci,winFakePaint hwnd tb)
+osDestroyProcessWindowCallback function {ccMsg} tb
+ = osdocumentinterfaceFatalError function ("received message nr:"+++toString ccMsg)
+
+// getOSDInfoOSToolbar retrieves the OSToolbar, if any.
+getOSDInfoOSToolbar :: !OSDInfo -> Maybe OSToolbar
+getOSDInfoOSToolbar (OSMDInfo {osmdOSInfo={osToolbar}}) = osToolbar
+getOSDInfoOSToolbar (OSSDInfo {ossdOSInfo={osToolbar}}) = osToolbar
+getOSDInfoOSToolbar _ = Nothing
+
+/* osOSDInfoIsActive tests if the given OSDInfo represents the interactive process with the
+ active menu system. (Always True on Windows; use menu bar on Mac.)
+*/
+osOSDInfoIsActive :: !OSDInfo !*OSToolbox -> (!Bool, !*OSToolbox)
+osOSDInfoIsActive osdinfo tb = (True,tb)
diff --git a/osevent.dcl b/osevent.dcl new file mode 100644 index 0000000..5f91025 --- /dev/null +++ b/osevent.dcl @@ -0,0 +1,60 @@ +definition module osevent
+
+// Clean Object I/O library, version 1.2
+
+from StdInt import class ^(..), instance ^ Int, class -(..), instance - Int
+from clCrossCall_12 import :: CrossCallInfo
+from ostoolbox import :: OSToolbox
+from ostime import :: OSTime
+from ostypes import :: OSWindowPtr
+from StdMaybe import :: Maybe
+
+
+:: *OSEvents
+
+osNewEvents :: OSEvents
+//osCopyEvents :: !OSEvents -> (!OSEvents,!OSEvents) PA: not used
+osAppendEvents :: !*[OSEvent] !OSEvents -> OSEvents // osAppendEvents adds events at the end of the queue
+osInsertEvents :: !*[OSEvent] !OSEvents -> OSEvents // osInsertEvents adds events at the front of the queue
+osIsEmptyEvents :: !OSEvents -> (!Bool,!OSEvents)
+osRemoveEvent :: !OSEvents -> (!OSEvent,!OSEvents)
+
+
+:: OSEvent
+ :== CrossCallInfo
+:: OSSleepTime // The max time the process allows multi-tasking
+ :== Int
+
+osNullEvent :: OSEvent // osNullEvent returns a valid non-informative event
+
+// OSLongSleep :: OSSleepTime
+OSLongSleep :== 2^15-1
+// OSNoSleep :: OSSleepTime
+OSNoSleep :== 0
+
+osHandleEvents :: !(.s -> (Bool,.s))
+ !(.s -> (OSEvents,.s)) !((OSEvents,.s) -> .s)
+ !(.s -> (Int,.s))
+ !(OSEvent -> .s -> ([Int],.s))
+ !(!.s,!*OSToolbox)
+ -> (!.s,!*OSToolbox)
+osEventIsUrgent :: !OSEvent -> Bool
+setReplyInOSEvent :: ![Int] -> OSEvent
+
+/* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
+createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+
+/* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
+createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+
+/* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
+createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+
+/* createOSZeroTimerEvent creates the event for reporting continued zero timer (virtual event).
+ getOSZeroTimerStartTime returns the registered time in the virtual event. Nothing is returned if wrong argument.
+*/
+createOSZeroTimerEvent :: !OSTime -> OSEvent
+getOSZeroTimerStartTime :: !OSEvent -> Maybe OSTime
diff --git a/osevent.icl b/osevent.icl new file mode 100644 index 0000000..85eb066 --- /dev/null +++ b/osevent.icl @@ -0,0 +1,161 @@ +implementation module osevent
+
+import StdBool, StdList, StdMisc, StdTuple
+import clCrossCall_12, ostime, ostoolbox, ostypes
+from commondef import hdtl, fatalError
+from StdMaybe import :: Maybe(..)
+
+
+oseventFatalError :: String String -> .x
+oseventFatalError function error
+ = fatalError function "osevent" error
+
+
+/* The OSEvents environment keeps track of delayed events.
+*/
+:: *OSEvents
+ :== [OSEvent]
+
+
+osAppendEvents :: !*[OSEvent] !OSEvents -> OSEvents
+osAppendEvents newEvents osEvents
+ = osEvents ++ newEvents
+
+osInsertEvents :: !*[OSEvent] !OSEvents -> OSEvents
+osInsertEvents newEvents osEvents
+ = newEvents ++ osEvents
+
+osIsEmptyEvents :: !OSEvents -> (!Bool,!OSEvents)
+osIsEmptyEvents []
+ = (True, [])
+osIsEmptyEvents osEvents
+ = (False, osEvents)
+
+osRemoveEvent :: !OSEvents -> (!OSEvent,!OSEvents)
+osRemoveEvent [osEvent:osEvents]
+ = (osEvent,osEvents)
+osRemoveEvent []
+ = oseventFatalError "osRemoveEvent" "OSEvents argument is empty"
+
+/* PA: does not seem to be used.
+osCopyEvents :: !OSEvents -> (!OSEvents,!OSEvents)
+osCopyEvents []
+ = ([],[])
+osCopyEvents [e:es]
+ = ([e:es1],[e:es2])
+where
+ (es1,es2) = osCopyEvents es
+*/
+
+osNewEvents :: OSEvents
+osNewEvents = []
+
+
+:: OSEvent
+ :== CrossCallInfo
+:: OSSleepTime // The max time the process allows multi-tasking
+ :== Int
+
+osNullEvent :: OSEvent
+osNullEvent
+ = { ccMsg = CcWmIDLETIMER
+ , p1 = 0
+ , p2 = 0
+ , p3 = 0
+ , p4 = 0
+ , p5 = 0
+ , p6 = 0
+ }
+
+// OSLongSleep :: OSSleepTime
+OSLongSleep :== 2^15-1
+// OSNoSleep :: OSSleepTime
+OSNoSleep :== 0
+
+osHandleEvents :: !(.s -> (Bool,.s)) !(.s -> (OSEvents,.s)) !((OSEvents,.s) -> .s) !(.s -> (Int,.s)) !(OSEvent -> .s -> ([Int],.s)) !(!.s,!*OSToolbox) -> (!.s,!*OSToolbox)
+
+osHandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
+ # (terminate,state) = isFinalState state
+ | terminate
+ = (state,tb)
+ # (osEvents,state) = getOSEvents state
+ # (noDelayEvents,osEvents) = osIsEmptyEvents osEvents
+ | noDelayEvents
+ # state = setOSEvents (osEvents,state)
+ # (sleep,state) = getSleepTime state
+ getEventCci = {ccMsg=CcRqDOMESSAGE,p1=toInt (sleep<>OSLongSleep),p2=sleep,p3=0,p4=0,p5=0,p6=0}
+ # (_,state,tb) = issueCleanRequest (rccitoevent handleOSEvent) getEventCci state tb
+ = osHandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
+ with
+ rccitoevent :: !(OSEvent -> .s -> ([Int],.s)) !OSEvent !.s !*OSToolbox -> (!OSEvent,!.s,!*OSToolbox)
+ rccitoevent handleOSEvent osEvent=:{ccMsg} state tb
+// # (reply,state) = handleOSEvent (trace_n ("CcRqDOMESSAGE-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
+ # (reply,state) = handleOSEvent osEvent state
+ = (setReplyInOSEvent reply,state,tb)
+ | otherwise
+ # (osEvent,osEvents) = osRemoveEvent osEvents
+ # state = setOSEvents (osEvents,state)
+// # (_,state) = handleOSEvent (trace_n ("DelayedEvent-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
+ # (_,state) = handleOSEvent osEvent state
+ = osHandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
+
+setReplyInOSEvent :: ![Int] -> OSEvent
+setReplyInOSEvent reply
+ | isEmpty reply = return0Cci
+ # (e1,reply) = hdtl reply
+ | isEmpty reply = return1Cci e1
+ # (e2,reply) = hdtl reply
+ | isEmpty reply = return2Cci e1 e2
+ # (e3,reply) = hdtl reply
+ | isEmpty reply = return3Cci e1 e2 e3
+ # (e4,reply) = hdtl reply
+ | isEmpty reply = return4Cci e1 e2 e3 e4
+ # (e5,reply) = hdtl reply
+ | isEmpty reply = return5Cci e1 e2 e3 e4 e5
+ # (e6,_) = hdtl reply
+ | isEmpty reply = return6Cci e1 e2 e3 e4 e5 e6
+ | otherwise = oseventFatalError "setReplyInOSEvent" "number of reply codes > 6"
+
+osEventIsUrgent :: !OSEvent -> Bool
+osEventIsUrgent {ccMsg}
+ = case ccMsg of
+ CcWmDRAWCLIPBOARD -> False // PA: in a future version, use this event to evaluate a clipboard callback function.
+ CcWmIDLETIMER -> False
+ CcWmTIMER -> False
+ CcWmZEROTIMER -> False
+ _ -> True
+
+
+/* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
+createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSActivateWindowEvent wPtr tb = (Rq1Cci CcWmACTIVATE wPtr,tb)
+
+createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSDeactivateWindowEvent wPtr tb = (Rq1Cci CcWmDEACTIVATE wPtr,tb)
+
+/* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
+createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSActivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmSETFOCUS wPtr cPtr,tb)
+
+createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSDeactivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmKILLFOCUS wPtr cPtr,tb)
+
+/* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
+createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSLooseMouseEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTMOUSE wPtr cPtr,tb)
+
+createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
+createOSLooseKeyEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTKEY wPtr cPtr,tb)
+
+/* createOSZeroTimerEvent creates the event for reporting continued zero timer (virtual event).
+ getOSZeroTimerStartTime returns the registered time in the virtual event. Zero if wrong argument.
+*/
+createOSZeroTimerEvent :: !OSTime -> OSEvent
+createOSZeroTimerEvent zeroStart = Rq1Cci CcWmZEROTIMER (toInt zeroStart)
+
+getOSZeroTimerStartTime :: !OSEvent -> Maybe OSTime
+getOSZeroTimerStartTime {ccMsg,p1}
+ | ccMsg==CcWmZEROTIMER
+ = Just (fromInt p1)
+ | otherwise
+ = Nothing
diff --git a/osfileselect.dcl b/osfileselect.dcl new file mode 100644 index 0000000..8d38fac --- /dev/null +++ b/osfileselect.dcl @@ -0,0 +1,12 @@ +definition module osfileselect
+
+// Clean Object I/O library, version 1.2
+
+import StdString
+from ostoolbox import :: OSToolbox
+import osevent
+
+osInitialiseFileSelectors :: !*OSToolbox -> *OSToolbox
+osSelectinputfile :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectoutputfile :: !(OSEvent->.s->.s) !.s !String !String !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectdirectory :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
diff --git a/osfileselect.icl b/osfileselect.icl new file mode 100644 index 0000000..5a18403 --- /dev/null +++ b/osfileselect.icl @@ -0,0 +1,86 @@ +implementation module osfileselect
+
+
+import StdBool, StdInt
+import clCrossCall_12, osevent
+from clCCall_12 import winMakeCString, winGetCStringAndFree, winReleaseCString, :: CSTR
+from commondef import fatalError
+import code from "cCrossCallFileSelectors_121.o"
+
+
+osfileselectFatalError :: String String -> .x
+osfileselectFatalError function error
+ = fatalError function "osfileselect" error
+
+
+osInitialiseFileSelectors :: !*OSToolbox -> *OSToolbox
+osInitialiseFileSelectors _
+ = code
+ {
+ .inline InstallCrossCallFileSelectors
+ ccall InstallCrossCallFileSelectors "I-I"
+ .end
+ }
+
+osSelectinputfile :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectinputfile handleOSEvent state tb
+ # (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq0Cci CcRqFILEOPENDIALOG) state tb
+ # (ok,name,tb) = getinputfilename rcci tb
+ = (ok,name,state,tb)
+where
+ getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
+ getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
+ | ok==0
+ = (False,"",tb)
+ | otherwise
+ # (pathname,tb) = winGetCStringAndFree ptr tb
+ = (True,pathname,tb)
+ getinputfilename {ccMsg=CcWASQUIT} tb
+ = (False,"",tb)
+ getinputfilename {ccMsg} _
+ = osfileselectFatalError "osSelectinputfile" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
+
+osSelectoutputfile :: !(OSEvent->.s->.s) !.s !String !String !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectoutputfile handleOSEvent state prompt filename tb
+ # (promptptr, tb) = winMakeCString prompt tb
+ # (filenameptr,tb) = winMakeCString filename tb
+ # (rcci,state, tb) = issueCleanRequest (callback handleOSEvent) (Rq2Cci CcRqFILESAVEDIALOG promptptr filenameptr) state tb
+ # tb = winReleaseCString promptptr tb
+ # tb = winReleaseCString filenameptr tb
+ # (ok,name,tb) = getoutputfilename rcci tb
+ = (ok,name,state,tb)
+where
+ getoutputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
+ getoutputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
+ | ok==0
+ = (False,"",tb)
+ | otherwise
+ # (path,tb) = winGetCStringAndFree ptr tb
+ = (True,path,tb)
+ getoutputfilename {ccMsg=CcWASQUIT} tb
+ = (False,"",tb)
+ getoutputfilename {ccMsg} _
+ = osfileselectFatalError "osSelectoutputfile" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
+
+osSelectdirectory :: !(OSEvent->.s->.s) !.s !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox)
+osSelectdirectory handleOSEvent state tb
+ # (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq0Cci CcRqDIRECTORYDIALOG) state tb
+ # (ok,name,tb) = getinputfilename rcci tb
+ = (ok,name,state,tb)
+where
+ getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox)
+ getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb
+ | ok==0
+ = (False,"",tb)
+ | otherwise
+ # (pathname,tb) = winGetCStringAndFree ptr tb
+ = (True,pathname,tb)
+ getinputfilename {ccMsg=CcWASQUIT} tb
+ = (False,"",tb)
+ getinputfilename {ccMsg} _
+ = osfileselectFatalError "osSelectdirectory" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")")
+
+// callback lifts a function::(OSEvent -> .s -> .s) to
+// a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox))
+callback :: !(OSEvent->.s->.s) !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
+callback handleOSEvent cci state tb = (return0Cci,handleOSEvent cci state,tb)
diff --git a/osfont.dcl b/osfont.dcl new file mode 100644 index 0000000..f3d1042 --- /dev/null +++ b/osfont.dcl @@ -0,0 +1,77 @@ +definition module osfont
+
+
+// Clean Object I/O library, version 1.2
+
+
+from StdOverloaded import class ==
+from ostoolbox import :: OSToolbox
+from ostypes import :: OSPictContext
+
+
+:: Font
+:: OSFont
+ = { osfontname :: !String // Name of the font
+ , osfontstyles:: !Int // Style variations of the font
+ , osfontsize :: !Int // Point size of the font
+ }
+:: OSFontDef
+ :== ( !String // Name of the font
+ , ![String] // Style variations of the font
+ , !Int // Point size of the font
+ )
+
+instance == OSFont // Equality on all fields
+
+// Font constants:
+osSerifFontDef :: OSFontDef
+osSansSerifFontDef :: OSFontDef
+osSmallFontDef :: OSFontDef
+osNonProportionalFontDef :: OSFontDef
+osSymbolFontDef :: OSFontDef
+
+/* osSelectfont fontdef
+ creates a font of the given name, style variations, and size in points.
+ If successful, the Bool is True, and the Font contains a useful value.
+ Otherwise, the Bool is False, and the Font is a dummy value.
+ osDefaultfont
+ returns the default window text font.
+ osDialogfont
+ returns the default dialog text font.
+ osFontgetdef
+ returns the requested name, style variations, and size in points of the given font.
+ osFontgetimp
+ returns the internal representation of the font.
+*/
+osSelectfont :: !OSFontDef !*OSToolbox -> (!Bool,!Font, !*OSToolbox)
+osDefaultfont :: !*OSToolbox -> ( !Font, !*OSToolbox)
+osDialogfont :: !*OSToolbox -> ( !Font, !*OSToolbox)
+osFontgetdef :: !Font -> OSFontDef
+osFontgetimp :: !Font -> OSFont
+
+/* osFontnames
+ returns the set of names all currently available fonts.
+ osFontstyles fontname
+ returns the set of all currently available style variations for the font with the given
+ fontname.
+ osFontsizes x y fontname
+ returns the set of all currently available sizes for the font with the given fontname
+ that lie between x and y (both inclusive).
+*/
+osFontnames :: !*OSToolbox -> (![String], !*OSToolbox)
+osFontstyles :: !String !*OSToolbox -> (![String], !*OSToolbox)
+osFontsizes :: !Int !Int !String !*OSToolbox -> (![Int], !*OSToolbox)
+
+/* osGetfontcharwidths hdcPassed maybeHdc chars font
+ returns the widths of all given chars in the same order of the given font.
+ osGetfontstringwidth hdcPassed maybeHdc string font
+ returns the width of the given string of the given font.
+ osGetfontstringwidths hdcPassed maybeHdc strings font
+ returns the widths of all given strings in the same order of the given font.
+ osGetfontmetrics hdcPassed maybeHdc font
+ returns the (ascent,descent,leading,maxwidth) of the given font in that order.
+*/
+osGetfontcharwidths :: !Bool !OSPictContext ![Char] !Font !*OSToolbox -> (![Int], !*OSToolbox)
+osGetfontstringwidth :: !Bool !OSPictContext !String !Font !*OSToolbox -> (!Int, !*OSToolbox)
+osGetfontstringwidths :: !Bool !OSPictContext ![String] !Font !*OSToolbox -> (![Int], !*OSToolbox)
+osGetfontmetrics :: !Bool !OSPictContext !Font !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
diff --git a/osfont.icl b/osfont.icl new file mode 100644 index 0000000..bbff295 --- /dev/null +++ b/osfont.icl @@ -0,0 +1,189 @@ +implementation module osfont
+
+
+import StdBool, StdClass, StdEnum, StdReal
+import clCrossCall_12, pictCCall_12
+from clCCall_12 import winMakeCString, winGetCString, :: CSTR, winGetVertResolution
+from StdPictureDef import :: FontName, :: FontSize, :: FontStyle, BoldStyle, ItalicsStyle, UnderlinedStyle
+from commondef import fatalError, isBetween, minmax, stateMap
+from ostypes import :: OSPictContext, :: HDC
+
+
+:: Font
+ = { fontdef :: !OSFontDef // The font requested by the program
+ , fontimp :: !OSFont // The font selected by the system
+ }
+:: OSFont
+ = { osfontname :: !String // Name of the font
+ , osfontstyles:: !Int // Style variations of the font
+ , osfontsize :: !Int // Size of the font
+ }
+:: OSFontDef
+ :== ( !String // Name of the font
+ , ![String] // Style variations of the font
+ , !Int // Point size of the font
+ )
+
+instance == OSFont where
+ (==) :: !OSFont !OSFont -> Bool
+ (==) f1 f2 = f1.osfontsize==f2.osfontsize && f1.osfontstyles==f2.osfontstyles && f1.osfontname==f2.osfontname
+
+// Font constants:
+osSerifFontDef :: OSFontDef; osSerifFontDef = ("Times New Roman",[],10)
+osSansSerifFontDef :: OSFontDef; osSansSerifFontDef = ("Arial", [],10)
+osSmallFontDef :: OSFontDef; osSmallFontDef = ("Small Fonts", [],7 )
+osNonProportionalFontDef :: OSFontDef; osNonProportionalFontDef= ("Courier New", [],10)
+osSymbolFontDef :: OSFontDef; osSymbolFontDef = ("Symbol", [],10)
+
+
+osSelectfont :: !OSFontDef !*OSToolbox -> (!Bool,!Font,!*OSToolbox)
+osSelectfont fdef=:(fName,fStyles,fSize) tb
+ = (True,{fontdef=fdef,fontimp=fimp},tb)
+where
+ fimp = {osfontname=fName,osfontstyles=sStyle2IStyle fStyles,osfontsize=fSize}
+
+osDefaultfont :: !*OSToolbox -> (!Font,!*OSToolbox)
+osDefaultfont tb
+ = ({fontdef=def,fontimp=imp},tb)
+where
+ def = (name,styles,size)
+ imp = {osfontname=name,osfontstyles=sStyle2IStyle styles,osfontsize=size}
+ name = "Times New Roman"
+ styles = []
+ size = 10
+
+osDialogfont :: !*OSToolbox -> (!Font,!*OSToolbox)
+osDialogfont tb
+ = ({fontdef=def,fontimp=imp},tb)
+where
+ def = (name,styles,size)
+ imp = {osfontname=name,osfontstyles=sStyle2IStyle styles,osfontsize=size}
+ name = "MS Sans Serif"
+ styles = []
+ size = 8
+
+osFontgetdef :: !Font -> OSFontDef
+osFontgetdef {fontdef}
+ = fontdef
+
+osFontgetimp :: !Font -> OSFont
+osFontgetimp {fontimp}
+ = fontimp
+
+sStyle2IStyle :: ![FontStyle] -> Int
+sStyle2IStyle styles
+ = s2i styles 0
+where
+ s2i [] i = i
+ s2i [ BoldStyle : rest ] i = s2i rest (i bitor iBold)
+ s2i [ ItalicsStyle : rest ] i = s2i rest (i bitor iItalic)
+ s2i [ UnderlinedStyle : rest ] i = s2i rest (i bitor iUnderline)
+ s2i [ _ : rest ] i = s2i rest i
+
+iStyle2SStyle :: !Int -> [FontStyle]
+iStyle2SStyle istyle
+ = idtofontstyles` istyle [iBold,iItalic,iUnderline,iStrikeOut]
+where
+ idtofontstyles` :: !Int ![Int] -> [String]
+ idtofontstyles` 0 _
+ = []
+ idtofontstyles` istyle [styleflag:styleflags]
+ | notStyleFlag = styles
+ | otherwise = [style:styles]
+ where
+ notStyleFlag = istyle bitand styleflag == 0
+ styles = idtofontstyles` (istyle-styleflag) styleflags
+ style = if (styleflag==iBold) BoldStyle
+ (if (styleflag==iItalic) ItalicsStyle
+ (if (styleflag==iUnderline) UnderlinedStyle
+ (fatalError "iStyle2SStyle" "osfont"
+ "unmatched styleflag value ("+++toString styleflag+++")"
+ )))
+ idtofontstyles` _ _
+ = []
+
+
+osFontnames :: !*OSToolbox -> (![String], !*OSToolbox)
+osFontnames tb
+ # getFontNamesCci = {ccMsg=CcRqGETFONTNAMES,p1=0,p2=0,p3=0,p4=0,p5=0,p6=0}
+ # (_,unsortednames,tb) = issueCleanRequest fontnamesCallback getFontNamesCci [] tb
+ = (sortAndRemoveDuplicates unsortednames,tb)
+where
+ fontnamesCallback :: !CrossCallInfo ![FontName] !*OSToolbox -> (!CrossCallInfo,![String],!*OSToolbox)
+ fontnamesCallback cci names os
+ # (newname,os) = winGetCString cci.p1 os
+ = (return0Cci,[newname:names],os)
+
+sortAndRemoveDuplicates :: !u:[a] -> u:[a] | Ord a
+sortAndRemoveDuplicates [e:es]
+ = insert e (sortAndRemoveDuplicates es)
+where
+ insert :: a !u:[a] -> u:[a] | Ord a
+ insert a list=:[b:x]
+ | a<b = [a:list]
+ | a>b = [b:insert a x]
+ | otherwise = list
+ insert a _
+ = [a]
+sortAndRemoveDuplicates _
+ = []
+
+
+osFontstyles :: !String !*OSToolbox -> (![String],!*OSToolbox)
+osFontstyles fname tb
+ = ([BoldStyle,ItalicsStyle,UnderlinedStyle],tb)
+
+osFontsizes :: !Int !Int !String !*OSToolbox -> (![Int],!*OSToolbox)
+osFontsizes between1 between2 fname tb
+ # (textptr,tb) = winMakeCString fname tb
+ getFontSizesCci = {ccMsg=CcRqGETFONTSIZES,p1=textptr,p2=0,p3=0,p4=0,p5=0,p6=0}
+ # (_,unsortedsizes,tb) = issueCleanRequest fontSizesCallback getFontSizesCci [] tb
+ = (sortAndRemoveDuplicates unsortedsizes,tb)
+where
+ (low,high) = minmax between1 between2
+
+ fontSizesCallback :: !CrossCallInfo ![FontSize] !*OSToolbox -> (!CrossCallInfo,![FontSize],!*OSToolbox)
+ fontSizesCallback cci=:{p1=size,p2=0} sizes tb
+ = (return0Cci,newsizes,tb)
+ where
+ pts = height2Points size
+ newsizes= if (isBetween pts low high)
+ [pts:sizes]
+ sizes
+ fontSizesCallback _ _ tb
+ = (return0Cci,[low..high],tb)
+
+height2Points :: !Int -> Int
+height2Points h
+ = toInt points
+where
+ dpi = toReal winGetVertResolution
+ phfactor= dpi / 72.0
+ points = toReal h / phfactor
+
+/* XXX MW: probably not called anywhere
+points2Height :: !Int -> Int
+points2Height p
+ = toInt height
+where
+ dpi = toReal winGetVertResolution
+ phfactor= dpi / 72.0
+ height = toReal p * phfactor
+*/
+
+osGetfontcharwidths :: !Bool !OSPictContext ![Char] !Font !*OSToolbox -> (![Int], !*OSToolbox)
+osGetfontcharwidths hdcPassed maybeHdc chars {fontimp={osfontname,osfontstyles,osfontsize}} tb
+ = stateMap (\c tb->winGetCharWidth c (osfontname,osfontstyles,osfontsize) (toInt hdcPassed) maybeHdc tb) chars tb
+
+osGetfontstringwidth :: !Bool !OSPictContext !String !Font !*OSToolbox -> (!Int, !*OSToolbox)
+osGetfontstringwidth hdcPassed maybeHdc string {fontimp={osfontname,osfontstyles,osfontsize}} tb
+ = winGetStringWidth string (osfontname,osfontstyles,osfontsize) (toInt hdcPassed) maybeHdc tb
+
+osGetfontstringwidths :: !Bool !OSPictContext ![String] !Font !*OSToolbox -> (![Int], !*OSToolbox)
+osGetfontstringwidths hdcPassed maybeHdc strings {fontimp={osfontname,osfontstyles,osfontsize}} tb
+ = stateMap (\s tb->winGetStringWidth s (osfontname,osfontstyles,osfontsize) (toInt hdcPassed) maybeHdc tb) strings tb
+
+osGetfontmetrics :: !Bool !OSPictContext !Font !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
+osGetfontmetrics hdcPassed maybeHdc {fontimp={osfontname,osfontstyles,osfontsize}} tb
+ # (ascent,descent,maxwidth,leading,tb) = winGetFontInfo (osfontname,osfontstyles,osfontsize) (toInt hdcPassed) maybeHdc tb
+ = ((ascent,descent,leading,maxwidth),tb)
diff --git a/osguishare.dcl b/osguishare.dcl new file mode 100644 index 0000000..902b4ba --- /dev/null +++ b/osguishare.dcl @@ -0,0 +1,5 @@ +definition module osguishare
+
+// Clean Object I/O library, version 1.2
+
+:: OSGUIShare
diff --git a/osguishare.icl b/osguishare.icl new file mode 100644 index 0000000..45a1176 --- /dev/null +++ b/osguishare.icl @@ -0,0 +1,3 @@ +implementation module osguishare
+
+:: OSGUIShare = OSGUIShare
diff --git a/oskey.dcl b/oskey.dcl new file mode 100644 index 0000000..81dea27 --- /dev/null +++ b/oskey.dcl @@ -0,0 +1,44 @@ +definition module oskey
+
+// Clean Object I/O library, version 1.2
+
+import StdOverloaded
+
+:: SpecialKey
+
+instance == SpecialKey // Equality on SpecialKey
+instance toString SpecialKey // Name of the SpecialKey
+
+backSpaceKey:: SpecialKey // Backspace
+beginKey :: SpecialKey // Begin of text
+clearKey :: SpecialKey // Clear
+deleteKey :: SpecialKey // Delete
+downKey :: SpecialKey // Arrow down
+endKey :: SpecialKey // End of text
+enterKey :: SpecialKey // Enter
+escapeKey :: SpecialKey // Escape
+f1Key :: SpecialKey // Function 1
+f2Key :: SpecialKey // Function 2
+f3Key :: SpecialKey // Function 3
+f4Key :: SpecialKey // Function 4
+f5Key :: SpecialKey // Function 5
+f6Key :: SpecialKey // Function 6
+f7Key :: SpecialKey // Function 7
+f8Key :: SpecialKey // Function 8
+f9Key :: SpecialKey // Function 9
+f10Key :: SpecialKey // Function 10
+f11Key :: SpecialKey // Function 11
+f12Key :: SpecialKey // Function 12
+f13Key :: SpecialKey // Function 13
+f14Key :: SpecialKey // Function 14
+f15Key :: SpecialKey // Function 15
+helpKey :: SpecialKey // Help
+leftKey :: SpecialKey // Arrow left
+pgDownKey :: SpecialKey // Page down
+pgUpKey :: SpecialKey // Page up
+returnKey :: SpecialKey // Return
+rightKey :: SpecialKey // Arrow right
+upKey :: SpecialKey // Arrow up
+
+toSpecialKey:: !Int -> SpecialKey // Convert Int to SpecialKey
+isSpecialKey:: !Int -> Bool // Check for one of the upper SpecialKeys
diff --git a/oskey.icl b/oskey.icl new file mode 100644 index 0000000..d8dce3d --- /dev/null +++ b/oskey.icl @@ -0,0 +1,157 @@ +implementation module oskey
+
+
+import StdBool, StdClass, StdInt, StdOverloaded, StdString
+
+
+:: SpecialKey
+ = { virtual :: !Int
+ }
+
+BackSpaceVirtualCode:== 8 // BackSpace
+BeginVirtualCode :== 115 // Begin of text
+ClearVirtualCode :== 71 // Clear
+DeleteVirtualCode :== 117 // Delete
+DownVirtualCode :== 125 // Arrow down
+EndVirtualCode :== 119 // End of text
+EnterVirtualCode :== 13 // Enter
+EscapeVirtualCode :== 53 // Escape
+F1VirtualCode :== 122 // Function 1
+F2VirtualCode :== 120 // Function 2
+F3VirtualCode :== 99 // Function 3
+F4VirtualCode :== 118 // Function 4
+F5VirtualCode :== 96 // Function 5
+F6VirtualCode :== 97 // Function 6
+F7VirtualCode :== 98 // Function 7
+F8VirtualCode :== 100 // Function 8
+F9VirtualCode :== 101 // Function 9
+F10VirtualCode :== 109 // Function 10
+F11VirtualCode :== 103 // Function 11
+F12VirtualCode :== 111 // Function 12
+F13VirtualCode :== 105 // Function 13
+F14VirtualCode :== 107 // Function 14
+F15VirtualCode :== 113 // Function 15
+HelpVirtualCode :== 114 // Help
+LeftVirtualCode :== 123 // Arrow left
+PgDownVirtualCode :== 121 // Page down
+PgUpVirtualCode :== 116 // Page up
+ReturnVirtualCode :== -1 // Return (dummy under Windows)
+RightVirtualCode :== 124 // Arrow right
+UpVirtualCode :== 126 // Arrow up
+
+instance == SpecialKey where
+ (==) {virtual=v1} {virtual=v2} = v1==v2
+
+instance toString SpecialKey where
+ toString {virtual}
+ = specialKeyCodeName virtual
+ where
+ specialKeyCodeName :: !Int -> {#Char}
+ specialKeyCodeName BackSpaceVirtualCode = "BackSpaceKey"
+ specialKeyCodeName BeginVirtualCode = "BeginKey"
+ specialKeyCodeName ClearVirtualCode = "ClearKey"
+ specialKeyCodeName DeleteVirtualCode = "DeleteKey"
+ specialKeyCodeName DownVirtualCode = "DownKey"
+ specialKeyCodeName EndVirtualCode = "EndKey"
+ specialKeyCodeName EnterVirtualCode = "EnterKey"
+ specialKeyCodeName EscapeVirtualCode = "EscapeKey"
+ specialKeyCodeName F1VirtualCode = "F1Key"
+ specialKeyCodeName F2VirtualCode = "F2Key"
+ specialKeyCodeName F3VirtualCode = "F3Key"
+ specialKeyCodeName F4VirtualCode = "F4Key"
+ specialKeyCodeName F5VirtualCode = "F5Key"
+ specialKeyCodeName F6VirtualCode = "F6Key"
+ specialKeyCodeName F7VirtualCode = "F7Key"
+ specialKeyCodeName F8VirtualCode = "F8Key"
+ specialKeyCodeName F9VirtualCode = "F9Key"
+ specialKeyCodeName F10VirtualCode = "F10Key"
+ specialKeyCodeName F11VirtualCode = "F11Key"
+ specialKeyCodeName F12VirtualCode = "F12Key"
+ specialKeyCodeName F13VirtualCode = "F13Key"
+ specialKeyCodeName F14VirtualCode = "F14Key"
+ specialKeyCodeName F15VirtualCode = "F15Key"
+ specialKeyCodeName HelpVirtualCode = "HelpKey"
+ specialKeyCodeName LeftVirtualCode = "LeftKey"
+ specialKeyCodeName PgDownVirtualCode = "PgDownKey"
+ specialKeyCodeName PgUpVirtualCode = "PgUpKey"
+ specialKeyCodeName ReturnVirtualCode = "ReturnKey"
+ specialKeyCodeName RightVirtualCode = "RightKey"
+ specialKeyCodeName UpVirtualCode = "UpKey"
+ specialKeyCodeName otherCode = "toSpecialKey "+++toString otherCode
+
+backSpaceKey:: SpecialKey; backSpaceKey= {virtual=BackSpaceVirtualCode}// BackSpace
+beginKey :: SpecialKey; beginKey = {virtual=BeginVirtualCode} // Begin of text
+clearKey :: SpecialKey; clearKey = {virtual=ClearVirtualCode} // Clear
+deleteKey :: SpecialKey; deleteKey = {virtual=DeleteVirtualCode} // Delete
+downKey :: SpecialKey; downKey = {virtual=DownVirtualCode} // Arrow down
+endKey :: SpecialKey; endKey = {virtual=EndVirtualCode} // End of text
+enterKey :: SpecialKey; enterKey = {virtual=EnterVirtualCode} // Enter
+escapeKey :: SpecialKey; escapeKey = {virtual=EscapeVirtualCode} // Escape
+f1Key :: SpecialKey; f1Key = {virtual=F1VirtualCode} // Function 1
+f2Key :: SpecialKey; f2Key = {virtual=F2VirtualCode} // Function 2
+f3Key :: SpecialKey; f3Key = {virtual=F3VirtualCode} // Function 3
+f4Key :: SpecialKey; f4Key = {virtual=F4VirtualCode} // Function 4
+f5Key :: SpecialKey; f5Key = {virtual=F5VirtualCode} // Function 5
+f6Key :: SpecialKey; f6Key = {virtual=F6VirtualCode} // Function 6
+f7Key :: SpecialKey; f7Key = {virtual=F7VirtualCode} // Function 7
+f8Key :: SpecialKey; f8Key = {virtual=F8VirtualCode} // Function 8
+f9Key :: SpecialKey; f9Key = {virtual=F9VirtualCode} // Function 9
+f10Key :: SpecialKey; f10Key = {virtual=F10VirtualCode} // Function 10
+f11Key :: SpecialKey; f11Key = {virtual=F11VirtualCode} // Function 11
+f12Key :: SpecialKey; f12Key = {virtual=F12VirtualCode} // Function 12
+f13Key :: SpecialKey; f13Key = {virtual=F13VirtualCode} // Function 13
+f14Key :: SpecialKey; f14Key = {virtual=F14VirtualCode} // Function 14
+f15Key :: SpecialKey; f15Key = {virtual=F15VirtualCode} // Function 15
+helpKey :: SpecialKey; helpKey = {virtual=HelpVirtualCode} // Help
+leftKey :: SpecialKey; leftKey = {virtual=LeftVirtualCode} // Arrow left
+pgDownKey :: SpecialKey; pgDownKey = {virtual=PgDownVirtualCode} // Page down
+pgUpKey :: SpecialKey; pgUpKey = {virtual=PgUpVirtualCode} // Page up
+returnKey :: SpecialKey; returnKey = {virtual=ReturnVirtualCode} // Return
+rightKey :: SpecialKey; rightKey = {virtual=RightVirtualCode} // Arrow right
+upKey :: SpecialKey; upKey = {virtual=UpVirtualCode} // Arrow up
+
+toSpecialKey :: !Int -> SpecialKey
+toSpecialKey specialkey = {virtual=specialkey}
+
+isSpecialKey:: !Int -> Bool
+isSpecialKey specialKey
+ = containsSorted specialKey virtualKeyCodes
+where
+ containsSorted :: !Int ![Int] -> Bool
+ containsSorted x [y:ys]
+ | x>y = containsSorted x ys
+ | otherwise = x==y
+ containsSorted _ _
+ = False
+
+virtualKeyCodes :: [Int] // The < sorted list of virtual key codes
+virtualKeyCodes =: [ BackSpaceVirtualCode // 8
+ , EnterVirtualCode // 13
+ , EscapeVirtualCode // 53
+ , ClearVirtualCode // 71
+ , F5VirtualCode // 96
+ , F6VirtualCode // 97
+ , F7VirtualCode // 98
+ , F3VirtualCode // 99
+ , F8VirtualCode // 100
+ , F9VirtualCode // 101
+ , F11VirtualCode // 103
+ , F13VirtualCode // 105
+ , F14VirtualCode // 107
+ , F10VirtualCode // 109
+ , F12VirtualCode // 111
+ , F15VirtualCode // 113
+ , HelpVirtualCode // 114
+ , BeginVirtualCode // 115
+ , PgUpVirtualCode // 116
+ , DeleteVirtualCode // 117
+ , F4VirtualCode // 118
+ , EndVirtualCode // 119
+ , F2VirtualCode // 120
+ , PgDownVirtualCode // 121
+ , F1VirtualCode // 122
+ , LeftVirtualCode // 123
+ , RightVirtualCode // 124
+ , DownVirtualCode // 125
+ , UpVirtualCode // 126
+ ]
diff --git a/osmenu.dcl b/osmenu.dcl new file mode 100644 index 0000000..fb1e54b --- /dev/null +++ b/osmenu.dcl @@ -0,0 +1,130 @@ +definition module osmenu
+
+
+// Clean Object I/O library, version 1.2
+
+
+from StdMaybe import :: Maybe
+from StdIOCommon import :: Modifiers
+from menuCrossCall_12 import :: HMENU, :: HITEM
+import osdocumentinterface, ostoolbox, ostypes
+
+
+// Types for menus and menu elements:
+:: OSMenu :== HMENU
+:: OSMenuItem :== HITEM
+:: OSMenuSeparator :== HITEM
+
+// Dummy values:
+OSNoMenu :== 0
+OSNoMenuItem :== 0
+OSNoMenuSeparator :== 0
+
+
+/* Initialisation:
+*/
+osInitialiseMenus :: !*OSToolbox -> *OSToolbox
+
+
+/* Enabling and disabling of menus and menu elements:
+ os(Dis/En)ableMenu index menubar
+ (dis/en)ables the top-level menu at the zero based index position of the menubar.
+ os(Dis/En)ableMenuItem parentMenu menuitem index
+ (dis/en)ables the menuitem that is part of the parentMenu.
+ os(Dis/En)ableSubMenu parentMenu submenu index
+ (dis/en)ables the submenu that is part of the parentMenu.
+*/
+osDisableMenu :: !Int !OSMenuBar !*OSToolbox -> *OSToolbox
+osEnableMenu :: !Int !OSMenuBar !*OSToolbox -> *OSToolbox
+osDisableMenuItem :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osEnableMenuItem :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osDisableSubMenu :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osEnableSubMenu :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+
+
+/* Changing and updating the menubar:
+ osDrawMenuBar
+ redraws the menubar. This must be done after every change of the menubar (adding/removing).
+ osMenuBarClear
+ clears the menubar.
+ osMenuBarSet
+ dunno??
+ osMenuInsert index menuNr title menubar
+ creates and inserts a new top-level menu at the indicated zero based index position.
+ The new menu has the given title and the menuNr as retrieved by OSNewMenuNr (below).
+ osSubMenuInsert index menuNr title parentMenu
+ creates and inserts a new submenu at the indicated zero based index position.
+ The new submenu has the given title and the menuNr as retrieved by OSNewSubMenuNr (below).
+ osMenuRemove menu menubar
+ removes the indicated menu both 'logically' and 'physically' from the menubar.
+ osSubMenuRemove submenu parentMenu ... submenuid submenuindex
+ removes the submenu both 'logically' and 'physically' from the parentMenu.
+ osRemoveMenuShortKey framePtr item
+ removes the shortcut key of the item.
+*/
+osDrawMenuBar :: !OSMenuBar !*OSToolbox -> *OSToolbox
+osMenuBarClear :: !*OSToolbox -> *OSToolbox
+osMenuBarSet :: !OSMenuBar !*OSToolbox -> (!OSMenuBar, !*OSToolbox)
+osMenuInsert :: !Int !OSMenuNr !{#Char} !OSMenuBar !*OSToolbox -> (!OSMenu,!OSMenuBar, !*OSToolbox)
+osSubMenuInsert :: !Int !OSMenuNr !{#Char} !OSMenu !*OSToolbox -> (!OSMenu,!OSMenu, !*OSToolbox)
+osMenuRemove :: !OSMenu !OSMenuBar !*OSToolbox -> (!OSMenuBar, !*OSToolbox)
+osSubMenuRemove :: !OSMenu !OSMenu !Int !Int !*OSToolbox -> (!OSMenu, !*OSToolbox)
+osRemoveMenuShortKey:: !OSWindowPtr !OSMenuItem !*OSToolbox -> *OSToolbox
+
+
+/* PopUpMenu functions:
+ osCreatePopUpMenu creates a pop up menu.
+ osTrackPopUpMenu shows the pop up menu and handles user selection:
+ the Int result is the menu item that has been selected (0 if none);
+ the Modifiers result are the modifiers that have been pressed at selection.
+*/
+:: OSTrackPopUpMenu // The result of tracking an item in a PopUpMenu:
+ = { ospupItem :: !OSTrackPopUpMenuResult // the item that has been selected
+ , ospupModifiers :: !Modifiers // the modifiers that have been pressed at selection
+ }
+:: OSTrackPopUpMenuResult // The item of a pop up menu that has been selected is indicated by:
+ = PopUpTrackedByIndex !Int !Int // the parent menu id and the item's index position (used on Mac)
+ | PopUpTrackedByItemId !Int // its identification (used on Windows)
+
+osCreatePopUpMenu :: !*OSToolbox -> (!OSMenu,!*OSToolbox)
+osTrackPopUpMenu :: !OSMenu !OSWindowPtr !*OSToolbox -> (!Maybe OSTrackPopUpMenu,!*OSToolbox)
+
+
+/* Changing (sub)menus and menu elements:
+ osAppendMenuItem osmenubar index menu title able mark key
+ adds a new menuitem to the given menu at the indicated zero based index position.
+ The menuitem has the given title, selectstate, markstate, and shortcut key.
+ The menu is element of the given osmenubar.
+ osAppendMenuSeparator index menu
+ adds a new menuseparator to the given menu at the indicated zero based index position.
+ osChangeMenuTitle menubar menu title
+ sets the new title of the indicated top-level menu in the menubar.
+ osChangeMenuItemTitle parentMenu menuitem index title
+ sets the new title of the indicated menuitem/submenu contained in the parentMenu.
+ osMenuItemCheck check parentMenu menuitem prevIndex newIndex
+ marks the item iff check of the indicated menuitem contained in the parentMenu.
+ osMenuRemoveItem menuitem index parentMenu
+ removes the menuitem 'logically' from the indicated parentMenu. The menuitem is not destroyed. CHECK APPLICATIONS!!
+*/
+osAppendMenuItem :: !OSMenuBar !Int !OSMenu !{#Char} !Bool !Bool !Char !*OSToolbox -> (!OSMenuItem, !OSMenu,!*OSToolbox)
+osAppendMenuSeparator :: !Int !OSMenu !*OSToolbox -> (!OSMenuSeparator,!OSMenu,!*OSToolbox)
+osChangeMenuTitle :: !OSMenuBar !OSMenu !{#Char} !*OSToolbox -> *OSToolbox
+osChangeMenuItemTitle :: !OSMenu !OSMenuItem !Int !{#Char} !*OSToolbox -> *OSToolbox
+osMenuItemCheck :: !Bool !OSMenu !OSMenuItem !Int !Int !*OSToolbox -> *OSToolbox
+osMenuRemoveItem :: !OSMenuItem !Int !OSMenu !*OSToolbox -> (!OSMenu,!*OSToolbox)
+
+
+/* Validation of (sub)menu (element) attributes:
+*/
+osValidateMenuItemTitle :: !(Maybe Char) !{#Char} -> {#Char}
+
+
+/* Two functions that generate free OS ids for menus and sub menus.
+ If the functions fail, then the Bool result is False, and the Int result is 0.
+ Do not continue to create the (sub)menu.
+*/
+:: OSMenuNr :== Int
+:: OSSubMenuNr :== Int
+
+osNewMenuNr :: !*OSToolbox -> (!Bool,!OSMenuNr, !*OSToolbox)
+osNewSubMenuNr :: !*OSToolbox -> (!Bool,!OSSubMenuNr,!*OSToolbox)
diff --git a/osmenu.icl b/osmenu.icl new file mode 100644 index 0000000..72e3daf --- /dev/null +++ b/osmenu.icl @@ -0,0 +1,176 @@ +implementation module osmenu
+
+
+import StdBool, StdChar, StdClass, StdInt, StdString
+import StdMaybe
+from StdIOCommon import :: Modifiers
+import menuCCall_12, menuCrossCall_12
+from osdocumentinterface import :: OSMenuBar{..}
+from ostypes import :: OSWindowPtr, OSNoWindowPtr
+
+
+// Types for menus and menu elements:
+:: OSMenuHandle :== HMENU
+:: OSMenu :== HMENU
+:: OSMenuItem :== HITEM
+:: OSMenuSeparator :== HITEM
+
+// Dummy values:
+OSNoMenu :== 0
+OSNoMenuItem :== 0
+OSNoMenuSeparator :== 0
+
+
+/* Initialisation:
+*/
+osInitialiseMenus :: !*OSToolbox -> *OSToolbox
+osInitialiseMenus tb
+ = winInitialiseMenus tb
+
+
+// Enabling and disabling menus and menu elements:
+
+osDisableMenu :: !Int !OSMenuBar !*OSToolbox -> *OSToolbox
+osDisableMenu zIndex osMenuBar=:{menuBar} tb
+ = winChangeMenuAbility menuBar zIndex False tb
+
+osEnableMenu :: !Int !OSMenuBar !*OSToolbox -> *OSToolbox
+osEnableMenu zIndex osMenuBar=:{menuBar} tb
+ = winChangeMenuAbility menuBar zIndex True tb
+
+osDisableMenuItem :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osDisableMenuItem menuHandle item _ tb
+ = winChangeItemAbility menuHandle item False tb
+
+osEnableMenuItem :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osEnableMenuItem menuHandle item _ tb
+ = winChangeItemAbility menuHandle item True tb
+
+osDisableSubMenu :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osDisableSubMenu menuHandle item _ tb
+ = winChangeItemAbility menuHandle item False tb
+
+osEnableSubMenu :: !OSMenu !OSMenuItem !Int !*OSToolbox -> *OSToolbox
+osEnableSubMenu menuHandle item _ tb
+ = winChangeItemAbility menuHandle item True tb
+
+
+
+// Changing and updating the menu bar:
+
+osDrawMenuBar :: !OSMenuBar !*OSToolbox -> *OSToolbox
+osDrawMenuBar {menuWindow,menuClient} tb
+ = winDrawMenuBar menuWindow (if (menuClient==OSNoWindowPtr) 0 menuClient) tb
+
+osMenuBarClear :: !*OSToolbox -> *OSToolbox
+osMenuBarClear tb
+ = tb
+
+osMenuBarSet :: !OSMenuBar !*OSToolbox -> (!OSMenuBar,!*OSToolbox)
+osMenuBarSet menuBar tb
+ = (menuBar,tb)
+
+osMenuInsert :: !Int !OSMenuNr !{#Char} !OSMenuBar !*OSToolbox -> (!OSMenu,!OSMenuBar,!*OSToolbox)
+osMenuInsert index osMenuNr title menuBar tb
+ # (menu,tb) = winCreatePopupMenuHandle tb
+ = (menu,menuBar,winInsertMenu title True menu menuBar.menuBar index tb)
+
+osSubMenuInsert :: !Int !OSMenuNr !{#Char} !OSMenu !*OSToolbox -> (!OSMenu, !OSMenu, !*OSToolbox)
+osSubMenuInsert index osMenuNr title parentMenu tb
+ # (menu,tb) = winCreatePopupMenuHandle tb
+ = (menu,parentMenu,winInsertMenu title True menu parentMenu index tb)
+
+osMenuRemove :: !OSMenu !OSMenuBar !*OSToolbox -> (!OSMenuBar, !*OSToolbox)
+osMenuRemove menu menuBar=:{menuBar=hmenu} tb
+ # tb = winDeleteMenu hmenu menu tb
+ # tb = winDestroyMenu menu tb
+ = (menuBar,tb)
+
+osSubMenuRemove :: !OSMenu !OSMenu !Int !Int !*OSToolbox -> (!OSMenu,!*OSToolbox)
+osSubMenuRemove submenu hmenu _ _ tb
+ # tb = winDeleteMenu hmenu submenu tb
+ # tb = winDestroyMenu submenu tb
+ = (hmenu,tb)
+
+osRemoveMenuShortKey :: !OSWindowPtr !OSMenuItem !*OSToolbox -> *OSToolbox
+osRemoveMenuShortKey framePtr item tb
+ = winRemoveMenuShortKey framePtr item tb
+
+osCreatePopUpMenu :: !*OSToolbox -> (!OSMenu,!*OSToolbox)
+osCreatePopUpMenu tb
+ = winCreatePopupMenuHandle tb
+
+:: OSTrackPopUpMenu // The result of tracking an item in a PopUpMenu:
+ = { ospupItem :: !OSTrackPopUpMenuResult // the item that has been selected
+ , ospupModifiers :: !Modifiers // the modifiers that have been pressed at selection
+ }
+:: OSTrackPopUpMenuResult // The item of a pop up menu that has been selected is indicated by:
+ = PopUpTrackedByIndex !Int !Int // the parent menu id and the item's index position (used on Mac)
+ | PopUpTrackedByItemId !Int // its identification (used on Windows)
+
+osTrackPopUpMenu :: !OSMenu !OSWindowPtr !*OSToolbox -> (!Maybe OSTrackPopUpMenu,!*OSToolbox)
+osTrackPopUpMenu menu framePtr tb
+ # (menuItemID,modifiers,tb) = winTrackPopupMenu menu framePtr tb
+ | menuItemID==0
+ = (Nothing,tb)
+ | otherwise
+ = (Just {ospupItem=PopUpTrackedByItemId menuItemID,ospupModifiers=modifiers},tb)
+
+
+// Changing (sub)menus:
+osAppendMenuItem :: !OSMenuBar !Int !OSMenu !{#Char} !Bool !Bool !Char !*OSToolbox -> (!OSMenuItem,!OSMenu,!*OSToolbox)
+osAppendMenuItem {menuWindow} index menu title able mark key tb
+ # title = if (key <> '\0')
+ (title +++ "\tCtrl+" +++ toString (toUpper key))
+ title
+ # (item,tb) = winInsertMenuItem title able mark menu index tb
+ | key <> '\0'
+ = (item,menu,winAddMenuShortKey menuWindow item key tb)
+ | otherwise
+ = (item,menu,tb)
+
+osAppendMenuSeparator :: !Int !OSMenu !*OSToolbox -> (!OSMenuSeparator,!OSMenu,!*OSToolbox)
+osAppendMenuSeparator index menu tb
+ # tb = winInsertSeparator menu index tb
+ = (OSNoMenuSeparator,menu,tb)
+
+osChangeMenuTitle :: !OSMenuBar !OSMenu !{#Char} !*OSToolbox -> *OSToolbox
+osChangeMenuTitle {menuBar} menu title tb
+ = winModifyMenu title menu menuBar tb
+
+osChangeMenuItemTitle :: !OSMenu !OSMenuItem !Int !{#Char} !*OSToolbox -> *OSToolbox
+osChangeMenuItemTitle menu item _ title tb
+ = winModifyMenuItem title item menu tb
+
+osMenuItemCheck :: !Bool !OSMenu !OSMenuItem !Int !Int !*OSToolbox -> *OSToolbox
+osMenuItemCheck check menu item _ _ tb
+ = winChangeMenuItemCheck menu item check tb
+
+osMenuRemoveItem :: !OSMenuItem !Int !OSMenu !*OSToolbox -> (!OSMenu,!*OSToolbox)
+osMenuRemoveItem item _ menu tb
+ = (menu,winRemoveMenuItem menu item tb)
+
+
+// Validation of (sub)menu (element) attributes:
+
+osValidateMenuItemTitle :: !(Maybe Char) !{#Char} -> {#Char} // PA: function now includes short key.
+osValidateMenuItemTitle Nothing title
+ = title
+osValidateMenuItemTitle (Just key) title
+ = title +++ "\tCtrl+" +++ toString (toUpper key)
+
+
+/* Two functions that generate free OS ids for menus and sub menus.
+ If the functions fail, then the Bool result is False, and the Int result is 0.
+ Do not continue to create the (sub)menu.
+*/
+:: OSMenuNr :== Int
+:: OSSubMenuNr :== Int
+
+osNewMenuNr :: !*OSToolbox -> (!Bool,!OSMenuNr,!*OSToolbox)
+osNewMenuNr tb
+ = (True,0,tb)
+
+osNewSubMenuNr :: !*OSToolbox -> (!Bool,!OSSubMenuNr,!*OSToolbox)
+osNewSubMenuNr tb
+ = (True,0,tb)
diff --git a/osmouse.dcl b/osmouse.dcl new file mode 100644 index 0000000..e218474 --- /dev/null +++ b/osmouse.dcl @@ -0,0 +1,8 @@ +definition module osmouse
+
+// Clean Object I/O library, version 1.2
+
+from ostoolbox import :: OSToolbox
+
+// RWS ??? returned resolution
+osGetDoubleClickTime :: !*OSToolbox -> (!Int, !*OSToolbox)
diff --git a/osmouse.icl b/osmouse.icl new file mode 100644 index 0000000..835ab0c --- /dev/null +++ b/osmouse.icl @@ -0,0 +1,8 @@ +implementation module osmouse
+
+from ostoolbox import :: OSToolbox
+
+// RWS ??? returned resolution
+osGetDoubleClickTime :: !*OSToolbox -> (!Int, !*OSToolbox)
+osGetDoubleClickTime toolbox
+ = (0, toolbox)
diff --git a/ospicture.dcl b/ospicture.dcl new file mode 100644 index 0000000..dbb9184 --- /dev/null +++ b/ospicture.dcl @@ -0,0 +1,219 @@ +definition module ospicture
+
+
+// Clean Object I/O library, version 1.2
+
+/* Drawing functions and other operations on Pictures.
+*/
+
+import osrgn, ostypes
+from StdFunc import :: St
+from osfont import :: Font
+from ostoolbox import :: OSToolbox
+import StdPictureDef
+
+
+:: Picture
+:: Origin
+ :== Point2
+/* PA: moved to ostypes
+:: OSPictContext
+ :== HDC
+*/
+:: Pen
+ = { penSize :: !Int // The width and height of the pen
+ , penForeColour :: !Colour // The drawing colour of the pen
+ , penBackColour :: !Colour // The background colour of the pen
+ , penPos :: !.Point2 // The pen position in local coordinates
+ , penFont :: !Font // The font information to draw text and characters
+ }
+
+/* Conversion operations to and from Picture.
+ To open/close a picture context:
+ packPicture creates a Picture, given the proper OS resources. The picture is initialised.
+ unpackPicture unpacks a Picture, releasing the proper OS resources.
+ To open/close an existing picture:
+ peekPicture gives you the components of a Picture
+ unpeekPicture restores the components to a Picture
+ To obtain the graphics context of an existing picture:
+ peekOSPictContext
+ To obtain a read-only picture:
+ sharePicture creates a copy of the Picture. This copy does not occupy OS resources.
+ To obtain temporary access to the screen:
+ peekScreen creates a window picture, applies the argument function to it, and releases the OS resources.
+*/
+packPicture :: !Origin !*Pen !Bool !OSPictContext !*OSToolbox -> *Picture
+unpeekPicture :: !Origin !*Pen !Bool !OSPictContext !*OSToolbox -> *Picture
+unpackPicture :: !*Picture -> (!Origin,!*Pen,!Bool,!OSPictContext,!*OSToolbox)
+peekPicture :: !*Picture -> (!Origin,!*Pen,!Bool,!OSPictContext,!*OSToolbox)
+peekOSPictContext :: !*Picture -> (!OSPictContext,!*Picture)
+sharePicture :: !*Picture -> (!Picture, !*Picture)
+peekScreen :: !.(St *Picture .x) !*OSToolbox -> (!.x,!*OSToolbox)
+
+defaultPen :: *Pen // The Pen for customised drawing operations
+dialogPen :: *Pen // The Pen for system drawing operations
+setPenAttribute :: !PenAttribute !u:Pen -> u:Pen
+sharePen :: !*Pen -> (!Pen,!*Pen)
+copyPen :: ! Pen -> *Pen
+
+
+// Picture interface functions.
+apppicttoolbox :: !(IdFun *OSToolbox) !*Picture -> *Picture
+accpicttoolbox :: !(St *OSToolbox .x) !*Picture -> (!.x,!*Picture)
+
+
+/* Attribute functions.
+*/
+// Access to Origin and Pen:
+setpictpen :: !Pen !*Picture -> *Picture
+getpictpen :: !*Picture -> (!Pen, !*Picture)
+setpictorigin :: !Origin !*Picture -> *Picture
+getpictorigin :: !*Picture -> (!Origin,!*Picture)
+
+// PenPos attributes:
+setpictpenpos :: !Point2 !*Picture -> *Picture
+getpictpenpos :: !*Picture -> (!Point2,!*Picture)
+movepictpenpos :: !Vector2 !*Picture -> *Picture
+// Move the pen position over the given vector
+
+// PenSize attributes:
+setpictpensize :: !Int !*Picture -> *Picture
+getpictpensize :: !*Picture -> (!Int,!*Picture)
+
+// PenColour attributes:
+setpictpencolour :: !Colour !*Picture -> *Picture
+setpictbackcolour :: !Colour !*Picture -> *Picture
+getpictpencolour :: !*Picture -> (!Colour,!*Picture)
+getpictbackcolour :: !*Picture -> (!Colour,!*Picture)
+toRGBtriple :: !Colour -> (!Int,!Int,!Int)
+
+// PenFont attributes:
+setpictpenfont :: !Font !*Picture -> *Picture
+getpictpenfont :: !*Picture -> (!Font,!*Picture)
+setpictpendefaultfont :: !*Picture -> *Picture
+// setpictpendefaultfont opens and sets the defaultFont (see StdFont).
+
+
+/* Drawing mode setting functions.
+*/
+setpictxormode :: !*Picture -> *Picture
+setpicthilitemode :: !*Picture -> *Picture
+setpictnormalmode :: !*Picture -> *Picture
+
+
+/* Point2 drawing operations.
+ pictdrawpoint
+ only draws a point at that position. The pen position is not changed.
+*/
+pictdrawpoint :: !Point2 !*Picture -> *Picture
+
+
+/* Line drawing operations.
+ pictdrawlineto
+ draws a line from the current pen position to the given pen position.
+ The new pen position is the endpoint of the line.
+ pictdrawline
+ draws a line from the first point to the second point. The pen position
+ is not changed.
+ pictundrawlineto
+ is the same as pictdrawlineto except that temporarily the background colour is used.
+ pictundrawline
+ is the same as pictdrawline except that temporarily the background colour is used.
+*/
+pictdrawlineto :: !Point2 !*Picture -> *Picture
+pictdrawline :: !Point2 !Point2 !*Picture -> *Picture
+pictundrawlineto :: !Point2 !*Picture -> *Picture
+pictundrawline :: !Point2 !Point2 !*Picture -> *Picture
+
+
+/* Text drawing operations.
+ pictdraw(char/string) draws a char/string at the current pen position. The new
+ pen position is immediately after the drawn char/string.
+*/
+pictdrawchar :: !Char !*Picture -> *Picture
+pictundrawchar :: !Char !*Picture -> *Picture
+pictdrawstring :: !String !*Picture -> *Picture
+pictundrawstring :: !String !*Picture -> *Picture
+
+
+/* Oval drawing operations.
+ pict(draw/fill)oval center oval
+ draws/fills an oval at center with horizontal and vertical radius. The new
+ pen position is not changed.
+ pict(undraw/unfill)oval center oval
+ draw/fill an oval at center with horizontal and vertical radius using the
+ background colour of the picture.
+*/
+pictdrawoval :: !Point2 !Oval !*Picture -> *Picture
+pictfilloval :: !Point2 !Oval !*Picture -> *Picture
+pictundrawoval :: !Point2 !Oval !*Picture -> *Picture
+pictunfilloval :: !Point2 !Oval !*Picture -> *Picture
+
+
+/* Curve drawing operations.
+ pict(draw/fill)curve movePen point curve
+ draws/fills a curve starting at point with a shape defined by curve. If movePen
+ is True, then the new pen position is at the end of the curve, otherwise it does
+ not change.
+ pictun(draw/fill)curve
+ is equal to pict(draw/fill)curve, using the background colour temporarily.
+ getcurve_rect_begin_end point curve
+ returns the enclosing rect of the curve and begin and end point lying on that
+ curve.
+*/
+pictdrawcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictundrawcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictfillcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictunfillcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+getcurve_rect_begin_end :: !Point2 !Curve -> (!OSRect,!Point2,!Point2)
+
+
+/* OSRect drawing operations.
+ pict(draw/fill)rect rect
+ draws/fills a rect. The pen position is not changed.
+ pictun(draw/fill)rect
+ is equal to pict(draw/fill)rect, using the background colour temporarily.
+*/
+pictdrawrect :: !OSRect !*Picture -> *Picture
+pictundrawrect :: !OSRect !*Picture -> *Picture
+pictfillrect :: !OSRect !*Picture -> *Picture
+pictunfillrect :: !OSRect !*Picture -> *Picture
+
+
+/* Scrolling operation (handle with care).
+*/
+pictscroll :: !OSRect !Vector2 !*Picture -> (!OSRect,!*Picture)
+pictscroll2 :: !OSRect !Vector2 !*Picture -> (!OSRect,!*Picture)
+
+
+/* Polygon drawing operations.
+ pict(draw/fill)polygon point polygon
+ draws/fills a polygon starting at point. The pen position is not changed.
+ pictun(draw/fill)polygon
+ is equal to pict(draw/fill)polygon, using the background colour temporarily.
+*/
+pictdrawpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictundrawpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictfillpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictunfillpolygon :: !Point2 !Polygon !*Picture -> *Picture
+
+
+/* Clipping operations.
+ pictgetcliprgn gets the current clipping region.
+ pictsetcliprgn sets the given clipping region.
+ pictandcliprgn takes the intersection of the current clipping region and the argument region.
+*/
+pictgetcliprgn :: !*Picture -> (!OSRgnHandle,!*Picture)
+pictsetcliprgn :: !OSRgnHandle !*Picture -> *Picture
+pictandcliprgn :: !OSRgnHandle !*Picture -> *Picture
+
+
+/* Resolution access function (added by MW):
+*/
+getResolutionC :: !OSPictContext !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+
+// MW: scaling of screen coordinates to printer coordinates.
+getPictureScalingFactors:: !OSPictContext !*OSToolbox -> (!(!Int,!Int),!(!Int,!Int),!OSPictContext,!*OSToolbox)
+
+getpictpenattributes :: !*Picture -> (![PenAttribute],!*Picture)
+getPenPenPos :: !*Pen -> (!Point2,!*Pen)
diff --git a/ospicture.icl b/ospicture.icl new file mode 100644 index 0000000..f0cfe01 --- /dev/null +++ b/ospicture.icl @@ -0,0 +1,663 @@ +implementation module ospicture
+
+import StdBool, StdFunc, StdInt, StdList, StdReal, StdTuple
+import pictCCall_12, osfont, ostypes
+from osrgn import :: OSRgnHandle
+from ostoolbox import OSNewToolbox
+import StdPictureDef
+from commondef import class toTuple(..), instance toTuple Point2, instance toTuple Vector2,
+ class subVector(..), instance subVector OSRect, setBetween
+
+:: Picture
+ = { pictContext :: !OSPictContext // The context for drawing operations
+ , pictToolbox :: !.OSToolbox // The continuation value
+ , pictOrigin :: !Origin // The current origin of the picture
+ , pictPen :: !.Pen // The current state of the pen
+ , pictToScreen :: !Bool // Flag: the output goes to screen (True) or printer (False)
+ }
+:: Origin
+ :== Point2
+/* PA: moved to ostypes
+:: OSPictContext
+ :== HDC
+*/
+:: Pen
+ = { penSize :: !Int // The width and height of the pen
+ , penForeColour :: !Colour // The drawing colour of the pen
+ , penBackColour :: !Colour // The background colour of the pen
+ , penPos :: !.Point2 // The pen position in local coordinates
+ , penFont :: !Font // The font information to draw text and characters
+ }
+
+
+// Conversion operations to and from Picture
+/*
+initialisePicture :: !Origin !Pen !OSPictContext !*OSToolbox -> (!OSPictContext,!*OSToolbox)
+initialisePicture origin pen=:{penSize,penForeColour,penBackColour,penPos,penFont} hdc tb
+ # {osfontname,osfontstyles,osfontsize} = osFontgetimp penFont
+ # (hdc,tb) = winInitPicture
+ penSize
+ iModeCopy
+ initforecolour
+ initbackcolour
+ initpen
+ (osfontname,osfontstyles,osfontsize)
+ (0,0)
+ (hdc,tb)
+ # (_,_,_,_,_,_,(hdc,tb)) = winDonePicture (hdc,tb)
+ = (hdc,tb)
+where
+ initforecolour = toRGBtriple penForeColour
+ initbackcolour = toRGBtriple penBackColour
+ initpen = toTuple (penPos-origin)
+*/
+packPicture :: !Origin !*Pen !Bool !OSPictContext !*OSToolbox -> *Picture
+packPicture origin pen=:{penSize,penForeColour,penBackColour,penPos,penFont} isScreenOutput hdc tb
+ #! {osfontname,osfontstyles,osfontsize}= osFontgetimp penFont
+ #! (hdc,tb) = winInitPicture
+ penSize
+ iModeCopy
+ initforecolour
+ initbackcolour
+ initpen
+ (osfontname,osfontstyles,osfontsize)
+ (0,0)
+ (hdc,tb)
+ = { pictContext = hdc
+ , pictToolbox = tb
+ , pictOrigin = origin
+ , pictPen = pen
+ , pictToScreen= isScreenOutput
+ }
+where
+ initforecolour = toRGBtriple penForeColour
+ initbackcolour = toRGBtriple penBackColour
+ initpen = toTuple (penPos-origin)
+
+unpackPicture :: !*Picture -> (!Origin,!*Pen,!Bool,!OSPictContext,!*OSToolbox)
+unpackPicture {pictOrigin,pictPen,pictToScreen,pictContext,pictToolbox}
+// PA: intend to use simplified version of winDonePicture; crashes for some reason.
+ # (_,_,_,_,_,_,(hdc,tb)) = winDonePicture (pictContext,pictToolbox)
+// # (hdc,tb) = WinDonePicture (pictContext,pictToolbox)
+ = (pictOrigin,pictPen,pictToScreen,hdc,tb)
+
+peekPicture :: !*Picture -> (!Origin,!*Pen,!Bool,!OSPictContext,!*OSToolbox)
+peekPicture {pictOrigin,pictPen,pictToScreen,pictContext,pictToolbox}
+ = (pictOrigin,pictPen,pictToScreen,pictContext,pictToolbox)
+
+unpeekPicture :: !Origin !*Pen !Bool !OSPictContext !*OSToolbox -> *Picture
+unpeekPicture origin pen isScreenOutput hdc tb
+ = {pictOrigin=origin,pictPen=pen,pictToScreen=isScreenOutput,pictContext=hdc,pictToolbox=tb}
+
+peekOSPictContext :: !*Picture -> (!OSPictContext,!*Picture)
+peekOSPictContext picture=:{pictContext}
+ = (pictContext,picture)
+
+sharePicture :: !*Picture -> (!Picture,!*Picture)
+sharePicture picture=:{pictOrigin,pictPen,pictToScreen}
+ # (sPen,uPen) = sharePen pictPen
+ = ({pictContext=0,pictToolbox=OSNewToolbox,pictOrigin=pictOrigin,pictPen=sPen,pictToScreen=pictToScreen},{picture & pictPen=uPen})
+
+sharePen :: !*Pen -> (!Pen,!*Pen)
+sharePen pen=:{penSize,penForeColour,penBackColour,penPos,penFont}
+ # (sPenPos,uPenPos) = sharePoint penPos
+ = ({penSize=penSize,penForeColour=penForeColour,penBackColour=penBackColour,penPos=sPenPos,penFont=penFont},{pen & penPos=uPenPos})
+where
+ sharePoint :: !*Point2 -> (!Point2,!*Point2)
+ sharePoint point=:{x,y} = ({x=x,y=y},point)
+
+copyPen :: !Pen -> *Pen
+copyPen {penSize,penForeColour,penBackColour,penPos={x,y},penFont}
+ = {penSize=penSize,penForeColour=penForeColour,penBackColour=penBackColour,penPos={x=x,y=y},penFont=penFont}
+
+peekScreen :: !.(St *Picture .x) !*OSToolbox -> (!.x,!*OSToolbox)
+peekScreen f tb
+ # (hdc,tb) = winCreateScreenHDC tb
+ # picture = packPicture zero defaultPen True hdc tb
+ # (x,picture) = f picture
+ # (_,_,_,hdc,tb)= unpackPicture picture
+ # tb = winDestroyScreenHDC (hdc,tb)
+ = (x,tb)
+
+
+defaultPen :: *Pen
+defaultPen
+ = { penSize = 1
+ , penForeColour = Black
+ , penBackColour = White
+ , penPos = {x=0,y=0}
+ , penFont = defaultFont
+ }
+where
+ (defaultFont,_) = osDefaultfont OSNewToolbox
+
+dialogPen :: *Pen
+dialogPen
+ = { penSize = 1
+ , penForeColour = Black
+ , penBackColour = White
+ , penPos = {x=0,y=0}
+ , penFont = dialogFont
+ }
+where
+ (dialogFont,_) = osDialogfont OSNewToolbox
+
+setPenAttribute :: !PenAttribute !u:Pen -> u:Pen
+setPenAttribute (PenSize size) pen = {pen & penSize =max 1 size}
+setPenAttribute (PenPos {x,y}) pen = {pen & penPos ={x=x,y=y} }
+setPenAttribute (PenColour colour) pen = {pen & penForeColour=colour }
+setPenAttribute (PenBack colour) pen = {pen & penBackColour=colour }
+setPenAttribute (PenFont font) pen = {pen & penFont =font }
+
+
+/* Picture interface functions.
+*/
+apppicttoolbox :: !(IdFun *OSToolbox) !*Picture -> *Picture
+apppicttoolbox f picture=:{pictToolbox}
+ = {picture & pictToolbox=f pictToolbox}
+
+accpicttoolbox :: !(St *OSToolbox .x) !*Picture -> (!.x,!*Picture)
+accpicttoolbox f picture=:{pictToolbox}
+ # (x,tb) = f pictToolbox
+ = (x,{picture & pictToolbox=tb})
+
+
+/* Attribute functions.
+*/
+// Access to Origin and Pen:
+getpictorigin :: !*Picture -> (!Origin,!*Picture)
+getpictorigin picture=:{pictOrigin}
+ = (pictOrigin,picture)
+
+setpictorigin :: !Origin !*Picture -> *Picture
+setpictorigin origin picture
+ = {picture & pictOrigin=origin}
+
+getpictpen :: !*Picture -> (!Pen,!*Picture)
+getpictpen picture=:{pictPen}
+ # (sPen,uPen) = sharePen pictPen
+ = (sPen,{picture & pictPen=uPen})
+
+setpictpen :: !Pen !*Picture -> *Picture
+setpictpen {penSize,penForeColour,penBackColour,penPos,penFont} picture
+ # picture = setpictpensize penSize picture
+ # picture = setpictpencolour penForeColour picture
+ # picture = setpictbackcolour penBackColour picture
+ # picture = setpictpenpos penPos picture
+ # picture = setpictpenfont penFont picture
+ = picture
+
+
+// Change the pen position:
+setpictpenpos :: !Point2 !*Picture -> *Picture
+setpictpenpos newpos=:{x=x`,y=y`} picture=:{pictToolbox,pictOrigin,pictPen=pen=:{penPos={x,y}},pictContext}
+ | x==x` && y==y`
+ = picture
+ | otherwise
+ # (context,tb) = winMovePenTo (toTuple (newpos-pictOrigin)) (pictContext,pictToolbox)
+ pen = {pen & penPos={x=x`,y=y`}}
+ = {picture & pictToolbox=tb,pictContext=context,pictPen=pen}
+
+getpictpenpos :: !*Picture -> (!Point2,!*Picture)
+getpictpenpos picture=:{pictPen={penPos={x,y}}}
+ = ({x=x,y=y},picture)
+
+movepictpenpos :: !Vector2 !*Picture -> *Picture
+movepictpenpos v=:{vx,vy} picture=:{pictToolbox,pictPen=pen=:{penPos={x,y}},pictContext}
+ # (context,tb) = winMovePen (toTuple v) (pictContext,pictToolbox)
+ pen = {pen & penPos={x=x+vx,y=y+vy}}
+ = {picture & pictToolbox=tb,pictContext=context,pictPen=pen}
+
+// Change the pen size:
+setpictpensize :: !Int !*Picture -> *Picture
+setpictpensize w picture=:{pictToolbox,pictContext,pictPen}
+ | w`==pictPen.penSize
+ = picture
+ | otherwise
+ # (context,tb) = winSetPenSize w` (pictContext,pictToolbox)
+ pen = {pictPen & penSize=w`}
+ = {picture & pictToolbox=tb,pictContext=context,pictPen=pen}
+where
+ w` = max 1 w
+
+getpictpensize :: !*Picture -> (!Int,!*Picture)
+getpictpensize picture=:{pictPen={penSize}}
+ = (penSize,picture)
+
+
+// Change the PenColour:
+setpictpencolour :: !Colour !*Picture -> *Picture
+setpictpencolour colour picture=:{pictToolbox,pictPen,pictContext}
+ | reqRGB==curRGB
+ = picture
+ | otherwise
+ # (context,tb) = winSetPenColor reqRGB (pictContext,pictToolbox)
+ pen = {pictPen & penForeColour=colour}
+ = {picture & pictPen=pen,pictToolbox=tb,pictContext=context}
+where
+ reqRGB = toRGBtriple colour
+ curRGB = toRGBtriple pictPen.penForeColour
+
+setpictbackcolour :: !Colour !*Picture -> *Picture
+setpictbackcolour colour picture=:{pictToolbox,pictPen,pictContext}
+ | reqRGB==curRGB
+ = picture
+ | otherwise
+ # (context,tb) = winSetBackColor (toRGBtriple colour) (pictContext,pictToolbox)
+ pen = {pictPen & penBackColour=colour}
+ = {picture & pictPen=pen,pictToolbox=tb,pictContext=context}
+where
+ reqRGB = toRGBtriple colour
+ curRGB = toRGBtriple pictPen.penBackColour
+
+toRGBtriple :: !Colour -> (!Int,!Int,!Int)
+toRGBtriple (RGB {r,g,b}) = (setBetween r MinRGB MaxRGB,setBetween g MinRGB MaxRGB,setBetween b MinRGB MaxRGB)
+toRGBtriple Black = (MinRGB,MinRGB,MinRGB)
+toRGBtriple DarkGrey = ( MaxRGB>>2, MaxRGB>>2, MaxRGB>>2)
+toRGBtriple Grey = ( MaxRGB>>1, MaxRGB>>1, MaxRGB>>1)
+toRGBtriple LightGrey = ((MaxRGB>>2)*3,(MaxRGB>>2)*3,(MaxRGB>>2)*3)
+toRGBtriple White = (MaxRGB,MaxRGB,MaxRGB)
+toRGBtriple Red = (MaxRGB,MinRGB,MinRGB)
+toRGBtriple Green = (MinRGB,MaxRGB,MinRGB)
+toRGBtriple Blue = (MinRGB,MinRGB,MaxRGB)
+toRGBtriple Cyan = (MinRGB,MaxRGB,MaxRGB)
+toRGBtriple Magenta = (MaxRGB,MinRGB,MaxRGB)
+toRGBtriple Yellow = (MaxRGB,MaxRGB,MinRGB)
+
+getpictpencolour :: !*Picture -> (!Colour,!*Picture)
+getpictpencolour picture=:{pictPen={penForeColour}}
+ = (penForeColour,picture)
+
+getpictbackcolour :: !*Picture -> (!Colour,!*Picture)
+getpictbackcolour picture=:{pictPen={penBackColour}}
+ = (penBackColour,picture)
+
+
+// Change the font attributes:
+setpictpenfont :: !Font !*Picture -> *Picture
+setpictpenfont font picture=:{pictToolbox,pictContext,pictPen=pen}
+ | imp==osFontgetimp pen.penFont
+ = picture
+ | otherwise
+ # (context,tb) = winSetFont (osfontname,osfontstyles,osfontsize) (pictContext,pictToolbox)
+ pen = {pen & penFont=font}
+ = {picture & pictToolbox=tb,pictContext=context,pictPen=pen}
+where
+ imp = osFontgetimp font
+ {osfontname,osfontstyles,osfontsize} = imp
+
+getpictpenfont :: !*Picture -> (!Font,!*Picture)
+getpictpenfont picture=:{pictPen={penFont}}
+ = (penFont,picture)
+
+setpictpendefaultfont :: !*Picture -> *Picture
+setpictpendefaultfont picture=:{pictToolbox,pictContext,pictPen}
+ # (font,tb) = osDefaultfont pictToolbox
+ {osfontname,osfontstyles,osfontsize}
+ = osFontgetimp font
+ # (context,tb) = winSetFont (osfontname,osfontstyles,osfontsize) (pictContext,tb)
+ pen = {pictPen & penFont=font}
+ = {picture & pictToolbox=tb,pictContext=context,pictPen=pen}
+
+
+/* Drawing mode setting functions.
+*/
+setpictxormode :: !*Picture -> *Picture
+setpictxormode picture=:{pictToolbox,pictContext}
+ # (context,tb) = winSetMode iModeXor (pictContext,pictToolbox)
+ = {picture & pictToolbox=tb,pictContext=context}
+
+setpicthilitemode :: !*Picture -> *Picture
+setpicthilitemode picture=:{pictToolbox,pictContext}
+ # (context,tb) = winSetMode iModeXor (pictContext,pictToolbox)
+ = {picture & pictToolbox=tb,pictContext=context}
+
+setpictnormalmode :: !*Picture -> *Picture
+setpictnormalmode picture=:{pictToolbox,pictContext}
+ # (context,tb) = winSetMode iModeCopy (pictContext,pictToolbox)
+ = {picture & pictToolbox=tb,pictContext=context}
+
+
+/* Point2 drawing operations.
+ pictdrawpoint
+ only draws a point at that position. The pen position is not changed.
+*/
+pictdrawpoint :: !Point2 !*Picture -> *Picture
+pictdrawpoint pos=:{x,y} picture=:{pictPen={penSize},pictOrigin={x=ox,y=oy},pictToolbox,pictContext}
+ | penSize==1
+ # (context,tb) = winDrawPoint (x`,y`) (pictContext,pictToolbox)
+ = {picture & pictToolbox=tb,pictContext=context}
+ | otherwise
+ # (context,tb) = winFillRectangle {rleft=x`,rtop=y`,rright=x`+penSize,rbottom=y`+penSize} (pictContext,pictToolbox)
+ = {picture & pictToolbox=tb,pictContext=context}
+where
+ (x`,y`) = (x-ox,y-oy)
+
+
+/* Line drawing operations.
+ pictdrawlineto
+ draws a line from the current pen position to the given pen position.
+ The new pen position is the endpoint of the line.
+ pictdrawline
+ draws a line from the first point to the second point. The pen position
+ is not changed.
+*/
+pictdrawlineto :: !Point2 !*Picture -> *Picture
+pictdrawlineto pos=:{x,y} picture=:{pictOrigin,pictToolbox,pictContext,pictPen}
+ # (context,tb) = winLinePenTo (toTuple (pos-pictOrigin)) (pictContext,pictToolbox)
+ pen = {pictPen & penPos={x=x,y=y}}
+ = {picture & pictToolbox=tb,pictContext=context,pictPen=pen}
+
+pictundrawlineto :: !Point2 !*Picture -> *Picture
+pictundrawlineto pos=:{x,y} picture=:{pictOrigin,pictToolbox,pictContext,pictPen=pen=:{penForeColour,penBackColour}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winLinePenTo (toTuple (pos-pictOrigin)) (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ = {picture & pictToolbox=tb,pictContext=context,pictPen={pen & penPos={x=x,y=y}}}
+
+pictdrawline :: !Point2 !Point2 !*Picture -> *Picture
+pictdrawline a b picture=:{pictOrigin,pictToolbox,pictContext}
+ # (context,tb) = winDrawLine (toTuple (a-pictOrigin)) (toTuple (b-pictOrigin)) (pictContext,pictToolbox)
+ = {picture & pictToolbox=tb,pictContext=context}
+
+pictundrawline :: !Point2 !Point2 !*Picture -> *Picture
+pictundrawline a b picture=:{pictOrigin,pictToolbox,pictContext,pictPen={penForeColour,penBackColour}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winDrawLine (toTuple (a-pictOrigin)) (toTuple (b-pictOrigin)) (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ = {picture & pictToolbox=tb,pictContext=context}
+
+
+/* Text drawing operations.
+ pictdraw(char/string) draws a char/string at the current pen position. The new
+ pen position is immediately after the drawn char/string.
+*/
+pictdrawchar :: !Char !*Picture -> *Picture
+pictdrawchar char picture=:{pictContext,pictToolbox,pictPen,pictOrigin}
+ # (context,tb) = winDrawChar (toInt char) (pictContext,pictToolbox)
+ # (x`,y`,context,tb)= winGetPenPos (context,tb)
+ #! {x,y} = pictOrigin
+ #! pen = {pictPen & penPos={x=x+x`,y=y+y`}}
+ = {picture & pictContext=context,pictToolbox=tb,pictPen=pen}
+
+pictundrawchar :: !Char !*Picture -> *Picture
+pictundrawchar char picture=:{pictContext,pictToolbox,pictPen=pen=:{penForeColour,penBackColour},pictOrigin={x=ox,y=oy}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winDrawChar (toInt char) (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ # (x,y,context,tb) = winGetPenPos (context,tb)
+ = {picture & pictContext=context,pictToolbox=tb,pictPen={pen & penPos={x=x+ox,y=y+oy}}}
+
+pictdrawstring :: !String !*Picture -> *Picture
+pictdrawstring string picture=:{pictContext,pictToolbox,pictPen,pictOrigin={x=ox,y=oy}} // PA:
+ # (context,tb) = winDrawString string (pictContext,pictToolbox)
+ # (x,y,context,tb) = winGetPenPos (context,tb)
+ pen = {pictPen & penPos={x=x+ox,y=y+oy}}
+ = {picture & pictContext=context,pictToolbox=tb,pictPen=pen}
+
+pictundrawstring :: !String !*Picture -> *Picture
+pictundrawstring string picture=:{pictContext,pictToolbox,pictPen=pen=:{penForeColour,penBackColour},pictOrigin={x=ox,y=oy}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winDrawString string (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ # (x,y,context,tb) = winGetPenPos (context,tb)
+ = {picture & pictContext=context,pictToolbox=tb,pictPen={pen & penPos={x=x+ox,y=y+oy}}}
+
+
+/* Oval drawing operations.
+ pict(draw/fill)oval center oval
+ draws/fills an oval at center with horizontal and vertical radius. The new
+ pen position is not changed.
+*/
+pictdrawoval :: !Point2 !Oval !*Picture -> *Picture
+pictdrawoval center oval picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winDrawOval rect (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+where
+ rect = ovalToRect (center-pictOrigin) oval
+
+pictundrawoval :: !Point2 !Oval !*Picture -> *Picture
+pictundrawoval center oval picture=:{pictContext,pictToolbox,pictOrigin,pictPen={penBackColour,penForeColour}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winDrawOval rect (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ = {picture & pictContext=context,pictToolbox=tb}
+where
+ rect = ovalToRect (center-pictOrigin) oval
+
+pictfilloval :: !Point2 !Oval !*Picture -> *Picture
+pictfilloval center oval picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winFillOval rect (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+where
+ rect = ovalToRect (center-pictOrigin) oval
+
+pictunfilloval :: !Point2 !Oval !*Picture -> *Picture
+pictunfilloval center oval picture=:{pictContext,pictToolbox,pictOrigin,pictPen}
+ # (context,tb) = winEraseOval rect (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+where
+ rect = ovalToRect (center-pictOrigin) oval
+
+ovalToRect :: !Point2 !Oval -> OSRect
+ovalToRect {x,y} {oval_rx,oval_ry}
+ = {rleft=x-rx,rtop=y-ry,rright=x+rx,rbottom=y+ry}
+where
+ rx = abs oval_rx
+ ry = abs oval_ry
+
+
+/* Curve drawing operations.
+ pict(draw/fill)curve movePen point curve
+ draws/fills a curve starting at point with a shape defined by curve. If movePen
+ is True, then the new pen position is at the end of the curve, otherwise it does
+ not change.
+*/
+pictdrawcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictdrawcurve movePen start=:{x,y} curve picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winDrawCurve wrect (toTuple wstart) (toTuple wend) (pictContext,pictToolbox)
+ # picture = {picture & pictContext=context,pictToolbox=tb}
+ | not movePen = picture
+ | otherwise = setpictpenpos end picture
+where
+ start` = start-pictOrigin
+ (wrect,wstart,wend) = getcurve_rect_begin_end start` curve
+ end = wend+pictOrigin
+
+pictundrawcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictundrawcurve movePen start=:{x,y} curve picture=:{pictContext,pictToolbox,pictOrigin,pictPen={penForeColour,penBackColour}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winDrawCurve wrect (toTuple wstart) (toTuple wend) (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ # picture = {picture & pictContext=context,pictToolbox=tb}
+ | not movePen = picture
+ | otherwise = setpictpenpos end picture
+where
+ start` = start-pictOrigin
+ (wrect,wstart,wend) = getcurve_rect_begin_end start` curve
+ end = wend+pictOrigin
+
+pictfillcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictfillcurve movePen start curve picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winFillWedge wrect (toTuple wstart) (toTuple wend) (pictContext,pictToolbox)
+ # picture = {picture & pictContext=context,pictToolbox=tb}
+ | not movePen = picture
+ | otherwise = setpictpenpos end picture
+where
+ start` = start-pictOrigin
+ (wrect,wstart,wend) = getcurve_rect_begin_end start` curve
+ end = wend+pictOrigin
+
+pictunfillcurve :: !Bool !Point2 !Curve !*Picture -> *Picture
+pictunfillcurve movePen start curve picture=:{pictContext,pictToolbox,pictOrigin,pictPen={penForeColour,penBackColour}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winFillWedge wrect (toTuple wstart) (toTuple wend) (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ # picture = {picture & pictContext=context,pictToolbox=tb}
+ | not movePen = picture
+ | otherwise = setpictpenpos end picture
+where
+ start` = start-pictOrigin
+ (wrect,wstart,wend) = getcurve_rect_begin_end start` curve
+ end = wend+pictOrigin
+
+getcurve_rect_begin_end :: !Point2 !Curve -> (!OSRect,!Point2,!Point2)
+getcurve_rect_begin_end start=:{x,y} {curve_oval={oval_rx,oval_ry},curve_from,curve_to,curve_clockwise}
+ | curve_clockwise = (rect,end,start)
+ | otherwise = (rect,start,end)
+where
+ rx` = toReal (abs oval_rx)
+ ry` = toReal (abs oval_ry)
+ cx = x -(toInt ((cos curve_from)*rx`))
+ cy = y +(toInt ((sin curve_from)*ry`))
+ ex = cx+(toInt ((cos curve_to )*rx`))
+ ey = cy-(toInt ((sin curve_to )*ry`))
+ end = {x=ex,y=ey}
+ rect = {rleft=cx-oval_rx,rtop=cy-oval_ry,rright=cx+oval_rx,rbottom=cy+oval_ry}
+
+
+/* OSRect drawing operations.
+ pict(draw/fill)rect rect
+ draws/fills a rect. The pen position is not changed.
+*/
+pictdrawrect :: !OSRect !*Picture -> *Picture
+pictdrawrect r picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winDrawRectangle (subVector (toVector pictOrigin) r) (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictundrawrect :: !OSRect !*Picture -> *Picture
+pictundrawrect r picture=:{pictContext,pictToolbox,pictOrigin,pictPen={penForeColour,penBackColour}}
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,pictToolbox)
+ # (context,tb) = winDrawRectangle (subVector (toVector pictOrigin) r) (context,tb)
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictfillrect :: !OSRect !*Picture -> *Picture
+pictfillrect r picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winFillRectangle (subVector (toVector pictOrigin) r) (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictunfillrect :: !OSRect !*Picture -> *Picture
+pictunfillrect r picture=:{pictContext,pictToolbox,pictOrigin}
+ # (context,tb) = winEraseRectangle (subVector (toVector pictOrigin) r) (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+
+/* Scrolling operation (handle with care).
+*/
+pictscroll :: !OSRect !Vector2 !*Picture -> (!OSRect,!*Picture)
+pictscroll r v picture=:{pictContext,pictToolbox,pictOrigin}
+ # (updRect,(context,tb)) = winScrollRectangle (subVector (toVector pictOrigin) r) (toTuple v) (pictContext,pictToolbox)
+ = (updRect,{picture & pictContext=context,pictToolbox=tb})
+
+pictscroll2 :: !OSRect !Vector2 !*Picture -> (!OSRect,!*Picture)
+pictscroll2 r v picture=:{pictContext,pictToolbox,pictOrigin}
+ # (updRect,(context,tb)) = winScrollRectangle2 (subVector (toVector pictOrigin) r) (toTuple v) (pictContext,pictToolbox)
+ = (updRect,{picture & pictContext=context,pictToolbox=tb})
+
+/* Polygon drawing operations.
+ pict(draw/fill)polygon point polygon
+ draws/fills a polygon starting at point. The pen position is not changed.
+*/
+pictdrawpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictdrawpolygon start {polygon_shape} picture=:{pictContext,pictToolbox,pictOrigin}
+ # tb = transferPolygon (start-pictOrigin) polygon_shape pictToolbox
+ # (context,tb) = winDrawPolygon (pictContext,tb)
+ # tb = winEndPolygon tb
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictundrawpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictundrawpolygon start {polygon_shape} picture=:{pictContext,pictToolbox,pictOrigin,pictPen={penForeColour,penBackColour}}
+ # tb = transferPolygon (start-pictOrigin) polygon_shape pictToolbox
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,tb)
+ # (context,tb) = winDrawPolygon (context,tb)
+ # tb = winEndPolygon tb
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictfillpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictfillpolygon start {polygon_shape} picture=:{pictPen={penSize},pictContext,pictToolbox,pictOrigin}
+ # tb = transferPolygon (start-pictOrigin) polygon_shape pictToolbox
+ # (context,tb) = winSetPenSize 1 (pictContext,tb)
+ # (context,tb) = winFillPolygon (context,tb)
+ # (context,tb) = winDrawPolygon (context,tb)
+ # (context,tb) = winSetPenSize penSize (context,tb)
+ # tb = winEndPolygon tb
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictunfillpolygon :: !Point2 !Polygon !*Picture -> *Picture
+pictunfillpolygon start {polygon_shape} picture=:{pictPen={penSize,penForeColour,penBackColour},pictContext,pictToolbox,pictOrigin}
+ # tb = transferPolygon (start-pictOrigin) polygon_shape pictToolbox
+ # (context,tb) = winSetPenColor (toRGBtriple penBackColour) (pictContext,tb)
+ # (context,tb) = winSetPenSize 1 (context,tb)
+ # (context,tb) = winFillPolygon (context,tb)
+ # (context,tb) = winDrawPolygon (context,tb)
+ # (context,tb) = winSetPenSize penSize (context,tb)
+ # tb = winEndPolygon tb
+ # (context,tb) = winSetPenColor (toRGBtriple penForeColour) (context,tb)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+transferPolygon :: !Point2 ![Vector2] !*OSToolbox -> *OSToolbox
+transferPolygon start vs tb
+ # tb = winStartPolygon (1 + length vs) tb
+ # tb = winAddPolygonPoint wstart tb
+ # tb = transferShape wstart vs tb
+ = tb
+where
+ wstart = toTuple start
+
+ transferShape :: !(!Int,!Int) ![Vector2] !*OSToolbox -> *OSToolbox
+ transferShape (x,y) [{vx,vy}:vs] tb
+ = transferShape newpos vs (winAddPolygonPoint newpos tb)
+ where
+ newpos = (x+vx,y+vy)
+ transferShape _ _ tb
+ = tb
+
+/* Clipping operations.
+ pictgetcliprgn gets the current clipping region.
+ pictsetcliprgn sets the given clipping region.
+ pictandcliprgn takes the intersection of the current clipping region and the argument region.
+*/
+pictgetcliprgn :: !*Picture -> (!OSRgnHandle,!*Picture)
+pictgetcliprgn picture=:{pictContext,pictToolbox}
+ # (cliprgn,(context,tb)) = winGetClipRgnPicture (pictContext,pictToolbox)
+ = (cliprgn,{picture & pictContext=context,pictToolbox=tb})
+
+pictsetcliprgn :: !OSRgnHandle !*Picture -> *Picture
+pictsetcliprgn cliprgn picture=:{pictContext,pictToolbox}
+ # (context,tb) = winSetClipRgnPicture cliprgn (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+pictandcliprgn :: !OSRgnHandle !*Picture -> *Picture
+pictandcliprgn cliprgn picture=:{pictContext,pictToolbox}
+ # (context,tb) = winClipRgnPicture cliprgn (pictContext,pictToolbox)
+ = {picture & pictContext=context,pictToolbox=tb}
+
+/* Resolution access function (added by MW):
+*/
+getResolutionC :: !OSPictContext !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+getResolutionC _ _
+ = code {
+ ccall getResolutionC "I:VII:I"
+ }
+
+// MW: scaling of screen coordinates to printer coordinates.
+getPictureScalingFactors :: !OSPictContext !*OSToolbox -> (!(!Int,!Int),!(!Int,!Int),!OSPictContext,!*OSToolbox)
+getPictureScalingFactors _ _
+ = code
+ {
+ ccall WinGetPictureScaleFactor "II-IIIIII"
+ }
+
+getpictpenattributes :: !*Picture -> (![PenAttribute],!*Picture)
+getpictpenattributes picture
+ # (pen,picture) = getpictpen picture
+ = (getpenattribute pen,picture)
+where
+ getpenattribute :: !Pen -> [PenAttribute]
+ getpenattribute {penSize,penForeColour,penBackColour,penPos,penFont}
+ = [PenSize penSize,PenPos penPos,PenColour penForeColour,PenBack penBackColour,PenFont penFont]
+
+getPenPenPos :: !*Pen -> (!Point2,!*Pen)
+getPenPenPos pen=:{penPos={x,y}} = ({x=x,y=y},pen)
diff --git a/osprint.dcl b/osprint.dcl new file mode 100644 index 0000000..27df495 --- /dev/null +++ b/osprint.dcl @@ -0,0 +1,51 @@ +definition module osprint
+
+// Clean Standard Object I/O library, version 1.2
+
+import StdFile, StdPicture, iostate
+
+:: PrintSetup
+:: JobInfo
+ = { range :: !(!Int,!Int) // First and last page as typed in by the
+ // user. If the user chooses "ALL", then the
+ // first page will be one, and the last page
+ // will be a "huge" number.
+ , copies :: !Int // Number of copies. This will not
+ // necessarily be equal to the number of
+ // copies, as specified in the print dialog.
+ // Some printer drivers take themselves care
+ // of producing the appropriate number of
+ // copies => printInfo.copies==1.
+ }
+:: PrintInfo
+ = { printSetup :: PrintSetup // PC: the print setup, which was chosen by
+ // the user via the print dialog
+ // Mac: the value will be identical to the
+ // actual PrintSetup argument, that was
+ // passed to one of the printing
+ // functions
+ , jobInfo :: JobInfo
+ }
+:: Alternative x y
+ = Cancelled x
+ | StartedPrinting y
+
+os_getpagedimensions :: !PrintSetup !Bool -> (!(!Int,!Int),!(!(!Int,!Int),!(!Int,!Int)),!(!Int,!Int))
+os_defaultprintsetup :: !*env -> (!PrintSetup, !*env)
+os_printsetupvalid :: !PrintSetup !*env -> (!Bool, !*env)
+
+class PrintEnvironments printEnv where
+ os_printpageperpage :: !Bool !Bool
+ !.x
+ .(.x -> .(PrintInfo -> .(*Picture -> *((.Bool,Point2),*(.state,*Picture)))))
+ (*(.state,*Picture) -> *((.Bool,Point2),*(.state,*Picture)))
+ !PrintSetup !*printEnv
+ -> (Alternative .x .state,!*printEnv)
+ os_printsetupdialog :: !PrintSetup !*printEnv
+ -> (!PrintSetup,!*printEnv)
+
+instance PrintEnvironments Files
+instance PrintEnvironments (PSt .l)
+
+os_printsetuptostring :: !PrintSetup -> String
+os_stringtoprintsetup :: !String -> PrintSetup
diff --git a/osprint.icl b/osprint.icl new file mode 100644 index 0000000..c56d54a --- /dev/null +++ b/osprint.icl @@ -0,0 +1,494 @@ +implementation module osprint
+
+import StdArray, StdBool, StdEnum, StdFile, StdFunc, StdInt, StdList, StdMisc, StdTuple
+import clCCall_12,clCrossCall_12, iostate, scheduler
+import ospicture, osevent, StdWindow, StdPSt
+import code from "cCrossCallPrinter_121.o",
+ "cprinter_121.o"
+
+:: PrintSetup
+ = { devmode :: !String
+ , device :: !String // device, driver & output strings are null terminated
+ , driver :: !String
+ , output :: !String
+ }
+:: JobInfo
+ = { range :: !(!Int,!Int)
+ , copies :: !Int
+ }
+:: PrintInfo
+ = { printSetup :: PrintSetup
+ , jobInfo :: JobInfo
+ }
+:: Alternative x y
+ = Cancelled x
+ | StartedPrinting y
+
+
+os_installprinter :: !*OSToolbox -> *OSToolbox
+os_installprinter _
+ = code
+ {
+ .inline InstallCrossCallPrinter
+ ccall InstallCrossCallPrinter "I-I"
+ .end
+ }
+
+
+os_getpagedimensions :: !PrintSetup !Bool -> (!(!Int,!Int), !(!(!Int,!Int),!(!Int,!Int)), !(!Int,!Int))
+os_getpagedimensions { devmode, device, driver } emulateScreenRes
+ = os_getpagedimensionsC devmode device driver emulateScreenRes
+
+os_defaultprintsetup :: !*env -> (!PrintSetup, !*env)
+os_defaultprintsetup env
+ # (dmSize,printerHandle,device,driver,output,env) = getDevmodeSizeC env
+ | dmSize==0
+ = ({devmode="\0", device="\0", driver="\0", output="\0"},env)
+ # devmode = createArray dmSize ' '
+ devmode = { devmode & [dec dmSize]='\0'}
+ env = getDefaultDevmodeC devmode printerHandle device env // alters contents of printSetup
+ = ({devmode=devmode, device=device, driver=driver, output=output}, env)
+
+printSetupDialogBoth :: !PrintSetup !(Maybe *Context) -> (!PrintSetup, !Maybe *Context)
+printSetupDialogBoth print_setup=:{devmode,device,driver,output} mb_context
+ # (os, mb_context) = EnvGetOS mb_context
+ # os = os_installprinter os
+ # (devmodePtr,os) = winMakeCString devmode os
+ # (devicePtr, os) = winMakeCString device os
+ # (driverPtr, os) = winMakeCString driver os
+ # (outputPtr, os) = winMakeCString output os
+ # (ok, pdPtr, mb_context, os) = CCPrintSetupDialog mb_context (size devmode) devmodePtr devicePtr driverPtr outputPtr os
+ # os = winReleaseCString devmodePtr os
+ # os = winReleaseCString devicePtr os
+ # os = winReleaseCString driverPtr os
+ # os = winReleaseCString outputPtr os
+ | ok==0
+ # os = release_memory_handles pdPtr os
+ = (print_setup, EnvSetOS os mb_context)
+ | otherwise
+ # ((ndevmode,ndevice,ndriver,noutput),os)
+ = get_printSetup_with_PRINTDLG pdPtr os
+ # os = release_memory_handles pdPtr os
+ = ({devmode=ndevmode,device=ndevice,driver=ndriver,output=noutput}, EnvSetOS os mb_context)
+
+os_printsetupvalid :: !PrintSetup !*env -> (!Bool, !*env)
+os_printsetupvalid {devmode,device,driver} env
+ = os_printsetupvalidC devmode device driver env
+
+os_printsetupvalidC :: !String !String !String!*env -> (!Bool, !*env)
+os_printsetupvalidC _ _ _ _
+ = code
+ {
+ ccall os_printsetupvalidC "SSS:I:A"
+ }
+
+class PrintEnvironments printEnv where
+ os_printpageperpage :: !Bool !Bool
+ !.x
+ .(.x -> .(PrintInfo -> .(*Picture -> *((.Bool,Point2),*(.state,*Picture)))))
+ (*(.state,*Picture) -> *((.Bool,Point2),*(.state,*Picture)))
+ !PrintSetup !*printEnv
+ -> (Alternative .x .state,!*printEnv)
+ os_printsetupdialog :: !PrintSetup !*printEnv
+ -> (!PrintSetup,!*printEnv)
+
+
+instance PrintEnvironments (PSt .l) where
+ os_printpageperpage doDialog emulateScreen x initFun transFun printSetup pSt=:{io}
+ #! (windowStack, io) = getWindowStack io
+ windowStackIds = map fst windowStack
+ (zippedWithSelectState, io) = seqList (map zipWithSelectState windowStackIds) io
+ activeWindowIds = [ id \\ (mbSelectState, id) <- zippedWithSelectState | isEnabled mbSelectState]
+ io = seq (map disableWindow activeWindowIds) io
+ (result, pSt) = accContext accFun { pSt & io=io }
+ pSt = appPIO (seq (map enableWindow activeWindowIds)) pSt
+ = (result, pSt)
+ where
+ accFun context
+ # (os, context) = EnvGetOS context
+ # os = os_installprinter os
+ # (x,mb_context,os) = printPagePerPageBothSemaphor
+ doDialog emulateScreen x initFun transFun printSetup (Just context) os
+ = (x,EnvSetOS os (fromJust mb_context))
+
+ zipWithSelectState :: Id (IOSt .l) -> (v:(Maybe SelectState,Id),IOSt .l)
+ zipWithSelectState id io
+ #! (mbSelectState, io) = getWindowSelectState id io
+ = ((mbSelectState, id), io)
+
+ isEnabled (Just Able) = True
+ isEnabled _ = False
+
+ os_printsetupdialog printSetup pSt
+ = accContext (accFun printSetup) pSt
+ where
+ accFun printSetup context
+ # (printSetup, Just context) = printSetupDialogBoth printSetup (Just context)
+ = (printSetup, context)
+
+
+
+instance PrintEnvironments Files where
+ os_printpageperpage doDialog emulateScreen x initFun transFun printSetup files
+ # (os, files) = EnvGetOS files
+ # os = os_installprinter os
+ # (x,_,os) = printPagePerPageBothSemaphor
+ doDialog emulateScreen x initFun transFun printSetup Nothing os
+ = (x, EnvSetOS os files)
+
+ os_printsetupdialog printSetup files
+ # (printSetup, _) = printSetupDialogBoth printSetup Nothing
+ = (printSetup, files) // oh lala
+
+
+printPagePerPageBothSemaphor :: !Bool !Bool .a
+ .(.a -> .(.PrintInfo -> .(*Picture -> *((Bool,Origin),*(.b,*Picture)))))
+ (*(.b,*Picture) -> *((Bool,Origin),*(.b,*Picture)))
+ !PrintSetup *(Maybe *Context) !*OSToolbox
+ -> *(*(Alternative .a .b),*(Maybe *Context),!*OSToolbox)
+printPagePerPageBothSemaphor p1 p2 x p4 p5 printSetup mb_context os
+// with this mechanism it is assured, that only one print job can happen at a time
+// addSemaphor adds the parameter to a C global and gives back the previous value of that
+// global
+ # (s,os) = addSemaphor 1 os
+ | s>0
+ # (_,os) = addSemaphor (-1) os
+ = (Cancelled x,mb_context,os)
+ # (result,mb_context,os) = printPagePerPageBoth p1 p2 x p4 p5 printSetup mb_context os
+ (_,os) = addSemaphor (-1) os
+ = (result,mb_context,os)
+
+printPagePerPageBoth :: !Bool !Bool .a
+ .(.a -> .(.PrintInfo -> .(*Picture -> *((Bool,Origin),*(.b,*Picture)))))
+ (*(.b,*Picture) -> *((Bool,Origin),*(.b,*Picture)))
+ PrintSetup *(Maybe *Context) !*OSToolbox
+ -> *(*(Alternative .a .b),*(Maybe *Context),!*OSToolbox)
+printPagePerPageBoth doDialog emulateScreen x initFun transFun printSetup mb_context os
+ // do the print dialog (or not) and get the hdc and the printInfo
+
+ # (err, hdc, printInfo, mb_context, os)
+ = getPrintInfo doDialog emulateScreen printSetup mb_context os
+
+ | err == 4107 // this error occurs, when the printsetup contains bad values
+ # (defaultPS, os) = os_defaultprintsetup os
+ = printPagePerPageBoth doDialog emulateScreen x initFun transFun defaultPS mb_context os
+
+ // check, whether the user canceled
+
+ | err >= 0 = (Cancelled x, mb_context, os)
+
+ // call StartDoc either via the OS thread or direct
+
+ # (err, mb_context, os) = CCstartDoc hdc mb_context os
+
+ | err <= 0 = (Cancelled x, mb_context, deleteDC hdc os)
+ // user canceled printing to file from file dialog
+
+ // initialise printer picture and call the initFun function
+
+ # picture = initPicture zeroOrigin (hdc,os)
+ (endOrig,(initState,picture)) = initFun x printInfo picture
+ (_,_,_,hdc,os) = unpackPicture picture
+
+ // now print all pages
+
+ # (finalState,hdc,mb_context,os)
+ = printPages 0 transFun endOrig initState hdc mb_context os
+
+ // Sluit af
+
+ (mb_context, os) = CCendDoc hdc mb_context os
+ = (StartedPrinting finalState, mb_context, (deleteDC hdc os))
+
+printPages :: Int
+ (*(.a,*Picture) -> *((Bool,Origin),* (.a,*Picture)))
+ (Bool,Origin) .a HDC *(Maybe *Context) !*OSToolbox
+ -> *(.a,HDC,*(Maybe *Context),!*OSToolbox)
+printPages _ _ (True,_) state hdc mb_context os
+ =(state,hdc,mb_context,os)
+printPages pageNr fun (_,origin) state hdc mb_context os
+
+ // give OS thread eventually a chance to handle events
+ # (mb_context,os) = evtlSwitchToOS pageNr hdc mb_context os
+
+ # (ok, os) = startPage hdc os
+ | ok == 0 = abort "\nPrint08: Failed in \"StartPage\". Probably not enough memory."
+ # picture = initPicture origin (hdc,os)
+ // apply drawfunctions contained in this page
+ ((endOfDoc,nextOrigin),(state`,picture)) = fun (state,picture)
+ // finish drawing
+ # (_,_,_,hdc,os) = unpackPicture picture
+ (ok, os) = endPage hdc os
+ // (not ok) should not cause an abort, because endPage returns an error, when user chooses
+ // "encapsulated postscript" as output format and the output is longer than one page.
+ // This situation can't be retrieved from the "GetLastError" code. An abort should not occur.
+ (canceled,os) = wasCanceled os
+ // draw rest of pages
+ = printPages (inc pageNr) fun (endOfDoc || canceled || (ok==0),nextOrigin) state` hdc mb_context os
+
+zeroOrigin :== zero
+
+///////////////////////////////////////////////////////////////////////////////
+
+getPrintInfo :: !.Bool !.Bool .PrintSetup *(Maybe *Context) !*OSToolbox
+ -> *(Int,Int,.PrintInfo,*Maybe *Context,!.OSToolbox);
+getPrintInfo doDialog emulateScreen {devmode, device, driver, output} mb_context os
+ # (devmodePtr,os) = winMakeCString devmode os
+ (devicePtr,os) = winMakeCString device os
+ (driverPtr,os) = winMakeCString driver os
+ (outputPtr,os) = winMakeCString output os
+ ( err, data, pdPtr, mb_context, os)
+ = CCgetDC (if doDialog 1 0) (if emulateScreen 2 0) // these two bits will be packed into one word in CCgetDC
+ (size devmode) devmodePtr devicePtr driverPtr outputPtr mb_context os
+ os = winReleaseCString devmodePtr os
+ os = winReleaseCString devicePtr os
+ os = winReleaseCString driverPtr os
+ os = winReleaseCString outputPtr os
+ | doDialog && (err==(-1))
+ # (setup_strings, os) = get_printSetup_with_PRINTDLG pdPtr os
+ os = release_memory_handles pdPtr os
+ = continuation err data mb_context (setup_strings, os)
+ = continuation err data mb_context ((devmode,device,driver,output),os)
+ where
+ continuation err (first,last,copies,hdc) mb_context ((devmode,device,driver,output),os)
+ # first` = max 1 first
+ last` = max first` last
+ copies` = max 1 copies
+ = ( err,
+ hdc,
+ { printSetup = { devmode=devmode, device=device ,driver=driver, output=output },
+ jobInfo = { range = (first`,last`),
+ copies = copies`
+ }
+ },
+ mb_context,
+ os
+ )
+
+handleContextOSEvent` :: !OSEvent !Context !*OSToolbox -> (!CrossCallInfo,!Context,!*OSToolbox)
+handleContextOSEvent` osEvent context tb
+ # (return,context) = handleContextOSEvent osEvent context
+ = (setReplyInOSEvent return,context,tb)
+
+
+CCgetDC :: !.Int !.Int !.Int !.Int !.Int !.Int !.Int !*(Maybe *Context) !*OSToolbox -> *(!Int,!(!Int,!Int,!Int,!Int),!Int,!*Maybe *Context,!.OSToolbox);
+CCgetDC doDialog emulateScreen devmodeSize devmodePtr devicePtr driverPtr outputPtr Nothing os
+ # (ok,first,last,copies,pdPtr,deviceContext,os)
+ = getDC doDialog emulateScreen 1 devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+ = (ok,(first,last,copies,deviceContext),pdPtr,Nothing,os)
+CCgetDC doDialog emulateScreen devmodeSize devmodePtr devicePtr driverPtr outputPtr (Just context) os
+ # createcci = Rq6Cci CcRqGET_PRINTER_DC (doDialog bitor emulateScreen) devmodeSize
+ devmodePtr devicePtr driverPtr outputPtr
+ # (rcci, context, os) = issueCleanRequest handleContextOSEvent` createcci context os
+ = ( rcci.p1, (rcci.p2, rcci.p3, rcci.p4,rcci.p6), rcci.p5,
+////////err, (first, last, copies, deviceContext),pdPtr,
+ Just context,os
+ )
+
+CCPrintSetupDialog :: !(Maybe *Context) !.Int !.Int !.Int !.Int !.Int !*OSToolbox -> (!OkReturn,!Int,!Maybe *Context, !.OSToolbox);
+CCPrintSetupDialog nothing=:Nothing devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+ # (ok, pdPtr, os) = printSetup 1 devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+ = (ok, pdPtr, nothing, os)
+CCPrintSetupDialog (Just context) devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+ # createcci = Rq5Cci CcRqDO_PRINT_SETUP devmodeSize devmodePtr devicePtr driverPtr outputPtr
+ (rcci, context, os) = issueCleanRequest handleContextOSEvent` createcci context os
+ = (rcci.p1, rcci.p2, Just context, os)
+/* MW was
+CCPrintSetupDialog :: !.Bool .Int .Int .Int .Int .Int !*OSToolbox -> (OkReturn,Int,!.OSToolbox);
+CCPrintSetupDialog True devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+ = printSetup 1 devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+CCPrintSetupDialog False devmodeSize devmodePtr devicePtr driverPtr outputPtr os
+ # createcci = Rq5Cci CcRqDO_PRINT_SETUP devmodeSize devmodePtr devicePtr driverPtr outputPtr
+ (rcci, os) = issueCleanRequest2 (ErrorCallback2 "ERROR in osPrint08") createcci os
+ (rcci, os) = issueCleanRequest2 handleContextOSEvent` createcci os
+ = (rcci.p1, rcci.p2, os)
+*/
+
+CCstartDoc :: !.HDC !*(Maybe *Context) !*OSToolbox -> *(!Int,!*Maybe *Context,!*OSToolbox)
+// error code: -1:no error, 0: user canceled file dialog, others: other error
+CCstartDoc hdc Nothing os
+ # (err,os) = startDoc hdc os
+ = (err,Nothing,os)
+CCstartDoc hdc (Just context) os
+ # createcci = Rq1Cci CcRqSTARTDOC hdc
+ (rcci,context, os) = issueCleanRequest handleContextOSEvent` createcci context os
+ = (rcci.p1, Just context, os)
+
+CCendDoc :: !.HDC !*(Maybe *Context) !*OSToolbox -> *(!*Maybe *Context,!*OSToolbox)
+CCendDoc hdc Nothing os
+ # os = endDoc hdc os
+ = (Nothing,os)
+CCendDoc hdc (Just context) os
+ # createcci = Rq1Cci CcRqENDDOC hdc
+ (_,context, os) = issueCleanRequest handleContextOSEvent` createcci context os
+ = (Just context,os)
+
+evtlSwitchToOS :: !Int !.Int !*(Maybe *Context) !*OSToolbox -> *(!*Maybe *Context,!.OSToolbox)
+evtlSwitchToOS _ _ Nothing os
+ = (Nothing,os)
+evtlSwitchToOS pageNr hdc (Just context) os
+ # nrStr = toString pageNr
+ # messageText = if (pageNr==0) ""
+ (nrStr+++" page"+++(if (pageNr==1) "" "s")+++" printed")
+ # (textPtr,os) = winMakeCString messageText os
+ # createcci = Rq1Cci CcRqDISPATCH_MESSAGES_WHILE_PRINTING textPtr
+ # (_,context, os) = issueCleanRequest handleContextOSEvent` createcci context os
+ # os = winReleaseCString textPtr os
+ = (Just context, os)
+
+initPicture :: !.Origin !*(!.OSPictContext,!*OSToolbox) -> *Picture
+initPicture origin intPict
+ = packPicture origin defaultPen False (fst intPict) (snd intPict)
+
+
+EnvGetOS :: !*env -> (!*OSToolbox,!*env)
+EnvGetOS env
+ = (42,env)
+
+EnvSetOS :: !*OSToolbox !*env -> *env
+EnvSetOS os env
+ = env
+
+
+//////////////////////////////////////////////////
+// //
+// C CALLING FUNCTIONS //
+// //
+//////////////////////////////////////////////////
+
+:: OkReturn :== Int // okReturn<>0 <=> ok !
+
+os_getpagedimensionsC :: !String !String !String !Bool
+ -> (!(!Int,!Int), !(!(!Int,!Int),!(!Int,!Int)), !(!Int,!Int))
+os_getpagedimensionsC _ _ _ _
+ = code
+ {
+ ccall os_getpagedimensionsC "SSSI-IIIIIIII"
+ }
+
+getDevmodeSizeC :: !*env -> (!Int,!Int,!String,!String,!String,!*env)
+getDevmodeSizeC _
+ = code
+ {
+ ccall getDevmodeSizeC ":VIISSS:A"
+ }
+
+getDefaultDevmodeC :: !String !Int !String !*env -> *env
+getDefaultDevmodeC _ _ _ _
+ = code
+ {
+ ccall getDefaultDevmodeC "SIS:V:A"
+ }
+
+printSetup :: !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!OkReturn,!Int,!*OSToolbox)
+printSetup _ _ _ _ _ _ _
+ = code
+ {
+ ccall printSetup "IIIIII:VII:I"
+ }
+
+get_printSetup_with_PRINTDLG :: !Int !*OSToolbox -> (!(!String, !String, !String, !String), !*OSToolbox)
+get_printSetup_with_PRINTDLG _ _
+ = code
+ {
+ ccall get_printSetup_with_PRINTDLG "I:VSSSS:I"
+ }
+
+release_memory_handles :: !Int !*OSToolbox -> *OSToolbox
+release_memory_handles _ _
+ = code
+ {
+ ccall release_memory_handles "II-I"
+ }
+
+startPage :: !HDC !*OSToolbox -> (!OkReturn, !*OSToolbox)
+startPage _ _
+ = code
+ {
+ ccall startPage "I:I:I"
+ }
+
+endPage :: !HDC !*OSToolbox -> (!OkReturn, !*OSToolbox)
+endPage _ _
+ = code
+ {
+ ccall endPage "I:I:I"
+ }
+
+startDoc :: !HDC !*OSToolbox -> (!Int, !*OSToolbox)
+ // err code: >0:no error, <=0: user cancelled file dialog
+startDoc _ _
+ = code
+ {
+ ccall startDoc "I:I:I"
+ }
+
+endDoc :: !HDC !*OSToolbox -> *OSToolbox
+endDoc _ _
+ = code
+ {
+ ccall endDoc "I:V:I"
+ }
+
+wasCanceled :: !*OSToolbox -> (!Bool,!*OSToolbox)
+wasCanceled _
+ = code
+ {
+ ccall wasCanceled ":I:I"
+ }
+
+deleteDC :: !HDC !*OSToolbox -> *OSToolbox
+deleteDC _ _
+ = code
+ {
+ ccall deleteDC "I:V:I"
+ }
+
+
+getDC :: !Int !Int !Int !Int !Int !Int !Int !Int !*OSToolbox -> (!Int, !Int, !Int, !Int, !Int, !Int, !*OSToolbox)
+// getDC doDialog emulateScreen "getDC called directly from CleanThread" devmodeSize
+// first element of result is an error code:
+// -1:no error, others: non fatal error
+getDC _ _ _ _ _ _ _ _ _
+ = code
+ {
+ ccall getDC "IIIIIIII:VIIIIII:I"
+ }
+
+addSemaphor :: !Int !*OSToolbox -> (!Int,!*OSToolbox)
+addSemaphor _ _
+ = code
+ {
+ ccall addSemaphor "I:I:I"
+ }
+
+os_printsetuptostring :: !PrintSetup -> String
+os_printsetuptostring {devmode, device, driver, output}
+ = toString (size devmode)+++" "+++toString (size device)+++" "+++toString (size driver)+++" "
+ +++devmode+++device+++driver+++output
+
+os_stringtoprintsetup :: !String -> PrintSetup
+os_stringtoprintsetup string
+ #! chList = [ch \\ ch<-:string]
+ (sizeChLists, rest) = seqList (repeatn 3 (splitInt [])) chList
+ sizes = map (toInt o toString) sizeChLists
+ (devmodeSize, deviceSize, driverSize) = listTo3Tuple sizes
+ devmode = toString (rest % (0, devmodeSize-1))
+ driverStartIndex = devmodeSize+deviceSize
+ device = toString (rest % (devmodeSize, driverStartIndex-1))
+ outputStartIndex = driverStartIndex+driverSize
+ driver = toString (rest % (driverStartIndex, outputStartIndex-1))
+ output = toString (rest % (outputStartIndex, (size string)-1))
+ | size devmode==devmodeSize && size device==deviceSize
+ && size driver==driverSize && size output==(length rest)-outputStartIndex
+ && devmodeSize>0 && deviceSize>0 && driverSize>0 && size output>0
+ = {devmode=devmode, device=device, driver=driver, output=output}
+ = {devmode="\0", device="\0", driver="\0", output="\0"}
+ where
+ splitInt akku []
+ = (reverse akku, [])
+ splitInt akku [ch:chs]
+ | isDigit ch
+ = splitInt [ch:akku] chs
+ = (reverse akku, chs)
+ listTo3Tuple [e1,e2,e3] = (e1,e2,e3)
diff --git a/osrgn.dcl b/osrgn.dcl new file mode 100644 index 0000000..a80df18 --- /dev/null +++ b/osrgn.dcl @@ -0,0 +1,34 @@ +definition module osrgn
+
+// Clean Object I/O library, version 1.2
+
+import ostoolbox, ostypes
+
+:: OSRgnHandle
+ :== Int
+
+// Region creation and disposal operations.
+osnewrgn :: !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osnewrectrgn:: !OSRect !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osdisposergn:: !OSRgnHandle !*OSToolbox -> *OSToolbox
+
+// Setting the shape of a region to a rectangle or a polygon.
+/* PA: used nowhere.
+osrectrgn :: !OSRect !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+*/
+ospolyrgn :: !(!Int,!Int) ![(Int,Int)] !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+
+/* Combining the shapes of the two argument regions into a new region.
+ The argument regions are not changed.
+*/
+ossectrgn :: !OSRgnHandle !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osunionrgn :: !OSRgnHandle !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osdiffrgn :: !OSRgnHandle !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+
+/* Region property access functions.
+ osgetrgnbox retrieves the bounding box of the region. The Bool is True iff
+ the bounding box equals the region.
+ osisemptyrgn determines whether the region is empty (its bounding box is empty).
+*/
+osgetrgnbox :: !OSRgnHandle !*OSToolbox -> (!Bool,!OSRect,!*OSToolbox)
+osisemptyrgn:: !OSRgnHandle !*OSToolbox -> (!Bool, !*OSToolbox)
diff --git a/osrgn.icl b/osrgn.icl new file mode 100644 index 0000000..9af1a24 --- /dev/null +++ b/osrgn.icl @@ -0,0 +1,85 @@ +implementation module osrgn
+
+import StdBool, StdInt, StdList
+from ostypes import :: OSRect{..}
+import pictCCall_12, rgnCCall_12
+
+:: OSRgnHandle
+ :== Int
+:: OSPointH
+ :== Int
+
+// Region creation and disposal operations.
+osnewrgn :: !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osnewrgn tb
+ = winCreateRectRgn 0 0 1 1 tb
+
+osnewrectrgn :: !OSRect !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osnewrectrgn {rleft,rtop,rright,rbottom} tb
+ = winCreateRectRgn rleft rtop rright rbottom tb
+
+osdisposergn :: !OSRgnHandle !*OSToolbox -> *OSToolbox
+osdisposergn osrgn tb
+ = winDeleteObject osrgn tb
+
+
+// Setting the shape of a Region.
+osrectrgn :: !OSRect !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osrectrgn {rleft,rtop,rright,rbottom} osrgn tb
+ = winSetRgnToRect rleft rtop rright rbottom osrgn tb
+
+ospolyrgn :: !(!Int,!Int) ![(Int,Int)] !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+ospolyrgn base shape osrgn tb
+ # (osrgn,tb) = winCombineRgn osrgn osrgn osrgn RGN_DIFF tb
+ | len==0
+ = (osrgn,tb)
+ | otherwise
+ # (shapeH,tb) = winAllocPolyShape len tb
+ # tb = setpolyshape shapeH 0 base shape tb
+ # (prgn,tb) = winCreatePolygonRgn shapeH len WINDING tb
+ # (osrgn,tb) = winCombineRgn osrgn prgn prgn RGN_COPY tb
+ # tb = winDeleteObject prgn tb
+ # tb = winFreePolyShape shapeH tb
+ = (osrgn,tb)
+where
+ len = length shape
+
+ setpolyshape :: !OSPointH !Int !(!Int,!Int) ![(Int,Int)] !*OSToolbox -> *OSToolbox
+ setpolyshape shapeH i (x,y) [(vx,vy):vs] tb
+ # tb = winSetPolyPoint i x y shapeH tb
+ # tb = setpolyshape shapeH (i+1) (x+vx,y+vy) vs tb
+ = tb
+ setpolyshape _ _ _ _ tb
+ = tb
+
+
+// Combining the shapes of two Regions into a new Region.
+ossectrgn :: !OSRgnHandle !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+ossectrgn rgn1 rgn2 tb
+ # (rrgn,tb) = winCreateRectRgn 0 0 1 1 tb
+ # (rrgn,tb) = winCombineRgn rrgn rgn1 rgn2 RGN_AND tb
+ = (rrgn,tb)
+
+osunionrgn :: !OSRgnHandle !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osunionrgn rgn1 rgn2 tb
+ # (rrgn,tb) = winCreateRectRgn 0 0 1 1 tb
+ # (rrgn,tb) = winCombineRgn rrgn rgn1 rgn2 RGN_OR tb
+ = (rrgn,tb)
+
+osdiffrgn :: !OSRgnHandle !OSRgnHandle !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osdiffrgn rgn1 rgn2 tb
+ # (rrgn,tb) = winCreateRectRgn 0 0 1 1 tb
+ # (rrgn,tb) = winCombineRgn rrgn rgn1 rgn2 RGN_DIFF tb
+ = (rrgn,tb)
+
+
+// Region property access functions.
+osgetrgnbox :: !OSRgnHandle !*OSToolbox -> (!Bool,!OSRect,!*OSToolbox)
+osgetrgnbox rgn tb
+ # (l,t, r,b, isRect,_,tb) = winGetRgnBox rgn tb
+ = (isRect,{rleft=l,rtop=t,rright=r,rbottom=b}, tb)
+
+osisemptyrgn:: !OSRgnHandle !*OSToolbox -> (!Bool,!*OSToolbox)
+osisemptyrgn rgn tb
+ # (_,_,_,_,_,isempty,tb) = winGetRgnBox rgn tb
+ = (isempty,tb)
diff --git a/ossystem.dcl b/ossystem.dcl new file mode 100644 index 0000000..0a4b188 --- /dev/null +++ b/ossystem.dcl @@ -0,0 +1,45 @@ +definition module ossystem
+
+// Clean Object I/O library, version 1.2
+
+import StdString
+import StdMaybe
+import osdocumentinterface, ostypes
+
+:: OSWindowMetrics
+ = { osmFont :: !Font // The internal Font used in Windows for controls
+ , osmFontMetrics :: !(!Int,!Int,!Int) // The ascent, descent, leading of osmFont
+ , osmHeight :: !Int // The height of the internal Font
+ , osmHorMargin :: !Int // The default horizontal margin
+ , osmVerMargin :: !Int // The default vertical margin
+ , osmHorItemSpace :: !Int // The default horizontal item space
+ , osmVerItemSpace :: !Int // The default vertical item space
+ , osmHSliderHeight :: !Int // The default height of a horizontal slider control
+ , osmVSliderWidth :: !Int // The default width of a vertical slider control
+ }
+
+OSdirseparator :== '/'
+
+osHomepath :: !String -> String
+osApplicationpath :: !String -> String
+OSnewlineChars :== "\xA"
+
+OStickspersecond :== 1000
+
+osMMtoHPixels :: !Real -> Int
+osMMtoVPixels :: !Real -> Int
+osMaxScrollWindowSize :: (!Int,!Int)
+osMaxFixedWindowSize :: (!Int,!Int)
+osScreenrect :: !*OSToolbox -> (!OSRect,!*OSToolbox)
+
+osPrintSetupTypical :: Bool
+
+// osGetProcessWindowDimensions returns OSRect of process window in terms of screen coordinates
+osGetProcessWindowDimensions :: !OSDInfo !*OSToolbox -> (!OSRect,!*OSToolbox)
+
+osDefaultWindowMetrics :: !*OSToolbox -> (!OSWindowMetrics,!*OSToolbox)
+
+/* osStripOuterSize isMDI isResizable
+ returns (dw,dh) required to add/subtract to view/outer size in order to obtain outer/view size.
+*/
+osStripOuterSize :: !Bool !Bool !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
diff --git a/ossystem.icl b/ossystem.icl new file mode 100644 index 0000000..8736fff --- /dev/null +++ b/ossystem.icl @@ -0,0 +1,106 @@ +implementation module ossystem
+
+import StdBool, StdInt, StdReal, StdString
+import StdMaybe
+import clCCall_12, clCrossCall_12, windowCrossCall_12
+import osdocumentinterface, osfont
+from ostypes import :: OSRect{..}
+
+
+:: OSWindowMetrics
+ = { osmFont :: !Font // The internal Font used in Windows for controls
+ , osmFontMetrics :: !(!Int,!Int,!Int) // The ascent, descent, leading of osmFont
+ , osmHeight :: !Int // The height of the internal Font
+ , osmHorMargin :: !Int // The default horizontal margin
+ , osmVerMargin :: !Int // The default vertical margin
+ , osmHorItemSpace :: !Int // The default horizontal item space
+ , osmVerItemSpace :: !Int // The default vertical item space
+ , osmHSliderHeight :: !Int // The default height of a horizontal slider control
+ , osmVSliderWidth :: !Int // The default width of a vertical slider control
+ }
+
+OSdirseparator :== '/' // OS separator between folder- and filenames in a pathname
+
+osHomepath :: !String -> String
+osHomepath fname = theApplicationPath +++ fname
+
+osApplicationpath :: !String -> String
+osApplicationpath fname = theApplicationPath +++ fname
+
+theApplicationPath =: path
+where
+ ptr = winGetAppPath
+ (path,_)= winGetCStringAndFree ptr 99
+
+OSnewlineChars :== "\xA" // MW11++
+
+OStickspersecond :== 1000 // OS max resolution of ticks per second
+
+osMMtoHPixels :: !Real -> Int
+osMMtoHPixels mm = toInt ( (mm/25.4) * toReal winGetHorzResolution )
+
+osMMtoVPixels :: !Real -> Int
+osMMtoVPixels mm = toInt ( (mm/25.4) * toReal winGetVertResolution )
+
+osMaxScrollWindowSize :: (!Int,!Int)
+osMaxScrollWindowSize = winMaxScrollWindowSize
+
+osMaxFixedWindowSize :: (!Int,!Int)
+osMaxFixedWindowSize = winMaxFixedWindowSize
+
+osScreenrect :: !*OSToolbox -> (!OSRect,!*OSToolbox)
+osScreenrect tb
+ # (screenWidth, tb) = winScreenXSize tb
+ # (screenHeight,tb) = winScreenYSize tb
+ = ({rleft=0,rtop=0,rright=screenWidth,rbottom=screenHeight},tb)
+
+osPrintSetupTypical :: Bool // MW11++
+osPrintSetupTypical = False
+
+osGetProcessWindowDimensions :: !OSDInfo !*OSToolbox -> (!OSRect,!*OSToolbox)
+osGetProcessWindowDimensions osdinfo tb
+ # maybeOSInfo = getOSDInfoOSInfo osdinfo
+ | isNothing maybeOSInfo
+ = osScreenrect tb
+ | otherwise
+ # osinfo = fromJust maybeOSInfo
+ # ((x,y),tb) = winGetWindowPos osinfo.osFrame tb
+ # ((w,h),tb) = winGetClientSize osinfo.osClient tb
+ = ({rleft=x,rtop=y,rright=x+w,rbottom=y+h},tb)
+
+osDefaultWindowMetrics :: !*OSToolbox -> (!OSWindowMetrics,!*OSToolbox)
+osDefaultWindowMetrics tb
+ # (font,tb) = osDialogfont tb
+ # ((ascent,descent,leading,_),tb) = osGetfontmetrics False 0 font tb
+ height = ascent+descent+leading
+ unit = (toReal height)/8.0
+ margin = toInt (unit*7.0)
+ itemspace = toInt (unit*4.0)
+ # (scrollWidth,scrollHeight,tb) = winScrollbarSize tb
+ = ( { osmFont = font
+ , osmFontMetrics = (ascent,descent,leading)
+ , osmHeight = height
+ , osmHorMargin = margin
+ , osmVerMargin = margin
+ , osmHorItemSpace = itemspace
+ , osmVerItemSpace = itemspace
+ , osmHSliderHeight = scrollHeight
+ , osmVSliderWidth = scrollWidth
+ }
+ , tb
+ )
+
+/* osStripOuterSize isMDI isResizable (width,height)
+ returns (dw,dh) required to add/subtract to view size/outer size in order to obtain
+ outer size/view size.
+*/
+osStripOuterSize :: !Bool !Bool !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osStripOuterSize isMDI isResizable tb
+ | isMDI
+ # (dw,dh,tb) = winMDIClientToOuterSizeDims styleFlags tb
+ = ((dw,dh),tb)
+ | otherwise
+ # (dw,dh,tb) = winSDIClientToOuterSizeDims styleFlags tb
+ = ((dw,dh),tb)
+where
+ styleFlags = if isResizable WS_THICKFRAME 0
diff --git a/ostick.dcl b/ostick.dcl new file mode 100644 index 0000000..e5d03dd --- /dev/null +++ b/ostick.dcl @@ -0,0 +1,10 @@ +definition module ostick
+
+// to be placed in something bigger later
+
+:: Tick
+
+pack_tick :: !Int -> Tick
+unpack_tick :: !Tick -> Int
+
+os_getcurrenttick :: !*World -> (!Tick, !*World)
diff --git a/ostick.icl b/ostick.icl new file mode 100644 index 0000000..563fb2c --- /dev/null +++ b/ostick.icl @@ -0,0 +1,25 @@ +implementation module ostick
+
+import StdEnv
+import ostoolbox
+
+:: Tick :== Int
+
+pack_tick :: !Int -> Tick
+pack_tick i = i
+
+unpack_tick :: !Tick -> Int
+unpack_tick tick = tick
+
+os_getcurrenttick :: !*World -> (!Tick, !*World)
+os_getcurrenttick world
+ = (fst (winGetTickCount 42), world)
+
+winGetTickCount :: !*OSToolbox -> (!Int, !*OSToolbox)
+winGetTickCount _
+ = code
+ {
+ .inline WinGetTickCount
+ ccall WinGetTickCount "I-II"
+ .end
+ }
diff --git a/ostime.dcl b/ostime.dcl new file mode 100644 index 0000000..1c36a8d --- /dev/null +++ b/ostime.dcl @@ -0,0 +1,30 @@ +definition module ostime
+
+// Clean Object I/O library, version 1.2
+
+import StdOverloaded
+import ostoolbox
+
+:: OSTime
+
+osMaxTime :: OSTime
+
+osGetTime :: !*OSToolbox -> (!OSTime,!*OSToolbox)
+// osGetTime returns the current OS time
+
+osWait :: !Int .x !*OSToolbox -> (.x, !*OSToolbox)
+// osWait waits atleast the given time (in milliseconds).
+
+osGetBlinkInterval :: !*OSToolbox -> (!Int, !*OSToolbox)
+// osGetBlinkInterval returns the recommended blink interval time of a cursor (in milliseconds).
+
+osGetCurrentTime :: !*OSToolbox -> (!(!Int,!Int,!Int),!*OSToolbox)
+// osGetCurrentTime returns current (hours,minutes,seconds).
+
+osGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
+// osGetCurrentTime returns current (year,month,day,day_of_week).
+
+instance - OSTime // Calculate difference between arg 1 and arg 2
+instance < OSTime // True iff arg 1 < arg 2
+instance toInt OSTime // Coerce OSTime to Integer (always positive or zero)
+instance fromInt OSTime // Coerce Int to OSTime (Integer will be made zero if negative)
diff --git a/ostime.icl b/ostime.icl new file mode 100644 index 0000000..560f159 --- /dev/null +++ b/ostime.icl @@ -0,0 +1,100 @@ +implementation module ostime
+
+import StdBool, StdClass, StdInt, StdOverloaded
+import ostoolbox
+
+:: OSTime
+ = OSTime !Int
+
+OSMaxTickCount :== 2^31-1
+
+osMaxTime :: OSTime
+osMaxTime = OSTime OSMaxTickCount
+
+osGetTime :: !*OSToolbox -> (!OSTime,!*OSToolbox)
+osGetTime tb
+ # (tickcount,tb) = getMessageTime tb
+ = (OSTime tickcount,tb)
+where
+ getMessageTime :: !*OSToolbox -> (!Int,!*OSToolbox)
+ getMessageTime tb = winGetTickCount tb
+
+osWait :: !Int .x !*OSToolbox -> (.x,!*OSToolbox)
+osWait delay x tb
+ = (x,winWait delay tb)
+
+osGetBlinkInterval :: !*OSToolbox -> (!Int,!*OSToolbox)
+osGetBlinkInterval tb
+ = winGetBlinkTime tb
+
+osGetCurrentTime :: !*OSToolbox -> (!(!Int,!Int,!Int),!*OSToolbox)
+osGetCurrentTime tb
+ = winGetTime tb
+
+osGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
+osGetCurrentDate tb
+ = winGetDate tb
+
+instance - OSTime where
+ (-) :: !OSTime !OSTime -> OSTime
+ (-) (OSTime new) (OSTime old)
+ | old<=new = OSTime (new-old)
+ | otherwise = OSTime (OSMaxTickCount-old+new)
+
+instance < OSTime where
+ (<) :: !OSTime !OSTime -> Bool
+ (<) (OSTime t1) (OSTime t2) = t1<t2
+
+instance toInt OSTime where
+ toInt :: !OSTime -> Int
+ toInt (OSTime t) = t
+
+instance fromInt OSTime where
+ fromInt :: !Int -> OSTime
+ fromInt t = OSTime (max 0 t)
+
+
+winGetTime :: !*OSToolbox -> (!(!Int,!Int,!Int),!*OSToolbox)
+winGetTime tb
+ = code
+ {
+ .inline WinGetTime
+ ccall WinGetTime "I-IIII"
+ .end
+ }
+
+winGetDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
+winGetDate tb
+ = code
+ {
+ .inline WinGetDate
+ ccall WinGetDate "I-IIIII"
+ .end
+ }
+
+winWait :: !Int !*OSToolbox -> *OSToolbox
+winWait i tb
+ = code
+ {
+ .inline WinWait
+ ccall WinWait "II-I"
+ .end
+ }
+
+winGetBlinkTime :: !*OSToolbox -> (!Int,!*OSToolbox)
+winGetBlinkTime tb
+ = code
+ {
+ .inline WinGetBlinkTime
+ ccall WinGetBlinkTime "I-II"
+ .end
+ }
+
+winGetTickCount :: !*OSToolbox -> (!Int, !*OSToolbox)
+winGetTickCount _
+ = code
+ {
+ .inline WinGetTickCount
+ ccall WinGetTickCount "I-II"
+ .end
+ }
diff --git a/ostoolbar.dcl b/ostoolbar.dcl new file mode 100644 index 0000000..ba46a84 --- /dev/null +++ b/ostoolbar.dcl @@ -0,0 +1,29 @@ +definition module ostoolbar
+
+// Clean object I/O library, version 1.2
+
+// Operations to add and remove tools.
+
+import osbitmap, ostoolbox, ostypes
+
+:: OSToolbar
+ = { toolbarPtr :: !OSToolbarHandle // The toolbar of the frame window (zero if no toolbar)
+ , toolbarHeight :: !Int // The height of the toolbar (zero if no toolbar)
+ }
+:: OSToolbarHandle
+ :== OSWindowPtr
+
+OSdefaultToolbarHeight :== 16 // The default height of the toolbar
+
+/* osCreateToolbar forMDI wPtr (width,height)
+ creates a toolbar in the argument window that contains buttons of the given width and height.
+ The forMDI is True in case the toolbar must be created for a MDI process, and False otherwise.
+ The return Int is the actual height of the toolbar.
+ osCreateBitmapToolbarItem toolbarPtr bitmap index
+ adds a button with the given bitmap to the toolbar. The index must be the button item number.
+ osCreateToolbarSeparator toolbarPtr
+ adds a separator to the toolbar.
+*/
+osCreateToolbar :: !Bool !OSWindowPtr !(!Int,!Int) !*OSToolbox -> (!(!OSToolbarHandle,!Int),!*OSToolbox)
+osCreateBitmapToolbarItem :: !OSToolbarHandle !OSBitmap !Int !*OSToolbox -> *OSToolbox
+osCreateToolbarSeparator :: !OSToolbarHandle !*OSToolbox -> *OSToolbox
diff --git a/ostoolbar.icl b/ostoolbar.icl new file mode 100644 index 0000000..0c2f953 --- /dev/null +++ b/ostoolbar.icl @@ -0,0 +1,40 @@ +implementation module ostoolbar
+
+import StdMisc, StdTuple
+from osbitmap import :: OSBitmap, osGetBitmapHandle
+from ostypes import :: HWND, :: OSWindowPtr, OSNoWindowPtr
+from pictCCall_12 import winCreateBitmap
+import clCrossCall_12, windowCCall_12
+
+
+:: OSToolbar
+ = { toolbarPtr :: !OSToolbarHandle // The toolbar of the frame window (zero if no toolbar)
+ , toolbarHeight :: !Int // The height of the toolbar (zero if no toolbar)
+ }
+:: OSToolbarHandle
+ :== OSWindowPtr
+
+OSdefaultToolbarHeight :== 16 // The default height of the toolbar
+
+/* osCreateToolbar wPtr height
+ creates a toolbar in the argument window with the given size of the bitmap images.
+ The return Int is the actual height of the toolbar.
+*/
+osCreateToolbar :: !Bool !OSWindowPtr !(!Int,!Int) !*OSToolbox -> (!(!OSToolbarHandle,!Int),!*OSToolbox)
+osCreateToolbar forMDI hwnd (w,h) tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "osCreateToolbar") (Rq3Cci (if forMDI CcRqCREATEMDITOOLBAR CcRqCREATESDITOOLBAR) hwnd w h) tb
+ tbPtr_Height = case rcci.ccMsg of
+ CcRETURN2 -> (rcci.p1,rcci.p2)
+ CcWASQUIT -> (OSNoWindowPtr,0)
+ other -> abort "[osCreateToolbar] expected CcRETURN1 value."
+ = (tbPtr_Height,tb)
+
+osCreateBitmapToolbarItem :: !OSToolbarHandle !OSBitmap !Int !*OSToolbox -> *OSToolbox
+osCreateBitmapToolbarItem tbPtr osBitmap index tb
+ = snd (issueCleanRequest2 (errorCallback2 "osCreateBitmapToolbarItem") (Rq3Cci CcRqCREATETOOLBARITEM tbPtr hbmp index) tb)
+where
+ hbmp = osGetBitmapHandle osBitmap
+
+osCreateToolbarSeparator :: !OSToolbarHandle !*OSToolbox -> *OSToolbox
+osCreateToolbarSeparator tbPtr tb
+ = snd (issueCleanRequest2 (errorCallback2 "osCreateToolbarSeparator") (Rq1Cci CcRqCREATETOOLBARSEPARATOR tbPtr) tb)
diff --git a/ostoolbox.dcl b/ostoolbox.dcl new file mode 100644 index 0000000..2e4a824 --- /dev/null +++ b/ostoolbox.dcl @@ -0,0 +1,20 @@ +definition module ostoolbox
+
+// Clean Object I/O library, version 1.2
+
+:: OSToolbox
+ :== Int
+
+// OSNewToolbox :: *OSToolbox
+OSNewToolbox :== 0
+
+// RWS ??? add success bool
+osInitToolbox :: !*OSToolbox -> *OSToolbox
+
+// RWS ??? ugly
+// OSDummyToolbox :: *OSToolbox
+OSDummyToolbox :== 0
+
+// PA: moved from world to ostoolbox
+worldGetToolbox :: !*World -> (!*OSToolbox,!*World)
+worldSetToolbox :: !*OSToolbox !*World -> *World
diff --git a/ostoolbox.icl b/ostoolbox.icl new file mode 100644 index 0000000..fbbd8e0 --- /dev/null +++ b/ostoolbox.icl @@ -0,0 +1,63 @@ +implementation module ostoolbox
+
+import StdBool, StdClass, StdInt, StdMisc, StdTuple
+import clCrossCall_12
+import code from "cCrossCallFont_121.o"// PA: moved to ostcp, "cCrossCallTCP_121.obj", "cTCP_121.obj"
+
+
+:: OSToolbox
+ :== Int
+
+// OSNewToolbox :: *OSToolbox
+OSNewToolbox :== 0
+
+// RWS ??? add success bool
+osInitToolbox :: !*OSToolbox -> *OSToolbox // PA: strictness added
+osInitToolbox toolbox
+ | toolbox<>0
+ = abort "osInitToolbox reinitialised\n"
+ # (ok,toolbox) = winInitOs
+ | not ok
+ = toolbox // PA: don't abort, otherwise you can't do startIO twice.
+ // = abort "osInitToolbox failed\n"
+ | otherwise
+ # toolbox = winStartOsThread toolbox // PA: WinStartOsThread added
+ # toolbox = osInstallFont toolbox // Install font info cross call handling
+ // # toolbox = osInstallTCP toolbox // Install tcp cross call handling (PA: moved to StdEventTCP)
+ = toolbox
+
+osInstallFont :: !*OSToolbox -> *OSToolbox
+osInstallFont _
+ = code
+ {
+ .inline InstallCrossCallFont
+ ccall InstallCrossCallFont "I-I"
+ .end
+ }
+/* PA: moved to ostcp
+osInstallTCP :: !*OSToolbox -> *OSToolbox
+osInstallTCP tb
+ = snd (IssueCleanRequest2 (\_ tb->(Return0Cci,tb)) (Rq0Cci CcRqCREATETCPWINDOW) (osInstallTCP tb))
+
+osInstallTCP :: !*OSToolbox -> *OSToolbox
+osInstallTCP _
+ = code
+ {
+ .inline InstallCrossCallTCP
+ ccall InstallCrossCallTCP "I-I"
+ .end
+ }
+*/
+
+// RWS ??? ugly
+// OSDummyToolbox :: *OSToolbox
+OSDummyToolbox :== 0
+
+// PA: moved from world to ostoolbox
+worldGetToolbox :: !*World -> (!*OSToolbox,!*World)
+worldGetToolbox world
+ = (OSNewToolbox,world)
+
+worldSetToolbox :: !*OSToolbox !*World -> *World
+worldSetToolbox _ world
+ = world
diff --git a/ostooltip.dcl b/ostooltip.dcl new file mode 100644 index 0000000..784f557 --- /dev/null +++ b/ostooltip.dcl @@ -0,0 +1,17 @@ +definition module ostooltip
+
+// Clean Object I/O library, version 1.2
+
+// Operations to add and remove tooltip controls and areas.
+
+import StdString
+from ostoolbox import :: OSToolbox
+from oswindow import :: OSWindowPtr
+
+/* Tooltip controls are added and removed by osAddControlToolTip and osRemoveControlToolTip.
+ The first OSWindowPtr argument identifies the parent window.
+ The second OSWindowPtr argument identifies the control.
+ The String argument is the tooltip text.
+*/
+osAddControlToolTip :: !OSWindowPtr !OSWindowPtr !String !*OSToolbox -> *OSToolbox
+osRemoveControlToolTip :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
diff --git a/ostooltip.icl b/ostooltip.icl new file mode 100644 index 0000000..c362a23 --- /dev/null +++ b/ostooltip.icl @@ -0,0 +1,21 @@ +implementation module ostooltip
+
+import StdTuple
+import clCrossCall_12
+from clCCall_12 import winMakeCString, winReleaseCString, :: CSTR
+from oswindow import :: OSWindowPtr
+
+osIgnoreCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+osIgnoreCallback _ tb
+ = (return0Cci,tb)
+
+osAddControlToolTip :: !OSWindowPtr !OSWindowPtr !String !*OSToolbox -> *OSToolbox
+osAddControlToolTip parentPtr controlPtr tip tb
+ # (textptr,tb) = winMakeCString tip tb
+ # cci = Rq3Cci CcRqADDCONTROLTIP parentPtr controlPtr textptr
+ # tb = snd (issueCleanRequest2 osIgnoreCallback cci tb)
+ = winReleaseCString textptr tb
+
+osRemoveControlToolTip :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osRemoveControlToolTip parentPtr controlPtr tb
+ = snd (issueCleanRequest2 osIgnoreCallback (Rq2Cci CcRqDELCONTROLTIP parentPtr controlPtr) tb)
diff --git a/ostypes.dcl b/ostypes.dcl new file mode 100644 index 0000000..c870c1b --- /dev/null +++ b/ostypes.dcl @@ -0,0 +1,33 @@ +definition module ostypes
+
+// ********************************************************************************
+// Clean Standard Object I/O library, version 1.2.2
+//
+// Standard types for the OS layer
+//
+// Author: Peter Achten
+// Modified: 8 October 2001 for Clean 2.0
+// ********************************************************************************
+
+:: OSPictContext // PA: moved from ospicture by DvA
+ :== Int // HDC
+:: HDC // PA: moved from pictCCall_12
+ :== Int
+:: OSRect // A OSRect is supposed to be an ordered rectangle with
+ = { rleft :: !Int // rleft<=rright && rtop<=rbottom
+ , rtop :: !Int
+ , rright :: !Int
+ , rbottom :: !Int
+ }
+:: OSWindowPtr
+ :== Int // HWND
+:: HWND
+ :== Int
+
+OSNoWindowPtr :== -1
+
+:: DelayActivationInfo
+ = DelayActivatedWindow OSWindowPtr // the window has become active
+ | DelayDeactivatedWindow OSWindowPtr // the window has become inactive
+ | DelayActivatedControl OSWindowPtr OSWindowPtr // the control (@2) in window (@1) has become active
+ | DelayDeactivatedControl OSWindowPtr OSWindowPtr // the control (@2) in window (@1) has become inactive
diff --git a/ostypes.icl b/ostypes.icl new file mode 100644 index 0000000..4fdfb2b --- /dev/null +++ b/ostypes.icl @@ -0,0 +1,24 @@ +implementation module ostypes
+
+:: OSPictContext // PA: moved from ospicture by DvA
+ :== Int // HDC
+:: HDC // PA: moved from pictCCall_12
+ :== Int
+:: OSRect // A OSRect is supposed to be an ordered rectangle with
+ = { rleft :: !Int // rleft<=rright && rtop<=rbottom
+ , rtop :: !Int
+ , rright :: !Int
+ , rbottom :: !Int
+ }
+:: OSWindowPtr
+ :== Int // HWND
+:: HWND
+ :== Int
+
+OSNoWindowPtr :== -1
+
+:: DelayActivationInfo
+ = DelayActivatedWindow OSWindowPtr // the window has become active
+ | DelayDeactivatedWindow OSWindowPtr // the window has become inactive
+ | DelayActivatedControl OSWindowPtr OSWindowPtr // the control (@2) in window (@1) has become active
+ | DelayDeactivatedControl OSWindowPtr OSWindowPtr // the control (@2) in window (@1) has become inactive
diff --git a/oswindow.dcl b/oswindow.dcl new file mode 100644 index 0000000..982012b --- /dev/null +++ b/oswindow.dcl @@ -0,0 +1,658 @@ +definition module oswindow
+
+
+// Clean Object I/O library, version 1.2
+
+
+import StdMaybe, StdOverloaded, StdString
+import osdocumentinterface, osevent, ostypes
+from StdIOCommon import :: CursorShape
+from osfont import :: Font
+from osrgn import :: OSRgnHandle
+from ossystem import :: OSWindowMetrics
+from ostoolbox import :: OSToolbox
+from ospicture import :: OSPictContext
+
+
+/* Initialisation:
+*/
+osInitialiseWindows :: !*OSToolbox -> *OSToolbox
+
+
+/* System dependent constants:
+*/
+OSControlTitleSpecialChars :== [] // Special prefix characters that should be removed
+
+
+/* System dependent metrics:
+*/
+osMinWindowSize :: (!Int,!Int)
+osMinCompoundSize :: (!Int,!Int)
+
+/* Window frame dimensions:
+*/
+osWindowFrameWidth :: Int
+osWindowTitleBarHeight :: Int
+
+
+// Calculating the view frame of window/compound with visibility of scrollbars.
+osGetCompoundContentRect:: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetCompoundHScrollRect:: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetCompoundVScrollRect:: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+
+osGetWindowContentRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetWindowHScrollRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetWindowVScrollRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+
+
+/* Determine the size of controls:
+ osGetButtonControlSize windowmetrics title
+ returns the size(height) of the ButtonControl that has the given title.
+ osGetTextControlSize windowmetrics title
+ returns the size of the TextControl that has the given title.
+ osGetEditControlSize windowmetrics width nr
+ returns the size of the EditControl that has the given width and should show nr of lines.
+ osGetPopUpControlSize windowmetrics items
+ returns the size of the PopUpControl that thas the given list of items.
+ osGet(Radio/Check)ControlItemSize windowmetrics title
+ returns the size of the (Radio/Check)ControlItem that has the given title.
+ osGet(Radio/Check)ControlItemHeight windowmetrics
+ returns the height of an individual (Radio/Check)ControlItem.
+ osGetSliderControlSize windowmetrics isHorizontal length
+ returns the correct size of the SliderControl given its direction (True iff Horizontal) and length.
+*/
+osGetButtonControlSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetTextControlSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetEditControlSize :: !OSWindowMetrics !Int !Int !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetPopUpControlSize :: !OSWindowMetrics ![String] !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetRadioControlItemSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetCheckControlItemSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetSliderControlSize :: !OSWindowMetrics !Bool !Int -> (!Int,!Int)
+
+/* Determine the height of controls.
+*/
+osGetButtonControlHeight :: !OSWindowMetrics -> Int
+osGetTextControlHeight :: !OSWindowMetrics -> Int
+osGetEditControlHeight :: !OSWindowMetrics !Int -> Int
+osGetPopUpControlHeight :: !OSWindowMetrics -> Int
+osGetRadioControlItemHeight :: !OSWindowMetrics -> Int
+osGetCheckControlItemHeight :: !OSWindowMetrics -> Int
+
+/* Determine the minimum width of controls.
+*/
+osGetButtonControlMinWidth :: !OSWindowMetrics -> Int
+osGetTextControlMinWidth :: !OSWindowMetrics -> Int
+osGetEditControlMinWidth :: !OSWindowMetrics -> Int
+osGetPopUpControlMinWidth :: !OSWindowMetrics -> Int
+osGetRadioControlItemMinWidth :: !OSWindowMetrics -> Int
+osGetCheckControlItemMinWidth :: !OSWindowMetrics -> Int
+osGetSliderControlMinWidth :: !OSWindowMetrics -> Int
+
+
+/* Window creation functions.
+ osCreateDialog isModal
+ isClosable title pos size behindPtr
+ getcontrolfocus createcontrols updatecontrols osdocinfo controlinfo
+ creates a dialog with the given title, position and size.
+ The isModal argument is True iff the dialog is modal.
+ The behindPtr argument is OSNoWindowPtr if the dialog must be created topmost;
+ it is an OSWindowPtr if it must be placed behind a given window.
+ osCreateWindow isResizable hScrollInfo vScrollInfo minSize maxSize
+ isClosable title pos size
+ getcontrolfocus createcontrols updatecontrols osdocinfo behindPtr controlinfo
+ creates a window with the given title, position and size.
+ The isResizable argument is True iff the window is user resizable.
+ The hScrollInfo argument represents the horizontal scrollbar of the window.
+ The vScrollInfo argument represents the vertical scrollbar of the window.
+ The minSize argument is the minimum size of the window.
+ The maxSize argument is the maximum size of the window.
+ The return OSWindowPtrs (result 3,4) are the OSWindowPtrs of the scrollbars.
+ The isClosable argument is True iff the window/dialog is user closeable.
+ The title argument is the title of the window/dialog.
+ The pos argument is the position of the window/dialog.
+ The size argument is the size of the window/dialog, including scrollbars, excluding title bar and frame.
+ The getcontrolfocus argument function returns the handle to the control that
+ has the input focus.
+ The createcontrols argument function creates the controls of the window/dialog,
+ given the handle to the created window/dialog and the proper control information.
+ The updatecontrols argument function updates the customised controls of the window/dialog.
+ The osdocinfo argument gives the document interface of the parent process.
+ The return [DelayActivationInfo] are the OSWindowPtrs of windows/dialogs that have become (in)active (in that order).
+ The return OSWindowPtr is the OSWindowPtr of the created window/dialog.
+ The return OSDInfo is the validated OSDInfo of the parent process.
+*/
+
+osCreateDialog :: !Bool
+ !Bool !String !(!Int,!Int) !(!Int,!Int) !OSWindowPtr
+ !(u:s->*(OSWindowPtr,u:s))
+ !(OSWindowPtr-> u:s -> u:(*OSToolbox -> *(u:s,*OSToolbox)))
+ !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !OSDInfo !u:s !*OSToolbox
+ -> (![DelayActivationInfo],!OSWindowPtr,!u:s,!*OSToolbox)
+osCreateWindow :: !OSWindowMetrics !Bool !ScrollbarInfo !ScrollbarInfo !(!Int,!Int) !(!Int,!Int)
+ !Bool !String !(!Int,!Int) !(!Int,!Int)
+ !(u:s->*(OSWindowPtr,u:s))
+ !(OSWindowPtr-> u:s -> u:(*OSToolbox -> *(u:s,*OSToolbox)))
+ !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !OSDInfo !OSWindowPtr !u:s !*OSToolbox
+ -> (![DelayActivationInfo],!OSWindowPtr,!OSWindowPtr,!OSWindowPtr,!OSDInfo,!u:s,!*OSToolbox)
+
+/* osCreateModalDialog wMetrics isCloseable title osdocinfo currentModal size
+ dialogControls dialogInit handleOSEvents
+ (getOSToolbox,setOSToolbox)
+ creates a modal dialog and handles the events until either the dialog is closed or its parent process terminated.
+ Events are handled according to handleOSEvents.
+ Controls are created according to dialogControls (only if (not osModalDialogHandlesControlCreation)!).
+ Before the event loop is entered, the dialogInit function is evaluated (only if (not osModalDialogHandlesWindowInit)!).
+*/
+
+:: OSModalEventHandling s
+ = OSModalEventCallback (s -> *(OSEvents,s)) (*(OSEvents,s) -> s) (OSEvent -> s -> *([Int],s))
+ | OSModalEventLoop (s -> s)
+
+osModalDialogHandlesMenuSelectState :== True
+osModalDialogHandlesWindowInit :== True
+osModalDialogHandlesControlCreation :== True
+osModalDialogHandlesEvents :== True
+
+osCreateModalDialog :: !OSWindowMetrics !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(!Int,!Int)
+ !(OSWindowPtr u:s -> u:s)
+ !(OSWindowPtr u:s -> u:s)
+ !(OSModalEventHandling u:s)
+ !(!u:s -> *(*OSToolbox,u:s), !*OSToolbox -> *(u:s -> u:s))
+ !u:s
+ -> (!Bool,!u:s)
+
+
+/* Control creation functions:
+ osCreateRadioControl parentWindow parentPos title able pos size selected isfirst
+ creates a RadioControl in the window identified by parentWindow.
+ osCreateCheckControl parentWindow parentPos title able pos size selected isfirst
+ creates a CheckControl in the window identified by parentWindow.
+ osCreateEmptyPopUpControl parentWindow parentPos able pos nrItems keySensitive
+ creates an initially empty PopUpControl that will display nrItems elements.
+ The boolean keySensitive holds iff the PopUpControl should respond to keyboard input (is editable).
+ The first result OSWindowPtr is the PopUpControl, the second OSWindowPtr is the EditControl (if editable).
+ osCreatePopUpControlItem parentPopUp pos able title selected
+ adds an item title to the parentPopUp PopUpControl. The pos argument determines the location of
+ the item title. If (-1), the item is appended, otherwise it is created behind the item with the
+ given pos index. The return Int is its zero based index.
+ osCreateSliderControl parentWindow parentPos show able horizontal pos size range
+ creates a horizontal (True) or vertical (False) SliderControl in the window identified by parentWindow.
+ osCreateTextControl parentWindow parentPos text pos size
+ creates a TextControl in the window identified by parentWindow.
+ osCreateEditControl parentWindow parentPos text able isKeySensitive pos size
+ creates an EditControl in the window identified by parentWindow.
+ osCreateButtonControl parentWindow parentPos title able pos size okOrCancel
+ creates a ButtonControl in the window identified by parentWindow.
+ osCreateCustomButtonControl parentWindow parentPos able pos size okOrCancel
+ creates a CustomButtonControl in the window identified by parentWindow.
+ osCreateCustomControl parentWindow parentPos able pos size
+ creates a CustomControl in the window identified by parentWindow.
+ osCreateCompoundControl parentWindow parentPos show able isTransparent pos size hScrollInfo vScrollInfo
+ creates a CompoundControl in the window identified by parentWindow.
+ The Boolean isTransparent should be True iff the CompoundControl has no ControlLook attribute.
+*/
+:: OKorCANCEL
+ = OK | CANCEL | NORMAL
+
+osCreateRadioControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !(!Int,!Int) !(!Int,!Int) !Bool !Bool !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateCheckControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !(!Int,!Int) !(!Int,!Int) !Bool !Bool !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateEmptyPopUpControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !(!Int,!Int) !(!Int,!Int) !Int !Bool !*OSToolbox
+ -> (!OSWindowPtr,!OSWindowPtr,!*OSToolbox)
+osCreatePopUpControlItem :: !OSWindowPtr !(Maybe OSWindowPtr) !Int !Bool !String !Bool !Int !*OSToolbox -> (!Int,!*OSToolbox)
+osCreatePopUpControlItems :: !OSWindowPtr !(Maybe OSWindowPtr) !Bool ![String] !Int !*OSToolbox -> *OSToolbox
+osCreateSliderControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !Bool !(!Int,!Int) !(!Int,!Int) !(!Int,!Int,!Int,!Int) !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateTextControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !(!Int,!Int) !(!Int,!Int) !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateEditControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !Bool !(!Int,!Int) !(!Int,!Int) !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateButtonControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !(!Int,!Int) !(!Int,!Int) !OKorCANCEL !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateCustomButtonControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !(!Int,!Int) !(!Int,!Int) !OKorCANCEL !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateCustomControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !(!Int,!Int) !(!Int,!Int) !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+
+:: ScrollbarInfo
+ = { cbiHasScroll :: !Bool // The scrollbar exists
+ , cbiPos :: (Int,Int) // Its position within the parent
+ , cbiSize :: (Int,Int) // Its size within the parent
+ , cbiState :: (Int,Int,Int,Int) // Its (min,thumb,max,thumbsize) settings
+ }
+
+osCreateCompoundControl :: !OSWindowMetrics !OSWindowPtr !(!Int,!Int) !Bool !Bool !Bool !(!Int,!Int) !(!Int,!Int)
+ !ScrollbarInfo !ScrollbarInfo !*OSToolbox
+ -> (!OSWindowPtr,!OSWindowPtr,!OSWindowPtr,!*OSToolbox)
+
+
+/* Window destruction operations.
+ osDestroyWindow isModal isWindow window
+ destroys the window identified by window.
+ The first Boolean isModal is True iff the window is Modal.
+ The second Boolean isWindow is True iff the window is a Window.
+*/
+osDestroyWindow :: !Bool !Bool !OSWindowPtr !(OSEvent -> .s -> ([Int],.s)) !OSDInfo !.s !*OSToolbox
+ -> (![DelayActivationInfo],!OSDInfo, .s,!*OSToolbox)
+
+
+/* Control destruction operations.
+*/
+osDestroyRadioControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCheckControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyPopUpControl :: !OSWindowPtr !(Maybe OSWindowPtr) !*OSToolbox -> *OSToolbox
+osDestroySliderControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyTextControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyEditControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyButtonControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCustomButtonControl:: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCustomControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCompoundControl :: !OSWindowPtr !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+
+
+/* Control update operations.
+ osUpdateRadioControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdateCheckControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdatePopUpControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdateSliderControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdateTextControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdateEditControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdateButtonControl area pos parentWindow theControl updates the area of theControl in parentWindow
+ osUpdateCompoundControl area pos parentWindow theControl updates the area of theControl in parentWindow
+
+ Both area and pos must in window coordinates (zero at left-top).
+*/
+osUpdateRadioControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateCheckControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdatePopUpControl :: !OSRect !OSWindowPtr !OSWindowPtr !(Maybe OSWindowPtr) !(!Int,!Int) !(!Int,!Int) !Bool !String !*OSToolbox -> *OSToolbox
+osUpdateSliderControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateTextControl :: !OSRect !OSRect !String !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateEditControl :: !OSRect !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateButtonControl :: !OSRect !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateCompoundControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+
+
+/* Control clipping operations.
+ osClipRadioControl parentWindow parentPos area pos size generates the clipping region of a radio control within area.
+ osClipCheckControl parentWindow parentPos area pos size generates the clipping region of a check control within area.
+ osClipPopUpControl parentWindow parentPos area pos size generates the clipping region of a pop up control within area.
+ osClipSliderControl parentWindow parentPos area pos size generates the clipping region of a slider control within area.
+ osClipTextControl parentWindow parentPos area pos size generates the clipping region of a text control within area.
+ osClipEditControl parentWindow parentPos area pos size generates the clipping region of a edit control within area.
+ osClipButtonControl parentWindow parentPos area pos size generates the clipping region of a button control within area.
+ osClipCustomButtonControl parentWindow parentPos area pos size generates the clipping region of a custom button control within area.
+ osClipCustomControl parentWindow parentPos area pos size generates the clipping region of a custom control within area.
+ osClipCompoundControl parentWindow parentPos area pos size generates the clipping region of a compound control within area.
+*/
+osClipRadioControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCheckControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipPopUpControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipSliderControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipTextControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipEditControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipButtonControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCustomButtonControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCustomControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCompoundControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+
+
+/* Window graphics context access operations.
+ osGrabWindowPictContext theWindow
+ returns the graphics context that must be used to update the window.
+ osReleaseWindowPictContext theWindow theContext
+ releases the graphics context.
+*/
+osGrabWindowPictContext :: !OSWindowPtr !*OSToolbox -> (!OSPictContext,!*OSToolbox)
+osReleaseWindowPictContext :: !OSWindowPtr !OSPictContext !*OSToolbox -> *OSToolbox
+
+
+/* osBeginUpdate theWindow
+ makes additional preparations to do updates. Dummy on Windows.
+ osEndUpdate theWindow
+ administrates and ends the update. Dummy on Windows.
+*/
+osBeginUpdate :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osEndUpdate :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osSetUpdate :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+
+
+/* (acc/app)Grafport theWindow f
+ applies f to the graphics context of theWindow (dummy on Windows).
+ (acc/app)Clipport theWindow clipRect f
+ applies f to the graphics context of theWindow while clipping clipRect (dummy on Windows).
+*/
+accGrafport :: !OSWindowPtr !.(St *OSToolbox .x) !*OSToolbox -> (!.x, !*OSToolbox)
+appGrafport :: !OSWindowPtr !.(*OSToolbox -> *OSToolbox) !*OSToolbox -> *OSToolbox
+accClipport :: !OSWindowPtr !OSRect !.(St *OSToolbox .x) !*OSToolbox -> (!.x, !*OSToolbox)
+appClipport :: !OSWindowPtr !OSRect !.(*OSToolbox -> *OSToolbox) !*OSToolbox -> *OSToolbox
+
+
+/* Scrollbar operations.
+*/
+
+/* toOSscrollbarRange (domainMin,viewMin,domainMax) viewSize
+ maps the (domainMin,viewMin,domainMax) viewSize values to proper OS values (osRangeMin,osThumb,osRangeMax,osThumbSize).
+ fromOSscrollbarRange (domainMin,domainMax) osThumb
+ maps the osThumb value between the (domainMin,domainMax) values.
+ These values are also valid for CompoundControls.
+ Both functions assume that:domainMin<=viewMin<= domainMax
+ and osRangeMin<=osThumb<=osRangeMax.
+ osScrollbarIsVisible (domainMin,domainMax) viewSize
+ determines whether the scrollbar is visible given these settings.
+ osScrollbarsAreVisible wMetrics windowDomain size (hasHScroll,hasVScroll)
+ determines the visibility of the horizontal/vertical scrollbars given the domain, size, and presence.
+*/
+toOSscrollbarRange :: !(!Int,!Int,!Int) !Int -> (!Int,!Int,!Int,!Int)
+fromOSscrollbarRange :: !(!Int,!Int) !Int -> Int
+osScrollbarIsVisible :: !(!Int,!Int) !Int -> Bool
+osScrollbarsAreVisible :: !OSWindowMetrics !OSRect !(!Int,!Int) !(!Bool,!Bool) -> (!Bool,!Bool)
+
+
+/* Window access operations.
+*/
+
+/* osSetWindowSliderThumb theWindow isHorizontal thumb redraw
+ sets the thumb value of the horizontal/vertical slider of the given window.
+ osSetWindowSliderThumbSize theWindow isHorizontal size redraw
+ sets the view size of the horizontal/vertical slider of the given window.
+*/
+osSetWindowSliderThumb :: !OSWindowMetrics !OSWindowPtr !Bool !Int !(Maybe OSWindowPtr) !(Maybe OSWindowPtr) !OSRect !OSRect !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetWindowSliderThumbSize :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !Bool !Int !Int !Int !(!Int,!Int) !OSRect !Bool !Bool !*OSToolbox -> *OSToolbox
+osSetWindowSliderPosSize :: !OSWindowPtr !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+
+
+/* osInvalidateWindow theWindow
+ invalidates the window identified by theWindow, forcing an update event for the entire contents.
+ osInvalidateWindowRect theWindow part
+ invalidates the part of the window identified by theWindow, forcing an update event for that part.
+ osValidateWindowRect theWindow part
+ validates the OSRect part of the window identified by theWindow, eliminating the need to update that part.
+ osValidateWindowRgn theWindow part
+ validate the Rgn part of the window identified by the theWindow, eliminating the need to update that part.
+*/
+osInvalidateWindow :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osInvalidateWindowRect :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osValidateWindowRect :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osValidateWindowRgn :: !OSWindowPtr !OSRgnHandle !*OSToolbox -> *OSToolbox
+osWindowHasUpdateRect :: !OSWindowPtr !*OSToolbox -> (!Bool,!*OSToolbox)
+
+
+/* os(Dis/En)ableWindow theWindow
+ (dis/en)able the window identified by theWindow.
+ The Boolean tuple indicates whether the window has a horizontal/vertical scrollbar.
+ The last Boolean argument indicates whether the window is (dis/en)abled because of a modal dialogue.
+*/
+osDisableWindow :: !OSWindowPtr !(!Bool,!Bool) !Bool !*OSToolbox -> *OSToolbox
+osEnableWindow :: !OSWindowPtr !(!Bool,!Bool) !Bool !*OSToolbox -> *OSToolbox
+
+/* osActivateWindow osdInfo thisWindow handleEvents info
+ activates thisWindow. The handleEvents function is applied when updates are required.
+ osActivateControl parentWindow theControl
+ activates theControl which is in parentWindow.
+ osStackWindow thisWindow behindWindow
+ moves the window identified by thisWindow behind the window identified by behindWindow.
+ osStackWindow assumes that thisWindow and behindWindow are valid values.
+*/
+osActivateWindow :: !OSDInfo !OSWindowPtr !(OSEvent->(.s,*OSToolbox)->(.s,*OSToolbox)) !.s !*OSToolbox
+ -> (![DelayActivationInfo],!.s,!*OSToolbox)
+osActivateControl :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+osStackWindow :: !OSWindowPtr !OSWindowPtr !(OSEvent->(.s,*OSToolbox)->(.s,*OSToolbox)) !.s !*OSToolbox
+ -> (![DelayActivationInfo],!.s,!*OSToolbox)
+
+/* osHideWindow thisWindow activate
+ hides the window. If the Boolean activate is True then a new window is made the active window.
+ osShowWindow thisWindow activate
+ shows the window. If the Boolean activate is True then the window is also made the active
+ window. If the Boolean activate is False then the stacking order is not changed.
+*/
+osHideWindow :: !OSWindowPtr !Bool !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+osShowWindow :: !OSWindowPtr !Bool !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+
+/* osSetWindowCursor sets the new cursor shape.
+*/
+osSetWindowCursor :: !OSWindowPtr !CursorShape !*OSToolbox -> *OSToolbox
+
+/* osGetWindowPos returns the current position of the window.
+ osGetWindowViewFrameSize returns the current size of the window view frame.
+ osGetWindowSize returns the current size of the window including bounds.
+ osSetWindowPos sets the position of the window.
+ osSetWindowViewFrameSize sets the size of the window view frame.
+ osSetWindowSize sets the size of the window.
+*/
+osGetWindowPos :: !OSWindowPtr !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetWindowViewFrameSize:: !OSWindowPtr !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetWindowSize :: !OSWindowPtr !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osSetWindowPos :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !*OSToolbox -> *OSToolbox
+osSetWindowViewFrameSize:: !OSWindowPtr !(!Int,!Int) !*OSToolbox -> *OSToolbox
+osSetWindowSize :: !OSWindowPtr !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+
+/* osSetWindowTitle sets the title of the window.
+*/
+osSetWindowTitle:: !OSWindowPtr !String !*OSToolbox -> *OSToolbox
+
+
+/* Control access operations.
+*/
+
+/* On compound controls:
+ osInvalidateCompound compoundPtr
+ invalidates the compound control, forcing an update event for the entire contents.
+ osInvalidateCompoundRect compoundPtr part
+ invalidates the part of the compound control, forcing an update event for that part.
+ osSetCompoundSliderThumb compoundPtr isHorizontal thumb (maxx,maxy) redraw
+ sets the thumb value of the horizontal/vertical slider of the given compound control.
+ (maxx,maxy) are the maximum x and y coordinates of the enclosing rectangle of the slider.
+ osSetCompoundSliderThumbSize compoundPtr isHorizontal size (maxx,maxy) redraw
+ sets the view size of the horizontal/vertical slider of the given compound control.
+ (maxx,maxy) are the maximum x and y coordinates of the enclosing rectangle of the slider.
+ osSetCompoundSlider compoundPtr isHorizontal (osRangeMin,osThumb,osRangeMax,osThumbSize)
+ sets all slider values of the horizontal/vertical slider of the given compound control.
+ osSetCompoundSelect parentWindow compoundPtr clipRect (hasHScroll,hasVScroll) toAble
+ enables the compound control (if toAble), or disables the compound control (if (not toAble)), while clipping.
+ osSetCompoundShow parentWindow compoundPtr clipRect show
+ shows the compound control (if show), or hides the compound control (if (not show)), while clipping.
+ osSetCompoundPos parentWindow parentPos compoundPtr pos size update
+ sets the new position of the compound control and updates the control if update holds.
+ osSetCompoundSize parentWindow parentPos compoundPtr pos size update
+ sets the new size of the compound control and updates the control if update holds.
+ osUpdateCompoundScroll parentWindow compoundPtr scrollRect
+ updates the compound control.
+ osCompoundMovesControls
+ is True iff moving a compound control also moves its elements.
+ osCompoundControlHasOrigin
+ is True iff compound control has a private origin; otherwise related to its item position.
+*/
+osInvalidateCompound :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+//osInvalidateCompoundRect :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox PA: not used
+//osSetCompoundSliderThumb :: !OSWindowMetrics !OSWindowPtr !Bool !Int !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSliderThumb :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !OSWindowPtr !OSRect !Bool !Int !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+//osSetCompoundSliderThumbSize :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !Bool !Int !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSliderThumbSize :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !OSWindowPtr !Int !Int !Int !OSRect !Bool !Bool !Bool !*OSToolbox -> *OSToolbox
+//osSetCompoundSlider :: !OSWindowMetrics !OSWindowPtr !Bool !(!Int,!Int,!Int,!Int) !(!Int,!Int) !*OSToolbox -> *OSToolbox PA: not used
+osSetCompoundSelect :: !OSWindowPtr !OSWindowPtr !OSRect !(!Bool,!Bool) !(!OSWindowPtr,!OSWindowPtr) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osUpdateCompoundScroll :: !OSWindowPtr !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osCompoundMovesControls :== True
+osCompoundControlHasOrigin :== True
+
+/* On slider controls:
+ osSetSliderControlThumb parentWindow sliderPtr clipRect redraw (min,thumb,max)
+ sets the thumb value of the slider control, while clipping.
+ osSetSliderControlSelect parentWindow sliderPtr clipRect toAble
+ enables the slider control (if toAble), or disables the slider control (if (not toAble)), while clipping.
+ osSetSliderControlShow parentWindow sliderPtr clipRect show
+ shows the slider control (if show), or hides the slider control (if (not show)), while clipping.
+ osSetSliderControlPos parentWindow parentPos sliderPtr pos size update
+ sets the new position of the slider control and updates the control if update holds.
+ osSetSliderControlSize parentWindow parentPos sliderPtr pos size update
+ sets the new size of the slider control and updates the control if update holds.
+*/
+osSetSliderControlThumb :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+osSetSliderControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+
+/* On radio controls:
+ osSetRadioControl parentWindow current new clipRect
+ removes the selection from current and sets the selection to new, while clipping.
+ osSetRadioControlSelect parentWindow radioPtr clipRect toAble
+ enables the radio control (if toAble), or disables the radio control (if (not toAble)), while clipping.
+ osSetRadioControlShow parentWindow radioPtr clipRect show
+ shows the radio control (if show), or hides the radio control (if (not show)), while clipping.
+ osSetRadioControlPos parentWindow parentPos radioPtr pos size update
+ sets the new position of the radio control and updates the control if update holds.
+ osSetRadioControlSize parentWindow parentPos radioPtr pos size update
+ sets the new size of the radio control and updates the control if update holds.
+*/
+osSetRadioControl :: !OSWindowPtr !OSWindowPtr !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osSetRadioControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+
+/* On check controls:
+ osSetCheckControl parentWindow checkPtr clipRect marked
+ sets the check mark (if marked) or removes the check mark (if not marked) of the check control, while clipping.
+ osSetCheckControlSelect parentWindow checkPtr clipRect toAble
+ enables the check control (if toAble), or disables the check control (if (not toAble)), while clipping.
+ osSetCheckControlShow parentWindow checkPtr clipRect show
+ shows the check control (if show), or hides the check control (if (not show)), while clipping.
+ osSetCheckControlPos parentWindow parentPos checkPtr pos size update
+ sets the new position of the check control and updates the control if update holds.
+ osSetCheckControlSize parentWindow parentPos checkPtr pos size update
+ sets the new size of the check control and updates the control if update holds.
+*/
+osSetCheckControl :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+
+/* On pop up controls:
+ osSetPopUpControl parentWindow popupPtr clipRect current new newtext shown
+ removes the selection from current and sets the selection to new, while clipping. Both indices are zero based!
+ osSetPopUpControlSelect parentWindow popupPtr clipRect toAble
+ enables the pop up control (if toAble), or disables the pop up control (if (not toAble)), while clipping.
+ osSetPopUpControlShow parentWindow popupPtr clipRect show
+ shows the pop up control (if show), or hides the pop up control (if (not show)), while clipping.
+ osSetPopUpControlPos parentWindow parentPos popupPtr pos size update
+ sets the new position of the pop up control and updates the control if update holds.
+ osSetPopUpControlSize parentWindow parentPos popupPtr pos size update
+ sets the new size of the pop up control and updates the control if update holds.
+*/
+osSetPopUpControl :: !OSWindowPtr !OSWindowPtr !(Maybe OSWindowPtr) !OSRect !OSRect !Int !Int !String !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osGetPopUpControlText :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!String,!*OSToolbox)
+
+/* On edit controls:
+ osSetEditControlText parentWindow editPtr clipRect itemRect shown text
+ sets the text of the shown edit control while clipping.
+ osGetEditControlText parentWindow editPtr
+ returns the current content of the edit control.
+ osSetEditControlCursor parentWindow editPtr clipRect itemRect pos
+ sets the cursor position at pos of the edit control while clipping.
+ osSetEditControlSelection parentWindow editPtr clipRect itemRect start end
+ sets the selection of the text in the edit control while clipping.
+ osSetEditControlSelect parentWindow editPtr clipRect toAble
+ enables the edit control (if toAble), or disables the edit control (if (not toAble)), while clipping.
+ osSetEditControlShow parentWindow editPtr clipRect show
+ shows the edit control (if show), or hides the edit control (if (not show)), while clipping.
+ osSetEditControlPos parentWindow parentPos editPtr pos size update
+ sets the new position of the edit control and updates the control if update holds.
+ osSetEditControlSize parentWindow parentPos editPtr pos size update
+ sets the new size of the edit control and updates the control if update holds.
+*/
+osSetEditControlText :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !String !*OSToolbox -> *OSToolbox
+osGetEditControlText :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!String,!*OSToolbox)
+osSetEditControlCursor :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Int !*OSToolbox -> *OSToolbox
+osSetEditControlSelection :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Int !Int !*OSToolbox -> *OSToolbox
+osSetEditControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osIdleEditControl :: !OSWindowPtr !OSRect !OSWindowPtr !*OSToolbox -> *OSToolbox
+
+/* On text controls:
+ osSetTextControlText parentWindow textPtr clipRect itemRect shown text
+ sets the text of the shown edit control while clipping.
+ osSetTextControlSelect parentWindow textPtr clipRect toAble
+ enables the text control (if toAble), or disables the text control (if (not toAble)), while clipping.
+ osSetTextControlShow parentWindow textPtr clipRect show
+ shows the text control (if show), or hides the text control (if (not show)), while clipping.
+ osSetTextControlPos parentWindow parentPos textPtr pos size update
+ sets the new position of the text control and updates the control if update holds.
+ osSetTextControlSize parentWindow parentPos textPtr pos size update
+ sets the new size of the text control and updates the control if update holds.
+*/
+osSetTextControlText :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !String !*OSToolbox -> *OSToolbox
+osSetTextControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetTextControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !String !*OSToolbox -> *OSToolbox
+osSetTextControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetTextControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+
+/* On button controls:
+ osSetButtonControlText parentWindow buttonPtr clipRect text
+ sets the text of the button control while clipping.
+ osSetButtonControlSelect parentWindow buttonPtr clipRect toAble
+ enables the button control (if toAble), or disables the button control (if (not toAble)), while clipping.
+ osSetButtonControlShow parentWindow buttonPtr clipRect show
+ shows the button control (if show), or hides the button control (if (not show)), while clipping.
+ osSetButtonControlPos parentWindow parentPos buttonPtr pos size update
+ sets the new position of the button control and updates the control if update holds.
+ osSetButtonControlSize parentWindow parentPos buttonPtr pos size update
+ sets the new size of the button control and updates the control if update holds.
+*/
+osSetButtonControlText :: !OSWindowPtr !OSWindowPtr !OSRect !String !*OSToolbox -> *OSToolbox
+osSetButtonControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+
+/* On custom button controls:
+ osSetCustomButtonControlSelect parentWindow buttonPtr clipRect toAble
+ enables the custom button control (if toAble), or disables the custom button control (if (not toAble)), while clipping.
+ osSetCustomButtonControlShow parentWindow buttonPtr clipRect show
+ shows the custom button control (if show), or hides the custom button control (if (not show)), while clipping.
+ osSetCustomButtonControlPos parentWindow parentPos buttonPtr pos size update
+ sets the new position of the custom button control and updates the custom button if update holds.
+ osSetCustomButtonControlSize parentWindow parentPos buttonPtr pos size update
+ sets the new size of the custom button control and updates the custom button if update holds.
+ osCustomButtonControlHasOrigin
+ is True iff the control has a private origin; otherwise related to its item position.
+*/
+osSetCustomButtonControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osCustomButtonControlHasOrigin :== True
+
+/* On custom controls:
+ osSetCustomControlSelect parentWindow controlPtr clipRect toAble
+ enables the custom control (if toAble), or disables the custom control (if (not toAble)), while clipping.
+ osSetCustomControlShow parentWindow controlPtr clipRect show
+ shows the custom control (if show), or hides the custom control (if (not show)), while clipping.
+ osSetCustomControlPos parentWindow parentPos controlPtr pos size update
+ sets the new position of the custom control and updates the control if update holds.
+ osSetCustomControlSize parentWindow parentPos controlPtr pos size update
+ sets the new size of the custom control and updates the control if update holds.
+ osCustomControlHasOrigin
+ is True iff the control has a private origin; otherwise related to its item position.
+*/
+osSetCustomControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osCustomControlHasOrigin :== True
+
+//--
+
+osSetCursorShape :: !CursorShape !*OSToolbox -> *OSToolbox
diff --git a/oswindow.icl b/oswindow.icl new file mode 100644 index 0000000..62a9989 --- /dev/null +++ b/oswindow.icl @@ -0,0 +1,1496 @@ +implementation module oswindow
+
+
+import StdBool, StdInt, StdReal, StdClass, StdOverloaded, StdList, StdMisc, StdTuple
+from StdIOCommon import :: CursorShape(StandardCursor,BusyCursor,IBeamCursor,CrossCursor,FatCrossCursor,ArrowCursor,HiddenCursor)
+import clCrossCall_12, clCCall_12, windowCCall_12, windowCrossCall_12
+import osdocumentinterface, osevent, osfont, ospicture, osrgn, ossystem, ostypes
+from menuCrossCall_12 import :: HMENU
+from commondef import fatalError, intersectRects, rectSize, stateMap2,
+ class fromTuple(..), instance fromTuple Vector2,
+ class toTuple4(..), instance toTuple4 OSRect,
+ class subVector(..), instance subVector OSRect,
+ instance zero OSRect
+
+
+oswindowFatalError :: String String -> .x
+oswindowFatalError function error
+ = fatalError function "oswindow" error
+
+
+/* Initialisation:
+*/
+osInitialiseWindows :: !*OSToolbox -> *OSToolbox
+osInitialiseWindows tb
+ = winInitialiseWindows tb
+
+
+/* System dependent constants:
+*/
+OSControlTitleSpecialChars
+ :== [] // Special prefix characters that should be removed
+
+
+/* System dependent metrics:
+*/
+
+osMinWindowSize :: (!Int,!Int)
+osMinWindowSize = winMinimumWinSize
+
+osMinCompoundSize :: (!Int,!Int)
+osMinCompoundSize = (0,0) // PA: (0,0)<--winMinimumWinSize (Check if this safe)
+
+
+/* Window frame dimensions: (PA: were defined as constants in windowvalidate. Moved here.)
+*/
+osWindowFrameWidth :: Int; osWindowFrameWidth = 0;
+osWindowTitleBarHeight :: Int; osWindowTitleBarHeight = 0;
+
+
+// Calculating the view frame of window/compound with visibility of scrollbars.
+
+osGetCompoundContentRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetCompoundContentRect {osmHSliderHeight,osmVSliderWidth} (visHScroll,visVScroll) itemRect=:{rright,rbottom}
+ | visHScroll && visVScroll = {itemRect & rright=r`,rbottom=b`}
+ | visHScroll = {itemRect & rbottom=b`}
+ | visVScroll = {itemRect & rright=r` }
+ | otherwise = itemRect
+where
+ r` = rright -osmVSliderWidth
+ b` = rbottom-osmHSliderHeight
+
+osGetCompoundHScrollRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetCompoundHScrollRect {osmHSliderHeight,osmVSliderWidth} (visHScroll,visVScroll) itemRect=:{rright,rbottom}
+ | not visHScroll = zero
+ | otherwise = {itemRect & rtop=b`,rright=if visVScroll r` rright}
+where
+ r` = rright -osmVSliderWidth
+ b` = rbottom-osmHSliderHeight
+
+osGetCompoundVScrollRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetCompoundVScrollRect {osmHSliderHeight,osmVSliderWidth} (visHScroll,visVScroll) itemRect=:{rright,rbottom}
+ | not visVScroll = zero
+ | otherwise = {itemRect & rleft=r`,rbottom=if visHScroll b` rbottom}
+where
+ r` = rright -osmVSliderWidth
+ b` = rbottom-osmHSliderHeight
+
+
+osGetWindowContentRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetWindowContentRect {osmHSliderHeight,osmVSliderWidth} (visHScroll,visVScroll) itemRect=:{rright,rbottom}
+ | visHScroll && visVScroll = {itemRect & rright=r`,rbottom=b`}
+ | visHScroll = {itemRect & rbottom=b`}
+ | visVScroll = {itemRect & rright=r` }
+ | otherwise = itemRect
+where
+ r` = rright -osmVSliderWidth //+1
+ b` = rbottom-osmHSliderHeight//+1
+
+osGetWindowHScrollRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetWindowHScrollRect {osmHSliderHeight,osmVSliderWidth} (visHScroll,visVScroll) {rleft,rtop,rright,rbottom}
+ | not visHScroll = zero
+ | otherwise = {rleft=rleft-1,rtop=b`,rright=if visVScroll (r`+1) (rright+1),rbottom=rbottom+1}
+where
+ r` = rright -osmVSliderWidth + 1
+ b` = rbottom-osmHSliderHeight + 1
+
+osGetWindowVScrollRect :: !OSWindowMetrics !(!Bool,!Bool) !OSRect -> OSRect
+osGetWindowVScrollRect {osmHSliderHeight,osmVSliderWidth} (visHScroll,visVScroll) {rleft,rtop,rright,rbottom}
+ | not visVScroll = zero
+ | otherwise = {rleft=r`,rtop=rtop-1,rright=rright+1,rbottom=if visHScroll (b`+1) (rbottom+1)}
+where
+ r` = rright -osmVSliderWidth + 1
+ b` = rbottom-osmHSliderHeight + 1
+
+
+/* Determine the size of controls.
+*/
+osGetButtonControlSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetButtonControlSize wMetrics=:{osmFont,osmHeight} text tb
+ # (widths,tb) = osGetfontstringwidths False 0 [text] osmFont tb
+ width = hd widths
+ = ((2*osmHeight+width,osGetButtonControlHeight wMetrics),tb)
+
+osGetButtonControlHeight :: !OSWindowMetrics -> Int
+osGetButtonControlHeight {osmHeight} = 2*osmHeight
+
+osGetTextControlSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetTextControlSize wMetrics=:{osmFont,osmHeight} text tb
+ # (widths,tb) = osGetfontstringwidths False 0 [text] osmFont tb
+ width = hd widths
+ = ((width+osmHeight/4,osGetTextControlHeight wMetrics),tb)
+
+osGetTextControlHeight :: !OSWindowMetrics -> Int
+osGetTextControlHeight {osmHeight} = osmHeight+osmHeight/2
+
+osGetEditControlSize :: !OSWindowMetrics !Int !Int !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetEditControlSize wMetrics width nrlines tb
+ = ((width,osGetEditControlHeight wMetrics nrlines),tb)
+
+osGetEditControlHeight :: !OSWindowMetrics !Int -> Int
+osGetEditControlHeight {osmHeight} nrlines = osmHeight/2+osmHeight*nrlines
+
+osGetPopUpControlSize :: !OSWindowMetrics ![String] !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetPopUpControlSize wMetrics=:{osmFont,osmHeight} items tb
+ # (widths,tb) = osGetfontstringwidths False 0 items osmFont tb
+ maxwidth = listmax widths
+ = ((maxwidth+2*osmHeight+osmHeight/2,osGetPopUpControlHeight wMetrics),tb)
+where
+ listmax :: ![Int] -> Int
+ listmax [x:xs] = foldr max x xs
+ listmax _ = 0
+
+osGetPopUpControlHeight :: !OSWindowMetrics -> Int
+osGetPopUpControlHeight {osmHeight} = osmHeight+osmHeight/2+2
+
+osGetRadioControlItemSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetRadioControlItemSize wMetrics=:{osmFont,osmHeight} text tb
+ # (widths,tb) = osGetfontstringwidths False 0 [text] osmFont tb
+ width = hd widths
+ = ((width+2*osmHeight+osmHeight/2,osGetRadioControlItemHeight wMetrics),tb)
+
+osGetRadioControlItemHeight :: !OSWindowMetrics -> Int
+osGetRadioControlItemHeight {osmHeight}
+ = osmHeight+osmHeight/2
+
+osGetCheckControlItemSize :: !OSWindowMetrics !String !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetCheckControlItemSize wMetrics=:{osmFont,osmHeight} text tb
+ # (widths,tb) = osGetfontstringwidths False 0 [text] osmFont tb
+ width = hd widths
+ = ((width+2*osmHeight+osmHeight/2,osGetCheckControlItemHeight wMetrics),tb)
+
+osGetCheckControlItemHeight :: !OSWindowMetrics -> Int
+osGetCheckControlItemHeight {osmHeight}
+ = osmHeight+osmHeight/2
+
+osGetSliderControlSize :: !OSWindowMetrics !Bool !Int -> (!Int,!Int)
+osGetSliderControlSize wMetrics isHorizontal length
+ | isHorizontal = (length,wMetrics.osmHSliderHeight)
+ | otherwise = (wMetrics.osmVSliderWidth,length)
+
+
+
+/* Determine the minimum width of controls.
+*/
+osGetButtonControlMinWidth :: !OSWindowMetrics -> Int
+osGetButtonControlMinWidth {osmHeight} = 2*osmHeight
+
+osGetTextControlMinWidth :: !OSWindowMetrics -> Int
+osGetTextControlMinWidth {osmHeight} = osmHeight/4
+
+osGetEditControlMinWidth :: !OSWindowMetrics -> Int
+osGetEditControlMinWidth _ = 0
+
+osGetPopUpControlMinWidth :: !OSWindowMetrics -> Int
+osGetPopUpControlMinWidth {osmHeight} = 2*osmHeight+osmHeight/2
+
+osGetRadioControlItemMinWidth :: !OSWindowMetrics -> Int
+osGetRadioControlItemMinWidth {osmHeight} = 2*osmHeight+osmHeight/2
+
+osGetCheckControlItemMinWidth :: !OSWindowMetrics -> Int
+osGetCheckControlItemMinWidth {osmHeight} = 2*osmHeight+osmHeight/2
+
+osGetSliderControlMinWidth :: !OSWindowMetrics -> Int
+osGetSliderControlMinWidth _ = 0
+
+
+/* Window creation functions.
+*/
+osCreateDialog :: !Bool !Bool !String !(!Int,!Int) !(!Int,!Int) !OSWindowPtr
+ !(u:s->*(OSWindowPtr,u:s))
+ !(OSWindowPtr->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !OSDInfo !u:s !*OSToolbox
+ -> (![DelayActivationInfo],!OSWindowPtr,!u:s,!*OSToolbox)
+osCreateDialog isModal isClosable title pos size behindPtr get_focus create_controls update_controls osdinfo control_info tb
+ # (textPtr,tb) = winMakeCString title tb
+ createcci = Rq4Cci CcRqCREATEDIALOG textPtr parentptr (if (behindPtr==OSNoWindowPtr) 0 behindPtr) (toInt isModal)
+ # (returncci,(control_info,delay_info),tb)
+ = issueCleanRequest (osCreateDialogCallback get_focus create_controls update_controls)
+ createcci
+ (control_info,[]) tb
+ # tb = winReleaseCString textPtr tb
+ wPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateDialog"
+ = (reverse delay_info,wPtr,control_info,tb)
+where
+ parentptr = case (getOSDInfoOSInfo osdinfo) of
+ Nothing -> 0
+ Just {osFrame} -> osFrame
+
+ osCreateDialogCallback :: !(u:s->*(OSWindowPtr,u:s))
+ !(OSWindowPtr->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !CrossCallInfo !*(u:s,[DelayActivationInfo]) !*OSToolbox
+ -> (!CrossCallInfo,!*(u:s,[DelayActivationInfo]),!*OSToolbox)
+ osCreateDialogCallback _ _ _ {ccMsg=CcWmPAINT,p1=hwnd} s tb
+ = //trace_n "osCreateDialogCallback CcWmPAINT"
+ (return0Cci, s, winFakePaint hwnd tb)
+ osCreateDialogCallback _ _ _ {ccMsg=CcWmACTIVATE,p1=hwnd} (control_info,delay_info) tb
+ = //trace_n "osCreateDialogCallback CcWmACTIVATE"
+ (return0Cci, (control_info,[DelayActivatedWindow hwnd:delay_info]), tb)
+ osCreateDialogCallback _ _ _ {ccMsg=CcWmDEACTIVATE,p1=hwnd} (control_info,delay_info) tb
+ = //trace_n "osCreateDialogCallback CcWmDEACTIVATE"
+ (return0Cci, (control_info,[DelayDeactivatedWindow hwnd:delay_info]), tb)
+ osCreateDialogCallback get_focus create_controls _ {ccMsg=CcWmINITDIALOG,p1=hwnd} (control_info,delay_info) tb
+ # (control_info,tb) = create_controls hwnd control_info tb
+ # (defhandle,control_info) = get_focus control_info
+ (x,y) = pos
+ (w,h) = size
+ r5cci = return5Cci x y w h (if (defhandle==OSNoWindowPtr) 0 defhandle)
+ = (r5cci, (control_info,delay_info), tb)
+ osCreateDialogCallback _ _ update_controls {ccMsg=CcWmDRAWCONTROL,p1=hdlog,p2=hctrl,p3=hdc} (control_info,delay_info) tb
+ # (control_info,tb) = update_controls hdlog hctrl hdc control_info tb
+ = (return0Cci, (control_info,delay_info), tb)
+ osCreateDialogCallback _ _ _ {ccMsg=CcWmKEYBOARD} s tb
+ = //trace_n "osCreateDialogCallback CcWmKEYBOARD"
+ (return0Cci, s, tb)
+ osCreateDialogCallback _ _ _ {ccMsg=CcWmSETFOCUS} s tb
+ = //trace_n "osCreateDialogCallback CcWmSETFOCUS"
+ (return0Cci, s, tb)
+ osCreateDialogCallback _ _ _ {ccMsg=CcWmKILLFOCUS} s tb
+ = //trace_n "osCreateDialogCallback CcWmKILLFOCUS"
+ (return0Cci, s, tb)
+ osCreateDialogCallback _ _ _ {ccMsg} s tb
+ = oswindowFatalError "osCreateDialogCallback" ("unknown message type ("+++toString ccMsg+++")")
+
+osCreateWindow :: !OSWindowMetrics !Bool !ScrollbarInfo !ScrollbarInfo !(!Int,!Int) !(!Int,!Int)
+ !Bool !String !(!Int,!Int) !(!Int,!Int)
+ !(u:s->*(OSWindowPtr,u:s))
+ !(OSWindowPtr->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !OSDInfo !OSWindowPtr !u:s !*OSToolbox
+ -> (![DelayActivationInfo],!OSWindowPtr,!OSWindowPtr,!OSWindowPtr,!OSDInfo,!u:s,!*OSToolbox)
+osCreateWindow wMetrics isResizable hInfo=:{cbiHasScroll=hasHScroll} vInfo=:{cbiHasScroll=hasVScroll} minSize maxSize
+ isClosable title pos size
+ get_focus
+ create_controls
+ update_controls
+ osdInfo behindPtr control_info tb
+ | di==MDI
+ # (textPtr,tb) = winMakeCString title tb
+ styleFlags = WS_SYSMENU
+ bitor WS_OVERLAPPED
+ bitor (if hasHScroll WS_HSCROLL 0)
+ bitor (if hasVScroll WS_VSCROLL 0)
+ bitor (if isResizable WS_THICKFRAME 0)
+ // bitor WS_CLIPCHILDREN
+ createcci = Rq6Cci CcRqCREATEMDIDOCWINDOW textPtr osinfo.osClient behindPtr (x<<16+(y<<16)>>16) (w<<16+(h<<16)>>16) styleFlags
+ # (returncci,(control_info,delay_info),tb)
+ = issueCleanRequest (osCreateWindowCallback isResizable minSize maxSize create_controls update_controls)
+ createcci
+ (control_info,[]) tb
+ # tb = winReleaseCString textPtr tb
+ wPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateWindow (MDI)"
+ # tb = setScrollRangeAndPos hasHScroll False wMetrics SB_HORZ hInfo.cbiState (0,0) wPtr tb
+ # tb = setScrollRangeAndPos hasVScroll False wMetrics SB_VERT vInfo.cbiState (0,0) wPtr tb
+ = (reverse delay_info,wPtr,OSNoWindowPtr,OSNoWindowPtr,osdInfo,control_info,tb)
+
+ | di==SDI
+ # (textPtr,tb) = winMakeCString title tb // PA+++
+ styleFlags = (if hasHScroll WS_HSCROLL 0) bitor (if hasVScroll WS_VSCROLL 0)
+ createcci = Rq6Cci CcRqCREATESDIDOCWINDOW textPtr osFrame (x<<16+(y<<16)>>16) w h styleFlags
+ # (returncci,(control_info,delay_info),tb)
+ = issueCleanRequest (osCreateWindowCallback isResizable minSize maxSize create_controls update_controls)
+ createcci
+ (control_info,[]) tb
+ # tb = winReleaseCString textPtr tb // PA+++
+ clientPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateWindow (SDI)"
+ osdInfo = setOSDInfoOSInfo {osinfo & osClient=clientPtr} osdInfo
+ # tb = setScrollRangeAndPos hasHScroll False wMetrics SB_HORZ hInfo.cbiState (0,0) clientPtr tb
+ # tb = setScrollRangeAndPos hasVScroll False wMetrics SB_VERT vInfo.cbiState (0,0) clientPtr tb
+ // # tb = osSetWindowTitle osFrame title tb
+ = (reverse delay_info,clientPtr,OSNoWindowPtr,OSNoWindowPtr,osdInfo,control_info,tb)
+
+ | otherwise
+ = oswindowFatalError "osCreateWindow" "unexpected OSDInfo (OSNoInfo) argument"
+where
+ (x,y) = pos // packed into one 32-bit integer
+ (w,h) = size
+ di = getOSDInfoDocumentInterface osdInfo
+ osinfo = fromJust (getOSDInfoOSInfo osdInfo)
+ osFrame = osinfo.osFrame
+
+osCreateWindowCallback :: !Bool !(!Int,!Int) !(!Int,!Int)
+ !(OSWindowPtr->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
+ !CrossCallInfo !*(u:s,[DelayActivationInfo]) !*OSToolbox
+ -> (!CrossCallInfo,!*(u:s,[DelayActivationInfo]),!*OSToolbox)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmPAINT,p1=hwnd} s tb
+ = //trace "osCreateWindowCallback CcWmPAINT"
+ (return0Cci, s, winFakePaint hwnd tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmACTIVATE,p1=hwnd} (control_info,delay_info) tb
+ = //trace "osCreateWindowCallback CcWmACTIVATE"
+ (return0Cci, (control_info,[DelayActivatedWindow hwnd:delay_info]), tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmDEACTIVATE,p1=hwnd} (control_info,delay_info) tb
+ = //trace "osCreateWindowCallback CcWmDEACTIVATE"
+ (return0Cci, (control_info,[DelayDeactivatedWindow hwnd:delay_info]), tb)
+osCreateWindowCallback _ _ _ create_controls _ {ccMsg=CcWmCREATE,p1=hwnd} (control_info,deactivates) tb
+ # (control_info,tb) = create_controls hwnd control_info tb
+ = (return0Cci, (control_info,deactivates), tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmNEWHTHUMB,p1=hwnd,p2=thumb} s tb
+ = //trace "osCreateWindowCallback CcWmNEWHTHUMB"
+ (return0Cci, s, tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmNEWVTHUMB,p1=hwnd,p2=thumb} s tb
+ = //trace "osCreateWindowCallback CcWmNEWVTHUMB"
+ (return0Cci, s, tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmSIZE,p1=hwnd,p2=width,p3=height} s tb
+ = //trace ("osCreateWindowCallback CcWmSIZE "+++toString (width,height))
+ (return0Cci, s, tb)
+osCreateWindowCallback _ _ _ _ update_controls {ccMsg=CcWmDRAWCONTROL,p1=hwnd,p2=hctrl,p3=hdc} (control_info,delay_info) tb
+ # (control_info,tb) = update_controls hwnd hctrl hdc control_info tb
+ = //trace ("osCreateWindowCallback CcWmDRAWCONTROL "+++toString (hwnd,hctrl,hdc))
+ (return0Cci, (control_info,delay_info), tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmKILLFOCUS} s tb
+ = //trace "osCreateWindowCallback CcWmKILLFOCUS"
+ (return0Cci, s, tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg=CcWmKEYBOARD,p1=hwnd,p2=hctrl,p3=char,p4=ks,p5=mods} s tb
+ = //trace "osCreateWindowCallback CcWmKEYBOARD "+++toString (hwnd,hctrl,char,ks,mods))
+ (return0Cci, s,tb)
+osCreateWindowCallback _ _ _ _ _ {ccMsg} s tb
+ = oswindowFatalError "osCreateWindowCallback" ("unknown message type ("+++toString ccMsg+++")")
+
+
+/* osCreateModalDialog wMetrics isCloseable title osdocinfo currentModal size
+ dialogControls dialogInit handleOSEvents
+ creates a modal dialog and handles the events until either the dialog is closed or its parent process terminated.
+ Events are handled according to handleOSEvents.
+ Controls are created according to dialogControls (only if (not osModalDialogHandlesControlCreation)!).
+ Before the event loop is entered, the dialogInit function is evaluated (only if (not osModalDialogHandlesWindowInit)!).
+*/
+:: OSModalEventHandling s
+ = OSModalEventCallback (s -> *(OSEvents,s)) (*(OSEvents,s) -> s) (OSEvent -> s -> *([Int],s))
+ | OSModalEventLoop (s -> s)
+
+osModalDialogHandlesMenuSelectState :== True
+osModalDialogHandlesWindowInit :== True
+osModalDialogHandlesControlCreation :== True
+osModalDialogHandlesEvents :== True
+
+osCreateModalDialog :: !OSWindowMetrics !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(!Int,!Int)
+ !(OSWindowPtr u:s -> u:s)
+ !(OSWindowPtr u:s -> u:s)
+ !(OSModalEventHandling u:s)
+ !(!u:s -> *(*OSToolbox,u:s), !*OSToolbox -> *(u:s -> u:s))
+ !u:s
+ -> (!Bool,!u:s)
+osCreateModalDialog wMetrics isClosable title osdinfo currentActiveModal size
+ dialogControls // evaluated iff not osModalDialogHandlesControlCreation
+ dialogInit // evaluated iff not osModalDialogHandlesWindowInit
+ (OSModalEventCallback getOSEvents setOSEvents handleOSEvents)
+ (getOSToolbox,setOSToolbox)
+ s
+ # (tb,s) = getOSToolbox s
+ # (textPtr,tb) = winMakeCString title tb
+ createcci = Rq2Cci CcRqCREATEMODALDIALOG textPtr parentptr
+ # (returncci,s,tb) = issueCleanRequest (osCreateModalDialogCallback getOSEvents setOSEvents handleOSEvents) createcci s tb
+ # tb = winReleaseCString textPtr tb
+ ok = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1==0
+ CcWASQUIT -> True
+ _ -> oswindowCreateError 1 "osCreateModalDialog"
+ # s = setOSToolbox tb s
+ = (ok,s)
+where
+ parentptr = case currentActiveModal of
+ Just wPtr -> wPtr
+ nothing -> case getOSDInfoOSInfo osdinfo of
+ Just info -> info.osFrame
+ nothing -> 0
+
+ osCreateModalDialogCallback :: !(u:s -> (OSEvents,u:s)) !((OSEvents,u:s)-> u:s) !(OSEvent -> u:s -> *([Int],u:s))
+ !CrossCallInfo !u:s !*OSToolbox
+ -> (!CrossCallInfo,!u:s,!*OSToolbox)
+ osCreateModalDialogCallback getOSEvents setOSEvents handleOSEvents osEvent s tb
+ # (replyToOS,s) = handleOSEvents osEvent s
+ | not (isEmpty replyToOS) // information must be returned to OS
+ = (setReplyInOSEvent replyToOS,s,tb)
+ # (osEvents, s) = getOSEvents s
+ # (noDelayEvents,osEvents) = osIsEmptyEvents osEvents
+ | noDelayEvents
+ = (setReplyInOSEvent replyToOS,setOSEvents (osEvents,s),tb)
+ | otherwise
+ # (osEvent,osEvents) = osRemoveEvent osEvents
+ # s = setOSEvents (osEvents,s)
+ = osCreateModalDialogCallback getOSEvents setOSEvents handleOSEvents osEvent s tb
+osCreateModalDialog _ _ _ _ _ _ _ _ (OSModalEventLoop _) _ _
+ = oswindowFatalError "osCreateModalDialog" "OSModalEventCallback argument expected instead of OSModalEventLoop"
+
+
+/* Control creation functions.
+*/
+oswindowCreateError :: Int String -> .x
+oswindowCreateError arity function
+ = oswindowFatalError function ("Expected CcRETURN"+++toString arity+++" value.\n")
+
+osIgnoreCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+osIgnoreCallback ccinfo=:{ccMsg=CcWmPAINT,p1=hwnd} tb
+ = (return0Cci,winFakePaint hwnd tb)//WinEndPaint hwnd (WinBeginPaint hwnd tb))
+osIgnoreCallback ccinfo tb
+ = (return0Cci,tb)
+
+osIgnoreCallback` :: !CrossCallInfo ![DelayActivationInfo] !*OSToolbox -> (!CrossCallInfo,![DelayActivationInfo],!*OSToolbox)
+osIgnoreCallback` {ccMsg=CcWmPAINT,p1=hwnd} s tb
+ = (return0Cci,s,winFakePaint hwnd tb)//WinEndPaint hwnd (WinBeginPaint hwnd tb))
+osIgnoreCallback` {ccMsg=CcWmACTIVATE,p1=hwnd} delayinfo tb
+ = (return0Cci,[DelayActivatedWindow hwnd:delayinfo],tb)
+osIgnoreCallback` {ccMsg=CcWmDEACTIVATE,p1=hwnd} delayinfo tb
+ = (return0Cci,[DelayDeactivatedWindow hwnd:delayinfo],tb)
+osIgnoreCallback` _ s tb
+ = (return0Cci,s,tb)
+
+/* OKorCANCEL type is used to tell Windows that a (Custom)ButtonControl is
+ the OK, CANCEL, or normal button.
+*/
+:: OKorCANCEL
+ = OK | CANCEL | NORMAL
+
+instance toInt OKorCANCEL where
+ toInt OK = ISOKBUTTON
+ toInt CANCEL = ISCANCELBUTTON
+ toInt NORMAL = ISNORMALBUTTON
+instance toString OKorCANCEL where
+ toString OK = "OK"
+ toString CANCEL = "CANCEL"
+ toString NORMAL = "NORMAL"
+
+osCreateRadioControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !(!Int,!Int) !(!Int,!Int) !Bool !Bool !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateRadioControl parentWindow parentPos title show able (x,y) (w,h) selected isfirst tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq6Cci CcRqCREATERADIOBUT parentWindow x y w h (toInt isfirst)
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ radioPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateRadioControl"
+ # tb = winSetWindowTitle radioPtr title tb
+ # tb = winCheckControl radioPtr selected tb
+ # tb = winEnableControl radioPtr able tb
+ # tb = winShowControl radioPtr show tb
+ = (radioPtr,tb)
+
+osCreateCheckControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !(!Int,!Int) !(!Int,!Int) !Bool !Bool !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateCheckControl parentWindow parentPos title show able (x,y) (w,h) selected isfirst tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq6Cci CcRqCREATECHECKBOX parentWindow x y w h (toInt isfirst)
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ checkPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateCheckControl"
+ # tb = winSetWindowTitle checkPtr title tb
+ # tb = winCheckControl checkPtr selected tb
+ # tb = winEnableControl checkPtr able tb
+ # tb = winShowControl checkPtr show tb
+ = (checkPtr,tb)
+
+MaxComboboxWidth :== 65535 // System maximum for width of combo box
+MaxComboboxHeight :== 65535 // System maximum for height of combo box
+MaxComboElementsVisible :== 15 // If there are <=MaxComboElementsVisible then show all elements
+MaxComboElementsScroll :== 12 // otherwise, show MaxComboElementsScroll elements
+
+osCreateEmptyPopUpControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !(!Int,!Int) !(!Int,!Int) !Int !Bool !*OSToolbox
+ -> (!OSWindowPtr,!OSWindowPtr,!*OSToolbox)
+osCreateEmptyPopUpControl parentWindow /*stackBehind*/ parentPos show able (x,y) (w,h) nrItems isEditable tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ # (screenRect,tb) = osScreenrect tb
+ # (wMetrics,tb) = osDefaultWindowMetrics tb
+ screenSize = rectSize screenRect
+ height = wMetrics.osmHeight
+ okNrItems = if (nrItems<=MaxComboElementsVisible) nrItems MaxComboElementsScroll
+ overall_h = min screenSize.h (min MaxComboboxHeight (h + (okNrItems+1)*(height+2)))
+ overall_w = min screenSize.w (min MaxComboboxWidth w)
+ createcci = Rq6Cci CcRqCREATEPOPUP parentWindow x y overall_w overall_h (toInt isEditable)
+ # (returncci,tb) = issueCleanRequest2 osIgnoreCallback createcci tb
+ (popUpPtr,editPtr)= case returncci.ccMsg of
+ CcRETURN2 -> (returncci.p1, returncci.p2)
+ CcWASQUIT -> (OSNoWindowPtr,OSNoWindowPtr)
+ _ -> oswindowCreateError 2 "osCreateEmptyPopUpControl"
+ # tb = winEnableControl popUpPtr able tb
+ # tb = winShowControl popUpPtr show tb
+// # (_,_,tb) = osStackWindow popUpPtr stackBehind k` 0 tb PA: parameter not passed anymore
+ // PA: for control delayinfo can be ignored (this call has been moved from controlinternal to oswindow to ensure the control
+ // is placed at the proper stacking order.)
+ = (popUpPtr,editPtr,tb)
+
+osCreatePopUpControlItem :: !OSWindowPtr !(Maybe OSWindowPtr) !Int !Bool !String !Bool !Int !*OSToolbox -> (!Int,!*OSToolbox)
+osCreatePopUpControlItem parentPopUp _ pos able title selected _ tb
+ # (textPtr,tb) = winMakeCString title tb
+ addcci = Rq5Cci CcRqADDTOPOPUP parentPopUp textPtr (toInt able) (toInt selected) pos
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback addcci tb
+ # tb = winReleaseCString textPtr tb
+ index = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> 0
+ _ -> oswindowCreateError 1 "osCreatePopUpControlItem"
+ = (index,tb)
+
+osCreatePopUpControlItems :: !OSWindowPtr !(Maybe OSWindowPtr) !Bool ![String] !Int !*OSToolbox -> *OSToolbox
+osCreatePopUpControlItems newPopUpPtr maybeEditPtr ableContext newItems newIndex tb
+ # (_,tb) = stateMap2 (appendPopUp newPopUpPtr maybeEditPtr newIndex) newItems (1,tb)
+ = tb
+where
+ appendPopUp :: !OSWindowPtr !(Maybe OSWindowPtr) !Index !String !(!Int,!*OSToolbox) -> (!Int,!*OSToolbox)
+ appendPopUp popUpPtr editPtr index title (itemNr,tb)
+ # (_,tb) = osCreatePopUpControlItem popUpPtr editPtr (-1) ableContext title (index==itemNr) itemNr tb
+ = (itemNr+1,tb)
+
+osCreateSliderControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !Bool !(!Int,!Int) !(!Int,!Int) !(!Int,!Int,!Int,!Int) !*OSToolbox
+ -> (!OSWindowPtr,!*OSToolbox)
+osCreateSliderControl parentWindow parentPos show able horizontal (x,y) (w,h) (min,thumb,max,thumbSize) tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq6Cci CcRqCREATESCROLLBAR parentWindow x y w h (toInt horizontal)
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ sliderPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateSliderControl"
+ # tb = winSetScrollRange sliderPtr SB_CTL min max False tb
+ # tb = winSetScrollPos sliderPtr SB_CTL thumb (x+w) (y+h) (if horizontal h w) tb
+ # tb = winSetScrollThumbSize sliderPtr SB_CTL thumbSize 0 0 0 tb // PA: hint by Diederik to add this code to solve Maarten's bug
+ # tb = winEnableControl sliderPtr able tb
+ # tb = winShowControl sliderPtr show tb
+ = (sliderPtr,tb)
+
+osCreateTextControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSWindowPtr,!*OSToolbox)
+osCreateTextControl parentWindow parentPos text show (x,y) (w,h) tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq5Cci CcRqCREATESTATICTXT parentWindow x y w h
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ textPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateTextControl"
+ # tb = winSetWindowTitle textPtr text tb
+ # tb = winShowControl textPtr show tb
+ = (textPtr,tb)
+
+osCreateEditControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !Bool !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSWindowPtr,!*OSToolbox)
+osCreateEditControl parentWindow parentPos text show able isKeySensitive (x,y) (w,h) tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ # (wMetrics,tb) = osDefaultWindowMetrics tb
+ nrLines = (h-wMetrics.osmHeight)/wMetrics.osmHeight //toInt ((toReal h) / (1.5*(toReal wMetrics.osmHeight)))
+ isMultiLine = nrLines>1
+ editflags = (if isMultiLine EDITISMULTILINE 0) + (if isKeySensitive EDITISKEYSENSITIVE 0)
+ createcci = Rq6Cci CcRqCREATEEDITTXT parentWindow x y w h editflags
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ editPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateEditControl"
+ # tb = winSetWindowTitle editPtr text tb
+ # tb = winEnableControl editPtr able tb
+ # tb = winShowControl editPtr show tb
+ = (editPtr,tb)
+
+osCreateButtonControl :: !OSWindowPtr !(!Int,!Int) !String !Bool !Bool !(!Int,!Int) !(!Int,!Int) !OKorCANCEL !*OSToolbox -> (!OSWindowPtr,!*OSToolbox)
+osCreateButtonControl parentWindow parentPos title show able (x,y) (w,h) okOrCancel tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq6Cci CcRqCREATEBUTTON parentWindow x y w h (toInt okOrCancel)
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ buttonPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateButtonControl"
+ # tb = winSetWindowTitle buttonPtr title tb
+ # tb = winEnableControl buttonPtr able tb
+ # tb = winShowControl buttonPtr show tb
+ = (buttonPtr,tb)
+
+osCreateCustomButtonControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !(!Int,!Int) !(!Int,!Int) !OKorCANCEL !*OSToolbox -> (!OSWindowPtr,!*OSToolbox)
+osCreateCustomButtonControl parentWindow parentPos show able (x,y) (w,h) okOrCancel tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq6Cci CcRqCREATEICONBUT parentWindow x y w h (toInt okOrCancel)
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ buttonPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateCustomButtonControl"
+ # tb = winEnableControl buttonPtr able tb
+ # tb = winShowControl buttonPtr show tb
+ = (buttonPtr,tb)
+
+osCreateCustomControl :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSWindowPtr,!*OSToolbox)
+osCreateCustomControl parentWindow parentPos show able (x,y) (w,h) tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ createcci = Rq5Cci CcRqCREATECUSTOM parentWindow x y w h
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ customPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateCustomControl"
+ # tb = winEnableControl customPtr able tb
+ # tb = winShowControl customPtr show tb
+ = (customPtr,tb)
+
+:: ScrollbarInfo
+ = { cbiHasScroll :: !Bool // The scrollbar exists
+ , cbiPos :: (Int,Int) // Its position within the parent
+ , cbiSize :: (Int,Int) // Its size within the parent
+ , cbiState :: (Int,Int,Int,Int) // Its (min,thumb,max,thumbsize) settings
+ }
+
+osCreateCompoundControl :: !OSWindowMetrics !OSWindowPtr !(!Int,!Int) !Bool !Bool !Bool !(!Int,!Int) !(!Int,!Int)
+ !ScrollbarInfo
+ !ScrollbarInfo
+ !*OSToolbox
+ -> (!OSWindowPtr,!OSWindowPtr,!OSWindowPtr,!*OSToolbox)
+osCreateCompoundControl wMetrics parentWindow parentPos show able isTransparent (x,y) (w,h)
+ hInfo=:{cbiHasScroll=hasHScroll}
+ vInfo=:{cbiHasScroll=hasVScroll} tb
+ # (x,y) = (x-fst parentPos,y-snd parentPos)
+ scrollFlags = (if hasHScroll WS_HSCROLL 0) bitor (if hasVScroll WS_VSCROLL 0)
+ createcci = Rq6Cci CcRqCREATECOMPOUND parentWindow (x<<16+(y<<16)>>16) w h scrollFlags (toInt isTransparent)
+ # (returncci,tb)= issueCleanRequest2 osIgnoreCallback createcci tb
+ compoundPtr = case returncci.ccMsg of
+ CcRETURN1 -> returncci.p1
+ CcWASQUIT -> OSNoWindowPtr
+ _ -> oswindowCreateError 1 "osCreateCompoundControl"
+ # tb = setScrollRangeAndPos hasHScroll False wMetrics SB_HORZ hInfo.cbiState (0,0) compoundPtr tb
+ # tb = setScrollRangeAndPos hasVScroll False wMetrics SB_VERT vInfo.cbiState (0,0) compoundPtr tb
+ # tb = winSetSelectStateWindow compoundPtr (hasHScroll,hasVScroll) able False tb
+ # tb = winShowControl compoundPtr show tb
+ = (compoundPtr,OSNoWindowPtr,OSNoWindowPtr,tb)
+
+setScrollRangeAndPos :: !Bool Bool OSWindowMetrics Int (Int,Int,Int,Int) (Int,Int) OSWindowPtr !*OSToolbox -> *OSToolbox
+setScrollRangeAndPos hasScroll redraw wMetrics iBar state maxcoords wPtr tb
+ | not hasScroll
+ = tb
+ # tb = winSetScrollRange wPtr iBar min max False tb
+ # tb = winSetScrollPos wPtr iBar thumb 0 0 0 tb
+ | redraw
+ = winSetScrollThumbSize wPtr iBar thumbsize maxx maxy extent tb
+ | otherwise
+ = winSetScrollThumbSize wPtr iBar thumbsize 0 0 0 tb
+where
+ (min,thumb,max,thumbsize) = state
+ (maxx,maxy) = maxcoords
+ horizontal = iBar==SB_HORZ
+ extent = if horizontal wMetrics.osmHSliderHeight wMetrics.osmVSliderWidth
+
+
+/* Window destruction operations.
+ PA: osDestroyWindow checks the process document interface and applies the appropriate destruction operation.
+*/
+/* PA: previous implementation of osDestroyWindow without update handling.
+osDestroyWindow :: !OSDInfo !Bool !Bool !OSWindowPtr !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+osDestroyWindow (OSMDInfo {osmdFrame,osmdClient}) isModal isWindow wPtr tb
+ # (_,delayInfo,tb) = issueCleanRequest osDelayCallback destroycci [] tb
+ = (reverse delayInfo,tb)
+where
+ destroycci = if isWindow (Rq3Cci CcRqDESTROYMDIDOCWINDOW osmdFrame osmdClient wPtr)
+ (if isModal (Rq1Cci CcRqDESTROYMODALDIALOG wPtr)
+ (Rq1Cci CcRqDESTROYWINDOW wPtr))
+osDestroyWindow (OSSDInfo _) isModal isWindow wPtr tb
+ # (_,delayInfo,tb) = issueCleanRequest osDelayCallback destroycci [] tb//(Rq1Cci CcRqDESTROYWINDOW wPtr) [] tb
+ = (reverse delayInfo,tb)
+where
+ destroycci = if isModal (Rq1Cci CcRqDESTROYMODALDIALOG wPtr)
+ (Rq1Cci CcRqDESTROYWINDOW wPtr)
+osDestroyWindow OSNoInfo isModal isWindow wPtr tb
+ | isWindow /* This condition should never occur (NDI processes have only dialogues). */
+ = oswindowFatalError "osDestroyWindow" "trying to destroy window of NDI process"
+ | otherwise
+ # (_,delayInfo,tb)= issueCleanRequest osDelayCallback destroycci [] tb//(Rq1Cci CcRqDESTROYWINDOW wPtr) [] tb
+ = (reverse delayInfo,tb)
+where
+ destroycci = if isModal (Rq1Cci CcRqDESTROYMODALDIALOG wPtr)
+ (Rq1Cci CcRqDESTROYWINDOW wPtr)
+
+osDelayCallback :: !CrossCallInfo ![DelayActivationInfo] !*OSToolbox
+ -> (!CrossCallInfo,![DelayActivationInfo],!*OSToolbox)
+osDelayCallback {ccMsg=CcWmPAINT,p1=wPtr} s tb
+ = (return0Cci,s,winFakePaint wPtr tb)
+osDelayCallback {ccMsg=CcWmACTIVATE,p1=wPtr} delayinfo tb
+ = (return0Cci,[DelayActivatedWindow wPtr:delayinfo],tb)
+osDelayCallback {ccMsg=CcWmDEACTIVATE,p1=wPtr} delayinfo tb
+ = (return0Cci,[DelayDeactivatedWindow wPtr:delayinfo],tb)
+osDelayCallback {ccMsg} s tb
+ | expected = (return0Cci,s,tb)
+ | otherwise = oswindowFatalError "osDelayCallback" ("unexpected delay message "+++toString ccMsg)
+where
+ expected = case ccMsg of
+ CcWmCLOSE -> True
+ CcWmDRAWCONTROL -> True
+ CcWmIDLETIMER -> True
+ CcWmKEYBOARD -> True
+ CcWmKILLFOCUS -> True
+ CcWmMOUSE -> True
+ CcWmSETFOCUS -> True
+ CcWmSIZE -> True
+ _ -> False
+*/
+/* PA: OSDInfo is now also returned by osDestroyWindow.
+ By - personal - convention its argument position has been moved to the end of osDestroyWindow.
+ Note: on Windows platform OSDInfo is not modified.
+*/
+osDestroyWindow :: !Bool !Bool !OSWindowPtr !(OSEvent -> .s -> ([Int],.s)) !OSDInfo !.s !*OSToolbox
+ -> (![DelayActivationInfo],!OSDInfo,.s,!*OSToolbox)
+osDestroyWindow isModal isWindow wPtr handleOSEvent osdInfo state tb
+ | di==MDI
+ # destroycci = if isWindow (Rq3Cci CcRqDESTROYMDIDOCWINDOW osFrame osClient wPtr)
+ (if isModal (Rq1Cci CcRqDESTROYMODALDIALOG wPtr)
+ (Rq1Cci CcRqDESTROYWINDOW wPtr))
+ # (_,(delayInfo,state),tb) = issueCleanRequest (osDelayCallback handleOSEvent) destroycci ([],state) tb
+ = (reverse delayInfo,osdInfo,state,tb)
+ | di==SDI
+ # destroycci = if isModal (Rq1Cci CcRqDESTROYMODALDIALOG wPtr)
+ (Rq1Cci CcRqDESTROYWINDOW wPtr)
+ # (_,(delayInfo,state),tb) = issueCleanRequest (osDelayCallback handleOSEvent) destroycci ([],state) tb
+ = (reverse delayInfo,osdInfo,state,tb)
+ // It's a NDI process
+ | isWindow /* This condition should never occur (NDI processes have only dialogues). */
+ = oswindowFatalError "osDestroyWindow" "trying to destroy window of NDI process"
+ | otherwise
+ # destroycci = if isModal (Rq1Cci CcRqDESTROYMODALDIALOG wPtr)
+ (Rq1Cci CcRqDESTROYWINDOW wPtr)
+ # (_,(delayInfo,state),tb) = issueCleanRequest (osDelayCallback handleOSEvent) destroycci ([],state) tb
+ = (reverse delayInfo,osdInfo,state,tb)
+where
+ di = getOSDInfoDocumentInterface osdInfo
+ {osFrame,osClient} = fromJust (getOSDInfoOSInfo osdInfo)
+
+osDelayCallback :: !(OSEvent -> .s -> ([Int],.s)) !CrossCallInfo !(![DelayActivationInfo],.s) !*OSToolbox
+ -> (!CrossCallInfo,!(![DelayActivationInfo],.s),!*OSToolbox)
+osDelayCallback handleOSEvent osEvent=:{ccMsg} (delayinfo,s) tb
+ | toBeHandled
+ # (replyToOS,s) = handleOSEvent osEvent s
+ = (setReplyInOSEvent replyToOS,(delayinfo,s),tb)
+ | ccMsg==CcWmACTIVATE
+ = (return0Cci,([DelayActivatedWindow osEvent.p1:delayinfo],s),tb)
+ | ccMsg==CcWmDEACTIVATE
+ = (return0Cci,([DelayDeactivatedWindow osEvent.p1:delayinfo],s),tb)
+ | toBeSkipped
+ = (return0Cci,(delayinfo,s),tb)
+ | otherwise
+ = oswindowFatalError "osDelayCallback" ("unexpected delay message "+++toString ccMsg)
+where
+ toBeHandled = case ccMsg of
+ CcWmPAINT -> True
+ CcWmDRAWCONTROL -> True
+ CcWmKEYBOARD -> True
+ CcWmKILLFOCUS -> True
+ CcWmMOUSE -> True
+ CcWmSETFOCUS -> True
+ other -> False
+ toBeSkipped = case ccMsg of
+ CcWmCLOSE -> True
+ CcWmIDLETIMER -> True
+ CcWmSIZE -> True
+ other -> False
+
+
+/* Control destruction operations.
+*/
+destroycontrol :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+destroycontrol wPtr tb
+ = snd (issueCleanRequest2 osDestroyControlCallback (Rq1Cci CcRqDESTROYWINDOW wPtr) tb)
+where
+ osDestroyControlCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
+ osDestroyControlCallback info=:{ccMsg} tb
+ | ccMsg==CcWmPAINT
+ = (return0Cci,winFakePaint info.p1 tb)//WinEndPaint info.p1 (WinBeginPaint info.p1 tb))
+ | expected
+ = (return0Cci,tb)
+ | otherwise
+ = oswindowFatalError "osDestroyControlCallback" ("unexpected message "+++toString ccMsg)
+ where
+ expected = case ccMsg of
+ CcWmACTIVATE -> True
+ CcWmBUTTONCLICKED -> True
+ CcWmCOMBOSELECT -> True
+ CcWmCOMMAND -> True
+ CcWmDEACTIVATE -> True
+ CcWmDRAWCONTROL -> True
+ CcWmIDLETIMER -> True
+ CcWmKEYBOARD -> True
+ CcWmKILLFOCUS -> True
+ CcWmSETFOCUS -> True
+ _ -> False
+
+osDestroyRadioControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyRadioControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyCheckControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCheckControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyPopUpControl :: !OSWindowPtr !(Maybe OSWindowPtr) !*OSToolbox -> *OSToolbox
+osDestroyPopUpControl wPtr _ tb = destroycontrol wPtr tb
+
+osDestroySliderControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroySliderControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyTextControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyTextControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyEditControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyEditControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyButtonControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyButtonControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyCustomButtonControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCustomButtonControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyCustomControl :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCustomControl wPtr tb = destroycontrol wPtr tb
+
+osDestroyCompoundControl :: !OSWindowPtr !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osDestroyCompoundControl wPtr _ _ tb = destroycontrol wPtr tb
+
+
+/* Control update operations.
+*/
+osUpdateRadioControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateRadioControl area pos parentWindow theControl tb = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+osUpdateCheckControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateCheckControl area pos parentWindow theControl tb = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+osUpdatePopUpControl :: !OSRect !OSWindowPtr !OSWindowPtr !(Maybe OSWindowPtr) !(!Int,!Int) !(!Int,!Int) !Bool !String !*OSToolbox -> *OSToolbox
+osUpdatePopUpControl area parentWindow theControl editControl pos size select text tb
+ = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+osUpdateSliderControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateSliderControl area pos parentWindow theControl tb = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+//OSupdateTextControl :: !OSRect !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+//OSupdateTextControl area parentWindow theControl tb = updatecontrol theControl area tb
+osUpdateTextControl :: !OSRect !OSRect !String !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateTextControl area _ _ pos parentWindow theControl tb
+ = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+//OSupdateEditControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+//OSupdateEditControl area pos parentWindow theControl tb = updatecontrol theControl (subVector (fromTuple pos) area) tb
+osUpdateEditControl :: !OSRect !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateEditControl area _ pos parentWindow theControl tb
+ = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+//OSupdateButtonControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+//OSupdateButtonControl area pos parentWindow theControl tb = updatecontrol theControl (subVector (fromTuple pos) area) tb
+osUpdateButtonControl :: !OSRect !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateButtonControl area _ pos parentWindow theControl tb
+ = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+//OSupdateCompoundControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+//OSupdateCompoundControl area pos parentWindow theControl tb = updatecontrol theControl (subVector (fromTuple pos) area) tb
+osUpdateCompoundControl :: !OSRect !(!Int,!Int) !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osUpdateCompoundControl area pos parentWindow theControl tb
+ = updatecontrol theControl (subVector (fromTuple pos) area) tb
+
+updatecontrol :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+updatecontrol theControl rect tb = winUpdateWindowRect theControl (toTuple4 rect) tb
+
+
+/* Control clipping operations.
+*/
+oscliprectrgn :: !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+oscliprectrgn parent_pos=:(parent_x,parent_y) rect (x,y) (w,h) tb
+ = osnewrectrgn (intersectRects area item) tb
+where
+ area = subVector (fromTuple parent_pos) rect
+ x` = x-parent_x
+ y` = y-parent_y
+ item = {rleft=x`,rtop=y`,rright=x`+w,rbottom=y`+h}
+
+osClipRadioControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipRadioControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipCheckControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCheckControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipPopUpControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipPopUpControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipSliderControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipSliderControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipTextControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipTextControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipEditControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipEditControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipButtonControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipButtonControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipCustomButtonControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCustomButtonControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipCustomControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCustomControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+osClipCompoundControl :: !OSWindowPtr !(!Int,!Int) !OSRect !(!Int,!Int) !(!Int,!Int) !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
+osClipCompoundControl _ parentPos area itemPos itemSize tb = oscliprectrgn parentPos area itemPos itemSize tb
+
+/* Window graphics context access operations.
+*/
+osGrabWindowPictContext :: !OSWindowPtr !*OSToolbox -> (!OSPictContext,!*OSToolbox)
+osGrabWindowPictContext wPtr tb
+ = winGetDC wPtr tb
+
+osReleaseWindowPictContext :: !OSWindowPtr !OSPictContext !*OSToolbox -> *OSToolbox
+osReleaseWindowPictContext wPtr hdc tb
+ = winReleaseDC wPtr (hdc,tb)
+
+
+/* osBeginUpdate theWindow
+ makes additional preparations to do updates. Dummy on Windows.
+ osEndUpdate theWindow
+ administrates and ends the update. Dummy on Windows.
+*/
+osBeginUpdate :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osBeginUpdate _ tb = tb
+
+osEndUpdate :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osEndUpdate _ tb = tb
+
+osSetUpdate :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osSetUpdate _ tb = tb
+
+
+/* (acc/app)Grafport theWindow f
+ applies f to the graphics context of theWindow (dummy on Windows).
+ (acc/app)Clipport theWindow clipRect f
+ applies f to the graphics context of theWindow while clipping clipRect (dummy on Windows).
+*/
+accGrafport :: !OSWindowPtr !.(St *OSToolbox .x) !*OSToolbox -> (!.x, !*OSToolbox)
+accGrafport _ f tb = f tb
+
+appGrafport :: !OSWindowPtr !.(*OSToolbox -> *OSToolbox) !*OSToolbox -> *OSToolbox
+appGrafport _ f tb = f tb
+
+accClipport :: !OSWindowPtr !OSRect !.(St *OSToolbox .x) !*OSToolbox -> (!.x, !*OSToolbox)
+accClipport _ _ f tb = f tb
+
+appClipport :: !OSWindowPtr !OSRect !.(*OSToolbox -> *OSToolbox) !*OSToolbox -> *OSToolbox
+appClipport _ _ f tb = f tb
+
+
+/* Window access operations.
+*/
+toOSscrollbarRange :: !(!Int,!Int,!Int) !Int -> (!Int,!Int,!Int,!Int)
+toOSscrollbarRange (domainMin,viewMin,domainMax) viewSize
+ = (osRangeMin,osThumb,osRangeMax,osThumbSize+1)
+where
+ (osRangeMin,osRangeMax) = toOSRange (domainMin,domainMax)
+ range = domainMax- domainMin
+ osRange = osRangeMax-osRangeMin
+ osThumb = inRange osRangeMin osRange (viewMin-domainMin) range
+ osThumbSize = if (viewSize>=range) osRange (toInt (((toReal viewSize)/(toReal range))*(toReal osRange)))
+
+fromOSscrollbarRange :: !(!Int,!Int) !Int -> Int
+fromOSscrollbarRange (domainMin,domainMax) osThumb
+ = inRange domainMin range (osThumb-osRangeMin) osRange
+where
+ (osRangeMin,osRangeMax) = toOSRange (domainMin,domainMax)
+ range = domainMax- domainMin
+ osRange = osRangeMax-osRangeMin
+
+osScrollbarIsVisible :: !(!Int,!Int) !Int -> Bool
+osScrollbarIsVisible (domainMin,domainMax) viewSize
+ = viewSize<domainMax-domainMin
+
+osScrollbarsAreVisible :: !OSWindowMetrics !OSRect !(!Int,!Int) !(!Bool,!Bool) -> (!Bool,!Bool)
+osScrollbarsAreVisible {osmHSliderHeight,osmVSliderWidth} {rleft=xMin,rtop=yMin,rright=xMax,rbottom=yMax} (width,height) (hasHScroll,hasVScroll)
+ = visScrollbars (False,False)
+ (hasHScroll && (osScrollbarIsVisible hRange width),hasVScroll && (osScrollbarIsVisible vRange height))
+where
+ hRange = (xMin,xMax)
+ vRange = (yMin,yMax)
+
+ visScrollbars :: !(!Bool,!Bool) !(!Bool,!Bool) -> (!Bool,!Bool)
+ visScrollbars (showH1,showV1) (showH2,showV2)
+ | showH1==showH2 && showV1==showV2
+ = (showH1,showV1)
+ | otherwise
+ = visScrollbars (showH2,showV2) (showH,showV)
+ where
+ showH = if showV2 (hasHScroll && osScrollbarIsVisible hRange (width -osmVSliderWidth )) showH2
+ showV = if showH2 (hasVScroll && osScrollbarIsVisible vRange (height-osmHSliderHeight)) showV2
+
+toOSRange :: !(!Int,!Int) -> (!Int,!Int)
+toOSRange (min,max)
+ = (OSSliderMin,if (range<=OSSliderRange) (OSSliderMin+range) OSSliderMax)
+where
+ range = max-min
+
+inRange :: !Int !Int !Int !Int -> Int
+inRange destMin destRange sourceValue sourceRange
+ | sourceRange == 0
+ = 0 // DvA: avoid obscure windows bug for ide
+ | otherwise
+ = destMin + (toInt (((toReal sourceValue) / (toReal sourceRange)) * (toReal destRange)))
+
+OSSliderMin :== 0 // 0
+OSSliderMax :== 32767 // MaxSigned2ByteInt
+OSSliderRange :== 32767 // OSSliderMax-OSSliderMin
+
+
+osSetWindowSliderThumb :: !OSWindowMetrics !OSWindowPtr !Bool !Int !(Maybe OSWindowPtr) !(Maybe OSWindowPtr) !OSRect !OSRect !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetWindowSliderThumb wMetrics theWindow isHorizontal thumb _ _ _ _ (maxx,maxy) redraw tb
+ = winSetScrollPos theWindow (if isHorizontal SB_HORZ SB_VERT) thumb maxx maxy extent tb
+where
+ extent = if isHorizontal wMetrics.osmHSliderHeight wMetrics.osmVSliderWidth
+
+osSetWindowSliderThumbSize :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !Bool !Int !Int !Int !(!Int,!Int) !OSRect !Bool !Bool !*OSToolbox -> *OSToolbox
+osSetWindowSliderThumbSize wMetrics theWindow _ isHorizontal min max size (maxx,maxy) _ _ redraw tb
+ # tb = winSetScrollRange theWindow (if isHorizontal SB_HORZ SB_VERT) min max False tb
+ = winSetScrollThumbSize theWindow (if isHorizontal SB_HORZ SB_VERT) size maxx maxy extent tb
+where
+ extent = if isHorizontal wMetrics.osmHSliderHeight wMetrics.osmVSliderWidth
+
+// PA: dummy function, required only for Mac (moved from \OS Macintosh\osutil) and made type independent of WindowHandle.
+osSetWindowSliderPosSize :: !OSWindowPtr !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osSetWindowSliderPosSize _ scrollPtr possize tb = tb
+
+osInvalidateWindow :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osInvalidateWindow theWindow tb
+ = winInvalidateWindow theWindow tb
+
+osInvalidateWindowRect :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osInvalidateWindowRect theWindow rect tb
+ = winInvalidateRect theWindow (toTuple4 rect) tb
+
+osValidateWindowRect :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osValidateWindowRect theWindow rect tb
+ = winValidateRect theWindow (toTuple4 rect) tb
+
+osValidateWindowRgn :: !OSWindowPtr !OSRgnHandle !*OSToolbox -> *OSToolbox
+osValidateWindowRgn theWindow rgn tb
+ = winValidateRgn theWindow rgn tb
+
+osWindowHasUpdateRect :: !OSWindowPtr !*OSToolbox -> (!Bool,!*OSToolbox)
+osWindowHasUpdateRect wPtr tb
+ # (ret,tb) = GetUpdateRect wPtr 0 0 tb
+ = (ret<>0, tb)
+where
+ GetUpdateRect :: !Int !Int !Int !*Int -> (!Int,!*Int)
+ GetUpdateRect _ _ _ _ = code {
+ ccall GetUpdateRect "PIII:I:I"
+ }
+
+osDisableWindow :: !OSWindowPtr !(!Bool,!Bool) !Bool !*OSToolbox -> *OSToolbox
+osDisableWindow theWindow scrollInfo modalContext tb
+ = winSetSelectStateWindow theWindow scrollInfo False modalContext tb
+
+osEnableWindow :: !OSWindowPtr !(!Bool,!Bool) !Bool !*OSToolbox -> *OSToolbox
+osEnableWindow theWindow scrollInfo modalContext tb
+ = winSetSelectStateWindow theWindow scrollInfo True modalContext tb
+
+osActivateWindow :: !OSDInfo !OSWindowPtr !(OSEvent->(.s,*OSToolbox)->(.s,*OSToolbox)) !.s !*OSToolbox
+ -> (![DelayActivationInfo],!.s,!*OSToolbox)
+osActivateWindow osdInfo thisWindow handleOSEvent state tb
+ # (_,(delayinfo,state),tb) = issueCleanRequest (osDelayActivationEventsCallback handleOSEvent) (Rq3Cci CcRqACTIVATEWINDOW (toInt isMDI) clientPtr thisWindow) ([],state) tb
+ = (reverse delayinfo,state,tb)
+where
+ isMDI = getOSDInfoDocumentInterface osdInfo==MDI
+ clientPtr = case (getOSDInfoOSInfo osdInfo) of
+ Just {osClient} -> osClient
+ nothing -> oswindowFatalError "osActivateWindow" "illegal DocumentInterface context"
+
+/* osDelayActivationEventsCallback delays activate and deactivate events for windows/dialogues/controls.
+ All other events are passed to the callback function.
+ Note that the returned [DelayActivationInfo] is in reversed order.
+ This function is also used by osActivateControl.
+*/
+osDelayActivationEventsCallback :: !(OSEvent->(.s,*OSToolbox)->(.s,*OSToolbox)) !CrossCallInfo !(![DelayActivationInfo],!.s) !*OSToolbox
+ -> (!CrossCallInfo,!(![DelayActivationInfo],!.s),!*OSToolbox)
+osDelayActivationEventsCallback handleOSEvent osEvent=:{ccMsg,p1,p2} (delayinfo,s) tb
+ | isDelayEvent
+ = (return0Cci,([delayEvent:delayinfo],s),tb)
+ | otherwise
+ # (s,tb) = handleOSEvent osEvent (s,tb)
+ = (return0Cci,(delayinfo,s),tb)
+where
+ (isDelayEvent,delayEvent) = case ccMsg of
+ CcWmACTIVATE -> (True,DelayActivatedWindow p1)
+ CcWmDEACTIVATE -> (True,DelayDeactivatedWindow p1)
+ CcWmKILLFOCUS -> (True,DelayDeactivatedControl p1 p2)
+ CcWmSETFOCUS -> (True,DelayActivatedControl p1 p2)
+ _ -> (False,undef)
+
+
+osActivateControl :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+osActivateControl parentWindow controlPtr tb
+ # (_,delayinfo,tb) = issueCleanRequest osIgnoreCallback` (Rq1Cci CcRqACTIVATECONTROL controlPtr) [] tb
+ = (reverse delayinfo,tb)
+where
+ osIgnoreCallback` :: !CrossCallInfo ![DelayActivationInfo] !*OSToolbox -> (!CrossCallInfo,![DelayActivationInfo],!*OSToolbox)
+ osIgnoreCallback` {ccMsg=CcWmPAINT,p1=hwnd} s tb
+ = (return0Cci,s,winFakePaint hwnd tb)//winEndPaint hwnd (winBeginPaint hwnd tb))
+ osIgnoreCallback` {ccMsg=CcWmKILLFOCUS,p1=hwnd,p2=cptr} delayinfo tb
+ = (return0Cci,[DelayDeactivatedControl hwnd cptr:delayinfo],tb)
+ osIgnoreCallback` {ccMsg=CcWmSETFOCUS,p1=hwnd,p2=cptr} delayinfo tb
+ = (return0Cci,[DelayActivatedControl hwnd cptr:delayinfo],tb)
+ osIgnoreCallback` _ s tb
+ = (return0Cci,s,tb)
+
+/* PA: previous implementation of osStackWindow ignored window updates and resizes. This is fixed below.
+osStackWindow :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> *OSToolbox
+osStackWindow thisWindow behindWindow tb
+ = winRestackWindow thisWindow behindWindow tb
+
+winRestackWindow :: !HWND !HWND !*OSToolbox -> *OSToolbox
+winRestackWindow theWindow behindWindow tb
+ = snd (issueCleanRequest2 (errorCallback2 "winRestackWindow") (Rq2Cci CcRqRESTACKWINDOW theWindow behindWindow) tb)
+*/
+
+osStackWindow :: !OSWindowPtr !OSWindowPtr !(OSEvent->(.s,*OSToolbox)->(.s,*OSToolbox)) !.s !*OSToolbox
+ -> (![DelayActivationInfo],!.s,!*OSToolbox)
+osStackWindow thisWindow behindWindow handleOSEvent state tb
+ # (_,(delayinfo,state),tb) = issueCleanRequest (osDelayActivationEventsCallback handleOSEvent) (Rq2Cci CcRqRESTACKWINDOW thisWindow behindWindow) ([],state) tb
+ = (reverse delayinfo,state,tb)
+
+osHideWindow :: !OSWindowPtr !Bool !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+osHideWindow wPtr activate tb
+ # (_,delayinfo,tb) = issueCleanRequest osIgnoreCallback` (Rq3Cci CcRqSHOWWINDOW wPtr (toInt False) (toInt activate)) [] tb
+ = (reverse delayinfo,tb)
+
+osShowWindow :: !OSWindowPtr !Bool !*OSToolbox -> (![DelayActivationInfo],!*OSToolbox)
+osShowWindow wPtr activate tb
+ # (_,delayinfo,tb) = issueCleanRequest osIgnoreCallback` (Rq3Cci CcRqSHOWWINDOW wPtr (toInt True) (toInt activate)) [] tb
+ = (reverse delayinfo,tb)
+
+osSetWindowCursor :: !OSWindowPtr !CursorShape !*OSToolbox -> *OSToolbox
+osSetWindowCursor wPtr shape tb
+ = winSetWindowCursor wPtr cursorCode tb
+where
+ cursorCode = toCursorCode shape
+
+// PA: moved from windowaccess.
+ toCursorCode :: !CursorShape -> Int
+ toCursorCode StandardCursor = CURSARROW
+ toCursorCode BusyCursor = CURSBUSY
+ toCursorCode IBeamCursor = CURSIBEAM
+ toCursorCode CrossCursor = CURSCROSS
+ toCursorCode FatCrossCursor = CURSFATCROSS
+ toCursorCode ArrowCursor = CURSARROW
+ toCursorCode HiddenCursor = CURSHIDDEN
+
+osGetWindowPos :: !OSWindowPtr !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetWindowPos wPtr tb
+ = winGetWindowPos wPtr tb
+
+osGetWindowViewFrameSize :: !OSWindowPtr !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetWindowViewFrameSize wPtr tb
+ = winGetClientSize wPtr tb
+
+osGetWindowSize :: !OSWindowPtr !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+osGetWindowSize wPtr tb
+ = winGetWindowSize wPtr tb
+
+osSetWindowPos :: !OSWindowPtr !(!Int,!Int) !Bool !Bool !*OSToolbox -> *OSToolbox
+osSetWindowPos wPtr pos update inclScrollbars tb
+ = winSetWindowPos wPtr pos update inclScrollbars tb
+
+osSetWindowViewFrameSize :: !OSWindowPtr !(!Int,!Int) !*OSToolbox -> *OSToolbox
+osSetWindowViewFrameSize wPtr size tb
+ = winSetClientSize wPtr size tb
+
+osSetWindowSize :: !OSWindowPtr !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetWindowSize wPtr size update tb
+ = winSetWindowSize wPtr size update tb
+
+osSetWindowTitle :: !OSWindowPtr !String !*OSToolbox -> *OSToolbox
+osSetWindowTitle wPtr title tb
+ = winSetWindowTitle wPtr title tb
+
+
+/* Control access operations.
+*/
+// On compound controls:
+
+osInvalidateCompound :: !OSWindowPtr !*OSToolbox -> *OSToolbox
+osInvalidateCompound compoundPtr tb
+ = winInvalidateWindow compoundPtr tb
+
+/* PA: not used
+osInvalidateCompoundRect :: !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osInvalidateCompoundRect compoundPtr rect tb
+ = winInvalidateRect compoundPtr (toTuple4 rect) tb
+*/
+
+osSetCompoundSliderThumb :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !OSWindowPtr !OSRect !Bool !Int !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSliderThumb wMetrics _ compoundPtr _ _ isHorizontal thumb (maxx,maxy) redraw tb
+ = winSetScrollPos compoundPtr (if isHorizontal SB_HORZ SB_VERT) thumb maxx` maxy` extent tb
+where
+ (maxx`,maxy`,extent) = if redraw (maxx,maxy,if isHorizontal wMetrics.osmHSliderHeight wMetrics.osmVSliderWidth) (0,0,0)
+
+osSetCompoundSliderThumbSize :: !OSWindowMetrics !OSWindowPtr !OSWindowPtr !OSWindowPtr !Int !Int !Int !OSRect !Bool !Bool !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSliderThumbSize wMetrics _ compoundPtr _ min max size rect isHorizontal _ redraw tb
+ # tb = winSetScrollRange compoundPtr (if isHorizontal SB_HORZ SB_VERT) min max False tb
+ = winSetScrollThumbSize compoundPtr (if isHorizontal SB_HORZ SB_VERT) size maxx` maxy` extent tb
+where
+ (maxx`,maxy`,extent) = if redraw (rect.rright,rect.rbottom,if isHorizontal wMetrics.osmHSliderHeight wMetrics.osmVSliderWidth) (0,0,0)
+/*
+osSetCompoundSlider :: !OSWindowMetrics !OSWindowPtr !Bool !(!Int,!Int,!Int,!Int) !(!Int,!Int) !*OSToolbox -> *OSToolbox
+osSetCompoundSlider wMetrics compoundPtr isHorizontal state maxcoords tb
+ = setScrollRangeAndPos True True wMetrics (if isHorizontal SB_HORZ SB_VERT) state maxcoords compoundPtr tb
+*/
+osSetCompoundSelect :: !OSWindowPtr !OSWindowPtr !OSRect !(!Bool,!Bool) !(!OSWindowPtr,!OSWindowPtr) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSelect _ compoundPtr _ scrollInfo _ select tb
+ = winSetSelectStateWindow compoundPtr scrollInfo select False tb
+// = winEnableControl compoundPtr scrollInfo select tb
+
+osSetCompoundShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundShow _ compoundPtr _ _ show tb
+ = winShowControl compoundPtr show tb
+
+osSetCompoundPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundPos _ (parent_x,parent_y) compoundPtr (x,y) _ update tb
+ = winSetWindowPos compoundPtr (x-parent_x,y-parent_y) update True tb
+
+osSetCompoundSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCompoundSize _ _ compoundPtr _ size update tb
+ = winSetWindowSize compoundPtr size update tb
+
+// PA: dummy function, required only for Mac
+osUpdateCompoundScroll :: !OSWindowPtr !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osUpdateCompoundScroll _ _ _ tb
+ = tb
+
+osCompoundMovesControls :== True
+
+osCompoundControlHasOrigin :== True
+
+
+// On slider controls:
+
+osSetSliderControlThumb :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+osSetSliderControlThumb _ cPtr _ redraw (min,thumb,max,thumbsize) tb
+ # tb = winSetScrollRange cPtr SB_CTL min max False tb
+ # tb = winSetScrollThumbSize cPtr SB_CTL thumbsize 0 0 0 tb
+ = winSetScrollPos cPtr SB_CTL thumb 0 0 0 tb
+
+osSetSliderControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlSelect _ cPtr _ select tb
+ = winEnableControl cPtr select tb
+
+osSetSliderControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlShow _ cPtr _ show tb
+ = winShowControl cPtr show tb
+
+osSetSliderControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlPos _ (parent_x,parent_y) sliderPtr (x,y) _ update tb
+ = winSetWindowPos sliderPtr (x-parent_x,y-parent_y) update False tb
+
+osSetSliderControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetSliderControlSize _ _ sliderPtr _ size update tb
+ = winSetWindowSize sliderPtr size update tb
+
+
+// On radio controls:
+
+osSetRadioControl :: !OSWindowPtr !OSWindowPtr !OSWindowPtr !OSRect !*OSToolbox -> *OSToolbox
+osSetRadioControl _ current new _ tb
+ = winCheckControl new True (winCheckControl current False tb)
+
+osSetRadioControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlSelect _ cPtr _ select tb
+ = winEnableControl cPtr select tb
+
+osSetRadioControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlShow _ cPtr _ show tb
+ = winShowControl cPtr show tb
+
+osSetRadioControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlPos _ (parent_x,parent_y) radioPtr (x,y) _ update tb
+ = winSetWindowPos radioPtr (x-parent_x,y-parent_y) update False tb
+
+osSetRadioControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetRadioControlSize _ _ radioPtr _ size update tb
+ = winSetWindowSize radioPtr size update tb
+
+
+// On check controls:
+
+osSetCheckControl :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControl _ cPtr _ check tb
+ = winCheckControl cPtr check tb
+
+osSetCheckControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlSelect _ cPtr _ select tb
+ = winEnableControl cPtr select tb
+
+osSetCheckControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlShow _ cPtr _ show tb
+ = winShowControl cPtr show tb
+
+osSetCheckControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlPos _ (parent_x,parent_y) checkPtr (x,y) _ update tb
+ = winSetWindowPos checkPtr (x-parent_x,y-parent_y) update False tb
+
+osSetCheckControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCheckControlSize _ _ checkPtr _ size update tb
+ = winSetWindowSize checkPtr size update tb
+
+
+// On pop up controls:
+
+osSetPopUpControl :: !OSWindowPtr !OSWindowPtr !(Maybe OSWindowPtr) !OSRect !OSRect !Int !Int !String !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControl _ pPtr _ _ _ _ new _ _ tb
+ = winSelectPopupItem pPtr (new-1) tb
+
+osSetPopUpControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlSelect _ pPtr _ select tb
+ = winEnableControl pPtr select tb
+
+osSetPopUpControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlShow _ pPtr _ show tb
+ = winShowControl pPtr show tb
+
+osSetPopUpControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlPos _ (parent_x,parent_y) popupPtr (x,y) _ update tb
+ = winSetWindowPos popupPtr (x-parent_x,y-parent_y) update False tb
+
+osSetPopUpControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetPopUpControlSize _ _ popupPtr _ size update tb
+ = winSetWindowSize popupPtr size update tb
+
+osGetPopUpControlText :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!String,!*OSToolbox)
+osGetPopUpControlText _ ePtr tb
+ = winGetWindowText ePtr tb
+
+
+// On edit controls:
+
+osSetEditControlText :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !String !*OSToolbox -> *OSToolbox
+osSetEditControlText _ ePtr _ _ _ text tb
+ = winSetWindowTitle ePtr text tb
+
+osGetEditControlText :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!String,!*OSToolbox)
+osGetEditControlText _ ePtr tb
+ = winGetWindowText ePtr tb
+
+osSetEditControlCursor :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Int !*OSToolbox -> *OSToolbox
+osSetEditControlCursor _ ePtr _ _ pos tb
+ = winSetEditSelection ePtr pos (pos+1) tb
+
+osSetEditControlSelection :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Int !Int !*OSToolbox -> *OSToolbox
+osSetEditControlSelection _ ePtr _ _ start end tb
+ = winSetEditSelection ePtr start end tb
+
+osSetEditControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlSelect _ ePtr _ select tb
+ = winEnableControl ePtr select tb
+
+osSetEditControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlShow _ ePtr _ show tb
+ = winShowControl ePtr show tb
+
+osSetEditControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlPos _ (parent_x,parent_y) editPtr (x,y) _ update tb
+ = winSetWindowPos editPtr (x-parent_x,y-parent_y) update False tb
+
+osSetEditControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetEditControlSize _ _ editPtr _ size update tb
+ = winSetWindowSize editPtr size update tb
+
+// Dummy implementation; used on Mac only (windowevent.icl):
+osIdleEditControl :: !OSWindowPtr !OSRect !OSWindowPtr !*OSToolbox -> *OSToolbox
+osIdleEditControl _ _ _ tb = tb
+
+
+// On text controls:
+
+osSetTextControlText :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !String !*OSToolbox -> *OSToolbox
+osSetTextControlText _ tPtr _ _ _ text tb
+ = winSetWindowTitle tPtr text tb
+
+osSetTextControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetTextControlSelect _ tPtr _ select tb
+ = winEnableControl tPtr select tb
+
+osSetTextControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !String !*OSToolbox -> *OSToolbox
+osSetTextControlShow _ tPtr _ _ show _ tb
+ = winShowControl tPtr show tb
+
+osSetTextControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetTextControlPos _ (parent_x,parent_y) textPtr (x,y) _ update tb
+ = winSetWindowPos textPtr (x-parent_x,y-parent_y) update False tb
+
+osSetTextControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetTextControlSize _ _ textPtr _ size update tb
+ = winSetWindowSize textPtr size update tb
+
+
+// On button controls:
+
+osSetButtonControlText :: !OSWindowPtr !OSWindowPtr !OSRect !String !*OSToolbox -> *OSToolbox
+osSetButtonControlText _ bPtr _ text tb
+ = winSetWindowTitle bPtr text tb
+
+osSetButtonControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlSelect _ bPtr _ select tb
+ = winEnableControl bPtr select tb
+
+osSetButtonControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlShow _ bPtr _ show tb
+ = winShowControl bPtr show tb
+
+osSetButtonControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlPos _ (parent_x,parent_y) buttonPtr (x,y) _ update tb
+ = winSetWindowPos buttonPtr (x-parent_x,y-parent_y) update False tb
+
+osSetButtonControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetButtonControlSize _ _ buttonPtr _ size update tb
+ = winSetWindowSize buttonPtr size update tb
+
+
+// On custom button controls:
+
+osSetCustomButtonControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlSelect _ cPtr _ select tb
+ = winEnableControl cPtr select tb
+
+osSetCustomButtonControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlShow _ cPtr _ _ show tb
+ = winShowControl cPtr show tb
+
+osSetCustomButtonControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlPos _ (parent_x,parent_y) cPtr (x,y) _ update tb
+ = winSetWindowPos cPtr (x-parent_x,y-parent_y) update False tb
+
+osSetCustomButtonControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCustomButtonControlSize _ _ cPtr _ size update tb
+ = winSetWindowSize cPtr size update tb
+
+osCustomButtonControlHasOrigin :== True
+
+
+// On custom controls:
+
+osSetCustomControlSelect :: !OSWindowPtr !OSWindowPtr !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlSelect _ cPtr _ select tb
+ = winEnableControl cPtr select tb
+
+osSetCustomControlShow :: !OSWindowPtr !OSWindowPtr !OSRect !OSRect !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlShow _ cPtr _ _ show tb
+ = winShowControl cPtr show tb
+
+osSetCustomControlPos :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlPos _ (parent_x,parent_y) customPtr (x,y) _ update tb
+ = winSetWindowPos customPtr (x-parent_x,y-parent_y) update False tb
+
+osSetCustomControlSize :: !OSWindowPtr !(!Int,!Int) !OSWindowPtr !(!Int,!Int) !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+osSetCustomControlSize _ _ customPtr _ size update tb
+ = winSetWindowSize customPtr size update tb
+
+osCustomControlHasOrigin :== True
+
+
+//--
+// PA: copied from OS Macintosh. I suppose this is to set the global cursor?
+osSetCursorShape :: !CursorShape !*OSToolbox -> *OSToolbox
+osSetCursorShape _ tb = tb
diff --git a/pictCCall_12.dcl b/pictCCall_12.dcl new file mode 100644 index 0000000..1bb37d5 --- /dev/null +++ b/pictCCall_12.dcl @@ -0,0 +1,168 @@ +definition module pictCCall_12
+
+
+from rgnCCall_12 import :: HRGN
+from ostoolbox import :: OSToolbox
+from ostypes import :: OSRect, :: HDC
+
+
+:: *PIC
+ :== ( !HDC
+ , !*OSToolbox
+ )
+:: Pt
+ :== ( !Int
+ , !Int
+ )
+:: RGBcolor
+ :== ( !Int
+ , !Int
+ , !Int
+ )
+:: Fnt
+ :== ( !{#Char}
+ , !Int
+ , !Int
+ )
+
+
+iWhitePattern :== 4
+iLtGreyPattern :== 3
+iGreyPattern :== 2
+iDkGreyPattern :== 1
+iBlackPattern :== 0
+
+iModeNotBic :== 7
+iModeNotXor :== 6
+iModeNotOr :== 5
+iModeNotCopy :== 4
+iModeBic :== 3
+iModeXor :== 2
+iModeOr :== 1
+iModeCopy :== 0
+
+iStrikeOut :== 8
+iUnderline :== 4
+iItalic :== 2
+iBold :== 1
+
+// PA: constants for drawing polygons.
+ALTERNATE :== 1
+WINDING :== 2
+// PA: end of addition.
+
+
+/* win(Create/Destroy)ScreenHDC added to temporarily create a HDC of a screen.
+ Never use these values for a window or control.
+*/
+winCreateScreenHDC :: !*OSToolbox -> PIC
+winDestroyScreenHDC :: !PIC -> *OSToolbox
+
+winGetPicStringWidth :: !{#Char} !PIC -> ( !Int, !PIC)
+winGetPicCharWidth :: !Char !PIC -> ( !Int, !PIC)
+winGetStringWidth :: !{#Char} !Fnt !Int !HDC !*OSToolbox -> ( !Int, !*OSToolbox)
+winGetCharWidth :: !Char !Fnt !Int !HDC !*OSToolbox -> ( !Int, !*OSToolbox)
+
+winGetPicFontInfo :: !PIC -> ( !Int, !Int, !Int, !Int, !PIC)
+winGetFontInfo :: !Fnt !Int !HDC !*OSToolbox -> ( !Int, !Int, !Int, !Int, !*OSToolbox)
+winSetFontStyle :: !Int !PIC -> PIC
+winSetFontSize :: !Int !PIC -> PIC
+winSetFontName :: !{#Char} !PIC -> PIC
+winSetFont :: !Fnt !PIC -> PIC
+
+/* Routines to PRINT bitmaps (winPrint(Resized)Bitmap).
+ Routines to DRAW bitmaps (winDraw(Resized)Bitmap).
+ Create a bitmap (winCreateBitmap).
+*/
+// MW11 winPrintBitmap :: !(!Int,!Int) !(!Int,!Int) !{#Char} !PIC -> PIC
+winPrintResizedBitmap :: !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) !{#Char} !PIC -> PIC
+winDrawBitmap :: !(!Int,!Int) !(!Int,!Int) !Int !PIC -> PIC
+winDrawResizedBitmap :: !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) !Int !PIC -> PIC
+winCreateBitmap :: !Int !{#Char} !HDC !*OSToolbox -> (!Int,!*OSToolbox)
+
+
+winInvertPolygon :: !PIC -> PIC
+winErasePolygon :: !PIC -> PIC
+winFillPolygon :: !PIC -> PIC
+winDrawPolygon :: !PIC -> PIC
+winAddPolygonPoint :: !Pt !*OSToolbox -> *OSToolbox
+winStartPolygon :: !Int !*OSToolbox -> *OSToolbox
+winEndPolygon :: !*OSToolbox -> *OSToolbox
+
+winAllocPolyShape :: !Int !*OSToolbox -> (!Int,!*OSToolbox)
+winSetPolyPoint :: !Int !Int !Int !Int !*OSToolbox -> *OSToolbox
+winFreePolyShape :: !Int !*OSToolbox -> *OSToolbox
+
+
+winInvertWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winEraseWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winFillWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winDrawWedge :: !OSRect !Pt !Pt !PIC -> PIC
+
+
+winInvertCircle :: !Pt !Int !PIC -> PIC
+winEraseCircle :: !Pt !Int !PIC -> PIC
+winFillCircle :: !Pt !Int !PIC -> PIC
+winDrawCircle :: !Pt !Int !PIC -> PIC
+
+
+winInvertOval :: !OSRect !PIC -> PIC
+winEraseOval :: !OSRect !PIC -> PIC
+winFillOval :: !OSRect !PIC -> PIC
+winDrawOval :: !OSRect !PIC -> PIC
+
+
+winInvertRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winEraseRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winFillRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winDrawRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+
+
+winScrollRectangle :: !OSRect !Pt !PIC -> (!OSRect,!PIC)
+winScrollRectangle2 :: !OSRect !Pt !PIC -> (!OSRect,!PIC)
+winCopyRectangle :: !OSRect !Pt !PIC -> PIC
+winCopyRectangleTo :: !OSRect !Pt !PIC -> PIC
+winMoveRectangle :: !OSRect !Pt !PIC -> PIC
+winMoveRectangleTo :: !OSRect !Pt !PIC -> PIC
+
+
+winInvertRectangle :: !OSRect !PIC -> PIC
+winEraseRectangle :: !OSRect !PIC -> PIC
+winFillRectangle :: !OSRect !PIC -> PIC
+winDrawRectangle :: !OSRect !PIC -> PIC
+
+
+winDrawChar :: !Int !PIC -> PIC
+winDrawString :: !{#Char} !PIC -> PIC
+
+
+winDrawCCurve :: !OSRect !Pt !Pt !RGBcolor !PIC -> PIC
+winDrawCLine :: !Pt !Pt !RGBcolor !PIC -> PIC
+winDrawCPoint :: !Pt !RGBcolor !PIC -> PIC
+winDrawCurve :: !OSRect !Pt !Pt !PIC -> PIC
+winDrawLine :: !Pt !Pt !PIC -> PIC
+winDrawPoint :: !Pt !PIC -> PIC
+
+
+winLinePen :: !Pt !PIC -> PIC
+winLinePenTo :: !Pt !PIC -> PIC
+
+winMovePen :: !Pt !PIC -> PIC
+winMovePenTo :: !Pt !PIC -> PIC
+winGetPenPos :: !PIC -> (!Int,!Int,!HDC,!*OSToolbox)
+
+winSetPenSize :: !Int !PIC -> PIC
+winSetPattern :: !Int !PIC -> PIC
+winSetMode :: !Int !PIC -> PIC
+winSetBackColor :: !RGBcolor !PIC -> PIC
+winSetPenColor :: !RGBcolor !PIC -> PIC
+
+winClipPicture :: !OSRect !PIC -> PIC
+winClipRgnPicture :: !HRGN !PIC -> PIC // Operation to set the clipping region
+winSetClipRgnPicture :: !HRGN !PIC -> PIC // Operation to completely set the clipping region
+winGetClipRgnPicture :: !PIC -> (!HRGN,!PIC) // Operation to retrieve the current clipping region
+
+winDeleteObject :: !Int !*OSToolbox -> *OSToolbox
+
+winDonePicture :: !PIC -> ( !Int, !Int, !RGBcolor, !RGBcolor, !Pt, !Fnt, !PIC)
+winInitPicture :: !Int !Int !RGBcolor !RGBcolor !Pt !Fnt !Pt !PIC -> PIC
diff --git a/pictCCall_12.icl b/pictCCall_12.icl new file mode 100644 index 0000000..b235b70 --- /dev/null +++ b/pictCCall_12.icl @@ -0,0 +1,769 @@ +implementation module pictCCall_12
+
+
+from ostypes import :: OSRect{..}, :: HDC
+import rgnCCall_12
+
+
+:: *PIC
+ :== ( !HDC
+ , !*OSToolbox
+ )
+:: Pt
+ :== ( !Int
+ , !Int
+ )
+:: RGBcolor
+ :== ( !Int
+ , !Int
+ , !Int
+ )
+:: Fnt
+ :== ( !{#Char}
+ , !Int
+ , !Int
+ )
+
+
+
+iWhitePattern :== 4
+iLtGreyPattern :== 3
+iGreyPattern :== 2
+iDkGreyPattern :== 1
+iBlackPattern :== 0
+
+iModeNotBic :== 7
+iModeNotXor :== 6
+iModeNotOr :== 5
+iModeNotCopy :== 4
+iModeBic :== 3
+iModeXor :== 2
+iModeOr :== 1
+iModeCopy :== 0
+
+iStrikeOut :== 8
+iUnderline :== 4
+iItalic :== 2
+iBold :== 1
+
+// PA: constants for drawing polygons.
+ALTERNATE :== 1
+WINDING :== 2
+// PA: end of addition.
+
+
+// PA: win(Create/Destroy)ScreenHDC added to temporarily create a HDC of a screen.
+// Never use these values for a window or control.
+winCreateScreenHDC :: !*OSToolbox -> PIC
+winCreateScreenHDC _
+ = code
+ {
+ .inline WinCreateScreenHDC
+ ccall WinCreateScreenHDC "I-II"
+ .end
+ }
+
+winDestroyScreenHDC :: !PIC -> *OSToolbox
+winDestroyScreenHDC _
+ = code
+ {
+ .inline WinDestroyScreenHDC
+ ccall WinDestroyScreenHDC "II-I"
+ .end
+ }
+
+// MW: this is never used in the object IO
+winGetPicStringWidth :: !{#Char} !PIC -> ( !Int, !PIC)
+winGetPicStringWidth _ _
+ = code
+ {
+ .inline WinGetPicStringWidth
+ ccall WinGetPicStringWidth "SII-III"
+ .end
+ }
+
+winGetPicCharWidth :: !Char !PIC -> ( !Int, !PIC)
+winGetPicCharWidth _ _
+ = code
+ {
+ .inline WinGetPicCharWidth
+ ccall WinGetPicCharWidth "III-III"
+ .end
+ }
+// END MW
+
+winGetStringWidth :: !{#Char} !Fnt !Int !HDC !*OSToolbox -> ( !Int, !*OSToolbox)
+winGetStringWidth _ _ _ _ _
+ = code
+ {
+ .inline WinGetStringWidth
+ ccall WinGetStringWidth "SSIIIII-II"
+ .end
+ }
+
+winGetCharWidth :: !Char !Fnt !Int !HDC !*OSToolbox -> ( !Int, !*OSToolbox)
+winGetCharWidth _ _ _ _ _
+ = code
+ {
+ .inline WinGetCharWidth
+ ccall WinGetCharWidth "ISIIIII-II"
+ .end
+ }
+
+winGetPicFontInfo :: !PIC -> ( !Int, !Int, !Int, !Int, !PIC)
+winGetPicFontInfo _
+ = code
+ {
+ .inline WinGetPicFontInfo
+ ccall WinGetPicFontInfo "II-IIIIII"
+ .end
+ }
+
+winGetFontInfo :: !Fnt !Int !HDC !*OSToolbox -> ( !Int, !Int, !Int, !Int, !*OSToolbox)
+winGetFontInfo _ _ _ _
+ = code
+ {
+ .inline WinGetFontInfo
+ ccall WinGetFontInfo "SIIIII-IIIII"
+ .end
+ }
+
+winSetFontStyle :: !Int !PIC -> PIC
+winSetFontStyle _ _
+ = code
+ {
+ .inline WinSetFontStyle
+ ccall WinSetFontStyle "III-II"
+ .end
+ }
+
+winSetFontSize :: !Int !PIC -> PIC
+winSetFontSize _ _
+ = code
+ {
+ .inline WinSetFontSize
+ ccall WinSetFontSize "III-II"
+ .end
+ }
+
+winSetFontName :: !{#Char} !PIC -> PIC
+winSetFontName _ _
+ = code
+ {
+ .inline WinSetFontName
+ ccall WinSetFontName "SII-II"
+ .end
+ }
+
+winSetFont :: !Fnt !PIC -> PIC
+winSetFont _ _
+ = code
+ {
+ .inline WinSetFont
+ ccall WinSetFont "SIIII-II"
+ .end
+ }
+
+
+winPrintResizedBitmap :: !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) !{#Char} !PIC -> PIC
+winPrintResizedBitmap _ _ _ _ _
+ = code
+ {
+ .inline WinPrintResizedBitmap
+ ccall WinPrintResizedBitmap "IIIIIISII-II"
+ .end
+ }
+
+// PA: Routines to DRAW bitmaps.
+winDrawBitmap :: !(!Int,!Int) !(!Int,!Int) !Int !PIC -> PIC
+winDrawBitmap _ _ _ _
+ = code
+ {
+ .inline WinDrawBitmap
+ ccall WinDrawBitmap "IIIIIII-II"
+ .end
+ }
+
+winDrawResizedBitmap :: !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) !Int !PIC -> PIC
+winDrawResizedBitmap _ _ _ _ _
+ = code
+ {
+ .inline WinDrawResizedBitmap
+ ccall WinDrawResizedBitmap "IIIIIIIII-II"
+ .end
+ }
+
+winCreateBitmap :: !Int !{#Char} !HDC !*OSToolbox -> (!Int,!*OSToolbox)
+winCreateBitmap _ _ _ _
+ = code
+ {
+ .inline WinCreateBitmap
+ ccall WinCreateBitmap "ISII-II"
+ .end
+ }
+
+winInvertPolygon :: !PIC -> PIC
+winInvertPolygon _
+ = code
+ {
+ .inline WinInvertPolygon
+ ccall WinInvertPolygon "II-II"
+ .end
+ }
+
+winErasePolygon :: !PIC -> PIC
+winErasePolygon _
+ = code
+ {
+ .inline WinErasePolygon
+ ccall WinErasePolygon "II-II"
+ .end
+ }
+
+winFillPolygon :: !PIC -> PIC
+winFillPolygon _
+ = code
+ {
+ .inline WinFillPolygon
+ ccall WinFillPolygon "II-II"
+ .end
+ }
+
+winDrawPolygon :: !PIC -> PIC
+winDrawPolygon _
+ = code
+ {
+ .inline WinDrawPolygon
+ ccall WinDrawPolygon "II-II"
+ .end
+ }
+
+winAddPolygonPoint :: !Pt !*OSToolbox -> *OSToolbox
+winAddPolygonPoint _ _
+ = code
+ {
+ .inline WinAddPolygonPoint
+ ccall WinAddPolygonPoint "III-I"
+ .end
+ }
+
+winStartPolygon :: !Int !*OSToolbox -> *OSToolbox
+winStartPolygon _ _
+ = code
+ {
+ .inline WinStartPolygon
+ ccall WinStartPolygon "II-I"
+ .end
+ }
+
+winEndPolygon :: !*OSToolbox -> *OSToolbox
+winEndPolygon _
+ = code
+ {
+ .inline WinEndPolygon
+ ccall WinEndPolygon "I-I"
+ .end
+ }
+
+/* Operations to create, modify, and destroy polygon shapes.
+*/
+winAllocPolyShape :: !Int !*OSToolbox -> (!Int,!*OSToolbox)
+winAllocPolyShape _ _
+ = code
+ {
+ .inline WinAllocPolyShape
+ ccall WinAllocPolyShape "II-II"
+ .end
+ }
+
+winSetPolyPoint :: !Int !Int !Int !Int !*OSToolbox -> *OSToolbox
+winSetPolyPoint _ _ _ _ _
+ = code
+ {
+ .inline WinSetPolyPoint
+ ccall WinSetPolyPoint "IIIII-I"
+ .end
+ }
+
+winFreePolyShape :: !Int !*OSToolbox -> *OSToolbox
+winFreePolyShape _ _
+ = code
+ {
+ .inline WinFreePolyShape
+ ccall WinFreePolyShape "II-I"
+ .end
+ }
+
+
+winInvertWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winInvertWedge _ _ _ _
+ = code
+ {
+ .inline WinInvertWedge
+ ccall WinInvertWedge "IIIIIIIIII-II"
+ .end
+ }
+
+winEraseWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winEraseWedge _ _ _ _
+ = code
+ {
+ .inline WinEraseWedge
+ ccall WinEraseWedge "IIIIIIIIII-II"
+ .end
+ }
+
+winFillWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winFillWedge _ _ _ _
+ = code
+ {
+ .inline WinFillWedge
+ ccall WinFillWedge "IIIIIIIIII-II"
+ .end
+ }
+
+winDrawWedge :: !OSRect !Pt !Pt !PIC -> PIC
+winDrawWedge _ _ _ _
+ = code
+ {
+ .inline WinDrawWedge
+ ccall WinDrawWedge "IIIIIIIIII-II"
+ .end
+ }
+
+
+winInvertCircle :: !Pt !Int !PIC -> PIC
+winInvertCircle _ _ _
+ = code
+ {
+ .inline WinInvertCircle
+ ccall WinInvertCircle "IIIII-II"
+ .end
+ }
+
+winEraseCircle :: !Pt !Int !PIC -> PIC
+winEraseCircle _ _ _
+ = code
+ {
+ .inline WinEraseCircle
+ ccall WinEraseCircle "IIIII-II"
+ .end
+ }
+
+winFillCircle :: !Pt !Int !PIC -> PIC
+winFillCircle _ _ _
+ = code
+ {
+ .inline WinFillCircle
+ ccall WinFillCircle "IIIII-II"
+ .end
+ }
+
+winDrawCircle :: !Pt !Int !PIC -> PIC
+winDrawCircle _ _ _
+ = code
+ {
+ .inline WinDrawCircle
+ ccall WinDrawCircle "IIIII-II"
+ .end
+ }
+
+
+winInvertOval :: !OSRect !PIC -> PIC
+winInvertOval _ _
+ = code
+ {
+ .inline WinInvertOval
+ ccall WinInvertOval "IIIIII-II"
+ .end
+ }
+
+winEraseOval :: !OSRect !PIC -> PIC
+winEraseOval _ _
+ = code
+ {
+ .inline WinEraseOval
+ ccall WinEraseOval "IIIIII-II"
+ .end
+ }
+
+winFillOval :: !OSRect !PIC -> PIC
+winFillOval _ _
+ = code
+ {
+ .inline WinFillOval
+ ccall WinFillOval "IIIIII-II"
+ .end
+ }
+
+winDrawOval :: !OSRect !PIC -> PIC
+winDrawOval _ _
+ = code
+ {
+ .inline WinDrawOval
+ ccall WinDrawOval "IIIIII-II"
+ .end
+ }
+
+
+winInvertRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winInvertRoundRectangle _ _ _ _
+ = code
+ {
+ .inline WinInvertRoundRectangle
+ ccall WinInvertRoundRectangle "IIIIIIII-II"
+ .end
+ }
+
+winEraseRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winEraseRoundRectangle _ _ _ _
+ = code
+ {
+ .inline WinEraseRoundRectangle
+ ccall WinEraseRoundRectangle "IIIIIIII-II"
+ .end
+ }
+
+winFillRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winFillRoundRectangle _ _ _ _
+ = code
+ {
+ .inline WinFillRoundRectangle
+ ccall WinFillRoundRectangle "IIIIIIII-II"
+ .end
+ }
+
+winDrawRoundRectangle :: !OSRect !Int !Int !PIC -> PIC
+winDrawRoundRectangle _ _ _ _
+ = code
+ {
+ .inline WinDrawRoundRectangle
+ ccall WinDrawRoundRectangle "IIIIIIII-II"
+ .end
+ }
+
+
+winScrollRectangle :: !OSRect !Pt !PIC -> (!OSRect,!PIC)
+winScrollRectangle _ _ _
+ = code
+ {
+ .inline WinScrollRectangle
+ ccall WinScrollRectangle "IIIIIIII-IIIIII"
+ .end
+ }
+
+winScrollRectangle2 :: !OSRect !Pt !PIC -> (!OSRect,!PIC)
+winScrollRectangle2 _ _ _
+ = code
+ {
+ .inline WinScrollRectangle2
+ ccall WinScrollRectangle2 "IIIIIIII-IIIIII"
+ .end
+ }
+
+winCopyRectangle :: !OSRect !Pt !PIC -> PIC
+winCopyRectangle _ _ _
+ = code
+ {
+ .inline WinCopyRectangle
+ ccall WinCopyRectangle "IIIIIIII-II"
+ .end
+ }
+
+winCopyRectangleTo :: !OSRect !Pt !PIC -> PIC
+winCopyRectangleTo _ _ _
+ = code
+ {
+ .inline WinCopyRectangleTo
+ ccall WinCopyRectangleTo "IIIIIIII-II"
+ .end
+ }
+
+winMoveRectangle :: !OSRect !Pt !PIC -> PIC
+winMoveRectangle _ _ _
+ = code
+ {
+ .inline WinMoveRectangle
+ ccall WinMoveRectangle "IIIIIIII-II"
+ .end
+ }
+
+winMoveRectangleTo :: !OSRect !Pt !PIC -> PIC
+winMoveRectangleTo _ _ _
+ = code
+ {
+ .inline WinMoveRectangleTo
+ ccall WinMoveRectangleTo "IIIIIIII-II"
+ .end
+ }
+
+
+winInvertRectangle :: !OSRect !PIC -> PIC
+winInvertRectangle _ _
+ = code
+ {
+ .inline WinInvertRectangle
+ ccall WinInvertRectangle "IIIIII-II"
+ .end
+ }
+
+winEraseRectangle :: !OSRect !PIC -> PIC
+winEraseRectangle _ _
+ = code
+ {
+ .inline WinEraseRectangle
+ ccall WinEraseRectangle "IIIIII-II"
+ .end
+ }
+
+winFillRectangle :: !OSRect !PIC -> PIC
+winFillRectangle _ _
+ = code
+ {
+ .inline WinFillRectangle
+ ccall WinFillRectangle "IIIIII-II"
+ .end
+ }
+
+winDrawRectangle :: !OSRect !PIC -> PIC
+winDrawRectangle _ _
+ = code
+ {
+ .inline WinDrawRectangle
+ ccall WinDrawRectangle "IIIIII-II"
+ .end
+ }
+
+
+winDrawChar :: !Int !PIC -> PIC
+winDrawChar _ _
+ = code
+ {
+ .inline WinDrawChar
+ ccall WinDrawChar "III-II"
+ .end
+ }
+
+winDrawString :: !{#Char} !PIC -> PIC
+winDrawString _ _
+ = code
+ {
+ .inline WinDrawString
+ ccall WinDrawString "SII-II"
+ .end
+ }
+
+
+winDrawCCurve :: !OSRect !Pt !Pt !RGBcolor !PIC -> PIC
+winDrawCCurve _ _ _ _ _
+ = code
+ {
+ .inline WinDrawCCurve
+ ccall WinDrawCCurve "IIIIIIIIIIIII-II"
+ .end
+ }
+
+winDrawCLine :: !Pt !Pt !RGBcolor !PIC -> PIC
+winDrawCLine _ _ _ _
+ = code
+ {
+ .inline WinDrawCLine
+ ccall WinDrawCLine "IIIIIIIII-II"
+ .end
+ }
+
+winDrawCPoint :: !Pt !RGBcolor !PIC -> PIC
+winDrawCPoint _ _ _
+ = code
+ {
+ .inline WinDrawCPoint
+ ccall WinDrawCPoint "IIIIIII-II"
+ .end
+ }
+
+winDrawCurve :: !OSRect !Pt !Pt !PIC -> PIC
+winDrawCurve _ _ _ _
+ = code
+ {
+ .inline WinDrawCurve
+ ccall WinDrawCurve "IIIIIIIIII-II"
+ .end
+ }
+
+winDrawLine :: !Pt !Pt !PIC -> PIC
+winDrawLine _ _ _
+ = code
+ {
+ .inline WinDrawLine
+ ccall WinDrawLine "IIIIII-II"
+ .end
+ }
+
+winDrawPoint :: !Pt !PIC -> PIC
+winDrawPoint _ _
+ = code
+ {
+ .inline WinDrawPoint
+ ccall WinDrawPoint "IIII-II"
+ .end
+ }
+
+
+winLinePen :: !Pt !PIC -> PIC
+winLinePen _ _
+ = code
+ {
+ .inline WinLinePen
+ ccall WinLinePen "IIII-II"
+ .end
+ }
+
+winLinePenTo :: !Pt !PIC -> PIC
+winLinePenTo _ _
+ = code
+ {
+ .inline WinLinePenTo
+ ccall WinLinePenTo "IIII-II"
+ .end
+ }
+
+winMovePen :: !Pt !PIC -> PIC
+winMovePen _ _
+ = code
+ {
+ .inline WinMovePen
+ ccall WinMovePen "IIII-II"
+ .end
+ }
+
+winMovePenTo :: !Pt !PIC -> PIC
+winMovePenTo _ _
+ = code
+ {
+ .inline WinMovePenTo
+ ccall WinMovePenTo "IIII-II"
+ .end
+ }
+
+winGetPenPos :: !PIC -> (!Int,!Int,!HDC,!*OSToolbox)
+winGetPenPos _
+ = code
+ {
+ .inline WinGetPenPos
+ ccall WinGetPenPos "II-IIII"
+ .end
+ }
+
+
+winSetPenSize :: !Int !PIC -> PIC
+winSetPenSize _ _
+ = code
+ {
+ .inline WinSetPenSize
+ ccall WinSetPenSize "III-II"
+ .end
+ }
+
+winSetPattern :: !Int !PIC -> PIC
+winSetPattern _ _
+ = code
+ {
+ .inline WinSetPattern
+ ccall WinSetPattern "III-II"
+ .end
+ }
+
+winSetMode :: !Int !PIC -> PIC
+winSetMode _ _
+ = code
+ {
+ .inline WinSetMode
+ ccall WinSetMode "III-II"
+ .end
+ }
+
+winSetBackColor :: !RGBcolor !PIC -> PIC
+winSetBackColor _ _
+ = code
+ {
+ .inline WinSetBackColor
+ ccall WinSetBackColor "IIIII-II"
+ .end
+ }
+
+winSetPenColor :: !RGBcolor !PIC -> PIC
+winSetPenColor _ _
+ = code
+ {
+ .inline WinSetPenColor
+ ccall WinSetPenColor "IIIII-II"
+ .end
+ }
+
+
+winClipPicture :: !OSRect !PIC -> PIC
+winClipPicture _ _
+ = code
+ {
+ .inline WinClipPicture
+ ccall WinClipPicture "IIIIII-II"
+ .end
+ }
+
+// PA: operation to set the clipping region.
+winClipRgnPicture :: !HRGN !PIC -> PIC
+winClipRgnPicture _ _
+ = code
+ {
+ .inline WinClipRgnPicture
+ ccall WinClipRgnPicture "III-II"
+ .end
+ }
+
+// PA+++: new operation to set the complete clipping region.
+winSetClipRgnPicture :: !HRGN !PIC -> PIC
+winSetClipRgnPicture _ _
+ = code
+ {
+ .inline WinSetClipRgnPicture
+ ccall WinSetClipRgnPicture "III-II"
+ .end
+ }
+
+// PA+++: new operation to retrieve the current clipping region.
+winGetClipRgnPicture :: !PIC -> (!HRGN,!PIC)
+winGetClipRgnPicture _
+ = code
+ {
+ .inline WinGetClipRgnPicture
+ ccall WinGetClipRgnPicture "II-III"
+ .end
+ }
+
+winDeleteObject :: !Int !*OSToolbox -> *OSToolbox
+winDeleteObject _ _
+ = code
+ {
+ .inline WinDeleteObject
+ ccall WinDeleteObject "II-I"
+ .end
+ }
+
+
+winDonePicture :: !PIC -> (!Int,!Int,!RGBcolor,!RGBcolor,!Pt,!Fnt,!PIC)
+winDonePicture _
+ = code
+ {
+ .inline WinDonePicture
+ ccall WinDonePicture "II-IIIIIIIIIISIIII"
+ .end
+ }
+
+winInitPicture :: !Int !Int !RGBcolor !RGBcolor !Pt !Fnt !Pt !PIC -> PIC
+winInitPicture _ _ _ _ _ _ _ _
+ = code
+ {
+ .inline WinInitPicture
+ ccall WinInitPicture "IIIIIIIIIISIIIIII-II"
+ .end
+ }
diff --git a/processevent.dcl b/processevent.dcl new file mode 100644 index 0000000..03526b1 --- /dev/null +++ b/processevent.dcl @@ -0,0 +1,14 @@ +definition module processevent
+
+
+// Clean Object I/O library, version 1.2
+
+// processevent defines the DeviceEventFunction for the process device.
+// This function is placed in a separate module because it is platform dependent.
+
+
+import deviceevents
+from iostate import :: PSt
+
+
+processEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
diff --git a/processevent.icl b/processevent.icl new file mode 100644 index 0000000..a1a5465 --- /dev/null +++ b/processevent.icl @@ -0,0 +1,89 @@ +implementation module processevent
+
+
+import StdArray, StdBool, StdList
+from clCrossCall_12 import CcWmDDEEXECUTE, CcWmPROCESSCLOSE, CcWmPROCESSDROPFILES, :: CrossCallInfo(..)
+from clCCall_12 import winGetCStringAndFree, :: CSTR
+from ostypes import OSNoWindowPtr, :: OSWindowPtr
+import deviceevents, iostate
+from commondef import fatalError
+from processstack import topShowProcessShowState
+
+processeventFatalError :: String String -> .x
+processeventFatalError function error
+ = fatalError function "processevent" error
+
+
+/* processEvent filters the scheduler events that can be handled by this process device.
+ processEvent assumes that it is not applied to an empty IOSt.
+*/
+processEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+
+processEvent schedulerEvent=:(ScheduleOSEvent osEvent=:{ccMsg} _) pState=:{io=ioState}
+ | isProcessOSEvent ccMsg
+ # (processStack,ioState) = ioStGetProcessStack ioState
+ (found,systemId) = topShowProcessShowState processStack
+ # (ioId,ioState) = ioStGetIOId ioState
+ # (osdInfo,ioState) = ioStGetOSDInfo ioState
+ # (tb,ioState) = getIOToolbox ioState
+ # (myEvent,replyToOS,deviceEvent,tb)
+ = filterOSEvent osEvent (found && systemId==ioId) osdInfo tb
+ # ioState = setIOToolbox tb ioState
+ # pState = {pState & io=ioState}
+ schedulerEvent = if (isJust replyToOS) (ScheduleOSEvent osEvent (fromJust replyToOS)) schedulerEvent
+ = (myEvent,deviceEvent,schedulerEvent,pState)
+ | otherwise
+ = (False,Nothing,schedulerEvent,pState)
+where
+ isProcessOSEvent :: !Int -> Bool
+ isProcessOSEvent CcWmDDEEXECUTE = True
+ isProcessOSEvent CcWmPROCESSCLOSE = True
+ isProcessOSEvent CcWmPROCESSDROPFILES = True
+ isProcessOSEvent _ = False
+
+processEvent schedulerEvent pState
+ = (False,Nothing,schedulerEvent,pState)
+
+
+/* filterOSEvent filters the OSEvents that can be handled by this process device.
+ The Bool argument is True iff the parent process is visible and active.
+*/
+filterOSEvent :: !OSEvent !Bool !OSDInfo !*OSToolbox -> (!Bool,!Maybe [Int],!Maybe DeviceEvent,!*OSToolbox)
+
+filterOSEvent {ccMsg=CcWmDDEEXECUTE,p1=cString} isActive _ tb
+ | not isActive
+ = (False,Nothing,Nothing,tb)
+ | otherwise
+ # (fName,tb) = winGetCStringAndFree cString tb
+ = (True,Nothing,Just (ProcessRequestOpenFiles [fName]),tb)
+
+filterOSEvent {ccMsg=CcWmPROCESSCLOSE,p1=framePtr} _ osdInfo tb
+ | framePtr==getOSDInfoFramePtr osdInfo
+ = (True,Nothing,Just ProcessRequestClose,tb)
+ | otherwise
+ = (False,Nothing,Nothing,tb)
+
+filterOSEvent {ccMsg=CcWmPROCESSDROPFILES,p1=framePtr,p2=cString} _ osdInfo tb
+ | framePtr<>getOSDInfoFramePtr osdInfo
+ = (False,Nothing,Nothing,tb)
+ | otherwise
+ # (allNames,tb) = winGetCStringAndFree cString tb
+ allNames = if (allNames.[size allNames-1]=='\n') allNames (allNames+++"\n")
+ = (True,Nothing,Just (ProcessRequestOpenFiles (filter ((<>) "") (getFileNames 0 0 (size allNames) allNames []))),tb)
+where
+// getFileNames assumes that the file names are separated by a single '\n' and the string ends with a '\n'.
+ getFileNames :: !Int !Int !Int !String [String] -> [String]
+ getFileNames low up nrChars allNames fNames
+ | up>=nrChars = fNames
+ | allNames.[up]=='\n' = getFileNames (up+1) (up+1) nrChars allNames [allNames%(low,up-1):fNames]
+ | otherwise = getFileNames low (up+1) nrChars allNames fNames
+
+filterOSEvent _ _ _ _
+ = processeventFatalError "filterOSEvent" "unmatched OSEvent"
+
+
+getOSDInfoFramePtr :: !OSDInfo -> OSWindowPtr
+getOSDInfoFramePtr osdInfo
+ = case (getOSDInfoOSInfo osdInfo) of
+ Just info -> info.osFrame
+ _ -> OSNoWindowPtr
diff --git a/receiverevent.dcl b/receiverevent.dcl new file mode 100644 index 0000000..b335ef6 --- /dev/null +++ b/receiverevent.dcl @@ -0,0 +1,14 @@ +definition module receiverevent
+
+
+// Clean Object I/O library, version 1.2
+
+// receiverevent defines the DeviceEventFunction for the receiver device.
+// This function is placed in a separate module because it is platform dependent.
+
+
+import deviceevents
+from iostate import :: PSt
+
+
+receiverEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
diff --git a/receiverevent.icl b/receiverevent.icl new file mode 100644 index 0000000..84f19b6 --- /dev/null +++ b/receiverevent.icl @@ -0,0 +1,28 @@ +implementation module receiverevent
+
+import StdBool
+import deviceevents, iostate, /*MW11*/ clCrossCall_12
+from StdPSt import accPIO
+
+
+/* receiverEvent filters the appropriate events for the receiver device.
+ These are only the message events (as long as receivers do not contain timers).
+ receiverEvent assumes that it is not applied to an empty IOSt.
+*/
+receiverEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+receiverEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState
+ # (ioid,pState) = accPIO ioStGetIOId pState
+ recloc = case msgEvent of
+ (QASyncMessage {qasmRecLoc}) -> qasmRecLoc
+ (ASyncMessage { asmRecLoc}) -> asmRecLoc
+ (SyncMessage { smRecLoc}) -> smRecLoc
+ | ioid==recloc.rlIOId && ReceiverDevice==recloc.rlDevice
+ = (True, Just (ReceiverEvent msgEvent),schedulerEvent,pState)
+ | otherwise
+ = (False,Nothing,schedulerEvent,pState)
+// MW11..
+receiverEvent schedulerEvent=:(ScheduleOSEvent {ccMsg=CcWmINETEVENT,p1,p2,p3,p4} _) pState
+ = (True, Just (InternetEvent (p1,p2,p3,p4)), schedulerEvent, pState)
+// ..MW11
+receiverEvent schedulerEvent pState
+ = (False,Nothing,schedulerEvent,pState)
diff --git a/rgnCCall.icl b/rgnCCall.icl new file mode 100644 index 0000000..f1855c4 --- /dev/null +++ b/rgnCCall.icl @@ -0,0 +1,3 @@ +implementation module rgnCCall
+
+
diff --git a/rgnCCall_12.dcl b/rgnCCall_12.dcl new file mode 100644 index 0000000..ef196a4 --- /dev/null +++ b/rgnCCall_12.dcl @@ -0,0 +1,24 @@ +definition module rgnCCall_12
+
+
+from ostoolbox import :: OSToolbox
+
+
+:: HRGN :== Int
+
+
+// PA: CombineRgn() Styles.
+RGN_AND :== 1
+RGN_OR :== 2
+RGN_XOR :== 3
+RGN_DIFF :== 4
+RGN_COPY :== 5
+// PA: end of addition.
+
+
+// PA: operations to create, modify and destroy regions.
+winCreateRectRgn :: !Int !Int !Int !Int !*OSToolbox -> (!HRGN,!*OSToolbox)
+winCreatePolygonRgn :: !Int !Int !Int !*OSToolbox -> (!HRGN,!*OSToolbox)
+winSetRgnToRect :: !Int !Int !Int !Int !HRGN !*OSToolbox -> (!HRGN,!*OSToolbox)
+winCombineRgn :: !HRGN !HRGN !HRGN !Int !*OSToolbox -> (!HRGN,!*OSToolbox)
+winGetRgnBox :: !HRGN !*OSToolbox -> (!Int,!Int,!Int,!Int,!Bool,!Bool,!*OSToolbox)
diff --git a/rgnCCall_12.icl b/rgnCCall_12.icl new file mode 100644 index 0000000..3cf9c5c --- /dev/null +++ b/rgnCCall_12.icl @@ -0,0 +1,64 @@ +implementation module rgnCCall_12
+
+
+from ostoolbox import :: OSToolbox
+
+
+:: HRGN :== Int
+
+
+// PA: CombineRgn() Styles.
+RGN_AND :== 1
+RGN_OR :== 2
+RGN_XOR :== 3
+RGN_DIFF :== 4
+RGN_COPY :== 5
+// PA: end of addition.
+
+
+/* PA: operations to create, modify and destroy regions.
+*/
+winCreateRectRgn :: !Int !Int !Int !Int !*OSToolbox -> (!HRGN,!*OSToolbox)
+winCreateRectRgn _ _ _ _ _
+ = code
+ {
+ .inline WinCreateRectRgn
+ ccall WinCreateRectRgn "IIIII-II"
+ .end
+ }
+
+winCreatePolygonRgn :: !Int !Int !Int !*OSToolbox -> (!HRGN,!*OSToolbox)
+winCreatePolygonRgn _ _ _ _
+ = code
+ {
+ .inline WinCreatePolygonRgn
+ ccall WinCreatePolygonRgn "IIII-II"
+ .end
+ }
+
+winSetRgnToRect :: !Int !Int !Int !Int !HRGN !*OSToolbox -> (!HRGN,!*OSToolbox)
+winSetRgnToRect _ _ _ _ _ _
+ = code
+ {
+ .inline WinSetRgnToRect
+ ccall WinSetRgnToRect "IIIIII-II"
+ .end
+ }
+
+winCombineRgn :: !HRGN !HRGN !HRGN !Int !*OSToolbox -> (!HRGN,!*OSToolbox)
+winCombineRgn _ _ _ _ _
+ = code
+ {
+ .inline WinCombineRgn
+ ccall WinCombineRgn "IIIII-II"
+ .end
+ }
+
+winGetRgnBox :: !HRGN !*OSToolbox -> (!Int,!Int,!Int,!Int,!Bool,!Bool,!*OSToolbox)
+winGetRgnBox _ _
+ = code
+ {
+ .inline WinGetRgnBox
+ ccall WinGetRgnBox "II-IIIIIII"
+ .end
+ }
diff --git a/timerevent.dcl b/timerevent.dcl new file mode 100644 index 0000000..656e8a3 --- /dev/null +++ b/timerevent.dcl @@ -0,0 +1,15 @@ +definition module timerevent
+
+
+// Clean Object I/O library, version 1.2
+
+/* timerevent defines the DeviceEventFunction for the timer device.
+ This function is placed in a separate module because it is platform dependent.
+*/
+
+
+import deviceevents
+from iostate import :: PSt
+
+
+timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
diff --git a/timerevent.icl b/timerevent.icl new file mode 100644 index 0000000..8c70e62 --- /dev/null +++ b/timerevent.icl @@ -0,0 +1,63 @@ +implementation module timerevent
+
+
+import StdBool, StdClass
+import deviceevents, timeraccess
+from commondef import fatalError, ucontains, :: UCond
+from iostate import :: PSt{..}, :: IOSt, ioStHasDevice, ioStGetDevice, ioStSetDevice, ioStGetIOId
+from StdPSt import accPIO
+
+
+timereventFatalError :: String String -> .x
+timereventFatalError function error
+ = fatalError function "timerevent" error
+
+
+/* The timerEvent function determines whether the given SchedulerEvent can be applied
+ to a timer of this process. These are the following cases:
+ * ScheduleTimerEvent: the timer event belongs to this process and device
+ * ScheduleMsgEvent: the message event belongs to this process and device
+ timerEvent assumes that it is not applied to an empty IOSt.
+*/
+timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+timerEvent schedulerEvent pState
+ # (hasDevice,pState) = accPIO (ioStHasDevice TimerDevice) pState
+ | not hasDevice // This condition should never occur: TimerDevice must have been 'installed'
+ = timereventFatalError "TimerFunctions.dEvent" "could not retrieve TimerSystemState from IOSt"
+ | otherwise
+ = timerEvent schedulerEvent pState
+where
+ timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+ timerEvent schedulerEvent=:(ScheduleTimerEvent te=:{teLoc}) pState=:{io=ioState}
+ # (ioid,ioState) = ioStGetIOId ioState
+ | teLoc.tlIOId<>ioid || teLoc.tlDevice<>TimerDevice
+ = (False,Nothing,schedulerEvent,{pState & io=ioState})
+ # (_,timer,ioState) = ioStGetDevice TimerDevice ioState
+ # timers = timerSystemStateGetTimerHandles timer
+ (found,timers) = lookForTimer teLoc.tlParentId timers
+ # ioState = ioStSetDevice (TimerSystemState timers) ioState
+ # pState = {pState & io=ioState}
+ | found
+ #! deviceEvent = TimerEvent te
+ = (True,Just deviceEvent,schedulerEvent,pState)
+ | otherwise
+ = (False,Nothing,schedulerEvent,pState)
+ where
+ lookForTimer :: !Id !(TimerHandles .pst) -> (!Bool,!TimerHandles .pst)
+ lookForTimer parent timers=:{tTimers=tHs}
+ # (found,tHs) = ucontains (identifyTimerStateHandle parent) tHs
+ = (found,{timers & tTimers=tHs})
+
+ timerEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState
+ # (ioid,pState) = accPIO ioStGetIOId pState
+ recloc = case msgEvent of
+ (QASyncMessage {qasmRecLoc}) -> qasmRecLoc
+ (ASyncMessage { asmRecLoc}) -> asmRecLoc
+ (SyncMessage { smRecLoc}) -> smRecLoc
+ | ioid==recloc.rlIOId && TimerDevice==recloc.rlDevice
+ = (True,Just (ReceiverEvent msgEvent),schedulerEvent,pState)
+ | otherwise
+ = (False,Nothing,schedulerEvent,pState)
+
+ timerEvent schedulerEvent pState
+ = (False,Nothing,schedulerEvent,pState)
diff --git a/windowCCall_12.dcl b/windowCCall_12.dcl new file mode 100644 index 0000000..90cea92 --- /dev/null +++ b/windowCCall_12.dcl @@ -0,0 +1,17 @@ +definition module windowCCall_12
+
+
+from ostoolbox import :: OSToolbox
+from ostypes import :: HWND
+from rgnCCall_12 import :: HRGN
+from pictCCall_12 import :: HDC
+
+
+winInitialiseWindows:: !*OSToolbox -> *OSToolbox
+winInvalidateWindow :: !HWND !*OSToolbox -> *OSToolbox
+winInvalidateRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winValidateRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winValidateRgn :: !HWND !HRGN !*OSToolbox -> *OSToolbox
+
+winGetDC :: !HWND !*OSToolbox -> (!HDC,!*OSToolbox)
+winReleaseDC :: !HWND !(!HDC,!*OSToolbox) -> *OSToolbox
diff --git a/windowCCall_12.icl b/windowCCall_12.icl new file mode 100644 index 0000000..e21a79e --- /dev/null +++ b/windowCCall_12.icl @@ -0,0 +1,72 @@ +implementation module windowCCall_12
+
+
+from ostoolbox import :: OSToolbox
+from ostypes import :: HWND
+from rgnCCall_12 import :: HRGN
+from pictCCall_12 import :: HDC
+import code from "cCCallWindows_121.o","cpicture_121.o"
+
+
+winInitialiseWindows:: !*OSToolbox -> *OSToolbox
+winInitialiseWindows _
+ = code
+ {
+ .inline InstallCrossCallWindows
+ ccall InstallCrossCallWindows "I-I"
+ .end
+ }
+
+winInvalidateWindow :: !HWND !*OSToolbox -> *OSToolbox
+winInvalidateWindow _ _
+ = code
+ {
+ .inline WinInvalidateWindow
+ ccall WinInvalidateWindow "II-I"
+ .end
+ }
+
+winInvalidateRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winInvalidateRect hwnd (left,top, right,bottom) tb
+ = code
+ {
+ .inline WinInvalidateRect
+ ccall WinInvalidateRect "IIIIII-I"
+ .end
+ }
+
+winValidateRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winValidateRect hwnd (left,top, right,bottom) tb
+ = code
+ {
+ .inline WinValidateRect
+ ccall WinValidateRect "IIIIII-I"
+ .end
+ }
+
+winValidateRgn :: !HWND !HRGN !*OSToolbox -> *OSToolbox
+winValidateRgn hwnd rgn tb
+ = code
+ {
+ .inline WinValidateRgn
+ ccall WinValidateRgn "III-I"
+ .end
+ }
+
+winGetDC :: !HWND !*OSToolbox -> (!HDC,!*OSToolbox)
+winGetDC _ _
+ = code
+ {
+ .inline WinGetDC
+ ccall WinGetDC "II-II"
+ .end
+ }
+
+winReleaseDC :: !HWND !(!HDC,!*OSToolbox) -> *OSToolbox
+winReleaseDC hwnd (hdc,tb)
+ = code
+ {
+ .inline WinReleaseDC
+ ccall WinReleaseDC "III-I"
+ .end
+ }
diff --git a/windowCrossCall_12.dcl b/windowCrossCall_12.dcl new file mode 100644 index 0000000..c7c885d --- /dev/null +++ b/windowCrossCall_12.dcl @@ -0,0 +1,111 @@ +definition module windowCrossCall_12
+
+
+import StdString
+from ostoolbox import :: OSToolbox
+from ostypes import :: HWND
+from rgnCCall_12 import :: HRGN
+from pictCCall_12 import :: HDC
+
+
+// Cursor shape constants:
+CURSHIDDEN :== 6
+CURSARROW :== 5
+CURSFATCROSS :== 4
+CURSCROSS :== 3
+CURSIBEAM :== 2
+CURSBUSY :== 1
+
+// Constants for handling scrollbars.
+SB_HORZ :== 0
+SB_VERT :== 1
+SB_CTL :== 2
+SB_BOTH :== 3
+
+SB_LINEUP :== 0
+SB_LINELEFT :== 0
+SB_LINEDOWN :== 1
+SB_LINERIGHT :== 1
+SB_PAGEUP :== 2
+SB_PAGELEFT :== 2
+SB_PAGEDOWN :== 3
+SB_PAGERIGHT :== 3
+SB_THUMBPOSITION :== 4
+SB_THUMBTRACK :== 5
+SB_TOP :== 6
+SB_LEFT :== 6
+SB_BOTTOM :== 7
+SB_RIGHT :== 7
+SB_ENDSCROLL :== 8
+
+// PA: constants for handling window styles.
+WS_OVERLAPPED :== 0x00000000
+WS_POPUP :== 0x80000000
+WS_CHILD :== 0x40000000
+WS_MINIMIZE :== 0x20000000
+WS_VISIBLE :== 0x10000000
+WS_DISABLED :== 0x08000000
+WS_CLIPSIBLINGS :== 0x04000000
+WS_CLIPCHILDREN :== 0x02000000
+WS_MAXIMIZE :== 0x01000000
+WS_CAPTION :== 0x00C00000 /* WS_BORDER | WS_DLGFRAME */
+WS_BORDER :== 0x00800000
+WS_DLGFRAME :== 0x00400000
+WS_VSCROLL :== 0x00200000
+WS_HSCROLL :== 0x00100000
+WS_SYSMENU :== 0x00080000
+WS_THICKFRAME :== 0x00040000
+WS_GROUP :== 0x00020000
+WS_TABSTOP :== 0x00010000
+
+WS_MINIMIZEBOX :== 0x00020000
+WS_MAXIMIZEBOX :== 0x00010000
+
+WS_TILED :== WS_OVERLAPPED
+WS_ICONIC :== WS_MINIMIZE
+WS_SIZEBOX :== WS_THICKFRAME
+// PA: end of addition.
+
+// PA: constants for stacking windows.
+HWND_TOP :== 0
+HWND_BOTTOM :== 1
+HWND_TOPMOST :== -1
+HWND_NOTOPMOST :== -2
+// PA: end of addition.
+
+// PA: flag values for passing information about edit controls from Clean to OS.
+EDITISMULTILINE :== 1 /* PA: flag value: edit control is multi-line. */
+EDITISKEYSENSITIVE :== 2 /* PA: flag value: edit control sends keyboard events to Clean. */
+// PA: end of addition.
+
+// PA: values for telling Windows if a (custom)button control is OK, CANCEL, or normal.
+ISNORMALBUTTON :== 0 /* The button is a normal button. */
+ISOKBUTTON :== 1 /* The button is the OK button. */
+ISCANCELBUTTON :== 2 /* The button is the CANCEL button. */
+// PA: end of addition
+
+
+winSetWindowCursor :: !HWND !Int !*OSToolbox -> *OSToolbox
+winObscureCursor :: !*OSToolbox -> *OSToolbox
+winSetWindowTitle :: !HWND !String !*OSToolbox -> *OSToolbox
+winGetWindowText :: !HWND !*OSToolbox -> (!String, !*OSToolbox)
+winUpdateWindowRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winSetSelectStateWindow :: !HWND !(!Bool,!Bool) !Bool !Bool !*OSToolbox -> *OSToolbox
+winBeginPaint :: !HWND !*OSToolbox -> (!HDC, !*OSToolbox)
+winEndPaint :: !HWND !(!HDC, !*OSToolbox) -> *OSToolbox
+winFakePaint :: !HWND !*OSToolbox -> *OSToolbox
+winGetClientSize :: !HWND !*OSToolbox -> (!(!Int,!Int), !*OSToolbox)
+winGetWindowSize :: !HWND !*OSToolbox -> (!(!Int,!Int), !*OSToolbox)
+winSetClientSize :: !HWND !(!Int,!Int) !*OSToolbox -> *OSToolbox
+winSetWindowSize :: !HWND !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+winGetWindowPos :: !HWND !*OSToolbox -> (!(!Int,!Int), !*OSToolbox)
+winSetWindowPos :: !HWND !(!Int,!Int) !Bool !Bool !*OSToolbox -> *OSToolbox
+winSetScrollRange :: !HWND !Int !Int !Int !Bool !*OSToolbox -> *OSToolbox
+winSetScrollPos :: !HWND !Int !Int !Int !Int !Int !*OSToolbox -> *OSToolbox
+winSetScrollThumbSize :: !HWND !Int !Int !Int !Int !Int !*OSToolbox -> *OSToolbox
+winSetEditSelection :: !HWND !Int !Int !*OSToolbox -> *OSToolbox // Note: @2<=@3, @1 must point to an edit control.
+winShowControl :: !HWND !Bool !*OSToolbox -> *OSToolbox // Hide (False) & show (True) controls.
+winEnableControl :: !HWND !Bool !*OSToolbox -> *OSToolbox
+winEnablePopupItem :: !HWND !Int !Bool !*OSToolbox -> *OSToolbox // PA: this function is currently not used, but might be
+winCheckControl :: !HWND !Bool !*OSToolbox -> *OSToolbox
+winSelectPopupItem :: !HWND !Int !*OSToolbox -> *OSToolbox
diff --git a/windowCrossCall_12.icl b/windowCrossCall_12.icl new file mode 100644 index 0000000..0b725d7 --- /dev/null +++ b/windowCrossCall_12.icl @@ -0,0 +1,231 @@ +implementation module windowCrossCall_12
+
+
+import StdMisc, StdTuple
+import clCrossCall_12
+from ostypes import :: HWND, OSNoWindowPtr
+from clCCall_12 import winMakeCString, winGetCStringAndFree, winReleaseCString, :: CSTR
+from pictCCall_12 import :: HDC
+from rgnCCall_12 import :: HRGN
+
+
+// Cursor shape constants:
+CURSHIDDEN :== 6
+CURSARROW :== 5
+CURSFATCROSS :== 4
+CURSCROSS :== 3
+CURSIBEAM :== 2
+CURSBUSY :== 1
+
+// Constants for handling scrollbars.
+SB_HORZ :== 0
+SB_VERT :== 1
+SB_CTL :== 2
+SB_BOTH :== 3
+
+SB_LINEUP :== 0
+SB_LINELEFT :== 0
+SB_LINEDOWN :== 1
+SB_LINERIGHT :== 1
+SB_PAGEUP :== 2
+SB_PAGELEFT :== 2
+SB_PAGEDOWN :== 3
+SB_PAGERIGHT :== 3
+SB_THUMBPOSITION :== 4
+SB_THUMBTRACK :== 5
+SB_TOP :== 6
+SB_LEFT :== 6
+SB_BOTTOM :== 7
+SB_RIGHT :== 7
+SB_ENDSCROLL :== 8
+
+// PA: constants for handling window styles.
+WS_OVERLAPPED :== 0x00000000
+WS_POPUP :== 0x80000000
+WS_CHILD :== 0x40000000
+WS_MINIMIZE :== 0x20000000
+WS_VISIBLE :== 0x10000000
+WS_DISABLED :== 0x08000000
+WS_CLIPSIBLINGS :== 0x04000000
+WS_CLIPCHILDREN :== 0x02000000
+WS_MAXIMIZE :== 0x01000000
+WS_CAPTION :== 0x00C00000 /* WS_BORDER | WS_DLGFRAME */
+WS_BORDER :== 0x00800000
+WS_DLGFRAME :== 0x00400000
+WS_VSCROLL :== 0x00200000
+WS_HSCROLL :== 0x00100000
+WS_SYSMENU :== 0x00080000
+WS_THICKFRAME :== 0x00040000
+WS_GROUP :== 0x00020000
+WS_TABSTOP :== 0x00010000
+
+WS_MINIMIZEBOX :== 0x00020000
+WS_MAXIMIZEBOX :== 0x00010000
+
+WS_TILED :== WS_OVERLAPPED
+WS_ICONIC :== WS_MINIMIZE
+WS_SIZEBOX :== WS_THICKFRAME
+// PA: end of addition.
+
+// PA: constants for stacking windows.
+HWND_TOP :== 0
+HWND_BOTTOM :== 1
+HWND_TOPMOST :== -1
+HWND_NOTOPMOST :== -2
+// PA: end of addition.
+
+// PA: flag values for passing information about edit controls from Clean to OS.
+EDITISMULTILINE :== 1 /* PA: flag value: edit control is multi-line. */
+EDITISKEYSENSITIVE :== 2 /* PA: flag value: edit control sends keyboard events to Clean. */
+// PA: end of addition.
+
+// PA: values for telling Windows if a (custom)button control is OK, CANCEL, or normal.
+ISNORMALBUTTON :== 0 /* The button is a normal button. */
+ISOKBUTTON :== 1 /* The button is the OK button. */
+ISCANCELBUTTON :== 2 /* The button is the CANCEL button. */
+// PA: end of addition
+
+
+winSetWindowCursor :: !HWND !Int !*OSToolbox -> *OSToolbox
+winSetWindowCursor hwnd cursorcode tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetWindowCursor") (Rq2Cci CcRqCHANGEWINDOWCURSOR hwnd cursorcode) tb)
+
+winObscureCursor :: !*OSToolbox -> *OSToolbox
+winObscureCursor tb
+ = snd (issueCleanRequest2 (errorCallback2 "winObscureCursor") (Rq0Cci CcRqOBSCURECURSOR) tb)
+
+winSetWindowTitle :: !HWND !String !*OSToolbox -> *OSToolbox
+winSetWindowTitle hwnd title tb
+ # (textptr,tb) = winMakeCString title tb
+ # (_,tb) = issueCleanRequest2 (errorCallback2 "SetWindowTitle") (Rq2Cci CcRqSETWINDOWTITLE hwnd textptr) tb
+ = winReleaseCString textptr tb
+
+winGetWindowText :: !HWND !*OSToolbox -> (!String, !*OSToolbox)
+winGetWindowText hwnd tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winGetWindowText") (Rq1Cci CcRqGETWINDOWTEXT hwnd) tb
+ # (text,tb) = case rcci.ccMsg of
+ CcRETURN1 -> winGetCStringAndFree rcci.p1 tb
+ CcWASQUIT -> ("",tb)
+ other -> abort "[winGetWindowText] expected CcRETURN1 value."
+ = (text,tb)
+
+/* PA: the following four functions are now implemented as C-calls.
+winInvalidateWindow :: !HWND !*OSToolbox -> *OSToolbox
+winInvalidateWindow hwnd tb
+ = snd (issueCleanRequest2 (errorCallback2 "winInvalidateWindow") (Rq1Cci CcRqINVALIDATEWINDOW hwnd) tb)
+
+winInvalidateRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winInvalidateRect hwnd (left,top, right,bottom) tb
+ = snd (issueCleanRequest2 (errorCallback2 "InvalidateRect") (Rq5Cci CcRqINVALIDATERECT hwnd left top right bottom) tb)
+
+winValidateRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winValidateRect hwnd (left,top, right,bottom) tb
+ = snd (issueCleanRequest2 (errorCallback2 "ValidateRect") (Rq5Cci CcRqVALIDATERECT hwnd left top right bottom) tb)
+
+winValidateRgn :: !HWND !HRGN !*OSToolbox -> *OSToolbox
+winValidateRgn hwnd rgn tb
+ = snd (issueCleanRequest2 (errorCallback2 "ValidateRgn") (Rq2Cci CcRqVALIDATERGN hwnd rgn) tb)
+*/
+
+winUpdateWindowRect :: !HWND !(!Int,!Int,!Int,!Int) !*OSToolbox -> *OSToolbox
+winUpdateWindowRect hwnd (left,top,right,bottom) tb
+ = snd (issueCleanRequest2 (errorCallback2 "winUpdateWindowRect") (Rq5Cci CcRqUPDATEWINDOWRECT hwnd left top right bottom) tb)
+
+winSetSelectStateWindow :: !HWND !(!Bool,!Bool) !Bool !Bool !*OSToolbox -> *OSToolbox
+winSetSelectStateWindow hwnd (hasHScroll,hasVScroll) toAble modalContext tb
+ # selectCci = Rq5Cci CcRqSETSELECTWINDOW hwnd (toInt hasHScroll) (toInt hasVScroll) (toInt toAble) (toInt modalContext)
+ = snd (issueCleanRequest2 (errorCallback2 "winSetSelectStateWindow") selectCci tb)
+
+winBeginPaint :: !HWND !*OSToolbox -> (!HDC,!*OSToolbox)
+winBeginPaint hwnd tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "BeginPaint") (Rq1Cci CcRqBEGINPAINT hwnd) tb
+ hdc = case rcci.ccMsg of
+ CcRETURN1 -> rcci.p1
+ CcWASQUIT -> 0
+ other -> abort "[winBeginPaint] expected CcRETURN1 value."
+ = (hdc,tb)
+
+winEndPaint :: !HWND !(!HDC, !*OSToolbox) -> *OSToolbox
+winEndPaint hwnd (hdc,tb)
+ = snd (issueCleanRequest2 (errorCallback2 "EndPaint") (Rq2Cci CcRqENDPAINT hwnd hdc) tb)
+
+winFakePaint :: !HWND !*OSToolbox -> *OSToolbox
+winFakePaint hwnd tb
+ = snd (issueCleanRequest2 (errorCallback2 "FakePaint") (Rq1Cci CcRqFAKEPAINT hwnd) tb)
+
+winGetClientSize :: !HWND !*OSToolbox -> (!(!Int,!Int), !*OSToolbox)
+winGetClientSize OSNoWindowPtr tb
+ = ((0,0),tb)
+winGetClientSize hwnd tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winGetClientSize") (Rq1Cci CcRqGETCLIENTSIZE hwnd) tb
+ size = case rcci.ccMsg of
+ CcRETURN2 -> (rcci.p1,rcci.p2)
+ CcWASQUIT -> (0,0)
+ other -> abort "[winGetClientSize] expected CcRETURN2 value."
+ = (size,tb)
+
+winGetWindowSize :: !HWND !*OSToolbox -> (!(!Int,!Int), !*OSToolbox)
+winGetWindowSize hwnd tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winGetWindowSize") (Rq1Cci CcRqGETWINDOWSIZE hwnd) tb
+ size = case rcci.ccMsg of
+ CcRETURN2 -> (rcci.p1,rcci.p2)
+ CcWASQUIT -> (0,0)
+ other -> abort "[winGetWindowSize] expected CcRETURN2 value."
+ = (size,tb)
+
+winSetClientSize :: !HWND !(!Int,!Int) !*OSToolbox -> *OSToolbox
+winSetClientSize hwnd (w,h) tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetClientSize") (Rq3Cci CcRqSETCLIENTSIZE hwnd w h) tb)
+
+winSetWindowSize :: !HWND !(!Int,!Int) !Bool !*OSToolbox -> *OSToolbox
+winSetWindowSize hwnd (w,h) update tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetWindowSize") (Rq4Cci CcRqSETWINDOWSIZE hwnd w h (toInt update)) tb)
+
+winGetWindowPos :: !HWND !*OSToolbox -> (!(!Int,!Int),!*OSToolbox)
+winGetWindowPos hwnd tb
+ # (rcci,tb) = issueCleanRequest2 (errorCallback2 "winGetWindowPos") (Rq1Cci CcRqGETWINDOWPOS hwnd) tb
+ pos = case rcci.ccMsg of
+ CcRETURN2 -> (rcci.p1,rcci.p2)
+ CcWASQUIT -> (0,0)
+ other -> abort "[winGetWindowPos] expected CcRETURN2 value."
+ = (pos,tb)
+
+winSetWindowPos :: !HWND !(!Int,!Int) !Bool !Bool !*OSToolbox -> *OSToolbox
+winSetWindowPos hwnd (x,y) update inclScrollbars tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetWindowPos") (Rq5Cci CcRqSETWINDOWPOS hwnd x y (toInt update) (toInt inclScrollbars)) tb)
+
+winSetScrollRange :: !HWND !Int !Int !Int !Bool !*OSToolbox -> *OSToolbox
+winSetScrollRange scrollHWND iBar min max redraw tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetScrollRange") (Rq5Cci CcRqSETSCROLLRANGE scrollHWND iBar min max (toInt redraw)) tb)
+
+winSetScrollPos :: !HWND !Int !Int !Int !Int !Int !*OSToolbox -> *OSToolbox
+winSetScrollPos scrollHWND iBar thumb maxx maxy extent tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetScrollPos") (Rq6Cci CcRqSETSCROLLPOS scrollHWND iBar thumb maxx maxy extent) tb)
+
+winSetScrollThumbSize :: !HWND !Int !Int !Int !Int !Int !*OSToolbox -> *OSToolbox
+winSetScrollThumbSize scrollHWND iBar size maxx maxy extent tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetScrollThumbSize") (Rq6Cci CcRqSETSCROLLSIZE scrollHWND iBar size maxx maxy extent) tb)
+
+winSetEditSelection :: !HWND !Int !Int !*OSToolbox -> *OSToolbox
+winSetEditSelection editHWND first last tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSetEditSelection") (Rq3Cci CcRqSETEDITSELECTION editHWND first last) tb)
+
+winShowControl :: !HWND !Bool !*OSToolbox -> *OSToolbox
+winShowControl hwnd bool tb
+ = snd (issueCleanRequest2 (errorCallback2 "winShowControl") (Rq2Cci CcRqSHOWCONTROL hwnd (toInt bool)) tb)
+
+winEnableControl :: !HWND !Bool !*OSToolbox -> *OSToolbox
+winEnableControl hwnd bool tb
+ = snd (issueCleanRequest2 (errorCallback2 "winEnableControl") (Rq2Cci CcRqENABLECONTROL hwnd (toInt bool)) tb)
+
+winEnablePopupItem :: !HWND !Int !Bool !*OSToolbox -> *OSToolbox
+winEnablePopupItem hwnd pos bool tb
+ = snd (issueCleanRequest2 (errorCallback2 "winEnablePopupItem") (Rq3Cci CcRqENABLEPOPUPITEM hwnd pos (toInt bool)) tb)
+
+winCheckControl :: !HWND !Bool !*OSToolbox -> *OSToolbox
+winCheckControl hwnd bool tb
+ = snd (issueCleanRequest2 (errorCallback2 "winCheckControl") (Rq2Cci CcRqSETITEMCHECK hwnd (toInt bool)) tb)
+
+winSelectPopupItem :: !HWND !Int !*OSToolbox -> *OSToolbox
+winSelectPopupItem hwnd pos tb
+ = snd (issueCleanRequest2 (errorCallback2 "winSelectPopupItem") (Rq2Cci CcRqSELECTPOPUPITEM hwnd pos) tb)
diff --git a/windowevent.dcl b/windowevent.dcl new file mode 100644 index 0000000..26d7847 --- /dev/null +++ b/windowevent.dcl @@ -0,0 +1,15 @@ +definition module windowevent
+
+
+// Clean Object I/O library, version 1.2
+
+/* windowevent defines the DeviceEventFunction for the window device.
+ This function is placed in a separate module because it is platform dependent.
+*/
+
+
+import deviceevents
+from iostate import :: PSt
+
+
+windowEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
diff --git a/windowevent.icl b/windowevent.icl new file mode 100644 index 0000000..f77f1fc --- /dev/null +++ b/windowevent.icl @@ -0,0 +1,1169 @@ +implementation module windowevent
+
+
+import StdBool, StdFunc, StdList, StdMisc, StdTuple
+import clCCall_12, clCrossCall_12, windowCrossCall_12
+from ostypes import OSNoWindowPtr
+from oswindow import fromOSscrollbarRange, osScrollbarsAreVisible
+import commondef, controlcreate, deviceevents, iostate, windowaccess
+from StdControlAttribute import isControlKeyboard, getControlKeyboardAtt,
+ isControlMouse, getControlMouseAtt,
+ isControlActivate, isControlDeactivate
+from StdPSt import accPIO
+from StdWindowAttribute import isWindowKeyboard, getWindowKeyboardAtt,
+ isWindowMouse, getWindowMouseAtt,
+ isWindowCursor, getWindowCursorAtt
+from windowcreate import createModalDialogControls
+
+
+windoweventFatalError :: String String -> .x
+windoweventFatalError function error
+ = fatalError function "windowevent" error
+
+
+/* windowEvent filters the scheduler events that can be handled by this window device.
+ For the time being no timer controls are added, so these events are ignored.
+ windowEvent assumes that it is not applied to an empty IOSt.
+*/
+windowEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+windowEvent schedulerEvent pState
+ # (hasDevice,pState) = accPIO (ioStHasDevice WindowDevice) pState
+ | not hasDevice // This condition should never occur: WindowDevice must have been 'installed'
+ = windoweventFatalError "windowFunctions.dEvent" "could not retrieve WindowSystemState from IOSt"
+ | otherwise
+ = windowEvent schedulerEvent pState
+where
+ windowEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
+ windowEvent schedulerEvent=:(ScheduleOSEvent osEvent _) pState=:{io=ioState}
+ | not (isWindowOSEvent osEvent.ccMsg)
+ = (False,Nothing,schedulerEvent,pState)
+ | otherwise
+ # (_,wDevice,ioState) = ioStGetDevice WindowDevice ioState
+ # (wMetrics, ioState) = ioStGetOSWindowMetrics ioState
+ windows = windowSystemStateGetWindowHandles wDevice
+ (myEvent,replyToOS,deviceEvent,windows,ioState)
+ = filterOSEvent wMetrics osEvent windows ioState
+ # ioState = ioStSetDevice (WindowSystemState windows) ioState
+ # pState = {pState & io=ioState}
+ schedulerEvent = if (isJust replyToOS) (ScheduleOSEvent osEvent (fromJust replyToOS)) schedulerEvent
+ = (myEvent,deviceEvent,schedulerEvent,pState)
+ where
+ isWindowOSEvent :: !Int -> Bool
+ isWindowOSEvent CcWmACTIVATE = True
+ isWindowOSEvent CcWmBUTTONCLICKED = True
+ isWindowOSEvent CcWmCLOSE = True
+ isWindowOSEvent CcWmCOMBOSELECT = True
+ isWindowOSEvent CcWmDEACTIVATE = True
+ isWindowOSEvent CcWmDRAWCONTROL = True
+ isWindowOSEvent CcWmIDLEDIALOG = True
+ isWindowOSEvent CcWmINITDIALOG = True
+ isWindowOSEvent CcWmKEYBOARD = True
+ isWindowOSEvent CcWmKILLFOCUS = True
+ isWindowOSEvent CcWmLOSTKEY = True
+ isWindowOSEvent CcWmLOSTMOUSE = True
+ isWindowOSEvent CcWmMOUSE = True
+ isWindowOSEvent CcWmPAINT = True
+ isWindowOSEvent CcWmSCROLLBARACTION = True
+ isWindowOSEvent CcWmSETFOCUS = True
+ isWindowOSEvent CcWmSIZE = True
+ isWindowOSEvent CcWmSPECIALBUTTON = True
+ isWindowOSEvent _ = False
+
+ windowEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
+ # (ioId,ioState) = ioStGetIOId ioState
+ | ioId<>recLoc.rlIOId || recLoc.rlDevice<>WindowDevice
+ = (False,Nothing,schedulerEvent,{pState & io=ioState})
+ | otherwise
+ # (_,wDevice,ioState) = ioStGetDevice WindowDevice ioState
+ windows = windowSystemStateGetWindowHandles wDevice
+ (found,windows) = hasWindowHandlesWindow (toWID recLoc.rlParentId) windows
+ deviceEvent = if found (Just (ReceiverEvent msgEvent)) Nothing
+ # ioState = ioStSetDevice (WindowSystemState windows) ioState
+ # pState = {pState & io=ioState}
+ = (found,deviceEvent,schedulerEvent,pState)
+ where
+ recLoc = getMsgEventRecLoc msgEvent
+
+ windowEvent schedulerEvent pState
+ = (False,Nothing,schedulerEvent,pState)
+
+
+/* filterOSEvent filters the OSEvents that can be handled by this window device.
+*/
+filterOSEvent :: !OSWindowMetrics !OSEvent !(WindowHandles (PSt .l)) !(IOSt .l)
+ -> (!Bool,!Maybe [Int],!Maybe DeviceEvent,!WindowHandles (PSt .l), !IOSt .l)
+
+filterOSEvent _ {ccMsg=CcWmBUTTONCLICKED,p1=wPtr,p2=cPtr,p3=mods,p4=toolbarIndex} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids, wsH) = getWindowStateHandleWIDS wsH
+ (itemNr,wsH) = getControlsItemNr cPtr wsH
+ controlSelectInfo = if (itemNr==0) // itemNrs are always > 0
+ Nothing
+ (Just (ControlSelection {csWIDS = wids
+ ,csItemNr = itemNr
+ ,csItemPtr = cPtr
+ ,csMoreData = 0
+ ,csModifiers= toModifiers mods
+ })
+ )
+ = (True,Nothing,controlSelectInfo,setWindowHandlesWindow wsH windows,ioState)
+where
+ getControlsItemNr :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Int,!WindowStateHandle .pst)
+ getControlsItemNr cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,itemNr,itemHs) = getControlsItemNr cPtr whItems
+ = (itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ getControlsItemNr :: !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Int,![WElementHandle .ls .pst])
+ getControlsItemNr cPtr [itemH:itemHs]
+ # (found,itemNr,itemH) = getControlItemNr cPtr itemH
+ | found
+ = (found,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,[itemH:itemHs])
+ where
+ getControlItemNr :: !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Int,!WElementHandle .ls .pst)
+ getControlItemNr cPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemInfo,wItemKind,wItemSelect,wItemShow,wItems})
+ | cPtr==wItemPtr = (True,itemNr,WItemHandle itemH)
+ | wItemKind==IsRadioControl = (contains (\{radioItemPtr}->radioItemPtr==cPtr) (getWItemRadioInfo wItemInfo).radioItems,itemNr,WItemHandle itemH)
+ | wItemKind==IsCheckControl = (contains (\{checkItemPtr}->checkItemPtr==cPtr) (getWItemCheckInfo wItemInfo).checkItems,itemNr,WItemHandle itemH)
+ | wItemSelect && wItemShow
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr wItems
+ = (found,itemNr,WItemHandle {itemH & wItems=itemHs})
+ | otherwise
+ = (False,0,WItemHandle itemH)
+ where
+ itemNr = if wItemSelect wItemNr 0
+
+ getControlItemNr cPtr (WListLSHandle itemHs)
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,WListLSHandle itemHs)
+
+ getControlItemNr cPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getControlItemNr cPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsItemNr cPtr itemHs
+ = (found,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getControlsItemNr _ []
+ = (False,0,[])
+
+ getControlsItemNr _ _
+ = windoweventFatalError "getControlsItemNr" "window placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmCOMBOSELECT,p1=wPtr,p2=cPtr,p3=index} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids, wsH) = getWindowStateHandleWIDS wsH
+ (itemNr,wsH) = getPopUpControlItemNr cPtr wsH
+ controlSelectInfo = if (itemNr==0) // itemNrs are always > 0
+ Nothing
+ (Just (ControlSelection {csWIDS = wids
+ ,csItemNr = itemNr
+ ,csItemPtr = cPtr
+ ,csMoreData = index+1
+ ,csModifiers= NoModifiers
+ })
+ )
+ = (True,Nothing,controlSelectInfo,setWindowHandlesWindow wsH windows,ioState)
+where
+ getPopUpControlItemNr :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Int,!WindowStateHandle .pst)
+ getPopUpControlItemNr cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,itemNr,itemHs) = getPopUpControlsItemNr cPtr whItems
+ = (itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ getPopUpControlsItemNr :: !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Int,![WElementHandle .ls .pst])
+ getPopUpControlsItemNr cPtr [itemH:itemHs]
+ # (found,itemNr,itemH) = getPopUpControlItemNr cPtr itemH
+ | found
+ = (found,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,[itemH:itemHs])
+ where
+ getPopUpControlItemNr :: !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Int,!WElementHandle .ls .pst)
+ getPopUpControlItemNr cPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemSelect,wItemShow,wItems})
+ | cPtr==wItemPtr
+ = (True,if (wItemKind==IsPopUpControl && wItemSelect && wItemShow) wItemNr 0,WItemHandle itemH)
+ | wItemShow
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr wItems
+ = (found,itemNr,WItemHandle {itemH & wItems=itemHs})
+ | otherwise
+ = (False,0,WItemHandle itemH)
+
+ getPopUpControlItemNr cPtr (WListLSHandle itemHs)
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,WListLSHandle itemHs)
+
+ getPopUpControlItemNr cPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getPopUpControlItemNr cPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,itemNr,itemHs) = getPopUpControlsItemNr cPtr itemHs
+ = (found,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getPopUpControlsItemNr _ []
+ = (False,0,[])
+
+ getPopUpControlItemNr _ _
+ = windoweventFatalError "getPopUpControlItemNr" "window placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmDRAWCONTROL,p1=wPtr,p2=cPtr,p3=gc} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ # (controls,wsH) = getUpdateControls cPtr wsH
+ updateInfo = if (isEmpty controls)
+ Nothing
+ (Just (WindowUpdate {updWIDS=wids,updWindowArea=zero,updControls=controls,updGContext=Just gc}))
+ = (True,Nothing,updateInfo,setWindowHandlesWindow wsH windows,ioState)
+where
+ getUpdateControls :: !OSWindowPtr !(WindowStateHandle .pst) -> (![ControlUpdateInfo],!WindowStateHandle .pst)
+ getUpdateControls cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems,whSize}}}
+ # (_,controls,itemHs) = getUpdateControls cPtr (sizeToRect whSize) whItems
+ = (controls,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ getUpdateControls :: !OSWindowPtr !OSRect ![WElementHandle .ls .pst] -> (!Bool,![ControlUpdateInfo],![WElementHandle .ls .pst])
+ getUpdateControls cPtr clipRect [itemH:itemHs]
+ # (found,controls,itemH) = getUpdateControl cPtr clipRect itemH
+ | found
+ = (found,controls,[itemH:itemHs])
+ | otherwise
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,[itemH:itemHs])
+ where
+ getUpdateControl :: !OSWindowPtr !OSRect !(WElementHandle .ls .pst) -> (!Bool,![ControlUpdateInfo],!WElementHandle .ls .pst)
+ getUpdateControl cPtr clipRect (WItemHandle itemH=:{wItemPtr,wItemNr,wItemShow,wItemPos,wItemSize,wItems})
+ | cPtr==wItemPtr
+ = (True,[{cuItemNr=wItemNr,cuItemPtr=wItemPtr,cuArea=clipRect1}],WItemHandle itemH)
+ | wItemShow
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect1 wItems
+ = (found,controls,WItemHandle {itemH & wItems=itemHs})
+ | otherwise
+ = (False,[],WItemHandle itemH)
+ where
+ clipRect1 = intersectRects clipRect (posSizeToRect wItemPos wItemSize)
+
+ getUpdateControl cPtr clipRect (WListLSHandle itemHs)
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,WListLSHandle itemHs)
+
+ getUpdateControl cPtr clipRect (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getUpdateControl cPtr clipRect (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,controls,itemHs) = getUpdateControls cPtr clipRect itemHs
+ = (found,controls,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getUpdateControls _ _ []
+ = (False,[],[])
+
+ getUpdateControls _ _
+ = windoweventFatalError "getUpdateControls" "placeholder not expected"
+
+/* PA: CcWmIDLEDIALOG is sent after a modal dialogue and its controls have been created.
+ At that moment the initialisation action can be evaluated. This is done by the
+ WindowInitialise device event.
+*/
+filterOSEvent _ {ccMsg=CcWmIDLEDIALOG,p1=wPtr} windows ioState
+ # (maybeWIDS,windows) = getWindowHandlesActiveModalDialog windows
+ | isNothing maybeWIDS
+ = (False,Nothing,Nothing,windows,ioState)
+ # wids = fromJust maybeWIDS
+ | wPtr<>wids.wPtr
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ = (True,Nothing,Just (WindowInitialise (fromJust maybeWIDS)),windows,ioState)
+
+/* PA: CcWmINITDIALOG is generated for modal and modeless dialogs. It should create all the controls of the
+ dialog, and return the desired position, size, and focus control of the dialog.
+ PA: THE FOLLOWING STATEMENT IS NOT TRUE; FUNCTIONALITY MOVED TO CcWmIDLEDIALOG.
+ In addition, the return DeviceEvent should be WindowInitialise to have the initialisation
+ function evaluated.
+*/
+/* PA: previous version. Now code is shared in windowcreate and windowevent.
+filterOSEvent wMetrics {ccMsg=CcWmINITDIALOG,p1=wPtr} windows ioState
+ # (maybeWIDS,windows) = getWindowHandlesActiveWindow windows
+ | isNothing maybeWIDS
+ = (False,Nothing,Nothing,windows,ioState)
+ # wids = fromJust maybeWIDS
+ | wids.wPtr<>0
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (_,wsH,windows) = removeWindowHandlesWindow (toWID 0) windows
+ wids = {wids & wPtr=wPtr}
+ wsH = (\wsH->{wsH & wshIds=wids}) wsH
+ # (tb,ioState) = getIOToolbox ioState
+ # (returnOS,wsH,tb) = createDialogControls wMetrics wsH tb
+ # ioState = setIOToolbox tb ioState
+ windows = addWindowHandlesActiveWindow wsH windows
+ = (True,Just returnOS,Nothing,windows,ioState)
+where
+ createDialogControls :: !OSWindowMetrics !(WindowStateHandle .pst) !*OSToolbox
+ -> (![Int], !WindowStateHandle .pst, !*OSToolbox)
+ createDialogControls wMetrics wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems=itemHs,whSize={w,h}}}} tb
+ # (itemHs,tb) = createControls wMetrics whDefaultId whCancelId True wPtr itemHs tb
+ # (itemPtr,wH) = getInitActiveControl {wH & whItems=itemHs}
+ r5cci = [-1,-1,w,h,if (itemPtr==OSNoWindowPtr) 0 itemPtr]
+ = (r5cci,{wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
+ where
+ whDefaultId = wH.whDefaultId
+ whCancelId = wH.whCancelId
+ createDialogControls _ _ _
+ = windoweventFatalError "createDialogControls" "placeholder not expected"
+*/
+filterOSEvent wMetrics {ccMsg=CcWmINITDIALOG,p1=wPtr} windows ioState
+ # (maybeWIDS,windows) = getWindowHandlesActiveWindow windows
+ | isNothing maybeWIDS
+ = (False,Nothing,Nothing,windows,ioState)
+ # wids = fromJust maybeWIDS
+ | wids.wPtr<>0
+ = (False,Nothing,Nothing,windows,ioState)
+ # (tb,ioState) = getIOToolbox ioState
+ # (itemPtr,windows,tb) = createModalDialogControls wMetrics wPtr windows tb
+ # ioState = setIOToolbox tb ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found // This alternative can't be reached, because createModalDialogControls has added this handle
+ = windoweventFatalError "filterOSEvent (CcWmINITDIALOG)" "could not retrieve window"
+ | otherwise
+ # ({w,h},wsH) = getWindowStateHandleSize wsH
+ windows = setWindowHandlesWindow wsH windows
+ = (True,Just [-1,-1,w,h,if (itemPtr==OSNoWindowPtr) 0 itemPtr],Nothing,windows,ioState)
+
+filterOSEvent _ {ccMsg=CcWmSCROLLBARACTION,p1=wPtr,p2=cPtr,p3=iBar,p4=action,p5=osThumb} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (sliderEvent,wsH) = getSlidersEvent wids iBar osThumb cPtr wsH
+ = (True,Nothing,Just sliderEvent,setWindowHandlesWindow wsH windows,ioState)
+where
+ getSlidersEvent :: !WIDS !Int !Int !OSWindowPtr !(WindowStateHandle .pst) -> (!DeviceEvent,!WindowStateHandle .pst)
+ getSlidersEvent wids iBar osThumb itemPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whWindowInfo,whItems,whSize={w,h}}}}
+ | wids.wPtr==itemPtr
+ = (WindowScrollAction info,wsH)
+ with
+ info = { wsaWIDS = wids
+ , wsaSliderMove = move min max view osThumb
+ , wsaDirection = if isHorizontal Horizontal Vertical
+ }
+ windowInfo = getWindowInfoWindowData whWindowInfo
+ domainRect = windowInfo.windowDomain
+ isHorizontal = iBar==SB_HORZ
+ (min,max,view) = if isHorizontal
+ (domainRect.rleft,domainRect.rright, w)
+ (domainRect.rtop, domainRect.rbottom,h)
+ # (found,sliderEvent,itemHs)= getSlidersEvent wids iBar osThumb itemPtr whItems
+ | found
+ = (sliderEvent,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ | otherwise
+ = windoweventFatalError "getSlidersEvent" "SliderControl could not be located"
+ where
+ getSlidersEvent :: !WIDS !Int !Int !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!DeviceEvent,![WElementHandle .ls .pst])
+ getSlidersEvent wids iBar osThumb itemPtr [itemH:itemHs]
+ # (found,sliderEvent,itemH) = getSliderEvent wids iBar osThumb itemPtr itemH
+ | found
+ = (found,sliderEvent,[itemH:itemHs])
+ | otherwise
+ # (found,sliderEvent,itemHs)= getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,[itemH:itemHs])
+ where
+ getSliderEvent :: !WIDS !Int !Int !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!DeviceEvent,!WElementHandle .ls .pst)
+ getSliderEvent wids iBar osThumb itemPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemShow,wItems,wItemInfo,wItemSize})
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr wItems
+ = (found,sliderEvent,WItemHandle {itemH & wItems=itemHs})
+ // otherwise
+ = (False,ControlSliderAction dummySlidersEvent,WItemHandle itemH)
+ | wItemKind==IsCompoundControl
+ = (True,CompoundScrollAction info,WItemHandle itemH)
+ with
+ info = { csaWIDS = wids
+ , csaItemNr = wItemNr
+ , csaItemPtr = itemPtr
+ , csaSliderMove = move min max view osThumb
+ , csaDirection = if isHorizontal Horizontal Vertical
+ }
+ compoundInfo = getWItemCompoundInfo wItemInfo
+ domainRect = compoundInfo.compoundDomain
+ isHorizontal = iBar==SB_HORZ
+ (min,max,view) = if isHorizontal
+ (domainRect.rleft,domainRect.rright, wItemSize.w)
+ (domainRect.rtop, domainRect.rbottom,wItemSize.h)
+ | otherwise
+ = (True,ControlSliderAction info,WItemHandle itemH)
+ with
+ info = { cslWIDS = wids
+ , cslItemNr = wItemNr
+ , cslItemPtr = itemPtr
+ , cslSliderMove = move sliderState.sliderMin sliderState.sliderMax 0 osThumb
+ }
+ sliderInfo = getWItemSliderInfo wItemInfo
+ sliderState = sliderInfo.sliderInfoState
+
+ getSliderEvent wids iBar osThumb itemPtr (WListLSHandle itemHs)
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,WListLSHandle itemHs)
+
+ getSliderEvent wids iBar osThumb itemPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getSliderEvent wids iBar osThumb itemPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,sliderEvent,itemHs) = getSlidersEvent wids iBar osThumb itemPtr itemHs
+ = (found,sliderEvent,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ getSlidersEvent _ _ _ _ []
+ = (False,ControlSliderAction dummySlidersEvent,[])
+
+ dummySlidersEvent = { cslWIDS=wids,cslItemNr=0,cslItemPtr=0,cslSliderMove=SliderIncSmall }
+
+ getSlidersEvent _ _ _ _ _
+ = windoweventFatalError "getSlidersEvent" "placeholder not expected"
+
+ move :: !Int !Int !Int !Int -> SliderMove
+ move min max view osThumb
+ = case action of
+ SB_LINEUP -> SliderDecSmall
+ SB_LINEDOWN -> SliderIncSmall
+ SB_PAGEUP -> SliderDecLarge
+ SB_PAGEDOWN -> SliderIncLarge
+ SB_THUMBPOSITION-> SliderThumb (fromOSscrollbarRange (min,max) osThumb)
+ SB_THUMBTRACK -> SliderThumb (fromOSscrollbarRange (min,max) osThumb)
+ SB_TOP -> SliderThumb min
+ SB_BOTTOM -> SliderThumb (max-view)
+ SB_ENDSCROLL -> SliderThumb (fromOSscrollbarRange (min,max) osThumb)
+
+filterOSEvent _ {ccMsg=CcWmACTIVATE,p1=wPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (active,wsH) = getWindowStateHandleActive wsH
+ | active // The window is already active, skip
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+// (activeModal,windows) = getWindowHandlesActiveModalDialog windows
+// = (True,Nothing,if (isJust activeModal) (Just (WindowInitialise wids)) (Just (WindowActivation wids)),windows,ioState) // PA: WindowInitialise? Why? Doesn't smell well
+ = (True,Nothing,Just (WindowActivation wids),windows,ioState) // DvA: always activate/deactivate windows
+
+filterOSEvent _ {ccMsg=CcWmCLOSE,p1=wPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+ = (True,Nothing,Just (WindowRequestClose wids),windows,ioState)
+
+filterOSEvent _ {ccMsg=CcWmDEACTIVATE,p1=wPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+// PA: in my version this test was not present.
+ # (active,wsH) = getWindowStateHandleActive wsH
+ | not active // The window is already inactive, skip
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+// ...PA
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+// (activeModal,windows) = getWindowHandlesActiveModalDialog windows
+// = (True,Nothing,if (isJust activeModal) Nothing (Just (WindowDeactivation wids)),windows,ioState)
+ = (True,Nothing,Just (WindowDeactivation wids),windows,ioState) // DvA: always activate/deactivate windows
+
+filterOSEvent _ {ccMsg=CcWmKEYBOARD,p1=wPtr,p2=cPtr,p3=keycode,p4=state,p5=mods} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The keyboard action takes place in the window
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,key,wsH,inputTrack) = okWindowKeyboardState keycode state mods wsH inputTrack
+ # ioState = ioStSetInputTrack inputTrack ioState
+ deviceEvent = if ok (Just (WindowKeyboardAction {wkWIDS=wids,wkKeyboardState=key})) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowKeyboardState :: !Int !Int !Int !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,KeyboardState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okWindowKeyboardState keycode state mods wsH=:{wshHandle=Just {wlsHandle={whKind,whWindowInfo,whAtts}}} inputTrack
+ | whKind==IsDialog
+ = (False,undef,wsH,inputTrack)
+ | trackingKeyboard wPtr 0 inputTrack // Window is already handle Key(Repeat/Up)
+ | isDownKey // Ignore all key down events
+ = (False,undef,wsH,inputTrack)
+ | pressState==KeyUp
+ = (okKeyboardAtt,keystate,wsH,untrackKeyboard inputTrack) // Clear keyboard tracking
+ // otherwise
+ = (okKeyboardAtt,keystate,wsH,inputTrack)
+ | isDownKey
+ = (okKeyboardAtt,keystate,wsH,trackKeyboard wPtr 0 inputTrack) // Key down sets input track
+ | otherwise
+ = (False,undef,wsH,inputTrack)
+ where
+ keystate = keyState keycode state mods
+ pressState = getKeyboardStateKeyState keystate
+ isDownKey = pressState==KeyDown False
+ (filter,selectState,_) = getWindowKeyboardAtt (snd (cselect isWindowKeyboard (WindowKeyboard (const False) Unable undef) whAtts))
+ okKeyboardAtt = filter keystate && selectState==Able
+ okWindowKeyboardState _ _ _ _ _
+ = windoweventFatalError "okWindowKeyboardState" "placeholder not expected"
+ | otherwise // The keyboard action takes place in a control
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,itemNr,key,wsH,inputTrack)= okControlItemsNrKeyboardState wPtr cPtr keycode state mods wsH inputTrack
+ # ioState = ioStSetInputTrack inputTrack ioState
+ info = { ckWIDS = wids
+ , ckItemNr = itemNr
+ , ckItemPtr = cPtr
+ , ckKeyboardState = key
+ }
+ deviceEvent = if ok (Just (ControlKeyboardAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemsNrKeyboardState :: !OSWindowPtr !OSWindowPtr !Int !Int !Int !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,!Int,KeyboardState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okControlItemsNrKeyboardState wPtr itemPtr keycode state mods wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}} inputTrack
+ # (_,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr True keycode state mods whItems inputTrack
+ = (ok,itemNr,itemPos,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}},inputTrack)
+ where
+ okControlsItemNrKeyboardState :: !OSWindowPtr !OSWindowPtr !Bool !Int !Int !Int ![WElementHandle .ls .pst] !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,KeyboardState,![WElementHandle .ls .pst],! Maybe InputTrack)
+ okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods [itemH:itemHs] inputTrack
+ # (found,ok,itemNr,itemPos,itemH,inputTrack) = okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemH inputTrack
+ | found
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ | otherwise
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ where
+ okControlItemNrKeyboardState :: !OSWindowPtr !OSWindowPtr !Bool !Int !Int !Int !(WElementHandle .ls .pst) !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,KeyboardState,!WElementHandle .ls .pst, ! Maybe InputTrack)
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods
+ (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemSelect,wItemShow,wItemAtts})
+ inputTrack
+ | itemPtr<>wItemPtr
+ | not wItemShow
+ = (False,False,0,undef,WItemHandle itemH,inputTrack)
+ // otherwise
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble1 keycode state mods itemH.wItems inputTrack
+ = (found,ok,itemNr,itemPos,WItemHandle {itemH & wItems=itemHs},inputTrack)
+ | trackingKeyboard wPtr itemPtr inputTrack // Control is already handling Key(Repeat/Up)
+ | isDownKey // Ignore all key down events
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ | pressState==KeyUp // Clear keyboard tracking
+ = (True,okKeyboardAtt,wItemNr,keystate,WItemHandle itemH,untrackKeyboard inputTrack)
+ // otherwise
+ = (True,okKeyboardAtt,wItemNr,keystate,WItemHandle itemH,inputTrack)
+ | isDownKey // Key down sets input track
+ = (True,okKeyboardAtt,wItemNr,keystate,WItemHandle itemH,trackKeyboard wPtr itemPtr inputTrack)
+ | otherwise
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ where
+ contextAble1 = contextAble && wItemSelect
+ noKeyboardAtt = ControlKeyboard (const False) Unable undef
+ (filter,selectState,_) = getControlKeyboardAtt (snd (cselect isControlKeyboard noKeyboardAtt wItemAtts))
+ okKeyboardAtt = contextAble1 && enabled selectState && filter keystate
+ keystate = keyState keycode state mods
+ pressState = getKeyboardStateKeyState keystate
+ isDownKey = pressState==KeyDown False
+
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods (WListLSHandle itemHs) inputTrack
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,WListLSHandle itemHs,inputTrack)
+
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods (WExtendLSHandle wExH=:{wExtendItems=itemHs}) inputTrack
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,WExtendLSHandle {wExH & wExtendItems=itemHs},inputTrack)
+
+ okControlItemNrKeyboardState wPtr itemPtr contextAble keycode state mods (WChangeLSHandle wChH=:{wChangeItems=itemHs}) inputTrack
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrKeyboardState wPtr itemPtr contextAble keycode state mods itemHs inputTrack
+ = (found,ok,itemNr,itemPos,WChangeLSHandle {wChH & wChangeItems=itemHs},inputTrack)
+
+ okControlsItemNrKeyboardState _ _ _ _ _ _ itemH inputTrack
+ = (False,False,0,undef,itemH,inputTrack)
+
+ okControlItemsNrKeyboardState _ _ _ _ _ _ _
+ = windoweventFatalError "okControlItemsNrKeyboardState" "window placeholder not expected"
+where
+ keyState :: !Int !Int !Int -> KeyboardState
+ keyState keycode state mods
+ | isSpecial = SpecialKey special ks modifiers
+ | otherwise = CharKey (toChar keycode) ks
+ where
+ modifiers = toModifiers mods
+ ks = case state of
+ KEYDOWN -> KeyDown False
+ KEYREPEAT -> KeyDown True
+ KEYUP -> KeyUp
+ (isSpecial,special) = case keycode of
+ WinBackSpKey-> (True,backSpaceKey)
+ WinBeginKey -> (True,beginKey)
+ WinDelKey -> (True,deleteKey)
+ WinDownKey -> (True,downKey)
+ WinEndKey -> (True,endKey)
+ WinEscapeKey-> (True,escapeKey)
+ WinHelpKey -> (True,helpKey)
+ WinLeftKey -> (True,leftKey)
+ WinPgDownKey-> (True,pgDownKey)
+ WinPgUpKey -> (True,pgUpKey)
+ WinReturnKey-> (True,enterKey)
+ WinRightKey -> (True,rightKey)
+ WinUpKey -> (True,upKey)
+ WinF1Key -> (True,f1Key)
+ WinF2Key -> (True,f2Key)
+ WinF3Key -> (True,f3Key)
+ WinF4Key -> (True,f4Key)
+ WinF5Key -> (True,f5Key)
+ WinF6Key -> (True,f6Key)
+ WinF7Key -> (True,f7Key)
+ WinF8Key -> (True,f8Key)
+ WinF9Key -> (True,f9Key)
+ WinF10Key -> (True,f10Key)
+ WinF11Key -> (True,f11Key)
+ WinF12Key -> (True,f12Key)
+ _ -> (False,undef)
+
+filterOSEvent _ {ccMsg=CcWmKILLFOCUS,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (found,itemNr,wsH) = getControlKeyFocusItemNr False cPtr wsH
+ windows = setWindowHandlesWindow wsH windows
+ | not found
+ = (True,Nothing,Nothing,windows,ioState)
+ | otherwise
+ = (True,Nothing,Just (ControlLooseKeyFocus {ckfWIDS=wids,ckfItemNr=itemNr,ckfItemPtr=cPtr}),windows,ioState)
+
+filterOSEvent _ {ccMsg=CcWmLOSTKEY,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The window lost the keyboard input
+ # (ok,wsH) = okWindowKeyLost wsH
+ deviceEvent = if ok (Just (WindowKeyboardAction {wkWIDS=wids,wkKeyboardState=KeyLost})) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowKeyLost :: !(WindowStateHandle .pst) -> (!Bool,!WindowStateHandle .pst)
+ okWindowKeyLost wsH=:{wshHandle=Just {wlsHandle={whKind,whAtts}}}
+ | whKind==IsDialog
+ = (False,wsH)
+ | otherwise
+ = (okKeyAtt,wsH)
+ where
+ (filter,selectState,_) = getWindowKeyboardAtt (snd (cselect isWindowKeyboard (WindowKeyboard (const False) Unable undef) whAtts))
+ okKeyAtt = filter KeyLost && selectState==Able
+ okWindowKeyLost _
+ = windoweventFatalError "okWindowKeyLost" "placeholder not expected"
+ | otherwise // One of the window controls lost the keyboard input
+ # (ok,itemNr,wsH) = okControlItemNrsKeyLost cPtr wsH
+ info = { ckWIDS = wids
+ , ckItemNr = itemNr
+ , ckItemPtr = cPtr
+ , ckKeyboardState = KeyLost
+ }
+ deviceEvent = if (ok && itemNr>0) (Just (ControlKeyboardAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemNrsKeyLost :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Bool,!Int,!WindowStateHandle .pst)
+ okControlItemNrsKeyLost itemPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,ok,itemNr,itemHs) = okControlsItemNrKeyLost True itemPtr whItems
+ = (ok,itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ okControlsItemNrKeyLost :: !Bool !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Bool,!Int,![WElementHandle .ls .pst])
+ okControlsItemNrKeyLost contextAble itemPtr [itemH:itemHs]
+ # (found,ok,itemNr,itemH) = okControlItemNrKeyLost contextAble itemPtr itemH
+ | found
+ = (found,ok,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,ok,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,[itemH:itemHs])
+ where
+ okControlItemNrKeyLost :: !Bool !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Bool,!Int,!WElementHandle .ls .pst)
+ okControlItemNrKeyLost contextAble itemPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemSelect,wItemShow,wItemAtts,wItems})
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble1 itemPtr wItems
+ = (found,okKey,itemNr,WItemHandle {itemH & wItems=itemHs})
+ // otherwise
+ = (False,False,0,WItemHandle itemH)
+ | otherwise
+ = (True,okKeyAtt,wItemNr,WItemHandle itemH)
+ where
+ contextAble1= contextAble && wItemSelect
+ (filter,selectState,_)
+ = getControlKeyboardAtt (snd (cselect isControlKeyboard (ControlKeyboard (const False) Unable undef) wItemAtts))
+ okKeyAtt = contextAble1 && enabled selectState && filter KeyLost
+
+ okControlItemNrKeyLost contextAble itemPtr (WListLSHandle itemHs)
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,okKey,itemNr,WListLSHandle itemHs)
+
+ okControlItemNrKeyLost contextAble itemPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,okKey,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ okControlItemNrKeyLost contextAble itemPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,okKey,itemNr,itemHs) = okControlsItemNrKeyLost contextAble itemPtr itemHs
+ = (found,okKey,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ okControlsItemNrKeyLost _ _ []
+ = (False,False,0,[])
+
+ okControlItemNrsKeyLost _ _
+ = windoweventFatalError "okControlItemNrsKeyLost" "placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmLOSTMOUSE,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The window lost the mouse input
+ # (ok,wsH) = okWindowMouseLost wsH
+ deviceEvent = if ok (Just (WindowMouseAction {wmWIDS=wids,wmMouseState=MouseLost})) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowMouseLost :: !(WindowStateHandle .pst) -> (!Bool,!WindowStateHandle .pst)
+ okWindowMouseLost wsH=:{wshHandle=Just {wlsHandle={whKind,whAtts}}}
+ | whKind==IsDialog
+ = (False,wsH)
+ | otherwise
+ = (okMouseAtt,wsH)
+ where
+ (filter,selectState,_) = getWindowMouseAtt (snd (cselect isWindowMouse (WindowMouse (const False) Unable undef) whAtts))
+ okMouseAtt = filter MouseLost && selectState==Able
+ okWindowMouseLost _
+ = windoweventFatalError "okWindowMouseLost" "placeholder not expected"
+ | otherwise // One of the window controls lost the mouse input
+ # (ok,itemNr,wsH) = okControlItemNrsMouseLost cPtr wsH
+ info = { cmWIDS = wids
+ , cmItemNr = itemNr
+ , cmItemPtr = cPtr
+ , cmMouseState = MouseLost
+ }
+ deviceEvent = if (ok && itemNr>0) (Just (ControlMouseAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemNrsMouseLost :: !OSWindowPtr !(WindowStateHandle .pst) -> (!Bool,!Int,!WindowStateHandle .pst)
+ okControlItemNrsMouseLost itemPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}}
+ # (_,ok,itemNr,itemHs) = okControlsItemNrMouseLost True itemPtr whItems
+ = (ok,itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+ where
+ okControlsItemNrMouseLost :: !Bool !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Bool,!Int,![WElementHandle .ls .pst])
+ okControlsItemNrMouseLost contextAble itemPtr [itemH:itemHs]
+ # (found,ok,itemNr,itemH) = okControlItemNrMouseLost contextAble itemPtr itemH
+ | found
+ = (found,ok,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,[itemH:itemHs])
+ where
+ okControlItemNrMouseLost :: !Bool !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Bool,!Int,!WElementHandle .ls .pst)
+ okControlItemNrMouseLost contextAble itemPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemSelect,wItemShow,wItemAtts,wItems})
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble1 itemPtr wItems
+ = (found,ok,itemNr,WItemHandle {itemH & wItems=itemHs})
+ // otherwise
+ = (False,False,0,WItemHandle itemH)
+ | otherwise
+ = (True,okMouseAtt,wItemNr,WItemHandle itemH)
+ where
+ contextAble1= contextAble && wItemSelect
+ (filter,selectState,_)
+ = getControlMouseAtt (snd (cselect isControlMouse (ControlMouse (const False) Unable undef) wItemAtts))
+ okMouseAtt = contextAble1 && enabled selectState && filter MouseLost
+
+ okControlItemNrMouseLost contextAble itemPtr (WListLSHandle itemHs)
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,WListLSHandle itemHs)
+
+ okControlItemNrMouseLost contextAble itemPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ okControlItemNrMouseLost contextAble itemPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,ok,itemNr,itemHs) = okControlsItemNrMouseLost contextAble itemPtr itemHs
+ = (found,ok,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+
+ okControlsItemNrMouseLost _ _ []
+ = (False,False,0,[])
+
+ okControlItemNrsMouseLost _ _
+ = windoweventFatalError "okControlItemNrsMouseLost" "placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmMOUSE,p1=wPtr,p2=cPtr,p3=action,p4=x,p5=y,p6=mods} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (able,wsH) = getWindowStateHandleSelect wsH
+ | not able
+ = (True,Nothing,Nothing,setWindowHandlesWindow wsH windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ | wPtr==cPtr // The mouse action takes place in the window
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,mouse,wsH,inputTrack) = okWindowMouseState action {x=x,y=y} wsH inputTrack
+ deviceEvent = if ok (Just (WindowMouseAction {wmWIDS=wids,wmMouseState=mouse})) Nothing
+ # ioState = ioStSetInputTrack inputTrack ioState
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okWindowMouseState :: !Int !Point2 !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,MouseState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okWindowMouseState action eventPos wsH=:{wshHandle=Just {wlsHandle={whKind,whWindowInfo,whAtts}}} inputTrack
+ | whKind==IsDialog
+ = (False,undef,wsH,inputTrack)
+ | trackingMouse wPtr 0 inputTrack // Window is already handling Mouse(Drag/Up)
+ | isDownButton || buttonstate==ButtonStillUp // Ignore all mouse down and mouse move events
+ = (False,undef,wsH,inputTrack)
+ | buttonstate==ButtonUp // Clear mouse tracking
+ = (okMouseAtt,mousestate,wsH,untrackMouse inputTrack)
+ // otherwise
+ = (okMouseAtt,mousestate,wsH,inputTrack)
+ | isDownButton // Mouse down event sets input track
+ = (okMouseAtt,mousestate,wsH,trackMouse wPtr 0 inputTrack)
+ | isMember buttonstate [ButtonStillDown,ButtonUp] // Ignore all mouse drag and up events when not tracking
+ = (False,undef,wsH,inputTrack)
+ | otherwise
+ = (okMouseAtt,mousestate,wsH,inputTrack)
+ where
+ origin = (getWindowInfoWindowData whWindowInfo).windowOrigin
+ mousestate = mouseState action (eventPos+origin)
+ buttonstate = getMouseStateButtonState mousestate
+ isDownButton = isMember buttonstate [ButtonDown,ButtonDoubleDown,ButtonTripleDown]
+ (filter,selectState,_) = getWindowMouseAtt (snd (cselect isWindowMouse (WindowMouse (const False) Unable undef) whAtts))
+ okMouseAtt = filter mousestate && selectState==Able
+ okWindowMouseState _ _ _ _
+ = windoweventFatalError "okWindowMouseState" "placeholder not expected"
+ | otherwise // The mouse action takes place in a control
+ # (inputTrack,ioState) = ioStGetInputTrack ioState
+ (ok,itemNr,mouse,wsH,inputTrack)
+ = okControlItemsNrMouseState wPtr cPtr action {x=x,y=y} wsH inputTrack
+ # ioState = ioStSetInputTrack inputTrack ioState
+ info = { cmWIDS = wids
+ , cmItemNr = itemNr
+ , cmItemPtr = cPtr
+ , cmMouseState = mouse
+ }
+ deviceEvent = if ok (Just (ControlMouseAction info)) Nothing
+ = (True,Nothing,deviceEvent,setWindowHandlesWindow wsH windows,ioState)
+ with
+ okControlItemsNrMouseState :: !OSWindowPtr !OSWindowPtr !Int !Point2 !(WindowStateHandle .pst) !(Maybe InputTrack)
+ -> (!Bool,!Int,MouseState,!WindowStateHandle .pst, ! Maybe InputTrack)
+ okControlItemsNrMouseState wPtr itemPtr action eventPos wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH=:{whItems}}} inputTrack
+ # (_,ok,itemNr,itemPos,itemHs,inputTrack)
+ = okControlsItemNrMouseState True wPtr itemPtr action eventPos whItems inputTrack
+ = (ok,itemNr,itemPos,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}},inputTrack)
+ where
+ okControlsItemNrMouseState :: !Bool !OSWindowPtr !OSWindowPtr !Int !Point2 ![WElementHandle .ls .pst] !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,MouseState,![WElementHandle .ls .pst], !Maybe InputTrack)
+ okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos [itemH:itemHs] inputTrack
+ # (found,ok,itemNr,itemPos,itemH,inputTrack)
+ = okControlItemNrMouseState contextAble wPtr itemPtr action eventPos itemH inputTrack
+ | found
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ | otherwise
+ # (found,ok,itemNr,itemPos,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,itemPos,[itemH:itemHs],inputTrack)
+ where
+ okControlItemNrMouseState :: !Bool !OSWindowPtr !OSWindowPtr !Int !Point2 !(WElementHandle .ls .pst) !(Maybe InputTrack)
+ -> (!Bool,!Bool,!Int,MouseState,!WElementHandle .ls .pst, !Maybe InputTrack)
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos
+ (WItemHandle itemH=:{wItemPtr,wItemSelect,wItemKind,wItemNr,wItemShow,wItemAtts,wItems,wItemInfo})
+ inputTrack
+ | itemPtr<>wItemPtr
+ | wItemShow
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble1 wPtr itemPtr action eventPos wItems inputTrack
+ = (found,ok,itemNr,mousestate,WItemHandle {itemH & wItems=itemHs},inputTrack)
+ // otherwise
+ = (False,False,0,undef,WItemHandle itemH,inputTrack)
+ | trackingMouse wPtr itemPtr inputTrack // Control is already handling Mouse(Drag/Up)
+ | isDownButton || buttonstate==ButtonStillUp // Ignore all mouse down and mouse move events
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ | buttonstate==ButtonUp // Clear mouse tracking
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,untrackMouse inputTrack)
+ // otherwise
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,inputTrack)
+ | isDownButton // Mouse down event sets input track
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,trackMouse wPtr itemPtr inputTrack)
+ | isMember buttonstate [ButtonStillDown,ButtonUp] // Ignore all mouse drag and up events when not tracking
+ = (True,False,0,undef,WItemHandle itemH,inputTrack)
+ | otherwise
+ = (True,okMouseAtt,wItemNr,mousestate,WItemHandle itemH,inputTrack)
+ where
+ contextAble1= contextAble && wItemSelect
+ (filter,selectState,_)
+ = getControlMouseAtt (snd (cselect isControlMouse (ControlMouse (const False) Unable undef) wItemAtts))
+ okMouseAtt = contextAble1 && enabled selectState && filter mousestate
+ mousestate = mouseState action (origin+eventPos)
+ buttonstate = getMouseStateButtonState mousestate
+ isDownButton= isMember buttonstate [ButtonDown,ButtonDoubleDown,ButtonTripleDown]
+ origin = case wItemKind of
+ IsCustomButtonControl -> zero
+ IsCustomControl -> zero
+ IsCompoundControl -> (getWItemCompoundInfo wItemInfo).compoundOrigin
+ _ -> windoweventFatalError "okControlItemsNrMouseState" "mouse event generated for unexpected control"
+
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos (WListLSHandle itemHs) inputTrack
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,mousestate,WListLSHandle itemHs,inputTrack)
+
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos (WExtendLSHandle wExH=:{wExtendItems=itemHs}) inputTrack
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,mousestate,WExtendLSHandle {wExH & wExtendItems=itemHs},inputTrack)
+
+ okControlItemNrMouseState contextAble wPtr itemPtr action eventPos (WChangeLSHandle wChH=:{wChangeItems=itemHs}) inputTrack
+ # (found,ok,itemNr,mousestate,itemHs,inputTrack) = okControlsItemNrMouseState contextAble wPtr itemPtr action eventPos itemHs inputTrack
+ = (found,ok,itemNr,mousestate,WChangeLSHandle {wChH & wChangeItems=itemHs},inputTrack)
+
+ okControlsItemNrMouseState _ _ _ _ _ [] inputTrack
+ = (False,False,0,undef,[],inputTrack)
+
+ okControlItemsNrMouseState _ _ _ _ _ _
+ = windoweventFatalError "okControlItemsNrMouseState" "placeholder not expected"
+where
+ modifiers = toModifiers mods
+ nrDown = case action of
+ BUTTONDOWN -> 1
+ BUTTONDOUBLEDOWN -> 2
+ _ -> 3
+ mouseState action pos = case action of
+ BUTTONSTILLUP -> MouseMove pos modifiers
+ BUTTONUP -> MouseUp pos modifiers
+ BUTTONSTILLDOWN -> MouseDrag pos modifiers
+ _ -> MouseDown pos modifiers nrDown
+
+filterOSEvent _ {ccMsg=CcWmSETFOCUS,p1=wPtr,p2=cPtr} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (found,itemNr,wsH) = getControlKeyFocusItemNr True cPtr wsH
+ windows = setWindowHandlesWindow wsH windows
+ | not found
+ = (True,Nothing,Nothing,windows,ioState)
+ | otherwise
+ = (True,Nothing,Just (ControlGetKeyFocus {ckfWIDS=wids,ckfItemNr=itemNr,ckfItemPtr=cPtr}),windows,ioState)
+
+filterOSEvent wMetrics {ccMsg=CcWmSIZE,p1=wPtr,p2=w,p3=h,p4=usersizing} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ # (wKind,wsH) = getWindowStateHandleWindowKind wsH
+ | wKind==IsDialog // This alternative should never occur
+ = windoweventFatalError "filterOSEvent" "WindowSizeAction event generated for Dialog"
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ # (tb,ioState) = getIOToolbox ioState
+ (info,wsH,tb) = getWindowStateHandleSize wids w h (usersizing<>0) wsH tb
+ # ioState = setIOToolbox tb ioState
+ windows = setWindowHandlesWindow wsH windows
+ = (True,Nothing,Just (WindowSizeAction info),windows,ioState)
+where
+ getWindowStateHandleSize :: !WIDS !Int !Int !Bool !(WindowStateHandle .pst) !*OSToolbox
+ -> (!WindowSizeActionInfo,!WindowStateHandle .pst, !*OSToolbox)
+ getWindowStateHandleSize wids newW newH usersizing wsH=:{wshHandle=Just {wlsHandle=wH=:{whSize,whWindowInfo}}} tb
+ = ({wsWIDS=wids,wsSize={w=newW`,h=newH`},wsUpdateAll=not usersizing},wsH,tb)
+ where
+ windowInfo = getWindowInfoWindowData whWindowInfo
+ domainRect = windowInfo.windowDomain
+ hasScrolls = (isJust windowInfo.windowHScroll,isJust windowInfo.windowVScroll)
+ (visHScroll,visVScroll) = osScrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
+ newW` = if visVScroll (newW+wMetrics.osmVSliderWidth) newW // Correct newW in case of visible vertical scrollbar
+ newH` = if visHScroll (newH+wMetrics.osmHSliderHeight) newH // Correct newH in case of visible horizontal scrollbar
+ getWindowStateHandleSize _ _ _ _ _ _
+ = windoweventFatalError "getWindowStateHandleSize" "placeholder not expected"
+
+filterOSEvent _ {ccMsg=CcWmSPECIALBUTTON,p1=wPtr,p2=okOrCancel} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ (okId,wsH) = getWindowStateHandleDefaultId wsH
+ (cancelId,wsH) = getWindowStateHandleCancelId wsH
+ okOrCancelEvent = if (okOrCancel==ISOKBUTTON) (if (isJust okId) (Just (WindowOK wids)) Nothing)
+ (if (okOrCancel==ISCANCELBUTTON) (if (isJust cancelId) (Just (WindowCANCEL wids)) Nothing)
+ (windoweventFatalError "filterOSEvent (CcWmSPECIALBUTTON)" "incorrect argument"))
+ = (True,Nothing,okOrCancelEvent,setWindowHandlesWindow wsH windows,ioState)
+
+/* The CcWmPAINT message is generated to update the indicated rectangle of the argument window.
+*/
+filterOSEvent _ {ccMsg=CcWmPAINT,p1=wPtr,p2=left,p3=top,p4=right,p5=bottom,p6=gc} windows ioState
+ # (found,wsH,windows) = getWindowHandlesWindow (toWID wPtr) windows
+ | not found
+ = (False,Nothing,Nothing,windows,ioState)
+ | otherwise
+ # (wids,wsH) = getWindowStateHandleWIDS wsH
+ windows = setWindowHandlesWindow wsH windows
+ updRect = fromTuple4 (left,top,right,bottom)
+ updateInfo = {updWIDS=wids,updWindowArea=updRect,updControls=[],updGContext=if (gc==0) Nothing (Just gc)}
+ = (True,Nothing,Just (WindowUpdate updateInfo),windows,ioState)
+
+filterOSEvent _ _ _ _
+ = windoweventFatalError "filterOSEvent" "unmatched OSEvent"
+
+
+/* PA: moved to clCCall_12:
+toModifiers :: !Int -> Modifiers
+toModifiers i
+ = { shiftDown = shifton
+ , optionDown = alton
+ , commandDown = ctrlon
+ , controlDown = ctrlon
+ , altDown = alton
+ }
+where
+ shifton = i bitand SHIFTBIT <> 0
+ alton = i bitand ALTBIT <> 0
+ ctrlon = i bitand CTRLBIT <> 0
+*/
+
+getControlKeyFocusItemNr :: !Bool !OSWindowPtr !(WindowStateHandle .pst) -> (!Bool,!Int,!WindowStateHandle .pst)
+getControlKeyFocusItemNr activated cPtr wsH=:{wshHandle=Just wlsH=:{wlsHandle=wH}}
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr wH.whItems
+ = (found,itemNr,{wsH & wshHandle=Just {wlsH & wlsHandle={wH & whItems=itemHs}}})
+where
+ getControlsKeyFocusItemNr` :: !Bool !OSWindowPtr ![WElementHandle .ls .pst] -> (!Bool,!Int,![WElementHandle .ls .pst])
+ getControlsKeyFocusItemNr` activated cPtr []
+ = (False,0,[])
+ getControlsKeyFocusItemNr` activated cPtr [itemH:itemHs]
+ # (found,itemNr,itemH) = getControlKeyFocusItemNr` activated cPtr itemH
+ | found
+ = (found,itemNr,[itemH:itemHs])
+ | otherwise
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,[itemH:itemHs])
+ where
+ getControlKeyFocusItemNr` :: !Bool !OSWindowPtr !(WElementHandle .ls .pst) -> (!Bool,!Int,!WElementHandle .ls .pst)
+ getControlKeyFocusItemNr` activated cPtr (WItemHandle itemH=:{wItemPtr,wItemNr,wItemKind,wItemSelect,wItemAtts,wItems})
+ | cPtr==wItemPtr
+ | not (isMember wItemKind [IsCompoundControl,IsCustomControl,IsEditControl,IsPopUpControl])
+ = (True,0,WItemHandle itemH)
+ /* PA: deze tests zijn verwijderd
+ | not wItemSelect
+ = (0,WItemHandle itemH)
+ | contains reqAttribute wItemAtts
+ = (wItemNr,WItemHandle itemH)
+ // otherwise
+ = (0,WItemHandle itemH)
+ */
+ // otherwise
+ = (True,wItemNr,WItemHandle itemH)
+ | not (isRecursiveControl wItemKind)
+ = (False,0,WItemHandle itemH)
+ | otherwise
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr wItems
+ = (found,itemNr,WItemHandle {itemH & wItems=itemHs})
+ /* where
+ reqAttribute = if activated isControlActivate isControlDeactivate // PA: wordt niet meer gebruikt
+ */
+ getControlKeyFocusItemNr` activated cPtr (WListLSHandle itemHs)
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,WListLSHandle itemHs)
+
+ getControlKeyFocusItemNr` activated cPtr (WExtendLSHandle wExH=:{wExtendItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,WExtendLSHandle {wExH & wExtendItems=itemHs})
+
+ getControlKeyFocusItemNr` activated cPtr (WChangeLSHandle wChH=:{wChangeItems=itemHs})
+ # (found,itemNr,itemHs) = getControlsKeyFocusItemNr` activated cPtr itemHs
+ = (found,itemNr,WChangeLSHandle {wChH & wChangeItems=itemHs})
+getControlKeyFocusItemNr _ _ _
+ = windoweventFatalError "getControlKeyFocusItemNr" "window placeholder not expected"
+
+
+// Access operations on InputTrack:
+
+trackingMouse :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Bool
+trackingMouse wPtr cPtr (Just {itWindow,itControl,itKind={itkMouse}})
+ = wPtr==itWindow && cPtr==itControl && itkMouse
+trackingMouse _ _ _
+ = False
+
+trackingKeyboard :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Bool
+trackingKeyboard wPtr cPtr (Just {itWindow,itControl,itKind={itkKeyboard}})
+ = wPtr==itWindow && cPtr==itControl && itkKeyboard
+trackingKeyboard _ _ _
+ = False
+
+trackMouse :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Maybe InputTrack
+trackMouse wPtr cPtr (Just it=:{itWindow,itControl,itKind=itk})
+ | wPtr<>itWindow || cPtr<>itControl
+ = windoweventFatalError "trackMouse" "incorrect window/control parameters"
+ | otherwise
+ = Just {it & itKind={itk & itkMouse=True}}
+trackMouse wPtr cPtr nothing
+// = Just {itWindow=wPtr,itControl=cPtr,itKind={itkMouse=True,itkKeyboard=False}}
+ = Just { itWindow = wPtr
+ , itControl = cPtr
+ , itKind = { itkMouse = True
+ , itkKeyboard = False
+ , itkChar = 0 // PA: assuming the fields itkChar and itkSlider are not used on Windows platform
+ , itkSlider = Nothing // dito
+ }
+ }
+
+untrackMouse :: !(Maybe InputTrack) -> Maybe InputTrack
+untrackMouse (Just it=:{itKind=itk})
+ | itk.itkKeyboard
+ = Just {it & itKind={itk & itkMouse=False}}
+ | otherwise
+ = Nothing
+untrackMouse nothing
+ = nothing
+
+untrackKeyboard :: !(Maybe InputTrack) -> Maybe InputTrack
+untrackKeyboard (Just it=:{itKind=itk})
+ | itk.itkMouse
+ = Just {it & itKind={itk & itkKeyboard=False}}
+ | otherwise
+ = Nothing
+untrackKeyboard nothing
+ = nothing
+
+trackKeyboard :: !OSWindowPtr !OSWindowPtr !(Maybe InputTrack) -> Maybe InputTrack
+trackKeyboard wPtr cPtr (Just it=:{itWindow,itControl,itKind=itk})
+ | wPtr<>itWindow || cPtr<>itControl
+ = windoweventFatalError "trackKeyboard" "incorrect window/control parameters"
+ | otherwise
+ = Just {it & itKind={itk & itkKeyboard=True}}
+trackKeyboard wPtr cPtr nothing
+// = Just {itWindow=wPtr,itControl=cPtr,itKind={itkMouse=False,itkKeyboard=True}}
+ = Just { itWindow = wPtr
+ , itControl = cPtr
+ , itKind = { itkMouse = False
+ , itkKeyboard = True
+ , itkChar = 0 // PA: assuming the fields itkChar and itkSlider are not used on Windows platform
+ , itkSlider = Nothing // dito
+ }
+ }
|