Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Recursively visit sub-directories and resize images
Last updated at 9:16 pm UTC on 20 August 2022

Note the use of #readOnlyFileNamed:, #baseNameFor, and #directoryNamed: to build up fully qualified filenames, rather than platform-specific string concatenation. nb #readOnlyFileNamed: is useful in that it won't silently create files when your logic isn't correct!



 scaleImagesOnPath: aPath toSize: anExtent
     | dir form filename |
     dir := FileDirectory on: aPath.
     Transcript cr; show: dir pathName.
 
 	(dir fileNames
 		select: [:each |
 			(each asLowercase endsWith: '.jpg')
 			and: [(each includesSubString: 'thumb') not]])
 	do: [:key |
 		form := Form fromBinaryStream: (dir readOnlyFileNamed:  key).
 		filename := dir fullPathFor: (FileDirectory baseNameFor: key) , '-thumb.jpg'.
 		dir deleteFileNamed: filename.
 		JPEGReadWriter2
 			putForm: (form scaledToSize: anExtent)
 			onFileNamed: filename].
 	"recurse"
 	dir directoryNames
 		do: [:each |
 			self scaleImagesOnPath:
 				(dir directoryNamed: each) pathName toSize: anExtent]

Based on an example from Ramon Leon's excellent blog.


(Creating Thumbnails With Smalltalk)

Use a pattern


Separate the directory traversal from the processing, thus:

traverse: aFileDirectory doing: aBlockWithFileArgument
	aFileDirectory fileNames 
		do: [ :p | aBlockWithFileArgument value: (aFileDirectory fullPathFor: p)].

	aFileDirectory directoryNames 
		select: [ :d | (d startsWith: '.') not]
		thenDo: [ :d | self traverse: (aFileDirectory directoryNamed: d) doing: aBlockWithFileArgument  ].



Call this code, eg:

	self 
		traverse: (FileDirectory on: 'c:\') 
		doing: [ :fp | Transcript show: fp; cr.].


See also

Scaling images in a FileDirectory (keysDo:)