grid-class.ss

(import swl:oop)
(import swl:macros)
(import swl:generics)
(import swl:option)

(define top (create <toplevel> with (title: "Grid Canvas")))

(define-class (<grid-canvas> parent) (<canvas> parent)
    (ivars (start #f) (goal #f) (robot #f) (visited #f) (frontier #f)
           (path-node #f) (rect #f))
    (inherited)
    (inheritable)
    (private)
    (protected)
    (public
      (move-make-robot (x0 y0)
        (let* ((sizer (floor (/ (* 3 size) 4)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set-coords! robot x y (+ x sizer) (+ y sizer))))
      (make-robot (x0 y0)
        (let* ((sizer (floor (/ (* 2 size) 3)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set! robot (create <oval> self x y (+ x sizer) (+ y sizer)))
          (set-fill-color! robot (make <rgb> 255 0 0))))
      (make-visited (x0 y0)
        (let* ((sizer (floor (/ (* 2 size) 3)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set! visited (create <oval> self x y (+ x sizer) (+ y sizer)))))
      (make-frontier (x0 y0)
        (let* ((sizer (floor (/ size 2)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set! frontier (create <oval> self x y (+ x sizer) (+ y sizer)))))
      (make-path-node (x0 y0)
        (let* ((sizer (floor (/ size 2)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set! path-node (create <oval> self x y (+ x sizer) (+ y sizer)))
          (set-fill-color! path-node (make <rgb> 255 255 0))))
      (make-start (x0 y0)
        (let* ((sizer (floor (/ (* 1 size) 1)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set! start (create <oval> self x y (+ x sizer) (+ y sizer)))
          (set-fill-color! start (make <rgb> 0 0 255))))
      (make-goal (x0 y0)
        (let* ((sizer (floor (/ (* 1 size) 1)))
               (diff (floor (/ (- size sizer) 2)))
               (x (+ 2 diff (* x0 size)))
               (y (+ 2 diff (* y0 size))))
          (set! goal (create <oval> self x y (+ x sizer) (+ y sizer)))
          (set-fill-color! goal (make <rgb> 0 255 0))))
      (make-free (x0 y0)
        (let ((x (+ 2 (* x0 size)))
              (y (+ 2 (* y0 size))))
          (set! rect (create <rectangle> self x y (+ x size) (+ y size)))))
      (make-obstacle (x0 y0)
        (let ((x (+ 2 (* x0 size)))
              (y (+ 2 (* y0 size))))
          (set! rect (create <rectangle> self x y (+ x size) (+ y size)))
          (set-fill-color! rect (make <rgb> 5 5 5))))))

(define canvas (create <grid-canvas> top with
    (background-color: (make <rgb> 215 215 215))))

(send canvas set-height! (+ 1 (* size num-col-row)))
(send canvas set-width! (+ 1 (* size num-col-row)))