update scripts

9 files changed, 552 insertions, 10 deletions

diff --git a/Makefile b/Makefile
index d22772d..6c593e9 100644
--- a/Makefile
+++ b/Makefile
@@ -3,9 +3,12 @@ SHELL := /bin/bash
 TARGET := wasm32-unknown-unknown
 BINARY := target/$(TARGET)/release/slgj-2025.wasm
 
-.PHONY: build serve
+.PHONY: build run
 
-build:
+build-wasm:
 	cargo build --target $(TARGET) --release; \
 	mkdir -p www; \
 	cp -f $(BINARY) www/slgj-2025.wasm
+
+run:
+	cargo run; \
diff --git a/scripts/main.el b/scripts/main.el
new file mode 100644
index 0000000..2c6c54d
--- /dev/null
+++ b/scripts/main.el
@@ -0,0 +1,3 @@
+(defun draw ()
+  (rq-draw-circle 50.0 50.0 40.0)
+  )
diff --git a/scripts/main.scm b/scripts/main.scm
new file mode 100644
index 0000000..9db17fc
--- /dev/null
+++ b/scripts/main.scm
@@ -0,0 +1,299 @@
+(load "./scripts/structs.scm")
+(load "./scripts/utils.scm")
+(load "./scripts/prompt.scm")
+(load "./scripts/gol.scm")
+
+(define current-stage-number 0)
+(define current-generation 0)
+(define current-pressed-key #f)
+(define starting-cells (list))
+(define trigger-level-reload #t)
+(define overlay-fade-time 0.0)
+(define is-advancing #f)
+
+
+(define stages (list (list '(1 . 0)
+			   '(1 . 1)
+			   '(0 . 0)
+			   '(0 . 1))
+		     (list '(0 . -1)
+			   '(1 . 0)
+			   '(0 . 1)
+			   '(-1 . 0))
+		     (list '(0 . 0)
+			   '(0 . 1)
+			   '(0 . 2))
+		     (list '(0 . 0)
+			   '(-1 . 0)
+			   '(0 . -1))
+		     (list '(1 . 0)
+			   '(0 . 1))
+		     (list '(2 . 0)
+			   '(1 . 0)
+			   '(1 . 1)
+			   '(0 . 1)
+			   '(0 . 2))
+		     (list '(-1 . -1)
+			   '(0 . -1)
+			   '(1 . 0)
+			   '(0 . 1)
+			   '(-1 . 1)
+			   '(-2 . 0))
+		     (list '(-1 . -1)
+			   '(0 . -1)
+			   '(1 . -1)
+			   '(-1 . 0)
+			   '(1 . 0)
+			   '(-1 . 1)
+			   '(0 . 1)
+			   '(1 . 1))
+		     (list '(0 . -1)
+			   '(0 . 0)
+			   '(0 . 1)
+			   '(1 . -1)
+			   '(1 . 0)
+			   '(1 . 1)
+			   '(2 . 0))
+		     ))
+
+(define (update-generation)
+  (clear-cells)
+  (set-cells-array starting-cells)
+
+  (let loop ((times 0))
+    (if (< times current-generation)
+	(begin (run-step)
+	       (loop (+ times 1)))
+	)
+    )
+  )
+
+(define (is-solution? l1)
+  (define trigger #t)
+  (for-each (lambda (c)
+	      (if (not (hash-table-ref current-cells c))
+		  (begin (set! trigger #f)))
+	      )
+	    (stages current-stage-number))
+  (and trigger (eq? (length (stages current-stage-number)) (length (hash-table-keys current-cells))))
+  )
+
+(define (update-game)
+  
+  (set! current-pressed-key (rl-get-key-pressed))
+  
+  (prompt-update)
+
+  (if trigger-level-reload
+      (begin (set! starting-cells (list))
+	     (clear-cells)
+	     (set-cells-array starting-cells)
+	     (set! trigger-level-reload #f)))
+  
+  (cond ((and (not prompt-active) (not is-advancing))
+	 (if (eq? current-pressed-key KEY_LEFT)
+	     (cond ((> current-generation 0)
+		    (set! current-generation (- current-generation 1))
+		    (update-generation)))
+	     )
+	 
+	 (if (eq? current-pressed-key KEY_RIGHT)
+	     (cond ((< current-generation 1)
+		    (set! current-generation (+ current-generation 1))
+		    (update-generation)))
+	     )
+	 
+	 ))
+
+  (if (and (eq? current-generation 1) (not is-advancing))
+      (if (is-solution? (stages current-stage-number))
+	  (begin (set! is-advancing #t)
+		 (set! overlay-fade-time 0.0))
+	  )
+      )
+
+  (if (and (rl-is-mouse-button-pressed) (eq? current-generation 0))
+      (let ((mouse-pos (rl-get-mouse-position)))
+	(define tile-x (floor ( / (- (mouse-pos 0) 275) 50)))
+	(define tile-y (floor ( / (- (mouse-pos 1) 200) 50)))
+	(if (and (>= tile-x -1)
+		 (<= tile-x 1)
+		 (>= tile-y -1)
+		 (<= tile-y 1))
+	    (begin (toggle-cell `(,tile-x . ,tile-y))
+		   (set! starting-cells (get-cells-list))))
+	))
+
+  (if is-advancing
+      (set! overlay-fade-time (+ overlay-fade-time (rl-get-frame-time)))
+      (set! overlay-fade-time (- overlay-fade-time (rl-get-frame-time)))
+      )
+
+  (if (> overlay-fade-time 1.0)
+      (begin (set! is-advancing #f)
+	     (clear-cells)
+	     (set! starting-cells (list))
+	     (set! current-generation 0)
+	     (set! current-stage-number (+ current-stage-number 1))
+	     )
+      )
+  )
+
+(define (update-end)
+  (if is-advancing
+      (set! overlay-fade-time (+ overlay-fade-time (rl-get-frame-time)))
+      (set! overlay-fade-time (- overlay-fade-time (rl-get-frame-time)))
+      )
+  )
+
+(define (update)
+  (if (>= current-stage-number (length stages))
+      (update-end)
+      (update-game)
+      )
+  )
+
+(define (draw-game)
+  (rl-draw-rectangle 0 0 600 450 (make-color 255 255 255 255))
+  
+  (prompt-draw)
+  
+  (rl-draw-text (string-append "Level " (number->string current-stage-number)) 75 15 20 (make-color 0 0 0 255))
+
+  (draw-cells)
+
+  (draw-grid)
+
+  (draw-generation)
+  
+  (define lerped-alpha (* 255.0 overlay-fade-time) )
+  (if (< lerped-alpha 0.0)
+      (set! lerped-alpha 0.0))
+
+  (rl-draw-rectangle 0 0 600 450 (make-color 255 255 255 (floor lerped-alpha)))
+  )
+
+(define (draw-end)
+  (rl-draw-rectangle 0 0 600 450 (make-color 255 255 255 255))
+  
+  (rl-draw-text "The end! Thank you for playing :)"  38 200 30 (make-color 0 0 0 255))
+
+  (rl-draw-text "Made with Raylib + S7 Scheme"  146 340 20 (make-color 0 0 0 255))
+  
+  (define lerped-alpha (* 255.0 overlay-fade-time) )
+  (if (< lerped-alpha 0.0)
+      (set! lerped-alpha 0.0))
+
+  (rl-draw-rectangle 0 0 600 450 (make-color 255 255 255 (floor lerped-alpha)))
+  )
+
+(define (draw-generation)
+  
+  (let loop ((times 0))
+    (if (< times 2)
+	(begin
+	  (rl-draw-rectangle (+ 75 (* times 40))
+			     410
+			     30
+			     30
+			     (make-color 190 190 190 255))
+	  (if (eq? times current-generation)
+	      (rl-draw-rectangle (+ 80 (* times 40))
+				 415
+				 20
+				 20
+				 (make-color 0 0 0 255)))
+	  
+	  (loop (+ times 1))
+	  )))
+
+  )
+
+(define (draw)
+  (if (>= current-stage-number (length stages))
+      (draw-end)
+      (draw-game)
+      )
+  )
+
+
+(define (draw-grid)
+  (define cell-width 50)
+  (define cell-height 50)
+  
+  (let loop ((times 10))
+    (if (> times 0)
+	(begin (rl-draw-line (+ (* times cell-width) (* cell-width 0.5))
+			     50
+			     (+ (* times cell-width) (* cell-width 0.5))
+			     400
+			     (make-color 200 200 200 255))
+	       (loop (- times 1)))
+	)
+    )
+
+  (let loop ((times 8))
+    (if (> times 0)
+	(begin (rl-draw-line 75
+			     (* times cell-height)
+			     525
+			     (* times cell-height)
+			     (make-color 200 200 200 255))
+	       (loop (- times 1)))
+	)
+    )
+
+  (let loop ((times 4))
+    (if (> times 0)
+	(begin (rl-draw-line (+ (* times cell-width) 175)
+			     150
+			     (+ (* times cell-width) 175)
+			     300
+			     (make-color 0 0 0 255))
+	       (loop (- times 1)))
+	)
+    )
+
+  (let loop ((times 4))
+    (if (> times 0)
+	(begin (rl-draw-line 225
+			     (+ (* times cell-height) 100)
+			     375
+			     (+ (* times cell-height) 100)
+			     (make-color 0 0 0 255))
+	       (loop (- times 1)))
+	)
+    )
+  )
+
+(define (draw-cells)
+  (define cell-width 50)
+  (define cell-height 50)
+  (define cell-color (if (eq? current-generation 0)
+			 (make-color 190 100 255 255)
+			 (make-color 255 190 100 255)))
+
+  
+  (for-each (lambda (cell)
+	      (rl-draw-rectangle
+	       (+ (* (car cell) cell-width) (- 300 (* cell-width 0.5)) )
+	       (+ (* (cdr cell) cell-height) (- 225 (* cell-height 0.5)) )
+	       cell-width
+	       cell-height
+	       cell-color)
+	      
+	      ) (hash-table-keys current-cells))
+
+
+  (for-each (lambda (cell)
+	      (rl-draw-rectangle
+	       (+ (* (car cell) 50) 290 )
+	       (+ (* (cdr cell) 50) 215 )
+	       20
+	       20
+	       (make-color 255 190 100 255))
+	      
+	      ) (stages current-stage-number))
+
+  
+  )
diff --git a/scripts/prompt.scm b/scripts/prompt.scm
new file mode 100644
index 0000000..e78e5b3
--- /dev/null
+++ b/scripts/prompt.scm
@@ -0,0 +1,45 @@
+(define prompt-active #f)
+(define prompt-box (make-rect 0 0 800 20))
+(define prompt-text "")
+
+(define (prompt-update)
+  (if (eq? current-pressed-key KEY_F1)
+      (set! prompt-active (not prompt-active))
+      )
+  
+  (if prompt-active
+      (begin
+	(let ((key (rl-get-char-pressed)))
+	  (cond ((and (>= key 32) (<= key 125))
+		 (set! prompt-text
+		       (string-append prompt-text (string (integer->char key)))))
+		))
+	
+	(if (rl-is-key-down KEY_ENTER)
+	    (begin
+	      (eval-string prompt-text)
+	      (set! prompt-text "")
+	      ))
+	
+	(if (eq? current-pressed-key KEY_BACKSPACE)
+	    (let ((n (string-length prompt-text)))
+	      (cond ((>= n 1)
+		     (set! prompt-text (substring prompt-text 0 (- n 1))))
+		    )))
+	
+	))
+  
+  )
+
+(define (prompt-draw)
+  (if prompt-active
+      (begin
+	(rl-draw-rectangle
+	 (rect-x prompt-box)
+	 (rect-y prompt-box)
+	 (rect-width prompt-box)
+	 (rect-height prompt-box)
+	 (make-color 190 100 255 255))
+	(rl-draw-text prompt-text 0 0 20 (make-color 0 0 0 255))
+	))
+  )
diff --git a/scripts/stage.scm b/scripts/stage.scm
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/scripts/stage.scm
diff --git a/scripts/structs.scm b/scripts/structs.scm
new file mode 100644
index 0000000..c3fa6ea
--- /dev/null
+++ b/scripts/structs.scm
@@ -0,0 +1,80 @@
+;; ============================================================
+;; define defstruct macro
+(define-macro (defstruct struct-name . fields)
+  (let* ((name (if (list? struct-name) (car struct-name) struct-name))
+	 (sname (if (string? name) name (symbol->string name)))
+
+	 (fsname (if (list? struct-name)
+		     (let ((cname (assoc :conc-name (cdr struct-name))))
+		       (if cname
+			   (symbol->string (cadr cname))
+			   sname))
+		     sname))
+
+	 (make-name (if (list? struct-name)
+			(let ((cname (assoc :constructor (cdr struct-name))))
+			  (if cname
+			      (cadr cname)
+			      (symbol "make-" sname)))
+			(symbol "make-" sname)))
+
+	 (copy-name (if (list? struct-name)
+			(let ((cname (assoc :copier (cdr struct-name))))
+			  (if cname
+			      (cadr cname)
+			      (symbol "copy-" sname)))
+			(symbol "copy-" sname)))
+
+	 (field-names (map (lambda (n)
+			     (symbol->string (if (list? n) (car n) n)))
+			   fields))
+
+	 (field-types (map (lambda (field)
+			     (if (list? field)
+				 (apply (lambda* (val type read-only) type) (cdr field))
+				 #f))
+			   fields))
+
+	 (field-read-onlys (map (lambda (field)
+				  (if (list? field)
+				      (apply (lambda* (val type read-only) read-only) (cdr field))
+				      #f))
+				fields)))
+    
+    `(begin
+       (define ,(symbol sname "?")
+	 (lambda (obj)
+	   (and (vector? obj)
+		(eq? (obj 0) ',(string->symbol sname)))))
+
+       (define* (,make-name
+		 ,@(map (lambda (n)
+			  (if (and (list? n)
+				   (>= (length n) 2))
+			      (list (car n) (cadr n))
+			      (list n #f)))
+			fields))
+	 (vector ',(string->symbol sname) ,@(map string->symbol field-names)))
+
+       (define ,copy-name copy)
+
+       ,@(map (let ((ctr 1))
+		(lambda (n type read-only)
+		  (let ((val (if read-only
+				 `(define ,(symbol fsname "-" n)
+				    (lambda (arg) (arg ,ctr)))
+				 `(define ,(symbol fsname "-" n)
+				    (dilambda
+				     (lambda (arg) (arg ,ctr))
+				     (lambda (arg val) (set! (arg ,ctr) val)))))))
+		    (set! ctr (+ 1 ctr))
+		    val)))
+	      field-names field-types field-read-onlys))))
+
+
+;; ============================================================
+;; Structures
+
+(defstruct rect (x 0.0) (y 0.0) (width 0.0) (height 0.0))
+(defstruct point (x 0.0) (y 0.0))
+(defstruct stage (width 0) (height 0) (generations 0) (final-state #f))
diff --git a/scripts/utils.scm b/scripts/utils.scm
new file mode 100644
index 0000000..3348075
--- /dev/null
+++ b/scripts/utils.scm
@@ -0,0 +1,8 @@
+(define (is-point-inside-rect? point rect)
+  (cond ((not (point? point)) #f)
+	((not (rect? rect)) #f)
+	(else (and (>= (point-x point) (rect-x rect))
+		   (>= (point-y point) (rect-y rect))
+		   (<= (point-x point) (+ (rect-x rect) (rect-width rect)))
+		   (<= (point-y point) (+ (rect-y rect) (rect-height rect))))
+	      )))
diff --git a/src/extended_environment.rs b/src/extended_environment.rs
new file mode 100644
index 0000000..d13cc2b
--- /dev/null
+++ b/src/extended_environment.rs
@@ -0,0 +1,76 @@
+use macroquad::prelude::*;
+use std::{cell::RefCell, collections::HashMap, rc::Rc};
+use rust_lisp::model::{Env, FloatType, RuntimeError, Symbol, Value};
+use rust_lisp::utils::{require_arg, require_typed_arg};
+
+pub type HashMapRc = Rc<RefCell<HashMap<Value, Value>>>;
+
+pub fn extend_environment(env: &Rc<RefCell<Env>>) {
+    env.borrow_mut().define(
+        Symbol::from("mq-draw-circle"),
+        Value::NativeFunc(
+            |_env, args| {
+                let x = require_typed_arg::<FloatType>("mq-draw-circle", &args, 0).unwrap();
+                let y = require_typed_arg::<FloatType>("mq-draw-circle", &args, 1).unwrap();
+                let radius = require_typed_arg::<FloatType>("mq-draw-circle", &args, 2).unwrap();
+                let color = GREEN;
+                
+                draw_circle(x, y, radius, color);
+                return Ok(Value::NIL);
+            })
+    );
+
+
+    // Hashtable functions
+    // TODO: convert to elisp compatible hash table command
+    env.borrow_mut().define(
+        Symbol::from("make-hash-table"),
+        Value::NativeFunc(|_env, args| {
+            let chunks = args.chunks(2);
+
+            let mut hash = HashMap::new();
+
+            for pair in chunks {
+                let key = pair.get(0).unwrap();
+                let value = pair.get(1);
+
+                if let Some(value) = value {
+                    hash.insert(key.clone(), value.clone());
+                } else {
+                    return Err(RuntimeError {
+                        msg: format!("Must pass an even number of arguments to 'hash', because they're used as key/value pairs; found extra argument {}", key)
+                    });
+                }
+            }
+
+            Ok(Value::HashMap(Rc::new(RefCell::new(hash))))
+        }),
+    );
+
+    env.borrow_mut().define(
+        Symbol::from("hash_get"),
+        Value::NativeFunc(|_env, args| {
+            let hash = require_typed_arg::<&HashMapRc>("hash_get", &args, 0)?;
+            let key = require_arg("hash_get", &args, 1)?;
+
+            Ok(hash
+                .borrow()
+                .get(key)
+                .map(|v| v.clone())
+                .unwrap_or(Value::NIL))
+        }),
+    );
+
+    env.borrow_mut().define(
+        Symbol::from("hash_set"),
+        Value::NativeFunc(|_env, args| {
+            let hash = require_typed_arg::<&HashMapRc>("hash_set", &args, 0)?;
+            let key = require_arg("hash_set", &args, 1)?;
+            let value = require_arg("hash_set", &args, 2)?;
+
+            hash.borrow_mut().insert(key.clone(), value.clone());
+
+            Ok(Value::HashMap(hash.clone()))
+        }),
+    );
+}
diff --git a/src/main.rs b/src/main.rs
index dbc60fb..62a3562 100644
--- a/src/main.rs
+++ b/src/main.rs
@@ -3,33 +3,61 @@ use macroquad::prelude::*;
 use std::{cell::RefCell, rc::Rc};
 
 use rust_lisp::default_env;
+use rust_lisp::lisp;
 use rust_lisp::parser::parse;
 use rust_lisp::interpreter::eval;
+use rust_lisp::model::{Symbol, Value};
 
+mod extended_environment;
 
 #[macroquad::main("BasicShapes")]
 async fn main() {
     // create a base environment
     let env = Rc::new(RefCell::new(default_env()));
 
+    // define new methods
+    extended_environment::extend_environment(&env);
+
     // parse into an iterator of syntax trees (one for each root)
-    let mut ast_iter = parse("(+ \"Hello \" \"world!\")");
-    let first_expression = ast_iter.next().unwrap().unwrap();
+    // let mut ast_iter = parse("(+ \"Hello \" \"world!\")");
+    // let first_expression = ast_iter.next().unwrap().unwrap();
 
     // evaluate
-    let evaluation_result = eval(env.clone(), &first_expression).unwrap();
+    // let evaluation_result = eval(env.clone(), &first_expression).unwrap();
+    // let mut ast_iter = parse("(test_draw)");
+    // let first_expression = ast_iter.next().unwrap().unwrap();
+
+    // let first_expression = lisp! {(test_draw)};
+    
+    // let mut inc = parse("(begin (set a 0) (+ a 1))");
+    // let mut inc = parse("(begin (define a 0) (set a (+ a 1)))");
+    // let inc_exp = inc.next().unwrap().unwrap();
+
+    // let inc_exp = lisp! {
+    //     (begin (define a 0) (set a (+ a 1)))
+    // };
+    // eval(env.clone(), &inc_exp).unwrap();
 
-    // use result
-    println!("{}", &evaluation_result);
+    // let inc_exp = lisp! {
+    //     (set a (+ a 1))
+    // };
+
+    let gol_exp = parse(include_str!("../scripts/main.el"));
+    for exp in gol_exp {
+        eval(env.clone(), &exp.unwrap()).unwrap();
+    }
+    
+    // let mut inc = parse("(set a (+ a 1))");
+    // let inc_exp = inc.next().unwrap().unwrap();
     
     loop {
         clear_background(RED);
 
         draw_line(40.0, 40.0, 100.0, 200.0, 15.0, BLUE);
         draw_rectangle(screen_width() / 2.0 - 60.0, 100.0, 120.0, 60.0, GREEN);
-        draw_circle(screen_width() - 30.0, screen_height() - 30.0, 15.0, YELLOW);
-
-        draw_text(&format!("IT WORKS! {}!", &evaluation_result), 20.0, 20.0, 30.0, DARKGRAY);
+        eval(env.clone(), &first_expression).unwrap();
+        let inc_eval = eval(env.clone(), &inc_exp).unwrap();
+        draw_text(&format!("IT WORKS! {}!", &inc_eval), 20.0, 20.0, 30.0, DARKGRAY);
 
         next_frame().await
     }