summaryrefslogtreecommitdiff
path: root/2d/helpers.scm
blob: 18bf8fa9105d251744d886d63f1a05f3648f677b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
;;; guile-2d
;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Miscellaneous helper procedures.
;;
;;; Code:

(define-module (2d helpers)
  #:use-module (srfi srfi-1)
  #:use-module (rnrs arithmetic bitwise)
  #:use-module (2d agenda)
  #:use-module (2d game)
  #:export (any-equal?
            logand?
            define-guardian))

(define (any-equal? elem . args)
  "Return #t if ELEM equals any of the elements in the list ARGS."
  (any (lambda (e) (equal? elem e)) args))

(define (logand? . args)
  "Return #t if the result of a bitwise AND of the integers in list
ARGS is non-zero."
  (not (zero? (apply logand args))))

(define-syntax-rule (define-guardian name reaper)
  "Define a new guardian called NAME and call REAPER when an object
within the guardian is GC'd.  Reaping is ensured to happen from the
same thread that is running the game loop."
  (begin
    (define name (make-guardian))
    (schedule-interval game-agenda
                       (lambda ()
                         (let reap ((obj (name)))
                           (when obj
                             (reaper obj)
                             (reap (name)))))
                       1)))