home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Audio 4.94 - Over 11,000 Files
/
audio-11000.iso
/
msdos
/
misc
/
sample20
/
sampler.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-05-20
|
55KB
|
1,266 lines
Program analog_sound_sampler_with_editor;
{$A+,B-,D-,E+,F-,I+,L+,N-,O+,R-,S+}
{$M 16384,0,655360}
{ $define debug}
{$ifdef debug}
{$r+}
{$endif}
{$v-}
Uses
dos, crt, graph, rm, menus, fonts, drivers, mousfunc, turbmous,printer;
{ $define pwm}
{$define sample}
{$l samplasm}
Const
{$ifndef pwm}
titlestring = 'Sampler V2.0 (C) R.McKenzie 1989';
{$endif pwm}
{$ifdef pwm}
titlestring = 'PWM Sampler 2.0 (C) R.McKenzie 1989';
{$endif pwm}
(*
(C) Copyright 1989 by Rowan McKenzie
You may copy these files or use the source code only
for non-profit purposes. Please contact me if you wish to use any
part of the package for commercial purposes.
Rowan McKenzie
35 Moore Ave,
Croydon 3136
Vic, Australia
This program allows the manipulation and replay with chromatic intervals of
digital sound samples from the keyboard using a guitar fretboard or piano
keyboard layout. Pitch is determined by a fractional increment technique
and played through a D/A converter connected to a parallel port or through
the PC speaker using Pulse Width Modulation.
To create the PWM speaker version, define pwm above, change the pwm
definition in the samplasm.asm file to true, reassemble samplasm.asm,
and recompile this file.
To create the D/A version, define da above, change the pwm
definition in the samplasm.asm file to false, reassemble samplasm.asm,
and recompile this file.
To use the D/A version, an 8 bit D/A converter will need to be connected
to the parallel printer port named in the SAMPLER.CNF file.
To use the sample facility an autotriggering A/D converter will need be
appear at the same port address as the D/A converter, and define sample *)
Const cnffilename = 'sampler.cnf';
clipboardfilename = '.\sampler.clp';
lpt1 = $3bc; {might be wrong order?}
lpt2 = $378;
lpt3 = $278;
default_samplerate = 27; {initial sample rate=27kHz}
blocksize = 4096; {size of blocks for blockread/write}
bufflength = $fe00; {sample buffer size (<64k-16)}
{NOTE: this is the absolute minimum size
allowed here if compatibility between
versions is to be maintained}
maxbeats = 500; {no. song elements allowed}
maxjumps = 20; {no. jumps allowed inside songs}
maxsymbols = 15; {no. symbols in songs allowed}
maxfiles = 301; {no. files allowed in directory list (set
according to how many will fit on directory
display +1)}
bigemptystring = ' ';
esc = #$1b;
introdelay = 700; {delay for user to read intro screen(x10ms)}
dialogbcolor = red;
dialogcolor = white;
clickbcolor = red;
clickcolor = white;
screencolor = green;
dirbcolor = green;
dircolor = black;
dirhcolor = white;
panelcolor = lightgreen;
wavecolor = white;
waveboxcolor = lightred;
hotcolor = white;
hotbcolor = lightblue;
titlecolor = black;
tuningbcolor = blue;
tuningcolor = white;
timerbcolor = green;
timercolor = white;
drawcolor = yellow;
cornersize = 20; {size of corner arc}
arrowxsize = 8; {width of arrow pointers}
arrowysize = 9; {height " }
arrowxoff = 4; {offset to center of arrow (arrowxsize div 2)}
arrowpoints = 8; {no. points in arrow}
{patterns for arrow pointers}
uparrowshape : Array[1..arrowpoints] Of pointtype =
((x : 4; y : 0), (x : 0; y : 4), (x : 3; y : 4), (x : 3; y : 9),
(x : 5; y : 9), (x : 5; y : 4), (x : 8; y : 4), (x : 4; y : 0));
downarrowshape : Array[1..arrowpoints] Of pointtype =
((x : 104; y : 9), (x : 100; y : 5), (x : 103; y : 5), (x : 103; y : 0),
(x : 105; y : 0), (x : 105; y : 5), (x : 108; y : 5), (x : 104; y : 9));
tuningshapepoints = 4;
tuningrshape : Array[1..tuningshapepoints] Of polypoint =
((x : 10; y : 8), (x : 0; y : 12), (x : 0; y : 4), (x : 10; y : 8));
tuninglshape : Array[1..tuningshapepoints] Of polypoint =
((x : 0; y : 8), (x : 10; y : 12), (x : 10; y : 4), (x : 0; y : 8));
introyoff = 3; {intro information position}
plotxoffset = arrowxoff; {indent from edge of screen for wave}
dirnamefieldwidth = 14; {field width for directory names}
{modified codes to represent special keys in one byte}
spctrl = #128; splshift = #129; sprshift = #130; spalt = #131; spcaps = #132;
spnum = #133; spscroll = #134; sphome = #135; spsys = #136; spuparrow = #137;
sppgup = #138; spprtsc = #139; spleftarrow = #140; sp5 = #141;
sprightarrow = #142; spminus = #143; spend = #144; spdownarrow = #145;
sppgdn = #146; spplus = #147; spins = #148; spdel = #149; spf1 = #151;
spf2 = #152; spf3 = #153; spf4 = #154; spf5 = #155; spf6 = #156; spf7 = #157;
spf8 = #158; spf9 = #159; spf10 = #160;
{the following arrays map the keyboard to a set of notes (guitar or piano)
where -13 is an invalid letter}
Type kbdmaptype = Array[''''..']'] Of Integer;
Const kbdmapguitar : kbdmaptype =
( {'} 3, -13, -13, -13, -13, -5, 13, -4, -3, 12, 3, 4, 5, 6, 7, 8,
9, 10, 11, -13, 2, -13, 14, -13, -13, -13,
{A} -7, -8, -10, -5, 0, -4, -3, -2, 5, -1, 0, 1, -6, -7, 6, 7,
-2, 1, -6, 2, 4, -9, -1, -11, 3, -12, 8, 15, 9);
kbdmappiano : kbdmaptype =
( {'} 10, -13, -13, -13, -13, 5, 20, 7, 9, 18, 3, -13, 6, 8, 10, -13,
13, 15, -13, -13, 8, -13, 22, -13, -13, -13,
{A} -13, 0, -3, -4, 7, -2, -13, 1, 16, 3, -13, 6, 4, 2, 17, 19, 4,
9, -6, 11, 14, -1, 5, -5, 12, -7, 21, -13, 23);
{the following table maps scan codes to ascii values}
scanmap : Array[0..255] Of Char =
( {0} #0, esc, '1', '2', '3', '4', '5', '6', '7', '8',
{10} '9', '0', '-', '=', #8, #9, 'Q', 'W', 'E', 'R',
{20} 'T', 'Y', 'U', 'I', 'O', 'P', '[', ']', #13, spctrl,
{30} 'A', 'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', ';',
{40} '''', '`', splshift, '\', 'Z', 'X', 'C', 'V', 'B', 'N',
{50} 'M', ',', '.', '/', sprshift, #0, spalt, ' ', spcaps, spf1,
{60} spf2, spf3, spf4, spf5, spf6, spf7, spf8, spf9, spf10, spnum,
{70} spscroll, sphome, spuparrow, sppgup, spminus, spleftarrow, sp5,
sprightarrow, spplus, spend,
{80} spdownarrow, sppgdn, spins, spdel, #0, #0, #0, #0, #0, #0,
{90} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{100} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{110} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{120} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{130} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{140} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{150} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{160} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{170} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{180} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{190} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{200} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{210} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{220} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{230} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{240} #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
{250} #0, #0, #0, #0, #0, #0);
Type
bufferp = ^buffertype;
buffertype =
Array[0..bufflength] Of Byte; {holds samples, plus overflow space}
dummyp = ^dummytype;
dummytype = Array[1..128] Of Byte; {overflow area for buffers}
directory_type = Array[1..maxfiles] Of String[12]; {holds directory entries}
songentry = Record {holds one entry of a song file}
note : Real; {do preprocessing to real beofre play time}
duration : Integer;
End;
Type filednote = Record
octave, note, staccato : Byte;
duration : Integer;
End;
notefile = File Of filednote;
Var i, j, k, m, viewleft, viewright,
{3 screen pointers representing left, right,
loop pointers in sound sample}
leftord, rightord, loopord : LongInt;
x1copy, x2copy,
arrowlowy, arrowhighy, {y positions of the 3 pointers}
directoryyoff, {directory listing y position}
dirnamesperline, {no. diectory entries per line}
increment, tune, {pitch parameters}
wavebottom, wavetop, wavescale, {position and size of waveform to be plotted}
graphdriver, graphmode,
lastx, lasty : Integer;
bufstart, bufloop, bufend : Word; {offsets of buffer positions for the
3 pointers}
uparrowp, downarrowp : Pointer; {points to image areas for arrows}
tinterval : Integer; {interval eg. 64=crotchet, 32=quaver}
quickexit : Boolean;
modulus, {counts interrupts for tinterval}
tconstant : Byte; {interrupt rate}
sysspeed, {indicates system speed for duration calcs}
incdef : Integer; {sets default pitch}
songspeed : Real; {determines overall song speed}
default_system, {initial value of system type (AT,XT etc)}
c, cdum : Char;
kbdmap : kbdmaptype; {holds current keyboard map}
trigger, {trigger level required to begin sampling}
samplerate : Integer; {sample rate (kHz)}
dir : directory_type; {holds list of file names in directory}
releasestate, timer,
copying, {indicates copy procedure in progress}
Release, loop, {current state of release & loop}
song : Boolean; {indicates song mode active}
registersrec : registers;
default_daport,
default_kbdmap,
default_sound_file, systemname,
songfilename,
path, str1,
workfile : String;
kbdmode : Boolean; {indicates special kbd processing required}
kbdflag, {indicates key pressed (custom kbd service)}
keyval : Byte; {holds key value " }
daout, {port for d/a converter}
crotchet, {holds tconstant for a crotchet duration}
filesavail : Integer; {number of sound files found in directory}
cnffile : Text; {holds default information}
songend : Integer; {points to end of current song}
songarray : Array[1..maxbeats] Of songentry; {holds current song}
dp, lastdialogentry, dialoghead : dialogentryp;
tuningcp, timercp, lastcp,
cp : clickboxtypep;
goodbye : Boolean;
storagep : Pointer; {general image storage pointer}
cutleft, cutright : LongInt; {left/right points of cut region}
cutactive, {indicates data has been cut to disk}
cutboxactive : Boolean; {indicates cut box currently active}
f : File; {general purpose file pointer}
bufflen : word;
buffer, bufferw : bufferp; {pointer to sound storage buffer,
and work buffer}
dummy : dummyp; {overflow area for bufferw}
fsong : notefile;
anote : filednote;
songp : Integer;
oldtimer, songloop : Boolean;
c1 : Char;
altdown : Boolean; {indicates alt key is currently down}
zoom : Boolean;
customkbd : boolean;
Procedure initial; External; {external assembler routines (samplasm.asm)}
Procedure restore; External;
Procedure sample; External;
Procedure replay; External;
Procedure replayt; External;
Procedure scalewave; External;
procedure echo; external;
procedure replay_sound(timer:boolean);
{calls appropriate replay module depending on whether timer operation is
required}
begin {replay_sound}
if timer then
replayt
else
replay;
end; {replay_sound}
{$i sampler.inc}
Function mymousemoved : Boolean;
{ like mousemoved, but is aware of custom kbd service}
Var moved : Boolean;
Inc : Integer;
Begin {mymousmoved}
moved := False;
If keypress And (scanmap[keyval] In [spuparrow, spdownarrow, spleftarrow,
sprightarrow]) Then {cursor key}
Begin
Inc := 10;
If mem[0:$417] And 2 > 0 Then {if left shift down}
Inc := 1;
Case scanmap[keyval] Of {arrow keys control mouse}
spuparrow : Begin mousey := mousey-Inc; moved := True; End;
spdownarrow : Begin mousey := mousey+Inc; moved := True; End;
spleftarrow : Begin mousex := mousex-Inc; moved := True; End;
sprightarrow : Begin mousex := mousex+Inc; moved := True; End;
End; {case}
If moved Then
Begin
kbdflag := 0;
keyval := keyval+128; {allow autorepeat}
End;
End;
mymousemoved := moved Or mousemoved;
End; {mymousemoved}
Procedure enable_custom_kbd;
{ enables custom kbd handler.
waits if ctrl,alt or caps lock down or active. bios seems to be confused if
first kbd signal is release of a key}
Begin {enable_custom_kbd}
Repeat Until (mem[0:$417] And $4c = 0)
And (mem[0:$418] And $40 = 0);
kbdmode := True;
End; {enable_custom_kbd}
Begin {main}
customkbd:=false;
WriteLn(MaxAvail, ' bytes free');
ExitProc := @samplerexit; {install custom error handler}
heaperrorinit; {install custom heap error handler}
If not mouseinit Then {if no mouse driver found}
Begin
WriteLn;
WriteLn;
WriteLn('No MSmouse driver found.');
WriteLn;
WriteLn('Cursor may be controlled using arrow keys');
WriteLn(' and the following buttons:');
WriteLn;
WriteLn(' Alt = left mouse button');
WriteLn(' Caps Lock = right mouse button');
WriteLn;
WriteLn('Press a key to continue...');
c := readkey;
End;
initialise; {set up graphics mode, defaults etc}
update_display; {fill screen with info}
mousearrowon;
keyval := 127; {clear custom key service info}
kbdmode := False;
initial; {replace kbd service now incase exit via samplerexit}
customkbd:=true;
c := ' '; {no sound immediately for loop}
enable_custom_kbd;
Repeat
If song And
Not(keypress And (scanmap[keyval] = sprshift)) Then
{if song mode and no shifts down}
Begin
kbdflag := 0;
tinterval := Round(songarray[songp].duration/songspeed);
increment := Round(tune*songarray[songp].note);
If songarray[songp].note = -13 Then
increment := 0; {silence for rest}
Release := releasestate;
replay_sound(timer);
Release := True;
Inc(songp);
song := (songp <= songend);
If Not song Then
If songloop Then
Begin
songp := 1;
song := True;
End
Else
Begin
menustructure[4].entry[2].visible := True; {play_song}
tinterval := crotchet;
timer := oldtimer;
End;
End;
If mymousemoved Then {track mouse and keyboard}
Begin
updatemousepos;
If keypress And (scanmap[keyval] In [spuparrow, spdownarrow, spleftarrow,
sprightarrow]) Then {cursor key}
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
End;
If keypress And (scanmap[keyval] In ['''', ','..']']) Then {if note key}
Begin
kbdflag := 0;
c := scanmap[keyval];
If kbdmap[c] > -13 Then {if valid note}
Begin
increment := get_inc(tune, c);
Release := releasestate;
replay_sound(timer); {then play}
Release := True;
End;
End
Else
Begin
If ((mousekeys > 1)
Or (keypress And (scanmap[keyval] In [spctrl, spcaps])))
And (cutboxactive Or song) Then
Begin {if right/middle button or ctrl/caps lock}
If cutboxactive Then
Begin
mousearrowoff;
erase_cutbox;
cutboxactive := False;
mousearrowon;
activate_menu_options(False); {disable cut box options}
If keypress And Not(scanmap[keyval] = sprshift) Then
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
End
Else
If song Then
Begin
song := False;
menustructure[4].entry[1].visible := True; {song}
mousearrowoff;
draw_menu_box(4, 1, False);
mousearrowon;
tinterval := crotchet;
timer := oldtimer;
If keypress And Not(scanmap[keyval] = sprshift) Then
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
End;
Repeat Until mousekeys = 0;
End
Else
If (mousekeys > 0) Or
(keypress And (scanmap[keyval] In [spctrl, spcaps, spalt])) Then
Begin
settextstyle(defaultfont, horizdir, 1);
i := click_selection(tuningcp, cornersize,
getmaxy-textheight(' ')*2);
If i > -1 Then {one of the tuning boxes selected?}
Begin
Case i Of
1 : If tune > 1 Then {octave down}
tune := tune Div 2;
2 : If tune > 1 Then {tune down coarse}
tune := tune-5;
3 : If tune > 1 Then {tune down fine}
Dec(tune);
4 : If tune < $1ae8 Then {tune up fine}
Inc(tune);
5 : If tune < $1ae8 Then {tune up coarse}
tune := tune+5;
6 : If tune < $1ae8 Then {note $1ae9 causes increment > ffff}
tune := tune*2; {up octage}
7 : tune := incdef; {reset tuning}
End; {case}
increment := get_inc(tune, 'E'); {calculate new tuning info}
i := -1; {not menu item}
If keypress And Not(scanmap[keyval] = sprshift) Then
Begin {if key pressed}
Repeat Until keyval > 127;
kbdflag := 0;
End;
Repeat Until mousekeys = 0; {wait for button release}
End
Else
Begin
i := click_selection(timercp,
getmaxx-cornersize-textwidth(' '),
getmaxy-textheight(' ')*2);
If i > -1 Then {one of the timer boxes selected?}
Begin
Case i Of
1 : songspeed := songspeed*0.85;
2 : songspeed := songspeed*0.95;
3 : songspeed := songspeed/0.95;
4 : songspeed := songspeed/0.85;
End; {case}
tinterval := Round(crotchet/songspeed); {timer duration}
i := -1; {not menu item}
If keypress And Not(scanmap[keyval] = sprshift) Then
Begin {if key pressed}
Repeat Until keyval > 127;
kbdflag := 0;
End;
Repeat Until mousekeys = 0; {wait for button release}
End
Else
Begin
i := arrow_selection; {trying to drag an arrow?}
If i > -1 Then
Begin
j := mousex; {remember mouse position}
k := mousey;
altdown := keypress And (scanmap[keyval] = spalt);
If altdown Then
Repeat Until keyval > 127; {wait for alt release}
While (arrow_selection = i) And ((mousekeys = 1) Or altdown) Do
Begin {while button down}
If mymousemoved Then {track mouse/kbd}
Begin
mousey := k; {keep mouse height constant}
updatemousepos; {replot mouse}
mousearrowoff;
Case i Of
1 : move_pointers(mousex-j, 0, 0); {left arrow}
2 : move_pointers(0, mousex-j, 0); {right arrow}
3 : move_pointers(0, 0, mousex-j); {loop arrow}
End; {case}
mousearrowon;
j := mousex; {remember last mouse pos}
If keypress And
(scanmap[keyval] In [spuparrow, spdownarrow,
spleftarrow, sprightarrow])
Then {cursor key}
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
End;
altdown := altdown And {wait for second alt}
Not(keypress And (scanmap[keyval] = spalt));
End;
altdown := False;
If keypress And Not(scanmap[keyval] = sprshift) Then
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
set_bounds; {recalculate buffer params}
i := -1; {not menu item}
End
Else {inside wave box?}
If (mousey > wavetop) And (mousey < wavebottom)
And (mousex >= plotxoffset) And
(mousex <= getmaxx-plotxoffset) And
Not cutboxactive Then
Begin
If (mousekeys = 1)
Or (keypress And (scanmap[keyval] = spalt)) Then
Begin
mousearrowoff;
erase_cutbox;
mousearrowon;
activate_menu_options(True);
{enable options requiring cut box}
cutboxactive := True;
cutleft := index(mousex);
lastx := mousex; {remember mouse x position}
altdown := keypress And (scanmap[keyval] = spalt);
If altdown Then
Repeat Until keyval > 127; {wait for alt release}
For j := wavetop-1 To wavebottom+1 Do {mark left box edge}
putpixel(mousex, j, getmaxcolor-getpixel(mousex, j));
Repeat
If mymousemoved Then {track mouse/kbd}
Begin
mousearrowoff;
If mousex < plotxoffset Then
{limit mouse range to wavebox}
mousex := plotxoffset;
If mousex > getmaxx-plotxoffset Then
mousex := getmaxx-plotxoffset;
If mousex > lastx Then
{moved to right, extend box edges}
For i := lastx+1 To mousex Do
Begin
If (getmaxcolor > 1) Or Odd(i) Then
Begin
putpixel(i, wavetop-1,
getmaxcolor-getpixel(i, wavetop-1));
putpixel(i, wavebottom+1,
getmaxcolor-getpixel(i, wavebottom+1));
End;
End
Else
If mousex < lastx Then
For i := lastx Downto mousex+1 Do
If (getmaxcolor > 1) Or Odd(i) Then
Begin {moved to left, extend box edges}
putpixel(i, wavetop-1,
getmaxcolor-getpixel(i, wavetop-1));
putpixel(i, wavebottom+1,
getmaxcolor-getpixel(i, wavebottom+1));
End;
mousearrowon;
updatemousepos;
lastx := mousex;
If keypress And
(scanmap[keyval] In [spuparrow, spdownarrow,
spleftarrow, sprightarrow]) Then
Begin {cursor key}
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
End;
altdown := altdown And
Not(keypress And (scanmap[keyval] = spalt));
Until (mousekeys = 0) And Not altdown;
{continue until button released}
If keypress And Not(scanmap[keyval] = sprshift)
Then
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
cutright := index(mousex);
If cutleft <> cutright Then
For j := wavetop-1 To wavebottom+1 Do {draw far side}
putpixel(mousex, j, getmaxcolor-getpixel(mousex, j));
If cutright < cutleft Then {make sure cutleft<=cutright}
Begin
i := cutleft;
cutleft := cutright;
cutright := i;
End;
i := -1; {not a menu item}
End
Else
If zoom Then
Begin {zoom mode means manual drawing}
mousearrowoff;
erase_cutbox;
lastx := mousex;
lasty := wavebottom-buffer^[index(mousex)] Div wavescale;
buffer^[index(mousex)] := (wavebottom-mousey)*wavescale;
setcolor(drawcolor);
line(lastx, lasty, lastx, mousey);
mousearrowon;
lasty := mousey;
altdown := keypress And (scanmap[keyval] = spcaps);
If altdown Then
Repeat Until keyval > 127; {wait for caps release}
Repeat
If mymousemoved Then {track mouse/kbd}
Begin
mousearrowoff;
If mousex < plotxoffset Then
{limit mouse range to wavebox}
mousex := plotxoffset;
If mousex > getmaxx-plotxoffset Then
mousex := getmaxx-plotxoffset;
If mousey < wavetop Then
mousey := wavetop;
If mousey > wavebottom Then
mousey := wavebottom;
line(lastx, lasty, mousex, mousey);
m := index(mousex)-index(lastx); {delta x}
For i := index(lastx)+1 To index(mousex) Do
{plot line in buffer}
buffer^[i] := Round((wavebottom-
((i-index(lastx))*
(mousey-lasty) Div m+lasty))*
wavescale);
For i := index(lastx)-1 Downto index(mousex) Do
buffer^[i] := Round((wavebottom-
((i-index(lastx))*
(mousey-lasty) Div m+lasty))*
wavescale);
lastx := mousex;
lasty := mousey;
mousearrowon;
updatemousepos;
If keypress
And (scanmap[keyval]
In [spuparrow, spdownarrow,
spleftarrow, sprightarrow])
Then {cursor key}
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
End;
altdown := altdown And {wait for second alt}
Not(keypress And (scanmap[keyval] = spcaps));
Until (mousekeys = 0) And Not altdown;
{continue until button released}
If keypress And Not(scanmap[keyval] = sprshift)
Then
Begin
Repeat Until keyval > 127; {wait for keyrelease}
kbdflag := 0;
End;
mousearrowoff;
draw_wave;
mousearrowon;
i := -1; {not a menu item}
End;
End
Else
Begin {might have been a menu heading}
j := -1; {default no submenu chosen}
i := menu_selection(horizdir, 0);
If i > -1 Then
Begin {was menu heading}
If menustructure[i].nentries = 1 Then
Begin
j := 1; {if no subtopics then remember it
was menu heading}
mousearrowoff;
draw_menu_box(i, j, True); {highlight submenu selection}
mousearrowon;
End
Else
Begin {wait for subtopic to be chosen}
kbdmode := False;
mousearrowoff;
draw_menu_box(i, 1, True); {highlight heading}
draw_menu_column(i); {show submenu for that column}
mousearrowon;
Repeat Until mousekeys = 0;
Repeat
Repeat
c := trackmouse;
Until (mousekeys > 0) Or (c = ^c);
If mousekeys = 1 Then {if left button}
j := menu_selection(vertdir, i)
{calculate which column was selected}
Else
j := -1; {other buttons cancel}
Until (mousekeys > 1) Or (j > -1);
{wait for valid select or cancel}
mousearrowoff;
If mousekeys > 1 Then
remove_menu_column(i); {if cancel, erase submenu}
If j > -1 Then
draw_menu_box(i, j, True);
{highlight submenu selection}
Repeat Until mousekeys = 0;
mousearrowon;
enable_custom_kbd;
End;
If j > -1 Then {if a valid menu item was selected}
Begin
kbdmode := False;
Case menustructure[i].entry[j].selection Of
concert_a :
Begin
sound(440); {concert A}
Repeat Until mousekeys > 1;
nosound;
mousearrowoff;
remove_menu_column(i);
draw_cutbox;
mousearrowon;
End;
monitor:
Begin
k := tconstant;
tconstant := Round(1.19318e3/17);
kbdflag := 0;
enable_custom_kbd;
echo; {echo a/d to d/a}
kbdmode := False;
tconstant := k;
mousearrowoff;
remove_menu_column(i);
draw_cutbox;
mousearrowon;
End;
_zoom :
Begin
mousearrowoff;
zoom := Not(zoom);
If zoom Then
Begin
viewleft := cutleft;
viewright := cutleft+getmaxx-plotxoffset*2;
End
Else
Begin
viewleft := 0;
viewright := bufflength;
End;
cutboxactive := cutboxactive And Not zoom;
remove_menu_column(i);
draw_wave;
draw_cutbox;
activate_menu_options(cutboxactive);
mousearrowon;
End;
read_song_file :
Begin
song := False;
loadsong;
menustructure[4].entry[2].visible := True;
{play_song}
mousearrowoff;
remove_menu_column(i);
mousearrowon;
End;
play_song :
Begin
song := False;
If songfilename <> '' Then
Begin
song := True;
oldtimer := timer;
timer := True;
songp := 1;
New(dp);
With dp^ Do
Begin
title := 'Looped play?';
argtype := _boolean;
booleanresult := False;
next := Nil;
End;
settextstyle(defaultfont, horizdir, 1);
dialog_box(dp, dialogbcolor, dialogcolor, False);
songloop := dp^.booleanresult;
Dispose(dp);
menustructure[4].entry[2].visible := False;
{play_song}
mousearrowoff;
remove_menu_column(i);
mousearrowon;
End;
End;
cut, _copy :
Begin
write_data(clipboardfilename, cutleft, cutright);
cutactive := True;
mousearrowoff;
remove_menu_column(i);
erase_cutbox;
If menustructure[i].entry[j].selection = cut Then
Begin
cut_region(cutleft, cutright);
draw_wave;
End;
cutboxactive := False;
activate_menu_options(False);
{disable cut box options}
mousearrowon;
End;
paste, mix :
Begin
load_sound_file(clipboardfilename, cutleft,
cutright,
(menustructure[i].entry[j].
selection = mix));
mousearrowoff;
remove_menu_column(i);
draw_wave;
draw_cutbox;
mousearrowon;
End;
mirror_segment :
Begin
mousearrowoff;
mirror_data;
remove_menu_column(i);
draw_wave;
draw_cutbox;
mousearrowon;
End;
clear :
Begin
mousearrowoff;
cut_region(cutleft, cutright);
remove_menu_column(i);
draw_wave;
draw_cutbox;
mousearrowon;
End;
_scale_envelope :
Begin
scale_envelope;
mousearrowoff;
remove_menu_column(i);
draw_wave;
draw_cutbox;
mousearrowon;
End;
_help :
Begin
dialoghead := Nil;
New(dp);
dp^.title :=
' Help for '+titlestring;
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'Select option from menu at top of screen using left mouse button or Alt key.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'Generally, the left mouse button or Alt key select objects, while the right button';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'or Ctrl key cancel operations.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'Boxes at lower left on screen alter tuning and octave. Reset restores default pitch.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'Boxes at lower right on screen alter timer period.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'Wave box pointers can be moved by clicking and dragging.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
settextstyle(smallfont, horizdir, 4);
dialog_box(dialoghead, dialogbcolor, dialogcolor, True);
dispose_dialog(dialoghead);
New(dp);
dp^.title :=
'Edit options remain invisible until a region is marked in the waveform box. Paste and mix';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'must be preceded by a Cut or Copy operation and a destination region must have been';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'marked in the waveform box.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'The Quit option is available under the File Heading.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
dialoghead := Nil;
New(dp);
dp^.title :=
'All configurable options are available from the settings box under the options heading.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'The Zoom option under the edit heading allows fine detail to be edited after a region has';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'been marked. When zoom is active, the right mouse button allows direct editing of the';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'waveform by drawing.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'When a song is in progress, the right shift key temporarily restores mouse movement to';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'allow alterations such as pitch and time. A song can be ended by pressing Ctrl.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
New(dp);
dp^.title :=
'Manual mouse control is available from arrow keys, and left shift allows fine control.';
dp^.argtype := _none;
add_dialogentry(dp, lastdialogentry, dialoghead);
settextstyle(smallfont, horizdir, 4);
dialog_box(dialoghead, dialogbcolor, dialogcolor, True);
dispose_dialog(dialoghead);
mousearrowoff;
remove_menu_column(i);
draw_cutbox;
mousearrowon;
End;
play_sound :
Begin {play sound immediately}
If default_kbdmap = 'guitar' Then
increment := get_inc(tune, 'E')
{default playback pitch}
Else
increment := get_inc(tune, 'B');
kbdflag := 0;
Release := False;
enable_custom_kbd;
replay_sound(timer);
kbdmode := False;
Release := True;
reset_mouse; {key release might have been
missed with com port disabled}
mousearrowoff;
draw_menu_box(i, j, False);
{restore submenu selection}
mousearrowon;
End;
settings :
Begin
display_status;
mousearrowoff;
update_settings;
remove_menu_column(i);
draw_cutbox;
mousearrowon;
End;
{$ifdef sample}
_sample :
Begin
mousearrowoff;
k := tconstant;
tconstant := Round(1.19318e3/samplerate);
{$ifdef pwm}
bufstart := Ofs(bufferw^);
bufloop := bufstart;
bufend := Ofs(bufferw^[bufflength]);
{$else}
bufstart := Ofs(buffer^);
bufloop := bufstart;
bufend := Ofs(buffer^[bufflength]);
{$endif}
tune := incdef;
leftord := 0;
loopord := leftord;
rightord := bufflength;
j := Port[daout]; {kill value from last time}
If trigger > 0 Then
display_message('Waiting for trigger...',
hotbcolor, hotcolor, storagep,
True)
Else
display_message('Sampling...',
hotbcolor, hotcolor, storagep,
True);
Release := False;
sample;
Release := True;
If trigger > 0 Then
display_message('Waiting for trigger...',
hotbcolor, hotcolor, storagep,
False)
Else
display_message('Sampling...',
hotbcolor, hotcolor, storagep,
False);
set_bounds;
remove_menu_column(i);
draw_wave;
If default_kbdmap = 'guitar' Then
increment := get_inc(tune, 'E')
{default playback pitch}
Else
increment := get_inc(tune, 'B');
tconstant := k;
enable_custom_kbd;
Release := False;
replay_sound(timer);
Release := True;
kbdmode := False;
cutboxactive := False;
activate_menu_options(False);
{disable cut box options}
mousearrowon;
reset_mouse;
End;
{$endif}
read_sound_file :
Begin
pickfile('SND', str1);
mousearrowoff;
If str1 <> '' Then
Begin
settextstyle(defaultfont, horizdir, 1);
display_message('Reading file, please wait...',
dialogbcolor, dialogcolor,
storagep, True);
mousearrowon;
If cutboxactive Then
load_sound_file(str1, cutleft, cutright, False)
Else
load_sound_file(str1, index(plotxoffset),
index(getmaxx-plotxoffset),
False);
mousearrowoff;
display_message('Reading file, please wait...',
dialogbcolor, dialogcolor,
storagep, False);
End;
update_display;
cutboxactive := False;
activate_menu_options(False);
{disable cut box options}
mousearrowon;
settextstyle(smallfont, horizdir, 4);
End;
directory :
Begin
mousearrowoff;
showdirectory('*');
c := continue_prompt(-cornersize, -1,
dialogbcolor, dialogcolor);
update_display;
draw_cutbox;
mousearrowon;
End;
write_sound_file :
Begin
New(dp);
With dp^ Do
Begin
title := 'Name of output file (.snd):';
argtype := _string;
ssize := 30;
stringresult := '';
next := Nil;
End;
settextstyle(defaultfont, horizdir, 1);
dialog_box(dp, dialogbcolor, dialogcolor, False);
If (dp^.stringresult <> '') Then
write_data(dp^.stringresult, leftord, rightord);
mousearrowoff;
remove_menu_column(i);
mousearrowon;
Dispose(dp);
End;
quit_to_dos :
Begin
New(dp);
With dp^ Do
Begin
title := 'Are you sure you want to quit?';
argtype := _boolean;
booleanresult := True;
next := Nil;
End;
settextstyle(defaultfont, horizdir, 1);
dialog_box(dp, dialogbcolor, dialogcolor, False);
goodbye := dp^.booleanresult;
Dispose(dp);
mousearrowoff;
remove_menu_column(i);
mousearrowon;
End;
Else
Begin
closegraph;
WriteLn('Invalid menu option selected');
Halt;
End;
End; {case}
While keypressed Do c := readkey;
enable_custom_kbd;
kbdflag := 0;
keyval := 127;
Repeat Until mousekeys = 0;
{wait for button release if relevant}
End;
End;
End;
End;
End;
End;
If keypress And (scanmap[keyval] In [sprshift]) Then
If mem[0:$417] And 1 = 0 Then {incase shift release lost while}
kbdflag := 0; {kbdmode was off, forget shift}
End;
Until goodbye;
closegraph;
gotoxy(1, 23);
Assign(f, clipboardfilename);
{$i-} Reset(f); {$i+}
If IoResult = 0 Then
Begin
Close(f);
Erase(f) {erase clipboard file if it exists}
End;
Write('Exiting...');
showerrormessage := False;
restore;
mem[0:$417] := mem[0:$417] And $fc; {shift off}
End.