PasteRack.org
Paste # 21352
2021-10-19 17:46:25

Fork as a new paste.

Paste viewed 612 times.


Embed:

  1. #lang racket
  2. (require pict)
  3.  
  4. (struct point (x y))
  5.  
  6. (define collision-rect%
  7.   (class object%
  8.     (init-field coord width height)
  9.     (field (tl-corner coord)
  10.            (tr-corner (point (+ (point-x coord) width) (point-y coord)))
  11.            (br-corner (point (+ (point-x coord) width) (+ (point-y coord) height)))
  12.            (bl-corner (point (point-x coord) (+ width (point-y coord)))))
  13.     (super-new)
  14.     (define/public (update new-coord)
  15.       (set! tl-corner new-coord)
  16.       (set! tr-corner (point (+ (point-x new-coord) width) (point-y new-coord)))
  17.       (set! br-corner (point (+ (point-x new-coord) width) (+ (point-y new-coord) height)))
  18.       (set! bl-corner (point (point-x new-coord) (+ width (point-y new-coord)))))
  19.  
  20.     (define/public (mouse-colliding? mouse-x mouse-y)
  21.       (if (and (>= mouse-x (point-x tl-corner))
  22.                (<= mouse-x (point-x br-corner))
  23.                (>= mouse-y (point-y tl-corner))
  24.                (<= mouse-y (point-y br-corner)))
  25.           #t
  26.           #f))
  27.  
  28.     (define/public (is-colliding? collision-box)
  29.       (let ([box2-tl-corner (get-field tl-corner collision-box)]
  30.             [box2-tr-corner (get-field tr-corner collision-box)]
  31.             [box2-bl-corner (get-field bl-corner collision-box)]
  32.             [box2-br-corner (get-field br-corner collision-box)])
  33.  
  34.         (if (or (> (point-x tl-corner) (point-x box2-tr-corner))
  35.                 (< (point-x tr-corner) (point-x box2-tl-corner))
  36.                 (> (point-y tl-corner) (point-y box2-bl-corner))
  37.                 (< (point-y bl-corner) (point-y box2-tl-corner)))
  38.             #f
  39.             #t)))))
  40.  
  41. (define prop%
  42.   (class object%
  43.     (init-field pos-x pos-y [path #f])
  44.     (super-new)
  45.     (field [img-width #f]
  46.            [img-height #f]
  47.            [img #f]
  48.            [collision-rect #f]
  49.            [debug-width 70]
  50.            [debug-height 70]
  51.            [collided? #f])
  52.     (define (read-img path)
  53.       (let* ([bmap (bitmap path)]
  54.              [width (pict-width bmap)]
  55.              [height (pict-height bmap)]
  56.              [image (pict->bitmap bmap)])
  57.         (set! img-width width)
  58.         (set! img-height height)
  59.         (set! img image)
  60.         (set!
  61.          collision-rect
  62.          (new collision-rect% [coord (point pos-x pos-y)] [width img-width] [height img-height]))))
  63.  
  64.     (define/public (paint canvas dc)
  65.       (if (false? path)
  66.           (send dc draw-rectangle pos-x pos-y debug-width debug-height)
  67.           (send dc draw-bitmap img pos-x pos-y)))
  68.  
  69.     ;; constructor
  70.     (if (false? path)
  71.         (set!
  72.          collision-rect
  73.          (new collision-rect% [coord (point pos-x pos-y)] [width debug-width] [height debug-height]))
  74.  
  75.         (read-img path))))

=>