[squeak-dev] The Trunk: Morphic-mt.1917.mczcommits at source.squeak.org commits at source.squeak.orgTue Mar 1 16:38:51 UTC 2022
Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1917.mcz ==================== Summary ==================== Name: Morphic-mt.1917 Author: mt Time: 1 March 2022, 5:38:45.946136 pm UUID: 7266c339-a1ef-904c-b634-0b4163950574 Ancestors: Morphic-mt.1916 Next major iteration on the FontImporterTool. Needs TrueType-mt.78 =============== Diff against Morphic-mt.1916 =============== Item was changed: + SystemOrganization addCategory: #'Morphic-Balloon'! + SystemOrganization addCategory: #'Morphic-Basic'! SystemOrganization addCategory: #'Morphic-Basic-NewCurve'! + SystemOrganization addCategory: #'Morphic-Borders'! - SystemOrganization addCategory: #'Morphic-Pluggable Widgets'! SystemOrganization addCategory: #'Morphic-Collections-Arrayed'! + SystemOrganization addCategory: #'Morphic-Demo'! + SystemOrganization addCategory: #'Morphic-Events'! - SystemOrganization addCategory: #'Morphic-Widgets'! SystemOrganization addCategory: #'Morphic-Explorer'! + SystemOrganization addCategory: #'Morphic-Kernel'! + SystemOrganization addCategory: #'Morphic-Layouts'! - SystemOrganization addCategory: #'Morphic-Borders'! - SystemOrganization addCategory: #'Morphic-Menus-DockingBar'! SystemOrganization addCategory: #'Morphic-Menus'! + SystemOrganization addCategory: #'Morphic-Menus-DockingBar'! + SystemOrganization addCategory: #'Morphic-Pluggable Widgets'! + SystemOrganization addCategory: #'Morphic-Sound-Synthesis'! SystemOrganization addCategory: #'Morphic-Support'! + SystemOrganization addCategory: #'Morphic-Text Support'! SystemOrganization addCategory: #'Morphic-TrueType'! + SystemOrganization addCategory: #'Morphic-Widgets'! - SystemOrganization addCategory: #'Morphic-Basic'! - SystemOrganization addCategory: #'Morphic-Demo'! SystemOrganization addCategory: #'Morphic-Windows'! - SystemOrganization addCategory: #'Morphic-Balloon'! - SystemOrganization addCategory: #'Morphic-Kernel'! - SystemOrganization addCategory: #'Morphic-Sound-Synthesis'! SystemOrganization addCategory: #'Morphic-Worlds'! - SystemOrganization addCategory: #'Morphic-Layouts'! - SystemOrganization addCategory: #'Morphic-Text Support'! - SystemOrganization addCategory: #'Morphic-Events'! Item was removed: - Object subclass: #FontImporterFontDescription - instanceVariableNames: 'fontname filename children parent' - classVariableNames: '' - poolDictionaries: '' - category: 'Morphic-Support'! Item was removed: - ----- Method: FontImporterFontDescription>><= (in category 'comparing') ----- - <= other - - ^ self fontname asString <= other fontname asString! Item was removed: - ----- Method: FontImporterFontDescription>>addChild: (in category 'accessing') ----- - addChild: aChild - - ^ self children add: aChild! Item was removed: - ----- Method: FontImporterFontDescription>>allFilenames (in category 'accessing') ----- - allFilenames - - ^ self filename - ifNil: [ - (self children - select: [:child | child filename notNil] - thenCollect: [:child | child filename]) - asSet asArray] - ifNotNil: [:f | {f}] ! Item was removed: - ----- Method: FontImporterFontDescription>>children (in category 'accessing') ----- - children - - ^ children ifNil: [children := OrderedCollection new].! Item was removed: - ----- Method: FontImporterFontDescription>>children: (in category 'accessing') ----- - children: anObject - - children := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>filename (in category 'accessing') ----- - filename - - ^ filename! Item was removed: - ----- Method: FontImporterFontDescription>>filename: (in category 'accessing') ----- - filename: anObject - - filename := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>fontname (in category 'accessing') ----- - fontname - - ^ fontname! Item was removed: - ----- Method: FontImporterFontDescription>>fontname: (in category 'accessing') ----- - fontname: anObject - - fontname := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>hasChildren (in category 'testing') ----- - hasChildren - - ^ self children notNil and: [self children notEmpty]! Item was removed: - ----- Method: FontImporterFontDescription>>normalize (in category 'actions') ----- - normalize - - self children size = 1 ifTrue: [ | pseudoChild | - pseudoChild := self children removeFirst. - (self filename notNil and: [pseudoChild filename ~= self filename]) - ifTrue: [self error: 'Inconsistent state']. - self filename: pseudoChild filename]! Item was removed: - ----- Method: FontImporterFontDescription>>parent (in category 'accessing') ----- - parent - - ^ parent! Item was removed: - ----- Method: FontImporterFontDescription>>parent: (in category 'accessing') ----- - parent: anObject - - parent := anObject! Item was removed: - ----- Method: FontImporterFontDescription>>printOn: (in category 'printing') ----- - printOn: aStream - - self parent ifNotNil: [:p | aStream nextPutAll: p fontname; nextPut: $ ]. - aStream nextPutAll: self fontname. - self children notEmpty ifTrue: [aStream nextPut: $ ]. - self children - do: [:subfont | aStream nextPutAll: subfont fontname] - separatedBy: [aStream nextPut: $/]. - aStream nextPut: $ ; nextPut: $(. - self allFilenames - do: [:filename | aStream nextPutAll: filename] - separatedBy: [aStream nextPut: $,; nextPut: $ ]. - aStream nextPut: $). - ! Item was changed: Model subclass: #FontImporterTool + instanceVariableNames: 'title allFonts currentSelection currentParent selectedFont previewTextSelector customPreviewText pointSize lineSpacing editModeWidgets' + classVariableNames: 'CustomPreviewTexts' - instanceVariableNames: 'title allFonts emphasis currentSelection currentParent warningSeen' - classVariableNames: '' poolDictionaries: '' category: 'Morphic-Support'! !FontImporterTool commentStamp: 'topa 3/9/2015 18:56' prior: 0! A tool to import platform (native) fonts into the image! Item was added: + ----- Method: FontImporterTool>>aboutToStyle: (in category 'preview text - code styling') ----- + aboutToStyle: aStyler + + previewTextSelector = #codeSample ifFalse: [^ false]. + self customPreviewText ifNotEmpty: [^ false]. + + aStyler parseAMethod: true. "See Text class >> #codeSample." + ^ true! Item was added: + ----- Method: FontImporterTool>>acceptCustomPreviewText: (in category 'preview text - custom') ----- + acceptCustomPreviewText: aStringOrTextOrNil + "The user accepted (i.e. CMD+S or Return) the current input text, Now we store it in the list of custom texts so that it is retrievable via the preview button." + + customPreviewText := aStringOrTextOrNil ifNotNil: [:value | value asString]. + self changed: #customPreviewText. + + self customPreviewText ifNotEmpty: [:customText | + CustomPreviewTexts ifNil: [CustomPreviewTexts := OrderedCollection new]. + (CustomPreviewTexts includes: customText) + ifFalse:[CustomPreviewTexts add: customText] ]. + + ^ true! Item was added: + ----- Method: FontImporterTool>>adjustXHeight (in category 'edit mode - actions') ----- + adjustXHeight + + self selectedFont adjustXHeight; adjustLineGapToGlyphScale. + + self currentSelection + ttExtraScale: self selectedFont extraGlyphScale; + ttExtraGap: self selectedFont extraLineGap. + + self changed: #objectChanged with: self currentSelection. + self changed: #selectedFontTextStyle. + + self changed: #pointSizeInput. + self changed: #lineSpacingInput. + self changed: #ttExtraScaleInput. + self changed: #ttExtraGapInput.! Item was changed: + ----- Method: FontImporterTool>>allFonts (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>allFonts (in category 'accessing') ----- allFonts - ^ allFonts ifNil: [ | fonts | - fonts := Dictionary new. - Cursor wait showWhile: [ - TTFileDescription fontPathsDo:[:path | - TTFileDescription fontFilesIn: path do:[:font| | fontDesc filename fname | - filename := path, FileDirectory slash, font fileName. - fname := self textForFamily: font familyName subfamily: nil. - fontDesc := fonts - at: font familyName - ifAbsentPut: (FontImporterFontDescription new fontname: fname; yourself). - font subfamilyName - ifNil: [fontDesc filename: filename] - ifNotNil: [ |subfontDesc sname | - sname := self textForFamily: font familyName subfamily: font subfamilyName. - subfontDesc := FontImporterFontDescription new fontname: sname; yourself. - subfontDesc - parent: fontDesc; - filename: filename. - fontDesc addChild: subfontDesc]]]]. - allFonts := fonts values sorted. - allFonts do: [:fontDesc | fontDesc normalize]. - allFonts]. + ^ allFonts ifNil: [Cursor wait showWhile: [allFonts := TTFontFileHandle allHandles values sorted]]! - ! Item was changed: + ----- Method: FontImporterTool>>allFonts: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>allFonts: (in category 'accessing') ----- allFonts: anObject allFonts := anObject. self changed: #allFonts.! Item was added: + ----- Method: FontImporterTool>>applyFont (in category 'actions') ----- + applyFont + + | fontSymbols fontLabels choice | + fontSymbols := self fontSymbolsToUse. + fontLabels := fontSymbols collect: [:ea | (ea findFeatures joinSeparatedBy: ' ') capitalized]. + choice := Project uiManager chooseFrom: fontLabels values: fontSymbols title: 'Apply font as...' translated. + choice ifNil: [^ self]. + self applyFontTo: choice.! Item was added: + ----- Method: FontImporterTool>>applyFontTo: (in category 'actions') ----- + applyFontTo: fontSymbol + + self currentSelection isInstalled ifFalse: [self installFont]. + + Cursor wait showWhile: [ + UserInterfaceTheme setFont: fontSymbol to: self selectedFont].! Item was added: + ----- Method: FontImporterTool>>browseFont (in category 'actions') ----- + browseFont + + self selectedFont browseAllGlyphsByCategory.! Item was removed: - ----- Method: FontImporterTool>>browseImported (in category 'actions') ----- - browseImported - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := (filenames gather: [:ea | TTFontReader parseFileNamed: ea]) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]. - - ttcFonts do: [:ea | ea browseAllGlyphs; browseAllGlyphsByCategory].! Item was removed: - ----- Method: FontImporterTool>>browseLinked (in category 'actions') ----- - browseLinked - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := filenames gather: [:ea | - (TTFileDescription readFontsFrom: ea) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. - - ttcFonts do: [:ea | ea browseAllGlyphs; browseAllGlyphsByCategory].! Item was added: + ----- Method: FontImporterTool>>browseSystemFonts (in category 'actions') ----- + browseSystemFonts + "Open a workspace that shows the current preview text with the usual system fonts so that users can compare the font they want to import." + + | sample tmp fonts sorted contents preview | + previewTextSelector = #widgetSample + ifTrue: [ sample := [:font | self widgetSampleFor: font] ] + ifFalse: [ + tmp := self previewText. + sample := [:font | tmp]]. + (TextStyler for: #Smalltalk) ifNotNil: [:stylerClass | + | styler | + styler := stylerClass new. + (self aboutToStyle: styler) + ifTrue: [sample := [:font | styler styledTextFor: tmp asText]]]. + + fonts := IdentityDictionary new. + self fontSymbolsToUse do: [:ea | + | font | + font := UserInterfaceTheme current get: ea. + (fonts at: font ifAbsentPut: [OrderedCollection new]) add: ea]. + + sorted := fonts keys sorted: [:a :b | + a familyName < b familyName or: [a familyName = b familyName and: [ + a pointSize < b pointSize or: [a pointSize = b pointSize and: [ + a emphasis < b emphasis]]]]]. + + contents := Text streamContents: [:s | + + sorted do: [:font | + preview := '{1} ({2} {3}pt)\ #{4}\\' withCRs asText format: { + font familyName asText addAttribute: (PluggableTextAttribute evalBlock: [font explore]); yourself. + font subfamilyName. + font pointSize. + (fonts at: font) joinSeparatedBy: '\ #' withCRs. }. + + preview := preview, (sample value: font). + preview := preview, String cr. "for the consistent line height at the end" + + s cr; nextPutAll: (preview asText addAttribute: (TextFontReference toFont: font); yourself); cr ]]. + + contents editWithLabel: 'Current system fonts'.! Item was changed: + ----- Method: FontImporterTool>>buildButtonBarWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildButtonBarWith: (in category 'toolbuilder') ----- buildButtonBarWith: builder "Build the button bar" | panelSpec | panelSpec := builder pluggablePanelSpec new. panelSpec layout: #horizontal; children: OrderedCollection new. { + #installButtonLabel. + #installButtonHelp. + #installButtonHit. + #installButtonColor. + #installButtonEnabled. + + 'Apply...' translated. + 'Apply the current font in the system. Assure that the font is installed.' translated. + #applyFont. + nil. + nil. + + "nil. nil. nil. nil." + 'Browse' translated. + 'Browse the glyphs. Do not install the font into the image.' translated. + #browseFont. - 'Read the font data and browse the glyphs. Do not install the font into the image.' translated. - #browseImported. - 'Install' translated. - 'Include the font data in the image and provide a TextStyle for the font' translated. - #import. - 'Close' translated. nil. + nil. + + 'Explore' translated. + 'Explore the font object.' translated. + #exploreFont. + nil. + nil. + } groupsDo: [:label :help :action :buttonColor :enabled | + | spec | + action + ifNil: [ + spec := builder pluggableSpacerSpec new] + ifNotNil: [ + spec := builder pluggableButtonSpec new + model: self; + label: label; + color: buttonColor; + help: help; + action: action; + enabled: enabled; + yourself]. + panelSpec children addLast: spec ]. - #close. - } groupsDo: [:label :help :action | - | buttonSpec | - buttonSpec := builder pluggableButtonSpec new - model: self; - label: label; - help: help; - action: action; - yourself. - panelSpec children addLast: buttonSpec]. ^panelSpec! Item was changed: + ----- Method: FontImporterTool>>buildFontListWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildFontListWith: (in category 'toolbuilder') ----- buildFontListWith: builder "Build the font choosers list of font names" ^ builder pluggableTreeSpec new model: self; roots: #allFonts; label: #labelOf: ; getChildren: #childrenOf: ; getSelected: #currentSelection; setSelected: #currentSelection:; setSelectedParent: #currentParent:; menu: #fontListMenu:; autoDeselect: false; yourself ! Item was added: + ----- Method: FontImporterTool>>buildFontPanelWith: (in category 'ui - building') ----- + buildFontPanelWith: builder + "Build the main panel for the currently selected font (family). Includes a list of associated file names, an interactive preview panel and the copyright." + + ^ builder pluggablePanelSpec new + children: { + builder pluggableTextSpec new + model: self; + getText: #filename; + readOnly: true; + indicateUnacceptedChanges: false; + font: self filenameFont; + help: '<- Please select a font family'; + frame: (LayoutFrame + fractions: (0 at 0 corner: 1 at 0) + offsets: (0 at 0 corner: 0@ self filenameHeight)); + yourself. + + (self buildPreviewPaneWith: builder) + frame: (LayoutFrame + fractions: (0 at 0 corner: 1 at 1) + offsets: (0@ self filenameHeight corner: 0@ (self copyrightHeight negated))); + yourself. + + builder pluggableTextSpec new + model: self; + getText: #copyright; + font: self copyrightFont; + readOnly: true; + indicateUnacceptedChanges: false; + frame: (LayoutFrame + fractions: (0 at 1 corner: 1 at 1) + offsets: (0 @ (self copyrightHeight negated) corner: 0 @ 0)); + yourself + + }; + yourself! Item was changed: + ----- Method: FontImporterTool>>buildPreviewPaneWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildPreviewPaneWith: (in category 'toolbuilder') ----- buildPreviewPaneWith: builder + "Build the preview panel. Offer the user the change preview text through the default font, point size, extra (glyph) scale and extra (line) gap." - "Build the preview panel" ^ builder pluggablePanelSpec new " wantsResizeHandles: true;" children: { + builder pluggablePanelSpec new + children: { + builder pluggableButtonSpec new + model: self; + help: #previewTextButtonHelp; + label: #previewTextButtonLabel; + action: #offerPreviewTextMenu; + frame: (LayoutFrame fractions: (0 at 0 corner: 0.15 at 1)); + yourself. + + builder pluggableInputFieldSpec new + model: self; + help: 'Type custom preview text here...' translated; + getText: #customPreviewText; + setText: #acceptCustomPreviewText:; + editText: #editCustomPreviewText:; + plainTextOnly: true; + frame: (LayoutFrame fractions: (0.15 at 0 corner: 0.85 at 1)); + yourself. + + builder pluggableButtonSpec new + model: self; + help: 'Click to see current preview text using the system''s current fonts for comparison' translated; + label: 'Compare' translated; + action: #browseSystemFonts; + frame: (LayoutFrame fractions: (0.85 at 0 corner: 1 at 1)); + yourself }; + frame: (LayoutFrame - builder pluggableTextSpec new - model: self; - getText: #filename; - readOnly: true; - indicateUnacceptedChanges: false; - font: self filenameFont; - frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 0) + offsets: (0 at 0 corner: 0@ self customPreviewTextHeight)); - offsets: (0 at 0 corner: 0@ self filenameHeight)); yourself. + - builder pluggableTextSpec new model: self; getText: #previewText; textStyle: #selectedFontTextStyle; askBeforeDiscardingEdits: false; indicateUnacceptedChanges: false; softLineWrap: false; + padding: self previewTextPadding; + stylerClass: (TextStyler for: #Smalltalk); + menu: #previewTextMenu:shifted:; + frame: (LayoutFrame - frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 1) + offsets: (0 @ self customPreviewTextHeight corner: 0@ self configurationPanelHeight negated)); - offsets: (0@ self filenameHeight corner: 0@ (self copyrightHeight negated))); yourself. + builder pluggablePanelSpec new name: #configPanel; children: (Array streamContents: [:s | | n | + n := 0. + self fontConfigurationSpecs groupsDo: [:kind :get :help :label :group | | w | + kind caseOf: { + [#spacer] -> [ + w := builder pluggableSpacerSpec new fillSpaceHorizontally]. + [#button] -> [ + w := builder pluggableButtonSpec new + model: self; label: label; action: get; help: help; yourself]. + [#text] -> [ + w := builder pluggableInputFieldSpec new + model: self; getText: get; setText: get asSimpleSetter; + help: help; plainTextOnly: true; yourself]. + } otherwise: [ "Ignore" ]. + w ifNotNil: [ "Remember the group. See #toggleEditMode" + w name: (group, (n := n + 1)) asSymbol. + s nextPut: w] ]]); + layout: #horizontal; + frame: self configurationPanelFrame; + yourself. - builder pluggableTextSpec new - model: self; - getText: #copyright; - font: Preferences standardBalloonHelpFont; - readOnly: true; - indicateUnacceptedChanges: false; - frame: (LayoutFrame - fractions: (0 at 1 corner: 1 at 1) - offsets: (0 @ (self copyrightHeight negated) corner: 0 @ 0)); - yourself - }; yourself! Item was changed: + ----- Method: FontImporterTool>>buildWith: (in category 'ui - building') ----- - ----- Method: FontImporterTool>>buildWith: (in category 'toolbuilder') ----- buildWith: builder "Create the ui for the browser" "ToolBuilder open: self" + | windowSpec window | - | windowSpec | windowSpec := self buildWindowWith: builder specs: { (self fontListFrame) -> [self buildFontListWith: builder]. + (self fontPanelFrame) -> [self buildFontPanelWith: builder]. - (self previewFrame) -> [self buildPreviewPaneWith: builder]. (self buttonsFrame) -> [self buildButtonBarWith: builder]. }. + window := builder build: windowSpec. + self prepareEditMode: (builder widgetAt: #configPanel). + ^ window! - ^ builder build: windowSpec! Item was changed: + ----- Method: FontImporterTool>>buttonHeight (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>buttonHeight (in category 'layout') ----- buttonHeight ^ ToolBuilder default buttonRowHeight! Item was changed: + ----- Method: FontImporterTool>>buttonsFrame (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>buttonsFrame (in category 'layout') ----- buttonsFrame ^ LayoutFrame fractions: (0 at 1 corner: 1 at 1) offsets: (0@ self buttonHeight negated corner: 0 at 0) ! Item was changed: + ----- Method: FontImporterTool>>childrenOf: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>childrenOf: (in category 'accessing') ----- childrenOf: aFontDescription ^ aFontDescription children! Item was removed: - ----- Method: FontImporterTool>>close (in category 'actions') ----- - close - self changed: #close.! Item was added: + ----- Method: FontImporterTool>>configurationPanelFrame (in category 'ui - layout') ----- + configurationPanelFrame + + ^ LayoutFrame + fractions: (0 at 1 corner: 1 at 1) + offsets: (0 @ self configurationPanelHeight negated corner: 0 at 0)! Item was added: + ----- Method: FontImporterTool>>configurationPanelHeight (in category 'ui - layout') ----- + configurationPanelHeight + + ^ ToolBuilder default inputFieldHeight! Item was changed: + ----- Method: FontImporterTool>>copyright (in category 'accessing') ----- - ----- Method: FontImporterTool>>copyright (in category 'model access') ----- copyright | f | f := self selectedFont ifNil:[^ '']. ^ f isTTCFont ifTrue: [f ttcDescription copyright ifNil: ['']] ifFalse: ['']! Item was added: + ----- Method: FontImporterTool>>copyrightFont (in category 'ui - layout') ----- + copyrightFont + + ^ Preferences standardBalloonHelpFont! Item was changed: + ----- Method: FontImporterTool>>copyrightHeight (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>copyrightHeight (in category 'layout') ----- copyrightHeight ^ ToolBuilder default helpFieldHeightFor: 3! Item was changed: + ----- Method: FontImporterTool>>currentParent (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>currentParent (in category 'accessing') ----- currentParent ^ currentParent! Item was changed: + ----- Method: FontImporterTool>>currentParent: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>currentParent: (in category 'accessing') ----- currentParent: anObject anObject = currentParent ifTrue: [^ self]. currentParent := anObject. self changed: #currentParent. ! Item was changed: + ----- Method: FontImporterTool>>currentSelection (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>currentSelection (in category 'accessing') ----- currentSelection ^ currentSelection! Item was changed: + ----- Method: FontImporterTool>>currentSelection: (in category 'font list/tree') ----- + currentSelection: fontHandleOrNil - ----- Method: FontImporterTool>>currentSelection: (in category 'accessing') ----- - currentSelection: anObject + fontHandleOrNil = currentSelection ifTrue: [^ self]. + currentSelection := fontHandleOrNil. - anObject = currentSelection ifTrue: [^ self]. - currentSelection := anObject. self changed: #currentSelection. + + fontHandleOrNil + ifNotNil: [self editModeEnabled: self currentSelection isModified]. + + self selectedFont: nil. "Refresh preview"! - " self changed: #previewText. - self changed: #selectedFontTextStyle." - self changed: #filename. - self changed: #copyright.! Item was added: + ----- Method: FontImporterTool>>customPreviewText (in category 'preview text - custom') ----- + customPreviewText + + ^ customPreviewText ifNil: ['']! Item was added: + ----- Method: FontImporterTool>>customPreviewTextFont (in category 'ui - layout') ----- + customPreviewTextFont + + ^ TextStyle defaultFont! Item was added: + ----- Method: FontImporterTool>>customPreviewTextHeight (in category 'ui - layout') ----- + customPreviewTextHeight + + ^ ToolBuilder default inputFieldHeight! Item was added: + ----- Method: FontImporterTool>>defaultButtonColor (in category 'ui - colors') ----- + defaultButtonColor + + ^ (UserInterfaceTheme current get: #color for: #PluggableButtonMorph) ifNil: [Color gray: 0.91]! Item was removed: - ----- Method: FontImporterTool>>delete (in category 'actions') ----- - delete - - | font | - (font := self selectedFont) textStyleOrNil ifNotNil: [:style | - TextConstants removeKey: font familyName]. - TTCFont registerAll. - TTFontDescription removeDescriptionNamed: font familyName. - self allFonts: nil. "force redraw"! Item was added: + ----- Method: FontImporterTool>>discardCustomPreviewTexts (in category 'preview text - custom') ----- + discardCustomPreviewTexts + + CustomPreviewTexts := nil. + self setCustomPreviewText: nil.! Item was added: + ----- Method: FontImporterTool>>editButtonHelp (in category 'edit mode - ui') ----- + editButtonHelp + + ^ 'Modify font properties such as <b>extra glyph scale</b> and <b>extra line gap</b>, which will be shared through all point sizes and text styles. Be careful.' translated asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>editCustomPreviewText: (in category 'preview text - custom') ----- + editCustomPreviewText: aStringOrTextOrNil + "The user typed something. Use it directly as a new preview text. Note that CMD+S (or Return) means that the user wants to save the text for later." + + customPreviewText := aStringOrTextOrNil ifNotNil: [:value | value asString]. + self changed: #previewText. + self changed: #previewTextButtonLabel.! Item was added: + ----- Method: FontImporterTool>>editModeEnabled (in category 'edit mode') ----- + editModeEnabled + + ^ Project current isMorphic + ifFalse: [false] + ifTrue: [(editModeWidgets at: #on) first visible]! Item was added: + ----- Method: FontImporterTool>>editModeEnabled: (in category 'edit mode') ----- + editModeEnabled: showEditWidgets + + Project current isMorphic ifFalse: [^ self]. + + showEditWidgets + ifFalse: [ + (editModeWidgets at: #on) do: [:ea | ea hide; disableLayout: true]. + (editModeWidgets at: #off) do: [:ea | ea show; disableLayout: false]] + ifTrue: [ + (editModeWidgets at: #on) do: [:ea | ea show; disableLayout: false]. + (editModeWidgets at: #off) do: [:ea | ea hide; disableLayout: true]].! Item was added: + ----- Method: FontImporterTool>>exploreFont (in category 'actions') ----- + exploreFont + + self selectedFont explore.! Item was removed: - ----- Method: FontImporterTool>>exploreImported (in category 'actions') ----- - exploreImported - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := (filenames gather: [:ea | TTFontReader parseFileNamed: ea]) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]. - - ttcFonts do: [:ea | ea explore].! Item was removed: - ----- Method: FontImporterTool>>exploreLinked (in category 'actions') ----- - exploreLinked - - | filenames fonts ttcFonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - - ttcFonts := filenames gather: [:ea | - (TTFileDescription readFontsFrom: ea) - collect: [:descr | TTCFont new ttcDescription: descr; pointSize: TextStyle defaultFont pointSize; yourself]]. - - ttcFonts do: [:ea | ea explore].! Item was changed: + ----- Method: FontImporterTool>>filename (in category 'accessing') ----- - ----- Method: FontImporterTool>>filename (in category 'model access') ----- filename ^ self currentSelection ifNil: [''] ifNotNil: [:sel | String streamContents: [:stream | + (sel allFilenames ifEmpty: [{'(unknown file location; image only)' translated}]) - sel allFilenames do: [:filename | stream nextPutAll: filename] separatedBy: [stream cr ]]]! Item was changed: + ----- Method: FontImporterTool>>filenameFont (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>filenameFont (in category 'toolbuilder') ----- filenameFont + + ^ Preferences standardBalloonHelpFont! - ^ Preferences standardDefaultTextFont! Item was changed: + ----- Method: FontImporterTool>>filenameHeight (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>filenameHeight (in category 'layout') ----- filenameHeight + ^ ToolBuilder default helpFieldHeightFor: 2 "lines"! - ^ ToolBuilder default inputFieldHeightFor: 3 "lines"! Item was removed: - ----- Method: FontImporterTool>>font:hasGlyphOf: (in category 'helper') ----- - font: f hasGlyphOf: aCharacter - - | font | - font := f isFontSet ifTrue: [f fontArray first] ifFalse: [f]. - ^ font hasGlyphOf: aCharacter! Item was added: + ----- Method: FontImporterTool>>fontConfigurationSpecs (in category 'ui - building') ----- + fontConfigurationSpecs + + ^ #( + text pointSizeInput pointSizeInputHelp nil preview + text lineSpacingInput lineSpacingInputHelp nil preview + spacer nil nil nil preview + button adjustXHeight 'Adjust the font''s x-height to match the system''s default font.' 'Adjust x' edit + text ttExtraScaleInput ttExtraScaleInputHelp nil edit + text ttExtraGapInput ttExtraGapInputHelp nil edit + button resetFontMetrics 'Reset all fields to their default value. Disable the edit mode.' 'Reset' edit + button toggleEditMode editButtonHelp 'Edit' toggle + )! Item was removed: - ----- Method: FontImporterTool>>fontFromFamily: (in category 'helper') ----- - fontFromFamily: aFamily - - | readFonts | - aFamily ifNil: [^ TextStyle defaultFont]. - readFonts := TTFileDescription readFontsFrom: aFamily allFilenames anyOne. - ^ (readFonts size > 1 - ifTrue: [ - | ftArray | - " see TTCFontSet>>newTextStyleFromTT: " - ftArray := readFonts collect: [:ttc | |f| - ttc ifNil: [nil] ifNotNil: [ - f := TTCFont new. - f ttcDescription: ttc. - f pointSize: TextStyle defaultFont pointSize. - f]]. - TTCFontSet newFontArray: ftArray] - ifFalse: [ |f| - f := TTCFont new. - f ttcDescription: readFonts anyOne. - f pointSize: TextStyle defaultFont pointSize. - f])! Item was changed: + ----- Method: FontImporterTool>>fontListFrame (in category 'ui - layout') ----- - ----- Method: FontImporterTool>>fontListFrame (in category 'layout') ----- fontListFrame ^ LayoutFrame + fractions: (0 at 0 corner: 0.25 at 1) - fractions: (0 at 0 corner: 0.4 at 1) offsets: (0 at 0 corner: 0@ self buttonHeight negated)! Item was changed: + ----- Method: FontImporterTool>>fontListMenu: (in category 'font list/tree') ----- - ----- Method: FontImporterTool>>fontListMenu: (in category 'font list') ----- fontListMenu: aMenu ^ aMenu addTranslatedList: #( + ('Browse' browseFont 'Browse all glyphs in the font') + ('Explore' exploreFont 'Explore the font object') - ('Browse Font (imported)' browseImported 'Import and browse all available glyphs') - ('Browse Font (linked)' browseLinked 'Browse all available glyphs') - + ('Install' installFont 'Make the font available in the environment but keep the glyph data outside the image') + ('Install & Load' installAndLoadFont 'Make the font available in the environment including all the glyph data to ensure portability of the image') - ('Explore Font (imported)' exploreImported 'Import and explore the font object') - ('Explore Font (linked)' exploreLinked 'Explore the font object') - - - ('Install Font (imported)' import 'Include the font data in the image and provide a TextStyle for the font') - ('Install Font (linked)' link 'Install the font as a link to its file and provide a TextStyle for the referenced font') ), (self selectedFont textStyleOrNil ifNil: [#()] ifNotNil: [#( - + ('Uninstall' uninstallFont 'Remove the font from the system') - ('Delete Font' delete 'Remove imported font data or link to font from the system') )]) yourself! Item was added: + ----- Method: FontImporterTool>>fontPanelFrame (in category 'ui - layout') ----- + fontPanelFrame + + ^ LayoutFrame + fractions: (0.25 at 0 corner: 1 at 1) + offsets: (0 at 0 corner: 0@ self buttonHeight negated)! Item was added: + ----- Method: FontImporterTool>>fontSymbolsToUse (in category 'accessing') ----- + fontSymbolsToUse + + ^ UserInterfaceTheme knownFontSymbols reject: [:ea | ea beginsWith: #wizard]! Item was removed: - ----- Method: FontImporterTool>>import (in category 'actions') ----- - import - | megaSize filenames fonts | - fonts := self currentSelection. - filenames := fonts allFilenames. - megaSize := ((filenames inject: 0 into: [ :sum :fn | - sum + (FileStream readOnlyFileNamed: fn do: [:file | file size])]) / (1024 * 1024)) asFloat. - (UIManager default confirm: ( - 'About to import {1}{2}.\\This is at least {3} MB of space required in the image.\ - Please respect the copyright and embedding restrictions of the font.\ - Proceed?' - translated withCRs format: { - self currentParent - ifNotNil: [:p| p fontname, ' ', self currentSelection fontname] - ifNil: [self currentSelection fontname]. - filenames size > 1 ifTrue: [' ({1} font files)' translated format: {filenames size}] ifFalse: ['']. - megaSize printShowingDecimalPlaces: 2})) - ifTrue: [ - filenames do: [:filename | | readFonts | - readFonts := TTFontDescription addFromTTFile: filename. - readFonts isCollection - ifFalse: [TTCFont newTextStyleFromTT: readFonts] - ifTrue: [self importFontFamily: readFonts]]]. - self allFonts: nil. "force redraw" - TTCFont registerAll.! Item was removed: - ----- Method: FontImporterTool>>importFontFamily: (in category 'helper') ----- - importFontFamily: readFonts - - |r rest array | - r := readFonts detect: [:f | - [f isRegular] on: Error do: [false] "hack for unknown emphases" - ] ifNone: [^ TTCFont newTextStyleFromTT: readFonts first]. - rest := readFonts copyWithout: r. - array :=TTCFont pointSizes collect: [:pt | | f | - f := TTCFont new ttcDescription: r; pointSize: pt; yourself. - rest do: [:rf | - (self isStyleNameSupported: rf subfamilyName) - ifTrue: [f derivativeFont: (TTCFont new ttcDescription: rf; pointSize: pt; yourself)] - ifFalse: [ - Transcript show: 'Cannot import unknown style ', rf subfamilyName, ' from Font family ', f name]]. - f]. - ^ TTCFont reorganizeForNewFontArray: array name: array first name asSymbol.! Item was changed: ----- Method: FontImporterTool>>initialExtent (in category 'initialize') ----- initialExtent + ^ 670 at 500! - ^ 600 at 400.! Item was changed: ----- Method: FontImporterTool>>initialize (in category 'initialize') ----- initialize super initialize. + + previewTextSelector := #textSample.! - emphasis := 0. - ! Item was added: + ----- Method: FontImporterTool>>installAndLoadFont (in category 'actions') ----- + installAndLoadFont + + self installFont ifTrue: [ + self selectedFont becomeLocalFont. + self currentSelection parent ifNotNil: [:p | self currentSelection: p]. + self changed: #objectChanged with: self currentSelection]. + + self flag: #todo. "mt: Warn the user about space constraints!!"! Item was added: + ----- Method: FontImporterTool>>installButtonColor (in category 'ui - installation') ----- + installButtonColor + + self currentSelection ifNil: [^ self defaultButtonColor]. + + ^ self currentSelection isFullyInstalled + ifTrue: [self uninstallColor] + ifFalse: [self installColor]! Item was added: + ----- Method: FontImporterTool>>installButtonEnabled (in category 'ui - installation') ----- + installButtonEnabled + + ^ self currentSelection + ifNil: [false] + ifNotNil: [:handle | handle isProtected not]! Item was added: + ----- Method: FontImporterTool>>installButtonHelp (in category 'ui - installation') ----- + installButtonHelp + + self currentSelection ifNil: [^ '']. + + ^ self currentSelection isInstalled + ifTrue: ['Remove all font data from the image. Note that existing texts or text styles may still refer to it for a while longer.' translated] + ifFalse: ['Include the font data in the image and provide a TextStyle for the font' translated].! Item was added: + ----- Method: FontImporterTool>>installButtonHit (in category 'ui - installation') ----- + installButtonHit + + self currentSelection ifNil: [^ self]. + + self currentSelection isFullyInstalled + ifTrue: [self uninstallFont] + ifFalse: [self installFont]. + + self changed: #installButtonLabel. + self changed: #installButtonColor.! Item was added: + ----- Method: FontImporterTool>>installButtonLabel (in category 'ui - installation') ----- + installButtonLabel + + self currentSelection ifNil: [^ 'Install' translated]. + + ^ self currentSelection isFullyInstalled + ifTrue: ['Uninstall' translated] + ifFalse: [ + self currentSelection isInstalled + ifTrue: ['Update' translated] + ifFalse: ['Install' translated] ]! Item was added: + ----- Method: FontImporterTool>>installColor (in category 'ui - colors') ----- + installColor + + ^ (UserInterfaceTheme current get: #okColor for: #ListChooser) ifNil: [Color r: 0.49 g: 0.749 b: 0.49]! Item was added: + ----- Method: FontImporterTool>>installFont (in category 'actions') ----- + installFont + "Install the selected font. Inform tha user that a modification is best reflected with a custom font name so that it is possible to also install the font with its original parameters." + + | handle wasRenamed | + handle := self currentSelection. + wasRenamed := false. + + (handle isModified and: [handle hasModifiedName not]) ifTrue: [ + (Project uiManager + request: 'You modified the selected font.\Please choose a new name:' translated withCRs + initialAnswer: 'My ', handle familyName) + ifEmpty: [^ false] + ifNotEmpty: [:answer | + wasRenamed := true. + handle fontname: answer]]. + + self currentSelection installFont. + self selectedFont: nil. "New identity from the handle" + + wasRenamed ifTrue: [ + "New child in the tree. So refresh everything." + allFonts := nil. self changed: #allFonts. ^ true]. + + self currentSelection parent ifNotNil: [:p | self currentSelection: p]. + self changed: #objectChanged with: self currentSelection. + + ^ true! Item was removed: - ----- Method: FontImporterTool>>isStyleNameSupported: (in category 'helper') ----- - isStyleNameSupported: subfamilyName - - ^ (TextStyle decodeStyleName: subfamilyName) second isEmpty! Item was changed: + ----- Method: FontImporterTool>>labelOf: (in category 'font list/tree') ----- + labelOf: aHandle - ----- Method: FontImporterTool>>labelOf: (in category 'model access') ----- - labelOf: aFontDescription + | label numSubfamilies| + self flag: #performance. "mt: Cache labels?" + + label := aHandle fontname. + + aHandle isLocalFont ifTrue: [label := '[', label, ']']. + (aHandle hasChildren and: [(numSubfamilies := aHandle children size) > 1]) + ifTrue: [label := label, ' (', numSubfamilies, ')']. + aHandle isModified ifTrue: [label := label, ' *']. + label := label asText. + aHandle isFullyInstalled + ifTrue: [label addAttribute: TextEmphasis underlined] + ifFalse: [aHandle isInstalled ifTrue: [ + label := '!! ' asText, label ]]. + aHandle isSubfamilySupported + ifFalse: [label addAttribute: TextColor gray]. + ^ label! - ^ aFontDescription fontname - - ! Item was added: + ----- Method: FontImporterTool>>lineSpacing (in category 'preview text - ui') ----- + lineSpacing + + ^ lineSpacing ifNil: [0.0]! Item was added: + ----- Method: FontImporterTool>>lineSpacingInput (in category 'preview text - ui') ----- + lineSpacingInput + "Redirect through #selectedFontTextStyle to get automatic suggestions e.g., for symbol fonts." + + ^ (lineSpacing ifNil: [self selectedFontTextStyle lineSpacing]) asString! Item was added: + ----- Method: FontImporterTool>>lineSpacingInput: (in category 'preview text - ui') ----- + lineSpacingInput: anObject + + self currentSelection ifNil: [^ false]. + + lineSpacing := [anObject asNumber] on: NumberParserError do: [nil]. + self changed: #lineSpacingInput. + self changed: #selectedFontTextStyle. + + ^ true! Item was added: + ----- Method: FontImporterTool>>lineSpacingInputHelp (in category 'preview text - ui') ----- + lineSpacingInputHelp + + self editModeEnabled ifFalse: [ + ^ 'Line spacing in the preview box' translated]. + + ^ '<b>Line spacing</b> in the preview box. A factor of 0.0 means no extra spacing while 1.0 means to double the current line height, which is based on the fonts within each line. The value may be negative.<br><br>Note that line spacing is application-specific and can thus be different for any <b>text style</b> (or text field). You can tweak the font itself through <b>extra line gap</b> to affect all its uses.<br><br>Make empty to reset to default value.' translated asTextFromHtml! Item was removed: - ----- Method: FontImporterTool>>link (in category 'actions') ----- - link - | filenames fonts | - fonts := self currentSelection. - self warningSeen ifFalse: [ - (Project uiManager confirm: ( - 'Note that linking a font instead of importing may make the - image un-portable, since the linked font must be present on - the system the next time the image is run. - - This warning is only shown once per session.' translated) trueChoice: 'Proceed' translated falseChoice: 'Cancel' translated) - ifFalse: [^ self]. - self warningSeen: true].. - filenames := fonts allFilenames. - filenames do: [:filename | | readFonts | - readFonts := TTFileDescription readFontsFrom: filename. - readFonts isCollection - ifFalse: [TTCFont newTextStyleFromTT: readFonts] - ifTrue: [self importFontFamily: readFonts]]. - self allFonts: nil. "force redraw" - TTCFont registerAll.! Item was added: + ----- Method: FontImporterTool>>offerPreviewTextMenu (in category 'preview text') ----- + offerPreviewTextMenu + + | builder menuSpec | + builder := ToolBuilder default. + menuSpec := builder pluggableMenuSpec new. + + #(textSample codeSample widgetSample nil forssmanSample melvilleSample fontSample) do: [:selector | + selector ifNil: [menuSpec addLine] ifNotNil: [ + | item marker | + marker := (customPreviewText isEmptyOrNil and: [previewTextSelector = selector]) + ifTrue: ['<yes>'] ifFalse: ['<no>']. + item := menuSpec + add: marker, (self previewTextSelectorLabelFor: selector) + target: self + selector: #setPreviewTextSelector: + argumentList: {selector}. + item help: (self previewTextSelectorHelpFor: selector)]]. + menuSpec addLine. + + (CustomPreviewTexts ifNil: [CustomPreviewTexts := OrderedCollection new]) + do: [:text | | marker | + marker := customPreviewText = text ifTrue: ['<yes>'] ifFalse: ['<no>']. + menuSpec + add: marker, (text contractTo: 40) + target: self + selector: #setCustomPreviewText: + argumentList: {text}]. + CustomPreviewTexts ifNotEmpty: [menuSpec addLine]. + + menuSpec + add: 'Discard custom texts' translated + target: self + selector: #discardCustomPreviewTexts + argumentList: #(). + + builder runModal: (builder open: menuSpec).! Item was added: + ----- Method: FontImporterTool>>okToClose (in category 'ui - building') ----- + okToClose + "Check for modifications to not installed fonts. Ask the user if those modifications should be discarded. Not that modifications to installed fonts were already applied." + + | modifiedFonts | + modifiedFonts := self allFonts "top level" select: [:ea | ea isModified and: [ea isInstalled not]]. + ^ (super okToClose and: [modifiedFonts isEmpty]) + ifTrue: [true] + ifFalse: [Project uiManager + confirm: ('You modified the following fonts:\\' translated, + (modifiedFonts inject: '' into: [:list :each | list, ' ', each fontname, '\']), + '\These fonts are not yet installed. Do\you want to discard your changes?' translated) withCRs + title: 'Discard Changes' translated]! Item was added: + ----- Method: FontImporterTool>>pointSize (in category 'preview text - ui') ----- + pointSize + + ^ pointSize ifNil: [TextStyle defaultFont pointSize]! Item was added: + ----- Method: FontImporterTool>>pointSizeInput (in category 'preview text - ui') ----- + pointSizeInput + + ^ self pointSize asString! Item was added: + ----- Method: FontImporterTool>>pointSizeInput: (in category 'preview text - ui') ----- + pointSizeInput: anObject + + self currentSelection ifNil: [^ false]. + + pointSize := [anObject asNumber roundTo: 0.5] on: NumberParserError do: [TextStyle defaultFont pointSize]. + pointSize := pointSize max: 1.0. + self changed: #pointSizeInput. + self selectedFont: nil. + + ^ true! Item was added: + ----- Method: FontImporterTool>>pointSizeInputHelp (in category 'preview text - ui') ----- + pointSizeInputHelp + + self editModeEnabled ifFalse: [ + ^ 'Point size in the preview box' translated]. + + ^ ('<b>Point size</b> in the preview box. The system''s default is currently <b>{1}</b> points. It is recommended to adjust the font''s <b>extra glyph scale</b> and <b>extra line gap</b> using the default point size. Look at other text in the system to assess whether this font would integrate nicely.<br><br>Make empty to reset to default value.' translated + format: {TextStyle defaultFont pointSize}) asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>prepareEditMode: (in category 'edit mode') ----- + prepareEditMode: container + + Project current isMorphic ifFalse: [^ self]. + + editModeWidgets := Dictionary new + at: #on put: OrderedCollection new; + at: #off put: OrderedCollection new; + yourself. + + container allMorphsDo: [:m | + ((m knownName ifNil: ['']) beginsWith: 'edit') + ifTrue: [(editModeWidgets at: #on) add: m] + ifFalse: [((m knownName ifNil: ['']) beginsWith: 'toggle') + ifTrue: [(editModeWidgets at: #off) add: m]]]. + + self toggleEditMode. "Turn it off"! Item was removed: - ----- Method: FontImporterTool>>previewFrame (in category 'layout') ----- - previewFrame - - ^ LayoutFrame - fractions: (0.4 at 0 corner: 1 at 1) - offsets: (0 at 0 corner: 0@ self buttonHeight negated)! Item was changed: + ----- Method: FontImporterTool>>previewText (in category 'preview text') ----- - ----- Method: FontImporterTool>>previewText (in category 'model access') ----- previewText + "Answer the current preview text. Avoid using a text with font-reference attributes so that any not-yet-installed font does not get spreaded across the system. See #selectedFontTextStyle to learn how the preview is rendered using the selected font." + self selectedFont ifNil: [^ '']. + self customPreviewText ifNotEmpty: [:text | ^ text withCRs]. + + previewTextSelector = #fontSample ifTrue: [ + ^ self selectedFont ttcDescription sampleText + ifEmpty: ['This font does not provide a sample text.' translated]]. + + (previewTextSelector ~= #textSample and: [self selectedFont isSymbolFont]) + ifTrue: [^ 'This symbol font does not support the preview text.\Please use ''Text/Symbol'' or type a custom text.' translated withCRs asText addAttribute: (TextFontReference toFont: TextStyle defaultFont); yourself]. + + self selectedFont isSymbolFont + ifTrue: [^ self selectedFont symbolSample asString]. + (Text respondsTo: previewTextSelector) + ifTrue: [^ (Text perform: previewTextSelector) asString]. + previewTextSelector = #widgetSample + ifTrue: [^ self widgetSample]. + + ^ ''! - ^ self selectedFont - ifNil: [Text new] - ifNotNil: [:font | font sampleText]! Item was added: + ----- Method: FontImporterTool>>previewTextButtonHelp (in category 'preview text') ----- + previewTextButtonHelp + + ^ self customPreviewText + ifNotEmpty: [^ 'Custom ->' "The arrow points to the input field in the UI."] + ifEmpty: [self previewTextSelectorHelpFor: previewTextSelector]! Item was added: + ----- Method: FontImporterTool>>previewTextButtonLabel (in category 'preview text') ----- + previewTextButtonLabel + + ^ self customPreviewText + ifNotEmpty: ['Custom ->'] + ifEmpty: [self previewTextSelectorLabelFor: previewTextSelector]! Item was added: + ----- Method: FontImporterTool>>previewTextMenu:shifted: (in category 'preview text') ----- + previewTextMenu: aMenu shifted: shifted + <previewTextMenu> + "See commentary in StringHolder >> #mainCodePaneMenu:shifted:." + + ^ StringHolder codePaneMenu: aMenu shifted: shifted! Item was added: + ----- Method: FontImporterTool>>previewTextPadding (in category 'preview text') ----- + previewTextPadding + "Static. Give a little bit more space so that the user can focus on the font, not the window ui. For UI themes that use bitmap fonts (i.e., the default 75%, 100%, 125%, and 150% scale factor) use the current font metrics. Otherwise, just use a font-agnostic measure in points. Maybe we can make text-field margins more dynamic (and per-font) in the future." + + ^ UserInterfaceTheme current isTTCBased + ifTrue: [(TextStyle pointsToPixels: 16 "pt" @20 "pt") truncated] + ifFalse: [(TextStyle defaultFont widthOf: $m) @ TextStyle defaultFont lineGrid]! Item was added: + ----- Method: FontImporterTool>>previewTextSelectorHelpFor: (in category 'preview text') ----- + previewTextSelectorHelpFor: symbol + + ^ symbol caseOf: { + [#textSample] -> ['See the font''s alphabet as a dummy text. For symbol fonts, show a selection of symbols.' translated]. + [#codeSample] -> ['See how the font would render some Smalltalk source code.' translated]. + [#forssmanSample] -> ['See an example of ragged text used in the book "Detailtypografie" by Friedrich Forssman and Ralf de Jong.' translated]. + [#melvilleSample] -> ['See the first two paragraphs of "Moby Dick" by Herman Melville.' translated]. + [#fontSample] -> ['See the example text that was provided by the font designer in the font description itself.' translated asTextFromHtml]. + [#widgetSample] -> ['See how the font would look in a list, tree, or menu widget.' translated]. + } otherwise: [ '' ]! Item was added: + ----- Method: FontImporterTool>>previewTextSelectorLabelFor: (in category 'preview text') ----- + previewTextSelectorLabelFor: symbol + + ^ symbol caseOf: { + [#textSample] -> ['Text/Symbols']. + [#codeSample] -> ['Source code']. + [#widgetSample] -> ['Widgets']. + [#forssmanSample] -> ['Forssman']. + [#melvilleSample] -> ['Melville']. + [#fontSample] -> ['Font sample']. + } otherwise: [ '???' ]! Item was added: + ----- Method: FontImporterTool>>resetFontMetrics (in category 'edit mode - actions') ----- + resetFontMetrics + + self selectedFont familyName = TextStyle defaultTTFont familyName + ifTrue: [^ self inform: 'You should not reset the font that is used as\reference for x-height adjustment. Please\change manually if at all.' translated withCRs]. + + self toggleEditMode. + + pointSize := nil. + lineSpacing := nil. + + self currentSelection ifNotNil: [:fontDescr | + fontDescr ttExtraScale: nil. + fontDescr ttExtraGap: nil]. + + self changed: #objectChanged with: self currentSelection. + self selectedFont: nil. ! Item was changed: + ----- Method: FontImporterTool>>selectedFont (in category 'accessing') ----- - ----- Method: FontImporterTool>>selectedFont (in category 'font list') ----- selectedFont + + ^ selectedFont ifNil: [selectedFont := self currentSelection + ifNil: [TextStyle defaultFont] + ifNotNil: [:o | o fontOfPointSize: self pointSize] ]! - | fontDesc font | - fontDesc := self currentSelection. - font := self fontFromFamily: fontDesc. - font isFontSet ifTrue: [ - font := (self currentParent isNil or: [self currentParent = self currentSelection]) - ifTrue: [font fontArray anyOne] - ifFalse: [ "we have selected a leaf " - font fontArray - detect: [:subfont | subfont subfamilyName = fontDesc fontname] - ifNone: [font]]]. - ^font emphasized: emphasis! Item was added: + ----- Method: FontImporterTool>>selectedFont: (in category 'accessing') ----- + selectedFont: aTTCFont + + selectedFont := aTTCFont. + + self changed: #previewText. + self changed: #selectedFontTextStyle. + + self changed: #filename. + self changed: #copyright. + + self changed: #pointSizeInput. + self changed: #lineSpacingInput. + self changed: #ttExtraScaleInput. + self changed: #ttExtraGapInput. + + self changed: #installButtonColor. + self changed: #installButtonLabel. + self changed: #installButtonEnabled. + + self changed: #windowTitle.! Item was changed: + ----- Method: FontImporterTool>>selectedFontTextStyle (in category 'accessing') ----- - ----- Method: FontImporterTool>>selectedFontTextStyle (in category 'font list') ----- selectedFontTextStyle + "Construct a new text style from the #selectedFont." + + ^ (TextStyle fontArray: {self selectedFont}) + lineSpacing: ((lineSpacing isNil and: [self selectedFont isSymbolFont]) + ifTrue: [ 0.3 ] + ifFalse: [ self lineSpacing ]); + yourself + + ! - - | font | - ^ (font := self selectedFont) isSymbolFont - ifFalse: [TextStyle fontArray: {font}] - ifTrue: [TextStyle default copy]! Item was added: + ----- Method: FontImporterTool>>setCustomPreviewText: (in category 'preview text - custom') ----- + setCustomPreviewText: aString + + self editCustomPreviewText: aString. + self changed: #customPreviewText.! Item was added: + ----- Method: FontImporterTool>>setPreviewTextSelector: (in category 'preview text') ----- + setPreviewTextSelector: symbol + + previewTextSelector := symbol. + self setCustomPreviewText: nil.! Item was removed: - ----- Method: FontImporterTool>>textForFamily:subfamily: (in category 'helper') ----- - textForFamily: familyName subfamily: subfamilyName - - subfamilyName ifNil: [ - ^ (TextStyle named: (familyName copyWithout: Character space)) - ifNil: [familyName] - ifNotNil: [:style | style isTTCStyle - ifTrue: ["we are already present " - Text string: familyName attribute: TextEmphasis underlined] - ifFalse: [familyName]]]. - - " frome here on it is only about subfamilies" - - (self isStyleNameSupported: subfamilyName) - ifFalse: [^ Text string: subfamilyName attribute: TextColor gray]. - - ^ (TextStyle named: familyName) - ifNil: ["importable" subfamilyName] - ifNotNil: [:style | - (style isTTCStyle and: [ | regular emph | - regular := style fonts anyOne. - emph := TTCFont indexOfSubfamilyName: subfamilyName. - " detect if this style is already imported " - regular emphasis = emph or: [(regular emphasis: emph) ~= regular]]) - ifFalse: ["again importable" subfamilyName] - ifTrue: [Text string: subfamilyName attribute: TextEmphasis underlined]]! Item was added: + ----- Method: FontImporterTool>>toggleEditMode (in category 'edit mode') ----- + toggleEditMode + + self editModeEnabled: self editModeEnabled not.! Item was added: + ----- Method: FontImporterTool>>ttExtraGapInput (in category 'edit mode - ui') ----- + ttExtraGapInput + + ^ (self currentSelection + ifNil: [0] + ifNotNil: [:handle | handle ttExtraGap]) asString! Item was added: + ----- Method: FontImporterTool>>ttExtraGapInput: (in category 'edit mode - ui') ----- + ttExtraGapInput: anObject + + self currentSelection ifNil: [^ false]. + + self currentSelection ttExtraGap: ([anObject asNumber truncated] on: NumberParserError do: [nil]). + self changed: #ttExtraGapInput. + self changed: #objectChanged with: self currentSelection. + + self selectedFont: nil. + + ^ true! Item was added: + ----- Method: FontImporterTool>>ttExtraGapInputHelp (in category 'edit mode - ui') ----- + ttExtraGapInputHelp + + | tt | + tt := self selectedFont ifNotNil: [:f | f isTTCFont ifTrue: [ f ttcDescription ] ]. + ^ ('<b>Extra line gap</b> in font measures. This font''s own value is <b>{1}</b> with units-per-em (UPM) being <b>{2}</b>. Adjust to change the font''s line grid (or "height") to compensate for <b>extra glyph scale</b>. The value may be negative.<br><br>Note that there is also <b>line spacing</b>, which is not per font but per <b>text style</b> and thus application-specific.<br><br>Make empty to reset to default value.' translated + format: { + tt ifNil: ['?'] ifNotNil: [tt typographicLineGap]. + tt ifNil: ['?'] ifNotNil: [tt unitsPerEm]. + }) asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>ttExtraScaleInput (in category 'edit mode - ui') ----- + ttExtraScaleInput + + ^ (self currentSelection + ifNil: [1.0] + ifNotNil: [:handle | handle ttExtraScale]) printShowingDecimalPlaces: 3! Item was added: + ----- Method: FontImporterTool>>ttExtraScaleInput: (in category 'edit mode - ui') ----- + ttExtraScaleInput: anObject + + self currentSelection ifNil: [^ false]. + + self currentSelection ttExtraScale: ([anObject asNumber] on: NumberParserError do: [nil]). + self changed: #ttExtraScaleInput. + self changed: #objectChanged with: self currentSelection. + + self selectedFont: nil. + + ^ true! Item was added: + ----- Method: FontImporterTool>>ttExtraScaleInputHelp (in category 'edit mode - ui') ----- + ttExtraScaleInputHelp + + (self selectedFont isNil or: [self selectedFont isTTCFont not]) + ifTrue: [ ^ '']. + + ^ ('<b>Extra glyph scale</b> to accommodate varying heights when using different fonts side-by-side. This font has a relative x-height of <b>{1}</b> while the system''s reference is <b>{2}</b>. You can only use values greater than 0.0.<br><br>Note that this does not change the font''s "pixel height" and is thus unrelated to the system''s overall <b>UI scale factor</b>. You may want to adjust <b>extra line gap</b> as well to retain the font''s aesthetics.<br><br>Make empty to reset to default value.' translated + format: { + self selectedFont xHeightFraction printShowingDecimalPlaces: 3. + TextStyle defaultTTFont xHeightFraction printShowingDecimalPlaces: 3 }) asTextFromHtml! Item was added: + ----- Method: FontImporterTool>>uninstallColor (in category 'ui - colors') ----- + uninstallColor + + ^ (UserInterfaceTheme current get: #cancel for: #ListChooser) ifNil: [Color r: 1 g: 0.6 b: 0.588]! Item was added: + ----- Method: FontImporterTool>>uninstallFont (in category 'actions') ----- + uninstallFont + + (Project uiManager + confirm: ('Do you want to uninstall the following font?\\ ' translated, + self currentSelection familyName, + '\\(There may be references left to this font\in text attributes and text styles.)' translated) withCRs + title: 'Uninstall Font' translated) ifFalse: [^ false]. + + self currentSelection uninstallFont. + + self currentSelection parent ifNotNil: [:p | self currentSelection: p]. + self changed: #objectChanged with: self currentSelection. + + ^ true! Item was removed: - ----- Method: FontImporterTool>>warningSeen (in category 'accessing') ----- - warningSeen - - ^ warningSeen ifNil: [false]! Item was removed: - ----- Method: FontImporterTool>>warningSeen: (in category 'accessing') ----- - warningSeen: anObject - - warningSeen := anObject! Item was added: + ----- Method: FontImporterTool>>widgetSample (in category 'preview text') ----- + widgetSample + + ^ self widgetSampleFor: self selectedFont! Item was added: + ----- Method: FontImporterTool>>widgetSampleFor: (in category 'preview text') ----- + widgetSampleFor: font + + | widgets data preferredWidth | + data := ChronologyConstants classPool at: #MonthNames. + widgets := OrderedCollection new. + preferredWidth := ((font widthOfString: (data detectMax: [:ea | ea size])) * 1.3) truncated. + + "1) List morph" + widgets add: ((PluggableListMorph on: data list: #value selected: nil changeSelected: nil) vResizing: #shrinkWrap; width: preferredWidth; font: font; yourself). + + "2) Menu morph" + widgets add: (MenuMorph new in: [:menu | data do: [:o | menu add: o action: #yourself. menu lastItem font: font]. menu]). + + "3) Buttons" + widgets add: (Morph new color: Color transparent; changeTableLayout; listDirection: #topToBottom; vResizing: #shrinkWrap; cellGap: (font widthOf: Character space); width: preferredWidth; addAllMorphs: (data collect: [:ea | (PluggableButtonMorph on: ea getState: nil action: #yourself label: #yourself) hResizing: #spaceFill; font: font; fullBounds; in: [:button | MorphicProject useCompactButtons ifFalse: [button vResizing: #rigid; height: button height * 1.6; flag: #magicNumber]]; yourself ])). + + ^ Text streamContents: [:sample | + widgets + do: [:widget | + widget textAnchorProperties verticalAlignment: #top. + sample nextPutAll: ( + Text + string: Character startOfHeader asString + attribute: widget asTextAnchor)] + separatedBy: [sample space: 5]]! Item was changed: + ----- Method: FontImporterTool>>windowTitle (in category 'ui - building') ----- - ----- Method: FontImporterTool>>windowTitle (in category 'toolbuilder') ----- windowTitle + ^ 'Font Importer', (self currentSelection + ifNil: [''] + ifNotNil: [:desc | ': ', desc familyName])! - ^'Choose a Font to import' translated! Item was changed: ----- Method: TTFontDescription>>asMorph (in category '*Morphic-TrueType') ----- asMorph + + ^ self asHandle font + browseAllGlyphs; + browseAllGlyphsByCategory; + browseAllSymbols; + yourself. + + "^TTSampleFontMorph font: self"! - ^TTSampleFontMorph font: self!
More information about the Squeak-dev mailing list |