Menu
▾
▴
[Win32forth-cvs] win32forth/src BUTTON.F, 1.3, 1.4 CONTROLS.F, 1.14, 1.15 Class.f, 1.46, 1.47 Dc.f, 1.20, 1.21 GENERIC.F, 1.32, 1.33 Primutil.f, 1.67, 1.68 WINMSG.F, 1.7, 1.8 Window.f, 1.34, 1.35
|
From: George H. <geo...@us...> - 2013-12-17 19:25:25
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv25360/src Modified Files: BUTTON.F CONTROLS.F Class.f Dc.f GENERIC.F Primutil.f WINMSG.F Window.f Log Message: Minor bug fixes and enhancements Index: WINMSG.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/WINMSG.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** WINMSG.F 20 Nov 2013 12:28:36 -0000 1.7 --- WINMSG.F 17 Dec 2013 19:25:22 -0000 1.8 *************** *** 11,16 **** int cols int rows ! int ontop? ! int msgactive int msg-string int msg-length --- 11,16 ---- int cols int rows ! ' wStatus1 alias ontop? ! ' wStatus2 alias msgactive int msg-string int msg-length *************** *** 32,36 **** :M GetActive: ( -- f1 ) \ is the message window active ! msgactive ;M --- 32,36 ---- :M GetActive: ( -- f1 ) \ is the message window active ! msgactive 0<> ;M *************** *** 115,119 **** ;Class ! msgwindow msg-window INTERNAL --- 115,119 ---- ;Class ! UserObject: msgwindow msg-window INTERNAL Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** GENERIC.F 28 Nov 2013 20:51:55 -0000 1.32 --- GENERIC.F 17 Dec 2013 19:25:22 -0000 1.33 *************** *** 68,95 **** \ *G Base class for all window objects. - (( - \ Macros for backward compatibility - : wRect.addrof s" addrof: winrect" evaluate ; immediate - : wRect.left s" left: winrect" evaluate ; immediate - : wRect.right s" right: winrect" evaluate ; immediate - : wRect.top s" top: winrect" evaluate ; immediate - : wRect.bottom s" bottom: winrect" evaluate ; immediate - \ synonym TempRect.addrof wRect.addrof \ made a colon def - [cdo-2008May13] - \ synonym TempRect.left wRect.left \ made a colon def - [cdo-2008May13] - \ synonym TempRect.right wRect.right \ made a colon def - [cdo-2008May13] - \ synonym TempRect.top wRect.top \ made a colon def - [cdo-2008May13] - \ synonym TempRect.bottom wRect.bottom \ made a colon def - [cdo-2008May13] - - : TempRect.addrof \ synonym of wRect.addrof for backward compatibility - postpone wRect.addrof ; IMMEDIATE - : TempRect.left \ synonym of wRect.Left for backward compatibility - postpone wRect.left ; IMMEDIATE - : TempRect.right \ synonym of wRect.right for backward compatibility - postpone wRect.right ; IMMEDIATE - : TempRect.top \ synonym of wRect.top for backward compatibility - postpone wRect.top ; IMMEDIATE - : TempRect.bottom \ synonym of wRect.bottom for backward compatibility - postpone wRect.bottom ; IMMEDIATE - )) in-application --- 68,71 ---- *************** *** 330,334 **** hWnd if EraseRect: WinRect ! AddrOf: WinRect hWnd Call GetWindowRect ?win-error Left: WinRect Top: WinRect Right: WinRect Bottom: WinRect --- 306,310 ---- hWnd if EraseRect: WinRect ! WinRect hWnd Call GetWindowRect ?win-error Left: WinRect Top: WinRect Right: WinRect Bottom: WinRect Index: Dc.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dc.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** Dc.f 6 Nov 2013 21:56:29 -0000 1.20 --- Dc.f 17 Dec 2013 19:25:22 -0000 1.21 *************** *** 323,327 **** Brush: PRINTFILLCOLOR left top right bottom SetRect: RECT ! RECT.AddrOf GetHandle: super ( 3 win-parameters ) Call FillRect ?win-error ;M --- 323,327 ---- Brush: PRINTFILLCOLOR left top right bottom SetRect: RECT ! RECT GetHandle: super ( 3 win-parameters ) Call FillRect ?win-error ;M Index: BUTTON.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/BUTTON.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** BUTTON.F 26 Jun 2010 08:24:15 -0000 1.3 --- BUTTON.F 17 Dec 2013 19:25:22 -0000 1.4 *************** *** 699,703 **** 0 0 StartSize: self 1+ SetRect: WinRect ! Addrof: WinRect GetHandle: dc call FillRect ?win-error EraseRect: WinRect StartPos: self StartSize: self Move: self --- 699,703 ---- 0 0 StartSize: self 1+ SetRect: WinRect ! WinRect GetHandle: dc call FillRect ?win-error EraseRect: WinRect StartPos: self StartSize: self Move: self Index: CONTROLS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROLS.F,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** CONTROLS.F 20 Nov 2013 12:28:36 -0000 1.14 --- CONTROLS.F 17 Dec 2013 19:25:22 -0000 1.15 *************** *** 115,119 **** :M WM_SETCURSOR { hndl msg wparam lparam -- res } EraseRect: WinRect \ init to zeros ! AddrOf: WinRect GetClientRect: self hWnd get-mouse-xy Top: WinRect Bottom: WinRect between over Left: WinRect Right: WinRect between and --- 115,119 ---- :M WM_SETCURSOR { hndl msg wparam lparam -- res } EraseRect: WinRect \ init to zeros ! WinRect GetClientRect: self hWnd get-mouse-xy Top: WinRect Bottom: WinRect between over Left: WinRect Right: WinRect between and Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 *** Class.f 9 Dec 2013 21:25:16 -0000 1.46 --- Class.f 17 Dec 2013 19:25:22 -0000 1.47 *************** *** 90,93 **** --- 90,95 ---- : class-allot ( n -- ) ^class DFA +! ; + : Class-align ( -- ) ^class dfa dup @ aligned swap ! ; + 0 value bitcnt 0 value bitmaxval *************** *** 415,419 **** \ from stack, if it's an array of objects THEN ! dLen cell+ idWid IF idWid #els * ( cell+ ) + \ get total length of obj --- 417,421 ---- \ from stack, if it's an array of objects THEN ! dLen ( cell+ ) idWid IF idWid #els * ( cell+ ) + \ get total length of obj *************** *** 467,470 **** --- 469,476 ---- fcall (heapObj) pop ecx + mov eax, UserObjectList [UP] + mov -4 [ecx], eax + lea eax, -4 [ecx] + mov UserObjectList [UP] , eax @@2: mov 0 [ecx], ebx @@3: next *************** *** 493,497 **** \ ** referenced. The pointer is set for the main task at compile time or the first usage for a saved program. ' dup ?isClass not THROW_NOT_CLASS ?throw >body Header DoUserObj compile, ! NEXT-USER @ dup cell+ NEXT-USER ! , <building> ; internal --- 499,503 ---- \ ** referenced. The pointer is set for the main task at compile time or the first usage for a saved program. ' dup ?isClass not THROW_NOT_CLASS ?throw >body Header DoUserObj compile, ! NEXT-USER @ dup 2 cells+ NEXT-USER ! cell+ , <building> ; internal *************** *** 973,979 **** if count name-max-chars min 2dup tempmsg$ place \ in case there is an error ! 2dup method-hash dup ?unhash ! if nip nip ! else >r unres-methods begin dup c@ while count + --- 979,985 ---- if count name-max-chars min 2dup tempmsg$ place \ in case there is an error ! 2dup hash-wid Search-Wordlist ! if execute nip nip ! else 2dup method-hash >r unres-methods begin dup c@ while count + *************** *** 1075,1078 **** --- 1081,1085 ---- \ ** in a Record: so only objects that don't use late binding can be used. -1 to contiguous-data? + Class-align header (&iv) , \ return address of array of bytes *************** *** 1187,1190 **** --- 1194,1198 ---- \ *G Long integer (32bit) instance variable. When used as an object variable has the same \ ** behaviour as VALUEs. + contiguous-data? 0= if Class-align then header (iv@) , *************** *** 1197,1200 **** --- 1205,1209 ---- : dint ( -"name"- ) \ W32F Class \ *G Double (64bit) instance variable. + contiguous-data? 0= if Class-align then header (ivd@) , *************** *** 1303,1306 **** --- 1312,1320 ---- ~: [ dup>r ] r> ( cell- ) Free THROW_DISPOSE_ERR ?throw ; + : ?Dispose ( addr -- ) + \ *G Dispose of a dynamically allocated object if address is non-zero. Allows storing either + \ ** 0 or an object address in a value. + ?dup if Dispose then ; + \ -------------------------------------------------------------------- \ ------------- Support for windows procedures etc ------------------- *************** *** 1365,1369 **** ;Class ! previous also in-system --- 1379,1389 ---- ;Class ! hashed definitions ! ! ' Addr: alias AddrOf: ! ! previous also definitions ! ! in-system *************** *** 1394,1398 **** \ ** ivar. Note dints perform the AND on the 2 cells of the ivar storing the result as the \ ** most significant cell, with n1 as the least. ! dup>r Get: self AND r> put: self ;M :M Or: ( n1 -- ) --- 1414,1418 ---- \ ** ivar. Note dints perform the AND on the 2 cells of the ivar storing the result as the \ ** most significant cell, with n1 as the least. ! dup>r Get: self AND r> put: self ;M :M Or: ( n1 -- ) *************** *** 1464,1469 **** EraseRect: self ;M - :M AddrOf: ( -- n1 ) AddrOf ;M - :M Addr: ( -- n1 ) AddrOf ;M :M Left: ( -- n1 ) Left ;M :M Top: ( -- n1 ) Top ;M --- 1484,1487 ---- Index: Window.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Window.f,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** Window.f 20 Nov 2013 12:28:36 -0000 1.34 --- Window.f 17 Dec 2013 19:25:22 -0000 1.35 *************** *** 165,169 **** r> self find-method execute SetRect: WinRect ! AddrOf: WinRect \ make a new rectangle Call AdjustWindowRectEx ?win-error \ adjust the window Height: WinRect \ adjusted height --- 165,169 ---- r> self find-method execute SetRect: WinRect ! WinRect \ make a new rectangle Call AdjustWindowRectEx ?win-error \ adjust the window Height: WinRect \ adjusted height *************** *** 295,299 **** WindowHasMenu: [ self ] \ have menu flag? WindowStyle: [ self ] \ window style ! AddrOf: WinRect \ make a new rectangle call AdjustWindowRectEx ?win-error \ adjust the window --- 295,299 ---- WindowHasMenu: [ self ] \ have menu flag? WindowStyle: [ self ] \ window style ! WinRect \ make a new rectangle call AdjustWindowRectEx ?win-error \ adjust the window Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.67 retrieving revision 1.68 diff -C2 -d -r1.67 -r1.68 *** Primutil.f 9 Dec 2013 21:25:16 -0000 1.67 --- Primutil.f 17 Dec 2013 19:25:22 -0000 1.68 *************** *** 1002,1005 **** --- 1002,1007 ---- in-application + cell NewUser UserObjectList \ For disposing of User Objects + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Locking for Windows |
