From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 1:53:37 pm (Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned. Choose terminate or close.'] <class> <name>SpecificAssetImport</name> <environment>Tools</environment> <super>Core.Object</super> <private>false</private> none assetClass file <imports></imports> <category>My Classes</category> <attributes> <package>Assets-IDE</package> </attributes> </class> <comment> Tools.SpecificAssetImport
I am used to reflect about and manage an individual resource file. I provide support for filtering valid imports, checking if they are up to date, stubbing the initial method, computing the selector names, etc. Instance Variables: assetClass <Assets> which class to define the asset for file <String> the file (tail only) to be integrated
</comment> <class> <name>ImportProgressOverlay</name> <environment>Refactory.Browser</environment> <super>Graphics.VisualPart</super> <private>false</private> none label progress buffer mask <imports></imports> <category>Assets-IDE</category> <attributes> <package>Assets-IDE</package> </attributes> </class> <comment> Refactory.Browser.ImportProgressOverlay
I am a temporary view that gets added on the top of the browser's view stack when the import operation is running.
</comment> <methods> Tools.SpecificAssetImport <category>accessing</category>
assetClass ^assetClass
assetMethod ^assetClass class compiledMethodAt: self assetSelector
assetSelector ^self needsSpecialSelector ifTrue: [('_' , self idealAssetSelector) asSymbol] ifFalse: [self idealAssetSelector]
compileImport | specificSource | specificSource := assetClass perform: self importSelector with: self fullFilename. assetClass class compile: (self genericSourceAround: specificSource)
file ^file
fileExtension "Return the file extension (all characters AFTER the last dot) of the file ivar. Leading and trailing dots don't count." | dot | dot := file lastIndexOf: $.. (dot < file size and: [dot > 1]) ifFalse: [^nil]. ^(file allButFirst: dot) asLowercase
fullFilename ^(self assetClass getLastDirectory: nil) construct: file
idealAssetSelector "Return a selector that is mapped to the file name. Make sure we don't map to an infrastructure method." | dot string | dot := file lastIndexOf: $.. string := file first: dot - 1. string first isDigit ifTrue: [string := '_' , string]. ^(string collect: [:char | char isAlphaNumeric ifTrue: [char] ifFalse: [$_]]) asSymbol
importSelector "Determine the candidate method to be used to import a file of the type in aFilepath, don't actually worry about whether the import method exists or not. Return nil if there is no extension." ^self fileExtension ifNotNil: [:type | ('import_' , type , ':') asSymbol]
sync self isSynced ifFalse: [self compileImport]
value ^self assetClass perform: self assetSelector
</methods> <methods> Tools.SpecificAssetImport <category>initialize-release</category>
assetClass: anAssetsClass assetClass := anAssetsClass
file: aFiletail file := aFiletail
</methods> <methods> Tools.SpecificAssetImport <category>private</category>
currentResourceHash "Return md5sum for the resource file associated with the asset named aSymbol. Return nil if no file is found." | rs | ^(self fullFilename) ifNotNil: [:fullPath | fullPath definitelyExists ifTrue: [rs := fullPath readStream. rs binary. [Security.MD5 hashFrom: rs] ensure: [rs close]] ifFalse: [nil]]
genericSourceAround: aSourceString "Emit source code for aSymbol. Update the housekeeping tags and wrap a once block around specificSource." ^'<1s> "WARNING: This code was automatically generated during asset import. Regeneration will destroy any manual edits." %<file: <2p>> %<md5sum: <3p>> ^[<4s>] once' expandMacrosWith: self assetSelector with: self file with: self currentResourceHash with: aSourceString
md5Tag ^Pragma named: #md5sum: inMethod: self assetMethod
rememberedHash ^self md5Tag ifNotNil: [:tag | tag arguments first]
stubChange ^Refactory.Browser.AddMethodChange compile: self stubSource in: assetClass classBehavior classified: self fileExtension , ' imports'
stubSource "Return the source code that would be used to initially define this method if it doesn't exist yet." ^'<1s> %<file: <2p>> ^self error: ''This asset not integrated yet''' expandMacrosWith: self assetSelector with: file
</methods> <methods> Tools.SpecificAssetImport <category>testing</category>
isDefined ^assetClass respondsTo: self assetSelector
isSynced "If we can find the resource file, determine whether we're synced against it. Though somewhat fallacious, we term the case where the resource file cannot be currently located as 'synced'." ^self currentResourceHash ifNil: [true] ifNotNil: [:fileHash | self rememberedHash = fileHash]
isValid "Will I even be something that my Assets class wishes or knows how to import?" ^file first ~= $. and: [self importSelector ifNotNil: [:selector | assetClass respondsTo: selector] ifNil: [false]]
needsSpecialSelector ^(Assets class whichClassIncludesSelector: self idealAssetSelector) notNil
</methods> <methods> Tools.SpecificAssetImport class <category>instance creation</category>
asset: anAssetsClass file: aFiletail ^(self new) assetClass: anAssetsClass; file: aFiletail
</methods> <methods> Refactory.Browser.ImportProgressOverlay <category>bounds accessing</category>
endRadius ^30
halfChordWidth ^150
preferredBounds ^Screen default bounds
</methods> <methods> Refactory.Browser.ImportProgressOverlay <category>initialize-release</category>
initialize super initialize. progress := 0.
</methods> <methods> Refactory.Browser.ImportProgressOverlay <category>displaying</category>
buffer (buffer notNil and: [buffer isOpen]) ifTrue: [^buffer]. buffer := Pixmap extent: self halfChordWidth @ self endRadius * 2. ^buffer
displayBackground: aGC | rectangle halfExtent center | halfExtent := self halfChordWidth @ self endRadius. center := self bounds center. rectangle := center - halfExtent corner: center + halfExtent. aGC paint: (ColorValue brightness: 0.1). aGC displayWedgeBoundedBy: (rectangle leftCenter - halfExtent y corner: rectangle leftCenter + halfExtent y) startAngle: 90 sweepAngle: 180; displayRectangle: (rectangle expandedBy: 1 @ 0); displayWedgeBoundedBy: (rectangle rightCenter - halfExtent y corner: rectangle rightCenter + halfExtent y) startAngle: 270 sweepAngle: 180
displayBuffer | gc | gc := self buffer graphicsContext. gc paint: (ColorValue brightness: 0.6); displayRectangle: self buffer bounds. self displayProgress: gc. self displayText: gc
displayOn: aGC aGC copyMaskedArea: self mask fromPixelArray: self buffer sourceOffset: Point zero destinationOffset: (self bounds extent - self buffer extent) // 2
displayProgress: gc | angle | gc paint: (ColorValue hue: progress / 3 saturation: 1 brightness: 0.75). angle := progress * 360. gc displayWedgeBoundedBy: ((Point zero corner: self endRadius asPoint * 2) insetBy: 5) startAngle: 265 - angle sweepAngle: angle
displayText: aGC label ifNil: [^self]. aGC paint: (ColorValue brightness: 0.9); display: label at: (self endRadius * 2 + 5) @ ((self buffer height - label height) // 2)
mask | gc | (mask notNil and: [mask isOpen]) ifTrue: [^mask]. mask := Mask extent: self halfChordWidth @ self endRadius * 2. mask background: CoverageValue transparent. gc := mask graphicsContext. gc paint: CoverageValue opaque. gc displayWedgeBoundedBy: (Point zero corner: self endRadius * 2) startAngle: 0 sweepAngle: 360; displayRectangle: (mask bounds insetBy: self endRadius @ 0); displayWedgeBoundedBy: ((mask bounds width - (self endRadius * 2)) @ 0 corner: mask bounds corner) startAngle: 0 sweepAngle: 360. ^mask
redisplay self isOpen ifFalse: [^self]. self displayBuffer. self displayOn: self graphicsContext
</methods> <methods> Refactory.Browser.ImportProgressOverlay <category>accessing</category>
cleanUp "Remove myself from my container. I'm assumed to be the last component of my topComponent." self topComponent ifNotNil: [:window | window component remove: window component components last]
progress: aFraction progress := aFraction. self redisplay
text: aText label := Label with: aText attributes: (TextAttributes systemSized: 16). self redisplay
</methods> <methods> Refactory.Browser.ImportProgressOverlay class <category>instance creation</category>
installOn: aWindow "Place a new instance of me for temporary use as the last element in the windows component (assumed to be a CompositePart of some sort)." | view | view := self new. aWindow component add: view in: (0 @ 0 corner: 1 @ 1). ^view
</methods> <methods> Graphics.Image <category>editing utilitys</category>
assetStoreString "It turns out that above about 16 unique colors we usually end up using more space storing the individual colors, rather than encoding them directly in the pixels." | colors newPalette | self depth = 1 ifTrue: [^self storeString]. colors := self uniqueColorValues. newPalette := colors size > 16 ifTrue: [FixedPalette rgb8Bit] ifFalse: [MappedPalette withColors: colors asArray]. ^(self copy convertToPalette: newPalette) storeString
</methods> <methods> Graphics.TextAttributes class <category>instance creation</category>
systemSized: anInteger "Return #system textAttributes with anInteger pixel size." | style newQuery | style := (self styleNamed: #pixelDefault) copy. style setCharacterAttributes: style characterAttributes copy. newQuery := (style characterAttributes defaultQueryFor: nil) copy. newQuery pixelSize: anInteger. style characterAttributes setDefaultQuery: newQuery. style gridForFont: newQuery withLead: 0. ^style
</methods> <methods> Core.Assets class <category>accessing</category>
getLastDirectory: ignored "We use a special selector to get this, so we can avoid cluttering up the unary message space which we want to leave as open as possible for asset selectors" ^lastDirectory
</methods> <methods> Core.Assets class <category>private-import-helpers</category>
importBytes: aLogicalFile "This is not called by the default install, but is an example of another kind of import type." | rs bytes ws | rs := aLogicalFile readStream. rs binary. bytes := [rs contents] ensure: [rs close]. ws := String new writeStream. ws nextPutAll: 'ByteArray fromNibbleString: '''. bytes printNibblesOn: ws. ws nextPut: $'. ^ws contents
importImage: aLogicalFile | reader | reader := ImageReader fromFile: aLogicalFile. ^'CachedImage on: (<1s>)' expandMacrosWith: reader image assetStoreString
importMaskedImage: aLogicalFile | reader | reader := ImageReader fromFile: aLogicalFile. ^'OpaqueImage figure: (CachedImage on: (<1s>)) shape: (CachedImage on: (<2s>))' expandMacrosWith: reader image assetStoreString with: reader mask assetStoreString
importString: aLogicalFile "This is not called by the default install, but is an example of another kind of import type." | rs string | rs := aLogicalFile readStream. rs lineEndAuto. string := [rs contents] ensure: [rs close]. ^string storeString
</methods> <methods> Core.Assets class <category>import-types</category>
import_bmp: aFilename ^self importImage: aFilename
import_gif: aFilename ^self importMaskedImage: aFilename
import_jpeg: aFilename ^self importImage: aFilename
import_jpg: aFilename ^self importImage: aFilename
import_png: aFilename ^self importMaskedImage: aFilename
</methods> <methods> Core.Assets class <category>accessing</category>
lastDirectory: aDirectory lastDirectory := aDirectory
</methods> <methods> Refactory.Browser.BrowserNavigator <category>private</category>
checkForExtraneousAssets: aCollectionOfImports | stowaways victims change | stowaways := self selectedClass classBehavior methodDictionary values select: [:each | each attributeMessages notNil]. stowaways removeAll: (aCollectionOfImports collect: [:each | each assetMethod]). stowaways isEmpty ifTrue: [^self]. victims := self promptForAssetMethodsToRemove: (stowaways collect: [:each | each definition]) asSortedCollection. victims isEmpty ifTrue: [^self]. change := CompositeRefactoryChange new. victims do: [:each | change removeMethod: each selector from: each implementingClass]. self performChange: change
isAssetClassSelected ^self selectedClass notNil and: [self selectedClass instanceBehavior includesBehavior: Assets]
promptForAssetMethodsToRemove: aSequenceOfMethodDefinitions | wrappers listModel dialog spec listWrapper resultHolder | wrappers := OrderedCollection new. listModel := MultiSelectionInList new. listModel list: aSequenceOfMethodDefinitions. dialog := SimpleDialog new. spec := dialog interfaceSpecFor: #emptySpec. dialog initializeBuilderFor: builder window. (dialog builder) add: spec window; add: spec component. dialog initializeWindowFor: builder window; setInitialGap; addMessage: #AssetsNoLongerInDirectory >> 'The following previously imported assets were absent from the synced directory.' centered: true; addGap: 10. listWrapper := dialog addMultiList: listModel lines: 10 validation: [true]. listWrapper widget displayStringSelector: #selector. dialog addGap: 5. wrappers add: (dialog addLabels: (Array with: #AssetsRetainOrphans >> 'Let All Stay' with: #AssetsRemoveSelectedOrphans >> 'Remove Selected' with: #AssetsRemoveAllOrphans >> 'Remove All') values: #(#letStay #removeSelected #removeAll) default: #removeAll storeInto: (resultHolder := #removeAll asValue) takeKeyboard: true equalize: true). dialog addGap: 5. dialog bottomAlignLowerEdge: listWrapper. dialog bottomAlign: wrappers. dialog preOpen. dialog builder openDialogWithExtent: dialog builder window displayBox extent. resultHolder value = #letStay ifTrue: [^Array new]. resultHolder value = #removeSelected ifTrue: [^listModel selections]. resultHolder value = #removeAll ifTrue: [^aSequenceOfMethodDefinitions]. self shouldNotImplement
setAssetsDirectory | dialog currentDirectory | currentDirectory := self selectedClass instanceBehavior getLastDirectory: nil. (InputState default shiftDown not and: [currentDirectory notNil and: [currentDirectory isReadable]]) ifTrue: [^self]. dialog := ChooseDirectoryDialog new. dialog windowTitle: #AssetsPickDirectory >> 'Choose directory which contains asset resource files'. self selectedClass instanceBehavior lastDirectory: dialog select
syncAssets | targetDirectory subFile imports change view lastUpdate | self setAssetsDirectory. (targetDirectory := self selectedClass instanceBehavior getLastDirectory: nil) ifNil: [^self]. self selectClass: self selectedClass classBehavior. imports := (targetDirectory directoryContents select: [:each | subFile := targetDirectory construct: each. subFile isDirectory not and: [subFile isReadable]]) collect: [:each | SpecificAssetImport asset: self selectedClass instanceBehavior file: each]. imports := imports select: [:each | each isValid]. view := ImportProgressOverlay installOn: builder window. builder window component invalidateNow. [change := CompositeRefactoryChange new. imports do: [:each | each isDefined ifFalse: [change addChange: each stubChange]]. change changesSize isZero ifFalse: [view text: #AssetsStubbing >> 'Creating initial imports...'. self performChange: change]. lastUpdate := 0. imports keysAndValuesDo: [:index :each | view text: (#AssetsSyncing >> 'Syncing <1s>' expandMacrosWith: each file). each sync. view progress: index asFloat / imports size]. view progress: 1.0. self checkForExtraneousAssets: imports. (Delay forMilliseconds: 60) wait] ensure: [view cleanUp]. self refreshLists
</methods> <methods> Tools.Pragma class <category>instance creation</category>
named: aTag inMethod: aCompiledCode "Return a new instance of the receiver which can be used to reflect on the specific method tag named aTag. Return nil if there is none." aCompiledCode attributeMessages ifNotNil: [:pragmaMessages | pragmaMessages do: [:pragmaMessage | pragmaMessage selector = aTag ifTrue: [^self new message: pragmaMessage methodDefinition: aCompiledCode definition]]]. ^nil
</methods> <methods> Refactory.Browser.BrowserNavigator <category>menus</category>
menuItemSyncAssets <itemInMenu: #(#classMenu) position: 300.1> ^(MenuItem labeled: #SyncAssets >> 'Sync Assets' << #assets) hidden: [self isAssetClassSelected not]; value: #syncAssets
</methods> "Imported Classes:" self error: 'Attempting to file-in parcel imports. Choose terminate or close' <class> <name>Object</name> <environment>Core</environment> <super></super> <private>false</private> none <imports></imports> <category>Kernel-Objects</category> <attributes> <package>Kernel-Objects</package> </attributes> </class> <class> <name>VisualPart</name> <environment>Graphics</environment> <super>Graphics.VisualComponent</super> <private>false</private> none container eventHandlers properties <imports></imports> <category>Graphics-Visual Objects</category> <attributes> <package>Graphics-Visual Objects</package> </attributes> </class> <class> <name>BrowserNavigator</name> <environment>Refactory.Browser</environment> <super>Refactory.Browser.Navigator</super> <private>false</private> none navigatorType cachedSelectors windowLabel navigatorSpecBlocks dependents <imports> Store.* </imports> <category>Browser-Navigator</category> <attributes> <package>Browser-BrowserUI</package> </attributes> </class> <class> <name>Image</name> <environment>Graphics</environment> <super>Graphics.PixelArray</super> <private>false</private> none bits width height depth bitsPerPixel palette maxPixelValue rowByteSize <imports></imports> <category>Graphics-Images</category> <attributes> <package>Graphics-Images</package> </attributes> </class>