path: root/scripts/main.scm

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

  
  )