DIM rh%(60), gh%(60), bh%(60), gv%(13), gt%(13), sa(5)
DIM ra%(11, 5), ga%(11, 5), ba%(11, 5)
INPUT "Gamma? "; gm
LINE INPUT "Filename? "; fi$
OPEN fi$ FOR OUTPUT AS #2
REM Read in color wheel
FOR i = 1 TO 60
READ rh%(i), gh%(i), bh%(i)
NEXT i
REM Calculate gray scale
rl = 12
FOR i = 1 TO rl - 1
gv%(i) = INT(85 * (SQR(1 + 15 * (i / rl)) - 1) + .5)
gt%(i) = INT(255 * (gv%(i) / 255) ^ gm + .5)
NEXT i
gv%(0) = 0
gv%(rl) = 255
gt%(0) = 0
gt%(rl) = 255
REM Read in saturation levels
FOR i = 1 TO 5
READ sa(i)
NEXT i
PRINT #2, ""
PRINT #2, ""
FOR hx = 1 TO 60
FOR j = 0 TO 11
FOR i = 0 TO 5
ra%(j, i) = -1
NEXT i
NEXT j
hi = rh%(hx)
IF (gh%(hx) > hi) THEN hi = gh%(hx)
IF (bh%(hx) > hi) THEN hi = bh%(hx)
lu = (82! * rh%(hx) + 123! * gh%(hx) + 50! * bh%(hx)) / 255
su = 255 / hi
IF hi = 255 THEN 790
REM Special processing for dimmed colors
rz = INT(rh%(hx) * su + .5)
gz = INT(gh%(hx) * su + .5)
bz = INT(bh%(hx) * su + .5)
ld = 255 - lu
li = (su - 1) * lu
REM Process fully saturated case
790 gx = 10
800 IF gv%(gx) <= lu THEN 810
gx = gx - 1
GOTO 800
810 vv = gv%(gx) / lu
rf = rh%(hx) * vv
gf = gh%(hx) * vv
bf = bh%(hx) * vv
REM Gamma correction
ra%(gx, 0) = INT(255 * (rf / 255) ^ gm + .5)
ga%(gx, 0) = INT(255 * (gf / 255) ^ gm + .5)
ba%(gx, 0) = INT(255 * (bf / 255) ^ gm + .5)
bu = gv%(gx + 1) / lu
IF bu > su THEN 900
rf = rh%(hx) * bu
gf = gh%(hx) * bu
bf = bh%(hx) * bu
REM Gamma correction
ra%(gx + 1, 0) = INT(255 * (rf / 255) ^ gm + .5)
ga%(gx + 1, 0) = INT(255 * (gf / 255) ^ gm + .5)
ba%(gx + 1, 0) = INT(255 * (bf / 255) ^ gm + .5)
900 REM Process less saturated colors for same hue
FOR ch = 1 TO 5
cm = sa(ch)
rb = INT(rh%(hx) * cm + .5)
gb = INT(gh%(hx) * cm + .5)
bb = INT(bh%(hx) * cm + .5)
IF (hi = 255) THEN 1100
IF (cm < (1 - li / ld)) THEN 1050
fr = (1 - cm) * ld / li
rt = INT(fr * rz + (1 - fr) * rh%(hx) + .5)
gt = INT(fr * gz + (1 - fr) * gh%(hx) + .5)
bt = INT(fr * bz + (1 - fr) * bh%(hx) + .5)
GOTO 1120
1050 ct = cm / (1 - li / ld)
GOTO 1110
1100 ct = cm
rz = rh%(hx)
gz = gh%(hx)
bz = bh%(hx)
1110 rt = INT(rz * ct + 255 * (1 - ct) + .5)
gt = INT(gz * ct + 255 * (1 - ct) + .5)
bt = INT(bz * ct + 255 * (1 - ct) + .5)
1120 REM
lb = (82! * rb + 123! * gb + 50! * bb) / 255
lt = (82! * rt + 123! * gt + 50! * bt) / 255
lr = lt - lb
sb = 1 + (lb / 85): sb = sb * sb - 1
st = 1 + (lt / 85): st = st * st - 1
FOR j = 1 TO 11
IF (gv%(j) > lt) OR (gv%(j) < lb) THEN 1200
aa = (gv%(j) - lb) / lr
rf = rb + ((rt - rb) * aa)
gf = gb + ((gt - gb) * aa)
bf = bb + ((bt - bb) * aa)
REM Gamma correction
ra%(j, ch) = INT(255 * (rf / 255) ^ gm + .5)
ga%(j, ch) = INT(255 * (gf / 255) ^ gm + .5)
ba%(j, ch) = INT(255 * (bf / 255) ^ gm + .5)
1200 REM
NEXT j
NEXT ch
REM Print out array of generated hues
PRINT #2, "Chart for hue "; hx; "
"
PRINT #2, ""
FOR lx = 11 TO 1 STEP -1
REM Eliminate spurious colors
IF ra%(lx, 1) < 0 THEN ra%(lx, 0) = -1
PRINT #2, " "
FOR cx = 0 TO 5
PRINT #2, " "
PRINT #2, "["; st$; "]"
PRINT #2, " "
NEXT cx
PRINT #2, " "
PRINT #2, "["; ss$; ss$; ss$; "]"
PRINT #2, " "
PRINT #2, "
"
NEXT lx
PRINT #2, "
"
NEXT hx
PRINT #2, ""
PRINT #2, ""
CLOSE 2
END
DATA 255, 0, 0, 255, 25, 0, 255, 49, 0, 255, 72, 0, 255, 93, 0
DATA 255, 113, 0, 255, 132, 0, 255, 149, 0, 255, 165, 0, 255, 186, 0
DATA 255, 204, 0, 255, 220, 0, 255, 232, 0, 255, 242, 0, 255, 249, 0
DATA 255, 254, 0, 255, 255, 0, 249, 255, 0, 232, 255, 0, 204, 255, 0
DATA 164, 255, 0, 113, 255, 0, 50, 255, 0, 42, 253, 0, 34, 247, 0
DATA 26, 237, 0, 17, 223, 0, 9, 205, 0, 0, 183, 0, 0, 183, 38, 0
DATA 183, 73, 0, 183, 105, 0, 183, 134, 0, 183, 160, 0, 183, 183
DATA 0, 160, 205, 0, 134, 223, 0, 105, 237, 0, 73, 247, 0, 38, 253
DATA 0, 0, 255, 50, 0, 254, 94, 0, 251, 133, 0, 246, 167, 0, 239
DATA 195, 0, 229, 218, 0, 218, 234, 0, 202, 246, 0, 184, 253, 0, 163
DATA 255, 0, 139, 255, 0, 128, 255, 0, 116, 255, 0, 103, 255, 0, 90
DATA 255, 0, 76, 255, 0, 62, 255, 0, 47, 255, 0, 32, 255, 0, 16
DATA .75, .533, .35, .2, .083