#+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: : # 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: : # *** Exit #+begin_src lisp (define-logos-command (com-quit :menu t) () (frame-exit *application-frame*)) #+end_src #+RESULTS: : COM-QUIT #+call: run-frame() #+RESULTS: : # *** 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: : # *** 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: : # 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: : # #+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