home *** CD-ROM | disk | FTP | other *** search
/ CD-X 1 / cdx_01.iso / demodisc / basq / source / 3dvektor / qb / dark.bas next >
Encoding:
BASIC Source File  |  1994-10-29  |  2.0 KB  |  99 lines
  1. INPUT " Palette file           : "; d$
  2. IF d$ = "" THEN d$ = "pal.pal"
  3.  
  4. INPUT " Range        default 16: "; rng
  5. IF rng = 0 THEN rng = 16
  6.  
  7. INPUT " XRef file name         : "; c$
  8. IF c$ = "" THEN c$ = "darken.xrf"
  9.  
  10. DIM r%(256 * rng + 256), g%(256 * rng + 256), b%(256 * rng + 256)
  11.  
  12. GOSUB getpal
  13.  
  14. ' Now find all conbinations for glenz/transparent polygons
  15. ' Colours with total intensity less than 15 are scrapped (63+63+63=189 max)
  16.  
  17. pels% = 256 * rng
  18.  
  19. ' Find darkest colour ii% - (for low intensity scrapping)
  20.  
  21. dd% = 5000
  22. ii% = 1
  23.  
  24.  FOR z% = 1 TO 255
  25.   d% = r%(z%) + g%(z%) + b%(z%)
  26.   IF d% < dd% THEN dd% = d%: ii% = z%
  27.  NEXT z%
  28.  
  29. PRINT
  30. PRINT " Generating darker colours"
  31.  
  32.  FOR x% = 0 TO rng - 1
  33.  i = (x% + 5) / (rng + 4)
  34.  
  35.   FOR z% = 0 TO 255
  36.   qq% = z% + x% * 256 + 256
  37.  
  38.   r%(qq%) = (r%(z%) * i):  ' this is the actual darken calculation
  39.   g%(qq%) = (g%(z%) * i)
  40.   b%(qq%) = (b%(z%) * i)
  41.  
  42. mok:
  43.   IF r%(qq%) + g%(qq%) + b%(qq%) < 15 THEN r%(qq%) = r%(qq%) * 1.3 + 1: g%(qq%) = g%(qq%) * 1.3 + 1: b%(qq%) = b%(qq%) * 1.3 + 1: GOTO mok
  44.  
  45.   NEXT z%
  46.  NEXT x%
  47.  
  48. dist% = 2
  49.  
  50. PRINT pels%; "new colours calculated"
  51.  
  52. ' Collect and output cross referancing tables
  53.  
  54. PRINT "Writing cross referancing tables"
  55.  
  56. OPEN c$ FOR OUTPUT AS #1
  57.  
  58.  FOR z% = 0 TO rng - 1
  59.  PRINT #1, "dark"; LTRIM$(RTRIM$(STR$(z%))); TAB(10); "db ";
  60.  
  61.   cc% = 0
  62.  
  63.   FOR x% = 0 TO 255
  64.   qq% = 256 + z% * 256 + x%
  65.  
  66.    uu% = 5000
  67.  
  68.    FOR rr% = 0 TO 255
  69.     ff% = ABS(r%(rr%) - r%(qq%)) + ABS(g%(rr%) - g%(qq%)) + ABS(b%(rr%) - b%(qq%))
  70.     IF ff% < uu% THEN uu% = ff%: jj% = rr%
  71.    NEXT rr%
  72.  
  73.    PRINT #1, LTRIM$(RTRIM$(STR$(jj%)));
  74.    cc% = cc% + 1
  75.    IF cc% < 16 THEN PRINT #1, ",";
  76.    IF cc% = 16 THEN PRINT #1, "": cc% = 0: IF x% <> 255 THEN PRINT #1, TAB(10); "db ";
  77.  
  78.   NEXT x%
  79.   PRINT #1, ""
  80.  NEXT z%
  81.  
  82. CLOSE #1
  83. END
  84.  
  85. getpal:
  86. OPEN d$ FOR BINARY AS #1
  87.  
  88. P$ = SPACE$(256 * 3): GET #1, , P$
  89.  
  90. FOR a = 0 TO 256 - 1
  91. r%(a) = ASC(MID$(P$, a * 3 + 1, 1))
  92. g%(a) = ASC(MID$(P$, a * 3 + 2, 1))
  93. b%(a) = ASC(MID$(P$, a * 3 + 3, 1))
  94. NEXT a
  95.  
  96. CLOSE #1
  97. RETURN
  98.  
  99.