Fixed water level rendering bug.
[microbotany.git] / view.scm
1 ;; View a garden
2 ;;
3
4 (lambda (uri)
5   (import (chicken io))
6   (for-each eval (with-input-from-file "garden.scm" read-list))
7   (serve-document-header (ext->mime "gmi"))
8   (let ((query (uri-query uri)))
9     (if (null? query)
10         (begin
11           (print "=> register.scm Please register first."))
12         (let ((hash (symbol->string (caar query))))
13           (condition-case
14               (let* ((g (with-input-from-file (make-pathname "accounts" hash) read))
15                      (user (garden-prop 'user g))
16                      (visits (+ 1 (garden-prop 'visits g))))
17                 (garden-prop-set! 'visits visits g)
18
19                 (print "# " user "'s garden\n")
20                 (if (> visits 1)
21                     (print "Welcome back, " user "!\n")
22                     (begin
23                       (print "Welcome to your new garden, " user "!\n"
24                              "\n"
25                              "## !!Important!!\n\n"
26                              "To visit and check on your garden, you'll need to use this link:\n"
27                              (uri->string uri) "\n"
28                              "Remember to bookmark it to keep it safe!\n")))
29
30                 (update-garden! g)
31                 (with-output-to-file (make-pathname "accounts" hash)
32                   (lambda ()
33                     (write g)))
34
35                 (print "```")
36                 (display-garden g)
37                 (print "```")
38                 (describe-garden g)
39
40                 (print "\nWater level:")
41                 (print "```")
42                 (display-water-level g)
43                 (print "```")
44
45                 (print "\n## Menu")
46                 (print "\n=> water.scm?" hash " Water plant\n")
47
48                 (when (= (garden-prop 'stage-idx g) 5)
49                     (print "=> plant-new.scm?" hash " Plant a new seed\n"))
50
51                 (print
52                        "=> help.scm?" hash " Caring for your plant (Instructions)\n"
53                        "\n"
54                        "=> delete-confirm.scm?" hash " Delete garden (Irreversible!)\n"
55                        "\n"
56                        "=> ./ μBotany start page"))
57             
58             (o (exn)
59                (print "This garden no longer exists.\n\n"
60                       "=> register.scm Register to create another.")))))))
61