#! xbigforth
\ automatic generated code
\ do not edit

also editor also minos also forth

menu-component class test-widgets
public:
  viewport ptr view0
  info-menu ptr coolness
  topindex ptr ti0
  topindex ptr ti1
  topindex ptr ti2
  button ptr clone-button
  beamer ptr beam1
  canvas ptr nikolaus
  infotextfield ptr tex
  vabox ptr topics
  vabox ptr sub-topics
 ( [varstart] ) early draw-cv1 ( [varend] ) 
how:
  : params   DF[ 0 ]DF X" FORTH" ;
class;

component class sub-menu1
public:
 ( [varstart] )  ( [varend] ) 
how:
  : params   DF[ 0 ]DF X" No Title" ;
class;

component class menu1
public:
 ( [varstart] )  ( [varend] ) 
how:
  : params   DF[ 0 ]DF X" No Title" ;
class;

component class color-menu1
public:
 ( [varstart] )  ( [varend] ) 
how:
  : params   DF[ 0 ]DF X" No Title" ;
class;

component class calc
public:
  infotextfield ptr a#
  infotextfield ptr b#
  infotextfield ptr r#
 ( [varstart] )  ( [varend] ) 
how:
  : params   DF[ 0 ]DF X" Calculator" ;
class;

calc implements
 ( [methodstart] )  ( [methodend] ) 
  : widget  ( [dumpstart] )
        #0. ]N ( MINOS ) ^^ SN[  ]SN ( MINOS ) X" A:" infotextfield new  ^^bind a#
        #0. ]N ( MINOS ) ^^ SN[  ]SN ( MINOS ) X" B:" infotextfield new  ^^bind b#
          ^^ S[ a# get b# get d+ r# assign ]S ( MINOS ) X" +" button new 
          ^^ S[ a# get b# get d- r# assign ]S ( MINOS ) X" -" button new 
          ^^ S[ a# get b# get d* r# assign ]S ( MINOS ) X" *" button new 
          ^^ S[ a# get b# get drop ud/mod r# assign drop ]S ( MINOS ) X" /" button new 
          ^^ S[ a# get 1. b# get drop 0 ?DO 2over d* LOOP r# assign 2drop ]S ( MINOS ) X" ^" button new 
          ^^ S[ r# get a# assign ]S ( MINOS ) X" >A" button new 
          ^^ S[ r# get b# assign ]S ( MINOS ) X" >B" button new 
        #7 hatbox new #1 hskips
        #0. ]N ( MINOS ) ^^ SN[  ]SN ( MINOS ) X" R:" infotextfield new  ^^bind r#
      #4 vabox new panel
    ( [dumpend] ) ;
class;

color-menu1 implements
 ( [methodstart] )  ( [methodend] ) 
  : widget  ( [dumpstart] )
        ^^ S[ gray-colors s" Gray" test-widgets coolness assign ]S ( MINOS ) X" Gray" menu-entry new 
        ^^ S[ red-colors s" Red" test-widgets coolness assign ]S ( MINOS ) X" Red" menu-entry new 
        ^^ S[ blue-colors s" Blue" test-widgets coolness assign ]S ( MINOS ) X" Blue" menu-entry new 
        ^^ S[ bisque-colors s" Bisque" test-widgets coolness assign ]S ( MINOS ) X" Bisque" menu-entry new 
          $0 $1 *hfil $0 $1 *vfil glue new 
        #1 habox new #-1 borderbox
        ^^ S[ paper s" Paper" test-widgets coolness assign ]S ( MINOS ) X" Paper" menu-entry new 
        ^^ S[ wood s" Wood" test-widgets coolness assign ]S ( MINOS ) X" Wood" menu-entry new 
        ^^ S[ water s" Water" test-widgets coolness assign ]S ( MINOS ) X" Water" menu-entry new 
        ^^ S[ water1 s" Caustics" test-widgets coolness assign ]S ( MINOS ) X" Caustics" menu-entry new 
        ^^ S[ marble s" Red Marble" test-widgets coolness assign ]S ( MINOS ) X" Red Marble" menu-entry new 
        ^^ S[ cracle s" Cracle" test-widgets coolness assign ]S ( MINOS ) X" Cracle" menu-entry new 
        ^^ S[ mono s" Mono" test-widgets coolness assign ]S ( MINOS ) X" Mono" menu-entry new 
      #12 vabox new #2 borderbox
    ( [dumpend] ) ;
class;

menu1 implements
 ( [methodstart] )  ( [methodend] ) 
  : widget  ( [dumpstart] )
        ^^ S[ s" Menu 0" test-widgets tex assign ]S ( MINOS ) X" Menu 0" menu-entry new 
        ^^ S[ s" Menu 1" test-widgets tex assign ]S ( MINOS ) X" Menu 1" menu-entry new 
        ^^ S[ s" Menu 2" test-widgets tex assign ]S ( MINOS ) X" Menu 2" menu-entry new 
      #3 vabox new #2 borderbox
    ( [dumpend] ) ;
class;

sub-menu1 implements
 ( [methodstart] )  ( [methodend] ) 
  : widget  ( [dumpstart] )
        ^^ S[ s" Menu 0" test-widgets tex assign ]S ( MINOS ) X" Menu 0" menu-entry new 
        ^^ S[ s" Menu 1" test-widgets tex assign ]S ( MINOS ) X" Menu 1" menu-entry new 
        M: menu1 menu X" Sub-Menu" sub-menu new 
        ^^ S[ s" Menu 2" test-widgets tex assign ]S ( MINOS ) X" Menu 2" menu-entry new 
      #4 vabox new #2 borderbox
    ( [dumpend] ) ;
class;

test-widgets implements
 ( [methodstart] ) : beam-clone  beam1 self
  screen self window new window with
      beamer with clone endwith s" Clone" assign show
  endwith ;
: show ( -- )
    #300 #400 geometry dpy sync super show beam-clone ;
: xto ( x y n1 n2 -- )
    2dup >=
    IF    - $100 min tuck * 8 >> >r * 8 >> r> canvas to
    ELSE  2drop 2drop  THEN ;
: draw-cv1 ( o -- flag )
    canvas with
        $300 $400 steps
        timer@ $E << $1000 um* nip >r
        clear
         2 linewidth
         $00 $00 $FF rgb> drawcolor
         $FF $00 $00 rgb> fillcolor
         $080  $380 home!  path
         $000  $200 r@ $100 xto
         $100  $100 r@ $200 xto
         $100 $-100 r@ $300 xto
        $-200  $000 r@ $400 xto
         $200 $-200 r@ $500 xto
         $000  $200 r@ $600 xto
        $-200 $-200 r@ $700 xto
         $200  $000 r@ $800 xto
        r@ $900 >= IF  canvas fill  THEN  canvas stroke
        1 1 textpos
        icon" icons/green-dot" icon
        1 0 textpos
        r@ $000 $200 within IF s" wer" THEN
        r@ $200 $300 within IF s" malt" THEN
        r@ $300 $400 within IF s" das" THEN
        r@ $400 $500 within IF s" Haus" THEN
        r@ $500 $600 within IF s" vom" THEN
        r@ $600 $700 within IF s" Ni-" THEN
        r@ $700 $800 within IF s" Niko-" THEN
        r@ $800 >= IF s" Nikolaus" THEN  canvas text
        0 linewidth
        r> $900 >=
    endwith ;
: start-cv1  recursive
    ^ draw-cv1 drop dpy sync ['] start-cv1 ^ #30 after dpy schedule ;
 ( [methodend] ) 
  : widget  ( [dumpstart] )
        M: menu1 menu X" FORTH" menu-title new 
        M: sub-menu1 menu X"  File " menu-title new 
        M: color-menu1 menu X"  Options " menu-title new 
        $0 $1 *hfilll $0 $1 *vfil rule new 
      #4 hbox new vfixbox  #2 borderbox
        1 1 viewport new  ^^bind view0 DS[ 
                  ^^ S[ s" Testbutton" tex assign ]S ( MINOS ) X" Testbutton" lbutton new 
                    ^^ S[ s" Button 1" tex assign ]S ( MINOS ) X" Button 1" button new 
                    ^^ S[ s" But 2" tex assign ]S ( MINOS ) X" But 2" button new 
                    $10 $1 *hfil $10 $1 *vfil glue new 
                    ^^ S[ s" Button 3" tex assign ]S ( MINOS ) X" Button 3" button new 
                  #4 hatbox new #2 hskips #2 borderbox
                  M: color-menu1 menu X" Coolness:" info-menu new  ^^bind coolness
                      0 0 flipper X" Index 0" topindex new ^^bind ti0
                      0 0 flipper X" Index 1" topindex new ^^bind ti1
                      0 -1 flipper X" Index 2" topindex new ^^bind ti2
                      topglue new 
                    #4 harbox new
                        ^^ S[ s" Index 0" tex assign ]S ( MINOS ) X" Index 0" button new 
                        ^^ S[ s" Klick mal" tex assign ]S ( MINOS ) X" Klick mal" button new 
                        $10 $1 *hfilll $10 $1 *vfil glue new 
                      #3 harbox new flipbox  panel dup ^^ with C[ ti0 ]C ( MINOS ) endwith 
                        ^^ S[ s" Index 1" tex assign ]S ( MINOS ) X" Index 1" button new 
                        ^^ S[ s" Kuck mal" tex assign ]S ( MINOS ) X" Kuck mal" button new 
                        $10 $1 *hfil $10 $1 *vfil glue new 
                      #3 hartbox new flipbox  panel dup ^^ with C[ ti1 ]C ( MINOS ) endwith 
                        ^^ S[ s" Kuck" tex assign ]S ( MINOS ) X" Kuck" button new  font" -*-verdana-medium-r-*--17-*-*-*-p-0-iso8859-15"
                        ^^ S[ s" mal" tex assign ]S ( MINOS ) X" mal" button new  font" -*-verdana-medium-i-*--17-*-*-*-p-0-iso8859-15"
                        ^^ S[ s" wer" tex assign ]S ( MINOS ) X" wer" button new  font" -*-verdana-bold-r-*--17-*-*-*-p-0-iso8859-15"
                        ^^ S[ s" da" tex assign ]S ( MINOS ) X" da" button new  font" -*-verdana-bold-i-*--17-*-*-*-p-0-iso8859-15"
                        ^^ S[ s" spricht" tex assign ]S ( MINOS ) X" spricht" button new 
                      #5 harbox new panel dup ^^ with C[ ti2 ]C ( MINOS ) endwith 
                    #3 habox new $10  noborderbox  #2 borderbox
                  #2 vabox new
                  ^^ S[ s" Button 4" tex assign ]S ( MINOS ) X" Button 4" button new 
                      ^^ S[ s" Printer-Icon" tex assign ]S ( MINOS )  icon" icons/printer" X" Printer-Icon" big-icon new 
                      $0 $1 *hfilll $10 $1 *vfilll rule new 
                        ^^ S[ beam-clone ]S ( MINOS ) X" Clone" button new  ^^bind clone-button
                      #1 habox new
                    #3 vabox new hfixbox 
                      :beamer beamer new  ^^bind beam1 D[ 
                        doublebuffer new  D[ 
                          CV[ outer with nikolaus with start-cv1 endwith endwith ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $10 $A *hfil $10 $A *vfil canvas new  ^^bind nikolaus
                        #1 habox new ]D ( MINOS ) 
                      #1 habox new ]D ( MINOS ) 
                    #1 habox new #-2 borderbox
                  #2 habox new #1 hskips
                  T" " ^^ ST[  ]ST ( MINOS ) X" Text:" infotextfield new  ^^bind tex
                    ^^ 0 #64 #16 SL[ extend tuck dabs <# #S rot sign #> tex assign ]SL ( MINOS ) hslider new 
                    ^^ 0 #64 #16 SL[ extend tuck dabs <# #S rot sign #> tex assign ]SL ( MINOS ) hslider new 
                  #2 habox new
                  ^^ #0 #1000 SC[ extend tuck dabs <# #S rot sign #> tex assign ]SC ( MINOS ) hscaler new  #-500 SC# 
                        ^^  0 T[ topics +flip ][ ( MINOS ) topics -flip ]T ( MINOS ) X" -" T" +" togglebutton new 
                      #1 habox new hfixbox 
                      ^^ S[ s" Flip It" tex assign ]S ( MINOS ) X" Flip It!" lbutton new 
                    #2 habox new
                        $10 $1 *hpix $10 $1 *vfil rule new 
                          ^^ S[ sub-topics flip ]S ( MINOS ) X" Topic A" lbutton new 
                              $10 $1 *hpix $10 $1 *vfil rule new 
                                ^^ S[ s" Sub-Topic A.0" tex assign ]S ( MINOS ) X" Sub-Topic A.0" lbutton new 
                                ^^ S[ s" Sub-Topic A.1" tex assign ]S ( MINOS ) X" Sub-Topic A.1" lbutton new 
                                ^^ S[ s" Sub-Topic A.2" tex assign ]S ( MINOS ) X" Sub-Topic A.2" lbutton new 
                              #3 vabox new
                            #2 habox new
                          #1 vabox new ^^bind sub-topics flipbox 
                          ^^ S[ s" Topic B" tex assign ]S ( MINOS ) X" Topic B" lbutton new 
                          ^^ S[ s" Topic C" tex assign ]S ( MINOS ) X" Topic C" lbutton new 
                        #4 vabox new
                      #2 habox new
                    #1 vabox new ^^bind topics flipbox 
                  #2 vabox new
                #10 vabox new panel
                ^^ #0 #10000 SC[ 0 <# #S #> tex assign ]SC ( MINOS ) vscaler new 
              #2 habox new
              vrtsizer new 
            #2 vasbox new
            $10 $1 *hfil $0 $1 *vfil rule new 
              vrtsizer new 
                  $0 $1 *hfil $0 $1 *vfil rule new 
                  hrtsizer new 
                #2 hasbox new
                  1 1 vviewport new  DS[ 
                        ^^ -1 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/mini-cross"icons/mini-exclam" X" Toggle 0" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/mini-cross"icons/mini-exclam" X" Toggle 1" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/mini-cross"icons/mini-exclam" X" Toggle 2" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/mini-cross"icons/mini-exclam" X" Toggle 3" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle 4" rbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle 5" rbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle 6" rbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle 7" rbutton new 
                      #8 varbox new
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/red-dot"icons/green-dot" X" Toggle 8" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/red-dot"icons/green-dot" X" Toggle 9" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/red-dot"icons/green-dot" X" Toggle A" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS )  2icon" icons/red-dot"icons/green-dot" X" Toggle B" ticonbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle C" tbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle D" tbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle E" tbutton new 
                        ^^  0 T[  ][ ( MINOS )  ]T ( MINOS ) X" Toggle F" tbutton new 
                      #8 vabox new
                    #2 habox new
                  #1 vabox new ]DS ( MINOS ) 
                  hrtsizer new 
                #2 hasbox new
                $0 $1 *hfil $0 $1 *vfil rule new 
              #3 habox new
            #2 vasbox new
          #3 vabox new
        #1 habox new ]DS ( MINOS ) 
      #1 vabox new
    ( [dumpend] ) ;
class;

: main
  calc open-app
  test-widgets open-app
  event-loop bye ;
script? [IF]  main  [THEN]
previous previous previous
