Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Göran's Code Snippets Of The Day
Last updated at 8:17 pm UTC on 1 November 2006
So, without further ado I bring to you "The Much Awaited Thumbnail And
Scaled Image Producer Doit" to impress all your deluded Java friends
with (had a collegue trying to do this and I couldn't resist):


dir := FileDirectory on: 'd:\\images'. "add some image files to this
directory first"
dir keysDo: [:name |
	form := Form fromBinaryStream: (dir fileNamed: name).
	JPEGReadWriter2
		putForm: (form scaledToSize: 512@512) onFileNamed: 'scaled_',name;
		putForm: (form scaledToSize: 80@80) onFileNamed: 'thumb_',name] 

(Merged some of Geoff's changes to make it work)

Geoff: I spent quite some time hacking on this. Thanks for the suggestions.
Fixes -

dir := FileDirectory default directoryNamed: 'images'. "in default dir"

form := Form ... " Object(false) doesn't understand... - eventually it hit."
   JPEGReadWriter2 "depends on image type?"
   ... onFileNamed: (dir fileNamed: 'scaled_', name) fullName; "make in the same directory, do it more than once for fun."



"Zip up a complete directory structure and place the zip in the parent
directory (as Winzip
does from the explorer menu choice). Anyone care to add a menu item in
FileList? :-)"
dirName _ 'd:\images'.
archive _ ZipArchive new.
dir _ FileDirectory on: dirName.
dir fullNamesOfAllFilesInSubtree do:[:fn|
	entry _ archive addFile: fn as: (fn last: (fn size - dirName size -
1)).
	entry desiredCompressionMethod: ZipArchive compressionDeflated.
].
archive writeToFileNamed: (dir containingDirectory fullNameFor: dir
localName, '.zip'); close.



"Well, might be useful to someone - open up an url on Win32"
| url dir fileName |
url _ 'http://www.squeak.org'.
fileName _ 'openit.url'.
dir _ FileDirectory default.
(dir fileExists: fileName) ifTrue:[ dir deleteFileNamed: fileName ].
file _ dir newFileNamed: fileName.
file nextPutAll: '[DEFAULT]';cr; nextPut: Character lf;
	nextPutAll: 'BASEURL=', url;cr; nextPut: Character lf;
	nextPutAll: '[InternetShortcut]';cr; nextPut: Character lf;
	nextPutAll: 'URL=', url;cr; nextPut: Character lf.
file close.
Win32Shell new shellOpen: (dir fullNameFor: fileName)



"Argghh, running out of snippets!!! :-) But hey, this one still is a
cool oldie performance wise:"
1000 factorial / 999 factorial



"Currently out of snippets, here is a UserFriendly comic instead... :-)"
HandMorph attach: (SketchMorph fromStream:
('http://www.userfriendly.org/cartoons/archives/01nov/xuf003653.gif'
asUrl retrieveContents contentStream))



"Well, I had to come up with something right :-)? Just do it"
[Sensor anyButtonPressed] whileFalse: [
	Display copy: Display boundingBox from: 0@1 in: Display rule: Form
over.
].
Display restore



"Just because it is faster to write than 'self halt' - you save 3 keys!"
0 halt



"Ok, a little tip then. Perhaps you have seen this in the code? It is a
Squeakish way of typing 'PENDING'. #flag: doesn't do anything but this
enables us to search for our PENDINGS. Try
searching for senders of workAround (by selecting that word and typing
Alt-n (Win32) and you will see what I mean). Andreas is obviously fond
of this technique! :-)"

self flag: #workAround



"A small snippet that plays a tune when something has changed at the
Squeak Swiki!
It simply polls the recent changes page every 30 seconds in a separate
Process.
Do note though that a too small Delay might overload the poor Swiki. Set
it reasonably high..."
| oldContent newContent |
oldContent _ nil.
[[Smalltalk at: #Stop ifAbsent:[true]] whileTrue: [
	newContent _ 'http://wiki.squeak.org/recent' asUrl
retrieveContents contents.
	(oldContent ~= newContent) ifTrue:[
		(FMSound majorChordOn: FMSound flute1 from: #c4) play.
		oldContent _ newContent
	].
	(Delay forSeconds:  30) wait.
]] forkAt: Processor userBackgroundPriority


"Aargh! I think I need to lower the pledge to ONE CSOTD per
day...
I am BUSY fixing up my CVS code... :-)"
AbstractSound busySignal: 3



	"This code returns the source without C++ style comments like '//' and '/*..*/'.
	It is a little buggy and does not handle nested comments..."
	| start stop result last nextChar aSource |
	aSource _ '// This is a comment\1 + 2\/* And this is one too. */\=3' withCRs.
	result _ WriteStream on: String new.
	start _ 0.
	last _ 1.
	[ start _ aSource findString: '/' startingAt: start + 1.
	start ~= 0 ] whileTrue: [
		stop _ nil.
		nextChar _ aSource at: start + 1.
		nextChar = $/
			ifTrue:[ stop _ (aSource indexOf: Character cr startingAt: start + 1)- 1]
			ifFalse:[
				nextChar = $*
					ifTrue:[ stop _ (aSource findString: '*/' startingAt: start + 1) +1 ]].
			stop
				ifNotNil: [
					result nextPutAll: (aSource copyFrom: last to: start - 1).
					last _ stop + 1.
					start _ stop + 1]
		 		ifNil: [start _ start + 1]].
	result nextPutAll: (aSource copyFrom: last to: aSource size).
	^result contents



"Hmmm, this nag feature I dropped into Celeste was perhaps a not so good
idea... :-)
Perhaps we should study this list of classes a little bit."
Smalltalk unusedClasses


"This one actually is borrowed from Leandro Caniglia. He
challenged me yesterday
to figure out why the method SmallInteger>>gcd: actually works. The
challenge can also be expressed
like this: Evaluate this code below and figure out why n=5.
One could ask oneself if the assignment (m _ n) is performed after or
before the
evaluation of the expression?
If it is done before - then n should become 4 right? (2 + 2)
And if it is done after then it should become 6... (3 + 3)
Gurus: don't spoil it for the newbies ok? Let them chew on it for a
while... :-)"
| m n |
n _ 2.
m _ 3.
n _ m + (m _ n)



"This one is a newbie trap I fell into myself the other day.
Before you do-it, what do you think it will say in the Transcript?"

| a |
a _ #(1).
a at: 1 put: 2.
Transcript show: 'An array with... what? ', #(1) printString;cr.

"Learn these two things:

1. A literal is not a constant. It is just sugar for creating an object.
2. Two equal literals (I guess) in the same method will be compiled to
refer to the same object!

PS. This almost drove me insane the other day..."


"This snipped is a bit large. I have started playing with Image
Segments
and they are nice. This code snippet extracts an ImageSegment,
writes it to file, counts stubs left behind and installs the segment
back.
Inspect or print it to see some interesting info about it all. Change
selfContainedObjectToPlayWith to whatever you like."

| is report extractTime writeTime nrOfStubs installTime |
selfContainedObjectToPlayWith _ 'aString'. "Put what you like here"
extractTime _ Time millisecondsToRun: [
		is _ ImageSegment new.
		is copyFromRoots: (Array with: selfContainedObjectToPlayWith)
sizeHint: 100000 areUnique: true.
		is segmentName: 'segmenttest' ].
report _ String streamContents: [:stream | is printSpaceAnalysisOn:
stream ].
writeTime _ Time millisecondsToRun: [ is extract; writeToFile ].
nrOfStubs _ (ImageSegmentRootStub allInstances collect: [:stub | stub
xxxSegment = is ]) size.
installTime _ Time millisecondsToRun: [ is install ].
'Extract time: ', extractTime printString, ' ms
Write to file time: ', writeTime printString, ' ms (includes one full GC
I think at about 500 ms that has been removed in newer Squeak)
Install time: ', installTime printString, ' ms
Number of stubs after extract: ', nrOfStubs printString,'
Analysis: ', report


"How to open up a workspace with text from a file (silly how long
it took me to get this right):"
(Workspace new contents: ((FileStream oldFileNamed: 'ws.txt')
contentsOfEntireFile))
	openLabel: 'My workspace'


> This one is actually not mine but Bijan's, but what the heck:
>
> "OK, I'm finalling doing one of these. This uses ImageSegments to 
> help figure out memory consumption of your objects:"
> 
> String streamContents: [:strm |
> 		(ImageSegment new copyFromRootsForExport: Browser allInstances)
> 					printSpaceAnalysisOn: strm]
> 


"Newbie tip: Bags are perfect for histograms and polls.
Do a 'print it' of below to see the number of votes for 'Yes'."
| votes |
votes _ Bag new.
votes add: 'Yes'; add: 'Yes'; add: 'No'.
votes occurrencesOf: 'Yes'



"Newbie tip: You want to know how long something takes to run? Use a
print it or inspect it on:"
Time millisecondsToRun: [ "put your code here like:" 100 factorial ]



Well, well... Can't come up with code right now. But I could explain a
nice little technique called
"double dispatch" perhaps not known to some newbies.

Personally I use when I want to be able to have multiple views on domain
objects
and still be able to rely on polymorphism on the domain object to create
the proper view.

Let's say you have a bunch of different fruit objects of classes Banana,
Lemon etc. Perhaps you also
create some form of UI classes called for example Views. A BananaView
for Bananas, LemonView for Lemons and so on.

Instead of doing this like a real OO newbie:

obj class == Banana ifTrue:[ BananaView on: obj ] 

...you would of course implement a method called say "getView" in the
Banana class like this:

Banana>>getView
	^BananaView on: self

...thus you implement getView for all fruit classes and you will get the
proper view. Ok, but what if you
suddenly have different views altogether, for example a bunch of
viewclasses for the web and another for
Morphic? Darn. Well, the obvious mistake would be too fall back into
non-OO practices like this:

Banana>>getWebView
Banana>>getMorphicView

...and let the caller decide which one to use. But that's ugly. Another
way would be to stuff a conditional into getView like this:

Banana>>getView
	(some test finding out which view to make - not so easy)
		ifTrue:[ ^WebBananaView on: self]
		ifFalse:[ ^MorphicBananaView on: self]

...not so pretty either and the test can be hard. Yuk. Conditionals are
a sure sign that perhaps we could use polymorphism instead - "let the
objects decide" so to speak. Ok. What if the domain object, when it gets
the message #getView could just bounce back and ask, "Well, I don't know
which particular view, but since I am a banana, it better be a
SomethingBananaView...". This can be implemented like:

getViewFor: theCaller
	"Bounce right back and call the proper method in the caller.
	Since I am a Banana, I will call the getBananaViewFor: method."

	^theCaller getBananaViewFor: self


...ok, now it is up to the called to implement #getBananaViewFor: so
that the correct type of View is created.
The first dispatch is on the domain object, the second is a
bounce-right-back-thingy on the caller, which typically is another
already existing View object. Thus - "double dispatch".

We could also view it as a way to find the correct method not only based
on the class of the receiver but also on the class of the caller.

Over-and-out.




"Ok, I can't just bail out AGAIN. So... ok, a newbie tip is always good,
right? It ain't code but... :-) Here goes:

If you get a 'MessageNotUnderstood' often referred to as a DNU (Does Not
Understand), which is a common error
in Smalltalk/Squeak there are AT LEAST three very common reasons for it:

1. An uninitialized variable (typically an instance variable).
You are sending a message to the object that the variable references and
that object is
the one-and-only-nil-guy. And Mr nil doesn't understand anything. Well,
he does understand a few things but not much.
If you are familiar with Java this is the equivalent to a NullPointer
Exception commonly referred to as NPE in the Java world.

2. A missing return statement. You have probably forgotten a ^ (return)
in one of your methods. If you forget that,
Smalltalk returns 'self' by default and that is probably in this case
not what you want. If you are really unlucky, the code dealing
with the result might actually work anyway and then you have a tricky
bug to find. An example would be if you test the result
with isNil or something and of course - it will never be nil... and
everybody understand isNil so there won't be a DNU popping up.

3. A method in the base classes returns nil as the answer (poor mans
error handling) if something can not be computed.
For historical reasons (and others) Smalltalk code relies on two error
handling techniques - returning nil (or 0 in some cases)
or raising an Exception. The latter is perhaps to be preferred today,
but testing for a nil-return is sometimes easier.

...and then of course - it just might happen that you have forgotten to
implement the method in question... :-) :-)

"


"Ok, this is not a snippet but actually a new method in String.
If you smack it in there then you can find matching parentheses in
Strings, try these 3 lines with print it:

| string |
string _ 'a String (with (some parentheses(and (this) one here:) should
be returned))'.
string copyFrom: 33 to: (string findMatching: $( with: $) startingAt:
33).

String>>findMatching: starter with: ender startingAt: start
	"Answer the index of matching ender within the receiver, starting at
start.
	starter and ender are two characters that are acting as pairs, like ${
and $}.
	If match is not found we answer 0." 

	| count delims index |
	delims _ String with: starter with: ender.
	count _ 0.
	index _ start - 1.
	[ index _ self findDelimiters: delims startingAt: index + 1.
	index ~= 0 ] whileTrue: [
		((self at: index) = starter)
			ifTrue: [ count _ count + 1 ]
			ifFalse: [ count _ count - 1.
					count isZero ifTrue: [ ^index].
					count < 0 ifTrue:[ ^0]]].
	^0



"Newbie tip: Simple string pattern matching! Do print it on each line,
see method
String>>match: for more details."

'abc*' match: 'abcdef'
'ab#de#' match: 'abcdef'
'*def' match: 'abcdef'




"I wonder why I ever came up with the idea of CSOTD? It is driving me
nuts.
Newbie tip: Reading in a file in a String. The path should be expressed
as expected
on your OS."
| myString |
myString _ (FileStream readOnlyFileNamed: 'd:\file.txt')
contentsOfEntireFile