CD Actual 15/CDACTUAL15.iso/cdactual/program/basic/PBCLON21.ZIP/PBC$BAS.ZIP/FILEMENU.BAS

BASIC Source File | 1993-01-11 | 11.5 KB | 305 lines

'   +----------------------------------------------------------------------+
'   |                                                                      |
'   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
'   |                                                                      |
'   +----------------------------------------------------------------------+

   TYPE FileName
      Arf AS STRING * 12     ' because TYPE is still pretty brain-dead
   END TYPE

   DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
   DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
   DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
   DECLARE SUB Delay18th (BYVAL WaitTime%)
   DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
   DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
   DECLARE SUB FileSort (Array() AS FileName, Elements%)
   DECLARE SUB FindFirstFx (Buffer$, FileName$, BYVAL FAttr%, ErrCode%)
   DECLARE SUB FindNextFx (Buffer$, ErrCode%)
   DECLARE FUNCTION GetAttrFx% (Buffer$)
   DECLARE FUNCTION GetCRT2% ()
   DECLARE FUNCTION GetEGA2% ()
   DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
   DECLARE SUB GetMouseLoc (Row%, Column%)
   DECLARE FUNCTION GetNameFx$ (Buffer$)
   DECLARE FUNCTION GetVGA2% ()
   DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
   DECLARE SUB MMButton (LeftB%, RightB%)
   DECLARE SUB MMCursorOff ()
   DECLARE SUB MMCursorOn ()
   DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
   DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
   DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)

SUB FileMenu (Mouse%, FileSpec$, SeekAttr%, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, FileListAttr%, HiliteAttr%, TitleAttr%, Title$, Grow%, Shade%)

   CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
   IF Visible% THEN LOCATE , , 0

   MaxFile% = 2048                          ' 2,048 files should be plenty (!)
   DIM File(1 TO MaxFile%) AS FileName

   GetVidMode VMode%, Cols%, Page%          ' use active display page

   IF GetCRT2% THEN                         ' use fast display unless CGA
      IF GetEGA2% OR GetVGA2% THEN
         Fast% = -1
      ELSE
         Fast% = 0
      END IF
   ELSE
      Fast% = -1
   END IF

   RightCol% = LeftCol% + 13                ' set right column
   Rows% = BottomRow% - TopRow% + 1         ' and number of rows

   IF Shade% THEN
      CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
   ELSE
      CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
   END IF
   DIM SavedScreen%(Words%)

   '--- load file list
   LastFile% = 0
   Buffer$ = SPACE$(64)
   FindFirstFx Buffer$, FileSpec$, ABS(SeekAttr%), ErrCode%
   DO UNTIL ErrCode%
      tmp% = GetAttrFx%(Buffer$)
      IF SeekAttr% >= 0 OR (SeekAttr% < 0 AND ((tmp AND 31) = -SeekAttr)) THEN
         IF LastFile% < MaxFile% THEN
            LastFile% = LastFile% + 1
            IF tmp% AND 16 THEN        ' capitalize subdirectories
               File(LastFile%).Arf = UCASE$(GetNameFx$(Buffer$))
            ELSE                       ' normal files get lowercase treatment
               File(LastFile%).Arf = LCASE$(GetNameFx$(Buffer$))
            END IF
         ELSE
            ErrCode% = -1
         END IF
      END IF
      IF ErrCode% = 0 THEN FindNextFx Buffer$, ErrCode%
   LOOP

   FileSort File(), LastFile%

   TopRec% = 1
   HiliteRow% = 1

   '--- save the screen
   IF Mouse% THEN MMCursorOff
   DSeg% = VARSEG(SavedScreen%(1))
   DOfs% = VARPTR(SavedScreen%(1))
   IF Shade% THEN
      DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
   ELSE
      DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
   END IF

   UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
   WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleAttr%, Title$, Page%, Fast%
   IF Mouse% THEN MMCursorOn
   GOSUB DisplayFiles

   DO
      '--- get input from appropriate device(s)
      IF LeftButton% THEN Delay18th 1
      DO
         IF Mouse% THEN MMButton LeftButton%, RightButton%
         IF LeftButton% = 0 AND RightButton% = 0 THEN
            BIOSInkey AsciiCode%, ScanCode%
         END IF
      LOOP UNTIL LeftButton% OR RightButton% OR AsciiCode% OR ScanCode%
      '--- handle mouse input, if any
      IF Mouse% THEN
         IF RightButton% THEN
            AsciiCode% = 27
         ELSEIF (LastFile% < 1) AND LeftButton% THEN
            AsciiCode% = 27
         ELSEIF LeftButton% THEN
            GetMouseLoc MouseRow%, MouseCol%
            IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
               IF MouseCol% = RightCol% + 1 THEN
                  tmp% = SCREEN(MouseRow%, MouseCol%)
                  IF tmp% = 24 THEN
                     ' convert to ^E (same as up arrow)
                     AsciiCode% = 5
                  ELSEIF tmp% = 25 THEN
                     ' convert to ^X (same as down arrow)
                     AsciiCode% = 24
                  END IF
               ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
                  IF MouseRow% - TopRow% + TopRec% <= LastFile% THEN
                     HiLiteRow% = MouseRow% - TopRow% + 1
                     AsciiCode% = 13
                  END IF
               END IF
            END IF
         END IF
      END IF
      '--- handle keyboard input, if any
      IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
         IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
            GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
            SELECT CASE AsciiCode%
               CASE 3                     ' ^QC converts to ^<PgDn>
                  AsciiCode% = 0
                  ScanCode% = 118
               CASE 18                    ' ^QR converts to ^<PgUp>
                  AsciiCode% = 0
                  ScanCode% = 132
               CASE ELSE
                  AsciiCode% = 0
                  ScanCode% = 0
            END SELECT
         END IF
         IF AsciiCode% = 0 AND ScanCode% = 71 THEN
            ' <HOME>
            IF HiliteRow% > 1 THEN
               HiliteRow% = 1
               GOSUB DisplayFiles
            END IF
         ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
            ' <END>
            IF TopRec% + Rows% > LastFile% THEN
               HiliteRow% = LastFile% - TopRec% + 1
            ELSE
               HiliteRow% = Rows%
            END IF
            GOSUB DisplayFiles
         ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
            ' <CTRL><PGDN>
            TopRec% = LastFile% - Rows% + 1
            IF TopRec% < 1 THEN TopRec% = 1
            IF TopRec% + Rows% > LastFile% THEN
               HiliteRow% = LastFile% - TopRec% + 1
            ELSE
               HiliteRow% = Rows%
            END IF
            GOSUB DisplayFiles
         ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
            ' <CTRL><PGUP>
            IF TopRec% > 1 OR HiliteRow% > 1 THEN
               TopRec% = 1
               HiliteRow% = 1
               GOSUB DisplayFiles
            END IF
         ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
            ' ^C or PgDn
            IF TopRec% + 2 * Rows% - 1 < LastFile% THEN
               TopRec% = TopRec% + Rows%
            ELSE
               TopRec% = LastFile% - Rows% + 1
               IF TopRec% < 1 THEN TopRec% = 1
            END IF
            IF TopRec% > LastFile% THEN TopRec% = LastFile%
            IF TopRec% + HiliteRow% - 1 >= LastFile% THEN
               HiliteRow% = LastFile% - TopRec% + 1
            END IF
            GOSUB DisplayFiles
         ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
            ' ^E or up arrow
            IF HiliteRow% > 1 OR TopRec% > 1 THEN
               IF HiliteRow% > 1 THEN
                  HiliteRow% = HiliteRow% - 1
               ELSE
                  TopRec% = TopRec% - 1
               END IF
               GOSUB DisplayFiles
            END IF
         ELSEIF AsciiCode% = 13 THEN
            ' <CR>
            IF LastFile% < 1 THEN
               AsciiCode% = 27
               LemmeOuttaHere% = -1
            ELSE
               PickedOne% = (TopRec% + HiLiteRow% - 1 <= LastFile%)
            END IF
         ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
            ' ^X or down arrow
            IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastFile% THEN
               HiliteRow% = HiliteRow% + 1
               GOSUB DisplayFiles
            ELSE
               IF TopRec% + Rows% - 1 < LastFile% THEN
                  TopRec% = TopRec% + 1
                  GOSUB DisplayFiles
               END IF
            END IF
         ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
            ' ^R or PgUp
            IF TopRec% > Rows% THEN
               TopRec% = TopRec% - Rows%
               GOSUB DisplayFiles
            ELSE
               IF TopRec% > 1 THEN
                  TopRec% = 1
                  GOSUB DisplayFiles
               END IF
            END IF
         ELSEIF AsciiCode% = 27 THEN
            ' <ESC>
            LemmeOuttaHere% = -1
         END IF
      END IF
   LOOP UNTIL PickedOne% OR LemmeOuttaHere%

   IF PickedOne% THEN
      FileSpec$ = RTRIM$(File(TopRec% + HiLiteRow% - 1).Arf)
   ELSE
      FileSpec$ = ""
   END IF

   '--- restore the screen
   IF Mouse% THEN MMCursorOff
   DSeg% = VARSEG(SavedScreen%(1))
   DOfs% = VARPTR(SavedScreen%(1))
   IF Shade% THEN
      DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
   ELSE
      DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
   END IF
   IF Mouse% THEN MMCursorOn
   IF Visible% THEN LOCATE , , 1

   EXIT SUB

DisplayFiles:
   IF Mouse% THEN MMCursorOff
   IF LastFile% < 1 THEN
      XQPrint "...no files...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
   ELSE
      ' update scroll bar as needed
      IF Rows% < LastFile% THEN
         FOR Row% = TopRow% TO BottomRow%
            XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
         NEXT
         IF TopRec% > 1 AND Rows% > 1 THEN
            XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
         END IF
         IF TopRec% + Rows% - 1 < LastFile% AND Rows% > 0 THEN
            XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
         END IF
      END IF
      ' update file list
      FOR Row% = 1 TO Rows%
         tmp% = TopRec% + Row% - 1
         IF tmp% <= LastFile% THEN
            St$ = " " + File(tmp%).Arf + " "
         ELSE
            St$ = SPACE$(14)
         END IF
         IF Row% = HiliteRow% THEN
            XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
         ELSE
            XQPrint St$, TopRow% + Row% - 1, LeftCol%, FileListAttr%, Page%, Fast%
         END IF
      NEXT
   END IF
   IF Mouse% THEN MMCursorOn
   RETURN

END SUB