init repo

.gitignore

@@ -0,0 +1,5 @@
+*~
+*.min.fnl
+.clj-kondo/
+.lsp/
+tokens.clj

README.md

@@ -0,0 +1,27 @@
+# Time Guesser Game
+
+This game is made with the L5 Fennel template. For the docs on that read ./TEMPLATE.md
+
+## Dev
+
+To get hot reloading dev experience run:
+
+```shell
+$ echo main.fnl | entr -r ./dev.sh
+```
+
+
+## Dev minifier
+
+When working on the minifier code you can also get hot reloading with char count printing; just run:
+
+```shell
+$ echo minify.bb | entr -s './minify.bb main.fnl && wc -c main.min.fnl'
+```
+
+
+Run minifier unit tests:
+
+```shell
+$ bb minify_test.bb
+```

TEMPLATE.md

@@ -0,0 +1,33 @@
+# L5 in Fennel template
+
+[Repo](https://codeberg.org/durian/l5-fennel-template.git)
+
+A minimalist template for using [L5](https://github.com/L5lua/L5) within [Fennel](https://fennel-lang.org/).
+
+[L5](https://l5lua.org/) is built on top of [LÖVE](https://www.love2d.org/), and it provides a Processing API for Lua. It's meant for interactive artwork on the computer, aimed at artists, designers, and anyone that wants a flexible way to prototype art, games, toys, and other software experiments in code.
+
+To use it in Fennel, we can use the [Absolutely Minimal Fennel Setup for Love2D](https://sr.ht/~benthor/absolutely-minimal-love2d-fennel/) template for `main.lua`, but modify it to add the `allowedGlobals=false` option for L5 to work properly. We do this because L5 sets global variables that we want to allow and `allowedGlobals=false` disables that check.
+
+```fennel
+fennel = require("fennel")
+debug.traceback = fennel.traceback
+table.insert(package.loaders,
+	     function(filename)
+			if love.filesystem.getInfo(filename) then
+				return function(...)
+					return fennel.eval(love.filesystem.read(filename), {env=_G, filename=filename, allowedGlobals=false}, ...), filename
+				end
+			end
+	     end)
+
+require("main.fnl")
+```
+
+Inside `main.fnl`, the other thing that we need to do is to expose the functions that L5 expects:
+
+```fennel
+(set _G.setup setup)
+(set _G.draw draw)
+```
+
+Now you can simply run `love .` in the root of your project directory and you should be good to go!

bootstrap.fnl

@@ -0,0 +1,5 @@
+(local m (require "main.min.fnl"))
+
+(set _G.setup m.setup)
+(set _G.draw m.draw)
+(set _G.keyPressed m.key-pressed)

dev.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+/Applications/love.app/Contents/MacOS/love .

main.fnl

@@ -0,0 +1,51 @@
+(require :L5)
+
+(fn setup []
+  (size 640 480)
+  (textSize 100))
+
+(local colors {
+  :yellow [255 228 112] ; #ffe470
+  :dark [64 56 48] ; #403830
+})
+
+(lambda remap [v in-min in-max out-min out-max]
+  (+ out-min (* (/ (- v in-min) (- in-max in-min)) (- out-max out-min))))
+
+(local steps (* 24  60))
+(var step 0)
+
+(lambda lpad [num] (if (< num 10) (.. "0" num) num))
+(lambda time [num]
+  (let [hour (floor (remap num 0 steps 0 24))
+       min (- num (* hour 60))]
+    (.. (lpad hour) ":" (lpad min))))
+
+(var pause false)
+(var won false)
+(fn key-pressed []
+  (when (= key "space") (set pause (not pause))))
+
+(local goal-time (floor (random 0 steps)))
+
+(fn draw []
+  (when (and (not won) (not pause)) (set step (+ step 1)))
+  (when (>= step steps) (set step 0))
+  (let [
+        half (/ steps 2)
+        color-step (if (> step half) (- half (- step half)) step)
+        color-fn #(+ (. colors.dark $1) (* (/ (- (. colors.yellow $1) (. colors.dark $1)) half) color-step))
+        r (color-fn 1)
+        g (color-fn 2)
+        b (color-fn 3)]
+    (background r g b))
+    (text (time step) 175 150)
+    (text (time goal-time) 175 250)
+    (when (and pause (= goal-time step)) (set won true))
+    (when won (text "YOU WIN" 100 400)))
+
+{
+  :setup setup
+  :draw draw
+  :key-pressed key-pressed
+}

main.lua

@@ -0,0 +1,20 @@
+-- Mostly from https://sr.ht/~benthor/absolutely-minimal-love2d-fennel/
+-- But added the allowedGlobals=false option
+
+fennel = require("fennel")
+debug.traceback = fennel.traceback
+table.insert(package.loaders, function(filename)
+	if love.filesystem.getInfo(filename) then
+		return function(...)
+			return fennel.eval(
+				love.filesystem.read(filename),
+				{ env = _G, filename = filename, allowedGlobals = false },
+				...
+			),
+				filename
+		end
+	end
+end)
+
+-- jump into Fennel
+require("bootstrap.fnl")

minify.bb

@@ -0,0 +1,184 @@
+#!/usr/bin/env bb
+(ns minify
+  (:require
+   [babashka.fs :as fs]
+   [clojure.pprint :refer [pprint]]
+   [clojure.string :as str])
+  (:import
+   'java.io.StringReader))
+
+;; TOKENIZE
+(defn is-whitespace [c] (contains? #{\  \tab \newline \return} c))
+(defn tokenize [source]
+  (let [chars (vec source) total-chars (count chars)]
+    (loop [cursor 0 tokens []]
+      ; (when (< cursor 100) (pprint {:tokens tokens}))
+      (if (>= cursor total-chars)
+        tokens
+        (let [c (chars cursor) nxt (get chars (inc cursor))]
+          (cond
+            ;; comment — inner loop scans to end of line
+            (= c \;)
+            (let [end (loop [j cursor]
+                        (if (or (>= j total-chars) (= (chars j) \newline))
+                          j
+                          (recur (inc j))))]
+              (recur end (conj tokens {:type :comment :value (apply str (subvec chars cursor end))})))
+            ;; whitespace — consume the whole run as one :space token
+            (is-whitespace c)
+            (let [end (loop [j cursor]
+                        (if (or (>= j total-chars) (not (is-whitespace (chars j))))
+                          j
+                          (recur (inc j))))]
+              (recur end (conj tokens {:type :space :value nil})))
+            (contains? #{\( \[ \{} c)
+            (recur (inc cursor) (conj tokens {:type :open-paren :value (str c)}))
+            (contains? #{\) \] \}} c)
+            (recur (inc cursor) (conj tokens {:type :close-paren :value (str c)}))
+            ;; strings
+            (= c \")
+            (let [end (loop [j (inc cursor)]
+                        (if (or (>= j total-chars) (= (chars j) \"))
+                          (inc j)
+                          (recur (inc j))))]
+              (recur end (conj tokens {:type :string :value (apply str (subvec chars cursor end))})))
+            (and nxt (= c \#) (= nxt \())
+            (recur (+ cursor 2) (conj tokens {:type :open-annon-fn :value "#("}))
+            :else
+            ; (let [delimiters #{\( \) \[ \] \{ \} \; \" \, \@ \` \'}
+            (let [delimiters #{\( \) \[ \] \{ \} \; \" \, \@ \` \'}
+                  cursor2 (loop [j cursor]
+                            (if (or (>= j total-chars) (is-whitespace (chars j)) (contains? delimiters (chars j))) j
+                                (recur (inc j))))]
+              (if (= cursor2 cursor)
+                (recur (inc cursor) (conj tokens {:type :unknown :value (str c)}))
+                (recur cursor2 (conj tokens {:type :symbol :value (apply str (subvec chars cursor cursor2))}))))))))))
+
+; COLLECT BINDING
+(def built-ins #{"fn" "local" "λ" "lambda" "require" "let" "+" "-" "/" "*" "<" ">" "<=" ">=" "not=" ".."
+                 "var" "if" "when" "and" "or" "not" "do" "set" "each" "for" "while"
+                 "true" "$1" "math.floor" "floor" "false" "nil" "size" "textSize" "background" "text" "random" "key"
+                 ":setup" ":draw" ":key-pressed" ":L5"})
+
+(defn collect-bindings [tokens]
+  (reduce (fn [acc token]
+            (let [val (:value token)]
+              (cond
+                (nil? val) acc
+                ; handle table access create bindings for each element tools.wrench -> tools wrench
+                (re-matches #"^[a-z]+\..*" val) ; table access
+                (apply conj acc (str/split val #"\."))
+                (and
+                 (> (count val) 1)
+                 (not (re-matches #"^:.*" val)) ; exclude keywords
+                ;; (not (re-matches #"^[a-z]+\..*" val)) ; table access
+                 (not (re-matches #"\d+" val))
+                 (not (get built-ins val))
+                 (= (:type token) :symbol))
+                (conj acc val)
+                :else
+                acc))) #{} tokens))
+
+;; BUILD RENAME MAP
+(defn short-name-seq
+  "Lazy infinite seq of short names. like a,b,c..aa,bb,cc..zzzzz"
+  []
+  (let [letters (map str "abcdefghijklmnopqrstuvwxyz")]
+    (mapcat (fn [length]
+              (map (fn [letter] (apply str (repeat length letter))) letters))
+            (range 1 Long/MAX_VALUE))))
+
+(defn build-rename-map [names]
+  (zipmap names (short-name-seq)))
+
+;; EMIT
+(def simple-replace-map {"lambda" "λ" "local" "var"})
+(def drop-tokens #{:space :comment})
+
+(defn needs-space?
+  "does this token need space before it?"
+  [prev current nxt]
+  (when (= (current :type) :string) (pprint {:current current}))
+  (or
+   (= (current :type) :open-annon-fn)
+   (and
+    prev
+    (= (prev :type) :string)
+    (contains? #{:symbol :open-paren} (current :type)))
+   (= (current :type) :string)
+    ; space needed: prev is :symbol or :close-paren, AND current is :symbol or :open-paren
+   (and
+    prev
+    (or (= (prev :type) :symbol) (= (prev :type) :close-paren))
+    (or (= (current :type) :symbol) (= (current :type) :open-paren)))))
+
+(defn add-space [tokens]
+  (loop [cursor 0 result []]
+    (if (>= cursor (count tokens))
+      result
+      (let [prev (when (pos? cursor) (get tokens (dec (count result))))
+            curr (tokens cursor)
+            nxt (when (< (inc cursor) (count tokens)) (tokens (inc cursor)))]
+        (recur (inc cursor)
+               (if (needs-space? prev curr nxt)
+                 (conj result (assoc curr :value (str " " (curr :value))))
+                 (conj result curr)))))))
+
+(defn transform-tokens
+  "get tokens ready to emit"
+  [tokens re-map]
+  (->>
+   tokens
+    ; drop whitespace and comments
+   (remove (fn [token] (drop-tokens (token :type))))
+    ; make simple replaces
+   (map (fn [token] (if (simple-replace-map (token :value))
+                      (assoc token :value (simple-replace-map (token :value)))
+                      token)))
+   ;; apply rename map
+   (map (fn [token]
+          (let [val (token :value)]
+            (cond
+              (nil? val) token
+              ; keywords
+              (and (re-matches #"^:.*" val) (not (built-ins val)))
+              (assoc token :value (str ":" (re-map (subs val 1))))
+              ; table access
+              (re-matches #"^[a-z]+\..*" val)
+              (assoc token :value  (->> (str/split val #"\.")
+                                        (map #(re-map %))
+                                        (str/join ".")))
+              ; keywords
+              :else
+              (if-let [new-value (re-map (token :value))]
+                (assoc token :value new-value)
+                token)))))
+   (vec)
+    ; add needed space before ( { [
+    ; space needed: prev is :symbol or :close-paren, AND current is :symbol or :open-paren
+   (add-space)))
+
+(defn emit [tokens re-map]
+  (->>
+   (transform-tokens tokens re-map)
+   (reduce (fn [acc token] (conj acc (:value token))) [])
+   (str/join "")))
+
+(defn write-file
+  "Write a file to the file system"
+  [file-name content]
+  (fs/write-lines file-name [content]))
+
+(defn gen-output-file-name [file-name] (str/replace file-name #"\.fnl$" ".min.fnl"))
+
+(when (first *command-line-args*)
+  (let [file-name (first *command-line-args*)
+        source (slurp file-name)
+        tokens (tokenize source)
+        re-map (build-rename-map (collect-bindings tokens))
+        output (emit tokens re-map)
+        output-file-name (gen-output-file-name file-name)]
+    (pprint {:output output :token-sample (take 15 tokens) :bindings (build-rename-map (collect-bindings tokens))})
+    (write-file "tokens.clj" (with-out-str (pprint (transform-tokens tokens re-map))))
+    (write-file output-file-name output)
+    (println (str "Wrote file " output-file-name))))

minify_test.bb

@@ -0,0 +1,43 @@
+(ns minify-test
+  (:require [clojure.test :refer [deftest is testing run-tests]]))
+
+(load-file "minify.bb")
+(refer 'minify :only '[tokenize emit short-name-seq])
+
+(deftest test-tokenize
+  (is (= [{:type :open-paren, :value "("}
+          {:type :symbol, :value "+"}
+          {:type :space, :value nil}
+          {:type :symbol, :value "1"}
+          {:type :space, :value nil}
+          {:type :symbol, :value "1"}
+          {:type :close-paren, :value ")"}
+          {:type :space, :value nil}
+          {:type :comment, :value "; how to add"}
+          {:type :space, :value nil}
+          {:type :open-paren, :value "("}
+          {:type :symbol, :value "var"}
+          {:type :space, :value nil}
+          {:type :symbol, :value "name"}
+          {:type :space, :value nil}
+          {:type :open-paren, :value "("}
+          {:type :symbol, :value ".."}
+          {:type :space, :value nil}
+          {:type :string, :value "\"jane\""}
+          {:type :space, :value nil}
+          {:type :string, :value "\"doe\""}
+          {:type :close-paren, :value ")"}
+          {:type :close-paren, :value ")"}]
+
+         (tokenize "(+ 1 1) ; how to add\n(var name (.. \"jane\" \"doe\"))"))))
+
+(deftest test-short-name-seq
+  (let [short-names (vec (take 1000 (short-name-seq)))]
+    (is (= (get short-names 0) "a"))
+    (is (= (get short-names 1) "b"))
+    (is (= (get short-names 25) "z"))
+    (is (= (get short-names 26) "aa"))
+    (is (= (get short-names 345) "hhhhhhhhhhhhhh"))
+    (is (= (get short-names 733) "fffffffffffffffffffffffffffff"))))
+
+(run-tests 'minify-test)