home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / microcrn / issue_36.arc / MOUSE.FIG < prev    next >
Encoding:
Text File  |  1987-05-21  |  13.6 KB  |  375 lines
  1.  
  2. program LabMouse;
  3. {
  4. Note: due to the use of the reserved word "window" in the Turbo
  5. Graphix Toolbox files "typedef.sys" and "kernel.sys", you'll have
  6. to do a little work on these files before trying to run this, or
  7. you will get an assignment compiler error. It appears that our
  8. friends at Borland pulled a good one and declared a "Window"
  9. variable in the Toolbox routines.
  10.  
  11. Unfortunately there's already a "Window" procedure in standard
  12. Turbo Pascal. For this reason, it really should be a reserved
  13. word. The fix is to do a search/replace (^QA) in the Turbo editor
  14. for the string "window:" and the string "window :" in the
  15. typedef.sys file. Replace them with "WindowArray:" (leave out the
  16. quotes but keep the colon in there). Type GNU at the options
  17. prompt to be certain of changing all occurrences.
  18.  
  19. Then, do a search/replace for the string "window[" in the
  20. kernel.sys file. Replace it with the string "WindowArray["
  21. (again, leave out the quotes but keep the [ sign). Use the GNU
  22. option to change them all.
  23.  
  24. This isn't a problem if you don't use the "Window" procedure in
  25. programs that use the Toolbox, but this code uses both the
  26. Toolbox and the built-in "Window" procedure. }
  27.  
  28. const
  29.    NumLines = 7;        {CGA scan lines numbered 7 at bottom to 0 at top}
  30.    {Next line for Hercules Video}
  31.    (*
  32.    NumLines = 13;       {Herc scan lines numbered 13 at bottom to 0 at top}
  33.    *)
  34. type
  35.    Table = array[1..64] of Integer;  {array to store electrode voltages (mV)}
  36.    CursorMasks = array[0..31] of integer;  {mouse graphics cursor masks}
  37.  
  38.    RegPack  = record
  39.                  AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  40.               end;
  41. var
  42.    Regs                       : RegPack;
  43.    CellNum,
  44.    Enable,
  45.    Count                      : integer;
  46.    InputTable                 : table;
  47.    Selection                  : char;
  48.    OK                         : boolean;
  49.  
  50. {$I typedef.sys}       {type definitions from Graphix Toolbox}
  51. {$I graphix.sys}       {graphics routines from Graphix Toolbox}
  52. {$I kernel.sys}        {graphics kernel from Graphix Toolbox}
  53. {$I mouse.sys}         {mouse routines}
  54.  
  55.  
  56. procedure CramBuffer  (AX, BX, CX, DX: Integer);
  57. {Allows left mouse button to act like a keyboard return by using
  58.  mouse interrupt capability.  Register contents AX-DX are not used
  59.  by the routine because there is only one condition which causes an
  60.  interrupt. (left button released)}
  61.  
  62. type
  63.    pointer = ^byte;
  64. var
  65.    BuffPtr :   integer absolute $0:$41C;  {determines head pointer in queue}
  66.    BufferPointer : pointer;               {head pointer in queue}
  67. begin
  68.    BufferPointer := Ptr(0,(BuffPtr+$400));  {pointer to current queue position}
  69.    BufferPointer^ := $0D;                   {cram carraige return into queue  }
  70.    BufferPointer := Ptr(0,(BuffPtr+$401));  {pointer to next queue position   }
  71.    BufferPointer^ := $1C;                   {cram linefeed into queue         }
  72.    if BuffPtr = $3C then                    {reset position pointer so that   }
  73.       BuffPtr := $1E                        {BIOS will read carraige return   }
  74. else                                        {and linefeed.                    }
  75.       BuffPtr := BuffPtr + 2;               {increment queue head pointer     }
  76. end;
  77.  
  78. procedure Beep;     {allows your choice of duration and frequency}
  79. begin
  80.    Sound(440);      {frequency}
  81.    Delay(500);      {duration}
  82.    NoSound;
  83. end;
  84.  
  85. procedure ShowInputTable(InputTable: Table); {updates screen with values (mV)}
  86. var
  87.    X,Y:        integer;
  88.  
  89. begin
  90.    for Count := 1 to 64 do begin             {64 voltages to update}
  91.       NormVideo;
  92.       X :=((Count-1) mod 8)*8+21;            {screen X coordinates}
  93.       Y :=((Count-1) div 8)*3+2;             {screen Y coordinates}
  94.       Window(X,Y,X+3,Y+2);                   {use window to restrict write}
  95.       ClrScr;                                {clear window}
  96.       GotoXY(2,1);                           {position cursor in window}
  97.       write(Count);                          {write heading}
  98.       LowVideo;                              {low video for voltage display}
  99.       GotoXY(1,2);                           {position cursor in window}
  100.       write(InputTable[Count]);              {write voltage (mV)}
  101.    end;
  102. Window(1,1,80,25);                           {reset window to full screen}
  103. end;
  104.  
  105. procedure SetScreen;                         {sets up screen}
  106. type
  107.      SmallStr = string[17];
  108.  
  109. procedure WriteBlk(X,Y :integer; Heading :SmallStr);   {writes headings}
  110. begin
  111.    GotoXY(X,Y);
  112.    Window(X,Y,X+18,Y+2);                     {use window to restrict write}
  113.    ClrScr;                                   {clear window}
  114.    GotoXY(2,2);
  115.    Write(Heading);
  116. end;
  117.  
  118. begin {procedure SetScreen}
  119.    TextCursor(NumLines,1);                   {no cursor}
  120.    TextBackground(0);                        {underline bright video}
  121.    TextColor(9);
  122.    GotoXY(22,1);
  123.    write('LIQUID CRYSTAL LENS CONTROL PROGRAM  type ''q''or ''Q'' to Quit');
  124.    TextBackground(7);                        {reverse video}
  125.    TextColor(0);
  126.    WriteBlk(1,10,' E: EDIT TABLE');
  127.    WriteBlk(1,18,'  G: GRAPHICS');
  128.    TextBackground(0);                        {normal video}
  129.    TextColor(7);
  130.    Window(1,1,80,25);                        {reset window to full screen}
  131.    ShowInputTable(InputTable);               {update screen}
  132. end;
  133.  
  134. procedure GetInput(CellNum : Integer; var InputTable : Table);
  135.                            {gets user entry for an output (1 to 64) }
  136. var
  137.    Voltage     : Integer;
  138. begin
  139.    LowVideo;
  140.    ClrScr;
  141.    TextCursor(NumLines-1, NumLines);            {underline cursor}
  142.    repeat
  143.       {$I-} readln (Voltage); {$I+}
  144.       OK := (IOresult = 0);
  145.       GotoXY(1,1);                    {calling routine has defined window}
  146.       ClrScr;                         {clear window}
  147.       if (NOT OK) or (Voltage > 5000) or (Voltage < 0) then
  148.          Beep;
  149.    until OK and ((Voltage <= 5000) and (Voltage >= 0));
  150.    write(Voltage);
  151.    InputTable[CellNum] := Voltage;    {update tables}
  152.    Window(1,1,80,25);                 {reset window}
  153.    NormVideo;
  154.    TextCursor(2,NumLines-2);
  155. end;
  156.  
  157. procedure Display( GraphMin, GraphMax : integer; var InputTable : table);
  158.                      {Scales and generates graphical display of data}
  159. var
  160.    Step,
  161.    LabelPos,
  162.    RightSide                           : integer;
  163.    Text                                : string[4];
  164.  
  165.  
  166. begin
  167.    Step := Round((GraphMax-GraphMin)/10);     {step scaling for graph}
  168.    DefineWindow(1,0,0,XMaxGlb,YMaxGlb);       {define graphics window}
  169.    DefineWorld(1,0,70,5000,0);
  170.    SelectWorld(1);
  171.    SelectWindow(1);
  172.    SetClippingOn;
  173.    SetLineStyle(0);
  174.    (*
  175.    {code commented out for CGA use}
  176.    for Count := 1 to 64 do begin              {display mV on left side}
  177.        str(InputTable[Count],Text);
  178.        DrawTextW(0,Count,1,Text);
  179.    end;
  180.    *)
  181.    DefineWindow(2,3,0,XMaxGlb,YMaxGlb);
  182.    DefineWorld(2,GraphMin,70,GraphMax,0);
  183.    SelectWorld(2);
  184.    SelectWindow(2);
  185.    (*
  186.    {code commented out for CGA use}
  187.    for Count := 1 to 64 do begin
  188.        if InputTable[Count] > GraphMax then     {do clipping check--Turbo}
  189.           RightSide := GraphMax                 {clipping is unreliable here}
  190.        else RightSide := InputTable[Count];
  191.        DrawLine(GraphMin,Count,RightSide,Count); {line to represents voltage}
  192.    end;
  193.    *)
  194.    LabelPos := GraphMin;
  195.    for Count := 1 to 10 do begin                 {draw scale at bottom}
  196.       str(LabelPos,Text);
  197.       DrawTextW(LabelPos,67,2,Text);
  198.       DrawLine(LabelPos,66,LabelPos,65);
  199.       LabelPos := LabelPos + Step;
  200.    end;
  201.       LabelPos := LabelPos + Step;
  202.       DrawLine(GraphMax,66,GraphMax,65);
  203. end;
  204.  
  205. procedure GraphMode(var InputTable : table);
  206.                {allows graphical display and entry of date with mouse}
  207. var
  208.      Range,
  209.      M3,M4,
  210.      Voltage,
  211.      GraphMin,
  212.      GraphMax,
  213.      ButtonPush,
  214.      RightLine       :integer;
  215.      VideoMode       :integer absolute $40:$49;  {DOS stores current video mode}
  216.      Cursor          :CursorMasks;
  217.      Text            :string[4];
  218. const
  219.   Scale = 3;
  220.   (*
  221.   {Next line for Hercules Video}
  222.   Scale = 5;
  223.   *)
  224.   HotX = 8;
  225.   HotY = 8;
  226.   HgcPageZero = 6;                               {Hercules graphics mode}
  227. begin
  228. NormVideo;
  229. TextCursor(Numlines-1, NumLines);
  230. GraphMin := 0;                                   {default values for graph}
  231. GraphMax := 5000;                                {dimensions              }
  232.   repeat
  233.      GotoXY(1,25);
  234.      write('Enter Display Minimum: ');
  235.      ClrEol;
  236.      {$I-} read (GraphMin); {$I+}
  237.      OK := (IOresult = 0);
  238.      if NOT OK then Beep;
  239.   until OK and ((GraphMin <= 5000) and (GraphMin >= 0));
  240.   repeat
  241.      GotoXY(35,25);
  242.      write('Enter Display Maximum: ');
  243.      ClrEol;
  244.      {$I-} read (GraphMax); {$I+}
  245.      OK := (IOresult = 0);
  246.      if NOT OK then Beep;
  247.   until OK and ((GraphMax <= 5000) and (GraphMax > GraphMin));
  248.   initgraphic;                                   {Toolbox initialization}
  249.   SetBreakOff;                                   {no breaks during Graphics}
  250.   (*
  251.   {Next line for Hercules Video}
  252.   VideoMode := HgcPageZero;
  253.   *)
  254.   Display(GraphMin, GraphMax, InputTable);
  255.   MouseReset(Enable);           {Initialize Mouse Driver}
  256.   for Count:= 0 to 3 do         {make a nice box for a cursor with masks}
  257.     cursor[Count]:= $FFFF;      {first 16 locations for screen mask}
  258.     cursor[4]:= $F00F;
  259.   for Count:= 5 to 10 do
  260.     cursor[Count]:= $F7EF;
  261.     cursor[11]:= $F00F;
  262.   for Count:= 12 to 15 do
  263.     cursor[Count]:= $FFFF;
  264.   for Count:= 16 to 18 do    {last 16 locations for cursor mask}
  265.     cursor[Count]:= $0000;
  266.   for Count:= 19 to 20 do
  267.     cursor[Count]:= $1FF8;
  268.   for Count:= 21 to 26 do
  269.     cursor[Count]:= $1818;
  270.   for Count:= 27 to 28 do
  271.     cursor[Count]:= $1FF8;
  272.   for Count:= 29 to 31 do
  273.     cursor[Count]:= $0000;
  274.   MakeGraphCursor(Cursor, HotX, HotY);
  275.   SetXLimits(24,XScreenMaxGlb);      {Set Min and Max Horizontal Position}
  276.   SetYLimits(0,YMaxGlb-30);          {Set Min and Max Vertical Position}
  277.   CursorOn;                          { Turn on Mouse cursor }
  278.   DefineWindow(1,0,0,XMaxGlb,YMaxGlb);
  279.   DefineWorld(1,0,70,5000,0);        {screen scaled for new coordinates}
  280.   SelectWorld(1);
  281.   SelectWindow(1);
  282.   SetLineStyle(0);                   {solid lines}
  283.   Range := GraphMax-GraphMin;
  284.   repeat
  285.       GetPosition(ButtonPush,M3,M4);    {returns mouse button pushed}
  286.       if ButtonPush = 1 then begin;     {paint lines if first button}
  287.         RightLine := (Trunc((M4-1)/Scale))*Scale+4;
  288.         Voltage := GraphMin + round(((M3-24)/(XScreenMaxGlb-24))*Range);
  289.                        {scale cursor position to voltage}
  290.         CellNum := Trunc((RightLine-4)/Scale+1);  {determine electrode}
  291.         InputTable[CellNum] := Voltage; {update tables}
  292.         (*
  293.         {code commented out for CGA use}
  294.         str(InputTable[CellNum],Text);  {update text}
  295.         *)
  296.         CursorOff;                      {must draw with cursor off}
  297.         SetColorBlack;                  {to write over old line   }
  298.         (*
  299.         {code commented out for CGA use}
  300.         DrawTextW(0,CellNum,2,Chr(27)+'4'+Chr(27)+'4'+Chr(27)+'4'+Chr(27)+'4');
  301.                            {wipe out old text on left side of screen}
  302.         *)
  303.         DrawStraight(24,XScreenMaxGlb,RightLine);       {wipe out old line}
  304.         SetColorWhite;                              {to draw new line}
  305.         (*
  306.         {code commented out for CGA use}
  307.         DrawTextW(0,CellNum,1,Text);            {update new text}
  308.         *)
  309.         DrawStraight(24,M3,RightLine);          {draw new line}
  310.         CursorOn;                               {turn cursor on}
  311.       end;
  312.   until ButtonPush = 2;                         {exit graphic if 2nd button}
  313. leavegraphic;
  314. end;
  315.  
  316. procedure EditTable;
  317.       {allows mouse editing of table of 64 electrode voltages}
  318.  
  319. var
  320.    M2,M3,M4           :integer;
  321.    XCoord,YCoord,
  322.    CellX, CellY       :byte;
  323.  
  324. begin
  325. IntSet($0004,Ofs(CramBuffer));  {sets interrupt for left button push}
  326. TextCursor(2,NumLines-2);
  327.   repeat
  328.      SetXLimits(136,632);        {Set Min and Max Horizontal Position}
  329.      SetYLimits(8,192);          {Set Min and Max Vertical Position}
  330.      GetPosition(M2,M3,M4);             {get mouse status}
  331.      CellX := Trunc((M3/8-18)/8);       {get coordinates of electrode}
  332.      CellY := Trunc((M4/8-1)/3);
  333.      XCoord := CellX * 8 + 21;
  334.      YCoord := CellY * 3 + 2;
  335.      GotoXY(XCoord, YCoord);            {move cursor to proper position}
  336.      if KeyPressed then begin           {get new value if keypressed}
  337.         CellNum := (CellX + 8 * CellY) + 1;
  338.         Window(XCoord, YCoord+1, XCoord+3, YCoord+2);
  339.         GetInput(CellNum, InputTable);
  340.      end;
  341.   until (M2 = 2);                       {exit this mode for right button push}
  342. MouseReset(Enable);  {Reinitialize Mouse Driver}
  343. TextCursor(NumLines,1);
  344. end;
  345.  
  346. begin {main body of program LabMouse}
  347.   MouseReset(Enable);  {Initialize Mouse Driver}
  348.   if (Enable = 0)  then begin
  349.      writeln('Please install mouse driver');    {exit program if no driver}
  350.      exit;
  351.   end;
  352.   ClrScr;
  353.   FillChar(InputTable,SizeOf(InputTable),0);
  354.   SetScreen;
  355.   NormVideo;
  356. repeat
  357.   repeat
  358.     read(kbd,selection);
  359.   if NOT (selection IN ['E','e','G','g','Q','q'])
  360.      then Beep;
  361.   until (selection IN ['E','e','G','g','Q','q']);
  362.  
  363.   case selection of
  364.     'E','e':  EditTable; {two modes of input available here}
  365.     'G','g':  begin
  366.                  GraphMode(InputTable);
  367.                  SetScreen;
  368.                  NormVideo;
  369.               end;
  370.   end;
  371. until (selection='q') or (selection='Q');   {to quit}
  372. TextCursor(NumLines-1, NumLines);           {restore cursor}
  373. ClrScr;
  374. end.
  375.