
\ -------------------------------------------------------------
\  Interface to real graphics hardware necessary.
\  This is just for ASCII art in terminal !
\ -------------------------------------------------------------

  : u.base10 ( u -- ) base @ decimal swap 0 <# #s #> type base ! ;
  : ESC[ ( -- ) 27 emit 91 emit ;
  : at-xy ( column row -- ) 1+ swap 1+ swap ESC[ u.base10 ." ;" u.base10 ." H" ;
  : page ESC[ ." 2J" 0 0 at-xy ;

: putpixel ( x y -- )  at-xy [char] * emit ;

\ -------------------------------------------------------------
\  Bresenham line
\ -------------------------------------------------------------

0 variable line-x1   0 variable line-y1
0 variable line-sx   0 variable line-sy
0 variable line-dx   0 variable line-dy
0 variable line-err

: line ( x0 y0 x1 y1 -- )

  line-y1 ! line-x1 !

  over line-x1 @ -   dup 0< if 1 else -1 then line-sx !   abs        line-dx !
  dup  line-y1 @ -   dup 0< if 1 else -1 then line-sy !   abs negate line-dy !
  line-dx @ line-dy @ + line-err !

  begin
    2dup putpixel
    2dup line-x1 @ line-y1 @ d<>
  while
    line-err @ 2* >r
    r@ line-dy @ > if line-dy @ line-err +! swap line-sx @ + swap then
    r> line-dx @ < if line-dx @ line-err +!      line-sy @ +      then
  repeat
  2drop
;

\ -------------------------------------------------------------
\  Bresenham ellipse
\ -------------------------------------------------------------

0 variable ellipse-xm   0 variable ellipse-ym
0 variable ellipse-dx   0 variable ellipse-dy
0 variable ellipse-a    0 variable ellipse-b
0 variable ellipse-a^2  0 variable ellipse-b^2
0 variable ellipse-err

: ellipse-putpixel ( y x -- ) ellipse-xm @ + swap ellipse-ym @ + putpixel ;

: ellipse-step ( -- )
    ellipse-dy @        ellipse-dx @        ellipse-putpixel
    ellipse-dy @ negate ellipse-dx @        ellipse-putpixel
    ellipse-dy @ negate ellipse-dx @ negate ellipse-putpixel
    ellipse-dy @        ellipse-dx @ negate ellipse-putpixel

    ellipse-err @ 2* >r
    r@  ellipse-dx @ 2* 1+ ellipse-b^2 @ *        < if  1 ellipse-dx +! ellipse-dx @ 2* 1+ ellipse-b^2 @ *        ellipse-err +! then
    r>  ellipse-dy @ 2* 1- ellipse-a^2 @ * negate > if -1 ellipse-dy +! ellipse-dy @ 2* 1- ellipse-a^2 @ * negate ellipse-err +! then
;


: ellipse ( xm ym a b -- )

  0 ellipse-dx ! dup ellipse-dy !

  dup ellipse-b ! dup * ellipse-b^2 !
  dup ellipse-a ! dup * ellipse-a^2 !
  ellipse-ym ! ellipse-xm !

  ellipse-b^2 @ ellipse-b @ 2* 1- ellipse-a^2 @ * - ellipse-err !

  begin
    ellipse-step
    ellipse-dy @ 0<
  until

  ellipse-dx @
  begin
    1+
    dup ellipse-a @ <
  while
    0 over        ellipse-putpixel
    0 over negate ellipse-putpixel
  repeat
  drop
;

: circle ( xm ym r -- ) dup ellipse ;

\ -------------------------------------------------------------
\  Artwork for 8x16 Bitmap font, taken from
\  http://v3.sk/~lkundrak/fonts/freebsd/fonts/iso-8x16
\  http://v3.sk/~lkundrak/fonts/freebsd/fonts/iso15-8x16
\ -------------------------------------------------------------

\ Emulate h, which is not available in Mecrisp-Quintus.

0 variable h,collection

: h, ( x -- )
  h,collection @ ?dup if $FFFF and swap 16 lshift or , 0 h,collection !
                      else $10000 or h,collection ! then ;

: halign ( -- )
  h,collection @ if 0 h, then ;

hex
create font

\ Unicode point, Bitmap Data                                               \ ISO8859-1, Name

0020 h,  0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 32 Space SPACE
0021 h,  0000 h, 3C18 h, 3C3C h, 1818 h, 0018 h, 1818 h, 0000 h, 0000 h,   \ 33 !     EXCLAMATION MARK
0022 h,  6600 h, 6666 h, 0024 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 34 "     QUOTATION MARK
0023 h,  0000 h, 6C00 h, FE6C h, 6C6C h, FE6C h, 6C6C h, 0000 h, 0000 h,   \ 35 #     NUMBER SIGN
0024 h,  1818 h, C67C h, C0C2 h, 067C h, 8606 h, 7CC6 h, 1818 h, 0000 h,   \ 36 $     DOLLAR SIGN
0025 h,  0000 h, 0000 h, C6C2 h, 180C h, 6030 h, 86C6 h, 0000 h, 0000 h,   \ 37 %     PERCENT SIGN
0026 h,  0000 h, 6C38 h, 386C h, DC76 h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 38 &     AMPERSAND
0027 h,  3000 h, 3030 h, 0060 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 39 '     APOSTROPHE
0028 h,  0000 h, 180C h, 3030 h, 3030 h, 3030 h, 0C18 h, 0000 h, 0000 h,   \ 40 (     LEFT PARENTHESIS
0029 h,  0000 h, 1830 h, 0C0C h, 0C0C h, 0C0C h, 3018 h, 0000 h, 0000 h,   \ 41 )     RIGHT PARENTHESIS
002A h,  0000 h, 0000 h, 6600 h, FF3C h, 663C h, 0000 h, 0000 h, 0000 h,   \ 42 *     ASTERISK
002B h,  0000 h, 0000 h, 1800 h, 7E18 h, 1818 h, 0000 h, 0000 h, 0000 h,   \ 43 +     PLUS SIGN
002C h,  0000 h, 0000 h, 0000 h, 0000 h, 1800 h, 1818 h, 0030 h, 0000 h,   \ 44 ,     COMMA
002D h,  0000 h, 0000 h, 0000 h, FE00 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 45 -     HYPHEN-MINUS
002E h,  0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 1818 h, 0000 h, 0000 h,   \ 46 .     FULL STOP
002F h,  0000 h, 0000 h, 0602 h, 180C h, 6030 h, 80C0 h, 0000 h, 0000 h,   \ 47 /     SOLIDUS
0030 h,  0000 h, 663C h, C3C3 h, DBDB h, C3C3 h, 3C66 h, 0000 h, 0000 h,   \ 48 0     DIGIT ZERO
0031 h,  0000 h, 3818 h, 1878 h, 1818 h, 1818 h, 7E18 h, 0000 h, 0000 h,   \ 49 1     DIGIT ONE
0032 h,  0000 h, C67C h, 0C06 h, 3018 h, C060 h, FEC6 h, 0000 h, 0000 h,   \ 50 2     DIGIT TWO
0033 h,  0000 h, C67C h, 0606 h, 063C h, 0606 h, 7CC6 h, 0000 h, 0000 h,   \ 51 3     DIGIT THREE
0034 h,  0000 h, 1C0C h, 6C3C h, FECC h, 0C0C h, 1E0C h, 0000 h, 0000 h,   \ 52 4     DIGIT FOUR
0035 h,  0000 h, C0FE h, C0C0 h, 06FC h, 0606 h, 7CC6 h, 0000 h, 0000 h,   \ 53 5     DIGIT FIVE
0036 h,  0000 h, 6038 h, C0C0 h, C6FC h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 54 6     DIGIT SIX
0037 h,  0000 h, C6FE h, 0606 h, 180C h, 3030 h, 3030 h, 0000 h, 0000 h,   \ 55 7     DIGIT SEVEN
0038 h,  0000 h, C67C h, C6C6 h, C67C h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 56 8     DIGIT EIGHT
0039 h,  0000 h, C67C h, C6C6 h, 067E h, 0606 h, 780C h, 0000 h, 0000 h,   \ 57 9     DIGIT NINE
003A h,  0000 h, 0000 h, 1818 h, 0000 h, 1800 h, 0018 h, 0000 h, 0000 h,   \ 58 :     COLON
003B h,  0000 h, 0000 h, 1818 h, 0000 h, 1800 h, 3018 h, 0000 h, 0000 h,   \ 59 ;     SEMICOLON
003C h,  0000 h, 0600 h, 180C h, 6030 h, 1830 h, 060C h, 0000 h, 0000 h,   \ 60 <     LESS-THAN SIGN
003D h,  0000 h, 0000 h, 7E00 h, 0000 h, 007E h, 0000 h, 0000 h, 0000 h,   \ 61 =     EQUALS SIGN
003E h,  0000 h, 6000 h, 1830 h, 060C h, 180C h, 6030 h, 0000 h, 0000 h,   \ 62 >     GREATER-THAN SIGN
003F h,  0000 h, C67C h, 0CC6 h, 1818 h, 0018 h, 1818 h, 0000 h, 0000 h,   \ 63 ?     QUESTION MARK

0040 h,  0000 h, 7C00 h, C6C6 h, DEDE h, DCDE h, 7CC0 h, 0000 h, 0000 h,   \ 64 @     COMMERCIAL AT
0041 h,  0000 h, 3810 h, C66C h, FEC6 h, C6C6 h, C6C6 h, 0000 h, 0000 h,   \ 65 A     LATIN CAPITAL LETTER A
0042 h,  0000 h, 66FC h, 6666 h, 667C h, 6666 h, FC66 h, 0000 h, 0000 h,   \ 66 B     LATIN CAPITAL LETTER B
0043 h,  0000 h, 663C h, C0C2 h, C0C0 h, C2C0 h, 3C66 h, 0000 h, 0000 h,   \ 67 C     LATIN CAPITAL LETTER C
0044 h,  0000 h, 6CF8 h, 6666 h, 6666 h, 6666 h, F86C h, 0000 h, 0000 h,   \ 68 D     LATIN CAPITAL LETTER D
0045 h,  0000 h, 66FE h, 6862 h, 6878 h, 6260 h, FE66 h, 0000 h, 0000 h,   \ 69 E     LATIN CAPITAL LETTER E
0046 h,  0000 h, 66FE h, 6862 h, 6878 h, 6060 h, F060 h, 0000 h, 0000 h,   \ 70 F     LATIN CAPITAL LETTER F
0047 h,  0000 h, 663C h, C0C2 h, DEC0 h, C6C6 h, 3A66 h, 0000 h, 0000 h,   \ 71 G     LATIN CAPITAL LETTER G
0048 h,  0000 h, C6C6 h, C6C6 h, C6FE h, C6C6 h, C6C6 h, 0000 h, 0000 h,   \ 72 H     LATIN CAPITAL LETTER H
0049 h,  0000 h, 183C h, 1818 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 73 I     LATIN CAPITAL LETTER I
004A h,  0000 h, 0C1E h, 0C0C h, 0C0C h, CCCC h, 78CC h, 0000 h, 0000 h,   \ 74 J     LATIN CAPITAL LETTER J
004B h,  0000 h, 66E6 h, 6C66 h, 7878 h, 666C h, E666 h, 0000 h, 0000 h,   \ 75 K     LATIN CAPITAL LETTER K
004C h,  0000 h, 60F0 h, 6060 h, 6060 h, 6260 h, FE66 h, 0000 h, 0000 h,   \ 76 L     LATIN CAPITAL LETTER L
004D h,  0000 h, E7C3 h, FFFF h, C3DB h, C3C3 h, C3C3 h, 0000 h, 0000 h,   \ 77 M     LATIN CAPITAL LETTER M
004E h,  0000 h, E6C6 h, FEF6 h, CEDE h, C6C6 h, C6C6 h, 0000 h, 0000 h,   \ 78 N     LATIN CAPITAL LETTER N
004F h,  0000 h, C67C h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 79 O     LATIN CAPITAL LETTER O
0050 h,  0000 h, 66FC h, 6666 h, 607C h, 6060 h, F060 h, 0000 h, 0000 h,   \ 80 P     LATIN CAPITAL LETTER P
0051 h,  0000 h, C67C h, C6C6 h, C6C6 h, D6C6 h, 7CDE h, 0E0C h, 0000 h,   \ 81 Q     LATIN CAPITAL LETTER Q
0052 h,  0000 h, 66FC h, 6666 h, 6C7C h, 6666 h, E666 h, 0000 h, 0000 h,   \ 82 R     LATIN CAPITAL LETTER R
0053 h,  0000 h, C67C h, 60C6 h, 0C38 h, C606 h, 7CC6 h, 0000 h, 0000 h,   \ 83 S     LATIN CAPITAL LETTER S
0054 h,  0000 h, DBFF h, 1899 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 84 T     LATIN CAPITAL LETTER T
0055 h,  0000 h, C6C6 h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 85 U     LATIN CAPITAL LETTER U
0056 h,  0000 h, C3C3 h, C3C3 h, C3C3 h, 66C3 h, 183C h, 0000 h, 0000 h,   \ 86 V     LATIN CAPITAL LETTER V
0057 h,  0000 h, C3C3 h, C3C3 h, DBC3 h, FFDB h, 6666 h, 0000 h, 0000 h,   \ 87 W     LATIN CAPITAL LETTER W
0058 h,  0000 h, C3C3 h, 3C66 h, 1818 h, 663C h, C3C3 h, 0000 h, 0000 h,   \ 88 X     LATIN CAPITAL LETTER X
0059 h,  0000 h, C3C3 h, 66C3 h, 183C h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 89 Y     LATIN CAPITAL LETTER Y
005A h,  0000 h, C3FF h, 0C86 h, 3018 h, C160 h, FFC3 h, 0000 h, 0000 h,   \ 90 Z     LATIN CAPITAL LETTER Z
005B h,  0000 h, 303C h, 3030 h, 3030 h, 3030 h, 3C30 h, 0000 h, 0000 h,   \ 91 [     LEFT SQUARE BRACKET
005C h,  0000 h, 8000 h, E0C0 h, 3870 h, 0E1C h, 0206 h, 0000 h, 0000 h,   \ 92 \     REVERSE SOLIDUS
005D h,  0000 h, 0C3C h, 0C0C h, 0C0C h, 0C0C h, 3C0C h, 0000 h, 0000 h,   \ 93 ]     RIGHT SQUARE BRACKET
005E h,  3810 h, C66C h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 94 ^     CIRCUMFLEX ACCENT
005F h,  0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, FF00 h, 0000 h,   \ 95 _     LOW LINE

0060 h,  3030 h, 0018 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 96 `     GRAVE ACCENT
0061 h,  0000 h, 0000 h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 97 a     LATIN SMALL LETTER A
0062 h,  0000 h, 60E0 h, 7860 h, 666C h, 6666 h, 7C66 h, 0000 h, 0000 h,   \ 98 b     LATIN SMALL LETTER B
0063 h,  0000 h, 0000 h, 7C00 h, C0C6 h, C0C0 h, 7CC6 h, 0000 h, 0000 h,   \ 99 c     LATIN SMALL LETTER C
0064 h,  0000 h, 0C1C h, 3C0C h, CC6C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 100 d    LATIN SMALL LETTER D
0065 h,  0000 h, 0000 h, 7C00 h, FEC6 h, C0C0 h, 7CC6 h, 0000 h, 0000 h,   \ 101 e    LATIN SMALL LETTER E
0066 h,  0000 h, 6C38 h, 6064 h, 60F0 h, 6060 h, F060 h, 0000 h, 0000 h,   \ 102 f    LATIN SMALL LETTER F
0067 h,  0000 h, 0000 h, 7600 h, CCCC h, CCCC h, 7CCC h, CC0C h, 0078 h,   \ 103 g    LATIN SMALL LETTER G
0068 h,  0000 h, 60E0 h, 6C60 h, 6676 h, 6666 h, E666 h, 0000 h, 0000 h,   \ 104 h    LATIN SMALL LETTER H
0069 h,  0000 h, 1818 h, 3800 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 105 i    LATIN SMALL LETTER I
006A h,  0000 h, 0606 h, 0E00 h, 0606 h, 0606 h, 0606 h, 6666 h, 003C h,   \ 106 j    LATIN SMALL LETTER J
006B h,  0000 h, 60E0 h, 6660 h, 786C h, 6C78 h, E666 h, 0000 h, 0000 h,   \ 107 k    LATIN SMALL LETTER K
006C h,  0000 h, 1838 h, 1818 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 108 l    LATIN SMALL LETTER L
006D h,  0000 h, 0000 h, E600 h, DBFF h, DBDB h, DBDB h, 0000 h, 0000 h,   \ 109 m    LATIN SMALL LETTER M
006E h,  0000 h, 0000 h, DC00 h, 6666 h, 6666 h, 6666 h, 0000 h, 0000 h,   \ 110 n    LATIN SMALL LETTER N
006F h,  0000 h, 0000 h, 7C00 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 111 o    LATIN SMALL LETTER O
0070 h,  0000 h, 0000 h, DC00 h, 6666 h, 6666 h, 7C66 h, 6060 h, 00F0 h,   \ 112 p    LATIN SMALL LETTER P
0071 h,  0000 h, 0000 h, 7600 h, CCCC h, CCCC h, 7CCC h, 0C0C h, 001E h,   \ 113 q    LATIN SMALL LETTER Q
0072 h,  0000 h, 0000 h, DC00 h, 6676 h, 6060 h, F060 h, 0000 h, 0000 h,   \ 114 r    LATIN SMALL LETTER R
0073 h,  0000 h, 0000 h, 7C00 h, 60C6 h, 0C38 h, 7CC6 h, 0000 h, 0000 h,   \ 115 s    LATIN SMALL LETTER S
0074 h,  0000 h, 3010 h, FC30 h, 3030 h, 3030 h, 1C36 h, 0000 h, 0000 h,   \ 116 t    LATIN SMALL LETTER T
0075 h,  0000 h, 0000 h, CC00 h, CCCC h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 117 u    LATIN SMALL LETTER U
0076 h,  0000 h, 0000 h, C300 h, C3C3 h, 66C3 h, 183C h, 0000 h, 0000 h,   \ 118 v    LATIN SMALL LETTER V
0077 h,  0000 h, 0000 h, C300 h, C3C3 h, DBDB h, 66FF h, 0000 h, 0000 h,   \ 119 w    LATIN SMALL LETTER W
0078 h,  0000 h, 0000 h, C300 h, 3C66 h, 3C18 h, C366 h, 0000 h, 0000 h,   \ 120 x    LATIN SMALL LETTER X
0079 h,  0000 h, 0000 h, C600 h, C6C6 h, C6C6 h, 7EC6 h, 0C06 h, 00F8 h,   \ 121 y    LATIN SMALL LETTER Y
007A h,  0000 h, 0000 h, FE00 h, 18CC h, 6030 h, FEC6 h, 0000 h, 0000 h,   \ 122 z    LATIN SMALL LETTER Z
007B h,  0000 h, 180E h, 1818 h, 1870 h, 1818 h, 0E18 h, 0000 h, 0000 h,   \ 123 {    LEFT CURLY BRACKET
007C h,  0000 h, 1818 h, 1818 h, 1818 h, 1818 h, 1818 h, 0000 h, 0000 h,   \ 124 |    VERTICAL LINE
007D h,  0000 h, 1870 h, 1818 h, 180E h, 1818 h, 7018 h, 0000 h, 0000 h,   \ 125 }    RIGHT CURLY BRACKET
007E h,  0000 h, DC76 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 126 ~    TILDE
007F h,  0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 127 Del  DELETE

00A0 h,  0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 160      NO-BREAK SPACE
00A1 h,  0000 h, 1818 h, 1800 h, 1818 h, 3C3C h, 183C h, 0000 h, 0000 h,   \ 161      INVERTED EXCLAMATION MARK
00A2 h,  1800 h, 7E18 h, C0C3 h, C0C0 h, 7EC3 h, 1818 h, 0000 h, 0000 h,   \ 162      CENT SIGN
00A3 h,  3800 h, 646C h, F060 h, 6060 h, 6060 h, FCE6 h, 0000 h, 0000 h,   \ 163      POUND SIGN
00A4 h,  0000 h, 8200 h, 7CC6 h, C6C6 h, C6C6 h, C67C h, 0082 h, 0000 h,   \ 164      CURRENCY SIGN
00A5 h,  0000 h, 66C3 h, 183C h, 18FF h, 18FF h, 1818 h, 0000 h, 0000 h,   \ 165      YEN SIGN
00A6 h,  0000 h, 1818 h, 1818 h, 1800 h, 1818 h, 1818 h, 0000 h, 0000 h,   \ 166      BROKEN BAR
00A7 h,  7C00 h, 60C6 h, 6C38 h, C6C6 h, 386C h, C60C h, 007C h, 0000 h,   \ 167      SECTION SIGN
00A8 h,  C600 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 168      DIAERESIS
00A9 h,  0000 h, C67C h, BA82 h, A2A2 h, 82BA h, 7CC6 h, 0000 h, 0000 h,   \ 169      COPYRIGHT SIGN
00AA h,  7000 h, 7818 h, 78C8 h, F800 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 170      FEMININE ORDINAL INDICATOR
00AB h,  0000 h, 0000 h, 3600 h, D86C h, 366C h, 0000 h, 0000 h, 0000 h,   \ 171      LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
00AC h,  0000 h, 0000 h, 0000 h, 06FE h, 0606 h, 0006 h, 0000 h, 0000 h,   \ 172      NOT SIGN
00AD h,  0000 h, 0000 h, 0000 h, 7C00 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 173      SOFT HYPHEN
00AE h,  0000 h, C67C h, BA82 h, B2AA h, 82AA h, 7CC6 h, 0000 h, 0000 h,   \ 174      REGISTERED SIGN
00AF h,  FE00 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 175      MACRON
00B0 h,  3800 h, 6C6C h, 0038 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 176      DEGREE SIGN
00B1 h,  0000 h, 0000 h, 1818 h, 187E h, 0018 h, 7E00 h, 0000 h, 0000 h,   \ 177      PLUS-MINUS SIGN
00B2 h,  7000 h, 30D8 h, C860 h, 00F8 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 178      SUPERSCRIPT TWO
00B3 h,  F800 h, 3018 h, D818 h, 0070 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 179      SUPERSCRIPT THREE
00B4 h,  3018 h, 0060 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 180      ACUTE ACCENT
00B5 h,  0000 h, 0000 h, 6666 h, 6666 h, 7E66 h, 6063 h, 00C0 h, 0000 h,   \ 181      MICRO SIGN
00B6 h,  0000 h, DB7F h, DBDB h, 1B7B h, 1B1B h, 1B1B h, 0000 h, 0000 h,   \ 182      PILCROW SIGN
00B7 h,  0000 h, 0000 h, 0000 h, 1800 h, 0018 h, 0000 h, 0000 h, 0000 h,   \ 183      MIDDLE DOT
00B8 h,  0000 h, 0000 h, 0000 h, 0000 h, 0000 h, 0C18 h, 3C06 h, 0000 h,   \ 184      CEDILLA
00B9 h,  6000 h, 60E0 h, 6060 h, 00F0 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 185      SUPERSCRIPT ONE
00BA h,  7000 h, 88D8 h, 70D8 h, F800 h, 0000 h, 0000 h, 0000 h, 0000 h,   \ 186      MASCULINE ORDINAL INDICATOR
00BB h,  0000 h, 0000 h, D800 h, 366C h, D86C h, 0000 h, 0000 h, 0000 h,   \ 187      RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
00BC h,  C000 h, C2C0 h, CCC6 h, 3018 h, CE66 h, 3E96 h, 0606 h, 0000 h,   \ 188      VULGAR FRACTION ONE QUARTER
00BD h,  C000 h, C2C0 h, CCC6 h, 3018 h, CE60 h, 069B h, 1F0C h, 0000 h,   \ 189      VULGAR FRACTION ONE HALF
00BE h,  F000 h, 7230 h, EC36 h, 3018 h, CE66 h, 3E96 h, 0606 h, 0000 h,   \ 190      VULGAR FRACTION THREE QUARTERS
00BF h,  0000 h, 3030 h, 3000 h, 6030 h, C6C0 h, 7CC6 h, 0000 h, 0000 h,   \ 191      INVERTED QUESTION MARK

00C0 h,  3060 h, 0018 h, 6C38 h, C6C6 h, C6FE h, C6C6 h, 0000 h, 0000 h,   \ 192      LATIN CAPITAL LETTER A WITH GRAVE
00C1 h,  180C h, 0030 h, 6C38 h, C6C6 h, C6FE h, C6C6 h, 0000 h, 0000 h,   \ 193      LATIN CAPITAL LETTER A WITH ACUTE
00C2 h,  3810 h, 006C h, 6C38 h, C6C6 h, C6FE h, C6C6 h, 0000 h, 0000 h,   \ 194      LATIN CAPITAL LETTER A WITH CIRCUMFLEX
00C3 h,  7600 h, 00DC h, 6C38 h, C6C6 h, C6FE h, C6C6 h, 0000 h, 0000 h,   \ 195      LATIN CAPITAL LETTER A WITH TILDE
00C4 h,  C600 h, 1000 h, 6C38 h, C6C6 h, C6FE h, C6C6 h, 0000 h, 0000 h,   \ 196      LATIN CAPITAL LETTER A WITH DIAERESIS
00C5 h,  6C38 h, 0038 h, 6C38 h, C6C6 h, C6FE h, C6C6 h, 0000 h, 0000 h,   \ 197      LATIN CAPITAL LETTER A WITH RING ABOVE
00C6 h,  0000 h, 6C3E h, CCCC h, CCFE h, CCCC h, CECC h, 0000 h, 0000 h,   \ 198      LATIN CAPITAL LETTER AE
00C7 h,  0000 h, 663C h, C0C2 h, C0C0 h, 66C2 h, 0C3C h, 7C06 h, 0000 h,   \ 199      LATIN CAPITAL LETTER C WITH CEDILLA
00C8 h,  1830 h, 000C h, 66FE h, 7C60 h, 6060 h, FE66 h, 0000 h, 0000 h,   \ 200      LATIN CAPITAL LETTER E WITH GRAVE
00C9 h,  3018 h, 0060 h, 66FE h, 7C60 h, 6060 h, FE66 h, 0000 h, 0000 h,   \ 201      LATIN CAPITAL LETTER E WITH ACUTE
00CA h,  3810 h, 006C h, 66FE h, 7C60 h, 6060 h, FE66 h, 0000 h, 0000 h,   \ 202      LATIN CAPITAL LETTER E WITH CIRCUMFLEX
00CB h,  C600 h, FE00 h, 6066 h, 7C60 h, 6060 h, FE66 h, 0000 h, 0000 h,   \ 203      LATIN CAPITAL LETTER E WITH DIAERESIS
00CC h,  1830 h, 000C h, 183C h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 204      LATIN CAPITAL LETTER I WITH GRAVE
00CD h,  180C h, 0030 h, 183C h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 205      LATIN CAPITAL LETTER I WITH ACUTE
00CE h,  3C18 h, 0066 h, 183C h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 206      LATIN CAPITAL LETTER I WITH CIRCUMFLEX
00CF h,  6600 h, 3C00 h, 1818 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 207      LATIN CAPITAL LETTER I WITH DIAERESIS
00D0 h,  0000 h, 6C78 h, 6666 h, F666 h, 6666 h, 786C h, 0000 h, 0000 h,   \ 208      LATIN CAPITAL LETTER ETH (Icelandic)
00D1 h,  DC76 h, C600 h, F6E6 h, DEFE h, C6CE h, C6C6 h, 0000 h, 0000 h,   \ 209      LATIN CAPITAL LETTER N WITH TILDE
00D2 h,  3060 h, 0018 h, C67C h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 210      LATIN CAPITAL LETTER O WITH GRAVE
00D3 h,  180C h, 0030 h, C67C h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 211      LATIN CAPITAL LETTER O WITH ACUTE
00D4 h,  3810 h, 006C h, C67C h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 212      LATIN CAPITAL LETTER O WITH CIRCUMFLEX
00D5 h,  DC76 h, 7C00 h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 213      LATIN CAPITAL LETTER O WITH TILDE
00D6 h,  C600 h, 7C00 h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 214      LATIN CAPITAL LETTER O WITH DIAERESIS
00D7 h,  0000 h, 0000 h, 6CC6 h, 1038 h, 6C38 h, 00C6 h, 0000 h, 0000 h,   \ 215      MULTIPLICATION SIGN
00D8 h,  0602 h, CE7C h, DECE h, D6D6 h, E6F6 h, 7CE6 h, 80C0 h, 0000 h,   \ 216      LATIN CAPITAL LETTER O WITH STROKE
00D9 h,  3060 h, 0018 h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 217      LATIN CAPITAL LETTER U WITH GRAVE
00DA h,  180C h, 0030 h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 218      LATIN CAPITAL LETTER U WITH ACUTE
00DB h,  3810 h, 006C h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 219      LATIN CAPITAL LETTER U WITH CIRCUMFLEX
00DC h,  C600 h, C600 h, C6C6 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 220      LATIN CAPITAL LETTER U WITH DIAERESIS
00DD h,  180C h, 0030 h, C3C3 h, 3C66 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 221      LATIN CAPITAL LETTER Y WITH ACUTE
00DE h,  60F0 h, 667C h, 6666 h, 607C h, 6060 h, F060 h, 0000 h, 0000 h,   \ 222      LATIN CAPITAL LETTER THORN (Icelandic)
00DF h,  0000 h, 6C38 h, CEC6 h, D8DC h, C6CC h, DCD6 h, 80C0 h, 0000 h,   \ 223      LATIN SMALL LETTER SHARP S (German)

00E0 h,  6000 h, 1830 h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 224      LATIN SMALL LETTER A WITH GRAVE
00E1 h,  1800 h, 6030 h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 225      LATIN SMALL LETTER A WITH ACUTE
00E2 h,  1000 h, 6C38 h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 226      LATIN SMALL LETTER A WITH CIRCUMFLEX
00E3 h,  0000 h, DC76 h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 227      LATIN SMALL LETTER A WITH TILDE
00E4 h,  0000 h, 00CC h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 228      LATIN SMALL LETTER A WITH DIAERESIS
00E5 h,  3800 h, 386C h, 7800 h, 7C0C h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 229      LATIN SMALL LETTER A WITH RING ABOVE
00E6 h,  0000 h, 0000 h, 6E00 h, 1B3B h, D87E h, 77DC h, 0000 h, 0000 h,   \ 230      LATIN SMALL LETTER AE
00E7 h,  0000 h, 0000 h, 663C h, 6060 h, 3C66 h, 060C h, 003C h, 0000 h,   \ 231      LATIN SMALL LETTER C WITH CEDILLA
00E8 h,  6000 h, 1830 h, 7C00 h, FEC6 h, C0C0 h, 7CC6 h, 0000 h, 0000 h,   \ 232      LATIN SMALL LETTER E WITH GRAVE
00E9 h,  0C00 h, 3018 h, 7C00 h, FEC6 h, C0C0 h, 7CC6 h, 0000 h, 0000 h,   \ 233      LATIN SMALL LETTER E WITH ACUTE
00EA h,  1000 h, 6C38 h, 7C00 h, FEC6 h, C0C0 h, 7CC6 h, 0000 h, 0000 h,   \ 234      LATIN SMALL LETTER E WITH CIRCUMFLEX
00EB h,  0000 h, 00C6 h, 7C00 h, FEC6 h, C0C0 h, 7CC6 h, 0000 h, 0000 h,   \ 235      LATIN SMALL LETTER E WITH DIAERESIS
00EC h,  6000 h, 1830 h, 3800 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 236      LATIN SMALL LETTER I WITH GRAVE
00ED h,  0600 h, 180C h, 3800 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 237      LATIN SMALL LETTER I WITH ACUTE
00EE h,  1800 h, 663C h, 3800 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 238      LATIN SMALL LETTER I WITH CIRCUMFLEX
00EF h,  0000 h, 0066 h, 3800 h, 1818 h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 239      LATIN SMALL LETTER I WITH DIAERESIS
00F0 h,  6C00 h, 3838 h, 0C6C h, 6C3C h, CCCC h, 78CC h, 0000 h, 0000 h,   \ 240      LATIN SMALL LETTER ETH (Icelandic)
00F1 h,  0000 h, DC76 h, DC00 h, 6666 h, 6666 h, 6666 h, 0000 h, 0000 h,   \ 241      LATIN SMALL LETTER N WITH TILDE
00F2 h,  6000 h, 1830 h, 7C00 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 242      LATIN SMALL LETTER O WITH GRAVE
00F3 h,  1800 h, 6030 h, 7C00 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 243      LATIN SMALL LETTER O WITH ACUTE
00F4 h,  1000 h, 6C38 h, 7C00 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 244      LATIN SMALL LETTER O WITH CIRCUMFLEX
00F5 h,  0000 h, DC76 h, 7C00 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 245      LATIN SMALL LETTER O WITH TILDE
00F6 h,  0000 h, 00C6 h, 7C00 h, C6C6 h, C6C6 h, 7CC6 h, 0000 h, 0000 h,   \ 246      LATIN SMALL LETTER O WITH DIAERESIS
00F7 h,  0000 h, 0000 h, 1818 h, 7E00 h, 1800 h, 0018 h, 0000 h, 0000 h,   \ 247      DIVISION SIGN
00F8 h,  0000 h, 0200 h, 7C06 h, DECE h, F6D6 h, 7CE6 h, 80C0 h, 0000 h,   \ 248      LATIN SMALL LETTER O WITH STROKE
00F9 h,  6000 h, 1830 h, CC00 h, CCCC h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 249      LATIN SMALL LETTER U WITH GRAVE
00FA h,  1800 h, 6030 h, CC00 h, CCCC h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 250      LATIN SMALL LETTER U WITH ACUTE
00FB h,  3000 h, CC78 h, CC00 h, CCCC h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 251      LATIN SMALL LETTER U WITH CIRCUMFLEX
00FC h,  0000 h, 00CC h, CC00 h, CCCC h, CCCC h, 76CC h, 0000 h, 0000 h,   \ 252      LATIN SMALL LETTER U WITH DIAERESIS
00FD h,  1800 h, 6030 h, C600 h, C6C6 h, C6C6 h, 7EC6 h, 0C06 h, 00F8 h,   \ 253      LATIN SMALL LETTER Y WITH ACUTE
00FE h,  0000 h, F000 h, 7C60 h, 6666 h, 6666 h, 7C66 h, 6060 h, 00F0 h,   \ 254      LATIN SMALL LETTER THORN (Icelandic)
00FF h,  0000 h, 6666 h, EE00 h, 6666 h, 6666 h, 3E66 h, 0C06 h, 0038 h,   \ 255      LATIN SMALL LETTER Y WITH DIAERESIS


\ Unicode point, Bitmap Data               \ ISO8859-15, Name

20AC h,  0000 h, 311E h, 6060 h, 60FE h, 60FC h, 1E31 h, 0000 h, 0000 h,   \ 164      EURO SIGN
0160 h,  386C h, 0010 h, C67C h, 3060 h, 0C18 h, 7CC6 h, 0000 h, 0000 h,   \ 166      LATIN CAPITAL LETTER S WITH CARON
0161 h,  6C00 h, 1038 h, 7C00 h, 60C6 h, 0C38 h, 7CC6 h, 0000 h, 0000 h,   \ 168      LATIN SMALL LETTER S WITH CARON
017D h,  386C h, 0010 h, C6FE h, 180C h, 6030 h, FEC6 h, 0000 h, 0000 h,   \ 180      LATIN CAPITAL LETTER Z WITH CARON
017E h,  6C00 h, 1038 h, FE00 h, 18CC h, 6030 h, FEC6 h, 0000 h, 0000 h,   \ 184      LATIN SMALL LETTER Z WITH CARON
0152 h,  0000 h, CC7E h, CCCC h, CCCE h, CCCC h, 7ECC h, 0000 h, 0000 h,   \ 188      LATIN CAPITAL LIGATURE OE
0153 h,  0000 h, 0000 h, 6E00 h, DBDB h, D8DE h, 67DC h, 0000 h, 0000 h,   \ 189      LATIN SMALL LIGATURE OE
0178 h,  C300 h, C300 h, 66C3 h, 183C h, 1818 h, 3C18 h, 0000 h, 0000 h,   \ 190      LATIN CAPITAL LETTER Y WITH DIAERESIS


0000 h,  0000 h, 0000 h, 3810 h, C66C h, FEC6 h, 0000 h, 0000 h, 0000 h,   \ End of font marker, replacement glyph.

halign decimal


: unicode>bitmap ( x -- c-addr ) \ Translates Unicode character to address of 8x8 bitmap.

  font ( x addr )
  begin
    2dup h@ = if nip 2 + exit then \ Character found, skip character number, give back bitmap data
  dup h@ while \ As long as there are more characters left in the glyph collection...
    18 + \ Not this one, skip it and its bitmap
  repeat

  nip 2 + \ Character not found within available collection of glyphs. Display replacement.

1-foldable ;

\ -------------------------------------------------------------
\  Write an Unicode character with 8x16 bitmap font
\ -------------------------------------------------------------

0 variable font-x   0 variable font-y

: drawbytepattern ( c -- )
  8 0 do dup 128 and if font-x @ font-y @ putpixel then shl 1 font-x +! loop
  drop -8 font-x +!
;

: drawcharacterbitmap ( c-addr -- )
  16 0 do dup c@ drawbytepattern 1 font-y +! 1+ loop
  drop -16 font-y +! 8 font-x +!
;

: drawunicode ( x -- ) unicode>bitmap drawcharacterbitmap ;

\ -------------------------------------------------------------
\  Unicode UTF-8 encoding decoder
\ -------------------------------------------------------------

0 variable utf8collection
0 variable utf8continuation

: utf8-character-length ( c -- c u )
  dup %11000000 and %11000000 = if dup 24 lshift not clz else 1 then ;

: drawcharacter ( c -- ) \ Handles a stream of UTF-8 bytes and translates this into Unicode letters.

  utf8continuation @
  if   \ Continue to receive an extended character into buffer

    %00111111 and utf8collection @ 6 lshift or utf8collection !  \ Six more bits
    -1 utf8continuation +!                                       \ One less continuation byte to expect
    utf8continuation @ 0= if utf8collection @ drawunicode then   \ Draw character if complete encoding was buffered.

  else \ Begin of a new character

    utf8-character-length 1- ?dup

    if \ Start of a new character or a sequence
      dup utf8continuation !
      25 + tuck lshift swap rshift \ Remove the length encoding by shifting it out of the register temporarily
      utf8collection !
    else \ One byte characters are classic 7 bit ASCII and can be drawn immediately
      drawunicode
    then

  then
;

\ -------------------------------------------------------------
\  Write a string and split into individual characters
\ -------------------------------------------------------------

: get-first-char ( addr len -- addr   len c ) over c@ ;
: cut-first-char ( addr len -- addr+1 len-1 ) 1- swap 1+ swap ;

: drawstring ( addr u x y -- )
  font-y ! font-x !

  begin
    dup 0<>
  while
    get-first-char
    drawcharacter
    cut-first-char
  repeat
  2drop
;

\ -------------------------------------------------------------
\  A small demo
\ -------------------------------------------------------------

: demo ( -- )
  page
  50 14 32 12 ellipse
  50 14 34 14 ellipse
  s" Mecrisp" 22 7 drawstring
  2 4 12 24 line
  4 4 14 24 line
;
