--- jam/scrlogos/hleve.lisp 2024-05-22 07:56:15.549790123 +1200
+++ common-lisp/scrlogos/hleve.lisp 2024-05-22 21:45:45.192889883 +1200
@@ -1,6 +1,8 @@
(uiop:define-package :scrlogos/hleve
+ (:import-from :scrlogos/frame)
(:mix :clim-lisp :clim :cl)
- (:mix-reexport :scrlogos/commands :scrlogos/engine #:scrlogos/parents)
+ (:mix-reexport :scrlogos/commands :scrlogos/engine
+ #:scrlogos/parents)
(:export #:com-set-step-len
#:com-set-phi
@@ -241,24 +243,36 @@
in an obvious way
"
(let ((frame *application-frame*))
- (refresh-labels frame)
- (case (keyboard-event-character event)
- (#\upwards_arrow
+ (case (keyboard-event-key-name event)
+ (:up
(execute-frame-command frame '(com-forward)))
- (#\downwards_arrow
+ (:down
(execute-frame-command frame `(com-undo)))
- (#\leftwards_arrow
+ (:left
(with-slots (phi phi-inc) frame
(execute-frame-command
frame
`(com-set-phi ,(mod (- phi phi-inc) 360)))))
- (#\rightwards_arrow
+ (:right
(with-slots (phi phi-inc) frame
(execute-frame-command frame
`(com-set-phi ,(mod (+ phi phi-inc) 360))))))))
(defmethod run-frame-top-level :before ((obj logos) &key &allow-other-keys))
-
-
-
+(defun scrlogos/frame:line-and-turtle (frame pane &rest display-spec)
+ (declare (ignore display-spec))
+ (with-slots (lines turtle-on) frame
+ (dolist (line lines)
+ (apply 'draw-line* pane line))
+ (when turtle-on
+ (with-slots (turtle-x turtle-y turtle-rad step-len phi) frame
+ (scroll-extent pane (- turtle-x 50) (- turtle-y 50))
+ (apply 'draw-circle* pane
+ turtle-x turtle-y turtle-rad '(:filled nil))
+ (let* ((new-x (round (+ turtle-x (* step-len (cos (* phi 2 pi (/ 360.0)))))))
+ (new-y (round (+ turtle-y (* step-len (sin (* phi 2 pi (/ 360.0)))))))
+ (xy (list turtle-x turtle-y))
+ (new-xy (list new-x new-y)))
+ (apply 'draw-line* pane
+ turtle-x turtle-y new-xy))))))
