-13 >ifflag
   20 0 reserve
>endf

5 >ask "Chemin I:\SONS\*.*"
   \ vrai pour chemin i:\sons\*.*
   \ faux pour chemin \*.*

\ 6 >true   \ vrai pour MIDIPLAY.RSN
6 >false  \ faux pour MIDIPVBL.RSN

_app 0= if
   appl_init intout w@
   "   Forth MusicPlayer" menu_register
then

>comp

variable p        \ le module SNDH
variable fichier  \ adresse du fichier
variable total    \ taille totale fichier
128 string filepath
20 string filename
20 string filetemp
variable fhd      \ handle du fichier
variable playing  \ flag en cours ou non
4 string speed    \ chaine du dialogue
2 string track    \ idem
variable done     \ pour accessoire, ne pas refaire init plusieurs fois
&wvar ID          \ celui de l'accessoire
variable sortie   \ flag pour quitter
variable midi_type     \ midi 0,1,2
variable cmdline  \ 0 ou taille ligne de commande
variable q
variable r

3 constant MODn   \ nombre de modules
variable MODi     \ index du module courant de 0  MODn-1

16 allot constant BUF
14 allot constant OUT

%b11101 >include "%MIDIPLAY.DEF"

>comp

_app 0= if
   intout w@ ID w!
then

MODn array MODtab   \ tableau des modules

>comp

: HEADER
   [var]
   1 >include "%MIDIPLAY.RSC"
;

: MODULE0
   18 [war]         \ le module doit etre prcd de 32 octets
   0 0 0 0 0 0      \ ici j'en cre 36, et 18[war] renvoie l'adresse
                    \ du dbut du module
-6 >ifflag
   1 >include "D:\PARX.SYS\RSN\MIDIPVBL.RSN"
>endf
6 >ifflag
   1 >include "D:\PARX.SYS\RSN\MIDIPLAY.RSN"
>endf
;

: MODULE1
   18 [war]
   0 0 0 0 0 0
   1 >include "D:\PARX.SYS\RSN\SNDH.RSN"
;

: MODULE2
   18 [war]
   0 0 0 0 0 0
   1 >include "D:\PARX.SYS\RSN\XLR8.RSN"
;

>comp

HEADER rsrc_rcfix
0 0 rsrc_gaddr addrout @
dup constant TREE
    &wdial_create MAFENETRE

MODULE2 MODULE1 MODULE0
MODn 0 do i MODtab ! loop


>comp
\ object
:: redraw_object
   MAFENETRE 4 + q !
   0 over 24 * TREE + 16 + r !
   .w size
   q )+@ r )+@ +   \ x fenetre + x bouton
   q )+@ r )+@ +   \ y fenetre + y bouton
   r )+@ r )+@     \ w et h
   TREE objc_draw
;

\ code objet setflag
: setflag
   24 * TREE + 11 + c@ 1 and \ 0 ou 1 selon objet slectionn
   -2 p modexe drop
;

: setflags
   MODi @ 1 <>            \ aucune commande pour SNDH
   if
      %h102 CONTPRES setflag   \ sert de force50Hz au XLR8
      MODi @ 0=            \ uniquement MIDI ici
      if
         %h100 speed val
         ?dup 0= if
            " 100" speed $!
            100
            VITESSE redraw_object
         then
         -2 p modexe drop
         %h101 SYSEX    setflag
         %h103 PROGCHG  setflag
         32 0 do
            i dup TRACKON + setflag
         loop
         16 0 do
            i 32 + i CHANNON + setflag
         loop
      then
   then
;

: disable
   over + swap do
      i 24 * TREE + 11 +   \ adresse state
      %hFE over c@ and               \ enleve le 1 selected
      8 or                           \ met le 8 disabled
      swap c!                        \ et stocke
   loop
;

: tracks_off
   TRACKON 32 disable
;

: on_unsel
   TRACKON + 24 * TREE +
   11 + dup c@ 1 or swap c!
;

: on_sel
   TRACKON + 24 * TREE +
   11 + dup c@ 1 or %hF7 and swap c!
;

: set_track
   midi_type @ 2 =
   if
      on_unsel
   else
      on_sel
   then
;

: tracks_on
   tracks_off
   0 on_unsel
   midi_type @
   if
      sndb 28 + @ 2/ %h7FFFFFFF and
      32 1 do
         2 /mod
         if
            i set_track
         then
      loop
      drop
   then
;

: channels_off
   CHANNON 16 disable
;

: channels_on
   16 0 do
      i CHANNON + 24 * TREE + 11 +   \ adresse state
      1 over c@ or                   \ met le 1 selected
      %hF7 and                       \ enleve disabled
      swap c!                        \ et stocke
   loop
;

:: obspec
   24 * TREE + 12 +
;

: set_button
   24 * TREE + 11 + dup >r
   c@ %hF7 and
   swap 0= if 8 or then
   r> c!
;

\ chaine enab1 enab2 enab3
: 3-button
   SYSEX    set_button
   PROGCHG  set_button
   CONTPRES set_button
   CONTPRES obspec @ @ puts
;

\ (soit play=0, soir pause=1)
:: play_pause
   if
      " Pause"
   else
      " Play"
   then
   PLAYBUT obspec !
   PLAYBUT redraw_object
;

: ferme
   fhd @ ?dup
   if
      fclose drop
      0 fhd !
      fichier @ mfree drop
   then
;

: init
   done @ 0=
   if
      screen_info %h40000 <      \ moins de 16 couleurs?
      if
         1 -1 TREE rsrc_mono    \ adapter en MONO
      then
      " D:\PARX.SYS\" 1 modset
      MODn 0 do
         0 i MODtab modload drop
      loop
      cmdline @ if
         basepage 129 + getpath filepath $!
         basepage 129 + getfile filetemp $!
      else
5 >ifflag
         " I:\SONS\*.*" filepath $!
>endf
-5 >ifflag
         " \*.*" filepath $!
>endf
         " " filename $!
      then
      " 100" speed $!
      " 1" track $!
         \ attribue les chaines aux FTEXT
      filename FICHIER obspec @ !
      speed    VITESSE obspec @ !
      track    PISTE   obspec @ !
      0 fhd !       \ marqueur de fichier ouvert
      0 playing !   \ marqueur de musique en cours
      1 done !
      0 play_pause
   then
;

: playmusic
   fhd @ 0 <>      \ un fichier ouvert
   if
      playing @ 0=   \ et pas de musique en cours
      if
         1 play_pause
         setflags   \ selon les modules...
         track val
         ?dup 0= if
            " 1" track $!
            1
            PISTE redraw_object
         then
         p modexe drop
         1 playing !
      else         \ ici si musique en cours, c'est pause!
         %h8000 p modexe %h8000 < if
            1 play_pause
         else
            0 play_pause
         then
      then
   then
;

: stopmusic
   fhd @ 0 <>
   playing @ 0 <>
   and
   if
      0 p modexe drop
      0 playing !
      0 play_pause
   then
;

: refresh
   3 0 0 0 0 MAFENETRE 4 + get_xywh form_dial
;

: charge
   cmdline @ if
      1
   else
      filename filetemp $!
      filepath filetemp fsel_input
      intout w@ intout 2+ w@ *
   then
   if
      filetemp filename $!
      stopmusic        \ au cas o
      fhd @ if         \ si fichier dj ouvert
         ferme         \ on ferme et libre l'ancien bloc
      then
      filepath filename path
      0 fopensize fhd ! 1+ %hFFFFFFFE and total ! \ pair

      MODn 0 do
         i MODtab @ p !
         fhd @ p modinfo ?dup
      0= ifloop
      dup MODi !
      MODn <>
      if
         MODi @
         case
            0 of " Ctrl Press" 1 1 1 endof
            1 of " Ctrl Press" 0 0 0 endof
            drop " Force 50Hz" 1 0 0
         endcase
         3-button
         1 =   \ est-ce un fichier compress? (1 renvoy par modinfo)
         if
            total @                \ taille fichier
            sndb 8 + @ +           \ + taille dcomp
            malloc fichier !       \ = taille  rserver
            fichier @              \ source
            dup total @ +          \ destination
            p modpal drop
         else   \ ici fichier non compress
            total @ malloc fichier !
            fichier @ -1 p modpal
            -2 =
            if
               1
               start
               " [1][ Warning :| Too many tracks ! | ( #"
               pushs
               32 sndb 16 + @ 10 + dup w@ pushv w!
               "  ) ][ Use first 32 ]" pushs
               getfmt
               form_alert
            then
         then
         sndb @ TYPE obspec @ !        \ le type (MIDI, SNDH...)
         MODi @
         if
            channels_off
            tracks_off
            2 32         \ pour XLR8 et SNDH, un espace et simuler MIDI2
         else
            channels_on
            sndb 16 + @ 9 + c@ dup midi_type !
            dup 48 +     \ pour MIDI type 0/1/2 en ASCI
            tracks_on    \ a besoin de midi_type
         then
         TYPE obspec @ 5 + c!
         " 1" track $!
         2 =
         if
            sndb 20 + @ <# # # #>
         else
            " 01"
         then
         PISTE obspec @ 4 + @ 9 + puts
      else
         1 " [3][ Unknown file type ! ][ Cancel ]" form_alert
         ferme
      then
   then
;


>comp




: main
   init
   0 v_show_c
   cmdline @ if
      charge
      0 cmdline !
   then
   VITESSE " Forth's Music Player" MAFENETRE wdial_open drop
   0 sortie !
   \ refresh
   begin
      playing @
      if
         -1 p modexe 0=
         if
            0 playing !
         then
      then
      BUF OUT wdial_evnt
      begin
         BUF OUT wdial_formdo
      while
         drop   \ une seule fentre, pas de test
         case
            -1 of stopmusic MAFENETRE wdial_close
                 1 sortie ! endof
            STOPBUT  of stopmusic
                 STOPBUT MAFENETRE wdial_change endof
            PLAYBUT  of playmusic
                 PLAYBUT MAFENETRE wdial_change endof
            FICHIER  of charge
                 FICHIER MAFENETRE wdial_change
                 refresh endof
            drop
         endcase
      repeat
      sortie @
   until
   ferme
;

: boucle_sans_fin
   0 v_show_c
   begin
      BUF evnt_mesag
      BUF w@
      40 =         \ rveiller l'accessoire?
      BUF 8 + w@
      ID w@ = and  \ c'est bien le mien ?
      if
         " " filename $!
         main
      then
   again
;

>comp

0 done !

-13 >ifflag       \ sous l'interprteur ne rien faire !
                  \ sinon, on lance...

_app if
   basepage 128 + c@ cmdline !
   main
else
   0 cmdline !
   boucle_sans_fin
then


>endf






