Home   Archive   Permalink

How to get wrapped text in a face object

I wrote a function to get a copy of wrapped text in a face object. I think it could be useful for someone else.
     ;a long text to be wrapped by face object
     s: {Originally, these port numbers were used by the Transmission Control Protocol (TCP) and the User Datagram Protocol (UDP),
     but are used also for the Stream Control Transmission Protocol (SCTP), and the Datagram Congestion Control Protocol (DCCP).
     SCTP and DCCP services usually use a port number that matches the service of the corresponding TCP or UDP implementation if they exist.
     The Internet Assigned Numbers Authority (IANA) is responsible for maintaining the official assignments of port numbers for specific uses.[1]
     However, many unofficial uses of both well-known and registered port numbers occur in practice.}
     gui: layout [
         backcolor gray / 1
         m: label 200 s white red edge [size: 4x4 color: black]
     wrap-text: func ["Returns the wrapped text in a face object." f "Face object." /local p t tmp-face h] [
         if any [none? f/text empty? f/text] [return copy ""]
         ;find the font height in pixels
         tmp-face: make face m []
         tmp-face/text: copy/part tmp-face/text 1
         h: second size-text tmp-face
         t: copy f/text
         repeat i length? f/line-list [
             p: index? offset-to-caret f as-pair 0 i + 1 * h
             insert at t p + i - 1 newline
     print wrap-text m
     view gui

posted by:   Endo       16-Sep-2011/3:42:37-7:00

I wrote another and probably a better version of the same function:
    gui: layout [
        b1: box 70x100 bold red "Wednesday"
        b2: box 70x100 bold red "Wednesday"
    view/new gui
    wrap-text: func [f /local i inf line-list result] [
        result: make string! 100
        if any [none? f/text empty? f/text] [return result]
        line-list: make system/view/line-info []
        i: 0
        while [
            inf: textinfo f line-list i
        ] [
            probe inf
            either tail? skip inf/start inf/num-chars [
                append result copy/part inf/start inf/num-chars
            ] [
                append result join copy/part inf/start inf/num-chars newline
            i: i + 1
    b2/text: wrap-text b1
    show b2
    probe b1/text
    probe b2/text

posted by:   Endo       18-Sep-2011/5:29:14-7:00

Thank you Endo :)

posted by:   Nick       19-Sep-2011/4:00:40-7:00