Estyle-ShinyMetal.fs

\ Enlightenment style                                  07feb98py

\needs get-imdata  include Estyle.fs

\ E icons                                              14feb98py

widget class Eicon-pixmap
public:
    cell var Eimage
    cell var pixmap
    cell var shape
    method draw-at
how:
    : init ( file len dpy -- )  bind dpy super init
        (read-imicon Eimage !
        3 3 3 3 Eimage @ Image border !+ !+ !+ !
        $100 $100 $200 sp@ Eimage @ dpy xrc imdata @
        ImlibSetImageModifier 2drop 2drop ;
    : draw-at ( x y w h -- 0 0 w h x y w1 w2 )
        over w @ <> over h @ <> or >r h ! w !
        r> IF
            pixmap @ ?dup IF
                dpy xrc imdata @ ImlibFreePixmap drop
            THEN
            h @ w @ Eimage @ dpy xrc imdata @
            ImlibRender drop
            Eimage @ dpy xrc imdata @ ImlibMoveMaskToPixmap shape !
            Eimage @ dpy xrc imdata @ ImlibMoveImageToPixmap pixmap !

	    4 dpy xrc set-function  0 dpy xrc set-color
	    dpy drawable nip shape @ pixmap @ rot
	    0 0 w @ h @ 0 0 1 XCopyPlane
	    3 dpy xrc set-function
        THEN
        >r >r 0 0 w @ h @ r> r>  shape @ pixmap @ ;
    : draw  xywh draw-at dpy mask ;
class;

: Eicon: ( "name" "file"<"> -- )
  Create 0 , ,"  DOES> ( -- icon )
  dup @ dup IF  nip  EXIT  THEN  drop
  dup cell+ count screen self Eicon-pixmap new tuck swap ! ;

\ draw button                                          14feb98py

Eicon: button-f Estyle/ShinyMetal/bar_horizontal_2.png"
Eicon: button-d Estyle/ShinyMetal/bar_horizontal_1.png"
Eicon: button-p Estyle/ShinyMetal/bar_horizontal_3.png"

button with
  F : e-choise ( -- m )
        color @ $FF and 1 =
        IF    push?
            IF    button-p
            ELSE  button-f  THEN
        ELSE  push?
            IF    button-p
            ELSE  button-d  THEN
        THEN  ;
  F : e-draw ( x y w h icon -- )
        Eicon-pixmap with draw-at endwith dpy mask ;
  F : e-button ( m -- ) >r xywh r> e-draw ;
endwith

button implements
    : draw ( -- )
      xywh defocuscol @ @ dpy box
      e-choise e-button
      text $@ 0 push? 1 and textcenter ;
class;

togglebutton implements
    : draw ( -- )
      xywh defocuscol @ @ dpy box
      e-choise e-button
      callback fetch
      0= IF    text $@ 0 push? 1 and textcenter
      ELSE  text1 $@  2dup 0 textsize >r >r
          xywh r> r> p- p2/ p+
          push? dup p- color @ 8 >> dpy text THEN ;
class;

flipbutton implements
     : draw ( -- )      xywh defocuscol @ @ dpy box
	 callback fetch push? or  color @ $FF and 1 =
	 IF    IF  button-p  ELSE  button-f  THEN
	 ELSE  IF  button-p  ELSE  button-d  THEN  THEN
	 e-button
	 text $@ 0 push? 1 and textcenter ;
class;

topindex implements
    : e-draw-half ( x y w h icon -- )
        Eicon-pixmap with 2* draw-at 4 pick 2/ 4 pin endwith
        dpy mask ;
    : e-button-half ( m y h -- )
      { m y h |
        x @ y w @ h m e-draw-half } ;
    : draw ( -- )
        callback fetch color @ $18 >> negate
        { state o |
          xywh state IF  xS +  THEN  defocuscol @ @ dpy box
          state 0= IF  xywh rot + swap xS shadow drop dpy box  THEN
          e-choise y @ h @ xS +
          state 0= IF  xS -2 xS * p+  THEN  e-button-half
          text $@ state IF  0 o  ELSE  xS negate o xS + THEN
          textcenter } ;
class;

boxchar implements
    : draw ( -- )
      xywh defocuscol @ @ dpy box
      e-choise e-button
      color 2+ 1 0 push? 1 and textcenter ;
    button :: hglue
class;

togglechar implements
    boxchar :: draw
    boxchar :: hglue
class;

lbutton implements
    : draw ( -- )
      xywh defocuscol @ @ dpy box
      e-choise e-button
      text $@ h @ 2/ w @ 2/ min push? 1 and textleft ;
class;

\ toggle button

Eicon: tbutton-fl+ Estyle/ShinyMetal/button_kill_2.png"
Eicon: tbutton-fl- Estyle/ShinyMetal/button_off_2.png"
Eicon: tbutton-dl+ Estyle/ShinyMetal/button_kill_1.png"
Eicon: tbutton-dl- Estyle/ShinyMetal/button_off_1.png"
Eicon: tbutton-pl+ Estyle/ShinyMetal/button_kill_3.png"
Eicon: tbutton-pl- Estyle/ShinyMetal/button_off_3.png"

tbutton with
  F : e-tchoise ( -- l+ l- ms r )
        color @ $FF and 1 =
        IF    push?
            IF    tbutton-pl+ tbutton-pl- button-p
            ELSE  tbutton-fl+ tbutton-fl- button-f  THEN
        ELSE  push?
            IF    tbutton-dl+ tbutton-dl- button-d
            ELSE  tbutton-dl+ tbutton-dl- button-d  THEN
        THEN  ;
  F : e-tbutton ( l+ l- ms -- )
      { l+ l- ms |
        xywh ms e-draw
        x @ y @ h @ h @ xS xywh-
        callback fetch IF  l+  ELSE  l-  THEN e-draw } ;
endwith

tbutton implements
    : draw ( -- )
\       xywh defocuscol @ @ dpy box
        e-tchoise e-tbutton
        text $@ h @ w @ 2/ min 0 textleft ;
class;

ticonbutton implements
    : draw ( -- )
        xywh e-tchoise nip nip e-draw
        x @ 1+ y @ 1+ h @ 2- callback fetch
        IF    icon+ h @ - 2/ + icon+ draw-at
        ELSE  icon- h @ - 2/ + icon- draw-at
        THEN  dpy mask
        text $@
        xN icon+ w @ icon- w @ max + 0 textleft ;
class;

Eicon: rbutton-fl+ Estyle/ShinyMetal/button_iconify_2.png"
Eicon: rbutton-fl- Estyle/ShinyMetal/button_off_2.png"
Eicon: rbutton-dl+ Estyle/ShinyMetal/button_iconify_1.png"
Eicon: rbutton-dl- Estyle/ShinyMetal/button_off_1.png"
Eicon: rbutton-pl+ Estyle/ShinyMetal/button_iconify_3.png"
Eicon: rbutton-pl- Estyle/ShinyMetal/button_off_3.png"

rbutton implements
    : e-rchoise ( -- l+ l- ms r )
        color @ $FF and 1 =
        IF    push?
            IF    rbutton-pl+ rbutton-pl- button-p
            ELSE  rbutton-fl+ rbutton-fl- button-f  THEN
        ELSE  push?
            IF    rbutton-dl+ rbutton-dl- button-d
            ELSE  rbutton-dl+ rbutton-dl- button-d  THEN
        THEN  ;
    : e-rbutton ( l+ l- ms -- )
      { l+ l- ms |
        xywh ms e-draw
        x @ y @ h @ h @ xS xywh-
        callback fetch IF  l+  ELSE  l-  THEN e-draw } ;
    : draw ( -- )
\       xywh defocuscol @ @ dpy box
        e-rchoise e-rbutton
        text $@ h @ w @ 2/ min 0 textleft ;
class;

\ text label

text-label implements
    : draw ( -- )
      xywh defocuscol @ @ dpy box
      button-d e-button
      text $@ h @ 2/ w @ textwh @ - 2/ min 0 textleft ;
    button :: hglue
class;

icon-button implements
    : draw  ( -- )
        xywh defocuscol @ @ dpy box
        e-choise e-button
        x @ xS + y @ h @ icon h @ - 2/ + push? dup p-
        icon draw-at dpy mask
        text $@
        xS 1+ icon w @ + xN + push? 1 and textleft ;
class;

icon-but implements
    : draw ( -- ) push? 1 and >r
        xywh defocuscol @ @ dpy box
        e-choise e-button
        x @ w @ icon w @ - 2/ + r@ +
        y @ h @ icon h @ - 2/ + r> +
        icon draw-at dpy mask ;
    : hglue   icon w @ xS 2* + 1 *fil ;
    : vglue   icon h @ xS 2* + 1+ 1 *fil ;
class;

toggleicon implements
    : draw  ( -- )
        callback fetch  push?  { s of |
            xywh defocuscol @ @ dpy box
            e-choise e-button
            s IF    icon+ w @ icon+ h @
            ELSE  icon- w @ icon- h @  THEN  >r >r
            x @ w @ r> - 2/ +  y @ h @ r> - 2/ +  of dup p-
            s IF icon+ draw-at ELSE icon- draw-at THEN dpy mask } ;
    : hglue  icon+ w @ icon- w @ max  xS 2* + 1+ 1 *fil ;
    : vglue  icon+ h @ icon- h @ max  xS 2* + 1+ 1 *fil ;
class;

flipicon implements
    : draw  ( -- )  color push  color @ $FFFFFF and
        callback fetch  IF -3 ELSE 2 THEN  $18 << or color !
        xywh defocuscol @ @ dpy box
        e-choise e-button
        callback fetch 1 and >r
        x @ w @ icon w @ - 2/ + r@ +
        y @ h @ icon h @ - 2/ + r> +
        icon draw-at dpy mask ;
    : hglue  icon w @ xS 2* + 1+ 1 *fil ;
    : vglue  icon h @ xS 2* + 1+ 1 *fil ;
class;

Eicon: arrow-pt Estyle/ShinyMetal/button_arrow_up_3.png"
Eicon: arrow-ft Estyle/ShinyMetal/button_arrow_up_2.png"
Eicon: arrow-dt Estyle/ShinyMetal/button_arrow_up_1.png"
Eicon: arrow-pr Estyle/ShinyMetal/button_arrow_right_3.png"
Eicon: arrow-fr Estyle/ShinyMetal/button_arrow_right_2.png"
Eicon: arrow-dr Estyle/ShinyMetal/button_arrow_right_1.png"
Eicon: arrow-pb Estyle/ShinyMetal/button_arrow_down_3.png"
Eicon: arrow-fb Estyle/ShinyMetal/button_arrow_down_2.png"
Eicon: arrow-db Estyle/ShinyMetal/button_arrow_down_1.png"
Eicon: arrow-pl Estyle/ShinyMetal/button_arrow_left_3.png"
Eicon: arrow-fl Estyle/ShinyMetal/button_arrow_left_2.png"
Eicon: arrow-dl Estyle/ShinyMetal/button_arrow_left_1.png"

| Create tri-p-table  T] arrow-pl arrow-pt arrow-pr arrow-pb [
| Create tri-f-table  T] arrow-fl arrow-ft arrow-fr arrow-fb [
| Create tri-d-table  T] arrow-dl arrow-dt arrow-dr arrow-db [

tributton implements
    : draw ( -- )  xywh defocuscol @ @ dpy box
        xywh  color @ $FF and 1 =
        IF  push?  IF  tri-p-table  ELSE  tri-f-table  THEN
        ELSE  tri-d-table  THEN
        color @ $E >> $C and + perform e-draw ;
    : hglue  xM xS 2* + 1 *fil ;
    : vglue  xM xS 2* + 1 *fil ;
class;

slidetri implements
    | Create o-table  3 0 , ,  0 3 , ,  -3 0 , ,  0 -3 , ,
    | Create p-table  T] arrow-pl arrow-pt arrow-pr arrow-pb [
    | Create f-table  T] arrow-fl arrow-ft arrow-fr arrow-fb [
    | Create d-table  T] arrow-dl arrow-dt arrow-dr arrow-db [
    : draw ( -- )  xywh defocuscol @ @ dpy box
        xywh
        color @ $FF and 1 =
        IF  push?  IF  p-table  ELSE  f-table  THEN
        ELSE  d-table  THEN
        color @ $E >> $C and + perform e-draw ;
    : hglue tributton :: hglue drop 0 ;
    : vglue tributton :: vglue drop 0 ;
class;

\ slider

Eicon: hslider-d Estyle/ShinyMetal/bar_amber_horizontal_1.png"
Eicon: hslider-f Estyle/ShinyMetal/bar_amber_horizontal_2.png"
Eicon: hslider-p Estyle/ShinyMetal/bar_horizontal_3.png"

Eicon: vslider-d Estyle/ShinyMetal/bar_amber_vertical_1.png"
Eicon: vslider-f Estyle/ShinyMetal/bar_amber_vertical_2.png"
Eicon: vslider-p Estyle/ShinyMetal/bar_vertical_3.png"

arule class Erule
public: 2 cells var Estretch
how:
    : init  ( actor hxt vxt iconf icond -- )
        Estretch 2!  super init ;
    : draw  ( -- )
        xywh Estretch 2@
        color @ $FF and 1 <>  IF  swap  THEN  drop
        Eicon-pixmap with draw-at endwith dpy mask ;
class;

arule class Eside
public: cell var Eicons
how:
    : focus    1 color c! draw ;
    : defocus  0 color c! draw ;
    : init ( actor hxt vxt icon -- )
        Eicons ! super init ;
    : e-draw ( x y w h icon -- )
        Eicon-pixmap with draw-at endwith dpy mask ;
    : ep-draw ( x y w h icon -- ) >r parent xywh
        r> Eicon-pixmap with draw-at endwith
        >r >r 2drop 2drop 2drop { x y w h |
        x y parent xywh 2drop p- w h x y } r> r>
        dpy mask ;
    : draw ( -- )
        xywh Eicons @ ep-draw ;
class;

hslider implements
    : subbox ( -- ) 
        ^ R[ lstep ]R 0 slidetri new
        ^ R[ lpage ]R ['] part1 ['] part0 hslider-p Eside new
        ^ M[ slide ]M ['] part2 ['] part0 hslider-f hslider-d Erule new
          arule with $01000003 assign ^ endwith
        ^ R[ rpage ]R ['] part3 ['] part0 hslider-p Eside new
        ^ R[ rstep ]R 2 slidetri new
        5 ;
class;

hslider0 implements
    hslider :: subbox
class;

hscaler implements
    : subbox ( -- )
        ^ M[ slide ]M ['] part0a ['] part5 arule new
        ^ R[ lpage ]R ['] part1 ['] part0b hslider-p Eside new
        ^ M[ slide ]M [: part4 swap 2* xS + swap ;]
                      [: part0a swap xS 2* + swap ;]
                      hslider-f hslider-d Erule new
        arule with $01000003 assign ^ endwith
        ^ R[ rpage ]R ['] part3 ['] part0b hslider-p Eside new
        3 hbox new
        2 vbox new 1 ;
class;

vscaler implements
    : subbox ( -- )
        ^ M[ slide ]M ['] part5 ['] part0a arule new
        ^ R[ rpage ]R ['] part0b ['] part3 vslider-p Eside new
        ^ M[ slide ]M [: part0a swap xS 2* + swap ;]
                      [: part4 swap 2* xS + swap ;]
                      vslider-f vslider-d Erule new
        arule with $01000003 assign ^ endwith
        ^ R[ lpage ]R ['] part0b ['] part1 vslider-p Eside new
        3 vbox new
        2 hbox new 1 ;
class;

vslider implements
    : subbox ( -- )
        ^ R[ lstep ]R 1 slidetri new \ 1 ^ habox new fixbox
        ^ R[ lpage ]R ['] part0 ['] part1 vslider-p Eside new
        ^ M[ slide ]M ['] part0 ['] part2 vslider-f vslider-d Erule new
          arule with $02000003 assign ^ endwith
        ^ R[ rpage ]R ['] part0 ['] part3 vslider-p Eside new
        ^ R[ rstep ]R 3 slidetri new \ 1 ^ habox new fixbox
        5 ;
class;

vslider0 implements
    vslider :: subbox
class;

Eicon: vbutton-f Estyle/ShinyMetal/bar_vertical_2.png"
Eicon: vbutton-d Estyle/ShinyMetal/bar_vertical_1.png"
Eicon: vbutton-p Estyle/ShinyMetal/bar_vertical_3.png"

vrtsizer implements
    : draw ( -- )  xywh defocuscol @ @ dpy box
      e-choise e-button ; 
class;

vsizer implements
    vrtsizer :: draw
class;

vxrtsizer implements
    vrtsizer :: draw
class;

hrtsizer implements
    : he-choise ( -- m )
        color @ $FF and 1 =
        IF    push?
            IF    vbutton-p
            ELSE  vbutton-f  THEN
        ELSE  push?
            IF    vbutton-p
            ELSE  vbutton-d  THEN
        THEN  ;
    : draw ( -- )  xywh defocuscol @ @ dpy box
      he-choise e-button ; 
class;

hsizer implements
    hrtsizer :: draw
class;

hxrtsizer implements
    hrtsizer :: draw
class;

menu-entry implements
    : draw ( -- ) push? >r
        r@ 1 and
        IF    button-f e-button
        ELSE  xywh color @ dpy box  THEN
        text $@ xM r> 2 = 1 and textleft ;
class;

menu-title implements
    : draw ( -- )
        color 2+ c@
        IF    button-f e-button
        ELSE  xywh color @ dpy box  THEN
        text $@ 0 0 textcenter ;
class;

sub-menu implements
    : draw  ( -- ) push? >r
        r@ 1 and color 2+ c@ or
        IF    button-f e-button
        ELSE  xywh color @ dpy box  THEN
        text $@ xM r> 2 = 1 and textleft
        xM xS 2* + >r
        x @ w @ + r@ - y @ h @ r@ - 2/ + r> dup
        color $FF and 1 =
        IF   push? IF  tri-p-table  ELSE  tri-f-table  THEN
        ELSE  tri-d-table  THEN  2 cells + perform e-draw ;
class;

previous previous previous previous previous previous previous Forth