Test using ltk canvas.

ltktest.asd

;;;; ltktest.asd

(asdf:defsystem #:ltktest
  :description "Describe ltktest here"
  :author "Jeremiah LaRocco <[email protected]>"
  :license "ISC"
  :depends-on (#:ltk
               #:iterate
               #:alexandria)
  :serial t
  :components ((:file "package")
               (:file "ltktest")))

ltktest.lisp

;;;; ltktest.lisp

(in-package #:ltktest)

(defstruct point
  (x 0.0)
  (y 0.0))

(defmacro scale-val (val minval maxval minnew maxnew)
  `(let ((new-diff (- ,maxnew ,minnew))
         (old-diff (- ,maxval ,minval))
         (val-diff (- ,val ,minval)))
     ;; (format t "~a ~a ~a~%" new-diff old-diff val-diff)
     (+ (* (/ val-diff old-diff) new-diff) ,minnew)))
  ;; `(* ((- ,maxnew ,minnew) (/ (- ,val ,minval) (- ,maxval ,minval))))

(defun pt-line (canvas p1 p2)
  ;; (format t "~a ~a~%" p1 p2)
  (finish-output t)
  (ltk:create-line* canvas
                    (floor (point-x p1)) (floor (point-y p1))
                    (floor (point-x p2)) (floor (point-y p2))))

(defun xform (pt xmin xmax ymin ymax width height)
  (let ((xp (point-x pt))
        (yp (point-y pt)))
    (make-point :x (scale-val xp xmin xmax 0 width)
                :y (scale-val yp ymin ymax 0 height))))

(defun main (&key (width 800) (height 800) (steps 400)
               (xmin -4.0) (xmax 4.0)
               (ymin -4.0) (ymax 4.0)
               (tmin 0.0) (tmax (* 2.0 pi))
               (xf #'identity)
               (yf (lambda (tv) (* 1.5 (sin tv)))) )
  (ltk:with-ltk ()
    (let ((canv (make-instance 'ltk:canvas 
                               :master nil
                               :width width
                               :height height
                               ))
          (hw (floor (/ width 2.0)))
          (hh (floor (/ height 2.0)))
          (prev-point nil))
      (dotimes (i steps)
        (let* ((tv (scale-val i 0 steps tmin tmax))
               (np (make-point :x (scale-val (funcall xf tv) xmin xmax 0 width)
                               :y (scale-val (funcall yf tv) ymin ymax 0 height))))
          (if (null prev-point)
              (setf prev-point np)
              (pt-line canv np prev-point))
          (setf prev-point np)))
      (ltk:pack canv))))

package.lisp

;;;; package.lisp

(defpackage #:ltktest
  (:use #:cl)
  (:export #:main
           #:scale-val
           #:make-point
))