hmm memory leak

This commit is contained in:
mehbark 2023-12-24 00:31:23 -05:00
parent 0dcf703917
commit 710bcdd2ce

View file

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