File: tone

package info (click to toggle)
picolisp 3.1.0.7-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 4,100 kB
  • sloc: ansic: 14,205; lisp: 795; makefile: 290; sh: 13
file content (41 lines) | stat: -rwxr-xr-x 853 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
# 13oct06abu
# (c) Software Lab. Alexander Burger

# Must be run on a virtual console

(load "lib/misc.l" "lib/gcc.l")

### 'ioctl' glue function
(gcc "tst" NIL 'tone)

#include <sys/ioctl.h>
#include <linux/kd.h> // KIOCSOUND

// (tone 'freq) -> flg
any tone(any ex) {
   long amp = evCnt(ex,cdr(ex));
   long freq = evCnt(ex,cddr(ex));

   return ioctl(0, KIOCSOUND, amp==0 || freq==0? 0 : 1193180L/freq) < 0? Nil : T;
}

/**/

### Create named pipe
(unless (call 'test "-p" "fifo/tone")
   (call 'mkdir "-p" "fifo")
   (call 'mkfifo "fifo/tone") )

(push1 '*Bye '(call 'rm "fifo/tone"))


### Serve calls like:
#  (setq *Tone (open "fifo/tone"))
#  (out *Tone (pr 100 440))  # 440 Hz
#  (out *Tone (pr 0 0))    # Off
#  (close *Tone)
(loop
   (in "fifo/tone"
      (while (rd)
         (tone @ (rd)) ) ) )