'===========================================================================
' Subject: SAVE PALETTE AS DATA STATEMENTS   Date: 04-21-98 (04:10)       
' Author:  Andrew S. Gibson                  Code: QB, QBasic, PDS        
' Origin:  zapf_dingbat@juno.com           Packet: GRAPHICS.ABC
'===========================================================================
'Converts 256 color palette file that are 768 bytes in length to DATA lines.
'You'll need QuickBASIC, E-mail address is Zapf_DingBat@JUNO.COM
'Program has internal, but dated help - I wrote this when I didn't
'know any direct access VGA stuff...
DEFINT A-Z
DECLARE SUB Help ()
DECLARE SUB Pause ()

IF COMMAND$ <> "" THEN Help: END
CLS
PRINT "Palette file converter version 1.0 for BASIC by Andrew Gibson": PRINT
LINE INPUT "Input Name for Palette data file >"; InpName$
LINE INPUT "Output Name for BASIC data statement file >"; OutName$
IF InpName$ = "" OR OutName$ = "" THEN PRINT : PRINT "Conversion aborted.": END
LOCATE 10, 29: PRINT "ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸";
LOCATE 11, 29: PRINT "³ °°°°°°°°°°°°°°°°°°°°° ³";
LOCATE 12, 29: PRINT "³   0% Percent Complete ³";
LOCATE 13, 29: PRINT "ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;";
Handle = FREEFILE
Handle2 = Handle + 1

ON ERROR GOTO Handler
OPEN InpName$ FOR BINARY AS #Handle
OPEN OutName$ FOR OUTPUT AS #Handle2

FOR PalFile = 0 TO 767 STEP 3
Red$ = INPUT$(1, #Handle)
Green$ = INPUT$(1, #Handle)
Blue$ = INPUT$(1, #Handle)

PRINT #Handle2, "DATA " + STR$(ASC(Red$)) + "," + STR$(ASC(Green$)) + "," + STR$(ASC(Blue$))
Percent$ = Percent$ + STRING$(INT(PalFile * 22) \ 768, 219)
LOCATE 11, 31: PRINT Percent$; : Percent$ = ""
LOCATE 12, 29: PRINT USING "³ ###% Percent Complete ³"; (101& * PalFile) \ 768;

NEXT PalFile
CLOSE
END

Handler:
CLOSE : LOCATE 14, 1: PRINT
IF OutName$ <> InpName$ OR InpName$ <> OutName$ THEN
   KILL InpName$: KILL OutName$
ELSEIF OutName$ = InpName$ THEN
   KILL OutName$
ELSEIF InpName$ = OutName$ THEN
KILL InpName$
END IF
 SELECT CASE ERR
        CASE 5
        PRINT "Error Number :" + STR$(ERR) + "  Cannot perform internal function request"
        CASE 7
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Out of memory"
        CASE 14
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Out of string space"
        CASE 51
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: INTERNAL ERROR"
        CASE 52
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Bad File Name or number"
        CASE 54
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Bad file mode"
        CASE 55
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: File already open"
        CASE 57
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Device I/O error"
        CASE 58
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: File already exists"
        CASE 59
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Bad record length"
        CASE 61
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Disk FULL"
        CASE 62
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Input past end of file"
        CASE 63
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Bad record number"
        CASE 64
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Bad file name"
        CASE 67
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Too many files"
        CASE 68
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Device UNAVAILABLE"
        CASE 71
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Disk not Ready"
        CASE 72
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Disk-Media error"
        CASE 73
        PRINT "Error Number :" + STR$(ERR) + "  Program Error: Feature unavailable"
        CASE 75
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Path/File access error"
        CASE 76
        PRINT "Error Number :" + STR$(ERR) + "  Disk Error: Path not found"
        CASE 53
            CLOSE
            PRINT "Error Number :" + STR$(ERR) + "  Disk Error: File not found"
   CASE ELSE
 END SELECT
PRINT : PRINT "Pal2Dat file coversion cannot continue."
END

SUB Help
VIEW PRINT 1 TO 24: CLS
PRINT "Palette file converter version 1.0 for BASIC by Andrew Gibson": PRINT
PRINT "This program is used to convert DAC palette files to DATA statements"
PRINT "for BASIC. The DAC palette files are exactly 768 bytes in length with"
PRINT "3 bytes that represent Red, Green, Blue for all 256 colors. 256*3=768"
PRINT "The resulting DATA statement file will have 256 lines is this format:": PRINT
PRINT "DATA  42, 63, 0": PRINT
PRINT "The palette is calculated in BASIC as follows:": PRINT
PRINT "'Read Palette data statements"
PRINT "ColorChange = -1: FOR N = 1 TO 768 STEP 3"
PRINT "ColorChange = ColorChange + 1: READ R, G, B"
PRINT "CL& = (B * 256 ^ 2) + (G * 256) + R"
PRINT "PALETTE ColorChange, CL&: NEXT N": PRINT
PRINT "This code sets a variable name ColorChange to -1, initializes a"
PRINT "for/next loop which causes ColorChange to advance one, reads three"
PRINT "bytes, sends the three bytes to the Long Integer calculator, and the"
PRINT "palette statement Loads the appropriate color for the color number."
Pause
PRINT "You should use the RESTORE statement with a data label to help"
PRINT "organize your code. The Palette Calculator formula shouldn't be"
PRINT "changed at all, except if you want to change the letter variables"
PRINT "to different positions which will change the order of your colors"
PRINT "or make new ones. If you are using a an all gray palette then the"
PRINT "three variable's postitions do not matter (in the Palette"
PRINT "Calculator formula).": PRINT
PRINT "If you need to store the calcuated results you HAVE to use a Long"
PRINT "Integer array like this,": PRINT
PRINT "DIM SHARED Paldef&(255) - (You might need to reference this array"
PRINT "somewhere else in your program.)": PRINT
PRINT "and to store the Palette Calculator results insert after the"
PRINT "Palette Calculator line like this:": PRINT
PRINT "'Read Palette data statements"
PRINT "ColorChange = -1: FOR N = 1 TO 768 STEP 3"
PRINT "ColorChange = ColorChange + 1: READ R, G, B"
PRINT "CL& = (B * 256 ^ 2) + (G * 256) + R: Paldef&(ColorChange) = CL&"
PRINT "PALETTE ColorChange, CL&: NEXT N"
Pause
PRINT "There are many different ways to do this, the information is aimed"
PRINT "towards the beginner, who may be trying to figure this process out."
PRINT "I was ignorant of this process, learned it, and now shared it with"
PRINT "all of you. The process described herein is compatable with QBasic"
PRINT "and Microsoft QuickBASIC 4.x": PRINT
PRINT "Basic program operation:": PRINT
PRINT "You will be asked to the proper name for the palette file, the"
PRINT "name can be any standard normal filename. The same idea is in"
PRINT "order for the output file name, too. You can (just like using copy)"
PRINT "use pathnames to specify the location of a Source or Destination"
PRINT "filename even across diskdrives and directories. If you make a"
PRINT "mistake then you have the chance to correct it, the left and right"
PRINT "arrow keys are used to move the cursor to the place at which you"
PRINT "have made an error and type over it, or if you have to insert"
PRINT "some text you can press the insert key to activate the text"
PRINT "insertion mode. The cursor will change slightly when you press"
PRINT "insert. A flat cursor means that overstrike is active, tall cursor"
PRINT "means insertion made is active. If you bump certain keys you will"
PRINT "hear an annoying beep which means that the key will not be accepted."
PRINT "Blank filenames (at either prompt) are not accepted and are"
PRINT "considered to be the `signal' to abort the program."
Pause
PRINT "If anything goes wrong the program will cease to operate and"
PRINT "describe what happened. If you see this,": PRINT
PRINT "Error Number : 5  Cannot perform internal function request": PRINT
PRINT "then you would have to start over, because i'm using a clever but"
PRINT "`touchy' conversion scheme. This program is bug free when used"
PRINT "according to the instructions. An error that is caused is most"
PRINT "likely of human origins. Errors may also be issued because of a"
PRINT "potential equipment failure. Most errors aren't serious."
VIEW PRINT 1 TO 25: LOCATE CSRLIN, 1, 0
END SUB

SUB Pause
LOCATE CSRLIN, 1: PRINT "Press a key to continue ...."; : WHILE INKEY$ = "": WEND: LOCATE CSRLIN, 1: PRINT STRING$(28, 32);
END SUB