~technomancy/tremendous-quest-iv

tremendous-quest-iv/env.fnl -rw-r--r-- 5.3 KiB
a3c24536Phil Hagelberg Bump to Fennel 0.9.1; fix some bugs. 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
;; This is mostly taken from Bussard; it sets up a sandboxed environment for
;; running "in-game" code

;; https://git.sr.ht/~technomancy/bussard/tree/master/env.fnl

(local editor (require :polywell))
(local fmt (require :polywell.lib.fnlfmt))
(local lume (require :polywell.lib.lume))
(local fennel (require :polywell.lib.fennel))
(local fennelview (require :polywell.lib.fennelview))
(local completion (require :polywell.completion))
(local fs (require :fs))

(local world (require :world))

(fn iterator-for [iterate raw ?wrap]
  (fn []
    (let [t [] wrap (or ?wrap (fn [x] x))]
      (each [k v (iterate raw)]
        (tset t k (if (= (type v) :table) (wrap v) v)))
      (values next t nil))))

(fn read-only [source table-name]
  (fn newindex []
    (error (.. (or table-name "table") ": read only")))
  (setmetatable {} {:__index (fn [_ key]
                               (if (= (type (. source key)) :table)
                                   (read-only (. source key))
                                   (. source key)))
                    :__newindex newindex
                    :__pairs (iterator-for pairs source read-only)
                    :__ipairs (iterator-for ipairs source read-only)
                    :__maxn (partial table.maxn source)}))

(local safe-globals [:assert :error :next :pcall :xpcall
                     :select :tonumber :tostring :type :unpack
                     :coroutine :math :table :string])

(local env {:package {:loaded {:polywell editor
                               :polywell.completion (require :polywell.completion)
                               :lume lume
                               :utf8 (require :polywell.lib.utf8)}}
            ;; the repl's implementation of cross-chunk local saving needs this
            :debug {:getlocal (fn getlocal [level local-num]
                                (if (= level 1)
                                    (debug.getlocal 1 local-num)
                                    (error "Disallowed!")))}
            :editor editor
            :print editor.print
            :pp (fn [x] (editor.print (fennelview x)))
            :rpp (fn [x] (print (fennelview x)))
            :realprint print

            :lume lume
            :graphics love.graphics
            :keyboard love.keyboard
            :image (fn [name] (love.graphics.newImage (.. "assets/" name)))
            :os {:exit (fn [] (love.event.quit))}
            :fmt fmt

            :pairs pairs
            :ipairs ipairs
            :messages []})

(set env._G env)

(each [_ g (ipairs safe-globals)]
  (tset env g (. _G g)))

(fn env.loadstring [code chunkname]
  (let [(chunk err) (loadstring code chunkname)]
    (if chunk
        (doto chunk (setfenv env))
        (values chunk err))))

(fn env-options [?options]
  (let [options (or ?options {})]
    (set options.env (or options.env env))
    options))

(set env.fennel
     {:eval (fn eval [str options ...]
              (fennel.eval str (env-options options) ...))
      :repl (fn repl [options]
              (fennel.repl (env-options options)))
      :dofile (fn [filename ?options]
                (let [source (fs.read filename)
                      options (or ?options {:filename filename})]
                  (env.fennel.eval source (env-options options))))
      :compileString (fn [str options ...]
                       (fennel.compileString str (env-options options) ...))
      :view fennelview})

(set env.package.loaded.fennel env.fennel)

(λ env.require [module]
  (or (. env.package.loaded module)
      (let [path (: module :gsub "%." "/")
            fnl-code? (= :file (fs.type (.. path ".fnl")))
            lua-code (fs.read (.. path ".lua"))
            value (if fnl-code?
                      (env.fennel.dofile (.. path ".fnl") {:correlate true})
                      lua-code
                      (let [chunk (assert (env.loadstring lua-code path)
                                          (.. "Could not load " module))]
                        (chunk))
                      (error (.. "Module " module " not found")))]
        (tset env.package.loaded module value)
        value)))

(λ env.reload [module]
  (if (: module :find "^/") ; allow reloading kernel modules too
      (lume.hotswap (: module :sub 2))
      (let [old (assert (. env.package.loaded module) (.. "No module: " module))
            _ (tset env.package.loaded module nil)
            (ok new) (pcall env.require module)
            new (if (not ok) (do (print new) old) new)]
        (when (= (type new) :table)
          ;; TODO: save off old values; recover if there's an error
          (each [k v (pairs new)]
            (tset old k v))
          (each [k (pairs old)]
            (when (not (. new k))
              (tset old k nil)))
          (tset env.package.loaded module old)))))

(fn editor.cmd.reload []
  (editor.read-line "module: " env.reload
                    {:completer (partial completion.for
                                         (lume.keys env.package.loaded))}))

(λ env.add-message [message]
  (when (not= message (. env.messages 1))
    (table.insert env.messages 1 message))
  (while (<= 64 (# env.messages))
    (table.remove env.messages 64)))

{:init (fn []
         (world.init env fs read-only)
         (editor.start (fn [dt] (world.update dt))) ; for reloadability
         (editor.set-fs fs true)
         (env.require "start"))}