aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

33
Task/Animation/Common-Lisp/animation.lisp Normal file
View file

@ -0,0 +1,33 @@
(use-package :ltk)
(defparameter *message* "Hello World! ")
(defparameter *direction* :left)
(defun animate (label)
(let* ((n (length *message*))
(i (if (eq *direction* :left) 0 (1- n)))
(c (char *message* i)))
(if (eq *direction* :left)
(setq *message* (concatenate 'string
(subseq *message* 1 n)
(list c)))
(setq *message* (concatenate 'string (list c)
(subseq *message* 0 (1- n)))))
(setf (ltk:text label) *message*)
(ltk:after 125 (lambda () (animate label)))))
(defun basic-animation ()
(ltk:with-ltk ()
(let* ((label (make-instance 'label
:font "Courier 14")))
(setf (text label) *message*)
(ltk:bind label "<Button-1>"
(lambda (event)
(declare (ignore event))
(cond
((eq *direction* :left) (setq *direction* :right))
((eq *direction* :right) (setq *direction* :left)))))
(ltk:pack label)
(animate label)
(ltk:mainloop))))
(basic-animation)