'===========================================================================
' Subject: TSR ASSISTANT FOR PB IDE          Date: 09-19-99 (19:36)       
' Author:  Dieter Folger                     Code: PB                     
' Origin:  folger@bamberg.baynet.de        Packet: PB.ABC
'===========================================================================
$IF 0
  ---------------------------------------------------------------------------
  PBASSI.BAS for PowerBasic
  A TSR program for moving quickly to functions and subs in the IDE.
  Freeware (c) 1996 by Dieter Folger
  ---------------------------------------------------------------------------
  PB-ASSIstant is a handy little TSR for Power Basic programmers. It helps
  you to move quickly to functions and procedures in your source code when
  you are in the Power Basic IDE.
  When PBASSI is resistant, press Alt-F2 and you get a box with a list of
  all FUNCTIONs and SUBs in your source. You can choose by moving the
  cursor up and down and then pressing Enter. As quickly as lightning you
  are at the procedure and can work there. When you choose "Return to
  previous line" you are back at the line where you started from.

  If you have written a new procedure you should press F2 (=Save). Next
  time PBASSI is invoked, the program will read the source again and the
  list of procs is updated.

  You can remove the program from memory with Alt-F2 at the DOS prompt.
  First you get a message that you can only use the program within the IDE.
  If you press 'U' now PBASSI is uninstalled.

  PBASSI supports the mouse. Left button works like Return, right button
  like Esc. If there are more procedures that the window can show, click
  the down arrow for PgDn or the up arrow for PgUp.
  --------------------------------------------------------------------------
$ENDIF
 POPUP MULTIPLEX &HC000, 254   ' reg AX and DX get this pattern as an ID
 REG 1, &HC000 : REG 4, 254    ' set pattern to check for already installed
 CALL INTERRUPT &H2F           ' do the multiplex interrrupt
 IF REG(1)<> &HC000 AND REG(4)<> 254 THEN END
 SaveScreen Temp$
 Box 16, 20, 4, 41, 15, 3
 LOCATE 17, 22
 PRINT "       P B - A S S I S T A N T        "
 LOCATE 18, 22
 PRINT "Now installed. Use in IDE with ALT-F2 "
 LOCATE 19,22
 PRINT "            (Press a key)             "
 WaitKey
 COLOR 7, 0
 RestoreScreen Temp$
 x& = SETMEM(-600000)
 x& = SETMEM(1024)
 POPUP KEY CHR$(8, 60, 119)     ' Alt-F2 is hot key
 SwapFile$ = LEFT$(CURDIR$, 2)+ "\"+ "PBASSI.SWP"
 REG 1, &HC001 : REG 4, 252
 POPUP SLEEP USING EMS, SwapFile$
 WHILE NOT Done
       IF REG(1)= &HC000 AND REG(4)= 254 THEN
          Jingle
          PRINT " PBASSI already installed.  "
          PRINT " If you want to uninstall press ALT-F2 "
          PRINT " and then 'U' to remove it from memory "
       ELSE
          'check if we are in Power Basic's IDE:
          Sc$ = ScreenRead$ (1, 1, 28)
          IF Sc$ <>  "     File     Edit     Search" THEN
             SaveScreen Temp$
             Box 16, 21, 4, 39, 15, 3
             LOCATE 17, 22
             PRINT "   Use PBASSI in PowerBasic IDE only  "
             LOCATE 18, 22
             PRINT "If you want to uninstall press 'U' now"
             LOCATE 19, 22
             PRINT "     or any other key to continue     "
             DO: K$= UCASE$(INKEY$): LOOP UNTIL LEN(K$)
             COLOR 7, 0
             IF K$= "U" THEN
                IF POPUP(1) THEN
                   RestoreScreen Temp$
                   PRINT : PRINT "PBASSI removed from memory"
                   END
                ELSE
                   Jingle
                END IF
             END IF
             RestoreScreen Temp$
             GOTO Go2Sleep
          ELSE
             File$= WorkFile$
             S$= ScreenRead(6, 20, 1)
             IF File$="" OR S$="ÉÍ" THEN
                Jingle
                SaveScreen Temp$
                Box 16, 23, 3, 34, 15, 3
                LOCATE 17, 24
                PRINT "Cannot continue. Quit menu first."
                LOCATE 18, 24
                PRINT "          (Press a key)          "
                Waitkey
                RestoreScreen Temp$
                GOTO Go2Sleep
             END IF
             IF DIR$(File$)= "" THEN     'we have an empty new file
                Jingle
                GOTO Go2Sleep
             END IF
             OPEN File$ FOR INPUT AS #1  ' Read sourcefile and get
             Fs&= LOF(1)                 '      filesize
             IF Fs&<> Ofs& THEN          ' when old and new size do
                Ofs&= Fs&                ' not match read source again
                Procs = 100              ' increase value for large programs
                REDIM Cmd$(Procs)        ' the source file again
                FOR i= 1 TO Procs: Cmd$(i)= "": NEXT
                MaxCmd= 1
                Cmd$(MaxCmd)= "Return to previous line"
                WHILE NOT EOF(1)
                      LINE INPUT #1, L$
                      L$= LTRIM$(UCASE$(L$))
                      IF INSTR(L$, "FUNCTION")= 1 OR INSTR(L$, "SUB")= 1 THEN
                         IF INSTR(L$,"FUNCTION") AND INSTR(LTRIM$(MID$(L$,9)),"=") = 1 THEN EXIT IF
                         INCR MaxCmd
                         IF MaxCmd > Procs THEN EXIT LOOP
                         IF INSTR(L$,"'") THEN L$ = LEFT$(L$,INSTR(L$,"'")-1)
                         Cmd$(MaxCmd)= LTRIM$(RTRIM$(L$))
                         LL= LEN(Cmd$(MaxCmd))
                         IF LL> Length THEN Length= LL
                      END IF
                WEND
             END IF
             CLOSE
             IF Cmd$(2)= "" THEN  'It's a program without
                Jingle            ' functions and subs
                GOTO Go2Sleep
             END IF
             IF StartLine$= "" THEN
                IF Screen (21, 1)= 192 THEN
                   StartLine$= ScreenRead$ (21, 4, 4)
                ELSE
                   StartLine$= ScreenRead$ (24, 4, 4)
               END IF
            END IF
            SaveScreen Temp$
            Again:
            F$= ChooseBox$
            IF F$= "Return to previous line" THEN
               IF Screen (21, 1)= 192 THEN
                  PresentLine$= ScreenRead$ (21, 4, 4)
               ELSE
                  PresentLine$= ScreenRead$ (24, 4, 4)
               END IF
               IF StartLine$ = PresentLine$ THEN
                  Jingle
                  GOTO Again
               END IF
            END IF
            RestoreScreen Temp$
            IF LEN(F$) THEN
               IF F$= "Return to previous line" THEN
                  IF LEN(StartLine$) THEN
                     Stuf$= CHR$(0, 0, 31)       'Alt-S = Search
                     POPUP STUFF Stuf$, 5, 0
                     DELAY .07
                     Stuf$= "G"                  'G = Goto line number
                     POPUP STUFF Stuf$, 5, 0
                     DELAY .07
                     Stuf$= Startline$+ CHR$(13) 'Line number + Cr
                     POPUP STUFF STUF$, 5, 0
                     DELAY .07
                     StartLine$= ""
                  END IF
               ELSE
                  DELAY .07
                  Stuf$= CHR$(0,0)+ CHR$(118) 'Ctrl-PgDn = Goto end of text
                  POPUP STUFF Stuf$, 5, 0
                  Stuf$= CHR$(17)+ "F"        'Ctrl-Q+F = Find...
                  POPUP STUFF Stuf$, 5, 0
                  Stuf$= F$+ CHR$(13)         'Insert proc name
                  POPUP STUFF STUF$, 5, 0
                  Stuf$= "BU"+ CHR$(13)       'Search whole text, any case
                  POPUP STUFF STUF$, 3, 0
               END IF
            END IF
         END IF
       END IF
       Go2Sleep:
       REG 1, &HC001: REG 4, 252
       POPUP SLEEP
 WEND
'-----------------------------------
FUNCTION ScreenRead$ (y, x, Length)
'-----------------------------------
 Sc$= ""
 FOR i= x TO x+ Length
   Sc$= Sc$+ CHR$(SCREEN(Y, i))
 NEXT
 ScreenRead$= Sc$
END FUNCTION
'----------------------------------------
FUNCTION WorkFile$ 'Read name of PB file
'----------------------------------------
 F$ = ScreenRead$(2, 2, 73)
 IF INSTR(F$,"Ä") THEN
    File$ = ""      'IDE-Menu active
    EXIT FUNCTION  'window covers filename
 END IF
 REPLACE "Í" WITH "" IN F$
 WorkFile$= F$
END FUNCTION
'------------------------------------
SUB SaveScreen (Scrn$) PUBLIC SHARED
'------------------------------------
  cy%= CSRLIN: cx%= POS(0)
  LOCATE ,, 0
  IF (pbvScrnCard AND 1) = 0 THEN
	Address= &HB800
  ELSE
	Address= &HB000
  END IF
  DEF SEG= Address
      Scrn$= PEEK$(0, 4000)
  DEF SEG
END SUB
'---------------------------------------
SUB RestoreScreen (Scrn$) PUBLIC SHARED
'---------------------------------------
  IF (pbvScrnCard AND 1)= 0 THEN
	Address= &HB800
  ELSE
	Address= &HB000
  END IF
  DEF SEG= Address
      POKE$ 0, Scrn$
  DEF SEG
  LOCATE cy%, cx%, 1
END SUB
'-----------------------------------------------
SUB Box (Row, Col, Rows, Cols, Fgc, Bgc) PUBLIC
'-----------------------------------------------
 COLOR Fgc, Bgc
 LOCATE Row, Col
 PRINT "Ú"+ STRING$(Cols- 1, "Ä")+ "¿"
 LOCATE Row+ Rows, Col
 PRINT "À"+ STRING$(Cols- 1, "Ä")+ "Ù"
 FOR i= 1 TO Rows- 1
     LOCATE Row+ i, Col
     PRINT "³"+ SPACE$(Cols- 1)+ "³"
 NEXT
END SUB
'---------------------------------
FUNCTION ChooseBox$ PUBLIC SHARED
'---------------------------------
 Mouse = M.There
 IF L < 10 THEN Rows = L + 1 ELSE Rows = 11
 Row= 10: Col= 25: Rows= 10: Cols= 30
 Box Row, Col, Rows, Cols, 15,3
 LOCATE Row, Col+ 3
 PRINT " Press RETURN to select "
 LOCATE Row+ Rows, Col+ 6
 PRINT " Press ESC to quit "
 BarLine= Row+ 1
 Start= 1: Offset= 1
 GOSUB WriteBox
 IF Mouse THEN
    M.Window Row+ 1, Col, Rows- 1, Cols+ 1
    M.Cursor 1
 END IF
 DO
   DO
     K$= INKEY$
     IF Mouse THEN
        M.Event Rgt, Lft, Mrow, MCol
        IF Rgt THEN K$= CHR$(27)
        IF Lft THEN
           IF SCREEN(MRow, MCol)= 25 THEN K$= CHR$(0, 81): EXIT IF 'Down
           IF SCREEN(MRow, MCol)= 24 THEN K$= CHR$(0,73): EXIT IF 'Up
           IF MRow> Row AND MRow< Row+ Rows AND MCol> Col _
              AND MCol< Col+ Cols THEN
              ChooseBox$ = Cmd$(Start+ MRow- 11)
              EXIT FUNCTION
           END IF
        END IF
     END IF
   LOOP UNTIL LEN(K$) OR Lft
   SELECT CASE K$
          CASE CHR$(0, 77)  ' Cursor right
               IF Offset< Length- 18 THEN INCR Offset
          CASE CHR$(0, 75)  ' Cursor left
               IF Offset> 1 THEN DECR Offset
          CASE CHR$(0, 80)  ' Cursor down
               IF BarLine< Row+ Rows- 1 AND Barline- Row+ Start- 1< MaxCmd THEN
                  INCR BarLine
               ELSE
                  IF Start+ Rows- 2< MaxCmd THEN INCR Start
               END IF
          CASE CHR$(0, 72)  ' Cursor up
               IF Barline> Row+ 1 THEN
                  DECR Barline
               ELSE
                  IF Start> 1 THEN DECR Start
               END IF
         CASE CHR$(0, 81)  ' Page down
              IF MaxCmd> Rows- 1 THEN
                 INCR Start, Rows- 1
                 IF Start+ Rows- 1> MaxCmd THEN Start= MaxCmd- Rows+ 2
              END IF
         CASE CHR$(0,73)   ' Page up
              DECR Start, Rows- 1: IF Start< 1 THEN Start= 1
         CASE CHR$(0,79)   ' End
              IF Rows<= MaxCmd THEN
                 Start= MaxCmd- (Rows- 2)
              END IF
              Barline= MaxCmd- Start+ Row+ 1
         CASE CHR$(0,71)   ' Home
              Start= 1: BarLine= Row+ 1
         CASE ELSE: EXIT SELECT
  END SELECT
  GOSUB WriteBox
 LOOP UNTIL K$= CHR$(27) OR K$= CHR$(13)
 IF K$= CHR$(27) THEN ChooseBox$= ""
 IF K$= CHR$(13) THEN ChooseBox$= Cmd$(Start+ Barline- Row- 1)
 EXIT FUNCTION
'---------
 WriteBox:
'---------
 IF Mouse THEN M.Cursor 0
 FOR i= Row+ 1 TO Row+ Rows- 1
    IF Start+ i- Row- 1> MaxCmd THEN EXIT FOR
    LOCATE i, Col+ 1
    IF i= Barline THEN COLOR 15, 4 ELSE COLOR 0, 3
    PRINT MID$(Cmd$(Start+ i- Row- 1)+ SPACE$(Cols), Offset, Cols- 2)
    COLOR 14, 3
    LOCATE Row+ Rows- 1,Col+ Cols
    IF Start+ Rows- 1< MaxCmd THEN
       COLOR 14, 1: PRINT CHR$(25)
    ELSE
       COLOR 15, 3: PRINT "³"
    END IF
    LOCATE Row+ 1, Col+ Cols
    IF Start> 1 THEN
       COLOR 14, 1: PRINT CHR$(24)
    ELSE
       COLOR 15, 3: print "³"
    END IF
 NEXT
 COLOR 15, 3
 IF Mouse THEN M.Cursor 1
 RETURN
END FUNCTION
'-----------
SUB WaitKey
'-----------
 DO: K$= INKEY$: LOOP UNTIL LEN(K$)
END SUB
'----------
SUB Jingle
'----------
 SOUND 300, .3: SOUND 700, .3
END SUB
'----------------------------------
FUNCTION M.There PUBLIC AS INTEGER
'----------------------------------
 REG 1, 0
 CALL INTERRUPT &H33
 M.There = REG(1)
END FUNCTION
'--------------------------
SUB M.Cursor (Mode) PUBLIC
'--------------------------
 IF Mode THEN REG 1, 1 ELSE REG 1, 2
 CALL INTERRUPT &H33
END SUB
'-------------------------------------------------
SUB M.Event (R.Button, L.Button, Row, Col) PUBLIC
'-------------------------------------------------
 R.Button = 0 : L.Button = 0 : Row = 0 : Col = 0
 REG 1, 3
 CALL INTERRUPT &H33
 SELECT CASE REG(2)
        CASE 1 : L.Button = 1
        CASE 2 : R.Button = 1
 END SELECT
 IF R.Button=0 AND L.Button=0 THEN EXIT SUB
 Row = REG(4) \ 8 + 1
 Col = REG(3) \ 8 + 1
 ' wait until the button is released
 DO
    REG 1, 3
    CALL INTERRUPT &H33
 LOOP UNTIL REG(2) = 0
END SUB
'------------------------------------------
SUB M.Window (Row, Col, Rows, Cols) PUBLIC
'------------------------------------------
 REG 3, 8 * (Col + Cols - 2)
 REG 4, 8 * (Col - 1)
 REG 1, 7
 CALL INTERRUPT &H33
 REG 3, 8 * (Row - 1)
 REG 4, 8 * (Row + Rows - 2)
 REG 1, 8
 CALL INTERRUPT &H33
END SUB
'=== eof ================================================================