'===========================================================================
' Subject: TEXT COLOR PALETTE FILE LOADER     Date: 04-29-98 (02:49)       
'  Author: Andrew S. Gibson                   Code: QB, QBasic, PDS        
'  Origin: zapf_dingbat@juno.com            Packet: TEXT.ABC
'===========================================================================
'Text Color Pal file loading program for aimed for command line use
'during any system session. The InVal and MidChar functions are Ethan
'Winer's & I'm not sure who the Txtpalset sub belongs to.
'97% coded by Zapf_DingBat.
'The E-Mail address is Zapf_DingBat@JUNO.COM
'for those who can compile this, use
' BC TCPSET /O/E
'and link using this
' LINK TCPSET+SMALLERR.OBJ+NOCOM.OBJ/NOE/FAR/PACKC/EX
' (if you don't need FPU emulation use this:
'  LINK TCPSET+SMALLERR.OBJ+NOCOM.OBJ+NOEM.OBJ/NOE/FAR/PACKC/EX
'  that version will be really small !)
' oh remember to add directory paths where needed...

DEFINT A-Z
DECLARE FUNCTION IntVal% (Work$)
DECLARE FUNCTION MidChar% (Work$, Position)
DECLARE SUB Txtpalset (col%, R%, G%, B%)

CONST VersionHeader$ = "Text Color Pal Save File Version .03á"

PRINT "Text Color Pal palette setting program version 0.1": PRINT

Filename$ = COMMAND$

ON ERROR GOTO EHandler
OPEN Filename$ FOR INPUT AS #1
   LINE INPUT #1, VH$
     IF VH$ <> VersionHeader$ THEN
        ERROR 255
    END IF
   FOR SetPal = 0 TO 15
        LINE INPUT #1, Red$: LINE INPUT #1, Green$: LINE INPUT #1, Blue$
        Rd% = IntVal%(Red$): Gn% = IntVal%(Green$): Be% = IntVal%(Blue$)
        Txtpalset SetPal, Rd%, Gn%, Be%
   NEXT SetPal
CLOSE
END


EHandler:
CLOSE
SELECT CASE ERR
  CASE 52
   PRINT "Program or User Error: Bad File Name or number"
   PRINT "You provided a bad file name or I tried to use a file number that doesn't exist."
  CASE 53
   PRINT "FileManager/User input Error: File not found"
   PRINT "I cannot find the file you requested."
  CASE 54
   PRINT "FileManager/Programmer Error: Bad file mode"
   PRINT "I am unable to read a file properly. Bug fix by programmer required."
  CASE 55
   PRINT "FileManager Error: File already open"
   PRINT "A file was already opened, all files are now closed."
  CASE 57
   PRINT "System Fault: Device I/O error"
   PRINT "I can not 'talk' to a specific device."
  CASE 58
   PRINT "Informative Error: File already exists"
  CASE 59
   PRINT "FileManager Error: Bad record length"
   PRINT "A database record of some sort is not long enough or is too long."
  CASE 61
   PRINT "Informative Error: Disk FULL"
   PRINT "Free up some disk space."
  CASE 62
   PRINT "FileManager Error: Input past end of file."
   PRINT "Attempt to read beyond the end of current file."
  CASE 63
   PRINT "Program Error: Bad record number"
   PRINT "A database record of some sort doesn't exist."
  CASE 64
   PRINT "User Error: Bad file name"
   PRINT "You specifically told me to use a file name that is incorrect."
  CASE 67
   PRINT "FileManager Fault: Too many files open"
   PRINT "I can't open more files than listed in your CONFIG.SYS file."
  CASE 68
   PRINT "System Error: Device UNAVAILABLE"
   PRINT "A user serviceable device is not accessable to the computer."
  CASE 71
   PRINT "User or System Error: Disk not Ready"
   PRINT "Insert a diskette in the current drive. (Excepting Hardrives)"
  CASE 72
   PRINT "Serious Informative Error: Disk-Media error"
   PRINT "The recordable media surface of the current disk has developed a defect."
  CASE 73
   PRINT "Informative Error: Feature unavailable"
   PRINT "An advanced capability is not available within this computer."
  CASE 75
   PRINT "FileManager/User input Error: Path/File access error"
  CASE 76
   PRINT "FileManager/User input Error: Path not found"
   PRINT "The path to a file is non-existant."
  CASE 255
   PRINT Filename$
   PRINT "Is not a Text Color Pal palette file !!!";
  CASE ELSE
   PRINT "Bug squashing Required. Contact orginal programmer."
END SELECT
END

FUNCTION IntVal% (Work$)
 'IntVal is an integer-only VAL substitute that reduces .EXE size up to 10K
  Length = LEN(RTRIM$(Work$))
  Value = 0
  FOR X = Length TO 1 STEP -1
    Temp = MidChar%(Work$, X)
    IF Temp > 47 AND Temp < 58 THEN
      IF X = Length THEN
        Value = Temp - 48
      ELSE
        Value = Value + (Temp - 48) * 10
      END IF
    END IF
  NEXT
  IntVal% = Value
END FUNCTION

FUNCTION MidChar% (Work$, Position)
IF Position <= LEN(Work$) THEN
  MidChar% = ASC(MID$(Work$, Position, 1))
ELSE
  MidChar% = -1
END IF
END FUNCTION

SUB Txtpalset (col%, R%, G%, B%)
C = col
SELECT CASE C
CASE 6
 C = 20
CASE 8 TO 15
 C = C + 48
END SELECT
OUT &H3C8, C: OUT &H3C9, R: OUT &H3C9, G: OUT &H3C9, B
END SUB