![]() |
||
| Home | SwiftForth Archive | SwiftX Archive | |

Hello Leo, Mike
Thanks very much for you suggestions, they have helped me solve my immediate problems.
I would still be interested as to why the command is detailed in the swiftforth documentation but not present..
Thanks again.
Rob
======= At 2004-06-24, 10:06:00 you wrote: =======
>More code to look at. Note that \u" is not u\" .
>
>\ unicode.f Leo Wong, June 24, 02004 +
>\ Compile ascii strings into Unicode strings
>\ Assumes 1 CHARS = 1 address unit
>\ ,u" u" \u"
>\ 020040623 + utype displays low byte only; bug: ends when low byte=0;
>\ 020040624 + utype displays Unicode escape when unicode > 0xFF
>
>\ Tools
>: 2count ( ca1 -- ca2 c2 c1 )
> COUNT >R COUNT R> ;
>\ (.) as implementated by Wil Baden
>: (.) ( n -- str len )
> DUP ABS 0 <# #S ROT SIGN #> ;
>: 0u.r ( n # -- )
> >R (.) R> OVER - 0 MAX 0 ?DO [CHAR] 0 EMIT LOOP TYPE ;
>: utype ( a -- ) \ types only low bytes
> BASE @ >R HEX
> BEGIN 2COUNT 2DUP OR
> WHILE SWAP ?DUP IF ." \u" 2 0u.r 2 0u.r ELSE EMIT THEN
> REPEAT 2DROP DROP
> R> BASE ! ;
>: parse" ( <string>" -- ca u ) [CHAR] " PARSE ;
>
>\ ,u" compiles a Unicode string
>: ,u" ( <string>" -- ) \ After SwiftForth
> parse" 0 ?DO COUNT C, 0 C, LOOP DROP 0 C, 0 C, ;
>
>\ u" compiles a Unicode string in a definiton
>: uallocate ( u -- a )
> 2* 2 + DUP ALLOCATE THROW TUCK SWAP ERASE ;
>: umove ( ca u s -- )
> SWAP 0 ?DO >R COUNT R@ C! R> 2 + LOOP 2DROP ;
>: uliteral ( ca u -- )
> DUP uallocate >R R@ umove R> POSTPONE LITERAL ; IMMEDIATE
>: u" ( <string>" -- a ) \ Compile only
> parse" POSTPONE uliteral ; IMMEDIATE
>
>\ \u" compiles a Unicode string, including unicode literals
>\ in the form of \uxxyy where xx and yy are hex numbers
>\ \uxxyy is compiled as yy xx
>: \cins ( ca u -- n )
> 0 TUCK ?DO >R COUNT [CHAR] \ = IF R> 1+ ELSE R> THEN LOOP NIP ;
>: \uallocate ( ca u1 -- ca u2 a )
> 2DUP \cins 5 * - DUP uallocate ;
>: >double ( ca1 u1 -- d ca2 )
> 0 0 2SWAP >NUMBER ABORT" >NUMBER failed" ;
>: >single ( ca1 u1 -- n ca2 )
> >double >R D>S R> ;
>: \ucount ( ca1 -- ca2 n1 n2 )
> BASE @ >R HEX
> COUNT DUP [CHAR] u <> SWAP [CHAR] U <> AND
> ABORT" Malformed \u escape"
> 2 >single 2 >single ROT ROT
> R> BASE ! ;
>: \umove ( ca u $ )
> SWAP 0 ?DO >R COUNT DUP [CHAR] \ =
> IF DROP \ucount SWAP R@ 1+ C! THEN
> R@ C! R> 2 +
> LOOP 2DROP ;
>: \uliteral ( ca u -- )
> \uallocate >R R@ \umove R> POSTPONE LITERAL ; IMMEDIATE
>: \u" ( <string>" -- a ) \ Compile only
> parse" POSTPONE \uliteral ; IMMEDIATE
>
>\ Usage examples:
>CREATE test1 ,u" Test1 ok"
>CR test1 utype
>: test2 CR u" Test2 ok" utype ;
>test2
>: test3 CR \u" T\u0065st3 \u006f\u006b" utype ;
>test3
>: test4 CR \u" Test4 \u0022\u005c\u0022 ok" utype ;
>test4
>: test5 CR \u" Test5 \uff00 ok" utype ;
>test5
>: test6 CR \u" Test6 \u8036\u7a23 \u006f\u006b" utype ;
>test6
>CR
>
>\ Leo Wong
>\ http://www.albany.net/~hello/
>
>
>----------------------------------------------------------------------
>sftalk_at_forth.com The SwiftForth programming discussion email list
>To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
>For list command help, send subject "help" to sftalk-request_at_forth.com
>Message archives are located at http://www.forth.com/archive/sftalk
>----------------------------------------------------------------------
>This list is a forum for SwiftForth users. For product support and bug
>reports, please send email to support_at_forth.com
>----------------------------------------------------------------------
= = = = = = = = = = = = = = = = = = = =
Best regards.
Rob Ward
rob.ward_at_tpg.com.au
2004-06-25
----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Fri Jun 25 2004 - 07:42:59 PDT
This archive was generated by hypermail 2.2.0 : Wed Nov 19 2008 - 03:04:23 PST