我想我会尝试使用世界/宇宙无突变方法的简单 GUI 应用程序,但尝试自己实现“世界/宇宙”程序设计。

我在下面有我的小草图,但我很快得出结论,虽然我可以使用教学包,但我不知道如何自己实现教学包功能。

我猜我应该使用延续,但这似乎不是 Universe.rkt 源中的方法。

我总是可以把程序塞进 Canvas 类中(就像早期的游戏一样 Slidey 和 same 似乎这样做),但我真的想了解如何实现“世界/宇宙”风格的程序控制。

;;;;----
#lang racket/gui

; simple drawing program
; mousedown starts recording a list of points
; mousechanged starts recording a new list
; paint callback paints the list of lists as lines.

(define diagramframe (new frame% [label "paint"] [width 300]
                                 [height 300] [x 1000][y 300]))

;(define lines '(((0 . 0) (0 . 300) (250 . 250) (150 . 176))))
(define lines '(((0 . 0) (0 . 300) (250 . 250) (150 . 176))
                ((10 . 4) (280 . 10))))

(define paintcanvas%
  (class canvas%
    (init-field mouse-event-callback)
    (super-new)
    (define dc (send this get-dc))
    (define/override (on-event mouse-event)
      (mouse-event-callback mouse-event))))

(define (paint-cb c dc) 
  (for-each (λ (line) (send dc draw-lines line)) lines))

(define (me-cb mouse-event)
   (let ((x (send mouse-event get-x))
        (y (send mouse-event get-y)))
    (when (and (send mouse-event get-left-down)
               (send mouse-event moving?))
      (if (send mouse-event button-changed?)
          ; if true append as new list
          '() 
          ; if false append existing list
          '()))))

(define Paintcanvas (new paintcanvas%
                         [parent diagramframe]
                         [paint-callback paint-cb]
                         [mouse-event-callback me-cb]))

(define (main world)
 (when world (main (??? world)))
  (send diagramframe show #t))
 
(main lines)

(send diagramframe show #t)

;;-----

最佳答案

这是我将如何做到的。

请注意,GUI 事件循环充当程序 main。
使用定时器事件来实现 on-tick。

 #lang racket/gui

;;;
;;; WORLD
;;;

(define-struct world (lines))
(define the-world (make-world '((0 . 0) (0 . 300) (250 . 250) (150 . 176) (10 . 4) (280 . 10))))

;;;
;;; USER LAND
;;;

(define (on-mouse-event world event)
  (if (and (send event get-left-down)
           (send event moving?)
           #; (send event button-changed?))
      (let ((x (send event get-x))
            (y (send event get-y)))
        (make-world (cons (cons x y) (world-lines world))))
      world))

(define (on-paint world dc)
  (send dc draw-lines
        (map pair->point (world-lines world))))

(define (pair->point p)
  (make-object point% (car p) (cdr p)))


;;;
;;; SYSTEM
;;;

(define user:on-paint on-paint)

(define diagramframe (new frame% [label "paint"] [width 300] [height 300] [x 1000][y 300]))

(define paintcanvas%
  (class canvas%
    (inherit get-dc refresh)
    (super-new)

    (define/override (on-paint)
      (send (get-dc) suspend-flush)
      (user:on-paint the-world (get-dc))
      (send (get-dc) resume-flush))

    (define/override (on-event mouse-event)
      (let* ([old-world the-world]
             [new-world (on-mouse-event the-world mouse-event)])
        (if (eq? old-world new-world)
            (super on-event mouse-event)
            (begin
              (set! the-world new-world)
              (refresh)))))))

(define paintcanvas (new paintcanvas% [parent diagramframe]))
(send diagramframe show #t)

关于inversion-of-control - 超越世界/宇宙,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/10072219/

10-12 19:20