#!/bin/sh
#|
exec mzscheme -LC "html.ss" "swindle" "$0" "$@"
|#
;;; ===========================================================================
(*html-target-dir* "~/html")
(define *title-prefix* "Eli Barzilay: ")
(define *bar-image* "slibar.gif")
(define *menu-in-img* "ball_yl")
(define *menu-out-img* "ball_pr")
(define *menu-sel-img* "ball_gr_rd")
(define *mail* "eli@barzilay.org")
(define *text-bar* "--------------------")
(define *text-bullet* "->")
(define *pics-address* "http://pics.barzilay.org/")
(load-relative "counter.scm")
;; Should add "description" and "keywords".
(*prefix* (text: (meta-content~ 'author (concat "Eli Barzilay, " *mail*))
(link-rel~ "icon" `(,*server-address* "favicon.ico"))))
;;; ===========================================================================
(current-directory (*html-target-dir*))
(define (with-menu: . lines)
(lambda args (apply my-html-with-menu lines args)))
(define (without-menu: . lines)
(lambda args (apply my-html lines args)))
(define (ls dir &optional regexp)
(quicksort
(map (lambda (f) (concat dir "/" f))
(filter (lambda (f)
(and (not (equal? f "thumbs"))
(or (not regexp) (regexp-match regexp f))))
(map path->string
(directory-list (concat (*html-target-dir*) dir)))))
string<=?))
(define (basename fname)
(regexp-replace "^(.*/)?([^./]+)([.].*)?$" fname "\\2"))
(define (nsplit n l)
(let loop ([i n] [l l] [tuple '()] [result '()])
(if (null? l)
(reverse! (cons (reverse! tuple) result))
(if (zero? i)
(loop n l '() (cons (reverse! tuple) result))
(loop (sub1 i) (cdr l) (cons (car l) tuple) result)))))
;;; ===========================================================================
(define (make-body-args color)
`(:background (,(*image-dir*) "maze-" ,color ".jpg")
:bgcolor ,(case color ; these match the brightest color in `make-menu'
[(red) "#F07878"]
[(green) "#78F078"]
[(blue) "#7878F0"]
[(yellow) "#F0F078"]
[(magenta) "#F078F0"]
[(cyan) "#78F0F0"])
:text "#000000" ; text
:link "#500000" ; not followed
:vlink "#005000" ; followed
:alink "#00FF00" ; clicked
))
(define thumb-width 80)
(define thumb-height 60)
(define (thumb-ref pic &keys [ref pic] [scale 1])
(ref~: ref
(img: :src (regexp-replace "^(.*/)?([^/.]+)(\\.[^/]*)?$" pic
"\\1thumbs/\\2.jpg")
:alt (basename pic) :border 0
:width (* scale thumb-width) :height (* scale thumb-height))))
(define (quickform: action . body)
(table*: ::newlines? #f row> ::newlines? #f col> ::newlines? #f
(apply form: :action action ::newlines? #f body)))
;;; ===========================================================================
(defhtml _main
:name "index"
:title (big~: 2 "Eli Barzilay: Maze is Life!")
:window-title "Eli Barzilay: Maze is Life!"
:menu-name "Main"
:bar-image "eli.jpg"
:menu-msg "Hi!"
:menu-pos 'left
:color-style 'blue
(with-menu: (main-page)))
(define (main-page &optional h?)
(define (-: eng heb) (if h? heb eng))
(text:
(center: (mailto~ *mail*) (br:) (my-gif~ "colors" *text-bar*))
(break~: 2)
((-: text: rtl:)
(-: #f (p: "סוף סוף ניתן להשתמש בשפת הקודש על הרשת..."
"הדף הזה לא מכיל שום דבר חדש \\- אבל בעברית!"))
(itemize: ::br 2
item> (b: (-: "Email" "דוא\"ל") :":") (mailto~ *mail*)
item> (i: (-: "Office" "משרד") :":") "320 WVH"
item> (i: (-: "Phone" "טלפון"):":") "+1-617-373-4211"
item> (i: (-: "Fax" "פקס") :":") "+1-617-373-5121"
item> (i: (-: "Address" "כתובת"):":")
(address:
(http~: "www.ccs.neu.edu/"
"College of Computer and Information Science"):"," (br:)
(http~: "www.northeastern.edu/" "Northeastern University"):"," (br:)
"440 Huntington Ave" (br:)
"Boston, MA 02115" (br:)
"USA")
;; item> (b: (-: "Home" "בית"):":")
;; (itemize: item> (i: (-: "Phone" "טלפון"):":") "+1-617-945-0249"
;; item> (i: (-: "Address" "כתובת"):":")
;; (address: "75 Fayette St., Apt #3" (br:)
;; "Cambridge, MA 02139" (br:)
;; "USA"))
))))
;;; ===========================================================================
(defhtml _research
:bar-image "felxbar.gif"
:menu-msg "Research stuff..."
:menu-pos 'top
:color-style 'magenta
(with-menu:
(h3: "PLT Scheme")
"I am now part of the" (http~: "www.plt-scheme.org/" "PLT Scheme") "group,"
"the" (http~: "www.ccs.neu.edu/research/prl/" "Northeastern branch"):"."
(h3: "Reflection")
"I have worked on an implementation of practical reflection for"
(http~: "www.nuprl.org/" "Nuprl"):"."
(itemize:
item> "The \"Reflection\" theory is accessible in this"
"automatically-generated"
(ref~: "misc/reflection.ps" "PostScript") "file."
item> "An example of using it is a formalization of the"
(ref~: "misc/tarski.ps" "Tarski")
"argument about the undefinability of truth."
item> "The HOAS representation is described in"
(em: "\"Reflecting Higher-Order Abstract Syntax in Nuprl\"")
(ref~: "misc/hoas-paper.ps.gz" "[PostScript]")
(ref~: "misc/hoas-paper.pdf" "[PDF]"):"."
item> "My" (http~: "thesis.barzilay.org/" "thesis") "is available too.")
br:
(h3: "BOOMS")
"As part of my master thesis I implemented"
(ref~: (html-ref-name _booms) "Booms"):": a structure editor for music."))
;;; ===========================================================================
(defhtml _interests
:menu-msg "Hacks, hobbies etc..."
:menu-pos 'right
:color-style 'red
(with-menu:
(itemize: ::br 1
item> "Scheme, Lambda-Calculus, Lisp, CLOS."
(itemize:
item> "My small web" (ref~: *server-address* "server"):"."
item> (ref~: "Swindle/index.html" "Swindle"):", my CLOS extension"
"for" (http~: "www.plt-scheme.org/" "MzScheme"):"."
item> "Scheme specification - the Revised^5 Report:"
(ref~: "books/r5rs/r5rs.txt" "Text"):","
(ref~: "books/r5rs/r5rs.ps.gz" "PostScript"):"."
item> "Common Lisp, the Language - a"
(ref~: "books/cltl/CLtL-text" "Text") "version."
item> "A" (ref~: "misc/meta" "meta") "processor for Scheme, with"
"some interesting"
(ref~: "misc/meta-sample.scm" "examples"):", and an Emacs"
(ref~: "misc/meta.el" "hack") "to highlight it."
item> "The" (ref~: "mazes/maze.ss" "maze") "drawing program that"
"I use to draw" (ref~: (html-ref-name _random) "mazes")
"with."
item> "GCalc (a toy graphic lambda-calculus) is now part of PLT"
"(as a game)."
item> "A smart" (ref~: "misc/mines.ss" "minesweeper")
"game makes those stupid clicking for you."
item> "A remsync-like utility for"
(ref~: "misc/syncfiles" "synchronizing")
"files across computers that are not always connected"
item> "A small" (ref~: "misc/server.tgz" "server") "program that"
"turns and stdin/out process to a network server."
item> "Finally, there's the Scheme program that I use to"
(ref~: "src/eli.scm" "create") "these pages. This is part of"
(ref~: "misc/swindle.plt" "Swindle") "(and also used by my"
(ref~: *server-address* "server"):")."
"If you want to use it, you'll want to read the"
(ref~: "misc/html-doc.txt" "documentation"):".")
(small: "(all Scheme code is for"
(http~: "www.drscheme.org/" "MzScheme"):")" (br:))
item> "Emacs"
(itemize:
item> "My" (http~: "www.barzilay.org/misc/EliEmacs.tgz" "EliEmacs")
"environment, and"
(http~: "www.barzilay.org/misc/calculator.el"
(tt: "calculator.el")):","
"my calculator.")
item> "Linux" (itemize: item> "...")
item> "Nietzsche"
(itemize:
item> "Thus Spake Zarathustra:"
(ref~: "books/zar/TSZ.txt" "Text"):","
(ref~: "books/zar/TSZ.ps.gz" "PostScript")
"or" (ref~: "books/zar/html/TSZ.html" "HTML"):".")
item> "Good Music"
(itemize:
item> (http~: "www.brainwashed.com/lpd/" "The Legendary Pink Dots")
item> (http~: "www.crammed.be/crammed/Minimalb.htm"
"Minimal Compact")
item> (http~: "www.depechemode.com/" "Depeche Mode")
item> (http~: "www.tractor.co.il/" "The Tractor's Revenge")
item> (http~: "www.deadcandance.com/" "Dead Can Dance")
item> (http~: "www.portishead.co.uk/" "Portishead")
item> (http~: "www.garbage.com/" "Garbage")
item> (http~: "www.radiohead.com/" "Radiohead"))
item> "Digital" (ref~: *pics-address* "photography")
"and other" (ref~: (html-ref-name _random) "stuff"):".")))
;;; ===========================================================================
'
(defhtml _family
:menu-msg "Me, my wife, our cats and the rest."
:menu-pos 'bottom
:color-style 'cyan
(with-menu:
(my-jpg~ "EliRegina" "EliRegina" :align 'right)
(itemize: ::br 2
item> "My wife:"
(http~: "people.csail.mit.edu/regina/" "Regina Barzilay"):"."
item> (let ([pic (lambda (img txt)
(ref~: (concat (*image-dir*) "cats/" img ".jpg")
txt))])
"Our two cats "
:(pic "CatsInABox" "Ger")
:(pic "CatsSleep" "sho")
:(pic "HouseFemales" "n a")
:(pic "CatQueen" "nd ")
:(pic "CatsReginaSleep" "Nek")
:(pic "CouchMoment" "hama")
:".")
item> (let ([pic (lambda (img txt)
(ref~: (concat (*image-dir*) "adva/adva" img ".jpg")
txt))])
"My mother and sister: Mazal and "
:(pic "1" "A"):(pic "2" "d"):(pic "3" "v"):(pic "4" "a"):".")
item> "My brother:"
(http~: "www.geocities.com/dmagician_geo/" "Doron"):".")))
;;; ===========================================================================
(defhtml _life
:menu-msg "Things I did..."
:menu-pos 'top
:color-style 'green
(with-menu:
(my-jpg~ "eli1" "eli" :align 'right)
(h3: "2005")
(itemize: ::br 2
item> "Current status:" (tt: "alive":(blink: "_"))
item> "Finished an 8-year" (http~: "thesis.barzilay.org/" "project"):".")
(h3: "2004")
(itemize: ::br 2
item> "Started having some" (http~: "www.plt-scheme.org/" "real fun"):"."
item> "Even more" (http~: "csu660.barzilay.org/" "fun"):".")
(h3: "2003")
(itemize: ::br 2
item> "Finally, made some substantial"
(ref~: (html-ref-name _research) "progress"):"."
item> "Moved to Boston")
(h3: "2002")
(itemize: ::br 2
item> "Was alive most of the time..."
item> "Got into some heavy "
(http~: "www.nuprl.org/documents/Barzilay/NuprlHOAS_02.html"
"stuff"):".")
(h3: "2001")
(itemize: ::br 2
item> "Continue the" (ref~: (html-ref-name _research) "phd") "stuff..."
item> "Had much more" (ref~: *server-address* "fun"):".")
(h3: "2000")
(itemize: ::br 2
item> "At last, started"
(ref~: (html-ref-name _research) "working"):"...")
(h3: "1999")
(itemize: ::br 2
item> "Had an idea!"
item> "Again, TA" (http~: "courses.cs.cornell.edu/cs212/" "CS212")
"in the spring."
item> "Started having" (ref~: (html-ref-name _random) "fun"):".")
(h3: "1998")
(itemize: ::br 2
item> "Tried to begin working on the"
(http~: "www.cs.cornell.edu/Info/Projects/NuPrl/" "Nuprl")
"project, (specifically MetaPrl, with"
(http~: "www.cs.cornell.edu/jyh/" "Jason"):")."
item> "Wrote" (ref~: "Swindle/index.html" "Swindle"):".")
(h3: "1997")
(itemize: ::br 2
item> "Fall: TA"
(http~: "courses.cs.cornell.edu/cs212/" "CS212"):"."
item> "Summer work at" (http~: "www.gefen.co.il/" "Gefen-Dekel"):"."
item> "Moved to Ithaca, NY - started a Ph.D. in the"
(http~: "www.cs.cornell.edu/" "Cornell Computer Science dept"):"."
item> "Finished a Computer Science Master in the"
(http~: "www.cs.bgu.ac.il/" "Ben-Gurion CS dept"):".")
(h3: "1996")
(itemize: ::br 2
item> "TA'ing with" (http~: "www.cs.bgu.ac.il/~mira/" "Mira Balaban")
"at the" (http~: "www.telhai.ac.il/" "Tel-Hai College"):".")
(h3: "1995")
(itemize: ::br 2
item> "Start working in" (http~: "www.gefen.co.il/" "Gefen-Dekel"):","
"the Israeli branch of"
(http~: "www.dalet.com/" "Dalet Technologies") "from Paris.")
(h3: "1994")
(itemize: ::br 2
item> "TA'ed the"
(http~: "www.cs.bgu.ac.il/~elhadad/ppl.html"
"Principles of Programming Languages")
"course with" (http~: "www.cs.bgu.ac.il/~mira/" "Mira Balaban")
"and loved every minute."
item> "Was"
(http~: "departments.agri.huji.ac.il/studentorg/tali.htm" "sad"):"."
item> "Started a Master thesis work with"
(http~: "www.cs.bgu.ac.il/~mira/" "Dr. Mira Balaban"):"."
item> "September 12 - Married"
(http~: "www.cs.columbia.edu/~regina/" "Regina"):"."
item> "Prolog summer work in"
(http~: "www.shibutzit.com/" "Shibutzit"):"."
item> "Finished a Computer Science B.Sc. in the"
(http~: "www.cs.bgu.ac.il/" "Ben-Gurion CS dept"):".")
(h3: "1993")
(itemize: ::br 2
item> "Part of the"
(http~: "www.cs.bgu.ac.il/people/cs-lab.html" "sysadmin")
"group in the"
(http~: "www.cs.bgu.ac.il/" "Ben-Gurion CS dept"):".")
(h3: "1991")
(itemize: ::br 2
item> "Started learning in the"
(http~: "www.cs.bgu.ac.il/" "Ben-Gurion CS dept"):"."
item> "Worked with William Farjun, installing PCs."
item> "Happily released from the" (http~: "www.idf.il/" "Army"):".")
(h3: "1988")
(itemize: ::br 2
item> "Grabbed by the" (http~: "www.idf.il/" "Israeli Army"):", became a"
(http~: "www.idf.il/IMAGES/insig/34.gif" "\"combat engineer\""):","
"played with explosives and mines,"
"and learned that life can be incredibly stinking."
item> "Finished highschool at"
(http~: "www.habsor.org.il/" "Habsor"):".")
(h3: "1983")
(itemize: ::br 2
item> "Bought a" (http~: "project64.c64.org/" "Commodore 64"):"."
item> "Had a sad \"Barmitzva\".")
(h3: "1982")
(itemize: ::br 2
item> "Moved from Haruvit in Sinai to"
(http~: "www.habsor.org.il/yeshuvim/einhabsor/einhabsor.html"
"Ein-Habsor"):".")
(h3: "1981")
(itemize: ::br 2
item> "Had a children course on computers... first contact.")
(h3: "1977")
(itemize: ::br 2
item> "Moved from Bat-Yam to Haruvit in the Sinai Desert.")
(h3: "1970")
(itemize: ::br 2
item> "July 30, 1970, 5pm - Born in Tel-Aviv at the age of 0.")))
;;; ===========================================================================
(require (lib "pic-info.ss" "pics"))
(defhtml _random
:menu-msg "Random art stuff"
:menu-pos 'right
:bar-image "eyes.gif"
:color-style 'blue
(with-menu:
(let ([items '()])
(define (item title &rest args)
(set! items
(append! items (list (cons (big~: 2 (strong: title)) args)))))
(let ([slides
`(;; slide-name text-title files/image-regexp
("maze" "Maze" ,(ls "mazes" "^.*\\.gif$") "is life!")
("CS212" "Lambda" "CS212" "stuff I did for CS212.")
("Y" "Y-combinator" "Y" "the meaning of life.")
("regina" "Regina" "regina" "...")
("hamsa" "Hamsot&Eyes" "hamsa" "for good luck.")
("people" "People" "people" "friends etc."))])
(item (ref~: *pics-address* "Pictures:") "- digital photography."
(let* ([items '()]
[item (lambda args
(set! items (append! items (list args))))])
(let loop ([pqs predefined-queries]
[n predefined-main-num])
(cond
[(null? pqs) #f]
[(zero? n)
(item (case (length pqs)
[(1) "One"] [(2) "Two"] [(3) "Three"] [(4) "Four"]
[else (length pqs)])
" more set":(and (> (length pqs) 1) "s")
:" available, check the"
(ref~: *pics-address* "picture") "pages.")]
[else (item (ref~: *pics-address* : "query/" : (caar pqs)
(cadar pqs)))
(loop (cdr pqs) (sub1 n))]))
(item "A few"
(ref~: (html-ref-name _picture-journal) "words"):".")
(item (quickform: *pics-address* :"query"
"Query:" (text-input: :name "q")))
(item "All of this is from my"
(ref~: *server-address* "Scheme server"):".")
(item "Want an original resolution?"
"Just" (mailto~: *mail* "ask"):"...")
(apply itemize: items)))
(for-each (lambda (args)
(let ([name (car args)]
[title (cadr args)]
[files (caddr args)])
(item (ref~:
(thunk
(unless (list? files)
(set! files
(if (directory-exists?
(concat (*html-target-dir*)
(*image-dir*) files))
(ls (concat (*image-dir*) files))
(ls (*image-dir*) files))))
(make-slide-show name title files "random"))
title : ":")
"-" (cdddr args))))
slides)
(item (ref~: "toys/index.html" "Some toys:") "- with JavaScript.")
(apply itemize: ::br 2 items)))
(http~: "www.gimp.org/" (my-gif~ "gimp" "Gimp" :border 0))))
;;; ===========================================================================
(defhtml _hebrew
:title (rtl: (big~: 2 "אלי ברזילי: מייז איז לייף!"))
:window-title "Eli Barzilay - אלי ברזילי: Maze is Life!"
:menu-name "Hebrew"
:bar-image "eli.jpg"
:menu-msg "בוקר טוב!"
:menu-pos 'left
:color-style 'blue
(with-menu: (main-page #t)))
;;; ===========================================================================
(defhtml _bookmarks
:menu-msg "Places to go..."
:menu-pos 'right
:color-style 'yellow
:extra-header (list (style: "A {text-decoration:none;}"))
(letrec ([r (regexp "~\n *")]
[ref
(lambda (ref txt)
(let ([ref (cond [(not (string? ref)) ref]
[(not (regexp-match "^[a-z]+://" ref))
(concat "http://" ref)]
[else ref])])
(cond
[(and (string? ref)
(regexp-match "^((.*/)[^/]+)[?]([^=?]+)=%s" ref)) =>
(lambda (x)
(quickform:
(regexp-replace "#" (cadr x) "")
(ref~: (cond
[(regexp-match "^(.*)#(.*)$" (cadr x)) => cadr]
[else (caddr x)])
txt :":")
(text-input: :name (cadddr x))))]
[else (ref~: ref txt)])))]
[bookmarks
(lambda (tree)
(list
(if (and (not (null? (cdr tree))) (string? (cadr tree)))
(let* ([tree (map (lambda (x)
(if (string? x)
(regexp-replace* r x "") x))
tree)])
(text: (ref (car tree) (cadr tree))
(and (pair? (cddr tree))
(eq? :quicks (caddr tree))
(small~: 2 "\\ \\ "
(mapconcat
(lambda (q) (ref (car q) "[": (cdr q) :"]"))
(cdddr tree) " ")))))
(let ([r (apply itemize-bullet: (map bookmarks (cdr tree)))])
(if (car tree) (text: (b: (car tree)) r) r)))))])
((compose with-menu: bookmarks)
`(#f ; no need for global title
("Quick Queries"
("www.google.com/search?q=%s" "Google")
("groups.google.com/groups?q=%s" "Usenet")
("www.dictionary.com/#cgi-bin/dict.pl?term=%s" "Dictionary")
(,(concat *pics-address* "query?q=%s") "My Pictures")
(,(concat *server-address* "phones/query?q=%s") "My Phones"))
("Cornell"
("query.cornell.edu:8765/query.html?qt=%s" "Search")
("www.cornell.edu/bin/MapMove.x/M1-1-1?200,300" "CUinfo Maps")
("www.cornell.edu/Calendar/" "Calendar of Events"
:quicks ("www.cornell.edu/Events/AudioVideo.html" "Cinema"))
("www.cornell.edu/Ithaca/Weather/" "Weather Page")
("catalog.library.cornell.edu/" "Library Catalog")
;; ("telnet://catalog.library.cornell.edu:410" "Library Catalog (telnet)")
("www.cornellfcu.com/" "CFCU"))
("Israel Stuff"
("Networks"
("www.kol-israel.com/" "Kol-Israel.com")
("www.iguide.co.il/" "iGuide - Israeli Internet Guide")
("www.walla.co.il/" "Walla")
("dapey.reshet.co.il/data/index.htm" "Dapey Reshet")
("www.msn.co.il/" "MSN Israel")
("www.netvision.net.il/" "NetVision"))
("Radio"
("www.iba.org.il/" "Israel Broadcasting Authority")
("glz.msn.co.il/" "Galey Tzahal"
:quicks ("http://stream.msn.co.il/glzcam" "Video")
("http://stream.msn.co.il/glz-stream" "Audio")
("http://stream.msn.co.il/gglz" "Galgalatz"))
("bet.iba.org.il/" "Reshet Bet"
:quicks ("http://www.iba.org.il/bet/reshetbet.ram" "Audio"))
("www.100fm.co.il/" "Radios 100FM")
("www.102fm.co.il/" "Radio Tel Aviv")
("www.1075fm.co.il/" "Radio Haifa")
("www.99fm.co.il/" "Radio Sharon & Merkaz"))
("News"
("mabat.iba.org.il/" "Channel #1 - Mabat"
:quicks ("http://mabat.iba.org.il/audio/mabattv.ram" "Mabat")
("http://mabat.iba.org.il/audio/yomantv.ram" "Yoman")
("http://mabat.iba.org.il/audio/engnews.ram" "English"))
("glz.msn.co.il/" "Galey Tzahal")
("www.israelnews2.co.il/" "Channel2 News")
("www.ynet.co.il/" "Y-Net (Yediot)")
("www.maariv.co.il/" "Ma'ariv")
("www.haaretz.co.il/" "Ha'Aretz")
("www.haaretzdaily.com/" "Ha'Aretz in English")
("www.globes.co.il/" "Globes"))
("Entertainment etc"
("www.reshet-tv.com" "Reshet TV")
("www.keshet-tv.com" "Keshet TV")
;; ("www.netking.com/harsufim/" "The Harsufim")
;; ("yard.netvision.net.il//vdo/effi/" "Index of //vdo/effi")
("www.mayesh.net/" "MaYesh?")
("dapey.reshet.co.il/amin/" "The Amin Report")
("Jokes"
("www.com-edi.co.il/" "com-edi")
("www.humor.co.il/" "The Israeli Humor Site/Center"))
("www.hed-arzi.co.il/" "Hed-Arzi Home Page")
("www.interpage.co.il/magnet/" "Magnet"))
("stage.co.il" "New Stage")
("www.israelemb.org/" "Embassy of Israel"))
("Languages"
("Scheme"
("www.schemers.org/" "Schemers.org")
("www.plt-scheme.org/" "PLT Scheme")
("www.cs.indiana.edu/scheme-repository/SRhome.html"
"The Scheme Repository")
("www.ai.mit.edu/projects/su/" "The Scheme Underground")
("www.cs.cmu.edu/Groups/AI/html/faqs/lang/scheme/part2/faq.html"
"FAQ: Scheme Implementations")
("www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/~
ai/lang/scheme/0.html" "The CMU Scheme Repository")
("Implementations"
("www.cs.indiana.edu/scheme-repository/imp.html"
"Scheme Implementations")
("www.drscheme.org/" "DrScheme (+MzScheme etc)")
("www.swiss.ai.mit.edu/~jaffer/SCM.html" "SCM home page")
;; ("jk.offworld.org/" "SCM for win32 alpha version 2")
("s48.orh/" "Scheme48")
("www.scsh.net/" "Scheme Shell (scsh)")
("www.gnu.org/software/guile/guile.html" "Guile")
("www.swiss.ai.mit.edu/projects/scheme/index.html" "MIT Scheme")
("www.rscheme.org/" "RScheme")
("www.neci.nj.nec.com/PLS/kali.html" "Kali Scheme")
("people.delphi.com/gjc/winsiod.html" "Windows SIOD")
("www.stklos.org/" "STklos")
("www-sop.inria.fr/mimosa/fp/Bigloo" "Bigloo")
("www.gnu.org/software/kawa/" "Kawa")
("www.norvig.com/SILK.html" "JScheme (SILK)")
("www.alphaworks.ibm.com/tech/skij" "Skij")
("www.iro.umontreal.ca/~gambit/" "Gambit Scheme System")
("tinyscheme.sourceforge.net/" "TinyScheme")
("www.open-scheme.com/" "OpenScheme")
("www.schemers.com/" "EdScheme - Schemers Inc.")
("www.lispme.de/lispme/index.html" "LispME")
("www.ccs.neu.edu/home/will/Larceny/" "Larceny")
("www.mazama.net/scheme/pscheme.htm" "Pocket Scheme")
("www.scheme.com/" "Chez Scheme")
("www.call-with-current-continuation.org/chicken.html"
"The Chicken Compiler")
("schemix.org" "Schemix (Scheme in the Linux kernel)")
("www.malgil.com/sxm/" "SXM")
("square.umin.ac.jp/~hchang/ksm/" "KSM"))
("Books/Lectures"
("www.htdp.org/" "How to Design Programs")
("www.htus.org/" "How to Use Scheme")
("www.ccs.neu.edu/~dorai/t-y-scheme/t-y-scheme.html"
"Teach Yourself Scheme in Fixnum Days")
("www.scheme.com/tspl2d/" "The Scheme Programming Language")
("www.scheme.com/tspl3/" "The Scheme Programming Language")
("www.cs.rice.edu/~shriram/311/"
"Lecture Notes on the Principles of Programming Languages")
("mitpress.mit.edu/sicp/sicp.html" "SICP")
("www.cs.indiana.edu/eopl/" "Essentials of Programming Languages")
("www.cs.rice.edu/~matthias/TLS/" "The Little Schemer")
("www.cs.rice.edu/~matthias/TSS/" "The Seasoned Schemer"))
("Misc"
("Formatting"
("www.ccs.neu.edu/home/dorai/tex2page/tex2page-doc.html" "TeX2Page")
("www-sop.inria.fr/mimosa/fp/Scribe/" "Scribe")
("www.latte.org/" "Latte")
;; ("mailhost.integritysi.com/mailman/listinfo/schema" "Schema")
("www.cs.auc.dk/~normark/laml/" "LAML")
("brl.sourceforge.net/" "Beautiful Report Language")
("para.inria.fr/~maranget/hevea/" "The HEVEA Home Page"))
("Partial Evaluation"
("www.irisa.fr/lande/schism.html" "Schism")
("www.diku.dk/research-groups/topps/activities/similix.html"
"Similix"))
("Parsing"
("www.informatik.uni-freiburg.de/proglang/software/essence/"
"Essence"))
("www.ccs.neu.edu/~dorai/pregexp/pregexp.html" "")))
("Lisp"
("www.alu.org/" "The Association of Lisp Users")
("www.alu.org/HyperSpec/FrontMatter/index.html"
"Common Lisp HyperSpec")
("www.franz.com/" "Franz")
("www.harlequin.com/" "Harlequin")
("ww.telent.net/cliki" "CLiki")
("www.franz.com/resources/educational_resources/"
"Franz's Community Resources")
("www.paulgraham.com/onlisptext.html" "On Lisp")
("www.cs.cmu.edu/afs/cs.cmu.edu/user/dst/www/LispBook/index.html"
"Common Lisp: A Gentle Introduction to Symbolic Computation")
("psg.com/~dlamkins/sl/contents.html" "Successful Lisp")
;; ("cathcart.sysc.pdx.edu/lispos/" "The LispOS Project")
("tunes.org/" "TUNES"))
;; ("Dylan"
;; ("www.gwydiondylan.org/" "Gwydion Home Page")
;; ("www.fun-o.com/" "Functional Developer")
;; ("www.computer.org/pubs/expert/1996/trends/x10010/dylan.htm"
;; "IEEE Expert - The Dylan language")
;; )
("[O]Caml"
("www.ocaml.org/" "The OCaml language")
("caml.inria.fr/" "The Caml language")
("caml.inria.fr/camlp4" "CamlP4")
("pauillac.inria.fr/camltk/" "CamlTk")
("kaolin.unice.fr/~serrano/camloo.html" "Camloo"))
("Java"
("java.sun.com/docs/books/jls/html/index.html"
"The Java Language Specification")
("www.javasoft.com/products/jdk/1.1/docs/index.html"
"JDK 1.1.x Documentation")
("www.javasoft.com/products/jdk/1.1/docs/api/API_users_guide.html"
"API User's Guide")
("www.javasoft.com/products/jdk/1.1/docs/~
relnotes/demos.html" "JDK Demos")
("grunge.cs.tu-berlin.de/~tolk/vmlanguages.html"
"Languages for the Java VM"))
("HTML/CSS/JavaScript"
("www.htmlcodetutorial.com/" "IDocs Guide to HTML")
("www.htmlhelp.com/" "HTML Help")
("developer.netscape.com/docs/" "Netscape documentations")
("www.wsabstract.com/" "Website Abstraction")
("www.dynamicdrive.com/" "DynamicDrive DHTML"))
("Misc"
("www.curl.com/" "Curl")
("www.gwydiondylan.org/" "Gwydion Dylan")))
("Art"
;; ("kultur-online.com/greatest/fr-magrit.htm" "Rene Magritte")
;; ("www.jardindesarts.com/Di-maccio/supportdi.htm" "Gerard Di-Maccio")
("www.artchive.com/" "Artchive")
("www.magritte.com/" "The Official Magritte Site")
("www.worldofescher.com/" "The World of Escher")
("escherdroste.math.leidenuniv.nl/" "Escher and the Droste effect")
("www.mathacademy.com/platonic_realms/minitext/escher.html"
"The Mathematical Art of M.C. Escher")
("www.di-maccio.com/" "Di-Maccio")
("www.museummorpheus.com/contemp/dimaccio/" "Di-Maccio")
("www.michal-macku.cz/" "Michal Macku")
("ftp://ftp.sunet.se/pub/pictures/art/" "Art (ftp)")
("(Digital) Photography"
("www.hobokenalmanac.com/" "Hoboken Almanac")
("www.megapixel.net/" "MegaPixel.net")
("www.steves-digicams.com/" "Steve's Digicams (reviews)")
("www.dpreview.com/" "Digital Camera Reviews and News")
("wrotniak.net/photo/c5050/"
"Olympus Camedia C-5050Z (from wrotniak.net)")
("www.dcresource.com/" "Digital Camera Resource")
("www.photo.net/" "Photo.net")))
("Music"
("members.aol.com/midevlman/dcdindex.htm" "Dead Can Dance")
("www.depechemode.com/" "Depeche Mode")
("MP3"
("www.xmms.org" "X MultiMedia System")
("www.winamp.com/" "WinAmp")
("www.shoutcast.com" "SHOUTcast")
;; ("www.mp3site.com/" "mp3site.com")
))
("Free Software"
("www.gnu.org/" "GNU's Not Unix! - FSF: the GNU Project")
("filewatcher.org/" "FileWatcher.org")
("Emacs"
("www.gnu.org/software/emacs/emacs.html" "GNU Emacs")
("www.gnu.org/software/emacs/windows/ntemacs.html"
"GNU Emacs for Windows")
("www.gnusoftware.com/index.html" "GNU Software for Windows")
;; ("www.naggum.no/emacs/" "Erik Naggum on GNU Emacs")
)
("Linux"
("www.redhat.com/" "Red Hat Software, Inc.")
("ftp://sunsite.unc.edu/pub/Linux/distributions/redhat/"
"RedHat download")
("www.debian.org/"
"Debian GNU/Linux - The Universal Operating System")
("www.slackware.com/" "The Slackware Linux Project"))
("Unix stuff for Windows"
("sources.redhat.com/cygwin/" "Cygwin")
("www.research.att.com/sw/tools/uwin/" "Unix for WINdows")
("fmg-www.cs.ucla.edu/fmg-members/geoff/ispell-winnt.html"
"Configuring ISPELL for Windows"))
("Graphics"
("www.gimp.org/" "The GIMP Homepage")
("www.gphoto.org/" "gPhoto")
("gimp-savvy.com/" "Gimp-Savvy"))
("www.gnome.org/" "GNOME Project")
("www.gtk.org/" "The GIMP Toolkit")
("www.kde.org/" "The K Desktop Environment")
;; ("scwm.mit.edu/" "Scheme-Configurable Window Manager")
("sawmill.sourceforge.net/" "Sawfish Window Manager")
("www.uk.research.att.com/vnc/" "VNC - Virtual Network Computing"))
("Dictionaries"
("www.dictionary.com" "Dictionary.com")
("www.m-w.com/dictionary" "WWWebster Dictionary"))
("Ithaca"
("www.ithaca.ny.us/" "IthacaNet")
("www.moosewoodrestaurant.com/" "moosewood restaurant"))
("Misc"
("www.irs.ustreas.gov/" "IRS")
("www.tax.state.ny.us/" "NY Tax")
("www.playsite.com/" "PlaySite")
("www.tug.org" "TeX Users Group")
("www.giss.nasa.gov/latex/" "Hypertext Help with Latex")
("www.tex.ac.uk/cgi-bin/texfaq2html?introduction=yes" "TeX FAQ")
("www.pricewatch.com/" "Price Watch - Street Price Search")
("www.cs.cmu.edu/~mleone/how-to.html"
"Advice on Research and Writing"))
("Nietzsche"
("www.usc.edu/dept/annenberg/thomas/nietzsche.html"
"The Nietzsche Page at USC")
("www.swan.ac.uk/german/fns/fns.htm" "Friedrich Nietzsche Society"))
("EBooks"
("www.computerbooks.web.com" "Computer Books")
("promo.net/pg/" "Project Gutenberg")
("www.ipl.org/" "The Internet Public Library")
("etext.lib.virginia.edu/" "Electronic Text Center")
("www.electricpress.com/" "electricpress.com"))
("Friends"
("www.geocities.com/SiliconValley/Peaks/5804/" "Doron Barzilay")
;; ("www.cs.huji.ac.il/~jesse/" "Jesse Alpert")
("www.cs.columbia.edu/~noemie/" "Noemie Elhadad")
("www.jiayo.net/" "Shawn Liu")
("www.geocities.com/SunsetStrip/Underground/2044/" "Gil Shalev"))))))
;;; ===========================================================================
(defhtml _meaning
:title "The Meaning of Life"
:menu-in-img "spinstar"
:menu-out-img "spinstar0"
:menu-sel-img "spinlambda0"
:extra-img-preload "spinlambda"
:menu-msg "You can see the light!"
:menu-pos 'right
:color-style 'magenta
(with-menu:
(break~: 2)
(center:
(ref~:
*image-dir* : "lambda.jpg"
:OnMouseOver
"document._meaning_img.src = '" : *image-dir* : "spinlambda.gif';"
: "return true;"
:OnMouseOut
"document._meaning_img.src = '" : *image-dir* : "spinlambda0.gif';"
: "return true;"
(my-jpg~ "lambda0" "((lambda (x) (x x)) (lambda (x) (x x)))"))
(let* ([Y "(function(x){ return x(x); })"]
[YY (list "'" Y Y "'")])
(script:
"function ydemo() {"
" eval(window.prompt(\"DON'T hit OK - it will only evaluate this"
:" expression, but your browser might die.\", ": YY :"));"
"}"))
(form:
(button: :value "Live Demo!" :OnClick "ydemo()")))))
;;; ===========================================================================
(define *pages* (reverse *defined-htmls*))
;;; ===========================================================================
(defhtml _reflection
:title "Practical Reflection for Nuprl"
(without-menu:
"Material related to my implementation of reflection in"
(http~: "www.nuprl.org/" "Nuprl"):":"
(itemize:
item> "The current status of the \"Reflection\" theory is accessible in"
"this automatically-generated"
(ref~: "misc/reflection.ps" "PostScript") "file."
item> "An example of using it is a formalization of the"
(ref~: "misc/tarski.ps" "Tarski")
"argument about the undefinability of truth."
item> "The Tarski proof is also available in HTML format made by Stuart's"
"Nuprl magic tricks, with either"
(ref~: "reflection/ElisTarskiPf_A/XElisTarskiPfIntro_A.html"
"my preferred notations")
"or using"
(ref~: "reflection/ElisTarskiPf_B/XElisTarskiPfIntro_B.html"
"his style"):"."
item> "The HOAS representation is described in"
(em: "\"Reflecting Higher-Order Abstract Syntax in Nuprl\"")
(ref~: "misc/hoas-paper.ps.gz" "[PostScript]")
(ref~: "misc/hoas-paper.pdf" "[PDF]"):".")))
;;; ===========================================================================
(defhtml _booms
:title "BOOMS"
:window-title "BOOMS Object Oriented Music System"
(without-menu:
(p: _"For my Master thesis, I have developed a music editor that is actually
a structure editor aimed at creative editing. This work should be
documented better on-line, but time is short..."_)
(p: _"Anyway, the system is not in a working state anymore, I have written
it in an old Allegro Lisp for Windows, which is no longer supported,
since they have modified the Windows interface. I hope that at some
point in the future I will revive it, since the idea is something
which is still not available in any decent music editor."_
(ref~: (concat (*image-dir*) "booms.jpg") "Here")
"is a proof that it wasn't a dream...")
(p: "The system is described in my" (ref~: "misc/booms.ps.gz" "thesis")
"and more recently in"
(em: "\"Abstraction as a Means for End-User Computing in Creative"
"Applications\"")
"(available as a" (ref~: "misc/booms-paper.ps.gz" "PostScript")
"and a" (ref~: "misc/booms-paper.pdf" "PDF"):")."
"There is also a" (ref~: "misc/booms-talk.ps.gz" "talk")
"I gave recently (with text ":(ref~: "misc/booms-talk.txt" "comments")
:").")
(p: "I did this work under the supervision of"
(http~: "www.cs.bgu.ac.il/~mira/" "Mira Balaban"):", and with"
"additional help from"
(http~: "www.cs.bgu.ac.il/~elhadad/" "Michael Elhadad"):".")))
;;; ===========================================================================
'
(defhtml _mazes
:menu-msg "The maze gallery."
:menu-pos 'top
(with-menu:
"These mazes were created using ":(tt: (ref~: "mazes/maze.ss" "maze.ss")):
" (written for MrEd)."
(script: "var mazetarget = '';")
(table: :width "100%"
(tr:
(form:
(map (lambda (x)
(list (button: :value ,(basename x)
:OnClick ("document.themaze.src = '" x "'; "
"mazetarget = '" x "'"))
(newline!:)))
(ls "mazes" "\\.gif$"))))
(tr:
(td: :align 'center
(ref~: "mazes.html"
:OnClick
"if (mazetarget != '') window.location = mazetarget; ":
"return false;"
(my-gif~ "choose-maze" "The Maze"
:width 600 :height 600 :name "themaze")))))))
;;; ===========================================================================
'
(defhtml _drinks
:title "Coke machine votes"
:body-extra-args '(:onLoad "update();")
(let ([drinks '((coke "Classic Coke" #t)
(cfcoke "Caffeine-free Coke" #f)
(dtcoke "Diet Coke" #t)
(cfdtcoke "Caffeine-free Diet Coke" #f)
(cherry "Cherry Coke" #f)
(dtcherry "Diet Cherry Coke" #f)
(sprite "Sprite" #f)
(dtsprite "Diet Sprite" #f)
(tab "Tab" #f)
(fresca "Fresca" #f)
(mello "Mello Yello" #f)
(barqs "Barq's Root Beer" #t)
(dtbarqs "Barq's Diet Root Beer" #f)
(csbarqs "Barq's Cream Soda" #f)
(pepper "Dr. Pepper" #t)
(sfpepper "Sugar-free Dr. Pepper" #t)
(ginger "Canada Dry Ginger Ale" #t)
(sunkist "Sunkist Orange Soda" #f)
(welchs "Welch's Grape Soda" #f)
(squirt "Squirt" #f)
(orangej "Orange Juice" #f)
(applej "Apple Juice" #f)
(grapefj "Grapefruit Juice" #f)
(craprs "Apple/Cranberry/Raspberry Blend" #f)
(fstrawj "Fruit Strawberry Juice" #f)
(fgrapej "Fruit Grape Juice" #f)
(fintj "Fruit Integration (Punch)" #f)
(ftangj "Fruit Tangerine Juice" #f)
(fkiwij "Fruit Kiwi Juice" #f)
(ctime "Country Time (Yellow Lemonade)" #f)
(nestea "Nestea Cool" #t))]
(my-input:
(lambda args
(apply text-input: :readonly #t :size 2 :onChange "update();"
args))))
(without-menu:
`(script:
"var vleft = 20;"
,@(map (lambda (x) "var ":(car x):" = 0;") drinks)
"function update() {"
" x = document.voter;"
" x.vleft.value = vleft;"
,@(map (lambda (x) " x.":(car x):".value = ":(car x):";") drinks)
" x.email.focus();"
"}"
,@(mappend (lambda (x)
`(("function more_" ,(car x) "() "
"{ if (vleft>0) "
"{ vleft--; " ,(car x) "++; update(); } }")
("function less_" ,(car x) "() "
"{ if (" ,(car x) ">0) "
"{ ",(car x)"--; vleft++; update(); } }")))
drinks)
"function update_and_submit() {"
" update();"
" if (document.voter.email.value == '') {"
" window.alert('No Email specified!');"
" return false;"
" }"
" return ("
" vleft == 0 ||"
" window.confirm('More votes left, continue?') );"
"}")
(let ([cells
(map (lambda (x)
`((:align right ,(if (caddr x) (b: (cadr x)) (cadr x)))
(:align center
,(my-input: :name (car x))
((button: :value " + "
:onClick ("more_" ,(car x) "();")
:onDblClick ("more_" ,(car x) "();"))
(button: :value " - "
:onClick ("less_" ,(car x) "();")
:onDblClick ("less_" ,(car x) "();"))))))
drinks)])
`(center:
(form:
:name voter
:method post
:action "http://polar.csuglab.cornell.edu/~eli/cgi-bin/voter.cgi"
:onSubmit "return update_and_submit();"
"Your email:"
((text-input: :size 8 :name email) "@cs.cornell.edu")
(break~: 2)
"Votes left:" ,(my-input: :name 'vleft)
"(do not edit the numbers, just click the buttons)"
(break~: 2)
(table*: :border 2
,@(nsplit 6 (apply append cells))
((:colspan 6 :align center :bgcolor "pink"
(submit~: "Submit!")))))))
(itemize:
item> "things in" (b: "bold") "are what we have now"
item> "you can re-submit to override your last vote"
item> "everything from Orange Juice on is non-soda"
item> "mail problems to" (mailto~ *mail*)))))
;;; ===========================================================================
'
(defhtml _corvette
:title "Corvette for sale"
(without-menu:
(apply table: :cellspacing 0 :cellpadding 3 :align 'center
(map (lambda (line) (apply tr: (map (lambda (x) (td: x)) line)))
(nsplit 6 (map (lambda (p1 p2) (thumb-ref p1 :ref p2))
(ls "corvette" "[0-9][0-9].jpg")
(ls "corvette" "[0-9][0-9]s.jpg")))))
br:
(itemize:
item> "1984 Corvette."
item> "8-Cylinder cross-fire engine, 5.7L."
item> "Originally came from Canada."
item> "Low millage: 83500 (mostly highway)."
item> "Very few minor scratches (can be seen in the pictures)."
item> "Includes original equipment & parts."
item> "Hood holder broken (as seen in the engine picture)."
item> "Want: $6200 (negotiable) (no trades)."
item> "Call Haim: 1-718-727-0833 (day time) for details.")
"Full pictures:"
br: ; <--- needed
(apply table: :cellspacing 0 :cellpadding 3 :align 'center
(map (lambda (line) (apply tr: (map (lambda (x) (td: x)) line)))
(nsplit 6 (map thumb-ref (ls "corvette" "[0-9][0-9].jpg")))))))
;;; ===========================================================================
(defhtml _picture-journal
:title "Some words on some pictures."
(without-menu:
(let* ([link (lambda (_ ref)
(regexp-case ref
(("^(.*):([^:]*)$" l s) (ref~: l s))
("^[0-9]+$" (thumb-ref (concat "images/pics/" ref ".jpg")
:scale 1/2))
("/.*\\.(jpg|gif)" (thumb-ref ref :scale 1/2))))]
[replace (regexp-replacements (list "<([^<>]+)>" link))])
(do-replacements replace (map (lambda (p) (apply p: p))
'(("My name is Eli "
".")
("I'm a <0642> student in"
" <0058>, working with"
" <0718>, on"
" <0033>. In 1999 I started doing stuff"
" for my minor in"
", which started with"
"the basic idea of a loop and advanced to"
" abstract things (with the help of"
").")
("In April 2000 I discovered <0001> digital photography when"
""
"<0539> pushed me. With normal cameras <0014> you wait forever: finish the"
"roll, take it to the photo shop, take the pictures back, scan them -- and"
"by that time you've forgot what picture you took... With a digital camera"
"<0470>, however, it is all a matter of seconds: see, click & download"
"<0493> <0621> <0581>...")
("In the beginning, <0007> I just took pictures <0042> like crazy <0047>,"
"but then <0173> things settled and I found some themes <0261> that I like"
"to play <0280> with. The major <0033> one is tightly related to my"
"research <0480> work: reflection <0050>. The meaning <0505> of this word"
"is very context <0413> sensitive, but there are <0635> always"
"equivalences: to reflect <0509> you basically need three elements. You"
"need a way of quoting <0479> (representing syntactic objects), a way to"
"reference yourself <0477>, and a reflection rule <0372>. In terms of"
"photographs (or maybe the <0411> \"real\" world), syntax would be any"
"visual <0523> form, so any photo <0430> is representing such syntax,"
"self-reference <0473> is any way someone (or something <0483>) relates to"
"itself, and a reflection <0476> rule is what makes the connection between"
"quotes and the real things <0498> they stand for (when I think about"
"myself, the image <0478> is indeed connected to me).")
("So, I like reflection <0459>, but there are some other games I'm trying."
"playing with light <0057> is something I really like: the way it behaves"
"with the digital camera lens <0173>, twisted colors <0084> <0101> <0102>"
"<0533>, getting too much <0100> or too little <0537>, long exposures"
"<0349> <0464> <0613>, nights <0191> from my car (more <0589> lights <0599>"
"= <0603> more <0605> fun) and much more <0210> <0542> <0550> <0555>. I"
"use my wife <0485> whenever possible <0361>, and some friends (mainly"
"Noemie <0308> <0595>) and family (my father <0222> and my uncle <0354>) as"
"well. Naturally, I use computers <0216> a lot since I'm surrounded by"
"them <0068>. I'm also trying to use works that I like <0378> for ideas"
"here <0475> and there <0639>, but there is still a long way ahead.")))))))
;;; ===========================================================================
(define gallery-size '(8 10))
(define (thumb-cell pic &optional [ref pic])
(list (thumb-ref pic :ref ref)))
(defhtml _navigator
:title "Slide navigator"
(lambda args
(html~: #f
(list
(script:
"var last_hilite = 0;"
"var sname = parent.sname;"
"var slides = parent.slides;"
"var slidenames = new Array();"
"for ( i = 0; i < slides.length; i++ )"
" slidenames[i] = slides[i].substring(slides[i].lastIndexOf('/')+1);"
"function get_cur() {"
" var loc = String(parent.target.location);"
" loc = loc.substring(loc.lastIndexOf('/')+1);"
" for ( i = 0; i < slidenames.length; i++ )"
" if ( slidenames[i] == loc )"
" return i+1;"
" return 0;"
"}"
"function set_slide_arrow(slide,arrow) {"
;; 2 pics each, slide base is 1, one pic for prev
" var img = "
: "parent.toc.document.images[slide*2-2+((parent.prevg!='')?1:0)];"
" if (img) {"
" img.src = 'images/arrow_'+arrow+'.gif';"
" return true;"
" } else return false;"
"}"
"function highlight(slide) {"
" var tloc = String(parent.toc.location);"
" tloc = tloc.substring(tloc.lastIndexOf('/')+1);"
" sloc = 'slides-'+parent.sname+'-toc.html';"
" if (last_hilite == 0 && slide > 0 && tloc != sloc) {"
" parent.toc.location = sloc;"
" if (set_slide_arrow(slide,'red')) last_hilite = slide;"
" else last_track = '???';"
" } else if (last_hilite > 0 && slide == 0) {"
" loc = 'images/eyes90.gif';"
" if (tloc != 'eyes90.gif') parent.toc.location = loc;"
" last_hilite = slide;"
" } else if (tloc != 'eyes90.gif') {"
" if (last_hilite > 0) set_slide_arrow(last_hilite,'blank');"
" if (slide > 0) {"
" if (set_slide_arrow(slide,'red')) last_hilite = slide;"
" else last_track = '???';"
" } else last_hilite = slide;"
" }"
"}"
"function prev_group() {"
" if (parent.prevg != '')"
" parent.location = 'slides-' + parent.prevg + '.html'"
"}"
"function next_group() {"
" if (parent.nextg != '')"
" parent.location = 'slides-' + parent.nextg + '.html'"
"}"
"function select(slide) {"
" if (slide > slides.length) {"
" if (parent.nextg != '') return next_group();"
" else slide = 0;"
" }"
" if (slide < 0) {"
" if (parent.prevg != '') return prev_group();"
" else slide = slides.length;"
" }"
" parent.target.location = "
: "(slide==0) ? 'slides-' + sname + '-idx.html' : slides[slide-1];"
" highlight(slide);"
" parent.target.focus();"
"}"
"function select_prev() { select(get_cur()-1); }"
"function select_next() { select(get_cur()+1); }"
"// Track slide for user movements (using history)"
"var last_track = '???';"
"function track_slide() {"
" var curloc = String(parent.target.location);";must turn to a string!
" if (curloc == last_track) {"
" setTimeout('track_slide()', 1000);"
" } else {"
" last_track = curloc;"
" var slide = get_cur();"
" if (slide != last_hilite) highlight(slide);"
" setTimeout('track_slide()', 500);"
" }"
"}"
"setTimeout('track_slide()', 1500);"))
(body: :bgcolor "black"
(center:
(let ([button
(lambda (label action gif &optional reftext)
(list :align 'center :width 90
(ref~: action
:OnMouseOver "window.status = '": label :"';"
:OnMouseOut "window.status = '';"
(or reftext (my-gif~ gif label :border 0)))))]
[space '(:width 120 "\\ ")])
(table*: :cellspacing 0 :cellpadding 0 :align 'center
row> :height 1
space
(button "prev group" "javascript:prev_group();" "arrow_red_ll")
(button "prev" "javascript:select_prev();" "arrow_red_l")
(button "index" "javascript:select(0);" "arrow_red_c")
(button "next" "javascript:select_next();" "arrow_red_r")
(button "next group" "javascript:next_group();" "arrow_red_rr")
space
(button "back to random"
"javascript:parent.location = parent.back;"
#f (size-2: "...back")))))))))
(define (make-slide-show0 sname slides-title images back
&keys [prevg :prev #f] [nextg :next #f]
[showprev? #t] [shownext? #t])
(define main-name (concat "slides-" sname))
(define index-name (concat "slides-" sname "-idx"))
(define toc-name (concat "slides-" sname "-toc"))
(define title (concat "Slides: " slides-title))
(define (prev-link)
(and prevg (ref~: (concat "slides-" prevg (*html-suffix*))
:target "_top"
(my-gif~ "arrow_red_ll" "prev group" :border 0))))
(define (next-link)
(and nextg (ref~: (concat "slides-" nextg (*html-suffix*))
:target "_top"
(my-gif~ "arrow_red_rr" "next group" :border 0))))
(defhtml main-html
:name main-name
:title title
(lambda args
(html~: title
(list
(apply script:
"var sname = '": sname :"';"
"var back = '": (concat back (*html-suffix*)) :"';"
"var prevg = '": prevg :"';"
"var nextg = '": nextg :"';"
"var i = 0;"
"var slides = new Array();"
(map (lambda (f) "slides[i++] = '": f :"';") images)))
(frameset: :rows "40,*" :border 0
(frame: :name "nav" :src (html-ref-name _navigator)
:scrolling 'no)
(frameset: :cols "160,*" :border 0
(frame: :name "toc" :src "images/eyes90.gif")
(frame: :name "target" :src (html-ref-name index-html)))))))
(defhtml index-html :name index-name :title slides-title : " index"
(lambda (&keys title &rest args)
(let ([cell (lambda (x) (td: :align 'center x))]
[space (td: :width 120 "\\ ")])
(html~: title #f
(body: :bgcolor "black"
(table*: :cellspacing 0 :cellpadding 0 :align 'center
row> :height 1
col> :align 'center (and showprev? (prev-link))
col> :align 'center title
col> :align 'center (and shownext? (next-link)))
(apply table*: :cellspacing 0 :cellpadding 3 :align 'center
(map (lambda (line) (map thumb-cell line))
(nsplit (car gallery-size) images))))))))
(defhtml toc-html :name toc-name :title title
(lambda args
(html~: title
'((script: "function sel(slide) { parent.nav.select(slide); }"))
(body: :bgcolor "black"
(let ([i 0])
`(table*: :width 110 :cellspacing 0 :cellpadding 3 :align center
,(and prevg `(:align center ,(prev-link)))
,@(map (lambda (f)
(define b (basename f))
(set! i (add1 i))
(my-gif~ :border 0 :align 'middle :hspace 2
"arrow_blank" "")
: (thumb-cell f (format "javascript:sel(~a)" i)))
images)
,(and nextg `(:align center ,(next-link)))))
(counter-thing main-name)))))
(and (not (null? images)) (html-ref-name main-html)))
(define (make-slide-show sname slides-title images back)
(define lists (nsplit (apply * gallery-size) images))
(if (= (length lists) 1)
(make-slide-show0 sname slides-title images back)
(let ([i 0] [r #f])
(define (name i) (format "~a-~a" sname i))
(for-each (lambda (images)
(set! i (add1 i))
(set! r
(make-slide-show0
(name i)
(format "~a [~a/~a]" slides-title i (length lists))
images back
:prev (name (if (> i 1) (sub1 i) (length lists)))
:next (name (if (< i (length lists)) (add1 i) 1))
:showprev? (> i 1)
:shownext? (< i (length lists)))))
lists)
r)))
;;; ===========================================================================
(define ((menu-preload &keys [cur-name :name #f] extra-img-preload) pages)
(let* ([preloaded-images '()]
[add-menu-image
(lambda (image)
(let ([image (concat (*image-dir*) image ".gif")])
(unless (member image preloaded-images)
(set! preloaded-images (cons image preloaded-images)))))])
(cond [extra-img-preload => add-menu-image])
(for-each
(lambda (page)
(if (equal? cur-name (getarg page :name))
(add-menu-image
(getarg page :menu-sel-img *menu-sel-img*))
(begin
(add-menu-image (getarg page :menu-in-img *menu-in-img*))
(add-menu-image (getarg page :menu-out-img *menu-out-img*)))))
pages)
(script: "var my_preloaded = new Array();"
"function preload_images() {"
(let loop ([i 0] [p preloaded-images])
(if (null? p)
'()
(cons (list " my_preloaded[" i "] = new Image;"
newline!:
" my_preloaded[" i "].src = '" (car p) "';"
newline!:)
(loop (+ i 1) (cdr p)))))
"}")))
(define (make-menu-entry this-name &keys
[page-name :name #f]
[menu-name (string-capital page-name)]
[in-img :menu-in-img *menu-in-img*]
[out-img :menu-out-img *menu-out-img*]
[sel-img :menu-sel-img *menu-sel-img*]
[menu-msg ""]
[suffix ""]
fgcolor bgcolor)
(let ([img-name (concat "_" page-name "_img")])
(list :nowrap #t :bgcolor bgcolor
(size-2: br:)
(let ([content
(list
(my-gif~
(if (equal? this-name page-name) sel-img out-img) *text-bullet*
:align 'middle :border 0 :hspace 2 :name img-name)
menu-name)]
[img-src= "document.": img-name :".src = '":(*image-dir*)]
[return "return true;"])
(if (equal? this-name page-name)
(big: (strong: content))
(ref~: (concat page-name (*html-suffix*))
:title menu-msg
:OnMouseOver img-src= : in-img :".gif';": return
:OnMouseOut img-src= : out-img :".gif';": return
(color~: fgcolor content))))
(size-2: suffix : br: : "\\ "))))
(define (make-menu &keys
[this-name :name #f] [menu-pos 'left] [color-style 'blue])
(define (index-of x l)
(let loop ([l l] [n 0])
(if (equal? (car l) x) n (loop (cdr l) (add1 n)))))
(define this-index
(index-of this-name (map (lambda (p) (getarg p :name)) *pages*)))
(define (this-color page)
(let* ([x1 (* 24 (- 10 (abs (- this-index (index-of page *pages*)))))]
[x2 (/ x1 2)])
(apply format "#~x~x~x"
(case color-style
[(red) (list x1 x2 x2)]
[(green) (list x2 x1 x2)]
[(blue) (list x2 x2 x1)]
[(yellow) (list x1 x1 x2)]
[(magenta) (list x1 x2 x1)]
[(cyan) (list x2 x1 x1)]))))
(apply table*: :cellspacing 0 :cellpadding 0
(let ([fgcolor (case color-style
[(red) "#40FFFF"]
[(green) "#FF40FF"]
[(blue) "#FFFF40"]
[(yellow) "#4040FF"]
[(magenta) "#40FF40"]
[(cyan) "#FF4040"])])
(if (memq menu-pos '(top bottom))
`((:align left
,@(map (lambda (page)
(apply make-menu-entry this-name
:bgcolor (this-color page)
:fgcolor fgcolor :suffix "\\ \\ "
page))
*pages*)))
(map (lambda (page)
`(:align left
,(apply make-menu-entry this-name
:bgcolor (this-color page) :fgcolor fgcolor
page)))
*pages*)))))
(define (title-ize lines &keys name
[title (string-capital name)]
[bar-image *bar-image*])
(apply text: (center: (h2: title) (my-image~ bar-image *text-bar*)) br:
lines))
(define (my-html lines &rest args &keys
name
[title (string-capital name)]
[window-title (concat *title-prefix* title)]
[bar-image *bar-image*]
with-menu?
[show-title? #t]
[body-extra-args '()]
[color-style 'blue]
[extra-header #f]
[charset-type (*charset-type*)])
(define header '())
(when with-menu?
(set! header (cons ((apply menu-preload args) *pages*) header)))
(when extra-header
(set! header (append extra-header header)))
(html~: window-title header
`(body: ,@(make-body-args color-style) ; body args
,@(if with-menu? (list :OnLoad "preload_images();") '())
,@body-extra-args
,(if show-title? (apply title-ize lines args) lines) ; html body
,br: ,(counter-thing name))
:charset-type charset-type))
(define (my-html-with-menu lines &rest args &keys
name
[title (string-capital name)]
[window-title (concat *title-prefix* title)]
[bar-image *bar-image*]
[menu-pos 'left]
[color-style 'blue])
(apply
my-html
(table: ::indent? #f :width "100%" :height "100%"
:border 0 :cellspacing 0 :cellpadding 0
(let* ([menu (td: ::newlines? #t ::indent? #f :valign 'top :width 80
(comment: "Menu junk begins here")
(apply make-menu args)
(comment: "Menu junk ends here"))]
[body (td: ::indent? #f ::spaces? #f :valign 'top
:width "100%" (apply title-ize lines args))]
[tr: (lambda args (apply tr: ::indent? #f args))]
[vline (td: ::indent? #f :valign 'top :width 5 :height 5
:bgcolor (case color-style
[(red) "#600000"]
[(green) "#006000"]
[(blue) "#000060"]
[(yellow) "#606000"]
[(magenta) "#600060"]
[(cyan) "#006060"])
;; (size-2: "\\ ")
(my-gif~ "blank5x5" ""))]
[hline (tr: :height 1 vline)]
[nl newline!:])
(case menu-pos
[(left) (tr: menu : nl : vline : nl : body)]
[(right) (tr: body : nl : vline : nl : menu)]
[(top) (tr: menu) : nl : hline : nl : (tr: body)]
[(bottom) (list (tr: body) : nl : hline : nl : (tr: menu))])))
:with-menu? #t
:show-title? #f
args))
;;; ===========================================================================
(define (main args) (html-main (cdr args)))
;;; ===========================================================================
;;Local variables:
;;mode: swindle
;;enable-local-eval: t
;;eval: (put 'output-to-html 'scheme-indent-function 1)
;;eval: (put 'thunk 'scheme-indent-function 'defun)
;;hide-local-variable-section: t
;;End: