home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p068 / 4.img / COLOR.CDL < prev    next >
Encoding:
Text File  |  1989-01-04  |  6.2 KB  |  295 lines
  1. REM  @(#)CADKEY SOLIDS    color.cdl    2.4    10/31/88
  2. REM  @(#)SOLIDS SYNTHESIS    color.cdl    3.02    1/25/88
  3.  
  4. REM " Program to dynamically change the color palette for CADKEY SOLIDS"
  5. REM " R.H. LaRochelle 11-19-87 "
  6. array colors[3][1]
  7. if ( sizeof(colran) != 0 ) 
  8. goto defined
  9. array colran[9][6] = { \
  10.  1, 2, 15,    1.0, 1.0, 1.0, \
  11.  1, 16, 55,   1.0, 0.0, 0.0, \
  12.  2, 56, 95,   0.0, 1.0, 0.0, \
  13.  3, 96, 135 , 0.0, 0.0, 1.0,\
  14.  4, 136, 175, 0.0, 1.0, 1.0,\
  15.  5, 176, 215, 1.0, 0.0, 1.0,\
  16.  6, 216, 255, 1.0, 1.0, 0.0, \
  17.  7, 1, 15,    1.0, 1.0, 1.0,\
  18.  8, 1, 15,    1.0, 0.0, 0.0     }
  19. :defined
  20. array rgbcol [7][3] = { \
  21. 1,0,0, \
  22. 0,1,0, \
  23. 0,0,1, \
  24. 0,1,1, \
  25. 1,0,1, \
  26. 1,1,0, \
  27. 1,1,1 }
  28. palnum = 0
  29. bgred = 0.0
  30. bggreen = 0.0
  31. bgblue = 0.0
  32. inc = .1
  33. inc_intens = 0.05
  34. from_class = 0
  35. indcl = 1
  36.    olcol = colran[indcl][0] 
  37.    stcol = colran[indcl][1]
  38.    endcol = colran[indcl][2]
  39.    red   = colran[indcl][3]
  40.    green = colran[indcl][4] 
  41.    blue  = colran[indcl][5] 
  42. :mainmenu
  43.     from_class = 0
  44.     getmenu "COLOR: Choose option",\
  45.         "CLASS",\
  46.         "COLOR",\
  47.         "INTENS",\
  48.         "RANGE",\
  49.         "BACKGD",\
  50.         "DONE"
  51.  
  52.     on (@key+3) goto leave_it,leave_it,mainmenu,,\
  53.         classmenu,\
  54.         colormenu,\
  55.         intensmenu,\
  56.         getst ,\
  57.         bgmix,\
  58.         leave_it
  59.         goto mainmenu
  60. :classmenu
  61.    getmenu "COLOR: Choose class ",\
  62.     "CLASS1",\
  63.     "CLASS2",\
  64.     "CLASS3",\
  65.     "CLASS4",\
  66.     "CLASS5",\
  67.     "CLASS6",\
  68.     "CLASS7",\
  69.     "CLASS8"
  70.  
  71.    on (@key+3) goto  leave_it,mainmenu,classmenu,,\
  72.     class,class,class,class,class,class,class,class \
  73.     goto mainmenu
  74.  
  75. :bgmix
  76.     if ( @numpal >= 17 )
  77.     goto okbg
  78.      pause "Not supported for this graphics card ... hit RETURN"
  79.     goto mainmenu
  80. :okbg
  81.    rgb = 0
  82. :setpal
  83.    colors[0][0] = bgred
  84.    colors[1][0] = bggreen 
  85.    colors[2][0] = bgblue
  86.    palette 0, 1, colors
  87.  
  88. :getkey
  89.    prompt "BKGD : Select color (R,G,B) ; define intensity "
  90.    getkey
  91.    if (@key == 0)
  92.       goto getkey
  93.    if (@key == 27)
  94.       goto leave_it 
  95.    if (@key == 68)
  96.       goto mainmenu
  97.    if ((@key == 72) || (@key == 80))
  98.       goto change
  99.    if (@key == 114)
  100.       rgb = 0
  101.    if (@key == 103)
  102.       rgb = 1
  103.    if (@key == 98)
  104.       rgb = 2
  105.    if (@key == 73)
  106.       inc = inc * 2
  107.    if (@key == 81)
  108.       inc = inc / 2
  109.    goto getkey
  110.  
  111. :change
  112.    inc1 = inc
  113.    if (@key == 80)
  114.       inc1 = -inc
  115.    on rgb goto r, g, b
  116. :r
  117.    bgred = bgred + inc1
  118.    if (bgred > 1.0)
  119.       bgred = 1.0
  120.    if (bgred < 0.0)
  121.       bgred = 0.0
  122.    goto setpal
  123. :g
  124.    bggreen = bggreen + inc1
  125.    if (bggreen > 1.0)
  126.       bggreen = 1.0
  127.    if (bggreen < 0.0)
  128.       bggreen = 0.0
  129.    goto setpal
  130. :b
  131.    bgblue = bgblue + inc1
  132.    if (bgblue > 1.0)
  133.       bgblue = 1.0
  134.    if (bgblue < 0.0)
  135.       bgblue = 0.0
  136.    goto setpal
  137.  
  138. :class
  139.    indcl = @key
  140.    olcol = colran[indcl][0] 
  141.    stcol = colran[indcl][1]
  142.    endcol = colran[indcl][2]
  143.    red   = colran[indcl][3]
  144.    green = colran[indcl][4] 
  145.    blue  = colran[indcl][5] 
  146.    from_class = 1
  147.    goto colormenu 
  148.  
  149.  
  150. :getst
  151.    tmp = stcol
  152.    getint "Enter starting color number (%d) =>", tmp  , stcol
  153.    if ((stcol > 0) && (stcol <= 255))
  154.       goto okst
  155.     pause "Invalid start color...press RETURN "
  156.     stcol = tmp
  157.     goto getst
  158. :okst 
  159.    if (@key == -2)
  160.       goto mainmenu
  161.    if (@key == -3)
  162.       goto leave_it
  163.  
  164. :getend
  165.    tmp = endcol
  166.    getint "Enter ending color number (%d) =>", tmp   ,endcol
  167.    if ((endcol >= stcol) && (endcol <= 255))
  168.       goto okend 
  169.     pause "Invalid end color...press RETURN "
  170.     endcol = tmp
  171.     goto getend 
  172. :okend
  173.    if (@key == -2)
  174.       goto getst
  175.    if (@key == -3)
  176.       goto leave_it 
  177.  
  178. :colormenu
  179.  
  180.    getmenu "COLOR: Choose color",\
  181.      "RED",\
  182.      "GREEN",\
  183.     "BLUE",\
  184.     "CYAN", \
  185.     "MAGENTA",\
  186.     "YELLOW",\
  187.     "WHITE"
  188.  
  189.   if ( from_class == 1 )  
  190.   goto frclass
  191.    on (@key+3) goto leave_it,mainmenu,colormenu,, \
  192.     strcol, strcol, strcol, strcol, strcol, strcol, strcol
  193.      goto mainmenu
  194. :frclass
  195.   if ( from_class == 1 ) 
  196.    on (@key+3) goto leave_it,classmenu,colormenu,, \
  197.     strcol, strcol, strcol, strcol, strcol, strcol, strcol
  198.      goto mainmenu
  199. :strcol
  200.    ind = @key - 1
  201.    colran[indcl][3] = rgbcol[ind][0]
  202.    colran[indcl][4] = rgbcol[ind][1]
  203.    colran[indcl][5] = rgbcol[ind][2]
  204.    red   = colran[indcl][3]
  205.    green = colran[indcl][4] 
  206.    blue  = colran[indcl][5] 
  207.    goto setrange
  208.  
  209. :setrange
  210.    ncol = endcol-stcol+1
  211.    i = 0
  212.    sred = 0.0
  213.    sgreen = 0.0
  214.    sblue = 0.0
  215.    ered = 0.0
  216.    egreen = 0.0
  217.    eblue = 0.0
  218.    sred = ( (2.0^(1/ncol)) - 1.0  ) * red 
  219.    sgreen = ( (2.0^(1/ncol)) - 1.0  ) * green 
  220.    sblue = ( (2.0^(1/ncol)) - 1.0  ) * blue 
  221.    ered = red
  222.    egreen = green
  223.    eblue = blue
  224.    prange stcol,ncol,sred,sgreen,sblue,ered,egreen,eblue
  225.    if ( @numpal < 17 )
  226.     REDRAW
  227.    goto colormenu
  228.  
  229. :intensmenu
  230.     ncol = endcol - stcol + 1
  231.     start_intens = 2.0^(1/ncol) - 1.0
  232.     end_intens = 1.0
  233.     abs_start = start_intens
  234.      abs_end = end_intens
  235. :gkk
  236.     prompt "INTENS : Change intensity of current color class"
  237.     getkey
  238.     if ( @key == 0 )
  239.     goto gkk
  240.     if (@key == 27 )
  241.     goto leave_it
  242.     if (@key == 68 )
  243.     goto mainmenu
  244.     if (( @key == 72 ) || ( @key == 80 )) 
  245.     goto chnintens
  246.        if (@key == 73)
  247.           inc_intens = inc_intens * 2
  248.        if (@key == 81)
  249.           inc_intens = inc_intens / 2
  250.     goto gkk
  251. :chnintens
  252.     if ( @key == 80 ) 
  253.     goto darker
  254.     if ( end_intens == abs_end ) 
  255.     goto light1
  256.     end_intens = end_intens + inc_intens
  257.     goto st
  258. :light1
  259.     start_intens = start_intens + inc_intens
  260.     if ( start_intens > 1.0 )
  261.     start_intens = 1.0
  262.      goto st
  263. :darker
  264.     if (start_intens == abs_start )
  265.     goto dark1
  266.     start_intens = start_intens - inc_intens
  267.     goto st
  268. :dark1
  269.     end_intens = end_intens - inc_intens
  270.     if ( end_intens < 0.0 ) 
  271.     end_intens = 0.0
  272. :st
  273.     sred = 0.0
  274.     sgreen = 0.0
  275.     sblue = 0.0    
  276.     ered = 0.0
  277.     egreen = 0.0
  278.     eblue = 0.0    
  279.     sred = start_intens * red  
  280.     sgreen = start_intens * green  
  281.     sblue = start_intens * blue  
  282.     ered = end_intens * red
  283.     egreen = end_intens * green
  284.     eblue = end_intens * blue
  285.     prange stcol,ncol,sred,sgreen,sblue,ered,egreen,eblue
  286.     if ( @numpal < 17 )
  287.     REDRAW
  288.     goto  gkk    
  289. goto mainmenu
  290.  
  291. :leave_it
  292. clear palnum,bgred,bggreen, bgblue,red,blue,green,inc,olcol,stcol,endcol
  293. clear start_intens,end_intens,inc_intens,abs_start,abs_end,ncol
  294. clear theinc,tmp,rgbcol[8][3]
  295.