4240 |origin family face style moreStyle skip fheight size |
4240 |origin family face style moreStyle skip fheight size |
4241 resX resY x1 x2 coding start end | |
4241 resX resY x1 x2 coding start end | |
4242 |
4242 |
4243 aString isNil ifTrue:[^ false]. |
4243 aString isNil ifTrue:[^ false]. |
4244 (aString startsWith:'-') ifFalse:[ |
4244 (aString startsWith:'-') ifFalse:[ |
4245 " |
4245 " |
4246 take care for ill-named fonts (i.e. pre Rel4 fonts) |
4246 take care for ill-named fonts (i.e. pre Rel4 fonts) |
4247 " |
4247 " |
4248 ('*-*-[0-9]*' match:aString) ifTrue:[ |
4248 ('*-*-[0-9]*' match:aString) ifTrue:[ |
4249 end := aString indexOf:$- startingAt:1. |
4249 end := aString indexOf:$- startingAt:1. |
4250 family := aString copyFrom:1 to:(end - 1). |
4250 family := aString copyFrom:1 to:(end - 1). |
4251 start := end + 1. |
4251 start := end + 1. |
4252 end := aString indexOf:$- startingAt:start. |
4252 end := aString indexOf:$- startingAt:start. |
4253 style := aString copyFrom:start to:(end - 1). |
4253 style := aString copyFrom:start to:(end - 1). |
4254 start := end + 1. |
4254 start := end + 1. |
4255 size := aString copyFrom:start. |
4255 size := aString copyFrom:start. |
4256 size := (Number readFromString:size onError:[^false]). |
4256 size := (Number readFromString:size onError:[^false]). |
4257 aBlock value:family value:nil value:style value:size value:nil. |
4257 aBlock value:family value:nil value:style value:size value:nil. |
4258 ^ true. |
4258 ^ true. |
4259 ]. |
4259 ]. |
4260 ('*-[0-9]*' match:aString) ifTrue:[ |
4260 ('*-[0-9]*' match:aString) ifTrue:[ |
4261 " |
4261 " |
4262 something like lucidasans-24 |
4262 something like lucidasans-24 |
4263 " |
4263 " |
4264 end := aString indexOf:$- startingAt:1. |
4264 end := aString indexOf:$- startingAt:1. |
4265 |
4265 |
4266 family := aString copyFrom:1 to:(end - 1). |
4266 family := aString copyFrom:1 to:(end - 1). |
4267 start := end + 1. |
4267 start := end + 1. |
4268 size := aString copyFrom:start. |
4268 size := aString copyFrom:start. |
4269 size := (Number readFromString:size onError:[^false]). |
4269 size := (Number readFromString:size onError:[^false]). |
4270 aBlock value:family value:nil value:nil value:size value:nil. |
4270 aBlock value:family value:nil value:nil value:size value:nil. |
4271 ^ true. |
4271 ^ true. |
4272 ]. |
4272 ]. |
4273 aBlock value:aString value:nil value:nil value:nil value:nil. |
4273 aBlock value:aString value:nil value:nil value:nil value:nil. |
4274 ^ true. |
4274 ^ true. |
4275 ]. |
4275 ]. |
4276 |
4276 |
4277 end := aString indexOf:$- startingAt:2. |
4277 end := aString indexOf:$- startingAt:2. |
4278 (end == 0) ifTrue:[^ false]. |
4278 (end == 0) ifTrue:[^ false]. |
4279 origin := aString copyFrom:2 to:(end - 1). |
4279 origin := aString copyFrom:2 to:(end - 1). |
4628 |
4632 |
4629 ^ self createFontFor:'fixed' |
4633 ^ self createFontFor:'fixed' |
4630 ! |
4634 ! |
4631 |
4635 |
4632 getFontWithFamily:familyString face:faceString |
4636 getFontWithFamily:familyString face:faceString |
4633 style:styleString size:sizeArg encoding:encodingSym |
4637 style:styleArgString size:sizeArg encoding:encodingSym |
4634 |
4638 |
4635 "try to get the specified font, if not available, try next smaller |
4639 "try to get the specified font, if not available, try next smaller |
4636 font. Access to X-fonts by name is possible, by passing the X font name |
4640 font. Access to X-fonts by name is possible, by passing the X font name |
4637 as family and the other parameters as nil. For example, the cursor font |
4641 as family and the other parameters as nil. For example, the cursor font |
4638 can be aquired that way." |
4642 can be aquired that way." |
4639 |
4643 |
4640 |theName theId xlatedStyle id | |
4644 |styleString theName theId xlatedStyle id spacing| |
|
4645 |
|
4646 styleString := styleArgString. |
4641 |
4647 |
4642 "special: if face is nil, allow access to X-fonts" |
4648 "special: if face is nil, allow access to X-fonts" |
4643 faceString isNil ifTrue:[ |
4649 faceString isNil ifTrue:[ |
4644 sizeArg notNil ifTrue:[ |
4650 sizeArg notNil ifTrue:[ |
4645 theName := familyString , '-' , sizeArg printString |
4651 theName := familyString , '-' , sizeArg printString |
4646 ] ifFalse:[ |
4652 ] ifFalse:[ |
4647 theName := familyString |
4653 theName := familyString |
4648 ]. |
4654 ]. |
4649 theName isNil ifTrue:[ |
4655 theName isNil ifTrue:[ |
4650 " |
4656 " |
4651 mhmh - fall back to the default font |
4657 mhmh - fall back to the default font |
4652 " |
4658 " |
4653 theName := 'fixed' |
4659 theName := 'fixed' |
4654 ]. |
4660 ]. |
4655 theId := self createFontFor:theName. |
4661 theId := self createFontFor:theName. |
4656 theId isNil ifTrue:[ |
4662 theId isNil ifTrue:[ |
4657 theId := self getDefaultFont |
4663 theId := self getDefaultFont |
4658 ]. |
4664 ]. |
4659 ^ theId |
4665 ^ theId |
|
4666 ]. |
|
4667 |
|
4668 "/ spacing other than 'normal' is contained as last component |
|
4669 "/ in style |
|
4670 |
|
4671 ((styleString endsWith:'-narrow') |
|
4672 or:[styleString endsWith:'-semicondensed']) ifTrue:[ |
|
4673 |i| |
|
4674 i := styleString lastIndexOf:$-. |
|
4675 spacing := styleString copyFrom:(i+1). |
|
4676 styleString := styleString copyTo:(i-1). |
|
4677 ] ifFalse:[ |
|
4678 spacing := 'normal'. |
4660 ]. |
4679 ]. |
4661 |
4680 |
4662 xlatedStyle := styleString. |
4681 xlatedStyle := styleString. |
4663 xlatedStyle notNil ifTrue:[ |
4682 xlatedStyle notNil ifTrue:[ |
4664 xlatedStyle := xlatedStyle first asString |
4683 xlatedStyle := xlatedStyle first asString |
4665 ]. |
4684 ]. |
4666 |
4685 |
4667 id := self |
4686 id := self |
4668 getFontWithFoundry:'*' |
4687 getFontWithFoundry:'*' |
4669 family:familyString asLowercase |
4688 family:familyString asLowercase |
4670 weight:faceString |
4689 weight:faceString |
4671 slant:xlatedStyle |
4690 slant:xlatedStyle |
4672 spacing:'normal' |
4691 spacing:spacing |
4673 pixelSize:nil |
4692 pixelSize:nil |
4674 size:sizeArg |
4693 size:sizeArg |
4675 registry:encodingSym |
4694 registry:encodingSym |
4676 encoding:'*'. |
4695 encoding:'*'. |
4677 |
4696 |
4678 id isNil ifTrue:[ |
4697 id isNil ifTrue:[ |
4679 (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[ |
4698 (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[ |
4680 "/ too stupid: encodings come in both cases |
4699 "/ too stupid: encodings come in both cases |
4681 "/ and X does not ignore case |
4700 "/ and X does not ignore case |
4682 "/ |
4701 "/ |
4683 id := self |
4702 id := self |
4684 getFontWithFoundry:'*' |
4703 getFontWithFoundry:'*' |
4685 family:familyString asLowercase |
4704 family:familyString asLowercase |
4686 weight:faceString |
4705 weight:faceString |
4687 slant:xlatedStyle |
4706 slant:xlatedStyle |
4688 spacing:'normal' |
4707 spacing:spacing |
4689 pixelSize:nil |
4708 pixelSize:nil |
4690 size:sizeArg |
4709 size:sizeArg |
4691 registry:encodingSym asUppercase |
4710 registry:encodingSym asUppercase |
4692 encoding:'*'. |
4711 encoding:'*'. |
4693 id isNil ifTrue:[ |
4712 id isNil ifTrue:[ |
4694 id := self |
4713 id := self |
4695 getFontWithFoundry:'*' |
4714 getFontWithFoundry:'*' |
4696 family:familyString asLowercase |
4715 family:familyString asLowercase |
4697 weight:faceString |
4716 weight:faceString |
4698 slant:xlatedStyle |
4717 slant:xlatedStyle |
4699 spacing:'normal' |
4718 spacing:spacing |
4700 pixelSize:nil |
4719 pixelSize:nil |
4701 size:sizeArg |
4720 size:sizeArg |
4702 registry:encodingSym asLowercase |
4721 registry:encodingSym asLowercase |
4703 encoding:'*'. |
4722 encoding:'*'. |
4704 ] |
4723 ] |
4705 ] |
4724 ] |
4706 ]. |
4725 ]. |
4707 ^ id |
4726 ^ id |
4708 |
4727 |
4709 "Modified: 24.2.1996 / 22:37:24 / cg" |
4728 "Modified: 24.2.1996 / 22:37:24 / cg" |
|
4729 "Modified: 4.7.1996 / 11:38:47 / stefan" |
4710 ! |
4730 ! |
4711 |
4731 |
4712 getFontWithFoundry:foundry family:family weight:weight |
4732 getFontWithFoundry:foundry family:family weight:weight |
4713 slant:slant spacing:spc pixelSize:pSize size:size |
4733 slant:slant spacing:spc pixelSize:pSize size:size |
4714 registry:registry encoding:encoding |
4734 registry:registry encoding:encoding |