REBOL [
    Title: "Color Match"
    Date: 21-May-2001
    Version: 1.0.0
    File: %colormatch.r
    Author: "Scot M. Sutherland"
    Purpose: {To illustrate the three basic principles of educational objects.
1.^-objective: a target outcome, task or pattern.
2.^-experience: an interface that allows students to build relationships to the concept.
3.  evaluation: integrated data collector and organizer for evaluation.
This EO was first introduced in 1987 to students building scripts to animate graphics over video.
}
    Email: ssutherl@westmont.edu
    library: [
        level: 'intermediate 
        platform: none 
        type: none 
        domain: [GUI game] 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]
points: 101
color: ""

rank?: func [score /local rank] [
    rank: "Drop Out!"
    if (points > 79) [rank: "Nerd"]
    if (points > 84) [rank: "Geek"]
    if (points > 89) [rank: "Expert"]
    if (points > 94) [rank: "ACE!"]
    return rank
]

match?: func [target [tuple!] test [tuple!] /local match] [
    match: false
    if ((test >= (target - 3.3.3)) and (test <= (target + 3.3.3))) [
        match: true
    ]
    return match
]

seed?: func [/local seed] [
    seed: (to-integer (pick (parse form now/time ":") 3)) * (to-integer (pick (parse form now/time ":") 2))
    return seed
]

random-color: func [][
    for x 0 length? color 1 [remove color]
    loop 2 [append color join form (random ((seed? // 120) + 135)) "."] append color form (random ((seed? // 120) + 135))
    return to-tuple color print color
]

text-val: func [value] [
    value: form (to-integer ((1 - value) * 255))
    return value
]

interface: [
    backdrop mint
    vh1 "Color Match" gold
        feel [over: func [f a o] [
            prompt/text: either a ["Educational Object"] ["Move sliders...Click Test."] show prompt]
        ] 
    at 10x55 prompt: txt 146 "Move sliders...Click Test." white
    at 33x78 button 94x104   
    at 35x80 target: box 90x50 "Target" random-color 
                        feel [over: func [f a o] [
                            prompt/text: either a ["Starts over..."] ["Move sliders...Click Test."]
                            show prompt
                            ]
                        ] 
             [  points: 101 
                target/color: random-color test/color: black
                redval/text: grnval/text: bluval/text: "0"
                score/text: "100"
                redslide/color: grnslide/color: bluslide/color: black
                redslide/data: grnslide/data: bluslide/data: 1.0
                test/text: "Test" target/text: "Target"
                show [target test redval grnval bluval score redslide grnslide bluslide]
             ] 
    at 35x130 test: box 90x50 "Test" black 
                        feel [over: func [f a o] [
                            prompt/text: either a ["Test for match..."] ["Move sliders...Click Test."]
                            show prompt
                            ]
                        ] 
            [   test/color: redslide/color + grnslide/color + bluslide/color 
                score/text: points: points - 1
                if match? target/color test/color [
                    test/text: "MATCH!"
                    target/text: rank? points
            ] 
                show [target test score]
            ]
    at 30x190 redval: vh4 "0" 30 center  
    at 65x190 grnval: vh4 "0" 30 center 
    at 100x190 bluval: vh4 "0" 30 center
    at 37x220 redslide: slider 15x130 black 
        feel [over: func [f a o] [
            prompt/text: either a ["Red slider..."] ["Move sliders...Click Test."] show prompt]
        ] 
        [redslide/color: to-tuple join (redval/text: text-val value) ".0.0" show [redval redslide]]
    at 72x220 grnslide: slider 15x130 black 
        feel [over: func [f a o] [
            prompt/text: either a ["Green slider..."] ["Move sliders...Click Test."] show prompt]
        ] 
        [grnslide/color: to-tuple join "0." join (grnval/text: text-val value) ".0" show [grnval grnslide]] 
    at 107x220 bluslide: slider 15x130 black 
        feel [over: func [f a o] [
            prompt/text: either a ["Blue slider..."] ["Move sliders...Click Test."] show prompt]
        ] 
        [bluslide/color: to-tuple join "0.0." (bluval/text: text-val value) show [bluval bluslide]] 
    at 55x360 vh2 "Score" gold
        feel [over: func [f a o] [
            prompt/text: either a ["Minus 1 for each Test"] ["Move sliders...Click Test."] show prompt]
        ] 
    at 57x380 score: title "100" white
        feel [over: func [f a o] [
            prompt/text: either a ["ACE Expert Geek or Nerd!"] ["Move sliders...Click Test."] show prompt]
        ] 
    redslide/data: bluslide/data: grnslide/data: 1.0
]

view layout interface