Wire up proof of concept!

This commit is contained in:
Scott Richmond 2023-11-24 18:41:26 -05:00
parent 8c19cca9e7
commit a072191081
8 changed files with 73 additions and 114 deletions

View File

@ -1,6 +1,7 @@
{:deps {:deps
{org.clojure/clojurescript {:mvn/version "1.11.121"} {org.clojure/clojurescript {:mvn/version "1.11.121"}
thheller/shadow-cljs {:mvn/version "2.26.0"}} thheller/shadow-cljs {:mvn/version "2.26.0"}
}
:aliases :aliases
{:main {:main

8
package-lock.json generated
View File

@ -8,6 +8,9 @@
"name": "ludus", "name": "ludus",
"version": "1.0.0", "version": "1.0.0",
"license": "ISC", "license": "ISC",
"dependencies": {
"p5": "^1.8.0"
},
"devDependencies": { "devDependencies": {
"shadow-cljs": "^2.26.0" "shadow-cljs": "^2.26.0"
} }
@ -707,6 +710,11 @@
"integrity": "sha512-gjcpUc3clBf9+210TRaDWbf+rZZZEshZ+DlXMRCeAjp0xhTrnQsKHypIy1J3d5hKdUzj69t708EHtU8P6bUn0A==", "integrity": "sha512-gjcpUc3clBf9+210TRaDWbf+rZZZEshZ+DlXMRCeAjp0xhTrnQsKHypIy1J3d5hKdUzj69t708EHtU8P6bUn0A==",
"dev": true "dev": true
}, },
"node_modules/p5": {
"version": "1.8.0",
"resolved": "https://registry.npmjs.org/p5/-/p5-1.8.0.tgz",
"integrity": "sha512-LHzRRl+aWEZVXmK+L9TDRNw5zm90wvwMdY7yTmsFkdNeXrU9n2KSZbonCTXkyGgriguovxJrDDgyhkynOxWB1A=="
},
"node_modules/pako": { "node_modules/pako": {
"version": "1.0.11", "version": "1.0.11",
"resolved": "https://registry.npmjs.org/pako/-/pako-1.0.11.tgz", "resolved": "https://registry.npmjs.org/pako/-/pako-1.0.11.tgz",

View File

@ -15,5 +15,8 @@
"license": "ISC", "license": "ISC",
"devDependencies": { "devDependencies": {
"shadow-cljs": "^2.26.0" "shadow-cljs": "^2.26.0"
},
"dependencies": {
"p5": "^1.8.0"
} }
} }

View File

@ -1,6 +1,8 @@
;; shadow-cljs configuration ;; shadow-cljs configuration
{:deps true {:deps true
:dev-http {8234 "target"}
:builds :builds
{:node {:target :node-library {:node {:target :node-library
:output-to "target/js/ludus.js" :output-to "target/js/ludus.js"
@ -9,5 +11,5 @@
:modules {:main {:entries [ludus.core]}}} :modules {:main {:entries [ludus.core]}}}
:browser {:target :browser :browser {:target :browser
:output-dir "target/js" :output-dir "target/js"
:asset-path "/assets" :asset-path "target"
:modules {:main {:entries [ludus.core]}}}}} :modules {:main {:init-fn ludus.web/init}}}}}

View File

@ -25,22 +25,4 @@
nil nil
) )
(let [interpreted (interpreter/interpret source parsed)] (let [interpreted (interpreter/interpret source parsed)]
(println (show/show interpreted)) (show/show interpreted)))))))
interpreted))))))
(defn main! []
(println "Ludus says, hi there...")
#?(:clj (println "...from Clojure.")
:cljs (println "...from ClojureScript."))
(run ":foo")
(run "add (1, 2)")
(run "nil")
(run "if true then :foo else :bar")
)
(run ":foo")
(run "add (1, 2)")
(run "nil")
(run "if true then :foo else :bar")

View File

@ -844,20 +844,20 @@
#?( #?(
:clj clojure.lang.ExceptionInfo :clj clojure.lang.ExceptionInfo
:cljs js/Object :cljs js/Object
)) ))
;; TODO: update this to use new parser pipeline & new AST representation ;; TODO: update this to use new parser pipeline & new AST representation
(defn interpret [source parsed] (defn interpret
(try ([source parsed] (interpret source parsed {}))
(let [base-ctx (volatile! {::parent (volatile! prelude/prelude)})] ([source parsed ctx]
(interpret-ast parsed base-ctx)) (try
(catch #?(:cljs :default :clj Throwable) e (let [base-ctx (volatile! {::parent (volatile! (merge prelude/prelude ctx))})]
(println "Ludus panicked!") (interpret-ast parsed base-ctx))
(println "On line" (get-in (ex-data e) [:ast :token :line])) (catch #?(:cljs :default :clj Throwable) e
(println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line]))) (println "Ludus panicked!")
(println (ex-message e)) (println "On line" (get-in (ex-data e) [:ast :token :line]))
(pp/pprint (ex-data e) (println ">>> " (get-line source (get-in (ex-data e) [:ast :token :line])))
;;(System/exit 67) (println (ex-message e))
)))) (pp/pprint (ex-data e)
;;(System/exit 67)
(+ 1 2) )))))

40
src/ludus/web.cljs Normal file
View File

@ -0,0 +1,40 @@
(ns ludus.web
(:require
[ludus.core :as core]
[goog.object :as o]
)
)
(defn get-element [id]
(.getElementById (.-document js/window) id))
(def canv (get-element "canv"))
(def code (get-element "code"))
(def out (get-element "output"))
(def play (get-element "play"))
(defn run-code []
(let [source (.-value code)
result (core/run source)]
(println "Running code:" source)
(o/set out "value" result)))
(.addEventListener play "click" run-code)
(defn setup []
(js/createCanvas 640 240 canv)
(js/background 235)
)
(defn draw []
(if js/mouseIsPressed
(js/fill 255)
(js/fill 155))
(js/ellipse js/mouseX js/mouseY 80 80))
(doto js/window
(o/set "setup" setup)
(o/set "draw" draw))

View File

@ -1,77 +0,0 @@
(ns ludus.turtle-graphics
(:require [quil.core :as q]
[quil.middleware :as m]))
(defn setup []
(q/frame-rate 60)
(q/color-mode :rgb)
{:position [0 0]
:path []})
(def path (atom []))
(defn turns->degrees [turns] (mod (+ 90 (* -360 turns)) 360))
(turns->degrees -0.25)
(defn degrees->turns [degs] (mod (/ (- degs 90) -360) 1))
(degrees->turns 360)
(defn add [[x1 y1] [x2 y2]] [(+ x1 x2) (+ y1 y2)])
(defn sub [[x1 y1 [x2 y2]]] [(- x1 x2) (- y1 y2)])
(defn scale [[x y] m] [(* x m) (* y m)])
(defn heading->vec [heading]
(let [degs (turns->degrees heading)]
[(Math/cos degs) (Math/sin degs)]))
(defn vec->heading [[x y]]
(degrees->turns (Math/atan2 x y)))
(defn forward [steps]
(let [prev (peek @path)
heading (:heading prev)
unit (heading->vec heading)
move (scale unit steps)
curr (update prev :postion #(add % move))]
(swap! path #(conj % curr))))
(defn back [steps] (forward (* -1 steps)))
(defn right [turns]
(let [prev (peek @path)
curr (update prev :heading #(- % turns))]
(swap! path #(conj % curr))))
(defn left [turns] (right (* -1 turns)))
(comment
:path {:start [x y] :end [x y] :color [R G B]}
)
(defn update-state [state]
{:color (mod (+ (:color state) 0.7) 255)
:angle (+ (:angle state) 0.1)})
(defn draw-state [state]
(q/background 240)
(q/fill (:color state) 255 255)
(let [angle (:angle state)
x (* 150 (q/cos angle))
y (* 150 (q/sin angle))]
(q/with-translation [(/ (q/width) 2) (/ (q/height) 2)]
(q/ellipse x y 100 100))))
(defn ludus-draw []
(q/defsketch sketch
:title "Hello Ludus"
:size [500 500]
:setup setup
:update update-state
:draw draw-state
:features []
:middleware [m/fun-mode])
:ok)