' This QBasic program prints itself on the
' screen with syntax highlighting.
' Written by Zsolt Nagy-Perge in April 12, 2017.

DEFINT A-Z
DECLARE SUB CPRINT (C, T$)

CONST F$ = "hilight.bas"

CONST TABS = 4

CLS

' Make sure the input file exists.
ON ERROR GOTO ErrorHandler
OPEN F$ FOR INPUT AS #1: CLOSE #1

' Fix negative file size.
OPEN F$ FOR BINARY AS #1
Z& = LOF(1)
IF Z& < 0 THEN Z& = &H7FFFFFFF

' Highlighed QBasic keywords:
K$ = " REM IF THEN ELSE ELSEIF FOR NEXT TO DO WHILE LOOP UNTIL WEND SELECT CASE GOTO SUB GOSUB FUNCTION DECLARE END EXIT STEP SYSTEM CONST DIM SHARED COMMON STATIC REDIM CALL RETURN RESUME LET DEFINT DEFDBL DEFLNG DEFSNG DEFSTR DATA ERROR STOP INTEGER DOUBLE LONG STRING SINGLE AS TYPE IS NOT OR XOR AND MOD EQV IMP WAIT "

DIM SHARED C AS STRING * 1  ' Store a byte from file

P& = 0    ' File pointer

W$ = ""   ' OUTPUT BUFFER

B$ = ""   ' READ BUFFER for searching keywords
	 
LINES = 0
DO
BEGIN:

	IF INKEY$ = CHR$(27) THEN EXIT DO   ' Pressing [Esc] ends program.

	IF P& = Z& THEN EXIT DO             ' Did we reach the end of file?
	P& = P& + 1

	GET #1, P&, C

	B = A          ' B <- Save previous character
	A = ASC(C)     ' A <- Get this character

	IF A = 10 OR A = 13 THEN
		GOSUB ISKEYWORD
	   
		IF B = 10 OR B = 13 THEN IF NOT A = B THEN A = 0: GOTO BEGIN
		PRINT

		W$ = ""     ' Most recent statement
		B$ = ""
		L = 0       ' Length of most recent statement
		CC = 15     ' Color
		LINES = LINES + 1
		IF LINES > 22 THEN
			COLOR 15, 4
			LOCATE 25, 1: PRINT "  Press any key to continue..."; SPACE$(50);
			COLOR 7, 0
			DO WHILE INKEY$ = "": LOOP
			CLS
			LINES = 0
		END IF
		GOTO BEGIN
	END IF

	IF CC = 11 THEN CPRINT 11, C: GOTO BEGIN

	IF A = 34 THEN     ' String begins or ends
		IF CC = 15 THEN GOSUB ISKEYWORD
		IF CC = 13 THEN CC = 15 ELSE CC = 13
		COLOR 13: PRINT CHR$(34);
		GOTO BEGIN
	END IF

	IF CC = 13 THEN CPRINT 13, C: GOTO BEGIN
   
	IF A = 39 THEN
		IF CC = 15 THEN GOSUB ISKEYWORD
		CC = 11
		CPRINT 11, C
		GOTO BEGIN
	END IF

	' Search for whole keywords
	IF A = 32 OR A = 9 OR A = 58 OR A = 59 OR A = 34 OR A = 41 THEN
		GOSUB ISKEYWORD
		CPRINT 15, C
		W$ = ""
		B$ = ""
		L = 0
	ELSE
		L = L + 1
		IF L <= 12 THEN
			W$ = W$ + C
		ELSE
			CPRINT 15, W$ + C
			W$ = ""
		END IF
	END IF
LOOP
GOSUB ISKEYWORD
CLOSE
END

' Looks for keywords
ISKEYWORD:
	B$ = UCASE$(W$)
	P = INSTR(K$, " " + B$ + " ")
	IF P < 1 THEN CC = 15
	IF P = 1 THEN CC = 11
	IF P > 1 THEN CC = 14
	CPRINT CC, W$
	L = 0
	W$ = ""
	B$ = ""
RETURN:


ErrorHandler:
L$ = CHR$(13)
E$ = "Cannot read file"
SELECT CASE ERR
	CASE 53: E$ = "File not found"
	CASE 76: E$ = "Path not found"
	CASE 75: E$ = "Path/File access error"
	CASE 64: E$ = "Bad file name"
	CASE 57: CASE 70: CASE 71: CASE 72: CASE 79: CASE 86:
	CASE ELSE: PRINT L$; "Program terminated unexpectedly."; L$; L$; "ERROR CODE ="; ERR; L$: END
END SELECT
PRINT L$; E$ + " - "; F$; L$
CLOSE

REM This is a comment.
END   ' and so is this :)

SUB CPRINT (C, T$)
   
	COLOR C
	FOR I = 1 TO LEN(T$)
		X = ASC(MID$(T$, I, 1))
		IF X = 9 THEN
			PRINT SPACE$(TABS);
		ELSE
			IF X > 6 AND X < 32 THEN PRINT ".";  ELSE PRINT CHR$(X);
		END IF
	NEXT I

END SUB