PasteRack.org
Paste # 29877
2021-10-19 17:45:14

Fork as a new paste.

Paste viewed 452 times.


Embed:

#lang racket
(require pict)

(struct point (x y))

(define collision-rect%
  (class object%
    (init-field coord width height)
    (field (tl-corner coord)
           (tr-corner (point (+ (point-x coord) width) (point-y coord)))
           (br-corner (point (+ (point-x coord) width) (+ (point-y coord) height)))
           (bl-corner (point (point-x coord) (+ width (point-y coord)))))
    (super-new)
    (define/public (update new-coord)
      (set! tl-corner new-coord)
      (set! tr-corner (point (+ (point-x new-coord) width) (point-y new-coord)))
      (set! br-corner (point (+ (point-x new-coord) width) (+ (point-y new-coord) height)))
      (set! bl-corner (point (point-x new-coord) (+ width (point-y new-coord)))))

    (define/public (mouse-colliding? mouse-x mouse-y)
      (if (and (>= mouse-x (point-x tl-corner))
               (<= mouse-x (point-x br-corner))
               (>= mouse-y (point-y tl-corner))
               (<= mouse-y (point-y br-corner)))
          #t
          #f))

    (define/public (is-colliding? collision-box)
      (let ([box2-tl-corner (get-field tl-corner collision-box)]
            [box2-tr-corner (get-field tr-corner collision-box)]
            [box2-bl-corner (get-field bl-corner collision-box)]
            [box2-br-corner (get-field br-corner collision-box)])

        (if (or (> (point-x tl-corner) (point-x box2-tr-corner))
                (< (point-x tr-corner) (point-x box2-tl-corner))
                (> (point-y tl-corner) (point-y box2-bl-corner))
                (< (point-y bl-corner) (point-y box2-tl-corner)))
            #f
            #t)))))

(define prop%
  (class object%
    (init-field pos-x pos-y [path #f])
    (super-new)
    (field [img-width #f]
           [img-height #f]
           [img #f]
           [collision-rect #f]
           [debug-width 70]
           [debug-height 70]
           [collided? #f])
    (define (read-img path)
      (let* ([bmap (bitmap path)]
             [width (pict-width bmap)]
             [height (pict-height bmap)]
             [image (pict->bitmap bmap)])
        (set! img-width width)
        (set! img-height height)
        (set! img image)
        (set!
         collision-rect
         (new collision-rect% [coord (point pos-x pos-y)] [width img-width] [height img-height]))))

    (define/public (paint canvas dc)
      (if (false? path)
          (send dc draw-rectangle pos-x pos-y debug-width debug-height)
          (send dc draw-bitmap img pos-x pos-y)))

    ;; constructor
    (if (false? path)
        (set!
         collision-rect
         (new collision-rect% [coord (point pos-x pos-y)] [width debug-width] [height debug-height]))

        (read-img path)))

=>

#<syntax:/home/pasterack/pasterack/tmp/29877/29877code.scrbl:5:0 "#lang racket">:41:0: read-syntax: expected a `)` to close `(`
  context...:
   /home/pasterack/racket82/collects/syntax/module-reader.rkt:186:17: body
   /home/pasterack/racket82/collects/syntax/module-reader.rkt:183:2: wrap-internal
   /home/pasterack/racket82/collects/racket/../syntax/module-reader.rkt:67:9: wrap-internal/wrapper
   /home/pasterack/racket82/share/pkgs/scribble-lib/scribble/private/manual-code.rkt:138:19: loop
   /home/pasterack/racket82/share/pkgs/scribble-lib/scribble/private/manual-code.rkt:112:0: get-tokens
   /home/pasterack/racket82/share/pkgs/scribble-lib/scribble/private/manual-code.rkt:56:0: typeset-code
   body of "/home/pasterack/pasterack/tmp/29877/29877code.scrbl"
   .../private/map.rkt:40:19: loop
   .../racket/cmdline.rkt:191:51
   body of "/home/pasterack/racket82/share/pkgs/scribble-lib/scribble/run.rkt"