q-lang-cvs Mailing List for Q - Equational Programming Language (Page 126)
Brought to you by:
agraef
You can subscribe to this list here.
2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(106) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2004 |
Jan
(219) |
Feb
(152) |
Mar
|
Apr
(92) |
May
(45) |
Jun
(3) |
Jul
|
Aug
(3) |
Sep
(111) |
Oct
(52) |
Nov
|
Dec
|
2005 |
Jan
|
Feb
(1) |
Mar
(1) |
Apr
(2) |
May
(23) |
Jun
(46) |
Jul
(158) |
Aug
(22) |
Sep
|
Oct
(26) |
Nov
(11) |
Dec
(49) |
2006 |
Jan
(57) |
Feb
(196) |
Mar
(10) |
Apr
(41) |
May
(149) |
Jun
(308) |
Jul
(11) |
Aug
(25) |
Sep
(15) |
Oct
|
Nov
|
Dec
(15) |
2007 |
Jan
|
Feb
|
Mar
|
Apr
(15) |
May
(204) |
Jun
(112) |
Jul
(7) |
Aug
(16) |
Sep
(134) |
Oct
(313) |
Nov
(262) |
Dec
(83) |
2008 |
Jan
(81) |
Feb
(83) |
Mar
(21) |
Apr
|
May
|
Jun
(1) |
Jul
(2) |
Aug
(6) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
2015 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(2) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
From: <ag...@us...> - 2004-01-10 13:14:58
|
Update of /cvsroot/q-lang/q In directory sc8-pr-cvs1:/tmp/cvs-serv8835 Modified Files: ChangeLog configure.in Log Message: added mkuint, isuint, mkbool, isbool to libq, bumped up libq version number Index: ChangeLog =================================================================== RCS file: /cvsroot/q-lang/q/ChangeLog,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** ChangeLog 5 Jan 2004 06:32:47 -0000 1.17 --- ChangeLog 10 Jan 2004 13:14:55 -0000 1.18 *************** *** 1,2 **** --- 1,13 ---- + 2004-01-10 Albert Graef <Dr....@t-...> + + * libq, modules: Finally added some routines to libq which are + used in many modules, but haven't been in libq up to now, namely + mkuint, isuint, mkbool and isbool. + + Unfortunately, the binary interface to libq had to be changed for + that in a non-backward-compatible way, so I bumped up the libq + version number. This implies that you *must* recompile all your + modules (including Q-Audio and Q-Midi if you use those). + 2004-01-05 Albert Graef <Dr....@t-...> Index: configure.in =================================================================== RCS file: /cvsroot/q-lang/q/configure.in,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** configure.in 6 Jan 2004 09:15:05 -0000 1.6 --- configure.in 10 Jan 2004 13:14:55 -0000 1.7 *************** *** 14,18 **** dnl set this to the libq version (interface:revision:age) ! LIBQ_VERSION=4:0:0 dnl set this to the year of the release (used to generate copyright infos) --- 14,18 ---- dnl set this to the libq version (interface:revision:age) ! LIBQ_VERSION=5:0:0 dnl set this to the year of the release (used to generate copyright infos) |
From: <ag...@us...> - 2004-01-08 00:13:42
|
Update of /cvsroot/q-lang/q-audio In directory sc8-pr-cvs1:/tmp/cvs-serv29684 Modified Files: README Log Message: updated README: need Q 4.6 or later Index: README =================================================================== RCS file: /cvsroot/q-lang/q-audio/README,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** README 16 Dec 2003 13:08:26 -0000 1.3 --- README 8 Jan 2004 00:13:39 -0000 1.4 *************** *** 30,34 **** http://q-lang.sourceforge.net. ! Make sure you get Q version 4.5 or later. Under the above URL you'll also find the latest Q-Audio sources and binary --- 30,34 ---- http://q-lang.sourceforge.net. ! Make sure you get Q version 4.6 or later. Under the above URL you'll also find the latest Q-Audio sources and binary |
From: <ag...@us...> - 2004-01-06 23:55:16
|
Update of /cvsroot/q-lang/q/modules/ggi In directory sc8-pr-cvs1:/tmp/cvs-serv10985 Modified Files: ggi.c Log Message: Freetype 2.0 compatibility fixes Index: ggi.c =================================================================== RCS file: /cvsroot/q-lang/q/modules/ggi/ggi.c,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** ggi.c 3 Jan 2004 04:13:51 -0000 1.17 --- ggi.c 6 Jan 2004 23:55:12 -0000 1.18 *************** *** 76,79 **** --- 76,87 ---- #include FT_FREETYPE_H #include FT_GLYPH_H + #if FREETYPE_MAJOR != 2 + #error "This module needs FreeType2, sorry." + #endif + #if FREETYPE_MINOR < 1 + #define FT_KERNING_DEFAULT ft_kerning_default + #define FT_RENDER_MODE_NORMAL ft_render_mode_normal + #define FT_RENDER_MODE_MONO ft_render_mode_mono + #endif #endif |
From: <ag...@us...> - 2004-01-06 09:15:08
|
Update of /cvsroot/q-lang/q/src In directory sc8-pr-cvs1:/tmp/cvs-serv8791/src Modified Files: Makefile.mingw Log Message: updated year in copyright notice Index: Makefile.mingw =================================================================== RCS file: /cvsroot/q-lang/q/src/Makefile.mingw,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Makefile.mingw 2 Jan 2004 04:30:52 -0000 1.3 --- Makefile.mingw 6 Jan 2004 09:15:05 -0000 1.4 *************** *** 42,46 **** # the following variable may be used to overwrite settings specified in sys.h ! DEFS = -DHAVE_MINGW_H -DYEAR='"2003"' -DSYSINFO='"$(host)"' -DQPATH='".;$(libdir)"' -DQEXEC='"$(prefix)/q"' -DREADLINE_LIBRARY -DUSE_THREADS EXEEXT = .exe --- 42,46 ---- # the following variable may be used to overwrite settings specified in sys.h ! DEFS = -DHAVE_MINGW_H -DYEAR='"2004"' -DSYSINFO='"$(host)"' -DQPATH='".;$(libdir)"' -DQEXEC='"$(prefix)/q"' -DREADLINE_LIBRARY -DUSE_THREADS EXEEXT = .exe |
From: <ag...@us...> - 2004-01-06 09:15:08
|
Update of /cvsroot/q-lang/q In directory sc8-pr-cvs1:/tmp/cvs-serv8791 Modified Files: configure.in Log Message: updated year in copyright notice Index: configure.in =================================================================== RCS file: /cvsroot/q-lang/q/configure.in,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** configure.in 23 Dec 2003 01:15:01 -0000 1.5 --- configure.in 6 Jan 2004 09:15:05 -0000 1.6 *************** *** 17,21 **** dnl set this to the year of the release (used to generate copyright infos) ! year=2003 qpath='.:$(pkgdatadir)/lib:$(pkglibdir)' --- 17,21 ---- dnl set this to the year of the release (used to generate copyright infos) ! year=2004 qpath='.:$(pkgdatadir)/lib:$(pkglibdir)' |
From: <ag...@us...> - 2004-01-06 01:03:15
|
Update of /cvsroot/q-lang/q In directory sc8-pr-cvs1:/tmp/cvs-serv733 Modified Files: NEWS Log Message: make magick module work with IM 4.4.7 Index: NEWS =================================================================== RCS file: /cvsroot/q-lang/q/NEWS,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** NEWS 5 Jan 2004 06:32:47 -0000 1.4 --- NEWS 6 Jan 2004 01:03:07 -0000 1.5 *************** *** 3,7 **** ======= ! * 4.6 5 January 2004 This release features a much improved GGI interface and a new magick module --- 3,7 ---- ======= ! * 4.6 6 January 2004 This release features a much improved GGI interface and a new magick module |
From: <ag...@us...> - 2004-01-06 01:03:15
|
Update of /cvsroot/q-lang/q/modules/magick In directory sc8-pr-cvs1:/tmp/cvs-serv733/modules/magick Modified Files: README-Magick magick.c magick.q Log Message: make magick module work with IM 4.4.7 Index: README-Magick =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/README-Magick,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** README-Magick 2 Jan 2004 07:38:12 -0000 1.7 --- README-Magick 6 Jan 2004 01:03:07 -0000 1.8 *************** *** 12,18 **** The module requires that you have ImageMagick installed, which should be ! readily available in most Linux distributions; ImageMagick installers for ! Windows are available from http://www.imagemagick.org/. At present a fairly ! recent ImageMagick version (>= 5.5) is required. Please see magick.q for a description of the functions provided by this --- 12,18 ---- The module requires that you have ImageMagick installed, which should be ! readily available in most Linux distributions; installers for Windows are ! available from http://www.imagemagick.org/. Versions >= 5.4.7 have been ! tested, older versions might require some work. Please see magick.q for a description of the functions provided by this *************** *** 25,29 **** Enjoy! :) ! Jan 2 2004 Albert Graef ag...@mu..., Dr....@t-... --- 25,29 ---- Enjoy! :) ! Jan 6 2004 Albert Graef ag...@mu..., Dr....@t-... Index: magick.c =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/magick.c,v retrieving revision 1.40 retrieving revision 1.41 diff -C2 -d -r1.40 -r1.41 *** magick.c 5 Jan 2004 05:28:35 -0000 1.40 --- magick.c 6 Jan 2004 01:03:07 -0000 1.41 *************** *** 67,70 **** --- 67,79 ---- #include <magick/api.h> + #if MagickLibVersion < 0x550 + #define ScaleQuantumToChar(quantum) Downscale(quantum) + #define PixelIntensityToQuantum(color) Intensity(color) + #define RLECompression RunlengthEncodedCompression + #define ScaleCharToQuantum(value) Upscale(value) + #define ScaleShortToQuantum(value) XDownscale(value) + #define ScaleQuantumToShort(quantum) XUpscale(quantum) + #endif + MODULE(magick) *************** *** 283,286 **** --- 292,296 ---- FUNCTION(magick,magick_limit,argc,argv) { + #if MagickLibVersion >= 0x550 char *res; unsigned long limit; *************** *** 301,304 **** --- 311,315 ---- return mkvoid; } else + #endif return __FAIL; } *************** *** 306,309 **** --- 317,321 ---- FUNCTION(magick,magick_limits,argc,argv) { + #if MagickLibVersion >= 0x550 if (argc == 0) { ListMagickResourceInfo(stdout, &exception); *************** *** 313,316 **** --- 325,329 ---- return mkvoid; } else + #endif return __FAIL; } *************** *** 318,321 **** --- 331,335 ---- FUNCTION(magick,magick_resources,argc,argv) { + #if MagickLibVersion >= 0x550 if (argc == 0) return mktuplel(4, mkuint(GetMagickResource(FileResource)), *************** *** 324,327 **** --- 338,342 ---- mkuint(GetMagickResource(DiskResource))); else + #endif return __FAIL; } *************** *** 1748,1751 **** --- 1763,1767 ---- FUNCTION(magick,thumbnail,argc,argv) { + #if MagickLibVersion >= 0x550 Image *img; int n; *************** *** 1763,1766 **** --- 1779,1783 ---- return mk_image(img); } else + #endif return __FAIL; } *************** *** 2154,2157 **** --- 2171,2175 ---- FUNCTION(magick,adaptive_threshold,argc,argv) { + #if MagickLibVersion >= 0x550 Image *img; unsigned long w, h; *************** *** 2171,2174 **** --- 2189,2193 ---- return mk_image(img); } else + #endif return __FAIL; } Index: magick.q =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/magick.q,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** magick.q 31 Dec 2003 15:56:43 -0000 1.32 --- magick.q 6 Jan 2004 01:03:07 -0000 1.33 *************** *** 127,136 **** public extern magick_info; ! /* ImageMagick resource management. You can set a limit on the resource RES ! (which can be any of the resource types for ImageMagick's -limit option, ! see ImageMagick(1) for details; currently "memory", "map" and "disk" are ! supported) with the magick_limit function, use the magick_limits function ! to print the current limits on standard output, and retrieve the current ! resource usage figures with magick_resources. */ public extern magick_limit RES VAL, magick_limits, magick_resources; --- 127,136 ---- public extern magick_info; ! /* ImageMagick resource management (IM > 5.4 only). You can set a limit on the ! resource RES (which can be any of the resource types for ImageMagick's ! -limit option, see ImageMagick(1) for details; currently "memory", "map" ! and "disk" are supported) with the magick_limit function, use the ! magick_limits function to print the current limits on standard output, and ! retrieve the current resource usage figures with magick_resources. */ public extern magick_limit RES VAL, magick_limits, magick_resources; *************** *** 529,533 **** public extern magnify IMG, minify IMG; public extern resize IMG DIM FILTER BLUR, sample IMG DIM, scale IMG DIM; ! public extern thumbnail IMG DIM; public extern flipx IMG, flipy IMG, roll IMG P; --- 529,533 ---- public extern magnify IMG, minify IMG; public extern resize IMG DIM FILTER BLUR, sample IMG DIM, scale IMG DIM; ! public extern thumbnail IMG DIM; // IM > 5.4 only public extern flipx IMG, flipy IMG, roll IMG P; *************** *** 590,594 **** /* Effects. */ ! public extern adaptive_threshold IMG DIM OFFS; public extern add_noise IMG NOISE; public extern blur IMG RADIUS SIGMA; --- 590,594 ---- /* Effects. */ ! public extern adaptive_threshold IMG DIM OFFS; // IM > 5.4 only public extern add_noise IMG NOISE; public extern blur IMG RADIUS SIGMA; |
From: <ag...@us...> - 2004-01-05 19:59:48
|
Update of /cvsroot/q-lang/q-midi/src In directory sc8-pr-cvs1:/tmp/cvs-serv29297/src Modified Files: Makefile.am Added Files: midi_player.q midi_player.tcl Removed Files: player.q player.tcl Log Message: renamed player -> midi_player, updated docs --- NEW FILE: midi_player.q --- #!/usr/bin/q -- #! -c main ARGS /* midi_player.q: simple MIDI player/recorder for the Q-Midi interface */ /* This file is part of the Q programming system. The Q programming system is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. The Q programming system is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ /* TODO: ******************************************************************** - add configuration dialog for changing input/ouput devices, PPQN/BPM settings and MIDI Thru setting **************************************************************************/ import midi, mididev, tk; /* This script extends the capabilities of the Q-Midi interface with some useful functions for playing back and recording multi-track sequences, represented as time-ordered lists of (TRACK,TIME,MSG) triples. It also serves as an example to illustrate how to write sequencer-like applications in Q. The main function is `midi_player' which implements a Tk-based GUI for playing back and recording MIDI sequences. Convenience functions for loading and saving MIDI files and basic sequence editing are also provided. */ /* midi_player SEQ: This is the main function. It provides a Tk interface with the usual push button controls (play, stop, record, etc.), a progress meter, and options to load and save sequences in MIDI files. SEQ is the input sequence and may be denoted may either by a (possibly empty) list or the name of a MIDI file which is loaded using `midi_load' (see below). The result is a sequence consisting of all tracks recorded during the player session -- without the input sequence. If desired, you can mix the result with the input sequence using the `mix' function, see below. */ public midi_player SEQ; /* midi_play SEQ, midi_record SEQ: Variations of the `midi_player' function which start playback/recording immediately. */ public midi_play SEQ, midi_record SEQ; /* midi_load NAME: Load the tracks from a MIDI file, mix them down to a single sequence, and convert timestamps to milliseconds. The result can be played back with the `midi_player' function. Note that track numbers are zero-based, so the first track is track #0, the second one track #1, etc. */ public midi_load NAME; /* midi_save NAME SEQ: Save the given sequence (with timestamps in milliseconds) in a type 1 MIDI file, assuming a resolution ("division") of 120 PPQN and a default tempo of 120 BPM (you can change these defaults in the CONFIG SECTION below). */ public midi_save NAME SEQ; /* track_nums SEQ: Return the list of all track numbers in a sequence. */ public track_nums SEQ; /* track N SEQ: Create a single track from a list of events. N denotes the track number, and SEQ a list of (TIME,MSG) pairs. Shorthand for `map (cons N) SEQ'. */ public track N SEQ; /* get_track N SEQ: Extract track N from the given sequence. */ public get_track N SEQ; /* del_track N SEQ: Delete track N from the given sequence. */ public del_track N SEQ; /* mix SEQ1 SEQ2: Mix two sequences. */ public mix SEQ1 SEQ2; /****************************************************************************/ /* START OF CONFIG SECTION. */ /****************************************************************************/ /* Here are some definitions you might want to customize for your local configuration. */ public var PPQN, BPM, MIDI_IN, MIDI_OUT, PORT; /* PPQN, BPM. Division and default tempo. This affects the reading and writing of MIDI files. You might wish to change the PPQN value to something larger to increase the resolution of saved MIDI files. */ def PPQN = 120, BPM = 120; /* MIDI_IN, MIDI_OUT, PORT. The MIDI I/O devices and output port. Defaults to MIDIDEV!0 for both input and output. You might wish to change this to redirect I/O to other devices listed in mididev.q */ def (_,MIDI_IN,_) = MIDIDEV!0, (_,MIDI_OUT,PORT) = MIDIDEV!0; /****************************************************************************/ /* END OF CONFIG SECTION. No need to edit below this line. */ /****************************************************************************/ /* Determine the scheduling policy and the corresponding maximum priority. The latter value is system-dependent, so we have to check it at startup. */ def POL = SCHED_RR, PRIO = maxprio; testprio PRIO = setsched this_thread 0 0 || true where () = setsched this_thread POL PRIO; = false otherwise; maxprio = until (neg testprio) (+1) 1 - 1; /* Determine the installation prefix. */ prefix NAME = substr ANAME 0 (#ANAME-2) where ANAME:String = which NAME; = NAME otherwise; /* Main program. This is to be executed when we are invoked from the command line. */ main ARGS = fprintf ERROR "%s: this program requires Q version >= 4.1\n" (ARGS!0) || exit 1 if version < "4.1"; = fprintf ERROR "%s: %s could not be found, please check your installation\n" (ARGS!0,FNAME) || exit 1 if not isfile (fopen FNAME "r") where FNAME = prefix "midi_player"++".tcl"; = fprintf ERROR "USAGE: %s [midi-file]\n" (ARGS!0) || exit 1 if (#ARGS>2) or else (#ARGS=2) and then ((ARGS!1="-h") or else (ARGS!1="-help")); = midi_play (ARGS!1) || exit 0 if #ARGS > 1; = midi_player [] || exit 0 otherwise; /* Internal clients used by the `midi_player' function. */ def MAIN = midi_open "Player", PLAY = midi_open "Playback", REC = midi_open "Recorder"; connect = midi_connect MAIN PLAY || midi_connect MAIN REC || midi_connect MIDI_IN PLAY || midi_connect MIDI_IN REC || midi_connect REC MIDI_OUT || midi_connect PLAY MIDI_OUT; disconnect = midi_disconnect MAIN PLAY || midi_disconnect MAIN REC || midi_disconnect MIDI_IN PLAY || midi_disconnect MIDI_IN REC || midi_disconnect REC MIDI_OUT || midi_disconnect PLAY MIDI_OUT; /* Tk error handler. */ tk_error S = throw '(tk_error S); tk_reads = "midi_player::quit_cb" if not tk_ready; /* Set up communication channels between the main thread and the background tasks. */ def SEM = sem, REC_SEM = sem; type Msg = const start_rec_msg T S, stop_rec_msg T S, start_play_msg T S, stop_play_msg T S, end_msg T S, exit_msg T S, midi_msg T S TRK MSG; flush_sem SEM = get SEM || flush_sem SEM if get_size SEM > 0; = () otherwise; /* The main function. */ /* This function invokes two background tasks: the playback thread which is responsible for playing back the sequence, and the recorder thread which keeps track of incoming events. The main thread merely executes the Tk GUI and listens for progress reports from the background tasks. */ midi_player SEQ = player update_state SEQ; player F SEQ = init_app SEQ || flush_sem SEM || main_loop (F (init_pos (update_title (init_state SEQ)))) if islist SEQ or else isstr SEQ; /* Variations of the midi_player function which start playback/recording immediately. */ midi_play SEQ = player play_cb SEQ; midi_record SEQ = player record_cb SEQ; /* Manage application state. The state of the application is stored in a hashed dictionary with the following keys: Name: name of the sequence if loaded from a file Playseq: the playback sequence; includes the input sequences and all recorded events Recseq: current sequence of recorded events Playtask: the playback thread if any, () otherwise Rectask: the recorder thread if any, () otherwise Start: start of the playback sequence (sequence time) Len: current length of the playback sequence in milliseconds Offs: absolute offset in milliseconds (sequence time) Trk: the track incoming events are recorded on */ var Name, Playseq, Recseq, Playtask, Rectask, Start, Len, Offs, Trk; init_state SEQ:List = midi_accept_type REC active_sense false || midi_accept_type REC clock false || connect || set_status (sprintf "%d events in %d tracks" (#SEQ,TRK)) || hdict [(Name,()), (Playseq,SEQ),(Recseq,[]), (Playtask,()),(Rectask,()), (Start,START),(Len,LEN),(Offs,START),(Trk,TRK)] where START = seq_start SEQ, LEN = seq_len SEQ, TRK = seq_max_track SEQ + 1; init_state NAME:String = midi_accept_type REC active_sense false || connect || open_file (hdict [(Name,()), (Playseq,[]),(Recseq,[]), (Playtask,()),(Rectask,()), (Start,0),(Len,0),(Offs,0),(Trk,1)]) NAME; fini_state STATE = midi_send MAIN PORT stop || result (STATE!Playtask) || result (STATE!Rectask) || process_all STATE || disconnect || STATE!Recseq; reinit_state STATE NAME SEQ:List = kill STATE || hdict [(Name,NAME), (Playseq,SEQ),(Recseq,[]), (Playtask,()),(Rectask,()), (Start,START),(Len,LEN),(Offs,START),(Trk,TRK)] where START = seq_start SEQ, LEN = seq_len SEQ, TRK = seq_max_track SEQ + 1; kill STATE = process_all STATE if not playing STATE and not recording STATE; kill STATE = midi_send MAIN PORT stop || result (STATE!Playtask) || result (STATE!Rectask) || process_all (foldl insert STATE [(Playtask,()),(Rectask,())]) otherwise; name STATE = STATE!Name; playseq STATE = STATE!Playseq; recseq STATE = STATE!Recseq; start_time STATE = STATE!Start; length STATE = STATE!Len; offset STATE = STATE!Offs; track STATE = STATE!Trk; playing STATE = isthread (STATE!Playtask); recording STATE = isthread (STATE!Rectask); new_track STATE = update STATE Trk (STATE!Trk+1); set_name STATE NAME = update STATE Name NAME; set_offset STATE OFFS = update STATE Offs OFFS; start_play STATE PLAYTASK = update STATE Playtask PLAYTASK; start_record STATE RECTASK = update STATE Rectask RECTASK; stop_play STATE OFFS = STATE if not playing STATE; = result (STATE!Playtask) || update STATE Playtask () if recording STATE; = result (STATE!Playtask) || foldl insert STATE [(Playtask,()),(Offs,OFFS)]; stop_record STATE = STATE if not recording STATE; stop_record STATE = result (STATE!Playtask) || set_status (sprintf "%d events recorded on track #%d" (#SEQ,STATE!Trk)) || init_pos (process_all foldl insert STATE [(Playseq,PLAYSEQ),(Recseq,RECSEQ), (Playtask,()),(Rectask,()), (Start,START),(Len,LEN),(Offs,OFFS)]) where SEQ = result (STATE!Rectask), PLAYSEQ = mix (STATE!Playseq) SEQ, RECSEQ = mix (STATE!Recseq) SEQ, START = seq_start PLAYSEQ, LEN = seq_len PLAYSEQ, OFFS = START + time_diff (STATE!Start) (STATE!Offs); abort_record STATE = result (STATE!Playtask) || set_status (sprintf "%d events scratched from track #%d" (#SEQ,STATE!Trk)) || update_pos (process_all (foldl insert STATE [(Playtask,()),(Rectask,())])) where SEQ = result (STATE!Rectask); /* Initialize the Tk GUI. */ init_app SEQ = tk_quit || tk "wm withdraw ." || tk "set argc 0; set argv {}" || tk (sprintf "source %s" (str (prefix "midi_player"++".tcl"))) || tk "proc exit { {returnCode 0} } { q midi_player::quit_cb }" || tk "wm protocol $widget(Toplevel) WM_DELETE_WINDOW exit" || // define some color tags for the text display tk "$widget(Text1) tag configure Red -foreground red4" || tk "$widget(Text1) tag configure Green -foreground green4" || tk "$widget(Text1) tag configure Blue -foreground blue4" || tk "$widget(Text1) tag configure Black -foreground black"; /* The main loop of the application. Keep processing callbacks and progress reports from the background threads until the application is exited. */ main_loop STATE = STATE if not tk_ready; = main_loop (tk_read STATE) if tk_check; = main_loop (process STATE (get SEM)) if get_size SEM > 0; = sleep 0.1 || main_loop STATE otherwise; /* Handle messages sent by the player and recorder threads. */ process STATE (midi_msg T S TRK MSG) = print T (TRK,DS,MSG) || set_pos DS || STATE where DS = time_diff (start_time STATE) S; process STATE (start_rec_msg T S) = print T "recording started" || STATE; process STATE (stop_rec_msg T S) = print T "recording stopped" || update_state (stop_record STATE); process STATE (start_play_msg T S) = print T "playback started" || STATE; process STATE (stop_play_msg T S) = print T "playback stopped" || update_state (stop_play STATE S); process STATE (end_msg T S) = print T "playback ended" || update_state (stop_play STATE (S+1)); process STATE (exit_msg T S) = update_state (stop_play STATE (offset STATE)); process_all STATE = process_all (process STATE (get SEM)) if get_size SEM > 0; = STATE otherwise; /* Update the state of the interface. */ // quote Tcl/Tk strings tkstr S:String = sprintf "\"%s\"" (strcat (map tkch (chars S))); tkch "{" = "\\{"; tkch "}" = "\\}"; tkch "[" = "\\["; tkch "]" = "\\]"; tkch "$" = "\\$"; tkch "\\" = "\\\\"; tkch "\"" = "\\\""; tkch C = C otherwise; clear_log = tk "$widget(Text1) delete 1.0 end"; set_title NAME = tk "wm title $widget(Toplevel) {Q-Midi Player}" if null NAME; = tk (sprintf "wm title $widget(Toplevel) %s" (tkstr (sprintf "%s - Q-Midi Player" NAME))) otherwise; set_status MSG = tk_set "status" MSG; set_mode MSG = tk_set "mode" MSG; set_track N = tk_set "track" (sprintf "#%d" N); set_pos T = tk_set "pos" (str (T div 100)); update_state STATE = set_mode "REC" || tk "$widget(RecordButton) configure -relief sunken" || tk "$widget(PlayButton) configure -state disabled" || tk "$widget(CancelButton) configure -state normal" || tk "$widget(StopButton) configure -state normal" || tk "$widget(StartButton) configure -state disabled" || tk "$widget(EndButton) configure -state disabled" || tk "$widget(SongPosScale) configure -state disabled" || STATE if recording STATE; = set_mode "PLAY" || tk "$widget(PlayButton) configure -relief sunken" || tk "$widget(RecordButton) configure -state disabled" || tk "$widget(CancelButton) configure -state disabled" || tk "$widget(StopButton) configure -state normal" || tk "$widget(StartButton) configure -state disabled" || tk "$widget(EndButton) configure -state disabled" || tk "$widget(SongPosScale) configure -state disabled" || STATE if playing STATE; = set_mode "IDLE" || tk "$widget(PlayButton) configure -relief raised" || tk "$widget(RecordButton) configure -relief raised" || tk "$widget(PlayButton) configure -state normal" || tk "$widget(RecordButton) configure -state normal" || tk "$widget(CancelButton) configure -state disabled" || tk "$widget(StopButton) configure -state disabled" || tk "$widget(StartButton) configure -state normal" || tk "$widget(EndButton) configure -state normal" || tk "$widget(SongPosScale) configure -state normal" || STATE otherwise; init_pos STATE = tk (sprintf "$widget(SongPosScale) configure -to %d" (length STATE div 100)) || update_pos STATE; update_pos STATE = set_pos (offset STATE-start_time STATE) || STATE; update_title STATE = set_title (name STATE) || set_track (track STATE) || STATE; /* Print MIDI events. */ print T MSG:String = tk (sprintf "$widget(Text1) insert end {%-8d }" T) || tk (sprintf "$widget(Text1) insert end {*** %s ***} Red {\n}" MSG) || tk "$widget(Text1) see end"; print T (TRK,S,MSG) = tk (sprintf "$widget(Text1) insert end {%-8d %s %-3d }" (T,time_str S,TRK)) || tk (sprintf "$widget(Text1) insert end {%-20s} %s" (str MSG,tag MSG)) || tk (sprintf "$widget(Text1) insert end { %s} %s {\n}" (note_name MSG,note_tag MSG)) || tk "$widget(Text1) see end"; tag MSG = "Green" if is_meta MSG; = "Red" if is_midishare_specific MSG; = "Black" if is_voice MSG; = "Blue" otherwise; var note_names; def note_names = ("C","C#","D","Eb","E","F","F#","G","G#","A","Bb","B"); note_name (note_on C P V) = sprintf "%-2s%d" (note_names!(P mod 12), P div 12); note_name (note_off C P V) = sprintf "%-2s%d" (note_names!(P mod 12), P div 12); note_name (note C P V D) = sprintf "%-2s%d" (note_names!(P mod 12), P div 12); note_name MSG = "" otherwise; note_tag (note_on C P 0) = "Green"; note_tag (note_on C P V) = "Red"; note_tag (note_off C P V) = "Green"; note_tag (note C P V D) = "Blue"; note_tag MSG = "Black" otherwise; /* Callback definitions. */ new_cb STATE = set_status "created new sequence" || set_pos 0 || update_state (init_pos (update_title (reinit_state STATE () []))); open_cb STATE = open_file STATE open_dg; save_cb STATE = save_file STATE (save_dg (name STATE)); save_as_cb STATE = save_file STATE save_as_dg; new_track_cb STATE = set_status (sprintf "created new track #%d" (track STATE1)) || update_title STATE1 otherwise where STATE1 = new_track STATE; clear_log_cb STATE = clear_log || STATE; quit_cb STATE = tk_quit || FIN where FIN = fini_state STATE; play_cb STATE = STATE if playing STATE or else recording STATE; = flush_sem REC_SEM || update_state (start_play STATE (thread (setsched this_thread POL PRIO || play_midi (offset STATE) (playseq STATE)))) otherwise; record_cb STATE = STATE if playing STATE or else recording STATE; = flush_sem REC_SEM || update_state (start_play (start_record STATE (thread (setsched this_thread POL PRIO || record_midi (offset STATE) (track STATE)))) (thread (setsched this_thread POL PRIO || play_midi (offset STATE) (playseq STATE)))) otherwise; stop_cb STATE = midi_send MAIN PORT stop || STATE if playing STATE or else recording STATE; = STATE otherwise; cancel_cb STATE = midi_send MAIN PORT stop || abort_record STATE if recording STATE; = STATE otherwise; start_cb STATE = STATE if playing STATE or else recording STATE; start_cb STATE = update_pos (set_offset STATE (start_time STATE)); end_cb STATE = STATE if playing STATE or else recording STATE; end_cb STATE = update_pos (set_offset STATE (start_time STATE+length STATE+1)); pos_cb STATE = STATE if playing STATE or else recording STATE; pos_cb POS STATE = set_offset STATE (start_time STATE+POS*100); about_cb STATE = about_dg "Q-Midi Player V1.2 01-05-04\n\n\ Copyright (c) 2002-04 by Albert Graef\n\ <Dr....@t-...>" || STATE; /* Open and save MIDI files. */ open_file STATE () = STATE; open_file STATE NAME = set_status (sprintf "%d events in %d tracks loaded from %s" (#SEQ,track STATE1,NAME)) || set_pos 0 || update_state (init_pos (update_title STATE1)) where SEQ:List = set_status "loading..." || midi_load NAME, STATE1 = reinit_state STATE NAME SEQ; = set_status (sprintf "error loading %s" NAME) || open_err_dg NAME || STATE otherwise; save_file STATE () = STATE; save_file STATE NAME = set_status (sprintf "%d events in %d tracks saved in %s" (#SEQ,track STATE+ifelse (null SEQ2) 0 1,NAME)) || update_title (set_name STATE NAME) if eq () (set_status "saving..." || midi_save NAME SEQ) where SEQ = playseq STATE, SEQ2 = recseq STATE; = set_status (sprintf "error saving %s" NAME) || save_err_dg NAME || STATE otherwise; /* Dialog definitions. */ open_dg = tk "tk_getOpenFile -title \"Open...\" \ -parent $widget(Toplevel) \ -defaultextension \".mid\" \ -filetypes {{{MIDI Files} {.mid}} {{All Files} *}}"; save_dg NAME = save_as_dg if null NAME; = NAME otherwise; save_as_dg = tk "tk_getSaveFile -title \"Save as...\" \ -parent $widget(Toplevel) \ -defaultextension \".mid\" \ -filetypes {{{MIDI Files} {.mid}} {{All Files} *}}"; open_err_dg NAME = tk "tk_messageBox -icon error -title Error -type ok \ -parent $widget(Toplevel) \ -message \"Error opening MIDI file\""; save_err_dg NAME = tk "tk_messageBox -icon error -title Error -type ok \ -parent $widget(Toplevel) \ -message \"Error saving MIDI file\""; about_dg MSG = tk (sprintf "tk_messageBox -parent $widget(Toplevel) \ -parent $widget(Toplevel) \ -icon info -title {About Q-Midi Player} -type ok -message %s" (str MSG)); /* The playback loop. */ play_midi OFFS SEQ = midi_flush PLAY || play0 OFFS SEQ; play0 OFFS SEQ = post REC_SEM midi_time || post SEM (exit_msg T 0) if null SEQ; play0 OFFS [(TRK,S,MSG)|SEQ] = play1 midi_time S [(TRK,S,MSG)|SEQ] if S >= OFFS; = midi_send PLAY PORT MSG || play0 OFFS SEQ if not is_note_on MSG and then not is_note_off MSG and then not is_note MSG; = play0 OFFS SEQ otherwise; play1 T S SEQ = post REC_SEM T || post SEM (start_play_msg T S) || play2 emptybag T S SEQ; play2 NOTES T S [] = post SEM (end_msg T S); play2 NOTES T S SEQ = all_notes_off T S NOTES || post SEM (stop_play_msg T S) if midi_avail PLAY and then is_stop (midi_get PLAY!3); play2 NOTES T1 S1 [(TRK,S2,MSG)|SEQ] = //check_time 0 midi_time T1 || midi_send PLAY PORT MSG || post SEM (midi_msg T1 S1 TRK MSG) || play2 (save_notes NOTES MSG) T1 S1 SEQ if S2 = S1; = //check_time (S2-S1) midi_time T2 || midi_send PLAY PORT MSG || post SEM (midi_msg T2 S2 TRK MSG) || play2 (save_notes NOTES MSG) T2 S2 SEQ where T2:Int = midi_wait_loop PLAY T1 (time_diff S1 S2 + T1); = all_notes_off T2 S2 NOTES || post SEM (stop_play_msg T2 S2) where T2 = time_diff S1 S2 + T1 otherwise; // interruptible wait def TICKS = 100; midi_wait_loop REF T1 T2 = midi_send MAIN PORT stop || () if midi_avail PLAY and then is_stop (midi_get PLAY!3); = T2 if T2 <= T1; = midi_wait REF T2 if T2-T1 <= TICKS; = midi_wait_loop REF T1 T2 where T1 = midi_wait REF (T1+TICKS); // report timing glitches >= 20ms, for testing purposes check_time DT T1 T2 = printf "%d ms late (delta = %d)!\n" (T1-T2,DT) if T1-T2>=20; save_notes NOTES (note_on CHAN PITCH VEL) = insert NOTES [CHAN,PITCH] if VEL > 0; = delete NOTES [CHAN,PITCH] otherwise; save_notes NOTES (note_off CHAN PITCH VEL) = delete NOTES [CHAN,PITCH]; save_notes NOTES _ = NOTES otherwise; all_notes_off T S NOTES = do (lambda [CHAN,PITCH] (midi_send PLAY PORT (note_on CHAN PITCH 0))) (members NOTES); /* The recording loop. */ record_midi OFFS TRK = midi_flush REC || post SEM (start_rec_msg TIME OFFS) || rec TRK TIME OFFS [] (midi_get REC) where TIME = get REC_SEM; rec TRK T0 S0 SEQ (_,_,T,stop) = post SEM (stop_rec_msg T S) || SEQ where S = S0 + time_diff T0 T; rec TRK T0 S0 SEQ (_,_,T,MSG) = midi_send REC PORT MSG || post SEM (midi_msg T S TRK MSG) || rec TRK T0 S0 (append SEQ (TRK,S,MSG)) (midi_get REC) where S = S0 + time_diff T0 T; /* Load a sequence from a MIDI file. */ midi_load NAME:String = convert (midi_file_division F) (60000000 div BPM) 0 0 (foldl mix [] (tracks F)) where F = midi_file_open NAME; // read the tracks from a MIDI file tracks F = listof (map (cons I) (midi_file_read_track F)) (I in nums 0 (midi_file_num_tracks F-1)); // convert timestamps convert _ _ _ _ [] = []; convert (FPS,FRACS) TEMPO T0 MS0 [(TRK,T,MSG)|SEQ] = [(TRK,MS,MSG)|convert (FPS,FRACS) TEMPO T0 MS0 SEQ] where MS = round (T/(FPS*FRACS)*1000); convert PPQN TEMPO T0 MS0 [(TRK,T,tempo TEMPO1)|SEQ] = [(TRK,MS,tempo TEMPO1)|convert PPQN TEMPO1 T MS SEQ] where MS = MS0+round (TEMPO/PPQN*(T-T0)/1000); convert PPQN TEMPO T0 MS0 [(TRK,T,MSG)|SEQ] = [(TRK,MS,MSG)|convert PPQN TEMPO T MS SEQ] where MS = MS0+round (TEMPO/PPQN*(T-T0)/1000); /* Save a sequence in a MIDI file. */ midi_save NAME:String SEQ:List = do (write_track F SEQ) (track_nums SEQ) where F:MidiFile = midi_file_create NAME 1 PPQN; // write a single track write_track F SEQ N = midi_file_write_track F (extract (60000000 div BPM) 0 0 (seq_start SEQ) N SEQ); // extract: extract a track from the sequence, convert timestamps to ticks; // the arguments are as follows: // TEMPO: current TEMPO of the sequence // U: current end time of track N // T0, S0: current time in ticks (Midi file time) and milliseconds // (sequence time) // N: number of track to extract // SEQ: rest of the sequence to process extract TEMPO U T0 S0 N [] = [(U,end_track)]; extract TEMPO U T0 S0 N [(M,S,end_track)|SEQ] = extract TEMPO U (T0+ticks TEMPO (time_diff S0 S)) S N SEQ if N<>M; = [(U,end_track)] otherwise; extract TEMPO U T0 S0 N [(M,S,tempo TEMPO1)|SEQ] = extract TEMPO1 U (T0+ticks TEMPO (time_diff S0 S)) S N SEQ if N<>M; = [(T0+DT,tempo TEMPO1)| extract TEMPO1 (T0+DT) (T0+DT) S N SEQ] otherwise where DT = ticks TEMPO (time_diff S0 S); extract TEMPO U T0 S0 N [(M,S,MSG)|SEQ] = extract TEMPO U (T0+ticks TEMPO (time_diff S0 S)) S N SEQ if N<>M; = [(T0+DT,MSG)| extract TEMPO (T0+DT) (T0+DT) S N SEQ] otherwise where DT = ticks TEMPO (time_diff S0 S); // convert millisecs to ticks, on the basis of the PPQN value and the current // TEMPO ticks TEMPO TIME = round (TIME*1000/TEMPO*PPQN); /* Return the list of track numbers of a sequence. */ track_nums SEQ:List = members (foldl insert emptyset (map fst SEQ)); /* Create a track from an event list. */ track N:Int SEQ:List = map (cons N) SEQ; /* Extract a track from a sequence. */ get_track N:Int SEQ:List = filter (lambda (M|EV) (N=M)) SEQ; /* Delete a track from a sequence. */ del_track N:Int SEQ:List = filter (lambda (M|EV) (N<>M)) SEQ; /* Mix two multi-track sequences. */ mix SEQ1:List SEQ2:List = SEQ1 if null SEQ2; = SEQ2 if null SEQ1; = [hd SEQ1|mix (tl SEQ1) SEQ2] if T1 <= T2 where (_,T1,_) = hd SEQ1, (_,T2,_) = hd SEQ2; = [hd SEQ2|mix SEQ1 (tl SEQ2)] otherwise; /* Miscellaneous helper functions. */ time_str TIME = sprintf "%d:%02d:%03d" (MIN,SECS,MSECS) where MIN = TIME div 60000, SECS = (TIME mod 60000) div 1000, MSECS = TIME mod 1000; time_diff T1 T2 = ifelse (DT>=0) DT (DT+0x100000000) where DT = T2 mod 0x100000000 - T1 mod 0x100000000; seq_start SEQ = T where (_,T,_) = hd SEQ; = 0 otherwise; seq_end SEQ = T where (_,T,_) = last SEQ; = 0 otherwise; seq_len SEQ = time_diff (seq_start SEQ) (seq_end SEQ); seq_max_track SEQ = foldl max (-1) (map fst SEQ); --- NEW FILE: midi_player.tcl --- #!/bin/sh # the next line restarts using wish\ exec wish "$0" "$@" if {![info exists vTcl(sourcing)]} { switch $tcl_platform(platform) { windows { option add *Button.padY 0 } default { option add *Scrollbar.width 10 option add *Scrollbar.highlightThickness 0 option add *Scrollbar.elementBorderWidth 2 option add *Scrollbar.borderWidth 2 } } } ############################################################################# # Visual Tcl v1.60 Project # ############################################################################# ## vTcl Code to Load Stock Images if {![info exist vTcl(sourcing)]} { ############################################################################# ## Procedure: vTcl:rename proc {vTcl:rename} {name} { regsub -all "\\." $name "_" ret regsub -all "\\-" $ret "_" ret regsub -all " " $ret "_" ret regsub -all "/" $ret "__" ret regsub -all "::" $ret "__" ret return [string tolower $ret] } ############################################################################# ## Procedure: vTcl:image:create_new_image proc {vTcl:image:create_new_image} {filename {description {no description}} {type {}} {data {}}} { global vTcl env # Does the image already exist? if {[info exists vTcl(images,files)]} { if {[lsearch -exact $vTcl(images,files) $filename] > -1} { return } } if {![info exists vTcl(sourcing)] && [string length $data] > 0} { set object [image create [vTcl:image:get_creation_type $filename] -data $data] } else { # Wait a minute... Does the file actually exist? if {! [file exists $filename] } { # Try current directory set script [file dirname [info script]] set filename [file join $script [file tail $filename] ] } if {![file exists $filename]} { set description "file not found!" set object [image create photo -data [vTcl:image:broken_image] ] } else { set object [image create [vTcl:image:get_creation_type $filename] -file $filename] } } set reference [vTcl:rename $filename] set vTcl(images,$reference,image) $object set vTcl(images,$reference,description) $description set vTcl(images,$reference,type) $type set vTcl(images,filename,$object) $filename lappend vTcl(images,files) $filename lappend vTcl(images,$type) $object # return image name in case caller might want it return $object } ############################################################################# ## Procedure: vTcl:image:get_image proc {vTcl:image:get_image} {filename} { set reference [vTcl:rename $filename] # Let's do some checking first if {![info exists ::vTcl(images,$reference,image)]} { # Well, the path may be wrong; in that case check # only the filename instead, without the path. set imageTail [file tail $filename] foreach oneFile $::vTcl(images,files) { if {[file tail $oneFile] == $imageTail} { set reference [vTcl:rename $oneFile] break } } } return $::vTcl(images,$reference,image) } ############################################################################# ## Procedure: vTcl:image:get_creation_type proc {vTcl:image:get_creation_type} {filename} { switch [string tolower [file extension $filename]] { .ppm - .jpg - .bmp - .gif {return photo} .xbm {return bitmap} default {return photo} } } ############################################################################# ## Procedure: vTcl:image:broken_image proc {vTcl:image:broken_image} {} { return { R0lGODdhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwICAgP8AAAD/ AP//AAAA//8A/wD//////wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAACwAAAAAFAAUAAAIhAAPCBxIsKDBgwgPAljIUOBC BAkBPJg4UeBEBBAVPkCI4EHGghIHChAwsKNHgyEPCFBA0mFDkBtVjiz4AADK mAds0tRJMCVBBkAl8hwYMsFPBwyE3jzQwKhAoASUwmTagCjDmksbVDWIderC g1174gQ71CHFigfOhrXKUGfbrwnjyp0bEAA7 } } foreach img { } { eval set _file [lindex $img 0] vTcl:image:create_new_image\ $_file [lindex $img 1] [lindex $img 2] [lindex $img 3] } } ############################################################################# ## vTcl Code to Load User Images catch {package require Img} foreach img { {{[file join / home ag src q q-midi images start.gif]} {user image} user { R0lGODlhEAAPAPIDAAAAAI6OjpSVlP///////wAAAAAAAAAAACH5BAEAAAQA LAAAAAAQAA8AAAONKCIigkREREgkIoAAMURIRESCMAIAGENEhEQCMSgAEINE RCQIECOAADFESCQAgDECABhDRIIAADEoABCDRAIACBAjgAAxJAgAAIAxAgAY QySAAAAxKAAQg0QkAAgQI4AAMURIJACAMQIAGENEhCQAMSgAEINEREQoECOA ETFESEREgjAyMzhDRIRERDIJADs=}} {{[file join / home ag src q q-midi images play.gif]} {user image} user { R0lGODlhDQAPAPIDAAAAAI6OjpSVlP///////wAAAAAAAAAAACH5BAEAAAQA LAAAAAANAA8AAANzKCIigkREREgCAIAgRERIJACAACBESEQCgAAAIEhEJIAA AAAIQkSCAAAACABChAIAAAgAAIIkAAAIAACAMQIACAAAgDEkAAgAAIAxRAII AACAMUQkCAAAgDFERCgAAIAxRERIAhGBMURESCQzgzNEREhECQA7}} {{[file join / home ag src q q-midi images record.gif]} {user image} user { R0lGODlhDQAPAPIEAAAAAMAAAI6OjpSVlP///////wAAAAAAACH5BAEAAAUA LAAAAAANAA8AAANzODMzg1VVVVgTEYExVVVYNRGBETFVWFUTgRERMVhVNYER EREYU1WDERERGBFThRMRERgREYM1EREYERGBQhMRGBERgUI1ERgREYFCVRMY ERGBQlU1GBERgUJVVTgREYFCVVVYEyKCQlVVWDVEhERVVVhVCQA7}} {{[file join / home ag src q q-midi images stop.gif]} {user image} user { R0lGODlhDQAPAPIDAAAAAI6OjpSVlP///////wAAAAAAAAAAACH5BAEAAAQA LAAAAAANAA8AAANzKCIigiIiIigCAIAAAAAYIwCAAAAACDECgAAAAAgQI4AA AAAIADGCAAAACAAQgwIAAAgAAIEjAAAIAACAMQIACAAAgBAjAAgAAIAAMQII AACAABAjCAAAgAAAMSgAAIAAABA4AhGBERERGCMzgzMzMzgzCQA7}} {{[file join / home ag src q q-midi images cancel.gif]} {user image} user { R0lGODlhEQAPAPECAAAAAIAAAP///wAAACH5BAEAAAIALAAAAAARAA8AAAKQ lChRokSJEiVKlChRokSJEiVKlChRYUSJEiUmlChRYsKIEiUmjChRosSEESUm jChRokSJCSMmjChRokSJEhMmjChRokSJEiUmjChRokSJEiUmTBhRokSJEiUm jJgwokSJEiUmjCgxYUSJEiUmjChRYsKIEiUqjChRosSEEiVKlChRokSJEiVK lChRokSJEiWqADs=}} {{[file join / home ag src q q-midi images end.gif]} {user image} user { R0lGODlhEAAPAPIDAAAAAI6OjpSVlP///////wAAAAAAAAAAACH5BAEAAAQA LAAAAAAQAA8AAAONKEJEhEREIigiIoBCRERIJACAMQIgSEREhAIAMSgAIIRE RAIIECOAACBESCQAgDECAAggRIQCADEoAACAIEQCCBAjgAAAEDgkAIAxAgAI EEOEAgAxKAAAgUNEAggQI4AAMURIJACAMQIQOEREhAIAMSgQQ4RERAIIECOA Q0RESCQQgTEyREhERIQyMzMJADs=}} } { eval set _file [lindex $img 0] vTcl:image:create_new_image\ $_file [lindex $img 1] [lindex $img 2] [lindex $img 3] } ################################# # VTCL LIBRARY PROCEDURES # if {![info exists vTcl(sourcing)]} { ############################################################################# ## Library Procedure: Window proc {Window} {args} { global vTcl set cmd [lindex $args 0] set name [lindex $args 1] set newname [lindex $args 2] set rest [lrange $args 3 end] if {$name == "" || $cmd == ""} { return } if {$newname == ""} { set newname $name } if {$name == "."} { wm withdraw $name; return } set exists [winfo exists $newname] switch $cmd { show { if {$exists} { wm deiconify $newname } elseif {[info procs vTclWindow$name] != ""} { eval "vTclWindow$name $newname $rest" } if {[winfo exists $newname] && [wm state $newname] == "normal"} { vTcl:FireEvent $newname <<Show>> } } hide { if {$exists} { wm withdraw $newname vTcl:FireEvent $newname <<Hide>> return} } iconify { if $exists {wm iconify $newname; return} } destroy { if $exists {destroy $newname; return} } } } ############################################################################# ## Library Procedure: vTcl:DefineAlias proc {vTcl:DefineAlias} {target alias widgetProc top_or_alias cmdalias} { global widget set widget($alias) $target set widget(rev,$target) $alias if {$cmdalias} { interp alias {} $alias {} $widgetProc $target } if {$top_or_alias != ""} { set widget($top_or_alias,$alias) $target if {$cmdalias} { interp alias {} $top_or_alias.$alias {} $widgetProc $target } } } ############################################################################# ## Library Procedure: vTcl:DoCmdOption proc {vTcl:DoCmdOption} {target cmd} { ## menus are considered toplevel windows set parent $target while {[winfo class $parent] == "Menu"} { set parent [winfo parent $parent] } regsub -all {\%widget} $cmd $target cmd regsub -all {\%top} $cmd [winfo toplevel $parent] cmd uplevel #0 [list eval $cmd] } ############################################################################# ## Library Procedure: vTcl:FireEvent proc {vTcl:FireEvent} {target event {params {}}} { ## The window may have disappeared if {![winfo exists $target]} return ## Process each binding tag, looking for the event foreach bindtag [bindtags $target] { set tag_events [bind $bindtag] set stop_processing 0 foreach tag_event $tag_events { if {$tag_event == $event} { set bind_code [bind $bindtag $tag_event] foreach rep "\{%W $target\} $params" { regsub -all [lindex $rep 0] $bind_code [lindex $rep 1] bind_code } set result [catch {uplevel #0 $bind_code} errortext] if {$result == 3} { ## break exception, stop processing set stop_processing 1 } elseif {$result != 0} { bgerror $errortext } break } } if {$stop_processing} {break} } } ############################################################################# ## Library Procedure: vTcl:Toplevel:WidgetProc proc {vTcl:Toplevel:WidgetProc} {w args} { if {[llength $args] == 0} { ## If no arguments, returns the path the alias points to return $w } ## The first argument is a switch, they must be doing a configure. if {[string index $args 0] == "-"} { set command configure ## There's only one argument, must be a cget. if {[llength $args] == 1} { set command cget } } else { set command [lindex $args 0] set args [lrange $args 1 end] } switch -- $command { "hide" - "Hide" - "show" - "Show" { Window [string tolower $command] $w } "ShowModal" { Window show $w raise $w grab $w tkwait window $w grab release $w } default { uplevel $w $command $args } } } ############################################################################# ## Library Procedure: vTcl:WidgetProc proc {vTcl:WidgetProc} {w args} { if {[llength $args] == 0} { ## If no arguments, returns the path the alias points to return $w } ## The first argument is a switch, they must be doing a configure. if {[string index $args 0] == "-"} { set command configure ## There's only one argument, must be a cget. if {[llength $args] == 1} { set command cget } } else { set command [lindex $args 0] set args [lrange $args 1 end] } uplevel $w $command $args } ############################################################################# ## Library Procedure: vTcl:toplevel proc {vTcl:toplevel} {args} { uplevel #0 eval toplevel $args set target [lindex $args 0] namespace eval ::$target {} } } if {[info exists vTcl(sourcing)]} { proc vTcl:project:info {} { set base .top32 namespace eval ::widgets::$base { set set,origin 0 set set,size 1 } namespace eval ::widgets::$base.cpd35 { array set save {-borderwidth 1 -height 1 -width 1} } set site_3_0 $base.cpd35 namespace eval ::widgets::$site_3_0.01 { array set save {-anchor 1 -font 1 -menu 1 -padx 1 -pady 1 -text 1 -width 1} } namespace eval ::widgets::$site_3_0.01.02 { array set save {-activebackground 1 -activeforeground 1 -foreground 1 -tearoff 1} } namespace eval ::widgets::$site_3_0.05 { array set save {-anchor 1 -font 1 -menu 1 -padx 1 -pady 1 -text 1 -width 1} } namespace eval ::widgets::$site_3_0.05.06 { array set save {-activebackground 1 -activeforeground 1 -foreground 1 -tearoff 1} } namespace eval ::widgets::$base.fra36 { array set save {-borderwidth 1 -height 1 -relief 1 -width 1} } set site_3_0 $base.fra36 namespace eval ::widgets::$site_3_0.but33 { array set save {-_tooltip 1 -anchor 1 -command 1 -image 1 -text 1} } namespace eval ::widgets::$site_3_0.but36 { array set save {-_tooltip 1 -anchor 1 -command 1 -image 1 -text 1} } namespace eval ::widgets::$site_3_0.but37 { array set save {-_tooltip 1 -anchor 1 -command 1 -image 1 -text 1} } namespace eval ::widgets::$site_3_0.but38 { array set save {-_tooltip 1 -anchor 1 -command 1 -image 1 -text 1} } namespace eval ::widgets::$site_3_0.but34 { array set save {-_tooltip 1 -command 1 -image 1 -text 1} } namespace eval ::widgets::$site_3_0.but40 { array set save {-_tooltip 1 -anchor 1 -command 1 -image 1 -text 1} } namespace eval ::widgets::$site_3_0.sca41 { array set save {-bigincrement 1 -command 1 -from 1 -orient 1 -resolution 1 -showvalue 1 -tickinterval 1 -to 1 -variable 1} } namespace eval ::widgets::$base.cpd37 { array set save {-borderwidth 1 -height 1 -relief 1 -width 1} } set site_3_0 $base.cpd37 namespace eval ::widgets::$site_3_0.01 { array set save {-command 1 -orient 1} } namespace eval ::widgets::$site_3_0.02 { array set save {-command 1} } namespace eval ::widgets::$site_3_0.03 { array set save {-background 1 -font 1 -height 1 -width 1 -wrap 1 -xscrollcommand 1 -yscrollcommand 1} } namespace eval ::widgets::$base.fra43 { array set save {-borderwidth 1 -height 1 -width 1} } set site_3_0 $base.fra43 namespace eval ::widgets::$site_3_0.lab44 { array set save {-anchor 1 -font 1 -relief 1 -textvariable 1 -width 1} } namespace eval ::widgets::$site_3_0.lab46 { array set save {-font 1 -relief 1 -textvariable 1 -width 1} } namespace eval ::widgets::$site_3_0.lab69 { array set save {-disabledforeground 1 -font 1 -relief 1 -textvariable 1 -width 1} } namespace eval ::widgets_bindings { set tagslist {all _TopLevel _vTclBalloon} } namespace eval ::vTcl::modules::main { set procs { init main vTclWindow. vTclWindow.top32 } } } } ################################# # USER DEFINED PROCEDURES # ############################################################################# ## Procedure: main proc {main} {argc argv} { wm protocol .top32 WM_DELETE_WINDOW {exit} } ############################################################################# ## Initialization Procedure: init proc {init} {argc argv} { if {[info command q] == {}} then { proc q { args } { } } option add *Dialog.msg.font {Helvetica 12} option add *fra36*Button.borderWidth 1 } init $argc $argv ################################# # VTCL GENERATED GUI PROCEDURES # proc vTclWindow. {base} { if {$base == ""} { set base . } ################### # CREATING WIDGETS ################### wm focusmodel $base passive wm geometry $base 1x1+0+0; update wm maxsize $base 1137 834 wm minsize $base 1 1 wm overrideredirect $base 0 wm resizable $base 1 1 wm withdraw $base wm title $base "vtcl.tcl" bindtags $base "$base Vtcl.tcl all" vTcl:FireEvent $base <<Create>> wm protocol $base WM_DELETE_WINDOW "vTcl:FireEvent $base <<DeleteWindow>>" ################### # SETTING GEOMETRY ################### vTcl:FireEvent $base <<Ready>> } proc vTclWindow.top32 {base} { if {$base == ""} { set base .top32 } if {[winfo exists $base]} { wm deiconify $base; return } set top $base ################### # CREATING WIDGETS ################### vTcl:toplevel $base -class Toplevel \ -highlightcolor black wm focusmodel $base passive wm geometry $base 609x422; update wm maxsize $base 1265 930 wm minsize $base 1 1 wm overrideredirect $base 0 wm resizable $base 1 1 wm deiconify $base wm title $base "Q-Midi Player" vTcl:DefineAlias "$base" "Toplevel" vTcl:Toplevel:WidgetProc "" 1 bindtags $base "$base Toplevel all _TopLevel" vTcl:FireEvent $base <<Create>> wm protocol $base WM_DELETE_WINDOW "vTcl:FireEvent $base <<DeleteWindow>>" frame $base.cpd35 \ -borderwidth 1 -height 30 -width 30 vTcl:DefineAlias "$base.cpd35" "MenuFrame" vTcl:WidgetProc "Toplevel" 1 set site_3_0 $base.cpd35 menubutton $site_3_0.01 \ -anchor w -font {Helvetica -12} -menu "$site_3_0.01.02" -padx 4 \ -pady 3 -text File -width 4 vTcl:DefineAlias "$site_3_0.01" "FileButton" vTcl:WidgetProc "Toplevel" 1 menu $site_3_0.01.02 \ -activebackground #dcdcdc -activeforeground #000000 \ -foreground #000000 -tearoff 0 vTcl:DefineAlias "$site_3_0.01.02" "FileMenu" vTcl:WidgetProc "" 1 $site_3_0.01.02 add command \ -accelerator Ctrl+N -command {q midi_player::new_cb} -font {Helvetica -12} \ -label New $site_3_0.01.02 add command \ -accelerator Ctrl+O -command {q midi_player::open_cb} \ -font {Helvetica -12} -label Open... $site_3_0.01.02 add command \ -accelerator Ctrl+S -command {q midi_player::save_cb} \ -font {Helvetica -12} -label Save $site_3_0.01.02 add command \ -command {q midi_player::save_as_cb} -font {Helvetica -12} \ -label {Save as...} $site_3_0.01.02 add command \ -accelerator Ctrl+K -command {q midi_player::new_track_cb} \ -font {Helvetica -12} -label {New track} $site_3_0.01.02 add separator $site_3_0.01.02 add command \ -accelerator Ctrl+C -command {q midi_player::clear_log_cb} \ -font {Helvetica -12} -label {Clear log} $site_3_0.01.02 add separator $site_3_0.01.02 add command \ -accelerator Ctrl+Q -command {q midi_player::quit_cb} \ -font {Helvetica -12} -label Quit menubutton $site_3_0.05 \ -anchor w -font {Helvetica -12} -menu "$site_3_0.05.06" -padx 4 \ -pady 3 -text Help -width 4 vTcl:DefineAlias "$site_3_0.05" "HelpButton" vTcl:WidgetProc "Toplevel" 1 menu $site_3_0.05.06 \ -activebackground #dcdcdc -activeforeground #000000 \ -foreground #000000 -tearoff 0 vTcl:DefineAlias "$site_3_0.05.06" "HelpMenu" vTcl:WidgetProc "" 1 $site_3_0.05.06 add command \ -command {q midi_player::about_cb} -font {Helvetica -12} -label About pack $site_3_0.01 \ -in $site_3_0 -anchor center -expand 0 -fill none -side left pack $site_3_0.05 \ -in $site_3_0 -anchor center -expand 0 -fill none -side right frame $base.fra36 \ -borderwidth 2 -relief ridge -height 37 -width 125 vTcl:DefineAlias "$base.fra36" "ToolbarFrame" vTcl:WidgetProc "Toplevel" 1 set site_3_0 $base.fra36 button $site_3_0.but33 \ -anchor center -command {q midi_player::start_cb} \ -image [vTcl:image:get_image [file join / home ag src q q-midi images start.gif]] \ -text Start vTcl:DefineAlias "$site_3_0.but33" "StartButton" vTcl:WidgetProc "Toplevel" 1 bindtags $site_3_0.but33 "$site_3_0.but33 Button $top all _vTclBalloon" bind $site_3_0.but33 <<SetBalloon>> { set ::vTcl::balloon::%W {Start of sequence} } button $site_3_0.but36 \ -anchor center -command {q midi_player::play_cb} \ -image [vTcl:image:get_image [file join / home ag src q q-midi images play.gif]] \ -text Play vTcl:DefineAlias "$site_3_0.but36" "PlayButton" vTcl:WidgetProc "Toplevel" 1 bindtags $site_3_0.but36 "$site_3_0.but36 Button $top all _vTclBalloon" bind $site_3_0.but36 <<SetBalloon>> { set ::vTcl::balloon::%W {Play} } button $site_3_0.but37 \ -anchor center -command {q midi_player::record_cb} \ -image [vTcl:image:get_image [file join / home ag src q q-midi images record.gif]] \ -text Record vTcl:DefineAlias "$site_3_0.but37" "RecordButton" vTcl:WidgetProc "Toplevel" 1 bindtags $site_3_0.but37 "$site_3_0.but37 Button $top all _vTclBalloon" bind $site_3_0.but37 <<SetBalloon>> { set ::vTcl::balloon::%W {Record} } button $site_3_0.but38 \ -anchor center -command {q midi_player::stop_cb} \ -image [vTcl:image:get_image [file join / home ag src q q-midi images stop.gif]] \ -text Stop vTcl:DefineAlias "$site_3_0.but38" "StopButton" vTcl:WidgetProc "Toplevel" 1 bindtags $site_3_0.but38 "$site_3_0.but38 Button $top all _vTclBalloon" bind $site_3_0.but38 <<SetBalloon>> { set ::vTcl::balloon::%W {Stop} } button $site_3_0.but34 \ -command {q midi_player::cancel_cb} \ -image [vTcl:image:get_image [file join / home ag src q q-midi images cancel.gif]] \ -text Cancel vTcl:DefineAlias "$site_3_0.but34" "CancelButton" vTcl:WidgetProc "Toplevel" 1 bindtags $site_3_0.but34 "$site_3_0.but34 Button $top all _vTclBalloon" bind $site_3_0.but34 <<SetBalloon>> { set ::vTcl::balloon::%W {Cancel recording} } button $site_3_0.but40 \ -anchor center -command {q midi_player::end_cb} \ -image [vTcl:image:get_image [file join / home ag src q q-midi images end.gif]] \ -text End vTcl:DefineAlias "$site_3_0.but40" "EndButton" vTcl:WidgetProc "Toplevel" 1 bindtags $site_3_0.but40 "$site_3_0.but40 Button $top all _vTclBalloon" bind $site_3_0.but40 <<SetBalloon>> { set ::vTcl::balloon::%W {End of sequence} } scale $site_3_0.sca41 \ -bigincrement 0.0 -command {q midi_player::pos_cb} -from 0.0 \ -orient horizontal -resolution 1.0 -showvalue 0 -tickinterval 0.0 \ -to 100.0 -variable pos vTcl:DefineAlias "$site_3_0.sca41" "SongPosScale" vTcl:WidgetProc "Toplevel" 1 pack $site_3_0.but33 \ -in $site_3_0 -anchor w -expand 0 -fill none -side left pack $site_3_0.but36 \ -in $site_3_0 -anchor w -expand 0 -fill none -side left pack $site_3_0.but37 \ -in $site_3_0 -anchor w -expand 0 -fill none -side left pack $site_3_0.but38 \ -in $site_3_0 -anchor w -expand 0 -fill none -side left pack $site_3_0.but34 \ -in $site_3_0 -anchor center -expand 0 -fill none -side left pack $site_3_0.but40 \ -in $site_3_0 -anchor w -expand 0 -fill none -side left pack $site_3_0.sca41 \ -in $site_3_0 -anchor e -expand 1 -fill x -side right frame $base.cpd37 \ -borderwidth 1 -relief raised -height 91 -width 30 vTcl:DefineAlias "$base.cpd37" "ScrolledTextFrame" vTcl:WidgetProc "Toplevel" 1 set site_3_0 $base.cpd37 scrollbar $site_3_0.01 \ -command "$site_3_0.03 xview" -orient horizontal vTcl:DefineAlias "$site_3_0.01" "Scrollbar1" vTcl:WidgetProc "Toplevel" 1 scrollbar $site_3_0.02 \ -command "$site_3_0.03 yview" vTcl:DefineAlias "$site_3_0.02" "Scrollbar2" vTcl:WidgetProc "Toplevel" 1 text $site_3_0.03 \ -background #ffffff \ -font -Adobe-Courier-Medium-R-Normal-*-*-120-*-*-*-*-*-* -height 10 \ -width 20 -wrap none -xscrollcommand "$site_3_0.01 set" \ -yscrollcommand "$site_3_0.02 set" vTcl:DefineAlias "$site_3_0.03" "Text1" vTcl:WidgetProc "Toplevel" 1 grid $site_3_0.01 \ -in $site_3_0 -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew grid $site_3_0.02 \ -in $site_3_0 -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky ns grid $site_3_0.03 \ -in $site_3_0 -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky nesw frame $base.fra43 \ -borderwidth 2 -height 75 -width 125 vTcl:DefineAlias "$base.fra43" "StatusFrame" vTcl:WidgetProc "Toplevel" 1 set site_3_0 $base.fra43 label $site_3_0.lab44 \ -anchor w -font {Helvetica -12} -relief groove -textvariable status \ -width 70 vTcl:DefineAlias "$site_3_0.lab44" "StatusLabel" vTcl:WidgetProc "Toplevel" 1 label $site_3_0.lab46 \ -font {Helvetica -12} -relief groove -textvariable mode -width 10 vTcl:DefineAlias "$site_3_0.lab46" "ModeLabel" vTcl:WidgetProc "Toplevel" 1 label $site_3_0.lab69 \ -disabledforeground #a1a4a1 -font {Helvetica -12} -relief groove \ -textvariable track -width 4 vTcl:DefineAlias "$site_3_0.lab69" "TrackLabel" vTcl:WidgetProc "Toplevel" 1 pack $site_3_0.lab44 \ -in $site_3_0 -anchor w -expand 1 -fill x -side left pack $site_3_0.lab46 \ -in $site_3_0 -anchor e -expand 0 -fill none -side right pack $site_3_0.lab69 \ -in $site_3_0 -anchor center -expand 0 -fill none -side right ################### # SETTING GEOMETRY ################### pack $base.cpd35 \ -in $base -anchor center -expand 0 -fill x -side top pack $base.fra36 \ -in $base -anchor w -expand 0 -fill x -side top pack $base.cpd37 \ -in $base -anchor w -expand 1 -fill both -side top grid columnconf $base.cpd37 0 -weight 1 grid rowconf $base.cpd37 0 -weight 1 pack $base.fra43 \ -in $base -anchor w -expand 0 -fill x -side top vTcl:FireEvent $base <<Ready>> } ############################################################################# ## Binding tag: all bind "all" <<PrevWindow>> { tkTabToWindow [tk_focusPrev %W] } bind "all" <Alt-Key> { tkTraverseToMenu %W %A } bind "all" <Control-Key-a> { q midi_player::start_cb } bind "all" <Control-Key-c> { q midi_player::clear_log_cb } bind "all" <Control-Key-e> { q midi_player::end_cb } bind "all" <Control-Key-k> { q midi_player::new_track_cb } bind "all" <Control-Key-n> { q midi_player::new_cb } bind "all" <Control-Key-o> { q midi_player::open_cb } bind "all" <Control-Key-p> { q midi_player::play_cb } bind "all" <Control-Key-q> { q midi_player::quit_cb } bind "all" <Control-Key-r> { q midi_player::record_cb } bind "all" <Control-Key-s> { q midi_player::save_cb } bind "all" <Control-Key-t> { q midi_player::stop_cb } bind "all" <Control-Key-x> { q midi_player::cancel_cb } bind "all" <Key-F10> { tkFirstMenu %W } bind "all" <Key-Tab> { tkTabToWindow [tk_focusNext %W] } bind "all" <Shift-Key-Tab> { focus [Widget::focusPrev %W] } ############################################################################# ## Binding tag: _TopLevel bind "_TopLevel" <<Create>> { if {![info exists _topcount]} {set _topcount 0}; incr _topcount } bind "_TopLevel" <<DeleteWindow>> { destroy %W; if {$_topcount == 0} {exit} } bind "_TopLevel" <Destroy> { if {[winfo toplevel %W] == "%W"} {incr _topcount -1} } ############################################################################# ## Binding tag: _vTclBalloon if {![info exists vTcl(sourcing)]} { bind "_vTclBalloon" <<KillBalloon>> { namespace eval ::vTcl::balloon { after cancel $id if {[winfo exists .vTcl.balloon]} { destroy .vTcl.balloon } set set 0 } } bind "_vTclBalloon" <<vTclBalloon>> { if {$::vTcl::balloon::first != 1} {break} namespace eval ::vTcl::balloon { set first 2 if {![winfo exists .vTcl]} { toplevel .vTcl; wm withdraw .vTcl } if {![winfo exists .vTcl.balloon]} { toplevel .vTcl.balloon -bg black } wm overrideredirect .vTcl.balloon 1 label .vTcl.balloon.l -text ${%W} -relief flat -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w pack .vTcl.balloon.l -side left -padx 1 -pady 1 wm geometry .vTcl.balloon +[expr {[winfo rootx %W]+[winfo width %W]/2}]+[expr {[winfo rooty %W]+[winfo height %W]+4}] set set 1 } } bind "_vTclBalloon" <Button> { namespace eval ::vTcl::balloon { set first 0 } vTcl:FireEvent %W <<KillBalloon>> } bind "_vTclBalloon" <Enter> { namespace eval ::vTcl::balloon { ## self defining balloon? if {![info exists %W]} { vTcl:FireEvent %W <<SetBalloon>> } set set 0 set first 1 set id [after 500 {vTcl:FireEvent %W <<vTclBalloon>>}] } } bind "_vTclBalloon" <Leave> { namespace eval ::vTcl::balloon { set first 0 } vTcl:FireEvent %W <<KillBalloon>> } bind "_vTclBalloon" <Motion> { namespace eval ::vTcl::balloon { if {!$set} { after cancel $id set id [after 500 {vTcl:FireEvent %W <<vTclBalloon>>}] } } } } Window show . Window show .top32 main $argc $argv Index: Makefile.am =================================================================== RCS file: /cvsroot/q-lang/q-midi/src/Makefile.am,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** Makefile.am 15 Dec 2003 11:00:30 -0000 1.1.1.1 --- Makefile.am 5 Jan 2004 19:59:37 -0000 1.2 *************** *** 15,32 **** stdlibdir = $(pkgdatadir)/lib ! stdlib_DATA = midi.q mididev.q player.q player.tcl install-data-hook: sed -e 's?#!/usr/bin/q?#!$(bindir)/q?g' \ ! < "$(pkgdatadir)/lib/player.q" \ ! > "$(pkgdatadir)/lib/player.sed" ! rm -f "$(pkgdatadir)/lib/player.q" ! mv "$(pkgdatadir)/lib/player.sed" "$(pkgdatadir)/lib/player.q" ! chmod a+x "$(pkgdatadir)/lib/player.q" ! rm -f "$(bindir)/player" ! ln -s "$(pkgdatadir)/lib/player.q" "$(bindir)/player" uninstall-hook: ! rm -f "$(bindir)/player" EXTRA_DIST = $(stdlib_DATA) Makefile.msc --- 15,32 ---- stdlibdir = $(pkgdatadir)/lib ! stdlib_DATA = midi.q mididev.q midi_player.q midi_player.tcl install-data-hook: sed -e 's?#!/usr/bin/q?#!$(bindir)/q?g' \ ! < "$(pkgdatadir)/lib/midi_player.q" \ ! > "$(pkgdatadir)/lib/midi_player.sed" ! rm -f "$(pkgdatadir)/lib/midi_player.q" ! mv "$(pkgdatadir)/lib/midi_player.sed" "$(pkgdatadir)/lib/midi_player.q" ! chmod a+x "$(pkgdatadir)/lib/midi_player.q" ! rm -f "$(bindir)/midi_player" ! ln -s "$(pkgdatadir)/lib/midi_player.q" "$(bindir)/midi_player" uninstall-hook: ! rm -f "$(bindir)/midi_player" EXTRA_DIST = $(stdlib_DATA) Makefile.msc --- player.q DELETED --- --- player.tcl DELETED --- |
From: <ag...@us...> - 2004-01-05 19:59:45
|
Update of /cvsroot/q-lang/q-midi In directory sc8-pr-cvs1:/tmp/cvs-serv29297 Modified Files: ChangeLog NEWS README README-Player configure.in Log Message: renamed player -> midi_player, updated docs Index: ChangeLog =================================================================== RCS file: /cvsroot/q-lang/q-midi/ChangeLog,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ChangeLog 5 Jan 2004 05:43:19 -0000 1.2 --- ChangeLog 5 Jan 2004 19:59:37 -0000 1.3 *************** *** 1,4 **** --- 1,10 ---- 2004-01-05 Albert Graef <Dr....@t-...> + +++ Release 1.12 +++ + + * player: renamed to midi_player + + * README: documented simplified Windows install procedure + * Makefile.msc: fixes to Windows build system Index: NEWS =================================================================== RCS file: /cvsroot/q-lang/q-midi/NEWS,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** NEWS 15 Dec 2003 10:59:21 -0000 1.1.1.1 --- NEWS 5 Jan 2004 19:59:37 -0000 1.2 *************** *** 1,2 **** --- 1,4 ---- + 1.12: "player" renamed to "midi_player", simplified Windows installation + 1.11: changed "iiwusynth" to "fluidsynth" Index: README =================================================================== RCS file: /cvsroot/q-lang/q-midi/README,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** README 5 Jan 2004 09:09:37 -0000 1.3 --- README 5 Jan 2004 19:59:37 -0000 1.4 *************** *** 1,4 **** ! Q-Midi 1.11 ====== ==== --- 1,4 ---- ! Q-Midi 1.12 ====== ==== *************** *** 22,29 **** Under the above URL you'll also find the latest Q-Midi sources and binary ! packages. Currently SuSE 8.x rpm and a Windows installer (msi) files are ! available; the latter also includes the necessary dlls and config files for ! running MidiShare under Windows. A binary package for OS X will soon be ! available, too. --- 22,28 ---- Under the above URL you'll also find the latest Q-Midi sources and binary ! packages. At present, some RPMs for popular Linux distributions and a Windows ! installer (MSI) package are available. The latter also includes the necessary ! dlls and config files for running MidiShare under Windows. *************** *** 32,46 **** You first have to get MidiShare at http://www.grame.fr/MidiShare/ and install ! it on your system. You can also get a SuSE 8.x rpm for the latest stable ! MidiShare version from the Q homepage. Then, if you have a SuSE 8.x system ! with Q installed under /usr, you can simply grab q-midi-<version>.rpm and ! install it with rpm. (If you have installed MidiShare from the sources, rpm ! may complain about an unsatisfied dependency on libMidiShare.so. In this case ! you can disable rpm's dependency checks to install the package anyway.) ! If you want to compile from the sources, you'll need both the MidiShare and ! POSIX thread libraries. See INSTALL for generic UNIX installation ! instructions. If you have the required libraries installed in the standard ! locations, running ./configure; make; make install --- 31,44 ---- You first have to get MidiShare at http://www.grame.fr/MidiShare/ and install ! it on your system. You can also get Linux rpms for the latest stable MidiShare ! version from the Q homepage. Then grab q-midi-<version>.rpm and install it ! with rpm. (If you have installed MidiShare from the sources, rpm may complain ! about an unsatisfied dependency on libMidiShare.so. In this case you can ! disable rpm's dependency checks to install the package anyway.) ! If you want to or need to compile from the sources, you'll need both the ! MidiShare and POSIX thread libraries. See INSTALL for generic UNIX ! installation instructions. If you have the required libraries installed in the ! standard locations, running ./configure; make; make install *************** *** 129,145 **** If you have not installed MidiShare before, you'll have to configure the MIDI driver ports. To do this, run the msDrivers program from the Qpad folder in ! the start menu, following the instructions in the Setup.html file; a link to ! this file can also be found in the start menu. NOTE: If you are going to use ! the portable device definitions in mididev.q, you should make sure that the ! your msDrivers configuration provides some "standard" port assignments; see ! "PORTABLE MIDI DEVICES" below for details. ! PLAYER ! ====== ! This release comes bundled with Player 1.1, a sample Q-Midi script which ! implements a full graphical MIDI player/recorder. To run this script, you'll ! need Tcl/Tk. See README-Player for further information. --- 127,143 ---- If you have not installed MidiShare before, you'll have to configure the MIDI driver ports. To do this, run the msDrivers program from the Qpad folder in ! the start menu, following the instructions in the MidiShare Docs\Setup.html ! file; a link to this file can also be found in the start menu. NOTE: If you ! are going to use the portable device definitions in mididev.q, you should make ! sure that the your msDrivers configuration provides some "standard" port ! assignments; see "PORTABLE MIDI DEVICES" below for details. ! MIDI PLAYER ! ==== ====== ! This release comes bundled with Q-Midi Player 1.2, a sample Q-Midi script ! which implements a full graphical MIDI player/recorder. To run this script, ! you'll need Tcl/Tk. See README-Player for further information. *************** *** 509,513 **** - MIDIDEV!0 is the external MIDI synthesizer (input/output) ! - MIDIDEV!1 is the internal MIDI synthesizer (input only) - MIDIDEV!2 is the network (input/output) --- 507,511 ---- - MIDIDEV!0 is the external MIDI synthesizer (input/output) ! - MIDIDEV!1 is the internal MIDI synthesizer (output only) - MIDIDEV!2 is the network (input/output) *************** *** 533,537 **** Enjoy! :) ! June 2003 Albert Graef ag...@mu..., Dr....@t-... --- 531,535 ---- Enjoy! :) ! January 2004 Albert Graef ag...@mu..., Dr....@t-... Index: README-Player =================================================================== RCS file: /cvsroot/q-lang/q-midi/README-Player,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** README-Player 15 Dec 2003 11:00:25 -0000 1.1.1.1 --- README-Player 5 Jan 2004 19:59:37 -0000 1.2 *************** *** 1,6 **** ! Player V1.2, Copyright (c) 2002, 2003 by Albert Graef ! The player.q script provides some additional utility functions for MIDI programming. The main function, `midi_player', lets you play back and record multi-track MIDI sequences using a graphical application implemented using the --- 1,6 ---- ! Q-Midi Player V1.2, Copyright (c) 2002, 2003, 2004 by Albert Graef ! The midi_player.q script provides some additional utility functions for MIDI programming. The main function, `midi_player', lets you play back and record multi-track MIDI sequences using a graphical application implemented using the *************** *** 13,17 **** ============ ===== ! This version of the player script comes bundled with Q-Midi. The script requires Tcl/Tk 8.3 or later, available from http://www.tcl.tk/. --- 13,17 ---- ============ ===== ! This version of the midi_player script comes bundled with Q-Midi. The script requires Tcl/Tk 8.3 or later, available from http://www.tcl.tk/. *************** *** 25,29 **** Run the script interactively with the interpreter as follows: ! $ q -i player To invoke the player from the Q interpreter you can then use a command like --- 25,29 ---- Run the script interactively with the interpreter as follows: ! $ q -i midi_player To invoke the player from the Q interpreter you can then use a command like *************** *** 35,46 **** (TRACK,TIME,MSG) triples forming a MIDI sequence. There also is a function `midi_play' which works like `midi_player' but starts playback immediately. ! Likewise, the `midi_record' function starts up player in recording mode. To use the player in your own scripts, simply put an import or include declaration like ! import player; ! near the beginning of your script. See the beginning of player.q for an overview of the operations provided by the script. --- 35,46 ---- (TRACK,TIME,MSG) triples forming a MIDI sequence. There also is a function `midi_play' which works like `midi_player' but starts playback immediately. ! Likewise, the `midi_record' function starts up the player in recording mode. To use the player in your own scripts, simply put an import or include declaration like ! import midi_player; ! near the beginning of your script. See the beginning of midi_player.q for an overview of the operations provided by the script. *************** *** 48,55 **** follows: ! $ player midi-file ! The midi-file name is optional. You can also run `player -help' or `player -h' ! to get a brief help message. Usage of the player application is fairly straightforward. The main window is --- 48,55 ---- follows: ! $ midi_player midi-file ! The midi-file name is optional. You can also run `midi_player -help' or ! `midi_player -h' to get a brief help message. Usage of the player application is fairly straightforward. The main window is *************** *** 126,130 **** Enjoy! :) ! June 2003 Albert Graef ag...@mu..., Dr....@t-... --- 126,130 ---- Enjoy! :) ! January 2004 Albert Graef ag...@mu..., Dr....@t-... Index: configure.in =================================================================== RCS file: /cvsroot/q-lang/q-midi/configure.in,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** configure.in 15 Dec 2003 11:00:09 -0000 1.1.1.1 --- configure.in 5 Jan 2004 19:59:37 -0000 1.2 *************** *** 2,6 **** AC_INIT(src/midi.q) AM_CONFIG_HEADER(config.h) ! AM_INIT_AUTOMAKE(q-midi, 1.11) AM_MAINTAINER_MODE AC_PROG_INSTALL --- 2,6 ---- AC_INIT(src/midi.q) AM_CONFIG_HEADER(config.h) ! AM_INIT_AUTOMAKE(q-midi, 1.12) AM_MAINTAINER_MODE AC_PROG_INSTALL |
From: <ag...@us...> - 2004-01-05 17:49:38
|
Update of /cvsroot/q-lang/q In directory sc8-pr-cvs1:/tmp/cvs-serv1528 Modified Files: README Log Message: more final touches... Index: README =================================================================== RCS file: /cvsroot/q-lang/q/README,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** README 5 Jan 2004 06:32:47 -0000 1.8 --- README 5 Jan 2004 17:49:35 -0000 1.9 *************** *** 62,67 **** powerful list processing functions, a collection of useful container data structures, an implementation of the lambda calculus, an interface to the ! PostScript language, binary and C-style formatted I/O, system utilities, ! POSIX threads, BSD sockets, regular expression matching, ... The distribution includes the Q programming tools, the standard library, a --- 62,68 ---- powerful list processing functions, a collection of useful container data structures, an implementation of the lambda calculus, an interface to the ! PostScript language, and a system interface featuring binary and C-style ! formatted I/O, file system and process manipulation utilities, POSIX ! threads, BSD sockets, regular expression matching, ... The distribution includes the Q programming tools, the standard library, a *************** *** 70,76 **** Tcl/Tk and IBM's Data Explorer, as well as Q language modes for Emacs and Kate. A Windows GUI frontend can be obtained as a separate package. For more ! information please check out the Q homepage at the following URL: ! http://q-lang.sourceforge.net GETTING Q --- 71,77 ---- Tcl/Tk and IBM's Data Explorer, as well as Q language modes for Emacs and Kate. A Windows GUI frontend can be obtained as a separate package. For more ! information please check out the Q homepage at SourceForge: ! http://q-lang.sourceforge.net GETTING Q *************** *** 78,88 **** As of December 2003, Q has become a SourceForge-hosted project, which can be ! found at http://sourceforge.net/projects/q-lang/. There you can obtain ! released source and binary packages, as well as the latest and greatest ! development sources in CVS, under the following URLs: ! - download area: http://sourceforge.net/project/showfiles.php?group_id=96881 ! - cvs access: http://sourceforge.net/cvs/?group_id=96881 Note that to build Q from the cvs sources you will first have to run the --- 79,96 ---- As of December 2003, Q has become a SourceForge-hosted project, which can be ! found at the following URL: ! http://sourceforge.net/projects/q-lang/ ! There you can obtain released source and binary packages, as well as the ! latest and greatest development sources in CVS, under the following URLs. ! ! Download area: ! ! http://sourceforge.net/project/showfiles.php?group_id=96881 ! ! CVS access: ! ! http://sourceforge.net/cvs/?group_id=96881 Note that to build Q from the cvs sources you will first have to run the *************** *** 335,342 **** If you want to build the native Windows port yourself, you need a recent version of Mingw and Msys, both available at http://www.mingw.org. To build ! *everything* Q-related on the SourceForge site, you'll need quite a lot of ! other stuff in addition, so the Q homepage has a zip file with the complete ! build tree used to create the current release, including the Qpad sources, the ! add-on modules, and all dependencies except ImageMagick and Tcl/Tk. OPTIONAL SOFTWARE --- 343,351 ---- If you want to build the native Windows port yourself, you need a recent version of Mingw and Msys, both available at http://www.mingw.org. To build ! the entire distribution, you'll also need MS Visual C/C++ and a bunch of ! additional libraries. To ease porting, the Q homepage has a zip file with the ! complete build tree used to create the current Windows release, including the ! Qpad sources, the add-on modules, and all dependencies except ImageMagick and ! Tcl/Tk. OPTIONAL SOFTWARE *************** *** 356,363 **** Q's `gdbm' module provides an interface to the GNU dbm library, see gdbm(3). ! If you have a Linux system then you most likely have this library, otherwise ! you can get it from http://www.gnu.org or one of its mirrors. This module is ! also supported on FreeBSD, OS X and Windows. See README-Gdbm for more ! information. GGI --- 365,372 ---- Q's `gdbm' module provides an interface to the GNU dbm library, see gdbm(3). ! If you have a Linux system then most likely you already have this library, ! otherwise you can get it from http://www.gnu.org or one of its mirrors. This ! module is also supported on FreeBSD, OS X and Windows. See README-Gdbm for ! more information. GGI |
From: <ag...@us...> - 2004-01-05 17:02:28
|
Update of /cvsroot/q-lang/q/modules/ggi/examples In directory sc8-pr-cvs1:/tmp/cvs-serv24708/modules/ggi/examples Modified Files: flying_ggis.q font_test.q Log Message: cosmetic changes in examples Index: flying_ggis.q =================================================================== RCS file: /cvsroot/q-lang/q/modules/ggi/examples/flying_ggis.q,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** flying_ggis.q 3 Jan 2004 03:12:05 -0000 1.3 --- flying_ggis.q 5 Jan 2004 17:02:25 -0000 1.4 *************** *** 4,10 **** /* flying_ggis.q: Another variation of the "Flying GGIs" theme. This one uses a custom font to render the text and an alpha buffer to make it translucent. ! Requires FreeType. */ ! ! /* Say `demo' to run. */ import ggi; --- 4,8 ---- /* flying_ggis.q: Another variation of the "Flying GGIs" theme. This one uses a custom font to render the text and an alpha buffer to make it translucent. ! Say `demo' to run. */ import ggi; *************** *** 49,53 **** search_font FONT = FONT where [FONT|_] = cat (map (compose glob (++("/"++FONT))) FONT_DIRS); ! = () otherwise; // adapt the maximum stretch according to the font --- 47,52 ---- search_font FONT = FONT where [FONT|_] = cat (map (compose glob (++("/"++FONT))) FONT_DIRS); ! = printf "Warning: %s could not be found -- using default font instead\n" FONT ! otherwise; // adapt the maximum stretch according to the font *************** *** 67,71 **** valid (image P S V C) = S<=MAXS; ! new IMGS = append IMGS (image (X,Y) 1.0 V C) where X = rand BD (WD-BD), Y = rand BD (HT-BD), --- 66,70 ---- valid (image P S V C) = S<=MAXS; ! new IMGS = [image (X,Y) 1.0 V C|IMGS] where X = rand BD (WD-BD), Y = rand BD (HT-BD), Index: font_test.q =================================================================== RCS file: /cvsroot/q-lang/q/modules/ggi/examples/font_test.q,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** font_test.q 3 Jan 2004 04:11:30 -0000 1.5 --- font_test.q 5 Jan 2004 17:02:25 -0000 1.6 *************** *** 34,38 **** search_font FONT = FONT where [FONT|_] = cat (map (compose glob (++("/"++FONT))) FONT_DIRS); ! = () otherwise; // set foreground and background color --- 34,39 ---- search_font FONT = FONT where [FONT|_] = cat (map (compose glob (++("/"++FONT))) FONT_DIRS); ! = printf "Warning: %s could not be found -- using default font instead\n" FONT ! otherwise; // set foreground and background color *************** *** 94,98 **** ggi_set_flags VIS FLAGS || // reset transform to default ! transform (0,0) (1,0,0,1) where FLAGS = ggi_get_flags VIS; --- 95,99 ---- ggi_set_flags VIS FLAGS || // reset transform to default ! transform (0,0) (1,0,0,1) || () where FLAGS = ggi_get_flags VIS; |
From: <ag...@us...> - 2004-01-05 17:02:28
|
Update of /cvsroot/q-lang/q/modules/magick/examples In directory sc8-pr-cvs1:/tmp/cvs-serv24708/modules/magick/examples Modified Files: magicktest.q Log Message: cosmetic changes in examples Index: magicktest.q =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/examples/magicktest.q,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** magicktest.q 3 Jan 2004 04:39:05 -0000 1.17 --- magicktest.q 5 Jan 2004 17:02:25 -0000 1.18 *************** *** 23,27 **** search_font FONT = FONT where [FONT|_] = cat (map (compose glob (++("/"++FONT))) FONT_DIRS); ! = () otherwise; /****************************************************************************/ --- 23,28 ---- search_font FONT = FONT where [FONT|_] = cat (map (compose glob (++("/"++FONT))) FONT_DIRS); ! = printf "Warning: %s could not be found -- using default font instead\n" FONT ! otherwise; /****************************************************************************/ |
From: <ag...@us...> - 2004-01-05 09:09:40
|
Update of /cvsroot/q-lang/q-midi In directory sc8-pr-cvs1:/tmp/cvs-serv4155 Modified Files: README Log Message: simplified Windows setup procedure Index: README =================================================================== RCS file: /cvsroot/q-lang/q-midi/README,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** README 16 Dec 2003 13:08:47 -0000 1.2 --- README 5 Jan 2004 09:09:37 -0000 1.3 *************** *** 128,142 **** If you have not installed MidiShare before, you'll have to configure the MIDI ! driver ports with the msDrivers application. To do this, go to the Qpad ! folder, run msDrivers.exe and follow the instructions in the MidiShare ! Docs\Setup.html file. Once you've completed this step, you should have a ! msMMSystem.ini file. Copy that file along with the other *.ini files and ! msDrivers.exe to your WINNT (or WINDOWS) folder. Make a shortcut to ! WINNT\msDrivers.exe on your desktop so that you can run it quickly when you ! want to change the port definitions. ! ! If you are going to use the portable device definitions in mididev.q, you ! should also make sure that the your msDrivers configuration provides some ! "standard" port assignments; see "PORTABLE MIDI DEVICES" below for details. --- 128,137 ---- If you have not installed MidiShare before, you'll have to configure the MIDI ! driver ports. To do this, run the msDrivers program from the Qpad folder in ! the start menu, following the instructions in the Setup.html file; a link to ! this file can also be found in the start menu. NOTE: If you are going to use ! the portable device definitions in mididev.q, you should make sure that the ! your msDrivers configuration provides some "standard" port assignments; see ! "PORTABLE MIDI DEVICES" below for details. |
From: <ag...@us...> - 2004-01-05 08:23:11
|
Update of /cvsroot/q-lang/q/modules/magick/examples In directory sc8-pr-cvs1:/tmp/cvs-serv27717/modules/magick/examples Modified Files: sprite.q Log Message: yet another workaround for Windows/Direct Input deficiencies. sigh Index: sprite.q =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/examples/sprite.q,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** sprite.q 5 Jan 2004 03:24:41 -0000 1.3 --- sprite.q 5 Jan 2004 08:23:07 -0000 1.4 *************** *** 6,11 **** /* To use, evaluate `sprite', click left in the GGI window to show the sprite at the current pointer position, move the pointer to move it around, click ! left again to hide the sprite, etc. Press the right mouse button to ! terminate the input loop at any time. */ import ggi, magick; --- 6,11 ---- /* To use, evaluate `sprite', click left in the GGI window to show the sprite at the current pointer position, move the pointer to move it around, click ! left again to hide the sprite, etc. Press a key to terminate the input loop ! at any time. */ import ggi, magick; *************** *** 82,90 **** loop STATE POS = process STATE POS (ggi_read VIS GGI_EM_ALL); ! // exit when right button pressed ! process STATE _ (ggi_event TYPE _ _ _ _ PARAM) = cleanup STATE ! if (TYPE = GGI_EV_PTRBUTTONPRESS) and then ! (PARAM = 2); // clean up at exit --- 82,89 ---- loop STATE POS = process STATE POS (ggi_read VIS GGI_EM_ALL); ! // exit when key pressed ! process STATE _ (ggi_event TYPE _ _ _ _ _) = cleanup STATE ! if TYPE = GGI_EV_KEYPRESS; // clean up at exit |
From: <ag...@us...> - 2004-01-05 07:10:06
|
Update of /cvsroot/q-lang/q/src In directory sc8-pr-cvs1:/tmp/cvs-serv17047/src Modified Files: mangle.h Log Message: mangled interpreter symbols Index: mangle.h =================================================================== RCS file: /cvsroot/q-lang/q/src/mangle.h,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** mangle.h 15 Dec 2003 12:07:14 -0000 1.2 --- mangle.h 5 Jan 2004 07:10:03 -0000 1.3 *************** *** 1,3 **** ! /* mangle.h: created Sun Dec 14 23:15:09 CET 2003 by mangle.sh */ #define Vflag __qq__Vflag --- 1,3 ---- ! /* mangle.h: created Mon Jan 5 08:08:56 CET 2004 by mangle.sh */ #define Vflag __qq__Vflag |
From: <ag...@us...> - 2004-01-05 06:32:50
|
Update of /cvsroot/q-lang/q In directory sc8-pr-cvs1:/tmp/cvs-serv11927 Modified Files: ChangeLog NEWS README Log Message: final touches for the 4.6 release Index: ChangeLog =================================================================== RCS file: /cvsroot/q-lang/q/ChangeLog,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** ChangeLog 5 Jan 2004 03:28:38 -0000 1.16 --- ChangeLog 5 Jan 2004 06:32:47 -0000 1.17 *************** *** 1,7 **** --- 1,17 ---- 2004-01-05 Albert Graef <Dr....@t-...> + +++ Release 4.6 +++ + + * README, NEWS: final touches + + * magick.c: bug fixes in flood fill operations + * sprite.q: Windows usability fixes + * magick, tk, odbc: fixes to Makefile.msc + 2004-01-03 Albert Graef <Dr....@t-...> + + * qdoc.texi: updated * graphics.q: overhaul of the standard devices section; this now Index: NEWS =================================================================== RCS file: /cvsroot/q-lang/q/NEWS,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** NEWS 16 Dec 2003 19:02:29 -0000 1.3 --- NEWS 5 Jan 2004 06:32:47 -0000 1.4 *************** *** 3,9 **** ======= ! * 4.6 (unreleased) ! BIG NEWS: Q goes SourceForge! As of December 2003, Q has become a SourceForge-hosted project, which can be found at the following URL: --- 3,14 ---- ======= ! * 4.6 5 January 2004 ! This release features a much improved GGI interface and a new magick module ! which uses ImageMagick to load, save and manipulate images in a variety of ! file formats. Of course, you can also transfer the pixel data from ImageMagick ! images to GGI visuals and vice versa. ! ! BIG NEWS: Q is now on SourceForge! As of December 2003, Q has become a SourceForge-hosted project, which can be found at the following URL: *************** *** 14,22 **** development sources in CVS ("CVS" link). Two mailing lists for discussing Q development and usage are also available ("Lists" link). - - Work is underway to improve the GGI interface and add a magick module which - uses libMagick to load, save and manipulate images in a variety of file - formats. This is currently available in CVS only, but we expect to release Q - 4.6 with all these new features "real soon now". :) --- 19,22 ---- Index: README =================================================================== RCS file: /cvsroot/q-lang/q/README,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** README 2 Jan 2004 07:38:12 -0000 1.7 --- README 5 Jan 2004 06:32:47 -0000 1.8 *************** *** 96,100 **** See the INSTALL file for generic (UNIX) installation instructions. This ! release has been tested on FreeBSD, Linux, Mac OS X and Windows, and should also work (with minor tweaking) on most other modern UNIX/POSIX-based platforms. Please report any patches required to build the package on other --- 96,100 ---- See the INSTALL file for generic (UNIX) installation instructions. This ! software has been tested on FreeBSD, Linux, Mac OS X and Windows, and should also work (with minor tweaking) on most other modern UNIX/POSIX-based platforms. Please report any patches required to build the package on other *************** *** 325,335 **** - Tcl/Tk: http://aspn.activestate.com/ASPN/Downloads/ActiveTcl/ - If you want to build the native Windows port yourself, you need Mingw - (http://www.mingw.org). (A few optional parts of the distribution also require - the MS Visual C compiler.) All necessary additional Makefiles are included in - the distribution, and some other required bits (like precompiled native - Windows binaries of the gmp and readline libraries) are available from the Q - homepage. - If you would like to use q-mode.el under Windows, you should get a Win32 version of Emacs which supports processes (and hence comint). Two nice Windows --- 325,328 ---- *************** *** 339,342 **** --- 332,342 ---- file to your Emacs site-lisp directory, and set up your .emacs file as described in Appendix E of the manual. + + If you want to build the native Windows port yourself, you need a recent + version of Mingw and Msys, both available at http://www.mingw.org. To build + *everything* Q-related on the SourceForge site, you'll need quite a lot of + other stuff in addition, so the Q homepage has a zip file with the complete + build tree used to create the current release, including the Qpad sources, the + add-on modules, and all dependencies except ImageMagick and Tcl/Tk. OPTIONAL SOFTWARE |
From: <ag...@us...> - 2004-01-05 05:43:22
|
Update of /cvsroot/q-lang/q-midi In directory sc8-pr-cvs1:/tmp/cvs-serv4421 Modified Files: ChangeLog Log Message: ChangeLog updated Index: ChangeLog =================================================================== RCS file: /cvsroot/q-lang/q-midi/ChangeLog,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -C2 -d -r1.1.1.1 -r1.2 *** ChangeLog 15 Dec 2003 11:00:27 -0000 1.1.1.1 --- ChangeLog 5 Jan 2004 05:43:19 -0000 1.2 *************** *** 1,2 **** --- 1,6 ---- + 2004-01-05 Albert Graef <Dr....@t-...> + + * Makefile.msc: fixes to Windows build system + 2003-07-22 Albert Graef <Dr....@t-...> |
From: <ag...@us...> - 2004-01-05 05:42:38
|
Update of /cvsroot/q-lang/q-audio In directory sc8-pr-cvs1:/tmp/cvs-serv4321 Modified Files: ChangeLog Log Message: ChangeLog updated Index: ChangeLog =================================================================== RCS file: /cvsroot/q-lang/q-audio/ChangeLog,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ChangeLog 23 Dec 2003 01:20:48 -0000 1.3 --- ChangeLog 5 Jan 2004 05:42:35 -0000 1.4 *************** *** 1,5 **** ! 2003-12-23 Albert Graef <Dr....@t-...> +++ Release 1.2 +++ * fixes for compatibility with latest Q-GGI --- 1,11 ---- ! 2004-01-05 Albert Graef <Dr....@t-...> +++ Release 1.2 +++ + + * audio_player.q: cosmetic changes + + * Makefile.msc: fixes to Windows build system + + 2003-12-23 Albert Graef <Dr....@t-...> * fixes for compatibility with latest Q-GGI |
From: <ag...@us...> - 2004-01-05 05:28:38
|
Update of /cvsroot/q-lang/q/modules/magick In directory sc8-pr-cvs1:/tmp/cvs-serv2044 Modified Files: magick.c Log Message: negate opacity values Index: magick.c =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/magick.c,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 *** magick.c 3 Jan 2004 04:02:07 -0000 1.39 --- magick.c 5 Jan 2004 05:28:35 -0000 1.40 *************** *** 2817,2821 **** return mkapp(mksym(sym(magick_error)), mkstr(strdup(msg))); } ! res = MatteFloodfillImage(img, target, opacity, x, y, m2?FillToBorderMethod:FloodfillMethod); if (!res) --- 2817,2821 ---- return mkapp(mksym(sym(magick_error)), mkstr(strdup(msg))); } ! res = MatteFloodfillImage(img, target, 0xffff-opacity, x, y, m2?FillToBorderMethod:FloodfillMethod); if (!res) *************** *** 2858,2862 **** PixelPacket target; set_pixels(&target, m1->v, 1, 1); ! res = TransparentImage(img, target, opacity); if (!res) return __FAIL; --- 2858,2862 ---- PixelPacket target; set_pixels(&target, m1->v, 1, 1); ! res = TransparentImage(img, target, 0xffff-opacity); if (!res) return __FAIL; |
From: <ag...@us...> - 2004-01-05 03:28:41
|
Update of /cvsroot/q-lang/q In directory sc8-pr-cvs1:/tmp/cvs-serv18895 Modified Files: ChangeLog Log Message: ChangeLog updated Index: ChangeLog =================================================================== RCS file: /cvsroot/q-lang/q/ChangeLog,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** ChangeLog 3 Jan 2004 15:21:05 -0000 1.15 --- ChangeLog 5 Jan 2004 03:28:38 -0000 1.16 *************** *** 1,2 **** --- 1,6 ---- + 2004-01-05 Albert Graef <Dr....@t-...> + + * sprite.q: Windows usability fixes + 2004-01-03 Albert Graef <Dr....@t-...> |
From: <ag...@us...> - 2004-01-05 03:24:44
|
Update of /cvsroot/q-lang/q/modules/magick/examples In directory sc8-pr-cvs1:/tmp/cvs-serv18493 Modified Files: sprite.q Log Message: Windows usability fixes Index: sprite.q =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/examples/sprite.q,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** sprite.q 23 Dec 2003 01:15:02 -0000 1.2 --- sprite.q 5 Jan 2004 03:24:41 -0000 1.3 *************** *** 6,10 **** /* To use, evaluate `sprite', click left in the GGI window to show the sprite at the current pointer position, move the pointer to move it around, click ! right to hide the sprite again, etc. Press the middle mouse button to terminate the input loop at any time. */ --- 6,10 ---- /* To use, evaluate `sprite', click left in the GGI window to show the sprite at the current pointer position, move the pointer to move it around, click ! left again to hide the sprite, etc. Press the right mouse button to terminate the input loop at any time. */ *************** *** 82,90 **** loop STATE POS = process STATE POS (ggi_read VIS GGI_EM_ALL); ! // exit when middle button pressed process STATE _ (ggi_event TYPE _ _ _ _ PARAM) = cleanup STATE if (TYPE = GGI_EV_PTRBUTTONPRESS) and then ! (PARAM = 3); // clean up at exit --- 82,90 ---- loop STATE POS = process STATE POS (ggi_read VIS GGI_EM_ALL); ! // exit when right button pressed process STATE _ (ggi_event TYPE _ _ _ _ PARAM) = cleanup STATE if (TYPE = GGI_EV_PTRBUTTONPRESS) and then ! (PARAM = 2); // clean up at exit *************** *** 95,99 **** def W2 = W div 2, H2 = H div 2; ! // show sprite when left button pressed process () (X,Y) (ggi_event TYPE _ _ _ _ PARAM) = show_sprite (X-W2,Y-H2) || --- 95,99 ---- def W2 = W div 2, H2 = H div 2; ! // toggle sprite when left button pressed process () (X,Y) (ggi_event TYPE _ _ _ _ PARAM) = show_sprite (X-W2,Y-H2) || *************** *** 101,111 **** if (TYPE = GGI_EV_PTRBUTTONPRESS) and then (PARAM = 1); - - // hide sprite when right button pressed process (X,Y) _ (ggi_event TYPE _ _ _ _ PARAM) = hide_sprite (X-W2,Y-H2) || loop () (X,Y) if (TYPE = GGI_EV_PTRBUTTONPRESS) and then ! (PARAM = 2); // move sprite when pointer is moved --- 101,109 ---- if (TYPE = GGI_EV_PTRBUTTONPRESS) and then (PARAM = 1); process (X,Y) _ (ggi_event TYPE _ _ _ _ PARAM) = hide_sprite (X-W2,Y-H2) || loop () (X,Y) if (TYPE = GGI_EV_PTRBUTTONPRESS) and then ! (PARAM = 1); // move sprite when pointer is moved |
From: <ag...@us...> - 2004-01-04 08:41:29
|
Update of /cvsroot/q-lang/q-audio/src In directory sc8-pr-cvs1:/tmp/cvs-serv20527 Modified Files: audio_player.q Log Message: shorten long filesnames in display Index: audio_player.q =================================================================== RCS file: /cvsroot/q-lang/q-audio/src/audio_player.q,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** audio_player.q 23 Dec 2003 01:20:48 -0000 1.2 --- audio_player.q 4 Jan 2004 08:41:26 -0000 1.3 *************** *** 242,246 **** show_name VIS NAME = ggi_set_foreground VIS FORE || ! ggi_puts VIS (100,5) NAME; /* Main program to be invoked from the shell. */ --- 242,254 ---- show_name VIS NAME = ggi_set_foreground VIS FORE || ! ggi_puts VIS (100,5) (shorten NAME); ! ! def MAXLEN = 30, DELIM = ifelse (pos "mingw" sysinfo >= 0) "/\\" "/"; ! ! shorten NAME = NAME if #NAME <= MAXLEN; ! = ifelse (null SUFF) (last PARTS) (".../" ++ last SUFF) ! where PARTS = split DELIM NAME, ! SUFF = scan1 (lambda X (lambda Y (Y++"/"++X))) (reverse PARTS), ! SUFF = takewhile (compose (<=MAXLEN-4) (#)) SUFF; /* Main program to be invoked from the shell. */ |
From: <ag...@us...> - 2004-01-04 05:25:01
|
Update of /cvsroot/q-lang/q-midi/src In directory sc8-pr-cvs1:/tmp/cvs-serv27819/src Modified Files: Makefile.msc Log Message: fixes to Windows build system Index: Makefile.msc =================================================================== RCS file: /cvsroot/q-lang/q-midi/src/Makefile.msc,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Makefile.msc 3 Jan 2004 22:24:13 -0000 1.2 --- Makefile.msc 4 Jan 2004 05:24:58 -0000 1.3 *************** *** 16,20 **** midi.dll: midi.c ../midifile/midifile.c ../midifile/midifile.h ! $(QCC) $(QCCFLAGS) --msc -o midi.dll midi.c ../midifile/midifile.c -- $(CFLAGS) $(DEFS) -I. -I../midifile -I../../MidiShare -I../../pthread --link ../../MidiShare/mshare32.lib ../../pthread/pthreadVC.lib /link/LIBPATH:../../q/libq clean mostlyclean distclean maintainer-clean:: --- 16,20 ---- midi.dll: midi.c ../midifile/midifile.c ../midifile/midifile.h ! $(QCC) $(QCCFLAGS) --msc -o midi.dll midi.c ../midifile/midifile.c -- $(CFLAGS) $(DEFS) -I. -I../midifile -I../../MidiShare -I../../pthread -I../../q/libq --link ../../MidiShare/mshare32.lib ../../pthread/pthreadVC.lib /link/LIBPATH:../../q/libq clean mostlyclean distclean maintainer-clean:: |
From: <ag...@us...> - 2004-01-04 05:24:15
|
Update of /cvsroot/q-lang/q-audio/src In directory sc8-pr-cvs1:/tmp/cvs-serv27772/src Modified Files: Makefile.msc Log Message: fixes to Windows build system Index: Makefile.msc =================================================================== RCS file: /cvsroot/q-lang/q-audio/src/Makefile.msc,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Makefile.msc 3 Jan 2004 22:19:04 -0000 1.4 --- Makefile.msc 4 Jan 2004 05:24:12 -0000 1.5 *************** *** 35,49 **** audio.dll: audio.c $(PORTAUDIO_HDR) $(PORTAUDIO_SRC) $(DRIVER_SRC) ! $(QCC) $(QCCFLAGS) --msc -o audio.dll audio.c $(PORTAUDIO_SRC) $(DRIVER_SRC) -- $(CFLAGS) $(DEFS) -I. -I../portaudio/pa_common -I../portaudio/pablio -I../../pthread --link winmm.lib ../../pthread/pthreadVC.lib /link/LIBPATH:../../q/libq audio_ds.dll: audio.c $(PORTAUDIO_HDR) $(PORTAUDIO_SRC) $(DSOUND_SRC) ! $(QCC) $(QCCFLAGS) --msc -o audio_ds.dll audio.c $(PORTAUDIO_SRC) $(DSOUND_SRC) -- $(CFLAGS) $(DEFS) -I. -I../portaudio/pa_common -I../portaudio/pa_win_ds -I../portaudio/pablio -I../../pthread --link dsound.lib winmm.lib user32.lib ../../pthread/pthreadVC.lib /link/LIBPATH:../../q/libq sndfile.dll: sndfile.c ! $(QCC) $(QCCFLAGS) --msc -o sndfile.dll sndfile.c -- $(CFLAGS) $(DEFS) -I. -I../../libsndfile --link ../../libsndfile/libsndfile.lib /link/LIBPATH:../../q/libq # NOTE: this one is compiled using mingw draw_wave.dll: draw_wave.c ggilib.h ggilib.c draw_line.c ! $(QCC) $(QCCFLAGS) -o draw_wave.dll draw_wave.c ggilib.c draw_line.c -- $(CFLAGS) $(DEFS) -I. -I../portaudio/pa_common -I../../ggi/include --link -L../../ggi/lib -lggi -L../../q/libq clean mostlyclean distclean maintainer-clean:: --- 35,49 ---- audio.dll: audio.c $(PORTAUDIO_HDR) $(PORTAUDIO_SRC) $(DRIVER_SRC) ! $(QCC) $(QCCFLAGS) --msc -o audio.dll audio.c $(PORTAUDIO_SRC) $(DRIVER_SRC) -- $(CFLAGS) $(DEFS) -I. -I../portaudio/pa_common -I../portaudio/pablio -I../../pthread -I../../q/libq --link winmm.lib ../../pthread/pthreadVC.lib /link/LIBPATH:../../q/libq audio_ds.dll: audio.c $(PORTAUDIO_HDR) $(PORTAUDIO_SRC) $(DSOUND_SRC) ! $(QCC) $(QCCFLAGS) --msc -o audio_ds.dll audio.c $(PORTAUDIO_SRC) $(DSOUND_SRC) -- $(CFLAGS) $(DEFS) -I. -I../portaudio/pa_common -I../portaudio/pa_win_ds -I../portaudio/pablio -I../../pthread -I../../q/libq --link dsound.lib winmm.lib user32.lib ../../pthread/pthreadVC.lib /link/LIBPATH:../../q/libq sndfile.dll: sndfile.c ! $(QCC) $(QCCFLAGS) --msc -o sndfile.dll sndfile.c -- $(CFLAGS) $(DEFS) -I. -I../../libsndfile -I../../q/libq --link ../../libsndfile/libsndfile.lib /link/LIBPATH:../../q/libq # NOTE: this one is compiled using mingw draw_wave.dll: draw_wave.c ggilib.h ggilib.c draw_line.c ! $(QCC) $(QCCFLAGS) -o draw_wave.dll draw_wave.c ggilib.c draw_line.c -- $(CFLAGS) $(DEFS) -I. -I../portaudio/pa_common -I../../ggi/include -I../../q/libq --link -L../../ggi/lib -lggi -L../../q/libq clean mostlyclean distclean maintainer-clean:: |
From: <ag...@us...> - 2004-01-04 02:31:15
|
Update of /cvsroot/q-lang/q/modules/magick In directory sc8-pr-cvs1:/tmp/cvs-serv4495/modules/magick Modified Files: Makefile.msc Log Message: fixed link options in msc makefiles Index: Makefile.msc =================================================================== RCS file: /cvsroot/q-lang/q/modules/magick/Makefile.msc,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Makefile.msc 2 Jan 2004 04:33:40 -0000 1.1 --- Makefile.msc 4 Jan 2004 02:31:11 -0000 1.2 *************** *** 16,20 **** magick$(SHLEXT): magick.c ! $(QCC) $(QCCFLAGS) --msc -o magick$(SHLEXT) magick.c -- $(DEFS) -I../../libq -I../../../magick/include -I../../../gmp --link CORE_RL_magick_.lib libgmp.lib "/link/LIBPATH:../../libq;../../../gmp" clean mostlyclean distclean maintainer-clean:: --- 16,20 ---- magick$(SHLEXT): magick.c ! $(QCC) $(QCCFLAGS) --msc -o magick$(SHLEXT) magick.c -- $(DEFS) -I../../libq -I../../../magick/include -I../../../gmp --link CORE_RL_magick_.lib libgmp.lib '/link' '/LIBPATH:../../../gmp' '/LIBPATH:../../libq' clean mostlyclean distclean maintainer-clean:: |