home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / F / MOUSE.LBR / MOUSE.PAS < prev   
Pascal/Delphi Source File  |  2000-06-30  |  5KB  |  211 lines
  1. {
  2. Mouse Demo 1.0 11/22/92 (C) 1992 Steve Goldsmith
  3. SG Tools Pro (C) 1992 Steve Goldsmith
  4. SG Tools (C) 1992 Parsec, Inc.
  5.  
  6. This program requires SG Tools from Parsec, Inc. to compile.  SG Tools Pro
  7. is a set of professional add-ons for SG Tools and Turbo Pascal.  You are
  8. free to use the MOUSE.INC module in your own programs as you wish.  If
  9. you use any of my tools or programs a $5.00 payment is requested to:
  10.  
  11. Steve Goldsmith
  12. 2805 Jamaica Street
  13. Sarasota, FL 34231
  14.  
  15. Send any comments to GEnie mail S.GOLDSMITH2
  16.  
  17. MOUSE.PAS shows how easy it is to add 1351 mouse input to your SG Tools
  18. applications.  The Run procedure polls the mouse, moves the cursor and
  19. displays the button pressed until a key is pressed.  The ReadMouse2
  20. procedure is part of the MOUSE.INC module.  I used the ADM-31 screen
  21. codes for cursor plotting and colors.  This was the easiest way until
  22. Parsec releases the VDC Screen Manager for SG Tools.
  23. }
  24.  
  25. program MouseDemo;
  26.  
  27. {$B-,C-,R-,U-,V-}
  28.  
  29. {SG Tools module to read cia and sid ports}
  30.  
  31. {$I PORT.INC}
  32.  
  33. {SG Tools Pro modules}
  34.  
  35. {$I JOYSTICK.INC}
  36. {$I MOUSE.INC}
  37.  
  38. {codes for adm-31/commodore protocol}
  39.  
  40. const
  41.  
  42.   appClrScr = #$1b#$3a;
  43.   appRvsOn = #$1b#$47#$34;
  44.   appRvsOff = #$1b#$47#$30;
  45.   appTitleColor = #$1b#$1b#$1b#$23;
  46.   appMouseColor = #$1b#$1b#$1b#$25;
  47.   appExitColor = #$1b#$1b#$1b#$21;
  48.  
  49. {text data}
  50.  
  51.   appTitle = 'C128 CP/M Mouse Demo 1.0 11/22/92';
  52.   appCopyright = '(C) 1992 Steve Goldsmith';
  53.   appInfo = 'Move 1351 mouse in port 2 around';
  54.   appExit = 'Press any key to exit';
  55.  
  56. {other app related stuff}
  57.  
  58.   appScrWidth = 80;
  59.   appScrHeight = 25;
  60.   appXFeel = 2;
  61.   appYFeel = 4;
  62.   appXOverflow = 10;
  63.   appYOverflow = 10;
  64.  
  65. type
  66.  
  67.   appDispStr = string[255];
  68.  
  69. var
  70.  
  71.   appMouseX, appMouseY, appCurX, appCurY : byte;
  72.  
  73. procedure PlotCursor (X,Y : byte);
  74.  
  75. begin
  76.   Write (#$1b#$3d+Chr (Y+$20)+Chr (X+$20))
  77. end;
  78.  
  79. procedure CenterText (S : appDispStr; Y : byte);
  80.  
  81. begin
  82.   PlotCursor ((appScrWidth-Length (S)) div 2,Y);
  83.   Write (S)
  84. end;
  85.  
  86. procedure PlotStr (X,Y : byte; S : appDispStr);
  87.  
  88. begin
  89.   PlotCursor (X,Y);
  90.   Write (S)
  91. end;
  92.  
  93. procedure MoveCursorX;
  94.  
  95. var
  96.  
  97.   XDiff : byte;
  98.  
  99. begin
  100.   XDiff := abs (appMouseX - mseX); {calc abs diff betewwn old and new pos}
  101.   if XDiff > appXFeel then         {see if diff > feel}
  102.   begin
  103.     if XDiff < appXOverflow then   {see if diff overflowed}
  104.     begin
  105.       if (appCurX < appScrWidth-1) and {which direction are we going?}
  106.       (mseX > appMouseX) then
  107.         appCurX := appCurX+1
  108.       else
  109.         if (appCurX > 0) and
  110.         (mseX < appMouseX) then
  111.           appCurX := appCurX-1
  112.     end;
  113.     appMouseX := mseX  {old mouse pos = new pos}
  114.   end
  115. end;
  116.  
  117. procedure MoveCursorY;
  118.  
  119. var
  120.  
  121.   YDiff : byte;
  122.  
  123. begin
  124.   YDiff := abs (appMouseY - mseY);
  125.   if YDiff > appYFeel then
  126.   begin
  127.     if YDiff < appYOverflow then
  128.     begin
  129.       if (appCurY < appScrHeight-1) and
  130.       (mseY < appMouseY) then
  131.         appCurY := appCurY+1
  132.       else
  133.         if (appCurY > 0) and
  134.         (mseY > appMouseY) then
  135.           appCurY := appCurY-1
  136.     end;
  137.     appMouseY := mseY
  138.   end
  139. end;
  140.  
  141. procedure MoveMouseCursor;
  142.  
  143. begin
  144.   Inline ($F3); {di                      ;disable hardware interrupt}
  145.   MoveCursorX;  {calling the cursor plotting procedures with interrupts}
  146.   MoveCursorY;  {off should be enough delay for key scan lines to}
  147.   ReadMouse2;   {stablize before reading sid pots}
  148.   Inline ($FB); {ei                      ;enable hardware interrupt}
  149.   PlotCursor (appCurX,appCurY)
  150. end;
  151.  
  152. procedure DispMouseInfo;
  153.  
  154. var
  155.  
  156.   ButtonData : byte;
  157.  
  158. begin
  159.   MoveMouseCursor;           {move cursor with mouse}
  160.   ButtonData := ReadJoy2;    {get button data}
  161.   if ButtonData and joyFire = 0 then {display button status}
  162.     CenterText ('Left Button ',10);
  163.   if ButtonData and JoyUp = 0 then
  164.     CenterText ('Right Button',10)
  165. end;
  166.  
  167. procedure Run;
  168.  
  169. var
  170.  
  171.   K : char;
  172.  
  173. begin
  174.   Write (appMouseColor);
  175.   repeat
  176.     DispMouseInfo
  177.   until KeyPressed;
  178.   Read (Kbd,K);
  179. end;
  180.  
  181. procedure Init;
  182.  
  183. begin
  184.   appMouseX := 0; {init app and module vars}
  185.   appMouseY := 0;
  186.   appCurX := appScrWidth div 2;
  187.   appCurY := appScrHeight div 2;
  188.   mseX := 0;
  189.   mseY := 0;
  190.   Write (appClrScr);
  191.   Write (appTitleColor);
  192.   CenterText (appTitle,0);
  193.   CenterText (appCopyright,2);
  194.   CenterText (appInfo,4);
  195.   CenterText (appExit,6)
  196. end;
  197.  
  198. procedure Done;
  199.  
  200. begin
  201.   Write (appExitColor);
  202.   PlotCursor (0,appScrHeight-3)
  203. end;
  204.  
  205.  
  206. begin
  207.   Init;
  208.   Run;
  209.   Done
  210. end.
  211.