5643 |
5643 |
5644 ^ self createFontFor:'fixed' |
5644 ^ self createFontFor:'fixed' |
5645 ! |
5645 ! |
5646 |
5646 |
5647 getFontWithFamily:familyString face:faceString |
5647 getFontWithFamily:familyString face:faceString |
5648 style:styleArgString size:sizeArg encoding:encodingSym |
5648 style:styleArgString size:sizeArg encoding:encoding |
5649 |
5649 |
5650 "try to get the specified font, if not available, try next smaller |
5650 "try to get the specified font, if not available, try next smaller |
5651 font. Access to X-fonts by name is possible, by passing the X font name |
5651 font. Access to X-fonts by name is possible, by passing the X font name |
5652 as family and the other parameters as nil. For example, the cursor font |
5652 as family and the other parameters as nil. For example, the cursor font |
5653 can be aquired that way." |
5653 can be aquired that way." |
5654 |
5654 |
5655 |styleString theName theId xlatedStyle id spacing| |
5655 |styleString theName theId xlatedStyle |
|
5656 id spacing encodingMatch registryMatch idx| |
5656 |
5657 |
5657 styleString := styleArgString. |
5658 styleString := styleArgString. |
5658 |
5659 |
5659 "special: if face is nil, allow access to X-fonts" |
5660 "special: if face is nil, allow access to X-fonts" |
5660 faceString isNil ifTrue:[ |
5661 faceString isNil ifTrue:[ |
5693 xlatedStyle := styleString. |
5694 xlatedStyle := styleString. |
5694 xlatedStyle notNil ifTrue:[ |
5695 xlatedStyle notNil ifTrue:[ |
5695 xlatedStyle := xlatedStyle first asString |
5696 xlatedStyle := xlatedStyle first asString |
5696 ]. |
5697 ]. |
5697 |
5698 |
|
5699 encodingMatch := encoding. |
|
5700 registryMatch := '*'. |
|
5701 encoding isNil ifTrue:[ |
|
5702 encodingMatch := '*'. |
|
5703 ] ifFalse:[ |
|
5704 idx := encoding indexOf:$-. |
|
5705 idx ~~ 0 ifTrue:[ |
|
5706 encodingMatch := encoding copyTo:idx - 1. |
|
5707 registryMatch := encoding copyFrom:idx + 1 |
|
5708 ]. |
|
5709 ]. |
|
5710 |
5698 id := self |
5711 id := self |
5699 getFontWithFoundry:'*' |
5712 getFontWithFoundry:'*' |
5700 family:familyString asLowercase |
5713 family:familyString asLowercase |
5701 weight:faceString |
5714 weight:faceString |
5702 slant:xlatedStyle |
5715 slant:xlatedStyle |
5703 spacing:spacing |
5716 spacing:spacing |
5704 pixelSize:nil |
5717 pixelSize:nil |
5705 size:sizeArg |
5718 size:sizeArg |
5706 registry:encodingSym |
5719 registry:encodingMatch |
5707 encoding:'*'. |
5720 encoding:registryMatch. |
5708 |
5721 |
5709 id isNil ifTrue:[ |
5722 id isNil ifTrue:[ |
5710 (encodingSym notNil and:[encodingSym ~= '*']) ifTrue:[ |
5723 (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[ |
5711 "/ too stupid: encodings come in both cases |
5724 "/ too stupid: encodings come in both cases |
5712 "/ and X does not ignore case |
5725 "/ and X does not ignore case |
5713 "/ |
5726 "/ |
5714 id := self |
5727 id := self |
5715 getFontWithFoundry:'*' |
5728 getFontWithFoundry:'*' |
5717 weight:faceString |
5730 weight:faceString |
5718 slant:xlatedStyle |
5731 slant:xlatedStyle |
5719 spacing:spacing |
5732 spacing:spacing |
5720 pixelSize:nil |
5733 pixelSize:nil |
5721 size:sizeArg |
5734 size:sizeArg |
5722 registry:encodingSym asUppercase |
5735 registry:encodingMatch asUppercase |
5723 encoding:'*'. |
5736 encoding:registryMatch. |
5724 id isNil ifTrue:[ |
5737 id isNil ifTrue:[ |
5725 id := self |
5738 id := self |
5726 getFontWithFoundry:'*' |
5739 getFontWithFoundry:'*' |
5727 family:familyString asLowercase |
5740 family:familyString asLowercase |
5728 weight:faceString |
5741 weight:faceString |
5729 slant:xlatedStyle |
5742 slant:xlatedStyle |
5730 spacing:spacing |
5743 spacing:spacing |
5731 pixelSize:nil |
5744 pixelSize:nil |
5732 size:sizeArg |
5745 size:sizeArg |
5733 registry:encodingSym asLowercase |
5746 registry:encodingMatch asLowercase |
5734 encoding:'*'. |
5747 encoding:registryMatch. |
5735 ] |
5748 ] |
5736 ] |
5749 ] |
5737 ]. |
5750 ]. |
5738 ^ id |
5751 ^ id |
5739 |
5752 |
5740 "Modified: 4.7.1996 / 11:38:47 / stefan" |
5753 "Modified: 4.7.1996 / 11:38:47 / stefan" |
5741 "Modified: 28.2.1997 / 18:26:12 / cg" |
5754 "Modified: 10.4.1997 / 19:20:06 / cg" |
5742 ! |
5755 ! |
5743 |
5756 |
5744 getFontWithFoundry:foundry family:family weight:weight |
5757 getFontWithFoundry:foundry family:family weight:weight |
5745 slant:slant spacing:spc pixelSize:pSize size:size |
5758 slant:slant spacing:spc pixelSize:pSize size:size |
5746 registry:registry encoding:encoding |
5759 registry:registry encoding:encoding |
5747 |
5760 |
5748 "get the specified font, if not available, return nil. |
5761 "get the specified font, if not available, return nil. |
5749 This is the new font creation method - all others will be changed to |
5762 This is the new font creation method - all others will be changed to |
5750 use this entry. |
5763 use this entry. |
5751 Individual attributes can be left empty (i.e. '') or nil to match any. |
5764 Individual attributes can be left empty (i.e. '') or nil to match any. |
5756 slant: 'r(oman)' 'i(talic)' 'o(blique)' |
5769 slant: 'r(oman)' 'i(talic)' 'o(blique)' |
5757 spacing: 'narrow' 'normal' semicondensed' ... usually '*' |
5770 spacing: 'narrow' 'normal' semicondensed' ... usually '*' |
5758 pixelSize: 16,18 ... usually left empty |
5771 pixelSize: 16,18 ... usually left empty |
5759 size: size in point (1/72th of an inch) |
5772 size: size in point (1/72th of an inch) |
5760 registry: iso8859, sgi ... '*' |
5773 registry: iso8859, sgi ... '*' |
5761 encoding: vendor specific encoding (usually '*') |
5774 encoding: registry specific encoding (usually '*') |
5762 " |
5775 " |
5763 |
5776 |
5764 |theName sizeMatch |
5777 |theName sizeMatch |
5765 foundryMatch familyMatch weightMatch slantMatch spcMatch |
5778 foundryMatch familyMatch weightMatch slantMatch spcMatch |
5766 pSizeMatch registryMatch encodingMatch| |
5779 pSizeMatch registryMatch encodingMatch| |
5767 |
5780 |
5768 "this works only on 'Release >= 3' - X-servers" |
5781 "this works only on 'Release >= 3' - X-servers" |
5769 "name is: |
5782 "name is: |
5770 -foundry-family -weight -slant- |
5783 -foundry-family -weight -slant- |
5771 sony helvetica bold r |
5784 sony helvetica bold r |
5772 adobe courier medium i |
5785 adobe courier medium i |
5773 msic fixed o |
5786 msic fixed o |
5774 ... ... |
5787 ... ... |
5775 " |
5788 " |
5776 |
5789 |
5777 size isNil ifTrue:[ |
5790 size isNil ifTrue:[ |
5778 sizeMatch := '*' |
5791 sizeMatch := '*' |
5779 ] ifFalse:[ |
5792 ] ifFalse:[ |
5780 sizeMatch := size printString , '0' |
5793 sizeMatch := size printString , '0' |
5781 ]. |
5794 ]. |
5782 foundry isNil ifTrue:[ |
5795 foundry isNil ifTrue:[ |
5783 foundryMatch := '*' |
5796 foundryMatch := '*' |
5784 ] ifFalse:[ |
5797 ] ifFalse:[ |
5785 foundryMatch := foundry |
5798 foundryMatch := foundry |
5786 ]. |
5799 ]. |
5787 family isNil ifTrue:[ |
5800 family isNil ifTrue:[ |
5788 familyMatch := '*' |
5801 familyMatch := '*' |
5789 ] ifFalse:[ |
5802 ] ifFalse:[ |
5790 familyMatch := family |
5803 familyMatch := family |
5791 ]. |
5804 ]. |
5792 weight isNil ifTrue:[ |
5805 weight isNil ifTrue:[ |
5793 weightMatch := '*' |
5806 weightMatch := '*' |
5794 ] ifFalse:[ |
5807 ] ifFalse:[ |
5795 weightMatch := weight |
5808 weightMatch := weight |
5796 ]. |
5809 ]. |
5797 slant isNil ifTrue:[ |
5810 slant isNil ifTrue:[ |
5798 slantMatch := '*' |
5811 slantMatch := '*' |
5799 ] ifFalse:[ |
5812 ] ifFalse:[ |
5800 slantMatch := slant |
5813 slantMatch := slant |
5801 ]. |
5814 ]. |
5802 spc isNil ifTrue:[ |
5815 spc isNil ifTrue:[ |
5803 spcMatch := '*' |
5816 spcMatch := '*' |
5804 ] ifFalse:[ |
5817 ] ifFalse:[ |
5805 spcMatch := spc |
5818 spcMatch := spc |
5806 ]. |
5819 ]. |
5807 pSize isNil ifTrue:[ |
5820 pSize isNil ifTrue:[ |
5808 pSizeMatch := '*' |
5821 pSizeMatch := '*' |
5809 ] ifFalse:[ |
5822 ] ifFalse:[ |
5810 pSizeMatch := pSize printString |
5823 pSizeMatch := pSize printString |
5811 ]. |
5824 ]. |
5812 registry isNil ifTrue:[ |
5825 registry isNil ifTrue:[ |
5813 registryMatch := '*' |
5826 registryMatch := '*' |
5814 ] ifFalse:[ |
5827 ] ifFalse:[ |
5815 registryMatch := registry |
5828 registryMatch := registry |
5816 ]. |
5829 ]. |
5817 encoding isNil ifTrue:[ |
5830 encoding isNil ifTrue:[ |
5818 encodingMatch := '*' |
5831 encodingMatch := '*' |
5819 ] ifFalse:[ |
5832 ] ifFalse:[ |
5820 encodingMatch := encoding |
5833 encodingMatch := encoding |
5821 ]. |
5834 ]. |
5822 |
5835 |
5823 theName := ('-' , foundryMatch, |
5836 theName := ('-' , foundryMatch, |
5824 '-' , familyMatch, |
5837 '-' , familyMatch, |
5825 '-' , weightMatch , |
5838 '-' , weightMatch , |
5826 '-' , slantMatch , |
5839 '-' , slantMatch , |
5827 '-' , spcMatch , |
5840 '-' , spcMatch , |
5828 '-*' , |
5841 '-*' , |
5829 '-' , pSizeMatch , |
5842 '-' , pSizeMatch , |
5830 '-' , sizeMatch , |
5843 '-' , sizeMatch , |
5831 '-*-*-*-*' , |
5844 '-*-*-*-*' , |
5832 '-' , registryMatch , |
5845 '-' , registryMatch , |
5833 '-' , encodingMatch). |
5846 '-' , encodingMatch). |
5834 |
5847 |
5835 "/ Transcript showCR:theName; endEntry. |
5848 "/ Transcript showCR:theName; endEntry. |
5836 |
5849 |
5837 ^ self createFontFor:theName. |
5850 ^ self createFontFor:theName. |
5838 |
5851 |
5839 |
5852 |
5840 " |
5853 " |
5841 Display getFontWithFoundry:'*' |
5854 Display getFontWithFoundry:'*' |
5842 family:'courier' |
5855 family:'courier' |
5843 weight:'medium' |
5856 weight:'medium' |
5844 slant:'r' |
5857 slant:'r' |
5845 spacing:nil |
5858 spacing:nil |
5846 pixelSize:nil |
5859 pixelSize:nil |
5847 size:13 |
5860 size:13 |
5848 registry:'iso8859' |
5861 registry:'iso8859' |
5849 encoding:'*' |
5862 encoding:'*' |
5850 " |
5863 " |
5851 |
5864 |
5852 "Modified: 24.2.1996 / 22:33:29 / cg" |
5865 "Modified: 10.4.1997 / 19:15:44 / cg" |
5853 ! |
5866 ! |
5854 |
5867 |
5855 listOfAvailableFonts |
5868 listOfAvailableFonts |
5856 "return a list with all available fonts on this display. |
5869 "return a list with all available fonts on this display. |
5857 Since this takes a long time, keep the result of the query for the |
5870 Since this takes a long time, keep the result of the query for the |