: quad-be ( stream byte -- stream char )
double-be over stream-read1 [
- dup -2 shift BIN: 110111 number= [
- [ 2 shift ] dip BIN: 11 bitand bitor
- over stream-read1 swap append-nums HEX: 10000 +
+ dup -2 shift 0b110111 number= [
+ [ 2 shift ] dip 0b11 bitand bitor
+ over stream-read1 swap append-nums 0x10000 +
] [ 2drop dup stream-read1 drop replacement-char ] if
] when* ;
dup stream-read1 drop replacement-char ;
: begin-utf16be ( stream byte -- stream char )
- dup -3 shift BIN: 11011 number= [
- dup BIN: 00000100 bitand zero?
- [ BIN: 11 bitand quad-be ]
+ dup -3 shift 0b11011 number= [
+ dup 0b00000100 bitand zero?
+ [ 0b11 bitand quad-be ]
[ drop ignore ] if
] [ double-be ] if ;
: quad-le ( stream ch -- stream char )
over stream-read1 swap 10 shift bitor
- over stream-read1 dup -2 shift BIN: 110111 = [
- BIN: 11 bitand append-nums HEX: 10000 +
+ over stream-read1 dup -2 shift 0b110111 = [
+ 0b11 bitand append-nums 0x10000 +
] [ 2drop replacement-char ] if ;
: double-le ( stream byte1 byte2 -- stream char )
- dup -3 shift BIN: 11011 = [
- dup BIN: 100 bitand 0 number=
- [ BIN: 11 bitand 8 shift bitor quad-le ]
+ dup -3 shift 0b11011 = [
+ dup 0b100 bitand 0 number=
+ [ 0b11 bitand 8 shift bitor quad-le ]
[ 2drop replacement-char ] if
] [ append-nums ] if ;
: encode-first ( char -- byte1 byte2 )
-10 shift
- [ -8 shift BIN: 11011000 bitor ] [ HEX: FF bitand ] bi ; inline
+ [ -8 shift 0b11011000 bitor ] [ 0xFF bitand ] bi ; inline
: encode-second ( char -- byte3 byte4 )
- BIN: 1111111111 bitand
- [ -8 shift BIN: 11011100 bitor ] [ BIN: 11111111 bitand ] bi ; inline
+ 0b1111111111 bitand
+ [ -8 shift 0b11011100 bitor ] [ 0b11111111 bitand ] bi ; inline
: stream-write2 ( char1 char2 stream -- )
[ B{ } 2sequence ] dip stream-write ; inline
! [ stream-write1 ] curry bi@ ; inline
: char>utf16be ( char stream -- )
- over HEX: FFFF > [
- [ HEX: 10000 - ] dip
+ over 0xFFFF > [
+ [ 0x10000 - ] dip
[ [ encode-first ] dip stream-write2 ]
[ [ encode-second ] dip stream-write2 ] 2bi
] [ [ h>b/b swap ] dip stream-write2 ] if ; inline
drop char>utf16be ;
: char>utf16le ( char stream -- )
- over HEX: FFFF > [
- [ HEX: 10000 - ] dip
+ over 0xFFFF > [
+ [ 0x10000 - ] dip
[ [ encode-first swap ] dip stream-write2 ]
[ [ encode-second swap ] dip stream-write2 ] 2bi
] [ [ h>b/b ] dip stream-write2 ] if ; inline
! UTF-16
-CONSTANT: bom-le B{ HEX: ff HEX: fe }
+CONSTANT: bom-le B{ 0xff 0xfe }
-CONSTANT: bom-be B{ HEX: fe HEX: ff }
+CONSTANT: bom-be B{ 0xfe 0xff }
: bom>le/be ( bom -- le/be )
dup bom-le sequence= [ drop utf16le ] [