Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
Ragnar Hojland Espinosa and the Wonderful Land Of Pluginia
Last updated at 5:45 am UTC on 21 August 2008
Here are some notes for personal use I wrote regarding writing plugins around 2003, and that I later posted hoping they could help someone else to have an easier time in figuring how everything worked together. Hopefully they aren't all that outdated by now. They are about creating a pluginized version of ncurses, which is a library for character output on terminal displays.

Building more complex plugins can be easily taken once you have figured out how to do the basic cases presented here. Be aware though that personal experience has gently taught me that sometimes it is better to implement in smalltalk whatever you are trying to pluginize, rather than the plugin. So if you are having trouble having to create and handle listeners, threads and non thread safe libraries, pointers and complex structures that must be passed around from C to smalltalk and viceversa, just do it in squeak. It's far more fun, productive and easier to debug.

Setup



Creating the skeleton for the plugin


We open a browser and scroll down to VMMaker. There we can see a VMMaker-SmartSyntaxPlugin category and some Plugin classes in it. The ncurses plugin we are going to create must be a subclass of one of these. I remember TestInterpreter, but SmartSyntax is new. Which one to try.. lets go for SmartSyntax and see if the name is as misleading as TestInterpeter (which, no, its not a class to test the interpreter). With all those letters in the name it must surely rock.



initialiseModule
	self export: true.
	^ self cCode: 'ncurses_init()' inSmalltalk: [true]

shutdownModule
	self export: true.
	^ self cCode: 'ncurses_shutdown()' inSmalltalk: [true]

We don't have to implement these two methods if we don't want to. Or we cas use cCode: 'true' inSmalltalk: [true] as a placeholder for the future.


moduleName
	^ 'CursesPlugin'

First test: compiling something


Nothing like testing from time to time how you are doing. We are going to tell squeak to generate the glue for our plugin, and attempt to compile that. Its not going to do much, but at least we'll see something. Besides, it'll serve as a good excuse to go for a beer while it compiles :)


Adding a really simple primitive


So it compiled, right, but can we see something? Nooo. Time to add some code then. We are going to add code to initialize and close the ncurses library, and output a little beep too. First we'll go with the beep.



primitiveCursesBeep
        | result |
        "bind a squeak variable to a C variable"
        self var: #result declareC: 'int result'.
        self primitive: 'primitiveCursesBeep'.
        self cCode: 'result = ncurses_beep()'.
        "cast the value we get back into a boolean"
        ^ result asOop: Boolean.

It will complain of an unused result. Ignore it for now and accept the code.


requiresPlatformFiles
	^ true

Try to re-generate the plugin via vmmaker. It won't let you now. So we have to create our file.


#include <ncurses.h>
int ncurses_init()
{
   return initscr() ? 1 : 0;  // the library call actually returns something else...
}

int ncurses_shutdown()
{
   return endwin() == OK ? 1 : 0;
}

int ncurses_beep()
{
   return beep() == OK ? 1 : 0;
}

PLIBS=$PLIBS -lncurses



primCursesBeep
        <primitive: 'primitiveCursesBeep' module: 'CursesPlugin'>
        self primitiveFailed



Is it there, or not?


Smalltalk listLoadedModules do: [ :each | Transcript show: each ; cr. ]
Smalltalk unloadModule: 'CursesPlugin'.

Some tweakings


hasHeaderFile
	^ true
#include <ncurses.h>

Primitives with parameters


It looks easy. It is easy. For now. :) We choose to pluginize the
int scrl (int)
function, as it looks the simplest.


primitiveCursesScrl: aNumberOfLines 
| result |
	
self var: #result declareC: 'int result'.
self primitive: 'primitiveCursesScrl' parameters: #(SmallInteger).
self cCode: 'result = ncurses_scrl (aNumberOfLines)'.
^ result asOop: Boolean.

int ncurses_scrl (int numlines)
{
   return scrl (numlines) == OK ? 1 : 0;
}

primCursesScrl: aNumberOfLines
<primitive: 'primitiveCursesScrl' module: 'CursesPlugin'>
self primitiveFailed

I tended to forget wether in primitiveFoo: aParm1 parm2: aParm2 you used parm2 or aParm2 when calling the function, but then i realized that if you used parm2, you would have no way to refer to the first aParm1


Our first friendly speed bump, SmallInteger


Next in the list of functions to pluginize is
int echochar (chtype ch)
where chtypeis an unsigned long because ch can contain both the ascii character to print ORed with some other flags. Seeing the problem yet? No? Did you know SmallInteger is shorter than 32 bits? Now thats a problem.

We can get around it by passing the value as an Oop instead of a SmallInteger. Remember to write the usual primCursesEchoChar: aChar too. The C side would be as usual (int ncurses_echochar (unsigned long ch))

primitiveCursesEchoChar: aChar 
   | longchar result |

   self var: #longchar declareC: 'unsigned long longchar'.
   self var: #result declareC: 'int result'.
   self primitive: 'primitiveCursesEchoChar' parameters: #(Oop).
   longchar _ self positive32BitValueOf: aChar.
   self cCode: 'result = ncurses_echochar (longchar)'.
   ^ result asOop: Boolean.

and to test, in a Workspace:

CursesPlugin primCursesEchoChar: 'a' asCharacter asInteger.
CursesPlugin primCursesEchoChar: $b asInteger.

Yeah, as comfortable to use as this mouse with a broken left button that I have, but remember this is just the raw glue. Nobody really likes glue. But you can use it to put together nice things.

Dealing with pointers, and SmallInteger strikes back


Lets do something more interesting. Pointers. We have our new candidate to pluginization
int wrefresh (WINDOW *window);
but, wait.. what argument are we going to call it with? We first need to get some valid window pointer to test it with. Lets do a ncurses_getstdscr() which returns the stdscr pointer. But what to return? Because SmallInteger is 31 bits..
primitiveCursesStdscr
       | result |
       self var: #result declareC: 'WINDOW *result'.
       self primitive: 'primitiveCursesStdscr'.
       self cCode: 'result = ncurses_stdscr()'
       ^ result asOop: Unsigned.
That Unsigned over there will make squeak return the value via a positive32BitValue macro in C. SmallInteger is finally defeated. Lets deal with wfrefresh now:
primitiveCursesWRefresh: aWindow
        | w result |
        self var: #w declareC: 'WINDOW *w'.
        self var: #result declareC: 'int result'.
        self primitive: 'primitiveCursesWRefresh' parameters: #(Oop).
        w _ self cCoerce: (self positive32BitValueOf: aWindow) to 'WINDOW*'.
        w = nil ifTrue: [^0].
        self cCode: 'result = ncurses_wrefresh(w)'.
        ^ result asOop: Boolean.                                                                            
To test, we cant do much. If we get a reasonable integer, and if it doesn't crash, we'll assume we are doing good.
Transcript show: (CursesPlugin primCursesStdscr); cr.
CursesPlugin primWRefresh: (CursesPlugin primCursesStdscr).
Yeah :)



Hints



Comments anyone?


You don't need to implement a moduleName method if you want the plugin name to be the same as the class name. Several plugin classes have strange names and use the moduleName to give the actual plugin a less strange name. Of course this can cause confusion later. Never let it be said that we cannot use the simplifying power of Smalltalk to cause confusion. Tim Rowledge