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: Mehran <Meh...@AW...> - 2008-05-19 10:18:53
|
Great climaxes await you once you start using this http://www.puanesh.com/ |
|
From: Massaker <nel...@MA...> - 2008-05-19 09:30:35
|
Fantastic gains in just 4 months, guaranteed http://www.bligena.com/ |
|
From: Karapetyan <hor...@1s...> - 2008-05-18 15:24:30
|
Size and girth increase guaranteed with herbal express http://www.topmuoan.com/ |
|
From: George H. <geo...@us...> - 2008-05-16 23:42:37
|
Update of /cvsroot/win32forth/win32forth/Help/html In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18832 Modified Files: w32f-forthtypes.htm Log Message: gah: minor corrections Index: w32f-forthtypes.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/html/w32f-forthtypes.htm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** w32f-forthtypes.htm 15 May 2008 07:36:49 -0000 1.1 --- w32f-forthtypes.htm 16 May 2008 23:42:33 -0000 1.2 *************** *** 42,48 **** <p><code>2VARIABLE ( <name> -- )</code> \ create a double precision variable</p> ! <p><code>CREATE</code> is a more versatile defining word that simply create a header in the dictionary and, when executed, pushes on stack its pfa, the address immediately following ! the header. Just after <code>CREATE</code>ing a word, you can allocate and/or initialize some space in the dictionary for it. Examples :</p> <pre> --- 42,48 ---- <p><code>2VARIABLE ( <name> -- )</code> \ create a double precision variable</p> ! <p><code>CREATE</code> is a more versatile defining word that simply creates a header in the dictionary and, when executed, pushes on stack its pfa, the address immediately following ! the header. Just after <code>CREATE</code>ing a word, you can allot and/or initialize some space in the dictionary for it. Examples :</p> <pre> *************** *** 55,59 **** 30 ERASE \ erase 30 byte starting at saved address HERE </pre> ! <p>Notice that <code>HERE</code> has to be invoqued before <code>ALLOT</code> because this later increments the dictionary pointer and we need to <code>ERASE</code> from the beginning of rawdata.</p> --- 55,59 ---- 30 ERASE \ erase 30 byte starting at saved address HERE </pre> ! <p>Notice that <code>HERE</code> has to be invoked before <code>ALLOT</code> because this later increments the dictionary pointer and we need to <code>ERASE</code> from the beginning of rawdata.</p> |
|
From: George H. <geo...@us...> - 2008-05-16 09:16:38
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv32533/win32forth/doc Modified Files: p-switch.htm Log Message: gah: replaced by dex-generated version. Index: p-switch.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-switch.htm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** p-switch.htm 21 Dec 2004 00:18:57 -0000 1.1 --- p-switch.htm 16 May 2008 09:16:34 -0000 1.2 *************** *** 1,138 **** ! <html> ! <head> ! <meta http-equiv="Content-Language" content="en-gb"> ! <meta name="GENERATOR" content="Chami HTML-Kit 1.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> ! <title>Using Switches</title> ! <style> ! <!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } ! h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } ! --> </style> </head> - <body> - - <h1 align="center"><img border="0" src="FORTHPRO.gif" width="32" height="32"> - Win32Forth</h1> - <h2 align="center"><font face="Tahoma"> - <a href="mailto:win...@ya...?subject=DOC: Doc error in $Id$"> - <img border="0" src="TELLUS.gif" align="left" width="32" height="32"></a>Using - Switches</font></h2> - - Switches are a cross between chains and case structures. Like chains they can - be defined where they need to be compiled and extended by later code. Like case - structures they perform different operations depending on the value on the top - of the stack. Unlike CASE the comparators are stored as a single cell so cannot - be a non-constant value. Also they pass the input value to a default case if no - match is found in the linked cases, whereas with CASE one has to add code to - handle a default case. - - <h3> STRUCTURE OF A SWITCH </h3> - - <big><pre> - <B>HEADER OF SWITCH SWITCH CELL</B> - | DOSWITCH CFA of SWITCH - | SWITCH LINK First case/null ---> SWITCH LINK Next case/null ---> - | XT Default COMPARATOR Value to match - | SWITCHES LINK Next switch/null __ XT Word to run if matched - V | - V - </pre></big> - <h3> GLOSSARY </h3> - <big><pre> - .SWITCH xt -- FORTH SYSTEM - </pre></big> - Print out all the conditions defined for this switch.Using SEE -< name >- on a - switch has the same effect.Conditions are listed default first followed by the - others with in the order they are found i.e. the later they are defined the - earlier they are in the list. - <big><pre> - .SWITCHES FORTH SYSTEM - </pre></big> - Print out all the defined switches.The more recently a switch has been defined - the earlier it comes in the list. - <big><pre> - :SWITCH xt -<name>- -- FORTH SYSTEM - </pre></big> - Define a switch -<name>- that executes the procedure whose xt is on the stack ( with - the input argument on top of the stack ) if no - matching condition has been added to the switch and open it for adding - conditions. - <big><pre> - RUN: head n -<words ;>- -- head FORTH SYSTEM - </pre></big> - Add a condition to the currently open switch structure that runs the following - forth words up to ; if the value n is passed to the switch. An error occurs if head - is not the head of the currently open switch, or no switch is open. - <big><pre> - RUNS head n -<word>- -- head FORTH SYSTEM - </pre></big> - Add a condition to the currently open switch structure that runs -<word>- if the - value n is passed to the switch. An error occurs if head - is not the head of the currently open switch, or no switch is open. - <big><pre> - SWITCH: -<name>- -<words ;>- -- head FORTH SYSTEM - </pre></big> - Define a switch -<name>- that executes the following forth words up to ; if no - matching condition has been added to the switch and open it for adding - conditions.The forth words can call the switch -<name>- as a recursive call - either with -<name>- or RECURSE. - <big><pre> - SWITCH] head -- FORTH SYSTEM - </pre></big> - Close the currently open switch structure. An error occurs if head is not the - head of the currently open switch. - <big><pre> - [+SWITCH -<switch>- -- head FORTH SYSTEM - </pre></big> - Open the named switch for additional conditions. - <big><pre> - [SWITCH -<name>- -<default>- -- head FORTH SYSTEM - </pre></big> - Define a switch -<name>- that executes -<default>- if no matching condition has - been added to the switch and open it for adding conditions. - - <h3> SOME EXAMPLES OF SWITCHES </h3> - <pre><code> - SWITCH: FACTORIAL ( n -- factorial ) - dup 1- factorial * ; \ Recursive call n <> 1 and n <> 0 - 0 runs 1 \ Base conditions:Note 1 is a constant - 1 runs 1 - switch] - </code></pre> - <p> - An implimentation of the classic recursive FACTORIAL function using SWITCH: - that is about 15% faster than the standard recursive version, while only taking - 16 cells ( the same as the standard version ). - </p> - <code><pre> [SWITCH FOO-ERROR throw SWITCH] ! : (FOO) -<Some code>- ; : FOO ['] (foo) catch foo-error ; ! </pre></code> ! <p> ! An extensible error handler. Initially any errors are simply thrown to the ! previous CATCH but adding extra conditions means they are caught and handled by ! FOO, since 0 THROW drops the 0 and carries on. You can even add a success ! condition e.g. ! </p> ! <code> ! [+SWITCH FOO-ERROR 0 run: ." Hip, Hip, Hoorah I've done it" ; SWITCH] ! </code> ! <p> ! if you want. ! </p> ! <a href=#top>Back to Top</a> ! <hr> ! <p>Document $Id$</p> ! <p> </p> ! <p> </p> ! </body> ! </html> --- 1,86 ---- ! <?xml version="1.0"?> ! <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" ! "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> ! <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> ! <meta name="GENERATOR" content="dexh v03"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> ! <title> ! W32F switch</title><style><!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } ! h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> + <body><h1 align="center"> + <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id$"> + <img border="0" src="TELLUS.gif" align="left" width="32" height="32"></a> + <img border="0" src="FORTHPRO.gif" + width="32" height="32"> Win32Forth</h1> + <hr /><h1>Using Switches + </h1><hr /><p>Switches are a cross between chains and case structures. Like chains they can be defined where they need to be + compiled and extended by later code. Like case structures they perform different operations depending on the + value on the top of the stack. Unlike CASE the comparators are stored as a single cell so cannot be a + non-constant value. Also they pass the input value to a default case if no match is found in the linked cases, + whereas with CASE one has to add code to handle a default case. For more information on switches see + Forth Dimensions Volume 20 Issue 3 (Page 19 onwards). + </p><h2>STRUCTURE OF A SWITCH + </h2><pre>HEADER OF SWITCH SWITCH CELL + | DOSWITCH CFA of SWITCH + | SWITCH LINK First case/null ---> SWITCH LINK Next case/null ---> + | XT Default COMPARATOR Value to match + | SWITCHES LINK Next switch/null __ XT Word to run if matched + V | + V + </pre><h2>GLOSSARY + </h2><pre><b><a name="0">: :SWITCH ( xt -<name>- -- head ) FORTH SYSTEM + </a></b></pre><p>Define a switch -<name>- that executes the procedure whose xt is on the stack ( with the input argument on top + of the stack ) if no matching condition has been added to the switch and open it for adding conditions. + </p><pre><b><a name="1">: [SWITCH ( -<name>- -<default>- -- head ) FORTH SYSTEM + </a></b></pre><p>Define a new switch -<name>- whose default action is -<default>- and open + it for adding conditions. + </p><pre><b><a name="2">: SWITCH: ( -<name>- -<code ;>- -- head ) FORTH SYSTEM + </a></b></pre><p>Define a new switch -<name>- whose default action is the following inline + forth code (up to the terminating ;). The forth words can call the switch + -<name>- as a recursive call with -<name>- . + </p><pre><b><a name="3">: [+SWITCH ( -<name>- -- head ) FORTH SYSTEM + </a></b></pre><p>Open existing SWITCH -<name>- for additional conditions. + </p><pre><b><a name="4">: SWITCH] ( head -- ) FORTH SYSTEM + </a></b></pre><p>Close SWITCH structure. An error occurs if head is not the head of the currently open switch. + </p><pre><b><a name="5">: RUNS ( head n -<word>- -- head ) FORTH SYSTEM + </a></b></pre><p>Add a condition to the currently open switch structure that runs -<word>- if the value n is passed to the + switch. An error occurs if head is not the head of the currently open switch, or no switch is open. + </p><pre><b><a name="6">: RUN: ( head n -<words ;>- -- head ) FORTH SYSTEM + </a></b></pre><p>Add a condition to the currently open switch structure that runs the following forth words up to ; if the + value n is passed to the switch. An error occurs if head is not the head of the currently open switch, or no + switch is open. + </p><pre><b><a name="7">: .SWITCH ( xt -- ) FORTH SYSTEM + </a></b></pre><p>Print out all the conditions defined for this switch.Using SEE -< name >- on a switch has the same effect. + Conditions are listed default first followed by the others with in the order they are found i.e. the later + they are defined the earlier they are in the list. + </p><pre><b><a name="8">: .SWITCHES FORTH SYSTEM + </a></b></pre><p>Print out all the defined switches.The more recently a switch has been defined the earlier it comes in the + list. + </p><h2>SOME EXAMPLES OF SWITCHES + </h2><pre>SWITCH: FACTORIAL ( n -- factorial ) + dup 1- factorial * ; \ Recursive call n <> 1 and n <> 0 + 0 runs 1 \ Base conditions:Note 1 is a constant + 1 runs 1 + switch] + An implimentation of the classic recursive FACTORIAL function using SWITCH: that is about 15% faster than + the standard recursive version, while only taking 16 cells ( the same as the standard version ). [SWITCH FOO-ERROR throw SWITCH] ! : (FOO) -&ltSome code>- ; : FOO ['] (foo) catch foo-error ; ! An extensible error handler. Initially any errors are simply thrown to the previous CATCH but adding extra ! conditions means they are caught and handled by FOO, since 0 THROW drops the 0 and carries on. You can even ! add a success condition e.g. ! [+SWITCH FOO-ERROR 0 run: ." Hip, Hip, Hoorah I've done it" ; SWITCH] ! if you want. ! ! </pre><hr><p>Document $Id$</p> ! </body></html> |
|
From: George H. <geo...@us...> - 2008-05-16 09:14:38
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31754/win32forth/src/lib Modified Files: switch.f Log Message: gah: corrected some stack comments and dexed file. Index: switch.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/switch.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** switch.f 20 Jun 2005 07:40:48 -0000 1.2 --- switch.f 16 May 2008 09:14:28 -0000 1.3 *************** *** 27,30 **** --- 27,53 ---- \ See Switches.txt for information about switches + \ *! p-switch W32F switch + \ *T Using Switches + + \ *P Switches are a cross between chains and case structures. Like chains they can be defined where they need to be + \ ** compiled and extended by later code. Like case structures they perform different operations depending on the + \ ** value on the top of the stack. Unlike CASE the comparators are stored as a single cell so cannot be a + \ ** non-constant value. Also they pass the input value to a default case if no match is found in the linked cases, + \ ** whereas with CASE one has to add code to handle a default case. For more information on switches see + \ ** Forth Dimensions Volume 20 Issue 3 (Page 19 onwards). + + \ *S STRUCTURE OF A SWITCH + + \ *E HEADER OF SWITCH SWITCH CELL + \ ** | DOSWITCH CFA of SWITCH + \ ** | SWITCH LINK First case/null ---> SWITCH LINK Next case/null ---> + \ ** | XT Default COMPARATOR Value to match + \ ** | SWITCHES LINK Next switch/null __ XT Word to run if matched + \ ** V | + \ ** V + + \ *S GLOSSARY + + Only Forth also definitions decimal \ gah 14mar03 Make sure of search order *************** *** 64,70 **** external ! \ Define a new switch -<name>- whose default action is xt and open it for ! \ adding conditions ! : :SWITCH ( xt -<name>- -- head ) NOSTACK (SWITCH) HERE 0 , SWAP , --- 87,93 ---- external ! : :SWITCH ( xt -<name>- -- head ) \ FORTH SYSTEM ! \ *G Define a switch -<name>- that executes the procedure whose xt is on the stack ( with the input argument on top ! \ ** of the stack ) if no matching condition has been added to the switch and open it for adding conditions. NOSTACK (SWITCH) HERE 0 , SWAP , *************** *** 72,78 **** dup to current-switch ; \ gah 9mar03 for security ! \ Define a new switch -<name>- whose default action is -<default>- and open ! \ it for adding conditions ! : [SWITCH ( -<name>- -- head ) nostack \ rbs (switch) HERE 0 , ' , --- 95,101 ---- dup to current-switch ; \ gah 9mar03 for security ! : [SWITCH ( -<name>- -<default>- -- head ) \ FORTH SYSTEM ! \ *G Define a new switch -<name>- whose default action is -<default>- and open ! \ ** it for adding conditions. nostack \ rbs (switch) HERE 0 , ' , *************** *** 81,87 **** ; ! \ Define a new switch -<name>- whose default action is the following inline ! \ forth code ! : SWITCH: ( -<name>- -<code ;>- -- head ) \ gah 13mar03 nostack (switch) here 0 , dup to current-switch --- 104,112 ---- ; ! \ gah 13mar03 ! : SWITCH: ( -<name>- -<code ;>- -- head ) \ FORTH SYSTEM ! \ *G Define a new switch -<name>- whose default action is the following inline ! \ ** forth code (up to the terminating ;). The forth words can call the switch ! \ ** -<name>- as a recursive call with -<name>- . nostack (switch) here 0 , dup to current-switch *************** *** 95,101 **** \ gah 23mar03 eliminated <SWITCH ! ! \ Open existing SWITCH -<name>- for additional conditions ! : [+SWITCH ( -<name>- -- head ) nostack \ rbs turn off stack checking ' dup @ doswitch = 0= \ gah 3mar03 added test for valid switch --- 120,125 ---- \ gah 23mar03 eliminated <SWITCH ! : [+SWITCH ( -<name>- -- head ) \ FORTH SYSTEM ! \ *G Open existing SWITCH -<name>- for additional conditions. nostack \ rbs turn off stack checking ' dup @ doswitch = 0= \ gah 3mar03 added test for valid switch *************** *** 105,122 **** internal ! \ Error if switch not open for additional conditions ! : SWITCH-OPEN current-switch 0= abort" No switch is open !" ; - \ Error if not link : NOT-LINK ( head n -- head n ) over current-switch <> abort" Not valid switch link !" ; ! \ Check for errors ! : RUN-ERROR switch-open not-link ; external ! \ Close SWITCH structure ! : SWITCH] ( head -- ) switch-open dup current-switch <> abort" Not trying to close valid switch !" --- 129,148 ---- internal ! : SWITCH-OPEN ( -- ) ! \ Error if switch not open for additional conditions. ! current-switch 0= abort" No switch is open !" ; : NOT-LINK ( head n -- head n ) + \ Error if not link. over current-switch <> abort" Not valid switch link !" ; ! : RUN-ERROR ( -- ) ! \ Check for errors. ! switch-open not-link ; external ! : SWITCH] ( head -- ) \ FORTH SYSTEM ! \ *G Close SWITCH structure. An error occurs if head is not the head of the currently open switch. switch-open dup current-switch <> abort" Not trying to close valid switch !" *************** *** 124,134 **** 0 to current-switch DROP ; ! \ Add a condition that runs -<word>- ! : RUNS ( head n -<word>- -- ) run-error ' 3reverse dup link, -rot , , ; ! \ Add a condition that runs the code up to ; ! : RUN: ( head n -<words ;>- -- ) run-error over link, , here cell allot --- 150,163 ---- 0 to current-switch DROP ; ! : RUNS ( head n -<word>- -- head ) \ FORTH SYSTEM ! \ *G Add a condition to the currently open switch structure that runs -<word>- if the value n is passed to the ! \ ** switch. An error occurs if head is not the head of the currently open switch, or no switch is open. run-error ' 3reverse dup link, -rot , , ; ! : RUN: ( head n -<words ;>- -- head ) \ FORTH SYSTEM ! \ *G Add a condition to the currently open switch structure that runs the following forth words up to ; if the ! \ ** value n is passed to the switch. An error occurs if head is not the head of the currently open switch, or no ! \ ** switch is open. run-error over link, , here cell allot *************** *** 137,142 **** internal - \ trim down the switch linked list : trim-switches ( nfa -- nfa ) switch-link begin @ ?dup --- 166,171 ---- internal : trim-switches ( nfa -- nfa ) + \ trim down the switch linked list. switch-link begin @ ?dup *************** *** 148,159 **** defined unknown? nip 0= [IF] - \ Return true if xt is an unnamed definition : UNKNOWN? ( xt -- f ) >NAME NAME> ['] [UNKNOWN] = ; [THEN] - \ Print out a condition : .CONDITION ( link -- ) dup cell+ @ . cell+ Cell+ @ dup unknown? if ." RUN:" >body .pfa --- 177,188 ---- defined unknown? nip 0= [IF] : UNKNOWN? ( xt -- f ) + \ Return true if xt is an unnamed definition. >NAME NAME> ['] [UNKNOWN] = ; [THEN] : .CONDITION ( link -- ) + \ Print out a condition. dup cell+ @ . cell+ Cell+ @ dup unknown? if ." RUN:" >body .pfa *************** *** 161,181 **** then cr ; - \ Print out all conditions : .CONDITIONS ( link -- ) cr begin ?dup While dup .condition @ repeat ; - \ Print default : .DEFAULT ( xt -- ) ." default ( n -- ) " 2 cells + @ dup unknown? if ." does: " >body .pfa else .name then ; - \ Print Switch : (.SWITCH) ( xt -- ) dup cr .default >body @ .conditions ; - \ Used by SEE : _.SWITCH ( xt -- xt|0) -if dup @ doswitch = if ." is a switch" (.switch) 0 then then ; --- 190,210 ---- then cr ; : .CONDITIONS ( link -- ) + \ Print out all conditions. cr begin ?dup While dup .condition @ repeat ; : .DEFAULT ( xt -- ) + \ Print default. ." default ( n -- ) " 2 cells + @ dup unknown? if ." does: " >body .pfa else .name then ; : (.SWITCH) ( xt -- ) + \ Print Switch. dup cr .default >body @ .conditions ; : _.SWITCH ( xt -- xt|0) + \ Used by SEE. -if dup @ doswitch = if ." is a switch" (.switch) 0 then then ; *************** *** 185,195 **** external ! \ Used interactively ! : .SWITCH ( xt -- ) dup @ doswitch <> abort" expects the xt of a SWITCH" cr dup .name (.switch) ; ! \ Print out list of all switches ! : .SWITCHES cr switch-link begin @ ?dup while dup -3 cells + .switch repeat ; --- 214,227 ---- external ! : .SWITCH ( xt -- ) \ FORTH SYSTEM ! \ *G Print out all the conditions defined for this switch.Using SEE -< name >- on a switch has the same effect. ! \ ** Conditions are listed default first followed by the others with in the order they are found i.e. the later ! \ ** they are defined the earlier they are in the list. dup @ doswitch <> abort" expects the xt of a SWITCH" cr dup .name (.switch) ; ! : .SWITCHES \ FORTH SYSTEM ! \ *G Print out all the defined switches.The more recently a switch has been defined the earlier it comes in the ! \ ** list. cr switch-link begin @ ?dup while dup -3 cells + .switch repeat ; *************** *** 197,202 **** internal also bug - \ Nest into switch when debugging : DBG-NEST-SWITCH ( xt false | true -- xt false | true ) dup ?exit \ exit if already dealt with over @ doswitch = if drop ." SWITCH nesting " \ is this a switch --- 229,234 ---- internal also bug : DBG-NEST-SWITCH ( xt false | true -- xt false | true ) + \ Nest into switch when debugging. dup ?exit \ exit if already dealt with over @ doswitch = if drop ." SWITCH nesting " \ is this a switch *************** *** 213,218 **** \in-system-ok dbg-nest-chain chain-add dbg-nest-switch - \ Print this is a switch : .WORD-TYPE-SWITCH ( xt false | true -- xt false | true ) dup ?exit over @ doswitch = if --- 245,250 ---- \in-system-ok dbg-nest-chain chain-add dbg-nest-switch : .WORD-TYPE-SWITCH ( xt false | true -- xt false | true ) + \ Print this is a switch. dup ?exit over @ doswitch = if *************** *** 226,228 **** in-application ! |
|
From: Mikrot <Man...@7a...> - 2008-05-15 11:20:02
|
Forget exercises or other techniques, the only thing that really increases size is herbal http://www.posieigi.com/ |
|
From: Housego <lei...@Vi...> - 2008-05-13 20:05:36
|
Top quality medication at factory-direct prices, healthcare for the masses http://www.allsteans.com/ |
|
From: Bourn <tsy...@BM...> - 2008-05-10 12:17:05
|
She will wrap her lips around your shaft http://www.buoeaig.com/ |
|
From: Fredrickson <fas...@JS...> - 2008-05-07 12:58:38
|
Limited period promo: Buy 4 bottles of express herbal and get 2 free http://www.rahoame.com/ |
|
From: Ezra B. <ezr...@us...> - 2008-05-04 18:13:29
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17219 Modified Files: CommandID.f EdFORTHFORM.F FORMOBJECT.F FORMPROPERTY.F Log Message: Bug fix #3 :-) Plus a little enhancement. Index: EdFORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdFORTHFORM.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** EdFORTHFORM.F 2 May 2008 02:00:23 -0000 1.2 --- EdFORTHFORM.F 4 May 2008 18:13:25 -0000 1.3 *************** *** 53,57 **** 0 value NextControlType \ next control to be created false value newcontrol? - \ 0 value statuswindow \ pointer to status window object 0 value picturebmp 0 value staticbmp --- 53,56 ---- *************** *** 74,81 **** \ status labels Label lblControlName - Label lblSize Label lblPosition ! Label lblFormName Label lblModified --- 73,80 ---- \ status labels + Label lblFormName Label lblControlName Label lblPosition ! Label lblSize Label lblModified *************** *** 110,114 **** join$( s" X= " x >str ! s" " s" Y= " y (.) --- 109,113 ---- join$( s" X= " x >str ! s" " s" Y= " y (.) *************** *** 231,235 **** FileOpenDialog GetBitmapDlg "Get Bitmap" "Bitmap Files|*.bmp;*.dib|" ! needs edformwindow.f \ form toolbar etc. \ all ForthForm dialogs needs ControlProperty.frm --- 230,234 ---- FileOpenDialog GetBitmapDlg "Get Bitmap" "Bitmap Files|*.bmp;*.dib|" ! needs edformwindow.f \ form designer window \ all ForthForm dialogs needs ControlProperty.frm *************** *** 320,324 **** then ; IDM_FORM_Open SetCommand ! : EditForm ( -- ) \ view/edit form ActiveForm 0= ?exit GetBuffer: ActiveForm FormName: ActiveForm count ShowSource ; IDM_FORM_EDITOR SetCommand --- 319,323 ---- then ; IDM_FORM_Open SetCommand ! : EditForm ( -- ) \ view/edit form source code ActiveForm 0= ?exit GetBuffer: ActiveForm FormName: ActiveForm count ShowSource ; IDM_FORM_EDITOR SetCommand *************** *** 405,414 **** Close: frmProperties++ FormList Dispose 0 to FormList else SetFocus: [ Data@: FormList ] ActiveControl: Activeform if UpdatePropertyWindow then ! then #Forms 2 < ! if Close: frmCreatePropertyForm then doUpdate ; IDM_FORM_Close SetCommand --- 404,416 ---- Close: frmProperties++ FormList Dispose 0 to FormList + ActiveChild 0= \ no other file opened + if WindowTitle: MainWindow zcount SetText: MainWindow + then else SetFocus: [ Data@: FormList ] ActiveControl: Activeform if UpdatePropertyWindow then ! then #Forms 2 < \ less than two forms opened ! if Close: frmCreatePropertyForm \ makes no sense then doUpdate ; IDM_FORM_Close SetCommand *************** *** 421,433 **** Repeat ; IDM_FORM_CloseAll SetCommand ! : AddOpenForms ( -- ) #Forms ?dup if 1+ 1 do i >Link#: FormList ! TextFile: [ Data@: FormList ] ! 2dup s" untitled.frm" istr= not ! if AddForm: TheProject ! else 2drop ! then loop then ; IDM_ADD_FORMS_PRJ SetCommand --- 423,437 ---- Repeat ; IDM_FORM_CloseAll SetCommand ! : AddFormToProject ( form -- ) \ include in project ! TextFile: [ ] 2dup s" untitled.frm" istr= not ! if AddForm: TheProject ! else 2drop ! then ; IDM_FORM_AddToProject SetCommand ! ! : AddOpenForms ( -- ) \ include all open forms in project #Forms ?dup if 1+ 1 do i >Link#: FormList ! Data@: FormList AddFormToProject loop then ; IDM_ADD_FORMS_PRJ SetCommand *************** *** 449,453 **** then ; IDM_FORM_WriteAll SetCommand - \ Session file loading definitions \ A session file is a standard text file defining the current state of the system --- 453,456 ---- Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMOBJECT.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FORMOBJECT.F 28 Apr 2008 05:17:17 -0000 1.1 --- FORMOBJECT.F 4 May 2008 18:13:25 -0000 1.2 *************** *** 26,29 **** --- 26,30 ---- MenuItem "Save (.ff)" IDM_FORM_SAVE DoCommand ; MenuItem "Compile (.frm)" IDM_FORM_WRITE DoCommand ; + MenuItem "Add To Project" ActiveForm IDM_FORM_AddToProject DoCommand ; :MenuItem mnu_lock "View Only" Lock: ActiveForm ; MenuSeparator *************** *** 1080,1084 **** locked? ?exitm \ if form is locked disable sizing width to frmWidth height to frmHeight ! firsttime? not \ ignore sizing message when when window is created if modified else false to firsttime? --- 1081,1085 ---- locked? ?exitm \ if form is locked disable sizing width to frmWidth height to frmHeight ! firsttime? not \ ignore sizing message when window is created if modified else false to firsttime? Index: CommandID.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/CommandID.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** CommandID.f 28 Apr 2008 05:17:15 -0000 1.13 --- CommandID.f 4 May 2008 18:13:25 -0000 1.14 *************** *** 190,193 **** --- 190,194 ---- NewId IDM_FORM_TABCONTROL NewID IDM_SHOW_FORMTAB + NewID IDM_FORM_AddToProject IdCounter constant IDM_LAST Index: FORMPROPERTY.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/FORMPROPERTY.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FORMPROPERTY.F 28 Apr 2008 05:17:17 -0000 1.1 --- FORMPROPERTY.F 4 May 2008 18:13:25 -0000 1.2 *************** *** 381,384 **** --- 381,389 ---- ;M + :M WindowStyle: ( -- style ) + WindowStyle: Super + WS_MINIMIZEBOX or \ allow moving out of the way + ;M + ;Object |
|
From: Ezra B. <ezr...@us...> - 2008-05-04 18:13:29
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17219/Forms Modified Files: EdPreferences.ff EdPreferences.frm Log Message: Bug fix #3 :-) Plus a little enhancement. Index: EdPreferences.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/EdPreferences.frm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EdPreferences.frm 28 Apr 2008 05:13:38 -0000 1.1 --- EdPreferences.frm 4 May 2008 18:13:25 -0000 1.2 *************** *** 98,102 **** self Start: grpFormOptions ! 191 103 175 94 Move: grpFormOptions Handle: Winfont SetFont: grpFormOptions s" Form Designer" SetText: grpFormOptions --- 98,102 ---- self Start: grpFormOptions ! 191 98 175 99 Move: grpFormOptions Handle: Winfont SetFont: grpFormOptions s" Form Designer" SetText: grpFormOptions Index: EdPreferences.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Forms/EdPreferences.ff,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsWdUCIE and /tmp/cvsexcQzV differ |
|
From: Angelbert <ore...@LA...> - 2008-05-04 10:49:05
|
Guaranteed size increase or your money back. Try herbal express today http://www.mubleae.com/ |
|
From: Dirk B. <db...@us...> - 2008-05-03 08:44:15
|
Update of /cvsroot/win32forth/win32forth/apps/Solipon2 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15557/apps/Solipon2 Modified Files: FileIO.f Menu.f SOLIPION.F Log Message: New menu entry "Random board" added to the "Game" menu of "Solipion". If this menu entry is selected you'll get an random board with a random count of pawns every time you start a new game. Index: Menu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/Menu.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Menu.f 30 Apr 2008 15:58:01 -0000 1.1 --- Menu.f 3 May 2008 08:44:05 -0000 1.2 *************** *** 37,40 **** --- 37,45 ---- + defer EnableMenuBar + + : (random-board?) + random-board? 0= to random-board? EnableMenuBar ; + POPUPBAR Solipion-Popup-bar *************** *** 43,46 **** --- 48,53 ---- MENUITEM "&Automatic Game " 'A' +k_control pushkey ; MENUSEPARATOR + :MenuItem mp_random1 "&Random board" (random-board?) ; + MENUSEPARATOR MENUITEM "&Open " 'O' +k_control pushkey ; MENUITEM "&Re-open " 'R' +k_control pushkey ; *************** *** 61,64 **** --- 68,73 ---- MENUITEM "&Automatic \tCtrl+A" 'A' +k_control pushkey ; MENUSEPARATOR + :MenuItem mp_random2 "&Random board" (random-board?) ; + MENUSEPARATOR MENUITEM "&Open... \tCtrl+O" 'O' +k_control pushkey ; MENUITEM "&Re-Open \tCtrl+R" 'R' +k_control pushkey ; *************** *** 76,77 **** --- 85,91 ---- MENUITEM "SoliPion" k_F1 +k_control pushkey ; ENDBAR + + :noname ( -- ) \ enable/disable the menu items + random-board? Check: mp_random1 + random-board? Check: mp_random2 + ; is EnableMenuBar Index: FileIO.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/FileIO.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FileIO.f 30 Apr 2008 15:58:01 -0000 1.1 --- FileIO.f 3 May 2008 08:44:05 -0000 1.2 *************** *** 13,48 **** : nothing false ; ' nothing is !bests ! 0 value gameloaded? ! : open-game { \ open$ hfile -- } ! max-path LocalAlloc: open$ ! GetHandle: SOLIPIONW Start: OpenGame dup c@ \ ( -- a1 n1 ) ! IF count open$ place ! open$ count r/w open-file abort" open-file" to hfile ! smallstring 19 hfile read-file 2drop ! smallstring 3 s" SOL" compare 0= dup if true to put-by? then ! smallstring 3 s" PLA" compare 0= dup if false to put-by? then ! or ! IF ! string-player-name 20 hfile read-file 2drop ! &of shift-x cell hfile read-file 2drop ! &of shift-y cell hfile read-file 2drop ! &of moves cell hfile read-file 2drop ! moves-table moves cells hfile read-file 2drop ! THEN ! true to show? ! moves 1- dup dup max-counter > if ! to max-counter to counter !bests ! else 2drop ! then ! hfile close-file drop ! true to gameloaded? ! ELSE DROP THEN ! ; \ --------------------------------------------------------------- --- 13,58 ---- : nothing false ; ' nothing is !bests ! 0 value gameloaded? ! : (load-game) ( addr len -- ) ! { \ hfile -- } ! r/w open-file abort" open-file" to hfile ! smallstring 19 hfile read-file 2drop ! smallstring 3 s" SOL" compare 0= dup if true to put-by? then ! smallstring 3 s" PLA" compare 0= dup if false to put-by? then ! or ! IF string-player-name 20 hfile read-file 2drop ! &of shift-x cell hfile read-file 2drop ! &of shift-y cell hfile read-file 2drop ! &of moves cell hfile read-file 2drop ! moves-table moves cells hfile read-file 2drop + \ for the Thing... + coords2 72 cells hfile read-file drop 0<> + if &of max-pawns cell hfile read-file drop 0<> + else false + then to random-board? THEN + hfile close-file drop + ; ! : open-game { \ open$ hfile -- } ! max-path LocalAlloc: open$ ! GetHandle: SOLIPIONW Start: OpenGame dup c@ \ ( -- a1 n1 ) ! IF count open$ place ! ! open$ count (load-game) ! ! true to show? ! moves 1- dup dup max-counter > ! if to max-counter to counter !bests ! else 2drop ! then ! ! true to gameloaded? ! ELSE DROP ! THEN ; \ --------------------------------------------------------------- *************** *** 50,79 **** \ --------------------------------------------------------------- ! : (re-open-game) { \ open$ hfile -- } ! max-path LocalAlloc: open$ ! in-memory? ! IF counter 1+ to moves ! ELSE ! S" GAME.SOL" open$ place ! open$ count r/w open-file abort" open-file" to hfile ! smallstring 3 hfile read-file 2drop ! smallstring 3 s" SOL" compare 0= dup if true to put-by? then ! smallstring 3 s" PLA" compare 0= dup if false to put-by? then ! or ! IF ! smallstring 16 hfile read-file 2drop ! string-player-name 20 hfile read-file 2drop ! &of shift-x cell hfile read-file 2drop ! &of shift-y cell hfile read-file 2drop ! &of moves cell hfile read-file 2drop ! moves-table moves cells hfile read-file 2drop ! ! THEN ! hfile close-file drop ! THEN ! 0 to tempo false to show? ! ; ! ' (re-open-game) is re-open-game \ --------------------------------------------------------------- --- 60,71 ---- \ --------------------------------------------------------------- ! :noname ( -- ) ! 0 to tempo ! false to show? ! in-memory? ! IF counter 1+ to moves ! ELSE S" GAME.SOL" (load-game) ! THEN ; is re-open-game \ --------------------------------------------------------------- *************** *** 81,108 **** \ --------------------------------------------------------------- ! : (save-game) { \ save$ hfile -- } ! max-path LocalAlloc: save$ \ ! in-memory? ! if counter 1+ to moves ! else ! s" GAME.SOL" save$ place ! save$ count r/w create-file abort" create-file" to hfile ! put-by? ! if s" PLA" ! else s" SOL" ! then hfile write-file drop ! get-local-time ! time-buf 16 hfile write-file drop ! string-player-name 20 hfile write-file drop ! &of shift-x cell hfile write-file drop ! &of shift-y cell hfile write-file drop ! counter 1+ to moves ! &of moves cell hfile write-file drop ! moves-table moves cells hfile write-file drop ! hfile close-file drop ! then ! ; ! ' (save-game) is save-game \ --------------------------------------------------------------- --- 73,106 ---- \ --------------------------------------------------------------- ! : (save-game) ( addr len -- ) ! { \ hfile -- } ! r/w create-file abort" create-file" to hfile ! put-by? ! if s" PLA" ! else s" SOL" ! then hfile write-file drop ! get-local-time ! time-buf 16 hfile write-file drop ! string-player-name 20 hfile write-file drop ! &of shift-x cell hfile write-file drop ! &of shift-y cell hfile write-file drop ! counter 1+ to moves ! &of moves cell hfile write-file drop ! moves-table moves cells hfile write-file drop ! ! random-board? ! if coords2 72 cells hfile write-file drop // for the Thing... ! &of max-pawns cell hfile write-file drop ! then ! ! hfile close-file drop ! ; ! ! :noname ( -- ) ! in-memory? ! if counter 1+ to moves ! else s" GAME.SOL" (save-game) ! then ; is save-game \ --------------------------------------------------------------- *************** *** 110,148 **** \ --------------------------------------------------------------- - : save-game-as { \ hfile save$ -- } max-path LocalAlloc: save$ ! s" Save the Game As : " save$ place ! save$ count SetTitle: SaveGame auto-save? ! if ! counter 0 <# # # # #> save$ place ! s" .SOL" save$ +place ! save$ count delete-file drop ! save$ dup c@ ! else ! GetHandle: SOLIPIONW Start: SaveGame dup c@ \ ( -- a1 n1 ) then ! IF ! count r/w create-file abort" create-file" to hfile ! put-by? if s" SOL" ! else s" PLA" ! then hfile write-file drop ! ! get-local-time ! time-buf 16 hfile write-file drop ! string-player-name 20 hfile write-file drop ! &of shift-x cell hfile write-file drop ! &of shift-y cell hfile write-file drop ! counter 1+ to moves ! &of moves cell hfile write-file drop ! moves-table moves cells hfile write-file drop ! hfile close-file drop ! ELSE ! drop ! THEN ! ! ; \ --------------------------------------------------------------- --- 108,127 ---- \ --------------------------------------------------------------- + : save-game-as { \ save$ -- } max-path LocalAlloc: save$ ! auto-save? ! if counter 0 <# # # # #> save$ place ! s" .SOL" save$ +place ! save$ count delete-file drop ! save$ dup c@ ! else s" Save the Game As : " SetTitle: SaveGame ! GetHandle: SOLIPIONW Start: SaveGame dup c@ \ ( -- a1 n1 ) then ! IF count (save-game) ! ELSE drop ! THEN ; \ --------------------------------------------------------------- Index: SOLIPION.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/SOLIPION.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** SOLIPION.F 30 Apr 2008 15:58:00 -0000 1.8 --- SOLIPION.F 3 May 2008 08:44:05 -0000 1.9 *************** *** 46,50 **** FALSE value yahoo-already? 0 value auto? - 0 value #toolbar? TRUE value put-by? 0 value hypothesis? --- 46,49 ---- *************** *** 56,59 **** --- 55,63 ---- 0 value dy FALSE value auto-save? + TRUE value best? + 500 value startsize + FALSE value same-thing? + FALSE value random-board? \ get a random board each time you start the game :) + 72 value max-pawns \ --------------------------------------------------------------- *************** *** 61,65 **** \ --------------------------------------------------------------- ! needs lib\BitmapDC.f bitmap-dc solipion-dc --- 65,69 ---- \ --------------------------------------------------------------- ! needs BitmapDC.f bitmap-dc solipion-dc *************** *** 90,96 **** ;Class ! \ --------------------------------------------------------------- ! \ Menu, Popup ... ! \ --------------------------------------------------------------- needs menu.f --- 94,100 ---- ;Class ! \ ------------------------------------------------------------------------------ ! \ Menu, Popup, Toolbar ... ! \ ------------------------------------------------------------------------------ needs menu.f *************** *** 103,112 **** \ ------------------------------------------------------------------------------ - \ the main window \ ------------------------------------------------------------------------------ ! defer save-game ' noop is save-game ! defer re-open-game ' noop is re-open-game ! defer Unroll ' noop is Unroll :Object SOLIPIONW <super window --- 107,119 ---- \ ------------------------------------------------------------------------------ \ ------------------------------------------------------------------------------ ! defer save-game ! defer re-open-game ! defer Unroll ! ! \ ------------------------------------------------------------------------------ ! \ the main window ! \ ------------------------------------------------------------------------------ :Object SOLIPIONW <super window *************** *** 143,147 **** :M MinSize: ( -- width height ) \ minimum window size ! StartSize: Solipion-Tool-bar1 >r 380 max r> 380 + ;M :M StartSize: ( -- width height ) --- 150,154 ---- :M MinSize: ( -- width height ) \ minimum window size ! StartSize: Solipion-Tool-bar1 >r StartSize max r> StartSize + ;M :M StartSize: ( -- width height ) *************** *** 241,247 **** ;Object - : uninit-solipion ( -- ) - DestroyWindow: SOLIPIONW ; - unload-chain chain-add-before uninit-solipion \ --------------------------------------------------------------- --- 248,251 ---- *************** *** 254,260 **** \ --------------------------------------------------------------- - : refresh ( -- ) - Refresh: solipionw ; - : temporizing ( -- ) winpause? --- 258,261 ---- *************** *** 264,272 **** \ --------------------------------------------------------------- - \ --------------------------------------------------------------- - - needs FileIO.f - - \ --------------------------------------------------------------- \ New Game \ --------------------------------------------------------------- --- 265,268 ---- *************** *** 286,289 **** --- 282,287 ---- create coords2 72 allot \ for the thing + needs FileIO.f + font vfont create string4$ cell allot *************** *** 396,400 **** THEN ! refresh temporizing showing? 0= to showing? --- 394,398 ---- THEN ! Refresh: SOLIPIONW temporizing showing? 0= to showing? *************** *** 417,451 **** ; - 0 value Same-Thing? - : Thing ( -- ) - tempo >r 0 to tempo ! 72 0 ! do ! Same-Thing? if ! coords2 i + c@ to nRaw ! coords2 i 1+ + c@ to nLine ! else ! 8 random 6 + dup coords2 i + c! to nRaw ! 8 random 6 + dup coords2 i 1+ + c! to nLine ! then ! pawn ! -1 univers nLine 20 * nRaw + + c! ! 2 ! +loop ! r> to tempo ! true to Same-Thing? ; ! \ rank ( 1st,2nd,3rd,4th,5th pawn of the -line- ) ! \ direction ( 1 = west->east 2 = north-west->south-west ! \ 3 = north->south 4 = south-west->north-east ) ! 0 value clean? ! ! ! : -LINE- { row# line# rank# direction# \ last first -- } --- 415,440 ---- ; : Thing ( -- ) tempo >r 0 to tempo ! max-pawns 0 ! do Same-Thing? ! if coords2 i + c@ to nRaw ! coords2 i 1+ + c@ to nLine ! else 8 random 6 + dup coords2 i + c! to nRaw ! 8 random 6 + dup coords2 i 1+ + c! to nLine ! then ! pawn ! -1 univers nLine 20 * nRaw + + c! ! 2 +loop ! r> to tempo ! true to Same-Thing? ; ! \ rank ( 1st,2nd,3rd,4th,5th pawn of the -line- ) ! \ direction ( 1 = west->east 2 = north-west->south-west ! \ 3 = north->south 4 = south-west->north-east ) ! 0 value clean? : -LINE- { row# line# rank# direction# \ last first -- } *************** *** 475,479 **** direction# last first i couleur row# rank# - j + step * i + dx + line# rank# - j + step * step 3 / i - + dy + MoveTo: solipion-dc ! row# rank# - j + 1+ step * step 3 / i - - dx + line# rank# - j + 1+ step * i - dy + LineTo: solipion-dc loop --- 464,468 ---- direction# last first i couleur row# rank# - j + step * i + dx + line# rank# - j + step * step 3 / i - + dy + MoveTo: solipion-dc ! row# rank# - j + 1+ step * step 3 / i - - dx + line# rank# - j + 1+ step * i - dy + LineTo: solipion-dc loop *************** *** 492,496 **** do direction# first last i couleur ! row# rank# - j + step * step 3 / i - + dx + line# rank# + j - step * i - dy + MoveTo: solipion-dc row# rank# - j + 1+ step * i - dx + line# rank# + j - 1- step * step 3 / i - + dy + LineTo: solipion-dc loop --- 481,485 ---- do direction# first last i couleur ! row# rank# - j + step * step 3 / i - + dx + line# rank# + j - step * i - dy + MoveTo: solipion-dc row# rank# - j + 1+ step * i - dx + line# rank# + j - 1- step * step 3 / i - + dy + LineTo: solipion-dc loop *************** *** 499,533 **** endcase loop ! refresh temporizing loop ; ! ! ! TRUE VALUE BEST? : New-Game ( -- ) ! univers 400 erase ! univers1 400 erase ! univers2 400 erase ! univers3 400 erase ! univers4 400 erase ! 0 to counter true to best? ! hypothesis? 0= if ! ReTitle: solipionw ! then TheSmallsDots - Cross ! ; : 0max19min ! 0 max 19 min ! ; : @line { rank# direction# \ -- flag } --- 488,520 ---- endcase loop ! Refresh: SOLIPIONW temporizing loop ; ! : (random) ( u1 u2 -- u3 ) ! \ *G Returns a random number beetween u1 and u2 (including u1 and u2). ! over - random + 1+ ; : New-Game ( -- ) ! univers 400 erase ! univers1 400 erase ! univers2 400 erase ! univers3 400 erase ! univers4 400 erase 0 to counter true to best? ! hypothesis? 0= if ReTitle: solipionw then TheSmallsDots ! random-board? ! if Same-Thing? 0= if 36 72 (random) to max-pawns then Thing ! else Cross ! then ; : 0max19min ! 0 max 19 min ; : @line { rank# direction# \ -- flag } *************** *** 591,597 **** ; - - - : Playable? { \ rank# direction# ppointer -- } busy? ?exit --- 578,581 ---- *************** *** 663,682 **** -LINE- 1 +to counter - - then - - moves 2 - i = if hypothesis? 0= if ReTitle: solipionw then ! refresh temporizing - - then loop ! r> to tempo 0 to size? TRUE to winpause? --- 647,660 ---- -LINE- 1 +to counter then moves 2 - i = if hypothesis? 0= if ReTitle: solipionw then ! Refresh: SOLIPIONW temporizing then loop ! r> to tempo 0 to size? TRUE to winpause? *************** *** 881,888 **** \ --------------------------------------------------------------- \ Print the Positions of the Game (text) - \ --------------------------------------------------------------- - - - \ --------------------------------------------------------------- \ Print the Bitmap of the Game \ --------------------------------------------------------------- --- 859,862 ---- *************** *** 923,926 **** --- 897,902 ---- : initialisations ( -- ) cursor-off + RANDOM-INIT + 256 malloc to smallstring 256 malloc to string-player-name *************** *** 961,966 **** ; - - \ --------------------------------------------------------------- \ The Beginning --- 937,940 ---- *************** *** 971,976 **** BEGIN ! size? if save-game re-open-game ! then auto? if ekey? if ekey --- 945,949 ---- BEGIN ! size? if save-game re-open-game then auto? if ekey? if ekey *************** *** 983,987 **** 'A' +k_control of <<<bleep1>>> auto? 0= to auto? ! auto? if 0 to music? then endof 'W' +k_control of <<<bleep1>>> --- 956,960 ---- 'A' +k_control of <<<bleep1>>> auto? 0= to auto? ! auto? 0= to music? endof 'W' +k_control of <<<bleep1>>> *************** *** 989,993 **** 'N' +k_control of <<<bleep1>>> !bests ! New-Game endof --- 962,966 ---- 'N' +k_control of <<<bleep1>>> !bests ! false to Same-Thing? New-Game endof *************** *** 1012,1016 **** GetHandle: SOLIPIONW Setup: ThePrinter endof ! 'T' +k_control of print-game endof 'B' +k_control of <<<bleep1>>> 16 print-demo-bmp endof --- 985,989 ---- GetHandle: SOLIPIONW Setup: ThePrinter endof ! 'T' +k_control of print-game endof 'B' +k_control of <<<bleep1>>> 16 print-demo-bmp endof *************** *** 1018,1022 **** true to in-memory? step 8 - 8 max to step - \ step 4 / dup +to dx +to dy true to size? --- 991,994 ---- *************** *** 1026,1034 **** k_right +k_control of <<<bleep1>>> true to in-memory? ! ! step 8 + ( 128 min ) to step ! ! ! \ step 4 / negate dup +to dx +to dy true to size? 'E' +k_control pushkey --- 998,1002 ---- k_right +k_control of <<<bleep1>>> true to in-memory? ! step 8 + to step true to size? 'E' +k_control pushkey *************** *** 1078,1084 **** turnkey? [if] - \ NoConsoleIO \ Setup the Console I/O for an application without the console window. - \ NoConsoleInImage \ Tell Imageman that we don't need the w32fconsole.dll. - \ Create the exe-file &forthdir count &appdir place --- 1046,1049 ---- |
|
From: Dirk B. <db...@us...> - 2008-05-03 08:44:15
|
Update of /cvsroot/win32forth/win32forth/proj In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15557/proj Modified Files: Solipon.fpj Log Message: New menu entry "Random board" added to the "Game" menu of "Solipion". If this menu entry is selected you'll get an random board with a random count of pawns every time you start a new game. Index: Solipon.fpj =================================================================== RCS file: /cvsroot/win32forth/win32forth/proj/Solipon.fpj,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Solipon.fpj 23 Jul 2006 10:12:56 -0000 1.1 --- Solipon.fpj 3 May 2008 08:44:06 -0000 1.2 *************** *** 3,11 **** SearchPath= Solipon,0 ! Modules,4 apps\Solipon2\SOLIPION.F ! SRC\old\optimize.f SRC\LIB\Resources.f apps\Solipon2\solidial.F DLLs,0 Forms,0 --- 3,17 ---- SearchPath= Solipon,0 ! Modules,10 apps\Solipon2\SOLIPION.F ! SRC\CONSOLE\NoConsole.f SRC\LIB\Resources.f + SRC\LIB\BitmapDC.f + apps\Solipon2\menu.f + apps\Solipon2\sound.f + apps\Solipon2\About.f + apps\Solipon2\FileIO.f apps\Solipon2\solidial.F + apps\Solipon2\Print.f DLLs,0 Forms,0 *************** *** 13,16 **** Resources,2 apps\Solipon2\SOLIPION.BMP ! apps\Solipon2\solipion.ico Docs,0 --- 19,22 ---- Resources,2 apps\Solipon2\SOLIPION.BMP ! src\res\Win32For.ico Docs,0 |
|
From: Ezra B. <ezr...@us...> - 2008-05-02 23:26:18
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16311 Modified Files: CreatePropertyForm.f Log Message: Bug fix #2 :-) Index: CreatePropertyForm.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/CreatePropertyForm.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CreatePropertyForm.f 28 Apr 2008 05:17:16 -0000 1.1 --- CreatePropertyForm.f 2 May 2008 23:26:14 -0000 1.2 *************** *** 299,305 **** s" anew -psheet" evaluate fload-buffer ! s" Start: " new$ dup>r place ! sheetname count r@ +place ! r> count evaluate ; : command-func { id obj -- } --- 299,305 ---- s" anew -psheet" evaluate fload-buffer ! s" Start: " pad place ! sheetname count pad +place ! pad count evaluate ; : command-func { id obj -- } *************** *** 311,315 **** TheBuffer s" PropertyForm" ShowSource endof ! GetID: btnTest of nostack1 load-sheet endof GetId: btnClose of Close: self endof endcase ; --- 311,315 ---- TheBuffer s" PropertyForm" ShowSource endof ! GetID: btnTest of load-sheet endof GetId: btnClose of Close: self endof endcase ; |
|
From: valentine <Ren...@Mo...> - 2008-05-02 14:29:32
|
Breakthrough with our scientific researched herbal formulas, guaranteed growth in 2 months http://www.fereanu.com/ |
|
From: Ezra B. <ezr...@us...> - 2008-05-02 02:01:04
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5180 Modified Files: EdFORTHFORM.F Log Message: Bug fix #1 :-) Index: EdFORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdFORTHFORM.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EdFORTHFORM.F 28 Apr 2008 05:17:16 -0000 1.1 --- EdFORTHFORM.F 2 May 2008 02:00:23 -0000 1.2 *************** *** 130,133 **** --- 130,134 ---- s" " SetText: lblControlName s" " SetText: lblFormName + s" " SetText: lblModified ; |
|
From: Meik <erv...@18...> - 2008-05-01 14:51:13
|
What do you do when what you have does not match what you say in the male department. http://www.nuatega.com/ |
|
From: Dirk B. <db...@us...> - 2008-04-30 15:58:11
|
Update of /cvsroot/win32forth/win32forth/apps/Solipon2 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8219 Modified Files: SOLIPION.F Added Files: About.f FileIO.f Menu.f Print.f Sound.f Log Message: - Major CleanUp of Solipion. --- NEW FILE: Sound.f --- \ $Id: Sound.f,v 1.1 2008/04/30 15:58:01 dbu_de Exp $ WinLibrary winmm.dll 0 value <hypothesis>busy? 0 value <hypothesis>handle 0 value <hypothesis>flag? 0 value <hypothesis>size : playthat SND_ASYNC SND_MEMORY or SND_NODEFAULT or NULL ROT Call PlaySound drop ; : find-file ( addr len -- addr1 len1 ) search-path off \ clear path list s" ." "fpath+ \ current dir is first &forthdir count "fpath+ s" apps\Solipon2" "fpath+ "path-file drop ; : <<<hypothesis>>> ( -- ) <hypothesis>busy? ?exit true to <hypothesis>busy? <hypothesis>flag? 0= if true to <hypothesis>flag? s" ep7.wav" find-file r/o open-file drop >r r@ file-size drop d>s to <hypothesis>size r@ <hypothesis>size malloc to <hypothesis>handle <hypothesis>handle <hypothesis>size r@ read-file 2drop r> close-file drop then <hypothesis>flag? music? and if <hypothesis>handle playthat then false to <hypothesis>busy? ; 0 value <ding>busy? 0 value <ding>handle 0 value <ding>flag? 0 value <ding>size : <<<ding>>> ( -- ) <ding>busy? ?exit true to <ding>busy? <ding>flag? 0= if true to <ding>flag? s" av7.wav" find-file r/o open-file drop >r r@ file-size drop d>s to <ding>size r@ <ding>size malloc to <ding>handle <ding>handle <ding>size r@ read-file 2drop r> close-file drop then <ding>flag? music? and if <ding>handle playthat then false to <ding>busy? ; 0 value <bleep1>busy? 0 value <bleep1>handle 0 value <bleep1>flag? 0 value <bleep1>size : <<<bleep1>>> ( -- ) <bleep1>busy? ?exit true to <bleep1>busy? <bleep1>flag? 0= if true to <bleep1>flag? s" bleep7.wav" find-file r/o open-file drop >r r@ file-size drop d>s to <bleep1>size r@ <bleep1>size malloc to <bleep1>handle <bleep1>handle <bleep1>size r@ read-file 2drop r> close-file drop then <bleep1>flag? music? and if <bleep1>handle playthat then false to <bleep1>busy? ; 0 value <yahoo>busy? 0 value <yahoo>handle 0 value <yahoo>flag? 0 value <yahoo>size : <<<yahoo>>> ( -- ) <yahoo>busy? ?exit true to <yahoo>busy? <yahoo>flag? 0= if true to <yahoo>flag? s" yahoo.wav" find-file r/o open-file drop >r r@ file-size drop d>s to <yahoo>size r@ <yahoo>size malloc to <yahoo>handle <yahoo>handle <yahoo>size r@ read-file 2drop r> close-file drop then <yahoo>flag? music? and if <yahoo>handle playthat then false to <yahoo>busy? ; 0 value <applause>busy? 0 value <applause>handle 0 value <applause>flag? 0 value <applause>size : <<<applause>>> ( -- ) <applause>busy? ?exit true to <applause>busy? <applause>flag? 0= if true to <applause>flag? s" applause7.wav" find-file r/o open-file drop >r r@ file-size drop d>s to <applause>size r@ <applause>size malloc to <applause>handle <applause>handle <applause>size r@ read-file 2drop r> close-file drop then music? <applause>flag? and if <applause>handle playthat then false to <applause>busy? ; --- NEW FILE: FileIO.f --- \ $Id: FileIO.f,v 1.1 2008/04/30 15:58:01 dbu_de Exp $ FileOpenDialog OpenGame "Open Game" "SoliPion (*.SOL)|*.SOL|All (*.*)|*.*|" FileSaveDialog SaveGame "Save Game" "SoliPion (*.SOL)|*.SOL|All (*.*)|*.*|" \ --------------------------------------------------------------- \ Open a Game \ --------------------------------------------------------------- defer !bests : nothing false ; ' nothing is !bests 0 value gameloaded? : open-game { \ open$ hfile -- } max-path LocalAlloc: open$ GetHandle: SOLIPIONW Start: OpenGame dup c@ \ ( -- a1 n1 ) IF count open$ place open$ count r/w open-file abort" open-file" to hfile smallstring 19 hfile read-file 2drop smallstring 3 s" SOL" compare 0= dup if true to put-by? then smallstring 3 s" PLA" compare 0= dup if false to put-by? then or IF string-player-name 20 hfile read-file 2drop &of shift-x cell hfile read-file 2drop &of shift-y cell hfile read-file 2drop &of moves cell hfile read-file 2drop moves-table moves cells hfile read-file 2drop THEN true to show? moves 1- dup dup max-counter > if to max-counter to counter !bests else 2drop then hfile close-file drop true to gameloaded? ELSE DROP THEN ; \ --------------------------------------------------------------- \ Re-Open the game \ --------------------------------------------------------------- : (re-open-game) { \ open$ hfile -- } max-path LocalAlloc: open$ in-memory? IF counter 1+ to moves ELSE S" GAME.SOL" open$ place open$ count r/w open-file abort" open-file" to hfile smallstring 3 hfile read-file 2drop smallstring 3 s" SOL" compare 0= dup if true to put-by? then smallstring 3 s" PLA" compare 0= dup if false to put-by? then or IF smallstring 16 hfile read-file 2drop string-player-name 20 hfile read-file 2drop &of shift-x cell hfile read-file 2drop &of shift-y cell hfile read-file 2drop &of moves cell hfile read-file 2drop moves-table moves cells hfile read-file 2drop THEN hfile close-file drop THEN 0 to tempo false to show? ; ' (re-open-game) is re-open-game \ --------------------------------------------------------------- \ Save the Game \ --------------------------------------------------------------- : (save-game) { \ save$ hfile -- } max-path LocalAlloc: save$ \ in-memory? if counter 1+ to moves else s" GAME.SOL" save$ place save$ count r/w create-file abort" create-file" to hfile put-by? if s" PLA" else s" SOL" then hfile write-file drop get-local-time time-buf 16 hfile write-file drop string-player-name 20 hfile write-file drop &of shift-x cell hfile write-file drop &of shift-y cell hfile write-file drop counter 1+ to moves &of moves cell hfile write-file drop moves-table moves cells hfile write-file drop hfile close-file drop then ; ' (save-game) is save-game \ --------------------------------------------------------------- \ Save the Game As \ --------------------------------------------------------------- : save-game-as { \ hfile save$ -- } max-path LocalAlloc: save$ s" Save the Game As : " save$ place save$ count SetTitle: SaveGame auto-save? if counter 0 <# # # # #> save$ place s" .SOL" save$ +place save$ count delete-file drop save$ dup c@ else GetHandle: SOLIPIONW Start: SaveGame dup c@ \ ( -- a1 n1 ) then IF count r/w create-file abort" create-file" to hfile put-by? if s" SOL" else s" PLA" then hfile write-file drop get-local-time time-buf 16 hfile write-file drop string-player-name 20 hfile write-file drop &of shift-x cell hfile write-file drop &of shift-y cell hfile write-file drop counter 1+ to moves &of moves cell hfile write-file drop moves-table moves cells hfile write-file drop hfile close-file drop ELSE drop THEN ; \ --------------------------------------------------------------- \ Save the bests-table \ --------------------------------------------------------------- : save-bests { \ best$ hfile -- } max-path LocalAlloc: best$ S" solipion.dat" best$ place best$ count r/w open-file 0= if to hfile smallstring 3 hfile read-file 2drop else drop best$ count r/w create-file drop to hfile s" SOL" 2dup hfile write-file drop smallstring swap cmove get-local-time time-buf 16 hfile write-file drop then smallstring 3 s" SOL" compare 0= if stamper 16 hfile write-file drop bests-table 220 hfile write-file drop then hfile close-file drop ; --- NEW FILE: Print.f --- \ $Id: Print.f,v 1.1 2008/04/30 15:58:01 dbu_de Exp $ \ --------------------------------------------------------------- \ Print the Positions of the Game (text) \ --------------------------------------------------------------- create ligne$ 256 allot : #moves" { nmoves \ -- adr len } ligne$ 256 blank moves-table nmoves cells+ s" " ligne$ place dup c@ 0 <# # # #> ligne$ +place s" " ligne$ +place dup 1 + c@ 0 <# # # #> ligne$ +place s" " ligne$ +place dup 2 + c@ 0 <# # #> ligne$ +place s" " ligne$ +place 3 + c@ 0 <# # #> ligne$ +place ligne$ count ; : print-game { \ message$ -- } MAXSTRING localAlloc: message$ screen-width >r 680 to screen-width screen-height >r 484 to screen-height char-height >r 12 to char-height char-width >r 9 to char-width #pages-up ?dup IF 2 = IF two-page ELSE four-page THEN THEN start-scaled IF s" Courier New" SetPrinterFont: ThePrinter s" Score : " message$ place counter 0 (ud,.) message$ +place message$ count Type: ThePrinter Cr: ThePrinter s" Row Line Rank Direction" Type: ThePrinter Cr: ThePrinter counter 0 DO i #moves" Type: ThePrinter Cr: ThePrinter LOOP print-scaled single-page THEN r> to char-width r> to char-height r> to screen-height r> to screen-width ; \ --------------------------------------------------------------- \ Print the Bitmap of the Game \ --------------------------------------------------------------- DECIMAL 4 constant sizeof(RGBQUAD) 14 constant sizeof(BitmapFileHeader) 40 constant sizeof(BitmapInfoHeader) 0 constant biSize 4 constant biWidth 8 constant biHeight 12 constant biPlanes 14 constant biBitCount 16 constant biCompression 20 constant biSizeImage 24 constant biXPelsPerMeter 28 constant biYPelsPerMeter 32 constant biClrUsed 36 constant biClrImportant : print-demo-bmp { nBits \ pbmi lpBits hbm hdcMem -- } Open: ThePrinter GetHandle: ThePrinter 0= ?EXIT LandScape: ThePrinter Start: ThePrinter sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + malloc to pbmi pbmi sizeof(BitmapInfoHeader) sizeof(RGBQUAD) 256 * + erase sizeof(BitmapInfoHeader) pbmi biSize + ! SCREEN-WIDTH pbmi biWidth + ! SCREEN-HEIGHT pbmi biHeight + ! 1 pbmi biPlanes + w! nBits pbmi biBitCount + w! BI_RGB pbmi biCompression + ! SCREEN-HEIGHT SCREEN-WIDTH GetHandle: solipion-dc Call CreateCompatibleBitmap to hbm GetHandle: solipion-dc Call CreateCompatibleDC to hdcMem hbm hdcMem Call SelectObject drop SRCCOPY 0 0 GetHandle: solipion-dc SCREEN-HEIGHT SCREEN-WIDTH 0 0 hdcMem Call BitBlt ?win-error DIB_RGB_COLORS pbmi NULL SCREEN-HEIGHT 0 hbm hdcMem Call GetDIBits 0= abort" 1st GetDIBits" pbmi biSizeImage + @ malloc to lpBits lpBits pbmi biSizeImage + @ erase DIB_RGB_COLORS pbmi lpBits SCREEN-HEIGHT 0 hbm hdcMem Call GetDIBits 0= abort" 2nd GetDIBits" SRCCOPY DIB_RGB_COLORS pbmi lpBits SCREEN-HEIGHT SCREEN-WIDTH 0 0 Height: ThePrinter 80 100 */ Width: ThePrinter 80 100 */ Height: ThePrinter 10 100 */ Width: ThePrinter 10 100 */ GetHandle: ThePrinter Call StretchDIBits GDI_ERROR = ABORT" StretchDIBits" 5 0 do Width: ThePrinter 8 100 */ i - Height: ThePrinter 8 100 */ i - MoveTo: ThePrinter Width: ThePrinter 92 100 */ i + Height: ThePrinter 8 100 */ i - LineTo: ThePrinter Width: ThePrinter 92 100 */ i + Height: ThePrinter 92 100 */ i + LineTo: ThePrinter Width: ThePrinter 8 100 */ i - Height: ThePrinter 92 100 */ i + LineTo: ThePrinter Width: ThePrinter 8 100 */ i - Height: ThePrinter 8 100 */ i - LineTo: ThePrinter loop End: ThePrinter Portrait: ThePrinter Close: ThePrinter hdcMem call DeleteDC ?win-error hbm call DeleteObject ?win-error lpBits release pbmi release ; --- NEW FILE: About.f --- \ $Id: About.f,v 1.1 2008/04/30 15:58:01 dbu_de Exp $ :Object AboutSolipion <SUPER dialog IDD_ABOUT_FORTH forthdlg find-dialog-id constant template create about-head z," Solipion Version: 2.0" create about-msg1 z," Written 2005 by:\n" +z," Bruno Gauthier\n" +z," eMail: bga...@fr...\n" +z," http:\\bgauthier.free.fr" create about-msg2 z," \n" +z," \n" +z," \n" +z," " create about-msg3 z," This is a Morpion Solitaire Game." :M On_Init: ( hWnd-focus -- f ) about-head zcount IDD_ABOUT_HEAD SetDlgItemText: self about-msg1 zcount IDD_ABOUT_TEXT SetDlgItemText: self about-msg2 zcount IDD_ABOUT_TEXT2 SetDlgItemText: self about-msg3 zcount IDD_ABOUT_TEXT3 SetDlgItemText: self 1 ;M :M On_Command: ( hCtrl code ID -- f1 ) CASE IDCANCEL OF 0 end-dialog ENDOF false swap ( default result ) ENDCASE ;M :M Start: ( -- f ) Addr: SolipionW template run-dialog ;M ;Object : about-solipion ( -- ) start: AboutSoliPion ; --- NEW FILE: Menu.f --- \ $Id: Menu.f,v 1.1 2008/04/30 15:58:01 dbu_de Exp $ ToolBar Solipion-Tool-Bar1 "SOLIPION.BMP" 0 PictureButton 'N' +k_control pushkey ; \ New ButtonInfo" New Game " 1 PictureButton 'O' +k_control pushkey ; \ Open ButtonInfo" Open " 1 PictureButton 'R' +k_control pushkey ; \ Re-open ButtonInfo" Re-Open " 2 PictureButton 'E' +k_control pushkey ; \ Save ButtonInfo" Save " 2 PictureButton 'S' +k_control pushkey ; \ Save As ButtonInfo" Save As " 3 PictureButton 'T' +k_control pushkey ; \ Print ButtonInfo" Print Text " 17 PictureButton 'B' +k_control pushkey ; \ Print bmp ButtonInfo" Print Bitmap " 11 PictureButton 'A' +k_control pushkey ; \ Automatic ButtonInfo" Automatic " 12 PictureButton k_left +k_control pushkey ; \ Shrinking ButtonInfo" Shrinking " 4 PictureButton k_right +k_control pushkey ; \ Enlarge ButtonInfo" Enlarge " 13 PictureButton k_scroll +k_control pushkey ; \ To last move ButtonInfo" To Last Move " 14 PictureButton k_pgdn +k_control pushkey ; \ To next move ButtonInfo" To Next Move " 9 PictureButton k_down +k_control pushkey ; \ ButtonInfo" Minus the Tempo " 10 PictureButton k_up +k_control pushkey ; \ ButtonInfo" More Tempo " 15 PictureButton 'W' +k_control pushkey ; \ ButtonInfo" On/Off the sound" 16 PictureButton 'H' +k_control pushkey ; \ Table of Bests Scores ButtonInfo" Table of Bests Scores" ENDBAR POPUPBAR Solipion-Popup-bar POPUP " " MENUITEM "&New Game " 'N' +k_control pushkey ; MENUITEM "&Automatic Game " 'A' +k_control pushkey ; MENUSEPARATOR MENUITEM "&Open " 'O' +k_control pushkey ; MENUITEM "&Re-open " 'R' +k_control pushkey ; MENUSEPARATOR MENUITEM "&Save " 'E' +k_control pushkey ; MENUITEM "Save &As " 'S' +k_control pushkey ; MENUSEPARATOR MENUITEM "Print &Text" 'T' +k_control pushkey ; MENUITEM "Print &Bitmap" 'B' +k_control pushkey ; MENUSEPARATOR MENUITEM "&Quit" 'Q' +k_control pushkey ; ENDBAR MENUBAR Solipion-Menu-bar POPUP "&Game" MENUITEM "&New \tCtrl+N" 'N' +k_control pushkey ; MENUITEM "&Automatic \tCtrl+A" 'A' +k_control pushkey ; MENUSEPARATOR MENUITEM "&Open... \tCtrl+O" 'O' +k_control pushkey ; MENUITEM "&Re-Open \tCtrl+R" 'R' +k_control pushkey ; MENUSEPARATOR MENUITEM "&Save \tCtrl+E" 'E' +k_control pushkey ; MENUITEM "Save &As... \tCtrl+S" 'S' +k_control pushkey ; MENUSEPARATOR MENUITEM "Print Setup... \tCtrl+Shift+P" 'P' +k_control +k_shift pushkey ; MENUITEM "&Print Text... \tCtrl+P" 'P' +k_control pushkey ; MENUITEM "&Print Bitmap... \tCtrl+B" 'B' +k_control pushkey ; MENUSEPARATOR MENUITEM "Quit \tCtrl+Q" 'Q' +k_control pushkey ; POPUP "&About..." MENUITEM "SoliPion" k_F1 +k_control pushkey ; ENDBAR Index: SOLIPION.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Solipon2/SOLIPION.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** SOLIPION.F 2 Dec 2006 10:17:30 -0000 1.7 --- SOLIPION.F 30 Apr 2008 15:58:00 -0000 1.8 *************** *** 1,15 **** ! \ SOLIPION.F 2.01 ! s" apps\Solipon2" "fpath+ ! needs old\optimize.f needs Resources.f ! only forth also definitions - 1280 value screen-mwidth [...1540 lines suppressed...] --- 1076,1094 ---- ; ! turnkey? [if] + \ NoConsoleIO \ Setup the Console I/O for an application without the console window. + \ NoConsoleInImage \ Tell Imageman that we don't need the w32fconsole.dll. + + \ Create the exe-file + &forthdir count &appdir place + ' solipion turnkey Solipion.exe + + \ add the Application icon to the EXE file + s" src\res\Win32For.ico" s" Solipion.exe" Prepend<home>\ AddAppIcon + + 1 pause-seconds bye + [else] + s" src\res\Win32For.ico" s" Solipion.exe" Prepend<home>\ AddAppIcon + solipion + [then] |
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:24
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/demos Modified Files: WINCLOCK.F Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes Index: WINCLOCK.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/WINCLOCK.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** WINCLOCK.F 26 Apr 2008 11:14:32 -0000 1.4 --- WINCLOCK.F 30 Apr 2008 15:51:08 -0000 1.5 *************** *** 7,200 **** needs NoConsole.f needs Resources.f false value turnkey? \ --------------------------------------------------------------- - \ ext-windc class - \ --------------------------------------------------------------- - - :class ext-windc <super windc - \ *G Extended windc class. - \ ** There are a few things missing in the windc class so I - \ ** added them here. - - int SavedState - - :M ClassInit: ( -- ) - \ *G Init the class - ClassInit: super - 0 to SavedState - ;m - - \ This method was added here because of a bug in the gdiDC class - \ (Sonntag, April 20 2008 - dbu) - :M Restore: ( SavedState -- ) - \ *G The Restore method restores the device context to the specified state. - \ ** The DC is restored by popping state information off a stack created by - \ ** earlier calls to the Save: method. - hObject call RestoreDC ?win-error ;M - - :M Destroy: ( -- ) - \ *G Destroy the device context. - Valid?: super - if \ First we restore the state of the device context. - \ After that all gdi objects that are currently selected - \ into this dc can be saftly destroyd later! - SavedState Restore: self - - GetHandle: super call DeleteDC ?win-error - 0 PutHandle: super - then ;M - - :M SetHandle: ( hObject -- ) - \ *G Set the handle of the object. \n - \ ** If the current handle of the object is valid it will be destroyed. - Destroy: self - PutHandle: super - - \ we save the state of the device contect here, so we - \ can restore it later. - Save: super to SavedState - ;M - - :m ~: ( -- ) - \ *G Clean up on dispose. - Destroy: self ;m - - ;class - - \ --------------------------------------------------------------- - \ timer-window class - \ --------------------------------------------------------------- - - :class timer-window <super window - \ *G timer-window class. - \ ** This class can be used for windows that should handle timer events. - \ ** Only one timer for the window can be used with this class. - - int timer - - :m ClassInit: ( -- ) - \ *G Init the class - ClassInit: super - 0 to timer - ;m - - :m KillTimer: ( -- ) - \ *G Destroy the timer for this window. - timer ?dup - if hWnd Call KillTimer ?win-error \ destroy the timer - 0 to timer - then ;m - - :M CreateTimer: ( ms -- ) - \ *G Create the timer for this window. - KillTimer: self \ not needed, but it doesn't hurt... - NULL swap hWnd hWnd Call SetTimer to timer - ;m - - :M On_Done: ( -- ) - \ *G Things to do before program termination - KillTimer: self \ destroy the timer, we are done - On_Done: super - ;M - - :M On_Timer: ( -- ) - \ *G Thing's to do when the window recives a timer event. Default does nothing. - ;m - - :M WM_TIMER ( -- ) \ handle the WM_TIMER events - On_Timer: [ self ] ;M - - ;class - - - \ --------------------------------------------------------------- - \ bitmap-dc class - \ --------------------------------------------------------------- - - :class bitmap-dc <super ext-windc - \ *G Bitmap device context class. - \ ** This can be used for buffered drawing. - - int bitmap - int bitmap-height - int bitmap-width - - :M ClassInit: ( -- ) - \ *G Init the class - ClassInit: super - 0 to bitmap - 0 to bitmap-height - 0 to bitmap-width - ;M - - :M Valid?: ( -- f ) - \ *G Check if it's save to use this device. - Valid?: super bitmap 0<> and ;M - - :M Fill: { color_object \ -- } - \ *G Fill the display bitmap with a specified color. - Valid?: self - if 0 0 bitmap-width bitmap-height color_object FillArea: super - then ;M - - :m Destroy: ( -- ) - \ *G Destroys the display bitmap. - - \ first we destroy the device context - Destroy: super - - \ and than the bitmap - bitmap 0<> - if bitmap call DeleteObject ?win-error - 0 to bitmap - then ;M - - :M Init: { width height RefDC \ -- } - \ *G Create the display bitmap and select it to our device context. - \ ** Our device context will be compatible to the reference device. - - Destroy: self - - width 0> height 0> and - if width to bitmap-width - height to bitmap-height - - CreateCompatibleDC: RefDC ?dup - if SetHandle: super - bitmap-width bitmap-height CreateCompatibleBitmap: RefDC ?dup - if dup to bitmap SelectObject: super drop - OEM_FIXED_FONT SelectStockObject: super drop - WHITE_PEN SelectStockObject: super drop - BLACK SetBkColor: super - WHITE SetTextColor: super - - BLACK Fill: self - then - then - then ;m - - :M On_EraseBackground: ( hwnd msg wparam lparam -- res ) - 4drop 0 ;M \ let the On_Paint: Method redraw the background - - :m Paint: { ps_left ps_top ps_right ps_bottom DestDC -- } - \ *G Draw the display bitmap into the destination device condtext. - Valid?: self - if SRCCOPY \ blitmode - ps_left ps_top \ sourcex,y - self \ sourcedc - ps_right ps_bottom \ sizex,y - ps_left ps_top \ destinationx,y - BitBlt: DestDC - then ;M - - :m ~: ( -- ) - \ *G Clean up on dispose. - Destroy: self ;m - - ;class - - \ --------------------------------------------------------------- \ line-dc - Device context class for simple line drawing \ --------------------------------------------------------------- --- 7,16 ---- needs NoConsole.f needs Resources.f + needs lib\BitmapDC.f + needs lib\TimerWindow.f false value turnkey? \ --------------------------------------------------------------- \ line-dc - Device context class for simple line drawing \ --------------------------------------------------------------- |
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:24
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/src/lib Added Files: BitmapDC.f ExtDC.f TimerWindow.f Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes --- NEW FILE: BitmapDC.f --- \ $Id: BitmapDC.f,v 1.1 2008/04/30 15:51:09 dbu_de Exp $ \ *D doc\classes\ \ *! BitmapDC \ *T bitmap-dc -- Bitmap device context class. \ *S Glossary cr .( Loading Bitmap device context class.... ) only forth also definitions in-application require lib/ExtDC.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ bitmap-dc class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :class bitmap-dc <super ext-windc \ *G Bitmap device context class. \ ** This can be used for buffered drawing. int bitmap int bitmap-width int bitmap-height :M ClassInit: ( -- ) \ *G Init the class ClassInit: super 0 to bitmap 0 to bitmap-width 0 to bitmap-height ;M :M Valid?: ( -- f ) \ *G Check if it's save to use this device. Valid?: super bitmap 0<> and ;M :M Fill: { color_object \ -- } \ *G Fill the display bitmap with a specified color. Valid?: self if 0 0 bitmap-width bitmap-height color_object FillArea: super then ;M :m FillArea: ( color_object -- ) \ *G Fill the display bitmap with a specified color. Fill: self ;m :m Destroy: ( -- ) \ *G Destroys the display bitmap. \ first we destroy the device context Destroy: super \ and than the bitmap bitmap 0<> if bitmap call DeleteObject ?win-error 0 to bitmap then ;M :M Init: { width height RefDC \ -- } \ *G Create the display bitmap and select it to our device context. \ ** Our device context will be compatible to the reference device. Destroy: self width 0> height 0> and if width to bitmap-width height to bitmap-height CreateCompatibleDC: RefDC ?dup if SetHandle: super bitmap-width bitmap-height CreateCompatibleBitmap: RefDC ?dup if dup to bitmap SelectObject: super drop OEM_FIXED_FONT SelectStockObject: super drop WHITE_PEN SelectStockObject: super drop BLACK SetBkColor: super WHITE SetTextColor: super BLACK Fill: self then then then ;m :m Paint: { ps_left ps_top ps_right ps_bottom DestDC -- } \ *G Draw the display bitmap into the destination device condtext. Valid?: self if SRCCOPY \ blitmode ps_left ps_top \ sourcex,y self \ sourcedc ps_right ps_bottom \ sizex,y ps_left ps_top \ destinationx,y BitBlt: DestDC then ;M :m ~: ( -- ) \ *G Clean up on dispose. Destroy: self ;m ;class \ *G End of bitmap-dc class \ *Z --- NEW FILE: ExtDC.f --- \ $Id: ExtDC.f,v 1.1 2008/04/30 15:51:09 dbu_de Exp $ \ *D doc\classes\ \ *! ExtDC \ *T ext-windc -- Extended WinDC class. \ *S Glossary cr .( Loading Extended device context class... ) only forth also definitions in-application require DC.f \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ ext-windc class \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :class ext-windc <super windc \ *G Extended version of the WinDC class. int SavedState :M ClassInit: ( -- ) \ *G Init the class ClassInit: super 0 to SavedState ;m :M Destroy: ( -- ) \ *G Destroy the device context. Valid?: super if \ First we restore the state of the device context. \ After that all gdi objects that are currently selected \ into this dc can be saftly destroyd later! SavedState Restore: self GetHandle: super call DeleteDC ?win-error 0 PutHandle: super then ;M :M SetHandle: ( hObject -- ) \ *G Set the handle of the object. \n \ ** If the current handle of the object is valid it will be destroyed. Destroy: self PutHandle: super \ we save the state of the device contect here, so we \ can restore it later. Save: super to SavedState ;M :M PutHandle: ( hObject -- ) \ *G Set the handle of the object. \n \ ** If the current handle of the object is valid it will be destroyed. SetHandle: self ;m :m ~: ( -- ) \ *G Clean up on dispose. Destroy: self ;m ;class \ *G End of ext-windc class \ *Z --- NEW FILE: TimerWindow.f --- \ $Id: TimerWindow.f,v 1.1 2008/04/30 15:51:09 dbu_de Exp $ \ *D doc\classes\ \ *! TimerWindow \ *T Timer-Window -- Timer-Window class. \ *S Glossary require window.f cr .( Loading Timer-Window class...) only forth also definitions in-application \ --------------------------------------------------------------- \ timer-window class \ --------------------------------------------------------------- :class timer-window <super window \ *G Timer-Window class. \ ** This class can be used for windows that should handle timer events. \ ** Only one timer per window can be used with this class. int timer :m ClassInit: ( -- ) \ *G Init the class ClassInit: super 0 to timer ;m :m KillTimer: ( -- ) \ *G Destroy the timer for this window. timer ?dup if hWnd Call KillTimer ?win-error \ destroy the timer 0 to timer then ;m :M CreateTimer: ( ms -- ) \ *G Create the timer for this window. KillTimer: self \ not needed, but it doesn't hurt... NULL swap hWnd hWnd Call SetTimer to timer ;m :M On_Done: ( -- ) \ *G Things to do before program termination KillTimer: self \ destroy the timer, we are done On_Done: super ;M :M On_Timer: ( -- ) \ *G Thing's to do when the window recives a timer event. Default does nothing. ;m :M WM_TIMER ( -- ) \ handle the WM_TIMER events On_Timer: [ self ] ;M ;class \ *G End of timer-window class. \ *Z |
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:24
|
Update of /cvsroot/win32forth/win32forth/doc/classes In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/doc/classes Added Files: BitmapDC.htm ExtDC.htm TimerWindow.htm Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes --- NEW FILE: BitmapDC.htm --- <?xml version="1.0"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <meta name="GENERATOR" content="dexh v03"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title> </title><style><!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> <body><h1 align="center"> <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: BitmapDC.htm,v 1.1 2008/04/30 15:51:09 dbu_de Exp $"> <img border="0" src="../TELLUS.gif" align="left" width="32" height="32"></a> <img border="0" src="../FORTHPRO.gif" width="32" height="32"> Win32Forth</h1> <hr /><h1>bitmap-dc -- Bitmap device context class. </h1><hr /><h2>Glossary </h2><pre><b><a name="0">:class bitmap-dc <super ext-windc </a></b></pre><p>Bitmap device context class. This can be used for buffered drawing. </p><pre><b><a name="1">:M ClassInit: ( -- ) </a></b></pre><p>Init the class </p><pre><b><a name="2">:M Valid?: ( -- f ) </a></b></pre><p>Check if it's save to use this device. </p><pre><b><a name="3">:M Fill: { color_object \ -- } </a></b></pre><p>Fill the display bitmap with a specified color. </p><pre><b><a name="4">:m FillArea: ( color_object -- ) </a></b></pre><p>Fill the display bitmap with a specified color. </p><pre><b><a name="5">:m Destroy: ( -- ) </a></b></pre><p>Destroys the display bitmap. </p><pre><b><a name="6">:M Init: { width height RefDC \ -- } </a></b></pre><p>Create the display bitmap and select it to our device context. Our device context will be compatible to the reference device. </p><pre><b><a name="7">:m Paint: { ps_left ps_top ps_right ps_bottom DestDC -- } </a></b></pre><p>Draw the display bitmap into the destination device condtext. </p><pre><b><a name="8">:m ~: ( -- ) </a></b></pre><p>Clean up on dispose. </p><pre><b><a name="9">;class </a></b></pre><p>End of bitmap-dc class </p><hr><p>Document $Id: BitmapDC.htm,v 1.1 2008/04/30 15:51:09 dbu_de Exp $</p> </body></html> --- NEW FILE: TimerWindow.htm --- <?xml version="1.0"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <meta name="GENERATOR" content="dexh v03"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title> </title><style><!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> <body><h1 align="center"> <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: TimerWindow.htm,v 1.1 2008/04/30 15:51:09 dbu_de Exp $"> <img border="0" src="../TELLUS.gif" align="left" width="32" height="32"></a> <img border="0" src="../FORTHPRO.gif" width="32" height="32"> Win32Forth</h1> <hr /><h1>Timer-Window -- Timer-Window class. </h1><hr /><h2>Glossary </h2><pre><b><a name="0">:class timer-window <super window </a></b></pre><p>Timer-Window class. This class can be used for windows that should handle timer events. Only one timer per window can be used with this class. </p><pre><b><a name="1">:m ClassInit: ( -- ) </a></b></pre><p>Init the class </p><pre><b><a name="2">:m KillTimer: ( -- ) </a></b></pre><p>Destroy the timer for this window. </p><pre><b><a name="3">:M CreateTimer: ( ms -- ) </a></b></pre><p>Create the timer for this window. </p><pre><b><a name="4">:M On_Done: ( -- ) </a></b></pre><p>Things to do before program termination </p><pre><b><a name="5">:M On_Timer: ( -- ) </a></b></pre><p>Thing's to do when the window recives a timer event. Default does nothing. </p><pre><b><a name="6">;class </a></b></pre><p>End of timer-window class. </p><hr><p>Document $Id: TimerWindow.htm,v 1.1 2008/04/30 15:51:09 dbu_de Exp $</p> </body></html> --- NEW FILE: ExtDC.htm --- <?xml version="1.0"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <meta name="GENERATOR" content="dexh v03"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title> </title><style><!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> <body><h1 align="center"> <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: ExtDC.htm,v 1.1 2008/04/30 15:51:09 dbu_de Exp $"> <img border="0" src="../TELLUS.gif" align="left" width="32" height="32"></a> <img border="0" src="../FORTHPRO.gif" width="32" height="32"> Win32Forth</h1> <hr /><h1>ext-windc -- Extended WinDC class. </h1><hr /><h2>Glossary </h2><pre><b><a name="0">:class ext-windc <super windc </a></b></pre><p>Extended version of the WinDC class. </p><pre><b><a name="1">:M ClassInit: ( -- ) </a></b></pre><p>Init the class </p><pre><b><a name="2">:M Destroy: ( -- ) </a></b></pre><p>Destroy the device context. </p><pre><b><a name="3">:M SetHandle: ( hObject -- ) </a></b></pre><p>Set the handle of the object. <br /> If the current handle of the object is valid it will be destroyed. </p><pre><b><a name="4">:M PutHandle: ( hObject -- ) </a></b></pre><p>Set the handle of the object. <br /> If the current handle of the object is valid it will be destroyed. </p><pre><b><a name="5">:m ~: ( -- ) </a></b></pre><p>Clean up on dispose. </p><pre><b><a name="6">;class </a></b></pre><p>End of ext-windc class </p><hr><p>Document $Id: ExtDC.htm,v 1.1 2008/04/30 15:51:09 dbu_de Exp $</p> </body></html> |
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:19
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/src/tools Modified Files: DexH-CreateDocs.f Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes Index: DexH-CreateDocs.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-CreateDocs.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** DexH-CreateDocs.f 13 Jun 2007 13:46:11 -0000 1.20 --- DexH-CreateDocs.f 30 Apr 2008 15:51:09 -0000 1.21 *************** *** 30,33 **** --- 30,34 ---- s" src\window.f" create-doc s" src\lib\TrayWindow.f" create-doc + s" src\lib\TimerWindow.f" create-doc s" src\childwnd.f" create-doc s" src\dialog.f" create-doc *************** *** 70,73 **** --- 71,76 ---- s" src\lib\file.f" create-doc s" src\lib\SQLite.F" create-doc + s" src\lib\ExtDC.F" create-doc + s" src\lib\BitmapDC.F" create-doc \ \ ADO |
|
From: Dirk B. <db...@us...> - 2008-04-30 15:51:18
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5706/doc Modified Files: p-classes.htm p-index.htm p-relnotes.6.14.htm Log Message: - New classes "Ext-WinDC", "Bitmap-DC" and "Timer-Window" added- - Updated the WinClock-Demo to work with the new classes Index: p-index.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-index.htm,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** p-index.htm 26 May 2007 10:24:11 -0000 1.20 --- p-index.htm 30 Apr 2008 15:51:08 -0000 1.21 *************** *** 160,164 **** <li><a href="Unicode.htm">Unicode Strings (for use with FCOM)</a></li> <li><a href="WinSock.htm">WinSock - Simple Socket Library</li> ! <li><a href="p-relnotes.6.12.htm">Release Notes</a></li> </ul> --- 160,164 ---- <li><a href="Unicode.htm">Unicode Strings (for use with FCOM)</a></li> <li><a href="WinSock.htm">WinSock - Simple Socket Library</li> ! <li><a href="p-relnotes.6.14.htm">Release Notes</a></li> </ul> Index: p-classes.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-classes.htm,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** p-classes.htm 26 May 2007 10:24:11 -0000 1.14 --- p-classes.htm 30 Apr 2008 15:51:08 -0000 1.15 *************** *** 33,36 **** --- 33,37 ---- <li><a href="./classes/TrayWindow.htm">TrayWindow</a> Class for windows that hide themself in the TrayBar when they are minimized.</li> + <li><a href="./classes/TimerWindow.htm">TimerWindow</a> Class for windows that can handle timer events.</li> <li><a href="./classes/Controls.htm#DialogWindow">DialogWindow</a> Class for windows that contain controls.</li> <li><a href="./classes/mdi.htm#MDIClientWindow">MDIClientWindow</a> MDI client control class.</li> *************** *** 139,143 **** </ul> ! <p> There are some other 'old' classes in Win32Forth that are dealing with the GDI:</p> <ul> <li><b>ColorObject</b> Class for color objects.</li> --- 140,144 ---- </ul> ! <p> There are some other classes in Win32Forth that are dealing with the GDI:</p> <ul> <li><b>ColorObject</b> Class for color objects.</li> *************** *** 146,152 **** <li><b>Font</b> Class for fonts.</li> <li><b>WinDC</b> Device context class for windows.</li> <li><b>WinPrinter</b> Device context class for printing.</li> </ul> ! <p>All these classes are rewritten to use the GDI class library.</p> <h2>Other classes</h2> --- 147,155 ---- <li><b>Font</b> Class for fonts.</li> <li><b>WinDC</b> Device context class for windows.</li> + <li><a href="./classes/ExtDC.htm">ext-windc</a> Extended version of the WinDC class.</li> <li><b>WinPrinter</b> Device context class for printing.</li> + <li><a href="./classes/BitmapDC.htm">bitmap-dc</a> Bitmap device context class.</li> </ul> ! <p>All these classes are written by using the GDI class library.</p> <h2>Other classes</h2> Index: p-relnotes.6.14.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-relnotes.6.14.htm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** p-relnotes.6.14.htm 14 Jul 2007 05:24:21 -0000 1.1 --- p-relnotes.6.14.htm 30 Apr 2008 15:51:08 -0000 1.2 *************** *** 75,78 **** --- 75,79 ---- </p> <h2>System Changes</h2> + <li>ForthForm has been integrated into the Win32ForthIDE.</li> <p> *************** *** 96,99 **** --- 97,103 ---- </ul> <h2>New classes</h2> + <li><a href="./classes/TimerWindow.htm">Timer-Window</a> Class for windows that can handle timer events.</li> + <li><a href="./classes/ExtDC.htm">Ext-WinDC</a> Extended version of the WinDC class.</li> + <li><a href="./classes/BitmapDC.htm">Bitmap-DC</a> Bitmap device context class.</li> <ul> </ul> |
1040 messages has been excluded from this view by a project administrator.
