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