Outdated egg!

This is an egg for CHICKEN 4, the unsupported old release. You're almost certainly looking for the CHICKEN 5 version of this egg, if it exists.

If it does not exist, there may be equivalent functionality provided by another egg; have a look at the egg index. Otherwise, please consider porting this egg to the current version of CHICKEN.

eggs

Outdated egg!
rfb

This extension provides a basic implementation of the Remote Framebuffer Protocol (http://tools.ietf.org/rfc/rfc6143.txt). Both a server and a client is available, but currently only Raw and CopyRect encoding is supported.

Security types are currently not supported and authentification is not provided.

Procedures

Connection managment

rfb-server

[procedure] (rfb-server #!key (port 5900) access (name "rfb"))

Creates a TCP socket and waits for clients to connect on the given port. Returns an rfb-session object if a connection could be established.

rfb-connect

[procedure] (rfb-connect HOSTNAME #!key (port 5900) shared)

Connects to an RFB server on the given host and port. If shared is given and true, then this requests a non-exclusive connection, where other clients are allowed to share this session. Returns an rfb-session when the connection could be established.

rfb-close

[procedure] (rfb-close RFBSESSION)

Closes an RFB client- or server connection.

Sending and receiving messages

Server messages

read-client-message

[procedure] (read-client-message RFBSESSION)

Waits for a message from an RFB client and returns an s-expression representing the message or end-of-file if the connection was closed.

Client messages may be any of the following:

Message	Meaning
(SetPixelFormat PIXELFORMAT)	Client request to change the pixel format to the one given in the contained pixel-format object
(SetEncodingType INTEGER ...)	Client request to change the current encoding type
(FramebufferUpdateRequest INCREMENTAL? X Y W H)	Client request for changes covering the designated area
(KeyEvent DOWN? KEYCODE)	Key-up/down event
(PointerEvent BUTTONMASK X Y)	Mouse and/or Mousebutton event
(ClientCutText STRING)	Request to copy string to clipboard

framebuffer-update-rectangle

[procedure] (framebuffer-update-rectangle RFBSESSION RECTANGLE)

Sends a FramebufferUpdateRequest to the client. RECTANGLE should be a rectangle object as returned by rectangle (see below).

framebuffer-update-rectangles

[procedure] (framebuffer-update-rectangles RFBSESSION RECTANGLELIST)

Sends a list of rectangles to the client.

set-colour-map-entries

[procedure] (set-colour-map-entries RFBSESSION U16VECTOR #!optional (first 0))

Sends a request to change an entry in the colour map of the client.

bell

[procedure] (bell RFBSESSION)

Asks the client to ring the bell.

server-cut-text

[procedure] (server-cut-text RFBSESSION STRING)

Copies a string to the client's clipboard.

Client messages

read-server-message

[procedure] (read-server-message RFBSESSION)

Waits for a message from an RFB server and resturns an s-expression representing the message or end-of-file if the connection was closed.

Server messages may be any of the following:

Message	Meaning
(FramebufferUpdate RECT ...)	Sends a list of rectangles to be updated, see brlow for a description of RECT
(SetColourMapEntries INDEX U16VECTOR)	Server request to change the entries in the colour-map to the RGB values given in the vector, starting at colour-index INDEX
(Bell)	Server request to the ring bell
(ServerCutText STRING)	Text pasted from clipboard

A RECT sent via a framebuffer update request has one of the following forms:

(Raw #(X Y W H U8VECTOR)): A bitmap in "Raw" encoding with given position, shape and data
(CopyRect #(X Y W H X2 Y2)): A request to copy the bitmap with the given position and size to position X2/Y2

Other encoding types can be handled using the register-encoding-type procedure (see below).

set-pixel-format

[procedure] (set-pixel-format RFBSESSION PIXELFORMAT)

Requests to change the pixel format to PIXELFORMAT, which should be a pixel-format object as returned by pixel-format (see below).

set-encoding-type

[procedure] (set-encoding-type RFBSESSION INTEGER)

Requests to change the default encoding type.

framebuffer-update-request

[procedure] (framebuffer-update-request RFBSESSION X Y W H #!optional (incremental #t))

Requests an update for the given framebuffer area, optionally asking only for incremental changes.

key-event

[procedure] (key-event RFBSESSION KEYCODE #!optional (down #t))

Sends a key-up/down event to the server.

pointer-event

[procedure] (pointer-event RFBSESSION BUTTONMASK X Y)

Sends a mouse move or button event to the server.

client-cut-text

[procedure] (client-cut-text RFBSESSION STRING)

Copies a string to the server's clipboard.

Encoding types

encoding-type

[procedure] (encoding-type SYMBOL)

Returns the integer code of the encoding type designated by SYMBOL. Predefined encoding type names are:

Name	Encoding type
Raw	0
CopyRect	1
RRE	02
Hextile	5
TRLE	15
ZRLE	16
Cursor	-239
DesktopSize	-223

Other encoding types can be defined by register-encoding-type (see below).

encoding-type-name

[procedure] (encoding-type-name INTEGER)

Returns the name associated with the encoding type code.

register-encodiing-type

[procedure] (register-encoding-type INTEGER SYMBOL DECODER)

Defines a custom encoding type with the given code and name. DECODER should be a procedure and will be called in an RFB client when a server sends data of this type. The procedure should take a single argument, the port from which the data should be read. The returned value will be added to a (FramebufferUpdate ...) message expression and returned when the server message is translated in a call to read-server-message.

RFB-session objects

rfb-session?

[procedure] (rfb-session? X)

Returns true if X is an rfb session object.

rfb-session-encoding-type

rfb-session-pixel-format

rfb-session-width

rfb-session-height

rfb-session-shared?

rfb-session-name

rfb-session-input-port

rfb-session-output-port

[procedure] (rfb-session-encoding-type RFBSESSION)
[procedure] (rfb-session-pixel-format RFBSESSION)
[procedure] (rfb-session-width RFBSESSION)
[procedure] (rfb-session-height RFBSESSION)
[procedure] (rfb-session-shared? RFBSESSION)
[procedure] (rfb-session-name RFBSESSION)
[procedure] (rfb-session-input-port RFBSESSION)
[procedure] (rfb-session-output-port RFBSESSION)

Accessors for the components of an RFB session object.

Pixel formats

pixel-format

[procedure] (pixel-format #!key (bits-per-pixel 32) (depth 24) (big-endian X) (true-color #t) (red-max 255) (green-max 255) (blue-max 255) (red-shift 16) (green-shift 8) (blue-shift 0))

Returns a pixel-format object representing the given pixel format. The endinanness defaults to the endianness this process is running on.

pixel-format?

[procedure] (pixel-format? X)

Returns true, if X is a pixel-format object.

pixel-format-bits-per-pixel

pixel-format-depth

pixel-format-big-endian?

pixel-format-true-color?

pixel-format-red-max

pixel-format-green-max

pixel-format-blue-max

pixel-format-red-shift

pixel-format-green-shift

pixel-format-blue-shift

[procedure] (pixel-format-bits-per-pixel PIXELFORMAT)
[procedure] (pixel-format-depth PIXELFORMAT)
[procedure] (pixel-format-big-endian? PIXELFORMAT)
[procedure] (pixel-format-true-color? PIXELFORMAT)
[procedure] (pixel-format-red-max PIXELFORMAT)
[procedure] (pixel-format-green-max PIXELFORMAT)
[procedure] (pixel-format-blue-max PIXELFORMAT)
[procedure] (pixel-format-red-shift PIXELFORMAT)
[procedure] (pixel-format-green-shift PIXELFORMAT)
[procedure] (pixel-format-blue-shift PIXELFORMAT)
[procedure] (pixel-format-bits-per-pixel PIXELFORMAT)

Accessors for the components of a pixel-format object.

;;;; life.scm


(use rfb srfi-25)

(use matchable miscmacros)

(define-values (width height cellsize)
  (let-optionals (command-line-arguments)
      ((w "100")
       (h "100")
       (cellsize "3"))
    (values (string->number w)
	    (string->number h)
	    (string->number cellsize))))

(define world (make-array (shape 0 width 0 height) #f))
(define next-world (make-array (shape 0 width 0 height) #f))
(define added '())
(define removed '())

(define (add-cell x y)
  (array-set! world x y #t)
  (array-set! next-world x y #t)
  (push! (cons x y) added))

; R-pentomino
(let ((x (quotient width 2))
      (y (quotient height 2)))
  (add-cell x y)               ;  **
  (add-cell (add1 x) y)        ; **
  (add-cell (sub1 x) (add1 y)) ;  *
  (add-cell x (add1 y)) 
  (add-cell x (+ y 2)))

(define (tick)
  (let ((live 0))
    (do ((x 0 (fx+ x 1)))
	((fx>= x width))
      (do ((y 0 (fx+ y 1)))
	  ((fx>= y height))
	(let ((now (array-ref world x y))
	      (n 0))
	  (when now (inc! live))
	  (do ((i -1 (fx+ i 1)))
	      ((fx>= i 2))
	    (do ((j -1 (fx+ j 1)))
		((fx>= j 2))
	      (when (and (or (not (zero? i)) (not (zero? j)))
			 (array-ref world (modulo (fx+ x i) width) (modulo (fx+ y j) height)))
		(set! n (fx+ n 1)))))
	  (cond (now
		 (when (or (fx< n 2) (fx> n 3))
		   (array-set! next-world x y #f)
		   (push! (cons x y) removed)))
		((eq? n 3)
		 (array-set! next-world x y #t)
		 (push! (cons x y) added))))))
    (exchange! world next-world)
    (for-each
     (match-lambda
       ((x . y) (array-set! next-world x y #t)))
     added)
    (for-each
     (match-lambda
       ((x . y) (array-set! next-world x y #f)))
     removed)
    live))

(define cell (make-u32vector (* cellsize cellsize) #xffffff))
(define empty (make-u32vector (* cellsize cellsize) 0))

(define (test)
  (let ((rs ((rfb-server) (* cellsize width) (* cellsize height))))
    (let loop ()
      (let ((m (read-client-message rs)))
	;(pp m)
	(match m
	  (('FramebufferUpdateRequest #f x y w h)
	   (framebuffer-update-rectangle
	    rs
	    (rectangle 0 0 (* width cellsize) (* height cellsize) (make-u32vector (* w h) 0))))
	  (('FramebufferUpdateRequest #t x y w h)
	   (tick)
	   (framebuffer-update-rectangles
	    rs
	    (map (match-lambda 
		   ((x . y)
		    (rectangle (fx* x cellsize) (fx* y cellsize) cellsize cellsize cell)))
		 added))
	   (framebuffer-update-rectangles
	    rs
	    (map (match-lambda 
		   ((x . y)
		    (rectangle (fx* x cellsize) (fx* y cellsize) cellsize cellsize empty)))
		 removed))
	   (set! added '())
	   (set! removed '()))
	  ((? eof-object?) (exit))
	  (('KeyEvent . _) (exit))
	  (_ #f))
	(loop)))))

(test)

You can test this against a VNC viewer, or try this client:

;;;; client.scm


(use rfb srfi-18 matchable ansi-escape-sequences extras posix miscmacros)


(define-optionals ((host "localhost") (count "100000"))
  (command-line-arguments))

(define rfb (rfb-connect host))
(thread-sleep! 1)

(print* (erase-display))

(set-pixel-format
 rfb
 (pixel-format
  bits-per-pixel: 8
  depth: 6
  red-max: 3
  green-max: 3
  blue-max: 3
  red-shift: 4
  green-shift: 2
  blue-shift: 0))

(define fw (rfb-session-width rfb))
(define fh (rfb-session-height rfb))

(framebuffer-update-request rfb 0 0 fw fh #f)

(let loop ((i (string->number count)))
  (when (positive? i)
    (framebuffer-update-request rfb 0 0 fw fh #t)
    (thread-sleep! 0.1)
    (match (read-server-message rfb)
      ((? eof-object?) #f)
      (('FramebufferUpdate rects ...)
       (for-each
	(lambda (rect)
	  (match rect
	    (('Raw #(x y w h data))
	     (do ((i 0 (add1 i)))
		 ((>= i h))
	       (do ((j 0 (add1 j)))
		   ((>= j w))
		 (print* 
		  (cursor-position (+ y i) (+ x j))
		  (if (zero? (u8vector-ref data (+ j (* i w))))
		      #\. #\*)))))
	    (msg #f)))
	rects)
       (loop (sub1 i)))
      (_ (loop (sub1 i))))))

(rfb-close rfb)

Authors

Felix Winkelmann

License

Copyright (c) 2011, Felix L. Winkelmann
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
 
  Redistributions of source code must retain the above copyright
  notice, this list of conditions and the following disclaimer.
 
  Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the
  distribution.
 
  Neither the name of the author nor the names of its contributors
  may be used to endorse or promote products derived from this
  software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY
WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

Version History

0.2: some API changes, added documentation
0.1: initial release