home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBC22B.ZIP / PBC$BAS.ZIP / FILEMENU.BAS < prev    next >
BASIC Source File  |  1993-01-11  |  12KB  |  305 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    TYPE FileName
  8.       Arf AS STRING * 12     ' because TYPE is still pretty brain-dead
  9.    END TYPE
  10.  
  11.    DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
  12.    DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
  13.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  14.    DECLARE SUB Delay18th (BYVAL WaitTime%)
  15.    DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  16.    DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  17.    DECLARE SUB FileSort (Array() AS FileName, Elements%)
  18.    DECLARE SUB FindFirstFx (Buffer$, FileName$, BYVAL FAttr%, ErrCode%)
  19.    DECLARE SUB FindNextFx (Buffer$, ErrCode%)
  20.    DECLARE FUNCTION GetAttrFx% (Buffer$)
  21.    DECLARE FUNCTION GetCRT2% ()
  22.    DECLARE FUNCTION GetEGA2% ()
  23.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  24.    DECLARE SUB GetMouseLoc (Row%, Column%)
  25.    DECLARE FUNCTION GetNameFx$ (Buffer$)
  26.    DECLARE FUNCTION GetVGA2% ()
  27.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  28.    DECLARE SUB MMButton (LeftB%, RightB%)
  29.    DECLARE SUB MMCursorOff ()
  30.    DECLARE SUB MMCursorOn ()
  31.    DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
  32.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  33.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  34.  
  35. SUB FileMenu (Mouse%, FileSpec$, SeekAttr%, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, FileListAttr%, HiliteAttr%, TitleAttr%, Title$, Grow%, Shade%)
  36.  
  37.    CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
  38.    IF Visible% THEN LOCATE , , 0
  39.  
  40.    MaxFile% = 2048                          ' 2,048 files should be plenty (!)
  41.    DIM File(1 TO MaxFile%) AS FileName
  42.  
  43.    GetVidMode VMode%, Cols%, Page%          ' use active display page
  44.  
  45.    IF GetCRT2% THEN                         ' use fast display unless CGA
  46.       IF GetEGA2% OR GetVGA2% THEN
  47.          Fast% = -1
  48.       ELSE
  49.          Fast% = 0
  50.       END IF
  51.    ELSE
  52.       Fast% = -1
  53.    END IF
  54.  
  55.    RightCol% = LeftCol% + 13                ' set right column
  56.    Rows% = BottomRow% - TopRow% + 1         ' and number of rows
  57.  
  58.    IF Shade% THEN
  59.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
  60.    ELSE
  61.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
  62.    END IF
  63.    DIM SavedScreen%(Words%)
  64.  
  65.    '--- load file list
  66.    LastFile% = 0
  67.    Buffer$ = SPACE$(64)
  68.    FindFirstFx Buffer$, FileSpec$, ABS(SeekAttr%), ErrCode%
  69.    DO UNTIL ErrCode%
  70.       tmp% = GetAttrFx%(Buffer$)
  71.       IF SeekAttr% >= 0 OR (SeekAttr% < 0 AND ((tmp AND 31) = -SeekAttr)) THEN
  72.          IF LastFile% < MaxFile% THEN
  73.             LastFile% = LastFile% + 1
  74.             IF tmp% AND 16 THEN        ' capitalize subdirectories
  75.                File(LastFile%).Arf = UCASE$(GetNameFx$(Buffer$))
  76.             ELSE                       ' normal files get lowercase treatment
  77.                File(LastFile%).Arf = LCASE$(GetNameFx$(Buffer$))
  78.             END IF
  79.          ELSE
  80.             ErrCode% = -1
  81.          END IF
  82.       END IF
  83.       IF ErrCode% = 0 THEN FindNextFx Buffer$, ErrCode%
  84.    LOOP
  85.  
  86.    FileSort File(), LastFile%
  87.  
  88.    TopRec% = 1
  89.    HiliteRow% = 1
  90.  
  91.    '--- save the screen
  92.    IF Mouse% THEN MMCursorOff
  93.    DSeg% = VARSEG(SavedScreen%(1))
  94.    DOfs% = VARPTR(SavedScreen%(1))
  95.    IF Shade% THEN
  96.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  97.    ELSE
  98.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  99.    END IF
  100.  
  101.    UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
  102.    WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleAttr%, Title$, Page%, Fast%
  103.    IF Mouse% THEN MMCursorOn
  104.    GOSUB DisplayFiles
  105.  
  106.    DO
  107.       '--- get input from appropriate device(s)
  108.       IF LeftButton% THEN Delay18th 1
  109.       DO
  110.          IF Mouse% THEN MMButton LeftButton%, RightButton%
  111.          IF LeftButton% = 0 AND RightButton% = 0 THEN
  112.             BIOSInkey AsciiCode%, ScanCode%
  113.          END IF
  114.       LOOP UNTIL LeftButton% OR RightButton% OR AsciiCode% OR ScanCode%
  115.       '--- handle mouse input, if any
  116.       IF Mouse% THEN
  117.          IF RightButton% THEN
  118.             AsciiCode% = 27
  119.          ELSEIF (LastFile% < 1) AND LeftButton% THEN
  120.             AsciiCode% = 27
  121.          ELSEIF LeftButton% THEN
  122.             GetMouseLoc MouseRow%, MouseCol%
  123.             IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
  124.                IF MouseCol% = RightCol% + 1 THEN
  125.                   tmp% = SCREEN(MouseRow%, MouseCol%)
  126.                   IF tmp% = 24 THEN
  127.                      ' convert to ^E (same as up arrow)
  128.                      AsciiCode% = 5
  129.                   ELSEIF tmp% = 25 THEN
  130.                      ' convert to ^X (same as down arrow)
  131.                      AsciiCode% = 24
  132.                   END IF
  133.                ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
  134.                   IF MouseRow% - TopRow% + TopRec% <= LastFile% THEN
  135.                      HiLiteRow% = MouseRow% - TopRow% + 1
  136.                      AsciiCode% = 13
  137.                   END IF
  138.                END IF
  139.             END IF
  140.          END IF
  141.       END IF
  142.       '--- handle keyboard input, if any
  143.       IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
  144.          IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
  145.             GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
  146.             SELECT CASE AsciiCode%
  147.                CASE 3                     ' ^QC converts to ^<PgDn>
  148.                   AsciiCode% = 0
  149.                   ScanCode% = 118
  150.                CASE 18                    ' ^QR converts to ^<PgUp>
  151.                   AsciiCode% = 0
  152.                   ScanCode% = 132
  153.                CASE ELSE
  154.                   AsciiCode% = 0
  155.                   ScanCode% = 0
  156.             END SELECT
  157.          END IF
  158.          IF AsciiCode% = 0 AND ScanCode% = 71 THEN
  159.             ' <HOME>
  160.             IF HiliteRow% > 1 THEN
  161.                HiliteRow% = 1
  162.                GOSUB DisplayFiles
  163.             END IF
  164.          ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
  165.             ' <END>
  166.             IF TopRec% + Rows% > LastFile% THEN
  167.                HiliteRow% = LastFile% - TopRec% + 1
  168.             ELSE
  169.                HiliteRow% = Rows%
  170.             END IF
  171.             GOSUB DisplayFiles
  172.          ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
  173.             ' <CTRL><PGDN>
  174.             TopRec% = LastFile% - Rows% + 1
  175.             IF TopRec% < 1 THEN TopRec% = 1
  176.             IF TopRec% + Rows% > LastFile% THEN
  177.                HiliteRow% = LastFile% - TopRec% + 1
  178.             ELSE
  179.                HiliteRow% = Rows%
  180.             END IF
  181.             GOSUB DisplayFiles
  182.          ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
  183.             ' <CTRL><PGUP>
  184.             IF TopRec% > 1 OR HiliteRow% > 1 THEN
  185.                TopRec% = 1
  186.                HiliteRow% = 1
  187.                GOSUB DisplayFiles
  188.             END IF
  189.          ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
  190.             ' ^C or PgDn
  191.             IF TopRec% + 2 * Rows% - 1 < LastFile% THEN
  192.                TopRec% = TopRec% + Rows%
  193.             ELSE
  194.                TopRec% = LastFile% - Rows% + 1
  195.                IF TopRec% < 1 THEN TopRec% = 1
  196.             END IF
  197.             IF TopRec% > LastFile% THEN TopRec% = LastFile%
  198.             IF TopRec% + HiliteRow% - 1 >= LastFile% THEN
  199.                HiliteRow% = LastFile% - TopRec% + 1
  200.             END IF
  201.             GOSUB DisplayFiles
  202.          ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
  203.             ' ^E or up arrow
  204.             IF HiliteRow% > 1 OR TopRec% > 1 THEN
  205.                IF HiliteRow% > 1 THEN
  206.                   HiliteRow% = HiliteRow% - 1
  207.                ELSE
  208.                   TopRec% = TopRec% - 1
  209.                END IF
  210.                GOSUB DisplayFiles
  211.             END IF
  212.          ELSEIF AsciiCode% = 13 THEN
  213.             ' <CR>
  214.             IF LastFile% < 1 THEN
  215.                AsciiCode% = 27
  216.                LemmeOuttaHere% = -1
  217.             ELSE
  218.                PickedOne% = (TopRec% + HiLiteRow% - 1 <= LastFile%)
  219.             END IF
  220.          ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
  221.             ' ^X or down arrow
  222.             IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastFile% THEN
  223.                HiliteRow% = HiliteRow% + 1
  224.                GOSUB DisplayFiles
  225.             ELSE
  226.                IF TopRec% + Rows% - 1 < LastFile% THEN
  227.                   TopRec% = TopRec% + 1
  228.                   GOSUB DisplayFiles
  229.                END IF
  230.             END IF
  231.          ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
  232.             ' ^R or PgUp
  233.             IF TopRec% > Rows% THEN
  234.                TopRec% = TopRec% - Rows%
  235.                GOSUB DisplayFiles
  236.             ELSE
  237.                IF TopRec% > 1 THEN
  238.                   TopRec% = 1
  239.                   GOSUB DisplayFiles
  240.                END IF
  241.             END IF
  242.          ELSEIF AsciiCode% = 27 THEN
  243.             ' <ESC>
  244.             LemmeOuttaHere% = -1
  245.          END IF
  246.       END IF
  247.    LOOP UNTIL PickedOne% OR LemmeOuttaHere%
  248.  
  249.    IF PickedOne% THEN
  250.       FileSpec$ = RTRIM$(File(TopRec% + HiLiteRow% - 1).Arf)
  251.    ELSE
  252.       FileSpec$ = ""
  253.    END IF
  254.  
  255.    '--- restore the screen
  256.    IF Mouse% THEN MMCursorOff
  257.    DSeg% = VARSEG(SavedScreen%(1))
  258.    DOfs% = VARPTR(SavedScreen%(1))
  259.    IF Shade% THEN
  260.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  261.    ELSE
  262.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  263.    END IF
  264.    IF Mouse% THEN MMCursorOn
  265.    IF Visible% THEN LOCATE , , 1
  266.  
  267.    EXIT SUB
  268.  
  269. DisplayFiles:
  270.    IF Mouse% THEN MMCursorOff
  271.    IF LastFile% < 1 THEN
  272.       XQPrint "...no files...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
  273.    ELSE
  274.       ' update scroll bar as needed
  275.       IF Rows% < LastFile% THEN
  276.          FOR Row% = TopRow% TO BottomRow%
  277.             XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
  278.          NEXT
  279.          IF TopRec% > 1 AND Rows% > 1 THEN
  280.             XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  281.          END IF
  282.          IF TopRec% + Rows% - 1 < LastFile% AND Rows% > 0 THEN
  283.             XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  284.          END IF
  285.       END IF
  286.       ' update file list
  287.       FOR Row% = 1 TO Rows%
  288.          tmp% = TopRec% + Row% - 1
  289.          IF tmp% <= LastFile% THEN
  290.             St$ = " " + File(tmp%).Arf + " "
  291.          ELSE
  292.             St$ = SPACE$(14)
  293.          END IF
  294.          IF Row% = HiliteRow% THEN
  295.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
  296.          ELSE
  297.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, FileListAttr%, Page%, Fast%
  298.          END IF
  299.       NEXT
  300.    END IF
  301.    IF Mouse% THEN MMCursorOn
  302.    RETURN
  303.  
  304. END SUB
  305.