#!/usr/bin/newlisp # # Play some notes on the speaker of your PC! # # Currently works with Linux console or X environment, or Win32 # # May 14, 2006 - Peter van Eerten (GPL) #--------------------------------------------------------------------- (context 'SPK) # Determine which library to use first. (case (last (sys-info)) # Linux (1 (import "libc.so.6" "ioctl") # Console (constant 'KIOCSOUND 0x4B2F) (constant 'KDMKTONE 0x4B30) (constant 'DEVICE 1) (if (file? "/usr/X11R6/lib/libX11.so") # X-environment (begin (import "libX11.so" "XOpenDisplay") (import "libX11.so" "XGetKeyboardControl") (import "libX11.so" "XChangeKeyboardControl") (import "libX11.so" "XCloseDisplay") (import "libX11.so" "XBell") (import "libX11.so" "XFlush") (constant 'KBBellPercent (<< 1 1)) (constant 'KBBellPitch (<< 1 2)) (constant 'KBBellDuration (<< 1 3)) (constant 'X true) ) ) ) # Windows (6 (import "kernel32.dll" "Beep") ) # Other (true (println "This platform is not supported (yet)! Exiting...") (exit) ) ) # Play a beep with pitch 'freq' and length 'duration' (define (beep freq duration, display settings note) # Is there a tone at all? (if (> freq 0) (case (last (sys-info)) # Linux (1 # Use console (if (and (< (ioctl DEVICE KIOCSOUND (/ 1193180 freq)) 0) X) # Use X when console command returns error (begin (set 'display (XOpenDisplay 0)) (set 'settings (dup "\000" 64)) (XGetKeyboardControl display settings) (set 'note (pack "lu lu lu lu lu lu lu lu" 0 0 freq duration 0 0 0 0)) (XChangeKeyboardControl display (| KBBellDuration KBBellPitch) note) (XBell display 100) (XFlush display) (sleep duration) (XChangeKeyboardControl display (| KBBellDuration KBBellPitch) settings) (XCloseDisplay display) ) # Finsh console (begin (sleep duration) (ioctl DEVICE KIOCSOUND 0) ) ) ) # Windows (6 (Beep freq duration) ) ) ) ) # Put it all to silence (define (shut, display) (case (last (sys-info)) # Linux (1 # Use console (if (and (< (ioctl DEVICE KIOCSOUND 0) 0) X) # Use X when console command returns error (begin (set 'display (XOpenDisplay 0)) (XFlush display) (XCloseDisplay display) ) ) ) # Windows (6 (Beep 0 0) ) ) ) #--------------------------------------------------------------------- (context 'MAIN) (set 'piano '((113 523) (119 587) (101 659) (114 698) (116 784) (121 880) (117 988) (105 1046))) (println "Press the keys QWERTYUI to play the piano! ESC to exit.") (while (!= (set 'c (read-key)) 27) (SPK:beep (lookup c piano) 100)) (SPK:shut) (exit)