'From Squeak3.1alpha of 4 February 2001 [latest update: #3771] on 3 March 2001 at 8:09:26 pm'! "Change Set: ProjResources4 Date: 3 March 2001 Author: Andreas Raab Make standard forms written out as disk proxies rather than forms. Make color forms hibernate their colors into a more compressed representation."! ArrayedCollection variableWordSubclass: #ColorArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! Object subclass: #ResourceCollector instanceVariableNames: 'stubMap originalMap locatorMap localDirectory baseUrl internalStubs ' classVariableNames: 'Current ' poolDictionaries: '' category: 'System-Support'! !SequenceableCollection methodsFor: 'converting' stamp: 'ar 3/3/2001 20:06'! asColorArray ^ColorArray withAll: self! ! !ColorArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 20:03'! at: index ^(super at: index) asColorOfDepth: 32! ! !ColorArray methodsFor: 'accessing' stamp: 'ar 3/3/2001 20:04'! at: index put: aColor ^super at: index put: (aColor pixelWordForDepth: 32).! ! !ColorArray methodsFor: 'converting' stamp: 'ar 3/3/2001 20:06'! asColorArray ^self! ! !ColorForm methodsFor: 'fileIn/Out' stamp: 'ar 3/3/2001 20:07'! hibernate "Make myself take up less space. See comment in Form>hibernate." super hibernate. self clearColormapCache. colors ifNotNil:[colors _ colors asColorArray].! ! !ColorForm methodsFor: 'fileIn/Out' stamp: 'ar 3/3/2001 20:07'! unhibernate colors ifNotNil:[colors _ colors asArray]. ^super unhibernate. ! ! !ResourceCollector methodsFor: 'initialize' stamp: 'ar 3/3/2001 19:49'! initialize | fd pvt | originalMap _ IdentityDictionary new. stubMap _ IdentityDictionary new. locatorMap _ IdentityDictionary new. internalStubs _ IdentityDictionary new. fd _ ScriptingSystem formDictionary. pvt _ ScriptingSystem privateGraphics asSet. fd keysAndValuesDo:[:sel :form| (pvt includes: sel) ifFalse:[ internalStubs at: form put: (DiskProxy global: #ScriptingSystem selector: #formAtKey:extent:depth: args: {sel. form extent. form depth})]].! ! !ResourceCollector methodsFor: 'accessing' stamp: 'ar 3/3/2001 20:00'! objectForDataStream: refStream fromForm: aForm "Return a replacement for aForm to be stored instead" | stub fName fStream copy loc fullSize | stub _ internalStubs at: aForm ifAbsent:[nil]. stub ifNotNil:[ refStream replace: aForm with: stub. ^stub]. stub _ originalMap at: aForm ifAbsent:[nil]. stub ifNotNil:[^aForm]. aForm hibernate. (aForm bits byteSize < 4096) ifTrue:[^aForm]. "too small to be of interest" stub _ FormStub extent: (aForm width min: 32) @ (aForm height min: 32) depth: (aForm depth min: 8). aForm displayScaledOn: stub. aForm hibernate. copy _ Form extent: aForm extent depth: aForm depth bits: nil. copy setResourceBits: aForm bits. fName _ localDirectory nextNameFor:'resource' extension:'form'. fStream _ localDirectory newFileNamed: fName. fStream binary. copy storeResourceOn: fStream. "Compress contents here" fStream position: 0. fStream compressFile. localDirectory deleteFileNamed: fName. localDirectory rename: fName, FileDirectory dot, 'gz' toBe: fName. fStream _ localDirectory readOnlyFileNamed: fName. fullSize _ fStream size. fStream close. ProgressNotification signal: '2:resourceFound' extra: stub. stub hibernate. loc _ locatorMap at: aForm ifAbsent:[nil]. (loc notNil and:[loc hasRemoteContents not]) ifTrue:[ "The locator describes some local resource. If we're preparing to upload the entire project to a remote server, make it a remote URL instead." baseUrl asUrl hasRemoteContents ifTrue:[loc urlString: baseUrl, fName]]. loc ifNil:[ loc _ ResourceLocator new urlString: baseUrl, fName. locatorMap at: aForm put: loc]. loc localFileName: (localDirectory fullNameFor: fName). loc resourceFileSize: fullSize. stub locator: loc. aForm setResourceBits: stub. originalMap at: aForm put: copy. stubMap at: stub put: aForm. locatorMap at: aForm put: loc. "note: *must* force aForm in out pointers if in IS or else won't get #comeFullyUpOnReload:" refStream replace: aForm with: aForm. ^aForm! ! !StandardScriptingSystem methodsFor: 'form dictionary' stamp: 'ar 3/3/2001 19:45'! deletePrivateGraphics "ScriptingSystem deletePrivateGraphics" self deletePrivateGraphics: self privateGraphics afterStoringToFileNamed: 'disGraphics'! ! !StandardScriptingSystem methodsFor: 'form dictionary' stamp: 'ar 3/3/2001 19:46'! formAtKey: aKey extent: extent depth: depth "ScriptingSystem saveForm: (TileMorph downPicture) atKey: 'downArrow'" ^ FormDictionary at: aKey asSymbol ifAbsent: [Form extent: extent depth: depth]! ! !StandardScriptingSystem methodsFor: 'form dictionary' stamp: 'ar 3/3/2001 19:49'! formDictionary ^FormDictionary! ! !StandardScriptingSystem methodsFor: 'form dictionary' stamp: 'ar 3/3/2001 19:44'! privateGraphics "ScriptingSystem deletePrivateGraphics" ^#(#BadgeMiniPic #BadgePic #Broom #CedarPic #CollagePic #CoverMain #CoverSpiral #CoverTexture #Fred #ImagiPic #KayaPic #StudioPic)! !