#+TITLE: Back-of-envelope-logos
#+author: screwlisp
I'm adding a detailed appendix about how to run this at the end.

UPDATE: Two small changes to help M-x org-babel-execute-buffer.
Note that you really have to start slime similar to the appendix.
* clim lisp
** Have a clim2 app at all.
#+begin_src lisp
  (define-application-frame logos () ())
  (find-application-frame 'logos)
#+end_src

#+RESULTS:
: DEFINE-LOGOS-COMMAND
** Actually, let's specify display and interactor panes
#+begin_src lisp
  (define-application-frame logos () ()
    (:panes
     (display :application :display-after-commands nil)
     (interactor :interactor))
    (:layouts
     (default (horizontally () display interactor))))
#+end_src

#+RESULTS:
: DEFINE-LOGOS-COMMAND

** Look at that (default application)
#+name: run-frame
#+begin_src lisp
  (defvar *logos* (make-application-frame 'logos))
  (run-frame-top-level *logos*)
#+end_src

#+RESULTS: run-frame
: NIL

#+RESULTS:
: #<LOGOS {10099AC083}>

Beneath the hood: I've actually set us in the CLIM-USER namespace.
** Menu with open, clear and exit
*** DONE Open (unimplemented)
[adding an open button was a homework topic for my friend,
see replay later]
#+begin_src lisp
  (define-logos-command (com-open :menu t) ()
    ())
#+end_src

#+RESULTS:
: COM-OPEN
*** DONE Clear
We clear the display pane. It's a bit abnormal to clear the interactor (just scroll down?) so that would be done in a not-otherwise-generalisable way (using the ==editor== tools).
#+begin_src lisp
  (define-logos-command (com-clear :menu t) ()
    (let ((pane (get-frame-pane *application-frame* 'display)))
      (window-clear pane)))
#+end_src

#+RESULTS:
: COM-CLEAR

Can just C-c C-c on this line to run it again:
#+call: run-frame()

#+RESULTS:
: #<LOGOS {1001B09633}>
*** Exit
#+begin_src lisp
  (define-logos-command (com-quit :menu t) ()
    (frame-exit *application-frame*))
#+end_src

#+RESULTS:
: COM-QUIT

#+call: run-frame()

#+RESULTS:
: #<LOGOS {10058DAEE3}>
*** Draw a circle at all
#+begin_src lisp :eval no :exports code
  (define-logos-command (com-encircle :menu t) ()
    (let ((pane (get-frame-pane *application-frame* 'display)))
      (draw-circle* pane 100 75 40 :filled t)))
#+end_src

#+RESULTS:
: COM-ENCIRCLE
** Add class slots
*** Drawing properties
tbh I just thought about what I knew about turtles
#+begin_src lisp
  (define-application-frame logos ()
    ((lines :type t :initform ())
     (step-len :type (integer 0 512) :initform 5)
     (turtle-rad :type (integer 0 512) :initform 3)
     (turtle-on :type t :initform t)
     (tail-down :type t :initform t)
     (turtle-x :type integer :initform 50)
     (turtle-y :type integer :initform 60)
     (degrees :type (number 0 360) :initform 90))
    (:panes
     (display :application :display-function 'line-and-turtle)
     (interactor :interactor))
    (:layouts
     (default (horizontally () display interactor))))

  (defun line-and-turtle (frame pane &rest 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) frame
	  (apply 'draw-circle* pane
		 turtle-x turtle-y turtle-rad '(:filled nil))))))

  (setq *logos* (find-application-frame 'logos :activate nil))
#+end_src

#+RESULTS:
: LINE-AND-TURTLE

#+call: run-frame()

#+RESULTS:
: #<LOGOS {1001E318E3}>
*** Forward
#+begin_src lisp
  (define-logos-command (com-forward :menu t) ()
    (with-slots (turtle-x turtle-y step-len degrees tail-down lines) *application-frame*
	(let ((new-x (round (+ turtle-x (* step-len (cos (* degrees 2 pi (/ 360.0)))))))
	      (new-y (round (+ turtle-y (* step-len (sin (* degrees 2 pi (/ 360.0))))))))
	  (when tail-down (push (list turtle-x turtle-y new-x new-y) lines))
	  (setf turtle-x new-x turtle-y new-y))))
#+end_src

#+RESULTS:
: COM-FORWARD
*** turn spinwise
#+begin_src lisp
  (define-logos-command (com-+turn :menu t) ()
    (with-slots (degrees) *application-frame*
      (setf degrees (+ degrees 90))))
#+end_src

#+RESULTS:
: COM-+TURN

*** Clear deletes lines
#+begin_src lisp
  (define-logos-command (com-clear :menu t) ()
    (with-slots (lines) *application-frame*
      (setf lines ())))
#+end_src

#+RESULTS:
: COM-CLEAR

#+call: run-frame()

#+RESULTS:
: #<LOGOS {1006439453}>

Pretty cool.

*** It turns out that execute-frame-command works on symbols          :aside:

*** Add "input-recording"
#+begin_src lisp
  (define-application-frame logos ()
    ((saving-inputs :type t :initform nil)
     (inputs-list :type t :initform ())
     (lines :type t :initform ())
     (step-len :type (integer 0 512) :initform 5)
     (turtle-rad :type (integer 0 512) :initform 3)
     (turtle-on :type t :initform t)
     (tail-down :type t :initform t)
     (turtle-x :type integer :initform 50)
     (turtle-y :type integer :initform 60)
     (degrees :type (number 0 360) :initform 90))
    (:panes
     (display :application :display-function 'line-and-turtle)
     (interactor :interactor))
    (:layouts
     (default (horizontally () display interactor))))
  (setq *logos* (find-application-frame 'logos :activate nil))

#+end_src

#+RESULTS:
: DEFINE-LOGOS-COMMAND

*** Record commmands (generally, I guess)
#+begin_src lisp
  (defmethod execute-frame-command :before ((frame logos) command)
    (with-slots (saving-inputs inputs-list) *application-frame*
	(when saving-inputs (push command inputs-list))))
#+end_src

#+RESULTS:
: #<STANDARD-METHOD CLIM:EXECUTE-FRAME-COMMAND :BEFORE (LOGOS T) {1006FE8E43}>

#+call: run-frame()

*** Toggle recording.
#+begin_src lisp
  (define-logos-command (com-toggle_rec :menu t) ()
    (with-slots (saving-inputs inputs-list) *application-frame*
      (when saving-inputs (setf inputs-list (nbutlast inputs-list)))
      (setf saving-inputs (not saving-inputs))))

  (define-logos-command (com-trash_rec :menu t) ()
    (with-slots (inputs-list) *application-frame*
      (setf inputs-list nil)))

  (define-logos-command (com-save_rec :menu t) ((fil 'pathname :default #p"logos.txt" :display-default t))
    (with-slots (inputs-list) *application-frame*
	(with-open-file (out fil :direction :output :if-exists :append :if-does-not-exist :create)
	  (format out "~{~a~^~%~}" inputs-list))))

#+end_src

#+RESULTS:
: COM-SAVE_REC

#+call: run-frame()

#+RESULTS:
: NIL

*** Load a prev file.
#+begin_src lisp
  (define-logos-command (com-replay :menu t) ((fil 'pathname :default #p"logos.txt" :display-default t))
    (with-open-file (in fil :direction :input)
      (loop for command = (read in nil nil)
	    while command do
	      (execute-frame-command *application-frame* command))))

#+end_src

#+RESULTS:
: COM-REPLAY

*** Remove deprecated commands
#+begin_src lisp
  (let ((table (find-command-table 'logos)))
    ;;(remove-command-from-command-table 'com-encircle table )
    (remove-command-from-command-table 'com-open table ))
#+end_src
- Encircle was just an example on a different redraw type
- open was replaced by ==com-redraw==
** ISSUES
- recorded commands are in time-reversed order
- I dunno, use your imagination.
- :display-after-commands is ~deprecated

* Running This File                                                :appendix:
This might seem like a lot, but it amounts to "have emacs, sbcl and McCLIM on your computer"
** Emacs, slime, lisp, sbcl, quicklisp, mcclim
1. Use quicklisp (quicklisp.org) to ==(ql:quickload :mcclim)==
2. Install slime-mode in emacs (melpa.org ?)
3. I start slime like this:
#+name: clim-sbcl-start
#+begin_src elisp :eval yes

  (eshell)
  (insert "sbcl --load ~/common-lisp/slime*/start-swank.lisp --eval '(progn (require :mcclim) (in-package :clim-user))'")
  (eshell-send-input)
  (sleep-for 5)
  (switch-to-prev-buffer)

#+end_src
followed by M-x slime-connect ret ret. Good luck/ask me for more specific help.
** That's all done:
1. Open the orgfile in emacs in a graphical environment.
2. M-x customize-variable org-babel-load-languages -> INS lisp and apply-and-save
   (ask me or your local emacs wizard)
3. Now you can run code blocks/CALLs from this file using C-c C-c
   to run where the cursor is
   a. Or the whole file in order with M-x org-babel-execute-buffer