Author Topic: Mighty Mouse?  (Read 4176 times)

0 Members and 1 Guest are viewing this topic.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Mighty Mouse?
« on: October 05, 2021, 02:16:59 pm »
I'll let you guys decide...

Code: QB64: [Select]
  1. mydemo% = -1
  2. DIM UI AS UserInput
  3.  
  4. TYPE UserInput
  5.     KeyPress AS STRING
  6.     KeyCombos AS INTEGER
  7.     MbStatus AS INTEGER
  8.     MbEnvoked AS INTEGER
  9.     drag AS INTEGER
  10.     DoubleClick AS INTEGER
  11.     MbLeftx AS INTEGER
  12.     MbLefty AS INTEGER
  13.     mx AS INTEGER
  14.     oldmx AS INTEGER
  15.     my AS INTEGER
  16.     oldmy AS INTEGER
  17.  
  18. PRINT "Press keys or use mouse for demo.";
  19.     CALL keyboard_mouse(UI, mydemo%)
  20.     IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
  21.         SOUND 1000, .3: UI.MbEnvoked = -1
  22.     END IF
  23.     IF UI.KeyPress = CHR$(13) THEN BEEP: EXIT DO
  24.  
  25.     CALL keyboard_mouse(UI, mydemo%)
  26.     IF UI.MbStatus > 0 AND UI.MbEnvoked = 0 THEN
  27.         SOUND 300, .3: UI.MbEnvoked = 1
  28.     END IF
  29.  
  30.  
  31. SUB keyboard_mouse (UI AS UserInput, mydemo%)
  32.     STATIC z1, lclick
  33.  
  34.     _LIMIT 30
  35.  
  36.     DEF SEG = 0
  37.     IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
  38.         UI.KeyCombos = 1 ' Shift  % = -1 ELSE shift% = 0
  39.     ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
  40.         UI.KeyCombos = 2 ' Ctrl  % = -1 ELSE ctrl% = 0
  41.     ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
  42.         UI.KeyCombos = 3 ' Alt  % = -1
  43.     ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
  44.         UI.KeyCombos = 4 ' Ctrl+Shift  % = -1 ELSE ctrlshift% = 0
  45.     ELSE
  46.         UI.KeyCombos = 0
  47.     END IF
  48.     DEF SEG
  49.  
  50.     IF mydemo% THEN GOSUB check_UI.KeyCombos
  51.  
  52.     UI.KeyPress = INKEY$
  53.     IF LEN(UI.KeyPress) THEN ' A key was pressed.
  54.         UI.MbEnvoked = 0: UI.MbLeftx = 0
  55.         SELECT CASE LEN(UI.KeyPress)
  56.             CASE 1 ' 1-byte key A-Z, etc.
  57.                 IF mydemo% THEN mydemo% = 1: GOSUB mydemo
  58.                 SELECT CASE UI.KeyPress
  59.                     ' Place key selection routine here...
  60.                     CASE CHR$(27): SYSTEM
  61.                 END SELECT
  62.             CASE 2 '2-byte key F1-F12, etc.
  63.                 IF mydemo% THEN mydemo% = 2: GOSUB mydemo
  64.                 SELECT CASE RIGHT$(UI.KeyPress, 1)
  65.                     ' Place key selection routine here...
  66.                 END SELECT
  67.         END SELECT
  68.     ELSE ' Check for mouse input since no keyboard input was detected.
  69.  
  70.         IF lclick THEN ' Check timer for double-clicks.
  71.             IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
  72.             IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
  73.         END IF
  74.  
  75.         WHILE _MOUSEINPUT
  76.             mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
  77.         WEND
  78.  
  79.         ' Get mouse status.
  80.         UI.mx = _MOUSEX
  81.         UI.my = _MOUSEY
  82.         lb = _MOUSEBUTTON(1)
  83.         rb = _MOUSEBUTTON(2)
  84.         mb = _MOUSEBUTTON(3)
  85.  
  86.         SELECT CASE UI.MbEnvoked
  87.             CASE 0
  88.                 IF lb OR rb OR mb THEN
  89.  
  90.                 END IF
  91.             CASE 1
  92.                 IF lb OR rb OR mb THEN UI.MbEnvoked = 0
  93.             CASE -1
  94.                 IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
  95.         END SELECT
  96.  
  97.         ' Check for mouse movement.
  98.         IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN
  99.             oldcsrlin = CSRLIN: oldpos = POS(0)
  100.             LOCATE 3, 1: PRINT "Mouse row/col ="; UI.my; UI.mx; "     ";: LOCATE oldcsrlin, oldpos
  101.         END IF
  102.  
  103.         IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
  104.             SELECT CASE UI.MbStatus
  105.                 CASE -1 ' Left button was pressed.
  106.                     IF lb = 0 THEN ' Left button released.
  107.                         SELECT CASE lclick ' Single or double click analysis.
  108.                             CASE 0
  109.                                 IF mydemo% THEN mydemo% = 3: GOSUB mydemo
  110.                                 lclick = lclick + 1
  111.                             CASE ELSE ' Double click. Completed upon 2nd left button release.
  112.                                 IF mydemo% THEN mydemo% = 11: GOSUB mydemo
  113.                                 UI.DoubleClick = -1
  114.                                 lclick = 0
  115.                         END SELECT
  116.                         UI.MbStatus = 1
  117.  
  118.                         IF UI.MbLeftx THEN
  119.                             IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
  120.                             UI.MbLeftx = 0: UI.MbLefty = 0
  121.                         END IF
  122.  
  123.                         IF UI.drag THEN UI.drag = 0
  124.                     ELSE ' Left button is being held down. Check for UI.drag.
  125.                         IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
  126.                             IF mydemo% THEN mydemo% = 12: GOSUB mydemo
  127.                             UI.drag = -1
  128.                         END IF
  129.                     END IF
  130.                 CASE -2 ' Right button was pressed.
  131.                     IF rb = 0 THEN ' Right button was relased.
  132.                         IF mydemo% THEN mydemo% = 4: GOSUB mydemo
  133.                         UI.MbStatus = 2
  134.                     END IF
  135.                 CASE -3 ' Middle button was pressed
  136.                     IF mb = 0 THEN ' Middle button was released.
  137.                         IF mydemo% THEN mydemo% = 5: GOSUB mydemo
  138.                         UI.MbStatus = 3
  139.                     END IF
  140.             END SELECT
  141.         ELSE
  142.             IF lb THEN ' Left button just pressed.
  143.                 IF mydemo% THEN mydemo% = 6: GOSUB mydemo
  144.                 UI.MbStatus = -1
  145.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  146.                 z1 = TIMER
  147.             ELSEIF rb THEN ' Right button just pressed.
  148.                 IF mydemo% THEN mydemo% = 7: GOSUB mydemo
  149.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  150.                 UI.MbStatus = -2
  151.             ELSEIF mb THEN ' Middle button just pressed.
  152.                 IF mydemo% THEN mydemo% = 8: GOSUB mydemo
  153.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  154.                 UI.MbStatus = -3
  155.             ELSEIF mw THEN ' Mouse wheel just moved.
  156.                 SELECT CASE mw
  157.                     CASE IS > 0 ' Scroll down.
  158.                         IF mydemo% THEN mydemo% = 9: GOSUB mydemo
  159.                     CASE IS < 0 ' Scroll up.
  160.                         IF mydemo% THEN mydemo% = 10: GOSUB mydemo
  161.                 END SELECT
  162.             END IF
  163.         END IF
  164.  
  165.         UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
  166.     END IF
  167.     EXIT SUB
  168.  
  169.     mydemo:
  170.     LOCATE 1, 1: PRINT "Last User Status:                                    ";
  171.     LOCATE , 19
  172.     SELECT CASE mydemo%
  173.         CASE 1
  174.             PRINT "1-byte Key = "; UI.KeyPress
  175.         CASE 2
  176.             PRINT "2-byte Key = "; UI.KeyPress
  177.         CASE 3
  178.             PRINT "Left button released."
  179.         CASE 4
  180.             PRINT "Right button released."
  181.         CASE 5
  182.             PRINT "Middle button released."
  183.         CASE 6
  184.             PRINT "Left button down."
  185.         CASE 7
  186.             PRINT "Right button down."
  187.         CASE 8
  188.             PRINT "Middle button down."
  189.         CASE 9
  190.             PRINT "Wheel scroll down."
  191.         CASE 10
  192.             PRINT "Wheel scroll up."
  193.         CASE 11
  194.             PRINT "Left button double click."
  195.         CASE 12
  196.             PRINT "Drag..."
  197.     END SELECT
  198.     mydemo% = -1
  199.     RETURN
  200.  
  201.     check_UI.KeyCombos:
  202.     IF UI.KeyCombos THEN
  203.         LOCATE 1, 50
  204.         SELECT CASE UI.KeyCombos
  205.             CASE 1
  206.                 PRINT "Shift key down.        ";
  207.             CASE 2
  208.                 PRINT "Ctrl key down.         ";
  209.             CASE 3
  210.                 PRINT "Alt key down.          ";
  211.             CASE 4
  212.                 PRINT "Ctrl + Shift key down. ";
  213.         END SELECT
  214.     ELSE
  215.         LOCATE 1, 50: PRINT SPACE$(29);
  216.     END IF
  217.     RETURN

Anyway, this is just something I threw together for another member to consider. I usually write these routines from scratch each time I need one, but for fun, I thought I take a shot at one I could save as a library and use as a universal routine for future apps. I need to add some more stuff from my other routines, like my PEEK / POKE routine for detecting Shift + arrow keys, alt, ctrl, etc. I also want to add another variable to let the user decide if the mouse action should take place upon button press or release. I'll probably update this post, occasionally, if and when I make these additions. Fun stuff.

Pete

Edited: Worked in V 1.3, but not the more recent versions. Reason was as bplus pointed out, I had two IF THEN statements following a SELECT CASE statement. Both statements were moved one line up, and now work in the later versions. Thanks for catching that, Mark!

Edited: Added a method and demo for mouse action either on button press or release. The first loop signals a high tone when a mouse click is made with button down. It then shuts off more mouse input until the button is released. Press [ENTER] to exit to the next loop, which issues a low tone when a depressed mouse button is released. Now the user can decide on each mouse event if the program should respond upon mouse button press or release.

Edited: Added my PEEK / POKE routine to detect Shift, Ctrl, Alt, and Ctrl+Shift.

Editd: Added a prevent click initiation on button release if mouse cursor is moved while button is held down. So if the user decides to use the activate mouse command on button release option, this addition allows the user to abort the click, by moving the mouse cursor before the button is released.

Edited: Did some renaming and changed variables to TYPE variables.

Edited: Added mouse row and column indicator.
« Last Edit: November 01, 2021, 11:26:57 pm by Pete »
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Mighty Mouse?
« Reply #1 on: October 05, 2021, 02:36:16 pm »
What the heck? I am getting error on line 16:
Code: QB64: [Select]
  1. IF mydemo%  THEN mydemo% = 1: GOSUB mydemo  
  2.  

@Pete is this working OK for you or you making a point in that funny way of yours?

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Mighty Mouse?
« Reply #2 on: October 05, 2021, 02:40:16 pm »
I think both Terry Richie and Steve have made similar do all mouse reporting, probably others too.

But I agree, more fun reinventing the wheel sometimes.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Mighty Mouse?
« Reply #3 on: October 05, 2021, 02:48:40 pm »
What the heck? I am getting error on line 16:
Code: QB64: [Select]
  1. IF mydemo%  THEN mydemo% = 1: GOSUB mydemo  
  2.  

@Pete is this working OK for you or you making a point in that funny way of yours?

Ohhh! You're trying an IF THEN right after Select Case, IDE is expecting a Case line. What version QB64 are you running Pete?

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Mighty Mouse?
« Reply #4 on: October 05, 2021, 03:03:09 pm »
THANKS MARK!

I coded this one on V 1.3. It compiled and worked just fine. I just did a post edit to correct the problem, and tested it on V1.5.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Mighty Mouse?
« Reply #5 on: October 05, 2021, 05:35:52 pm »
I think I just made my last edit / addition to the code for today, unless someone finds a goof, then I'll go back and fix it. This is why I love having the edit post ability extended. Thanks, Fell.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Mighty Mouse?
« Reply #6 on: October 05, 2021, 06:21:15 pm »
@Pete

Instead of Peek and Poke to check Shift, Ctrl, Alt have you considered _KeyDown(keyInQuestion)?

FellippeHeitor

  • Guest
Re: Mighty Mouse?
« Reply #7 on: October 05, 2021, 06:29:37 pm »
I think I just made my last edit / addition to the code for today, unless someone finds a goof, then I'll go back and fix it. This is why I love having the edit post ability extended. Thanks, Fell.

Pete

Stop rubbing it in, will ya.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Mighty Mouse?
« Reply #8 on: October 05, 2021, 06:36:28 pm »
I know, I feel like such a heel!

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Mighty Mouse?
« Reply #9 on: October 05, 2021, 06:47:20 pm »
@bplus Yes, I actually have one very extensive keyboard input routine I wrote with the newer QB64 key keywords. It works, but because I did not use CONSTANTS, just numeric values, I discovered it was just too unfamiliar to be comfortable. I'm not sure if I'm recalling correctly now, but I also thought mixing INKEY$ and _KEYDOWN was a big mistake, whereas the PEEK / POKE marriage works perfectly. If I were to do another _KEYDOWN routine, I'd do like I do with SENDKEY, and make CONSTANTS to replace the numeric entries.

Now I have a reached a bit of a difficulty with my posted routine. I need to work out an elegant way to cancel a mouse cycle if the mouse is moved. I was just thinkjng a few minutes ago that I have a couple of routines I designed to do exactly that. So if you slide off a mouse hot spot, and release the button, the click will not take action. It is a neat way of changing your mind in the middle of a selection process.

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Mighty Mouse?
« Reply #10 on: October 06, 2021, 03:14:10 pm »
I made one more edit to use TYPE variables, easier to pass in subs without the need to to DIM SHARED. Also, I improved some of the variable names.

At some point I might start to analyze the code for debugging and modifying improvements. It would be neat to come back to a coding project after a couple of years, and be able to read it like a book. Easy to search and simple to modify. Ah well, I can dream...

Pete
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/