REM $TITLE: 'SMALLEXE'

	' How to create a SMALL QB EXEcutable
	' T. G. Muench January 1991

	REM $INCLUDE: 'C:\QBASIC\QB.BI'

	DEFINT A-Z

	' Constants

	CONST FALSE = 0
	CONST TRUE = NOT FALSE

	' Global variables

	COMMON SHARED INPREG AS REGTYPE
	COMMON SHARED OUTREG AS REGTYPE
	COMMON SHARED CR$, LF$, CRLF$

	' Functions and subprograms

	DECLARE FUNCTION FileExist (FILE$)
	DECLARE FUNCTION ReadData$ (DATA$)
	DECLARE FUNCTION ReadTimer& ()
	DECLARE FUNCTION StrToInt& (NUMSTR$)

	DECLARE SUB GetInput (PROMPT$, ENTRY$)
	DECLARE SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$)

Initialization:

	' Sample string data

	DATA$ = "1,2,3,4,5,6,7,8,9,10"
	DATA$ = DATA$ + ",Now,is,the,time,for,all,good,persons,to,come"

	' I/O channel

	CHAN = 1

	' Miscellaneous

	CR$ = CHR$(13)
	LF$ = CHR$(10)
	CRLF$ = CR$ + LF$

	REM $PAGE

StartProgram:

	PRINT : PRINT "Integers"
	START& = ReadTimer&
	FOR I = 1 TO 10
	    PRINT I, StrToInt&(ReadData$(DATA$))
	NEXT I
	PRINT "Ticks = "; ReadTimer& - START&
	CALL GetInput("Press Enter to continue: ", ENTRY$)

	PRINT : PRINT "Strings"
	START& = ReadTimer&
	FOR I = 11 TO 20
	    PRINT I, ReadData$(DATA$)
	NEXT I
	PRINT "Ticks = "; ReadTimer& - START&
	CALL GetInput("Press Enter to continue: ", ENTRY$)

	PRINT : PRINT "Read ASCII file:"
	CALL GetInput("File to read? ", FILE$)
	IF FILE$ = "" THEN
	    BEEP : PRINT "No file specified"
	ELSEIF NOT FileExist(FILE$) THEN
	    BEEP : PRINT "File not found"
	ELSE
	    CALL GetInput("Display lines (Y,N)? ", ENTRY$)
	    IF UCASE$(ENTRY$) = "Y" THEN
		DISPLAY = TRUE
	    ELSE
		DISPLAY = FALSE
	    END IF
	    START& = ReadTimer&
	    OPEN FILE$ FOR BINARY AS #CHAN
	    MAXSIZE = 4 * 1024
	    FILESTAT = 1
	    DO UNTIL FILESTAT = -1
		CALL InputLine(CHAN, MAXSIZE, FILESTAT, LINE$)
		COUNT = COUNT + 1
		IF DISPLAY THEN
		    PRINT LINE$
		END IF
	    LOOP
	    CLOSE #CHAN
	    PRINT : PRINT "Read"; COUNT; "lines"
	    PRINT "Ticks = "; ReadTimer& - START&
	END IF

EndProgram:

	END

	REM $PAGE

	'[]=============================================================[]
	'[]	  Checks to see if a file exists so that it may be 	[]
	'[]			 opened by BASIC			[]
	'[]=============================================================[]

	FUNCTION FileExist (FILE$) STATIC

	NAME$ = FILE$ + CHR$(0)

	INPREG.AX = &H3D00
	INPREG.DX = SADD(NAME$)

	CALL INTERRUPT(&H21, INPREG, OUTREG)

	IF (OUTREG.FLAGS AND 1) THEN
	    FileExist = FALSE
	ELSE
	    FileExist = TRUE
	    '
	    ' Close the file handle
	    '
	    INPREG.AX = &H3E00
	    INPREG.BX = OUTREG.AX
	    CALL INTERRUPT(&H21, INPREG, OUTREG)
	END IF

	END FUNCTION

	'[]=============================================================[]
	'[]	        Gets user input from the keyboard		[]
	'[]=============================================================[]

	SUB GetInput (PROMPT$, ENTRY$) STATIC

	IF PROMPT$ <> "" THEN
	    PRINT PROMPT$;
	END IF

	COL = POS(0)

	ENTRY$ = ""
	DO WHILE TRUE
	    LOCATE CSRLIN, COL, 1
	    CHAR$ = INPUT$(1)
	    SELECT CASE CHAR$
		CASE CHR$(13)
		    PRINT
		    EXIT DO
		CASE CHR$(8)
		    IF LEN(ENTRY$) > 0 THEN
			ENTRY$ = LEFT$(ENTRY$, LEN(ENTRY$) - 1)
			COL = COL - 1
			LOCATE CSRLIN, COL, 1
			PRINT " ";
		    END IF
		CASE ELSE
		    ENTRY$ = ENTRY$ + CHAR$
		    PRINT CHAR$;
		    COL = COL + 1
	    END SELECT
	LOOP

	END SUB

	'[]=============================================================[]
	'[]	   Inputs a line of text from the specified file	[]
	'[]=============================================================[]

	SUB InputLine (IOCHAN, BUFSIZE, STATUS, TEXT$) STATIC

	STATIC TOTBYTES&	' Total #bytes in file
	STATIC BYTES&		' #Bytes read so far
	STATIC SEEKPOS&		' Seek position in file
	STATIC SPOS		' Start of line in buffer

	' Initialize if this is the first call

	IF STATUS = 1 THEN
	    STATUS = 0
	    TOTBYTES& = LOF(IOCHAN)
	    BYTES& = 0
	    SEEKPOS& = 1
	    BUFFER$ = STRING$(BUFSIZE, 0)
	    SPOS = 1
	END IF

	EPOS = INSTR(SPOS, BUFFER$, CRLF$)
	IF EPOS <> 0 THEN
	    '
	    ' Easy - have a full line
	    '
	    TEXT$ = MID$(BUFFER$, SPOS, EPOS - SPOS)
	ELSE
	    ' Partial line - read the next block
	    '  and assemble the full line
	    '
	    IF LEFT$(BUFFER$, 1) = CHR$(0) THEN
		TEXT$ = ""
	    ELSE
		TEXT$ = MID$(BUFFER$, SPOS, BUFSIZE - SPOS + 1)
	    END IF
	    IF (SEEKPOS& + BUFSIZE) > TOTBYTES& THEN
		BUFSIZE = TOTBYTES& - SEEKPOS& + 1
		BUFFER$ = STRING$(BUFSIZE, 0)
	    END IF
	    GET #IOCHAN, SEEKPOS&, BUFFER$
	    BYTES& = BYTES& + BUFSIZE
	    SEEKPOS& = SEEKPOS& + BUFSIZE
	    IF BYTES& = TOTBYTES& THEN
		'
		' Last block needs ending CRLF
		'
		IF RIGHT$(BUFFER$, 2) <> CRLF$ THEN
		    BUFFER$ = BUFFER$ + CRLF$
		    BUFSIZE = BUFSIZE + 2
		END IF
	    END IF
	    IF RIGHT$(TEXT$, 1) = CR$ THEN
		'
		' Special case - CR at end of previous block
		'
		TEXT$ = LEFT$(TEXT$, LEN(TEXT$) - 1)
		EPOS = 0
	    ELSE
		EPOS = INSTR(1, BUFFER$, CRLF$)
		TEXT$ = TEXT$ + MID$(BUFFER$, 1, EPOS - 1)
	    END IF
	END IF

	' Point to start of next line

	SPOS = EPOS + 2

	' All done? If so set status and deallocate buffer

	IF (BYTES& = TOTBYTES& AND EPOS = (BUFSIZE - 1)) THEN
	    BUFFER$ = "" ' This doesn't ERASE
	    STATUS = -1
	END IF

	END SUB

	'[]=============================================================[]
	'[]	      Returns the next string element from the 		[]
	'[]			passed data string			[]
	'[]=============================================================[]

	FUNCTION ReadData$ (DATA$) STATIC

	STATIC COUNT    ' Number of times called
	STATIC SPOS     ' Starting pos in string

	COUNT = COUNT + 1
	IF COUNT = 1 THEN
	    SPOS = 1
	END IF

	EPOS = INSTR(SPOS, DATA$, ",")
	IF EPOS = 0 THEN
	    '
	    ' Assume at end of string
	    '
	    EPOS = LEN(DATA$) + 1
	END IF

	ReadData$ = MID$(DATA$, SPOS, EPOS - SPOS)

	SPOS = EPOS + 1

	END FUNCTION

	FUNCTION ReadTimer& STATIC

	'[]=============================================================[]
	'[]	 Returns the number of clock ticks since midnight	[]
	'[]=============================================================[]

	INPREG.AX = &H0000
	CALL INTERRUPT(&H1A, INPREG, OUTREG)

	IF OUTREG.DX < 0 THEN
	    LO& = 65536 + OUTREG.DX     ' Adjust for signed word
	ELSE
	    LO& = OUTREG.DX
	END IF

	ReadTimer& = (65536 * OUTREG.CX) + LO&

	END FUNCTION

	'[]=============================================================[]
	'[]   Returns the long integer equivalent of a numeric string	[]
	'[]=============================================================[]

	FUNCTION StrToInt& (NUMSTR$) STATIC

	IF LEFT$(NUMSTR$, 1) = "-" THEN
	    NEGATIVE = TRUE
	    WORK$ = RIGHT$(NUMSTR$, LEN(NUMSTR$) - 1)
	ELSE
	    NEGATIVE = FALSE
	    WORK$ = NUMSTR$
	END IF

	VALUE& = 0 : POWER& = 1

	FOR INDX = LEN(WORK$) TO 1 STEP -1
	    BYTE$ = MID$(WORK$, INDX, 1)
	    IF (BYTE$ < "0" OR BYTE$ > "9") THEN
		EXIT FOR
	    ELSE
		VALUE& = VALUE& + (POWER& * (ASC(BYTE$) - 48))
		POWER& = 10 * POWER&
	    END IF
	NEXT INDX

	IF NEGATIVE THEN
	    StrToInt& = -VALUE&
	ELSE
	    StrToInt& = VALUE&
	END IF

	END FUNCTION