htoolkit-cvs — HToolkit CVS commit messages

[htoolkit-cvs] port configure,1.14,1.15 makefile,1.23,1.24

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port
In directory sc8-pr-cvs1:/tmp/cvs-serv32397

Modified Files:
	configure makefile 
Log Message:
better configure/make scripts


Index: configure
===================================================================
RCS file: /cvsroot/htoolkit/port/configure,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** configure	4 Jul 2003 17:39:04 -0000	1.14
--- configure	16 Jul 2003 22:11:06 -0000	1.15
***************
*** 15,19 ****
  hcpkg=""
  hcpkglocal=""
! ffidir=""
  hdoc=""
  hdoclibs=""
--- 15,20 ----
  hcpkg=""
  hcpkglocal=""
! incdir=""
! libdir=""
  hdoc=""
  hdoclibs=""
***************
*** 48,53 ****
      -hc*)
          hc="$2"; shift;;
!     -ffidir*)
!         ffidir="$2"; shift;;
      -hcpkg*)
          hcpkg="$2"; shift;;
--- 49,54 ----
      -hc*)
          hc="$2"; shift;;
!     -incdir*)
!         incdir="$2"; shift;;
      -hcpkg*)
          hcpkg="$2"; shift;;
***************
*** 117,121 ****
    echo " unable to find: $hc"
    echo " pleasy specify the path to GHC."
!   echo " for example: ./configure -hc //c/ghc/ghc-5.04.2/bin/ghc"
    hc=echo
    exit 2
--- 118,122 ----
    echo " unable to find: $hc"
    echo " pleasy specify the path to GHC."
!   echo " for example: ./configure -hc /usr/bin/ghc"
    hc=echo
    exit 2
***************
*** 124,128 ****
  
  # check ghc version
! version="`$hc --version | sed -e 's|[A-Za-z \t,]*||'`"
  case $version in
    0* | 1* |  2* |  3* |  4* |  5.00* |  5.01* |  5.02* |  5.03* |  5.04 |  5.04.0 |  5.04.1) echo "WARNING:"
--- 125,129 ----
  
  # check ghc version
! version="`$hc --numeric-version`"
  case $version in
    0* | 1* |  2* |  3* |  4* |  5.00* |  5.01* |  5.02* |  5.03* |  5.04 |  5.04.0 |  5.04.1) echo "WARNING:"
***************
*** 136,152 ****
  	 echo " unable to recognise the ghc version ($version ?)"
           echo " ghc versions prior to 5.04.2 have gc bugs that make port applications crash."
! 	 echo "";;  
  esac
  
! # find HsFFI.h
! if test -z "$ffidir"; then
!   if test -f $hc; then
!     ffidir="`echo $hc | sed -e 's|bin/ghc|include|' -e 's|.exe||'`"
!   else
!     ffidir="`which $hc | sed -e 's|bin/ghc|include|' -e 's|.exe||'`"
!   fi
! fi
  
! if test -f "$ffidir/HsFFI.h"; then
    echo "HsFFI.h found"
  else
--- 137,147 ----
  	 echo " unable to recognise the ghc version ($version ?)"
           echo " ghc versions prior to 5.04.2 have gc bugs that make port applications crash."
! 	 echo "";;
  esac
  
! libdir="`$hc --print-libdir`"
! incdir="$libdir/include"
  
! if test -f "$incdir/HsFFI.h"; then
    echo "HsFFI.h found"
  else
***************
*** 154,158 ****
    echo " could not find 'HsFFI.h'"
    echo " please specify the ffi include directories"
!   echo " for example: ./configure -ffidir /pkg/ghc-5.04.2/lib/ghc-5.04.2/include"
    exit 2
  fi
--- 149,153 ----
    echo " could not find 'HsFFI.h'"
    echo " please specify the ffi include directories"
!   echo " for example: ./configure -incdir /usr/lib/ghc-6.0/include"
    exit 2
  fi
***************
*** 385,389 ****
  fi
  
! echo "FFIDIR=$ffidir"    >> config/config.mk
  echo "GUILIB=$target"    >> config/config.mk
  echo "CLIBS=$clibopts"   >> config/config.mk
--- 380,385 ----
  fi
  
! echo "LIBDIR=$libdir"    >> config/config.mk
! echo "INCDIR=$incdir"    >> config/config.mk
  echo "GUILIB=$target"    >> config/config.mk
  echo "CLIBS=$clibopts"   >> config/config.mk
***************
*** 425,431 ****
  echo "  { name=\"port\""		>> config/port.pkg
  echo "  , auto=True"	>> config/port.pkg
! echo "  , import_dirs=[\"$curdir/imports\"]"	>> config/port.pkg
! echo "  , library_dirs=[\"$curdir\" $extralibdirs]"	>> config/port.pkg
! echo "  , hs_libraries=[\"port\"]"	>> config/port.pkg
  echo "  , extra_libraries=[$extralibs]" >> config/port.pkg
  echo "  , package_deps=[]"		>> config/port.pkg
--- 421,427 ----
  echo "  { name=\"port\""		>> config/port.pkg
  echo "  , auto=True"	>> config/port.pkg
! echo "  , import_dirs=[\"\$libdir/imports\"]"	>> config/port.pkg
! echo "  , library_dirs=[\"$libdir\" $extralibdirs]"	>> config/port.pkg
! echo "  , hs_libraries=[\"HSport\"]"	>> config/port.pkg
  echo "  , extra_libraries=[$extralibs]" >> config/port.pkg
  echo "  , package_deps=[]"		>> config/port.pkg

Index: makefile
===================================================================
RCS file: /cvsroot/htoolkit/port/makefile,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** makefile	8 Jul 2003 20:31:29 -0000	1.23
--- makefile	16 Jul 2003 22:11:06 -0000	1.24
***************
*** 82,86 ****
  CSRCDIRS    = src/cbits/$(GUILIB)
  HEADERDIR   = src/include
! CINCDIRS    = $(HEADERDIR) $(HOUTDIR)/Port $(FFIDIR) src/cbits/$(GUILIB)
  
  
--- 82,86 ----
  CSRCDIRS    = src/cbits/$(GUILIB)
  HEADERDIR   = src/include
! CINCDIRS    = $(HEADERDIR) $(HOUTDIR)/Port $(INCDIR) src/cbits/$(GUILIB)
  
  
***************
*** 89,94 ****
  #--------------------------------------------------------------------------
  
! HC-OPTIONS	= # -O2
! CC-OPTIONS	= 
  
  ifdef HDOCHTML
--- 89,94 ----
  #--------------------------------------------------------------------------
  
! HC-OPTIONS	= -O2
! CC-OPTIONS	= -O2
  
  ifdef HDOCHTML
***************
*** 115,120 ****
  
  # main, object files, dependencies and hi files
! MAINLIB	    = lib$(MAIN).a
! MAINOBJ	    = $(MAIN).o
  
  HOBJS	    = $(patsubst %.hs,$(HOUTDIR)/%.o, $(HSRCS))
--- 115,120 ----
  
  # main, object files, dependencies and hi files
! MAINLIB	    = libHS$(MAIN).a
! MAINOBJ	    = HS$(MAIN).o
  
  HOBJS	    = $(patsubst %.hs,$(HOUTDIR)/%.o, $(HSRCS))
***************
*** 139,148 ****
  all: release doc
  
! release:  $(MAINOBJ)
  
! # build a library
! $(MAINOBJ): $(MAINLIB) $(PKG)
! 	  $(RM) $(MAINOBJ)
! 	  $(HCPKG) -u -g -i $(PKG)
  
  $(MAINLIB): $(HOBJS) $(COBJS) $(STUBSTUBOBJS)
--- 139,156 ----
  all: release doc
  
! release:  $(MAINLIB)
  
! install: $(MAINLIB) $(PKG)
! 	install -d $(LIBDIR)/imports/Graphics/UI/Port
! 	install -d $(LIBDIR)/include/port
! 	install -m 644 src/include/HsPort.h $(LIBDIR)/include/port
! 	install -m 644 imports/Graphics/UI/*.hi $(LIBDIR)/imports/Graphics/UI
! 	install -m 644 imports/Graphics/UI/Port/*.hi $(LIBDIR)/imports/Graphics/UI/Port
! 	install -m 644 $(MAINLIB) $(LIBDIR)/$(MAINLIB)
! 	install -m 644 src/include/HsPort.h $(LIBDIR)/include
! 	install -m 644 src/include/*.h $(LIBDIR)/include/port
! 	$(RM) $(LIBDIR)/include/port/HsPort.h
! 	$(RM) $(LIBDIR)/$(MAINOBJ)
! 	$(HCPKG) -u -g -i $(PKG)
  
  $(MAINLIB): $(HOBJS) $(COBJS) $(STUBSTUBOBJS)
***************
*** 160,164 ****
  
  $(HOBJS): $(HOUTDIR)/%.o: %.hs
! 	$(HC) -o $@ -package-name port -ohi $(IMPORTDIR)/Graphics/UI/$(*D)/$(*F).hi -odir $(HOUTDIR)/$(*D) -c $<  $(HC-OPTIONS) $($(*F)_OPTIONS) -i$(IMPORTDIR) $(INCDIRS) 
  	@# move stub files
  	@-if test -f $(<D)/$(*F)_stub.h; then $(MV) $(<D)/$(*F)_stub.[ch] $(HOUTDIR)/$(*D); fi   
--- 168,172 ----
  
  $(HOBJS): $(HOUTDIR)/%.o: %.hs
! 	$(HC) -o $@ -package-name port -ohi $(IMPORTDIR)/Graphics/UI/$(*D)/$(*F).hi -odir $(HOUTDIR)/$(*D) -c $<  $(HC-OPTIONS) $($(*F)_OPTIONS) -i$(IMPORTDIR) $(INCDIRS)
  	@# move stub files
  	@-if test -f $(<D)/$(*F)_stub.h; then $(MV) $(<D)/$(*F)_stub.[ch] $(HOUTDIR)/$(*D); fi   
***************
*** 194,198 ****
  $(HOUTDIR)/Port/Window.o: $(HEADERDIR)/Window.h
  $(HOUTDIR)/Port/Canvas.o: $(HEADERDIR)/Canvas.h $(HEADERDIR)/Font.h
! $(HOUTDIR)/Port/FileDialog.o: $(HEADERDIR)/FileDialog.h
  $(HOUTDIR)/Port/Font.o:	$(HEADERDIR)/Font.h
  $(HOUTDIR)/Port/Handlers.o: $(HEADERDIR)/Types.h $(HEADERDIR)/Timer.h
--- 202,207 ----
  $(HOUTDIR)/Port/Window.o: $(HEADERDIR)/Window.h
  $(HOUTDIR)/Port/Canvas.o: $(HEADERDIR)/Canvas.h $(HEADERDIR)/Font.h
! $(HOUTDIR)/Port/CommonDialogs.o: $(HEADERDIR)/CommonDialogs.h
! $(HOUTDIR)/Port/Message.o: $(HEADERDIR)/Message.h
  $(HOUTDIR)/Port/Font.o:	$(HEADERDIR)/Font.h
  $(HOUTDIR)/Port/Handlers.o: $(HEADERDIR)/Types.h $(HEADERDIR)/Timer.h
***************
*** 202,206 ****
  			    $(HEADERDIR)/EditBox.h $(HEADERDIR)/Label.h \
  			    $(HEADERDIR)/ListBox.h $(HEADERDIR)/PopUp.h \
! 			    $(HEADERDIR)/RadioBox.h $(HEADERDIR)/Window.h
  
  
--- 211,217 ----
  			    $(HEADERDIR)/EditBox.h $(HEADERDIR)/Label.h \
  			    $(HEADERDIR)/ListBox.h $(HEADERDIR)/PopUp.h \
! 			    $(HEADERDIR)/RadioBox.h $(HEADERDIR)/Window.h \
! 			    $(HEADERDIR)/ProgressBar.h $(HEADERDIR)/Slider.h
! $(HOUTDIR)/Port/ToolBar.o: $(HEADERDIR)/ToolBar.h
  
  

[htoolkit-cvs] port/src/include ToolBar.h,1.2,1.3

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/include
In directory sc8-pr-cvs1:/tmp/cvs-serv31279/src/include

Modified Files:
	ToolBar.h 
Log Message:
Add signatures for osGetToolButtonChecked and osSetToolButtonChecked functions.


Index: ToolBar.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/ToolBar.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ToolBar.h	8 Jul 2003 21:18:06 -0000	1.2
--- ToolBar.h	16 Jul 2003 22:03:14 -0000	1.3
***************
*** 19,22 ****
--- 19,24 ----
  void osDestroyToolItem(ToolHandle toolItem);
  int osGetToolItemPos(ToolHandle toolItem);
+ void osSetToolButtonChecked(ToolHandle toolButton, BOOL bState);
+ BOOL osGetToolButtonChecked(ToolHandle toolButton);
  
  #endif

[htoolkit-cvs] port/src/Port Controls.hs,1.14,1.15

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv30816/src/Port

Modified Files:
	Controls.hs 
Log Message:
Add extra -#include options


Index: Controls.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Controls.hs,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Controls.hs	10 Jul 2003 19:39:56 -0000	1.14
--- Controls.hs	16 Jul 2003 22:01:04 -0000	1.15
***************
*** 1,3 ****
! {-# OPTIONS -fglasgow-exts -#include Button.h -#include CheckBox.h -#include EditBox.h -#include Label.h -#include ListBox.h -#include PopUp.h -#include RadioBox.h -#include Window.h #-}
  -----------------------------------------------------------------------------------------
  {-| Module      :  Controls
--- 1,3 ----
! {-# OPTIONS -fglasgow-exts -#include Button.h -#include CheckBox.h -#include EditBox.h -#include Label.h -#include ListBox.h -#include PopUp.h -#include RadioBox.h -#include Window.h -#include ProgressBar.h -#include Slider.h #-}
  -----------------------------------------------------------------------------------------
  {-| Module      :  Controls

[htoolkit-cvs] port/src/cbits/GTK Window.c,1.24,1.25

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv30337/src/cbits/GTK

Modified Files:
	Window.c 
Log Message:
bugfix: Better implementation for osSetWindowResizeable


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Window.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** Window.c	15 Jul 2003 19:12:03 -0000	1.24
--- Window.c	16 Jul 2003 21:59:24 -0000	1.25
***************
*** 598,601 ****
--- 598,603 ----
  		h += EDGE_SIZE*2 + TITLE_SIZE;
  
+ 		gFrameWidth  = w;
+ 		gFrameHeight = h;
  		gtk_window_resize(GTK_WINDOW(toplevel), w, h);
  	}
***************
*** 606,612 ****
  	GtkAdjustment *adjustment;
  
- 	gtk_window_set_resizable(GTK_WINDOW(gFrameWidget), FALSE);
  	gtk_widget_set_size_request(GTK_BIN(GTK_BIN(window)->child)->child,cx,cy);
- 	gtk_window_set_resizable(GTK_WINDOW(gFrameWidget), TRUE);
  
  	adjustment = gtk_scrolled_window_get_hadjustment (GTK_SCROLLED_WINDOW(window));
--- 608,612 ----
***************
*** 852,856 ****
  	if (toplevel != gFrameWidget || gDocumentInterface == 1)
  	{
! 		gtk_window_set_resizable(GTK_WINDOW(toplevel), resizeable != 0);
  	}
  }
--- 852,864 ----
  	if (toplevel != gFrameWidget || gDocumentInterface == 1)
  	{
! 		GdkGeometry geometry;
! 
! 		geometry.min_width  = gFrameWidth;
! 		geometry.min_height = gFrameHeight;
! 		geometry.max_width  = gFrameWidth;
! 		geometry.max_height = gFrameHeight;
! 
! 		gtk_window_set_geometry_hints(GTK_WINDOW(toplevel), toplevel, &geometry,
! 		                                                                GDK_HINT_MIN_SIZE | GDK_HINT_MAX_SIZE);
  	}
  }

[htoolkit-cvs] port/src/cbits/GTK Window.c,1.23,1.24

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv18641/src/cbits/GTK

Modified Files:
	Window.c 
Log Message:
Remove unused frame_leave_notify_handler


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Window.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** Window.c	15 Jul 2003 19:00:30 -0000	1.23
--- Window.c	15 Jul 2003 19:12:03 -0000	1.24
***************
*** 170,194 ****
  };
  
- static gboolean frame_leave_notify_handler(GtkWidget *widget, GdkEventCrossing *event, gpointer user_data)
- {
- 	if (!bInDragMode)
- 	{
- 		GtkWidget *window = (GtkWidget *) user_data;
- 		GtkScrolledWindow *sw = GTK_SCROLLED_WINDOW(window);
- 
- 		int x, y;
- 		int modifiers = 0;
- 
- 		if (event->state & GDK_SHIFT_MASK) modifiers |= shiftBIT;
- 		if (event->state & GDK_CONTROL_MASK) modifiers |= ctrlBIT;
- 		if (event->state & GDK_MOD1_MASK) modifiers |= altBIT;
- 
- 		x = gtk_scrolled_window_get_hadjustment (sw)->value + event->x;
- 		y = gtk_scrolled_window_get_vadjustment (sw)->value + event->y;
- 	}
- 
- 	return gtk_true();
- };
- 
  static void frame_adjustment_value_changed_handler (GtkAdjustment *adjustment, gpointer user_data)
  {
--- 170,173 ----

[htoolkit-cvs] port/src/cbits/GTK Window.c,1.22,1.23

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv16673/src/cbits/GTK

Modified Files:
	Window.c 
Log Message:
The implementation for MouseEnter and MouseLeave events is too hard for Windows
and probably imposible to make it portable. The events was completely removed.


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Window.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** Window.c	15 Jul 2003 18:24:33 -0000	1.22
--- Window.c	15 Jul 2003 19:00:30 -0000	1.23
***************
*** 170,196 ****
  };
  
- static gboolean frame_enter_notify_handler(GtkWidget *widget, GdkEventCrossing *event, gpointer user_data)
- {
- 	if (!bInDragMode)
- 	{
- 		GtkWidget *window = (GtkWidget *) user_data;
- 		GtkScrolledWindow *sw = GTK_SCROLLED_WINDOW(window);
- 
- 		int x, y;
- 		int modifiers = 0;
- 
- 		if (event->state & GDK_SHIFT_MASK) modifiers |= shiftBIT;
- 		if (event->state & GDK_CONTROL_MASK) modifiers |= ctrlBIT;
- 		if (event->state & GDK_MOD1_MASK) modifiers |= altBIT;
- 
- 		x = gtk_scrolled_window_get_hadjustment (sw)->value + event->x;
- 		y = gtk_scrolled_window_get_vadjustment (sw)->value + event->y;
- 
- 		handleWindowMouse(window, evMouseEnter, x, y, modifiers);
- 	}
- 
- 	return gtk_true();
- };
- 
  static gboolean frame_leave_notify_handler(GtkWidget *widget, GdkEventCrossing *event, gpointer user_data)
  {
--- 170,173 ----
***************
*** 209,214 ****
  		x = gtk_scrolled_window_get_hadjustment (sw)->value + event->x;
  		y = gtk_scrolled_window_get_vadjustment (sw)->value + event->y;
- 
- 		handleWindowMouse(window, evMouseLeave, x, y, modifiers);
  	}
  
--- 186,189 ----
***************
*** 289,298 ****
  	gtk_signal_connect (GTK_OBJECT(viewport), "motion_notify_event",
  			GTK_SIGNAL_FUNC(window_motion_notify_handler),
- 			sw);
- 	gtk_signal_connect (GTK_OBJECT (viewport), "enter_notify_event",
- 			GTK_SIGNAL_FUNC(frame_enter_notify_handler),
- 			sw);
- 	gtk_signal_connect (GTK_OBJECT (viewport), "leave_notify_event",
- 			GTK_SIGNAL_FUNC(frame_leave_notify_handler),
  			sw);
  	gtk_signal_connect (GTK_OBJECT (gtk_viewport_get_hadjustment (GTK_VIEWPORT(viewport))), "value-changed",
--- 264,267 ----

[htoolkit-cvs] port/src/Port Types.hs,1.25,1.26

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv16673/src/Port

Modified Files:
	Types.hs 
Log Message:
The implementation for MouseEnter and MouseLeave events is too hard for Windows
and probably imposible to make it portable. The events was completely removed.


Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** Types.hs	13 Jul 2003 17:18:22 -0000	1.25
--- Types.hs	15 Jul 2003 19:00:28 -0000	1.26
***************
*** 432,437 ****
  data MouseEvent
    =  MouseMove	      !Point !Modifiers	-- ^ Mouse was moved over the client area of the window
-   |  MouseEnter       !Point !Modifiers	-- ^ Mouse enters in the client area of the window
-   |  MouseLeave       !Point !Modifiers	-- ^ Mouse leaves the client area of the window
    |  MouseRightDown   !Point !Modifiers	-- ^ Mouse right button goes down
    |  MouseRightUp     !Point !Modifiers	-- ^ Mouse right button goes up
--- 432,435 ----
***************
*** 447,452 ****
    = case mouseEvent of
        MouseMove	p m       -> p
-       MouseEnter p m      -> p      
-       MouseLeave p m      -> p      
        MouseRightDown p m  -> p
        MouseRightUp p m    -> p    
--- 445,448 ----
***************
*** 461,466 ****
    = case mouseEvent of
        MouseMove	p m       -> m
-       MouseEnter p m      -> m      
-       MouseLeave p m      -> m      
        MouseRightDown p m  -> m
        MouseRightUp p m    -> m    
--- 457,460 ----
***************
*** 477,482 ****
        = case fromCInt cevent of
            1 -> MouseMove
-           2 -> MouseEnter
-           3 -> MouseLeave
            4 -> MouseLeftDown
            5 -> MouseRightDown
--- 471,474 ----

[htoolkit-cvs] port/src/include Window.h,1.7,1.8

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/include
In directory sc8-pr-cvs1:/tmp/cvs-serv16673/src/include

Modified Files:
	Window.h 
Log Message:
The implementation for MouseEnter and MouseLeave events is too hard for Windows
and probably imposible to make it portable. The events was completely removed.


Index: Window.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/Window.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Window.h	13 Jul 2003 10:21:28 -0000	1.7
--- Window.h	15 Jul 2003 19:00:30 -0000	1.8
***************
*** 9,14 ****
  
  #define evMouseMove   	    1
- #define evMouseEnter   	    2
- #define evMouseLeave   	    3
  #define evMouseLeftDown     4
  #define evMouseRightDown    5
--- 9,12 ----

[htoolkit-cvs] port/src/cbits/Win32 Window.c,1.35,1.36

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv16673/src/cbits/Win32

Modified Files:
	Window.c 
Log Message:
The implementation for MouseEnter and MouseLeave events is too hard for Windows
and probably imposible to make it portable. The events was completely removed.


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Window.c,v
retrieving revision 1.35
retrieving revision 1.36
diff -C2 -d -r1.35 -r1.36
*** Window.c	13 Jul 2003 11:24:46 -0000	1.35
--- Window.c	15 Jul 2003 19:00:30 -0000	1.36
***************
*** 10,14 ****
  	SIZE LineSize, PageSize;
  	BOOL bInDragMode;
- 	BOOL bInMouseMoveMode;
  	int nWindowKind;
  
--- 10,13 ----
***************
*** 115,135 ****
  }
  
- static HWND checkMousePosition(HWND hWnd, POINT pos)
- {
- 	HWND hCtrl;
- 	
- 	hCtrl = ChildWindowFromPointEx(hWnd, pos, CWP_SKIPINVISIBLE | CWP_SKIPDISABLED | CWP_SKIPTRANSPARENT);
- 	if (hCtrl == hWnd) hCtrl = NULL;
- 
- 	if (hCtrl == NULL)
- 	{
- 		ClientToScreen(hWnd, &pos);
- 		hCtrl = WindowFromPoint(pos);
- 		if (hCtrl == hWnd) hCtrl = NULL;
- 	}
- 
-     return hCtrl;
- }
- 
  LRESULT CALLBACK HWindowSharedFunction(WNDPROC pDefWindowProc, HWND hWnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
  {
--- 114,117 ----
***************
*** 152,156 ****
              pData->PageSize.cy = 10;
              pData->bInDragMode = FALSE;
-             pData->bInMouseMoveMode = FALSE;
              pData->foreColor = RGB(0,0,0);
              pData->backColor = RGB(255,255,255);
--- 134,137 ----
***************
*** 444,453 ****
                  handleWindowMouse(hWnd,evMouseLeftUp,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
              }
- 
-             if (pData->bInMouseMoveMode)
-             {
-                 handleWindowMouse(hWnd,evMouseLeave,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
-                 pData->bInMouseMoveMode = FALSE;
-             }
          }
          break;
--- 425,428 ----
***************
*** 461,486 ****
                  handleWindowMouse(hWnd,evMouseDrag,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
              else
!             {
!                 if (pData->bInMouseMoveMode)
!                 {
!                     RECT rect;
! 
!                     GetClientRect(hWnd, &rect);
!                     if (cx < rect.left || cx > rect.right || cy < rect.top || cy > rect.bottom)
!                     {
!                         handleWindowMouse(hWnd,evMouseLeave,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
!                         pData->bInMouseMoveMode = FALSE;
!                         ReleaseCapture();
!                     }
!                     else
!                         handleWindowMouse(hWnd,evMouseMove,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
!                 }
!                 else
!                 {
!                     pData->bInMouseMoveMode = TRUE;
!                     SetCapture(hWnd);
!                     handleWindowMouse(hWnd,evMouseEnter,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
!                 }
!             }
          }
          break;
--- 436,440 ----
                  handleWindowMouse(hWnd,evMouseDrag,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
              else
!                 handleWindowMouse(hWnd,evMouseMove,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
          }
          break;
***************
*** 489,511 ****
          {
              POINT pos;
-             HWND hCtrl;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
! 
!             hCtrl = checkMousePosition(hWnd, pos);
!             if (hCtrl)
!             {
!                 ClientToScreen(hWnd, &pos);
!                 ScreenToClient(hCtrl, &pos);
!                 SendMessage(hCtrl, uMsg, wParam, MAKELPARAM(pos.x, pos.y));
!                 return 0;
!             }
!             else
!             {
!                 pData->bInDragMode = TRUE;
!                 if (!pData->bInMouseMoveMode) SetCapture(hWnd);
!                 handleWindowMouse(hWnd,evMouseLeftDown,pos.x,pos.y,GetModifiers());
!             }
          }
          break;
--- 443,454 ----
          {
              POINT pos;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
!             
! 			pData->bInDragMode = TRUE;
! 			handleWindowMouse(hWnd,evMouseLeftDown,pos.x,pos.y,GetModifiers());
! 			
! 			SetCapture(hWnd);
          }
          break;
***************
*** 514,532 ****
          {
              POINT pos;
-             HWND hCtrl;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
  
!             hCtrl = checkMousePosition(hWnd, pos);
!             if (hCtrl)
!             {
!                 ClientToScreen(hWnd, &pos);
!                 ScreenToClient(hCtrl, &pos);
!                 SendMessage(hCtrl, uMsg, wParam, MAKELPARAM(pos.x, pos.y));
!                 return 0;
!             }
!             else
!                 handleWindowMouse(hWnd,evMouseDoubleClick,pos.x,pos.y,GetModifiers());
          }
          break;
--- 457,465 ----
          {
              POINT pos;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
  
!             handleWindowMouse(hWnd,evMouseDoubleClick,pos.x,pos.y,GetModifiers());
          }
          break;
***************
*** 535,539 ****
          {
              POINT pos;
-             HWND hCtrl;
              int cx, cy;
  
--- 468,471 ----
***************
*** 547,573 ****
              handleWindowMouse(hWnd,evMouseLeftUp,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
  
!             if (pData->bInMouseMoveMode)
!             {
!                 RECT rect;
! 
!                 GetClientRect(hWnd, &rect);
!                 if (cx < rect.left || cx > rect.right || cy < rect.top || cy > rect.bottom)
!                 {
!                     handleWindowMouse(hWnd,evMouseLeave,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
!                     pData->bInMouseMoveMode = FALSE;
!                     ReleaseCapture();
!                 }
!             }
!             else
!                 ReleaseCapture();
! 
!             hCtrl = checkMousePosition(hWnd, pos);
!             if (hCtrl)
!             {
!                 ClientToScreen(hWnd, &pos);
!                 ScreenToClient(hCtrl, &pos);
!                 SendMessage(hCtrl, uMsg, wParam, MAKELPARAM(pos.x, pos.y));
!                 return 0;
!             }
          }
          break;
--- 479,483 ----
              handleWindowMouse(hWnd,evMouseLeftUp,pData->Origin.x+cx,pData->Origin.y+cy,GetModifiers());
  
!             ReleaseCapture();
          }
          break;
***************
*** 576,596 ****
          {
              POINT pos;
-             HWND hCtrl;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
  
!             hCtrl = checkMousePosition(hWnd, pos);
!             if (hCtrl)
!             {
!                 pos.x = GET_X_LPARAM(lParam);
!                 pos.y = GET_Y_LPARAM(lParam);
!                 ClientToScreen(hWnd, &pos);
!                 ScreenToClient(hCtrl, &pos);
!                 SendMessage(hCtrl, uMsg, wParam, MAKELPARAM(pos.x, pos.y));
!                 return 0;
!             }
!             else
!                 handleWindowMouse(hWnd,evMouseRightDown,pos.x,pos.y,GetModifiers());
          }
          break;
--- 486,494 ----
          {
              POINT pos;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
  
!             handleWindowMouse(hWnd,evMouseRightDown,pos.x,pos.y,GetModifiers());
          }
          break;
***************
*** 599,617 ****
          {
              POINT pos;
-             HWND hCtrl;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
  
!             hCtrl = checkMousePosition(hWnd, pos);
!             if (hCtrl)
!             {
!                 ClientToScreen(hWnd, &pos);
!                 ScreenToClient(hCtrl, &pos);
!                 SendMessage(hCtrl, uMsg, wParam, MAKELPARAM(pos.x, pos.y));
!                 return 0;
!             }
!             else
!                 handleWindowMouse(hWnd,evMouseRightUp,pos.x,pos.y,GetModifiers());
          }
          break;
--- 497,505 ----
          {
              POINT pos;
  
              pos.x = pData->Origin.x+GET_X_LPARAM(lParam);
              pos.y = pData->Origin.y+GET_Y_LPARAM(lParam);
  
! 			handleWindowMouse(hWnd,evMouseRightUp,pos.x,pos.y,GetModifiers());
          }
          break;

[htoolkit-cvs] port/src/cbits/GTK Window.c,1.21,1.22

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv10870/src/cbits/GTK

Modified Files:
	Window.c 
Log Message:
Better implementation for osGetWindowViewSize and osSetWindowViewSize


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Window.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** Window.c	13 Jul 2003 10:21:27 -0000	1.21
--- Window.c	15 Jul 2003 18:24:33 -0000	1.22
***************
*** 4,7 ****
--- 4,10 ----
  #include <gdk/gdkkeysyms.h>
  
+ #define EDGE_SIZE 3
+ #define TITLE_SIZE 13
+ 
  char *gWindowName = NULL;
  
***************
*** 567,570 ****
--- 570,577 ----
  };
  
+ // The implementation for osGetWindowViewSize and osSetWindowViewSize functions
+ // is inspired from implementation for DoGetClientSize and DoSetClientSize functions from
+ // wxWindows. The trouble here is the asume that the window frame borders are
+ // with constant sizes (see EDGE_SIZE and TITLE_SIZE constants). This is not true at all.
  void osGetWindowViewSize(WindowHandle window, int *res)
  {
***************
*** 573,578 ****
--- 580,601 ----
  	if (toplevel != gFrameWidget || gDocumentInterface == 1)
  	{
+ 		GtkRequisition req;
+ 
  		res[0] = toplevel->allocation.width-4;
  		res[1] = toplevel->allocation.height-4;
+ 
+ 		if (GNOME_IS_APP(toplevel))
+ 		{
+ 			GtkWidget *menubar = GNOME_APP(toplevel)->menubar;
+ 
+ 			if (menubar != NULL)
+ 			{
+ 				req.width = 2;
+ 				req.height = 2;
+ 				(* GTK_WIDGET_CLASS( GTK_OBJECT_GET_CLASS(menubar) )->size_request )
+ 				                                                                                             (menubar, &req);
+ 				res[1] -= req.height;
+ 			}
+ 		}
  	}
  	else
***************
*** 587,591 ****
  	GtkWidget *toplevel = gtk_widget_get_toplevel(window);
  	if (toplevel != gFrameWidget || gDocumentInterface == 1)
! 		gtk_window_resize(GTK_WINDOW(toplevel), w+4, h+4);
  }
  
--- 610,655 ----
  	GtkWidget *toplevel = gtk_widget_get_toplevel(window);
  	if (toplevel != gFrameWidget || gDocumentInterface == 1)
! 	{
! 		GtkRequisition req;
! 		GtkScrolledWindow *scroll_window = GTK_SCROLLED_WINDOW(window);
! 		GtkScrolledWindowClass *scroll_class = GTK_SCROLLED_WINDOW_CLASS(GTK_OBJECT_GET_CLASS(window));
! 
! 		if (scroll_window->vscrollbar_visible)
! 		{
! 			req.width = 2;
! 			req.height = 2;
! 			(* GTK_WIDGET_CLASS( GTK_OBJECT_GET_CLASS(scroll_window->vscrollbar) )->size_request )
! 			                                                                                                     (scroll_window->vscrollbar, &req );
! 			w += req.width + scroll_class->scrollbar_spacing;
! 		}
! 
! 		if (scroll_window->hscrollbar_visible)
! 		{
! 			req.width = 2;
! 			req.height = 2;
! 			(* GTK_WIDGET_CLASS( GTK_OBJECT_GET_CLASS(scroll_window->hscrollbar) )->size_request )
! 			                                                                                                     (scroll_window->hscrollbar, &req );
! 			h += req.height + scroll_class->scrollbar_spacing;
! 		}
! 
! 		if (GNOME_IS_APP(toplevel))
! 		{
! 			GtkWidget *menubar = GNOME_APP(toplevel)->menubar;
! 
! 			if (menubar != NULL)
! 			{
! 				req.width = 2;
! 				req.height = 2;
! 				(* GTK_WIDGET_CLASS( GTK_OBJECT_GET_CLASS(menubar) )->size_request )
! 				                                                                                             (menubar, &req);
! 				h += req.height;
! 			}
! 		}
! 
! 		w += EDGE_SIZE*2;
! 		h += EDGE_SIZE*2 + TITLE_SIZE;
! 
! 		gtk_window_resize(GTK_WINDOW(toplevel), w, h);
! 	}
  }
  

[htoolkit-cvs] gio/src/examples/simple Hanoi.hs,1.1,1.2

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv2993

Modified Files:
	Hanoi.hs 
Log Message:
bugfix


Index: Hanoi.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/examples/simple/Hanoi.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Hanoi.hs	13 Jul 2003 14:52:56 -0000	1.1
--- Hanoi.hs	13 Jul 2003 18:25:58 -0000	1.2
***************
*** 18,22 ****
  speed3 = 13
  speed4 = 6
! speed5 = 0
  
  minDisks = 2
--- 18,22 ----
  speed3 = 13
  speed4 = 6
! speed5 = 1
  
  minDisks = 2
***************
*** 103,107 ****
  						changeTowers towers@(Towers {moves=(3:2:moves),tower3=(f3:r3),tower2=t2}) =
  							(drawMove 3 2 f3 (length r3) (length t2),towers{moves=moves,tower3=r3,tower2=(f3:t2)})
! 		
  						drawMove :: Int -> Int -> Int -> Int -> Int -> Canvas -> IO ()
  						drawMove start end disk lenfr lento can = do
--- 103,107 ----
  						changeTowers towers@(Towers {moves=(3:2:moves),tower3=(f3:r3),tower2=t2}) =
  							(drawMove 3 2 f3 (length r3) (length t2),towers{moves=moves,tower3=r3,tower2=(f3:t2)})
! 
  						drawMove :: Int -> Int -> Int -> Int -> Int -> Canvas -> IO ()
  						drawMove start end disk lenfr lento can = do
***************
*** 110,124 ****
  							where
  								tx	= end  *xOffs
! 								ty	= 10+10*(maxDisks-lento) 
  								fx	= start*xOffs
! 								fy	= 10+10*(maxDisks-lenfr) 
  								w	= disk *5
  
  		-- The update function: redraw the towers
! 		onPaint ref can _ _ = do
  			twrs <- readIORef ref
  			drawTowerPos 1 (tower1 twrs) can
  			drawTowerPos 2 (tower2 twrs) can
  			drawTowerPos 3 (tower3 twrs) can
  
  		-- Set the speed of a (possibly running) Hanoi simulation.
--- 110,127 ----
  							where
  								tx	= end  *xOffs
! 								ty	= 10+10*(maxDisks-lento)
  								fx	= start*xOffs
! 								fy	= 10+10*(maxDisks-lenfr)
  								w	= disk *5
  
  		-- The update function: redraw the towers
! 		onPaint ref can (Rect l t r b) _ = do
  			twrs <- readIORef ref
  			drawTowerPos 1 (tower1 twrs) can
  			drawTowerPos 2 (tower2 twrs) can
  			drawTowerPos 3 (tower3 twrs) can
+ 			drawLine (Point l y) (Point r y) can
+ 			where
+ 				y = 20+10*maxDisks
  
  		-- Set the speed of a (possibly running) Hanoi simulation.
***************
*** 158,162 ****
  				y	= 20+10*i
  		drawTower _ _ [] can = return ()
! 			
  		drawName :: Int -> Canvas -> IO ()
  		drawName nr can
--- 161,165 ----
  				y	= 20+10*i
  		drawTower _ _ [] can = return ()
! 
  		drawName :: Int -> Canvas -> IO ()
  		drawName nr can

[htoolkit-cvs] gio/src/examples/simple Fonts.hs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv28301

Added Files:
	Fonts.hs 
Log Message:
Added Fonts example: ported from HToolkit


--- NEW FILE: Fonts.hs ---
module Main where

import Data.FiniteMap
import Graphics.UI.GIO
			
main = start "Fonts" "1.0" SDI [] $ do
	w <- window []
	set w [on paint =: onPaint w, on resize =: \_ -> repaint w]
	names <- getFontNames
	styles <- popup [] w
	sizes  <- popup [] w
	fonts  <- popup [items =: map (\name -> (name, onSetFontName w styles sizes name)) names] w
	set w [layout =: hfill fonts <<< hfill styles <<< hfill sizes, size =: Size 400 200]
	where
		onSetFontName w styles popSizes name = do
			variants <- getFontVariants name 1 40
			set styles [items =: foldFM (\w_s sizes items -> styleToItem w_s sizes : items) [] variants]
			where
				styleToItem (weight,style) sizes =
					(variantToString weight style, onSetFontStyle popSizes w name weight style sizes)
			
		onSetFontStyle popSizes w name weight style sizes = 
			set popSizes [items =: map sizeToItem sizes]
			where
				sizeToItem size =
					(show size, onSetFontSize w (FontDef { fontName=name
					                                     , fontSize=size
					                                     , fontWeight=weight
					                                     , fontStyle=style
					                                     , fontUnderline=False
					                                     , fontStrikeOut=False
					                                     }))

		onSetFontSize :: Window -> FontDef -> IO ()
		onSetFontSize w fontdef = do
			myfont <- createFont fontdef
			set w [font =: myfont]
			repaint w
			
		onPaint w can _ _ = do
			size <- get w view
			metrics <- get can canvasFontMetrics
			width   <- get can (canvasFontStringWidth text)
			let Rect l t r b = centralRect (rectOfSize size) (Size width (fontLineHeight metrics))
			drawString (Point l (t+fontAscent metrics)) text can
			where
				text = "Hello, world!"
		
variantToString weight style = weightToString weight ++ " " ++ styleToString style
	where
		weightToString 100 = "thin"
		weightToString 200 = "ultra light"
		weightToString 300 = "light"
		weightToString 400 = "regular"
		weightToString 500 = "medium"
		weightToString 600 = "demi bold"
		weightToString 700 = "bold"
		weightToString 800 = "ultra bold"
		weightToString 900 = "black"

		styleToString Roman   = ""
		styleToString Italic  = "italic"
		styleToString Oblique = "oblique"

[htoolkit-cvs] port/src/Port Types.hs,1.24,1.25

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv24529/src/Port

Modified Files:
	Types.hs 
Log Message:
bugfix


Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** Types.hs	13 Jul 2003 09:09:10 -0000	1.24
--- Types.hs	13 Jul 2003 17:18:22 -0000	1.25
***************
*** 903,908 ****
  -- | Standard line height of a font is the sum of its leading, ascent and descent.
  fontLineHeight :: FontMetrics -> Int
! fontLineHeight fontMetrics	
!   = fontLeading fontMetrics + fontAscent fontMetrics + fontDescent fontMetrics
  
  {-----------------------------------------------------------------------------------------
--- 903,907 ----
  -- | Standard line height of a font is the sum of its leading, ascent and descent.
  fontLineHeight :: FontMetrics -> Int
! fontLineHeight fontMetrics = fontAscent fontMetrics + fontDescent fontMetrics
  
  {-----------------------------------------------------------------------------------------

[htoolkit-cvs] port/src/cbits/Win32 Canvas.c,1.7,1.8

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv16152/src/cbits/Win32

Modified Files:
	Canvas.c 
Log Message:
bugfix


Index: Canvas.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Canvas.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Canvas.c	12 Jul 2003 12:00:47 -0000	1.7
--- Canvas.c	13 Jul 2003 16:12:43 -0000	1.8
***************
*** 343,346 ****
--- 343,349 ----
  
  	SetBkMode(canvas->hDC, bkMode ? OPAQUE : TRANSPARENT);
+ 	
+ 	SelectObject (canvas->hDC, font);
+ 	canvas->theFont = font;
  };
  
***************
*** 560,569 ****
  	   Font stuff
    -----------------------------*/
- 
- void osSetFont (FontHandle font, CanvasHandle canvas)
- {
- 	SelectObject (canvas->hDC, font);
- 	canvas->theFont = font;
- }	/* osSetFont */
  
  void osGetResolution(CanvasHandle canvas, int *xResP, int *yResP)
--- 563,566 ----

[htoolkit-cvs] port/src/cbits/GTK Canvas.c,1.11,1.12

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv16152/src/cbits/GTK

Modified Files:
	Canvas.c 
Log Message:
bugfix


Index: Canvas.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Canvas.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Canvas.c	12 Jul 2003 12:00:47 -0000	1.11
--- Canvas.c	13 Jul 2003 16:12:43 -0000	1.12
***************
*** 445,448 ****
--- 445,450 ----
  		gdk_colormap_free_colors(colormap, &whiteColor, 1);
  		gdk_colormap_free_colors(colormap, &blackColor, 1);
+ 		
+ 		canvas->theFont = font;
  	}
  }
***************
*** 665,673 ****
      }
  }	/* osDrawBitmap */
- 
- void osSetFont (FontHandle font, CanvasHandle canvas)
- {
- 	canvas->theFont = font;
- }	/* osSetFont */
  
  void osGetResolution(CanvasHandle canvas, int *xResP, int *yResP)
--- 667,670 ----

[htoolkit-cvs] gio/src/examples/simple Hanoi.hs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv5221

Added Files:
	Hanoi.hs 
Log Message:
Add Hanoi example: ported from ObjectIO


--- NEW FILE: Hanoi.hs ---
module Main where

import Data.IORef
import Graphics.UI.GIO

type Tower = [Int]
type Moves = [Int]
data Towers
   = Towers
	{ moves	 :: !Moves
	, tower1 :: !Tower
	, tower2 :: !Tower
	, tower3 :: !Tower
	}

speed1 = 40
speed2 = 26
speed3 = 13
speed4 = 6
speed5 = 0

minDisks = 2
maxDisks = 20
xOffs	 = maxDisks * 10 + 1

--	Starting the program

main :: IO ()
main = start "Hanoi" "1.0" SDI [] $ mdo
	w <- window [domain =: Size 430 180, on paint =: onPaint ref]
	
	ref <- newIORef (initTowers 0)
	
	mhanoi <- menu [title =: "&Hanoi"] mainMenu
	mrun <- menu [title =: "&Run (nr disks)"] mhanoi
	rg1 <- menuRadioGroup [] mrun
	sequence [menuRadioItem [title =: show i, on command =: onRun i mrun mcont mhalt t w ref] rg1 
	                        | i <- [minDisks..maxDisks]]
	mhalt <- menuitem [title =: "Halt",     accel =: KeyChar '.', enabled =: False, on command =: onHalt mrun mcont mhalt t] mhanoi
	mcont <- menuitem [title =: "Continue", accel =: KeyChar ',', enabled =: False, on command =: onCont mrun mcont mhalt t] mhanoi
	mspeed <- menu [title =: "&Speed"] mhanoi
	rg2 <- menuRadioGroup [] mspeed
	menuRadioItem [title =: "V&ery Slow", accel =: KeyChar '\^A', on command =: onSetSpeed speed1 t] rg2
	menuRadioItem [title =: "&Slow",      accel =: KeyChar '\^S', on command =: onSetSpeed speed2 t] rg2
	menuRadioItem [title =: "&Normal",    accel =: KeyChar '\^D', on command =: onSetSpeed speed3 t] rg2
	menuRadioItem [title =: "&Fast",      accel =: KeyChar '\^F', on command =: onSetSpeed speed4 t] rg2
	menuRadioItem [title =: "&Very Fast", accel =: KeyChar '\^G', on command =: onSetSpeed speed5 t] rg2
	menuline mhanoi
	menuitem [title =: "E&xit", on command =: halt] mhanoi
	
	t <- timer [interval =: speed3, enabled =: False, on command =: onTimer mrun mhalt t w ref]
	return ()
	where
		-- The function for the Run command.
		onRun n mrun mcont mhalt timer w ref = do
			set mrun  [enabled =: False]
			set mcont [enabled =: False]
			set mhalt [enabled =: True]
			set timer [enabled =: True]
			writeIORef ref (initTowers n)
			repaint w

		-- The function for the Halt command.
		onHalt mrun mcont mhalt timer = do
			set mrun  [enabled =: True]
			set mcont [enabled =: True]
			set mhalt [enabled =: False]
			set timer [enabled =: False]

		-- The function for the Continue command.
		onCont mrun mcont mhalt timer = do
			set mrun  [enabled =: False]
			set mcont [enabled =: False]
			set mhalt [enabled =: True]
			set timer [enabled =: True]
		
		-- The timer function: take a move from the list of all moves and show it in the window.
		onTimer mrun mhalt timer w ref = do
			towers <- readIORef ref
			stepHanoi towers
			where
				stepHanoi towers@(Towers {moves=[]}) = do
					set mrun  [enabled =: True]
					set mhalt [enabled =: False]
					set timer [enabled =: False]
				stepHanoi towers = do
					drawInWindow UnBuffered w drawf
					writeIORef ref towers1
					where
						(drawf,towers1)	= changeTowers towers
		
						changeTowers :: Towers -> (Canvas -> IO (),Towers)
						changeTowers towers@(Towers {moves=(1:2:moves),tower1=(f1:r1),tower2=t2}) =
							(drawMove 1 2 f1 (length r1) (length t2),towers{moves=moves,tower1=r1,tower2=(f1:t2)})
						changeTowers towers@(Towers {moves=(1:3:moves),tower1=(f1:r1),tower3=t3}) =
							(drawMove 1 3 f1 (length r1) (length t3),towers{moves=moves,tower1=r1,tower3=(f1:t3)})
						changeTowers towers@(Towers {moves=(2:1:moves),tower2=(f2:r2),tower1=t1}) =
							(drawMove 2 1 f2 (length r2) (length t1),towers{moves=moves,tower2=r2,tower1=(f2:t1)})
						changeTowers towers@(Towers {moves=(2:3:moves),tower2=(f2:r2),tower3=t3}) =
							(drawMove 2 3 f2 (length r2) (length t3),towers{moves=moves,tower2=r2,tower3=(f2:t3)})
						changeTowers towers@(Towers {moves=(3:1:moves),tower3=(f3:r3),tower1=t1}) =
							(drawMove 3 1 f3 (length r3) (length t1),towers{moves=moves,tower3=r3,tower1=(f3:t1)})
						changeTowers towers@(Towers {moves=(3:2:moves),tower3=(f3:r3),tower2=t2}) =
							(drawMove 3 2 f3 (length r3) (length t2),towers{moves=moves,tower3=r3,tower2=(f3:t2)})
		
						drawMove :: Int -> Int -> Int -> Int -> Int -> Canvas -> IO ()
						drawMove start end disk lenfr lento can = do
							eraseDisk (Rect (fx-w) fy (fx+w) (fy+10)) can
							drawDisk  (Rect (tx-w) ty (tx+w) (ty+10)) can
							where
								tx	= end  *xOffs
								ty	= 10+10*(maxDisks-lento) 
								fx	= start*xOffs
								fy	= 10+10*(maxDisks-lenfr) 
								w	= disk *5

		-- The update function: redraw the towers
		onPaint ref can _ _ = do
			twrs <- readIORef ref
			drawTowerPos 1 (tower1 twrs) can
			drawTowerPos 2 (tower2 twrs) can
			drawTowerPos 3 (tower3 twrs) can

		-- Set the speed of a (possibly running) Hanoi simulation.
		onSetSpeed :: Int -> Timer -> IO ()
		onSetSpeed speed timer = set timer [interval =: speed]


-- The initial Towers value, given the number of disks
initTowers :: Int -> Towers
initTowers nr_disks =
	Towers
	  { moves	= hanoi nr_disks 1 2 3
	  , tower1	= [1..nr_disks]
	  , tower2	= []
	  , tower3	= []
	  }
	where
		hanoi :: Int -> Int -> Int -> Int -> Moves	-- The function that calculates the list of disk moves
		hanoi n start end via
			| n==0		= []
			| otherwise	= hanoi m start via end ++ (start:end:hanoi m via end start)
			where
				m	= n-1

drawTowerPos :: Int -> Tower -> Canvas -> IO ()
drawTowerPos pos tower can = do
	drawTower pos (maxDisks-length tower) tower can
	drawName  pos                               can
	where
		drawTower :: Int -> Int -> Tower -> Canvas -> IO ()
		drawTower nr i (f:r) can = do
			drawDisk (Rect (x-w) y (x+w) (y+10)) can
			drawTower nr (i+1) r can
			where
				x	= nr*xOffs
				w	= f *5
				y	= 20+10*i
		drawTower _ _ [] can = return ()
			
		drawName :: Int -> Canvas -> IO ()
		drawName nr can
			| nr==1	= drawString (Point (xOffs-14)  y) "from" can
			| nr==2	= drawString (Point (2*xOffs-6) y) "to"   can
			| nr==3	= drawString (Point (3*xOffs-9) y) "via"  can
			where
				y = 35+10*maxDisks

drawDisk :: Rect -> Canvas -> IO ()
drawDisk rect can = do
	setCanvasPen can [color =: skyblue]
	fillRect rect can
	setCanvasPen can [color =: black]
	drawRect rect can
	
eraseDisk :: Rect -> Canvas -> IO ()
eraseDisk (Rect l t r b) can = do
	setCanvasPen can [color =: white]
	fillRect (Rect l t r (b-1)) can

[htoolkit-cvs] gio/src/examples/simple Counter.hs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/examples/simple
In directory sc8-pr-cvs1:/tmp/cvs-serv13234

Added Files:
	Counter.hs 
Log Message:
Add Counter example (ported from ObjectIO)


--- NEW FILE: Counter.hs ---
module Main (main) where

import Graphics.UI.GIO

main = start "Counter" "1.0" SDI [] $ do
	w <- window []
	ent <- entry [readOnly =: True, tooltip =: "Counter Value", title =: "0"] w
	bplus  <- button [title =: "-", tooltip =: "Decrement Value", on command =: upd (\x->x-1) ent] w
	bminus <- button [title =: "+", tooltip =: "Increment Value", on command =: upd (\x->x+1) ent] w
	set w [layout =: hfill ent ^^^ hcenter (pad 5 (fill bplus <<< fill bminus))]
	where
		upd f ent = set ent [title ~: show . f . read]

[htoolkit-cvs] port/src/cbits/Win32 Window.c,1.34,1.35

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv10707/src/cbits/Win32

Modified Files:
	Window.c 
Log Message:
bugfix


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Window.c,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** Window.c	13 Jul 2003 10:21:27 -0000	1.34
--- Window.c	13 Jul 2003 11:24:46 -0000	1.35
***************
*** 1009,1012 ****
--- 1009,1013 ----
      SetScrollPos(window,SB_VERT,y,TRUE);
      moveControls(window, pData->Origin.x-x, pData->Origin.y-y);
+     InvalidateRect(window,NULL,TRUE);
      pData->Origin.x = x;
      pData->Origin.y = y;

[htoolkit-cvs] gio/src/examples/life Life.hs,NONE,1.1 Main.hs,NONE,1.1

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/examples/life
In directory sc8-pr-cvs1:/tmp/cvs-serv5220

Added Files:
	Life.hs Main.hs 
Log Message:
Add Life example


--- NEW FILE: Life.hs ---
module Life where

import Graphics.UI.GIO
import Control.Monad(when)

type Generation	= [[LifeCell]]
type CellSize	= Int
type ClickPoint	= Point

data LifeCell
   = LifeCell
	{ cx	:: !Int
	, cy	:: !Int
	, age	:: !Int
	} deriving Show

colours :: [Color]
colours = [red,magenta,green,yellow,cyan,blue]

ageToColour :: Int -> Color
ageToColour age
	| age<=0	= colours !! 0
	| age>=5	= colours !! 5
	| otherwise	= colours !! age

makeGeneration :: Generation
makeGeneration = []

makeLifeCell :: ClickPoint -> CellSize -> LifeCell
makeLifeCell (Point x y) size = LifeCell{cx=x `div` size, cy=y `div` size, age=0}

newLifeCell :: Int -> Int -> LifeCell
newLifeCell x y = LifeCell{cx=x,cy=y,age=0}


--	Rendering of LifeCells.

drawCells :: (LifeCell -> Canvas -> IO ()) -> Generation -> Canvas -> IO ()
drawCells f gen can = mapM_ (mapM_ (flip f can)) gen

drawCell :: CellSize -> LifeCell -> Canvas -> IO ()
drawCell size (LifeCell {cx=cx,cy=cy,age=age}) can = do
	setCanvasPen can [color =: ageToColour age]
	fillRect (Rect px py (px+size) (py+size)) can
	where
		px	= cx*size
		py	= cy*size

eraseCell :: CellSize -> LifeCell -> Canvas -> IO ()
eraseCell size (LifeCell {cx=cx,cy=cy}) can = do
	setCanvasPen can [color =: black]
	fillRect (Rect px py (px+size) (py+size)) can
	where
		px	= cx*size
		py	= cy*size


{-	Insert a LifeCell to a Generation.
	In a Generation LifeCells are ordered by increasing x-coordinate first, and by increasing y-coordinate second.
-}
insertCell :: LifeCell -> Generation -> Generation
insertCell c1@(LifeCell{cx=x1}) gen@(cs@(LifeCell{cx=x2,cy=y2}:x2ys) : cs_xs)
	| x2<x1			= cs : insertCell c1 cs_xs
	| x2==x1		= insertCelly c1 cs : cs_xs
	| otherwise		= [c1]:gen
	where
		insertCelly :: LifeCell -> [LifeCell] -> [LifeCell]
		insertCelly c1@(LifeCell {cy=y1}) g@(c2@(LifeCell {cx=x2,cy=y2}):x2ys)
			| y2<y1		= c2	: insertCelly c1 x2ys
			| y2==y1	= c1	: x2ys
			| otherwise	= c1	: g
		insertCelly c1 _ = [c1]
insertCell c1 [] = [[c1]]

{-	Remove a LifeCell from a Generation.
-}
removeCell :: LifeCell -> Generation -> Generation
removeCell c1@(LifeCell {cx=x1,cy=y1}) gen@(cs@((LifeCell {cx=x2,cy=y2}):x2ys):cs_xs)
	| x2<x1		= cs:removeCell c1 cs_xs
	| x2>x1		= gen
	| otherwise	=
		let cs1 = removeCelly c1 cs
		in if null cs1 then cs_xs
		   else cs1 : cs_xs
	where
		removeCelly :: LifeCell -> [LifeCell] -> [LifeCell]
		removeCelly c1@(LifeCell {cy=y1}) cs@(c2@(LifeCell {cx=x2,cy=y2}):x2ys)
			| y2<y1		= c2 : removeCelly c1 x2ys
			| y2==y1	= x2ys
			| otherwise	= cs
		removeCelly _ _ = []
removeCell c ([]:cs_xs) = removeCell c cs_xs
removeCell c _ = []

{-	Calculate the new Generation (first tuple result) and the Generation of LifeCells that die (second tuple result).
-}
lifeGame :: Generation -> (Generation,Generation)
lifeGame gen =
	let 
		(next,_,die) = nextGen gen gen
		next1 = celebrateSurvival next gen
	in 
		(next1,die)
	where
		nextGen :: Generation -> Generation -> (Generation,Generation,Generation)
		nextGen ((c@(LifeCell{cx=cx,cy=cy}):cs_x):cs_xs) gen
			| neighbours34 (neighbours c gen) = (insertCell c gennext1,new,diednext)
			| otherwise			  = (gennext1,new,insertCell c diednext)
			where
				(gennext,newbornsnext,diednext)	= nextGen (cs_x:cs_xs) gen1
				(gennext1,new)			= newBorns c newbornsnext gennext gen
				gen1				= shiftGeneration (cs_x:cs_xs) gen

				neighbours34 [_,_,_]	=  True
				neighbours34 [_,_,_,_] 	=  True
				neighbours34 _		=  False

				newBorns :: LifeCell -> Generation -> Generation -> Generation -> (Generation,Generation)
				newBorns c newbornsnext gennext gen =
					newBorns1 (newBornNeighbours c gen) newbornsnext gennext gen
					where
						newBorns1 (c@(LifeCell {cx=x1,cy=y1}):cs) newbornsnext gennext gen
							| neighbours3 (neighbours c gen) = (insertCell c gennext1,insertCell c newbornsnext1)
							| otherwise			 = next_genANDnewborns
							where
								(gennext1,newbornsnext1)	= next_genANDnewborns
								next_genANDnewborns		= newBorns1 cs newbornsnext gennext gen

								neighbours3 :: [LifeCell] -> Bool
								neighbours3 [_,_,_]	= True
								neighbours3 _ 		= False
						newBorns1 [] newbornsnext gennext _ = (gennext,newbornsnext)

						--	newBornNeighbours c gen -> dead neighbours of c in gen in decreasing order.

						newBornNeighbours :: LifeCell -> Generation -> [LifeCell]
						newBornNeighbours (LifeCell {cx=cx,cy=cy}) gen =
							newBornNeighbours1 (cx-1) (cx+1) (cy-1) gen []
							where
								newBornNeighbours1:: Int -> Int -> Int -> Generation -> [LifeCell] -> [LifeCell]
								newBornNeighbours1 x xn y (cs@((LifeCell {cx=x2}):_):cs_xs) newborns
									| x>xn		= newborns
									| x2<x		= newBornNeighbours1 x xn y cs_xs newborns
									| x2==x		= newBornNeighbours2 x y (y+2) cs (newBornNeighbours1 (x+1) xn y cs_xs newborns)
									| otherwise	= (newLifeCell x y:newLifeCell x (y+1):newLifeCell x (y+2):newBornNeighbours1 (x+1) xn y cs_xs newborns)
								newBornNeighbours1 x xn y [] newborns
									| x>xn		= newborns
									| otherwise	= (newLifeCell x y:newLifeCell x (y+1):newLifeCell x (y+2):newBornNeighbours1 (x+1) xn y [] newborns)

								newBornNeighbours2:: Int -> Int -> Int -> [LifeCell] -> [LifeCell] -> [LifeCell]
								newBornNeighbours2 x y yn (c@(LifeCell {cx=x2,cy=y2}):cs) cs_xs
									| y>yn		= cs_xs
									| y2<y		= newBornNeighbours2 x y yn cs cs_xs
									| y2==y		= newBornNeighbours2 x (y+1) yn cs cs_xs
									| otherwise	= (newLifeCell x y:newBornNeighbours2 x (y+1) yn cs cs_xs)
								newBornNeighbours2 x y yn [] cs_xs
									| y>yn		= cs_xs
									| otherwise	= newLifeCell x y:newBornNeighbours2 x (y+1) yn [] cs_xs

				shiftGeneration :: Generation -> Generation -> Generation
				shiftGeneration (   (c@(LifeCell {cx=cx,cy=cy}):_):_) gen = shiftGeneration1 c{cx=cx-2,cy=cy-2} gen
				shiftGeneration ([]:(c@(LifeCell {cx=cx,cy=cy}):_):_) gen = shiftGeneration1 c{cx=cx-2,cy=cy-2} gen
				shiftGeneration partial_gen           gen = gen

				shiftGeneration1:: LifeCell -> Generation -> Generation
				shiftGeneration1 c@(LifeCell {cx=x1,cy=y1}) gen@((c2@(LifeCell {cx=x2,cy=y2}):cs_x):cs_xs)
					| x2<x1			= shiftGeneration1 c cs_xs
					| x2==x1 && y2<y1	= shiftGeneration1 c (cs_x:cs_xs)
					| otherwise		= gen
				shiftGeneration1 c ([]:cs_xs) = shiftGeneration1 c cs_xs
				shiftGeneration1 c _ = []

				--	neighbours c gen -> neighbours of c in gen in decreasing order.

				neighbours :: LifeCell -> Generation -> [LifeCell]
				neighbours (LifeCell {cx=x,cy=y}) gen =
					neighbours1 (x-1) (x+1) (y-1) gen []
					where
						neighbours1:: Int -> Int -> Int -> Generation -> [LifeCell] -> [LifeCell]
						neighbours1 x xn y (cs@((LifeCell {cx=x2,cy=y2}):_):cs_xs) neighbours
							| x2<x		= neighbours1 x xn y cs_xs neighbours
							| x2<=xn	= neighbours2 y (y+2) cs (neighbours1 (x+1) xn y cs_xs neighbours)
							| otherwise	= neighbours
						neighbours1 _ _ _ [] neighbours = neighbours

						neighbours2:: Int -> Int -> [LifeCell] -> [LifeCell] -> [LifeCell]
						neighbours2 y yn (c@(LifeCell {cx=x2,cy=y2}):cs) cs_xs
							| y2<y		= neighbours2 y yn cs cs_xs
							| y2<=yn	= (c:neighbours2 (y+1) yn cs cs_xs)
							| otherwise	= cs_xs
						neighbours2 _ _ [] cs_xs = cs_xs

		nextGen ([]:cs_xs) gen = nextGen cs_xs gen
		nextGen _ _ = ([],[],[])
	
		celebrateSurvival :: Generation -> Generation -> Generation
		celebrateSurvival new old = map (map (celebrate old)) new
			where
				celebrate :: Generation -> LifeCell -> LifeCell
				celebrate old newcell
					| found		= newcell{age=age+1}
					| otherwise	= newcell{age=age}
					where
						(found,age)	= getCellAge newcell old

				getCellAge :: LifeCell -> Generation -> (Bool,Int)
				getCellAge c1@(LifeCell {cx=x1}) (xs@((LifeCell {cx=x2}):_):xss)
					| x1<x2		= (False,0)
					| x1>x2		= getCellAge  c1 xss
					| otherwise	= getCellAge' c1 xs
				getCellAge _ _ = (False,0)

				getCellAge' :: LifeCell -> [LifeCell] -> (Bool,Int)
				getCellAge' c1@(LifeCell {cy=y1}) (LifeCell{cy=y2,age=age}:xs)
					| y1<y2		= (False,0)
					| y1>y2		= getCellAge' c1 xs
					| otherwise	= (True,age)
				getCellAge' _ _ = (False,0)

--- NEW FILE: Main.hs ---
module Main where

import Graphics.UI.GIO
import Life
import Data.Char(ord,chr)
import Data.IORef

data Life = Life
   	{ gen       :: Generation
	, cellSize :: CellSize
	} deriving Show

initialLife = Life
	{ gen       = makeGeneration
	, cellSize = startCellSize
	}

main :: IO ()
main = start "Life" "1.0" SDI [] $ do
		ref <- newIORef initialLife

		let mydomain@(Size dw dh) = getViewDomain startCellSize
		    myorigin = Point (dw `div` 2) (dh `div` 2)
		w <- window [domain =: mydomain, origin =: myorigin, bgcolor =: black]
		set w [on mouse =: onMouse w ref, on paint =: onPaint ref]
		set w [origin =: myorigin]

		mfile <- menu  [title =: "File"] mainMenu
		menuitem [title =: "About LifeGameExample...", on command =: onAbout] mfile
		menuline mfile
		menuitem [title =: "Exit", on command =: halt] mfile

		mopts  <- menu [title =: "Options"] mainMenu
		msizes <- menu [title =: "Cell Size"] mopts
		rg <- menuRadioGroup [] msizes
		sequence [menuRadioItem [ title =: mkTitle size
		                                        , on command =: onNewSize size w ref] rg
				| size <- [1..8]]
		set rg [selected =: 7]

		mcmd <- menu [title =: "Commands"] mainMenu
		merase <- menuitem [title =: "Erase Cells", accel =: KeyChar '\^E'] mcmd
		mplay  <- menuitem [title =: "Play",           accel =: KeyChar '\^P'] mcmd
		mhalt  <- menuitem [title =: "Halt",            accel =: KeyChar '\^H', enabled =: False] mcmd
		mstep  <- menuitem [title =: "Step",           accel =: KeyChar '\^S'] mcmd

		t <- timer [enabled =: False, interval =: 40, on command =: onTimer w ref]

		set merase [on command =: onErase w ref]
		set mplay [on command =: onPlay mplay mstep  mhalt t]
		set mhalt [on command =: onHalt mplay mstep  mhalt t]
		set mstep [on command =: onTimer w ref]
		where
			mkTitle size	= show size ++ " * " ++ show size

			onTimer w ref = do
				life <- readIORef ref
				let size = cellSize life
				let (next,died) = lifeGame (gen life)
				let render can = drawCells (drawCell size) next can >> drawCells (eraseCell size) died can
				writeIORef ref (life{gen=next})
				drawInWindow UnBuffered w render

			onAbout = do
				logo <- readBitmap "../images/logo.bmp" []
				runAboutDialog "Life" "1.0"
				                       "(C) Krasimir Angelov, 2003"
				                       "The Life is an example program\nfreely distributed with HToolkit"
				                       [] [] [] logo Nothing

			onMouse w ref (MouseLeftDown pos mods)
				| mods == justControl = do
					life <- readIORef ref
					let cell = makeLifeCell pos (cellSize life)
					writeIORef ref (life{gen=removeCell cell (gen life)})
					drawInWindow UnBuffered w (eraseCell (cellSize life) cell)
				| mods == noModifiers = do
					life <- readIORef ref
					let cell = makeLifeCell pos (cellSize life)
					writeIORef ref (life{gen=insertCell cell (gen life)})
					drawInWindow UnBuffered w (drawCell (cellSize life) cell)
			onMouse w ref (MouseDrag pos mods) = do
					life <- readIORef ref
					let cell = makeLifeCell pos (cellSize life)
					writeIORef ref (life{gen=insertCell cell (gen life)})
					drawInWindow UnBuffered w (drawCell (cellSize life) cell)
			onMouse w ref _ = return ()

			onPaint ref can _ _ = do
				life <- readIORef ref
				drawCells (drawCell (cellSize life)) (gen life) can

			-- onErase sets the current generation to empty and clears the window.
			onErase :: Window -> IORef Life -> IO ()
			onErase w ref = do
				life <- readIORef ref
				writeIORef ref (life{gen=makeGeneration})
				repaint w

			-- play starts the computation of successive generations given the current set of life cells.
			onPlay :: MenuItem -> MenuItem -> MenuItem -> Timer -> IO ()
			onPlay mplay mstep  mhalt timer = do
				set mplay   [enabled =: False]
				set mstep   [enabled =: False]
				set mhalt    [enabled =: True ]
				set timer     [enabled =: True ]

			-- onHalt stops the computation of successive generations, but does not change the current generation.
			onHalt :: MenuItem -> MenuItem -> MenuItem -> Timer -> IO ()
			onHalt mplay mstep  mhalt timer = do
				set mplay   [enabled =: True]
				set mstep   [enabled =: True]
				set mhalt    [enabled =: False]
				set timer     [enabled =: False]

			-- onNewSize changes the size in which life cells are rendered and redraws the window.
			onNewSize :: Int -> Window -> IORef Life -> IO ()
			onNewSize newSize w ref = do
				life <- readIORef ref
				oldOrigin <- get w origin
				let oldSize = cellSize life
				    newOrigin = Point ((px oldOrigin) `div` oldSize*newSize) ((py oldOrigin) `div` oldSize*newSize)
				set w [domain =: getViewDomain newSize, origin =: newOrigin]
				writeIORef ref (life{cellSize=newSize})

	-- Given the size in which to render life cells, getViewDomain calculates the corresponding ViewDomain:
			getViewDomain :: CellSize -> Size
			getViewDomain size =
				let Size w h = universe
				in Size (w*size) (h*size)

--	Program constants.

universe	= Size 2000 2000
startCellSize	= 8

[htoolkit-cvs] gio/src/examples/life - New directory

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/examples/life
In directory sc8-pr-cvs1:/tmp/cvs-serv5051/life

Log Message:
Directory /cvsroot/htoolkit/gio/src/examples/life added to the repository

[htoolkit-cvs] gio/src/Graphics/UI/GIO Window.hs,1.20,1.21

[<kr_...@us...>]

Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO
In directory sc8-pr-cvs1:/tmp/cvs-serv4190/src/Graphics/UI/GIO

Modified Files:
	Window.hs 
Log Message:
Added "origin" attribute.


Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Window.hs,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** Window.hs	2 Jul 2003 20:04:45 -0000	1.20
--- Window.hs	13 Jul 2003 10:22:56 -0000	1.21
***************
*** 12,16 ****
  -----------------------------------------------------------------------------------------
  module Graphics.UI.GIO.Window 
!               ( Window, window, domain, resizeable, view, layout, autosize, layoutSize
                , dialog, runDialog
                , drawInWindow
--- 12,16 ----
  -----------------------------------------------------------------------------------------
  module Graphics.UI.GIO.Window 
!               ( Window, window, domain, origin, resizeable, view, layout, autosize, layoutSize
                , dialog, runDialog
                , drawInWindow
***************
*** 123,126 ****
--- 123,129 ----
    = newAttr (\w   -> getVar (vdomain w))
              (\w x -> setVar (vdomain w) x >> relayoutWindow w)
+ 
+ origin :: Attr Window Point
+ origin = newAttr (Lib.getWindowScrollOrigin . hwindow) (Lib.setWindowScrollOrigin . hwindow)
  
  -- | Can the window be resized?

[htoolkit-cvs] port/src/include Window.h,1.6,1.7

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/include
In directory sc8-pr-cvs1:/tmp/cvs-serv3786/src/include

Modified Files:
	Window.h 
Log Message:
osScrollWindowTo function is renamed to osSetWindowScrollOrigin.
Added osGetWindowScrollOrigin function


Index: Window.h
===================================================================
RCS file: /cvsroot/htoolkit/port/src/include/Window.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** Window.h	26 Apr 2003 20:03:08 -0000	1.6
--- Window.h	13 Jul 2003 10:21:28 -0000	1.7
***************
*** 1,94 ****
! #ifndef WINDOW_H
! #define WINDOW_H
! 
! #include "Types.h"
! 
! #define shiftBIT 1
! #define ctrlBIT  2
! #define altBIT   4
! 
! #define evMouseMove   	    1
! #define evMouseEnter   	    2
! #define evMouseLeave   	    3
! #define evMouseLeftDown     4
! #define evMouseRightDown    5
! #define evMouseDoubleClick  6
! #define evMouseDrag    	    7
! #define evMouseLeftUp       8
! #define evMouseRightUp      9
! 
! #define evKeyDown   		10
! #define evKeyStillDown  	11
! #define evKeyUp    			12
! #define evKeyLost			13
! 
! #define kbBackSpace 		8
! #define kbTab				9
! #define kbEnter				13
! #define kbEscape			27
! #define kbBegin 			1003
! #define kbClear				1004
! #define kbDelete			1005
! #define kbDown				1006
! #define kbEnd				1007
! #define kbF1				1010
! #define kbF2				1011
! #define kbF3				1012
! #define kbF4				1013
! #define kbF5				1014
! #define kbF6				1015
! #define kbF7				1016
! #define kbF8				1017
! #define kbF9				1018
! #define kbF10				1019
! #define kbF11				1020
! #define kbF12				1021
! #define kbF13				1022
! #define kbF14				1023
! #define kbF15				1024
! #define kbHelp				1025
! #define kbLeft				1026
! #define kbPgDown			1027
! #define kbPgUp				1028
! #define kbRight				1029
! #define kbUp				1030
! 
! 
! 
! void osMoveResizeControl(WindowHandle ctrl, int x, int y, int w, int h);
! void osGetControlRect(WindowHandle ctrl, int *res);
! void osSetControlEnabled(WindowHandle ctrl, BOOL enabled);
! BOOL osGetControlEnabled(WindowHandle ctrl);
! void osSetControlTip(WindowHandle ctrl, char *text);
! char *osGetControlTip(WindowHandle ctrl);
! 
! void osInvalidateWindow(WindowHandle window);
! void osInvalidateWindowRect(WindowHandle window, int left, int top, int right, int bottom);
! 
! WindowHandle osCreateWindow();
! WindowHandle osCreateDialog(WindowHandle parent);
! void osSetWindowColor(WindowHandle window, int foreColor, int backColor, int hatchStyle, BitmapHandle patBmp);
! char *osGetWindowTitle(WindowHandle window);
! void osSetWindowTitle(WindowHandle window, char *txt);
! void osGetWindowViewSize(WindowHandle window, int *res);
! void osSetWindowViewSize(WindowHandle window, int w, int h);
! void osShowWindow(WindowHandle window);
! void osRunDialog(WindowHandle window);
! void osSetWindowDomainSize(WindowHandle window, int cx, int cy);
! void osScrollWindowTo(WindowHandle window, int x, int y);
! void osGetWindowPageSize(WindowHandle window, int *res);
! void osSetWindowPageSize(WindowHandle window, int cx, int cy);
! void osGetWindowLineSize(WindowHandle window, int *res);
! void osSetWindowLineSize(WindowHandle window, int cx, int cy);
! BOOL osDismissWindow(WindowHandle window);
! void osDestroyWindow(WindowHandle window);
! void osSetWindowEnabled(WindowHandle ctrl, BOOL enabled);
! BOOL osGetWindowEnabled(WindowHandle ctrl);
! CanvasHandle osGetWindowCanvas(WindowHandle window);
! void osReleaseWindowCanvas(WindowHandle window,CanvasHandle canvas);
! 
! void osSetWindowRect(WindowHandle window, int x0, int y0, int x1, int y1);
! void osGetWindowRect(WindowHandle window, int *res);
! void osSetWindowResizeable(WindowHandle window, int resizeable);
! 
! #endif
--- 1,95 ----
! #ifndef WINDOW_H
! #define WINDOW_H
! 
! #include "Types.h"
! 
! #define shiftBIT 1
! #define ctrlBIT  2
! #define altBIT   4
! 
! #define evMouseMove   	    1
! #define evMouseEnter   	    2
! #define evMouseLeave   	    3
! #define evMouseLeftDown     4
! #define evMouseRightDown    5
! #define evMouseDoubleClick  6
! #define evMouseDrag    	    7
! #define evMouseLeftUp       8
! #define evMouseRightUp      9
! 
! #define evKeyDown   		10
! #define evKeyStillDown  	11
! #define evKeyUp    			12
! #define evKeyLost			13
! 
! #define kbBackSpace 		8
! #define kbTab				9
! #define kbEnter				13
! #define kbEscape			27
! #define kbBegin 			1003
! #define kbClear				1004
! #define kbDelete			1005
! #define kbDown				1006
! #define kbEnd				1007
! #define kbF1				1010
! #define kbF2				1011
! #define kbF3				1012
! #define kbF4				1013
! #define kbF5				1014
! #define kbF6				1015
! #define kbF7				1016
! #define kbF8				1017
! #define kbF9				1018
! #define kbF10				1019
! #define kbF11				1020
! #define kbF12				1021
! #define kbF13				1022
! #define kbF14				1023
! #define kbF15				1024
! #define kbHelp				1025
! #define kbLeft				1026
! #define kbPgDown			1027
! #define kbPgUp				1028
! #define kbRight				1029
! #define kbUp				1030
! 
! 
! 
! void osMoveResizeControl(WindowHandle ctrl, int x, int y, int w, int h);
! void osGetControlRect(WindowHandle ctrl, int *res);
! void osSetControlEnabled(WindowHandle ctrl, BOOL enabled);
! BOOL osGetControlEnabled(WindowHandle ctrl);
! void osSetControlTip(WindowHandle ctrl, char *text);
! char *osGetControlTip(WindowHandle ctrl);
! 
! void osInvalidateWindow(WindowHandle window);
! void osInvalidateWindowRect(WindowHandle window, int left, int top, int right, int bottom);
! 
! WindowHandle osCreateWindow();
! WindowHandle osCreateDialog(WindowHandle parent);
! void osSetWindowColor(WindowHandle window, int foreColor, int backColor, int hatchStyle, BitmapHandle patBmp);
! char *osGetWindowTitle(WindowHandle window);
! void osSetWindowTitle(WindowHandle window, char *txt);
! void osGetWindowViewSize(WindowHandle window, int *res);
! void osSetWindowViewSize(WindowHandle window, int w, int h);
! void osShowWindow(WindowHandle window);
! void osRunDialog(WindowHandle window);
! void osSetWindowDomainSize(WindowHandle window, int cx, int cy);
! void osSetWindowScrollOrigin(WindowHandle window, int x, int y);
! void osGetWindowScrollOrigin(WindowHandle window, int *res);
! void osGetWindowPageSize(WindowHandle window, int *res);
! void osSetWindowPageSize(WindowHandle window, int cx, int cy);
! void osGetWindowLineSize(WindowHandle window, int *res);
! void osSetWindowLineSize(WindowHandle window, int cx, int cy);
! BOOL osDismissWindow(WindowHandle window);
! void osDestroyWindow(WindowHandle window);
! void osSetWindowEnabled(WindowHandle ctrl, BOOL enabled);
! BOOL osGetWindowEnabled(WindowHandle ctrl);
! CanvasHandle osGetWindowCanvas(WindowHandle window);
! void osReleaseWindowCanvas(WindowHandle window,CanvasHandle canvas);
! 
! void osSetWindowRect(WindowHandle window, int x0, int y0, int x1, int y1);
! void osGetWindowRect(WindowHandle window, int *res);
! void osSetWindowResizeable(WindowHandle window, int resizeable);
! 
! #endif

[htoolkit-cvs] port/src/cbits/Win32 Window.c,1.33,1.34

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/Win32
In directory sc8-pr-cvs1:/tmp/cvs-serv3786/src/cbits/Win32

Modified Files:
	Window.c 
Log Message:
osScrollWindowTo function is renamed to osSetWindowScrollOrigin.
Added osGetWindowScrollOrigin function


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/Win32/Window.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** Window.c	12 Jul 2003 13:49:41 -0000	1.33
--- Window.c	13 Jul 2003 10:21:27 -0000	1.34
***************
*** 1002,1006 ****
  }
  
! void osScrollWindowTo(WindowHandle window, int x, int y)
  {
      WindowData *pData = (WindowData *) GetWindowLong(window,GWL_USERDATA);
--- 1002,1006 ----
  }
  
! void osSetWindowScrollOrigin(WindowHandle window, int x, int y)
  {
      WindowData *pData = (WindowData *) GetWindowLong(window,GWL_USERDATA);
***************
*** 1011,1014 ****
--- 1011,1022 ----
      pData->Origin.x = x;
      pData->Origin.y = y;
+ }
+ 
+ void osGetWindowScrollOrigin(WindowHandle window, int *res)
+ {
+     WindowData *pData = (WindowData *) GetWindowLong(window,GWL_USERDATA);
+ 
+     res[0] = pData->Origin.x;
+     res[1] = pData->Origin.y;
  }
  

[htoolkit-cvs] port/src/cbits/GTK Window.c,1.20,1.21

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/cbits/GTK
In directory sc8-pr-cvs1:/tmp/cvs-serv3786/src/cbits/GTK

Modified Files:
	Window.c 
Log Message:
osScrollWindowTo function is renamed to osSetWindowScrollOrigin.
Added osGetWindowScrollOrigin function


Index: Window.c
===================================================================
RCS file: /cvsroot/htoolkit/port/src/cbits/GTK/Window.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** Window.c	5 Jul 2003 11:01:16 -0000	1.20
--- Window.c	13 Jul 2003 10:21:27 -0000	1.21
***************
*** 592,604 ****
  void osSetWindowDomainSize(WindowHandle window, int cx, int cy)
  {
  	gtk_window_set_resizable(GTK_WINDOW(gFrameWidget), FALSE);
  	gtk_widget_set_size_request(GTK_BIN(GTK_BIN(window)->child)->child,cx,cy);
  	gtk_window_set_resizable(GTK_WINDOW(gFrameWidget), TRUE);
  }
  
! void osScrollWindowTo(WindowHandle window, int x, int y)
  {
  	gtk_adjustment_set_value(gtk_scrolled_window_get_hadjustment (GTK_SCROLLED_WINDOW(window)), x);
  	gtk_adjustment_set_value(gtk_scrolled_window_get_vadjustment (GTK_SCROLLED_WINDOW(window)), y);
  }
  
--- 592,620 ----
  void osSetWindowDomainSize(WindowHandle window, int cx, int cy)
  {
+ 	GtkAdjustment *adjustment;
+ 
  	gtk_window_set_resizable(GTK_WINDOW(gFrameWidget), FALSE);
  	gtk_widget_set_size_request(GTK_BIN(GTK_BIN(window)->child)->child,cx,cy);
  	gtk_window_set_resizable(GTK_WINDOW(gFrameWidget), TRUE);
+ 
+ 	adjustment = gtk_scrolled_window_get_hadjustment (GTK_SCROLLED_WINDOW(window));
+ 	adjustment->upper = cx;
+ 	gtk_adjustment_changed(adjustment);
+ 
+ 	adjustment = gtk_scrolled_window_get_vadjustment (GTK_SCROLLED_WINDOW(window));
+ 	adjustment->upper = cy;
+ 	gtk_adjustment_changed(adjustment);
  }
  
! void osSetWindowScrollOrigin(WindowHandle window, int x, int y)
  {
  	gtk_adjustment_set_value(gtk_scrolled_window_get_hadjustment (GTK_SCROLLED_WINDOW(window)), x);
  	gtk_adjustment_set_value(gtk_scrolled_window_get_vadjustment (GTK_SCROLLED_WINDOW(window)), y);
+ }
+ 
+ void osGetWindowScrollOrigin(WindowHandle window, int *res)
+ {
+ 	res[0] = gtk_adjustment_get_value(gtk_scrolled_window_get_hadjustment (GTK_SCROLLED_WINDOW(window)));
+ 	res[1] = gtk_adjustment_get_value(gtk_scrolled_window_get_vadjustment (GTK_SCROLLED_WINDOW(window)));
  }
  

[htoolkit-cvs] port/src/Port Window.hs,1.12,1.13

[<kr_...@us...>]

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv3786/src/Port

Modified Files:
	Window.hs 
Log Message:
osScrollWindowTo function is renamed to osSetWindowScrollOrigin.
Added osGetWindowScrollOrigin function


Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Window.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Window.hs	8 Jun 2003 19:42:15 -0000	1.12
--- Window.hs	13 Jul 2003 10:21:27 -0000	1.13
***************
*** 13,17 ****
  -----------------------------------------------------------------------------------------
  module Graphics.UI.Port.Window
!              ( 
               -- * Creation
                 createWindow, createDialog
--- 13,17 ----
  -----------------------------------------------------------------------------------------
  module Graphics.UI.Port.Window
!              (
               -- * Creation
                 createWindow, createDialog
***************
*** 20,24 ****
               , dismissWindow, dismissAllWindows
               , destroyWindow, destroyAllWindows
-              , scrollWindowTo
               , invalidateWindowFrame
               , invalidateWindow
--- 20,23 ----
***************
*** 28,31 ****
--- 27,31 ----
               , setWindowColor
               , setWindowDomainSize
+ 	     , setWindowScrollOrigin, getWindowScrollOrigin
               , setWindowViewSize,  getWindowViewSize
               , setWindowTitle,     getWindowTitle
***************
*** 162,167 ****
  getWindowViewSize :: WindowHandle -> IO Size
  getWindowViewSize hwnd
!   = withCSizeResult $ \csize ->
!     osGetWindowViewSize hwnd csize
  foreign import ccall osGetWindowViewSize :: WindowHandle -> Ptr CInt -> IO ()
  
--- 162,166 ----
  getWindowViewSize :: WindowHandle -> IO Size
  getWindowViewSize hwnd
!   = withCSizeResult (osGetWindowViewSize hwnd)
  foreign import ccall osGetWindowViewSize :: WindowHandle -> Ptr CInt -> IO ()
  
***************
*** 181,190 ****
  foreign import ccall osSetWindowDomainSize :: WindowHandle -> CInt -> CInt -> IO ()
  
! -- | Scroll the view frame to a specific point.
! scrollWindowTo :: WindowHandle -> Point -> IO ()
! scrollWindowTo hwnd point
!   = withCPoint point $ \cx cy ->
!     osScrollWindowTo hwnd cx cy
! foreign import ccall osScrollWindowTo :: WindowHandle -> CInt -> CInt -> IO ()
  
  -- | Get the horizontal and vertical scroll distance for a /large/ scroll action.
--- 180,194 ----
  foreign import ccall osSetWindowDomainSize :: WindowHandle -> CInt -> CInt -> IO ()
  
! -- | Set the scroll origin for the specified window
! setWindowScrollOrigin :: WindowHandle -> Point -> IO ()
! setWindowScrollOrigin hwnd point
!   = withCPoint point (osSetWindowScrollOrigin hwnd)
! foreign import ccall osSetWindowScrollOrigin :: WindowHandle -> CInt -> CInt -> IO ()
! 
! -- | Get the scroll origin for the specified window
! getWindowScrollOrigin :: WindowHandle -> IO Point
! getWindowScrollOrigin hwnd
!   = withCPointResult (osGetWindowScrollOrigin hwnd)
! foreign import ccall osGetWindowScrollOrigin :: WindowHandle -> Ptr CInt -> IO ()
  
  -- | Get the horizontal and vertical scroll distance for a /large/ scroll action.