'===========================================================================
' Subject: PB MOUSE IMPLEMENTATION           Date: 08-14-96 (13:17)       
' Author:  Egbert Zijlema                    Code: PB                     
' Origin:  E.Zijlema@uni4nn.iaf.nl         Packet: MOUSE.ABC
'===========================================================================
' MOUSMENU.BAS    : shows how to implement the mouse in your program
' Author          : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)
' (up)Date        : August 14, 1996
' Language        : Power Basic 3.2
' Copyright status: Public Domain


' Credit:
' The routines written in assembly (mouse driver calls & SUB Box)
' are from Dave Navarro. They came with Power Basic 3.2
' (MOUSUNIT.BAS & SCRNUNIT.BAS - subdirectory PB32\EXAMPLE).

' To improve the mouse driver stuff, 3 flags have been added:
' 1. mflg.allow - to be set on start up. Driver present.
' 2. mflg.mouse - driver activated by user (options menu).
' 3. mflg.mseon - (mouse on) to avoid switching on/off the cursor more
'    than once. This is rather crucial, due to the fact that the mouse
'    is counting, not toggling, its on/off status.

' I also implemented a slight modification in SUB Box, making it
' possible to choose 1 out of 3 rectangles: single frame, double frame,
' no frame (inverse or clean background)

$COMPILE EXE           ' compile the file if you might want to try
                       ' to exit to DOS (File-menu)
DEFINT A - Z

%FALSE = 0 : %TRUE = NOT %FALSE

' equates for arrow keys:
%HOME  = 71 * 256 : %UP  = 72 * 256 : %LEFT = 75 * 256
%RIGHT = 77 * 256 : %END = 79 * 256 : %DOWN = 80 * 256

' equates for command keys
%TAB   = 9 : %ENTER = 13 : %ESCAPE = 27

' equates for pulldown menus
%ALTI = 23 * 256                    ' open info menu
%ALTO = 24 * 256                    ' open options menu
%ALTF = 33 * 256                    ' open file menu
%ALTX = 45 * 256                    ' exit program
%F1   = 59 * 256                    ' help screen

TYPE GENERICFLAGS
  mono AS INTEGER                   ' monochrome card
  menu AS INTEGER                   ' scroll menu
  clok AS INTEGER                   ' time on/off
END TYPE
DIM flag AS SHARED GENERICFLAGS

TYPE MOUSEFLAGS
  allow AS INTEGER                  ' driver present
  mouse AS INTEGER                  ' driver active
  mseon AS INTEGER                  ' mouse cursor on/off
END TYPE
DIM mflg AS SHARED MOUSEFLAGS

filemenudata:
  DATA 4, 3
  DATA " *Select      "
  DATA " *Dos         "
  DATA " E*xit  Alt-X "

infomenudata:
  DATA 11, 3
  DATA " *Help     F1 "
  DATA " *Read Me     "
  DATA " *About       "

helpdata:
  DATA "HOT KEYS:"
  DATA "F1    : Display this helpscreen"
  DATA "Alt-x : Exit"
  DATA "Alt-f : Open File-menu"
  DATA "Alt-i : Open Info-menu"
  DATA "Alt-o : Open Options-menu"
  DATA ""
  DATA "Esc   : Cancel any operation"
  DATA "Tab   : Toggle yes/no in dialog box"

aboutdata:
  DATA "MOUSE DEMO"
  DATA "Author: Egbert Zijlema"
  DATA "Status: Public Domain"

readmedata:
  DATA "MOUSE DIFFICULTIES"
  DATA "Routines concerning the mouse are basically very simple. They are"
  DATA "all done by calling INTERRUPT &H33. Depending of the value passed"
  DATA "through the AX-register, one can test for the presence of the"
  DATA "mouse, show/hide its cursor, define a screen area; and so on."
  DATA ""
  DATA "But unfortunately all those routines don't tell you how to"
  DATA "implement the mouse in your program. How, for instance, do you tell"
  DATA "your software that clicking the word  File  in the menu bar means"
  DATA "the same as pressing Alt-f (to pull down the File menu)?"
  DATA "This demo shows how to manipulate pull down menus and how to select"
  DATA "a file from a list of 30 filenames (out of an array of 60) - either"
  DATA "by the mouse or the arrow keys."

DIM VideoAddress AS SHARED INTEGER
DIM MainScreen AS SHARED STRING                       ' initial screen
DIM FileName(1 : 60) AS SHARED STRING

IF (pbvScrnCard AND 1) = 0 THEN
  VideoAddress = &HB800                               ' color card
ELSE
  VideoAddress = &HB000                               ' monochrome
  flag.mono = %TRUE
END IF

IF MsThere THEN
  mflg.allow = %TRUE                                  ' mouse present
  mflg.mouse = %TRUE                                  ' mouse active
  DIM matrix(1 : 25, 1 : 80) AS SHARED INTEGER        ' screen matrix
END IF

FUNCTION MsThere AS INTEGER
  ! push DS                 ; save DS for PowerBASIC
  ! xor  AX, AX             ; clear AX
  ! int  &H33               ; call mouse driver
  ! xor  BX, BX             ; clear BX, assume no mouse present

  ! or   AX, AX             ; does AX = 0?
  ! jz   MsThereDone        ; yes, we're done
  ! dec  BX                 ; no, make it -1
MsThereDone:
  ! mov  FUNCTION, BX       ; put BX in RetVal variable
  ! pop  DS                 ; restore DS
END FUNCTION

FUNCTION GetMouseOrKey
  STATIC t$                                            ' actual time
  MsStatus oldButn, oldRow, oldCol
  IF oldButn = 1 THEN oldKey = matrix(oldRow, oldCol)  ' avoid repeating
  DO

    IF t$ <> TIME$ THEN
      t$ = TIME$
      IF flag.mono THEN COLOR 0, 7 ELSE COLOR 15, 7
      LOCATE 1, 72, 0
      IF flag.clok THEN PRINT t$ ELSE PRINT SPACE$(8)
    END IF

    MsStatus buttons, row, col

    IF INSTAT THEN
      FUNCTION = CVI( INKEY$ + CHR$(0) )
      EXIT FUNCTION
    ELSEIF (buttons = 1) AND ( matrix(row, col) <> oldKey ) THEN
      FUNCTION = matrix(row, col)
      EXIT FUNCTION
    ELSEIF buttons > 1 THEN                  ' right butn = Escape
      FUNCTION = %ESCAPE
      EXIT FUNCTION
    END IF

  LOOP UNTIL (oldButn = 1) AND (buttons = 0) ' until releasing left butn
  FUNCTION = %ENTER
END FUNCTION

SUB WaitForInput
  DO
    MsStatus buttons, dummy, dummy
  LOOP UNTIL LEN(INKEY$) OR buttons
  MsLocate 1, 1
END SUB

SUB MsCursorOn
  IF mflg.mouse = %FALSE THEN EXIT SUB            ' no mouse, so quit
  IF mflg.mseon = %FALSE THEN                     ' only when mouse is off
    ! push DS                  ; save DS for PowerBASIC
    ! mov  AX, 1               ; mouse driver function 1, turn on cursor
    ! int  &H33                ; call driver
    ! pop  DS                  ; restore DS
    mflg.mseon = %TRUE                            ' mouse cursor on
  END IF
END SUB

SUB MsCursorOff
  IF mflg.mouse = %FALSE THEN EXIT SUB
  IF mflg.mseon THEN
    ! push DS                  ; save DS for PowerBASIC
    ! mov  AX, 2               ; mouse driver function 2, turn off cursor
    ! int  &H33                ; call driver
    ! pop  DS                  ; restore DS
    mflg.mseon = %FALSE                           ' mouse cursor off
  END IF
END SUB

SUB MsLocate(BYVAL row AS INTEGER, BYVAL col AS INTEGER)
  IF mflg.mouse = %FALSE THEN EXIT SUB
  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THEN
    row = (row - 1) * 8
    col = (col - 1) * 8
  END IF

  ! push DS                  ; save DS for PowerBASIC
  ! mov  AX, &H04            ; function 04h, set mouse location
  ! mov  CX, col             ; put column in CX
  ! mov  DX, row             ; put row in DX
  ! int  &H33                ; call mouse interrupt
  ! pop  DS                  ; restore DS for PowerBASIC
END SUB

SUB MsStatus(buttons AS INTEGER, row AS INTEGER, col AS INTEGER)
  IF mflg.mouse = %FALSE THEN EXIT SUB
  ! push DS                  ; save DS for PowerBASIC
  ! mov  AX, &H03            ; function 03h, get mouse status
  ! int  &H33                ; call mouse interrupt
  ! les  DI, buttons         ; point ES:DI to buttons
  ! mov  ES:[DI], BX         ; put active button(s) in variable
  ! les  DI, row             ; point ES:DI to Row
  ! mov  ES:[DI], DX         ; put mouse row in variable
  ! les  DI, col             ; point ES:DI to Column
  ! mov  ES:[DI], CX         ; put mouse column in variable
  ! pop  DS                  ; restore DS for PowerBASIC

  IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THEN
    row = (row \ 8) + 1      ' if text mode, then fix coordinates
    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 = %FALSE 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          ' if text mode, adjust coordinates
    Rows = Rows * 8
    Col  = Col  * 8
    Cols = Cols * 8
  END IF

  ! push DS                  ; save DS for PowerBASIC
  ! mov  CX, Row             ; put start row in CX
  ! mov  DX, Rows            ; put end row in DX
  ! mov  AX, &H08            ; function 08h, set vertical limit
  ! int  &H33                ; call mouse interrupt
  ! mov  CX, Col             ; put start column in CX
  ! mov  DX, Cols            ; put end column in DX
  ! mov  AX, &H07            ; function 07h, set horizontal limit
  ! int  &H33                ; call mouse interrupt
  ! pop  DS                  ; restore DS for PowerBASIC
END SUB

SUB Box(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Rows AS INTEGER, _
        BYVAL Cols AS INTEGER, BYVAL Shape AS INTEGER, BYVAL Attr AS BYTE)

  ' draw a rectangle
  ' original from Power Basic Inc.
  ' modified by Egbert Zylema (NL)

  SELECT CASE Shape

    CASE 1

      ' draw single rectangle
      TL.Char? = 218            ' Ú
      TR.Char? = 191            ' ¿
      BL.Char? = 192            ' À
      BR.Char? = 217            ' Ù
      Hor?     = 196            ' Ä
      Vert?    = 179            ' ³

    CASE 2

      ' draw double rectangle
      TL.Char? = 201            ' É
      TR.Char? = 187            ' »
      BL.Char? = 200            ' È
      BR.Char? = 188            ' ¼
      Hor?     = 205            ' Í
      Vert?    = 186            ' º

    CASE 0

      ' background without frame
      ' cleans the area when attri is set to zero
      TL.Char? = 32
      TR.Char? = 32
      BL.Char? = 32
      BR.Char? = 32
      Hor?     = 32
      Vert?    = 32
  END SELECT

  ! push DS                 ; save DS

  ! mov  AX, VideoAddress   ; put screen segment in AX
  ! mov  ES, AX             ;  and in ES

  ! mov  AX, Row            ; put row in AX
  ! dec  AX                 ; minus one
  ! mov  CX, 160            ; AX =
  ! mul  CX                 ;   AX * 160
  ! mov  DI, AX             ; put it in DI
  ! mov  AX, Col            ; put column in AX
  ! dec  AX                 ; minus one
  ! shl  AX, 1              ; times 2
  ! add  DI, AX             ; add to DI

  ! mov  DX, Rows           ; put rows in DX
  ! dec  DX                 ; minus top row
  ! dec  DX                 ; minus bottom row

  ! mov  CX, Cols           ; put columns in CX
  ! dec  CX                 ; minus left column
  ! dec  CX                 ; minus right column

  ! mov  AH, Attr           ; put attribute in AH

  ! push CX                 ; save CX (columns)
  ! push DI                 ;  and DI (screen location)
  ! mov  AL, TL.Char?       ; put top left char in AL
  ! stosw                   ; write it to the screen
  ! mov  AL, Hor?           ; put top char in AL
  ! rep  stosw              ; write it to the screen CX times
  ! mov  AL, TR.Char?       ; put top right char in AL
  ! stosw                   ; write it to the screen
  ! pop  DI                 ; restore DI
  ! pop  CX                 ;  and CX

HorizLoop:
  ! add  DI, 160            ; move to next row on the screen
  ! push CX                 ; save CX
  ! push DI                 ;  and DI
  ! mov  AL, Vert?          ; put left char in AL
  ! stosw                   ; write it to the screen
  ! mov  AL, 32             ; put a space in AL
  ! rep  stosw              ; write it to the screen CX times
  ! mov  AL, Vert?          ; put right char in AL
  ! stosw                   ; write it to the screen
  ! pop  DI                 ; restore DI
  ! pop  CX                 ;  and CX
  ! dec  DX                 ; one less row
  ! jnz  HorizLoop          ; loop until DX (rows) = 0

  ! add  DI, 160            ; move to next row on the screen
  ! mov  AL, BL.Char?       ; put bottom left char in AL
  ! stosw                   ; write it to the screen
  ! mov  AL, Hor?           ; put bottom char in AL
  ! rep  stosw              ; write it to the screen CX times
  ! mov  AL, BR.Char?       ; put bottom right char in AL
  ! stosw                   ; write it to the screen

  ! pop  DS                 ; restore DS for PowerBASIC
END SUB

SUB repaint(row, col, attri, length)
  start  = (row - 1) * 160 + (col - 1) * 2
  finish = start + (length - 1) * 2
  DEF SEG = VideoAddress
  FOR offset = start TO finish STEP 2
    POKE offset + 1, attri                     ' color offset
  NEXT
  DEF SEG
END SUB

FUNCTION YesNo(header$)
  MsCursorOff
  IF flag.mono THEN attri = 15 ELSE attri = 63
  question$ = "Are you sure?"
  IF LEN(question$) < LEN(header$) THEN
    length = LEN(header$)
  ELSE
    length = LEN(question$)
  END IF
  col = (80 - length) \ 2
  Box 10, col - 2, 7, length + 4, 2, attri
  Box 13, 33, 3, 13, 1, attri
  COLOR attri MOD 16, attri \ 16
  LOCATE 11, col : PRINT header$
  LOCATE 12, col : PRINT "Are you sure?"
  LOCATE 13, 39  : PRINT CHR$(194)                     ' Â
  LOCATE 14, 34  : PRINT " Yes ";CHR$(179);" No  "     ' ³
  LOCATE 15, 39  : PRINT CHR$(193)                     ' Á
  IF flag.mono THEN
    repaint 14, 36,  7, 3         ' normal white (initials are intense)
    repaint 14, 42,  7, 1
  ELSE
    repaint 14, 35, 62, 1         ' initials yellow on cyane
    repaint 14, 41, 62, 1
  END IF
  DEF SEG = VideoAddress
  YesNoScrn$ = PEEK$(160, 3840)
  DEF SEG

  init = %TRUE : result = %FALSE
  ERASE matrix
  FOR cell = 34 TO 38
    matrix(14, cell) = ASC("Y")
  NEXT
  FOR cell = 40 TO 44
    matrix(14, cell) = ASC("N")
  NEXT
  MsSetWindow 12, col - 2, 2, length + 2
  DO
    MsCursorOn
    IF init THEN
      init = %FALSE
      KeyIn = %TAB
    ELSE
      KeyIn = GetMouseOrKey
    END IF
    SELECT CASE KeyIn
      CASE ASC("Y"), ASC("y")
        result = %TRUE
        KeyIn = %ENTER
      CASE ASC("N"), ASC("n"), %ESCAPE
        result = %FALSE
        KeyIn = %ENTER
      CASE %TAB
        IF result THEN
          result = %FALSE : offset = 40
        ELSE
          result = %TRUE  : offset = 34
        END IF
    END SELECT
    MsCursorOff
    DEF SEG = VideoAddress
    POKE$ 160, YesNoScrn$
    DEF SEG
    repaint 14, offset, 15, 5
    IF flag.mono THEN
      repaint 14, offset, 112, 5         ' inverse
    ELSE
      repaint 14, offset + 1, 14, 1      ' yellow
    END IF
  LOOP UNTIL KeyIn = %ENTER
  FUNCTION = result
  MainMatrix
END FUNCTION

' ............... end of library routines ........................

SUB MainMatrix
  ERASE matrix
  CALL MenuBarMatrix
  row = 3 : col = 4
  FOR count = 1 TO 30                              ' 30 files displayed
    FOR cell = col TO col + 11                     ' length = 12
      matrix(row, cell) = count + 256              ' no ASCII values
    NEXT
    INCR col, 14
    IF col = 74 THEN
      INCR row : col = 4
    END IF
  NEXT

  FOR cell = 1 TO 80                               ' mouse out of bounds
    matrix(2, cell) = %UP                          ' to simulate up &
    matrix(9, cell) = %DOWN                        ' down arrow
  NEXT
END SUB

SUB MenuBarMatrix
  FOR cell = 5 TO 8
    matrix(1, cell)     = %ALTF
    matrix(1, cell + 7) = %ALTI
  NEXT
  FOR cell = 19 TO 25
    matrix(1, cell)     = %ALTO
  NEXT
END SUB

SUB DrawMenuBar
  SHARED bar$
  COLOR 0, 7
  LOCATE 1, 1 : PRINT SPACE$(80);
  LOCATE 1, 5 : PRINT "File   Info   Options"
  IF flag.mono = %FALSE THEN
    repaint 1,  5, 116, 1
    repaint 1, 12, 116, 1
    repaint 1, 19, 116, 1
  END IF
  DEF SEG = VideoAddress
  bar$ = PEEK$(0, 50)
  DEF SEG
END SUB

SUB DrawMainScreen
  shape = 2                                          ' double frame
  attri = 15                                         ' intense white
  start = 1                                          ' record to start with
  total = 30                                         ' 30 records
  Box 2, 1, 20, 80, shape, attri                     ' draw rectangle

  CollectFileNames
  DisplayFiles start, total

  DEF SEG = VideoAddress
  MainScreen = PEEK$(160, 3840)                      ' exclude menubar
  DEF SEG
  COLOR 7,0
  LOCATE 25, 4
  PRINT "Press F1 for help";
END SUB

SUB CollectFileNames
  FileToFind$ = DIR$("C:\DOS\*.*")
  DO WHILE LEN(FileToFind$)
    INCR count
    FileName(count) = FileToFind$ + SPACE$(12 - LEN(FileToFind$))
    IF count = UBOUND(FileName) THEN EXIT DO         ' don't exceed 60
    FileToFind$ = DIR$
  LOOP
  ARRAY SORT FileName()                              ' alfabetic order
END SUB

SUB DisplayFiles(start, total)
  COLOR 15, 0
  row = 3 : col = 4
  FOR count = start TO start + total - 1
    LOCATE row, col
    PRINT FileName(count)
    INCR col, 14
    IF col = 74 THEN
      INCR row : col = 4
    END IF
  NEXT
END SUB

SUB DosEscape
  IF BIT(pbvHost, 5) <> 0 THEN EXIT SUB     ' don't try this in the IDE
  DefaultDir$ = CURDIR$
  DEF SEG = VideoAddress
  OldScreen$ = PEEK$(0, 4000)
  COLOR 7, 0
  CLS
  LOCATE 1, 1
  PRINT "Type EXIT and press ENTER to return..."
  SHELL

  ' restore drive and directory
  IF LEFT$(CURDIR$, 2) <> LEFT$(DefaultDir$, 2) THEN
    CHDRIVE LEFT$(DefaultDir$, 2)
  END IF
  IF CURDIR$ <> DefaultDir$ THEN CHDIR DefaultDir$
  POKE$ 0, OldScreen$
  DEF SEG
END SUB

SUB ShowText
  IF flag.mono THEN attri = 112 ELSE attri = 94
  Box 5, 5, 15, 69, 0, attri
  COLOR attri MOD 16, attri \ 16
  RESTORE readmedata
  FOR count = 1 TO 13
    READ me$
    LOCATE count + 5, 6 : PRINT me$
  NEXT
  LOCATE 14, 43 : PRINT CHR$(34)
  LOCATE 14, 48 : PRINT CHR$(34)
  WaitForInput
END SUB

SUB About
  IF flag.mono THEN attri = 112 ELSE attri = 78
  Box 3, 10, 5, 26, 1, attri
  COLOR attri MOD 16, attri \ 16
  RESTORE aboutdata
  FOR count = 1 TO 3
    READ abt$
    LOCATE count + 3, 12 : PRINT abt$
  NEXT
  WaitForInput
END SUB

SUB HelpText
  IF flag.mono THEN attri = 112 ELSE attri = 31
  Box 3, 10, 11, 39, 1, attri
  COLOR attri MOD 16, attri \ 16
  RESTORE helpdata
  FOR count = 1 TO 9
    READ help$
    LOCATE count + 3, 12 : PRINT help$
    IF flag.mono = %FALSE AND count > 1 THEN
      repaint count + 3, 12, 30, 5                  ' yellow on blue
    END IF
  NEXT
  WaitForInput
END SUB

SUB DrawMenu(menu$(), options, column, length, letter$)
  shape = 1
  flag.menu = %TRUE
  IF flag.mono THEN attri = 112 ELSE attri = 127
  rows = UBOUND(menu$) + 2
  cols = LEN(menu$(1)) + 1                          ' + 2 - 1 (asterix)
  MsSetWindow 0, 0, options + 2, 28
  ERASE matrix
  MenuBarMatrix
  MsCursorOff
  repaint 1, column + 1, 12, 1
  repaint 1, column + 2,  7, length - 1
  Box 2, column - 1, rows, cols, shape, attri
  COLOR attri MOD 16, attri \ 16
  FOR count = 1 TO UBOUND(menu$)
    split    = INSTR(menu$(count), "*")
    PartTwo$ = MID$(menu$(count), split + 1)
    letter$  = letter$ + UCASE$(LEFT$( PartTwo$, 1) )
    offset   = column + split - 1
    LOCATE count + 2, column
    PRINT LEFT$(menu$(count), split - 1) + partTwo$

    IF flag.mono = %FALSE THEN
      repaint count + 2, offset, attri + 4 - attri MOD 16, 1  ' red
    END IF

    FOR cell = column TO column + cols - 3
      matrix(count + 2, cell) = count + 256
    NEXT
  NEXT
END SUB

SUB FileMenu(choice)
  RESTORE filemenudata
  READ column, options
  REDIM MenuItem(1 : options) AS LOCAL STRING
  FOR count = 1 TO options
    READ MenuItem(count)
  NEXT
  length = 4
  DrawMenu MenuItem(), options, column, length, letter$
  InRow = 1                                        ' 1 per row
  exclude = %ALTF
  length = LEN( MenuItem(1) ) - 1                  ' minus asterix
  ScrollMenu letter$, options, InRow, column, exclude, length, result
  SELECT CASE result
    CASE 1
      ScreenMenu
    CASE 2
      MsCursorOff
      DosEscape
    CASE 3
      ' return result to main menu to avoid recursion
      choice = %ALTX
    CASE %LEFT, %ALTO
      choice = %ALTO
    CASE %RIGHT, %ALTI
      choice = %ALTI
  END SELECT
END SUB

SUB InfoMenu(choice)
  RESTORE infomenudata
  READ column, options
  REDIM MenuItem(1 : options) AS LOCAL STRING
  FOR count = 1 TO options
    READ MenuItem(count)
  NEXT
  length = 4
  DrawMenu MenuItem(), options, column, length, letter$
  InRow = 1                                        ' 1 per row
  exclude = %ALTI
  length = LEN( MenuItem(1) ) - 1                  ' minus asterix
  ScrollMenu letter$, options, InRow, column, exclude, length, result
  SELECT CASE result
    CASE 1
      choice = %F1
    CASE 2
      MsCursorOff
      ShowText
    CASE 3
      MsCursorOff
      About
    CASE %RIGHT, %ALTO
      choice = %ALTO
    CASE %LEFT, %ALTF
      choice = %ALTF
  END SELECT
END SUB

SUB OptionsMenu(choice)
  IF mflg.allow THEN options = 2 ELSE options = 1
  REDIM MenuItem(1 : options) AS LOCAL STRING

  IF flag.clok THEN extra$ = "ff " ELSE extra$ = "n  "
  MenuItem(1) = " *Time  o" + extra$
  IF options = 2 THEN
    IF mflg.mouse THEN plus$ = "ff " ELSE plus$ = "n  "
    MenuItem(2) = " *Mouse o" + plus$
  END IF
  column = 18
  length = 7
  DrawMenu MenuItem(), options, column, length, letter$
  InRow = 1
  exclude = %ALTO
  length = LEN( MenuItem(1) ) - 1                  ' minus asterix
  ScrollMenu letter$, options, InRow, column, exclude, length, result
  question$ = "Time to be switched off!"
  SELECT CASE result
    CASE 1
      IF flag.clok THEN
        IF YesNo(question$) THEN flag.clok = %FALSE
      ELSE
        flag.clok = %TRUE
      END IF
    CASE 2
      IF mflg.allow = %FALSE THEN EXIT SELECT
      IF mflg.mouse THEN mflg.mouse = %FALSE ELSE mflg.mouse = %TRUE
      MsLocate 1, 1
    CASE %LEFT, %ALTI
      choice = %ALTI
    CASE %RIGHT, %ALTF
      choice = %ALTF
  END SELECT
END SUB

SUB ScreenMenu
  STATIC FirstChar$
  MainMatrix
  IF FirstChar$ = "" THEN
    FOR count = 1 TO UBOUND(FileName)
      FirstChar$ = FirstChar$ + LEFT$(FileName(count), 1)
    NEXT
  END IF
  options = UBOUND(FileName)
  InRow = 5
  column = 4
  exclude = 0
  length = LEN( FileName(1) )
  MsSetWindow 0, 0, 9, 80
  ScrollMenu FirstChar$, options, InRow, column, exclude, length, result
  MsCursorOff
  COLOR 15, 0
  LOCATE 20, 4 : PRINT "You selected ";
  IF result THEN
    PRINT FileName(result);
    COLOR 7
    LOCATE 25, 4 : PRINT "Press any key or click mouse button";
    WaitForInput
  END IF
END SUB

SUB ScrollMenu(letter$, options, InRow, column, exclude, length, result)
  SHARED bar$                                   ' see: DrawMenuBar

  ' LEGEND:
  ' letter$ = marked characters of menu options
  ' options = number of array elements
  ' InRow   = elements per row
  ' column  = first column
  ' exclude = value of the key that opened the menu
  ' length  = length of each element

  first = 1                                     ' first element main screen
  IF flag.menu THEN                             ' menu scrolling
    total   = options                           ' all options on screen
    between = 0                                 ' no spaces
  ELSE                                          ' screen scrolling
    init = %TRUE
    total   = 30                                ' 30 filenames
    between = 2                                 ' 2 spaces in between
  END IF

  DEF SEG = VideoAddress
    MenuScrn$ = PEEK$(160, 3840)                ' initial screen
  DEF SEG
  MsCursorOn

  DO
    IF init THEN
      init = %FALSE
      action = %RIGHT
    ELSE
      action = GetMouseOrKey
    END IF
    SELECT CASE action
      CASE %ESCAPE
        result = 0
        EXIT DO
      CASE 65 TO 90, 97 TO 122
        match = INSTR( letter$, UCASE$(CHR$(action)) )
        IF match THEN
          result = match
          IF flag.menu THEN EXIT DO
        END IF
      CASE %LEFT, %RIGHT
        IF flag.menu THEN
          result = action
          EXIT DO
        ELSE
          CALL LeftRight(action, result, options)
        END IF
      CASE %UP, %DOWN
        MsStatus buttons, row, col
        UpDown action, row, InRow, options, result, cursor
        IF (buttons = 1) AND (cursor > 2) THEN MsLocate cursor, col
      CASE %HOME, %END
        IF action = %HOME THEN result = 1 ELSE result = options
      CASE 257 TO total + 256
        result = action + first - 257
      CASE %ALTF, %ALTI, %ALTO
        IF flag.menu = %FALSE THEN EXIT SELECT
        IF action = exclude THEN result = 0 ELSE result = action
        IF result THEN EXIT DO
    END SELECT
    MsCursorOff

    ' do we need to refresh the main screen?
    IF flag.menu = %FALSE THEN
      IF refresh(result, first, total, InRow) THEN
        DisplayFiles first, total
        DEF SEG = VideoAddress
        MenuScrn$ = PEEK$(160, 3840)
        DEF SEG
      END IF
    END IF

    DEF SEG = VideoAddress
    POKE$ 160, MenuScrn$
    DEF SEG

    IF result THEN
      row = (result - first) \ InRow : INCR row, 3
      col = ( (result - first) MOD InRow ) * (length + between)
      INCR col, column
      IF flag.menu THEN attri = 7 ELSE attri = 112
      repaint row, col, attri, length
    END IF
    MsCursorOn
  LOOP UNTIL action = %ENTER
  MsCursorOff
  IF flag.menu THEN
    DEF SEG = VideoAddress
    POKE$ 0, bar$
    POKE$ 160, MainScreen
    DEF SEG
    flag.menu = %FALSE
  END IF
END SUB

SUB LeftRight(action, result, options)
  SELECT CASE action
    CASE %LEFT  : IF result > 1 THEN DECR result
    CASE %RIGHT : IF result < options THEN INCR result
  END SELECT
END SUB

SUB UpDown(action, row, InRow, options, result, cursor)
  old = result
  SELECT CASE action
    CASE %UP
      DECR result, InRow
      cursor = row + 1
    CASE %DOWN
      INCR result, InRow
      cursor = row - 1
  END SELECT
  SELECT CASE result
    CASE < 1
      IF flag.menu THEN result = options ELSE result = old
    CASE > options
      IF flag.menu THEN result = 1 ELSE result = old
  END SELECT
END SUB

FUNCTION refresh(result, first, total, InRow)
  SELECT CASE result
    CASE 0
      FUNCTION = %FALSE
      EXIT FUNCTION
    CASE => first + total
      DO WHILE result => first + total
        INCR first, InRow
      LOOP
      FUNCTION = %TRUE
    CASE < first
      DO WHILE result < first
        DECR first, InRow
      LOOP
      FUNCTION = %TRUE
    CASE ELSE
      FUNCTION = %FALSE
  END SELECT
END FUNCTION

SUB MainMenu
  DO
    IF choice THEN
      KeyIn = choice
      choice = 0
    ELSE
      KeyIn = GetMouseOrKey
    END IF
    SELECT CASE KeyIn
      CASE %ALTX
        IF YesNo("Quitting demo") THEN
          MsCursorOff
          COLOR 7, 0
          CLS
          SYSTEM
        END IF
      CASE %F1   : Helptext
      CASE %ALTI : InfoMenu choice
      CASE %ALTF : FileMenu choice
      CASE %ALTO : OptionsMenu choice
    END SELECT
    MsCursorOff
    DEF SEG = VideoAddress
    POKE$ 160, MainScreen
    DEF SEG
    MsSetWindow 0, 0, 25, 80
    MsCursorOn
  LOOP
END SUB

' sample main
CLS
  flag.clok = %TRUE         ' time on
  DrawMenuBar
  DrawMainScreen
  MainMatrix
  MsLocate 1, 1
  MsCursorOn
  MainMenu
END