' deCAL v1.00 (build 81014)
' 14 October 1998: Too many people complaining about CAL.  Calc hacker to the
'   rescue.  ;)
' $INCLUDE: 'qb.bi'
DEFINT A-Z
DECLARE FUNCTION ByteRead% (FileHandle%)
DECLARE FUNCTION checksum& (StringFile%)
DECLARE FUNCTION DblWordRead& (FileHandle%)
DECLARE FUNCTION DEC% (Hexadecimal$)
DECLARE FUNCTION DIR$ (FileSpec$)
DECLARE FUNCTION HeaderRead% (Filename$)
DECLARE FUNCTION StrRead$ (FileHandle%, Length%)
DECLARE FUNCTION WordRead% (FileHandle%)

TYPE file
	CalcType AS STRING * 2
	StringIdentifier AS STRING * 8
	EOFMarker AS STRING * 3
	StringComment AS STRING * 42
	NumOfBytesLess2 AS INTEGER
	NameSkip AS INTEGER
	DataLength AS INTEGER
	TypeCode AS INTEGER
	NameLength AS INTEGER
	VATName AS STRING * 8
	StringLength AS INTEGER
	DataLength2 AS INTEGER
	MajorType AS INTEGER
	MinorType AS INTEGER
	checksum AS LONG
END TYPE

DIM SHARED file AS file

'Used by DOS directory function.
CONST DOS = &H21
CONST SetDTA = &H1A00, FindFirst = &H4E00, FindNext = &H4F00
'Used by deCAL.  ;)
CONST Header$ = "[ deCAL v1.00                                                       Stuntworks ]"
CONST Footer$ = "[ deCAL Copyright (C) 1998 Stuntworks                                          ]"

'Initialize program error handler:
ON ERROR GOTO ErrorHandler

COLOR 0, 7: PRINT Header$; : COLOR 7, 0: PRINT

IF COMMAND$ = "SWX" THEN ERROR 250           'easter egg
IF COMMAND$ = "" THEN ERROR 249

Restart:
'Start main program loop.
Filename$ = DIR$(COMMAND$)
IF LEN(Filename$) = 0 THEN ERROR 249

PRINT TAB(3); "Opening and analyzing "; COMMAND$; "...  ";

foo% = HeaderRead%(COMMAND$)                    'analyze
FileHandle% = FREEFILE                          'open
OPEN COMMAND$ FOR BINARY AS FileHandle%
PRINT "complete."

SELECT CASE foo%
	CASE 0
		PRINT TAB(3); "This file has correct primary and secondary TI-86 headers."
		PRINT TAB(3); "Closing file...  ";
	CASE 1
		'display error messages
		IF file.EOFMarker = CHR$(26) + CHR$(12) + CHR$(0) THEN   'CAL strikes again!
			PRINT TAB(3); "This file is a TI-86 file with a TI-85 secondary header."
		ELSE
			PRINT TAB(3); "This file is a TI-86 file with an unknown secondary header."
		END IF
	  
		PRINT TAB(3); "Patching secondary header...  ";
		bar$ = CHR$(10)   'changing (most likely) $0C to $0A.
		PUT FileHandle%, 10, bar$
		PRINT "patched."
		PRINT TAB(3); "Closing file...  ";
	CASE 2
		PRINT TAB(3); "This file has no TI-86 headers.  It is not an 86x file."
		PRINT TAB(3); "Closing file...  ";
END SELECT

CLOSE FileHandle%
PRINT "file closed."

COLOR 0, 7: PRINT Footer$; : COLOR 7, 0
PRINT : PRINT

END

ErrorHandler:
PRINT "Program abended: Error #"; ERR; ":"

SELECT CASE ERR
	CASE 255
		PRINT SPACE$(17); "File is not a valid 86x file."
	CASE 253
		PRINT SPACE$(17); "This file has an invalid checksum."
	CASE 250
		PRINT SPACE$(17); : COLOR 9: PRINT "Stuntworks"; : COLOR 15: PRINT " Error: "; CHR$(34); "Easter egg"; CHR$(34): COLOR 7
		PRINT SPACE$(17); "deCAL Copyright (C) 1998 Stuntworks."
		PRINT SPACE$(17); "This is v1.00 build 81014, compiled on 14 October 1998."
		PRINT
		PRINT SPACE$(17); "Main Programmer: Nathan Haines    <stuntman@jps.net>"
		'PRINT SPACE$(17); "Beta-testers   : Wayne Chen       <chenw@uci.com>"
		'PRINT SPACE$(34); "Andreas Ess      <ess.andreas@cable.vol.net>"
		PRINT SPACE$(17); "Support        : http://stuntworks.home.ml.org/"
		PRINT SPACE$(34); "stuntman@jps.net"
	CASE 249
		PRINT SPACE$(17); "You did not specify a filename on the command line or"
		PRINT SPACE$(17); "specified a file which does not exist."
		PRINT SPACE$(17); "Here are the 86x files in the current directory:"
		FileSpec$ = "*.86?"
		Found$ = DIR$(FileSpec$)
	  
		DO WHILE LEN(Found$)
NextDIR:
			foo% = HeaderRead(Found$)
			IF foo% < 2 THEN
				FileCount% = FileCount + 1
				IF (FileCount + 5) MOD 25 = 0 THEN
					PRINT "--MORE--";
					DO: LOOP UNTIL INKEY$ <> ""
					LOCATE , 1
				END IF
				PRINT SPACE$(19); Found$;
				SELECT CASE foo%
					CASE 0
						PRINT TAB(35); "Valid TI-86 variable"
					CASE 1
						PRINT TAB(35); "Invalid TI-86 variable"
					CASE 2
						PRINT TAB(35); "Invalid, unspecified type"
				END SELECT
			END IF
			Found$ = DIR$("")
		LOOP
		PRINT SPACE$(16); FileCount%; "file";
		IF FileCount% <> 1 THEN PRINT "s";
		PRINT " found."
	CASE 53
		PRINT SPACE$(17); "System error: "; CHR$(34); "File not found"; CHR$(34)
			PRINT SPACE$(17); "You must specify an existing 86x file."
	CASE ELSE
		PRINT SPACE$(17); "There was an error that is unspecified by the advanced"
		PRINT SPACE$(17); "Stuntworks error handler.  Please contact Stuntworks"
		PRINT SPACE$(17); "for support."
		PRINT SPACE$(15); "http://stuntworks.home.ml.org/          stuntman@jps.net"
END SELECT

COLOR 0, 7: PRINT Footer$; : COLOR 7, 0
PRINT : PRINT

END

FUNCTION ByteRead% (FileHandle%)

'short integer
Bob$ = SPACE$(1)
GET #FileHandle%, , Bob$
foo% = ASC(Bob$)
ByteRead% = foo%

END FUNCTION

' September 7, 1998: i may have finally found the checksum error!  :) Tests
'   were done with xclevel.85s (very big!) which were reported as invalid, and
'   with xcedit.85s (very small!) which were reported as valid.  Half of
'   everything calculated by this program were showing up as valid by Link85.
'   Every time I checked calculated vs. stated checksum, it would come up
'   different.  Now by 2, now by 5, now by 247 (grrr.., hehe).  When I used a
'   fine-toothed hex editor to go through xclevel.85s (with a variance of 5),
'   I did indeed find the number 1,427 (length of variable data).  This is
'   $0593, or in the Z80 (little-endian) format, $9305.  Now, the SEEK state-
'   ment previously sought to 55 ($37), but because file records in QB start
'   with one, it was really seeking to $36 in the file.  This accounts for
'   why the FOR...NEXT loop could not start from 1 (like it was supposed to),
'   but had to start with 0.  Well, with the SEEK changed to 56, and the
'   counter changed to start with "1", xclevel.85s came up with a valid check-
'   sum, and my nightmare is over!!!   :))))  This program is NOW ready for
'   release!
FUNCTION checksum& (StringFile%)

foo& = 0                'August 19, 1998: changed from Foo% to foo&.  ;)
Bob$ = SPACE$(1)
SEEK #StringFile%, 56

FOR Counter% = 1 TO file.NumOfBytesLess2
	GET #StringFile%, , Bob$
	foo& = foo& + ASC(Bob$)
NEXT Counter

checksum& = foo& MOD 65536

END FUNCTION

FUNCTION DblWordRead& (FileHandle%)

'long integer
GET FileHandle%, , DblWordRead&

END FUNCTION

FUNCTION DEC% (Hexadecimal$)

' 6 August 1998: added in single-digit hex support for online help.  ;)
'   Since Hexadecimal$ can be change /by reference/, I did not modify it
'   if it was single-digit.  This would screw some of the other single-digit
'   functions such as SpriteExchange.
' 7 August 1998: fixed problem with DEC% returning 0 for 8-bit hex numbers.
'   Seems when I put in 4-bit support, I forgot the ELSE statement below, hehe
IF LEN(Hexadecimal$) = 1 THEN Foobar$ = "0" + Hexadecimal$ ELSE Foobar$ = Hexadecimal$

DIM Value%(1 TO 2)

	FOR Counter% = 1 TO 2
		Temp$ = UCASE$(MID$(Foobar$, Counter%, 1))
		SELECT CASE Temp$
			CASE CHR$(48) TO CHR$(57)
				Value(Counter%) = ASC(Temp$) - 48
			CASE CHR$(65) TO CHR$(70)
				Value(Counter%) = ASC(Temp$) - 55
		END SELECT
	NEXT Counter%

DEC% = Value%(1) * 16 + Value%(2)

END FUNCTION

DEFSNG A-Z
FUNCTION DIR$ (FileSpec$) STATIC
DIM DTA AS STRING * 44, Regs AS RegTypeX
'-----  Set up our own DTA so we don't destroy COMMAND$
Regs.ax = SetDTA                    'Set DTA function
Regs.dx = VARPTR(DTA)               'DS:DX points to our DTA
Regs.ds = -1                        'Use current value for DS
INTERRUPTX DOS, Regs, Regs          'Do the interrupt
'-----  Check to see if this is First or Next
IF LEN(FileSpec$) THEN              'FileSpec$ isn't null, so
					 'FindFirst
  FileSpecZ$ = FileSpec$ + CHR$(0)   'Make FileSpec$ into an ASCIIZ
					'string
  Regs.ax = FindFirst              'Perform a FindFirst
  Regs.cx = 0                      'Only look for normal files
  Regs.dx = SADD(FileSpecZ$)       'DS:DX points to ASCIIZ file
  Regs.ds = -1                     'Use current DS
ELSE                                'We have a null FileSpec$,
  Regs.ax = FindNext               'so FindNext
END IF
INTERRUPTX DOS, Regs, Regs          'Do the interrupt
'-----  Return file name or null
IF Regs.flags AND 1 THEN            'No files found
  DIR$ = ""                        'Return null string
ELSE
  Nulls = INSTR(31, DTA, CHR$(0))     'Get the filename found
  DIR$ = MID$(DTA, 31, Nulls - 31)  'It's an ASCIIZ string starting
END IF                              'at offset 30 of the DTA
END FUNCTION

DEFINT A-Z
FUNCTION HeaderRead% (Filename$)

StringFile% = FREEFILE                             'assign file number
OPEN Filename$ FOR INPUT AS #StringFile%           'make sure file exists
CLOSE #StringFile%

OPEN Filename$ FOR BINARY AS #StringFile%          'open string file
file.StringIdentifier = StrRead$(StringFile%, 8)   'get string signature
file.EOFMarker = StrRead$(StringFile%, 3)          'get extended signature
file.StringComment = StrRead$(StringFile%, 42)     'get file comment
file.NumOfBytesLess2 = WordRead%(StringFile%)
file.NameSkip = WordRead%(StringFile%)
file.DataLength = WordRead%(StringFile%)
file.TypeCode = ByteRead%(StringFile%)
file.NameLength = ByteRead%(StringFile%)
IF file.StringIdentifier = "**TI85**" THEN        'TI-85 string
	file.VATName = StrRead$(StringFile%, file.NameLength)
ELSE                                               'must be a TI-86 string
	file.VATName = StrRead$(StringFile%, 8)
END IF
file.StringLength = WordRead%(StringFile%)
file.DataLength2 = WordRead%(StringFile%)
SEEK StringFile%, 56 + file.NumOfBytesLess2
GET #StringFile, , file.checksum

SELECT CASE file.StringIdentifier            'checks file signatures
	CASE "**TI86**"
		foo% = 0
		IF file.EOFMarker <> CHR$(26) + CHR$(10) + CHR$(0) THEN foo% = 1
	CASE ELSE
		foo% = 2
END SELECT

CLOSE #StringFile%

HeaderRead% = foo%

END FUNCTION

FUNCTION StrRead$ (FileHandle%, Length)

'fixed-length string (0 length for ASCIIZ)
SELECT CASE Length
	CASE 0
		Temp$ = SPACE$(1)
		DO
			GET #FileHandle%, , Temp$
			foo$ = foo$ + Temp$
		LOOP UNTIL Temp$ = CHR$(0)
		Bob$ = foo$
		IF RIGHT$(Bob$, 1) = CHR$(0) THEN Bob$ = LEFT$(Bob$, LEN(Bob$) - 1)
	CASE ELSE
		Bob$ = SPACE$(Length)
		GET #FileHandle%, , Bob$
END SELECT

StrRead$ = Bob$

END FUNCTION

FUNCTION WordRead% (FileHandle%)

'long integer
GET FileHandle%, , WordRead%

END FUNCTION