'-----------------Zkman Palette-----------------
'
' March 1999
' Simple Palette Creator
' Thanks to Wafn for the neato-keen palette saver
' Use:
' There are two "modes".  Alter color mode, and normal.
' In normal, you can arrow key around the colors, then
' press enter and you switch to "alter mode", where the
' arrow keys, as shown below, will change the rgb or do
' gradients.  The pal saves in BSAVE format.
' ESC - Quit
' Enter - switch from color change to alter color
'   You start in color change mode.
' arrow keys -
'   Color change mode- move thru the palette to
'   select the color you want to alter
'   Alter color mode- up and down raise and lower
'   the rgb components. left and right switch back
'   and forth between the red, green, and blue.
' s -
'   Save your palette. To load it, copy the "loadpal"
'   sub from this program to your program
' l -
'   load a palette
' g - *alter color mode only*
'   Create a "gradient". This asks you for a Starting color
'   number, end color number, and start/end for the rgb's (must
'   be numbers between 0 and 63 for rgb). Will create a gradient
'   based on your choices. Press enter at any choice, and it will
'   default to 0 for that number. Very handy!
'-----------------------------------------------
DECLARE SUB loadpal (filename$)
DECLARE SUB PalSave (filename$)
DEFINT A-Z
mode = 0
part = 1
CLS
SCREEN 13
filer$ = "palette.pal"

curcol = 1
downline = 1
hline = 1
PRINT "zkman's pal editor"
PRINT "Save palette function by Wafn"
FOR i = 1 TO 51
FOR j = 1 TO 5
LINE (10 + i * 5, 120 + j * 5)-STEP(3, 3), i + ((j - 1) * 51), BF
NEXT
NEXT
'FOR i = 1 TO 51
'LINE (10 + i * 5, 120 + 1 * 5)-STEP(3, 3), i, BF
'NEXT
'FOR i = 52 TO 102
'LINE (10 + i * 5, 120 + 2 * 5)-STEP(3, 3), i + 51, BF
'NEXT
LOCATE 20, 11: PRINT "Current Palette"
COLOR 1
LOCATE 21, 11: PRINT "Press S to Save"
COLOR 15
DO
linen = INT((curcol - 1) / 51) + 1
LINE (9 + (curcol - (51 * (linen - 1))) * 5, 119 + linen * 5)-STEP(5, 5), 15, B
SELECT CASE mode
CASE 0
SELECT CASE INKEY$
 CASE CHR$(0) + "M"
 LINE (9 + (curcol - (51 * (linen - 1))) * 5, 119 + linen * 5)-STEP(5, 5), 0, B
 curcol = curcol + 1
 IF (curcol - 1) MOD 51 = 0 THEN curcol = curcol - 51
 CASE CHR$(0) + "K"
 LINE (9 + (curcol - (51 * (linen - 1))) * 5, 119 + linen * 5)-STEP(5, 5), 0, B
 curcol = curcol - 1
 IF curcol = 0 THEN curcol = 255
 IF curcol MOD 51 = 0 THEN curcol = curcol + 51
 CASE CHR$(0) + "H"
 LINE (9 + (curcol - (51 * (linen - 1))) * 5, 119 + linen * 5)-STEP(5, 5), 0, B
 curcol = curcol - 51
 IF curcol < 0 THEN curcol = curcol + 255
 CASE CHR$(0) + "P"
 LINE (9 + (curcol - (51 * (linen - 1))) * 5, 119 + linen * 5)-STEP(5, 5), 0, B
 curcol = curcol + 51
 IF curcol > 255 THEN curcol = curcol - 255
 CASE "s"
 LOCATE 12, 8: INPUT "Save as? ", filer$
 IF filer$ <> "" THEN PalSave filer$
 LOCATE 12, 8: PRINT "                            "

 CASE "l"
 LOCATE 12, 8: INPUT "Load What? ", load$
 IF load$ <> "" THEN loadpal load$
 LOCATE 12, 8: PRINT "                            "


 CASE CHR$(13)
 part = 1
 mode = 1
 CASE CHR$(27)
 END
END SELECT
CASE 1

SELECT CASE INKEY$
 CASE CHR$(0) + "H"
 tempr = 0: tempg = 0: tempb = 0
 IF part = 1 THEN tempr = tempr + 1
 IF part = 2 THEN tempg = tempg + 1
 IF part = 3 THEN tempb = tempb + 1
 IF rr = 63 THEN tempr = 0
 IF gg = 63 THEN tempg = 0
 IF bb = 63 THEN tempb = 0
 OUT &H3C8, curcol
 OUT &H3C9, rr + tempr
 OUT &H3C9, gg + tempg
 OUT &H3C9, bb + tempb

 CASE CHR$(0) + "P"
 tempr = 0: tempg = 0: tempb = 0
 IF part = 1 THEN tempr = tempr - 1
 IF part = 2 THEN tempg = tempg - 1
 IF part = 3 THEN tempb = tempb - 1
 IF rr = 0 THEN tempr = 0
 IF gg = 0 THEN tempg = 0
 IF bb = 0 THEN tempb = 0
 OUT &H3C8, curcol
 OUT &H3C9, rr + tempr
 OUT &H3C9, gg + tempg
 OUT &H3C9, bb + tempb


 CASE CHR$(0) + "M"
 part = part + 1
 IF part = 4 THEN part = 1

 CASE CHR$(0) + "K"
 part = part - 1
 IF part = 0 THEN part = 3

 CASE CHR$(13)
 mode = 0

 CASE "s"
 LOCATE 12, 8: INPUT "Save as? ", filer$
 IF filer$ <> "" THEN PalSave filer$
 LOCATE 12, 8: PRINT "                            "

 CASE "l"
 LOCATE 12, 8: INPUT "Load What?", load$
 IF load$ <> "" THEN loadpal load$
 LOCATE 12, 8: PRINT "                            "

 CASE CHR$(27)
 END

 CASE "g"
 col1 = 0
 col2 = 0
 col3 = 0
 col4 = 0
 col5 = 0
 col6 = 0
 col7 = 0
 col8 = 0
 LOCATE 12, 10: INPUT "Start:", col1
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "End:  ", col2
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "Red Start:", col3
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "Red End:  ", col4
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "Green Start:", col5
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "Green End:  ", col6
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "Blue Start: ", col7
 LOCATE 12, 10: PRINT "                   "
 LOCATE 12, 10: INPUT "Blue End:   ", col8
 LOCATE 12, 10: PRINT "                   "
 pif = col2 - col1
 gradi! = 63 / pif
 IF col4 = 0 AND col3 = 0 THEN
 redgrad! = 0
 ELSE
 redgrad! = (col4 - col3) / pif
 PRINT redgrad!
 END IF
 IF col5 = 0 AND col6 = 0 THEN
 greengrad! = 0
 ELSE
 greengrad! = (col6 - col5) / pif
 PRINT greengrad!
 END IF
 IF col7 = 0 AND col8 = 0 THEN
 bluegrad! = 0
 ELSE
 bluegrad! = (col8 - col7) / pif
 END IF

 
 FOR i = col1 TO col2
 OUT &H3C8, i
 OUT &H3C9, (i - col1) * INT(redgrad!) + col3%
 COLOR 200
 LOCATE 1, 1: PRINT (i - col1)
 LOCATE 2, 1: PRINT INT(redgrad!)
 LOCATE 3, 1: PRINT (i - col1) * INT(redgrad!)
 'SLEEP
 OUT &H3C9, (i - col1) * INT(greengrad!) + col5%
 OUT &H3C9, (i - col1) * INT(bluegrad!) + col7%
 NEXT
END SELECT
COLOR 4
IF part = 1 THEN LOCATE 6, 16: PRINT "Red: "; rr
IF part = 2 THEN LOCATE 8, 16: PRINT "Green: "; gg
IF part = 3 THEN LOCATE 10, 16: PRINT "Blue: "; bb
COLOR 15
END SELECT
LOCATE 6, 4: PRINT "Color: "; curcol
LINE (45, 50)-STEP(20, 20), curcol, BF
OUT 967, curcol
rr = INP(969): gg = INP(969): bb = INP(969)
IF mode = 1 THEN
IF part <> 1 THEN LOCATE 6, 16: PRINT "Red: "; rr
IF part <> 2 THEN LOCATE 8, 16: PRINT "Green: "; gg
IF part <> 3 THEN LOCATE 10, 16: PRINT "Blue: "; bb
END IF
IF mode = 0 THEN
LOCATE 6, 16: PRINT "Red: "; rr
LOCATE 8, 16: PRINT "Green: "; gg
LOCATE 10, 16: PRINT "Blue: "; bb
END IF
LOOP

SUB loadpal (filename$)
DIM pal(512)
DEF SEG = VARSEG(pal(0))
BLOAD filename$, 0
i = 0
FOR c = 0 TO 255
  OUT &H3C8, c
  OUT &H3C9, PEEK(i)
  OUT &H3C9, PEEK(i + 1)
  OUT &H3C9, PEEK(i + 2)
  i = i + 4
NEXT
DEF SEG

END SUB

REM $DYNAMIC
                                'Set default data type as integer
SUB PalSave (filename$)
 DIM TPal(255) AS LONG        'DIM an array to temporarily hold the palette
 DEF SEG = VARSEG(TPal(0))    'Define the segment to the palette array
 
 OUT 966, 255                 'Access Palette (for speed)
 OUT 967, 0                   'Start reading from the first color (0)
 FOR i = 0 TO 255             'Loop 255 times for the whole palette
    
  FOR j = 0 TO 2                        'Loop 3 times, for R, G, and B
   POKE VARPTR(TPal(i)) + j, INP(969)   'Put all the palette data in TPal()
  NEXT j                                'Finish RGB loop
 
 NEXT i                       'Finish palette loop

 IF filename$ <> "" THEN      'Make sure FileName$ isn't empty
 BSAVE filename$, VARPTR(TPal(0)), 1023  'BSAVE the palette to FileName$
 END IF                       'Duh.

DEF SEG                       'Restore the default segment
LOCATE 21, 10: PRINT "Palette was Saved"
SLEEP
COLOR 1
LOCATE 21, 10: PRINT " Press S to Save "
COLOR 15

END SUB