;---------------------------------------------------------------------------------------------
;
;      maxpatch-overview / fo 010422
;
;
;  draws an ascii overview of a maxpatch's structure, variables and third-party externals/abstractions
;
;   1. save a maxpatch "as text..."
;   2. load and evaluate the lisp file (cmd-Y)
;   3. enter "(maxpatch-overview)" in the lisp listener and press enter
;   4. find and open the saved maxpatch when prompted
;   5. see how patches are built, which variables are in use (send, receive, value) and
;      which third-party externals/abstractions that are utilized
;
;---------------------------------------------------------------------------------------------

(defun maxpatch-overview ()
  "draws an ascii overview of a maxpatch's structure, variables and third-party externals/abstractions"
  (let ((maxStartup '(dial edetonate efunc emovie envi etable ezadc~ ezdac~ fpic function gain~ GSwitch GSwitch2 hslider imovie IncDec kslider LCD led meter~ multiSlider number~ oval playbar rslider scope~ ubutton umenu uslider))
        (maxExternals '(anal append bondo Borax Bucket buddy capture cd clip clocker coll counter cycle date decide Decode defer detonate dialog drunk env filein flush folder forward funbuff funnel glove Histo iter lib libbang libfrom libnames libswitch libto libtofrom match maximum midiflush minimum mousefilter MouseState movie msd mtr numkey offer omscontrollers omsinfo omsnotes omspatches past Peak pics pict poly prepend prob pv serial snd speedlim spell split spray sprintf sxformat tempo Text thisTimeline thisTrack thresh tiCmd tiOut TogEdge Trough urn Uzi vdp vexpr xbendin xbendout xnotein xnoteout))
        (mspExternals '(*~ +~ -~ /~ <~ ==~ >~ abs~ adc~ allpass~ avg~ begin~ biquad~ buffer~ capture~ change~ clip~ comb~ cos~ count~ curve~ cycle~ dac~ delay~ delta~ dspstate~ edge~ fft~ ftom gate~ groove~ ifft~ index~ info~ kink~ linedrive line~ log~ lookup~ lores~ mstosamps~ mtof mute~ noise~ normalize~ pass~ peek~ phasor~ play~ poke~ pow~ rand~ readsf~ receive~ record~ reson~ sah~ sampstoms~ selector~ send~ sfinfo~ sflist~ sfplay~ sfrecord~ sig~ snapshot~ sqrt~ tapin~ tapout~ thresh~ train~ vst~ wave~ writesf~))
        (maxOther '(!= % & && * + - / < << <= == > >= >> abs accum active b bag bangbang bendin bendout change closebang ctlin ctlout delay expr f float follow frame fswap gate grab graphic i if int key keyup line loadbang makenote menubar metro midiformat midiin midiout midiparse notein noteout pack patcher pcontrol pgmin pgmout pics2 pipe polyin polyout print r random receive rect ring route rtin s sel select send seq setclock stripnote sustain swap switch sysexin t table thispatcher timeline timer timein timeout touchin touchout trigger unpack v value xbendin2 xbendout2 "|" "||"))
        
        ;----- get file
        (input-list (with-open-file (file (choose-file-dialog))
                      (loop with input-data
                            while (setf input-data (remove (char ";" 0) (read-line file nil) :count 1 :from-end t))
                            collect input-data))))
    (if (not (equal (first input-list) "max v2"))
      (pprint "error! wrong file format")
      
      ;----- main loop
      (loop for i in (reverse input-list) with level = 0
            do
            (setf i (remove "hidden" (tokens i #'constituent 0) :test 'string-equal))
            (let ((pos-6 (nth 6 i)))
              (cond
               
               ((string-equal (second i) "vpatcher")
                (format t "~vt|~%" (* 4 level)) (setf level (1- level)))
               
               ((string-equal (second i) "newobj")
                (if (not (or
                          (member pos-6 maxStartup :test 'string-equal)
                          (member pos-6 maxExternals :test 'string-equal)
                          (member pos-6 mspExternals :test 'string-equal)
                          (member pos-6 maxOther :test 'string-equal)))
                  (progn
                    (format t "~vt|~%~vt‹‹‹‹‹[ ~{~a ~}]~%" (* 4 level) (* 4 level) (nthcdr 7 i))
                    (setf level (1+ level)))))
               
               ((string-equal (second i) "message")
                (if (string-equal pos-6 "\\;")
                  (format t "~vt| ; ~{~a ~}~%" (* 4 level) (nthcdr 7 i))))
               
               ((string-equal (second i) "newex")
                (if (or (not (or
                              (member pos-6 maxStartup :test 'string-equal)
                              (member pos-6 maxExternals :test 'string-equal)
                              (member pos-6 mspExternals :test 'string-equal)
                              (member pos-6 maxOther :test 'string-equal)
                              (every #'digit-char-p (remove (char "-" 0) (remove (char "." 0) pos-6)))
                              ))
                        (member pos-6 '(s send r receive v value) :test 'string-equal))
                  (format t "~vt| ~{~a ~}~%" (* 4 level) (nthcdr 6 i))))
               ))))))

;---------------------------------------------------------------------------------------------
;      tools from Paul Graham's book "ANSI Common Lisp"
;---------------------------------------------------------------------------------------------
(defun tokens (str test start)
  (let ((p1 (position-if test str :start start)))
    (if p1
      (let ((p2 (position-if #'(lambda (c)
                                 (not (funcall test c)))
                             str :start p1)))
        (cons (subseq str p1 p2)
              (if p2
                (tokens str test p2)
                nil)))
      nil)))

(defun constituent (c)
  (and (graphic-char-p c)
       (not (char= c #\ ))))