home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
microcrn
/
issue_36.arc
/
MOUSE.FIG
< prev
next >
Wrap
Text File
|
1987-05-21
|
14KB
|
375 lines
program LabMouse;
{
Note: due to the use of the reserved word "window" in the Turbo
Graphix Toolbox files "typedef.sys" and "kernel.sys", you'll have
to do a little work on these files before trying to run this, or
you will get an assignment compiler error. It appears that our
friends at Borland pulled a good one and declared a "Window"
variable in the Toolbox routines.
Unfortunately there's already a "Window" procedure in standard
Turbo Pascal. For this reason, it really should be a reserved
word. The fix is to do a search/replace (^QA) in the Turbo editor
for the string "window:" and the string "window :" in the
typedef.sys file. Replace them with "WindowArray:" (leave out the
quotes but keep the colon in there). Type GNU at the options
prompt to be certain of changing all occurrences.
Then, do a search/replace for the string "window[" in the
kernel.sys file. Replace it with the string "WindowArray["
(again, leave out the quotes but keep the [ sign). Use the GNU
option to change them all.
This isn't a problem if you don't use the "Window" procedure in
programs that use the Toolbox, but this code uses both the
Toolbox and the built-in "Window" procedure. }
const
NumLines = 7; {CGA scan lines numbered 7 at bottom to 0 at top}
{Next line for Hercules Video}
(*
NumLines = 13; {Herc scan lines numbered 13 at bottom to 0 at top}
*)
type
Table = array[1..64] of Integer; {array to store electrode voltages (mV)}
CursorMasks = array[0..31] of integer; {mouse graphics cursor masks}
RegPack = record
AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
end;
var
Regs : RegPack;
CellNum,
Enable,
Count : integer;
InputTable : table;
Selection : char;
OK : boolean;
{$I typedef.sys} {type definitions from Graphix Toolbox}
{$I graphix.sys} {graphics routines from Graphix Toolbox}
{$I kernel.sys} {graphics kernel from Graphix Toolbox}
{$I mouse.sys} {mouse routines}
procedure CramBuffer (AX, BX, CX, DX: Integer);
{Allows left mouse button to act like a keyboard return by using
mouse interrupt capability. Register contents AX-DX are not used
by the routine because there is only one condition which causes an
interrupt. (left button released)}
type
pointer = ^byte;
var
BuffPtr : integer absolute $0:$41C; {determines head pointer in queue}
BufferPointer : pointer; {head pointer in queue}
begin
BufferPointer := Ptr(0,(BuffPtr+$400)); {pointer to current queue position}
BufferPointer^ := $0D; {cram carraige return into queue }
BufferPointer := Ptr(0,(BuffPtr+$401)); {pointer to next queue position }
BufferPointer^ := $1C; {cram linefeed into queue }
if BuffPtr = $3C then {reset position pointer so that }
BuffPtr := $1E {BIOS will read carraige return }
else {and linefeed. }
BuffPtr := BuffPtr + 2; {increment queue head pointer }
end;
procedure Beep; {allows your choice of duration and frequency}
begin
Sound(440); {frequency}
Delay(500); {duration}
NoSound;
end;
procedure ShowInputTable(InputTable: Table); {updates screen with values (mV)}
var
X,Y: integer;
begin
for Count := 1 to 64 do begin {64 voltages to update}
NormVideo;
X :=((Count-1) mod 8)*8+21; {screen X coordinates}
Y :=((Count-1) div 8)*3+2; {screen Y coordinates}
Window(X,Y,X+3,Y+2); {use window to restrict write}
ClrScr; {clear window}
GotoXY(2,1); {position cursor in window}
write(Count); {write heading}
LowVideo; {low video for voltage display}
GotoXY(1,2); {position cursor in window}
write(InputTable[Count]); {write voltage (mV)}
end;
Window(1,1,80,25); {reset window to full screen}
end;
procedure SetScreen; {sets up screen}
type
SmallStr = string[17];
procedure WriteBlk(X,Y :integer; Heading :SmallStr); {writes headings}
begin
GotoXY(X,Y);
Window(X,Y,X+18,Y+2); {use window to restrict write}
ClrScr; {clear window}
GotoXY(2,2);
Write(Heading);
end;
begin {procedure SetScreen}
TextCursor(NumLines,1); {no cursor}
TextBackground(0); {underline bright video}
TextColor(9);
GotoXY(22,1);
write('LIQUID CRYSTAL LENS CONTROL PROGRAM type ''q''or ''Q'' to Quit');
TextBackground(7); {reverse video}
TextColor(0);
WriteBlk(1,10,' E: EDIT TABLE');
WriteBlk(1,18,' G: GRAPHICS');
TextBackground(0); {normal video}
TextColor(7);
Window(1,1,80,25); {reset window to full screen}
ShowInputTable(InputTable); {update screen}
end;
procedure GetInput(CellNum : Integer; var InputTable : Table);
{gets user entry for an output (1 to 64) }
var
Voltage : Integer;
begin
LowVideo;
ClrScr;
TextCursor(NumLines-1, NumLines); {underline cursor}
repeat
{$I-} readln (Voltage); {$I+}
OK := (IOresult = 0);
GotoXY(1,1); {calling routine has defined window}
ClrScr; {clear window}
if (NOT OK) or (Voltage > 5000) or (Voltage < 0) then
Beep;
until OK and ((Voltage <= 5000) and (Voltage >= 0));
write(Voltage);
InputTable[CellNum] := Voltage; {update tables}
Window(1,1,80,25); {reset window}
NormVideo;
TextCursor(2,NumLines-2);
end;
procedure Display( GraphMin, GraphMax : integer; var InputTable : table);
{Scales and generates graphical display of data}
var
Step,
LabelPos,
RightSide : integer;
Text : string[4];
begin
Step := Round((GraphMax-GraphMin)/10); {step scaling for graph}
DefineWindow(1,0,0,XMaxGlb,YMaxGlb); {define graphics window}
DefineWorld(1,0,70,5000,0);
SelectWorld(1);
SelectWindow(1);
SetClippingOn;
SetLineStyle(0);
(*
{code commented out for CGA use}
for Count := 1 to 64 do begin {display mV on left side}
str(InputTable[Count],Text);
DrawTextW(0,Count,1,Text);
end;
*)
DefineWindow(2,3,0,XMaxGlb,YMaxGlb);
DefineWorld(2,GraphMin,70,GraphMax,0);
SelectWorld(2);
SelectWindow(2);
(*
{code commented out for CGA use}
for Count := 1 to 64 do begin
if InputTable[Count] > GraphMax then {do clipping check--Turbo}
RightSide := GraphMax {clipping is unreliable here}
else RightSide := InputTable[Count];
DrawLine(GraphMin,Count,RightSide,Count); {line to represents voltage}
end;
*)
LabelPos := GraphMin;
for Count := 1 to 10 do begin {draw scale at bottom}
str(LabelPos,Text);
DrawTextW(LabelPos,67,2,Text);
DrawLine(LabelPos,66,LabelPos,65);
LabelPos := LabelPos + Step;
end;
LabelPos := LabelPos + Step;
DrawLine(GraphMax,66,GraphMax,65);
end;
procedure GraphMode(var InputTable : table);
{allows graphical display and entry of date with mouse}
var
Range,
M3,M4,
Voltage,
GraphMin,
GraphMax,
ButtonPush,
RightLine :integer;
VideoMode :integer absolute $40:$49; {DOS stores current video mode}
Cursor :CursorMasks;
Text :string[4];
const
Scale = 3;
(*
{Next line for Hercules Video}
Scale = 5;
*)
HotX = 8;
HotY = 8;
HgcPageZero = 6; {Hercules graphics mode}
begin
NormVideo;
TextCursor(Numlines-1, NumLines);
GraphMin := 0; {default values for graph}
GraphMax := 5000; {dimensions }
repeat
GotoXY(1,25);
write('Enter Display Minimum: ');
ClrEol;
{$I-} read (GraphMin); {$I+}
OK := (IOresult = 0);
if NOT OK then Beep;
until OK and ((GraphMin <= 5000) and (GraphMin >= 0));
repeat
GotoXY(35,25);
write('Enter Display Maximum: ');
ClrEol;
{$I-} read (GraphMax); {$I+}
OK := (IOresult = 0);
if NOT OK then Beep;
until OK and ((GraphMax <= 5000) and (GraphMax > GraphMin));
initgraphic; {Toolbox initialization}
SetBreakOff; {no breaks during Graphics}
(*
{Next line for Hercules Video}
VideoMode := HgcPageZero;
*)
Display(GraphMin, GraphMax, InputTable);
MouseReset(Enable); {Initialize Mouse Driver}
for Count:= 0 to 3 do {make a nice box for a cursor with masks}
cursor[Count]:= $FFFF; {first 16 locations for screen mask}
cursor[4]:= $F00F;
for Count:= 5 to 10 do
cursor[Count]:= $F7EF;
cursor[11]:= $F00F;
for Count:= 12 to 15 do
cursor[Count]:= $FFFF;
for Count:= 16 to 18 do {last 16 locations for cursor mask}
cursor[Count]:= $0000;
for Count:= 19 to 20 do
cursor[Count]:= $1FF8;
for Count:= 21 to 26 do
cursor[Count]:= $1818;
for Count:= 27 to 28 do
cursor[Count]:= $1FF8;
for Count:= 29 to 31 do
cursor[Count]:= $0000;
MakeGraphCursor(Cursor, HotX, HotY);
SetXLimits(24,XScreenMaxGlb); {Set Min and Max Horizontal Position}
SetYLimits(0,YMaxGlb-30); {Set Min and Max Vertical Position}
CursorOn; { Turn on Mouse cursor }
DefineWindow(1,0,0,XMaxGlb,YMaxGlb);
DefineWorld(1,0,70,5000,0); {screen scaled for new coordinates}
SelectWorld(1);
SelectWindow(1);
SetLineStyle(0); {solid lines}
Range := GraphMax-GraphMin;
repeat
GetPosition(ButtonPush,M3,M4); {returns mouse button pushed}
if ButtonPush = 1 then begin; {paint lines if first button}
RightLine := (Trunc((M4-1)/Scale))*Scale+4;
Voltage := GraphMin + round(((M3-24)/(XScreenMaxGlb-24))*Range);
{scale cursor position to voltage}
CellNum := Trunc((RightLine-4)/Scale+1); {determine electrode}
InputTable[CellNum] := Voltage; {update tables}
(*
{code commented out for CGA use}
str(InputTable[CellNum],Text); {update text}
*)
CursorOff; {must draw with cursor off}
SetColorBlack; {to write over old line }
(*
{code commented out for CGA use}
DrawTextW(0,CellNum,2,Chr(27)+'4'+Chr(27)+'4'+Chr(27)+'4'+Chr(27)+'4');
{wipe out old text on left side of screen}
*)
DrawStraight(24,XScreenMaxGlb,RightLine); {wipe out old line}
SetColorWhite; {to draw new line}
(*
{code commented out for CGA use}
DrawTextW(0,CellNum,1,Text); {update new text}
*)
DrawStraight(24,M3,RightLine); {draw new line}
CursorOn; {turn cursor on}
end;
until ButtonPush = 2; {exit graphic if 2nd button}
leavegraphic;
end;
procedure EditTable;
{allows mouse editing of table of 64 electrode voltages}
var
M2,M3,M4 :integer;
XCoord,YCoord,
CellX, CellY :byte;
begin
IntSet($0004,Ofs(CramBuffer)); {sets interrupt for left button push}
TextCursor(2,NumLines-2);
repeat
SetXLimits(136,632); {Set Min and Max Horizontal Position}
SetYLimits(8,192); {Set Min and Max Vertical Position}
GetPosition(M2,M3,M4); {get mouse status}
CellX := Trunc((M3/8-18)/8); {get coordinates of electrode}
CellY := Trunc((M4/8-1)/3);
XCoord := CellX * 8 + 21;
YCoord := CellY * 3 + 2;
GotoXY(XCoord, YCoord); {move cursor to proper position}
if KeyPressed then begin {get new value if keypressed}
CellNum := (CellX + 8 * CellY) + 1;
Window(XCoord, YCoord+1, XCoord+3, YCoord+2);
GetInput(CellNum, InputTable);
end;
until (M2 = 2); {exit this mode for right button push}
MouseReset(Enable); {Reinitialize Mouse Driver}
TextCursor(NumLines,1);
end;
begin {main body of program LabMouse}
MouseReset(Enable); {Initialize Mouse Driver}
if (Enable = 0) then begin
writeln('Please install mouse driver'); {exit program if no driver}
exit;
end;
ClrScr;
FillChar(InputTable,SizeOf(InputTable),0);
SetScreen;
NormVideo;
repeat
repeat
read(kbd,selection);
if NOT (selection IN ['E','e','G','g','Q','q'])
then Beep;
until (selection IN ['E','e','G','g','Q','q']);
case selection of
'E','e': EditTable; {two modes of input available here}
'G','g': begin
GraphMode(InputTable);
SetScreen;
NormVideo;
end;
end;
until (selection='q') or (selection='Q'); {to quit}
TextCursor(NumLines-1, NumLines); {restore cursor}
ClrScr;
end.