From 2e23e8ba3025ebc11f517abd620df2d6c9243382 Mon Sep 17 00:00:00 2001
From: Johan Ceuppens <jceuppen@vub.ac.be>
Date: Mon, 16 Jan 2012 16:22:48 +0000
Subject: [PATCH] scgame and tmail initial commit

---
 scsh/scgame/AUTHORS                |   1 +
 scsh/scgame/BLURB                  |   1 +
 scsh/scgame/NEWS                   |   2 +
 scsh/scgame/README                 |   1 +
 scsh/scgame/packages.scm           |   9 +
 scsh/scgame/pkg-def.scm            |  17 ++
 scsh/scgame/scgame.scm             | 179 +++++++++++++++++++
 scsh/scgame/scgamedictionaries.scm | 276 +++++++++++++++++++++++++++++
 scsh/scgame/scgameutil.scm         |  50 ++++++
 scsh/scgame/scgamewidgets.scm      |  45 +++++
 scsh/scgame/scganadu.scm           |  82 +++++++++
 scsh/scgame/scganaduutil.scm       |  67 +++++++
 scsh/scgame/test.xpm               |  22 +++
 scsh/tmail/AUTHORS                 |   1 +
 scsh/tmail/BLURB                   |   1 +
 scsh/tmail/NEWS                    |  12 ++
 scsh/tmail/README                  |  10 ++
 scsh/tmail/packages.scm            |   8 +
 scsh/tmail/pkg-def.scm             |  19 ++
 scsh/tmail/tclient.scm             |  38 ++++
 scsh/tmail/tdaemon.scm             |  59 ++++++
 scsh/tmail/tforks.scm              | 118 ++++++++++++
 scsh/tmail/tmailbox-load.scm       |  53 ++++++
 scsh/tmail/tmailbox.scm            |  46 +++++
 scsh/tmail/trecords.scm            |  57 ++++++
 scsh/tmail/tserver.scm             |  43 +++++
 scsh/tmail/util.scm                |  31 ++++
 27 files changed, 1248 insertions(+)
 create mode 100644 scsh/scgame/AUTHORS
 create mode 100644 scsh/scgame/BLURB
 create mode 100644 scsh/scgame/NEWS
 create mode 100644 scsh/scgame/README
 create mode 100644 scsh/scgame/packages.scm
 create mode 100644 scsh/scgame/pkg-def.scm
 create mode 100644 scsh/scgame/scgame.scm
 create mode 100644 scsh/scgame/scgamedictionaries.scm
 create mode 100644 scsh/scgame/scgameutil.scm
 create mode 100644 scsh/scgame/scgamewidgets.scm
 create mode 100644 scsh/scgame/scganadu.scm
 create mode 100644 scsh/scgame/scganaduutil.scm
 create mode 100644 scsh/scgame/test.xpm
 create mode 100644 scsh/tmail/AUTHORS
 create mode 100644 scsh/tmail/BLURB
 create mode 100644 scsh/tmail/NEWS
 create mode 100644 scsh/tmail/README
 create mode 100644 scsh/tmail/packages.scm
 create mode 100644 scsh/tmail/pkg-def.scm
 create mode 100644 scsh/tmail/tclient.scm
 create mode 100644 scsh/tmail/tdaemon.scm
 create mode 100644 scsh/tmail/tforks.scm
 create mode 100644 scsh/tmail/tmailbox-load.scm
 create mode 100644 scsh/tmail/tmailbox.scm
 create mode 100644 scsh/tmail/trecords.scm
 create mode 100644 scsh/tmail/tserver.scm
 create mode 100644 scsh/tmail/util.scm

diff --git a/scsh/scgame/AUTHORS b/scsh/scgame/AUTHORS
new file mode 100644
index 0000000..c2430eb
--- /dev/null
+++ b/scsh/scgame/AUTHORS
@@ -0,0 +1 @@
+Copyright (C) 2011-2012 Johan Ceuppens
diff --git a/scsh/scgame/BLURB b/scsh/scgame/BLURB
new file mode 100644
index 0000000..ffaf070
--- /dev/null
+++ b/scsh/scgame/BLURB
@@ -0,0 +1 @@
+scgame : a Carbon library (drawing and widgets)
diff --git a/scsh/scgame/NEWS b/scsh/scgame/NEWS
new file mode 100644
index 0000000..7af6637
--- /dev/null
+++ b/scsh/scgame/NEWS
@@ -0,0 +1,2 @@
+version 0.1
+* line drawing algorithm and xanadu file system
diff --git a/scsh/scgame/README b/scsh/scgame/README
new file mode 100644
index 0000000..03e0fcc
--- /dev/null
+++ b/scsh/scgame/README
@@ -0,0 +1 @@
+scgame is a drawing package and should be useful to make widgets
diff --git a/scsh/scgame/packages.scm b/scsh/scgame/packages.scm
new file mode 100644
index 0000000..648a4e6
--- /dev/null
+++ b/scsh/scgame/packages.scm
@@ -0,0 +1,9 @@
+(define-interface scgame-interface
+  (export
+   make-scgame))
+
+(define-structure scgame
+  scgame-interface
+  (open scheme)
+  (files scgame))
+
diff --git a/scsh/scgame/pkg-def.scm b/scsh/scgame/pkg-def.scm
new file mode 100644
index 0000000..a562ebb
--- /dev/null
+++ b/scsh/scgame/pkg-def.scm
@@ -0,0 +1,17 @@
+(define-package "scgame"
+  (0 1)
+  ((install-lib-version (1 3 0)))
+  (write-to-load-script
+   `((config)
+     (load ,(absolute-file-name "packages.scm"
+                                (get-directory 'scheme #f)))))
+  (install-file "README" 'doc)
+  (install-file "NEWS" 'doc)
+  (install-string (COPYING) "COPYING" 'doc)
+  (install-file "packages.scm" 'scheme)
+  (install-file "scgamedictionaries.scm" 'scheme)
+  (install-file "scgameutil.scm" 'scheme)
+  (install-file "scgamewidgets.scm" 'scheme)
+  (install-file "scganadu.scm" 'scheme)
+  (install-file "scganaduutil.scm" 'scheme)
+  (install-file "scgame.scm" 'scheme))
diff --git a/scsh/scgame/scgame.scm b/scsh/scgame/scgame.scm
new file mode 100644
index 0000000..f3f8524
--- /dev/null
+++ b/scsh/scgame/scgame.scm
@@ -0,0 +1,179 @@
+;;; scgame.scm - a scheme game library
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(load "scgameutil.scm")
+(load "scgamedictionaries.scm")
+
+;; interface 1
+(define (make-scdraw1) (lambda (msg) (aspecterror)(display "make-scdraw1")))
+(define (make-scimage1) (lambda (msg) (aspecterror)(display "make-scimage1")))
+
+;; interface 2
+(define (coolness? x) (not (null? x))) ;; coolness
+
+(define (make-scdraw2)
+  (define (draw-line x0 y0 x1 y1 . w) ;; FIXME w == line width
+    (let ((width (if (coolness? w)(if (number? (car w)) (car w) 1))))
+      (display "FIX drawing line...")
+      ;;FIXME This should be Bresenham
+      (let ((steep (> (abs (- y1 y0))
+		      (abs (- x1 x0))))
+	    (swap (lambda (x y)
+		      (list y x)))
+	    (range (lambda (x y)
+		     (let ((l '()))
+		       (cond ((< x y)
+			      (do ((i x (+ i 1)))
+				  ((= x y) l)
+				(set! l (append l (list i)))))
+			     ((< y x)
+			      (do ((i y (+ i 1)))
+				  ((= y x) l)
+				(set! l (append l (list i)))))
+			     (else (display "range : x == y")
+				   x)))))
+	    )
+	(if steep
+	    (let ((t (swap x0 y0))
+		  (x0 (car t))
+		  (y0 (cadr t)))
+	      (let ((deltax (- x1 x0))
+		    (deltay (abs (- y1 y0))))
+		(let ((error (/ delta 2))
+		      (ystep 0)
+		      (y y0))
+		  (if (< y0 y1)
+		      (+ ystep 1)
+		      (- ystep 1)
+		      (for-each (if steep
+				    (putpixel y x 254)
+				    (putpixel x y 254))
+
+				(set! error (- error deltay))
+				(if (< error 0)
+				    (set! y (+ y ystep))
+				    (set! error (+ error deltax)))
+				(range x0 x1))
+		      ))))))))
+
+    (define (draw-lines l1 . w)
+      (display "FIX drawing lines...")
+      (for-each draw-line l1)
+      )
+
+    (lambda (msg)
+      (cond ((eq? msg 'draw-line)draw-line)
+	    (else (aspecterror)(display "scdraw2"))))
+    ))
+
+
+;; color table out of xpm pre
+
+(define (make-color-table)
+  (let ((dict (make-dictionary)))
+    (define (add! key color)
+      (dictionary-add! dict key color))
+    (define (set! key color)
+      (dictionary-set! dict key color))
+    (lambda (msg)
+      (cond ((eq? msg 'add!) add!)
+	    ((eq? msg 'set!) set!)
+	    (else (dict msg))))
+    ))
+
+(define (make-scimage2)
+  (let ((*db (make-dictionary)))
+
+    ;; private methods
+
+    (define (load-xpm-image filename)
+      (let ((in (open-input-file filename))
+	    (colorcharsdictionary (make-color-dictionary 8)) ;;
+	    (colorcharstable (make-color-table))
+	    )
+	(do ((str (read in) (read in)))
+	    ((string<=? "{" str)#t))
+	(do ((chr (read-char in) (read-char in)))
+	    ((eq? #\" chr)#t))
+	(let ((width (read in))
+	      (height (read in))
+	      (number-of-colors (read in))
+	      )
+	  (do ((chr (read-char in) (read-char in)))
+	      ((eq? #\, chr)#t))
+	  (do ((n1 number-of-colors (- n1 1)))
+	      ((<= n1 0)#t)
+	    (do ((chr (read-char in) (read-char in)))
+		((eq? #\" chr)#t))
+	    (let* ((colorchar (read-char in))
+		   (colorcharnumber (string->number (string colorchar)))
+		   )
+	      ((colorchars 'add!) colorchar colorcharnumber)  ;; FIXME color 255 (extra map-dict)
+	      ))
+	  ;;FIX
+	)))
+
+    ;; public methods
+
+    (define (load-image filename)
+      ;; FIXME read in xpm or png
+      (display "loading image...")
+      (cond ((string<=? ".xpm" filename)
+	     (load-xpm-image filename)
+	     )
+
+    (lambda (msg)
+      (cond ((eq? msg 'load-image)load-image)
+	    (else (aspecterror)(display "scimage2"))))
+    ))
+
+;; Give a #t as arg and have a nice interface
+(define (make-scgame . tm)
+  (cond ((not (null? tm)
+	      (let ((*scdraw (make-scdraw1))
+		    (*scimage (make-scimage1))
+		    )
+
+		(lambda (msg)
+		  (cond ((do ((i 0 (+ i 1)))
+			     ((substring? "draw-" msg i) (*scdraw msg))))
+			((do ((i 0 (+ i 1)))
+			     ((substring? "image-" msg i) (*scimage msg))))
+			(else (aspecterror)(display "scgame1"))
+			))))
+	 )
+	(else
+	 (let ((*scdraw (make-scdraw2))
+	       (*scimage (make-scimage2))
+	       )
+
+	   (lambda (msg)
+	     (cond ((eq? msg 'draw-line) (*scdraw msg))
+		   ((eq? msg 'draw-lines) (*scdraw msg))
+		   (else (aspecterror)(display "scgame2"))))
+	   ))))
diff --git a/scsh/scgame/scgamedictionaries.scm b/scsh/scgame/scgamedictionaries.scm
new file mode 100644
index 0000000..c54b7cc
--- /dev/null
+++ b/scsh/scgame/scgamedictionaries.scm
@@ -0,0 +1,276 @@
+;;; scgamedictionaries.scm - a scheme dictionary system for scgame 
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+;; Dictionary ADT with ref,set!,add!,make public methods at the end
+
+(define (make-dictionary1)
+  ;; methods are FIFO (first fixed first out)  
+  (let ((*dict '()))
+
+    (define (get key) ;; get key
+      (do ((l *dict (cdr l)))
+	  ((eq? key (caar l))
+	   (cadr l));;returns value
+	))
+    (define (add key value)
+      (set! *dict (append *dict (list (list key value)))))
+
+    (define (set key value) ;; get key
+      (do ((l *dict (cdr l))
+	   (res '() (append (list (car l) res))))
+	  ((eq? key (caar l))
+	   (set! (cadr res) value)
+	   (set! *dict (append res (cdr l))))
+	))
+
+    
+    (lambda (msg)
+      (cond ((eq? msg 'get) get)
+	    ((eq? msg 'set) set)	    
+	    ((eq? msg 'add) add)
+	    (else (aspecterror)(display "make-dictionary"))))
+    ))
+
+(define (make-dictionary) (make-dictionary1))
+(define (dictionary-ref dict key) ((dict 'get) key))
+(define (dictionary-set! dict key value) ((dict 'set) key value))
+(define (dictionary-add! dict key value) ((dict 'add) key value))
+
+;; color dictionary - for CSS colors use bpp set to 0
+;; helper functions
+
+(define (string->color str)
+  (let ((colornumber 0))
+    (do ((i 0 (+ i 1)))
+	((< i (string-length str)) colornumber)
+      (let* ((c (string-ref str i))
+	     (n (cond ((or (eq? c #\a)(eq? c #\A))
+		       10)
+		      ((or (eq? c #\b)(eq? c #\B))
+		       11)
+		      ((or (eq? c #\c)(eq? c #\C))
+		       12)
+		      ((or (eq? c #\d)(eq? c #\D))
+		       13)
+		      ((or (eq? c #\e)(eq? c #\E))
+		       14)
+		      ((or (eq? c #\f)(eq? c #\F))
+		       15)
+		      (else (string->number (string c))))))
+	(set! colornumber (+ (* n 16) colornumber))))))
+
+(define (little-endian->big-endian n)
+  (let ((str (string n))
+	(rets ""))
+    (do ((i (string-length str) (- i 1)))
+	((<= i 0)
+	 (string->number rets))
+      (set! rets (string 
+		  (bitwise-and 
+		   (string->number (* (expt 2 i)(string-ref str i)))
+		   (string->number rets)))))
+    ))
+
+(define (big-endian->littleendian n)
+  (let ((str (string n))
+	(rets ""))
+    (do ((i 0 (+ i 1)))
+	((>= i (string-length str))
+	 (string->number rets))
+      (set! rets (string 
+		  (bitwise-and 
+		   (string->number (* (expt 2 i)(string-ref str i)))
+		   (string->number rets)))))
+    ))
+
+
+(define (make-color-dictionary bpp)
+  (let ((dict (make-dictionary))
+	(pow (expt 2 bpp)))
+    (cond ((= pow 16) ;; 16 colors 
+	   (do ((i 0 (+ i 1)))
+	       ((< i pow) 
+		(dictionary-add! dict i i)))
+	   (dictionary-add! dict 'black 0)
+
+	   ;; ... FIXME fill in 4-bit colors
+	   dict)
+	  ((= pow 256) ;; 256 colors
+	   (dictionary-add! dict 'black 0)
+	   ;; ... FIXME fill in 8-bit colors
+	   dict)
+	  (else (display "color-dictionary : no or unsupported bit depth. Using CSS dictionary")	  
+		(dictionary-add! dict 'Black   "000000")
+		(dictionary-add! dict 'Navy   "000080")
+		(dictionary-add! dict 'DarkBlue   "00008B")
+		(dictionary-add! dict 'MediumBlue   "0000CD")
+		(dictionary-add! dict 'Blue   "0000FF")
+		(dictionary-add! dict 'DarkGreen   "006400")
+		(dictionary-add! dict 'Green   "008000")
+		(dictionary-add! dict 'Teal   "008080")
+		(dictionary-add! dict 'DarkCyan   "008B8B")
+		(dictionary-add! dict 'DeepSkyBlue   "00BFFF")
+		(dictionary-add! dict 'DarkTurquoise   "00CED1")
+		(dictionary-add! dict 'MediumSpringGreen   "00FA9A")
+		(dictionary-add! dict 'Lime   "00FF00")
+		(dictionary-add! dict 'SpringGreen   "00FF7F")
+		(dictionary-add! dict 'Aqua   "00FFFF")
+		(dictionary-add! dict 'Cyan   "00FFFF")
+		(dictionary-add! dict 'MidnightBlue   "191970")
+		(dictionary-add! dict 'DodgerBlue   "1E90FF")
+		(dictionary-add! dict 'LightSeaGreen   "20B2AA")
+		(dictionary-add! dict 'ForestGreen   "228B22")
+		(dictionary-add! dict 'SeaGreen   "2E8B57")
+		(dictionary-add! dict 'DarkSlateGray   "2F4F4F")
+		(dictionary-add! dict 'DarkSlateGrey   "2F4F4F")
+		(dictionary-add! dict 'LimeGreen   "32CD32")
+		(dictionary-add! dict 'MediumSeaGreen   "3CB371")
+		(dictionary-add! dict 'Turquoise   "40E0D0")
+		(dictionary-add! dict 'RoyalBlue   "4169E1")
+		(dictionary-add! dict 'SteelBlue   "4682B4")
+		(dictionary-add! dict 'DarkSlateBlue   "483D8B")
+		(dictionary-add! dict 'MediumTurquoise   "48D1CC")
+		(dictionary-add! dict 'Indigo    "4B0082")
+		(dictionary-add! dict 'DarkOliveGreen   "556B2F")
+		(dictionary-add! dict 'CadetBlue   "5F9EA0")
+		(dictionary-add! dict 'CornflowerBlue   "6495ED")
+		(dictionary-add! dict 'MediumAquaMarine   "66CDAA")
+		(dictionary-add! dict 'DimGray   "696969")
+		(dictionary-add! dict 'DimGrey   "696969")
+		(dictionary-add! dict 'SlateBlue   "6A5ACD")
+		(dictionary-add! dict 'OliveDrab   "6B8E23")
+		(dictionary-add! dict 'SlateGray   "708090")
+		(dictionary-add! dict 'SlateGrey   "708090")
+		(dictionary-add! dict 'LightSlateGray   "778899")
+		(dictionary-add! dict 'LightSlateGrey   "778899")
+		(dictionary-add! dict 'MediumSlateBlue   "7B68EE")
+		(dictionary-add! dict 'LawnGreen   "7CFC00")
+		(dictionary-add! dict 'Chartreuse   "7FFF00")
+		(dictionary-add! dict 'Aquamarine   "7FFFD4")
+		(dictionary-add! dict 'Maroon   "800000")
+		(dictionary-add! dict 'Purple   "800080")
+		(dictionary-add! dict 'Olive   "808000")
+		(dictionary-add! dict 'Gray   "808080")
+		(dictionary-add! dict 'Grey   "808080")
+		(dictionary-add! dict 'SkyBlue   "87CEEB")
+		(dictionary-add! dict 'LightSkyBlue   "87CEFA")
+		(dictionary-add! dict 'BlueViolet   "8A2BE2")
+		(dictionary-add! dict 'DarkRed   "8B0000")
+		(dictionary-add! dict 'DarkMagenta   "8B008B")
+		(dictionary-add! dict 'SaddleBrown   "8B4513")
+		(dictionary-add! dict 'DarkSeaGreen   "8FBC8F")
+		(dictionary-add! dict 'LightGreen   "90EE90")
+		(dictionary-add! dict 'MediumPurple   "9370D8")
+		(dictionary-add! dict 'DarkViolet   "9400D3")
+		(dictionary-add! dict 'PaleGreen   "98FB98")
+		(dictionary-add! dict 'DarkOrchid   "9932CC")
+		(dictionary-add! dict 'YellowGreen   "9ACD32")
+		(dictionary-add! dict 'Sienna   "A0522D")
+		(dictionary-add! dict 'Brown   "A52A2A")
+		(dictionary-add! dict 'DarkGray   "A9A9A9")
+		(dictionary-add! dict 'DarkGrey   "A9A9A9")
+		(dictionary-add! dict 'LightBlue   "ADD8E6")
+		(dictionary-add! dict 'GreenYellow   "ADFF2F")
+		(dictionary-add! dict 'PaleTurquoise   "AFEEEE")
+		(dictionary-add! dict 'LightSteelBlue   "B0C4DE")
+		(dictionary-add! dict 'PowderBlue   "B0E0E6")
+		(dictionary-add! dict 'FireBrick   "B22222")
+		(dictionary-add! dict 'DarkGoldenRod   "B8860B")
+		(dictionary-add! dict 'MediumOrchid   "BA55D3")
+		(dictionary-add! dict 'RosyBrown   "BC8F8F")
+		(dictionary-add! dict 'DarkKhaki   "BDB76B")
+		(dictionary-add! dict 'Silver   "C0C0C0")
+		(dictionary-add! dict 'MediumVioletRed   "C71585")
+		(dictionary-add! dict 'IndianRed    "CD5C5C")
+		(dictionary-add! dict 'Peru   "CD853F")
+		(dictionary-add! dict 'Chocolate   "D2691E")
+		(dictionary-add! dict 'Tan   "D2B48C")
+		(dictionary-add! dict 'LightGray   "D3D3D3")
+		(dictionary-add! dict 'LightGrey   "D3D3D3")
+		(dictionary-add! dict 'PaleVioletRed   "D87093")
+		(dictionary-add! dict 'Thistle   "D8BFD8")
+		(dictionary-add! dict 'Orchid   "DA70D6")
+		(dictionary-add! dict 'GoldenRod   "DAA520")
+		(dictionary-add! dict 'Crimson   "DC143C")
+		(dictionary-add! dict 'Gainsboro   "DCDCDC")
+		(dictionary-add! dict 'Plum   "DDA0DD")
+		(dictionary-add! dict 'BurlyWood   "DEB887")
+		(dictionary-add! dict 'LightCyan   "E0FFFF")
+		(dictionary-add! dict 'Lavender   "E6E6FA")
+		(dictionary-add! dict 'DarkSalmon   "E9967A")
+		(dictionary-add! dict 'Violet   "EE82EE")
+		(dictionary-add! dict 'PaleGoldenRod   "EEE8AA")
+		(dictionary-add! dict 'LightCoral   "F08080")
+		(dictionary-add! dict 'Khaki   "F0E68C")
+		(dictionary-add! dict 'AliceBlue   "F0F8FF")
+		(dictionary-add! dict 'HoneyDew   "F0FFF0")
+		(dictionary-add! dict 'Azure   "F0FFFF")
+		(dictionary-add! dict 'SandyBrown   "F4A460")
+		(dictionary-add! dict 'Wheat   "F5DEB3")
+		(dictionary-add! dict 'Beige   "F5F5DC")
+		(dictionary-add! dict 'WhiteSmoke   "F5F5F5")
+		(dictionary-add! dict 'MintCream   "F5FFFA")
+		(dictionary-add! dict 'GhostWhite   "F8F8FF")
+		(dictionary-add! dict 'Salmon   "FA8072")
+		(dictionary-add! dict 'AntiqueWhite   "FAEBD7")
+		(dictionary-add! dict 'Linen   "FAF0E6")
+		(dictionary-add! dict 'LightGoldenRodYellow   "FAFAD2")
+		(dictionary-add! dict 'OldLace   "FDF5E6")
+		(dictionary-add! dict 'Red   "FF0000")
+		(dictionary-add! dict 'Fuchsia   "FF00FF")
+		(dictionary-add! dict 'Magenta   "FF00FF")
+		(dictionary-add! dict 'DeepPink   "FF1493")
+		(dictionary-add! dict 'OrangeRed   "FF4500")
+		(dictionary-add! dict 'Tomato   "FF6347")
+		(dictionary-add! dict 'HotPink   "FF69B4")
+		(dictionary-add! dict 'Coral   "FF7F50")
+		(dictionary-add! dict 'Darkorange   "FF8C00")
+		(dictionary-add! dict 'LightSalmon   "FFA07A")
+		(dictionary-add! dict 'Orange   "FFA500")
+		(dictionary-add! dict 'LightPink   "FFB6C1")
+		(dictionary-add! dict 'Pink   "FFC0CB")
+		(dictionary-add! dict 'Gold   "FFD700")
+		(dictionary-add! dict 'PeachPuff   "FFDAB9")
+		(dictionary-add! dict 'NavajoWhite   "FFDEAD")
+		(dictionary-add! dict 'Moccasin   "FFE4B5")
+		(dictionary-add! dict 'Bisque   "FFE4C4")
+		(dictionary-add! dict 'MistyRose   "FFE4E1")
+		(dictionary-add! dict 'BlanchedAlmond   "FFEBCD")
+		(dictionary-add! dict 'PapayaWhip   "FFEFD5")
+		(dictionary-add! dict 'LavenderBlush   "FFF0F5")
+		(dictionary-add! dict 'SeaShell   "FFF5EE")
+		(dictionary-add! dict 'Cornsilk   "FFF8DC")
+		(dictionary-add! dict 'LemonChiffon   "FFFACD")
+		(dictionary-add! dict 'FloralWhite   "FFFAF0")
+		(dictionary-add! dict 'Snow   "FFFAFA")
+		(dictionary-add! dict 'Yellow   "FFFF00")
+		(dictionary-add! dict 'LightYellow   "FFFFE0")
+		(dictionary-add! dict 'Ivory   "FFFFF0")
+		(dictionary-add! dict 'White   "FFFFFF")
+		))
+    
+    ))
diff --git a/scsh/scgame/scgameutil.scm b/scsh/scgame/scgameutil.scm
new file mode 100644
index 0000000..26a54f6
--- /dev/null
+++ b/scsh/scgame/scgameutil.scm
@@ -0,0 +1,50 @@
+;;; scgameutil.scm - a scheme game library utility
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+;; aspect-oriented features
+
+(define (aspecterror)
+  (display "Message not understood."))
+
+;; FIX : use scsh regexp instead of these following 2 functions
+
+(define (string-cat s j)
+  (if (< j (string-length s))
+      (begin
+	(display j)
+	(string-append (string (string-ref s j)) (string-cat s (+ j 1)))
+	)
+      ""))
+
+(define (substring? needle haystack j)
+;;  (define (max? s1 s2 j)
+    (if (and (string? haystack)(string? needle))
+	(let ((hs (string-cat haystack j)))
+	  ((string>=? needle hs) hs))
+	#f))
+
diff --git a/scsh/scgame/scgamewidgets.scm b/scsh/scgame/scgamewidgets.scm
new file mode 100644
index 0000000..6f56b09
--- /dev/null
+++ b/scsh/scgame/scgamewidgets.scm
@@ -0,0 +1,45 @@
+;;; scgame.scm - a scheme game library 
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(load "scgameutil.scm")
+
+(define (make-scgamewidget)
+    (lambda (msg)
+      (display "subclass responsability")))
+
+(define (make-button)
+  (let ((*widget (make-scgamewidget))
+	(*image #f)) ;; pixel array
+    
+    (define (set-image filename)
+      (((make-scimage2)'load-image) filename))
+
+    (lambda (msg)
+      (cond ((eq? 'set-image) set-image)
+	    (else (aspecterror)(display "make-button"))
+	    ))))
diff --git a/scsh/scgame/scganadu.scm b/scsh/scgame/scganadu.scm
new file mode 100644
index 0000000..8d04127
--- /dev/null
+++ b/scsh/scgame/scganadu.scm
@@ -0,0 +1,82 @@
+;;; scganadu.scm - a Xanadu file system (until desktop publishing)
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(load "scgameutil.scm")
+(load "scganaduutil.scm")
+;; This code fabricates xanadu hypertext files to attach
+;; to xanandu objects or use as metafiles
+
+(define (make-scganadu)
+  (let ((record (delay #f)))
+
+    (define (add-file filename)
+      (let ((displayproc (write (((FILE-MAKER-unit (force record)) 'get-post-html)
+				 (string-append "<filename>"
+						filename
+						"</filename>"))))
+
+	    (with-output-to-file (string-append "." filename ".scganadu") displayproc)
+	    )))
+
+    (define (attach-to-file! filename)
+      (let ((displayproc (write (((FILE-MAKER-unit (force record)) 'get-post-html)
+				 (string-append "<filename>"
+						filename
+						"</filename>")))))
+
+	(with-output-to-file filename displayproc)
+	))
+
+    (define (dispatch msg)
+      (lambda (msg)
+	(cond ((eq? msg 'add-file)add-file)
+	      ((eq? msg 'attach-to-file!)attach-to-file!)
+	      (else (aspecterror) (display "make-scganadu")))))
+
+
+  (define :scganadu-record
+    (make-record-type 'scganadu-record
+		      '(FILE-MAKER make-scganadu)))
+  (define make-scganadu-record
+    (record-constructor :scganadu-record
+			'(FILE-MAKER make-scganadu)))
+  (define FILE-MAKER-unit (record-accessor :scganadu-record 'FILE-MAKER))
+  (define make-scganadu-unit (record-accessor :scganadu-record 'make-scganadu))
+  (define make-scganadu-record
+    (delay (make-copy-of-document))
+    (delay (make-cell dispatch)))
+  (set! record make-scganadu-record)
+  dispatch))
+
+
+;; interface
+
+(define scganadu (make-scganadu))
+;; FIXME (define X (make-scganadu1))
+(define (scganadu-add-file X filename) ((X 'add-file) filename))
+(define (scganadu-attach-to-file! X filename) ((X 'attach-to-file! filename)))
diff --git a/scsh/scgame/scganaduutil.scm b/scsh/scgame/scganaduutil.scm
new file mode 100644
index 0000000..66f378a
--- /dev/null
+++ b/scsh/scgame/scganaduutil.scm
@@ -0,0 +1,67 @@
+;;; scganaduutil.scm - a scheme Xanadu utility
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(load "scgameutil.scm")
+
+(define (make-copy-of-document)
+  (let ((*XMLOPENDATA (list "<scganadu>" "<audio>" "<image>"))
+	(*XMLCLOSEDATA (list "</scganadu>" "</audio>" "</image>"))
+	(*scganadutag! car)
+	(*audiotag! cadr)
+	(*imagetag! caadr)
+	)
+
+    (define (get-open-xml tag)
+      (tag *XMLOPENDATA))
+    (define (get-close-xml tag)
+      (tag *XMLCLOSEDATA))
+
+  (define (get-copyright)
+    "Copyright (C) unknown by SCGanadu."))
+
+  (define (get-post hypertext)
+    (get-post-html hypertext))
+  (define (get-post-html hypertext)
+    (string-append (get-open-xml scganadutag!) hypertext (get-open-xml scganadutag!))
+  (define (get-post-sound hypertext2)
+    (get-post-html (string (get-open-xml audiotag!) hypertext2 (get-close-xml audiotag!))))
+  (define (get-post-image hypertext3)
+    (get-post-html (string (get-open-xml imagetag!) hypertext3 (get-close-xml imagetag!))))
+
+  (lambda (msg)
+    (cond ((eq? msg 'get-copyright)
+	   get-copyright)
+	  ((eq? msg 'get-post-sound)
+	   get-post-sound)
+	  ((eq? msg 'get-post-image)
+	   get-post-image)
+	  ((eq? msg 'get-post-scganadu)
+	   get-post-scganadu)
+	  ((eq? msg 'get-post)
+	   get-post)
+	  (else (aspecterror) (display "make-copy-of-document")))))
diff --git a/scsh/scgame/test.xpm b/scsh/scgame/test.xpm
new file mode 100644
index 0000000..f6d1916
--- /dev/null
+++ b/scsh/scgame/test.xpm
@@ -0,0 +1,22 @@
+/* XPM */
+static char * test_xpm[] = {
+"16 16 3 1",
+" 	c gray77",
+".	c #000000000000",
+"X	c #861782078617",
+"                ",
+"                ",
+"............... ",
+". . . . . . . .X",
+"...............X",
+" X.XXXXXXX.XXXXX",
+"  .X      .X    ",
+"  .X      .X    ",
+"  .X      .X    ",
+"  .X      .X    ",
+"............... ",
+" . . . . . . . X",
+"...............X",
+" XXXXXXXXXXXXXXX",
+"                ",
+"                "};
diff --git a/scsh/tmail/AUTHORS b/scsh/tmail/AUTHORS
new file mode 100644
index 0000000..c2430eb
--- /dev/null
+++ b/scsh/tmail/AUTHORS
@@ -0,0 +1 @@
+Copyright (C) 2011-2012 Johan Ceuppens
diff --git a/scsh/tmail/BLURB b/scsh/tmail/BLURB
new file mode 100644
index 0000000..c40ecf5
--- /dev/null
+++ b/scsh/tmail/BLURB
@@ -0,0 +1 @@
+tmail : a client-server mail system
diff --git a/scsh/tmail/NEWS b/scsh/tmail/NEWS
new file mode 100644
index 0000000..bb09772
--- /dev/null
+++ b/scsh/tmail/NEWS
@@ -0,0 +1,12 @@
+version 0.1
+* working connection with a few commands (telnet localhost 1025 and
+* type in MAIL\r\n or QUIT\r\n
+* tdaemon.scm script which can be run in scsh to (run-daemon-child staterecord)
+* "rc" alike tforks.scm, tserver.scm tclient.scm which contain tell-client and ask-server methods.
+* tforks.scm contains record and daemon to be spawned by e.g. init or daemontools
+* and uses fork-and-forget with 10 commands per session.
+* old/ code directory
+* daemon state record (port, host, etc.)
+* telnetable daemon
+* daemon state record
+* dispatch object second executable file
diff --git a/scsh/tmail/README b/scsh/tmail/README
new file mode 100644
index 0000000..da109c1
--- /dev/null
+++ b/scsh/tmail/README
@@ -0,0 +1,10 @@
+- This is a mail daemon (lots of protocols)
+Basically run scsh, ',open records sockets reduce' or sometimes
+',open sockets records' and '(load "tdaemon.scm")' 
+telnet localhost 1025 and type in APOP\r\n or QUIT\r\n
+for asking the server.
+
+mailer daemon command history:
+APOP retrieves full mailbox (FIXME)
+STAT returns
+LIST returns
diff --git a/scsh/tmail/packages.scm b/scsh/tmail/packages.scm
new file mode 100644
index 0000000..6743044
--- /dev/null
+++ b/scsh/tmail/packages.scm
@@ -0,0 +1,8 @@
+(define-interface tmail-interface
+  (export
+   run-daemon-child))
+
+(define-structure tmail
+  tmail-interface
+  (open scheme)
+  (files tdaemon trecords tclient tserver tforks tmailbox))
\ No newline at end of file
diff --git a/scsh/tmail/pkg-def.scm b/scsh/tmail/pkg-def.scm
new file mode 100644
index 0000000..fe6baad
--- /dev/null
+++ b/scsh/tmail/pkg-def.scm
@@ -0,0 +1,19 @@
+(define-package "tmail"
+  (0 1)
+  ((install-lib-version (1 3 0)))
+  (write-to-load-script
+   `((config)
+     (load ,(absolute-file-name "packages.scm"
+                                (get-directory 'scheme #f)))))
+  (install-file "README" 'doc)
+  (install-file "NEWS" 'doc)
+  (install-string (COPYING) "COPYING" 'doc)
+  (install-file "packages.scm" 'scheme)
+  (install-file "tdaemon.scm" 'scheme)
+  (install-file "tforks.scm" 'scheme)
+  (install-file "tclient.scm" 'scheme)
+  (install-file "trecords.scm" 'scheme)
+  (install-file "tmailbox.scm" 'scheme)
+  (install-file "tmailbox-load.scm" 'scheme)
+  (install-file "util.scm" 'scheme)
+  (install-file "tserver.scm" 'scheme))
diff --git a/scsh/tmail/tclient.scm b/scsh/tmail/tclient.scm
new file mode 100644
index 0000000..e33d02e
--- /dev/null
+++ b/scsh/tmail/tclient.scm
@@ -0,0 +1,38 @@
+;;; tclient.scm - a full-duplex connect-to-server
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(define (ask-server request port-number)
+  (call-with-values
+    (lambda ()
+      (socket-client (get-host-name) port-number))
+    (lambda (in out)
+       (display request out)
+       (close-output-port out)
+       (let ((answer (make-string-input-port in))) ; returns any server response into some string
+      (close-input-port in)
+      answer))))
diff --git a/scsh/tmail/tdaemon.scm b/scsh/tmail/tdaemon.scm
new file mode 100644
index 0000000..285b928
--- /dev/null
+++ b/scsh/tmail/tdaemon.scm
@@ -0,0 +1,59 @@
+;;; tdaemon.scm - a scheme pop mail daemon (instantiated) 
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+;;#!/home/erana/scheme/bin/scsh -ds \
+;;!#
+
+;;#!/home/erana/scheme/bin/scsh \
+;;-lm tmail.scm -o mail-daemon -s
+
+(load "trecords.scm")
+(load "tclient.scm")
+(load "tserver.scm")
+(load "tforks.scm")
+(display "FIXMES: mail-daemon structure needs carriage return statement")
+(newline)
+
+(define rc (make-daemon-record 
+	    (delay "localhost") ;; virtual host
+	    (delay 1110) 
+	    (delay (open-socket (force (port rc)))) 
+	    (delay "POP3 tmail server ready")
+	    (delay "+OK ")
+	    (delay "APOP ")
+	    (delay "STAT")
+	    (delay "LIST")
+	    (delay "+OK POP3 server signing off")
+	    (delay "Exceeded maximum transactions.")
+	    (delay "500 Command not understood.")
+	    (delay "HELO")
+	    (delay "EHLO")))
+(run-daemon-child rc)
+
+(display "mail-daemon ends.")
+(newline)
diff --git a/scsh/tmail/tforks.scm b/scsh/tmail/tforks.scm
new file mode 100644
index 0000000..e54ee83
--- /dev/null
+++ b/scsh/tmail/tforks.scm
@@ -0,0 +1,118 @@
+;;; tforks.scm - a scheme daemon child process
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(load "trecords.scm")
+(load "tserver.scm")
+(load "tmailbox-load.scm")
+
+;; You can spawn this
+
+(define (run-daemon-child rec)
+  (display "Opening listening socket on host : ")
+  (display (force (hostname rec)))
+  (display " port unknown at this stage, default 1110 ")
+  (display " ...")
+  (newline)
+  (fork-and-forget
+   (let ((socket (force (sock rec))))
+     (begin
+       (
+	(lambda (request portnumber)
+	  (call-with-values
+	      (lambda ()
+		(socket-accept socket))
+	    (lambda (in out)
+	      (write request out)
+	      (do ((i 0 (+ i 1)))
+		    ((> i 9)(display "Quitting mail daemon child.")(newline))
+		;; (iterate loop
+		;;	((count* i 0))
+		;;	()
+		;;	(if (>= i 10)
+		;;	    (display "Quitting mail daemon child.")(newline)
+
+
+		  (call-with-values ;; FIXME (let ((answer2 (read in)))
+		      (lambda ()
+			(list (read in)(read in)))
+		    (lambda (answer)
+		      (let ((answer2 (car answer))
+			    (answer3 (if (not (null? (cdr answer)))
+					 (cadr answer)
+					 'foo)))
+			(display "Asked something : ")(display (symbol->string answer2))(display " ")(display answer3)(newline)
+			(if (symbol? answer2)
+			    (cond ((eq? 'APOP answer2)
+				   (write mailbox-contents out)
+				   ;; FIXME write "" to user's mailbox file
+				   ;;(let ((out2 (open-output-file (string-append spooldirectory (getenv "USER")))))
+				   ;;  (write out2 ""))
+				   )
+				  ((eq? 'STAT answer2)
+				   #t)
+				  ((eq? 'LIST answer2)
+				   #t)
+				  ((eq? 'RETR answer2)
+				   (let ((idx (string->number (symbol->string answer3))))
+				     (if idx
+					 (write (tmail-get-mail-with-index (getenv "USER") idx) out))))
+				  ;; for brokeness
+				  ((eq? 'USER answer2)
+				   ;;FIXME overflow
+				   (let ((username (if (number? answer3)
+						       (number->string answer3)
+						       (symbol->string answer3))))
+				     (setenv "USER" username)
+				     (write "+OK user accepted - not implemented" out)))
+				  ((eq? 'PASS answer2)
+				   (let ((pass (if (number? answer3)
+						   (number->string answer3)
+						   (symbol->string answer3))))
+				     (write "+OK password accepted - not implemented" out)))
+				  ((eq? 'QUIT answer2)
+				   (write (force (BYE rec)) out)
+				   (close-input-port in)
+				   (close-socket socket)
+				   (close-output-port out)
+				   (exit))
+				  (else
+				   (write (force (ERROR500 rec)) out))
+				  ))
+			))))
+	      (write (force (SPAWNEND rec)) out)
+	      (write (force (BYE rec)) out)
+
+	      (close-input-port in)
+	      (close-socket socket)
+	      (close-output-port out)
+
+	      (exit)
+
+	      )))
+	(force (MOTD rec)) (port rec))
+       ))))
\ No newline at end of file
diff --git a/scsh/tmail/tmailbox-load.scm b/scsh/tmail/tmailbox-load.scm
new file mode 100644
index 0000000..9bd9a05
--- /dev/null
+++ b/scsh/tmail/tmailbox-load.scm
@@ -0,0 +1,53 @@
+;;; tmailbox.scm - a scheme mailbox system for smtp
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(load "tmailbox.scm")
+
+;; read in current user's mailbox
+
+(define mailbox-contents (tmail-mailbox-contents (getenv "USER")))
+
+;; get mail with index
+
+(define (tmail-get-mail-with-index usernamestr idx)
+  (let ((mailboxcontents tmail-mailbox-contents))
+    (let ((s "")
+	  (i 0))
+      ;; FIXME make do*
+      (do ((j 0 (+ j 1)))
+	  ((string=? "From " s)
+	   (set! i (+ i 1))
+	   (if (= i (+ idx 1))
+	       s)
+	   )
+	(let ((c (string-ref mailboxcontents j)))
+	  (if (string=? "From " s)
+	      (set! s "From "))
+	  (string-append s (string c)))))))
+
+
diff --git a/scsh/tmail/tmailbox.scm b/scsh/tmail/tmailbox.scm
new file mode 100644
index 0000000..5d427fd
--- /dev/null
+++ b/scsh/tmail/tmailbox.scm
@@ -0,0 +1,46 @@
+;;; tmailbox.scm - a scheme mailbox system for smtp
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(define spooldirectory "/var/spool/mail/")
+
+(define (tmail-read-in-mailbox username)
+  (let ((file (string-append spooldirectory username)))
+    (display file)
+    (let ((in (open-input-file file)))
+      (let ((mailboxcontents ""))
+	(do ((s (read-char in)(read-char in))
+	     (i 0 (+ i 1)))
+	    ((eof-object? s) (if (= (string-length mailboxcontents) 0)
+				 (display "empty mailbox"))
+	     mailboxcontents)
+	  (set! mailboxcontents (string-append mailboxcontents (string s)))
+	  )))))
+
+;; global
+(define (tmail-mailbox-contents username) (tmail-read-in-mailbox username))
+
diff --git a/scsh/tmail/trecords.scm b/scsh/tmail/trecords.scm
new file mode 100644
index 0000000..6782ac5
--- /dev/null
+++ b/scsh/tmail/trecords.scm
@@ -0,0 +1,57 @@
+;;; trecords.scm - records for tmail 
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(define :daemon-record
+  (make-record-type 'daemon-record 
+		    '(hostname port sock MOTD ACK APOP STAT LIST BYE SPAWNEND ERROR500 HELO EHLO)))
+(define make-daemon-record 
+  (record-constructor :daemon-record 
+		      '(hostname port sock MOTD ACK APOP STAT LIST BYE SPAWNEND ERROR500 HELO EHLO)))
+;; (define make-daemon-record-default 
+;;   (record-constructor :daemon-record 
+;; 		      '(hostname 
+;; 		 	1025 #f
+;; 			"Hello."
+;; 			"OK." 
+;; 			"Bye." 
+;; 			"500 Command not understood." 
+;; 			"EHLO Server ready.")))
+(define hostname (record-accessor :daemon-record 'hostname))
+(define port (record-accessor :daemon-record 'port))
+(define sock (record-accessor :daemon-record 'sock))
+(define MOTD (record-accessor :daemon-record 'MOTD))
+(define ACK (record-accessor :daemon-record 'ACK))
+(define APOP (record-accessor :daemon-record 'APOP))
+(define STAT (record-accessor :daemon-record 'STAT))
+(define LIST (record-accessor :daemon-record 'LIST))
+(define BYE (record-accessor :daemon-record 'BYE))
+(define SPAWNEND (record-accessor :daemon-record 'SPAWNEND))
+(define ERROR500 (record-accessor :daemon-record 'ERROR500))
+(define HELO (record-accessor :daemon-record 'HELO))
+(define EHLO (record-accessor :daemon-record 'EHLO))
+					    
diff --git a/scsh/tmail/tserver.scm b/scsh/tmail/tserver.scm
new file mode 100644
index 0000000..0924255
--- /dev/null
+++ b/scsh/tmail/tserver.scm
@@ -0,0 +1,43 @@
+;;; tserver.scm - a full-duplex connect-to-client
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(define (tell-client request port-number sock)
+  (call-with-values
+    (lambda ()
+      (socket-accept sock))
+    (lambda (in out)
+       (display request out)
+       (display #\newline out)
+       ;;(display #\return out)
+       ;;FIXME(close-output-port out)
+       ;;(let ((answer (make-string-input-port in))) ; returns any server response into some string
+      ;;FIXME(close-input-port in)
+      ;;answer)
+       )))
+
+
diff --git a/scsh/tmail/util.scm b/scsh/tmail/util.scm
new file mode 100644
index 0000000..f6a5e40
--- /dev/null
+++ b/scsh/tmail/util.scm
@@ -0,0 +1,31 @@
+;;; util.scm - tmail utilities 
+;;;
+;;; Copyright (c) 2011-2012 Johan Ceuppens
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. 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.
+;;; 3. The name of the authors may not be used to endorse or promote products
+;;;    derived from this software without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+(define (aspecterror) (display " message not understood. "))
+
+