Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Jos v.d.V. <jo...@us...> - 2007-05-12 13:42:13
|
Update of /cvsroot/win32forth/win32forth-stc/demos/AccelDemo In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20372 Added Files: Accel.f AccelDemo.bmp AccelDemo.f Log Message: Jos: Added an other demo. Note: I am still looking in copy-demo-bitmap. --- NEW FILE: Accel.f --- \ $Id: Accel.f,v 1.1 2007/05/12 13:42:09 jos_ven Exp $ \ --------------------------------------------------------------------------- \ ACCEL.F \ Windows Accelerator Table support for Win32Forth \ \ Written by Dirk Busch (dbu) \ eMail: di...@SP... \ ^^ ^^^^ remove this \ \ Version 1.0 May 17th, 2003 - 21:30 \ Version 1.1 May 22nd, 2003 - 17:54 \ Version 1.2 (for Win32Forth 6.07.07 and later) August 30th, 2003 dbu \ Version 1.3 (for Win32Forth 6.09.12 and later) Samstag, September 11 2004 \ --------------------------------------------------------------------------- cr .( Windows Accelerator Table support...) Require Childwnd.f \ --------------------------------------------------------------------------- \ helper words \ --------------------------------------------------------------------------- \ --------------------------------------------------------------------------- \ Debug support \ --------------------------------------------------------------------------- in-system 0 value Debug-Accelerator-Table-Support : Dump-Accelerator-Key-Table { addr -- } cr ." Accelerator-Key-Table:" addr cell+ addr @ 0 do dup i 10 * + cr dup 8 h.R SPACE dup c@ 2 h.R SPACE dup 2 + w@ 4 h.R SPACE dup 4 + w@ 4 h.R SPACE 6 + @ >NAME .ID loop drop cr ; : Dump-Windows-Accelerator-Key-Table ( addr count -- ) cr ." Windows-Accelerator-Key-Table:" over swap 0 do dup i 6 * + cr dup 8 h.R SPACE dup c@ 2 h.R SPACE dup 2 + w@ 4 h.R SPACE 4 + w@ 4 h.R SPACE loop 2drop cr ; in-application 0 value ACCEL-HNDL variable ACCEL-PTR \ --------------------------------------------------------------------------- \ compiling accelerator table into dictionary \ --------------------------------------------------------------------------- 1 constant FVIRTKEY \ yet another missing Windows constant : ACCELTABLE ( -- <-name-> ) CREATE HERE 0 , NOSTACK1 ; : ACCELENTRY { flags key-code cmd-id xt -- } flags FVIRTKEY or FNOINVERT or c, 0 c, key-code w, cmd-id w, xt , ; : ACCELEND ( -- ) HERE OVER - 10 ( table entry length ) / SWAP ! ; \ --------------------------------------------------------------------------- \ Create and destroy Windows Accelerator Table \ --------------------------------------------------------------------------- : Destroy-Accelerator-Table ( -- ) \ destroy's the Windows Accelerator Table ACCEL-HNDL 0<> if ACCEL-HNDL call DestroyAcceleratorTable drop then 0 to ACCEL-HNDL ACCEL-PTR OFF ; : Create-Accelerator-Table { addr \ addr2 -- } \ takes the Accelerator-Key-Table and builds a Windows Accelerator Table Destroy-Accelerator-Table \ debug stuff ------ Turnkeyed? 0= \IN-SYSTEM-OK if Debug-Accelerator-Table-Support \IN-SYSTEM-OK if addr Dump-Accelerator-Key-Table \IN-SYSTEM-OK then then \ ------------------ addr ACCEL-PTR ! \ Copy the Accelerator-Key-Table to a buffer addr @ 6 * MALLOC to addr2 addr cell+ addr2 ( addr' addr2 ) addr @ 0 ( addr' addr2 do loop ) do ( addr' addr2 ) 2dup 6 cmove swap 10 + swap 6 + loop 2drop \ debug stuff ------ Turnkeyed? 0= \IN-SYSTEM-OK if Debug-Accelerator-Table-Support \IN-SYSTEM-OK if addr2 addr @ Dump-Windows-Accelerator-Key-Table \IN-SYSTEM-OK then then \ ------------------ \ Create the Accelerator Table from the global memory handle addr @ addr2 ( count addr2 ) call CreateAcceleratorTable ( hAccelTable ) \ free buffer addr2 RELEASE dup to ACCEL-HNDL 0= if Destroy-Accelerator-Table then ; \ --------------------------------------------------------------------------- \ handle accelerator key \ --------------------------------------------------------------------------- : Get-Accelerator-Table-Entry { addr cmd-id \ table-offset -- table-offset >= 0 } -1 to table-offset addr cell+ \ move to first table entry addr @ 0 do i 10 * 4 + \ addr' offset over + w@ \ addr' cmd-id' cmd-id = \ addr' flag if i to table-offset leave then loop drop table-offset ; : Is-Accelerator-Key ( addr cmd-id -- flag ) Get-Accelerator-Table-Entry 0 >= ; : Get-Accelerator-Key-CFA { addr cmd-id -- cfa } addr cmd-id Get-Accelerator-Table-Entry 10 * 6 + addr cell+ + @ ; : Handle-Key-Table ( cmd-id -- true | false ) ACCEL-PTR @ swap 2dup Is-Accelerator-Key if Get-Accelerator-Key-CFA execute true else 2drop false then ; DEFER ACCEL-KEY ' NOOP IS ACCEL-KEY \ Handler for key entries 1 callback: HandleMessagesEx { pMsg -- 0 } pMsg TRUE msg-chain do-chain nip if ACCEL-HNDL if pMsg ACCEL-HNDL pMsg @ \ get the message's HWND Call TranslateAccelerator 0= if pMsg Call TranslateMessage drop pMsg Call DispatchMessage drop then else pMsg Call TranslateMessage drop pMsg Call DispatchMessage drop then then 0 ; \ --------------------------------------------------------------------------- \s How to use: \ --------------------------------------------------------------------------- \ 1 to Debug-Accelerator-Table-Support \ turn debug-support on \ 1. define the Word's to be executed by an accelerator key : handle-alt-a ( -- ) ; : handle-ctrl-b ( -- ) beep ; : handle-alt-ctrl-c ( -- ) ; : handle-alt-ctrl-r ( -- ) ; \ 2. Define the accelerator key table ACCELTABLE Accelerator-Key-Table \ Flags (Virt-)Key-Code Command-ID CFA FALT 'A' 4711 ' handle-alt-a ACCELENTRY FCONTROL 'B' 4712 ' handle-ctrl-b ACCELENTRY FALT FCONTROL or 'C' 4713 ' handle-alt-ctrl-c ACCELENTRY FALT FCONTROL or 'R' 4714 ' handle-alt-ctrl-r ACCELENTRY ACCELEND \ mark the end of table \ 3. init Accelerator Table the support \ Best place to do is in WM_CREATE-Message-Handler Accelerator-Key-Table Create-Accelerator-Table \ 4. let w32f processes the windows message with our own function ['] HandleMessagesEx &CB-MSG ! \ 5. later deinit the Accelerator Table support \ Best place to do is in WM_DESTROY-Message-Handler Destroy-Accelerator-Table \ see AcceleratorTableDemo for a working demo --- NEW FILE: AccelDemo.f --- \ AccelDemo.f June 7th, 2003 - 14:01 dbu \ based on WINDEMO.F March 24th, 1999 - 21:37 \ changed for Win32Forth 6.07.07 September 6th, 2003 - 17:29 dbu \ changed for Win32Forth 6.09.12 Samstag, September 11 2004 dbu \ \ Search for "dbu" to see what's needed for Accelerator-Table-Support \ in your own application. only forth also definitions Require accel.f \ dbu Require button.f defer Init-Accelerator-Table ' noop is Init-Accelerator-Table \ dbu 1280 value screen-mwidth 1024 value screen-mheight 400 to screen-width [...1114 lines suppressed...] \ Top Level program starts here \ --------------------------------------------------------------- : AccelDemo ( -- ) Start: DEMOW StartPos: DEMOW 50 + swap 50 + swap message-origin blue line-color RANDOM-INIT \ initialize random number generator erase-demo begin Refresh: DEMOW key drop \ handle keyboard interpretation \ this is needed because key contains the \ main window message loop !!! again ; AccelDemo \ ' windemo turnkey AccelDemo |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-12 13:38:15
|
Update of /cvsroot/win32forth/win32forth-stc/demos/AccelDemo In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18311/AccelDemo Log Message: Directory /cvsroot/win32forth/win32forth-stc/demos/AccelDemo added to the repository |
|
From: George H. <geo...@us...> - 2007-05-12 10:49:17
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9157/win32forth-stc/src Modified Files: forget.f primutil.f Log Message: gah:made ?turnkeyed work, and fixed bugs in recognising if words are in particular areas. Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** primutil.f 5 May 2007 19:01:05 -0000 1.31 --- primutil.f 12 May 2007 10:49:12 -0000 1.32 *************** *** 60,64 **** in-previous ! false constant turnkeyed? defer "message ' 2drop is "message --- 60,64 ---- in-previous ! : turnkeyed? sys-size 0= ; defer "message ' 2drop is "message Index: forget.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/forget.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** forget.f 24 Apr 2007 09:15:01 -0000 1.3 --- forget.f 12 May 2007 10:49:12 -0000 1.4 *************** *** 53,57 **** \ *G Returns true if addr is between the origin and top of the space represented \ ** by ?dp (adp, cdp, sdp, kdp or any transient space created by the user). ! dup @ swap 2 cells+ @ between ; : (sys-trim?) ( nfa addr -- addr pre-?dp ?dp-top ) --- 53,57 ---- \ *G Returns true if addr is between the origin and top of the space represented \ ** by ?dp (adp, cdp, sdp, kdp or any transient space created by the user). ! dup cell+ @ swap 2 cells+ @ between ; : (sys-trim?) ( nfa addr -- addr pre-?dp ?dp-top ) *************** *** 114,118 **** forget-chain chain-add trim-WinLibs ! : trim-WinProcs dup winproc-link full-trim winproc-link @ winproc-last ! ; --- 114,118 ---- forget-chain chain-add trim-WinLibs ! : trim-WinProcs ( nfa -- nfa ) dup winproc-link full-trim winproc-link @ winproc-last ! ; |
|
From: Dirk B. <db...@us...> - 2007-05-12 07:51:45
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6548/src Modified Files: CALLBACK.f Extend.f editor_io.f Log Message: - Fixed this nasty Win32ForthIDE F12 bug :-) Index: editor_io.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/editor_io.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** editor_io.f 23 Jul 2006 09:39:39 -0000 1.2 --- editor_io.f 12 May 2007 07:51:19 -0000 1.3 *************** *** 171,175 **** : (win-set-break) { wParam lParam \ bp$ -- wParam lParam } wParam lParam ! second-forth? ?EXIT \ ignore messages if second copy MAXSTRING LocalAlloc: bp$ ed-ptr 0= ?EXIT \ exit if no shared memory --- 171,180 ---- : (win-set-break) { wParam lParam \ bp$ -- wParam lParam } wParam lParam ! ! \ This forth instance counting doesn't work well, and I don't understand ! \ what it's realy good for. So I removed the SECOND-FORTH? check to ! \ fix this nasty Win32ForthIDE F12 bug. (Samstag, Mai 12 2007 dbu) ! \ second-forth? ?EXIT \ ignore messages if second copy ! MAXSTRING LocalAlloc: bp$ ed-ptr 0= ?EXIT \ exit if no shared memory Index: CALLBACK.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CALLBACK.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** CALLBACK.f 26 May 2006 12:42:38 -0000 1.8 --- CALLBACK.f 12 May 2007 07:51:19 -0000 1.9 *************** *** 274,279 **** \ ** able to talk to other instances of forth. \ Create a unique message name; we do this to make shure ! \ that the console only talk to WinEd/SciEdit with the ! \ build with the Win32Forth Version. \ using PAD is ok here; because this is called before any --- 274,279 ---- \ ** able to talk to other instances of forth. \ Create a unique message name; we do this to make shure ! \ that the console only talks to WinEd/SciEdit build with the ! \ same Win32Forth Version. \ using PAD is ok here; because this is called before any Index: Extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Extend.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** Extend.f 25 Feb 2007 19:04:53 -0000 1.12 --- Extend.f 12 May 2007 07:51:19 -0000 1.13 *************** *** 125,131 **** THEN ed-ptr 0<> \ if shared memory was inited ! IF ! ed-forth-count @ 1 > IF TRUE to second-forth? THEN --- 125,133 ---- THEN + \ This forth instance counting doesn't work well, and I don't understand + \ what it's realy good for. I think I have to dig my head deeper into this area, + \ to see if it can't be removed completly (Samstag, Mai 12 2007 dbu). ed-ptr 0<> \ if shared memory was inited ! IF ed-forth-count @ 1 > IF TRUE to second-forth? THEN |
|
From: Dirk B. <db...@us...> - 2007-05-12 07:51:45
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6548 Modified Files: fkernel.exe setup.exe Log Message: - Fixed this nasty Win32ForthIDE F12 bug :-) Index: setup.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/setup.exe,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 Binary files /tmp/cvsZutFYi and /tmp/cvsFRfZzn differ Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 Binary files /tmp/cvsf5uEcp and /tmp/cvsXDN7Rt differ |
|
From: Dirk B. <db...@us...> - 2007-05-12 07:51:45
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6548/apps/Win32ForthIDE Modified Files: ClassBrowser.f EdCompile.f Log Message: - Fixed this nasty Win32ForthIDE F12 bug :-) Index: EdCompile.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdCompile.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** EdCompile.f 13 Oct 2006 03:55:11 -0000 1.3 --- EdCompile.f 12 May 2007 07:51:19 -0000 1.4 *************** *** 51,56 **** version# ((version)) Win32ForthName +place Win32ForthName +NULL ! base ! ! ; : GetForthWindow ( -- ) \ get the handle of the forth console window --- 51,55 ---- version# ((version)) Win32ForthName +place Win32ForthName +NULL ! base ! ; : GetForthWindow ( -- ) \ get the handle of the forth console window *************** *** 73,77 **** then ! hWndForthWindow 0<> if \ if we have a valid window handle to the forth console \ we can just send the message directly --- 72,76 ---- then ! hWndForthWindow call IsWindow if \ if we have a valid window handle to the forth console \ we can just send the message directly *************** *** 80,84 **** then ; - \ ----------------------------------------------------------------------------- \ Start the Forth console if needed --- 79,82 ---- Index: ClassBrowser.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ClassBrowser.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** ClassBrowser.f 16 Apr 2007 08:29:05 -0000 1.6 --- ClassBrowser.f 12 May 2007 07:51:19 -0000 1.7 *************** *** 158,161 **** --- 158,163 ---- : AddVocabularies ( -- ) \ add the vocabularies to the treeview + false SetRedraw: self + -1 z" Vocabularies" TVI_LAST TVI_ROOT 1 true AddItem *************** *** 165,169 **** to hRoot ['] sys-addr? AddVoc ! to hRoot ['] app-addr? AddVoc ; --- 167,174 ---- to hRoot ['] sys-addr? AddVoc ! to hRoot ['] app-addr? AddVoc ! ! true SetRedraw: self ! ; *************** *** 209,212 **** --- 214,219 ---- : AddClasses ( -- ) \ add the classes to the treeview + false SetRedraw: self + -1 z" Classes" TVI_LAST TVI_ROOT 1 true AddItem hPrev >R *************** *** 219,223 **** else drop then @ dup 0= ! until drop r>drop ; --- 226,233 ---- else drop then @ dup 0= ! until drop r>drop ! ! true SetRedraw: self ! ; |
|
From: Dirk B. <db...@us...> - 2007-05-12 07:49:30
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6137/src/lib Modified Files: LoadProject.f Log Message: - Some minor changes Index: LoadProject.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/LoadProject.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** LoadProject.f 12 May 2007 05:11:31 -0000 1.4 --- LoadProject.f 12 May 2007 07:49:22 -0000 1.5 *************** *** 3,7 **** Needs src\lib\w_search.f ! IN-APPLICATION map-handle ProjectHndl --- 3,7 ---- Needs src\lib\w_search.f ! IN-SYSTEM map-handle ProjectHndl |
|
From: Dirk B. <db...@us...> - 2007-05-12 07:49:30
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6137/src/console Modified Files: ConsoleMenu.f Log Message: - Some minor changes Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/ConsoleMenu.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** ConsoleMenu.f 25 Feb 2007 19:05:07 -0000 1.9 --- ConsoleMenu.f 12 May 2007 07:49:21 -0000 1.10 *************** *** 115,119 **** if 0= open-web EXIT then over [ K_F12 ] literal = ! if 0= 2>r >r LoadProject r> 2r> EXIT then over [ 'L' +k_control ] literal = if 0= load-forth EXIT then --- 115,119 ---- if 0= open-web EXIT then over [ K_F12 ] literal = ! \in-system-ok if 0= 2>r >r LoadProject r> 2r> EXIT then over [ 'L' +k_control ] literal = if 0= load-forth EXIT then *************** *** 243,247 **** MENULINE "Win32Forth IDE" ".IDE" MENULINE "ForthForm" ".ForthForm" ! MENUITEM "Compile &Project\tF12" LoadProject ; MENUSEPARATOR MENULINE "&Class and Vocabulary browser..." "class-browser" --- 243,247 ---- MENULINE "Win32Forth IDE" ".IDE" MENULINE "ForthForm" ".ForthForm" ! \in-system-ok MENUITEM "Compile &Project\tF12" LoadProject ; MENUSEPARATOR MENULINE "&Class and Vocabulary browser..." "class-browser" |
|
From: Dirk B. <db...@us...> - 2007-05-12 05:11:36
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv11781/src/lib Modified Files: LoadProject.f ScintillaLexer.f Log Message: - Some minor changes Index: LoadProject.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/LoadProject.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** LoadProject.f 10 Mar 2007 13:02:27 -0000 1.3 --- LoadProject.f 12 May 2007 05:11:31 -0000 1.4 *************** *** 3,7 **** Needs src\lib\w_search.f ! IN-SYSTEM map-handle ProjectHndl --- 3,7 ---- Needs src\lib\w_search.f ! IN-APPLICATION map-handle ProjectHndl Index: ScintillaLexer.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ScintillaLexer.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** ScintillaLexer.f 3 Oct 2006 07:44:22 -0000 1.7 --- ScintillaLexer.f 12 May 2007 05:11:31 -0000 1.8 *************** *** 80,84 **** ,{ [ ] } ,{ INCLUDE-FILE INCLUDED $FLOAD FLOAD SYS-FLOAD "FLOAD INCLUDE NEEDS } ! ,{ REQUIRED REQUIRES } ,{ ("LOADED?) "LOADED? LOADED? \LOADED- \LOADED } ,{ FSAVE TURNKEY APPLICATION } --- 80,84 ---- ,{ [ ] } ,{ INCLUDE-FILE INCLUDED $FLOAD FLOAD SYS-FLOAD "FLOAD INCLUDE NEEDS } ! ,{ REQUIRED REQUIRES require } ,{ ("LOADED?) "LOADED? LOADED? \LOADED- \LOADED } ,{ FSAVE TURNKEY APPLICATION } |
|
From: George H. <geo...@us...> - 2007-05-11 13:59:21
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17367/win32forth-stc/src Modified Files: float.f Log Message: gah:changed float-number? to correctly do lower case, as suggested by Tom Dixon Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** float.f 22 Mar 2007 02:11:27 -0000 1.7 --- float.f 11 May 2007 13:59:15 -0000 1.8 *************** *** 2120,2124 **** \ so we add an extra test for the presence of the required letter 'E' in a \ floating point string. ! 2dup 'E' scan nip 0= throw FALSE to float? \ need to initialize to non-floating# >FLOAT 0= throw \ not a float, throw --- 2120,2125 ---- \ so we add an extra test for the presence of the required letter 'E' in a \ floating point string. ! 2dup 'E' scan nip 0= ! if 2dup 'e' scan nip 0= throw then \ take into account lower case FALSE to float? \ need to initialize to non-floating# >FLOAT 0= throw \ not a float, throw |
|
From: George H. <geo...@us...> - 2007-05-11 10:45:21
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8410/win32forth-stc/src Modified Files: Utils.f Log Message: gah:added macro to utils removed timing routines (now in utils.f) from the benchmarks and added dependency. Added dependency to ConsoleMenu Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Utils.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Utils.f 9 May 2007 07:28:44 -0000 1.3 --- Utils.f 11 May 2007 10:45:16 -0000 1.4 *************** *** 805,813 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! (( in-system ! : 2literal ( d1 -- ) ! swap POSTPONE LITERAL POSTPONE LITERAL ; immediate : MACRO ( "name <char> ccc<char>" -- ) --- 805,814 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! in-system ! \ Now in the kernel ! \ : 2literal ( d1 -- ) ! \ swap POSTPONE LITERAL POSTPONE LITERAL ; immediate : MACRO ( "name <char> ccc<char>" -- ) *************** *** 816,820 **** POSTPONE evaluate POSTPONE ; immediate ; ! )) MODULE --- 817,823 ---- POSTPONE evaluate POSTPONE ; immediate ; ! ! in-application ! MODULE |
|
From: George H. <geo...@us...> - 2007-05-11 10:45:21
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8410/win32forth-stc/src/console Modified Files: ConsoleMenu.f Log Message: gah:added macro to utils removed timing routines (now in utils.f) from the benchmarks and added dependency. Added dependency to ConsoleMenu Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ConsoleMenu.f 9 May 2007 15:00:54 -0000 1.2 --- ConsoleMenu.f 11 May 2007 10:45:16 -0000 1.3 *************** *** 2,5 **** --- 2,7 ---- \ ConsoleMenu.F + Require Menu.f + cr .( Loading Console Menus...) |
|
From: George H. <geo...@us...> - 2007-05-11 10:45:20
|
Update of /cvsroot/win32forth/win32forth-stc/demos/benchmarks In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8410/win32forth-stc/demos/benchmarks Modified Files: Testpde.f bench.f Log Message: gah:added macro to utils removed timing routines (now in utils.f) from the benchmarks and added dependency. Added dependency to ConsoleMenu Index: bench.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/demos/benchmarks/bench.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** bench.f 5 Nov 2006 23:34:07 -0000 1.2 --- bench.f 11 May 2007 10:45:15 -0000 1.3 *************** *** 1,96 **** ! \ IN-SYSTEM ! ! create TIME-BUF ! here ! 0 w, \ +0 year ! 0 w, \ +2 month ! 0 w, \ +4 day of week ! 0 w, \ +6 day of month ! 0 w, \ +8 hour ! 0 w, \ +10 minute ! 0 w, \ +12 second ! 0 w, \ +14 milliseconds ! here swap - constant TIME-LEN ! ! create date$ 32 allot ! create time$ 32 allot ! ! : get-local-time ( -- ) \ get the local computer date and time ! time-buf call GetLocalTime drop ; ! ! : time&date ( -- sec min hour day month year ) ! get-local-time ! time-buf 12 + w@ \ seconds ! time-buf 10 + w@ \ minutes ! time-buf 8 + w@ \ hours ! time-buf 6 + w@ \ day of month ! time-buf 2 + w@ \ month of year ! time-buf w@ ; \ year ! ! : .#" ( n1 n2 -- a1 n3 ) ! >r 0 <# r> 0 ?do # loop #> ; ! ! : >date" ( time_structure -- ) ! >r 31 date$ null \ z" ddddd',' MMMM dd yyyy" ! r> null LOCALE_USER_DEFAULT ! call GetDateFormat date$ swap 1- ; ! ! : .date ( -- ) ! get-local-time time-buf >date" type ; ! ! : >month,day,year" ( time_structure -- ) ! >r 31 date$ z" ddddd',' MMMM dd yyyy" ! r> null LOCALE_USER_DEFAULT ! call GetDateFormat date$ swap 1- ; ! ! ! : .month,day,year ( -- ) ! get-local-time time-buf >month,day,year" type ; ! ! : >time" ( time_structure -- ) ! >r 31 time$ null ! r> null LOCALE_USER_DEFAULT ! call GetTimeFormat time$ swap 1- ; ! ! : .time ( -- ) ! get-local-time time-buf >time" type ; ! ! : >am/pm" ( time_structure -- ) ! >r 31 time$ z" h':'mmtt" ! r> null LOCALE_USER_DEFAULT ! call GetTimeFormat time$ swap 1- ; ! ! : .am/pm ( -- ) ! get-local-time time-buf >am/pm" type ; ! ! : ms@ ( -- ms ) ! get-local-time ! time-buf ! dup 8 + w@ 60 * \ hours ! over 10 + w@ + 60 * \ minutes ! over 12 + w@ + 1000 * \ seconds ! swap 14 + w@ + ; \ milli-seconds ! ! 0 value start-time ! ! : time-reset ( -- ) ! ms@ to start-time ; ! ! ' time-reset alias timer-reset ! ! : .elapsed ( -- ) ! ." Elapsed time: " ! ms@ start-time - ! 1000 /mod ! 60 /mod ! 60 /mod 2 .#" type ." :" ! 2 .#" type ." :" ! 2 .#" type ." ." ! 3 .#" type ; ! ! : elapse ( -<commandline>- ) ! time-reset interpret cr .elapsed ; ! false constant specifics \ true to use system dependent code --- 1,4 ---- ! Require utils.f \ Timing routines now in utils.f false constant specifics \ true to use system dependent code *************** *** 283,287 **** : Precedes ( n n - f ) u< ; ! : Exchange ( a1 a2 -- ) 2DUP @ SWAP @ ROT ! SWAP ! ; : Both-Ends ( f l pivot - f l ) --- 191,195 ---- : Precedes ( n n - f ) u< ; ! : Exchange ( a1 a2 -- ) 2DUP @ SWAP @ ROT ! SWAP ! ; : Both-Ends ( f l pivot - f l ) *************** *** 451,455 **** ABORT" File Access Error. " ; ! : read-char \ file -- char drop getnextchar 0= if -1 then ; --- 359,363 ---- ABORT" File Access Error. " ; ! : read-char \ file -- char drop getnextchar 0= if -1 then ; *************** *** 802,814 **** \ -- Control human fatigue factor ! 500000 VALUE LOOPS \ -- Some types ! 1 CONSTANT Ident1 ! 2 CONSTANT Ident2 ! 3 CONSTANT Ident3 ! 4 CONSTANT Ident4 ! 5 CONSTANT Ident5 ! 0 CONSTANT NIL CHAR A CONSTANT 'A' --- 710,722 ---- \ -- Control human fatigue factor ! 500000 VALUE LOOPS \ -- Some types ! 1 CONSTANT Ident1 ! 2 CONSTANT Ident2 ! 3 CONSTANT Ident3 ! 4 CONSTANT Ident4 ! 5 CONSTANT Ident5 ! 0 CONSTANT NIL CHAR A CONSTANT 'A' *************** *** 820,832 **** CHAR Z CONSTANT 'Z' ! CREATE Array1Glob 50 CELLS ALLOT ! CREATE Array2Glob 50 DUP * CELLS ALLOT \ -- Some obvious macro's ! : []Array1Par S" CELLS Array1Par + " EVALUATE ; IMMEDIATE ! : [][]Array2Par S" 50 * + CELLS Array2Par + " EVALUATE ; IMMEDIATE ! : ADDRESS ; IMMEDIATE ! 0 VALUE /bytes : RECORD CREATE 0 TO /bytes HERE 0 , \ ( -- sys ) --- 728,740 ---- CHAR Z CONSTANT 'Z' ! CREATE Array1Glob 50 CELLS ALLOT ! CREATE Array2Glob 50 DUP * CELLS ALLOT \ -- Some obvious macro's ! : []Array1Par S" CELLS Array1Par + " EVALUATE ; IMMEDIATE ! : [][]Array2Par S" 50 * + CELLS Array2Par + " EVALUATE ; IMMEDIATE ! : ADDRESS ; IMMEDIATE ! 0 VALUE /bytes : RECORD CREATE 0 TO /bytes HERE 0 , \ ( -- sys ) *************** *** 836,849 **** : SIMPLE-TYPE CREATE , \ ( fieldlength> -- ) ! DOES> @ CREATE IMMEDIATE /bytes , /bytes + TO /bytes DOES> @ \ ( 'record -- 'offset ) ! S" LITERAL + " EVALUATE ; ! 1 CELLS SIMPLE-TYPE RecordPtr 1 CELLS SIMPLE-TYPE Enumeration \ one of Ident1 .. Ident5 ! 1 CELLS SIMPLE-TYPE OneToFifty 31 CHARS SIMPLE-TYPE String30 \ extra count byte --- 744,757 ---- : SIMPLE-TYPE CREATE , \ ( fieldlength> -- ) ! DOES> @ CREATE IMMEDIATE /bytes , /bytes + TO /bytes DOES> @ \ ( 'record -- 'offset ) ! S" LITERAL + " EVALUATE ; ! 1 CELLS SIMPLE-TYPE RecordPtr 1 CELLS SIMPLE-TYPE Enumeration \ one of Ident1 .. Ident5 ! 1 CELLS SIMPLE-TYPE OneToFifty 31 CHARS SIMPLE-TYPE String30 \ extra count byte *************** *** 854,868 **** OneToFifty IntComp \ 3 CELLS String30 StringComp \ 4 CELLS ! END \ -- Some global variables ! 0 VALUE IntGlob ! 0 VALUE BoolGlob ! 0 VALUE Char1Glob ! 0 VALUE Char2Glob ! 0 VALUE p^ NIL VALUE PtrGlb ! NIL VALUE PtrGlbNext : Proc7 S" + 2 + " EVALUATE ; IMMEDIATE \ ( n1 n2 -- n3 ) --- 762,776 ---- OneToFifty IntComp \ 3 CELLS String30 StringComp \ 4 CELLS ! END \ -- Some global variables ! 0 VALUE IntGlob ! 0 VALUE BoolGlob ! 0 VALUE Char1Glob ! 0 VALUE Char2Glob ! 0 VALUE p^ NIL VALUE PtrGlb ! NIL VALUE PtrGlbNext : Proc7 S" + 2 + " EVALUATE ; IMMEDIATE \ ( n1 n2 -- n3 ) *************** *** 872,878 **** ELSE DROP 100 TO IntGlob THEN ! 10 IntGlob Proc7 PtrGlb IntComp ! ; ! : Func3 S" Ident3 = " EVALUATE ; IMMEDIATE : Proc6 ( n1 n2 -- n ) --- 780,786 ---- ELSE DROP 100 TO IntGlob THEN ! 10 IntGlob Proc7 PtrGlb IntComp ! ; ! : Func3 S" Ident3 = " EVALUATE ; IMMEDIATE : Proc6 ( n1 n2 -- n ) *************** *** 883,887 **** Ident2 OF IntGlob 100 > IF Ident1 ! ELSE Ident4 THEN ENDOF Ident3 OF Ident2 ENDOF --- 791,795 ---- Ident2 OF IntGlob 100 > IF Ident1 ! ELSE Ident4 THEN ENDOF Ident3 OF Ident2 ENDOF *************** *** 889,896 **** Ident5 OF Ident3 ENDOF ABORT" Proc6: argument out of range" ! ENDCASE ; : Proc1 ( 'record -- ) ! TO p^ PtrGlb p^ PtrComp ! 5 p^ IntComp ! --- 797,804 ---- Ident5 OF Ident3 ENDOF ABORT" Proc6: argument out of range" ! ENDCASE ; : Proc1 ( 'record -- ) ! TO p^ PtrGlb p^ PtrComp ! 5 p^ IntComp ! *************** *** 904,908 **** p^ PtrComp @ IntComp DUP @ 10 Proc7 SWAP ! ELSE p^ PtrComp @ p^ ! ! THEN ; : Proc2 ( val -- val' ) --- 812,816 ---- p^ PtrComp @ IntComp DUP @ 10 Proc7 SWAP ! ELSE p^ PtrComp @ p^ ! ! THEN ; : Proc2 ( val -- val' ) *************** *** 910,919 **** BEGIN Char1Glob 'A' = \ This one never ends WHILE IntLoc 1- TO IntLoc \ unless Char = 'A' ?? ! DROP IntLoc IntGlob - TRUE UNTIL THEN ; ! : Proc4 S" 'B' TO Char2Glob " EVALUATE ; IMMEDIATE ! : Proc5 S" 'A' TO Char1Glob FALSE TO BoolGlob " EVALUATE ; IMMEDIATE : Proc8 ( 'array1 'array2 n1 n2 -- ) --- 818,827 ---- BEGIN Char1Glob 'A' = \ This one never ends WHILE IntLoc 1- TO IntLoc \ unless Char = 'A' ?? ! DROP IntLoc IntGlob - TRUE UNTIL THEN ; ! : Proc4 S" 'B' TO Char2Glob " EVALUATE ; IMMEDIATE ! : Proc5 S" 'A' TO Char1Glob FALSE TO BoolGlob " EVALUATE ; IMMEDIATE : Proc8 ( 'array1 'array2 n1 n2 -- ) *************** *** 962,966 **** 0 0 0 \ The following must be on ONE line or Win32Forth will crash. ! LOCALS| CharIndex CharLoc EnumLoc IntLoc3 IntLoc2 IntLoc1 String2Loc String1Loc | RecordType TO PtrGlb \ constructor, allocates ! --- 870,874 ---- 0 0 0 \ The following must be on ONE line or Win32Forth will crash. ! LOCALS| CharIndex CharLoc EnumLoc IntLoc3 IntLoc2 IntLoc1 String2Loc String1Loc | RecordType TO PtrGlb \ constructor, allocates ! *************** *** 970,987 **** Ident3 PtrGlb EnumComp ! 40 PtrGlb IntComp ! ! C" DHRYSTONE PROGRAM, SOME STRING" DUP C@ 1+ PtrGlb StringComp SWAP MOVE ! LOOPS 0 DO ! Proc5 Proc4 2 TO IntLoc1 3 TO IntLoc2 ! C" DHRYSTONE PROGRAM, 2'ND STRING" DUP C@ 1+ String2Loc SWAP MOVE Ident2 TO EnumLoc ! String1Loc String2Loc Func2 INVERT TO BoolGlob ! BEGIN IntLoc1 IntLoc2 < ! WHILE IntLoc1 5 * IntLoc2 - TO IntLoc3 IntLoc1 IntLoc2 Proc7 TO IntLoc3 \ The Forth way --- 878,895 ---- Ident3 PtrGlb EnumComp ! 40 PtrGlb IntComp ! ! C" DHRYSTONE PROGRAM, SOME STRING" DUP C@ 1+ PtrGlb StringComp SWAP MOVE ! LOOPS 0 DO ! Proc5 Proc4 2 TO IntLoc1 3 TO IntLoc2 ! C" DHRYSTONE PROGRAM, 2'ND STRING" DUP C@ 1+ String2Loc SWAP MOVE Ident2 TO EnumLoc ! String1Loc String2Loc Func2 INVERT TO BoolGlob ! BEGIN IntLoc1 IntLoc2 < ! WHILE IntLoc1 5 * IntLoc2 - TO IntLoc3 IntLoc1 IntLoc2 Proc7 TO IntLoc3 \ The Forth way *************** *** 989,1004 **** REPEAT ! ADDRESS Array1Glob ADDRESS Array2Glob IntLoc1 IntLoc2 Proc8 PtrGlb Proc1 'A' TO CharIndex ! BEGIN CharIndex Char2Glob <= ! WHILE CharIndex 'C' Func1 EnumLoc = IF Ident1 EnumLoc Proc6 TO EnumLoc THEN ! CharIndex 1+ TO CharIndex REPEAT --- 897,912 ---- REPEAT ! ADDRESS Array1Glob ADDRESS Array2Glob IntLoc1 IntLoc2 Proc8 PtrGlb Proc1 'A' TO CharIndex ! BEGIN CharIndex Char2Glob <= ! WHILE CharIndex 'C' Func1 EnumLoc = IF Ident1 EnumLoc Proc6 TO EnumLoc THEN ! CharIndex 1+ TO CharIndex REPEAT *************** *** 1007,1015 **** IntLoc3 IntLoc2 - 7 * IntLoc1 - TO IntLoc2 IntLoc1 Proc2 TO IntLoc1 \ the Forth way ! LOOP PtrGlb FREE THROW PtrGlbNext FREE THROW String1Loc FREE THROW ! String2Loc FREE THROW ; : $DHRY$ \ -- --- 915,923 ---- IntLoc3 IntLoc2 - 7 * IntLoc1 - TO IntLoc2 IntLoc1 Proc2 TO IntLoc1 \ the Forth way ! LOOP PtrGlb FREE THROW PtrGlbNext FREE THROW String1Loc FREE THROW ! String2Loc FREE THROW ; : $DHRY$ \ -- *************** *** 1058,1062 **** .ann ." This system's primitives" .specifics cr .header ! [$ $DO$ $+$ $M+$ --- 966,970 ---- .ann ." This system's primitives" .specifics cr .header ! [$ $DO$ $+$ $M+$ *************** *** 1077,1081 **** .ann ." This system's application performance" .specifics CR .header ! [$ $SIEVE$ $FIB$ $SORT$ $RAND$ $CODE77$ $DHRY$ \ [ ANSSYSTEM ] [IF] $DHRY$ [THEN] --- 985,989 ---- .ann ." This system's application performance" .specifics CR .header ! [$ $SIEVE$ $FIB$ $SORT$ $RAND$ $CODE77$ $DHRY$ \ [ ANSSYSTEM ] [IF] $DHRY$ [THEN] Index: Testpde.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/demos/benchmarks/Testpde.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Testpde.f 1 Oct 2006 07:38:44 -0000 1.1 --- Testpde.f 11 May 2007 10:45:15 -0000 1.2 *************** *** 2,103 **** only forth also definitions decimal ! \ defined b/float nip 0= [if] 8 constant b/float [then] ! ! \ needs stc/float ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Timing Routines \ ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! create TIME-BUF ! here ! 0 w, \ +0 year ! 0 w, \ +2 month ! 0 w, \ +4 day of week ! 0 w, \ +6 day of month ! 0 w, \ +8 hour ! 0 w, \ +10 minute ! 0 w, \ +12 second ! 0 w, \ +14 milliseconds ! here swap - constant TIME-LEN ! ! create date$ 32 allot ! create time$ 32 allot ! ! : get-local-time ( -- ) \ get the local computer date and time ! time-buf call GetLocalTime drop ; ! ! : time&date ( -- sec min hour day month year ) ! get-local-time ! time-buf 12 + w@ \ seconds ! time-buf 10 + w@ \ minutes ! time-buf 8 + w@ \ hours ! time-buf 6 + w@ \ day of month ! time-buf 2 + w@ \ month of year ! time-buf w@ ; \ year ! ! : .#" ( n1 n2 -- a1 n3 ) ! >r 0 <# r> 0 ?do # loop #> ; ! ! : >date" ( time_structure -- ) ! >r 31 date$ null \ z" ddddd',' MMMM dd yyyy" ! r> null LOCALE_USER_DEFAULT ! call GetDateFormat date$ swap 1- ; ! ! : .date ( -- ) ! get-local-time time-buf >date" type ; ! ! : >month,day,year" ( time_structure -- ) ! >r 31 date$ z" ddddd',' MMMM dd yyyy" ! r> null LOCALE_USER_DEFAULT ! call GetDateFormat date$ swap 1- ; ! ! ! : .month,day,year ( -- ) ! get-local-time time-buf >month,day,year" type ; ! ! : >time" ( time_structure -- ) ! >r 31 time$ null ! r> null LOCALE_USER_DEFAULT ! call GetTimeFormat time$ swap 1- ; ! ! : .time ( -- ) ! get-local-time time-buf >time" type ; ! ! : >am/pm" ( time_structure -- ) ! >r 31 time$ z" h':'mmtt" ! r> null LOCALE_USER_DEFAULT ! call GetTimeFormat time$ swap 1- ; ! ! : .am/pm ( -- ) ! get-local-time time-buf >am/pm" type ; ! ! : ms@ ( -- ms ) ! get-local-time ! time-buf ! dup 8 + w@ 60 * \ hours ! over 10 + w@ + 60 * \ minutes ! over 12 + w@ + 1000 * \ seconds ! swap 14 + w@ + ; \ milli-seconds ! ! 0 value start-time ! ! : time-reset ( -- ) ! ms@ to start-time ; ! ! ' time-reset alias timer-reset ! ! : .elapsed ( -- ) ! ." Elapsed time: " ! ms@ start-time - ! 1000 /mod ! 60 /mod ! 60 /mod 2 .#" type ." :" ! 2 .#" type ." :" ! 2 .#" type ." ." ! 3 .#" type ; ! ! : elapse ( -<commandline>- ) ! time-reset interpret cr .elapsed ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 2,6 ---- only forth also definitions decimal ! require utils.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 105,112 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - : ROLL ( n1 n2 .. nk k -- n2 n3 .. nk n1 ) - \ Rotate k values on the stack, bringing the deepest to the top. - DUP>R PICK SP@ DUP CELL+ R> CELLS CELL+ MOVE DROP ; - code k ( -- n ) mov -4 [ebp], eax --- 8,11 ---- |
|
From: George H. <geo...@us...> - 2007-05-11 09:15:50
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6678/win32forth Modified Files: fkernel.exe Log Message: gah:new kernel with rdrop Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.38 retrieving revision 1.39 diff -C2 -d -r1.38 -r1.39 Binary files /tmp/cvsFV7Tvm and /tmp/cvsxzwZ2C differ |
|
From: Alex M. <ale...@us...> - 2007-05-10 06:28:20
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21126 Modified Files: dis486.f Log Message: arm: correct 3 addr form of imul (opcode 69/6B) disassembly error Index: dis486.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** dis486.f 2 May 2007 05:53:57 -0000 1.18 --- dis486.f 10 May 2007 06:28:16 -0000 1.19 *************** *** 76,80 **** 0 value dis.16bit \ start in 32 bit mode 0 value dis.base-addr \ no offset by default ! 0 value dis.size \ size of data in opcode 0 value dis.data16 \ 16 bit data 0 value dis.addr16 \ 16 bit address --- 76,80 ---- 0 value dis.16bit \ start in 32 bit mode 0 value dis.base-addr \ no offset by default ! 0 value dis.size \ size of data in opcode (false=8bit reg, true=16/32bit reg) 0 value dis.data16 \ 16 bit data 0 value dis.addr16 \ 16 bit address *************** *** 477,483 **** : bnd ( addr op -- addr' ) .sop" bound" drop 1 to dis.size r,r/m ; : arp ( addr op -- addr' ) .sop" arpl" drop true to dis.data16 1 to dis.size r,r/m ; ! : mli ( addr op -- addr' ) 1 to dis.size ! .sop" imul" swap r,r/m ., bit1 if .imm8 else .imm16/32 then ; \ -------------------- Jumps and Calls -------------------- --- 477,483 ---- : bnd ( addr op -- addr' ) .sop" bound" drop 1 to dis.size r,r/m ; : arp ( addr op -- addr' ) .sop" arpl" drop true to dis.data16 1 to dis.size r,r/m ; ! : mli ( addr op -- addr' ) \ 3 addr form of imul 1 to dis.size ! .sop" imul" swap r,r/m ., swap bit1 if .imm8 else .imm16/32 then ; \ -------------------- Jumps and Calls -------------------- |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-09 15:00:58
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14592 Modified Files: ConsoleMenu.f Log Message: Jos: Activated already defined display menus. Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ConsoleMenu.f 9 May 2007 12:11:40 -0000 1.1 --- ConsoleMenu.f 9 May 2007 15:00:54 -0000 1.2 *************** *** 214,217 **** --- 214,218 ---- MENUSEPARATOR MENUITEM "&Mark all Text \tCtrl+A" mark-all ; + )) POPUP "&Display" *************** *** 222,229 **** MENULINE "Console Current Size \tGetColRow . ." "GetColRow . ." MENULINE "Console Maximum Size \tGetMaxColRow . ." "GetMaxColRow . ." ! MENULINE "Return Stack Contents \t.RSTACK" ".RSTACK" MENULINE "Memory Used and Available \t.FREE" ".FREE" MENULINE "File Search Path \t.FPATH" ".FPATH" ENDSUBMENU SUBMENU "Vocabulary Functions" MENULINE "Words in Current Vocabulary \tWORDS" "WORDS" --- 223,232 ---- MENULINE "Console Current Size \tGetColRow . ." "GetColRow . ." MENULINE "Console Maximum Size \tGetMaxColRow . ." "GetMaxColRow . ." ! \ MENULINE "Return Stack Contents \t.RSTACK" ".RSTACK" MENULINE "Memory Used and Available \t.FREE" ".FREE" MENULINE "File Search Path \t.FPATH" ".FPATH" ENDSUBMENU + + (( SUBMENU "Vocabulary Functions" MENULINE "Words in Current Vocabulary \tWORDS" "WORDS" *************** *** 231,242 **** MENULINE "Current Vocab Thread Counts \t.COUNTS" ".COUNTS" MENULINE "Current Vocab Thread Words \t.THREADS" ".THREADS" ! ENDSUBMENU SUBMENU "List Functions" ! MENULINE "List of Classes in Win32Forth \t.CLASSES" ".CLASSES" ! MENULINE "List of Loaded Files \t.LOADED" ".LOADED" ! MENULINE "List of Fonts in System \t.FONTS" ".FONTS" ! MENULINE "List of Deferred &Word \t.DEFERRED" ".DEFERRED" ! MENULINE "List of Execution Chains \t.CHAINS" ".CHAINS" ! MENULINE "List of Pointers \t.POINTERS" ".POINTERS" MENULINE "List of Dynamic Memory Used \t.MALLOCS" ".MALLOCS" MENULINE "List of Win32API Calls Used \t.PROCS" ".PROCS" --- 234,246 ---- MENULINE "Current Vocab Thread Counts \t.COUNTS" ".COUNTS" MENULINE "Current Vocab Thread Words \t.THREADS" ".THREADS" ! ENDSUBMENU )) ! SUBMENU "List Functions" ! \ MENULINE "List of Classes in Win32Forth \t.CLASSES" ".CLASSES" ! \ MENULINE "List of Loaded Files \t.LOADED" ".LOADED" ! \ MENULINE "List of Fonts in System \t.FONTS" ".FONTS" ! \ MENULINE "List of Deferred &Word \t.DEFERRED" ".DEFERRED" ! \ MENULINE "List of Execution Chains \t.CHAINS" ".CHAINS" ! \ MENULINE "List of Pointers \t.POINTERS" ".POINTERS" MENULINE "List of Dynamic Memory Used \t.MALLOCS" ".MALLOCS" MENULINE "List of Win32API Calls Used \t.PROCS" ".PROCS" *************** *** 246,249 **** --- 250,254 ---- MENULINE "The Current &Time \t.TIME" ".TIME" ENDSUBMENU + (( POPUP "&Tools" |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-09 13:20:28
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7212 Modified Files: gkernel.exe Log Message: Jos: This kernel has the missing _interpret needed for ConsoleStatbar.f Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.42 retrieving revision 1.43 diff -C2 -d -r1.42 -r1.43 Binary files /tmp/cvsbugITy and /tmp/cvsd30mua differ |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-09 12:58:45
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31048 Modified Files: ConsoleStatbar.f Log Message: Jos: Enabled it in the reset-stack-chain again. Index: ConsoleStatbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleStatbar.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ConsoleStatbar.f 9 May 2007 12:12:52 -0000 1.2 --- ConsoleStatbar.f 9 May 2007 12:58:41 -0000 1.3 *************** *** 131,136 **** \in-system-ok if Update-Console-Statusbar then ; ! \ reset-stack-chain chain-add CONSOLE-STATUSBAR-RESET-STACKS \ Orginal ! INITIALIZATION-CHAIN chain-add CONSOLE-STATUSBAR-RESET-STACKS INTERNAL --- 131,136 ---- \in-system-ok if Update-Console-Statusbar then ; ! INITIALIZATION-CHAIN chain-add CONSOLE-STATUSBAR-RESET-STACKS ! reset-stack-chain chain-add CONSOLE-STATUSBAR-RESET-STACKS INTERNAL |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-09 12:14:49
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv13553 Modified Files: extend.f Log Message: Jos: Adapted for the console-menu and menubar. Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** extend.f 24 Apr 2007 09:25:52 -0000 1.18 --- extend.f 9 May 2007 12:14:08 -0000 1.19 *************** *** 30,37 **** --- 30,50 ---- FLOAD src\console\keyboard.f \ function and special key constants FLOAD src\console\lineedit.f \ a line editor utility + FLOAD src\ansfile.f \ ansi file words FLOAD src\registry.f \ Win32 Registry support FLOAD src\primhash.f \ primitive hash functions for OOP later *** to be done *** FLOAD src\class.f \ ***** Object Oriented Programming Support ***** + sys-FLOAD src\console\ConsoleStatBar.f \ status bar for the console window + FLOAD src\console\forthdlg.f + fload src\xfiledlg.f \ xcall replacements for open dialogs + FLOAD src\console\ConsoleMenu.f + + : Temp-HELLO { \ doing-app? -- } \ startup stuff till anything works + (boot) + only forth also definitions + initialization-chain do-chain + ; + + \in-system-ok ' Temp-HELLO is boot here fence ! mark empty \ Prevent forgetting anything before this *************** *** 69,73 **** FLOAD src\colors.f FLOAD src\fonts.f \ font class - fload src\xfiledlg.f \ xcall replacements for open dialogs FLOAD src\PrintSupport.f \ replacement for the w32fPrint.dll FLOAD src\dc.f \ device context class --- 82,85 ---- *************** *** 80,89 **** FLOAD src\button.f FLOAD src\dialog.f - FLOAD src\console\forthdlg.f FLOAD src\keysave.f FLOAD src\lib\BROWSEFLD.F \ SHBrowseForFolder() support - FLOAD src\menu.f - FLOAD src\console\ConsoleMenu.f - sys-FLOAD src\console\ConsoleStatBar.f \ status bar for the console window \ sys-Fload src\xref.f \ Cross reference all words used by the word in question --- 92,97 ---- |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-09 12:13:22
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12844 Modified Files: ConsoleStatbar.f Log Message: Jos: Minor change to enable it after a boot. Index: ConsoleStatbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleStatbar.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ConsoleStatbar.f 8 May 2007 08:08:44 -0000 1.1 --- ConsoleStatbar.f 9 May 2007 12:12:52 -0000 1.2 *************** *** 131,135 **** \in-system-ok if Update-Console-Statusbar then ; ! reset-stack-chain chain-add CONSOLE-STATUSBAR-RESET-STACKS INTERNAL --- 131,136 ---- \in-system-ok if Update-Console-Statusbar then ; ! \ reset-stack-chain chain-add CONSOLE-STATUSBAR-RESET-STACKS \ Orginal ! INITIALIZATION-CHAIN chain-add CONSOLE-STATUSBAR-RESET-STACKS INTERNAL *************** *** 174,178 **** then ; ! m_init_cons : M_INIT-CONSOLE ( -- f ) --- 175,179 ---- then ; ! \ m_init_cons : M_INIT-CONSOLE ( -- f ) |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-09 12:11:51
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12450 Added Files: ConsoleMenu.f Log Message: Jos: Enabled the compile menu only to save us a lot of type-work. --- NEW FILE: ConsoleMenu.f --- \ $Id: ConsoleMenu.f,v 1.1 2007/05/09 12:11:40 jos_ven Exp $ \ ConsoleMenu.F cr .( Loading Console Menus...) only forth also definitions in-application INTERNAL \ internal definitions start here \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ FileOpenDialog LoadForth "Load Forth File" "Forth Files (*.f)|*.f|All Files (*.*)|*.*|" FileOpenDialog EditForth "Edit Forth File" "Forth Files (*.f)|*.f|Text Files (*.txt)|*.txt|All Files (*.*)|*.*|" FileOpenDialog PrintForth "Print Forth File" "Forth Files (*.f)|*.f|Text Files (*.txt)|*.txt|All Files (*.*)|*.*|" FileSaveDialog SaveForth "Save Forth Image" "Image Files (*.exe)|*.exe|All Files (*.*)|*.*|" FileOpenDialog EditLog "Edit Key Log File" "Log Files (*.LOG)|*.LOG|Text Files (*.txt)|*.txt|All Files (*.*)|*.*|" NewEditDialog HtmlDlg "Open Web Page Address" "Page (WWW. and .COM optional):" "Open" "" "" (( : edit-forth ( -- ) \ edit a forth file conhndl start: EditForth dup c@ IF count pocket place 0 pocket $edit ELSE drop THEN ; )) \ changed to work with blanks in file name \ January 31st, 2004 - 20:38 dbu : load-forth ( -- ) conhndl start: LoadForth dup c@ IF count pocket place s" FLOAD '" "pushkeys pocket count "pushkeys s" '" "pushkeys 0x0D pushkey ELSE drop THEN ; (( : print-forth ( -- ) \ print a forth file conhndl start: PrintForth dup c@ IF count pocket place #pages-up ?dup IF 2 = IF two-page ELSE four-page THEN pocket $fprint single-page ELSE pocket $fprint THEN ELSE drop THEN ; : edit-log ( -- ) \ edit a macro file conhndl start: EditLog dup c@ IF count pocket place 0 pocket $edit ELSE drop THEN ; : adjust-forth ( -- ) \ show help on how to change the dictionary size 1 c" ADJFORTH.TXT" $browse ; : save-forth ( -- ) \ save a new Forth image turnkeyed? ?exit conhndl start: SaveForth dup c@ \in-system-ok if count "fsave else drop then ; : open-web { \ web$ -- } MAXSTRING LocalAlloc: web$ web$ off web$ conhndl Start: HtmlDlg IF web$ count conhndl "Web-Link THEN ; : ChdirDlg { \ path$ -- } \ set current directory MAXSTRING LocalAlloc: path$ current-dir$ count path$ place z" Choose the current directory" path$ conhndl BrowseForFolder \in-system-ok if path$ dup +null count "chdir .dir cr then ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Function key additions to the keyboard interpreter during commandline entry \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : F2-help ( -- ) \ F2 starts up the initial help file s" doc\p-getstart.htm" conhndl "file-link ; : F1-doc ( -- ) \ F1 starts up the documentation s" doc\p-index.htm" conhndl "file-link ; : ?f1-help ( char flag -- char flag ) dup ?exit \ exit if flag is TRUE over k_F2 = if 0= F2-help then over k_F1 = if 0= F1-doc then ; ledit-chain chain-add ?f1-help \ help key recognition : ?macro-keys ( chad flag -- char flag ) dup ?exit over [ 'S' +k_control +k_shift ] literal = if 0= start/stop-macro EXIT then over [ 'M' +k_control +k_shift ] literal = if 0= replay-macro EXIT then over [ 'R' +k_control +k_shift ] literal = if 0= CONHNDL repeat-amacro EXIT then over [ 'O' +k_control ] literal = if 0= edit-forth EXIT then over [ 'W' +k_control ] literal = if 0= open-web EXIT then over [ K_F12 ] literal = if 0= 2>r >r LoadProject r> 2r> EXIT then over [ 'L' +k_control ] literal = if 0= load-forth EXIT then over [ 'P' +k_control ] literal = if 0= print-screen EXIT then over [ 'X' +k_control ] literal = if 0= cut-console [DEFINED] ledit-y [IF] getxy nip to ledit-y [THEN] EXIT then over [ 'A' +k_control ] literal = if 0= mark-all EXIT then over [ 'C' +k_control ] literal = if 0= copy-console EXIT then over [ 'V' +k_control ] literal = if 0= paste-load EXIT then turnkeyed? ?exit over [ 'D' +k_control ] literal = if 0= ChdirDlg EXIT then ; ledit-chain chain-add ?macro-keys \ add macro key recognition \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ INTERNAL \ internal definitions start here \ \ |Class MENUCONSOLE <Super MENUITEM \ Only for use with the console window \ \ :M DoMenu: ( IDM -- ) \ mid = \ if mfunc execute-menufunc \ cr \ [DEFINED] ledit-y [IF] getxy to ledit-y to ledit-x \ move lineeditor down \ [THEN] then ;M \ \ ;Class )) EXTERNAL MENUBAR Win32Forth-Menu-bar \ Note: If you add a new menu entry with a shortcut, you must add \ add the handling of the shortcut to ?MACRO-KEYS !!! POPUP "&File" \ MENUITEM "&Edit Forth File...\tCtrl+O" edit-forth ; MENUITEM "&Load Forth File...\tCtrl+L" load-forth ; (( MENUSEPARATOR MENUITEM "Set current directory...\tCtrl+D" ChdirDlg ; MENUSEPARATOR MENUITEM "Open a Web link...\tCtrl+W" open-web ; MENUSEPARATOR MENUCONSOLE "&Save Forth System..." save-forth ; MENUCONSOLE "&Adjust Forth Dictionaries..." adjust-forth ; MENUSEPARATOR \ ***************************************************************************** \ ***************************************************************************** \ ******** The following lines are for example ONLY, they show how to use sub \ ******** menus, the code will not run, so don't un-comment it out. \ ***************************************************************************** \ ***************************************************************************** \ SUBMENU "Keyboard &Macros" \ MENUITEM "&New Key Macro Recording..." a-new-log ; \ MENUITEM "&Stop Key Macro Recording" logging-off ; \ MENUSEPARATOR \ MENUITEM "&Edit Key Macro Log File..." edit-log ; \ MENUITEM "&Play Key Macro Log File..." play-log ; \ \ ******** SUBMENUs can even be nested as many levels as you wish! ********* \ \ SUBMENU "Keyboard Macros" \ \ MENUITEM "Edit Key Log File" edit-log ; \ \ MENUITEM "Play Key Log File" play-log ; \ \ ENDSUBMENU \ ENDSUBMENU \ MENUSEPARATOR MENUITEM "Print Setup... " page-setup ; MENUITEM "Pages Up Setup..." page-up-setup ; MENUITEM "&Print Forth File..." print-forth ; MENUITEM "Print Forth Console Window...\tCtrl+P" print-screen ; MENUITEM "Print Forth Console Buffer..." print-console ; MENUSEPARATOR MENUCONSOLE "E&xit Win32Forth \tBYE" bye ; POPUP "&Edit" MENUITEM "&Cut and Clear Console \tCtrl+X" cut-console ; MENUITEM "&Copy Highlighted Text \tCtrl+C" copy-console ; MENUITEM "&Paste to Keyboard \tCtrl+V" paste-load ; MENUSEPARATOR MENUITEM "&Mark all Text \tCtrl+A" mark-all ; POPUP "&Display" SUBMENU "System Functions" MENULINE "This Programs Name \t.PROGRAM" ".PROGRAM" MENULINE "Version of Win32Forth \t.VERSION" ".VERSION" MENULINE "Operating System Version \t.PLATFORM" ".PLATFORM" MENULINE "Console Current Size \tGetColRow . ." "GetColRow . ." MENULINE "Console Maximum Size \tGetMaxColRow . ." "GetMaxColRow . ." MENULINE "Return Stack Contents \t.RSTACK" ".RSTACK" MENULINE "Memory Used and Available \t.FREE" ".FREE" MENULINE "File Search Path \t.FPATH" ".FPATH" ENDSUBMENU SUBMENU "Vocabulary Functions" MENULINE "Words in Current Vocabulary \tWORDS" "WORDS" MENULINE "All Vocabulary Statistics \tVOCS" "VOCS" MENULINE "Current Vocab Thread Counts \t.COUNTS" ".COUNTS" MENULINE "Current Vocab Thread Words \t.THREADS" ".THREADS" ENDSUBMENU SUBMENU "List Functions" MENULINE "List of Classes in Win32Forth \t.CLASSES" ".CLASSES" MENULINE "List of Loaded Files \t.LOADED" ".LOADED" MENULINE "List of Fonts in System \t.FONTS" ".FONTS" MENULINE "List of Deferred &Word \t.DEFERRED" ".DEFERRED" MENULINE "List of Execution Chains \t.CHAINS" ".CHAINS" MENULINE "List of Pointers \t.POINTERS" ".POINTERS" MENULINE "List of Dynamic Memory Used \t.MALLOCS" ".MALLOCS" MENULINE "List of Win32API Calls Used \t.PROCS" ".PROCS" ENDSUBMENU SUBMENU "Time and Date Functions" MENULINE "Todays &Date \t.DATE" ".DATE" MENULINE "The Current &Time \t.TIME" ".TIME" ENDSUBMENU POPUP "&Tools" MENULINE "Win32Forth IDE" ".IDE" MENULINE "ForthForm" ".ForthForm" MENUITEM "Compile &Project\tF12" LoadProject ; MENUSEPARATOR MENULINE "&Class and Vocabulary browser..." "class-browser" MENULINE "&Help System" "help-system" MENULINE "Cross &reference lister" "xref" MENULINE "&Dex - Document Extractor" "dexh" MENULINE "Dump Top-Level-&Windows" ".Windows" POPUP "&Macros" MENUITEM "&New Key Recording File..." con-new-macro ; MENUITEM "&Start - Stop Key Recording \tCtrl+Shft+S" start/stop-macro ; MENUITEM "&Edit Key Macro Log File..." edit-log ; MENUSEPARATOR MENUITEM "&Play Key File" con-play-macro ; MENUITEM "RePlay &Last Key File \tCtrl+Shft+M" replay-macro ; MENUITEM "&Repeat Key File 'n' times..\tCtrl+Shft+R" conhndl repeat-amacro ; POPUP "&Help" MENUITEM "Win32Forth &Documentation\tF1" F1-doc ; MENUITEM "&Help me get Started!\tF2" F2-help ; MENUITEM "Win32Forth &FAQ" s" doc\p-faq.htm" conhndl "file-link ; MENULINE "&Utilities in Win32Forth" "BROWSE doc\UTILDOC.TXT" MENUITEM "&Assembler Documentation" s" doc\p-486asm.htm" conhndl "file-link ; MENUSEPARATOR MENUITEM "ANS Forth &Standard" s" doc\dpans\DPANS.HTM" conhndl "file-link ; MENUITEM "ANS Forth &Word List" s" doc\dpans\DPANSF.HTM" conhndl "file-link ; MENUITEM "Win32&Forth ANS Documentation" s" doc\p-ansi.htm" conhndl "file-link ; MENUSEPARATOR SUBMENU "Web Based Resources" MENUITEM "Win32Forth Project Group" s" http://www.win32forth.org/" conhndl "Web-Link ; MENUITEM "Win32Forth Forum" s" http://groups.yahoo.com/group/win32forth/" conhndl "Web-Link ; SUBMENU "Forth Interest Group" MENUITEM "FIG US" s" http://www.forth.org/" conhndl "Web-Link ; MENUITEM "FIG UK" s" http://www.fig-uk.org/" conhndl "Web-Link ; MENUITEM "FIG Russia" s" http://www.forth.org.ru/" conhndl "Web-Link ; MENUITEM "FIG Taiwan" s" http://www.figtaiwan.org/" conhndl "Web-Link ; MENUITEM "Dutch Forth Users Group" s" http://www.forth.hccnet.nl/homegb.htm" conhndl "Web-Link ; MENUITEM "German FORTH-Gesellschaft" s" http://www.forth-ev.de/" conhndl "Web-Link ; ENDSUBMENU SUBMENU "Forth Usenet Groups" MENUITEM "comp.lang.forth \tGeneral Forth" s" news:comp.lang.forth" conhndl "Web-Link ; MENUITEM "comp.lang.forth.mac\tMacintosh Specific" s" news:comp.lang.forth.mac" conhndl "Web-Link ; MENUITEM "de.comp.lang.forth \tGerman Language" s" news:de.comp.lang.forth" conhndl "Web-Link ; ENDSUBMENU SUBMENU "comp.lang.forth FAQ's" MENUITEM "General Information" s" http://www.faqs.org/faqs/computer-lang/forth-faq/part1/" conhndl "Web-Link ; MENUITEM "Online Resources" s" http://www.faqs.org/faqs/computer-lang/forth-faq/part2/" conhndl "Web-Link ; MENUITEM "Vendors & Authors" s" http://www.faqs.org/faqs/computer-lang/forth-faq/part3/" conhndl "Web-Link ; MENUITEM "Forth Systems" s" http://www.faqs.org/faqs/computer-lang/forth-faq/part4/" conhndl "Web-Link ; MENUITEM "Books & Periodicals" s" http://www.faqs.org/faqs/computer-lang/forth-faq/part5/" conhndl "Web-Link ; MENUITEM "Groups & Organizations" s" http://www.faqs.org/faqs/computer-lang/forth-faq/part6/" conhndl "Web-Link ; ENDSUBMENU ENDSUBMENU MENUSEPARATOR MENUITEM "&About Win32Forth" about-Win32Forth ; )) ENDBAR \ these two lines illustrate how to make a popup that runs code \ POPUPITEM "WORDS" words ; \ BREAKPOPUP \ force start of a new menu line \ POPUPITEM "DUMPHERE" here 32 dump ; \ Note: The :MENUITEM hplmc above creates a named menu item that can be \ later checked or unchecked with the following commands: \ \ true Check: hlpmc \ turn on the items check mark \ false Check: hlpmc \ clear the items check mark \ \ The Enable: method can also be sued in the same way as follows: \ \ true Enable: hlpmc \ Enable the item \ false Enable: hlpmc \ Disable the item Win32Forth-menu-bar value console-menu \ the default Forth console menu (( POPUPBAR Win32Forth-Popup-bar POPUP " " MENUITEM "&Copy Highlighted Text \tCtrl+C" copy-console ; MENUITEM "&Paste to Keyboard \tCtrl+V" paste-load ; MENUSEPARATOR MENUITEM "&Mark all Text \tCtrl+A" mark-all ; MENUSEPARATOR MENUCONSOLE "Exit" bye ; ENDBAR Win32Forth-Popup-bar value console-popup )) INTERNAL \ more internal definitions : menukey ( -- c1 ) \ keyboard/event handler for console menus cursorinview BEGIN _mkey dup menu_mask and WHILE havemenu? IF 0xFFFF and dup DoMenu: console-menu \ dup DoMenu: console-popup THEN drop REPEAT ( menukey-more ) ; : menu-forth-io ( -- ) ['] menukey is key ; FORTH-IO-CHAIN CHAIN-ADD MENU-FORTH-IO menu-forth-io (( : RightMouseClick ( -- ) \ Handle a right mouse click mouseflags 3 and 2 <> ?EXIT \ exit if not right mouse clicked mousex mousey conhndl Track: console-popup ; MOUSE-CHAIN CHAIN-ADD RightMouseClick )) : Start-console-menu { \ mlink -- } \ startup the console's menubar menubar-link @ \ clear all menu handles begin dup while dup cell+ @ to mlink ZeroMenu: mlink @ repeat drop true havemenu! ZeroMenu: console-menu conhndl loadmenu: console-menu menuhandle: console-menu conhndl call SetMenu havemenu! \ ZeroMenu: console-popup \ conhndl loadmenu: console-popup ; INITIALIZATION-CHAIN CHAIN-ADD START-CONSOLE-MENU Start-console-menu EXTERNAL MODULE \s : Menu-off ( -- ) \ turn off the console's menubar false havemenu! 0 conhndl call SetMenu 0= havemenu! ; : Set-console-menu ( menubar -- ) \ switch to a new console menubar menu-off to console-menu start-console-menu ; : Set-console-popup ( menubar -- ) \ switch to a new console popup to console-popup ; MODULE \ end of the module |
|
From: George H. <geo...@us...> - 2007-05-09 07:46:43
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5664/win32forth/src Modified Files: CHILDWND.F CONTROL.F CONTROLS.F WINMSG.F Log Message: gah:added dependencies plus bugfix for child windows Index: CONTROLS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROLS.F,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** CONTROLS.F 6 Feb 2006 17:48:17 -0000 1.9 --- CONTROLS.F 9 May 2007 07:46:40 -0000 1.10 *************** *** 18,21 **** --- 18,23 ---- \ *T Controls -- Classes for standard windows controls. + Require Control.f + cr .( Loading Low Level Controls...) Index: WINMSG.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/WINMSG.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** WINMSG.F 27 Jan 2006 10:10:25 -0000 1.4 --- WINMSG.F 9 May 2007 07:46:40 -0000 1.5 *************** *** 3,6 **** --- 3,8 ---- \ WINMSG.F Windows Message Window Class by Tom Zimmer + Require window.f + cr .( Loading Message Window...) Index: CONTROL.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CONTROL.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** CONTROL.F 8 Nov 2006 11:11:24 -0000 1.8 --- CONTROL.F 9 May 2007 07:46:40 -0000 1.9 *************** *** 5,8 **** --- 5,10 ---- \ *T Control -- Class for child controls with subclassing. + Require WinMsg.f + cr .( Loading Control Window...) *************** *** 123,127 **** ?dup if r@ WndProcError ! then r>drop r> sp0 ! else --- 125,129 ---- ?dup if r@ WndProcError ! then rdrop r> sp0 ! else Index: CHILDWND.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** CHILDWND.F 16 Apr 2007 08:29:05 -0000 1.10 --- CHILDWND.F 9 May 2007 07:46:40 -0000 1.11 *************** *** 33,37 **** :M SetParent: ( parent -- ) \ *G Set the object address of the parent window. ! Parent ;M :M GetParent: ( -- parent ) --- 33,37 ---- :M SetParent: ( parent -- ) \ *G Set the object address of the parent window. ! to Parent ;M :M GetParent: ( -- parent ) |
|
From: George H. <geo...@us...> - 2007-05-09 07:46:43
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5664/win32forth/src/lib Modified Files: Calendar.f Log Message: gah:added dependencies plus bugfix for child windows Index: Calendar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Calendar.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Calendar.f 21 Feb 2007 09:59:29 -0000 1.5 --- Calendar.f 9 May 2007 07:46:40 -0000 1.6 *************** *** 6,9 **** --- 6,11 ---- anew -Calendar.f + Require control.f + WinLibrary COMCTL32.DLL |
|
From: George H. <geo...@us...> - 2007-05-09 07:41:25
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv3683/win32forth/demos Added Files: CalendarDemo.f Log Message: gah:added new demo --- NEW FILE: CalendarDemo.f --- \ $Id: CalendarDemo.f,v 1.1 2007/05/09 07:41:22 georgeahubert Exp $ \ Simple calendar G.Hubert Tuesday, May 08 2007 Require calendar.f anew -CalendarDemo :Object DemoWindow <super window MonthCalendar MyCalendar :m On_Init: ( -- ) self Start: MyCalendar AutoSize: MyCalendar ;m \ Make Calendar fill window :M MinSize: ( -- width height ) MinSize: MyCalendar ;m \ Limit minimum size to 1 month :m On_Size: ( -- ) AutoSize: MyCalendar ;m \ Resize Calendar to window ;object : Demo ( -- ) Start: DemoWindow ; : Undemo ( -- ) Close: DemoWindow ; Demo |
|
From: George H. <geo...@us...> - 2007-05-09 07:37:07
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv1588/win32forth-stc/demos Added Files: CalendarDemo.f Log Message: gah:added new demo --- NEW FILE: CalendarDemo.f --- \ $Id: CalendarDemo.f,v 1.1 2007/05/09 07:37:04 georgeahubert Exp $ \ Simple calendar G.Hubert Tuesday, May 08 2007 Require calendar.f anew -CalendarDemo :Object DemoWindow <super window MonthCalendar MyCalendar :m On_Init: ( -- ) self Start: MyCalendar AutoSize: MyCalendar ;m \ Make Calendar fill window :M MinSize: ( -- width height ) MinSize: MyCalendar ;m \ Limit minimum size to 1 month :m On_Size: ( -- ) AutoSize: MyCalendar ;m \ Resize Calendar to window ;object : Demo ( -- ) Start: DemoWindow ; : Undemo ( -- ) Close: DemoWindow ; Demo |
1040 messages has been excluded from this view by a project administrator.
