home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 17
/
CD_ASCQ_17_101194.iso
/
vrac
/
pbsyntax.zip
/
PBSYNTAX.BAS
< prev
next >
Wrap
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