test.rkt

#lang racket/base

(require
 racket/class
 racket/gui/base
 racket/draw)

(define lim-x0 10.0)
(define lim-y0 10.0)
(define lim-x1 340.0)
(define lim-y1 340.0)
(define box-x lim-x0)
(define box-y lim-y0)
(define box-vx 250.0)
(define box-vy 0.0)

(define (animate dt)
  (set! box-x (+ box-x (* dt box-vx)))
  (set! box-y (+ box-y (* dt box-vy)))
  (cond
    [(> box-x lim-x1) (set! box-x lim-x1) (set! box-vy box-vx) (set! box-vx 0.0)]
    [(> box-y lim-y1) (set! box-y lim-y1) (set! box-vx (- box-vy)) (set! box-vy 0.0)]
    [(< box-x lim-x0) (set! box-x lim-x0) (set! box-vy box-vx) (set! box-vx 0.0)]
    [(< box-y lim-y0) (set! box-y lim-y0) (set! box-vx (- box-vy)) (set! box-vy 0.0)]))

(define no-pen (new pen% [style 'transparent]))
(define brush-background (new brush% [color (make-object color% 160 160 160)]))
(define brush-box (new brush% [color (make-object color% 70 70 70)]))

(define (paint _canv dc)
  (define-values [width height] (send dc get-size))
  (send dc clear)
  (send dc set-pen no-pen)
  (send dc set-brush brush-background)
  (send dc draw-rectangle 0 0 width height)
  (send dc set-brush brush-box)
  (send dc draw-rectangle box-x box-y 50 50)
  (void))

(define frame
  (new frame% [label "Test"]))

(define canv
  (new canvas%
       [parent frame]
       ;[style '(transparent no-autoclear)]
       [paint-callback paint]
       [min-width 400]
       [min-height 400]
       [stretchable-width #t]
       [stretchable-height #t]))

(define (animate/refresh-loop [t0 (current-inexact-milliseconds)])
  (when (send frame is-shown?)
    (send canv refresh)
    (sleep/yield 0.01666)
    (define t1 (current-inexact-milliseconds))
    (define dt (/ (- t1 t0) 1000.0))
    (when (> dt 0.02)
      (printf "FPS dropped: ~a\n" (/ 1.0 dt))
      (flush-output))
    (animate dt)
    (animate/refresh-loop t1)))

(module+ main
  (send frame show #t)
  (animate/refresh-loop))