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-20 15:36:24
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19025 Modified Files: ConsoleMenu.f Log Message: Jos: Enabled more list menu's Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** ConsoleMenu.f 20 May 2007 15:11:37 -0000 1.6 --- ConsoleMenu.f 20 May 2007 15:36:21 -0000 1.7 *************** *** 305,312 **** 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" --- 305,312 ---- 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" |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-20 15:34:51
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18177 Modified Files: Utils.f words.f Log Message: Jos: Enabled .loaded Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Utils.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Utils.f 20 May 2007 15:09:15 -0000 1.5 --- Utils.f 20 May 2007 15:34:47 -0000 1.6 *************** *** 78,91 **** \ 7 Display the files loaded into the system \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ also hidden ! \ ! \ : .loaded ( -- ) ! \ also files ! \ screendelay 0 to screendelay ! \ false to with-tabs? ! \ _words ! \ previous to screendelay ; ! \ previous \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 78,91 ---- \ 7 Display the files loaded into the system \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + (( + also hidden ! : .loaded ( -- ) ! also files ! screendelay 0 to screendelay ! \ false to with-tabs? ! _words ! previous to screendelay ; ! previous )) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Index: words.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/words.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** words.f 19 May 2007 10:12:28 -0000 1.1 --- words.f 20 May 2007 15:34:47 -0000 1.2 *************** *** 182,185 **** --- 182,192 ---- EXTERNAL + : .loaded ( -- ) + also files + screendelay 0 to screendelay + false to with-tabs? + _words + previous to screendelay ; + : WORDS ( -<optional_name>- ) \ WORDS partial-string will focus the list true to with-tabs? _words ; |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-20 15:11:41
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9018 Modified Files: ConsoleMenu.f Log Message: Jos: Enabled the menu of .classes Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** ConsoleMenu.f 19 May 2007 10:14:00 -0000 1.5 --- ConsoleMenu.f 20 May 2007 15:11:37 -0000 1.6 *************** *** 304,308 **** 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" --- 304,308 ---- 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" |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-20 15:09:19
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7994 Modified Files: Class.f Utils.f dthread.f Log Message: Jos: Enabled .classes and moved voc>vcfa and name> Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Utils.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Utils.f 11 May 2007 10:45:16 -0000 1.4 --- Utils.f 20 May 2007 15:09:15 -0000 1.5 *************** *** 22,26 **** 260 constant max-handle ! ' name>xt alias name> Library Shell32.dll --- 22,26 ---- 260 constant max-handle ! Library Shell32.dll Index: dthread.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/dthread.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** dthread.f 19 May 2007 10:12:28 -0000 1.1 --- dthread.f 20 May 2007 15:09:15 -0000 1.2 *************** *** 4,8 **** cr .( Loading Hash Thread Display...) - synonym voc>vcfa voc>vxt@ synonym l>name link>name ' count alias nfa-count --- 4,7 ---- Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Class.f 13 May 2007 22:13:26 -0000 1.7 --- Class.f 20 May 2007 15:09:13 -0000 1.8 *************** *** 1603,1608 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ IN-SYSTEM ! (( : .CLASSES ( -- ) \ W32F Class \ *G Display all classes in the system. --- 1603,1611 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + synonym voc>vcfa voc>vxt@ + synonym name> name>xt + IN-SYSTEM ! : .CLASSES ( -- ) \ W32F Class \ *G Display all classes in the system. *************** *** 1612,1617 **** BEGIN dup vlink>voc voc>vcfa dup ?isClass ! IF dup >name name> ! ['] [UNKNOWN] = \ if not found IF drop \ then discard the class ELSE .name --- 1615,1620 ---- 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 *************** *** 1622,1626 **** @ dup 0= UNTIL drop ; ! )) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ return xt of method --- 1625,1629 ---- @ dup 0= UNTIL drop ; ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ return xt of method |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-20 11:05:33
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv13446 Modified Files: primutil.f Log Message: Jos: Changed ?isClass to get rid of objects like about-forth-dialog from the vocabularie list, when VOCS is used. Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** primutil.f 13 May 2007 21:39:26 -0000 1.33 --- primutil.f 20 May 2007 11:05:27 -0000 1.34 *************** *** 155,161 **** in-application ! : ?isClass ( cfa -- f ) >name n>tfa c@ dup tCla = ! swap t|Cl = or ; defer \n->crlf --- 155,163 ---- in-application ! : ?isClass ( cfa -- f ) >name n>tfa c@ dup tCla = ! over t|Cl = or ! swap tobj = or ! ; defer \n->crlf |
|
From: George H. <geo...@us...> - 2007-05-19 13:51:14
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21930/win32forth/demos Added Files: MSCALcontrol.f Log Message: gah:added demo --- NEW FILE: MSCALcontrol.f --- \ MSCAL.Calendar ActiveX control example \ Thomas Dixon \ 7/11/2006 anew -MSCALControl.f needs AXControl :CLASS MSCALControl <SUPER AXControl CELL bytes MSCAL \ pointer to Dispatch Interface :M Start: ( Parent -- ) Start: super s" MSCAL.Calendar" AXCreate: self MSCAL IDispatch QueryInterface: self abort" Unable to get the Dispatch Interface!" ;M :M On_Done: ( -- ) MSCAL @ if MSCAL COM IDispatch IReleaseref drop 0 MSCAL ! then ;M :M Today: ( -- ) \ selects the current date MSCAL displate" Today" drop ;M :M GetDay: ( -- day ) \ get the selected day MSCAL displate" GetDay" drop retvt@ drop ;M :M GetMonth: ( -- month ) \ get the selected month MSCAL displate" GetMonth" drop retvt@ drop ;M :M GetYear: ( -- year ) \ get the selected year MSCAL displate" GetYear" drop retvt@ drop ;M :M SetDay: ( day -- ) VT_I2 >vt MSCAL displate" PutDay" drop ;M :M SetMonth: ( month -- ) VT_I2 >vt MSCAL displate" PutMonth" drop ;M :M SetYear: ( year -- ) VT_I2 >vt MSCAL displate" PutYear" drop ;M :M Refresh: ( -- ) MSCAL displate" Refresh" drop ;M :M Aboutbox: ( -- ) MSCAL displate" AboutBox" drop ;M ;CLASS \ Example: window win start: win mscalcontrol cal win start: cal autosize: cal |
|
From: George H. <geo...@us...> - 2007-05-19 13:49:49
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21142/win32forth-stc/demos Added Files: MSCALcontrol.f Log Message: gah:added demo --- NEW FILE: MSCALcontrol.f --- \ MSCAL.Calendar ActiveX control example \ Thomas Dixon \ 7/11/2006 anew -MSCALControl.f needs AXControl :CLASS MSCALControl <SUPER AXControl CELL bytes MSCAL \ pointer to Dispatch Interface :M Start: ( Parent -- ) Start: super s" MSCAL.Calendar" AXCreate: self MSCAL IDispatch QueryInterface: self abort" Unable to get the Dispatch Interface!" ;M :M On_Done: ( -- ) MSCAL @ if MSCAL COM IDispatch IReleaseref drop 0 MSCAL ! then ;M :M Today: ( -- ) \ selects the current date MSCAL displate" Today" drop ;M :M GetDay: ( -- day ) \ get the selected day MSCAL displate" GetDay" drop retvt@ drop ;M :M GetMonth: ( -- month ) \ get the selected month MSCAL displate" GetMonth" drop retvt@ drop ;M :M GetYear: ( -- year ) \ get the selected year MSCAL displate" GetYear" drop retvt@ drop ;M :M SetDay: ( day -- ) VT_I2 >vt MSCAL displate" PutDay" drop ;M :M SetMonth: ( month -- ) VT_I2 >vt MSCAL displate" PutMonth" drop ;M :M SetYear: ( year -- ) VT_I2 >vt MSCAL displate" PutYear" drop ;M :M Refresh: ( -- ) MSCAL displate" Refresh" drop ;M :M Aboutbox: ( -- ) MSCAL displate" AboutBox" drop ;M ;CLASS \ Example: window win start: win mscalcontrol cal win start: cal autosize: cal |
|
From: Hooper J. C. <nu...@de...> - 2007-05-19 13:48:27
|
GPSI Announces Market Attack Into $1 Trillion Market! Global Payment Solutions Symbol: GPSI Price: $0.03 GPSI announced its plans to address the huge influx of immigrant workers into the US that need banking solutions that they otherwise would not qualify for. This market is expected to represent over $1 Trillion dollars to be managed by 2008. GPSI provides viable solutions to this market. This is hot, read the news and watch for more Monday! Get on GPSI first thing Monday! A Persistence Example To illustrate using generics with Java Persistence, let's looks at a simple Java Persistence example. About the Authors Sean Brydon is an engineer with Sun Microsystems where he is the technical lead for the Java BluePrints program. It then caches the data. Pet Store's mashup with the Google Maps service is a client-side mashup. " Integrating other technologies with GlassFish also went well. Notice too that the geoCode method does the following: Identifies the URL of the Yahoo Maps geocoding service. Recall that Pet Store uses the Yahoo Maps Geocoding service together with the Google Maps service to display a map of pet locations. An Example of a Proxy-Style Mashup The Pet Store mashup with the Yahoo Maps Geocoding service is an example of a mashup that uses the proxy style. After data is retrieved from the live RSS feed on the Java Blueprints project site, the server side of the Pet Store application parses the RSS XML document and converts it to JSON. You can find the answers at the end of the quiz. In this tip you'll learn how to refactor applications to use generics. The Yahoo Maps Geocoding service does precisely that: It converts each address to a longitude and latitude. For example, if the page containing the XMLHttpRequest is loaded from mySite. It handles all of the details of how relational data is mapped to Java objects, and it standardizes object-relational mapping. |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-19 11:19:06
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29788 Modified Files: Tracer.f Log Message: Jos: Added also an output example for the STC version of Win32Forth. Index: Tracer.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/lib/Tracer.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Tracer.f 17 May 2007 13:25:27 -0000 1.1 --- Tracer.f 19 May 2007 11:18:51 -0000 1.2 *************** *** 123,127 **** demo-tracer abort ! \s Enter the number trace points you like to see after the T>>. --- 123,167 ---- demo-tracer abort ! ! \s Output examples: ! ! \ In the STC-version of Win32Forth you see: ! ! Enter the number trace points you like to see after the T>>. ! Negative input skips the number of trace points. 0 aborts. ! ! 19-5-2007 13:12:29. Used Win32Forth: ! version: 0.02.05 build: 767 ! ! TRON TRACING T>> 99 ! ! TROFF - [empty] ! Put trace in the definition to activate the tracer. ! Troff sets the tracer off, tron puts it on. ! i/o executed stack ! | | | ! \|/ \|/ \|/ ! ! TRON \ tron - [empty] ! \ literal - [1] 3 ! \ literal - [2] 3 0 ! \ do - [empty] ! \ i - [1] 0 ! 0 \ . - [empty] ! \ do - [empty] ! \ i - [1] 1 ! 1 \ . - [empty] ! \ do - [empty] ! \ i - [1] 2 ! 2 \ . - [empty] ! \ loop - [empty] ! ! \ cr - [empty] ! End of demo. \ ." - [empty] ! ; \ .unnest - [empty] ! ! ! \ In the ITC-version of Win32Forth you see: ! Enter the number trace points you like to see after the T>>. |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-19 10:14:03
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6503 Modified Files: ConsoleMenu.f Log Message: Jos: Run extend.bat to see the new functions for words and threads.. Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** ConsoleMenu.f 19 May 2007 09:50:32 -0000 1.4 --- ConsoleMenu.f 19 May 2007 10:14:00 -0000 1.5 *************** *** 295,299 **** ENDSUBMENU ! (( SUBMENU "Vocabulary Functions" MENULINE "Words in Current Vocabulary \tWORDS" "WORDS" --- 295,299 ---- ENDSUBMENU ! SUBMENU "Vocabulary Functions" MENULINE "Words in Current Vocabulary \tWORDS" "WORDS" *************** *** 301,305 **** MENULINE "Current Vocab Thread Counts \t.COUNTS" ".COUNTS" MENULINE "Current Vocab Thread Words \t.THREADS" ".THREADS" ! ENDSUBMENU )) SUBMENU "List Functions" --- 301,305 ---- MENULINE "Current Vocab Thread Counts \t.COUNTS" ".COUNTS" MENULINE "Current Vocab Thread Words \t.THREADS" ".THREADS" ! ENDSUBMENU SUBMENU "List Functions" |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-19 10:12:32
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6104 Modified Files: extend.f Added Files: dthread.f words.f Log Message: Jos: Enabled the display of words and threads. --- NEW FILE: dthread.f --- \ $Id: dthread.f,v 1.1 2007/05/19 10:12:28 jos_ven Exp $ \ DTHREAD.F Display the Threads by Tom Zimmer cr .( Loading Hash Thread Display...) synonym voc>vcfa voc>vxt@ synonym l>name link>name ' count alias nfa-count : link> ( link -- cfa ) link>name name>xt ; 0 value words-cnt 0 value app-cnt \ count of application dictionary words 0 value header-cnt : count-voc ( voc -- ) dup voc#threads >r dup voc>vcfa ?isclass not \ don't look through classes if r@ 0 do dup i cells + begin @ ?dup while 1 +to words-cnt dup link> here u< if 1 +to app-cnt then dup l>name c@ 1+ 2 cells+ +to header-cnt repeat start/stop loop then drop r>drop ; : count-words ( -- n1 ) 0 to words-cnt 0 to app-cnt 0 to header-cnt voc-link begin @ ?dup while dup vlink>voc count-voc repeat words-cnt ; : .1thread { voc-thread \ thread-depth -- } 0 to thread-depth voc-thread begin ?dup while dup l>name dup nfa-count nip 5 + ?cr .id @ 1 +to thread-depth start/stop repeat cr ." Thread depth: " thread-depth . cr ; : 1tcount { voc-thread \ thread-depth -- n1 } \ get thread depth of voc thread 0 to thread-depth voc-thread begin @ ?dup while 1 +to thread-depth start/stop repeat thread-depth ; : .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 r> min 0max cells+ @ .1thread ; : .threads ( -- ) context @ dup voc>vcfa >name cr ." Vocabulary: " .id dup voc#threads 0 do cr ." Thread: " i . cr dup i cells + @ .1thread start/stop loop drop ; : .counts { \ #thread-over -- } 0 to words-cnt 0 to app-cnt 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 getxy drop 12 < over voc#threads I 1+ = over 0= and if cr then getcolrow drop 12 < or ?leave loop dup voc#threads 0 do 13 ?line ." " i 3 .r ." :" dup i cells + 1tcount dup words-cnt context @ voc#threads / > if 1 +to #thread-over then 3 .r 3 spaces start/stop loop drop cr ." Vocabulary words: " words-cnt . ." Words over average: " #thread-over 100 * context @ voc#threads / 1 .r ." %" cr ." Total system words: " count-words . ; Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** extend.f 13 May 2007 21:39:26 -0000 1.20 --- extend.f 19 May 2007 10:12:28 -0000 1.21 *************** *** 39,42 **** --- 39,44 ---- FLOAD src\console\forthdlg.f fload src\xfiledlg.f \ xcall replacements for open dialogs + sys-FLOAD src\words.f + FLOAD src\console\ConsoleMenu.f --- NEW FILE: words.f --- \ $Id: words.f,v 1.1 2007/05/19 10:12:28 jos_ven Exp $ cr .( Loading WORDS...) only forth also definitions in-system Require Dthread.f \ display words from one or two patterns : horizontal-line ( -- ) getcolrow drop getxy drop - 8 - 0max 8 /mod 0 ?do ." --------" loop s" --------" drop swap type cr ; INTERNAL \ internal definitions start here variable vocsave create words-pocket MAXSTRING allot : .voc-once ( -- ) vocsave @ ?dup if cr ." ----------- " .NAME horizontal-line vocsave off then ; : match? ( addr len -- f ) 2dup >r >r words-pocket count search nip nip pocket c@ if r> r> pocket count search nip nip and else r> r> 2drop then words-pocket c@ 0= or ; 0 value with-address? true value with-tabs? : (words) { voc \ words-pad$ w#threads -- } 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 words-pad$ ?uppercase count match? if .voc-once with-address? if 2 pick link> dup here u> if ." +" else space then ." 0x" h.8 ." " 30 else 20 then -rot type with-tabs? if dup #tab space ?cr else drop cr then 1 +to words-cnt start/stop screendelay ms \ slow down screen output else 2drop then @ swap ! repeat 2drop else drop then vocsave off ; \ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ \ ++++++++++++ display windows constants containing adr,len ++++++++++++++ \ ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ \ enum constants \ int wcEnumWin32Constants(char* addr, int len, CALLBACKPROC* proc) \ int callback(char* addr, int len, int value) 0 value constant-cnt 0 value constant-tot 3 CALLBACK: .WinConstantCount ( abs_adr len value -- f ) 3drop 1 +to constant-tot 1 ; 3 CALLBACK: .WinConstant ( abs_adr len value -- f ) drop \ discard the constant's value 2dup match? if type 20 #tab space 20 ?cr 1 +to constant-cnt else 2drop then nuf? 0= ; (( : count-constants ( -- n1 ) \ count the constants available to system constant-tot 0= \ only count if not counted... if WinConPtr proc>cfa @ dodefer = \ Leave if 'wcFindWin32Constant' if 0 EXIT then \ hasn't already been resolved &.WinConstantCount 0 here CALL wcEnumWin32Constants DROP then constant-tot ; )) EXTERNAL : VOCS ( -- ) \ display vocabularies cr ." Vocabularies #Threads #Words #Average" 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 0 to header-cnt count-voc words-cnt dup 9 .r 10 * r> / 10 .r.1 cr ELSE DROP THEN @ DUP 0= UNTIL DROP ." -----------------------------------------" cr ." Total System Words: " count-words 11 .r cr ; : .words ( -- ) count-words dup cr app-cnt dup 6 u,.r - ." Words in Application dictionary" cr 6 u,.r ." Words in System dictionary" cr 6 u,.r ." Words total in dictionaries" ( cr count-constants 6 u,.r ." Windows Constants available") ; (( : CONSTANTS ( -<optional_name>- ) cr 0 to constant-cnt WinConPtr proc>cfa @ dodefer = \ Leave if 'wcFindWin32Constant' if ." WINCON.DLL missing" EXIT then \ hasn't already been resolved cr ." ----------- Windows Constants " horizontal-line bl word ?uppercase count words-pocket place bl word ?uppercase drop &.WinConstant 0 here CALL wcEnumWin32Constants DROP cr horizontal-line cr ." Displayed " constant-cnt . ." of the " count-constants . ." Windows Constants in the system." ; )) : with-address ( -- ) true to with-address? ; INTERNAL : _WORDS ( -<optional_name>- ) \ WORDS partial-string will focus the list 0 to words-cnt words-pocket off bl word ?uppercase c@ if pocket count words-pocket place bl word ?uppercase drop voc-link @ begin dup vlink>voc ( #threads cells - ) ['] (words) catch if cr ." Interrupted!" drop TRUE \ stop now else @ dup 0= then until drop else context @ ['] (words) catch if drop cr ." Interrupted!" then then 0 to with-address? base @ >r decimal cr horizontal-line ." Displayed " words-cnt . ." of the " count-words . ." words in the system." cr ." ** Use: WORDS <substring> to limit the list **" cr ." ** Use: CONSTANTS <substring> to display Windows Constants **" cr ." See also .loaded .deferred .file .fonts .free and more" r> base ! ; EXTERNAL : WORDS ( -<optional_name>- ) \ WORDS partial-string will focus the list true to with-tabs? _words ; (( : on-allwords { theCFA \ vocBuf -- } 512 cells LocalAlloc: vocBuf voc-link @ 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 if vocBuf r@ cells move \ copy vocabulary up begin vocBuf r@ largest dup while dup l>name theCFA execute @ swap ! repeat 2drop else drop then r>drop @ dup 0= until drop ; )) in-application MODULE \ end of the module |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-19 09:50:35
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30048 Modified Files: ConsoleMenu.f Log Message: Jos: Enabled copy-console to avoid typo's Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ConsoleMenu.f 11 May 2007 10:45:16 -0000 1.3 --- ConsoleMenu.f 19 May 2007 09:50:32 -0000 1.4 *************** *** 12,15 **** --- 12,81 ---- INTERNAL \ internal definitions start here + : copy-console { \ gblhndl gblptr b/l l/s len -- } + \ *G Copy text to Windows clipboard + marked? 0= + if beep EXIT + then + conhndl call OpenClipboard 0= + if beep + else getmaxcolrow to l/s \ lines per screen (really total) + to b/l \ bytes per line + b/l 2 + l/s * 2 cells + \ max buffer size needed + GMEM_MOVEABLE GMEM_DDESHARE or \ flags + call GlobalAlloc to gblhndl \ allocate a buffer + gblhndl call GlobalLock to gblptr \ lock memory + + getxy nip getrowoff + l/s min to l/s \ adjust to lines needed + 0 to len + + l/s 0 + ?do i mkstlin mkedlin between \ if its a line we want + if i mkstlin = + if i b/l * &the-screen + + i mkedlin = + if b/l -trailing mkedcol min + mkstcol /string >r + gblptr len + r@ move \ append text + r> +to len \ adjust length + else b/l mkstcol /string -trailing >r + gblptr len + r@ move \ append text + r> +to len \ adjust length + crlf$ count \ srlf string + gblptr len + swap move \ append crlf + 2 +to len \ adjust length + then + else i mkedlin = + if i b/l * &the-screen + + mkedcol b/l min -trailing >r + gblptr len + r@ move \ append text + r> +to len \ adjust length + else i b/l * &the-screen + \ the line + b/l -trailing >r \ remove extra spaces + gblptr len + r@ move \ append text + r> +to len \ adjust length + crlf$ count \ srlf string + gblptr len + swap move \ append crlf + 2 +to len \ adjust length + then + then + then + loop gblptr len + off \ null terminate buffer + + gblhndl call GlobalUnlock drop \ unlock the buffer + call EmptyClipboard ?win-error \ clear out the clipboard + \ pass to windows + gblhndl CF_TEXT call SetClipboardData ?win-error + call CloseClipboard ?win-error + then ; + + : cut-console ( -- ) + \ *G Cut the complete text from the console window to the clipboard. + marked? + if beep + else mark-all + copy-console + cls + then ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 209,220 **** 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" --- 275,285 ---- 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" |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-19 09:10:13
|
Update of /cvsroot/win32forth/win32forth/demos/COM In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14332 Modified Files: EX_DDRAW.F Log Message: Jos: Changed CoCreateInstance as Thomas Dixon hinted. Index: EX_DDRAW.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/COM/EX_DDRAW.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** EX_DDRAW.F 18 Sep 2005 11:10:30 -0000 1.2 --- EX_DDRAW.F 19 May 2007 09:10:07 -0000 1.3 *************** *** 29,33 **** : setup-ddraw ( -- ) ! dx7 IDirectx7 1 0 Directx7 CoCreateInstance abort" Unable to get Directx!" dd7 0 dx7 DirectDrawCreate abort" DirectDrawCreate failed!" 16 480 640 full-screen \ set screen resolutuion (use window-mode to work from a window) --- 29,33 ---- : setup-ddraw ( -- ) ! dx7 IDirectx7 1 0 Directx7 Call CoCreateInstance abort" Unable to get Directx!" dd7 0 dx7 DirectDrawCreate abort" DirectDrawCreate failed!" 16 480 640 full-screen \ set screen resolutuion (use window-mode to work from a window) |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-19 09:09:24
|
Update of /cvsroot/win32forth/win32forth-stc/demos/COM In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14251 Modified Files: EX_DDRAW.F Log Message: Jos: Canged CoCreateInstance as Thomas Dixon hinted. Index: EX_DDRAW.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/demos/COM/EX_DDRAW.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EX_DDRAW.F 16 May 2007 20:35:42 -0000 1.1 --- EX_DDRAW.F 19 May 2007 09:09:20 -0000 1.2 *************** *** 29,33 **** : setup-ddraw ( -- ) ! dx7 IDirectx7 1 0 Directx7 CoCreateInstance abort" Unable to get Directx!" dd7 0 dx7 DirectDrawCreate abort" DirectDrawCreate failed!" 16 480 640 full-screen \ set screen resolutuion (use window-mode to work from a window) --- 29,33 ---- : setup-ddraw ( -- ) ! dx7 IDirectx7 1 0 Directx7 Call CoCreateInstance abort" Unable to get Directx!" dd7 0 dx7 DirectDrawCreate abort" DirectDrawCreate failed!" 16 480 640 full-screen \ set screen resolutuion (use window-mode to work from a window) |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-17 19:06:55
|
Update of /cvsroot/win32forth/win32forth-stc/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14644 Added Files: Forth_Primer.pdf Log Message: Jos: Needed for the PdfControlDemo.f --- NEW FILE: Forth_Primer.pdf --- (This appears to be a binary file; contents omitted.) |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-17 13:25:31
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18665 Added Files: Tracer.f Log Message: Jos: A high level Forth-tracer for Win32Forth ( ITC/STC) --- NEW FILE: Tracer.f --- \ A high level Forth-tracer for Win32Forth ( ITC/STC) \ Ported from Gem-Forth by Jos v.d.Ven \ Still to solve: \ - floating point numbers \ - IO redirection when used in the future. anew -Tracer.f cr .( Loading Tracer.f ) variable tron? \ Tracer on/off/abort variable #traces \ Number of traces to see or not defined n>bfa nip not [IF] \ Assumes the STC version of Win32Forth : immediate? ( cfa - flag ) drop true ; \ Solved by >ct-exec [THEN] defined n>bfa nip [IF] \ Assumes the ITC version of Win32Forth : 1+! ( adr - ) 1 swap +! ; : immediate? ( cfa - flag ) >name n>bfa c@ 128 and ; : >ct-exec ( cfa - ) execute ; [THEN] create accepted$ maxstring allot : accept$ ( -- adr count ) \ Accept a line of input from the user accepted$ dup maxstring accept ; : input ( - n flag ) accept$ (number?) nip ; \ User input for a number : (tr) tron? @ if #traces @ 0< if #traces 1+! #traces @ 0< \ No trace-output when #traces is < 0 if drop exit \ Drop the CFA indicator then else -1 #traces +! then tab ." \ " >name count type \in-system-ok tab ." - " .s tab cr #traces @ 0= \ Ask a new value when #traces = 0 if ." T>> " input over and if #traces ! else abort \ 0 aborts tracing then then else drop \ Drop the CFA indicator then ; : tron ( - ) cr ." TRON " 1 tron? ! ; \ Tracer ON : troff ( - ) \in-system-ok cr ." TROFF " ." - " .s cr 0 tron? ! ; \ Tracer OFF : tracer ( - ) \ Activates the tracer cr .date space .time ." . Used Win32Forth:" .version cr \ To show what was used. tron 3 spaces ." TRACING T>> " input over and if cr #traces ! else abort then ; create ?; ," ;" : FindNextWord ( - str ) \ From the sourcefile begin bl word dup count 0= while 2drop refill drop repeat drop ; : .Unnest ." ;" ; \ End of word marker \in-system-ok : [Compile]Literal ( n - ) [compile] literal ; \ Trace compiles the word to be executed, followed by its CFA as a literal and (tr) \ in the definition after the word trace. : trace ( - ) compile tracer \ Activates the tracer in run-time begin FindNextWord dup count ?; count compare 0<> while find \ Word defined? if dup immediate? if dup>r >ct-exec r> \ execute immediate words on a clean stack else dup compile, \ compile word to execute then else count (number?) drop d>s [Compile]Literal \ Compile numbers ['] Literal \ To compile LITERAL as an indicator for (tr) then [Compile]Literal \ Compile CFA as literal as an indicator for (tr) compile (tr) \ Compile (tr) repeat drop compile .Unnest \ Compile an extra indication at the end. ['] .Unnest [Compile]Literal compile (tr) ['] ; execute \ Compiles ; and resumes normal compilation ; immediate \s \ Test section: (( : test trace do i . loop ; \ see test 3 0 test abort )) : demo-tracer ( - ) cr cr ." Enter the number trace points you like to see after the T>>." cr ." Negative input skips the number of trace points. 0 aborts." cr trace troff ." Put trace in the definition to activate the tracer." cr ." Troff sets the tracer off, tron puts it on." cr ." i/o executed stack " cr ." | | |" cr ." \|/ \|/ \|/" cr tron 3 0 do i . loop cr ." End of demo." ; demo-tracer abort \s Enter the number trace points you like to see after the T>>. Negative input skips the number of trace points. 0 aborts. 17-5-2007 14:55:24. Used Win32Forth: Version: 6.11.10 Build: 27 TRON TRACING T>> 99 TROFF - empty Put trace in the definition to activate the tracer. Troff sets the tracer off, tron puts it on. i/o executed stack | | | \|/ \|/ \|/ TRON \ TRON - empty \ LITERAL - [1] 3 \ 0 - [2] 3 0 \ DO - empty \ I - [1] 0 0 \ . - empty \ DO - empty \ I - [1] 1 1 \ . - empty \ DO - empty \ I - [1] 2 2 \ . - empty \ LOOP - empty \ CR - empty End of demo. \ ." - empty ; \ .UNNEST - empty \s |
|
From: Dirk B. <db...@us...> - 2007-05-17 11:51:10
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15159/demos Added Files: clock.swf Log Message: Missing file added --- NEW FILE: clock.swf --- (This appears to be a binary file; contents omitted.) |
|
From: George H. <geo...@us...> - 2007-05-17 11:11:26
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31502/win32forth/doc Modified Files: p-relnotes.6.12.htm Log Message: gah:added to release notes Index: p-relnotes.6.12.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-relnotes.6.12.htm,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** p-relnotes.6.12.htm 25 Aug 2006 14:13:34 -0000 1.12 --- p-relnotes.6.12.htm 17 May 2007 11:11:22 -0000 1.13 *************** *** 78,82 **** <li>The File w32fHtmlDisplay.dll was removed because it was replaced whith the new ActiveX support written by Thomas Dixon.</li> <li>The File FreeImage.dll was added because it is used by the Win32Forth IDE to display Bitmap images.</li> ! <li>PATH-PTR was changed. All code that depend on PATH-PTR be defined as a VALUE must be changed !!! Alternatively you can INCLUDE the file compat\oldpaths.f for a harness to use old code with the new paths.f</li> --- 78,82 ---- <li>The File w32fHtmlDisplay.dll was removed because it was replaced whith the new ActiveX support written by Thomas Dixon.</li> <li>The File FreeImage.dll was added because it is used by the Win32Forth IDE to display Bitmap images.</li> ! <li>PATH-PTR was changed. All code that depend on PATH-PTR being defined as a VALUE must be changed !!! Alternatively you can INCLUDE the file compat\oldpaths.f for a harness to use old code with the new paths.f</li> *************** *** 84,88 **** <h3>Documentation</h3> <p> ! A lot of new documentation was added using Brad Eckert's <a href="p-dexh.htm">DexH - Document Extractor</a>. </p> <h3>Bug fixes</h3> --- 84,88 ---- <h3>Documentation</h3> <p> ! A lot of new documentation has been added using an extended version of Brad Eckert's <a href="p-dexh.htm">DexH - Document Extractor</a>. </p> <h3>Bug fixes</h3> *************** *** 117,121 **** <ul> <li><a href="./classes/HTMLControl.htm">HTML browser control</a> ! This is a HTML browser control that can be used for all kinds of things. </li> --- 117,123 ---- <ul> <li><a href="./classes/HTMLControl.htm">HTML browser control</a> ! This is a HTML browser control that can be used for all kinds of things. This ! requires that Internet Explorer is installed (even if it's not your default ! browser). </li> |
|
From: George H. <geo...@us...> - 2007-05-17 11:10:27
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31044/win32forth/src Modified Files: ANSFILE.F CALLBACK.f Dialog.f Primutil.f Log Message: gah:moved caps-compare and caps-search to ansfile.f (as in the STC version) plus minor spelling corrections. Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** Primutil.f 10 Mar 2007 15:05:02 -0000 1.22 --- Primutil.f 17 May 2007 11:10:22 -0000 1.23 *************** *** 706,710 **** endof endcase to winver ! r>drop _localfree ; --- 706,710 ---- endof endcase to winver ! rdrop _localfree ; *************** *** 818,866 **** LCOUNT + 0 SWAP C! ; - - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - \ Some case insensitive version of search and compare - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - - \ enhanced caps-search for source string > 255 bytes - \ search for t-adr,t-len within string s-adr,s-len. f1=true if string was found - : CAPS-SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) - \ *G Search the string specified by c-addr1 u1 for the string specified by c-addr2 u2, - \ ** using a case-insensitive search. \n - \ ** If flag is true, a match was found at c-addr3 with u3 characters remaining. \n - \ ** If flag is false there was no match and c-addr3 is c-addr1 and u3 is u1. - { s-adr s-len t-adr t-len \ t-buf t-str -- adr len flag } - MAXSTRING localalloc: t-str - s-len cell+ ALLOCATE 0= - IF to t-buf \ make a buffer big enough for s-adr - t-adr t-len t-str place - t-str count upper - s-adr t-buf s-len move - t-buf s-len upper - t-buf s-len t-str count search - IF nip \ discard found address - s-len swap - \ offset where string was found - s-adr s-len rot /string - \ location of found string in original buf - TRUE - ELSE 2drop - s-adr s-len FALSE - THEN - t-buf FREE drop - ELSE s-adr s-len FALSE \ failed, couldn't allocate buffer - THEN ; - - \ COMPARE compares two strings, ignoring case. The return value is: - \ - \ 0 = string1 = string2 - \ -1 = string1 < string2 - \ 1 = string1 > string2 - : CAPS-COMPARE { sa1 sn1 sa2 sn2 \ st1 st2 -- f1 } - MAXSTRING LocalAlloc: st1 - MAXSTRING LocalAlloc: st2 - sa1 sn1 st1 place st1 count upper - sa2 sn2 st2 place st2 count upper - st1 count st2 count compare ; - in-system --- 818,821 ---- Index: CALLBACK.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CALLBACK.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** CALLBACK.f 12 May 2007 07:51:19 -0000 1.9 --- CALLBACK.f 17 May 2007 11:10:21 -0000 1.10 *************** *** 265,269 **** \ *G This windows message definition for WM_WIN32FORTH, provides a way for \ ** multiple Win32Forth applications to interact between themselves ! \ ** wile running. \ changed Sonntag, August 22 2004 dbu --- 265,269 ---- \ *G This windows message definition for WM_WIN32FORTH, provides a way for \ ** multiple Win32Forth applications to interact between themselves ! \ ** while running. \ changed Sonntag, August 22 2004 dbu Index: Dialog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dialog.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Dialog.f 6 Feb 2006 17:48:17 -0000 1.5 --- Dialog.f 17 May 2007 11:10:22 -0000 1.6 *************** *** 32,36 **** lcount begin over r@ dialogID? ! if r>drop \ discard the ID drop \ discard the length \ return the template header address --- 32,36 ---- lcount begin over r@ dialogID? ! if rdrop \ discard the ID drop \ discard the length \ return the template header address *************** *** 82,86 **** :CLASS Dialog <SUPER Dialog&Control \ *G Dialog class. \n ! \ ** To use this class you have to create a ressource file (*.res) whitch must contain \ ** the dialog resource. Since Win32Forth doesn't provide any tool's to create a dialog \ ** resource you should use ForthForm to create your dialog windows instead. --- 82,86 ---- :CLASS Dialog <SUPER Dialog&Control \ *G Dialog class. \n ! \ ** To use this class you have to create a ressource file (*.res) which must contain \ ** the dialog resource. Since Win32Forth doesn't provide any tool's to create a dialog \ ** resource you should use ForthForm to create your dialog windows instead. *************** *** 199,203 **** :Class ModelessDialog <SUPER Dialog \ *G Modless Dialog class \n ! \ ** To use this class you have to create a ressource file (*.res) whitch must contain \ ** the dialog resource. Since Win32Forth doesn't provide any tool's to create a dialog \ ** resource you should use ForthForm to create your dialog windows instead. --- 199,203 ---- :Class ModelessDialog <SUPER Dialog \ *G Modless Dialog class \n ! \ ** To use this class you have to create a ressource file (*.res) which must contain \ ** the dialog resource. Since Win32Forth doesn't provide any tool's to create a dialog \ ** resource you should use ForthForm to create your dialog windows instead. Index: ANSFILE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/ANSFILE.F,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** ANSFILE.F 23 Sep 2006 09:49:37 -0000 1.9 --- ANSFILE.F 17 May 2007 11:10:21 -0000 1.10 *************** *** 73,76 **** --- 73,121 ---- 2 newuser wMilliseconds + \ ------------------------------------------------------------------------ + \ Some case insensitive version of search and compare + \ ------------------------------------------------------------------------ + + \ enhanced caps-search for source string > 255 bytes + \ search for t-adr,t-len within string s-adr,s-len. f1=true if string was found + : CAPS-SEARCH ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) + \ *G Search the string specified by c-addr1 u1 for the string specified by c-addr2 u2, + \ ** using a case-insensitive search. \n + \ ** If flag is true, a match was found at c-addr3 with u3 characters remaining. \n + \ ** If flag is false there was no match and c-addr3 is c-addr1 and u3 is u1. + { s-adr s-len t-adr t-len \ t-buf t-str -- adr len flag } + MAXSTRING localalloc: t-str + s-len cell+ ALLOCATE 0= + IF to t-buf \ make a buffer big enough for s-adr + t-adr t-len t-str place + t-str count upper + s-adr t-buf s-len move + t-buf s-len upper + t-buf s-len t-str count search + IF nip \ discard found address + s-len swap - \ offset where string was found + s-adr s-len rot /string + \ location of found string in original buf + TRUE + ELSE 2drop + s-adr s-len FALSE + THEN + t-buf FREE drop + ELSE s-adr s-len FALSE \ failed, couldn't allocate buffer + THEN ; + + \ COMPARE compares two strings, ignoring case. The return value is: + \ + \ 0 = string1 = string2 + \ -1 = string1 < string2 + \ 1 = string1 > string2 + : CAPS-COMPARE { sa1 sn1 sa2 sn2 \ st1 st2 -- f1 } + MAXSTRING LocalAlloc: st1 + MAXSTRING LocalAlloc: st2 + sa1 sn1 st1 place st1 count upper + sa2 sn2 st2 place st2 count upper + st1 count st2 count compare ; + + : get-fspace { zroot \ clus freclus b/sec s/clus -- as bs cs ds } \ *G Get a drive's free space, cluster and sector information |
|
From: Alex M. <ale...@us...> - 2007-05-17 08:13:25
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22499 Added Files: struct.f Log Message: arm: initial load --- NEW FILE: struct.f --- \ $Id: struct.f,v 1.1 2007/05/17 08:13:21 alex_mcdonald Exp $ \ \ --------------------------- Change Block ------------------------------- \ \ \ ------------------------- End Change Block ----------------------------- \ \ Experimental: a fully optimising, STC based, ANS Forth compliant kernel \ \ Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com) \ \ 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. \ \ ------------------------------------------------------------------------ \ RfD: Structures - Version 4 \ 6 February 2007, Stephen Pelc \ ------------------------------------------------------------------------ : begin-structure ( -- addr 0 ) create here 0 0 , does> ( -- size ) @ ; : end-structure ( addr n -- ) swap ! ; \ set size : +field ( n1 n2 "name" -- n3 ) create over , + does> ( addr -- addr+n1 ) @ + ; : field: ( n1 <"name"> -- n2 ) ( addr -- 'addr ) aligned cell +FIELD ; : cfield: ( n1 <"name"> -- n2 ) ( addr -- 'addr ) 1 chars +FIELD ; : bfield: ( n1 <"name"> -- n2 ) ( addr -- 'addr ) 1 +FIELD ; : wfield: ( n1 <"name"> -- n2 ) ( addr -- 'addr ) 2 +FIELD ; : lfield: ( n1 <"name"> -- n2 ) ( addr -- 'addr ) 4 +FIELD ; : xfield: ( n1 <"name"> -- n2 ) ( addr -- 'addr ) 8 +FIELD ; |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-16 20:35:45
|
Update of /cvsroot/win32forth/win32forth-stc/demos/COM In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10247 Added Files: D3Dtest.f EX_ADO.F EX_D3D.F EX_DDRAW.F EX_SAPI.F Log Message: Jos: Tom Dixon's COM demo's. --- NEW FILE: EX_ADO.F --- \ $Id: EX_ADO.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of using ADO \ Thomas Dixon \ This is a very simple sql utility needs fcom 2 7 typelib {EF53050B-882E-4776-B643-EDA472E8E3F2} \ inlude ADO type library _RecordSet ComIFace rec create DSN 1024 allot \ DSN holder create querybuf 1024 allot \ holds the query buffer create cCol 32 allot u" ," cCol uniplace \ Column Delimeter create NL 32 allot crlf$ count >unicode NL uniplace \ New Record Delimeter create nullch 32 allot u" " nullch uniplace \ Null Character Replacement create sqlbuf 0 , 0 , \ holds the returned buffer : DSN! ( str len -- ) \ store the connection string (ODBC) rec @ 0= if rec _RecordSet 1 0 RecordSet call CoCreateInstance abort" Unable to Create ADO Recordset!" then asc>uni 2dup DSN uniplace drop free drop ; : SQLEXEC ( options locktype cursortype -- ) 0 DSN unicount drop 0 8 0 querybuf unicount drop 0 8 rec open abort" Unable to Execute SQL Query!" ; : records>str ( -- str len ) \ converts recordset to string sqlbuf @ ?dup if free drop then 0 sqlbuf ! sqlbuf nullch unicount drop NL unicount drop ccol unicount drop -1 2 rec GetString abort" Unable to convert data to String!" sqlbuf @ dup zunicount uni>asc 2dup sqlbuf cell+ ! sqlbuf ! rot call CoTaskMemFree drop ; : SQL ( str len -- str len ) \ executes a query asc>uni 2dup querybuf uniplace drop free drop adOptionUnspecified adLockUnspecified adOpenDynamic SQLEXEC records>str ; (( \ Here is a simple example I use on my System \ (Assumes 'DBTest' is a dsn on the machine with a table called 'test') s" DSN=DBTest" dsn! \ Load the DSN s" Select * FROM test" SQL cr type \ Execute a query rec close drop \ cleanup )) --- NEW FILE: EX_D3D.F --- \ $Id: EX_D3D.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of using Direct3d (Directx 8.1) \ Thomas Dixon needs fcom 1 0 typelib {E1211242-8E94-11D1-8808-00C04FC2C603} \ Load Directx 8.1 winlibrary dx8vb.dll \ Interfaces IDirectx8 ComIFace dx8 Direct3D8 ComIFace d3d Direct3DDevice8 ComIFace d3dev ID3dx8 Comiface d3dhelper D3DXBuffer ComIFace meshbuf D3DXMesh COMIFace mesh \ Structures D3DDISPLAYMODE d3dmode D3DPRESENT_PARAMETERS d3dpp D3DMATRIX matworld D3DMATERIAL8 meshmat D3DLIGHT8 dlight : setup-d3d ( -- ) dx8 IDirectx8 1 0 Directx8 call CoCreateInstance abort" Unable to get Directx!" d3d dx8 Direct3dCreate abort" Direct3dCreate Failed!" d3dmode D3DADAPTER_DEFAULT d3d GetAdapterDisplayMode abort" Unable to get Mode!" 1 d3dpp windowed ! D3DSWAPEFFECT_COPY_VSYNC d3dpp swapeffect ! d3dmode format @ d3dpp BackBufferFormat ! d3dev d3dpp D3DCREATE_SOFTWARE_VERTEXPROCESSING ( Change "software" to "hardware" for speed) conhndl D3DDEVTYPE_HAL D3DADAPTER_DEFAULT d3d CreateDevice abort" Unable to create device!" d3dhelper ID3DX8 1 0 D3DX8 call CoCreateInstance abort" Unable to get d3dx8!" ; : free-d3d ( -- ) d3dev release drop d3d release drop dx8 release drop ; variable nummat 0 nummat ! D3DVECTOR v1 D3DVECTOR v2 D3DVECTOR v3 : v! ( fz fy fx v -- ) dup sf! dup 4 + sf! 8 + sf! ; : color>cstruct ( fr fg fb fa addr -- ) dup COM D3DCOLORVALUE a sf! dup COM D3DCOLORVALUE b sf! dup COM D3DCOLORVALUE g sf! COM D3DCOLORVALUE r sf! ; : load-demo ( -- ) setup-d3d \ Setup the World Matrix matworld call VB_D3DXMatrixIdentity drop matworld D3DTS_WORLD d3dev SetTransform drop \ Setup the View Matrix -5e0 3e0 0e0 v1 v! \ eye 0e0 0e0 0e0 v2 v! \ at 0e0 1e0 0e0 v3 v! \ look v3 v2 v1 matworld call VB_D3DXMatrixLookAtLH drop matworld D3DTS_VIEW d3dev SetTransform drop \ Setup the Projection Matrix 1000e0 sfs>ds 1e0 sfs>ds dup .785398e0 sfs>ds matworld call VB_D3DXMatrixPerspectiveFovLH drop matworld D3DTS_PROJECTION d3dev SetTransform drop \ Render States (initial) D3DFILL_WIREFRAME D3DRS_FILLMODE d3dev SetRenderState drop 1 D3DRS_CLIPPING d3dev SetRenderState drop D3DCULL_CCW D3DRS_CULLMODE d3dev setRenderState drop \ Setup the Light Source (directional from above) D3DLIGHT_DIRECTIONAL dlight Type ! 1e0 1e0 1e0 0e0 dlight diffuse color>cstruct 0.5e0 dlight Direction x sf! -3e0 dlight Direction y sf! 0.5e0 dlight Direction z sf! 1000e0 dlight Range sf! dlight 0 d3dev setlight abort" Unable to set light source!" 1 D3DRS_LIGHTING d3dev SetRenderState drop 1 0 d3dev LightEnable abort" No Light Sources Supported!" $202020 D3DRS_AMBIENT d3dev setrenderstate drop D3DSHADE_GOURAUD D3DRS_SHADEMODE d3dev SetRenderState drop ; \ Words to load various mesh shapes : load-teapot ( --) mesh @ if mesh release drop then mesh meshbuf d3dev @ d3dhelper CreateTeapot abort" Unable to Load Teapot!" ; : load-sphere ( --) mesh @ if mesh release drop then mesh meshbuf 20 20 1e0 sfs>ds d3dev @ d3dhelper CreateSphere abort" Unable to Load Sphere!" ; : load-torus ( --) mesh @ if mesh release drop then mesh meshbuf 20 20 1e0 sfs>ds .5e0 sfs>ds d3dev @ d3dhelper CreateTorus abort" Unable to Load Sphere!" ; : load-box ( --) mesh @ if mesh release drop then mesh meshbuf 1.0e0 sfs>ds dup dup d3dev @ d3dhelper CreateBox abort" Unable to Load Sphere!" ; \ Matrix! : m! ( f1 f2 ... f16 mat -- ) 0 15 do dup i cells + sf! -1 +loop drop ; \ Rotate (matrix multiply) 0e0 fvalue angle : rotate ( -- ) angle fcos 0e0 angle fsin -1e0 f* 0e0 0e0 1e0 0e0 0e0 angle fsin 0e0 angle fcos 0e0 0e0 0e0 0e0 1e0 matworld m! matworld D3DTS_WORLD d3dev SetTransform drop ; : vclear ( -- ) 0 1e0 sfs>ds $FFFFFF D3DCLEAR_TARGET 0 0 d3dev Clear drop ; : beginScene ( -- ) d3dev beginScene drop ; : endScene ( -- ) d3dev endscene drop ; : Present ( -- ) 0 0 0 0 d3dev Present drop ; \ special effects : wire ( -- ) D3DFILL_WIREFRAME D3DRS_FILLMODE d3dev setrenderstate drop ; : setred ( -- ) D3DFILL_SOLID D3DRS_FILLMODE d3dev SetRenderState drop 1e0 0e0 0e0 1e0 meshmat ambient color>cstruct 1e0 0e0 0e0 1e0 meshmat diffuse color>cstruct meshmat d3dev SetMaterial drop ; : setgreen ( -- ) D3DFILL_SOLID D3DRS_FILLMODE d3dev SetRenderState drop 0e0 1e0 0e0 1e0 meshmat ambient color>cstruct 0e0 1e0 0e0 1e0 meshmat diffuse color>cstruct meshmat d3dev SetMaterial drop ; : setblue ( -- ) D3DFILL_SOLID D3DRS_FILLMODE d3dev SetRenderState drop 0e0 0e0 1e0 1e0 meshmat ambient color>cstruct 0e0 0e0 1e0 1e0 meshmat diffuse color>cstruct meshmat d3dev SetMaterial drop ; : demo ( -- ) load-demo load-teapot begin vclear rotate beginscene 0 mesh drawsubset drop 0.05e0 angle f+ fdup 6.28319e0 f> if 6.28319e0 f- then fto angle key? if false key case 49 of wire endof 50 of setred endof 51 of setgreen endof 52 of setblue endof 53 of load-teapot endof 54 of load-sphere endof 55 of load-torus endof 56 of load-box endof 27 of drop true endof endcase else false then endscene present until free-d3d ; demo (( Instructions for the demo: just run "demo" and you find a rotating teapot in the window. some keys will change the way this demo works. 1 = Wire frame rendering 2 = red filling 3 = green filling 4 = blue filling 5 = teapot shape 6 = sphere shape 7 = torus shape 8 = box shape esc = end demo )) --- NEW FILE: D3Dtest.f --- \ $Id: D3Dtest.f,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of drawing one triangle using Direct3d (Directx 8.1) \ Thomas Dixon needs fcom 1 0 typelib {E1211242-8E94-11D1-8808-00C04FC2C603} \ Load Directx 8.1 \ Interfaces IDirectx8 ComIFace dx8 Direct3D8 ComIFace d3d Direct3DDevice8 ComIFace d3dev \ Structures D3DDISPLAYMODE d3dmode D3DPRESENT_PARAMETERS d3dpp \ custom vertex D3DFVF_XYZRHW D3DFVF_DIFFUSE or value FVF_Custom 20 value vertsize : vertarray ( n -- ) create vertsize * allot does> swap vertsize * + ; : setup-d3d ( -- ) dx8 IDirectx8 1 0 Directx8 call CoCreateInstance abort" Unable to get Directx!" d3d dx8 Direct3dCreate abort" Direct3dCreate Failed!" d3dmode D3DADAPTER_DEFAULT d3d GetAdapterDisplayMode abort" Unable to get Mode!" 1 d3dpp windowed ! D3DSWAPEFFECT_COPY_VSYNC d3dpp swapeffect ! d3dmode format @ d3dpp BackBufferFormat ! d3dev d3dpp D3DCREATE_SOFTWARE_VERTEXPROCESSING ( Change "software" to "hardware" for speed) conhndl D3DDEVTYPE_HAL D3DADAPTER_DEFAULT d3d CreateDevice abort" Unable to create device!" ; : free-d3d ( -- ) d3dev release drop d3d release drop dx8 release drop ; \ Initialize the vertext buffer 3 vertarray vert : vert! ( color rhw fz fy fx vert -- ) 4 0 do dup i cells + sf! loop 4 cells + ! ; $ffff0000 1e0 0.5e0 50.0e0 150.0e0 0 vert vert! $ff00ff00 1e0 0.5e0 250.0e0 250.0e0 1 vert vert! $ff00ffff 1e0 0.5e0 250.0e0 50.0e0 2 vert vert! : tri-list ( listarray n -- ) FVF_Custom d3dev SetVertexShader drop vertsize -rot D3DPT_TRIANGLELIST d3dev DrawPrimitiveUP drop ; : vclear ( -- ) 0 1e0 sfs>ds $FF D3DCLEAR_TARGET 0 0 d3dev Clear drop ; : beginScene ( -- ) d3dev beginScene drop ; : endScene ( -- ) d3dev endscene drop ; : Present ( -- ) 0 0 0 0 d3dev Present drop ; setup-d3d vclear beginscene 0 vert 3 tri-list endscene present free-d3d --- NEW FILE: EX_DDRAW.F --- \ $Id: EX_DDRAW.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of using Direct Draw (Directx) \ Thomas Dixon needs fcom 1 0 typelib {E1211242-8E94-11D1-8808-00C04FC2C602} \ Load Directx7 \ Interfaces IDirectx7 ComIFace dx7 DirectDraw7 ComIFace dd7 DirectDrawSurface7 ComIFace primary \ Structures DDSURFACEDESC2 ddsdl \ define a surface structure Rect winrect : window-mode ( -- ) DDSCL_NORMAL conhndl dd7 SetCooperativeLevel abort" SetCooperativelevel failed!" ; : full-screen ( color width height -- ) DDSCL_FULLSCREEN DDSCL_ALLOWMODEX DDSCL_EXCLUSIVE or or conhndl dd7 setCooperativeLevel abort" SetCooperativeLevel failed!" >r 2>r DDSDM_DEFAULT 0 2r> r> dd7 setdisplaymode abort" Unable to set display mode!" ; : setup-ddraw ( -- ) dx7 IDirectx7 1 0 Directx7 CoCreateInstance abort" Unable to get Directx!" dd7 0 dx7 DirectDrawCreate abort" DirectDrawCreate failed!" 16 480 640 full-screen \ set screen resolutuion (use window-mode to work from a window) DDSD_CAPS ddsdl lFlags ! DDSCAPS_PRIMARYSURFACE ddsdl ddsCaps lCaps ! primary ddsdl dd7 CreateSurface abort" Primary surface failed!" ; : get-rect ( -- ) winrect conhndl dx7 getwindowrect drop ; : rand-circle ( -- ) $FF random 16 lshift $FF random 8 lshift $FF random + + primary setforecolor drop 200 random 480 random 640 random primary drawcircle drop ; : test get-rect 0 do rand-circle loop ; (( \ This is a simple example using directdraw. DirectDraw is optimized for blitting \ in 2D. It is also fast, fairly low-level, and supports hardware acceleration. \ In this example, we don't blit at all, we just draw lots of random circles. )) setup-ddraw 10000 test --- NEW FILE: EX_SAPI.F --- \ $Id: EX_SAPI.F,v 1.1 2007/05/16 20:35:42 jos_ven Exp $ \ Example of Speech API \ Thomas Dixon needs FCOM.F \ SAPI 5.0 typelibrary 5 0 typelib {C866CA3A-32F7-11D2-9602-00C04F8EE628} ISpVoice ComIFace voice \ Create voice instance voice ISpVoice 1 0 SpVoice call CoCreateInstance drop 0 0 u" Hello World!" drop voice speak . \ Say it slower -9 voice setrate . 0 0 u" I'm talking slower now." drop voice speak . \ Say it faster 5 voice setrate . 0 0 u" I'm talking fast now." drop voice speak . \ Say it higher 0 voice setrate . \ Example of how to build it as an exe! : main ( -- ) voice ISpVoice 1 0 SpVoice call CoCreateInstance if true s" Unable to Create SPVoice!" ?messagebox bye then 0 0 u" Hello World!" drop voice speak if true s" Unable to Speak!" ?messagebox bye then 0 bye ; \ ' main turnkey speak.exe |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-16 20:34:28
|
Update of /cvsroot/win32forth/win32forth-stc/demos/ADO In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9460 Added Files: ADOreadme.txt EX_Connstr.f EX_Create.f EX_Dump.f EX_Ins.f EX_InsSQL.f test.mdb Log Message: Jos: Tom Dixon's ADO-demo's --- NEW FILE: EX_Create.f --- \ Example of Creating Database Tables \ Tom Dixon needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string adModeReadWrite setmode: conn \ set the mode to read and write connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object adLockOptimistic SetLockType: cursor \ Lock on updates create qstr 256 allot \ Create a generic Globals Table s" CREATE TABLE globals ( " qstr place s" global_name varchar(64) not null, " qstr +place s" global_char varchar(255) null, " qstr +place s" global_text text null, " qstr +place s" global_datetime datetime null, " qstr +place s" global_integer int null, " qstr +place s" global_float float null) " qstr +place qstr count execute: cursor close: cursor close: conn --- NEW FILE: ADOreadme.txt --- These files are examples on how to use the ADO classes. In order to run them, you must setup a database and make sure that the connection string in EX_Connstr.F points to it. An access database is the easiest to make. All the examples use EX_Connstr.f to connect. EX_Create.f - creates a table in the database EX_InsSQL.F - inserts records into the table (through SQL) EX_Ins.F - inserts records programmatically EX_Dump.F - dumps a column of the table If you run the examples in the order listed, there should be no errors. Drop the table from the database to run them again. --- NEW FILE: EX_Connstr.f --- \ Database Connection Example \ Tom Dixon \ ADO connects to a database through the connection string. \ This connection string can take several different formats. \ For our example, we will only use Access needs ADO defined connstr nip 0= [if] create connstr 256 allot [then] s" DRIVER={Microsoft Access Driver (*.mdb)};" connstr place \ this may need to be changed to where ever the test database is. s" DBQ=C:\win32forth-stc\demos\ADO\test.mdb" connstr +place \ For a large list of other connection string options, as well as examples \ of other databases, look at \ http://www.carlprothman.net/Default.aspx?tabid=81 --- NEW FILE: test.mdb --- (This appears to be a binary file; contents omitted.) --- NEW FILE: EX_Ins.f --- \ Example of inserting data programmatically \ Tom Dixon \ This example shows how to insert data programmatically. needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string adModeReadWrite setmode: conn \ set the mode to read and write connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object adLockOptimistic SetLockType: cursor \ Lock on updates \ retrieve the table s" SELECT * FROM globals" execute: cursor \ add a float global addrow: cursor \ add a row to the end s" PI" 0 setstr: cursor 3.14159265358979e0 5 setfloat: cursor update: cursor \ add an integer global addrow: cursor s" Major Version" 0 setstr: cursor 3 4 setint: cursor update: cursor \ add a date global addrow: cursor s" Testdate" 0 setstr: cursor time&date 3 setdatetime: cursor update: cursor \ add a varchar addrow: cursor s" Owner" 0 setstr: cursor s" Billy Bones" 2 setstr: cursor update: cursor \ clean up close: cursor close: conn --- NEW FILE: EX_Dump.f --- \ Example of Selecting and displaying Data \ Tom Dixon \ This example shows how to access data from a cursor needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object \ retrieve the table s" SELECT * FROM globals" execute: cursor : testdump ( -- ) cr movefirst: cursor 0 fieldname: cursor dup >r type cr r> 0 ?do [char] - emit loop cr begin 0 getstr: cursor type cr movenext: cursor eof: cursor until ; testdump \ clean up close: cursor close: conn --- NEW FILE: EX_InsSQL.f --- \ Example of inserting data into a database VIA SQL \ Tom Dixon \ This example shows how to execut SQL queries to insert \ data into a table needs ADO needs EX_Connstr.f \ load in the connection string \ declare the objects that we are going to work with ADOConnection conn ADOCursor cursor start: conn \ start the connection connstr count setconnstring: conn \ set the connection string adModeReadWrite setmode: conn \ set the mode to read and write connect: conn \ connect to the database start: cursor \ start the cursor conn SetConnection: cursor \ tell cursor to use the 'conn' connection object adLockOptimistic SetLockType: cursor \ Lock on updates create qstr 256 allot s" INSERT INTO globals (global_name, global_text, global_integer, global_datetime)" qstr place s" VALUES('StartDate','The Date the database was started',1,now())" qstr +place qstr count execute: cursor close: cursor close: conn |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-16 20:31:36
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8635 Added Files: FlashControlDemo.f HtmlControlDemo.f PdfControlDemo.f Log Message: Jos: Tom Dixon's Control demo's --- NEW FILE: HtmlControlDemo.f --- \ $Id: HtmlControlDemo.f,v 1.1 2007/05/16 20:31:33 jos_ven Exp $ \ Demo for the HTML Control \ Thomas Dixon cr .( Loading Html Control Demo...) anew -HtmlControlDemo.f \ *D doc\classes\ \ *> HTMLcontrol \ *S Example (demos\HtmlControlDemo.f) \ *+ needs HtmlControl.f \ Create a simple browser window :class Browserwin <super window HTMLcontrol html :M On_Init: ( -- ) On_Init: super self Start: html ;M :M On_Size: ( h m w -- ) 2drop drop autosize: html ;M :M GoURL: ( str len -- ) GoURL: html ;M :M GetLocationURL: ( -- str len ) GetLocationURL: html ;M :M GetLocationName: ( -- str len ) GetLocationName: html ;M :M Busy?: ( -- flag ) Busy?: html ;M :M Offline?: ( -- flag ) Offline?: html ;M :M GetType: ( -- str len ) GetType: html ;M :M Wait: ( -- ) \ Wait until the browser has finished all \ downloading operation or other activity. begin winpause Busy?: self 0= until ;M ;class BrowserWin bwin : test \ start the window start: bwin \ let the browser load a document Offline?: bwin if s" doc\p-index.htm" Prepend<home>\ else s" www.win32forth.org\doc\p-index.htm" then GoURL: bwin \ wait until browser is ready Wait: bwin \ display some information about the document cr GetLocationURL: bwin type cr GetLocationName: bwin type cr GetType: bwin type ; test \ *- \ *Z --- NEW FILE: PdfControlDemo.f --- \ $Id: PdfControlDemo.f,v 1.1 2007/05/16 20:31:33 jos_ven Exp $ \ Demo for the Acrobat PDF Control \ Thomas Dixon cr .( Loading PDF Control Demo...) anew -PdfControlDemo.f needs PdfControl.f \ Create a simple pdf window :class PDFwin <super window PDFControl pdf :M On_Init: ( -- ) On_Init: super self Start: pdf ;M :M On_Size: ( h m w -- ) 2drop drop autosize: pdf ;M :M LoadFile: ( str len -- flag ) LoadFile: pdf ;M :M SetPage: ( n -- ) SetPage: pdf ;M :M gotoFirstPage: ( -- ) gotoFirstPage: pdf ;M :M gotoLastPage: ( -- ) gotoLastPage: pdf ;M :M gotoNextPage: ( -- ) gotoNextPage: pdf ;M :M gotoPreviousPage: ( -- ) gotoPreviousPage: pdf ;M :M goForward: ( -- ) goForward: pdf ;M :M goBack: ( -- ) goBack: pdf ;M :M Print: ( -- ) Print: pdf ;M :M PrintWithDialog: ( -- ) PrintWithDialog: pdf ;M :M PrintPages: ( n n -- ) PrintPages: pdf ;M :M PrintPagesFit: ( flag n n -- ) PrintPagesFit: pdf ;M :M PrintAll: ( -- ) PrintAll: pdf ;M :M PrintAllFit: ( bool -- ) PrintAllFit: pdf ;M :M SetZoom: ( float -- ) SetZoom: pdf ;M :M SetZoomScroll: ( float float float -- ) SetZoomScroll: pdf ;M :M SetViewRect: ( float float float float -- ) SetViewRect: pdf ;M :M SetPageMode: ( str len -- ) SetPageMode: pdf ;M :M SetLayoutMode: ( str len -- ) SetLayoutMode: pdf ;M :M SetNamedDest: ( str len -- ) SetNamedDest: pdf ;M :M SetShowToolbar: ( flag -- ) SetShowToolbar: pdf ;M :M SetShowScrollbars: ( flag -- ) SetShowScrollbars: pdf ;M :M Aboutbox: ( -- ) Aboutbox: pdf ;M ;class \ This should load a pdf file and display it in a window pdfwin pwin start: pwin s" doc\Forth_Primer.pdf" Prepend<home>\ loadfile: pwin drop \ I don't think the PDF viewer was ever ment to be used as an embedded control \ It only supports the dispatch interface and updates (such as resizing) are rather slow --- NEW FILE: FlashControlDemo.f --- \ $Id: FlashControlDemo.f,v 1.1 2007/05/16 20:31:33 jos_ven Exp $ \ Demo for Shockwave Flash control \ Tom Dixon cr .( Loading Flash Control Demo...) anew -FlashControlDemo.f needs FlashControl.f :class Flashwin <super window Flashcontrol fcntrl :M On_Init: ( -- ) On_Init: super self Start: fcntrl ;M :M On_Size: ( h m w -- ) 2drop drop autosize: fcntrl ;M \ ShockWave Methods :M PutMovie: ( str len -- f ) PutMovie: fcntrl ;M :M GetMovie: ( -- str len ) GetMovie: fcntrl ;M :M Play: ( -- ) Play: fcntrl ;M :M Stop: ( -- ) Stop: fcntrl ;M :M Back: ( -- ) Back: fcntrl ;M :M Forward: ( -- ) Forward: fcntrl ;M :M Rewind: ( -- ) Rewind: fcntrl ;M :M StopPlay: ( -- ) StopPlay: fcntrl ;M :M GotoFrame: ( n -- ) GotoFrame: fcntrl ;M :M CurrentFrame: ( -- n ) CurrentFrame: fcntrl ;M :M TotalFrames: ( -- n ) TotalFrames: fcntrl ;M :M Playing?: ( -- flag ) Playing?: fcntrl ;M :M Loaded%: ( -- percent ) Loaded%: fcntrl ;M :M Loop: ( flag -- ) Loop: fcntrl ;M :M Loop?: ( -- flag ) Loop?: fcntrl ;M :M Pan: ( n n n -- ) Pan: fcntrl ;M :M Zoom: ( n -- ) Zoom: fcntrl ;M :M SetZoomRect: ( n n n n -- ) SetZoomRect: fcntrl ;M :M BGColor: ( -- color ) BGColor: fcntrl ;M :M SetBGColor: ( color -- ) SetBGColor: fcntrl ;M ;class Flashwin fwin start: fwin 0x808080 setbgcolor: fwin s" demos\clock.swf" Prepend<home>\ putmovie: fwin drop true loop: fwin |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-16 20:30:23
|
Update of /cvsroot/win32forth/win32forth-stc/demos/COM In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8173/COM Log Message: Directory /cvsroot/win32forth/win32forth-stc/demos/COM added to the repository |
|
From: Jos v.d.V. <jo...@us...> - 2007-05-16 20:30:22
|
Update of /cvsroot/win32forth/win32forth-stc/demos/ADO In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8173/ADO Log Message: Directory /cvsroot/win32forth/win32forth-stc/demos/ADO added to the repository |
1040 messages has been excluded from this view by a project administrator.
