From: George H. <geo...@us...> - 2007-06-27 07:41:16
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20682/win32forth-stc/src Modified Files: GENERIC.F Menu.f callback.f Log Message: gah: modified words with local structures to use localalloc: Modified winpause to work with noconsole code and multi-tasking Index: callback.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/callback.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** callback.f 6 Oct 2006 15:42:27 -0000 1.3 --- callback.f 27 Jun 2007 07:41:12 -0000 1.4 *************** *** 118,122 **** defer DefaultWindowProc ' _DefaultWindowProc is DefaultWindowProc ! 1 callback: HandleMessages { pMsg -- 0 } pMsg TRUE msg-chain do-chain nip if pMsg Call TranslateMessage drop --- 118,122 ---- defer DefaultWindowProc ' _DefaultWindowProc is DefaultWindowProc ! : HandleMessages { pMsg -- 0 } pMsg TRUE msg-chain do-chain nip if pMsg Call TranslateMessage drop *************** *** 124,127 **** --- 124,142 ---- then 0 ; + \ ************************************************************************* + \ A definition of WINPAUSE that doesn't need the console window. + \ ************************************************************************* + + 5 proc PeekMessage + \ + :Noname ( -- ) + { | pMsg -- } + 7 cells LocalAlloc: pMsg + BEGIN PM_REMOVE 0 0 0 pMsg Call PeekMessage + WHILE pMsg HandleMessages drop + REPEAT ; is WINPAUSE + + 1 callback: _HandleMessages ( pMsg -- 0 ) HandleMessages ; + 4 callback: HandleWindowsMessages { lParam wParam msg hwnd -- flag } msg WM_WIN32FORTH = *************** *** 139,143 **** : HandleMessages-init ( -- ) ! ['] HandleMessages &CB-MSG ! ['] HandleWindowsMessages &CB-WINMSG ! ['] byebye &CB-BYE ! --- 154,158 ---- : HandleMessages-init ( -- ) ! ['] _HandleMessages &CB-MSG ! ['] HandleWindowsMessages &CB-WINMSG ! ['] byebye &CB-BYE ! Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/GENERIC.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** GENERIC.F 22 May 2007 07:36:20 -0000 1.3 --- GENERIC.F 27 Jun 2007 07:41:12 -0000 1.4 *************** *** 58,65 **** : get-mouse-xy ( hWnd -- x y) \ W32F \ *G Return the co-ordinates of the mouse pointer in window, hWnd. ! { hWnd | CursorPoint.x CursorPoint.y -- x y } ! &of CursorPoint.x Call GetCursorPos drop ! &of CursorPoint.x hWnd Call ScreenToClient drop ! CursorPoint.x CursorPoint.y ; in-system --- 58,66 ---- : get-mouse-xy ( hWnd -- x y) \ W32F \ *G Return the co-ordinates of the mouse pointer in window, hWnd. ! { hWnd | CursorPoint -- x y } ! 2 cells localalloc: CursorPoint ! CursorPoint Call GetCursorPos drop ! CursorPoint hWnd Call ScreenToClient drop ! CursorPoint 2@ swap ; in-system Index: Menu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Menu.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Menu.f 8 May 2007 08:34:39 -0000 1.3 --- Menu.f 27 Jun 2007 07:41:12 -0000 1.4 *************** *** 153,162 **** ;M ! :M Track: { x y win-handle -- } hmenu -1 <> if 0 hmenu Call GetSubMenu >r ! &of x \ ClientToScreen begin here win-handle \ convert relative to absolute coords Call ClientToScreen drop --- 153,163 ---- ;M ! :M Track: { win-handle | point -- } ! 2 cells localalloc: point swap point 2! hmenu -1 <> if 0 hmenu Call GetSubMenu >r ! point \ ClientToScreen begin here win-handle \ convert relative to absolute coords Call ClientToScreen drop *************** *** 164,169 **** win-handle 0 ! y \ recover absolute screen coordinates ! x [ TPM_LEFTALIGN TPM_RIGHTBUTTON or ] literal r> --- 165,169 ---- win-handle 0 ! point 2@ \ recover absolute screen coordinates [ TPM_LEFTALIGN TPM_RIGHTBUTTON or ] literal r> |