LISP CLIM LOVE HEART DRAWING 2: [DOUG'S] RECKONING

lispmoo2 » Devlog
14 hours ago by screwtape
Share this post:

Let's

1. improve our valentine's day heart attempt

and lisp clim drawing skillz.

  1. Re-opening the application-frame window after making changes clearly sucks. and
  2. Make the bottom of the heart curvy

1.1. Since the window changes dynamically

I just keep issuing reinitialize-instance, though you can only see it a few places in this article (and reopening the window when I accidentally close it after all). I guess-and-checked all the translation, scaling, and "good choice of heart points" since this was convenient to do dynamically.

2. start the frame from last time

again but in a long-running way.

2.1. Setup   again

(require :mcclim)
(in-package :clim-user)

2.2. The frame's definition   again

(define-application-frame heart ()
  ((current-ink :initform +red+))
  (:pane :application :display-function 'display-function))

2.2.1. Put the heart drawer in its own function finally

Merest of refactors. Let's stay real. By the way, &aux arguements are just an initial let. application-frame refers to the active application-frame which I guess will be the one calling this function, after all. 

(defun old-heart (pane &aux (rad 25))
  (with-slots (current-ink) *application-frame*
    (with-drawing-options (pane :ink current-ink)
      (let ((x (* rad (cos (* pi 1/6))))
            (y (* rad (sin (* pi 1/6)))))
        (with-translation (pane 60 80)
          (draw-circle* pane 0 0 rad :filled nil
                                     :start-angle
                                     (/ pi 6)
                                     :end-angle
                                     (+ pi (/ pi 6)))
          (let* ((dx (+ (* 2 rad)
                        (- (* 2 (- rad x)))))
                 (dy (* dx
                        (- (/ x y)))))
            (draw-line* pane
                        (- x)
                        y
                        (+ (- x) dx)
                        (+ y (- dy)))))

      (with-translation (pane (+ 60 40) 80)
        (draw-circle* pane 0 0 rad :filled nil
                                   :start-angle (* pi -1/6)
                                   :end-angle (- pi (/ pi 6)))
        (let* ((dx (+ (* 2 rad)
                      (- (* 2 (- rad x)))))
               (dy (* dx
                      (- (/ x y)))))
          (draw-line* pane
                      (+ x)
                      y
                      (- x dx)
                      (+ y (- dy)))))))))

phew, that was dense actually. Exploratory programming sometimes goes like this, as you accrue a previously unknown stack of ideas.

2.2.2. Let's define display-function that frame pane wanted

(defun display-function (frame pane)
  (old-heart pane))

2.3. Make one particular instance of the frame

(defparameter *heart*
  (make-application-frame 'heart))

2.4. Run that particular heart.

This is different to 'find-application-frame which just kinda makes something happen. 

(run-frame-top-level *heart*)

2.5. Run that… In a different thread

Remember that every time you feel vexed by mcclim, that it's actually threadsafe, so we can do things to one application frame from different threads and it always works. 

(require :bordeaux-threads)
;; de facto lisp threading
(bt:make-thread
 (lambda () (run-frame-top-level *heart*)))

That's just how-that-works in lisp: you make a lambda for the other thread to go do.

Anyway, now we kept our repl thread free to redef stuff. Er, let's

2.6. Add some custom lines at all

(defun some-lines (pane)
  (draw-lines* pane '(10 20 30 40 50 60 70 80)))

2.7. Put that in the display function.

(Defun display-function (frame pane)
  (old-heart pane)
  (some-lines pane))

2.8. Jiggle the frame so it picks up the new display-function

(reinitialize-instance *heart*)

Well, that kinda worked.

2.9. Let's get a bunch of lines

Now, just kinda bear with me. After the last article, someone gave me this equation:

\[y = \log{|\sec{x}+\tan{x}|} \]

they thought would look nice as the bottom of the heart.

Anyway, I'm adopting a cltl2 appendix A approach to that equation.

This is a lisp idiom originating around 1978.

2.9.1. Series linear space of equation making a list

(progn
  (require :series)
  (series::install)
(defparameter *heart-bottom*
 (butlast 
  (let* ((x (scan-range :from (- pi 0.3)
                        :upto (* 2 pi)
                        :by 0.05))
         ;;Let's just witchcraft these infinities away.
         (x+h (#m+ x (series 0.01)))
         (cosx (#mcos x+h))
         (secx (#M/ x+h))
         (tanx (#mtan x+h))
         (+abs (#Mabs (#M+ secx tanx)))
         (lnx (#mlog +abs)))
    (collect (#Mlist x lnx)))
  3)))

Er, great. Sorry about that. I guess we're using these. 

(defun draw-heart-bottom (pane)
  (funcall 'draw-lines* pane
         (apply 'append (butlast *heart-bottom*)))
  (funcall 'draw-lines* pane
       (apply 'append
              (cdr *heart-bottom*))))

2.10. Latest and greatest display-function

(defun display-function (frame pane)
  (with-scaling (pane 10 10)
    (draw-heart-bottom pane)))

2.11. GUESS AND CHECK COARSE REGISTRATION

(defun display-function (frame pane)
  (old-heart pane)
  (with-translation (pane -45 120)
    (with-scaling (pane 28 15)
      (with-slots (current-ink) frame
        (with-drawing-options (pane :ink current-ink)
          (draw-heart-bottom pane))))))
(reinitialize-instance *heart*)

2.12. New heart.

(defun old-heart (pane &aux (rad 25))
  (with-slots (current-ink) *application-frame*
    (with-drawing-options (pane :ink current-ink)
      (let ((x (* rad (cos (* pi 1/6))))
            (y (* rad (sin (* pi 1/6)))))
        (with-translation (pane 60 80)
          (draw-circle* pane 0 0 rad :filled nil
                                     :start-angle
                                     (/ pi 6)
                                     :end-angle
                                     (+ pi (/ pi 6))))

      (with-translation (pane (+ 60 40) 80)
        (draw-circle* pane 0 0 rad :filled nil
                                   :start-angle (* pi -1/6)
                                   :end-angle (- pi (/ pi 6))))))))
</div>

Author: screwlisp

Created: 2025-02-01 Sat 14:10

Validate

Get lispmoo2

lispmoo2

Add New Kind Of Society To Collection

More posts

See all posts

Comments

Log in with itch.io to leave a comment.

screwtape13 hours ago

Some emacs lisp clim howto videos I made a while ago

Reply