Menu
▾
▴
win32forth-cvs
|
From: George H. <geo...@us...> - 2007-05-22 07:36:38
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9168/win32forth-stc/src Modified Files: CONTROL.F Class.f GENERIC.F dthread.f words.f Log Message: gah:modified .classes to ignore the anonymous class of :objects, removed name> and voc>vcfa. Moved get-mouse-xy to generic.f and made thread safe (per the ITC). Index: dthread.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dthread.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** dthread.f 20 May 2007 15:09:15 -0000 1.2 --- dthread.f 22 May 2007 07:36:20 -0000 1.3 *************** *** 15,19 **** : count-voc ( voc -- ) dup voc#threads >r ! dup voc>vcfa ?isclass not \ don't look through classes if r@ 0 --- 15,19 ---- : count-voc ( voc -- ) dup voc#threads >r ! dup voc>vxt@ ?isclass not \ don't look through classes if r@ 0 *************** *** 58,62 **** : .thread ( n1 -- ) \ display a thread of context vocabulary >r ! context @ dup voc>vcfa >name cr ." Vocabulary: " .id cr ." Thread " r@ . dup voc#threads ." of " dup . ." threads" cr --- 58,62 ---- : .thread ( n1 -- ) \ display a thread of context vocabulary >r ! context @ dup voc>vxt@ >name cr ." Vocabulary: " .id cr ." Thread " r@ . dup voc#threads ." of " dup . ." threads" cr *************** *** 64,68 **** : .threads ( -- ) ! context @ dup voc>vcfa >name cr ." Vocabulary: " .id dup voc#threads 0 do cr ." Thread: " i . cr --- 64,68 ---- : .threads ( -- ) ! context @ dup voc>vxt@ >name cr ." Vocabulary: " .id dup voc#threads 0 do cr ." Thread: " i . cr *************** *** 76,80 **** 0 to #thread-over context @ count-voc ! context @ dup voc>vcfa >name cr ." Vocabulary: " .id cr dup voc#threads 0 do ." Thread:Depth " 13 ?line --- 76,80 ---- 0 to #thread-over context @ count-voc ! context @ dup voc>vxt@ >name cr ." Vocabulary: " .id cr dup voc#threads 0 do ." Thread:Depth " 13 ?line Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Class.f 21 May 2007 14:16:59 -0000 1.11 --- Class.f 22 May 2007 07:36:20 -0000 1.12 *************** *** 1600,1608 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - synonym voc>vcfa voc>vxt@ - synonym name> name>xt - IN-SYSTEM : .CLASSES ( -- ) \ W32F Class \ *G Display all classes in the system. --- 1600,1607 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ IN-SYSTEM + also classes + : .CLASSES ( -- ) \ W32F Class \ *G Display all classes in the system. *************** *** 1611,1622 **** voc-link @ BEGIN dup vlink>voc ! voc>vcfa dup ?isClass ! IF dup >name name> 0= ! \ ['] [UNKNOWN] = \ if not found ! IF drop \ then discard the class ! ELSE .name ! 20 #tab 20 ?cr ! THEN ! ELSE drop THEN @ dup 0= --- 1610,1620 ---- voc-link @ BEGIN dup vlink>voc ! voc>vxt@ dup ?isClass ! IF dup ['] [NoNameClass] = \ if :Object ! IF drop \ then discard the class ! ELSE .name ! 20 #tab 20 ?cr ! THEN ! ELSE drop THEN @ dup 0= *************** *** 1627,1631 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! also classes also hidden : GetMethod { \ m0cfa -- -<method: object>- m0cfa } \ W32F Class --- 1625,1629 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! also hidden : GetMethod { \ m0cfa -- -<method: object>- m0cfa } \ W32F Class Index: words.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/words.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** words.f 21 May 2007 08:38:46 -0000 1.4 --- words.f 22 May 2007 07:36:20 -0000 1.5 *************** *** 43,50 **** MAXSTRING LocalAlloc: words-pad$ voc dup voc#threads to w#threads ! dup voc>vcfa ?isclass not \ don't look through classes if dup here 500 + w#threads cells move \ copy vocabulary up ! voc>vcfa vocsave ! begin here 500 + w#threads largest dup while dup l>name nfa-count 2dup "CLIP" words-pad$ place --- 43,50 ---- MAXSTRING LocalAlloc: words-pad$ voc dup voc#threads to w#threads ! dup voc>vxt@ ?isclass not \ don't look through classes if dup here 500 + w#threads cells move \ copy vocabulary up ! voc>vxt@ vocsave ! begin here 500 + w#threads largest dup while dup l>name nfa-count 2dup "CLIP" words-pad$ place *************** *** 107,113 **** cr VOC-LINK @ BEGIN DUP VLINK>VOC ! dup voc>vcfa ?isclass not \ don't look through classes ! IF dup voc>vcfa .NAME 18 #tab dup voc#threads dup>r 4 .r 0 to words-cnt --- 107,113 ---- cr VOC-LINK @ BEGIN DUP VLINK>VOC ! dup voc>vxt@ ?isclass not \ don't look through classes ! IF dup voc>vxt@ .NAME 18 #tab dup voc#threads dup>r 4 .r 0 to words-cnt *************** *** 201,205 **** begin dup vlink>voc dup voc#threads >r ! dup voc>vcfa @ dup doClass = \ don't look through classes swap do|Class = or 0= \ don't look through classes --- 201,205 ---- begin dup vlink>voc dup voc#threads >r ! dup voc>vxt@ @ dup doClass = \ don't look through classes swap do|Class = or 0= \ don't look through classes Index: CONTROL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/CONTROL.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CONTROL.F 3 May 2007 09:10:51 -0000 1.1 --- CONTROL.F 22 May 2007 07:36:20 -0000 1.2 *************** *** 1,4 **** --- 1,37 ---- \ $Id$ + \ + \ Copyright [c] 2007 by Alex McDonald (alex at rivadpm dot com) + \ Dirk Busch (dirk at win32forth.org) + \ George Hubert (georgeahubert at yahoo.co.uk) + \ Jos V D Ven + \ Tom Dixon + \ The original Win32Forth system was public domain; this file is GPL. + \ Although the basic structure of Win32Forth and many of its capabilities + \ are employed in this code, the subclass routine has been completely rewritten. + \ The original code was originally developed by Tom Zimmer, Andrew McKewan + \ with minor contributions by others and placed in the public domain. I + \ acknowledge their copyrighted contributions and the structure and some + \ of the methods and concepts employed in this further development. + \ + \ The assembler is Copyright [c] 1994, 1995, by Jim Schneider and is issued + \ under the LGPL. + \ + \ This program is free software; you can redistribute it and/or modify it + \ under the terms of the GNU General Public License as published by the + \ Free Software Foundation; either version 2 of the License, or <at your + \ option> any later version. + \ + \ This program is distributed in the hope that it will be useful, but + \ WITHOUT ANY WARRANTY; without even the implied warranty of + \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + \ General Public License for more details. + \ + \ You should have received a copy of the GNU General Public License along + \ with this program; if not, write to the Free Software Foundation, Inc., + \ 675 Mass Ave, Cambridge, MA 02139, USA. + \ + \ ------------------------------------------------------------------------ + \ *D doc\classes\ \ *! Control *************** *** 13,53 **** DEFER SUBCLASS-WNDPROC :NONAME 4DROP 0 ; IS SUBCLASS-WNDPROC - \ ------------------------------------------------------------------------ - \ ----------------- ITC Only --------------------------------------------- - \ ------------------------------------------------------------------------ - - \ NCODE SUBCLASS-RETURN - \ CODE-HERE CELL+ CODE-, \ itc - \ mov eax, ebx \ C return value - \ mov esp, ebp \ restore stack - \ pop ebp \ restore registers - \ pop ebx - \ pop edi - \ pop esi - \ ret # 4 CELLS \ return & discard params - \ c; - - \ CFA-CODE SUBCLASS-ENTRY ( lparam wparam message hwnd -- result ) - \ push esi \ save registers - \ push edi - \ push ebx - \ push ebp - \ mov ebx, ecx \ address of object - \ mov ebp, esp \ make forth stacks - \ sub esp, # 4000 \ room for return stack - \ push 5 CELLS [ebp] \ hwnd - \ push 6 CELLS [ebp] \ message - \ push 7 CELLS [ebp] \ wparam - \ push 8 CELLS [ebp] \ lparam - \ xor edi, edi \ EDI is constant 0 - \ mov edx, fs: 0x14 \ edx is now ptr from TIB pvArbitrary - \ mov esi, # ' SUBCLASS-RETURN - \ mov eax, # ' SUBCLASS-WNDPROC - \ exec c; - - \ ------------------------------------------------------------------------ - \ -------------------------- STC Only ------------------------------------ - \ ------------------------------------------------------------------------ - CODE SUBCLASS-ENTRY ( lparam wparam message hwnd -- result ) push esi \ save registers --- 46,49 ---- *************** *** 75,79 **** pop esi ret # 4 CELLS \ return & discard params ! c; : CallWindowProc ( hwnd msg wparam lparam wndproc -- result ) --- 71,75 ---- pop esi ret # 4 CELLS \ return & discard params ! next c; : CallWindowProc ( hwnd msg wparam lparam wndproc -- result ) *************** *** 92,97 **** create &ButtonRect 4 cells allot \ temp rectangle for current info msg &ButtonRect 4 cells erase ! create &CursorPoint 2 cells allot ! &CursorPoint 2 cells erase 255 constant max-binfo \ longest info message allowed --- 88,92 ---- create &ButtonRect 4 cells allot \ temp rectangle for current info msg &ButtonRect 4 cells erase ! 255 constant max-binfo \ longest info message allowed *************** *** 106,115 **** FALSE value mouse-is-down? - : get-mouse-xy { hWnd -- x y } - &CursorPoint Call GetCursorPos drop - &CursorPoint hWnd Call ScreenToClient drop - &CursorPoint @ - &CursorPoint cell+ @ ; - : in-button? { x y hWnd -- f1 } &ButtonRect hWnd Call GetClientRect drop --- 101,104 ---- Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/GENERIC.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** GENERIC.F 1 May 2007 07:41:55 -0000 1.2 --- GENERIC.F 22 May 2007 07:36:20 -0000 1.3 *************** *** 54,57 **** --- 54,66 ---- ' TempRect Alias wRect + \ Moved from control.f since it's also used by descendants of the class window. + \ Made thread-safe gah Sunday, May 20 2007 + : 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 |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X