<commit_before>! Copyright (C) 2005, 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math math.functions
namespaces make opengl sequences strings splitting ui.gadgets
ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
ui.baseline-alignment ui.text colors colors.constants models
combinators opengl.gl ;
IN: ui.gadgets.labels

! A label gadget draws a string.
TUPLE: label < gadget text font ;

SLOT: string

M: label string>> ( label -- string )
    text>> dup string? [ "\n" join ] unless ; inline

<PRIVATE

PREDICATE: string-array < array [ string? ] all? ;

PRIVATE>

: ?string-lines ( string -- string/array )
    CHAR: \n over member-eq? [ string-lines ] when ;

ERROR: not-a-string object ;

M: label string<< ( string label -- )
    [
        {
            { [ dup string-array? ] [ ] }
            { [ dup string? ] [ ?string-lines ] }
            [ not-a-string ]
        } cond
    ] dip text<< ; inline

: label-theme ( gadget -- gadget )
    sans-serif-font >>font ; inline

: new-label ( string class -- label )
    new
    swap >>string
    label-theme ; inline

: <label> ( string -- label )
    label new-label ;

: >label< ( label -- font text )
    [ font>> ] [ text>> ] bi ;

M: label pref-dim*
    >label< text-dim ;

<PRIVATE

: label-metrics ( label -- metrics )
    >label< dup string? [ first ] unless line-metrics ;

PRIVATE>

M: label baseline
    label-metrics ascent>> round ;

M: label cap-height
    label-metrics cap-height>> round ;

M: label draw-gadget*
    >label<<commit_msg>ui.gadgets.labels: use font-metrics directly.<commit_after>! Copyright (C) 2005, 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hashtables io kernel math math.functions
namespaces make opengl sequences strings splitting ui.gadgets
ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
ui.baseline-alignment ui.text colors colors.constants models
combinators opengl.gl ;
IN: ui.gadgets.labels

! A label gadget draws a string.
TUPLE: label < gadget text font ;

SLOT: string

M: label string>> ( label -- string )
    text>> dup string? [ "\n" join ] unless ; inline

<PRIVATE

PREDICATE: string-array < array [ string? ] all? ;

PRIVATE>

: ?string-lines ( string -- string/array )
    CHAR: \n over member-eq? [ string-lines ] when ;

ERROR: not-a-string object ;

M: label string<< ( string label -- )
    [
        {
            { [ dup string-array? ] [ ] }
            { [ dup string? ] [ ?string-lines ] }
            [ not-a-string ]
        } cond
    ] dip text<< ; inline

: label-theme ( gadget -- gadget )
    sans-serif-font >>font ; inline

: new-label ( string class -- label )
    new
    swap >>string
    label-theme ; inline

: <label> ( string -- label )
    label new-label ;

: >label< ( label -- font text )
    [ font>> ] [ text>> ] bi ;

M: label pref-dim*
    >label< text-dim ;

M: label baseline
    font>> font-metrics ascent>> round ;

M: label cap-height
    font>> font-metrics cap-height>> round ;

M: label draw-gadget*
    >label<
{'fraction_non_alphanumeric': 0.13222079589216945, 'fraction_numerical': 0.005134788189987163, 'mean_word_length': 2.6541617819460726, 'pattern_counts': {'":': 0, '<': 29, '<?xml version=': 0, '>': 53, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '914493', 'n_tokens_mistral': 1049, 'n_tokens_neox': 1022, 'n_words': 309}