#lang scheme/base (require scheme/class "list-utils.ss") (provide (all-defined-out)) ;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ; a message for sending betwixt logic and view side (define-serializable-class* message% object% () (init-field (name 'none) ; a symbol denoting the type of the message (data '())) ; should be an assoc list map of name to values, eg: ; '((name "archibold") (age 53)) ; shouldn't put logic objects in here - 'raw' data only (define/public (get-name) name) (define/public (get-data arg-name) (cadr (assoc arg-name data))) (define/public (print) (printf "msg: ~a ~a~n" name data)) (define/public (to-string) (string-append (symbol->string name) " " (nvpairs->string data ""))) (define/public (from-string str) (let ((tokens (string-split str #\ ))) (set! name (string->symbol (car tokens))) (set! data (string->nvpairs (list-string-concat (cdr tokens) " ") '())))) (define (value->string a) (cond ((number? a) (string-append "n:" (number->string a))) ((string? a) (string-append "s:" a)) ((vector? a) (string-append "v:" (number->string (vector-ref a 0)) "," (number->string (vector-ref a 1)) "," (number->string (vector-ref a 2)))) ((symbol? a) (string-append "y:" (symbol->string a))) (else (error "unsupported arg type for " a)))) (define (nvpairs->string l s) (cond ((null? l) s) (else (nvpairs->string (cdr l) (string-append s (symbol->string (caar l)) "=" (value->string (cadr (car l))) " "))))) (define (string->value a) (cond ((string=? (car a) "n") (string->number (cadr a))) ((string=? (car a) "s") (cadr a)) ((string=? (car a) "v") (let ((v (string-split (cadr a) #\,))) (vector (string->number (list-ref v 0)) (string->number (list-ref v 1)) (string->number (list-ref v 2))))) ((string=? (car a) "y") (string->symbol (cadr a))) (else (error "unsupported value type for " a)))) (define (string->nvpairs s l) (map (lambda (pair) (let ((nv (string-split pair #\=))) (list (string->symbol (car nv)) (string->value (string-split (cadr nv) #\:))))) (string-split s #\ ))) (super-new))