diff options
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/gol.scm | 35 | ||||
| -rw-r--r-- | scripts/main.scm | 308 | ||||
| -rw-r--r-- | scripts/prompt.scm | 53 | ||||
| -rw-r--r-- | scripts/stage.scm | 0 | ||||
| -rw-r--r-- | scripts/structs.scm | 1 |
5 files changed, 329 insertions, 68 deletions
diff --git a/scripts/gol.scm b/scripts/gol.scm index 7e10d2d..e0732a6 100644 --- a/scripts/gol.scm +++ b/scripts/gol.scm @@ -3,12 +3,6 @@ (define neighbors '((-1 . -1) (0 . -1) (1 . -1) (-1 . 0) (1 . 0) (-1 . 1) (0 . 1) (1 . 1))) -(set! (current-cells '(1 . 1)) #t) -(set! (current-cells '(2 . 1)) #t) -(set! (current-cells '(3 . 1)) #t) -(set! (current-cells '(3 . 0)) #t) -(set! (current-cells '(2 . -1)) #t) - (define sum-cells (lambda (c1 c2) (cons (+ (car c1) (car c2)) (+ (cdr c1) (cdr c2))))) @@ -37,8 +31,10 @@ (define list-neighbors (lambda (c) (map (lambda (n) - (sum-cells c n)) - neighbors))) + (sum-cells c n) + ) + neighbors) + )) (define sum-live-cells (lambda (lat n) @@ -76,3 +72,26 @@ ) ) ) + +(define (clear-cells) + (set! current-cells (make-hash-table)) + ) + +(define (toggle-cell c) + (if (current-cells c) + (set! (current-cells c) #f) + (set! (current-cells c) #t) + ) + ) + +(define (set-cells-array arr) + (map (lambda (c) + (set! (current-cells c) #t) + ) + arr + ) + ) + +(define (get-cells-list) + (hash-table-keys current-cells) + ) diff --git a/scripts/main.scm b/scripts/main.scm index 5dcbe10..9db17fc 100644 --- a/scripts/main.scm +++ b/scripts/main.scm @@ -3,53 +3,297 @@ (load "./scripts/prompt.scm") (load "./scripts/gol.scm") -(define camera-offset (make-point)) -(define space-pressed #f) +(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 (update) - (prompt-update) - (cond ((not prompt-active) - (if (rl-is-key-down KEY_DOWN) - (set! (point-y camera-offset) (+ (point-y camera-offset) 2)) - ) - - (if (rl-is-key-down KEY_UP) - (set! (point-y camera-offset) (+ (point-y camera-offset) -2)) - ) +(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)) + )) - (if (rl-is-key-down KEY_LEFT) - (set! (point-x camera-offset) (+ (point-x camera-offset) -2)) +(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 (rl-is-key-down KEY_RIGHT) - (set! (point-x camera-offset) (+ (point-x camera-offset) 2)) + (if (eq? current-pressed-key KEY_RIGHT) + (cond ((< current-generation 1) + (set! current-generation (+ current-generation 1)) + (update-generation))) ) - (cond ((and (rl-is-key-down KEY_SPACE) (not space-pressed)) - (set! space-pressed #t) - (run-step)) - ) - - (if (not (rl-is-key-down KEY_SPACE)) - (set! space-pressed #f) - ) )) + + (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 (draw) +(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) 30) (point-x camera-offset)) - (+ (* (cdr cell) 30) (point-y camera-offset)) - 30 - 30 - (make-color 190 100 255)) + (+ (* (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 index 3440b28..32e7606 100644 --- a/scripts/prompt.scm +++ b/scripts/prompt.scm @@ -3,35 +3,32 @@ (define prompt-text "") (define (prompt-update) - (let ((key-pressed (rl-get-key-pressed))) - - - (if (eq? key-pressed 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_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 (eq? key-pressed KEY_BACKSPACE) - (let ((n (string-length prompt-text))) - (cond ((>= n 1) - (set! prompt-text (substring prompt-text 0 (- n 1)))) - ))) - - )) - ) + + (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) 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 index e6be071..c3fa6ea 100644 --- a/scripts/structs.scm +++ b/scripts/structs.scm @@ -77,3 +77,4 @@ (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)) |