#! 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