#+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.
Actually, just (in-package :clim-user) in slime manually please.
* 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

You are viewing proxied material from tilde.club. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.