DP Tool Club 17/CD_ASCQ_17_101194.iso/vrac/pbsyntax.zip/PBSYNTAX.BAS

BASIC Source File | 1994-08-18 | 7KB | 307 lines

$compile exe
$COM 0
$SOUND 10
$STRING 4
$error ALL off
$LIB ALL OFF

defint a-z
%FALSE = 0
%TRUE = NOT %FALSE
$IF 0
   Syntax.BAS -- This program runs in the backgorund and is intended to
                 highlight the PB keywords.

   PBSyntax <options>
             /r  -  go resident
             /u  -  unload from memory
             /x  - debug info
             /m  - force monochrome
$ENDIF

 %black = 0
 %blue  = 1
 %green = 2
 %cyan  = 3
 %red   = 4
 %magenta = 5
 %brown = 6
 %white = 7
 %gray  = 8
 %ltblue = 9
 %ltgreen = 10
 %ltcyan = 11
 %ltred = 12
 %ltmagenta = 13
 %yellow = 14
 %highwhite = 15
 %blink = 16

StartUp:

TYPE colordefs
  KeywordAttr as byte
  CommentAttr as byte
  CompilerAttr   as byte
END TYPE

dim scolors as colordefs

TYPE screencell
  stext as byte
  attr  as byte
END TYPE

 public scolors

 'you can change the colors below to whatever you wish
 scolors.KeyWordAttr = %Black * 16 + %Yellow
 scolors.CommentAttr = %Black * 16 + %Green
 scolors.CompilerAttr = %Black * 16 + %Cyan

  x& = SETMEM(-700000)
  x& = SETMEM(5000)

  usercommand$ = UCASE$(COMMAND$)   'save command line

  IF INSTR(usercommand$, "/R") > 0 THEN
    RunAsTSR% = -1
  END IF

  IF INSTR(usercommand$,"/M") THEN ForceMono% = -1

  IF INSTR(usercommand$,"/U") THEN 'Uninstall
    REG 1, &HCCCC : REG 2, 1: REG 4, 254    ' pass code 1 in reg 2
    CALL INTERRUPT &H2F   'Tell the resident copy to unload
    IF REG(1)=&HCCCC AND REG(4)=254 AND REG(2)=1 THEN _
        PRINT "PBSyntax Not Loaded ..."      'No tsr is loaded
    END
  END IF

  POPUP MULTIPLEX &HCCCC, 254   ' reg AX and DX get this pattern as an ID
  REG 1, &HCCCC : REG 2,0: REG 4, 254  ' set pattern to check for already installed
  CALL INTERRUPT &H2F           ' do the multiplex interrrupt
  IF REG(2) <> 0 THEN
       PRINT "PBSyntax Already Installed ....."
       BEEP
       END 'we were already installed
  END IF


  DIM PBKeyWords$(1:400), PBWordTypes%(1:400)
  public PBKeyWords$(), PBWordTypes%(), MaxKeyWords%

  MaxKeyWords%= LoadKeyWords
  IF MaxKeyWords < 1 THEN
    PRINT "No Key Words Loaded"
    BEEP
    END
  END IF

  Checking% = %True               'default to active
  POPUP TIMER 18                  'every second
  POPUP KEY CHR$(&H08,&H01,&H70)  'Alt-Esc
  POPUP MULTIPLEX &HCCCC, 254     'reg AX and DX get this pattern as an ID
  POPUP SLEEP USING EMS

WHILE NOT Terminated%
 MainLoop:

  popmethod% = POPUP(4)
  IF popmethod% = 16 AND REG(2)=1 THEN   'unload
    PRINT "Unloading .."
    REG 1, &HCCCC : REG 2,3: REG 4, 254  ' Alter AX,bx,DX to show we were here
    EXIT LOOP
  END IF

  IF popmethod% = 16 AND REG(1)=&HCCCC AND REG(4)=254 THEN
    REG(1), &HCCCC : REG(4),254 : REG(2),3
    POPUP SLEEP
    GOTO MainLOOP
  END IF

  IF popmethod% = 1 THEN
    Checking% = NOT Checking%
    IF Checking% = %False THEN
      POPUP TIMER OFF
      GOTO SkipProcessing
    ELSE
      POPUP TIMER ON
    END IF
  END IF

  'make sure we have a good screen mode

  IF pbvScrnMode <> 7 AND pbvScrnMode <> 0 THEN
      IF LEN(DIR$("Modeerr.log")) = 0 THEN
        EFile = FREEFILE
        OPEN "O",#EFile,"Modeerr.log"
        WRITE #EFile, STR$(pbvScrnMode)
        CLOSE #EFile
      END IF
      POPUP SLEEP
      GOTO MainLoop
  END IF

  CALL HiLightKeyWords

SkipProcessing:
  POPUP SLEEP

WEND

ShutDown:
  Counter% = 1
  IF RunAsTSR% THEN   'give it 5 seconds to uninstall
    POPUP TIMER 9     'popup at .5 second intervals for a max of 10 times
    REG(2), 0
    INCR Counter%
    WHILE Counter% < 10
      POPUP SLEEP
      INCR Counter%
      IF POPUP(1) THEN
        PRINT "PBSyntax Removed from Memory"
        END
      END IF
    WEND
    PRINT "Can NOT Remove PBSyntax ..."
  END IF
  END

SUB HiLightKeyWords

  'get number of lines on the screen
  NumLines% = 25

  DIM ABSOLUTE BIOS(&H300) AS INTEGER AT 0

  IF pbvScrnCard > 3 THEN   'ega or better
     NumLines% = (BIOS(&H242) AND 255) + 1
  END IF

  ERASE BIOS

  MaxCells% = 80 * NumLines%

  IF pbvScrnMode = 7 THEN
    DIM Screenarea(1:4000) as screencell at &HB000
  ELSE
    DIM Screenarea(1:MaxCells%) as screencell at &HB800
  END IF

  'for quick and dirty reasons, we check the whole pb entry area
  'mainly in case of scroll down or up

  currow = 3  'PB starts at line 3, column 2
  curcol = 2

  FOR temprow = currow TO NumLines%  'search for last pb window line
    IF screenarea(((temprow-1) * 80) + 1).stext = 192 THEN
      lastrow = temprow-1
      EXIT FOR
    END IF
  NEXT

  'see if we have an active edit screen .. this is done by checking for the
  'status line of the bottom, pb turns off the status when doing something else

  'determines where the ascii code 180 is this is beginning of the
  'pb area showing row:column

  Statuscell% = Lastrow*80 + 3
  IF screenarea(StatusCell%).stext <> 180 THEN EXIT SUB

  maxcell = ((lastrow-1) * 80) + 79
  currentcell = ((currow-1) * 80) + curcol
  beginofline = ((currow-1) * 80) + 1

  tempword$ = ""
  FoundQuote% = %FALSE

  WHILE currentcell < maxcell
    SELECT CASE screenarea(currentcell).stext
      CASE 13,32,40,41,44: GOSUB ChangeAttr     'CR,space,parens,comma
      CASE 39 : TempData$ = CHR$(39)   'single quote
                INCR currentcell
                GOSUB RemarkTheLine
      CASE 34:  FoundQuote% = NOT FoundQuote%
      CASE ELSE : TempWord$ = TempWord$ + CHR$(screenarea(currentcell).stext)
    END SELECT
    INCR currentcell
    IF currentcell MOD 80 = 1 THEN
      FoundQuote% = %False
      INCR currentcell
      TempWord$ = ""
    END IF
  WEND
  ERASE screenarea
  EXIT SUB

ChangeAttr:
 IF LEN(TempWord$) = 0 THEN RETURN
 IF FoundQuote% THEN RETURN   'no highlights within quote marks
 TempData$ = UCASE$(TempWord$)
 ARRAY SCAN PBKeyWords$() FOR MaxKeyWords%, =TempData$, to found%

 IF found% = 0 THEN
   TempWord$ = ""
   RETURN
 END IF

 IF PBWordTypes(found%) = 3 THEN  'check for a remark
   GOSUB RemarkTheLine
   TempWord$ = ""
   RETURN
 END IF

 newAttr? = scolors.KeyWordAttr   'default to keyword

 IF PBWordTypes(found%) = 1 THEN newattr? = scolors.CompilerAttr

 TempCell = currentcell - LEN(TempData$)
 WHILE TempCell < currentcell
   screenarea(Tempcell).attr = newattr?
   INCR TempCell
 WEND

 TempWord$ = ""
 RETURN

RemarkTheLine:
 currentcell = currentcell - LEN(TempData$)
 WHILE currentcell MOD 80 > 0
   screenarea(currentcell).attr = scolors.CommentAttr
   INCR currentcell
 WEND
 TempWord$ = ""
 RETURN

END SUB

FUNCTION LoadKeyWords
  'see if we can find data file with key words
  IF LEN(DIR$("PBSyntax.DEF")) = 0 THEN
    BEEP
    PRINT "Can not find PBSyntax.DEF"
    LoadKeyWords = -1
    EXIT FUNCTION
  END IF

  inFile% = FREEFILE
  OPEN "I",#inFile%, "PBSyntax.DEF"
  WHILE NOT EOF(inFile%) AND MaxWords% < 350
    INCR MaxWords%
    INPUT #inFile%, a$
    IF LEFT$(a$,2) = "**" THEN
      CurWordType% = VAL(MID$(a$,3,1))
    ELSE
      PBKeyWords$(MaxWords%) = UCASE$(a$)
      PBWordTypes(MaxWords%) = CurWordType%
    END IF
  WEND
  CLOSE #inFile%
  LoadKeyWords = MaxWords%

END FUNCTION