diff --git a/scsh/scgame/BLURB b/scsh/scgame/BLURB index 059cb1f..ffaf070 100644 --- a/scsh/scgame/BLURB +++ b/scsh/scgame/BLURB @@ -1 +1 @@ -scgame : a Carbon library (drawing and widgets) + Xanadu file system +scgame : a Carbon library (drawing and widgets) diff --git a/scsh/scgame/pkg-def.scm b/scsh/scgame/pkg-def.scm index ccaad72..cf79d9a 100644 --- a/scsh/scgame/pkg-def.scm +++ b/scsh/scgame/pkg-def.scm @@ -13,6 +13,4 @@ (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/scganadu.scm b/scsh/scgame/scganadu.scm deleted file mode 100644 index 9e7939a..0000000 --- a/scsh/scgame/scganadu.scm +++ /dev/null @@ -1,82 +0,0 @@ -;;; 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. - -;; This code fabricates xanadu hypertext files to attach -;; to xanandu objects or use as metafiles -(load "scgameutil.scm") -(load "scganaduutil.scm") - -(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 - "")))) - - (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 - ""))))) - - (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 deleted file mode 100644 index 66f378a..0000000 --- a/scsh/scgame/scganaduutil.scm +++ /dev/null @@ -1,67 +0,0 @@ -;;; 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 "" "" "" "")) - (*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")))))