diff --git a/main.scm b/main.scm index d45810e..16c0a47 100644 --- a/main.scm +++ b/main.scm @@ -3,7 +3,6 @@ ; https://www.mzrg.com/mines/msx/index.html ; let's do about the minimum to do what i want ; keep the names almost exactly the same for googling's sake - (load-shared-object "libraylib.so") ; color @@ -492,14 +491,37 @@ (vector-ref (game-squares game) (+ x (* y (game-width game))))) -; preliminary -(define (game-square-type-at game x y) - (define square (game-square-at game x y)) +(define (vector2-adjacent? a b) + (and (<= (abs (- (vector2-x a) (vector2-x b))) 1) + (<= (abs (- (vector2-y a) (vector2-y b))) 1))) + +(define (pair-adjacent? a b) + (and (<= (abs (- (car a) (car b))) 1) + (<= (abs (- (cdr a) (cdr b))) 1))) + +(define (square-mouse-over) + (cons (floor (/ (get-mouse-x) square-width)) + (floor (/ (get-mouse-y) square-width)))) + +(define (square-pressed? x y) + (or + (and (button-down? 'left) (equal? (cons x y) (square-mouse-over))) + (and (button-down? 'middle) (pair-adjacent? (cons x y) (square-mouse-over))))) + +(define (square-type square x y) (cond [(square-flagged? square) 'flag] + [(not (square-revealed? square)) + (if (square-pressed? x y) + 'pressed + 'unknown)] [(square-mine? square) 'mine] [else (square-num-adjacent square)])) +; preliminary +(define (game-square-type-at game x y) + (square-type (game-square-at game x y) x y)) + (define (game-in-bounds? game x y) (and (< -1 x (game-width game)) (< -1 y (game-height game)))) @@ -531,6 +553,7 @@ (length (filter square-mine? (game-around game x y))))) game)) + ; as feared, make-vector references the same thing (define (new-game mines width height) (define squares (list->vector (append (make-squares mines #t) @@ -540,7 +563,27 @@ (fill-game-arounds! game) game) -; ignoring revealed for now + +(define (game-tick! game) + (define mouse-x (car (square-mouse-over))) + (define mouse-y (cdr (square-mouse-over))) + (define mouse-in-bounds? (game-in-bounds? game mouse-x mouse-y)) + (define mouse-square (and mouse-in-bounds? (game-square-at game mouse-x mouse-y))) + (define redraw? + (and mouse-in-bounds? + (or (button-down? 'left) + (button-down? 'middle) + (button-down? 'right) + + (button-released? 'left) + (button-released? 'middle) + (button-released? 'right)))) + + ; not quite perfectly correct + (when (and mouse-in-bounds? (button-pressed? 'right)) + (square-flagged?-set! mouse-square (not (square-flagged? mouse-square)))) + redraw?) + (define (draw-game-squares game skin pos) (game-squares-for-each (lambda (x y) @@ -548,10 +591,6 @@ (blit-square skin (game-square-type-at game x y) pos))) game)) -(define (square-mouse-over) - (cons (floor (/ (get-mouse-x) square-width)) - (floor (/ (get-mouse-y) square-width)))) - (define (draw-write obj x y size color) (draw-text (with-output-to-string (lambda () (write obj))) x y size color)) @@ -587,19 +626,23 @@ border-rects)) (define (draw-mouse-info color) - (draw-write (square-mouse-over) 0 0 20 color) + (draw-write (square-mouse-over) 2 0 20 color) - (draw-write `(left down . ,(button-down? 'left)) 0 20 10 color) - (draw-write `(middle down . ,(button-down? 'middle)) 0 30 10 color) - (draw-write `(right down . ,(button-down? 'right)) 0 40 10 color) + (draw-write `(left down . ,(button-down? 'left)) 1 20 10 color) + (draw-write `(middle down . ,(button-down? 'middle)) 1 30 10 color) + (draw-write `(right down . ,(button-down? 'right)) 1 40 10 color) - (draw-write `(left pressed . ,(button-pressed? 'left)) 0 50 10 color) - (draw-write `(middle pressed . ,(button-pressed? 'middle)) 0 60 10 color) - (draw-write `(right pressed . ,(button-pressed? 'right)) 0 70 10 color) + (draw-write `(left pressed . ,(button-pressed? 'left)) 1 50 10 color) + (draw-write `(middle pressed . ,(button-pressed? 'middle)) 1 60 10 color) + (draw-write `(right pressed . ,(button-pressed? 'right)) 1 70 10 color) - (draw-write `(left released . ,(button-released? 'left)) 0 80 10 color) - (draw-write `(middle released . ,(button-released? 'middle)) 0 90 10 color) - (draw-write `(right released . ,(button-released? 'right)) 0 100 10 color)) + (draw-write `(left released . ,(button-released? 'left)) 1 80 10 color) + (draw-write `(middle released . ,(button-released? 'middle)) 1 90 10 color) + (draw-write `(right released . ,(button-released? 'right)) 1 100 10 color)) + +(define (game-draw game skin) + (draw-game-squares game skin (vector2 0 0))) +; draw-game-over as a separate thing would be nice ; the game shows -99 when you (- num-mines num-flagged) is less than -99 (define (run-game mines width height) @@ -611,14 +654,21 @@ ;; (display skin) ;; (newline) + (with-draw (game-draw game skin)) ; with the actual game, we almost certainly don't have to redraw everything every time ; but we can afford it if laziness necessitates it (until (window-should-close?) (with-draw - (draw-game-squares game skin (vector2 0 0)) - (draw-mouse-info WHITE))) + ; this saves a lot of resources + (when (game-tick! game) + ; something leaks memory. huh! + (clear-background BLACK) + (game-draw game skin)) + #;(draw-mouse-info BLACK) + )) (unload-texture skin) (close-window))) - ; let's save playing with shaders for later + +; seems like minesweeper.online doesn't need middle-clicking to be separate (left-clicking performs the same function)