ui.gadgets.buttons: New look for checkboxes and radio buttons

basis/ui/gadgets/buttons/buttons.factor

@@ -5,8 +5,8 @@ strings quotations assocs combinators classes colors colors.constants
 classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
-ui.pens ui.pens.solid ui.pens.caching math.rectangles locals
+ui.pens ui.pens.solid ui.pens.image math.rectangles locals
-specialized-arrays.float fry combinators.smart ;
+fry combinators.smart ;
 IN: ui.gadgets.buttons
 
 TUPLE: button < border pressed? selected? quot ;
@@ -21,8 +21,8 @@ TUPLE: button < border pressed? selected? quot ;
     hand-clicked get-global child? ;
 
 : button-update ( button -- )
-    dup mouse-clicked?
+    dup
-    over button-rollover? and
+    [ mouse-clicked? ] [ button-rollover? ] bi and
     buttons-down? and
     >>pressed?
     relayout-1 ;
@@ -45,28 +45,31 @@ button H{
 : <button> ( label quot -- button )
     button new-button ;
 
-TUPLE: button-paint plain rollover pressed selected ;
+TUPLE: button-pen
+plain rollover
+pressed selected pressed-selected ;
 
-C: <button-paint> button-paint
+C: <button-pen> button-pen
 
 : find-button ( gadget -- button )
     [ button? ] find-parent ;
 
-: button-paint ( button paint -- button paint )
+: button-pen ( button pen -- button pen )
     over find-button {
+        { [ dup [ pressed?>> ] [ selected?>> ] bi and ] [ drop pressed-selected>> ] }
         { [ dup pressed?>> ] [ drop pressed>> ] }
         { [ dup selected?>> ] [ drop selected>> ] }
         { [ dup button-rollover? ] [ drop rollover>> ] }
         [ drop plain>> ]
     } cond ;
 
-M: button-paint draw-interior
+M: button-pen draw-interior
-    button-paint dup [ draw-interior ] [ 2drop ] if ;
+    button-pen dup [ draw-interior ] [ 2drop ] if ;
 
-M: button-paint draw-boundary
+M: button-pen draw-boundary
-    button-paint dup [ draw-boundary ] [ 2drop ] if ;
+    button-pen dup [ draw-boundary ] [ 2drop ] if ;
 
-M: button-paint pen-pref-dim
+M: button-pen pen-pref-dim
     [
         {
             [ plain>> pen-pref-dim ]
@@ -80,8 +83,8 @@ M: button-paint pen-pref-dim
     { 0 1/2 } >>align ; inline
 
 : roll-button-theme ( button -- button )
-    f COLOR: black <solid> dup f <button-paint> >>boundary
+    f COLOR: black <solid> dup f f <button-pen> >>boundary
-    f f pressed-gradient f <button-paint> >>interior
+    f f pressed-gradient f f <button-pen> >>interior
     align-left ; inline
 
 : <roll-button> ( label quot -- button )
@@ -92,7 +95,8 @@ M: button-paint pen-pref-dim
     rollover-gradient
     pressed-gradient
     selected-gradient
-    <button-paint> ;
+    selected-gradient
+    <button-pen> ;
 
 : bevel-button-theme ( gadget -- gadget )
     <bevel-button-paint> >>interior
@@ -115,49 +119,18 @@ repeat-button H{
     #! the mouse is held down.
     repeat-button new-button bevel-button-theme ;
 
-TUPLE: checkmark-paint < caching-pen color last-vertices ;
+: <checkmark-paint> ( -- pen )
-
+    "checkbox" theme-image <image-pen>
-: <checkmark-paint> ( color -- paint )
+    "checkbox" theme-image <image-pen>
-    checkmark-paint new swap >>color ;
+    "checkbox-clicked" theme-image <image-pen>
-
+    "checkbox-set" theme-image <image-pen>
-<PRIVATE
+    "checkbox-set-clicked" theme-image <image-pen>
-
+    <button-pen> ;
-: checkmark-points ( dim -- points )
-    [
-        {
-            [ { 0 0 } v* { 0.5 0.5 } v+ ]
-            [ { 1 1 } v* { 0.5 0.5 } v+ ]
-            [ { 1 0 } v* { -0.3 0.5 } v+ ]
-            [ { 0 1 } v* { -0.3 0.5 } v+ ]
-        } cleave
-    ] output>array ;
-
-: checkmark-vertices ( dim -- vertices )
-    checkmark-points concat >float-array ;
-
-PRIVATE>
-
-M: checkmark-paint recompute-pen
-    swap dim>> checkmark-vertices >>last-vertices drop ;
-
-M: checkmark-paint draw-interior
-    [ compute-pen ]
-    [ color>> gl-color ]
-    [ last-vertices>> gl-vertex-pointer ] tri
-    GL_LINES 0 4 glDrawArrays ;
-
-: checkmark-theme ( gadget -- gadget )
-    f
-    f
-    COLOR: black <solid>
-    COLOR: black <checkmark-paint>
-    <button-paint> >>interior
-    COLOR: black <solid> >>boundary ;
 
 : <checkmark> ( -- gadget )
     <gadget>
-    checkmark-theme
+    <checkmark-paint> >>interior
-    { 14 14 } >>dim ;
+    dup dup interior>> pen-pref-dim >>dim ;
 
 : toggle-model ( model -- )
     [ not ] change-model ;
@@ -174,46 +147,18 @@ TUPLE: checkbox < button ;
 M: checkbox model-changed
     swap value>> >>selected? relayout-1 ;
 
-TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ;
+: <radio-paint> ( -- pen )
-
+    "radio" theme-image <image-pen>
-: <radio-paint> ( color -- paint ) radio-paint new swap >>color ;
+    "radio" theme-image <image-pen>
-
+    "radio-clicked" theme-image <image-pen>
-<PRIVATE
+    "radio-set" theme-image <image-pen>
-
+    "radio-set-clicked" theme-image <image-pen>
-CONSTANT: circle-steps 8
+    <button-pen> ;
-
-PRIVATE>
-
-M: radio-paint recompute-pen
-    swap dim>>
-    [ { 4 4 } swap { 9 9 } v- circle-steps fill-circle-vertices >>interior-vertices ]
-    [ { 1 1 } swap { 3 3 } v- circle-steps circle-vertices >>boundary-vertices ] bi
-    drop ;
-
-<PRIVATE
-
-: (radio-paint) ( gadget paint -- )
-    [ compute-pen ] [ color>> gl-color ] bi ;
-
-PRIVATE>
-
-M: radio-paint draw-interior
-    [ (radio-paint) ] [ interior-vertices>> gl-vertex-pointer ] bi
-    GL_POLYGON 0 circle-steps glDrawArrays ;
-
-M: radio-paint draw-boundary
-    [ (radio-paint) ] [ boundary-vertices>> gl-vertex-pointer ] bi
-    GL_LINE_STRIP 0 circle-steps 1+ glDrawArrays ;
-
-:: radio-knob-theme ( gadget -- gadget )
-    COLOR: black <radio-paint> :> radio-paint
-    gadget
-    f f radio-paint radio-paint <button-paint> >>interior
-    radio-paint >>boundary
-    { 16 16 } >>dim ;
 
 : <radio-knob> ( -- gadget )
-    <gadget> radio-knob-theme ;
+    <gadget>
+    <radio-paint> >>interior
+    dup dup interior>> pen-pref-dim >>dim ;
 
 TUPLE: radio-control < button value ;