Color match game

This is the equivalent of an old Amiga game. Your task is to find the correct mix of primary colors in order to obtain the requested color. Push on TEST button to see if you are correct.

 Here the source:

REBOL [
    Title:   "Colormatch 1.5"
    File:   %colormatch15.r
    Author: "Scot M. Sutherland"
    Verson: 1.5.1
    Date: 15-Mar-2007
    Copyright: "©2006, by Scot M. Sutherland.   All rights reserved."
    Purpose: {Color Match 1.5 simulates very closely the Amiga Version created in 1987.
Junior High students learned how to created accurate colors by typing in numbers into a
multimedia program.
}
    Notes: {
        12-Oct-2006 Rewrite of colormatch for 64 colors, and bigger handles.
                    Leaping slider handles added.
    }
]
col-nos: 4
col-fact: 256 / col-nos
random/seed now
s: 10
rand-color: func [/local col v vf] [
    col: copy [] v: 0
    loop 3 [
        v: ((random (col-nos + 1)) - 1)
        either v > 0 [vf: (v * col-fact) - 1][vf: 0]
        append col vf
    ]
    return to-tuple col
]
rank?: func [score /local rank] [
    rank: "Drop Out!"
    if (score > 5) [rank: "Nerd"]
    if (score > 6) [rank: "Geek"]
    if (score > 7) [rank: "Expert"]
    if (score > 8) [rank: "ACE!"]
    return rank
]
s-off: func [c sv z /local color [tuple!] off [pair!] val [integer!] data y sy ][
    y: (to-integer (second parse mold z "x")) - 18
    if sv < 1 [sy: y - 4 off: to-pair reduce [0 sy] color: c * 0 val: 0 data: 1]
    if sv < .95 [sy: y * .75 off: to-pair reduce [0 sy] color: c * .25 val: 1 data: .75]
    if sv < .625 [sy: y * .5 off: to-pair reduce [0 sy] color: c * .5 val: 2   data: .5]
    if sv < .375 [sy: y * .25 off: to-pair reduce [0 sy] color: c * .75 val: 3 data: .25]
    if sv < .05 [off: 0x0 color: c val: 4 data: 0.0]
    return reduce [color off val data]
]
;for x 0 16 1 [probe (x * 16)]

lay: layout [
    style t-box box 150x100
    backdrop forest + 100 effect [gradient 1x1 20.200.80 30.90.50]
    vh1 150 center Gold "Colormatch 1.5"
        feel [over: func [f a o] [
            prompt/text: either a ["Intuica, Inc. Patent Pending"] ["Move sliders...Click Test."] show prompt]
        ]
    prompt: txt white 155 center "Move sliders...Click Test" space 0x0
    frame: box 156x206 edge [size: 3x3 color: gray effect: 'bevel]
    at frame/offset + 3x3
    targ: t-box rand-color "Target"
        feel [over: func [f a o] [
            prompt/text: either a ["Start over..."] ["Move sliders...Click Test."] show prompt]
        ][
            targ/color: rand-color targ/color
            test/text: "Test" targ/text: "Target"
            score/text: "10" s: 10
            test/color: r/data: g/data: b/data: 1.0
            r/color: g/color: b/color: 0
            rt/text: gt/text: bt/text: "0"
            show [targ test r g b rt gt bt score]
    ]
    test: t-box 150x100 black "Test"
            feel [over: func [f a o] [
            prompt/text: either a ["Test for a match..."] ["Move sliders...Click Test."] show prompt]
        ][
        score/text: s: s - 1
        test/color: r/color + g/color + b/color
        if test/color = targ/color [rank/text: rank? s test/text: "MATCH!"   targ/text: "New Color"]
        show [test score rank targ]
    ]
    across space (frame/size / 10) * 1x0
    guide (frame/offset + (frame/size * 0x1) + 15x15)
    rt: vh4 30 "0"   gt: vh4 30 "0" bt: vh4 30 "0" return pad 3x5
    space ((frame/size / 5) - 5 ) * 1x0
    r: slider 20x192
            feel [over: func [f a o] [
            prompt/text: either a ["Red slider..."] ["Move sliders...Click Test."] show prompt]
        ][
        rv: s-off red r/data r/size
        if find rv none [rv: reduce [black   (r/size * 0x1 - (r/pane/1/size * 0x1) - 0x4) 0 1.0]]
        r/pane/1/offset: second rv
        r/data: fourth rv
        rt/text: third rv
        r/color: first rv
        show [r rt]
    ]
    g: slider 20x192
            feel [over: func [f a o] [
            prompt/text: either a ["Green slider..."] ["Move sliders...Click Test."] show prompt]
        ][
        gv: s-off green g/data g/size
        if find gv none [gv: reduce [black   (g/size * 0x1 - (g/pane/1/size * 0x1) - 0x4) 0 1.0]]
        g/pane/1/offset: second gv
        g/data: fourth gv
        gt/text: third gv
        g/color: first gv
        show [g gt]
    ]
    b: slider 20x192
            feel [over: func [f a o] [
            prompt/text: either a ["Blue slider..."] ["Move sliders...Click Test."] show prompt]
        ][
        bv: s-off blue b/data b/size
        if find bv none [bv: reduce [black   (b/size * 0x1 - (b/pane/1/size * 0x1) - 0x4) 0 1.0]]
        b/pane/1/offset: second bv
        b/data: fourth bv
        bt/text: third bv
        b/color: first bv
        show [b bt]
    ]
    return space 5x5 pad 0x20
    vh4 gold "Score: " score: vh4 "10"
    feel [over: func [f a o] [
            prompt/text: either a ["Deduct 1 for each Test"] ["Move sliders...Click Test."] show prompt]
        ] return
    vh4 gold "Rank: "   rank: vh4 "Thinking..." left
        feel [over: func [f a o] [
            prompt/text: either a ["ACE!, Expert, Geek or Nerd!"] ["Move sliders...Click Test."] show prompt]
        ] return pad -20x0
    do [
        r/data: b/data: g/data: 1.0
        r/color: g/color: b/color: 0
        targ/color rand-color
        r/pane/1/color: red
        g/pane/1/color: green
        b/pane/1/color: blue
    ]
]
;probe lay/size

view lay