BBC BASIC for Windows
IDE and Compiler >> Tools and Utilities >> Color mixer with Hexidecimal rr gg bb for 3D
http://bb4w.conforums.com/index.cgi?board=addins&action=display&num=1504412140

Color mixer with Hexidecimal rr gg bb for 3D
Post by michael on Sep 3rd, 2017, 04:15am

I dug up some old code and repurposed it for Vertex coloring.

So now you move the sliders to mix the color you want and then it will automatically create the Hexidecimal values for the rr gg bb values you need to color each triangle.

Now it is possible to get custom complex colors easy.

It could be more compact.
Code:
      ON ERROR END
      PROCgraphics(400,300)
      DIM cmd$(50)
      current$="":ln%=0:pln%=0
      butx%=0:buty%=0:buth%=0:butv%=0:sx%=0:sy%=0:sh%=0:sv%=0:cx%=0:cy%=0
      PROCcolor("b","000,000,000"):CLG
      PROCcolor("f","yellow")

      PROCpr(10,425,"Color Mixer with Hexidecimal for rr gg bb ","white")

      REPEAT
        s3$=FNcolormix(100,100)
        MOUSE mx%,my%,butt%
        IF mx%>0 AND mx%<501 AND my%>0 AND my%<501 AND butt%=4 THEN butx%=mx%/10:buty%=my%/10
        IF mx%>0 AND mx%<501 AND my%>0 AND my%<501 AND butt%=1 THEN buth%=mx%/10:butv%=my%/10
        IF butx%<1 THEN butx%=1
        IF buty%<1 THEN buty%=1
        IF buth%<1 THEN buth%=1
        IF butv%<1 THEN butv%=1
        WAIT 10
      UNTIL FALSE
      END

      REM COLORMIX object mixer
      DEFFNcolormix(x,y)
      PRIVATE rgb$,r%,g%,b%,switch%
      LOCAL h%,v%,click%
      MOUSE h%,v%,click%
      IF click%=4 THEN
        IF h%>x AND h%<x+50 AND v%>y AND v%<y+255 THEN r%=v%-y
        IF h%>x+49 AND h%<x+90 AND v%>y AND v%<y+255 THEN g%=v%-y
        IF h%>x+99 AND h%<x+140 AND v%>y AND v%<y+255 THEN b%=v%-y
      ENDIF
      IF switch%=0 OR click%=4 THEN
        PROCsbox(x-5,y-5,x+150,y+265,"255,255,255")
        PROCsbox(x,y+r%,x+40,y+r%+10,"200,000,000")
        PROCsbox(x+50,y+g%,x+90,y+g%+10,"000,200,000")
        PROCsbox(x+100,y+b%,x+140,y+b%+10,"000,000,200")
        switch%=1
        rgb$=FNnumstr(r%)+","+FNnumstr(g%)+","+FNnumstr(b%)
        PROCsbox(x-5,y+265,x+150,y+295,rgb$)
      ENDIF
      PROCpr(10,80,"rr "+STR$~(r%)+" gg "+STR$~(g%)+" bb "+STR$~(b%)+"","white")
      =rgb$
      REM  GRAPHICS(x,y)
      DEF PROCgraphics(x,y)
      VDU 23,22,x;y;8,15,16,1
      OFF
      VDU 5
      ENDPROC
      REM SBOX **********************
      DEF PROCsbox(x%,y%,w%,h%,c$)
      LOCAL ry%,sx%,sy%
      sx%=x%:sy%=y%
      IF x%>w% THEN x%=w%:w%=sx%
      IF y%>h% THEN y%=h%:h%=sy%
      ry%=y%
      PROCcolor("f",c$)
      REPEAT
        LINE x%,y%,w%,y%
        y%=y%+1
      UNTIL y%=h%
      y%=ry%
      IF c$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")
      LINE x%+2,y%+2,w%-2,y%+2
      LINE w%-2,y%+2,w%-2,h%-4
      LINE w%-2,h%-4,x%+2,h%-4
      LINE x%+2,h%-4,x%+2,y%+2
      PROCresetrgb
      ENDPROC
      REM RECT **********************
      DEFPROCrect(x%,y%,w%,h%)
      LOCAL sx%,sy%
      sx%=x%:sy%=y%
      IF x%>w% THEN x%=w%:w%=sx%
      IF y%>h% THEN y%=h%:h%=sy%
      LINE x%,y%,w%,y%
      LINE w%,y%,w%,h%
      LINE w%,h%,x%,h%
      LINE x%,h%,x%,y%
      ENDPROC
      REM pixel *******************
      REM restore default color palettes
      DEFPROCresetrgb
      COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
      COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
      COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
      COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
      COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
      COLOUR 15,248,248,248
      ENDPROC
      DEF PROCcolor(fb$,rgb$)
      PRIVATE assemble$,br%,bg%,bb%
      IF rgb$="0" OR rgb$="black" THEN rgb$="000,000,000"
      IF rgb$="1" OR rgb$="red" THEN rgb$="200,000,000"
      IF rgb$="2" OR rgb$="green" THEN rgb$="000,200,000"
      IF rgb$="3" OR rgb$="yellow" THEN rgb$="200,200,000"
      IF rgb$="4" OR rgb$="blue" THEN rgb$="000,000,200"
      IF rgb$="5" OR rgb$="magenta" THEN rgb$="200,000,200"
      IF rgb$="6" OR rgb$="cyan" THEN rgb$="000,200,200"
      IF rgb$="7" OR rgb$="white" THEN rgb$="200,200,200"
      IF rgb$="8" OR rgb$="grey" THEN rgb$="056,056,056"
      IF rgb$="9" OR rgb$="light red" THEN rgb$="248,056,056"
      IF rgb$="10" OR rgb$="light green" THEN rgb$="056,248,056"
      IF rgb$="11" OR rgb$="light yellow" THEN rgb$="248,248,056"
      IF rgb$="12" OR rgb$="light blue" THEN rgb$="056,056,248"
      IF rgb$="13" OR rgb$="light magenta" THEN rgb$="248,056,248"
      IF rgb$="14" OR rgb$="light cyan" THEN rgb$="056,248,248"
      IF rgb$="15" OR rgb$="light white" THEN rgb$="248,248,248"
      assemble$=rgb$
      br%=VAL(MID$(assemble$,1,3)):bg%=VAL(MID$(assemble$,5,3)):bb%=VAL(MID$(assemble$,9,3))
      IF fb$="f" OR fb$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0
      IF fb$="b" OR fb$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1
      ENDPROC
      DEFFNnumstr(num)
      LOCAL cov$,l%
      cov$=STR$(num)
      l%=LEN(cov$)
      IF l%=1 THEN ret$="00"+cov$
      IF l%=2 THEN ret$="0"+cov$
      IF l%=3 THEN ret$=cov$
      =ret$
      DEFPROCpaint(x%,y%,co$)
      PROCcolor("b",FNrgb(x%,y%)):PROCcolor("f",co$)
      FILL x%,y%
      ENDPROC
      REM dotrgb ********************************
      DEFPROCdotrgb(x%,y%,r%,g%,b%)
      COLOUR 0,r%,g%,b% : GCOL 0
      MOVE x%,y%:DRAW x%,y%
      ENDPROC
      REM *****SPECIAL RGB tools (color extraction) has use with PROCdotrgb
      DEF PROCrgbret(x%,y%,RETURN r%,RETURN g%,RETURN b%)
      LOCAL rgb%
      rgb%=TINT(x%,y%)
      b%=INT(rgb%/(256*256))
      g%=INT((rgb%-b% *256*256)/256)
      r%=INT(rgb%-b%*256*256-g%*256)
      ENDPROC
      REM experimental
      DEFFNrgb(x%,y%)
      LOCAL r$,g$,b$,join$,r,g,b
      rgb%=TINT(x%,y%)
      b=INT(rgb%/(256*256))
      g=INT((rgb%-b *256*256)/256)
      r=INT(rgb%-b*256*256-g*256)
      r$=FNnumstr(r):g$=FNnumstr(g):b$=FNnumstr(b)
      join$=r$+","+g$+","+b$
      =join$
      REM  "INTERFACE" -library - for graphics text input and other tools
      REM X,Y,message,r,g,b
      DEF PROCpr(X,Y,msg$,c$)
      PRIVATE trackx,tracky,trackmsg$,trackc$
      LOCAL initialx%,fi%,reduction%,tx,ty
      IF trackx=X AND tracky=Y AND trackmsg$<>msg$ THEN PROCprsub(trackx,tracky,trackmsg$,"000,000,000")
      IF trackx<>X OR tracky<>Y OR trackmsg$<>msg$ OR trackc$<>c$ THEN
        initialx%=LEN(msg$)
        PROCcolor("f",c$)
        GCOL 0
        LET tx= X+initialx%+25
        LET ty= Y:reduction%=0
        reduction%=initialx%/2
        reduction%=reduction%*6
        IF initialx%<20 THEN reduction%=reduction%/2
        initialx%=initialx%*22-reduction%
        FOR fi%=12 TO 48
          LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
        NEXT
        COLOUR 0,0,0,0
        GCOL 0
        MOVE tx,ty
        PRINT msg$
        MOVE 0,0
      ENDIF
      trackx=X:tracky=Y:trackmsg$=msg$:trackc$=c$
      ENDPROC
      DEFPROCprsub(X,Y,msg$,c$)
      LOCAL initialx%,fi%,reduction%,tx,ty
      initialx%=LEN(msg$)
      PROCcolor("f",c$)
      GCOL 0
      LET tx= X+initialx%+25
      LET ty= Y:reduction%=0
      reduction%=initialx%/2
      reduction%=reduction%*6
      IF initialx%<20 THEN reduction%=reduction%/2
      initialx%=initialx%*22-reduction%
      FOR fi%=12 TO 48
        LINE X-3,Y+20-fi%,X+initialx%+8,Y+20-fi%
      NEXT
      COLOUR 0,0,0,0
      GCOL 0
      MOVE tx,ty
      PRINT msg$
      MOVE 0,0
      ENDPROC