r1/kernel-methods.scm
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 223 646d45b098aa
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
223
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
;; This file is included in a couple of different contexts to
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     2
;; initialise the primitive table and to build a bootstrap image, and
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     3
;; should only contain define-method forms.
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
(define-method (primListen (port *traits-number*)) primListenSocket
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     6
  (or (sdl-net-tcp-open (make-sdl-ip-address 0 0 0 0 port))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     7
      *nil*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
(define-method (primConnect: (hostname *traits-string*) (port *traits-number*)) primConnectSocket
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    10
  (or (sdl-net-tcp-open (sdl-net-resolve-host hostname port))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
      *nil*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    13
(define-method (accept (sock *traits-socket*)) primSocketAccept
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    14
  (or (accept-from-socket sock)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
      *nil*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    17
(define-method (primPeerAddress (sock *traits-socket*)) primSocketPeerAddress
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
  (or (and-let* ((ipa (sdl-net-tcp-get-peer-address sock))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    19
		 (hostname (sdl-net-resolve-ip ipa)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    20
	(vector hostname (sdl-ip-address-port ipa)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    21
      *nil*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    22
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    23
(define-method (close (sock *traits-socket*)) primSocketClose
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    24
  (sdl-net-tcp-close sock)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    25
  *nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    26
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    27
(define-method (printOn: o (out *traits-socket*)) displayPrintString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    28
  (let ((string-port (open-output-string)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    29
    (display (send/previous-method/missing-handler #f
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    30
						   (lambda (argv) "#<OBJECT>")
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    31
						   'printString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    32
						   (vector o))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    33
	     string-port)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    34
    (let ((representation (get-output-string string-port)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    35
      (sdl-net-tcp-send-string out representation)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    36
      *nil*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    37
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    38
(define-method (printString (x *traits-root*)) rootPrintString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    39
  (send as: x *traits-string*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    40
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    41
(define-method (primStringAppend: (s1 *traits-string*) (s2 *traits-string*)) primStringAppend
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    42
  (string-append s1 s2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    43
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    44
(define-method (- (n1 *traits-number*) (n2 *traits-number*)) numSub (- n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    45
(define-method (+ (n1 *traits-number*) (n2 *traits-number*)) numPlus (+ n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    46
(define-method (* (n1 *traits-number*) (n2 *traits-number*)) numTimes (* n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    47
(define-method (/ (n1 *traits-number*) (n2 *traits-number*)) numDiv (/ n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    48
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    49
(define-method (< (n1 *traits-number*) (n2 *traits-number*)) numLT (< n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    50
(define-method (> (n1 *traits-number*) (n2 *traits-number*)) numGT (> n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    51
(define-method (<= (n1 *traits-number*) (n2 *traits-number*)) numLE (<= n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    52
(define-method (>= (n1 *traits-number*) (n2 *traits-number*)) numGE (>= n1 n2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    53
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    54
(define-method (= (x *traits-root*) (y *traits-root*)) primEgal
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    55
  (let egal ((x x) (y y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    56
    (or (eq? x y)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    57
	(cond
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    58
	 ((and (object? x) (object? y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    59
	  (let ((lx (object-layout x)) (sx (object-slots x))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    60
		(ly (object-layout y)) (sy (object-slots y)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    61
	    (and (eq? lx ly)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    62
		 (call-with-current-continuation
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    63
		  (lambda (escape)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    64
		    (layout-for-each lx
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    65
				     (lambda (slot-name slot)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    66
				       (case (slot-kind slot)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    67
					 ((mutable) (escape #f))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    68
					 ((immutable)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    69
					  (let ((index (slot-index slot)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    70
					    (if (not (egal (vector-ref sx index)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    71
							   (vector-ref sy index)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    72
						(escape #f))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    73
					 ((method) 'ignore-methods)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    74
					 (else (error "Unknown slot kind in egal"
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    75
						      (slot-kind slot))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    76
		    #t)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    77
	 ((and (pair? x) (pair? y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    78
	  (and (egal (car x) (car y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    79
	       (egal (cdr x) (cdr y))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    80
	 ((and (vector? x) (vector? y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    81
	  (let ((len (vector-length x)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    82
	    (and (= len (vector-length y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    83
		 (let loop ((i 0))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    84
		   (if (= i len)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    85
		       #t
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    86
		       (and (egal (vector-ref x i)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    87
				  (vector-ref y i))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    88
			    (loop (+ i 1))))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    89
	 ((and (number? x) (number? y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    90
	  (= x y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    91
	 (else #f)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    92
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    93
(define-method (as: x (y *traits-string*)) rootAsString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    94
  (if (eq? x *no-role*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    95
      "NoRole"
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    96
      (send name x)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    97
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    98
(define-method (as: (x '()) (y *traits-string*)) nilAsString "Nil")
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    99
(define-method (as: (x '#t) (y *traits-string*)) trueAsString "True")
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   100
(define-method (as: (x '#f) (y *traits-string*)) falseAsString "False")
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   101
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   102
(define-method (as: (x *traits-traits*) (y *traits-string*)) traitsAsString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   103
  (string-append "#<"(send name x)" traits>"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   104
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   105
(define-method (as: (x *traits-string*) (y *traits-string*)) stringAsString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   106
  (if (string? x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   107
      x
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   108
      (resend)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   109
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   110
(define-method (as: (x *traits-symbol*) (y *traits-string*)) symbolAsString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   111
  (if (symbol? x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   112
      (symbol->string x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   113
      (resend)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   114
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   115
(define-method (as: (x *traits-number*) (y *traits-string*)) numberAsString
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   116
  (if (number? x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   117
      (number->string x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   118
      (resend)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   119
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   120
(define-method (new (c *traits-cell*)) newCell
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   121
  (clone-object *cell*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   122
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   123
(define-method (key (o *traits-pair*)) pairCar
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   124
  (car o))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   125
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   126
(define-method (value (o *traits-pair*)) pairCdr
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   127
  (cdr o))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   128
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   129
(define-method (size (v *traits-tuple*)) tupleSize
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   130
  (vector-length v))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   131
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   132
(define-method (at: (v *traits-tuple*) (n *traits-number*)) tupleAt
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   133
  (vector-ref v n))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   134
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   135
(define-method (-> (x *traits-root*) y) pairCons
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   136
  (cons x y))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   137
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   138
(define-method (--> (c *traits-cell*) (m *traits-block*)) cellExtract
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   139
  (send applyWith: m (metalevel-extract-cell-value c)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   140
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   141
(define-method (peek (c *traits-cell*)) cellPeek
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   142
  (metalevel-peek-cell-value c))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   143
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   144
(define-method (<-- (c *traits-cell*) v) cellInject
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   145
  (metalevel-inject-cell-value c v))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   146
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   147
(define-method (withSlot:value: template (name *traits-symbol*) val) primAddSlot
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   148
  (let ((o (clone-object template)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   149
    (if (has-slot? o name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   150
	(set-slot! o name val)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   151
	(add-slot! o name val #f 'immutable))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   152
    o))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   153
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   154
(define-method (fork: (loc *traits-location*) (block *traits-block*)) forkBlockInLocation
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   155
  (metalevel-spawn loc (lambda () (send do block)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   156
  *nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   157
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   158
(define-method (fileIn (filename *traits-string*)) stringFileIn
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   159
  (ThiNG-load-file filename))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   160
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   161
(define-method (compileOneStatement (sock *traits-socket*)) primCompileOneStatement
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   162
  (let-values (((success ast) (parse-ThiNG (external-representation sock)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   163
					   ThiNG-topexpr-parser
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   164
					   (make-char-provider-thunk-for-socket sock))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   165
    (if success
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   166
	(cons *true* (metalevel-eval `(block () (,ast))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   167
	(cons *false* ast))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   168
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   169
(define-method (saveImage (filename *traits-string*)) primSaveImage
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   170
  (debug 0 "Saving image...")
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   171
  (call-with-output-file filename
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   172
    (lambda (port)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   173
      (write (serialize-image!) port)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   174
      (newline port))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   175
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   176
(define-method (primQuit (r *traits-root*)) primQuit
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   177
  (shutdown-sdl!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   178
  *nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   179
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   180
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   181
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   182
(define-method (handle (e *traits-sdl-event*)) handleBasicSdlEvent
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   183
  #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   184
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   185
(define-method (handle (e (traits-for-sdl-event-type SDL_QUIT))) handleQuitSdlEvent
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   186
  (metalevel-stop!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   187
  #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   188
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   189
(define-method (handle (e (traits-for-sdl-event-type SDL_MOUSEBUTTONDOWN))) handleSdlClick
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   190
  (let ((s2 (ttf-render-text-blended *system-font*
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   191
				     "(click)"
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   192
				     (make-sdl-color 255 255 255))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   193
    (sdl-blit-surface s2 #f
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   194
		      *video-surface* (make-sdl-rect (sdl-event-x e)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   195
						     (sdl-event-y e)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   196
						     0 0))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   197
    (sdl-free-surface s2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   198
  (sdl-flip *video-surface*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   199
  (resend))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   200
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   201
(define-method (handle (e (traits-for-sdl-event-type SDL_VIDEORESIZE))) handleSdlVideoResize
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   202
  (let ((w (sdl-event-w e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   203
	(h (sdl-event-h e)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   204
    (display (list 'resize w h))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   205
    (newline)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   206
    (sdl-set-video-mode w h 0 (+ SDL_HWSURFACE
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   207
				 SDL_HWPALETTE
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   208
				 SDL_RESIZABLE
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   209
				 SDL_DOUBLEBUF)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   210
  (sdl-fill-rect *video-surface*
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   211
		 (make-sdl-rect 0 0
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   212
				(sdl-surface-width *video-surface*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   213
				(sdl-surface-height *video-surface*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   214
		 (sdl-map-rgb (sdl-surface-pixel-format *video-surface*) 0 0 64))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   215
  (let ((s2 (ttf-render-text-blended *system-font*
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   216
				     "Hello, world!"
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   217
				     (make-sdl-color 255 255 255))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   218
    (sdl-blit-surface s2 #f *video-surface* (make-sdl-rect 0 0 0 0))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   219
    (sdl-free-surface s2))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   220
  (sdl-flip *video-surface*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   221
  (resend))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   222
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   223
(define-method (handle (e (traits-for-sdl-event-type SDL_KEYDOWN))) handleSdlKeydown
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   224
  (let* ((i (sdl-event-sym e))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   225
	 (c (integer->char i)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   226
    (if (or (= i 27) (memv c '(#\q #\Q)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   227
	(shutdown-sdl!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   228
	(begin (display (list 'got-key c))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   229
	       (newline))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   230
  (resend))