Jogo para iPhone em Scheme

O Scheme hacker Alex Queiroz implementou o jogo Reverso para iPhone. Os comentários de Alex sobre a implementação do jogo estão em http://www.ventonegro.org/2009/10/scheme-hits-the-app-store/.

Certamente uma aplicação muito interessante da linguagem. Alex utilizou a implementação Gambit (assim como Chicken, compila Scheme para C) e diz que o código resultante é 90% Scheme e 10% Objective-C.

web-scheme para Chicken 4

Vou aproveitar a transição de versões do sistema Chicken (versão 3 -> versão 4, com algumas incompatibilidades) para lançar uma versão nova de web-scheme, totalmente incompatível com a versão anterior (para Chicken 3). Eu mesmo provavelmente serei o maior prejudicado pelas incompatibilidades. Sem exagero, devo ter algumas dezenas de milhares de linhas de código usando web-scheme e Chicken 3. Mas o momento é esse.

Se bem me lembro, a extensão web-scheme foi lançada em 2005 e, desde então, venho pensando em algumas melhorias que só podem ser implementadas quebrando a compatibilidade com versões anteriores. Como Chicken 4 de certa forma faz isso, vou aproveitar a onda. :-)

As duas maiores modificações são sintáticas.

Uma das coisas que me incomodam em web-scheme para Chicken 3 é o mapeamento direto de nomes de tags para procedimentos. Inicialmente me pareceu uma boa idéia, e na maioria dos casos é, mas há situações que tornam esse aspecto inconveniente. Por exemplo, o procedimento equivalente à tag map, deveria, a rigor, ser map. Obviamente isso causa problemas em Scheme.

Casos semelhantes ocorrem com tags com nomes muito usuais como select (Chicken define uma macro com esse nome), title, i ou object.

Em Chicken 4 há a possibilidade de se importar um módulo prefixando símbolos do módulo importado. Então, por exemplo, seria possível importar o módulo web-scheme prefixando os procedimentos por ws:. Nos casos como o do procedimento map, não usar um prefixo seria suicídio. É difícil algum código em Scheme não fazer uso de map. web-scheme para Chicken 3 coloca "de fábrica" o prefixo ws: nos procedimentos map e select, para evitar conflito de nomes com os respectivos procedimento e macro correspondentes. Isso já é meio feio em Chicken 3, em que não há uma forma direta para se importar uma biblioteca de extensão com um prefixo -- em Chicken 4 seria muito feio, pois se o usuário decide prefixar os símbolos do módulo, ficarão dois prefixos para map e select!

Decidi, então, modificar o nome de todos os procedimentos correspondentes a tags HTML e usar uma notação semelhante à usada por Hop. Assim, em vez de (pre "texto"), tem-se (<pre> "texto").

Não estou totalmente satisfeito com esta notação, pois é conflitante com a convenção de nomes de classes quando se usa um sistema de objetos. Em Scheme não chega a ser um grande problema, pois o uso de classes não é muito usual. Em Common Lisp essa decisão seria mais problemática, pois CLOS é bastante usado. Optei por essa sitaxe porque claramente lembra a sintaxe de tags HTML e provavelmente desenvolvedores para a Web associarão <pre> à tag pre de HTML e não à classe pre de algum código parte de um sistema de objetos.

A outra modificação é com relação à sintaxe para atributos e valores de atributos de tags. Em web-scheme para Chicken 3 usa-se da seguinte forma:

(a 'href "http://minha-url.com" "Minha URL")

Em web-scheme para Chicken 4 decidi usar parâmetros por palavra-chave para representar atributos. Fica, então, assim:

(<a> href: "http://minha-url.com" "Minha URL")

As razões para esta mudaça são puramente técnicas. No esquema usado em web-scheme para Chicken 3, precisei implementar um parser para extrair atributos e seus respectivos valores. Usando parâmetros por palavra-chave, ganho o parser "de brinde" de Chicken, melhor e mais rápido.

O esquema de atributos usado por web-scheme para Chicken 3 tem uma limitação chata quando espera-se poder usar ou não atributos em função do fluxo de execução do código. Exemplo: no caso de um procedimento text-input como um wrapper para o elemento input de tipo texto:

(define (text-input text #!key maxlength)
     (if maxlength
       (input 'type "text" 'maxlength maxlength 'value text)
       (input 'type "text" 'value text)))

Em web-scheme para Chicken 3 não há uma forma "fácil" (i.e., sem eval ou macros) de fazer isso sem duplicar código. Em web-scheme para Chicken 4 bastará:

(define (text-input text #!key maxlength)
    (<input> type: "text" maxlength: maxlength value: text)

O uso de parâmetros por palavra-chave dá essa flexibilidade, o que é tratado internamente pelo código que gera o HTML. Se o valor de um parâmetro for #f o par atributo/valor não é gerado. Em web-scheme para Chicken 3 geraria uma certa complicação nos casos de atributos que não requerem valor, como selected em elementos select.

Essas serão as modificações mais radicais. Haverá também modificações nos procedimentos extras de web-scheme, os quais não estão diretamente relacionados ao mapeamento tags->procedimentos. Mas essa parte ainda está em estudo.

Fatiamento de seqüências em Scheme

Python oferece uma funcionalidade interessante para ser usadas com seqüências (string, listas e qualquer objeto com o método __getslice__, suponho). O fatiamento de Python admite índices negativos, omissão de índices e índices maiores que o tamanho da seqüência.

Exemplos:

>>> "abcdef"[3:6]
'def'
>>> [1, 2, 3, 4, 5][:3]
[1, 2, 3]
>>> [1,2,3,4,5][:-3]
[1, 2]
>>> [1,2,3,4,5][-3:]
[3, 4, 5]
>>> [1,2,3,4,5][-10:]
[1, 2, 3, 4, 5]

A seguir está uma implementação de algo parecido para Chicken, que funciona com listas, vetores, strings e permite a adição de fatiadores personalizados para o procedimento slice.

#!/usr/bin/csi -script

(use (srfi 1 13))

(define slice
 (let ()
   (define (positive? n) (> n 0))
   (define (negative? n) (< n 0))
   (define (both-positive? n m) (and n m (>= n 0) (>= m 0)))
 
   (define (from/to from to len)
     (cond
      ((and from (> from len))         ; [XXX:2]
        #f)
      ((and (both-positive? from to)   ; [1:2]
             from to
            (> to from)
            (< to len))
       (cons from to))
      ((and (both-positive? from to)   ; [1:XXX]
             from to
            (> to from)
            (>= to len))
       (cons from len))
      ((and (both-positive? from to)   ; [2:1]
             from to
            (> from to))
       #f)
      ((and from                       ; [-1:]
             (< from 0)
            (not to))
       (cons (if (>= (abs from) len)
                 0
                 (+ len from))
             len))
      ((and (not from)                 ; [:-1]
             to
            (< to 0))
       (cons 0
             (if (>= (abs to) len)
                 len
                 (+ len to))))
      ((and from                       ; [1:]
             (>= from 0)
            (not to))
       (cons from len))
      ((and from to                    ; [-2:-1]
             (< from 0)
            (< to 0)
            (< to from))
       #f)
      ((and from to                    ; [-1:-2]
             (< from 0)
            (< to 0))
       (cons (if (>= (abs from) len)
                 0
                 (+ len from))
             (if (>= (abs to) len)
                 len
                 (+ len to))))      
      (else #f)))

   (define (generic-slicer obj from to ruler empty obj-slicer)
     (let* ((len (ruler obj))
            (from&to (from/to from to len))
            (from (and from&to (car from&to)))
            (to (and from&to (cdr from&to))))
       (if (and from to)
           (obj-slicer obj from to)
           empty)))

   (define (string-slice s from to)
     (generic-slicer s from to string-length "" substring))

   (define (list-slice l from to)
     (generic-slicer l from to length '()
                     (lambda (l from to)
                       (take (drop l from) (- to from)))))

   (define (vector-slice v from to)
     (define (subvector vector start end)
       (let ((sub (make-vector (- end start))))
         (let loop ((i 0))
           (if (< i (- end start))
               (begin (vector-set! sub i (vector-ref vector (+ i start)))
                      (loop (+ i 1)))))
         sub))
     (generic-slicer v from to vector-length '#() subvector))


   (let ((slicers
          (list (lambda (obj)
                  (and (string? obj)
                       string-slice))
                (lambda (obj)
                  (and (vector? obj)
                       vector-slice))
                (lambda (obj)
                  (and (list? obj)
                       list-slice)))))
     (lambda (obj #!optional from to)
       (if (procedure? obj)
           (set! slicers (cons obj slicers))
           (let loop ((slicers slicers))
             (if (null? slicers)
                 (error "No slicer for the given object.")
                 (let* ((slicer (car slicers))
                        (slice (slicer obj)))
                   (if slice
                       (slice obj from to)
                       (loop (cdr slicers)))))))))))

Abaixo está o arquivo de teste do código de fatiamento (usando a extensão test), o qual também serve como exemplo de uso.

#!/usr/bin/csi -script

(use test)

(load "slice.scm")

;;;
;;; Strings
;;;
(define s "1234567")

(display "s = ")
(pp s)
(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "1" (slice s 0 1))
(test "" (slice s 10 10))
(test "1234567" (slice s 0 10))
(test "" (slice s 10 0))

(test "1234567" (slice s 0))
(test "7" (slice s -1))
(test "" (slice s 10))
(test "1234567" (slice s -10))
(test "4567" (slice s -4))

(test "" (slice s -4 -4))
(test "45" (slice s -4 -2))
(test "" (slice s -4 -10))
(test "123" (slice s -10 -4))


;;;
;;; Lists
;;;
(define l '(1 2 3 4 5 6 7))

(newline)
(display "l = ")
(pp l)

(test '() (slice l 0 0))
(test '() (slice l 1 0))
(test '(1) (slice l 0 1))
(test '(2 3) (slice l 1 3))
(test '() (slice l 10 10))
(test '(1 2 3 4 5 6 7) (slice l 0 10))
(test '() (slice l 10 0))

(test '(1 2 3 4 5 6 7) (slice l 0))
(test '(7) (slice l -1))
(test '() (slice l 10))
(test '(1 2 3 4 5 6 7) (slice l -10))
(test '(4 5 6 7) (slice l -4))

(test '() (slice l -4 -4))
(test '(4 5) (slice l -4 -2))
(test '() (slice l -4 -10))
(test '(1 2 3) (slice l -10 -4))

;;;
;;; Vectors
;;;
(define v '#(1 2 3 4 5 6 7))

(newline)
(display "v = ")
(pp v)

(test '#() (slice v 0 0))
(test '#() (slice v 1 0))
(test '#(1) (slice v 0 1))
(test '#(2 3) (slice v 1 3))
(test '#() (slice v 10 10))
(test '#(1 2 3 4 5 6 7) (slice v 0 10))
(test '#() (slice v 10 0))

(test '#(1 2 3 4 5 6 7) (slice v 0))
(test '#(7) (slice v -1))
(test '#() (slice v 10))
(test '#(1 2 3 4 5 6 7) (slice v -10))
(test '#(4 5 6 7) (slice v -4))

(test '#() (slice v -4 -4))
(test '#(4 5) (slice v -4 -2))
(test '#() (slice v -4 -10))
(test '#(1 2 3) (slice v -10 -4))

;;;
;;; Custom object
;;;
(define-record custom-string text)

(define s (make-custom-string "custom string"))
(slice (lambda (obj)
        (and (custom-string? obj)
             (lambda (obj from to)
               (handle-exceptions
                exn
                ""
                (substring (custom-string-text obj) from to))))))

(newline)
(display "s = ")
(pp s)

(test "" (slice s 0 0))
(test "" (slice s 1 0))
(test "c" (slice s 0 1))

A seguir está a saída da execução do programa de teste:

s = "1234567"
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]
(slice s 10 10) ................................ [ PASS]
(slice s 0 10) ................................. [ PASS]
(slice s 10 0) ................................. [ PASS]
(slice s 0) .................................... [ PASS]
(slice s -1) ................................... [ PASS]
(slice s 10) ................................... [ PASS]
(slice s -10) .................................. [ PASS]
(slice s -4) ................................... [ PASS]
(slice s -4 -4) ................................ [ PASS]
(slice s -4 -2) ................................ [ PASS]
(slice s -4 -10) ............................... [ PASS]
(slice s -10 -4) ............................... [ PASS]

l = (1 2 3 4 5 6 7)
(slice l 0 0) .................................. [ PASS]
(slice l 1 0) .................................. [ PASS]
(slice l 0 1) .................................. [ PASS]
(slice l 1 3) .................................. [ PASS]
(slice l 10 10) ................................ [ PASS]
(slice l 0 10) ................................. [ PASS]
(slice l 10 0) ................................. [ PASS]
(slice l 0) .................................... [ PASS]
(slice l -1) ................................... [ PASS]
(slice l 10) ................................... [ PASS]
(slice l -10) .................................. [ PASS]
(slice l -4) ................................... [ PASS]
(slice l -4 -4) ................................ [ PASS]
(slice l -4 -2) ................................ [ PASS]
(slice l -4 -10) ............................... [ PASS]
(slice l -10 -4) ............................... [ PASS]

v = #(1 2 3 4 5 6 7)
(slice v 0 0) .................................. [ PASS]
(slice v 1 0) .................................. [ PASS]
(slice v 0 1) .................................. [ PASS]
(slice v 1 3) .................................. [ PASS]
(slice v 10 10) ................................ [ PASS]
(slice v 0 10) ................................. [ PASS]
(slice v 10 0) ................................. [ PASS]
(slice v 0) .................................... [ PASS]
(slice v -1) ................................... [ PASS]
(slice v 10) ................................... [ PASS]
(slice v -10) .................................. [ PASS]
(slice v -4) ................................... [ PASS]
(slice v -4 -4) ................................ [ PASS]
(slice v -4 -2) ................................ [ PASS]
(slice v -4 -10) ............................... [ PASS]
(slice v -10 -4) ............................... [ PASS]

s = #<custom-string>
(slice s 0 0) .................................. [ PASS]
(slice s 1 0) .................................. [ PASS]
(slice s 0 1) .................................. [ PASS]

Spam via telefone

Como se não bastasse a praga de spams que assola o mundo dos e-mails, há algum tempo venho recebendo propagandas não solicitadas da própria companhia telefônica (TIM) -- tanto através de SMS como, ultimamente, por ligações e mensagens de voz.

Hoje decidi ligar para a TIM para ver se conseguia me livrar desse transtorno. O atendente me disse que não é possível desativar esse "serviço" e sugeriu que eu mandasse um e-mail para a ouvidoria TIM, cujo endereço estaria disponível no site da empresa. Quando eu disse que não faria por medo de começar a receber spam da TIM por e-mail também, ele mesmo deu uma risada discreta, como se estivesse pensando "ele tem razão, é muita burrice fazer isso".

Do fundo do baú

Em algum outro baú, mais fundo, devo ter as apostilas dos cursos. :-)

Disparador de programas para Sawfish

Havia tempos que eu queria um disparador de aplicações para usar com o Sawfish. Nunca tinha encontrado um que tivesse me agradado. Basicamente, gostaria de um que fosse simples, permitisse completar o nome de programas com TAB, que fosse rápido e que não ocupasse muita memória. Com uma rápida pesquisa na Internet, achei o código em http://www.skamphausen.de/cgi-bin/ska/download/runner.jl, o qual faz exatamente o que eu queria e satisfaz todos os meus requisitos: como é implementado em rep, não é preciso nem criar um novo processo; e a implementação é minúscula.

Depois de uma leve refatorada no código, estou usando o seguinte:

(require 'prompt)

(define (uniq l #!optional in)
  ;; Elimina replicas na lista L usando o procedimento IN para
  ;; verificar se um dado elemento se encontra na lista.
  (let ((unique '()))
    (let loop ((l l))
      (if (null l)
          unique
          (let ((head (car l)))
            (unless ((or in member) head unique)
              (setq unique (cons head unique)))
            (loop (cdr l)))))
    (reverse unique)))

(define runner
  (let* ((paths (uniq (delete-if-not file-directory-p
         (string-split ":" (getenv "PATH")))))
  (completions (uniq (apply append (mapcar directory-files paths)))))
    (lambda ()
      (interactive)
      (let ((cmd (prompt-from-list completions "Run: " "" t)))
 (system (concat cmd " &"))))))

Adicionei o procedimento uniq para eliminar eventuais réplicas na lista de comandos. Ela é mais flexível que uniquify-list, do Sawfish (a comparação é feita exclusivamente usando eq). uniq aceita um argumento opcional que é o procedimento de comparação (em caso de omissão, usa member).

O procedimento runner monta uma lista de elementos para serem usados como possíveis alternativas para completar palavras digitadas pelo usuário (tab completion), a qual é usada por prompt-from-list, do módulo prompt. As alternativas são os arquivos nos diretórios apontados pela variável de ambiente PATH.

Associei o procedimento runner à combinação de teclas H-RET (Hyper-Enter):

(bind-keys global-keymap
...
   "H-RET"  (lambda () (runner))
...)

A seguir está um screenshot:



O prompt criado pelo procedimento prompt-from-list define um mapa de teclas. Assim, quando em uso, o prompt aceita as seguintes combinações de teclas associadas a procedimentos (de prompt.jl, so Sawfish):

(bind-keys prompt-keymap
     "ESC" prompt-exit
     "C-g" prompt-exit
     "C-u" prompt-clear
     "BS" prompt-backspace
     "C-k" prompt-kill-line
     "Left" prompt-backward-character
     "C-b" prompt-backward-character
     "Right" prompt-forward-character
     "C-f" prompt-forward-character
     "C-Left" prompt-backward-word
     "M-b" prompt-backward-word
     "A-b" prompt-backward-word
     "C-Right" prompt-forward-word
     "M-f" prompt-forward-word
     "A-f" prompt-forward-word
     "C-a" prompt-beginning-of-line
     "C-e" prompt-end-of-line
     "TAB" prompt-complete
     "RET" prompt-accept
     "Up" prompt-previous
     "Down" prompt-next
     "M-n" prompt-next
     "M-p" prompt-previous
     "A-n" prompt-next
     "A-p" prompt-previous))

Sawfish

O Sawfish é um dos softwares da lista dos que eu não gostaria de parar de usar. Assim como o Emacs, é o tipo de software que, depois que se entende e aprende a usar, é difícil de largar.

O Sawfish durante algum tempo foi o gerenciador de janelas do ambiente de desktop Gnome. Por razões ainda não muito claras para mim, foi substituído pelo Metacity.

Assim como o Emacs, um dos grandes diferenciais do Sawfish é o fato de ser programável em uma linguagem de alto nível da família Lisp. Sawfish usa a linguagem rep (Read, Eval, Print), a qual inicialmente foi inspirada por Elisp (Emacs Lisp). A concepção do Sawfish segue a mesma linha do Emacs: prover uma API em uma linguagem de alto nível para desenvolvimento voltado às aplicações a que se destina (abstração). Manipulação de texto no caso do Emacs e gerenciamento de janelas no caso do Sawfish. Com base na API de alto nível, os aplicativos são desenvolvidos. Assim são desenvolvidos o Emacs e o Sawfish. A maior parte do código do Emacs é em Elisp e a maior parte do código do Sawfish é em rep.

O fato de prover uma API para desenvolvimento em uma linguagem de alto nível faz com que o Sawfish seja altamente (e facilmente!) personalizável e extensível. Além das possibilidades de configuração e extensão através de código em rep, Sawfish também dispõe de um configurador gráfico, o qual, por baixo dos panos, apenas gera e executa código rep para configurar o gerenciador de janelas (similar à interface para personalização do Emacs).



Seguindo a tradição de linguagens Lisp e de aplicativos que usam Lisp como linguagem de extensão/implementacao, Sawfish também oferece um REPL para avaliação de expressões rep. Abaixo está um exemplo de sessão com o REPL do Sawfish:

$ sawfish-client
sawfish 1.3.3, Copyright (C) 1999-2000 John Harper
sawfish comes with ABSOLUTELY NO WARRANTY; for details see the file COPYING

Enter `,help' to list commands.
user> (define emacs (get-window-by-name-re "emacs.*"))
user> emacs
#<window 1e00011>
user> (window-name emacs)
"emacs@mandolate"
user> (window-visible-p emacs)
t
user> (window-iconified-p emacs)
()
user> (window-dimensions emacs)
(798 . 742)
user> (window-border-width emacs)
0
user> (window-framed-p emacs)
t
user> (window-depth emacs)
0
user> (window-absolute-position emacs)
(68 . 0)
user> (window-sticky-p emacs)
()
user> (move-window-to emacs 200 100)
#<window 1e00011>
user> (window-absolute-position emacs)
(200 . 100)

O Manual de Programação do Sawfish documenta a API para programação e extensão do gerenciador de janelas.

Abaixo está um screenshot com temas pouco usuais do sawfish (cada janela pode ser decorada com um tema diferente).



A seguir está um exemplo de aplicação feita na linguagem de extensão do Sawfish. Os aplicativos no canto superior esquerdo da tela são dockapps (aqui há vários deles). Quando um dockapp é executado em um gerenciador de janelas sem suporte a dock, o aplicativo é mostrado como uma janela normal, com bordas, decorações e respondendo a eventos como qualquer outra janela. Quando o gerenciador de janelas oferece suporte a dockapps, ou quando se usa um programa externo para gerenciar dockapps, eles são mostrados como no screenshot e têm comportamento diferenciado (são exibidos em todas as áreas de trabalho, não são cobertos por outras janelas quando elas são maximizadas etc).



A extensão para gerenciamento de dockapps pode ser obtida em http://paginas.ucpel.tche.br/~mario/english/utils/sawdock/.