graphics/vecto-test.lisp

   1 (in-package :bio-graphics)
   2
   3 (defun square-test ()
   4   (with-canvas (:width 400 :height 400)
   5     (set-font (get-font (default-font)) 40)
   6     (set-rgb-fill 1.0 1.0 1.0)
   7     (clear-canvas)
   8     (rounded-rectangle 20 20 360 360 10 10)
   9     (stroke)
  10     (translate 200 200)
  11     (set-rgb-stroke 1 0 0)
  12     (set-rgb-fill 0 0 0)
  13     (draw-centered-string 0 -10 "Square")
  14     (stroke)
  15     (save-png "square.png")))
  16
  17 (defun circle-test ()
  18   (with-canvas (:width 400 :height 400)
  19     (set-font (get-font (default-font)) 40)
  20     (set-rgb-fill 1.0 1.0 1.0)
  21     (clear-canvas)
  22     (centered-circle-path 200 200 180)
  23     (stroke)
  24     (translate 200 200)
  25     (set-rgb-stroke 1 0 0)
  26     (set-rgb-fill 0 0 0)
  27     (draw-centered-string 0 -10 "circle")
  28     (stroke)
  29     (save-png "circle.png")))
  30
  31 (defun stream-test (stream)
  32   (with-canvas (:width 400 :height 400)
  33     (set-font (get-font (default-font)) 40)
  34     (set-rgb-fill 1.0 1.0 1.0)
  35     (clear-canvas)
  36     (centered-circle-path 200 200 180)
  37     (stroke)
  38     (translate 200 200)
  39     (set-rgb-stroke 1 0 0)
  40     (set-rgb-fill 0 0 0)
  41     (draw-centered-string 0 -10 "circle")
  42     (stroke)
  43     (save-png-stream stream)))
  44
  45
  46 (defun feature (start end)
  47   (with-graphics-state
  48     (set-rgb-stroke 0 0 1.0)
  49     (rectangle start 0 (- end start) 1)
  50     (fill-and-stroke)))
  51
  52 (defun feature-test ()
  53   (with-canvas (:width 400 :height 400)
  54     (flet ((draw-feature (f)
  55              (with-graphics-state
  56                (scale (/ (- 400 20) 1000) 10)
  57                (funcall f))))
  58
  59       (let ((features
  60              (list
  61               (lambda () (feature 300 700))
  62               (lambda () (feature 500 800))
  63               (lambda () (feature 300 600)
  64                       (feature 100 150) )
  65               (lambda () (feature 1 1000)))))
  66
  67         (set-rgb-fill 1.0 1.0 1.0)
  68         (set-rgb-stroke 0 0 0)
  69         (clear-canvas)
  70
  71         (translate 10 0)
  72         (dolist (feature features)
  73           (translate 0 30)
  74           (draw-feature feature)))
  75       (save-png "feature.png"))))
  76