I've had this one in my pocket but haven't messed with it in a while.
https://www.ideone.com/uXPtsd
\ Picture words give a flag based on x and y.
0 Value x 0 Value y \ 10000x fixed decimal.
: -squared ( nn-n) - dup 10000 */ ;
: disc ( rxy-f) y -squared swap x -squared + > ;
: udisc ( -f) 10000 0 0 disc ;
: vert ( -f) x -1500 -6000 within ;
: horz ( -f) y -2000 -4000 within ;
: smash ( -f) vert horz and udisc and ;
: top ( r-f) 0 -5000 disc ;
: bot ( r-f) 0 5000 disc ;
: wave ( -f) 2500 bot 2500 top invert x 0< and or ;
: eyes ( -f) 350 bot 350 top or ;
: yinyang ( -f) udisc wave xor eyes xor ;
: pit ( -f) x 7143 1429 within y 1429 < or ;
: turn ( -) x negate y to x to y ;
: manji ( -f) true 4 0 DO pit and turn LOOP ;
\ Given the 8 low bits, emit Braille U+28XX as UTF-8.
: emitb8 ( c-) ?dup-0=-IF $80 THEN $E2 emit
dup 6 rshift $A0 or emit $3F and $80 or emit ;
\ Braille dot row/col for each codepoint bit.
: CVals ( -;i-c) Create does> + c@ ;
CVals dr 0 c, 1 c, 2 c, 0 c, 1 c, 2 c, 3 c, 3 c,
CVals dc 0 c, 0 c, 0 c, 1 c, 1 c, 1 c, 0 c, 1 c,
\ Screen row/col/dot to pic x/y, -10000 to 10000.
0 Value r 0 Value c 0 Value d Defer pic ( -f)
12 dup Constant hgt 2* Constant wid
: toy ( -) r 4 * d dr + -5000 hgt */ 10000 + to y ;
: tox ( -) c 2 * d dc + 10000 wid */ 10000 - to x ;
: dotbit ( -c) toy tox pic 1 and d lshift ;
: calcb8 ( -c) 0 8 0 DO i to d dotbit or LOOP ;
: line ( -) wid 0 DO i to c calcb8 emitb8 LOOP ;
: draw ( x-) hgt 0 DO i to r cr line LOOP ;
\ ' smash is pic draw
: 3pic ( -xxx) ['] smash ['] yinyang ['] manji ;
: 3line ( xxx-) 3 0 DO is pic line 2 spaces LOOP ;
: 3draw ( -) hgt 0 DO i to r cr 3pic 3line LOOP ;
3draw