gearmulator

Emulation of classic VA synths of the late 90s/2000s that are based on Motorola 56300 family DSPs
Log | Files | Refs | Submodules | README | LICENSE

test-no-cm.lisp (3331B)

      1 ;; this is a half-baked sequence of PortMidi calls to test the interface
      2 ;; No calls to Common Music are made, hence test-no-cm.lisp
      3 
      4 ; setup cffi if it has not been done already
      5 (if (not (boundp '*clpath*))
      6     (load "setup-pm.lisp"))
      7 
      8 (defun println (s) (print s) (terpri))
      9 
     10 ;; initialize portmidi lib
     11 (pm:portmidi)
     12 ;; timer testing
     13 (pt:Start )
     14 (pt:Started)
     15 (format t "time is ~A, type something~%" (pt:Time))
     16 (read)
     17 (format t "time is ~A, type something~%" (pt:Time))
     18 (read)
     19 (pt:Time)
     20 (format t "time is ~A, type something~%" (pt:Time))
     21 
     22 ;; device testing
     23 (pm:CountDevices)
     24 (pprint (pm:GetDeviceInfo ))
     25 (defparameter inid (pm:GetDefaultInputDeviceID ))
     26 (pm:GetDeviceInfo inid)
     27 (defparameter outid (pm:GetDefaultOutputDeviceID ))
     28 (pm:GetDeviceInfo outid)
     29 ;; output testing
     30 (defparameter outid 4) ; 4 = my SimpleSynth
     31 (defparameter outdev (pm:OpenOutput outid 100 1000))
     32 (pm:getDeviceInfo outid) ; :OPEN should be T
     33 ;; message tests
     34 (defun pm (m &optional (s t))
     35   (format s "#<message :op ~2,'0x :ch ~2,'0d :data1 ~3,'0d :data2 ~3,'0d>"
     36           (ash (logand (pm:Message.status m) #xf0) -4)
     37           (logand (pm:Message.status m) #x0f)
     38           (pm:Message.data1 m)
     39           (pm:Message.data2 m)))
     40 (defparameter on (pm:message #b10010000 60 64))
     41 (terpri)
     42 (pm on)
     43 (pm:Message.status on)
     44 (logand (ash (pm:Message.status on) -4) #x0f)
     45 (pm:Message.data1 on)
     46 (pm:Message.data2 on)
     47 (pm:WriteShort outdev (+ (pm:time) 100) on)
     48 (defparameter off (pm:message #b10000000 60 64))
     49 (terpri)
     50 (pm off)
     51 (terpri)
     52 (println "type something for note off")
     53 (read)
     54 (pm:WriteShort outdev (+ (pm:time) 100) off)
     55 (println "type something to close output device")
     56 (read)
     57 (pm:Close outdev)
     58 ;; event buffer testing
     59 (defparameter buff (pm:EventBufferNew 8))
     60 (loop for i below 8 for x = (pm:EventBufferElt buff i) 
     61    ;; set buffer events
     62    do
     63      (pm:Event.message x (pm:message #b1001000 (+ 60 i) (+ 100 i)))
     64      (pm:Event.timestamp x (* 1000 i)))
     65 (loop for i below 8 for x = (pm:EventBufferElt buff i) 
     66    ;; check buffer contents
     67    collect (list (pm:Event.timestamp x)
     68                  (pm:Message.data1 (pm:Event.message x))
     69                  (pm:Message.data2 (pm:Event.message x))))
     70 (pm:EventBufferFree buff)
     71 ;; input testing -- requires external midi keyboard
     72 (println (pm:GetDeviceInfo ))
     73 (defparameter inid 1) ; 1 = my external keyboard
     74 (defparameter indev (pm:OpenInput inid 256)) 
     75 (pm:GetDeviceInfo inid) ; :OPEN should be T
     76 (pm:SetFilter indev pm:filt-realtime) ; ignore active sensing etc.
     77 (println "poll says:")
     78 (println (pm:Poll indev))
     79 (println "play midi keyboard and type something")
     80 (read)
     81 ;;
     82 ;; ...play midi keyboard, then ...
     83 ;;
     84 (println "poll says")
     85 (println (pm:Poll indev))
     86 (defparameter buff (pm:EventBufferNew 32))
     87 (defparameter num (pm:Read indev buff 32))
     88 (println "pm:Read gets")
     89 (println num)
     90 (println "input messages:")
     91 (pm:EventBufferMap (lambda (a b) b (terpri) (pm a))
     92                    buff num)
     93 (pm:Poll indev)
     94 
     95 (println "play keyboard, to stop, play middle-C")
     96 
     97 ;;; recv testing
     98 
     99 (defparameter pitch 0)
    100 (loop while (/= pitch 60) do
    101   (let ((n (pm:Read indev buff 1)))
    102     (cond ((= n 1)
    103            (pm:EventBufferMap
    104                 (lambda (a b) 
    105                    b (pm a) (terpri)
    106                    (setf pitch (pm:Message.data1 a)))
    107                 buff n)))))
    108 
    109 (pm:EventBufferFree buff)
    110 (pm:Close indev)
    111 
    112