#! xbigforth
\ automatic generated code
\ do not edit

also editor also minos also forth

include midi-classes.fs
component class midi
public:
  infotextfield ptr filename
  button ptr play-it
  button ptr stop-it
  button ptr load-it
  button ptr close-it
  canvas ptr channel0
  canvas ptr channel1
  canvas ptr channel2
  canvas ptr channel3
  canvas ptr channel4
  canvas ptr channel5
  canvas ptr channel6
  canvas ptr channel7
  canvas ptr channel8
  canvas ptr channel9
  canvas ptr channelA
  canvas ptr channelB
  canvas ptr channelC
  canvas ptr channelD
  canvas ptr channelE
  canvas ptr channelF
 ( [varstart] ) midi-player ptr player
cell var midi-path
cell var scheduled ( [varend] ) 
how:
  : params   DF[ 0 ]DF X" Midi Player" ;
class;

include midi.fs
midi implements
 ( [methodstart] ) : ?player ( -- )
  player self 0= IF
     midi-player new bind player THEN 
  midi-path $@ filename get path+file player file ;
: dispose ( -- )
  midi-path @ IF  midi-path [ also memory ] HandleOff [ previous ] THEN
  super dispose ;
: do-draw
  canvas outer with scheduled @ scheduled on endwith
  0> IF  canvas outer with scheduled off endwith
  ELSE  parent draw dpy sync  THEN ;
: draw-sound ( i canvas -- )
  canvas with
     128 128 steps  0 0 0 rgb> backcolor clear
     7 lshift outer with player self
         IF  player patch-buf  ELSE  drop  0  THEN  endwith
     dup
     IF  127 0 DO  i $80 home!  dup I + c@ dup
                   IF  $00 $FF $80 rgb> drawcolor
                       >r path 0 r> to stroke
                   ELSE  drop  THEN
         LOOP  THEN  drop
     outer with
        scheduled @ 0< IF  ['] do-draw channel0 self
                           #40 after screen schedule  THEN
        scheduled off
     endwith
  endwith pause ; ( [methodend] ) 
  : widget  ( [dumpstart] )
          T" " ^^ ST[  ]ST ( MINOS ) X" Datei:" infotextfield new  ^^bind filename
            ^^ S[ ?player player start scheduled on draw ]S ( MINOS ) X" Play" button new  ^^bind play-it
            ^^ S[ ?player player stop 1 scheduled ! ]S ( MINOS ) X" Stop" button new  ^^bind stop-it
            ^^ S[ 1 scheduled !
s" MIDI" s" " midi-path @
IF  midi-path $@  ELSE  S" *.mid"  THEN
^ S[ 2swap midi-path $! filename assign ?player ]S fsel-action ]S ( MINOS ) X" Load" button new  ^^bind load-it
            ^^ S[ close ]S ( MINOS ) X" Close" button new  ^^bind close-it
            ^^  0 T[ player self IF  player precision on  THEN ][ ( MINOS ) player self IF  player precision off  THEN ]T ( MINOS )  TT" Timing Precission" X" time" tbutton new 
          #5 hatbox new #1 hskips
        #2 vabox new vfixbox  panel
          CV[ 0 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel0
          CV[ 1 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel1
          CV[ 2 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel2
          CV[ 3 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel3
          CV[ 4 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel4
          CV[ 5 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel5
          CV[ 6 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel6
          CV[ 7 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel7
          CV[ 8 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel8
          CV[ 9 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channel9
          CV[ 10 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channelA
          CV[ 11 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channelB
          CV[ 12 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channelC
          CV[ 13 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channelD
          CV[ 14 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channelE
          CV[ 15 ^ draw-sound ]CV ( MINOS ) ^^ CK[ 2drop 2drop  ]CK ( MINOS ) $80 $1 *hfil $8 $1 *vfil canvas new  ^^bind channelF
        #16 vabox new #-2 borderbox
      #2 vabox new
    ( [dumpend] ) ;
class;

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