'===========================================================================
' Subject: MOUSE ROUTINES W/DOUBLE CLICK      Date: 09-03-96 (23:10)       
'  Author: Egbert Zijlema                     Code: PB                     
'  Origin: zylema@bnc.nl                    Packet: MOUSE.ABC
'===========================================================================
' MOUS.BAS        - mouse routines, new version with double click
'                   (revision of MOUSDEMO.BAS)
' Author          : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)
' (up)Date        : September 3, 1996
' Language        : Power Basic 3.2
' Copyright status: Public Domain

' Again?
' Yes, again a mouse routine from this author for a couple of reasons.
' A few minor bug fixes, to begin with.

' The most important reason for this revision, however, is a new
' key/mouse trap: ScrollMouse. It now contains 2 different mouse
' performances: the classical one to support pull down menus and
' another one to doubleclick an item.

' In this revision I left a lot of things out, just to keep it as
' simple as possible. For instance: the menu does not support
' highlighted characters and contains only 2 working options.
' Furthermore: I left the Power Basic mouse library out and replaced
' it by plain BASIC INTERRUPT calls; only their names are identical.
' Registered PB-users may re-replace them by the faster assembly
' code that came with version 3.2 (subdirectory EXAMPLE\MOUSUNIT.BAS).
' In that case: DO NOT FORGET to implement the mouseflag tests in those
' procedures. They are not in the original set. I suggested Dave Navarro
' already to include them, in one way or another, within the following
' PB-release.

' ScrollMouse - method 1:
' When clicking in the menu bar the selected menu pops down. The normal
' way here is to hold the left button until you confirm your selection by
' releasing it.

' ScrollMouse - method 2:
' After you've selected "Select files" in the File menu you can
' select 1 of the filenames by doubleclicking it. The doubleclick must
' be performed within half a second, otherwise the result will be
' zero, in order to wait for a following doubleclick.
' You can always escape by pressing the Esc-key or the right mouse button.

DEFINT A - Z

%NO      =        0 : %YES    = NOT %NO              ' true or false
%ALTF    = 33 * 256 : %ALTX   = 45 * 256
%HOME    = 71 * 256 : %UP     = 72 * 256
%DOWN    = 80 * 256 : %ENDKEY = 79 * 256
%ENTER   = 13       : %ESCAPE = 27
%MOUSEDRIVER = &H33 : %AX = 1 : %BX = 2 : %CX = 3 : %DX = 4

TYPE MOUSEFLAGS
  mseon AS INTEGER                             ' cursor on
  mouse AS INTEGER                             ' mouse is there
  menu AS BYTE                                 ' matrix rowcounter
END TYPE
DIM mflg AS SHARED MOUSEFLAGS

DIM MainScreen AS SHARED STRING                ' original screen
DIM FileName(1 : 60) AS SHARED STRING          ' array of 60 elements
DIM matrix(1 : 50, 1 : 80) AS SHARED INTEGER   ' 2 * 25 rows - 80 cols

' NOTE: a text screen has 25 rows, indeed!
' BUT : the matrices of the menu(s) and the mainscreen
'       overlap. Therefore we reserve 'rows' 26 through 50
'       for the menu, which is a much better way than
'       swapping them after every menu/main screen switch.

SUB MousInit
  temp = MsThere(buts)
  COLOR 15, 0
  LOCATE 25, 2
  IF temp THEN
    PRINT "Your mouse has ";LTRIM$(RTRIM$(STR$(buts))); " buttons";
    mflg.mouse = %YES
  ELSE
    PRINT "Mouse driver not available";
  END IF
END SUB

FUNCTION MsThere(buts AS INTEGER) AS INTEGER
  REG %AX, 0
  CALL INTERRUPT %MOUSEDRIVER
  buts = REG(%BX)
  FUNCTION = REG(%AX)
END FUNCTION

SUB MsCursorOn
  IF mflg.mouse = 0 THEN EXIT SUB            ' no mouse, so quit
  IF mflg.mseon = 0 THEN                     ' only when mouse is off
    REG %AX, 1
    CALL INTERRUPT %MOUSEDRIVER
    mflg.mseon = %YES                        ' mouse cursor on
  END IF
END SUB

SUB MsCursorOff
  IF mflg.mouse = 0 THEN EXIT SUB
  IF mflg.mseon THEN
    REG %AX, 2
    CALL INTERRUPT %MOUSEDRIVER
    mflg.mseon = 0                           ' mouse cursor off
  END IF
END SUB

SUB MsLocate(BYVAL row AS INTEGER, BYVAL col AS INTEGER)
  IF mflg.mouse = 0 THEN EXIT SUB
  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THEN
    row = (row - 1) * 8
    col = (col - 1) * 8
  END IF
  REG %AX, 4
  REG %CX, col
  REG %DX, row
  CALL INTERRUPT %MOUSEDRIVER
END SUB

SUB MsStatus(buttons AS INTEGER, row AS INTEGER, col AS INTEGER)
  IF mflg.mouse = 0 THEN EXIT SUB
  REG %AX, 3
  CALL INTERRUPT %MOUSEDRIVER
  buttons = REG(%BX)
  row = REG(%DX)
  col = REG(%CX)
  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THEN
    row = (row \ 8) + 1
    col = (col \ 8) + 1
  END IF
END SUB

SUB MsSetWindow(BYVAL row  AS INTEGER, BYVAL col  AS INTEGER, _
                BYVAL rows AS INTEGER, BYVAL cols AS INTEGER)

  IF mflg.mouse = 0 THEN EXIT SUB
  rows = row + rows - 1      ' adjust rows to real coordinates
  cols = col + cols - 1      ' adjust cols to real coordinates

  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THEN
    row  = row * 8 - 1 : rows = rows * 8 - 1   ' adjust for PB
    col  = col * 8 - 1 : cols = cols * 8 - 1   ' adjust for PB
  END IF
  REG %AX, 7
  REG %CX, col
  REG %DX, cols
  CALL INTERRUPT %MOUSEDRIVER
  REG %AX, 8
  REG %CX, row
  REG %DX, rows
  CALL INTERRUPT %MOUSEDRIVER
END SUB

SUB box(row, col, rows, cols, fore, back)
  ' draw single rectangle
  toprow$ = CHR$(218) + STRING$(cols - 2, 196) + CHR$(191)  ' ÚÄÄ¿
  botrow$ = CHR$(192) + STRING$(cols - 2, 196) + CHR$(217)  ' ÀÄÄÙ
  vert$ = CHR$(179)                                         ' ³

  COLOR fore, back
  LOCATE row, col: PRINT toprow$;
  FOR count = row + 1 TO row + rows - 2
    LOCATE count, col
    PRINT vert$; SPACE$(cols - 2); vert$;
  NEXT
  LOCATE count, col: PRINT botrow$
END SUB

SUB MenuMatrices
  ' reserve rows 3 throug 12 (28-37 in the matrix) for pop down menus
  ' this is enough if your menus contain no more than 10 options
  mflg.menu = 25
  FOR row = 3 TO 12
    FOR cell = 1 TO 80
      matrix(row + mflg.menu, cell) = row - 2  + 256     ' no ascii!
    NEXT
  NEXT
  mflg.menu = 0
END SUB

SUB DrawMenuBar
  mflg.menu = 25
  COLOR 0, 7
  LOCATE 1, 1 : PRINT SPACE$(80);
  LOCATE 1, 5 : PRINT "ile"
  COLOR 15, 7
  LOCATE 1, 4 : PRINT "F"
  FOR cell = 4 TO 7
    matrix(1, cell) = %ALTF
    matrix(1 + mflg.menu, cell) = %ALTF
  NEXT
  mflg.menu = 0
END SUB

SUB FileMenu(choice)
  STATIC last
  REDIM MenuItem (1: 4) AS LOCAL STRING
  mflg.menu = 25
  exclude = %ALTF
  options = 4
  column = 3
  MenuItem(1) = " Select files  "
  MenuItem(2) = " Not supported "
  MenuItem(3) = " Bla bla       "
  MenuItem(4) = " Exit          "
  MsCursorOff
  box 2, column - 1, options + 2, LEN(MenuItem(1)) + 2, 15, 7
  FOR row = 3 TO 6
    LOCATE row, 3 : PRINT MenuItem(row - 2)
  NEXT
  ScrollMenu last, MenuItem(), column, options, exclude, result
  last = result
  SELECT CASE result
    CASE 1
      mflg.menu = 0
      SelectFiles
    CASE 4 : choice = %ALTX
  END SELECT
END SUB

FUNCTION ScrollMouse AS INTEGER
  MsStatus oldButn, oldRow, oldCol
  IF oldButn = 1 THEN                            ' test status to avoid
                                                 ' repeat (causes flicker)
    oldKey = matrix(oldRow + mflg.menu, oldCol)
  END IF
  DO
    MsStatus buttons, row, col
    IF INSTAT THEN
      FUNCTION = CVI( INKEY$ + CHR$(0) )
      EXIT FUNCTION
    ELSEIF buttons = 1 AND matrix(row + mflg.menu, col) <> oldKey THEN
      FUNCTION = matrix(row + mflg.menu, col)
      EXIT FUNCTION
    ELSEIF buttons = 2 THEN                      ' right button = escape
      ReleaseButtons
      FUNCTION = %ESCAPE
      EXIT FUNCTION
    END IF
  LOOP UNTIL (oldButn = 1) AND (buttons = 0)     ' until release
  IF mflg.menu = 0 THEN                          ' perform doubleclick
    start# = TIMER
    DO
      MsStatus buttons, dummy, dummy
      now# = TIMER
      IF now# - start# > .5 THEN
        FUNCTION = 0
        EXIT FUNCTION
      END IF
    LOOP UNTIL buttons = 1
    ReleaseButtons
  END IF
  FUNCTION = %ENTER
END FUNCTION

SUB ReleaseButtons
  DO
    MsStatus buttons, dummy, dummy
  LOOP UNTIL buttons = 0
END SUB

SUB ReadAndDisplayFiles
  temp$ = DIR$("\DOS\*.*")
  DO WHILE LEN(temp$)
    INCR count
    hwmany = count
    FileName(count) = LEFT$(temp$ + SPACE$(12), 12)
    IF count = UBOUND(FileName) THEN          ' if there are more than 60
      EXIT DO
    ELSE
      temp$ = DIR$
    END IF
  LOOP
  ARRAY SORT FileName()
  COLOR 15, 0
  FOR count = 1 TO 20
    IF count > hwmany THEN EXIT SUB
    LOCATE count + 2, 2 : PRINT FileName(count);
    FOR cell = 2 TO 13                        ' len(filename) = 12
      matrix (count + 2, cell) = count + 256  ' no ascii
    NEXT
  NEXT
END SUB

SUB SelectFiles
  column = 2
  options = 20
  ScrollMenu 0, FileName(), column, options, %ALTF, result
  MsCursorOff
  IF result = 0 THEN EXIT SUB
  COLOR 7, 0
  LOCATE 25, 1
  PRINT "You selected: ";FileName(result);
  DO
  LOOP UNTIL LEN(INKEY$)
  RestoreMain
END SUB

SUB RestoreMain
  DEF SEG = &HB800
  POKE$ 160, MainScreen
  DEF SEG
END SUB

SUB ScrollMenu(last, item$(), column, options, exclude, result)
  IF mflg.menu THEN
    result = last - 1
    IF result <= 0 THEN
      result = 0
      MsLocate 3, 5
    ELSE
      MsLocate result + 2, 5
    END IF
    MsRow = 1 : plus = 2
  ELSE
    MsLocate 3, 5
    MsRow = 3 : plus = 0
  END IF

  DEF SEG = &HB800                         ' assume color card
  MenuScreen$ = PEEK$(160, 3840)
  DEF SEG
  MsSetWindow MsRow, column - 1, options + plus, LEN(item$(1))
  init = %YES
  DO
    MsCursorOn
    IF init AND mflg.menu THEN
      init = %NO
      KeyIn = %DOWN
    ELSE
      KeyIn = ScrollMouse
    END IF

    SELECT CASE KeyIn
      CASE %UP
        DECR result
        IF result < 1 THEN result = options
      CASE %DOWN
        INCR result
        IF result > options THEN result = 1
      CASE %HOME
        result = 1
      CASE %ENDKEY
        result = options
      CASE %ESCAPE
        result = 0
        EXIT DO
      CASE exclude
        result = 0
      CASE 257 TO 276
        ' mouse only!
        result = KeyIn - 256
    END SELECT
    IF result THEN
      MsCursorOff
      DEF SEG = &HB800
      POKE$ 160, MenuScreen$
      DEF SEG
      IF mflg.menu THEN COLOR 7,0 ELSE COLOR 0, 7
      LOCATE result + 2, column
      PRINT item$(result)
    END IF
  LOOP UNTIL KeyIn = %ENTER AND result          ' safety first
  MsCursorOff
  RestoreMain
END SUB

SUB MainMenu
  DO

    IF choice THEN
      KeyIn = choice
      choice = 0
    ELSE
      KeyIn = ScrollMouse
    END IF

    ' modified = %NO
    SELECT CASE KeyIn
      CASE %ALTX
        MsCursorOff
        COLOR 7, 0
        CLS
        SYSTEM
      CASE %ALTF
        FileMenu choice
    END SELECT
    MsCursorOn
    MsSetWindow 1, 1, 25, 80
  LOOP
END SUB

CLS
  MenuMatrices
  DrawMenuBar
  ReadAndDisplayFiles
  DEF SEG = &HB800
  MainScreen = PEEK$(160, 3840)
  DEF SEG
  MousInit
  MsLocate 1, 1
  MsCursorOn
  MainMenu
END