;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10 -*-

(in-package :clim-user)

(define-application-frame fifteen-puzzle-1 ()
  ((pieces :initform (make-array `(4 4) :initial-contents `((1 2 3 4)
							    (5 6 7 8)
							    (9 10 11 12)
							    (13 14 15 0)))))
  
(:menu-bar nil)
(:panes
 (display :application
	  :text-style `(:fix :bold :very-large)
	  :display-function `draw-the-display
	  :scroll-bars nil)
 (menu :command-menu))
(:layouts
 (main
  (vertically () display menu))))

;;; this draws the entire display
(defmethod draw-the-display ((application fifteen-puzzle-1) stream
			     &key &allow-other-keys)
(with-slots (pieces) application
(dotimes (y 4)
(dotimes (x 4)
(let ((piece (aref pieces y x)))
(if (zerop piece)
(format stream "
 ")
(format stream "~2D " piece))))
(terpri stream))))
;;; useful macrology - the body will be run with x and y bound to
;;; the coordinates of the empty cell
(defmacro find-empty-piece-and-do ((y x) &body body)
‘(block find-empty-piece
(dotimes `(,y 4)
(dotimes `(,x 4)
(when (zerop `(aref pieces ,y ,x))
  ,@body ;; как бороться сэтим
         ;; READ error during COMPILE-FILE:
         ;; Comma not inside a backquote.
         ;; Line: 41, Column: 3, File-Position: 1092
(return-from find-empty-piece))))))
(define-fifteen-puzzle-1-command (down :menu t) ()
(with-slots (pieces) *application-frame*
(find-empty-piece-and-do (y x)
(if (not (zerop y))
(rotatef (aref pieces y x) (aref pieces (- y 1) x))))))
(define-fifteen-puzzle-1-command (up :menu t) ()
(with-slots (pieces) *application-frame*
(find-empty-piece-and-do (y x)
(if (not (= y 3))
(rotatef (aref pieces y x) (aref pieces (+ y 1) x))))))
(define-fifteen-puzzle-1-command (left :menu t) ()
(with-slots (pieces) *application-frame*
(find-empty-piece-and-do (y x)
(if (not (= x 3))
(rotatef (aref pieces y x) (aref pieces y (+ x 1)))))))
(define-fifteen-puzzle-1-command (right :menu t) ()
(with-slots (pieces) *application-frame*
(find-empty-piece-and-do (y x)
(if (not (zerop x))
(rotatef (aref pieces y x) (aref pieces y (- x 1)))))))
#||
()
(setq fp1 (make-application-frame ’fifteen-puzzle-1
:left 200 :right 400 :top 150 :bottom 350))
(run-frame-top-level fp1)
||#

(ql:quickload '(mcclim clim-listener))


The function :USE is undefined.
   [Condition of type UNDEFINED-FUNCTION]


CL-USER> (ql:quickload :clim-listener)
To load "clim-listener":
  Load 1 ASDF system:
    clim-listener
; Loading "clim-listener"
; 
; compilation unit aborted
;   caught 2 fatal ERROR conditions
(:CLIM-LISTENER)

have you updated you OS recently? Try reinstall VariCAD if it does not help, create symlinks to libssl 1.0.0 and libcrypto 1.0.0.
 
VariCAD still uses older versions of the said libraries for compatibility reasons. We are considering release of 2 versions of VariCAD for 1.0.0 and 1.0.1.

apt-cache policy 
Списки пакетов:

; file: /home/igor/.emacs.d/elpa/slime-2.23/swank/sbcl.lisp
; in: DEFUN SWANK/SBCL::MAKE-SOCKET-IO-STREAM
;     (EQ :FD-HANDLER SWANK:*COMMUNICATION-STYLE*)
; 
; caught WARNING:
;   undefined variable: SWANK:*COMMUNICATION-STYLE*

; in: DEFUN SWANK/SBCL::LISP-SOURCE-LOCATION
;     (LET ((SWANK/SBCL::SOURCE
;            (PRIN1-TO-STRING
;             (SB-DEBUG::CODE-LOCATION-SOURCE-FORM SWANK/SBCL::CODE-LOCATION 100)))
;           (CONDITION SWANK:*SWANK-DEBUGGER-CONDITION*))
;       (IF (AND (TYPEP CONDITION 'STEP-FORM-CONDITION)
;                (SEARCH "SB-IMPL::WITH-STEPPING-ENABLED" SWANK/SBCL::SOURCE :TEST
;                        #'CHAR-EQUAL)
;                (SEARCH "SB-IMPL::STEP-FINISHED" SWANK/SBCL::SOURCE :TEST
;                        #'CHAR-EQUAL))
;           (SWANK/BACKEND:MAKE-ERROR-LOCATION "Stepping...")
;           (SWANK/BACKEND:MAKE-LOCATION `(:SOURCE-FORM ,SWANK/SBCL::SOURCE)
;                                        '(:POSITION 1))))
; 
; caught WARNING:
;   undefined variable: SWANK:*SWANK-DEBUGGER-CONDITION*
; 
; compilation unit finished
;   Undefined variables:
;     SWANK:*COMMUNICATION-STYLE* SWANK:*SWANK-DEBUGGER-CONDITION*
;   caught 2 WARNING conditions

; file: /home/igor/.emacs.d/elpa/slime-2.23/contrib/swank-arglists.lisp
; in: DEFSTRUCT KEYWORD-ARG
;     (DEFSTRUCT
;         (SWANK::KEYWORD-ARG (:CONC-NAME SWANK::KEYWORD-ARG.)
;          (:CONSTRUCTOR SWANK::%MAKE-KEYWORD-ARG))
;       KEYWORD
;       SWANK::ARG-NAME
;       SWANK::DEFAULT-ARG)
; --> PROGN EVAL-WHEN 
; ==>
;   (SB-KERNEL::%COMPILER-DEFSTRUCT
;    '#<SB-KERNEL:DEFSTRUCT-DESCRIPTION SWANK::KEYWORD-ARG {10054BEB73}>
;    '#(#<SB-KERNEL:LAYOUT for T {20300003}>
;       #<SB-KERNEL:LAYOUT for STRUCTURE-OBJECT {20300103}>))
; 
; caught STYLE-WARNING:
;   Previously compiled calls to SWANK::KEYWORD-ARG.KEYWORD,
;   SWANK::KEYWORD-ARG.ARG-NAME and SWANK::KEYWORD-ARG.DEFAULT-ARG could not be
;   inlined because the structure definition for SWANK::KEYWORD-ARG was not yet
;   seen. To avoid this warning, DEFSTRUCT should precede references to the
;   affected functions, or they must be declared locally notinline at each call
;   site.

; in: DEFSTRUCT OPTIONAL-ARG
;     (DEFSTRUCT
;         (SWANK::OPTIONAL-ARG (:CONC-NAME SWANK::OPTIONAL-ARG.)
;          (:CONSTRUCTOR SWANK::%MAKE-OPTIONAL-ARG))
;       SWANK::ARG-NAME
;       SWANK::DEFAULT-ARG)
; --> PROGN EVAL-WHEN 
; ==>
;   (SB-KERNEL::%COMPILER-DEFSTRUCT
;    '#<SB-KERNEL:DEFSTRUCT-DESCRIPTION SWANK::OPTIONAL-ARG {100594EF33}>
;    '#(#<SB-KERNEL:LAYOUT for T {20300003}>
;       #<SB-KERNEL:LAYOUT for STRUCTURE-OBJECT {20300103}>))
; 
; caught STYLE-WARNING:
;   Previously compiled calls to SWANK::OPTIONAL-ARG.ARG-NAME and
;   SWANK::OPTIONAL-ARG.DEFAULT-ARG could not be inlined because the structure
;   definition for SWANK::OPTIONAL-ARG was not yet seen. To avoid this warning,
;   DEFSTRUCT should precede references to the affected functions, or they must be
;   declared locally notinline at each call site.

; in: DEFGENERIC EXTRACT-LOCAL-OP-ARGLISTS => DEF.BODY (CDDR CURRENT-DEF)
;     (CDDR SWANK::CURRENT-DEF)
; --> CDR CDR 
; ==>
;   SWANK::CURRENT-DEF
; 
; note: deleting unreachable code

; in: DEFGENERIC EXTRACT-LOCAL-OP-ARGLISTS
;     (SWANK::%COLLECT-OP/ARGL-ALIST SWANK::DEFS)
; ==>
;   SWANK::DEFS
; 
; note: deleting unreachable code
; 
; compilation unit finished
;   caught 2 STYLE-WARNING conditions
;   printed 2 notes

; file: /home/igor/.emacs.d/elpa/slime-2.23/contrib/swank-presentations.lisp
; in: EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
;     (SWANK:SWANK-REQUIRE :SWANK-REPL)
; 
; caught WARNING:
;   SWANK-REPL also exports the following symbols:
;     (SWANK-REPL:LISTENER-SAVE-VALUE SWANK-REPL:REDIRECT-TRACE-OUTPUT
;      SWANK-REPL:CLEAR-REPL-VARIABLES SWANK-REPL:CREATE-REPL
;      SWANK-REPL:LISTENER-GET-VALUE SWANK-REPL:LISTENER-EVAL)
;   See also:
;     The ANSI Standard, Macro DEFPACKAGE
;     The SBCL Manual, Variable SB-EXT:*ON-PACKAGE-VARIANCE*
; 
; caught STYLE-WARNING:
;   redefining THREAD-FOR-EVALUATION (#<STRUCTURE-CLASS SWANK::MULTITHREADED-CONNECTION>
;                                     #<SB-MOP:EQL-SPECIALIZER :FIND-EXISTING>) in DEFMETHOD
; 
; compilation unit finished
;   caught 1 WARNING condition
;   caught 1 STYLE-WARNING condition

(defun string-to-number (n)
  (car (list (read-from-string n))))

(defun degrees-minutes-seconds-to-radians (d m s)
  (+ (* (string-to-number d) (/ pi 180))
     (* (string-to-number m) (/ pi (* 180 60)))
     (* (string-to-number s) (/ pi (* 180 60 60)))
     ))

;;;(let* ((n 4)
   ;;;      (m (expt 10 n)))
      ;;;(/ (fround 0.2398476566 (/ 1 m)) m))

;;; Round a flout number to required number of digits
(defun my-round (x digits)
(let* ((n (string-to-number digits))
         (m (expt 10 n)))
      (/ (fround x (/ 1 m)) m)))


(defun dms ()
  (with-ltk ()
    (let* ((window (make-instance 'frame))
	   #-:tk84
	 ;;;; Explanation
	 (fcriteria (make-instance 'frame :master window))
	 (criteria (make-instance 'label
				  :master fcriteria
				  :width 60
				  :text "rad = aº * (π / 180) + a' * (π / (180 * 60) + a'' * (π / (180 * 60 * 60))"))
	   (fdigits (make-instance 'frame :master window))
	   (before-digits (make-instance 'label
					 :master fdigits
					 :text "Округлить до "))
	   (e-digits (make-instance 'entry
				    :master fdigits
				    :width 1))
	   (after-digits (make-instance 'label
					:master fdigits
					:text " знаков после запятой"))
	 ;;;; ENTER DATA
(fdms (make-instance 'frame :master window))
(e-degrees (make-instance 'entry
			  :master fdms
			  :width 3))
(e-minutes (make-instance 'entry
			  :master fdms
			  :width 2))
(e-seconds (make-instance 'entry
			  :master fdms
			  :width 2))
(l-d (make-instance 'label
		    :master fdms
		    :text "º "))
(l-m (make-instance 'label
		    :master fdms
		    :text "' "))
(l-s (make-instance 'label
		    :master fdms
		    :text "''"))
(l1 (make-instance 'label
		   :master fdms
		   :text " = "))
(l2 (make-instance 'label
		   :master fdms
		   :text " rad"))
a
r
rslt
(b1 (make-instance 'button
		   :master window
		   :text "Run"
		   :command (lambda ()
			      (setf
			       a (degrees-minutes-seconds-to-radians
				  (text e-degrees)
				  (text e-minutes)
				  (text e-seconds)))
			      (setf r (my-round a (text e-digits)))
			      (setf (text rslt) r)))))

(setf rslt (make-instance 'label :master fdms :text 0))

(pack window)
(pack fcriteria)
(pack criteria)
(pack fdigits)
(pack before-digits :side :left)
(pack e-digits :side :left)
(pack after-digits :side :left)
(pack fdms)
(pack e-degrees :side :left)
(pack l-d :side :left)
(pack e-minutes :side :left)
(pack l-m :side :left)
(pack e-seconds :side :left)
(pack l-s :side :left)
(pack l1 :side :left)
(pack rslt :side :left)
(pack l2 :side :left)
(pack b1))))

;;; Вывод полученных данных

(progn
  (format t "Стойка ~,6F, мм~%" *L1*)
  (format t "Кривошип ~,6F, мм~%" *L2*)
  (format t "Шатун ~,6F, мм~%" *L3*)
  (format t "Коромысло ~,6F, мм~%" *L4*)
  ;;;(format t "Проверка выбранных размеров кривошипа,
            ;;    шатуна, коромысла, стойки. Если t, полученные
             ;;   данные принимаются ~A.~%" *prov*)
  (format t "Шаг разбивки окружности ~,6F, мм~%" *step*)
  (format t "Частота вращения ~,6F, об/мин~%" *n*)
  (format t "Время пуска ~,6F, с~%" *time*)
        (format t "Максимальный угол φ4max = ~,6F. рад~%" *phi4-max*)
	(format t "Минимальный угол φ4min = ~,6F. рад~%" *phi4-min*)
	(format t "Угол φ2 при максимальном φ4. φ2max = ~,6F. рад~%" *phi2-max*)
	(format t "Угол φ2 при минимальном φ4.  φ2min = ~,6F. рад~%" *phi2-min*)
	(format t "Угол поворота коромысла ~,6F. рад~%" *angle*)
  (format t "Максимальная угловая скорость ω3max = ~,6F. 1/c~%" *omega3-max*)
  (format t "Максимальная угловая скорость ω4max = ~,6F. 1/c~%" *omega4-max*)
  (format t "Максимальное угловое ускорение ε3max = ~,6F. 1/c^2~%" 
		*epsilon3-max*)
  (format t "Максимальное угловое ускорение ε4max = ~,6F. 1/c^2~%" 
	  *epsilon4-max*)
  (format t "Выдача данных расчёта несколько искажена format поэтому 
              нужно брать цифру до 4 знака после запятой или это ещё 
             какое-то искажение.~%")
  )

(progn 
;;=========Для расчёта геометрии четырёхзвенного механизма==============
  (defvar *L1*)  ;;стойка, мм
  (defvar *L2*)   ;;кривошип, мм
  (defvar *L3*)  ;;шатун, мм
  (defvar *L4*)   ;;коромысло, мм
  (defvar *step*) ;;шаг угла поворота, рад  
  (defvar *tmp-lst-of-val-PHI2*) 
  (defvar *lst-of-val-PHI2*) ;; Лист углов кривошипа φ2 за один оборот
  (defvar *tmp-val-PHI2*)       ;; угол 0рад в листе отсутсвует
  (defvar *lst-of-angles-tg-PHIs*) ;;лист значений тангенса угла tg(PHIs)
  (defvar *lst-val-PHIs*) ;;Лист значений угла PHIs
  (defvar *lst-of-vector-s*) ;;лист значений вектора s
  (defvar *lst-val-PHI4s*) ;;лист значений PHI4s
  (defvar *lst-val-PHI3s*)  ;;лист значений PHI3s
  (defvar *lst-val-PHI4*)  ;;Лист значений углов PHI4 рад
  (defvar *lst-val-PHI3*)  ;;лист значений углов PHI3 рад
  (defvar *count-max*) ;;счёт листа начинается с 0.
  (defvar *count-min*)
  
  (setq *tmp-lst-of-val-PHI2* nil) 
  (setq *lst-of-val-PHI2* nil);; Лист углов кривошипа φ2 за один оборот
  (setq *tmp-val-PHI2* 0.0)       ;; угол 0рад в листе отсутсвует
  (setq *lst-of-angles-tg-PHIs* nil) ;;лист значений тангенса угла tg(PHIs)
  (setq *lst-val-PHIs* nil) ;;Лист значений угла PHIs
  (setq *lst-of-vector-s* nil) ;;лист значений вектора s
  (setq *lst-val-PHI4s* nil) ;;лист значений PHI4s
  (setq *lst-val-PHI3s* nil)  ;;лист значений PHI3s
  (setq *lst-val-PHI4* nil)  ;;Лист значений углов PHI4 рад
  (setq *lst-val-PHI3* nil)  ;;лист значений углов PHI3 рад
  (setq *count-max* 0) ;;счёт листа начинается с 0.
  (setq *count-min* 0))
  ;;;============ввод данных=======================
  ;;; Проверка на число
  (defun string-to-number (n)
    (car (list (read-from-string n))))

  (defun alarm ()
    (do-msg "Введите число"))
  
(with-ltk ()
  (let* ((window (make-instance 'frame))
    #-:tk84
    ;;стойка, мм
    (base (make-instance 'label :master window
			        :text "Стойка: "))
    (e-base (make-instance 'entry :master window))
    (base-units (make-instance 'label :master window
			              :text "мм"))
  ;;кривошип, мм
  (crank (make-instance 'label :master window
		              :text "Кривошип: "))
  (e-crank (make-instance 'entry :master window))
  (crank-units (make-instance 'label :master window
			             :text "мм"))
  ;;шатун, мм
  (bar (make-instance 'label :master window
		      :text "Шатун: "))
  (e-bar (make-instance 'entry :master window))
  (bar-units (make-instance 'label :master window
			    :text "мм"))
  ;;коромысло, мм
  (beam (make-instance 'label :master window
		       :text "Коромысло: "))
  (e-beam (make-instance 'entry window))
  (beam-units (make-instance 'label :master window
			     :text "мм"))
 

  (divide-step (make-instance 'label :master window
		       :text "Шаг разбивки окружности: "))
  (e-divide-step (make-instance 'entry window))
  (divide-step-units (make-instance 'label :master window
				    :text "рад"))

  (b1 (make-instance 'button
		     :master window
		     :text "Поехали"
		     :command (lambda ()
				(progn
				  ;;стойка, мм
				  (if (numberp (string-to-number
						       (text e-base)))
					     (setf *L1* (string-to-number
						      (text e-base)))
					     (alarm))

				  ;;кривошип, мм
				  (if (numberp (string-to-number
						       (text e-base)))
					     (setf *L2* (string-to-number
						      (text e-crank)))
					     (alarm))

				  ;;шатун, мм
				  (if (numberp (string-to-number
						       (text e-base)))
					     (setf *L3* (string-to-number
						      (text e-bar)))
					     (alarm))

				  ;;коромысло, мм
				  (if (numberp (string-to-number
						       (text e-base)))
					     (setf *L4* (string-to-number
						      (text e-beam)))
					     (alarm))
				  
				  ;;Шаг разбивки окружности
				  (if (numberp (string-to-number
						       (text e-divide-step)))
				      (setf *step*
					       (string-to-number
						      (text e-divide-step)))
					     (alarm)))))))
    (pack window)
    (pack base)
    (pack e-base)
    (pack base-units)
    (pack crank)
    (pack e-crank)
    (pack crank-units)
    (pack bar)
    (pack e-bar)
    (pack bar-units)
    (pack beam)
    (pack e-beam)
    (pack beam-units)
    (pack divide-step)
    (pack e-divide-step)
    (pack divide-step-units)
    (pack b1)))

;;;;====McCLIM Guided Tour===========
(in-package :common-lisp-user)

(defpackage "HELLO"
(:use :clim :clim-lisp)
(:export "HELLO-MAIN"))

(in-package :hello)

(define-application-frame hello-world ()
  ((greeting :initform "Hello World"
	     :accessor greeting))
  (:pane (make-pane 'hello-world-pane :width 200 :height 50))) 
                                  ;;; ^ never miss it
(defclass hello-world-pane
  (clim-stream-pane) ())

;;; Behavior defined by the Handle Repaint Protocol
(defmethod handle-repaint ((pane hello-world-pane) region)
  (let ((w (bounding-rectangle-width pane))
	(h (bounding-rectangle-height pane)))
    ;; Blanc the pane out
    (draw-rectangle* pane 0 0 w h
		     :filled t
		     :ink (pane-background pane))
    ;; Draw greeting in center of pane
    (draw-text* pane
		(greeting *application-frame*)
		(floor w 2) (floor h 2)
		:align-x :center
		:align-y :center)))

(defun hello-main ()
(run-frame-top-level
 (make-application-frame 'hello-world)))

(defun string-to-number (n)
  (car (list (read-from-string n))))

(defun sum (a b)
  (+ (string-to-number a) (string-to-number b)))

(defvar s)
(setq s 0)

(defun ltksum()
  (with-ltk ()
    (let* ((bar (make-instance 'frame))
	   #-:tk84
	   (e1 (make-instance 'entry :master bar))
	   (e2 (make-instance 'entry :master bar))
	   (b4 (make-instance 'button
			      :master bar
			      :text "Sum"
			      :command (lambda ()
					 (setf s (sum (text e1) (text e2))))))
	   (l (make-instance 'label
			     :master bar
			     :text s)))
(pack bar)
(pack e1 :side :left)
(pack e2 :side :left)
(pack b4 :side :left)
(pack l :side :left)
)))