I apologize for the delay in replying.  I thought someone else had
written something similar to what you're asking about, and it took a
while to determine that there wasn't any such thing.


takanobu maekawa <[EMAIL PROTECTED]> writes:

> I have found DisplayContext class and wonder I can somehow do this
> with it... :-D

Yes, I think DisplayContext.get-string-advance-width corresponds
(roughly) to Graphics.MeasureString in VB.

There are a number of different problems that you might be trying to
solve.  I'm including an applet that solves one of them.  You might be
able to adapt it to your needs.  If it doesn't do what you need, let
me know and maybe I can write something that fits better.

  --deh!


{curl 4.0 applet}

{define-class public ShrinkingText {inherits Graphic}
  field private constant ideal-font-size:Distance
  field private constant min-font-size:Distance

  field private contents:String = ""
  field private font:Font = {Font "sans-serif", 12pt} ||""

  {constructor public {default
                          ideal-font-size:Distance = 12pt,
                          min-font-size:Distance = 4pt,
                          ...
                      }
    set self.ideal-font-size = ideal-font-size
    set self.min-font-size = min-font-size
    {construct-super ...}
  }

  {method public {non-keyword-init-arg a:any}:void
    {type-switch a
     case a:String do
        set self.contents = a
     else
        {super.non-keyword-init-arg a}
    }
  }

  {method private {get-font size:Distance}:Font
    {return
        {Font
            self.font-family,
            size,
            weight = self.font-weight,
            style = self.font-style
        }
    }
  }

  {method private {get-font-values
                      dc:DisplayContext,
                      size:Distance
                  }:(font:Font,
                     width:Distance,
                     ascent:Distance,
                     descent:Distance)
    let constant font:Font = {self.get-font size}
    let constant width:Distance =
        {dc.get-string-advance-width font, self.contents}
    let constant ascent:Distance =  {dc.get-font-ascent font}
    let constant descent:Distance = {dc.get-font-descent font}
    {return font, width, ascent, descent}
  }

  {method public {get-width-preference lc:LayoutContext}:Dimension
    let constant dc:DisplayContext = lc.layout-display-context
    let constant font:Font = {self.get-font self.ideal-font-size}
    let constant width:Distance =
        {dc.get-string-advance-width font, self.contents}

    let constant stretchiness:double =
        {if width > 0m then
            (width / 1pt)
         else
            .0001
        }
    let constant elastic:Elastic =
        {make-elastic
            minimum-size = width,
            preferred-size = width,
            compressibility = stretchiness,
            compress-order = rigid-compress-order,
            stretchiness = stretchiness,
            stretch-order = rigid-stretch-order
        }
    {return elastic}
  }

  {method public {get-height-preference lc:LayoutContext}:Dimension
    let constant dc:DisplayContext = lc.layout-display-context
    let constant font:Font = {self.get-font self.ideal-font-size}
    let constant ascent:Distance = {dc.get-font-ascent font}
    let constant descent:Distance = {dc.get-font-descent font}

    let constant ascent-stretch-order:int = rigid-stretch-order - 2

    let constant oe:OriginElastic =
        {make-origin-elastic
            first={make-elastic
                      minimum-size = ascent,
                      preferred-size = ascent,
                      stretch-order = ascent-stretch-order
                  },
            last={make-elastic
                     minimum-size = descent,
                     preferred-size = descent,
                     stretch-order = rigid-stretch-order,
                     compress-order = rigid-compress-order
                 }
        }
    {return oe}
  }

  {method public {set-size lc:LayoutContext, bounds:GRect}:void
    let constant dc:DisplayContext = lc.layout-display-context
    let constant contents:String = self.contents

    let constant max-width:Distance = bounds.rextent
    let constant max-ascent:Distance = bounds.ascent
    let constant max-descent:Distance = bounds.descent

    let constant min-font-size:Distance = self.min-font-size

    let current-font-size:Distance = self.ideal-font-size
    let (font:Font, width:Distance, ascent:Distance, descent:Distance) =
        {self.get-font-values dc, current-font-size}

    {while
        width > max-width or
        ascent > max-ascent or
        descent > max-descent
     do
        {dump width, current-font-size}

        {dec current-font-size, 1pt}
        set (font, width, ascent, descent) =
            {self.get-font-values dc, current-font-size}
        {if current-font-size <= min-font-size then
            {break}
        }
    }

    set self.font = font
  }

  {method public {draw r:Renderer2d}:void
    {r.render-string 0m, 0m, self.contents, font = self.font}
  }
}

{define-proc {mytext ...}:Graphic
    {return
        {ShrinkingText
            border-color = "black",
            border-width = 1px,
            ...
        }
    }
}

The ideal size:

{mytext ideal-font-size = 64pt, "Greetings, good sir!"}

Limited width:

{mytext width = 5cm, ideal-font-size = 64pt, "Greetings, good sir!"}

Limited height:

{mytext height = 1.5cm, ideal-font-size = 64pt, "Greetings, good sir!"}

Hitting the min size:

{mytext width = 1cm, ideal-font-size = 64pt, "Greetings, good sir!"}

*******************************************
To unsubscribe from this list, send a mail to:
mailto:[EMAIL PROTECTED]
To contact a human list administrator, send a mail to:
mailto:[EMAIL PROTECTED]
To recieve a list of other options for this list, send a mail to:
mailto:[EMAIL PROTECTED]

Reply via email to