Home   Archive   Permalink



How to get wrapped text in a face object

Hi,
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
         ]
         t
     ]
    
     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"
        return
        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
        ]
        result
    ]
    
    b2/text: wrap-text b1
    show b2
    
    probe b1/text
    probe b2/text
    halt


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