PasteRack.org
Paste # 23639
2021-10-19 13:57:22

Fork as a new paste.

Paste viewed 570 times.


Embed:

raco fmt output

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

=>