Paste: a font library

! I wrote this for my graphics homework
! It outputs lines of four integers, which should be
! interpreted as:
! X1 Y1 X2 Y2
! For each of these, another program draws a line from
! (X1, Y1) to (X2, Y2), and this displays some text
USING: math kernel sequences arrays namespaces io.files io
fry math.parser assocs io.encodings.ascii grouping math.matrices
combinators generalizations ;
IN: font

CONSTANT: letters H{
    { CHAR: l { { { .5 0 } { .5 1 } } } }
    { CHAR: o { { { .5 0 } { 0 .1 } { 0 .4 } { .5 .5 } { 1 .4 } { 1 .1 } { .5 0 } } } }
    { CHAR: d { { { .5 0 } { 0 .1 } { 0 .4 } { .5 .5 } { 1 .4 } { 1 .1 } { .5 0 } } { { 1 0 } { 1 1 } } } }
    { CHAR: w { { { 0 .5 } { .25 0 } { .5 .5 } { .75 0 } { 1 .5 } } } }
    { CHAR: ! { { { .5 .2 } { .5 1 } } { { .5 0 } { .5 .1 } } } }
    { CHAR: r { { { 0 0 } { 0 .5 } } { { 0 .4 } { .5 .5 } { 1 .4 } } } }
    { CHAR: h { { { 0 0 } { 0 1 } } { { 0 .4 } { .5 .5 } { 1 .4 } { 1 0 } } } }
    { CHAR: e { { { 0 .3 } { 1 .3 } { .8 .5 } { .2 .5 } { 0 .3 } { .2 0 } { .8 0 } { 1 .15 } } } }
    { CHAR: x { { { 0 .5 } { 1 0 } } { { 0 0 } { 1 .5 } } } }
    { CHAR: t { { { .5 0 } { .5 1 } } { { 0 .5 } { 1 .5 } } } }
    { CHAR: b { { { 0 1 } { 0 0 } { .8 0 } { 1 .25 } { .8 .5 } { 0 .5 } } } }
    { CHAR: i { { { .5 0 } { .5 .5 } } { { .5 .6 } { .5 .7 } } } }
    { CHAR: a { { { 1 0 } { 1 .5 } { .2 .5 } { 0 .25 } { .2 0 } { .8 0 } { 1 .2 } } } }
    { CHAR: c { { { 1 .5 } { .2 .5 } { 0 .25 } { .2 0 } { 1 0 } } } }
    { CHAR: H { { { 0 0 } { 0 1 } } { { 0 .5 } { 1 .5 } } { { 1 0 } { 1 1 } } } }
    { CHAR: s { { { 1 .5 } { .2 .5 } { 0 .375 } { .2 .25 } { .8 .25 } { 1 .125 } { .8 0 } { 0 0 } } } }
}

: scale ( point width height -- point' )
    2array [ * ] 2map ;

SYMBOL: location

: next-location ( offset -- location )
    [ location get ] dip
    location [
        first2 [ + ] dip 2array
    ] change ;

: locate ( commands offset -- commands' )
    next-location '[ [ _ [ + >integer ] 2map ] map ] map ;

: typeset ( string width height offset location -- commands )
    location [
        '[ letters at [ [ _ _ scale ] map ] map _ locate ] { } map-as concat
    ] with-variable ;

: string>commands ( string -- commands )
    50 100 60 { -350 -50 } typeset ;

: italicize ( commands base -- italics-commands )
    '[ [ { { 1 0 } { .2 1 } } v.m first2 [ _ .2 * - ] dip 2array ] map ] map ;

: string>italics-commands ( string -- commands )
    60 90 65 { -390 200 } typeset 200 italicize ;

: boldface ( commands times -- bold-commands )
    [ '[ [ [ _ + ] map ] map ] map ] with map concat ;

: string>boldface-commands ( string -- commands )
    40 120 55 { -320 -250 } typeset 7 boldface ;

: string>both-commands ( string -- commands )
    30 50 35 { -200 120 } typeset 4 boldface 120 italicize ;

: print-commands ( commands -- )
    [
        2 <clumps> [
            [ [ >integer number>string write bl ] each ] each nl
        ] each
    ] each ;

: print-string ( -- )
    "bold text" string>boldface-commands
    "italics text" string>italics-commands
    "both!!!!!!!!" string>both-commands
    "Hello world!" string>commands
    4 nappend print-commands ;