hmm memory leak
This commit is contained in:
parent
0dcf703917
commit
710bcdd2ce
1 changed files with 72 additions and 22 deletions
94
main.scm
94
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)
|
||||
|
|
Loading…
Reference in a new issue