Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Chess TOOLSET.F,1.3,1.4
|
From: Dirk B. <db...@us...> - 2005-05-14 11:40:30
|
Update of /cvsroot/win32forth/win32forth/apps/Chess In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10339/apps/Chess Modified Files: TOOLSET.F Log Message: Some minor changes, to make the code work with my changes to Float.f Index: TOOLSET.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Chess/TOOLSET.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** TOOLSET.F 5 May 2005 09:43:25 -0000 1.3 --- TOOLSET.F 14 May 2005 11:40:20 -0000 1.4 *************** *** 11,15 **** \ Solved a bug in set-priority ! \ Additions are made at the end. )) Forth --- 11,16 ---- \ Solved a bug in set-priority ! \ Additions are made at the end. ! )) Forth *************** *** 146,150 **** : test2 test ; ! test2 \ )) : here! ( n - ) here ! ; --- 147,152 ---- : test2 test ; ! test2 \ ! )) : here! ( n - ) here ! ; *************** *** 656,701 **** : fchoose 100000 * random s>f 100000e f/ ; \ <n> --- <> F: <> --- <r> ! : fvalue-to-string \ ( adr - ) fs: ( n - ) \ Borrowed from f. ! >r 0 r@ c! \ Now it puts a float in a string ! fdepth 0 <= ! IF ." Empty " r> drop EXIT ! THEN ! precision 1 max set-precision ! fexam 0x0200 and ! IF fabs s" -" r@ +place ! THEN ! fdup f0.5 f< ! IF s" ." r@ +place f1.0 f+ $ftemp ! precision 1+ maxsig umin ! represent ! drop drop drop ! $ftemp 1+ precision maxsig 1- umin ! r@ +place s" " r@ +place ! ELSE $ftemp precision represent 0= ! IF drop drop $ftemp precision ! r@ +place s" " r@ +place ! ELSE drop dup precision < ! IF dup 0= ! IF drop s" ." r@ +place ! $ftemp precision ! r@ +place s" " r> +place EXIT ! THEN ! $ftemp over r@ +place s" ." r@ +place ! $ftemp over + swap precision ! swap - r@ +place s" " r@ +place ! ELSE dup precision = ! IF $ftemp swap r@ +place ! s" . " r> +place ! EXIT ! THEN ! $ftemp precision r@ +place r@ pad ! ! precision - 0 ! DO s" 0" pad @ +place ! LOOP ! s" . " r@ +place ! THEN ! THEN ! THEN r> drop ; : string>float \ ( adr - f ) FS: ( - n ) \ Note: 0 on FS when f is false count >float dup not --- 658,705 ---- : fchoose 100000 * random s>f 100000e f/ ; \ <n> --- <> F: <> --- <r> ! \ : fvalue-to-string \ ( adr - ) fs: ( n - ) \ Borrowed from f. ! \ >r 0 r@ c! \ Now it puts a float in a string ! \ fdepth 0 <= ! \ IF ." Empty " r> drop EXIT ! \ THEN ! \ precision 1 max set-precision ! \ fexam 0x0200 and ! \ IF fabs s" -" r@ +place ! \ THEN ! \ fdup f0.5 f< ! \ IF s" ." r@ +place f1.0 f+ $ftemp ! \ precision 1+ maxsig umin ! \ represent ! \ drop drop drop ! \ $ftemp 1+ precision maxsig 1- umin ! \ r@ +place s" " r@ +place ! \ ELSE $ftemp precision represent 0= ! \ IF drop drop $ftemp precision ! \ r@ +place s" " r@ +place ! \ ELSE drop dup precision < ! \ IF dup 0= ! \ IF drop s" ." r@ +place ! \ $ftemp precision ! \ r@ +place s" " r> +place EXIT ! \ THEN ! \ $ftemp over r@ +place s" ." r@ +place ! \ $ftemp over + swap precision ! \ swap - r@ +place s" " r@ +place ! \ ELSE dup precision = ! \ IF $ftemp swap r@ +place ! \ s" . " r> +place ! \ EXIT ! \ THEN ! \ $ftemp precision r@ +place r@ pad ! ! \ precision - 0 ! \ DO s" 0" pad @ +place ! \ LOOP ! \ s" . " r@ +place ! \ THEN ! \ THEN ! \ THEN r> drop ; + ' (f.) alias fvalue-to-string + : string>float \ ( adr - f ) FS: ( - n ) \ Note: 0 on FS when f is false count >float dup not *************** *** 906,910 **** z" TEST" DelEnvironmentVariable z" TEST" s" 2Hello" setEnvironmentVariable ! z" TEST" buffer 256 GetEnvironmentVariable cr dump abort )) : computername$! ( adr - ) \ March 30th, 2002 was GetComputerName --- 910,915 ---- z" TEST" DelEnvironmentVariable z" TEST" s" 2Hello" setEnvironmentVariable ! z" TEST" buffer 256 GetEnvironmentVariable cr dump abort ! )) : computername$! ( adr - ) \ March 30th, 2002 was GetComputerName *************** *** 963,967 **** LPTSTR lpReturnedString, // points to destination buffer DWORD nSize, // size of destination buffer ! LPCTSTR lpFileName // points to initialization filename )) \ lpReturnedString will contain a counted string with a 0 at the end --- 968,973 ---- LPTSTR lpReturnedString, // points to destination buffer DWORD nSize, // size of destination buffer ! LPCTSTR lpFileName // points to initialization filename ! )) \ lpReturnedString will contain a counted string with a 0 at the end *************** *** 994,998 **** test_WritePrivateProfileString ! test_GetPrivateProfileString profile$ .string \ )) : s>tmp$ ( n - adr ) s>d (d.) tmp$ place tmp$ dup 0terminated 1+ ; --- 1000,1005 ---- test_WritePrivateProfileString ! test_GetPrivateProfileString profile$ .string \ ! )) : s>tmp$ ( n - adr ) s>d (d.) tmp$ place tmp$ dup 0terminated 1+ ; *************** *** 1133,1137 **** : test foo foo + . ; ! cr see test test \ )) --- 1140,1145 ---- : test foo foo + . ; ! cr see test test \ ! )) *************** *** 1255,1259 **** \ ( w2k) GetRegistryEntry drop ? ." Mhz" cr ; ! test_reg$ \ )) \ November 3rd, 2001 - 21:19 added: u,. ?u,. ?u,.cr --- 1263,1268 ---- \ ( w2k) GetRegistryEntry drop ? ." Mhz" cr ; ! test_reg$ \ ! )) \ November 3rd, 2001 - 21:19 added: u,. ?u,. ?u,.cr *************** *** 1333,1337 **** ^ ^ REG PTR EBX --> <-- ECX ! ESP OFFSET 16 12 8 4 0 )) --- 1342,1347 ---- ^ ^ REG PTR EBX --> <-- ECX ! ESP OFFSET 16 12 8 4 0 ! )) *************** *** 1517,1521 **** [3] -1087358 3 -1 4293879938 45 53 74 ESt ok ! )) \ June 8th, 2003 --- 1527,1531 ---- [3] -1087358 3 -1 4293879938 45 53 74 ESt ok ! )) \ June 8th, 2003 |
