summaryrefslogtreecommitdiff
path: root/scripts/main.scm
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/main.scm')
-rw-r--r--scripts/main.scm299
1 files changed, 0 insertions, 299 deletions
diff --git a/scripts/main.scm b/scripts/main.scm
deleted file mode 100644
index 9db17fc..0000000
--- a/scripts/main.scm
+++ /dev/null
@@ -1,299 +0,0 @@
-(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))
-
-
- )
generated by cgit v1.2.3 (git 2.39.1) at 2025-08-18 18:21:16 +0000