Feeds:
Posts
Comments

Archive for the ‘Scheme’ Category

There are a number of different methods for passing data between pages. These include:

1. Passing the data in a query string.
2. Storing the data in a hidden field and using Javascript to respond to onClick on the links.
3. Storing the data on the server and retrieving it using a session id.

The first option can be very wasteful if we have a large table with many columns. We would have to replicate the data for each column.

The second option seems reasonable but excludes people who disable Javascript so I favour using sessions.

I’m not aware of a PLT scheme library that handles sessions for CGI but it is easy enough to create a very basic example. For our purposes, we will store the sessions in the temporary directory and not have any type of session expiry.

PLT scheme has a nice library called serialize.ss which replaces a lot of the code I discussed earlier. We define a session as a serializable struct which contains the session id, the filename where the data lives and the data itself.

(define-serializable-struct session (id filename data))

The data in a session is simply key value pairs so we provide functions to store and retrieve the data and check if it exists. This implementation obviously assumes that data is a hash table.

(define (session-data-put! session key value)
  (hash-table-put! (session-data session) key value))

(define (session-data-get session key)
  (hash-table-get (session-data session) key (lambda () #f)))

(define (session-data-exists? session key)
  (with-handlers ((exn:fail:contract? (lambda (exn) #f)))
    (hash-table-get (session-data session) key)
    #t))

We also need some way of storing and retrieving sessions on the filesystem. Loading the session checks if one exists for a given session ID. If not, it uses make-temporary-file.

(define *temp-file-prefix* "cgisession-")
(define *temp-file-format-string*
  (string-append *temp-file-prefix* "~a"))

(define (filename->session-id filename)
  (cadr (regexp-match (string-append *temp-file-prefix*
                                     "([-0-9]+)$")
                      (path->string filename))))

(define (load-session session-id)
  (let ((tmp-filename (build-path (find-system-path 'temp-dir)
                                  (string-append *temp-file-prefix*
                                                 session-id))))
    (if (file-exists? tmp-filename)
        (call-with-input-file tmp-filename
          (lambda (port) (deserialize (read port))))
        (let ((filename (make-temporary-file *temp-file-format-string*)))
          (make-session (filename->session-id filename)
                        filename
                        (make-hash-table 'equal))))))

This is less robust than it could be, e.g. if the temporary file exists and does not contain something that we can deserialize then it will fall over. Fixing that is left as an exercise.

Saving the session is trivial.

(define (save-session session)
  (let ((port (open-output-file (session-filename session) 'truncate)))
    (print (serialize session) port)
    (close-output-port port)))

Finally, here is the full code listing including a few tests.

(require (lib "file.ss"))
(require (lib "serialize.ss"))

(define *temp-file-prefix* "cgisession-")
(define *temp-file-format-string*
  (string-append *temp-file-prefix* "~a"))

(define-serializable-struct session (id filename data))

(define (filename->session-id filename)
  (cadr (regexp-match (string-append *temp-file-prefix*
                                     "([-0-9]+)$")
                      (path->string filename))))

(define (load-session session-id)
  (let ((tmp-filename (build-path (find-system-path 'temp-dir)
                                  (string-append *temp-file-prefix*
                                                 session-id))))
    (if (file-exists? tmp-filename)
        (call-with-input-file tmp-filename
          (lambda (port) (deserialize (read port))))
        (let ((filename (make-temporary-file *temp-file-format-string*)))
          (make-session (filename->session-id filename)
                        filename
                        (make-hash-table 'equal))))))

(define (save-session session)
  (let ((port (open-output-file (session-filename session) 'truncate)))
    (print (serialize session) port)
    (close-output-port port)))

(define (session-data-put! session key value)
  (hash-table-put! (session-data session) key value))

(define (session-data-get session key)
  (hash-table-get (session-data session) key (lambda () #f)))

(define (session-data-exists? session key)
  (with-handlers ((exn:fail:contract? (lambda (exn) #f)))
    (hash-table-get (session-data session) key)
    #t))

;;; --- Test code --- ;;;

(define *session-id* "1234")
(define s (load-session *session-id*))
(set! *session-id* (session-id s))

(session-data-put! s 'k 'v)
(session-data-get s 'k)
(session-data-exists? s 'k1)

(save-session s)

Read Full Post »

I know that last time I said we would look at passing data to other pages and data sorting but instead I thought I would make a brief diversion into sqlite. Playing around with table data such as this:

a b c
1 2 3
4 5 6
7 8 9

which is rendered by:

(print-ln (render-table (make-table
                         '("a" "b" "c")
                         '(("1" "2" "3")
                           ("4" "5" "6")
                           ("7" "8" "9")))
                        '()))

is pretty uninspiring. Instead, I can use some financial data that is available from yahoo. Data for the first 50 (or so) NASDAQ stocks is available here.

(require (lib "url.ss" "net"))

(define (print-ln . args)
  (for-each display args)
  (newline))

(define *url-prefix* "http://download.finance.yahoo.com/d/quotes.csv?")
(define *url* (string-append *url-prefix*
                             "s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50"))

(define (display-url url)
  (let ((p (get-pure-port (string->url url))))
    (let loop ((line (read-line p)))
      (unless (eof-object? line)
        (print-ln line)
        (loop (read-line p))))
    (close-input-port p)))

(display-url *url*)

Running this script gives the rather strange error message Missing Format Variable.

(url->string (string->url *url*))

reveals the reason. string->url corrupts the url! It should be this:

http://download.finance.yahoo.com/d/quotes.csv?s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50

But instead it is this (ampersands converted to semi-colons amongst aother things):

http://download.finance.yahoo.com/d/quotes.csv?s=%40%5EIXIC;f=sl1d1t1c1ohgv;e=.csv;h=50

Yahoo rejects the later url with the error message as above.

Absolutely unbe-fricking-lievable.

I can’t imagine the thinking behind making string->url take a perfectly valid URL and breaking it. If you must do this, at least provide a function that doesn’t have this behaviour, say string->url and string->borked-url. This totally unreasonable design decision has damaged my confidence in the PLT scheme standard library. It is possible to work around the stupid default behaviour (although the fix presumably breaks URLs with semi-colons in the query string).

(require (lib "url.ss" "net")
         (lib "uri-codec.ss" "net"))

(current-alist-separator-mode 'amp)

(define (print-ln . args)
  (for-each display args)
  (newline))

(define *url-prefix* "http://download.finance.yahoo.com/d/quotes.csv?")
(define *url* (string-append *url-prefix*
                             "s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50"))

(define (display-url url)
  (let ((p (get-pure-port (string->url url))))
    (let loop ((line (read-line p)))
      (unless (eof-object? line)
        (print-ln line)
        (loop (read-line p))))
    (close-input-port p)))

(display-url *url*)

The next step is to store the data in the database. First create a suitable table:

CREATE TABLE stock_data
(
    ticker varchar(8),
    price double,
    change double,
    date datetime
)

There is a nice csv library on planet. You declare a csv reader like this:

(define make-csv-reader
  (make-csv-reader-maker
   '((separator-chars            . (#\,))
     (strip-leading-whitespace?  . #t)
     (strip-trailing-whitespace? . #t))))

Then the functions to extract the interesting data and store it in the database. The symbol, price and change from the previous day are the first, second and fifth fields respectively. I think this csv file only changes once a day so we fix the time portion of the datetime to an arbitrary value. I haven’t named the functions particularly well here, but they should convey my intent at least.

(define (db-insert-row symbol price change)
  (let ((sql (format "
    INSERT INTO stock_data
    (ticker, price, change, date)
    VALUES
    ('~a', ~a, ~a, strftime('%Y-%m-%d 06:00:00', 'now'))
    " symbol price change)))
    (print-ln sql)
    (exec/ignore *dbh* sql)))

(define (csv-insert-into-db p)
  (let ((reader (make-csv-reader p)))
    (let loop ()
      (let ((l (reader)))
        (unless (or (null? l)
                    (null? (cdr l)))
          (let ((symbol (first l))
                (price (second l))
                (change (fifth l)))
            (db-insert-row symbol price change))
          (loop))))))

And here is the complete script:

(require (lib "1.ss" "srfi")
         (lib "url.ss" "net")
         (lib "uri-codec.ss" "net")
         (planet "csv.ss" ("neil" "csv.plt" 1 1))
         (planet "sqlite.ss" ("jaymccarthy" "sqlite.plt" 3 1)))

(current-alist-separator-mode 'amp)

(define (print-ln . args)
  (for-each display args)
  (newline))

(define *url-prefix* "http://download.finance.yahoo.com/d/quotes.csv?")
(define *url* (string-append *url-prefix*
                             "s=@%5EIXIC&f=sl1d1t1c1ohgv&e=.csv&h=50"))

(define (display-url url)
  (let ((p (get-pure-port (string->url url))))
    (let loop ((line (read-line p)))
      (unless (eof-object? line)
        (print-ln line)
        (loop (read-line p))))
    (close-input-port p)))

(define make-csv-reader
  (make-csv-reader-maker
   '((separator-chars            . (#\,))
     (strip-leading-whitespace?  . #t)
     (strip-trailing-whitespace? . #t))))

(define (db-insert-row symbol price change)
  (let ((sql (format "
    INSERT INTO stock_data
    (ticker, price, change, date)
    VALUES
    ('~a', ~a, ~a, strftime('%Y-%m-%d 06:00:00', 'now'))
    " symbol price change)))
    (print-ln sql)
    (exec/ignore *dbh* sql)))

(define (csv-insert-into-db p)
  (let ((reader (make-csv-reader p)))
    (let loop ()
      (let ((l (reader)))
        (unless (or (null? l)
                    (null? (cdr l)))
          (let ((symbol (first l))
                (price (second l))
                (change (fifth l)))
            (db-insert-row symbol price change))
          (loop))))))

(define (process-html url processor)
  (let ((p (get-pure-port (string->url url))))
    (processor p)
    (close-input-port p)))

(define *path-prefix* "c:/tmp")
(define (path p)
  (string->path (string-append *path-prefix* "/" p)))

(define *dbh* (open (path "test.db")))

(process-html *url* csv-insert-into-db)

(select *dbh* "SELECT count(*) as stocks from stock_data")
(define *results* (select *dbh* "SELECT * from stock_data"))

(for-each print-ln *results*)

(close *dbh*)

Read Full Post »

This time we said that we would talk about extracting the parameters from the query string and rendering the table. The string (srfi-13) and character set (srfi-14) SRFIs make it very easy to parse the query string.

(string-tokenize *query-string* (char-set-complement (char-set #\= #\&)))

We are not quite ready to talk about passing data from one page to another so we won’t discuss this any further until next time. How about rendering the table? Concatenating strings is messy and error-prone. We need some helper functions. e.g. let’s say there was a function tag that took a tag name, some attributes and content and formatted it into HTML. How would we want that to look? Maybe something like this?

(tag 'br) --> <br/>
(tag 'a '(href "www.google.com") "google") --> <a href="www.google.com">google</a>
(tag 'tr '() (tag 'td '() "hello")) --> "<tr><td>hello</td></tr>"

First of all, we need something to convert attributes into a string. Perhaps we might want multiple attributes or an attribute may want to concatenate a number of elements together:

e.g.

(list 'href "data=" data "&xyz=" xyz)
(define (attributes->string attributes)
  (if (pair? attributes)
      (let ((h (car attributes))
            (t (cdr attributes)))
        (if (pair? h)
            (string-join (map attributes->string attributes) " ")
            (string-append (symbol->string h)
                           "="
                           (qstr (string-concatenate t)))))
      ""))

A little helper function prefixes the attributes with a space if they result in a non-empty string.

(define (prefix-space s)
  (if (and (string? s)
           (> (string-length s) 0))
      (string-append " " s) ""))

We may not want to pass all of the parameters in so only the tag name is compulsory. Everything else is passed into args as a list. We then extract the appropriate variables parameters if there are any.

(define (tag name . args)
  (let* ((s-name (symbol->string name))
         (args-len (length args))
         (s-attributes (if (>= args-len 1)
                           (attributes->string (first args)) ""))
         (s-content (if (>= args-len 2)
                        (string-concatenate (cdr args)) ""))
         (content-length (string-length s-content)))
    (string-append "<" s-name
                   (prefix-space s-attributes)
                   (if (> content-length 0)
                       (string-append ">" s-content
                                      "</" s-name ">")
                       "/>"))))

srfi-13 provides some convenience functions for concatenating lists of strings and joining strings together.

I briefly thought about providing a nicer interface with two functions providing a tag interface without attributes and with attributes respectively and delegating to a similar function to the one above.

(define (tag name . args) ...)
(define (tag-attribs name . args) ...)

Alternatively the keyword library can be used to make a nicer interface:

(require (lib "kw.ss"))

(define/kw (tag/kw tag-name #:key attributes (content ""))
  (tag tag-name attributes content))

This would then be called like this:

(print-ln (tag/kw 'x #:attributes '(a "b")))
(print-ln (tag/kw 'td #:content "hi"))

Now that we have a tag function, we can use it to render a table. A basic table is straight-forward enough. We map a render row function across each table row, joining the result with string-join. The render row maps a function that surrounds each element with <td> … </td> string-concatenates that, and surrounds that with <tr> … </tr>. We want to alternate different classes to each row and closures are great for this. We provide a function that returns a closure that returns a different id each call.

(define (id-generator ids)
  (let ((i -1)
        (ids (list->vector ids))
        (len (length ids)))
    (lambda ()
      (set! i (+ i 1))
      (vector-ref ids (remainder i len)))))

We can the use this generator to pass a different id to the row renderer for each row in the table.

(define (render-table-row row . tr-class)
  (let ((tr-attribs (if (null? tr-class) '()
                        (list 'class (car tr-class)))))
    (tag 'tr tr-attribs
         (string-concatenate (map (lambda (e) (tag 'td '() e)) row)))))

(define (render-table table . ids)
  (let ((columns (table-columns table))
        (data (table-data table))
        (f-row (if (null? ids)
                   render-table-row
                   (let ((f (id-generator (map symbol->string (car ids)))))
                     (lambda (e)
                       (render-table-row e (f)))))))
    (tag 'table '() (string-join (map f-row data) "\n"))))

And here is a little test function:

(print-ln (render-table (make-table
                         '("a" "b" "c")
                         '(("1" "2" "3")
                           ("4" "5" "6")
                           ("7" "8" "9")))
                        '(id0 id1)))

I’m not really happy with the interface yet so maybe I’ll look at fixing that next time along with passing data from one page to the next and sorting based on the columns.

Postscript: Danny Yoo mentioned an xml library I need to look into to see if it will replace (tag …) and related functions. The uri-codec library replaces a lot of the code from the earlier article.

(define *encodings-list*
  '((%20 " ")
    (+a  "&")
    (+e  "=")
    (+p  "+")
    (+q  "\"")
    (+r  "\r\n")))

(define *hash* (make-hash-table 'equal))

(for-each (lambda (e)
            (let ((k (symbol->string (car e)))
                  (v (second e)))
              (hash-table-put! *hash* k v)
              (hash-table-put! *hash* v k)))
          *encodings-list*)

(define (encode-chars regex s)
  (pregexp-replace* regex s
                    (lambda (k)
                      (hash-table-get *hash* k))))

The data-encode and data-decode functions also become simpler as they now use the uri-encode and uri-decode functions.

(define (data-encode data)
  (let ((i (open-input-string data))
        (o (open-output-bytes)))
    (deflate i o)
    (let ((r (base64-encode (get-output-bytes o))))
      (uri-encode (bytes->string/utf-8
                   (subbytes r 0 (- (bytes-length r) 2)))))))

(define (data-decode data)
  (let ((i (open-input-bytes
            (base64-decode
             (string->bytes/utf-8
              (uri-decode data)))))
        (o (open-output-string)))
    (inflate i o)
    (get-output-string o)))

Read Full Post »

Last time we were looking at encoding data. HTML has a nice way of encoding its special characters, e.g. < and > are mapped to &lt; and &gt; We can do something similar. Important characters to encode are quote, equals, ampersand and maybe a few others. Then we have to decide on a character for encoding – I like plus (+) as it doesn’t look like a special character to my eyes. As we are not planning for the future, plus and a single character should do.

First of all list all the encodings.

(define *encodings-list*
  '((+s " ")
    (+a "&")
    (+e "=")
    (+p "+")
    (+q "\"")
    (+r "\r\n")))

Then store the encodings and the reverse encodings in a hash.

(define *hash* (make-hash-table 'equal))

(for-each (lambda (e)
            (let ((k (symbol->string (car e)))
                  (v (second e)))
              (hash-table-put! *hash* k v)
              (hash-table-put! *hash* v k)))
          *encodings-list*)

pregexp-replace* is perfect for encoding and decoding.

(define (encode-chars regex s)
  (pregexp-replace* regex s
                    (lambda (k)
                      (hash-table-get *hash* k))))

This would be called like

(encode-chars "[+ &\"]|\r\n" "<a string>")

I’ve decided to compress and base64 encode my data in case it becomes really big.

(define (data-encode data)
  (let ((i (open-input-string data))
        (o (open-output-bytes)))
    (deflate i o)
    (let ((r (base64-encode (get-output-bytes o))))
      (encode-chars "[+=]|\r\n"
                    (bytes->string/utf-8
                     (subbytes r 0 (- (bytes-length r) 2)))))))

We also need a decoder that performs the inverse operation.

(define (data-decode data)
  (let ((i (open-input-bytes
            (base64-decode
             (string->bytes/utf-8
              (encode-chars "\\+." data)))))
        (o (open-output-string)))
    (inflate i o)
    (get-output-string o)))

And finally, my url looks reasonable:

(print-ln "<a href=\"ser.scm?data="
          (data-encode (object->string *data*))
          "\">next page</a><br/>")

Does decode perform the inverse of encode?

(print-ln (data-decode (data-encode (object->string *data*))))

which gives:

> (("Task" "Monday" "Tuesday" "Wednesday") ("Cooking" "1hr" "1hr" "2hrs"))

The encoded data itself looks like this:

> "BcExCsAgDEDRq4Q/mdFeoXM3oXMgUougYOjg7fteShSLjnDN4bYRylfDbSPc1UcNt41K4pyz+rv+pNByG0h5LYQjrYC1R8+e"

I fixed print-ln too – display is for human-readable stuff, print is for the computer. Next time we will have to extract the data from the query string, load the data into a variable (this shouldn’t be too difficult) and think about rendering the table. For anyone following along at home, the full script is as follows:

#!mzscheme -mqf

(require (lib "1.ss" "srfi")
         (lib "pregexp.ss")
         (lib "base64.ss" "net")
         (lib "deflate.ss")
         (lib "inflate.ss"))

(define-struct table-data (columns data))

(define (print-ln . args)
  (for-each display args)
  (newline))

(define (header type)
  (string-append "Content-type: " type "; charset=iso-8859-1~n~n"))

(printf (header "text/html"))

(define *encodings-list*
  '((%20 " ")
    (+a  "&")
    (+e  "=")
    (+p  "+")
    (+q  "\"")
    (+r  "\r\n")))

(define *hash* (make-hash-table 'equal))

(for-each (lambda (e)
            (let ((k (symbol->string (car e)))
                  (v (second e)))
              (hash-table-put! *hash* k v)
              (hash-table-put! *hash* v k)))
          *encodings-list*)

(define (blank-if-null s) (if (string? s) s ""))
(define *query-string* (blank-if-null (getenv "QUERY_STRING")))

(when (> (string-length *query-string*) 0)
      (printf "[~a]<br/>~n" *query-string*))

(define (string->object s)
  (read (open-input-string s)))

(define (object->string o)
  (let ((string-port (open-output-string)))
    (write o string-port)
    (get-output-string string-port)))

(define (manifest-string-encode s)
  (pregexp-replace* "'" s "\""))

(define (manifest-string->data s)
  (string->object (manifest-string-encode s)))

(define *data* #f)

(set! *data*
      (manifest-string->data
       "(('Task' 'Monday' 'Tuesday' 'Wednesday')
         ('Cooking' '1hr' '1hr' '2hrs'))"))

(define (encode-chars regex s)
  (pregexp-replace* regex s
                    (lambda (k)
                      (hash-table-get *hash* k))))

(define (data-encode data)
  (let ((i (open-input-string data))
        (o (open-output-bytes)))
    (deflate i o)
    (let ((r (base64-encode (get-output-bytes o))))
      (encode-chars "[+=]|\r\n"
                    (bytes->string/utf-8
                     (subbytes r 0 (- (bytes-length r) 2)))))))

(define (data-decode data)
  (let ((i (open-input-bytes
            (base64-decode
             (string->bytes/utf-8
              (encode-chars "\\+." data)))))
        (o (open-output-string)))
    (inflate i o)
    (get-output-string o)))

(print-ln "<a href=\"ser.scm?data="
          (data-encode (object->string *data*))
          "\">next page</a><br/>")

(print-ln "<a href=\"ser.scm\">Restart</a><br>")

(print-ln (data-decode (data-encode (object->string *data*))))

(exit)

Read Full Post »

Seaside has inspired me to try to write a basic HTML/CGI based grid style widget. In Seaside, that widget is called WATableReport which is described here and provides column sorting as is available in most decent GUI widget sets. My web-fu is a little rusty. Last time I was writing web code was back in the dark ages pre-servlets and nice session managing frameworks using pure CGI. This may well be available somewhere already but what the heck, let’s get started…

First of all, we need a data-type for the table data. For now we will keep it simple and just have the column names and the data which will probably be a list of lists.

(define-struct table-data (columns data))

We will need to serialise the data so we can pass it to another page through the query string. I briefly toyed with the idea of having some custom format of lists of comma seperated values surrounded by square brackets. e.g.

[Task, Monday, Tuesday, Wednesday],
[Cooking, 1hr, 1hr, 2hrs],
...

The parser tools supplied with PLT Scheme would make this fairly straight-forward. Even easier is using the read and print functions so we will go with that. I also want to be able to define a whole package of data for testing purposes and escaping every quote will be a pain so let me allow single quotes too. I had a look in the Scheme Cookbook for a simple way to transform characters within a string. string-map from srfi-13 offered a possibility, but we will almost certainly want something more powerful later so we might as well start with regexes.

(require (lib "pregexp.ss"))

(define (string-encode s)
  (pregexp-replace* "'" s "\""))

Together with a function to convert strings to scheme objects we can provide a convenience function for converting manifest strings into our data.

(define (string->object s)
  (read (open-input-string s)))

(define (string->data s)
  (string->object (string-encode s)))

(define *data* #f)

(set! *data*
      (string->data
       "(('Task' 'Monday' 'Tuesday' 'Wednesday')
         ('Cooking' '1hr' '1hr' '2hrs'))"))

Next time we will look at encoding the data so we can pass it through the query string. At the moment, we will have a small problem with quotes and a few other characters…

(define (print-ln . args)
  (for-each print args)
  (newline))

(print-ln "<a href=\"ser.scm?data=" *data* "\">next page</a>")

> "<a href=\"ser.scm?data="(("Task" "Monday" "Tuesday" "Wednesday") ("Cooking" "1hr" "1hr" "2hrs"))"\">next page</a>"

Read Full Post »

After fiddling around for a couple of minutes I found the correct incantation to get cgi scripts to work with Windows Apache. It uses the traditional Unix hash-bang line. Here we have a nice little hello world cgi:

#!mzscheme -mqf

(define *query-string* (getenv "QUERY_STRING"))

(define (header type)
  (string-append "Content-type: " type "; charset=iso-8859-1~n~n"))

(printf (header "text/html"))
(printf "Hello World~n")

(when *query-string*
      (printf "[~a]~n" *query-string*))

(exit)

But why bother with CGI when there are all these wonderful frameworks around? Isn’t that old-school? Well, I’ve been inspired by something in Seaside. I’m not thinking of porting the whole framework, no way. If I wanted to, then why not just use Seaside? No, I want to try something much smaller.

Read Full Post »

PLT Scheme provides a graphical toolkit for implementing GUIs called MrEd. At least on Windows, the result looks like a native application and was used to implement the IDE, DrScheme. As usual, the documentation is excellent.

When an application is running, it can be useful for it to output diagnostics that report on what it is currently doing, e.g. which database it connected to, or the id of a transaction that may have failed. This is normally output to a file, but it can also copy the output to a logging window, e.g. the Transcripter in Squeak, or the Java Web Start Console. How easy is it to implement a simple transcripter in PLT Scheme?

As usual, it is a good idea to decide on your API first as encapsulating everything behind an API means that we can easily change the implementation later on. I will simply provide a function (log s) where s is a string but you would probably want to have various logging levels which can be enabled or disabled at runtime.

(require (lib "42.ss" "srfi"))

;; First of all, create a text area inside a window (frame)

(define *frame* (instantiate frame% ("Transcript")))

(define *text* (instantiate text-field% ()
                 (label "")
                 (style '(multiple))
                 (parent *frame*)))

;; We need the editor belonging to the text area in order to append text to it

(define *editor* (send *text* get-editor))

;; The 'API' for accessing the Transcripter
;; This is a somewhat unrealistic implementation, but good enough for a quick example
(define (log s) (send *editor* insert s))

;; A test method, displaying 200 numbers on the transcripter
;; - this is the same as we did in Squeak

(define (200-nums)
  (time
   (do-ec (:range i 1 201)
          (log (string-append (number->string i) "n")))))

(instantiate button% ()
  (label "Execute")
  (parent *frame*)
  (callback (lambda (button event)
              (200-nums))))

(send *frame* show #t)

A couple of things. First of all, performance: When I ran this initially, the display numbers test took ~60ms. However, when I expanded the Transcripter window to a reasonable size, it took ~2000ms (2 seconds!) When I retried the same in Squeak it took around 5700ms although I’m certain it had earlier taken more than 10 seconds. This is a different computer and a different image but maybe the Squeak Transcripter isn’t so bad after all.

Secondly, it was fairly straight-forward to construct the GUI. Of course, such a simple example doesn’t really give any idea how hard it is to use MrEd to create moderately complex GUIs, but the existence of DrScheme indicates that it is at least possible.

Read Full Post »

Older Posts »

Follow

Get every new post delivered to your Inbox.