update scripts

1 files changed, 299 insertions, 0 deletions

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))
+
+  
+  )