home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / MOUSE / MSMOUSE1.ZIP / FOR.ZIP / FTEST.FOR < prev    next >
Encoding:
Text File  |  1989-02-10  |  3.5 KB  |  126 lines
  1. ******************************************************************
  2. *  FTEST.FOR                                                     *
  3. *                                                                *
  4. *  Demonstrates use of the Microsoft Mouse from FORTRAN 4.1      *
  5. *                                                                *
  6. *  Assumes ANSI.SYS and MOUSE.COM have been loaded by MS-DOS.    *
  7. *  Compile using large model (default), and link with MOUSE.LIB  *
  8. *  Example:   fl /FPc ftest.for -link mouse                      *
  9. ******************************************************************
  10.  
  11.       PROGRAM FTEST
  12.       IMPLICIT INTEGER*2 (A-Z)
  13.  
  14. * Clear the display using ANSI.SYS escape-code sequence
  15.       WRITE(*,*) CHAR(27),'[2J'
  16.  
  17. * Display simple instructions for user
  18.       WRITE(*,*) 'FTEST - Mouse demonstration using FORTRAN 4.1'
  19.       WRITE(*,*) ' '
  20.       WRITE(*,*) 'Use mouse to highlight a menu option.'
  21.       WRITE(*,*) 'Press either button to select option.'
  22.  
  23. * Check for mouse, resetting it in the process
  24.       M1 = 0
  25.       CALL MOUSEL(M1, M2, M3, M4)
  26.  
  27. * Quit if mouse wasn't found
  28.       IF (M1.EQ.0) THEN
  29.           WRITE(*,*) 'Error: Mouse not found'
  30.           GOTO 999
  31.       END IF
  32.  
  33. * Initialize menu pointer to first option
  34.       MENPTR = 1
  35.  
  36. * Initialize count of accumulated vertical mouse motion
  37.       MOTION = 0
  38.  
  39. * Set flag to update menu first time
  40.       WFLAG = 1
  41.  
  42. * Main loop starts here
  43.    10 CONTINUE
  44.  
  45. * Update the menu only when necessary
  46.       IF (WFLAG.EQ.1) THEN
  47.           WFLAG = 0
  48.  
  49. * Write first line of the menu, highlighted if selected
  50.           IF (MENPTR.EQ.1) THEN
  51.               WRITE(*,*) CHAR(27),'[7m'
  52.           ELSE
  53.               WRITE(*,*) CHAR(27),'[0m'
  54.           END IF
  55.           WRITE(*,*) CHAR(27),'[10;29f 1. First menu option '
  56.  
  57. * Write second line of the menu, highlighted if selected
  58.           IF (MENPTR.EQ.2) THEN
  59.               WRITE(*,*) CHAR(27),'[7m'
  60.           ELSE
  61.               WRITE(*,*) CHAR(27),'[0m'
  62.           END IF
  63.           WRITE(*,*) CHAR(27),'[11;29f 2. Second option     '
  64.  
  65. * Write third line of the menu, highlighted if selected
  66.           IF (MENPTR.EQ.3) THEN
  67.               WRITE(*,*) CHAR(27),'[7m'
  68.           ELSE
  69.               WRITE(*,*) CHAR(27),'[0m'
  70.           END IF
  71.           WRITE(*,*) CHAR(27),'[12;29f 3. Third option      '
  72.  
  73. * Be sure highlighting is turned off
  74.           WRITE(*,*) CHAR(27),'[0m'
  75.  
  76. * End of updating the menu
  77.       END IF
  78.  
  79. * Accumulate vertical mouse motion counts
  80.       M1 = 11
  81.       CALL MOUSEL(M1, M2, M3, M4)
  82.       MOTION = MOTION + M4
  83.  
  84. * Move up the menu if enough mouse motion
  85.       IF (MOTION.LT.-17) THEN
  86.           MOTION = 0
  87.           IF (MENPTR.GT.1) THEN
  88.               MENPTR = MENPTR - 1
  89.               WFLAG = 1
  90.           END IF
  91.       END IF
  92.  
  93. * Move down the menu if enough mouse motion
  94.       IF (MOTION.GT.17) THEN
  95.           MOTION = 0
  96.           IF (MENPTR.LT.3) THEN
  97.               MENPTR = MENPTR + 1
  98.               WFLAG = 1
  99.           END IF
  100.       END IF
  101.  
  102. * Check if left button pressed
  103.       M1 = 5
  104.       M2 = 0
  105.       CALL MOUSEL(M1, M2, M3, M4)
  106.       IF (M2.NE.0) THEN
  107.           WRITE(*,*) 'Left button used to select option',MENPTR
  108.           GOTO 999
  109.       END IF
  110.  
  111. * Check if right button pressed
  112.       M1 = 5
  113.       M2 = 1
  114.       CALL MOUSEL(M1, M2, M3, M4)
  115.       IF (M2.NE.0) THEN
  116.           WRITE(*,*) 'Right button used to select option',MENPTR
  117.           GOTO 999
  118.       END IF
  119.  
  120. * Loop back until one of the buttons is pressed
  121.       GOTO 10
  122.  
  123. * All done
  124.   999 CONTINUE
  125.       END
  126.