' ******************************************************************************
' ****                           Configurateur pour le PACK_3D              ****
' ****                           Version 0.0.1                              ****
' **** (C) BARANGER Emmanuel                                      GFA 3.6TT ****
' **** 31, rue de la porte Morard                                           ****
' **** 28000 Chartres                                                       ****
' **** France  Tlphone : 06 16 67 89 04                        18/02/2006 ****
' ****                     02 37 35 67 02                                   ****
' **** e-mail : embaranger@free.fr                                          ****
' **** WEB    : http://ebmodel3.atari.org                                   ****
' ****                                                                      ****
' **** Produit totalement libre de droit. Je vous livre les sources pour    ****
' **** que vous puissiez vous amiser un peu avec.                           ****
' ******************************************************************************
$m64000                                 ! Pour le compilateur
compile!=BYTE{ADD(BASEPAGE,256)}<>96    ! L'xcution est elle en compil
IF NOT compile!                         ! Si ce n'est pas le cas
  RESERVE 64000                         ! On rserve un peu de mmoire
ENDIF                                   ! Sinon, on continue
ap_id&=@appl_init                       ! Recuperer l'AP_ID de l'application
IF ap_id&=-1                            ! AP_ID incorrecte...Dsol, mais
  n%=@prendre(512,FALSE,3)              ! il faut prvenir que le lancement
  CHAR{n%}="[1]["                       ! du programme est annul
  CHAR{n%}=CHAR{n%}+" Mauvais ID d'application,|"
  CHAR{n%}=CHAR{n%}+" Programme arrt !       |"
  CHAR{n%}=CHAR{n%}+" Bad application ID,      |"
  CHAR{n%}=CHAR{n%}+" Programm stopped !       |"
  CHAR{n%}=CHAR{n%}+"][ Dsol | Sorry ]"+CHR$(0)
  ~@afficher_alerte(n%)
  libere(*n%)
  appl_exit                             ! on le dit au GEM
  END                                   ! et on sort de l. ...snif
ENDIF
definir_variables                       ! les constantes du programme
open_virtuel_screen_workstation(2)      ! Ouvrir une station de travail
etude_du_systeme                        ! Mais quelle machine est ce donc ?
extended_inquire_function               ! On rcupre toutes les donnes
ON ERROR GOSUB gestion_des_erreurs      ! Pour les erreurs. Si, si, il y en a !
IF @initialisation                      ! Initialisation complte du programme
retour_des_erreurs:                     ! En cas d'erreur c'est la le retour
  boucle_principale                     ! Boucle presque sans fin
ENDIF                                   !
liberation_memoire                      ! On rend la mmoire au GEM
close_virtual_screen_workstation(vdihandle%) ! On ferme la sation de travail
appl_exit                               ! et on le dit au GEM
END                                     ! L, c'est la fin...snif...snif
'                                       !
> PROCEDURE boucle_principale           ! La, on boucle et on attend
  LOCAL event&                          ! Type d'vnement, index de boucle
  '
  souris|=11
  asouris|=100
  DO                                      ! BOUCLE PRINCIPALE DU PROGRAMME
    ' Appel fonction xform_do() qui gre le bureau
    event&=@xform_do(&X110011,adr_desk%,255)
    '
    whandle&=@wind_find(mx&,my&)
    IF BTST(event&,4)                     ! EVENEMENT DE MESSAGE
      evenements_message
      CLR event&
    ENDIF
    IF BTST(event&,0)                     ! EVENEMENT CLAVIER
      evenements_clavier
      CLR event&
    ENDIF
    IF BTST(event&,1)                     ! EVENEMENT DE CLIC SOURIS
      evenements_souris
      CLR event&
    ENDIF
    '
    evenements_autres                     ! AUCUN EVENEMENT MAIS LA SOURIS BOUGE
    '
  LOOP WHILE NOT fin_programme!
  '
RETURN
'
> PROCEDURE evenements_message          ! Tien ! un message vient d'arriver
  LOCAL xw&,yw&,ww&,hw&  ! Coordonnes zone de travail fentre
  LOCAL dummy&,adr_arb%,obstate&
  LOCAL zx&,zy&,zw&,zh&,adrc%,cr|,cv|,cb|,c0
  LOCAL fx&,fy&,fw&,fh&
  '
  $S&,S>
  SELECT INT{buf%}
  CASE mn_selected&
    evenements_menus
  CASE wm_redraw&
    redraw(INT{ADD(buf%,8)},INT{ADD(buf%,10)},INT{ADD(buf%,12)},INT{ADD(buf%,14)},TRUE)
  CASE wm_topped&
    wind_set(INT{ADD(buf%,6)},wf_top&,0,0,0,0)
    ~@wind_get(INT{ADD(buf%,6)},wf_workxywh&,xw&,yw&,ww&,hw&)
  CASE wm_closed&
    dummy&=@numero_fenetre(INT{ADD(buf%,6)})
    IF dummy&<>-1
      SELECT dummy&
      CASE idx_generale&
        fin_programme!=TRUE
      ENDSELECT
      IF (NOT fin_programme!)
        fermeture_fenetre(SHL(dummy&,1))
      ENDIF
    ENDIF
  CASE wm_fulled&
    '  fulled
  CASE wm_moved&
    zx&=SHL(SHR(INT{ADD(buf%,8)},2),2)          ! Sur un multiple de 8
    zy&=INT{ADD(buf%,10)}
    zw&=INT{ADD(buf%,12)}
    zh&=INT{ADD(buf%,14)}
    wind_set(INT{ADD(buf%,6)},wf_currxywh&,zx&,zy&,zw&,zh&)
    dummy&=@numero_fenetre(INT{ADD(buf%,6)})
    IF dummy&<>-1
      ~@wind_get(INT{ADD(hwind%,SHL(dummy&,1))},wf_workxywh&,xw&,yw&,ww&,hw&)
      OB_X(@arbre_ressource(dummy&),0)=xw&
      OB_Y(@arbre_ressource(dummy&),0)=yw&
    ENDIF
  CASE wm_sized&
    wind_set(INT{ADD(buf%,6)},wf_currxywh&,INT{ADD(buf%,8)},INT{ADD(buf%,10)},INT{ADD(buf%,12)},INT{ADD(buf%,14)})
    dummy&=@numero_fenetre(INT{ADD(buf%,6)})
    redraw_force(dummy&,dummy&)
  CASE wm_newtop&
    wind_set(INT{ADD(buf%,6)},wf_currxywh&,INT{ADD(buf%,8)},INT{ADD(buf%,10)},INT{ADD(buf%,12)},INT{ADD(buf%,14)})
  CASE bubblegem_request&
    bulles_d_aide
  CASE ap_dragdrop&
    '
  CASE va_start&
    IF travail_a_sauver! AND (nombre_d_objets&>0)
      IF @afficher_alerte(adr_danger%)=2
        chargement_par_va_start
      ENDIF
    ELSE
      chargement_par_va_start
    ENDIF
  CASE shut_down&
    IF travail_a_sauver! AND (nombre_d_objets&>0)
      IF @afficher_alerte(adr_danger%)=2
        IF @afficher_alerte(adr_quitter%)=1
          fin_programme!=TRUE
        ENDIF
      ENDIF
    ELSE
      IF @afficher_alerte(adr_quitter%)=1
        fin_programme!=TRUE
      ENDIF
    ENDIF
  CASE wm_zero&
    INT{ADD(buf%,8)}=0
    INT{ADD(buf%,10)}=0
    INT{ADD(buf%,12)}=0
    INT{ADD(buf%,14)}=0
  ENDSELECT
  '
RETURN
> PROCEDURE evenements_menus            ! Bon, on a cliquer dans les menus
  '
  ' Placer le titre de menus dans son tat normal
  menu_tnormal(adr_menu%,INT{ADD(buf%,6)},1)
  $S&,S>
  SELECT INT{ADD(buf%,8)}       ! Selon l'option de menu clique
  CASE minfo&
    ouvrir_information
  CASE mcharger&
  CASE msauverr&
  CASE mquitter&
    ' IF @afficher_alerte(adr_quitter%)=1
    fin_programme!=TRUE
    ' ENDIF
  ENDSELECT
  '
RETURN
> PROCEDURE evenements_souris           ! La souris a encore fait des siennes
  LOCAL dummy&,i&,rx&,ry&
  LOCAL fx&,fy&,fw&,fh&
  LOCAL top&,anc_ob_ac&
  LOCAL src_depl%
  LOCAL des_depl%
  LOCAL tai_depl%
  LOCAL univ%,adr_poi%
  '
  dummy&=@numero_fenetre(@wind_find(mx&,my&))
  $S&,S>
  SELECT dummy&
  CASE idx_info&
    gestion_information
  CASE idx_generale&
    gestion_generale
  CASE idx_auteur&
    gestion_auteur
  ENDSELECT
  '
RETURN
> PROCEDURE evenements_clavier          ! Pas si fort, les touches sont fragiles
  ' Un petit souvenir de EB Model 3. Un certain nombre de code AsCan des touches
  ' qui m'ont servit dans le modeleur. Vous viterez de chercher comme moi ainsi.
  '
  IF edit&=0
    kbd&=BCLR(kbd&,4)                   ! Annuler bit Capslock
    IF key&=&H206
      '                                         Touche CONTROL '1'
    ELSE IF key&=&H302
      '                                         Touche CONTROL '2'
    ELSE IF key&=&H402
      '                                         Touche CONTROL '3'
    ELSE IF key&=&H507
      '                                         Touche CONTROL '4'
    ELSE IF key&=&H608
      '                                         Touche CONTROL '5'
    ELSE IF key&=&H71D
      '                                         Touche CONTROL '6'
    ELSE IF key&=&H80A
      '                                         Touche CONTROL '7'
    ELSE IF key&=&H901
      '                                         Touche CONTROL '8'
    ELSE IF CARD(key&)=&HA07
      '                                         Touche CONTROL '9'
    ELSE IF CARD(key&)=&HB05
      '                                         Touche CONTROL '0'
    ELSE IF CARD(key&)=&HC09
      '                                         Touche CONTROL ''
    ELSE IF key&=&H211
      '                                         Touche SHIFT CONTROL '1'
    ELSE IF key&=&H300
      '                                         Touche SHIFT CONTROL '2'
    ELSE IF key&=&H413
      '                                         Touche SHIFT CONTROL '3'
    ELSE IF key&=&H514
      '                                         Touche SHIFT CONTROL '4'
    ELSE IF key&=&H615
      '                                         Touche SHIFT CONTROL '5'
    ELSE IF key&=&H71E
      '                                         Touche SHIFT CONTROL '6'
    ELSE IF key&=&H817
      '                                         Touche SHIFT CONTROL '7'
    ELSE IF key&=&H918
      '                                         Touche SHIFT CONTROL '8'
    ELSE IF CARD(key&)=&HA19
      '                                         Touche SHIFT CONTROL '9'
    ELSE IF CARD(key&)=&HB10
      '                                         Touche SHIFT CONTROL '0'
    ELSE IF key&=&H3B00
      '                                         Touche F1
    ELSE IF key&=&H5400
      '                                         Touche Shift F1
    ELSE IF key&=&H3C00
      '                                         Touche F2
    ELSE IF key&=&H5500
      '                                         Touche Shift F2
    ELSE IF key&=&H3D00
      '                                         Touche F3
    ELSE IF key&=&H5600
      '                                         Touche Shift F3
    ELSE IF key&=&H3E00
      IF BTST(kbd&,cl_control&)
        '                                       Touche CONTROL F4
      ELSE IF BTST(kbd&,cl_alternate&)
        '                                       Touche ALTERNATE F4
      ELSE
        '                                       Touche F4
      ENDIF
    ELSE IF key&=&H5700
      '                                         Touche Shift F4
    ELSE IF key&=&H3F00
      '                                         Touche F5
    ELSE IF key&=&H5800
      '                                         Touche Shift F5
    ELSE IF key&=&H4000
      '                                         Touche F6
    ELSE IF key&=&H5900
      '                                         Touche Shift F6
    ELSE IF key&=&H4100
      '                                         Touche F7
    ELSE IF key&=&H5A00
      '                                         Touche Shift F7
    ELSE IF key&=&H4200
      '                                         Touche F8
    ELSE IF key&=&H5B00
      '                                         Touche Shift F8
    ELSE IF key&=&H4300
      '                                         Touche F9
    ELSE IF key&=&H5C00
      '                                         Touche Shift F9
    ELSE IF key&=&H4400
      '                                         Touche F10
    ELSE IF key&=&H5D00
      '                                         Touche Shift F10
    ELSE IF key&=&H11B
      ' Touche ESC        A ne pas utiliser pour ne pas interfrer avec
      '                   les saisies du GEM
    ELSE IF key&=&HF09
      IF BTST(kbd&,cl_shift_droit&) OR BTST(kbd&,cl_shift_gauche&)
        '                                       Touche Shift TAB
      ELSE
        '                                       Touche TAB
      ENDIF
    ELSE IF key&=&H2E63 OR key&=&H2E43
      '                                         Touche 'C' ou 'c'
    ELSE IF key&=&H2D78 OR key&=&H2D58
      '                                         Touche 'x' ou 'X'
    ELSE IF key&=&H1579 OR key&=&H1559
      '                                         Touche 'y' ou 'Y'
    ENDIF
  ELSE IF key&=&H1970 OR key&=&H1950
    '                                           Touche 'p' ou 'P'
  ELSE IF key&=&H117A OR key&=&H115A
    '                                           Touche 'Z' ou 'z'
  ELSE IF key&=&H1675 OR key&=&H1655
    '                                           Touche 'U' ou 'u'
  ELSE IF key&=&H2146 OR key&=&H2166
    '                                           Touche 'F' ou 'f'
  ELSE IF key&=&H1474 OR key&=&H1454
    '                                           Touche 'T' ou 't'
  ELSE IF key&=&H1372 OR key&=&H1352
    '                                           Touche 'R' ou 'r'
  ELSE IF SHR&(key&,8)=&H4D
    '                                           Curseur vers la droite
  ELSE IF SHR&(key&,8)=&H4B
    '                                           Curseur vers la gauche
  ELSE IF SHR&(key&,8)=&H48
    '                                           Curseur vers le haut
  ELSE IF SHR&(key&,8)=&H50
    '                                           Curseur vers le bas
  ELSE IF SHR&(key&,8)=&H52
    '                                           Touche INSERT
  ELSE IF key&=&H537F
    '                                           Touche DELETE
  ELSE IF BYTE(key&)=&H2B
    '                                           Touche '+'
  ELSE IF BYTE(key&)=&H2D
    '                                           Touche '-'
  ELSE IF key&=&H662A OR key&=&H1B2A
    '                                           Touche '*' pav numrique ou clavier
  ELSE IF key&=&H6100
    '                                           Touche 'UNDO'
  ELSE IF key&=&H4700
    '                                           Touche 'CLR/HOME'
  ELSE IF key&=&H6200
    '                                           Touche 'HELP'
  ELSE IF key&=&H314E OR key&=&H316E
    '                                           Touche 'N' ou 'n'
  ELSE IF key&=&H276D OR key&=&H274D
    '                                           Touche 'M' ou 'm'
  ELSE IF BYTE(key&)=32
    '                                           Touche 'ESPACE'
  ELSE IF key&=&H2C77 OR key&=&H2C57
    '                                           Touche 'W' ou 'w'
  ENDIF
RETURN
'
> PROCEDURE evenements_autres                 !
RETURN
' ******************************************************************************
' **** Fonctions disque...Ouverture, Fermeture, Lecture, Ecriture...        ****
' ******************************************************************************
> FUNCTION fcreate(name%,attr%)
  '
  RETURN GEMDOS(&H3C,L:name%,attr%)
  '
ENDFUNC
> FUNCTION fopen(name%,mode%)
  '
  RETURN GEMDOS(&H3D,L:name%,mode%)
  '
ENDFUNC
> FUNCTION fclose(handle%)
  '
  RETURN GEMDOS(&H3E,handle%)
  '
ENDFUNC
> FUNCTION fread(handle%,buff%,count%)
  '
  RETURN GEMDOS(&H3F,handle%,L:count%,L:buff%)
  '
ENDFUNC
> FUNCTION fwrite(handle%,buff%,count%)
  '
  RETURN GEMDOS(&H40,handle%,L:count%,L:buff%)
  '
ENDFUNC
> FUNCTION fseek(handle%,offset%,seekmode%)
  '
  RETURN GEMDOS(&H42,L:offset%,handle%,seekmode%)
  '
ENDFUNC
> FUNCTION floc(handle%)
  LOCAL offset%,seekmode%
  offset%=0
  seekmode%=1
  '
  RETURN GEMDOS(&H42,L:offset%,handle%,seekmode%)
  '
ENDFUNC
> FUNCTION flof(handle%)
  LOCAL offset%,seekmode%,retour%
  offset%=0
  seekmode%=2
  '
  retour%=GEMDOS(&H42,L:offset%,handle%,seekmode%)
  ~@fseek(handle%,0,0)
  '
  RETURN retour%
ENDFUNC
' ********************** Gestion des messages VA_START *************************
> PROCEDURE chargement_par_va_start
  LOCAL ap_id_prg_appelant&
  LOCAL adr_nom%
  '
  adr_nom%={ADD(buf%,6)}
  ap_id_prg_appelant&=INT{ADD(buf%,2)}
  '
  IF adr_nom%>0                 ! juste un petite scurit
    '
    membfill(titre_en_cours%,512,0)
    bmove(adr_nom%,titre_en_cours%,LEN(CHAR{adr_nom%}))
    '
    ' on confirme au programme appelant qu'on a rcupr quelque chose
    '
    INT{buf%}=av_start&                 ! Numro du message
    INT{ADD(buf%,2)}=ap_id&             ! Indentificateur expditeur du message
    INT{ADD(buf%,4)}=0                  ! Pas d'excdent au message
    {ADD(buf%,6)}=adr_nom%              ! Le nom de fichier en question
    INT{ADD(buf%,8)}=0                  ! Le reste est mis  zro pour
    INT{ADD(buf%,10)}=0                 ! viter tout problme.
    INT{ADD(buf%,12)}=0                 !
    INT{ADD(buf%,14)}=0
    '                                   ! et enfin l'envoie de tout cela.
    appl_write(ap_id_prg_appelant&,16,buf%)
    '
    ' on rcupre le nom du fichier
    '
    IF RINSTR(CHAR{titre_en_cours%},"\")=0
      CHAR{titre_en_cours%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+CHAR{titre_en_cours%}+CHR$(0)
    ELSE
      CHAR{titre_en_cours%}=CHAR{titre_en_cours%}+CHR$(0)
    ENDIF
    '
    ' et enfin, on charge le fichier pass en paramtre.
    '
    ' Oups y a plus rien ici LOL
    '
  ENDIF
RETURN
' *********************** Les routines XFORM DO en GFA *************************
' ******************************************************************************
> FUNCTION xform_do(flags&,address%,count|)
  LOCAL evnt&,count|,top&,dummy&,whandle&
  '
  ' Fonction qui remplace le form_do du GEM permettant la gestion de dialogues
  ' dans des fentres.
  '
  CLR objet&                            ! Mise  zro avant de commencer
  ~@wind_get(0,wf_top&,top&,dummy&,dummy&,dummy&)
  IF @numero_fenetre(top&)=24 AND count|=255
    count|=100
  ELSE
    count|=5
  ENDIF
  DO                                    ! BOUCLE "SANS FIN"
    ' Surveillance des vnements
    evnt&=@evnt_multi(flags&,258,3,0,0,0,0,1,1,0,0,0,1,1,buf%,count|,mx&,my&,mk&,kbd&,key&,click&)
    ' ==========================================================================
    ' ==== Evnement clavier
    ' ==========================================================================
    IF BTST(evnt&,0)
      IF @xform_do_clavier(address%,evnt&)
        RETURN evnt&
      ENDIF
    ENDIF
    ' ==========================================================================
    ' ==== Evnement message
    ' ==========================================================================
    IF BTST(evnt&,4)
      IF @xform_do_message(address%,evnt&)
        RETURN evnt&
      ENDIF
    ENDIF
    ' ==========================================================================
    ' ==== Evnement souris
    ' ==========================================================================
    IF BTST(evnt&,1)
      IF @xform_do_souris(address%,evnt&)
        RETURN evnt&
      ENDIF
    ENDIF
    RETURN evnt&                        ! Toujours retourner l'vnement
  LOOP
  '
ENDFUNC
' ..............................................................................
> FUNCTION xform_do_clavier(address%,VAR evnt&)
  LOCAL xfd_i&,xfd_adr%,xfd_dum&,xfd_top&
  LOCAL xfd_cha&,xfd_ctr|
  '
  IF address%=adr_desk%                 ! Si on travaille sur le bureau
    ~@wind_get(0,wf_top&,xfd_top&,xfd_dum&,xfd_dum&,xfd_dum&)
    '                                   Si la fentre formulaire est au 1 plan
    xfd_dum&=@numero_fenetre(xfd_top&)
    IF xfd_dum&<>-1
      '                                 Rcuprer adresse formulaire en fentre
      xfd_adr%=@arbre_ressource(xfd_dum&)
    ELSE
      xfd_adr%=adr_desk%
    ENDIF
  ELSE                                  ! Si on travaille sur formulaire
    xfd_adr%=address%                   ! Rcuprer adresse formulaire
  ENDIF
  ' ........................................................................
  ' .... Si <Return> ou <Enter> appuy au clavier
  ' ........................................................................
  IF BYTE(key&)=&HD
    '   Chercher bouton DEFAULT et s'il y en a un, le slectionner
    CLR xfd_i&                                  ! En partant de la racine
    DO
      IF BTST(OB_FLAGS(xfd_adr%,xfd_i&),aes_default&) ! Si objet DEFAULT
        objc_offset(xfd_adr%,xfd_i&,xob&,yob&)        ! Position de l'objet
        wob&=OB_W(xfd_adr%,xfd_i&)                    ! Largeur de l'objet
        hob&=OB_H(xfd_adr%,xfd_i&)                    ! Hauteur de l'objet
        ob_state(xfd_adr%,xfd_i&,aes_selected&,TRUE)  ! le slectionner
        '                                               Redessiner l'objet
        objc_draw(xfd_adr%,xfd_i&,12,xob&,yob&,wob&,hob&,-1)
        objet&=xfd_i&                                 ! Enregistrer l'objet
        avmx&=mx&                             ! Position de la souris avant
        avmy&=my&                             !    //    // //   //    //
        mx&=ADD(xob&,DIV(wob&,2))             ! Milieu X de l'objet
        my&=ADD(yob&,DIV(hob&,2))             ! Mileur Y de l'objet
        set_input_mode(sample&)               ! Mode SAMPLE
        input_locator(mx&,my&)                ! Positionner la souris
        set_input_mode(request&)              ! Retour en mode REQUEST
        evnt&=2                               ! Modifier le type d'vnement
        IF edit&                              ! Si curseur  l'cran
          objc_edit(xfd_adr%,edit&,0,pos&,3,pos&) ! le dsactiver
          CLR edit&
        ENDIF
        RETURN TRUE                           ! Retourner l'vnement
      ENDIF
      EXIT IF BTST(OB_FLAGS(xfd_adr%,xfd_i&),aes_lastob&)
      INC xfd_i&                                    ! Objet suivant
    LOOP
    ' ......................................................................
    ' .... L'une des flches (avec ou sans <Shift>  t appuye
    ' .... sans champ ditable dans le formulaire actif
    ' ......................................................................
  ELSE IF edit&=0 AND (key&=&H11B OR key&=&H4D00 OR key&=&H4B00 OR key&=&H4800 OR key&=&H5000)
    evnt&=1
    RETURN TRUE
    ' ......................................................................
    ' .... Un champ ditable est prsent dans le formulaire actif
    ' ......................................................................
  ELSE IF edit&>0
    ' ......................................................................
    ' .... Flche vers le bas
    ' ......................................................................
    IF key&=&H5000
      IF xfd_adr%<>adr_saisie%
        xfd_cha&=@next(xfd_adr%,edit&)                ! Chercher champ suivant
        ' S'il y en a un et qu'il n'est pas DISABLE
        IF xfd_cha&>-1
          IF NOT BTST(OB_STATE(xfd_adr%,xfd_cha&),aes_disable&)
            objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)   ! Dsactiver curseur
            edit&=xfd_cha&                            ! Nouvel ditable
            objc_edit(xfd_adr%,edit&,0,pos&,1,pos&)   ! Ractiver curseur
          ENDIF
        ELSE
          objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)     ! Dsactiver curseur
        ENDIF
      ELSE
        evnt&=1
        RETURN TRUE
      ENDIF
      ' ....................................................................
      ' .... Flche vers le haut
      ' ....................................................................
    ELSE IF key&=&H4800
      IF xfd_adr%<>adr_saisie%
        xfd_cha&=@prev(xfd_adr%,edit&)                ! Chercher champ prcdent
        ' S'il y en a un et qu'il n'est pas DISABLE
        IF xfd_cha&>-1
          IF BTST(OB_STATE(xfd_adr%,xfd_cha&),aes_disable&)=0
            objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)   ! Dsactiver curseur
            edit&=xfd_cha&                            ! Nouvel ditable
            objc_edit(xfd_adr%,edit&,0,pos&,1,pos&)   ! Ractiver curseur
          ENDIF
        ELSE
          objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)     ! Dsactiver curseur
        ENDIF
      ELSE
        evnt&=1
        RETURN TRUE
      ENDIF
      ' ....................................................................
      ' .... Pour toute autre touche, c'est le GEM qui s'occupe de tout
      ' ....................................................................
    ELSE
      objc_edit(xfd_adr%,edit&,key&,pos&,2,pos&)
    ENDIF
    ' ......................................................................
    ' .... Sinon, on regarde si ce n'est pas un raccourcis des menus
    ' ......................................................................
  ELSE
    kbd&=BIOS(&HB,-1)                           ! Etat des touches spciales
    kbd&=BCLR(kbd&,4)                           ! Annuler bit Capslock
    IF BTST(kbd&,cl_shift_droit&) OR BTST(kbd&,cl_shift_gauche&)
      xfd_ctr|=ASC("")                         ! <Shift> enfonce
    ELSE IF BTST(kbd&,cl_control&)
      xfd_ctr|=ASC("^")                         ! <Control> enfonce
    ELSE IF BTST(kbd&,cl_alternate&)
      xfd_ctr|=ASC("")                         ! <Alternate> enfonce
    ELSE                                        ! Sinon
      CLR xfd_ctr|                              ! Pas de touche spciale
    ENDIF
    IF xfd_ctr|
      touc|=@stdkey                             ! Recherche code Ascii
      xfd_i&=0
      DO                                        ! Pour chaque objet du menu
        IF OB_TYPE(adr_menu%,xfd_i&)=28         ! Est ce une option de menu
          CHAR{option%}=TRIM$(CHAR{OB_SPEC(adr_menu%,xfd_i&)})  ! La lire
          IF (ASC(RIGHT$(CHAR{option%},1))=touc|) AND (ASC(LEFT$(RIGHT$(CHAR{option%},2),1))=xfd_ctr|)
            ' Si le caractre et la touche spciale correspondent
            IF NOT (BTST(OB_STATE(adr_menu%,xfd_i&),aes_disable&)) ! Si actif
              evnt&=16                          ! Fabriquer un vnement
              INT{buf%}=10
              INT{ADD(buf%,6)}=@m_title(adr_menu%,xfd_i&)  ! Titre de l'option
              INT{ADD(buf%,8)}=xfd_i&
            ENDIF
          ENDIF
        ENDIF
        EXIT IF BTST(OB_FLAGS(adr_menu%,xfd_i&),aes_lastob&)
        INC xfd_i&
      LOOP
    ENDIF
  ENDIF
  RETURN FALSE
ENDFUNC
> FUNCTION xform_do_message(address%,VAR evnt&)
  LOCAL obstate&,whandle&
  '
  IF INT{buf%}=wm_topped&                   ! Le message  envoyer au GEM
    whandle&=@wind_find(mx&,my&)            ! Fentre clique
    RETURN TRUE
  ELSE
    RETURN TRUE
  ENDIF
  RETURN FALSE
ENDFUNC
> FUNCTION xform_do_souris(address%,VAR evnt&)
  LOCAL xfd_adr%,obflags&,obstate&
  LOCAL whandle&,dummy&,xfd_i&,xfd_j&
  LOCAL nx&,ny&,fx&,fy&,fw&,fh&
  '
  IF address%=adr_desk%             ! Si on travaille sur le bureau
    whandle&=@wind_find(mx&,my&)    ! A t-on cliqu une fentre ?
    IF whandle&>0                   ! Si oui
      ' +++++++++++++++++++ Chercher le numro de la fentre de premier plan
      ~@wind_get(0,wf_top&,top&,dummy&,dummy&,dummy&)
      ' ++++++++++++++ clique sur fentre de 1 plan ou sur "bote  outils"
      IF whandle&=top& OR @numero_fenetre(whandle&)=1
        IF @numero_fenetre(whandle&)=1
          dummy&=1
        ELSE
          dummy&=@numero_fenetre(top&)
        ENDIF
        IF dummy&<>-1
          ' Adresse formulaire en fentre
          xfd_adr%=@arbre_ressource(dummy&)
        ENDIF
      ENDIF
    ENDIF
  ELSE                                 ! Sinon on travaille sur formulaire
    xfd_adr%=address%                  ! Adresse formulaire
  ENDIF
  objet&=@objc_find(xfd_adr%,0,7,mx&,my&) ! Objet cliqu
  IF objet&>-1                         ! Si on a cliqu sur un objet
    obflags&=OB_FLAGS(xfd_adr%,objet&) ! Noter ob_flags objet
    obstate&=OB_STATE(xfd_adr%,objet&) ! Noter ob_state objet
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """" Si l'objet cliqu est dj slectionn => gestion des bascules
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obstate&,aes_selected&)
      IF xfd_adr%=adr_lumieres%
        IF @bouton_lumiere(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_parametre_tos2gem%
        IF @bouton_t2g(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_modules%
        IF objet&<>drivpere&
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_copier%
        IF @bouton_copie(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_calage%
        IF objet&<>numrefe&
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_predefinie%
        IF @bouton_couleur(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_fenetre%
        IF @buton_fenetre(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_lanceur%
        IF @bouton_du_lanceur(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_parametres%
        IF objet&<>act_opengl&
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_outils%
        IF objet&<>izcentre& AND objet&<>iztotal& AND objet&<>iplein& AND objet&<>iimgfond&
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_modifier%
        IF @bouton_modifier(objet&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_fonctions%
        IF (objet&<fnct01& OR objet&>fnct02&) AND (objet&<lte01& OR objet&>lte02&) AND objet&<>fnctpere&
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_bicubics%
        IF (objet&<>fraopt&)
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE IF xfd_adr%=adr_camera%
        IF objet&<>camfocac&
          CLR evnt&
          RETURN TRUE
        ENDIF
      ELSE
        CLR evnt&
        RETURN TRUE
      ENDIF
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' "" Si c'est un objet 'DEFAULT' donc fermer la fentre, retirer EDIT&
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obflags&,aes_default&)
      IF edit&
        objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)       ! Dsactiver curseur
        CLR edit&
      ENDIF
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """ Si l'objet est dsactiv, sortir de suite, il n'y a rien  faire
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obstate&,aes_disable&)
      CLR evnt&
      RETURN TRUE
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """" Si slectable simple alors on inverse son tat
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF ((BTST(obflags&,aes_selectable&)) AND (NOT (BTST(obflags&,aes_rbutton&))))
      ob_state(xfd_adr%,objet&,aes_selected&,NOT BTST(OB_STATE(xfd_adr%,objet&),aes_selected&))
      IF xfd_adr%=adr_outils%
        redraw_element_fenetre(2,xfd_adr%,objet&)
      ELSE
        redraw_elem(xfd_adr%,objet&)
      ENDIF
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """" Si ce n'est pas un TOUCHEXIT ou que l'on clique bouton  droit
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF (NOT BTST(obflags&,aes_touchexit&)) OR mk&=2 OR click&=2
      IF mk&=2 OR click&=2
        IF xfd_adr%<>adr_hierarchie%
          videsouris
          mk&=2
        ENDIF
      ELSE
        videsouris
      ENDIF
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """" Si c'est un RADIO-BOUTON
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF (BTST(obflags&,aes_selectable&)) AND (BTST(obflags&,aes_rbutton&)) AND (NOT (BTST(obstate&,aes_selected&)))
      xfd_j&=objet&                         ! Partir de cet objet
      ob_state(xfd_adr%,objet&,aes_selected&,TRUE)
      redraw_elem(xfd_adr%,objet&)
      xfd_i&=@parent(xfd_adr%,xfd_j&)       ! Chercher le pre
      xfd_j&=OB_HEAD(xfd_adr%,xfd_i&)       ! Partir du 1 enfant...
      xfd_i&=OB_TAIL(xfd_adr%,xfd_i&)       ! jusqu'au dernier.
      DO
        IF (BTST(OB_FLAGS(xfd_adr%,xfd_j&),aes_rbutton&)) AND (xfd_j&<>objet&) AND (BTST(OB_STATE(xfd_adr%,xfd_j&),aes_selected&))
          ' ----------Les mettre en normal si RBUTTON sauf l'objet cliqu.
          ob_state(xfd_adr%,xfd_j&,aes_selected&,NOT BTST(OB_STATE(xfd_adr%,xfd_j&),aes_selected&))
          redraw_elem(xfd_adr%,xfd_j&)
        ENDIF
        xfd_j&=OB_NEXT(xfd_adr%,xfd_j&)      ! Au suivant...
        EXIT IF (xfd_j&>xfd_i&) OR (xfd_j&=-1)
      LOOP                                   ! jusqu'au dernier.
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """" Si c'est une zone ditable
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obflags&,aes_editable&)
      IF edit&>0
        objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)  ! Dsactiver curseur
        CLR edit&
      ENDIF
      IF BTST(obflags&,aes_selectable&)
        ob_state(xfd_adr%,objet&,aes_selected&,NOT BTST(OB_STATE(xfd_adr%,objet&),aes_selected&))
        IF xfd_adr%=adr_outils%
          redraw_element_fenetre(2,xfd_adr%,objet&)
        ELSE
          redraw_elem(xfd_adr%,objet&)
        ENDIF
      ENDIF
      edit&=objet&                            ! Nouvel ditable courant
      objc_edit(xfd_adr%,edit&,0,pos&,1,pos&) ! Ractiver curseur
    ENDIF
  ENDIF
  RETURN FALSE
ENDFUNC
' ..............................................................................
> FUNCTION parent(adr%,object&)
  ' Retourne l'objet pre d'un objet
  LOCAL i&
  i&=object&            ! Partir de cet objet
  WHILE i&>=object&
    i&=OB_NEXT(adr%,i&) ! Passer au suivant
  WEND                  ! Jusqu'au dernier
  RETURN i&             ! Retourner le pre
ENDFUNC
> FUNCTION next(adr%,ed&)
  ' Chercher l'ditable suivant
  ' Attention : si l'ditable, ou l'un de ses pres est HIDETREE,
  ' il ne faut pas le prendre
  LOCAL pere&,vu&,ob&
  '
  vu&=TRUE
  ob&=SUCC(ed&)
  WHILE (NOT (BTST(OB_FLAGS(adr%,ob&),aes_lastob&)))
    ' Tant qu'on n'est pas au dernier objet
    pere&=@parent(adr%,ob&)     ! Chercher son pre
    ' Si ce n'est pas la racine et pas HIDETREE
    WHILE ((pere&>0) AND (vu&=TRUE))
      ' Si le pre est HIDETREE
      IF BTST(OB_FLAGS(adr%,pere&),aes_hidetree&)
        vu&=FALSE               ! l'objet n'est pas visible
      ENDIF
      pere&=@parent(adr%,pere&)  ! Pre suivant
    WEND
    IF vu&=TRUE                 ! Si l'objet est visible
      IF NOT ((BTST(OB_STATE(adr%,ob&),aes_disable&)))
        IF NOT ((BTST(OB_FLAGS(adr%,ob&),aes_hidetree&)))
          IF (BTST(OB_FLAGS(adr%,ob&),aes_editable&))
            RETURN ob&              ! Retourner son numro
          ENDIF
        ENDIF
      ENDIF
    ENDIF
    INC ob&
  WEND
  RETURN -1   ! Sinon, -1
ENDFUNC
> FUNCTION prev(adr%,ed&)
  ' Chercher l'ditable prcdent
  ' Attention : si l'ditable, ou l'un de ses pres est HIDETREE,
  ' il ne faut pas le prendre
  LOCAL pere&,vu&,ob&
  '
  vu&=TRUE
  ob&=PRED(ed&)
  WHILE (ob&>0)                 ! En arrire jusqu' la racine
    pere&=@parent(adr%,ob&)     ! Pre de l'objet
    ' Si ce n'est pas la racine et pas HIDETREE
    WHILE ((pere&>0) AND (vu&=TRUE))
      ' Si le pre est HIDETREE
      IF BTST(OB_FLAGS(adr%,pere&),aes_hidetree&)
        vu&=FALSE               ! L'objet n'est pas visible
      ENDIF
      pere&=@parent(adr%,pere&) ! Pre suivant
    WEND
    IF vu&=TRUE                 ! Si l'objet est visible
      IF NOT ((BTST(OB_STATE(adr%,ob&),aes_disable&)))
        IF NOT ((BTST(OB_FLAGS(adr%,ob&),aes_hidetree&)))
          IF (BTST(OB_FLAGS(adr%,ob&),aes_editable&))
            RETURN ob&              ! Retourner son numro
          ENDIF
        ENDIF
      ENDIF
    ENDIF
    DEC ob&
  WEND
  RETURN -1                     ! Sinon, -1
ENDFUNC
> FUNCTION stdkey
  LOCAL b%
  b%=XBIOS(16,L:-1,L:-1,L:-1)
  RETURN ASC(UPPER$(CHR$(BYTE{{ADD(b%,4)}+BYTE(SHR&(key&,8))})))
ENDFUNC
> FUNCTION m_title(adresse%,option&)
  LOCAL men_&,k&
  LOCAL pere&,tit&
  '
  men_&=1
  k&=3
  pere&=@parent(adresse%,option&)
  WHILE (OB_TYPE(adresse%,k&)<>20)
    INC k&              ! Chercher la 1 G_BOX
  WEND
  WHILE (k&<>pere&)
    k&=OB_NEXT(adresse%,k&)  ! Chercher menu correspondant
    INC men_&           ! Compter les menus
  WEND
  k&=3
  WHILE ((k&-3)<>men_&)
    tit&=k&           ! L'affecter
    INC k&
  WEND
  RETURN tit&         ! Retourner le n du titre
ENDFUNC
> FUNCTION bouton_modifier(objet&)
  $S&,$S>
  SELECT objet&
  CASE visuel&,ouvert&,ensmooth&,modtaide&,facinout&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
> FUNCTION buton_fenetre(objet&)
  $S&,$S>
  SELECT objet&
  CASE fenvue23&,fenvue24&,fenlib_x&,fenlib_y&,fenlib_z&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
> FUNCTION bouton_du_lanceur(objet&)
  $S&,$S>
  SELECT objet&
  CASE povgene&,povaffi&,povatte&,povater&,antionof&,symbonof&
    RETURN FALSE
  CASE povutsl&,povnume&,povlafa&,jittonof&,buffonof&,povcont&
    RETURN FALSE
  CASE pov_ul&,pov_uv&,pov_ur&,pov_su&,pov_ua&,povmosai&
    RETURN FALSE
  CASE pov_ga&,pov_gd&,pov_gf&,pov_gr&,pov_gs&,pov_gw&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
> FUNCTION bouton_couleur(objet&)
  $S&,$S>
  SELECT objet&
  CASE ascetein&,ascelumi&,ascesatu&,asceroug&
    RETURN FALSE
  CASE ascevert&,ascebleu&,ascetran&,asccol&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
> FUNCTION bouton_copie(objet&)
  $S&,$S>
  SELECT objet&
  CASE distri0x&,distri0y&,distri0z&
    RETURN FALSE
  CASE distri1x&,distri1y&,distri1z&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
> FUNCTION bouton_lumiere(objet&)
  $S&,$S>
  SELECT objet&
  CASE surfjitt&,surcylin&,suratmos&,surombre&,surinter&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
> FUNCTION bouton_t2g(objet&)
  $S&,$S>
  SELECT objet&
  CASE t2gclose&,t2gmove&,t2gfulle&,t2gvert&,t2gsize&,t2ghori&
    RETURN FALSE
  DEFAULT
    RETURN TRUE
  ENDSELECT
ENDFUNC
' ------------------------------------------------------------------------------
> PROCEDURE fenetre_suivante(fen&)
  LOCAL dummy&,top&,mem_dum&,suivante&
  '
  ~@wind_get(0,wf_top&,top&,dummy&,dummy&,dummy&)
  dummy&=@numero_fenetre(fen&)
  mem_dum&=dummy&
  suivante&=-1
  DO
    INC dummy&
    IF dummy&<32
      ' Regarder si la fentre est ouverte et si elle n'est pas l'active
      IF INT{ADD(hwind%,SHL(dummy&,1))}>0 AND dummy&<>mem_dum&
        ' Si oui, alors, c'est elle que l'on va activer
        suivante&=dummy&
      ENDIF
      ' Sinon, on passe  la suivante au prochain tour
    ELSE
      ' Si c'tait la dernire fentre, alors, on reprend  la premire
      ' De toute faon, il y a toujours plusieurs fentres actives
      ' en mme temps
      dummy&=-1
    ENDIF
    IF dummy&=mem_dum&
      suivante&=mem_dum&
    ENDIF
    EXIT IF suivante&=>0
  LOOP
  IF mem_dum&<>suivante&
    ' On envoie le message de mise en avant de la fentre suivante
    INT{buf%}=wm_topped&             ! Numro du message
    INT{ADD(buf%,2)}=ap_id&          ! Indentificateur expditeur
    INT{ADD(buf%,4)}=0               ! Pas d'excdent au message
    '                                   Handle fentre concerne
    INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(suivante&,1))}
    INT{ADD(buf%,8)}=global_xb&      ! Cordonne zone redraw (bureau)
    INT{ADD(buf%,10)}=global_yb&
    INT{ADD(buf%,12)}=global_wb&
    INT{ADD(buf%,14)}=global_hb&
    appl_write(ap_id&,16,buf%) ! Envoi du message
  ENDIF
RETURN
> PROCEDURE reduire_fenetre(fen&)
  LOCAL dummy&,fx&,fy&,fw&,fh&
  '
  dummy&=INT{ADD(hwind%,SHL(@numero_fenetre(fen&),1))}
  ~@wind_get(dummy&,wf_currxywh&,fx&,fy&,fw&,fh&)
  fh&=24
  wind_set(dummy&,wf_currxywh&,fx&,fy&,fw&,fh&)
  ' On s'envoie  soi-mme un message de redimensionnement
  INT{buf%}=wm_redraw&              ! Numro du message (redessin)
  INT{ADD(buf%,2)}=ap_id&           ! Indentificateur expditeur
  INT{ADD(buf%,4)}=0                ! Pas d'excdent au message
  '                                   Handle fentre concerne
  INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(@numero_fenetre(whandle&),1))}
  INT{ADD(buf%,8)}=global_xb&       ! Cordonne zone redraw (fentre)
  INT{ADD(buf%,10)}=global_yb&
  INT{ADD(buf%,12)}=global_wb&
  INT{ADD(buf%,14)}=global_hb&
  appl_write(ap_id&,16,buf%)         ! Envoi du message
RETURN
> PROCEDURE agrandir_fenetre(fen&)
  LOCAL dummy&,fx&,fy&,fw&,fh&
  '
  dummy&=INT{ADD(hwind%,SHL(@numero_fenetre(fen&),1))}
  ~@wind_get(dummy&,wf_currxywh&,fx&,fy&,fw&,fh&)
  fh&=OB_H(@arbre_ressource(@numero_fenetre(fen&)),0)
  wind_set(dummy&,wf_currxywh&,fx&,fy&,fw&,fh&)
  ' On s'envoie  soi-mme un message de redimensionnement
  INT{buf%}=wm_redraw&              ! Numro du message (redessin)
  INT{ADD(buf%,2)}=ap_id&           ! Indentificateur expditeur
  INT{ADD(buf%,4)}=0                ! Pas d'excdent au message
  '                                   Handle fentre concerne
  INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(@numero_fenetre(whandle&),1))}
  INT{ADD(buf%,8)}=global_xb&       ! Cordonne zone redraw (fentre)
  INT{ADD(buf%,10)}=global_yb&
  INT{ADD(buf%,12)}=global_wb&
  INT{ADD(buf%,14)}=global_hb&
  appl_write(ap_id&,16,buf%)         ! Envoi du message
RETURN
> PROCEDURE fermer_fenetre(fen&)
  '
  INT{buf%}=wm_closed&            ! Numro du message
  INT{ADD(buf%,2)}=ap_id&         ! Indentificateur expditeur message
  INT{ADD(buf%,4)}=0              ! Pas d'excdent au message
  '                                   Handle fentre concerne
  INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(@numero_fenetre(fen&),1))}
  INT{ADD(buf%,8)}=global_xb&     ! Cordonne zone redraw (bureau)
  INT{ADD(buf%,10)}=global_yb&
  INT{ADD(buf%,12)}=global_wb&
  INT{ADD(buf%,14)}=global_hb&
  appl_write(ap_id&,16,buf%)       ! Envoi du message
RETURN
' ******************************************************************************
> FUNCTION initialisation               ! Initialisation du programme
  LOCAL lar_gou&,hau_gou&,taille_zone%,largeur1%,largeur2%,taille_z_buf%
  LOCAL x&,y&,w&,h&,duree%,tail%,comm%,taille_totale%
  LOCAL xw&,yw&,ww&,hw&,v|,univ%,dum&,tm%,atm%
  LOCAL dummy&,i&,j&,i%,taille_forme%,a&
  LOCAL ro,ve,bl,pr&,adresse%,ofs&,offs%
  LOCAL adr_sr%,n%,tos%,mem_f!,top&,atop&
  LOCAL taille%,decalage%,palette_video&
  LOCAL cfg_lim!,cfg_par!,obspec%,presentex&,presentey&
  LOCAL mi_x&,mi_y&,adr%,fin_adr%,adr2%
  LOCAL ex&,ey&,ew&,eh&,adr_presente%
  LOCAL x_ouv&,y_ouv&,w_ouv&,h_ouv&
  LOCAL chemin%
  '
  init_correct!=FALSE
  CLR flag_aes_mctrl!,flag_aes_update!
  '
  precalcul%=@prendre(256,FALSE,3)
  adr%=precalcul%
  ' adr%=SHL(SHR(ADD(precalcul%,15),4),4)
  fin_adr%=ADD(adr%,256)
  DO
    {adr%}=0
    ADD adr%,4
  LOOP WHILE adr%<fin_adr%
  xmax&=INT{station%}
  ymax&=INT{ADD(station%,2)}
  haute_resolution!=FALSE
  IF (xmax&>640) AND (ymax&>640)
    haute_resolution!=TRUE
  ENDIF
  maxcol&=PRED(INT{ADD(station%,26)})
  plan_systeme&=INT{ADD(etendue%,8)}
  $S&,$S>
  SELECT plan_systeme&
  CASE 1,2                                      ! 2, 4 couleurs
    mode_entrelace!=TRUE
    true_color!=FALSE
  CASE 4,8                                      ! 16, 256 couleurs
    mode_entrelace!=TRUE                        ! Est-ce entrelac ?
    IF maxcol&=255
      mode_entrelace!=@mode_entrelace_256
    ELSE IF maxcol&=15
      mode_entrelace!=@mode_entrelace_16
    ENDIF
    true_color!=FALSE
  CASE 15,16,24,32                              ! 32768, 65536 ou 16777216 coul.
    mode_entrelace!=FALSE
    true_color!=TRUE
  ENDSELECT
  ecran%=((SUCC(xmax&)/8)*SUCC(ymax&)*plan_systeme&)
  taille_preview_ecran%=MUL(600,plan_systeme&)
  quartecran%=DIV(ecran%,4)
  physique%=XBIOS(2)
  lecteur%=GEMDOS(&H19)
  '
  tracer_bios_tab%=0
  CLR taille_totale%
  ADD taille_totale%,4          ! disque_systeme%
  ADD taille_totale%,128        ! masque%
  ADD taille_totale%,128        ! msq%
  ADD taille_totale%,272        ! path_systeme
  ADD taille_totale%,4          ! disque%
  ADD taille_totale%,272        ! path%
  ADD taille_totale%,512        ! a_charger%
  ADD taille_totale%,512        ! chemin%
  ADD taille_totale%,512        ! eb_temp%
  ADD taille_totale%,512        ! mem_nom%
  ADD taille_totale%,512        ! mem_che%
  ADD taille_totale%,512        ! titre_en_cours%
  ADD taille_totale%,1024       ! tr_tmp%
  '
  multitache!=(WORD{{GB+4}+2}<>1)
  '
  adr_chemin_systeme%=@prendre(taille_totale%,TRUE,3)
  adresse%=adr_chemin_systeme%
  ' adresse%=SHL(SHR(ADD(adr_chemin_systeme%,15),4),4)
  '
  disque_systeme%=@zone(4,adresse%)     ! Le disque systme (au lancement)
  path_systeme%=@zone(272,adresse%)     ! Le chemin systme (au lancement)
  disque%=@zone(4,adresse%)             ! Le disque de mouvement
  masque%=@zone(128,adresse%)           ! Les masques du slecteur
  msq%=@zone(128,adresse%)              ! Les masque de backup
  path%=@zone(272,adresse%)             ! Le chemin de mouvement
  a_charger%=@zone(512,adresse%)        ! Nom du fichier  charger du SHEL_READ
  chemin%=@zone(512,adresse%)           ! Chemin systme dans le SHEL_READ
  eb_temp%=@zone(512,adresse%)          ! Chemin des fichiers de configurations
  mem_nom%=@zone(512,adresse%)          ! Mmoire pour les accs disque
  mem_che%=@zone(512,adresse%)          ! Pour les chemins d'accs disque
  titre_en_cours%=@zone(512,adresse%)   ! Le titre de la scne en cours
  tr_tmp%=@zone(1024,adresse%)          ! Pour les tracs temporaires
  '
  ' ============================================================================
  ' ==== Rcupration de la ligne de commande (si il y en a une bien sur)  =====
  ' ====                                                                   =====
  ' ==== chemin%    : le chemin systme si tous s'est bien pass           =====
  ' ==== Merci  Eric REBOUX pour l'info sur ce paramtre du SHELL_READ    =====
  ' ====                                                                   =====
  ' ==== a_charger% : Le nom du fichier  charger                          =====
  ' ====                                                                   =====
  ' ============================================================================
  lire_la_ligne_de_commande(chemin%,a_charger%)
  ' ============================================================================
  ' ==== Vrifier la validite du chemin systme. En cas de problme,      =====
  ' ==== essayer par les fonctions GEMDOS (DGETDRV et DGETPATH)            =====
  ' ====                                                                   =====
  ' ==== Si rien ne va, on arrte l et on prvient du problme de chemin  =====
  ' ============================================================================
  CHAR{path%}=LEFT$(CHAR{chemin%},RINSTR(CHAR{chemin%},"\"))+"pack_cnf.prg"+CHR$(0)
  IF @s_exist(path%)
    CHAR{disque_systeme%}=LEFT$(CHAR{chemin%},2)+CHR$(0)
    bmove(ADD(chemin%,2),chemin%,510)
    CHAR{path_systeme%}=LEFT$(CHAR{chemin%},RINSTR(CHAR{chemin%},"\"))+CHR$(0)
  ELSE
    CHAR{disque_systeme%}=CHR$(ADD(65,lecteur%))+":"+CHR$(0)
    ~GEMDOS(&H47,L:path_systeme%,0)
    CHAR{path_systeme%}=CHAR{path_systeme%}+"\"+CHR$(0)
  ENDIF
  CHAR{path%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+"pack_cnf.prg"+CHR$(0)
  IF NOT @s_exist(path%)
    CHAR{path%}="[3][|Chemin systme non dfini|System path not defined ][ Annule|Cancel ]"+CHR$(0)
    ~@afficher_alerte(path%)
    RETURN FALSE
  ENDIF
  minuscule(disque_systeme%)
  IF multitache!
    lecteur%=SUB(ASC(CHAR{disque_systeme%}),97)
  ELSE
    lecteur%=SUB(ASC(CHAR{disque_systeme%}),65)
  ENDIF
  minuscule(path_systeme%)
  '
  ' ============================================================================
  chemin_systeme                ! Forcer le chemin systme de PACK_CNF
  r_resident!=FALSE
  ' ----------------------------------------------------------------------------
  CHAR{disque%}=CHAR{disque_systeme%}+CHR$(0)
  CHAR{path%}=CHAR{path_systeme%}+CHR$(0)
  '
  ' ============================================================================
  ' ==== Faire tout les MALLOC ncessaires au bon fonctionnement du programme ==
  ' ============================================================================
  reservation_memoire
  '
  ' ............................................................................
  ' .... Ensuite, on recopie la zone  contenant le fichier  charger dans   ....
  ' .... la zone prvue  cet effet.                                        ....
  ' .... et on rempli les diffrents champs ASCII pr-dfinis               ....
  ' ............................................................................
  bmove(a_charger%,titre_en_cours%,512)
  '
  ' ============================================================================
  ' ==== Allez, courage, on continue...                                       ==
  ' ============================================================================
  mon_aespb%={ADD(GB,4)}                ! _GemParBlk.global
  '
  IF NOT @chargement_des_ressources(pr&,presentex&,presentey&)
    RETURN FALSE
  ENDIF
  '
  init_correct!=TRUE
  ' ////////////////////////////////////////////////////////////////////////////
  CLR global_xb&,global_yb&,global_wb&,global_hb&
  CLR global_xf&,global_yf&,global_wf&,global_hf&
  CLR global_xf2&,global_yf2&
  CLR souris|,asouris|
  fin_programme!=FALSE
  '
  force_redess!=FALSE
  sauve!=FALSE
  un_clic!=FALSE
  ' *--------------------------------------------------------------------------*
  ' Aprs une modification, si petite soit-elle, ce drapeau doit passer  TRUE
  ' pour viter de perdre le travail sans alerte pralable.
  travail_a_sauver!=FALSE
  ' *--------------------------------------------------------------------------*
  ' *---- Coloration des ressources                                        ----*
  ' *--------------------------------------------------------------------------*
  ' IF maxcol&<15
  '  environnement_mono
  ' ELSE
  '  environnement_coul
  ' ENDIF
  '
  CLR adr_desk%
  menu_bar(adr_menu%,1)                                                      ! Afficher le menu
  ~@wind_get(0,wf_workxywh&,global_xb&,global_yb&,global_wb&,global_hb&)     ! Coordonnes du bureau
  graf_mouse(fleche&,0)
  wind_calc(1,&X0,global_xb&,global_yb&,global_wb&,global_hb&,x&,y&,w&,h&)
  mise_a_la_taille_fenetre_generale
  gestion_onglets_generaux(onglet_config&,FALSE)
  gestion_onglets_specifiques(onglet_config&,onglet_global&,FALSE)
  ' demarquer_les_menus
  ' marquer_les_menus
  '
  ouvrir_generale
  '
  RETURN TRUE
ENDFUNC
'
> FUNCTION chargement_des_ressources(pr&,presentex&,presentey&)
  '
  CHAR{commande%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+CHR$(0)
  '
  ' ******************** Chargement des ressources *****************************
  CHAR{mem_che%}=CHAR{commande%}+"pack_cnf.rsc"+CHR$(0)
  IF @xrsrc_load(mem_che%)=0
    CHAR{mem_che%}="[3][|PACK_CNF.RSC non charg|PACK_CNF.RSC not loaded|][ Ok ]"+CHR$(0)
    ~@afficher_alerte(mem_che%)
    RETURN FALSE
  ELSE
    initialiser_ressource_1
  ENDIF
  adr_menu%={ress%}                                     !  1
  adr_info%={ADD(ress%,4)}                              !  2
  adr_generale%={ADD(ress%,8)}                          !  3
  adr_auteur%={ADD(ress%,12)}                           !  4
  ' ============================================================================
  ' Si jamais BUBBLE GEM est en mmoire, alors, on charge les messages pour les
  ' bulles d'aide. ATTENTION...Beaucoup de mmoire xige
  ' ============================================================================
  IF bubble_gem!
    CHAR{mem_che%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+"bubbles.rsc"+CHR$(0)
    IF @xrsrc_load(mem_che%)=0
      ' Pas de ressource pour BUBBLE GEM, c'est dommage, il tait en mmoire
    ELSE
      initialiser_les_bulles
    ENDIF
  ENDIF
  RETURN TRUE
ENDFUNC
PROCEDURE date_et_version
  ' version%=OB_SPEC(adr_info%,version&)
  ' date%={OB_SPEC(adr_info%,bardev&)}
  ' CHAR{date%}="18/02/2006"                             ! La date de compilation
  ' CHAR{version%}=STR$(0.1,4)+" Fv. 2006"            ! Le numro de version
RETURN
> PROCEDURE lire_la_ligne_de_commande(l0%,l1%)
  ~@shel_read(l0%,l1%)
RETURN
> FUNCTION mode_entrelace_256           ! 256 couleurs, cran entrelac ou pas ?
  ' Mettre le premier octet de l'cran  0
  BYTE{XBIOS(2)}=0
  ' Choisir une couleur sans dcalage VDI (la 4 par exemple)
  set_remplissage(2,8,4,-1)
  ' Faire un point sur le premier pixel de l'cran
  graf_mouse(m_off&,0)
  vdi_11(1,0,0,0,0,0,0,0,0)
  graf_mouse(m_on&,0)
  ' Lire le premier octet de l'cran en accs direct
  ' Si le contenu est gale  la couleur, l'cran n'est pas entrelac
  ' et par consquent, nous nous trouvons sur une carte graphique
  RETURN (BYTE{XBIOS(2)}<>4)
ENDFUNC
> FUNCTION mode_entrelace_16            ! 256 couleurs, cran entrelac ou pas ?
  ' Mettre le premier octet de l'cran  0
  BYTE{XBIOS(2)}=0
  ' Choisir une couleur sans dcalage VDI (la 4 par exemple)
  set_remplissage(2,8,4,-1)
  ' Faire un point sur le premier pixel de l'cran
  graf_mouse(m_off&,0)
  vdi_11(1,0,0,0,0,0,0,0,0)
  graf_mouse(m_on&,0)
  ' Lire le premier octet de l'cran en accs direct
  ' Si le contenu des 4 bit de gauche gale  la couleur, l'cran n'est pas
  ' entrelac et par consquent, nous nous trouvons sur une carte graphique
  RETURN (BYTE{XBIOS(2)}<>64)
ENDFUNC
' ------------------------------------------------------------------------------
> PROCEDURE bulles_d_aide               ! Des aides en bulle
  LOCAL bubble_id&,handle_win&,mo_x&,mo_y&,mo_k&,nuf&,ob&,adr_li%,bubble%,arb_b%
  LOCAL arb_b%,c%,pc%,pcf%
  '
  ' On commence par vrifier si BUBBLE GEM est accessible...
  '
  CHAR{mem_che%}="BUBBLE  "+CHR$(0)
  bubble_id&=@appl_find(mem_che%)
  '
  IF bubble_id&>0 AND adr_bub%>0
    '
    ' On rcupre les informations ncessaire  l'appel de BUBBLE GEM
    '
    mo_x&=INT{ADD(buf%,8)}
    mo_y&=INT{ADD(buf%,10)}
    nuf&=@numero_fenetre(@wind_find(mo_x&,mo_y&))
    '
    adr_li%={ADD(adr_bub%,SHL(nuf&,2))}
    IF adr_li%>0                        ! Si la zone mmoire existe
      '
      arb_b%=@arbre_ressource(nuf&)     ! Arbre des messages
      '
      ob&=@objc_find(arb_b%,0,7,mo_x&,mo_y&)
      '
      pc%=OB_TAIL(arb_b%,0)             ! Combien d'enfants ??
      WHILE pc%<>-1                     ! Recherche du dernier enfant
        pcf%=pc%                        ! Mise en mmoire du compteur
        pc%=OB_TAIL(arb_b%,pcf%)        ! Objet suivant ?
      WEND                              ! Ok on est au dernier
      INC pcf%
      '
      IF ob&<pcf% AND ob&>0             ! Si l'objet est dans l'arbre
        '
        IF LEFT$(CHAR{OB_SPEC(adr_li%,ob&)},1)<>"."     ! Si le message existe
          bubble%=OB_SPEC(adr_li%,ob&)
          '
          ' Puis, on effectue l'appel proprement dit
          '
          INT{buf%}=bubblegem_show&     ! Affichage demand
          INT{ADD(buf%,2)}=ap_id&       ! ap_id de EB Model
          INT{ADD(buf%,4)}=0            ! Toujours  0
          INT{ADD(buf%,6)}=mo_x&        ! coords X du curseur souris
          INT{ADD(buf%,8)}=mo_y&        ! Coords Y du curseur souris
          {ADD(buf%,10)}=bubble%        ! adresse du buffer message
          INT{ADD(buf%,14)}=0           ! Toujours  0
          appl_write(bubble_id&,16,buf%) ! L'appel par APPL_WRITE
          '
        ENDIF
      ENDIF
    ENDIF
  ENDIF
RETURN
' ------------------------------------------------------------------------------
> PROCEDURE initialiser_ressource_1     ! Mettre en mmoire adresses ressource 1
  LOCAL adr%
  LOCAL x&,y&,w&,h&
  '
  ~@xrsrc_gaddr(0,menu&,adr%)
  {ress%}=adr%
  ~@xrsrc_gaddr(0,info&,adr%)
  {ADD(ress%,4)}=adr%
  ~@xrsrc_gaddr(0,generale&,adr%)
  {ADD(ress%,8)}=adr%
  ~@xrsrc_gaddr(0,auteur&,adr%)
  {ADD(ress%,12)}=adr%
  '
  form_center({ADD(ress%,4)},x&,y&,w&,h&)
  form_center({ADD(ress%,12)},x&,y&,w&,h&)
RETURN
> PROCEDURE initialiser_les_bulles      ! Mettre en mmoire adresse des bulles.
  LOCAL adr%
  ~@xrsrc_gaddr(0,bgem_000&,adr%)
  {adr_bub%}=adr%
  ~@xrsrc_gaddr(0,bgem_001&,adr%)
  {ADD(adr_bub%,4)}=adr%
  ~@xrsrc_gaddr(0,bgem_002&,adr%)
  {ADD(adr_bub%,8)}=adr%
  ~@xrsrc_gaddr(0,bgem_003&,adr%)
  {ADD(adr_bub%,12)}=adr%
  ~@xrsrc_gaddr(0,bgem_004&,adr%)
  {ADD(adr_bub%,16)}=adr%
  ~@xrsrc_gaddr(0,bgem_005&,adr%)
  {ADD(adr_bub%,20)}=adr%
  ~@xrsrc_gaddr(0,bgem_006&,adr%)
  {ADD(adr_bub%,24)}=adr%
  ~@xrsrc_gaddr(0,bgem_007&,adr%)
  {ADD(adr_bub%,28)}=adr%
  ~@xrsrc_gaddr(0,bgem_008&,adr%)
  {ADD(adr_bub%,32)}=adr%
  ~@xrsrc_gaddr(0,bgem_009&,adr%)
  {ADD(adr_bub%,36)}=adr%
  ~@xrsrc_gaddr(0,bgem_010&,adr%)
  {ADD(adr_bub%,40)}=adr%
  ~@xrsrc_gaddr(0,bgem_011&,adr%)
  {ADD(adr_bub%,44)}=adr%
  ~@xrsrc_gaddr(0,bgem_012&,adr%)
  {ADD(adr_bub%,48)}=adr%
  ~@xrsrc_gaddr(0,bgem_013&,adr%)
  {ADD(adr_bub%,52)}=adr%
  ~@xrsrc_gaddr(0,bgem_014&,adr%)
  {ADD(adr_bub%,56)}=adr%
  ~@xrsrc_gaddr(0,bgem_015&,adr%)
  {ADD(adr_bub%,60)}=adr%
  ~@xrsrc_gaddr(0,bgem_016&,adr%)
  {ADD(adr_bub%,64)}=adr%
  ~@xrsrc_gaddr(0,bgem_017&,adr%)
  {ADD(adr_bub%,68)}=adr%
  ~@xrsrc_gaddr(0,bgem_018&,adr%)
  {ADD(adr_bub%,72)}=adr%
  ~@xrsrc_gaddr(0,bgem_019&,adr%)
  {ADD(adr_bub%,76)}=adr%
  ~@xrsrc_gaddr(0,bgem_020&,adr%)
  {ADD(adr_bub%,80)}=adr%
  ~@xrsrc_gaddr(0,bgem_021&,adr%)
  {ADD(adr_bub%,84)}=adr%
  ~@xrsrc_gaddr(0,bgem_022&,adr%)
  {ADD(adr_bub%,88)}=adr%
  ~@xrsrc_gaddr(0,bgem_023&,adr%)
  {ADD(adr_bub%,92)}=adr%
  ~@xrsrc_gaddr(0,bgem_024&,adr%)
  {ADD(adr_bub%,96)}=adr%
  ~@xrsrc_gaddr(0,bgem_025&,adr%)
  {ADD(adr_bub%,100)}=adr%
  ~@xrsrc_gaddr(0,bgem_026&,adr%)
  {ADD(adr_bub%,104)}=adr%
  ~@xrsrc_gaddr(0,bgem_027&,adr%)
  {ADD(adr_bub%,108)}=adr%
  ~@xrsrc_gaddr(0,bgem_028&,adr%)
  {ADD(adr_bub%,112)}=adr%
  ~@xrsrc_gaddr(0,bgem_029&,adr%)
  {ADD(adr_bub%,116)}=adr%
RETURN
' ***************************** Gestion des COOKIEs ****************************
> PROCEDURE etude_du_systeme            ! Mais quelle machine est ce donc ?
  LOCAL super%,adr%,type%,slot%,long%,magic_cookie%
  son|=255
  pro|=255
  copro|=255
  video|=255
  machine|=255
  magic!=FALSE
  mint!=FALSE
  geneva!=FALSE
  mode_winx!=FALSE
  mode_nvdi!=FALSE
  bubble_gem!=FALSE
  mode_naes!=FALSE
  mode_myaes!=FALSE
  tos2gem!=FALSE
  mode_fvdi!=FALSE
  CLR magic_version&
  gdos!=FALSE
  super%=GEMDOS(&H20,L:0)                 ! Passage en mode SUPERVISEUR
  adr%={&H5A0}                            ! Pointeur sur le premier COOKIE
  IF adr%=0
    ' Il n'y a aucun COOKIEs en mmoire
    ' Il est donc impossible de dterminer le type d'ATARI sur lequel
    ' on se trouve par le systme des COOKIEs
    son|=0
    pro|=0
    copro|=0
    video|=0
    machine|=0
  ELSE
    CLR slot%
    WHILE {ADD(adr%,SHL(slot%,3))}<>0
      long%={ADD(ADD(adr%,SHL(slot%,3)),4)}
      $S%,$S>
      SELECT LEFT$(CHAR{ADD(adr%,SHL(slot%,3))},4)
      CASE "_MCH"
        IF machine|=255
          SELECT INT(SWAP(long%))  ! Mot de poid fort
          CASE 0                                ! STf
            machine|=0
          CASE 1
            SELECT INT(long%)      ! Mot de poid faible
            CASE 0                              ! STe
              machine|=1
            CASE 1                              ! ST Book
              machine|=2
            CASE 8                              ! STE avec IDE
              machine|=3
            CASE 16                             ! Mega STE
              machine|=4
            CASE 256                            ! Falcon
              machine|=5
            ENDSELECT
          CASE 2                                ! TT
            machine|=6
          CASE 3                                ! Falcon
            machine|=5
          CASE 4                                ! MILAN
            machine|=7
          CASE 5                                ! ARANYM l'mulateur ultime
            machine|=9
          DEFAULT                               ! Inconnu (par dfaut STf)
            machine|=0
          ENDSELECT
        ENDIF
      CASE "_MIL"                               ! Ah! tiens! un MILAN
        machine|=7
      CASE "hade"                               ! Oh! un HADES
        machine|=8
      CASE "_CPU"
        SELECT long%
        CASE 0                                  ! 68000
          pro|=0
        CASE 10                                 ! 68010
          pro|=1
        CASE 20                                 ! 68020
          pro|=2
        CASE 30                                 ! 68030
          pro|=3
        CASE 40                                 ! 68040
          pro|=4
        CASE 60                                 ! 68060
          pro|=5
        DEFAULT                                 ! Inconnue (68000 par dfaut)
          pro|=0
        ENDSELECT
      CASE "_FPU"
        SELECT INT(SWAP(long%))  ! Mot de poid fort
        CASE 0                                  ! Pas de copro
          copro|=0
        CASE 1                                  ! SFP004
          copro|=1
        CASE 2                                  ! 68881 ou 68882
          copro|=2
        CASE 3                                  ! 68881 ou 68882 et SFP004
          copro|=3
        CASE 4                                  ! 68881
          copro|=4
        CASE 5                                  ! 68881 et SFP004
          copro|=5
        CASE 6                                  ! 68882
          copro|=6
        CASE 7                                  ! 68882 et SFP004
          copro|=7
        CASE 8                                  ! 68040
          copro|=8
        CASE 9                                  ! 68040 et SFP004
          copro|=9
        DEFAULT                                 ! par dfaut pas de copro
          copro|=0
        ENDSELECT
      CASE "_VDO"
        SELECT INT(SWAP(long%))  ! Mot de poid fort
        CASE 0                                  ! STf
          video|=0
        CASE 1
          SELECT INT(long%)      ! Mot de poid faible
          CASE 0                                ! STe Scroll hard
            video|=1
          CASE 1                                ! ST Book
            video|=2
          ENDSELECT
        CASE 2                                  ! TT
          video|=3
        CASE 3                                  ! FALCON
          video|=4
        CASE 4                                  ! Carte PCI
          video|=5
        DEFAULT                                 !
          video|=0
        ENDSELECT
      CASE "_SWI"
        ' Etat des switch avec INT(long%)
        ' mot de poid faible.
      CASE "_SND"
        IF BTST(long%,0)                        ! PSG prsent
          son|=0
        ENDIF
        IF BTST(long%,1)                        ! 8 Bit DMA prsent
          son|=1                                        ! (STe, TT et FALCON)
        ENDIF
        IF BTST(long%,2)                        ! 16 Bit CODEC prsent (FALCON)
          son|=2
        ENDIF
        IF BTST(long%,3)                        ! DSP prsent (FALCON)
          son|=3
        ENDIF
        IF BTST(long%,4)                        ! MATRIX prsent (FALCON)
          son|=4
        ENDIF
      CASE "MagX"                               ! Multitche avec MagiC
        magic_cookie%=long%
        magic_version&=INT{ADD({ADD(magic_cookie%,8)},48)}
        magic_date%={ADD({ADD(magic_cookie%,8)},16)}
        magic!=TRUE
      CASE "Gnva"                               ! Multitche avec Geneva
        geneva!=TRUE
      CASE "MiNT"                               ! Multitche avec MiNT
        mint!=TRUE
      CASE "nAES"                               ! N AES
        mode_naes!=TRUE
        ver_naes1|=VAL(MID$(HEX$(INT{long%},4),2,1))
        ver_naes2|=VAL(MID$(HEX$(INT{long%},4),2,1))
        ver_naes3|=VAL(RIGHT$(HEX$(INT{long%},4),1))
        dat_naes1|=VAL("%"+RIGHT$(BIN$(INT{ADD(long%,2)},16),5))
        dat_naes2|=VAL("%"+MID$(BIN$(INT{ADD(long%,2)},16),8,4))
        dat_naes3&=ADD(1980,VAL("%"+LEFT$(BIN$(INT{ADD(long%,2)},16),7)))
      CASE "_MAS"
        mode_myaes!=TRUE                        ! Fait par moi pour EB Model 3
      CASE "PSND"                               ! PSOUND de Loic SEBALD
        son|=5
        psound_fnct%=VAL("&H"+LEFT$(HEX$(long%),4))
        psound0|=VAL("$"+MID$(HEX$(long%),5,2))
        psound1|=VAL("$"+RIGHT$(HEX$(long%),2))
      CASE "BGEM"                               ! BUBBLEGEM
        bubble_gem!=TRUE
        bubble_release%=CARD{ADD(long%,8)}
      CASE "NVDI"                               ! NVDI
        mode_nvdi!=TRUE
        ver_nvdi1|=VAL(LEFT$(HEX$(CARD{long%},4),2))
        ver_nvdi2|=VAL(RIGHT$(HEX$(CARD{long%},4),2))
        dat_nvdi1|=VAL(LEFT$(HEX$({ADD(long%,2)},8),2))
        dat_nvdi2|=VAL(MID$(HEX$({ADD(long%,2)},8),3,2))
        dat_nvdi3&=VAL(RIGHT$(HEX$({ADD(long%,2)},8),4))
      CASE "LDGM"
        ldg_gl%=long%
        ldg_version%=WORD{ldg_gl%}
        ldg_path%=ADD(ldg_gl%,2)
        ldg_garbage%=WORD{ADD(ldg_gl%,130)}
        ldg_idle%=WORD{ADD(ldg_gl%,132)}
        ldg_libexec%={ADD(ldg_gl%,134)}
        ldg_libterm%={ADD(ldg_gl%,138)}
        ldg_find%={ADD(ldg_gl%,142)}
        ldg_libexec_evnt%={ADD(ldg_gl%,146)}
        ldg_error%={ADD(ldg_gl%,150)}
      CASE "_FDC"
        ' CHAR{long%}
      CASE "_JPD"
        ' "Dcodeur JPEG prsent"
      CASE "_AFM"
        ' "Audio Fun Machine prsent"
      CASE "WINX"
        mode_winx!=TRUE
      CASE "T2GM"
        tos2gem!=TRUE
        adresse_tos2gem%=long%
      CASE "FSMC"
        IF CHAR{long%}="_FSM"                   ! "FSM GDOS prsent"
          speedogdos!=TRUE
        ELSE IF CHAR{long%}="_SPD"              ! "SPEEDO GDOS prsent"
          speedogdos!=TRUE
        ENDIF
      CASE "fVDI"
        mode_fvdi!=TRUE
      ENDSELECT
      INC slot%
    WEND
  ENDIF
  ~GEMDOS(&H20,L:super%)                ! Retour en mode UTILISATEUR
  pro|=0*(pro|=255)-pro|*(pro|<>0)
  copro|=0*(copro|=255)-copro|*(copro|<>0)
  video|=0*(video|=255)-video|*(video|<>0)
  machine|=0*(machine|=255)-machine|*(machine|<>0)
  IF NOT speedogdos!                    ! Si SPEEDOGDOS ou FSMGDOS
    gdos!=GDOS?                         ! est absent alors on test
  ENDIF                                 ! le bon vieux GDOS
  nombre_de_fontes%=1                   ! est disponible pour crire
  '
  CLR winx_version&
  IF @wind_get(0,wf_return&,d&,d&,d&,d&)=0
    IF @wind_get(0,wf_winx&,winx_version&,d&,d&,d&)=wf_winx&
      winx_beta&=VAL("%"+LEFT$(BIN$(winx_version&,16),4))
      winx_major&=VAL("%"+MID$(BIN$(winx_version&,16),5,4))
      winx_minor&=VAL("%"+MID$(BIN$(winx_version&,16),9,4))
      winx_ident&=VAL("%"+RIGHT$(BIN$(winx_version&,16),4))
    ELSE
      CLR winx_version&
    ENDIF
  ENDIF
  IF INT{{ADD(GB,4)}}=>&H400 OR magic_version&=>&H200 OR winx_version&=>&H210 OR APPL_FIND("AGI?")=0
    INT{ADD(GCONTRL,2)}=1
    INT{ADD(GCONTRL,4)}=5
    INT{ADD(GCONTRL,6)}=0
    INT{ADD(GCONTRL,8)}=0
    INT{GINTIN}=0
    GEMSYS 130
    ' gout1&=INT{ADD(GINTOUT,2)}
    ' gout2&=INT{ADD(GINTOUT,4)}
    ' gout3&=INT{ADD(GINTOUT,6)}
    ' gout4&=INT{ADD(GINTOUT,8)}
    ' RETURN INT{GINTOUT}
  ENDIF
RETURN
' *********************** Modification des RESSOURCES **************************
> PROCEDURE environnement_mono          ! La, le ressource est monochrome
  LOCAL i&,adr%
  FOR i&=0 TO max_res&
    adr%={ADD(ress%,SHL(i&,2))}
    IF adr%>0
      IF fond_gris!
        rsrc_color(adr%,noir&,4)
      ELSE
        rsrc_color(adr%,blanc&,0)
      ENDIF
    ENDIF
  NEXT i&
RETURN
> PROCEDURE environnement_coul          ! Ah ! la, il est en couleurs
  LOCAL i&,adr%
  FOR i&=0 TO max_res&
    adr%={ADD(ress%,SHL(i&,2))}
    IF adr%>0
      IF fond_gris!
        rsrc_color(adr%,gris_clair&,7)
      ELSE
        rsrc_color(adr%,blanc&,0)
      ENDIF
    ENDIF
  NEXT i&
RETURN
> PROCEDURE rsrc_color(arb%,coul&,tram_des&)
  LOCAL c%,type&,type_suivant&,pc%,ob_spec%,te_color&,acoul&
  '
  acoul&=coul&
  pc%=OB_TAIL(arb%,0)           ! Combien d'enfants ??
  WHILE pc%<>-1                 ! Recherche du dernier enfant
    pcf%=pc%
    pc%=OB_TAIL(arb%,pcf%)
  WEND                          ! Ok on est au dernier
  INC pcf%
  CLR c%
  DO
    coul&=acoul&
    type&=OB_TYPE(arb%,c%)               ! Recherche du type de l'lment
    ' --------------------------------------------------------------------------
    ob_spec%=OB_SPEC(arb%,c%)
    $S&,S>
    SELECT type&
    CASE g_box&,g_ibox&,g_boxchar&
      IF BTST(OB_FLAGS(arb%,c%),aes_indicateur&) OR BTST(OB_FLAGS(arb%,c%),aes_fond&)
        IF (NOT @un_flacon) OR (maxcol&<4)
          ob_spec%=ob_spec% AND -128
          ob_spec%=ob_spec% OR SHL(tram_des&,4)   ! Nouvelle trame
          ob_spec%=ob_spec% OR coul&              ! Nouvelle couleur
          OB_SPEC(arb%,c%)=ob_spec%
        ENDIF
      ENDIF
    CASE g_text&,g_boxtext&,g_fboxtext&
      IF BTST(OB_FLAGS(arb%,c%),aes_indicateur&) OR BTST(OB_FLAGS(arb%,c%),aes_fond&)
        IF (NOT @un_flacon) OR (maxcol&<4)
          te_color&=INT{ADD(ob_spec%,18)}
          te_color&=te_color& AND -128
          te_color&=te_color& OR SHL(tram_des&,4)   ! Nouvelle trame
          te_color&=te_color& OR coul&              ! Nouvelle couleur
          INT{ADD(ob_spec%,18)}=te_color&
        ENDIF
      ENDIF
    ENDSELECT
    INC c%
  LOOP WHILE c%<pcf%
RETURN
> FUNCTION un_flacon
  IF machine|=5
    RETURN TRUE
  ENDIF
  RETURN FALSE
ENDFUNC
' ******************************************************************************
> PROCEDURE definir_variables           ! Quelques variables globales
  index_ressource_1
  index_ressource_bubble_gem
  variables_reservees_au_gem
  variables_indexs_fenetres
  ' ++SYM
  blanc&=0
  noir&=1
  rouge&=2
  vert&=3
  bleu&=4
  cyan&=5
  jaune&=6
  violet&=7
  gris_clair&=8
  gris_fonce&=9
  rouge_pal&=10
  vert_pal&=11
  bleu_pal&=12
  cyan_pal&=13
  jaune_pal&=14
  violet_pal&=15
  ' ++SYM
RETURN
> PROCEDURE variables_reservees_au_gem  ! Celles la, elles sont pour le GEM
  ' ++SYM
  ' ---- Constantes concernant les vnements MESSAGE ----
  mn_selected&=10       ! Slection d'un menu
  wm_redraw&=20         ! Demande de redessin d'cran
  wm_topped&=21         ! Ractivation d'un fentre par clic
  wm_closed&=22         ! Fermeture d'une fentre
  wm_fulled&=23         ! Mise en plein cran d'une fentre
  wm_arrowed&=24        ! Clic sur un des uatres champs flchs
  wm_hslid&=25          ! Changement de position du poussoir horizontal
  wm_vslid&=26          ! Changement de position du poussoir vertical
  wm_sized&=27          ! Changement de taille d'une fentre
  wm_moved&=28          ! Dplacement d'une fentre
  wm_newtop&=29         ! Ractivation d'une fentre par femeture d'une autre
  wm_zero&=9999         ! Mise  zro des messages
  ac_open&=40           ! Ouverture d'un accssoire
  ac_close&=41          ! Fermeture d'un accessoire
  ' Ajouter par moi mme pour la gestion des lments non GEM d'une fentre
  wm_xmenu&=9           ! Bouton d'ouverture du popup de gestion fentre
  wm_xcrossed&=10       ! Bouton valid avec une croix
  wm_xfulled&=11        ! Bouton en pseudo 3D (plein cran ou non)
  wm_xbutton&=12        ! Bouton en pseudo 3D (redessin par 2 objets avant)
  wm_xreducted&=13      ! Rduction d'une fentre
  wm_xmoved&=14         ! Dplacement d'une fentre
  wm_xclosed&=15        ! Fermeture d'une fentre
  ' ---- Constantes concernant les vnements FENETRE ----
  wf_kind&=1            ! Fixe de nouvelles parties de fentre
  wf_name&=2            ! Fixe un nom de fentre
  wf_info&=3            ! Fixe une nouvelle info de fentre
  wf_workxywh&=4        ! Coordonnes de la zone de travail de fentre
  wf_currxywh&=5        ! Coordonnees de la zone total de fentre
  wf_prevxywh&=6        ! Taille globale fentre prcdente
  wf_fullxywh&=7        ! Taille globale fentre plein cran
  wf_hslide&=8          ! Position poussoir horizontal
  wf_vslide&=9          ! Position poussoir vertical
  wf_top&=10            ! Code de fentre active
  wf_firstxywh&=11      ! Premier rectangle de la liste des rectangles
  wf_nextxywh&=12       ! Prochain rectangle de la liste des rectangles
  wf_newdesk&=14        ! Fixe un nouvel arbre pour le bureau
  wf_hslsize&=15        ! Fixe taille poussoir horizontal
  wf_vslsize&=16        ! Fixe taille poussoir vertical
  wf_color&=18          !
  wf_dcolor&=19         !
  wf_return&=1          ! Fonction WINX
  wf_owner&=20          ! Fonction WINX
  wf_bevent&=24         ! Fonction WINX
  wf_bottom&=25         ! Fonction WINX
  wf_untopped&=30       ! Fonction WINX
  wf_ontop&=31          ! Fonction WINX
  wf_bottemed&=33       ! Fonction WINX
  wf_winx&=22360        ! Fonction WINX (appl_getinfo)
  wf_winxcfg&=22361     ! Fonction WINX
  ' ---- Constantes concernant les touches mortes du clavier
  cl_shift_droit&=0
  cl_shift_gauche&=1
  cl_control&=2
  cl_alternate&=3
  ' ---- Constantes concernant les modes graphiques --------
  mode_remplace|=1
  mode_transparent|=2
  mode_xor|=3
  mode_inverse_transparent|=4
  ' ---- Constantes concernant les types d'objets RSC ------
  g_box&=20
  g_text&=21
  g_boxtext&=22
  g_image&=23
  g_userdef&=24
  g_ibox&=25
  g_button&=26
  g_boxchar&=27
  g_string&=28
  g_ftext&=29
  g_fboxtext&=30
  g_icon&=31
  g_title&=32
  g_cicon&=33
  ' ---- Constantes concernant l'AES -----------------------
  '             ................................ OB FLAGS
  aes_selectable&=0
  aes_default&=1
  aes_exit&=2
  aes_editable&=3
  aes_rbutton&=4
  aes_lastob&=5
  aes_touchexit&=6
  aes_hidetree&=7
  aes_indirect&=8
  '             ................................ OB STATE
  aes_selected&=0
  aes_crossed&=1
  aes_checked&=2
  aes_disable&=3
  aes_outlined&=4
  aes_shadowed&=5
  '
  end_update&=0
  beg_update&=1
  end_mctrl&=2
  beg_mctrl&=3
  ' ---- Pour le nouveau GEM en pseudo 3D -----------------------
  aes_indicateur&=9
  aes_fond&=10
  aes_flags11|=11
  ' ---- Les formes de souris et l'activation/dsactivation du rongeur -----
  fleche&=0
  trait_vertical&=1
  abeille&=2
  main_pointee&=3
  main_a_plat&=4
  reticule_mince&=5
  reticule_epais&=6
  contour_de_reticule&=7
  user_def&=255
  m_off&=256
  m_on&=257
  ' ---- Les deux modes de travail des fonction VDI ------------------------
  request&=1
  sample&=2
  ' ---- Pour la gestion AV START ------------------------------------------
  va_start&=&H4711                                   ! Protocol AV-START
  av_start&=&H4738
  av_startprog&=&H4722
  av_protokoll&=&H4700
  va_protostatus&=&H4701
  ' ---- Pour la gestion Drag n' Drop --------------------------------------
  ap_dragdrop&=&H3F
  ' ---- Pour les bulles d'aide de BUBBLE GEM ------------------------------
  bubblegem_request&=-17734
  bubblegem_show&=-17733
  ' ------------------------------------------------------------------------
  screnmgr&=1                                        ! MAG!C...
  smc_unfreeze&=4
  sm_m_special&=101
  shut_down&=&H32
  ' -------------------- Mode de lancement de PEXEC ------------------------
  shw_load_go&=0
  shw_load&=3
  shw_go&=4
  shw_parallel&=100
  shw_single&=101
  ' ---- Pour les accs disque via GEMDOS ----------
  gemdos_read%=0
  gemdos_write%=1
  gemdos_read_write%=2
  ' ++SYM
RETURN
> PROCEDURE variables_indexs_fenetres  ! Constantes globales pour les indexs de fenetres
  ' ++SYM
  '
  idx_info&=0
  idx_info_dbl&=0
  idx_generale&=1
  idx_generale_dbl&=2
  idx_auteur&=2
  idx_auteur_dbl&=4
  '
  ' ++SYM
RETURN
> PROCEDURE index_ressource_1           ! Constantes globales du ressource n1
  ' ++SYM
  '
  REM Resource file indices for PACK_CNF.
  '
  LET menu&=0 ! Menu-tree
  LET minfo&=7 ! STRING in tree MENU
  LET mnouveau&=16 ! STRING in tree MENU
  LET mcharger&=18 ! STRING in tree MENU
  LET msauver&=19 ! STRING in tree MENU
  LET mquitter&=21 ! STRING in tree MENU
  '
  LET info&=1 ! Form/Dialog-box
  LET fininfo&=1 ! BUTTON in tree INFO
  LET infoauteur&=14 ! BUTTON in tree INFO
  LET infomem&=15 ! FTEXT in tree INFO
  LET infomemt&=16 ! FTEXT in tree INFO
  LET bartit01&=17 ! FBOXTEXT in tree INFO
  '
  LET generale&=2 ! Form/Dialog-box
  LET pack_conf&=0 ! BOX in tree GENERAL
  LET onglet_config&=1 ! BUTTON in tree GENERAL
  LET onglet_mint&=2 ! BUTTON in tree GENERAL
  LET onglet_myaes&=3 ! BUTTON in tree GENERAL
  LET sous_config&=4 ! BOX in tree GENERAL
  LET path_config&=7 ! BOXTEXT in tree GENERAL
  LET path_aranym&=8 ! BOXTEXT in tree GENERAL
  LET find_config&=9 ! BUTTON in tree GENERAL
  LET onglet_global&=10 ! BUTTON in tree GENERAL
  LET onglet_video&=11 ! BUTTON in tree GENERAL
  LET onglet_systeme&=12 ! BUTTON in tree GENERAL
  LET onglet_net_midi&=13 ! BUTTON in tree GENERAL
  LET onglet_boot&=14 ! BUTTON in tree GENERAL
  LET onglet_disques&=15 ! BUTTON in tree GENERAL
  LET onglet_nfvdi&=16 ! BUTTON in tree GENERAL
  LET sous_global&=17 ! BOX in tree GENERAL
  LET global_memoire&=20 ! BOXTEXT in tree GENERAL
  LET global_floppy&=25 ! BOXTEXT in tree GENERAL
  LET global_emutos&=26 ! BOXTEXT in tree GENERAL
  LET global_tos&=27 ! BOXTEXT in tree GENERAL
  LET find_floppy&=28 ! BUTTON in tree GENERAL
  LET find_emutos&=29 ! BUTTON in tree GENERAL
  LET find_tos&=30 ! BUTTON in tree GENERAL
  LET active_floppy&=31 ! BUTTON in tree GENERAL
  LET active_emutos&=32 ! BUTTON in tree GENERAL
  LET active_tos&=33 ! BUTTON in tree GENERAL
  LET active_autogm&=34 ! BUTTON in tree GENERAL
  LET active_grabm&=39 ! BUTTON in tree GENERAL
  LET find_aranym&=41 ! BUTTON in tree GENERAL
  LET sous_video&=42 ! BOX in tree GENERAL
  LET sous_systeme&=65 ! BOX in tree GENERAL
  LET sous_net_midi&=97 ! BOX in tree GENERAL
  LET sous_boot&=125 ! BOX in tree GENERAL
  LET sous_disques&=137 ! BOX in tree GENERAL
  LET sous_nfvdi&=186 ! BOX in tree GENERAL
  LET sous_mint&=207 ! BOX in tree GENERAL
  LET sous_myaes&=210 ! BOX in tree GENERAL
  '
  LET auteur&=3 ! Form/Dialog-box
  LET finauteur&=1 ! BUTTON in tree AUTEUR
  '
  ' ++SYM
RETURN
> PROCEDURE index_ressource_bubble_gem  ! En cas de BUBBLE GEM en mmoire
  ' ++SYM
  ' ++SYM
RETURN
' ******************************************************************************
> PROCEDURE reservation_memoire         ! Un peu de mmoire pour travailler
  LOCAL adresse%,taille_totale%,ef&,ad%,ad2%,x&,y&,w&,h&
  LOCAL ex&,ey&,ew&,eh&,i&,i%
  LOCAL d%,dl&,dh&,dp&,x11&,y11&,x21&,y21&
  '
  CLR taille_totale%
  ADD taille_totale%,20             ! mfdb%
  ADD taille_totale%,20             ! mfbd%
  ADD taille_totale%,24             ! mem_num%
  ADD taille_totale%,32             ! buf%
  ADD taille_totale%,32             ! buf2%
  ADD taille_totale%,64             ! hwind%
  ADD taille_totale%,240            ! ress%
  ADD taille_totale%,240            ! mem_vid%
  ADD taille_totale%,256            ! nom_en_cours%
  ADD taille_totale%,256            ! nom_divers%
  ADD taille_totale%,256            ! nom_mouvement%
  ADD taille_totale%,272            ! commande%
  ADD taille_totale%,1024           ! coord_polygon%
  ADD taille_totale%,1144           ! temporaire%
  ADD taille_totale%,1536           ! palette%
  ADD taille_totale%,2048           ! mem_redraw%
  IF bubble_gem!
    ADD taille_totale%,30*4         ! adr_bub%
  ENDIF
  ' ----------------------------------------------------------------------------
  '
  IF taille_totale%<MAX(@memoire_dispo(0),@memoire_dispo(1))
    zone%=@prendre(taille_totale%,TRUE,3)
    adresse%=zone%
    '
    mfdb%=@zone(20,adresse%)              ! Pour les raster copy
    mfbd%=@zone(20,adresse%)              ! Pour les raster copy
    mem_num%=@zone(24,adresse%)           ! Pour les tris de faces
    buf%=@zone(32,adresse%)               ! Le buffer d'vnement
    buf2%=@zone(32,adresse%)              ! Le buffer d'vnement
    hwind%=@zone(64,adresse%)             ! Les fentres (32 * 2 octets)
    i%=hwind%
    CLR i&
    DO
      INT{i%}=-1
      ADD i%,2
      INC i&
    LOOP WHILE i&<32
    ress%=@zone(240,adresse%)             ! Adresses des arbres des ressources
    mem_vid%=@zone(240,adresse%)          ! Pour Gouraud et Phong
    nom_en_cours%=@zone(256,adresse%)     ! Nom du fichier en cours
    nom_divers%=@zone(256,adresse%)       ! Les autres noms lors d'accs disque
    nom_mouvement%=@zone(256,adresse%)    ! Nom pour les fichier INC
    commande%=@zone(272,adresse%)         ! Ligne de commande de POV.TTP
    coord_polygon%=@zone(1024,adresse%)   ! Coordonnes des polygones VDI
    temporaire%=@zone(1144,adresse%)      ! Pour les appels externes
    palette%=@zone(1536,adresse%)         ! Palette systme
    redraw_mem%=@zone(2048,adresse%)      ! Pour effectuer des redraws corrects
    IF bubble_gem!
      adr_bub%=@zone(30*4,adresse%)       ! 30 adresses pour les messages
    ENDIF
    ' --------------------------------------------------------------------!
    zone_transfert%=@prendre(ADD(1024,16),FALSE,3) ! pour les calculs 3D
    transfert%=zone_transfert%
  ELSE
    CHAR{path%}="[3][|Manque de mmoire !|Out of memory !|][ Ok ]"+CHR$(0)
    ~@afficher_alerte(path%)
    close_virtual_screen_workstation(vdihandle%) ! On ferme la sation de travail
    liberation_memoire                      ! On rend la mmoire au GEM
    appl_exit                               ! et on le dit au GEM
    END                                     ! L, c'est la fin...snif...snif
  ENDIF
RETURN
> PROCEDURE liberation_memoire          ! Bon, rendont la au GEM, il la veut
  LOCAL i&
  ' ----------------------------------------------------------------------------
  '                             Avant de quitter l'application :
  ' ----------------------------------------------------------------------------
  IF init_correct!
    chemin_systeme
    IF hwind%
      i&=31
      DO                                                ! Pour chaque fentre
        IF INT{ADD(hwind%,SHL(i&,1))}>-1                ! Si la fentre est ouverte
          wind_close(INT{ADD(hwind%,SHL(i&,1))})        ! La fermer
          wind_delete(INT{ADD(hwind%,SHL(i&,1))})       ! La dtruire
          INT{ADD(hwind%,SHL(i&,1))}=-1
        ENDIF
        DEC i&
      LOOP WHILE i&>-1
    ENDIF
  ENDIF
  ' ----------------------------------------------------------------------------
  graf_mouse(fleche&,0)
  '                           Effacer les vecteurs normaux
  IF adr_menu%
    menu_bar(adr_menu%,0)               ! Virer la barre de menu
  ENDIF
  wind_set(0,wf_newdesk&,0,0,0,0)       ! Rendre le bureau
  IF @xrsrc_free<>0
    libere(ADD(f_init%,4))
    xrsrc_exit
  ENDIF
  ' IF INT{{ADD(GB,4)}}>=&H320            ! AES>3.20
  '  INT{ADD(GCONTRL,2)}=0
  '  INT{ADD(GCONTRL,4)}=0
  '  INT{ADD(GCONTRL,6)}=0
  '  INT{ADD(GCONTRL,8)}=0
  ' GEMSYS 109                          ! wind_new()
  ' ENDIF
  libere(*zone%)
  libere(*adr_chemin_systeme%)
  libere(*precalcul%)
  libere(*etendue%)
  libere(*station%)
RETURN
> PROCEDURE efface_fichier
  IF @s_exist(mem_che%)
    ~GEMDOS(&H41,L:mem_che%)
  ENDIF
RETURN
' **************************** Gestion de la mmoire ***************************
> FUNCTION prendre(tl%,id!,mod|)         ! Prendre un peu de mmoire
  LOCAL l%,dummy&
  ' Adapter la taille au multiple de 16 immdiatement suprieur
  tl%=SHL(SHR(ADD(tl%,16),4),4)
  '
  IF GEMDOS(&H44,L:-1,W:0)<>-32       ! La fonction est elle accepte
    IF multitache!
      mod|=mod| OR &X11000            ! Force l'utilisation des informations de
    ENDIF                             ! l'entte
    l%=GEMDOS(&H44,L:tl%,W:mod|)      ! L, on est sur TT, FALCON ou plus...
  ELSE
    l%=GEMDOS(&H48,L:tl%)             ! Bon, allez, les vieux appels compatibles
  ENDIF
  $S%,S>
  SELECT l%
  CASE 0
    PRINT tl%
    ERROR 8
  DEFAULT
    IF id!
      membfill(l%,tl%,0)
    ENDIF
    RETURN l%
  ENDSELECT
ENDFUNC
> FUNCTION memoire_dispo(mod|)           ! Reste-t-il de la mmoire
  IF GEMDOS(&H44,L:-1,W:0)<>-32         ! La fonction est elle accepte
    RETURN GEMDOS(&H44,L:-1,W:mod|)     ! Sur TT/FALCON, nouvel appel
  ELSE
    RETURN GEMDOS(&H48,L:-1)            ! Sinon, vieux appels compatibles
  ENDIF
ENDFUNC
> PROCEDURE libere(ad%)                  ! On rend la mmoire  la machine
  IF ad%>0
    $S%,S>
    SELECT {ad%}
    CASE 0
      ' Ne rien faire
    DEFAULT
      ~GEMDOS(&H49,L:{ad%})
      {ad%}=0
    ENDSELECT
  ENDIF
  garbage_collector
RETURN
> PROCEDURE membfill(vide_adr%,size%,msq%) ! Remplissage et vidage de bloc
  LOCAL dep_vi%,fin_vi%,nombre%
  LOCAL adr%,fin_adr%
  LOCAL nombre%
  adr%=precalcul%
  fin_adr%=ADD(adr%,256)
  DO
    {adr%}=msq%
    ADD adr%,4
  LOOP WHILE adr%<fin_adr%
  ' *************************************************************
  ' ****    Merci  Sbastien TRUTTET (MANGUE d'ADRENLINE)   ****
  ' ****    Pour cette routine vraiment rapide...            ****
  ' *************************************************************
  IF NOT EVEN(vide_adr%)                  ! recalage sur une adresse paire
    BYTE{vide_adr%}=0                     ! Efface 1 octet
    INC vide_adr%                         ! adresse graphique suivante
    DEC size%                             ! diminue bien sur la longueur
  ENDIF
  '                            si la taille est suprieure ou gale  256 octets
  IF AND(size%,&HFF00)
    FOR nombre%=1 TO SHR(size%,8)         ! autant de fois que ncessaire
      BMOVE precalcul%,vide_adr%,256      ! Remplir de blanc
      ADD vide_adr%,256                   ! Avancer dans la zone mmoire
    NEXT nombre%
  ENDIF
  BMOVE precalcul%,vide_adr%,AND(size%,&HFF) ! on finit de recopier les donnes
  '
RETURN
PROCEDURE garbage_collector            ! Un peu de mnage dans la mmoire
  ~FRE(0)
  ~FRE()
  IF hwind%>0 AND adr_info%>0
    CHAR{{OB_SPEC(adr_info%,infomem&)}}=STR$(@memoire_dispo(0),9)
    IF GEMDOS(&H44,L:-1,W:0)<>-32       ! La fonction est elle accepte
      CHAR{{OB_SPEC(adr_info%,infomemt&)}}=STR$(@memoire_dispo(1),9)
    ELSE
      CHAR{{OB_SPEC(adr_info%,infomemt&)}}="ABSENTE "
    ENDIF
    IF INT{hwind%}>-1
      redraw_element_fenetre(0,adr_info%,infomem&)
      redraw_element_fenetre(0,adr_info%,infomemt&)
    ENDIF
  ENDIF
RETURN
> FUNCTION zone(tal%,VAR adresse%)       ! Dcalage d'adresse en mmoire
  ADD adresse%,tal%
  RETURN SUB(adresse%,tal%)
ENDFUNC
> PROCEDURE bmove(bsrc%,bdes%,siz%)      ! Copie de bloc rapide
  BMOVE bsrc%,bdes%,siz%
RETURN
' *************************  Nouvelles routines de Xrsrc: **********************
> PROCEDURE xrsrc_exit
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=129    ! Numro de la fonction
    $C+
    r%=C:f_scalc%()
    $C-
  ENDIF
RETURN
> FUNCTION xrsrc_free
  LOCAL r%
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=2      ! Numro de la fonction
    $C+
    r%=C:f_scalc%()
    $C-
    RETURN r%
  ELSE
    ~@rsrc_free
    RETURN 0
  ENDIF
ENDFUNC
> FUNCTION xrsrc_gaddr(re_gtype&,re_gindex&,VAR re_gaddr%)
  LOCAL r%
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=3          ! Numro de la fonction
    WORD{ADD(ADD(f_init%,4),0)}=re_gtype&
    WORD{ADD(ADD(f_init%,4),2)}=re_gindex&
    {ADD(ADD(f_init%,4),16)}=V:re_gaddr%
    $C+
    r%=C:f_scalc%()
    $C-
  ELSE
    r%=@rsrc_gaddr(re_gtype&,re_gindex&,re_gaddr%)
  ENDIF
  RETURN r%
ENDFUNC
> PROCEDURE xrsrc_init
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=128    ! Numro de la fonction
    $C+
    r%=C:f_scalc%()
    $C-
  ENDIF
RETURN
> FUNCTION xrsrc_load(n%)
  LOCAL r%
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=1                  ! Numro de la fonction
    {ADD(ADD(f_init%,4),16)}=n%
    $C+
    r%=C:f_scalc%()
    $C-
  ELSE
    r%=@rsrc_load(n%)
  ENDIF
  RETURN r%
ENDFUNC
> FUNCTION xrsrc_obfix(re_gaddr%,re_obj&)
  LOCAL r%
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=5          ! Numro de la fonction
    WORD{ADD(ADD(f_init%,4),0)}=re_obj&
    {ADD(ADD(f_init%,4),16)}=re_gaddr%
    $C+
    r%=C:f_scalc%()
    $C-
  ELSE
    r%=@rsrc_obfix(re_obj&,re_gaddr%)
  ENDIF
  RETURN r%
ENDFUNC
> FUNCTION xrsrc_saddr(re_gtype&,re_gindex&,VAR re_gaddr%)
  LOCAL r%
  IF r_resident!
    WORD{ADD(ADD(f_init%,4),36)}=4          ! Numro de la fonction
    WORD{ADD(ADD(f_init%,4),0)}=re_gtype&
    WORD{ADD(ADD(f_init%,4),2)}=re_gindex&
    {ADD(ADD(f_init%,4),16)}=V:re_gaddr%
    $C+
    r%=C:f_scalc%()
    $C-
  ELSE
    r%=@rsrc_saddr(re_gtype&,re_gindex&,re_gaddr%)
  ENDIF
  RETURN r%
ENDFUNC
' ******************************************************************************
> PROCEDURE redraw_force(debut_redraw&,fin_redraw&)
  LOCAL xv&,yv&,wv&,hv&
  LOCAL i&,xw&,yw&,ww&,hw&
  i&=debut_redraw&                      ! Pour certaines fentres
  DO
    ' Si la fentre est ouverte ou si c'est le bureau
    IF (INT{ADD(hwind%,SHL(i&,1))}>-1) OR (i&=0)
      IF i&=0
        xw&=global_xb&
        yw&=global_yb&
        ww&=global_wb&
        hw&=global_hb&
      ELSE
        IF mode_winx!
          ~@wind_get(INT{ADD(hwind%,SHL(i&,1))},wf_workxywh&,xv&,yv&,wv&,hv&)
          wind_calc(0,0,xv&,yv&,wv&,hv&,xw&,yw&,ww&,hw&)
        ELSE
          ~@wind_get(INT{ADD(hwind%,SHL(i&,1))},wf_currxywh&,xw&,yw&,ww&,hw&)
        ENDIF
      ENDIF
      ' On s'envoie  soi-mme un message de redraw
      INT{buf%}=wm_redraw&              ! Numro du message
      INT{ADD(buf%,2)}=ap_id&           ! Indentificateur expditeur du message
      INT{ADD(buf%,4)}=0                ! Pas d'excdent au message
      INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(i&,1))} ! Handle fentre concerne
      INT{ADD(buf%,8)}=xw&              ! Cordonne zone redraw (bureau)
      INT{ADD(buf%,10)}=yw&
      INT{ADD(buf%,12)}=ww&
      INT{ADD(buf%,14)}=hw&
      appl_write(ap_id&,16,buf%) ! Envoi du message
    ENDIF
    INC i&
  LOOP WHILE i&<SUCC(fin_redraw&)
RETURN
> PROCEDURE redraw(x&,y&,w&,h&,de!)      ! Une liste de rectangle c'est utile...
  LOCAL redrx&,redry&,redrw&,redrh&,rdx&,rdy&,rdw&,rdh&,index&
  LOCAL mem_redrx&,mem_redry&,mem_redrw&,mem_redrh&,m_ix&,m_iy&
  LOCAL dummy&,top&,i&,cp&,r%,x_f&,y_f&,cr|,cv|,cb|,rep&
  LOCAL cx&,cy&,cw&,ch&,num_buf&,adrc%,taille_fic%
  LOCAL zx&,zy&,zw&,zh&,fx&,fy&,fw&,fh&,origx&,origy&
  LOCAL p_cou1&,p_cou2&,p_tra1%,p_tra2%,p_tra3%
  LOCAL s%,sl&,sh&,sp&,d%,dl&,dh&,dp&
  '
  num_buf&=INT{ADD(buf%,6)}
  ~@wind_get(0,wf_top&,top&,dummy&,dummy&,dummy&)
  index&=@numero_fenetre(num_buf&)
  rdx&=x&        ! Coordonnes rectangle  redessiner
  rdy&=y&
  rdw&=w&
  rdh&=h&
  ' L, on commence par rcuprer tout les rectangles  redessiner.
  ' Ainsi, on est sur qu'aucune perturbation ne viendra stoper les
  ' redessins d'crans de mme que mes routines de dessins qui bloque
  ' les listes de rectangles.
  CLR cp&
  r%=redraw_mem%                ! Zone de mmorisation des rectangles
  ' Demande les coord. et dimensions du 1 rectangle de la liste
  ~@wind_get(num_buf&,wf_firstxywh&,redrx&,redry&,redrw&,redrh&)
  DO
    '
    IF (redrw&>0) AND (redrh&>0)
      INT{r%}=index&
      INT{ADD(r%,2)}=redrx&
      INT{ADD(r%,4)}=redry&
      INT{ADD(r%,6)}=redrw&
      INT{ADD(r%,8)}=redrh&
      INC cp&
      ADD r%,10
    ENDIF
    '                        Rectangle suivant
    rep&=@wind_get(num_buf&,wf_nextxywh&,redrx&,redry&,redrw&,redrh&)
    ' Tant qu'il y a largeur ou hauteur et pas d'erreur...
    ' et tant que le compteur n'a pas atteint la valeur 100
    EXIT IF (redrw&<1) OR (redrh&<1) OR (rep&=0)
    '
    EXIT IF rep&=0
    EXIT IF cp&=200             ! j'ai cent rectangles en rserve...
  LOOP
  ' Et voil. Maintenant, le GEM peut faire ce qu'il veut. La liste des
  ' rectangles est sauve. Il est donc possible de la parcourir sans passer
  ' par le GEM et enfin faire des  redessins correts.
  r%=redraw_mem%
  CLR i&
  DO
    index&=INT{r%}
    redrx&=INT{ADD(r%,2)}
    redry&=INT{ADD(r%,4)}
    redrw&=INT{ADD(r%,6)}
    redrh&=INT{ADD(r%,8)}
    '
    IF (redrw&<>0) AND (redrh&<>0)
      ' Si intersection des deux zones
      IF RC_INTERSECT(rdx&,rdy&,rdw&,rdh&,redrx&,redry&,redrw&,redrh&) AND index&<>-1
        x_f&=PRED(ADD(redrx&,redrw&))
        IF x_f&>xmax&
          redrw&=SUB(redrw&,SUB(x_f&,xmax&))
        ENDIF
        y_f&=PRED(ADD(redry&,redrh&))
        IF y_f&>ymax&
          redrh&=SUB(redrh&,SUB(y_f&,ymax&))
        ENDIF
        $S|,S>
        SELECT index&
        DEFAULT
          objc_draw(@arbre_ressource(index&),0,12,redrx&,redry&,redrw&,redrh&,-1)
        ENDSELECT
      ENDIF
    ENDIF
    '
    INC i&
    ADD r%,10
  LOOP WHILE i&<cp&
  '
RETURN
> PROCEDURE redraw_elem(arb%,obj&)      ! Un lment  redessiner. C'est ici
  LOCAL x&,y&,w&,h&,ob&
  objc_offset(arb%,obj&,x&,y&)
  w&=OB_W(arb%,obj&)
  h&=OB_H(arb%,obj&)
  objc_draw(arb%,0,12,x&,y&,w&,h&,-1)
RETURN
> PROCEDURE redraw_element_fenetre(index&,adr_arb%,obj&)
  LOCAL rx&,ry&,rw&,rh&,rdx&,rdy&,rdw&,rdh&
  LOCAL zx&,zy&,zw&,zh&,rep&
  '
  ' Coordonnes rectangle  redessiner
  objc_offset(adr_arb%,obj&,rdx&,rdy&)
  rdw&=OB_W(adr_arb%,obj&)
  rdh&=OB_H(adr_arb%,obj&)
  '
  ' Demande les coord. et dimensions du 1 rectangle de la liste
  ~@wind_get(INT{ADD(hwind%,index&)},wf_firstxywh&,rx&,ry&,rw&,rh&)
  DO
    '                                           Si intersection des deux zones
    IF RC_INTERSECT(rdx&,rdy&,rdw&,rdh&,rx&,ry&,rw&,rh&)
      objc_draw(@arbre_ressource(SHR(index&,1)),0,12,rx&,ry&,rw&,rh&,-1)
    ENDIF
    '                                           Rectangle suivant
    rep&=@wind_get(INT{ADD(hwind%,index&)},wf_nextxywh&,rx&,ry&,rw&,rh&)
    EXIT IF (rw&<1) OR (rh&<1) OR (rep&=0)      ! Tant que largeur ou hauteur...
  LOOP                                          ! et pas d'erreur
  '
RETURN
> PROCEDURE mettre_a_jour_les_redraws(xw&,yw&,ww&,hh&,de!) ! On dsaturer le GEM
  LOCAL evt&
  DO
    evt&=@evnt_multi(&X110011,258,3,0,0,0,0,1,1,0,0,0,1,1,buf%,5,mx&,my&,mk&,kbd&,key&,click&)
    IF (INT{buf%}=wm_redraw&) AND (evt& AND &X10000)
      redraw(xw&,yw&,ww&,hh&,de!)
    ENDIF
  LOOP WHILE (evt& AND &X10000)
RETURN
> PROCEDURE mise_a_la_taille_fenetre_generale     ! On ajuste le ressource
  LOCAL x&,y&,w&,h&
  LOCAL xf&,yf&,wf&,hf&
  '
  '
  ' Largeur et hauteur du fond fixes d'aprs les ressources
  OB_W(adr_generale%,pack_cnf&)=508
  OB_H(adr_generale%,pack_cnf&)=320
  '
  form_center(adr_generale%,x&,y&,w&,h&)
  ~@wind_get(INT{ADD(hwind%,idx_generale_dbl&)},wf_currxywh&,xf&,yf&,wf&,hf&)
  '
  ' Le fond
  OB_X(adr_generale%,pack_cnf&)=xf&
  OB_Y(adr_generale%,pack_cnf&)=yf&
  '
  ' Les onglets
  OB_X(adr_generale%,sous_video&)=OB_X(adr_generale%,sous_global&)
  OB_Y(adr_generale%,sous_video&)=OB_Y(adr_generale%,sous_global&)
  '
  OB_X(adr_generale%,sous_systeme&)=OB_X(adr_generale%,sous_global&)
  OB_Y(adr_generale%,sous_systeme&)=OB_Y(adr_generale%,sous_global&)
  '
  OB_X(adr_generale%,sous_net_midi&)=OB_X(adr_generale%,sous_global&)
  OB_Y(adr_generale%,sous_net_midi&)=OB_Y(adr_generale%,sous_global&)
  '
  OB_X(adr_generale%,sous_boot&)=OB_X(adr_generale%,sous_global&)
  OB_Y(adr_generale%,sous_boot&)=OB_Y(adr_generale%,sous_global&)
  '
  OB_X(adr_generale%,sous_disques&)=OB_X(adr_generale%,sous_global&)
  OB_Y(adr_generale%,sous_disques&)=OB_Y(adr_generale%,sous_global&)
  '
  OB_X(adr_generale%,sous_nfvdi&)=OB_X(adr_generale%,sous_global&)
  OB_Y(adr_generale%,sous_nfvdi&)=OB_Y(adr_generale%,sous_global&)
  '
  OB_W(adr_generale%,sous_config&)=508
  OB_H(adr_generale%,sous_config&)=288
  '
  OB_X(adr_generale%,sous_mint&)=OB_X(adr_generale%,sous_config&)
  OB_Y(adr_generale%,sous_mint&)=OB_Y(adr_generale%,sous_config&)
  '
  OB_X(adr_generale%,sous_myaes&)=OB_X(adr_generale%,sous_config&)
  OB_Y(adr_generale%,sous_myaes&)=OB_Y(adr_generale%,sous_config&)
  '
RETURN
> PROCEDURE videsouris                  ! Elle bouge trop celle l.
  LOCAL evt&
  graf_mkstate(mx&,my&,mk&,kbd&)
  DO
    graf_mkstate(mx&,my&,mk&,kbd&)
    EXIT IF mk&=0                     ! Attendre bouton souris relach
  LOOP
  IF NOT flag_aes_mctrl!
    DO
      evt&=@evnt_multi(&X110011,258,3,0,0,0,0,1,1,0,0,0,1,1,buf%,5,mx&,my&,mk&,kbd&,key&,click&)
    LOOP WHILE (evt& AND &X10000)
  ENDIF
RETURN
' ******************************************************************************
' Les procdures d'ouverture de fentres.
> PROCEDURE ouvrir_information
  ecrire_donnees_dans_info
  ouvrir_fenetre(idx_info&,adr_info%)
RETURN
> PROCEDURE ouvrir_generale
  ecrire_donnees_dans_generale
  ouvrir_fenetre(idx_generale&,adr_generale%)
RETURN
> PROCEDURE ouvrir_auteur
  ecrire_donnees_dans_auteur
  ouvrir_fenetre(idx_auteur&,adr_auteur%)
RETURN
' ------------------------------------------------------------------------------
PROCEDURE ouvrir_fenetre(index_de_fenetre&,adresse%)
  ' Ouverture fentre formulaire
  LOCAL x&,y&,w&,h&      ! Coordonnes du formulaire
  LOCAL attr&            ! Attributs GEM de la fentre
  LOCAL dummy&,adr%
  '
  attr&=&X1011
  ' Si la fentre formulaire est dj ouverte, on la replace en TOP
  IF INT{ADD(hwind%,SHL(index_de_fenetre&,1))}>-1
    wind_set(INT{ADD(hwind%,SHL(index_de_fenetre&,1))},wf_top&,0,0,0,0)
    ~@wind_get(INT{ADD(hwind%,SHL(index_de_fenetre&,1))},wf_workxywh&,x&,y&,w&,h&)
  ELSE              ! Sinon, on l'ouvre
    ' Lire coordonnes courantes du formulaire (X sur un multiple de 16)
    x&=OB_X(adresse%,0)
    y&=OB_Y(adresse%,0)
    w&=OB_W(adresse%,0)
    h&=OB_H(adresse%,0)
    ' En dduire les coordonnes totales de la fentre
    wind_calc(0,attr&,x&,y&,w&,h&,global_xf&,global_yf&,global_wf&,global_hf&)
    global_xf&=SHL(SHR(global_xf&,2),2)                               ! Sur un mulitple de 8
    wind_calc(1,attr&,global_xf&,global_yf&,global_wf&,global_hf&,x&,y&,w&,h&)
    OB_X(adresse%,0)=x&
    IF global_yf&<global_yb&
      global_yf&=global_yb&
    ENDIF
    ' Crer la fentre
    INT{ADD(hwind%,SHL(index_de_fenetre&,1))}=@wind_create(attr&,global_xf&,global_yf&,global_wf&,global_hf&)
    IF INT{ADD(hwind%,SHL(index_de_fenetre&,1))}<0
      '                                         Si la fentre n'a pu tre cre
      ' ~@afficher_alerte(adr_nofenetre%)       ! Prvenir
    ELSE                                      ! Si la fentre a pu tre cre
      wind_open(INT{ADD(hwind%,SHL(index_de_fenetre&,1))},global_xf&,global_yf&,global_wf&,global_hf&)
    ENDIF
  ENDIF
RETURN
> PROCEDURE fermeture_fenetre(numero|)
  LOCAL xw&,yw&,ww&,hw&
  IF INT{ADD(hwind%,numero|)}>-1
    IF edit&
      CLR edit&
    ENDIF
    ~@wind_get(INT{ADD(hwind%,numero|)},wf_currxywh&,xw&,yw&,ww&,hw&)
    wind_close(INT{ADD(hwind%,numero|)})
    wind_delete(INT{ADD(hwind%,numero|)})
    INT{ADD(hwind%,numero|)}=-1
    IF avmx&<>-1 OR avmy&<>-1
      ' Enlever la souris
      set_input_mode(sample&)               ! Mode SAMPLE
      input_locator(avmx&,avmy&)            ! Positionner la souris
      set_input_mode(request&)              ! Retour en mode REQUEST
      ' Remettre la souris
      avmx&=-1
      avmy&=-1
    ENDIF
  ENDIF
RETURN
' ------------------------------------------------------------------------------
> PROCEDURE ecrire_donnees_dans_info
  '
  CHAR{{OB_SPEC(adr_info%,infomem&)}}=STR$(@memoire_dispo(0),9)
  IF GEMDOS(&H44,L:-1,W:0)<>-32       ! La fonction est elle accepte
    CHAR{{OB_SPEC(adr_info%,infomemt&)}}=STR$(@memoire_dispo(1),9)
  ELSE
    CHAR{{OB_SPEC(adr_info%,infomemt&)}}="ABSENTE "
  ENDIF
  '
RETURN
> PROCEDURE ecrire_donnees_dans_generale
  '
RETURN
> PROCEDURE ecrire_donnees_dans_auteur
  '
RETURN
' ************** Gestion des formulaires en fentre GEM ************************
> PROCEDURE gestion_information
  $S&,$S>
  SELECT objet&
  CASE infoauteur&
    objc_change(adr_info%,objet&)
    ouvrir_auteur
  CASE fininfo&
    objc_change(adr_info%,objet&)
    fermeture_fenetre(idx_info_dbl&)
  ENDSELECT
RETURN
PROCEDURE gestion_generale
  $S&,$S>
  SELECT objet&
    ' **************************************************************************
    ' ****    partie pour choisir le fichier  modifier                     ****
    ' **************************************************************************
  CASE onglet_config&
    objc_change(adr_generale%,objet&)
    gestion_onglets_generaux(objet&,TRUE)
    gestion_onglets_specifiques(objet&,onglet_global&,TRUE)
  CASE onglet_mint&
    objc_change(adr_generale%,objet&)
    gestion_onglets_generaux(objet&,TRUE)
    gestion_onglets_specifiques(objet&,0,TRUE)
  CASE onglet_myaes&
    objc_change(adr_generale%,objet&)
    gestion_onglets_generaux(objet&,TRUE)
    gestion_onglets_specifiques(objet&,0,TRUE)
    ' **************************************************************************
    ' ****    Sous partie pour CONFIG d'ARAnyM                              ****
    ' **************************************************************************
  CASE onglet_global&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE onglet_video&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE onglet_systeme&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE onglet_net_midi&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE onglet_boot&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE onglet_disques&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE onglet_nfvdi&
    objc_change(adr_generale%,objet&)
    gestion_onglets_specifiques(onglet_config&,objet&,TRUE)
  CASE find_config&,find_aranym&,find_floppy&,find_emutos&,find_tos&
    objc_change(adr_generale%,objet&)
    videsouris
  CASE active_floppy&,active_autogm&,active_grabm&
    objc_change(adr_generale%,objet&)
  ENDSELECT
RETURN
> PROCEDURE gestion_auteur
  $S&,$S>
  SELECT objet&
  CASE finauteur&
    objc_change(adr_auteur%,objet&)
    fermeture_fenetre(idx_auteur_dbl&)
  ENDSELECT
RETURN
' ******************************************************************************
> PROCEDURE gestion_onglets_generaux(onglet&,des!)
  ob_state(adr_generale%,onglet_config&,aes_selected&,onglet&=onglet_config&)
  ob_state(adr_generale%,onglet_mint&,aes_selected&,onglet&=onglet_mint&)
  ob_state(adr_generale%,onglet_myaes&,aes_selected&,onglet&=onglet_myaes&)
  '
  ob_flags(adr_generale%,sous_config&,aes_hidetree&,onglet&<>onglet_config&)
  ob_flags(adr_generale%,sous_mint&,aes_hidetree&,onglet&<>onglet_mint&)
  ob_flags(adr_generale%,sous_myaes&,aes_hidetree&,onglet&<>onglet_myaes&)
  '
  IF des!
    redraw_elem(adr_generale%,onglet_config&)
    redraw_elem(adr_generale%,onglet_mint&)
    redraw_elem(adr_generale%,onglet_myaes&)
    $S&,$S>
    SELECT onglet&
    CASE onglet_config&
      redraw_elem(adr_generale%,sous_config&)
    CASE onglet_config&
      redraw_elem(adr_generale%,sous_mint&)
    CASE onglet_config&
      redraw_elem(adr_generale%,sous_myaes&)
    ENDSELECT
  ENDIF
  '
RETURN
> PROCEDURE gestion_onglets_specifiques(onglet&,sousonglet&,des!)
  '
  $S&,$S>
  SELECT onglet&
  CASE onglet_config&
    ob_state(adr_generale%,onglet_global&,aes_selected&,sousonglet&=onglet_global&)
    ob_state(adr_generale%,onglet_video&,aes_selected&,sousonglet&=onglet_video&)
    ob_state(adr_generale%,onglet_systeme&,aes_selected&,sousonglet&=onglet_systeme&)
    ob_state(adr_generale%,onglet_net_midi&,aes_selected&,sousonglet&=onglet_net_midi&)
    ob_state(adr_generale%,onglet_boot&,aes_selected&,sousonglet&=onglet_boot&)
    ob_state(adr_generale%,onglet_disques&,aes_selected&,sousonglet&=onglet_disques&)
    ob_state(adr_generale%,onglet_nfvdi&,aes_selected&,sousonglet&=onglet_nfvdi&)
    '
    ob_flags(adr_generale%,sous_global&,aes_hidetree&,sousonglet&<>onglet_global&)
    ob_flags(adr_generale%,sous_video&,aes_hidetree&,sousonglet&<>onglet_video&)
    ob_flags(adr_generale%,sous_systeme&,aes_hidetree&,sousonglet&<>onglet_systeme&)
    ob_flags(adr_generale%,sous_net_midi&,aes_hidetree&,sousonglet&<>onglet_net_midi&)
    ob_flags(adr_generale%,sous_boot&,aes_hidetree&,sousonglet&<>onglet_boot&)
    ob_flags(adr_generale%,sous_disques&,aes_hidetree&,sousonglet&<>onglet_disques&)
    ob_flags(adr_generale%,sous_nfvdi&,aes_hidetree&,sousonglet&<>onglet_nfvdi&)
    IF des!
      redraw_elem(adr_generale%,sous_config&)
    ENDIF
  CASE onglet_mint&
    IF des!
      redraw_elem(adr_generale%,sous_mint&)
    ENDIF
  CASE onglet_myaes&
    IF des!
      redraw_elem(adr_generale%,sous_myaes&)
    ENDIF
  ENDSELECT
  '
RETURN
' ******************************************************************************
> FUNCTION saisie_d_un_nom(arb_adr%,edi&) ! Bon, on a besoin d'un nom l !
  LOCAL x&,y&,w&,h&,obje&,sortie!,ret!
  videsouris
  sortie!=FALSE
  objc_offset(arb_adr%,0,x&,y&)
  objc_offset(arb_adr%,edi&,obje&,y&)
  w&=OB_W(arb_adr%,0)
  IF PRED(ADD(obje&,OB_W(adr_saisie%,0)))=>PRED(ADD(x&,w&))
    x&=SUB(PRED(ADD(x&,w&)),OB_W(adr_saisie%,0))
  ELSE
    objc_offset(arb_adr%,edi&,x&,y&)
  ENDIF
  ADD x&,16
  x&=SHL(SHR(x&,4),4)
  objc_offset(arb_adr%,edi&,obje&,y&)
  OB_X(adr_saisie%,0)=x&
  OB_Y(adr_saisie%,0)=y&
  w&=OB_W(adr_saisie%,0)
  h&=OB_H(adr_saisie%,0)
  objc_draw(adr_saisie%,0,12,PRED(x&),PRED(y&),ADD(w&,2),ADD(h&,2),-1)
  videsouris
  DO
    obje&=@form_do(adr_saisie%,saisinom&)
    SELECT obje&
    CASE annsais&
      objc_change(adr_saisie%,obje&)
      ret!=FALSE
      sortie!=TRUE
    CASE valisais&
      objc_change(adr_saisie%,obje&)
      ret!=TRUE
      sortie!=TRUE
    ENDSELECT
  LOOP WHILE NOT sortie!
  objc_draw(arb_adr%,0,12,PRED(x&),PRED(y&),ADD(w&,2),ADD(h&,2),-1)
  IF ret!
    RETURN {OB_SPEC(adr_saisie%,saisinom&)}
  ELSE
    RETURN -1
  ENDIF
ENDFUNC
> PROCEDURE saisie_d_une_composante(arb_adr%,edi_&,mi,ma,lo&,vi&) ! Clavier
  LOCAL sortie!,ret!,val,x&,y&,w&,h&,x0&,y0&
  LOCAL evnt&,champ&,i_&
  videsouris
  sortie!=FALSE
  modifie_la_saisie(arb_adr%,edi_&,mi,ma,lo&,vi&,x&,y&,w&,h&)
  DO
    evnt&=@xform_do(&X110011,adr_saisie%,0)
    IF BTST(evnt&,0)                     ! EVENEMENT CLAVIER
      IF BYTE(key&)=&HD
        ' RETRUN ou ENTER
        objc_change(adr_saisie%,valisais&)
        ret!=TRUE
        sortie!=TRUE
      ELSE IF key&=&H6100
        ' UNDO
        objc_change(adr_saisie%,annsais&)
        ret!=FALSE
        sortie!=TRUE
        objc_change(adr_saisie%,annsais&)
      ELSE IF key&=&H5000                         ! Si flche vers le bas
        champ&=@next(arb_adr%,edi_&)              ! Chercher champ suivant
        ' S'il y en a un et qu'il n'est pas DISABLE
        IF champ&>-1
          IF NOT BTST(OB_STATE(arb_adr%,champ&),aes_disable&)
            IF mi<>ma
              val=VAL(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}})
              val=-val*(val>mi AND val<=ma)-mi*(val<=mi)-ma*(val>ma)
              CHAR{{OB_SPEC(arb_adr%,edi_&)}}=STR$(val,lo&,vi&)
            ELSE
              CHAR{{OB_SPEC(arb_adr%,edi_&)}}=LEFT$(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}}+SPACE$(lo&),lo&)
            ENDIF
            objc_draw(arb_adr%,0,12,x&,y&,w&,h&,-1)
            redraw_elem(arb_adr%,edi_&)
            edi_&=champ&
            nouveau_masque_de_saisie(arb_adr%,edi_&,mi,ma,lo&,vi&)
            modifie_la_saisie(arb_adr%,edi_&,mi,ma,lo&,vi&,x&,y&,w&,h&)
          ENDIF
        ENDIF
      ELSE IF key&=&H4800                         ! Si flche vers le bas
        champ&=@prev(arb_adr%,edi_&)              ! Chercher champ prcdent
        ' S'il y en a un et qu'il n'est pas DISABLE
        IF champ&>-1
          IF BTST(OB_STATE(arb_adr%,champ&),aes_disable&)=0
            IF mi<>ma
              val=VAL(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}})
              val=-val*(val>mi AND val<=ma)-mi*(val<=mi)-ma*(val>ma)
              CHAR{{OB_SPEC(arb_adr%,edi_&)}}=STR$(val,lo&,vi&)
            ELSE
              CHAR{{OB_SPEC(arb_adr%,edi_&)}}=LEFT$(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}}+SPACE$(lo&),lo&)
            ENDIF
            objc_draw(arb_adr%,0,12,x&,y&,w&,h&,-1)
            redraw_elem(arb_adr%,edi_&)
            edi_&=champ&
            nouveau_masque_de_saisie(arb_adr%,edi_&,mi,ma,lo&,vi&)
            modifie_la_saisie(arb_adr%,edi_&,mi,ma,lo&,vi&,x&,y&,w&,h&)
          ENDIF
        ENDIF
      ENDIF
      CLR evnt&
    ENDIF
    IF BTST(evnt&,1)                     ! EVENEMENT DE CLIC SOURIS
      $S&,$S>
      SELECT objet&
      CASE annsais&
        objc_change(adr_saisie%,objet&)
        ret!=FALSE
        sortie!=TRUE
      CASE valisais&
        objc_change(adr_saisie%,objet&)
        ret!=TRUE
        sortie!=TRUE
      ENDSELECT
      CLR evnt&
    ENDIF
  LOOP WHILE NOT sortie!
  IF edit&>0
    objc_edit(adr_saisie%,edit&,0,pos&,3,pos&)
    CLR edit&
  ENDIF
  ' IF LEN(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}})
  '  FOR i_&=1 TO LEN(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}})
  '  NEXT i_&
  ' ENDIF
  IF ret!
    IF mi<>ma
      val=VAL(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}})
      val=-val*(val>mi AND val<=ma)-mi*(val<=mi)-ma*(val>ma)
      CHAR{{OB_SPEC(arb_adr%,edi_&)}}=STR$(val,lo&,vi&)
    ELSE
      CHAR{{OB_SPEC(arb_adr%,edi_&)}}=LEFT$(CHAR{{OB_SPEC(adr_saisie%,saisinom&)}}+SPACE$(lo&),lo&)
    ENDIF
  ENDIF
  objc_draw(arb_adr%,0,12,x&,y&,w&,h&,-1)
  form_dial(3,x&,y&,w&,h&,x&,y&,w&,h&)
RETURN
> PROCEDURE nouveau_masque_de_saisie(arb_adr%,edi_&,VAR mi,ma,lo&,vi&)
  ' Avec : mi = Valeur minimum autorise
  '        ma = Valeur maximum autorise
  '        lo&= Longueur de la chaine totale en caractres
  '        vi&= Nombre de caractres aprs la virgule
  mi=0
  ma=0
  lo&=0
  vi&=0
  CLR lo&,vi&
  $S%,$S>
  SELECT arb_adr%
  CASE adr_bicubics%
    $S&,$S>
    SELECT edi_&
    CASE somx01&,somx02&,somx03&,somx04&,somy01&,somy02&,somy03&,somy04&,somz01&,somz02&,somz03&,somz04&
      mi=-999999999
      ma=999999999
      lo&=10
      vi&=3
    CASE somx05&,somx06&,somx07&,somx08&,somy05&,somy06&,somy07&,somy08&,somz05&,somz06&,somz07&,somz08&
      mi=-999999999
      ma=999999999
      lo&=10
      vi&=3
    CASE somx09&,somx10&,somx11&,somx12&,somy09&,somy10&,somy11&,somy12&,somz09&,somz10&,somz11&,somz12&
      mi=-999999999
      ma=999999999
      lo&=10
      vi&=3
    CASE somx13&,somx14&,somx15&,somx16&,somy13&,somy14&,somy15&,somy16&,somz13&,somz14&,somz15&,somz16&
      mi=-999999999
      ma=999999999
      lo&=10
      vi&=3
    ENDSELECT
  CASE adr_quadric%
    $S&,$S>
    SELECT edi_&
    CASE valquad0& TO valquad1&
      mi=-32768
      ma=32767
      lo&=9
      vi&=3
    ENDSELECT
  CASE adr_quartic%
    $S&,$S>
    SELECT edi_&
    CASE valquar0& TO valquar1&
      mi=-32768
      ma=32767
      lo&=9
      vi&=3
    ENDSELECT
  CASE adr_fonctions%
    $S&,$S>
    SELECT edi_&
    CASE blobtres&
      mi=0.00001
      ma=0.99999
      lo&=8
      vi&=5
    ENDSELECT
  CASE adr_vue_subjective%
    $S&,$S>
    SELECT edi_&
    CASE possubx&,possuby&,possubz&,subversx&,subversy&,subversz&
      mi=-32768
      ma=32767
      lo&=10
      vi&=3
    ENDSELECT
  CASE adr_copier%
    $S&,$S>
    SELECT edi_&
    CASE conombr&
      mi=1
      ma=9999
      lo&=4
    CASE comdistx&,comdisty&,comdistz&
      mi=-32768
      ma=32767
      lo&=9
      vi&=3
    CASE codegrex&,codegrey&,codegrez&
      mi=-180
      ma=180
      lo&=8
      vi&=3
    CASE coptauxx&,coptauxy&,coptauxz&
      mi=1
      ma=999
      lo&=3
      vi&=0
    CASE coalea0x&,coalea0y&,coalea0z&
      mi=0
      ma=100
      lo&=3
      vi&=0
    CASE coalea1x&,coalea1y&,coalea1z&
      mi=0
      ma=100
      lo&=3
      vi&=0
    CASE coalea2x&,coalea2y&,coalea2z&
      mi=0
      ma=100
      lo&=3
      vi&=0
    CASE coinitia&
      mi=0
      ma=999999999
      lo&=9
      vi&=0
    ENDSELECT
  CASE adr_calage%
    $S&,$S>
    SELECT edi_&
    CASE refx&,refy&,refz&
      mi=-32768
      ma=32767
      lo&=10
      vi&=3
    ENDSELECT
  CASE adr_parametres%
    $S&,$S>
    SELECT edi_&
    CASE def_x&,def_y&,def_z&
      mi=0.01
      ma=500
      lo&=7
      vi&=3
    CASE limites&
      mi=10
      ma=32767
      lo&=5
    CASE cheundo&
      ma=32767
      lo&=5
    CASE tailgril&
      mi=2
      ma=500
      lo&=3
    CASE consxpov&,consypov&
      ma=999
      lo&=3
    CASE chedetai&
      ma=100
      lo&=3
    ENDSELECT
  CASE adr_lanceur%
    $S&,$S>
    SELECT edi_&
    CASE povbuffe&
      ma=999999
      lo&=6
    CASE povslabs&
      mi=1
      ma=999
      lo&=3
    CASE povlarge&,povhaute&,cpovdebu&,cpovfin&,rpovdebu&,rpovfin&
      ma=32767
      lo&=5
    ENDSELECT
  CASE adr_lumieres%
    $S&,$S>
    SELECT edi_&
    CASE sourenx&,soureny&,sourenz&,viseenx&,viseeny&,viseenz&,surflarg&,surflong&
      mi=-32768
      ma=32767
      lo&=10
      vi&=3
    CASE surfrotx&,surfroty&
      mo=-180
      ma=180
      lo&=7
      vi&=2
    CASE surfadap&
      mi=-32768
      ma=32767
      lo&=6
    CASE radius&,falloff&
      mi=1
      ma=180
      lo&=3
    CASE filstigh&
      mi=0
      ma=100
      lo&=3
    ENDSELECT
  CASE adr_camera%
    $S&,$S>
    SELECT edi_&
    CASE poscamx&,poscamy&,poscamz&,posversx&,posversy&,posversz&,posfocax&,posfocay&,posfocaz&
      mi=-32768
      ma=32767
      lo&=10
      vi&=3
    CASE possampl&,posapert&
      mi=0
      ma=100
      lo&=3
      vi&=0
    CASE posangle&
      mi=-180
      ma=180
      lo&=8
      vi&=3
    CASE posobdeg&
      ma=180
      lo&=7
      vi&=3
    ENDSELECT
  CASE adr_modifier%
    $S&,$S>
    SELECT edi_&
    CASE modtora1&,modtora2&
      mi=-360
      ma=360
      lo&=4
    CASE modpx&,modpy&,modpz&
      mi=-32768
      ma=32767
      lo&=10
      vi&=3
    CASE modtx&,modty&,modtz&
      mi=0.001
      ma=65535
      lo&=9
      vi&=3
    CASE trisomx1&,trisomy1&,trisomz1&,trisomx2&,trisomy2&,trisomz2&,trisomx3&,trisomy3&,trisomz3&
      mi=-32768
      ma=32767
      lo&=10
      vi&=3
    CASE modthrbl&
      mi=0.00001
      ma=1
      lo&=8
      vi&=5
    CASE modforbl&
      mi=-1
      ma=1
      lo&=8
      vi&=5
    CASE modrx&,modry&,modrz&
      mi=-180
      ma=180
      lo&=8
      vi&=3
    ENDSELECT
  CASE adr_calques%
    $S&,$S>
    SELECT edi_&
    CASE calnom01& TO calnom10&
      lo&=12
    ENDSELECT
  ENDSELECT
RETURN
> PROCEDURE modifie_la_saisie(arb_adr%,edi_&,mi,ma,lo&,vi&,VAR x&,y&,w&,h&)
  LOCAL val,x0&,y0&
  IF mi<>ma
    val=VAL(CHAR{{OB_SPEC(arb_adr%,edi_&)}})
    CHAR{{OB_SPEC(adr_saisie%,saisinom&)}}=STR$(val,lo&,vi&)
  ELSE
    CHAR{{OB_SPEC(adr_saisie%,saisinom&)}}=TRIM$(LEFT$(CHAR{{OB_SPEC(arb_adr%,edi_&)}}+SPACE$(lo&),lo&))
  ENDIF
  objc_offset(arb_adr%,0,x&,y&)
  objc_offset(arb_adr%,edi_&,x0&,y0&)
  w&=OB_W(arb_adr%,0)
  h&=OB_H(arb_adr%,0)
  IF PRED(ADD(x0&,OB_W(adr_saisie%,0)))=>PRED(ADD(x&,w&))
    x&=SUB(PRED(ADD(x&,w&)),OB_W(adr_saisie%,0))
  ELSE
    objc_offset(arb_adr%,edi_&,x&,y0&)
  ENDIF
  x&=SHL(SHR(x&,4),4)
  IF PRED(ADD(y0&,OB_H(adr_saisie%,0)))=>PRED(ADD(y&,h&))
    y&=SUB(PRED(ADD(y&,h&)),OB_H(adr_saisie%,0))
  ELSE
    objc_offset(arb_adr%,edi_&,x0&,y&)
  ENDIF
  IF x&<0
    x&=0
  ENDIF
  IF y&<global_yb&
    y&=global_yb&
  ENDIF
  OB_X(adr_saisie%,0)=x&
  OB_Y(adr_saisie%,0)=y&
  w&=OB_W(adr_saisie%,0)
  h&=OB_H(adr_saisie%,0)
  ob_flags(adr_saisie%,saisinom&,aes_editable&,TRUE)
  form_dial(0,x&,y&,w&,h&,x&,y&,w&,h&)
  objc_draw(adr_saisie%,0,12,x&,y&,w&,h&,-1)
  edit&=saisinom&
  objc_edit(adr_saisie%,edit&,0,pos&,1,pos&)
RETURN
> PROCEDURE saisie_d_une_ligne(arb_adr%,edi&,bok&,min,max,lo&,vi&)  ! Clavier
  LOCAL obj&,sortie!,ret!,val
  IF vi&=0
    CHAR{{OB_SPEC(arb_adr%,edi&)}}=TRIM$(CHAR{{OB_SPEC(arb_adr%,edi&)}})
  ENDIF
  ob_flags(arb_adr%,bok&,aes_default&,FALSE)
  ob_flags(arb_adr%,edi&,aes_editable&,TRUE)
  ob_flags(arb_adr%,edi&,aes_default&,TRUE)
  sortie!=FALSE
  videsouris
  DO
    obj&=@form_do(arb_adr%,edi&)
    SELECT obj&
    CASE edi&
      objc_change(arb_adr%,obj&)
      sortie!=TRUE
    DEFAULT
      objc_change(arb_adr%,obj&)
    ENDSELECT
  LOOP WHILE NOT sortie!
  IF mi<>ma
    val=VAL(CHAR{{OB_SPEC(arb_adr%,edi&)}})
    val=-val*(val>mi AND val<=ma)-mi*(val<=mi)-ma*(val>ma)
    CHAR{{OB_SPEC(arb_adr%,edi&)}}=STR$(val,lo&,vi&)
  ELSE
    CHAR{{OB_SPEC(arb_adr%,edi&)}}=LEFT$(CHAR{{OB_SPEC(arb_adr%,edi&)}}+SPACE$(lo&),lo&)
  ENDIF
  objc_change(arb_adr%,edi&)
  ob_flags(arb_adr%,edi&,aes_default&,FALSE)
  ob_flags(arb_adr%,edi&,aes_editable&,FALSE)
  ob_flags(arb_adr%,bok&,aes_default&,TRUE)
  redraw_elem(arb_adr%,edi&)
RETURN
' ******************************************************************************
> PROCEDURE demarquer_les_menus
  ' ---- et les entres menus correspondantes
  ' menu_icheck(adr_menu%,mface&,0)
RETURN
> PROCEDURE marquer_les_menus
  '
  ' menu_ienable(adr_menu%,mface&,1)
RETURN
' ..............................................................................
> FUNCTION lire_une_ligne(b%)
  LOCAL lig%,f!,pos%
  lig%=b%
  DO
    BGET #1,lig%,1
    f!=EOF(#1)
    EXIT IF (BYTE{lig%}=13) OR (BYTE{lig%}=10) OR (f!=TRUE)
    INC lig%
  LOOP
  lig%=b%
  DO
    EXIT IF (BYTE{lig%}=13) OR (BYTE{lig%}=10) OR (BYTE{lig%}=35)
    INC lig%
  LOOP
  BYTE{lig%}=0
  pos%=PRED(LEN(CHAR{b%}))
  DO
    EXIT IF BYTE{ADD(b%,pos%)}<>&H20
    BYTE{ADD(b%,pos%)}=0
    DEC pos%
  LOOP
  RETURN f!
ENDFUNC
> PROCEDURE enleve_code(b%)                     ! On enlve les espaces en trop
  CHAR{b%}=RIGHT$(CHAR{b%},SUB(LEN(CHAR{b%}),3))
  b%=@enleve_caractere(b%,&H20)
RETURN
' ********************** Fonctions diverses et varies *************************
> FUNCTION afficher_alerte(message_d_alerte%)
  RETURN @form_alert(1,message_d_alerte%)
ENDFUNC
> FUNCTION arbre_ressource(n&)
  $S&,S>
  SELECT n&
  CASE 0
    RETURN adr_info%
  CASE 1
    RETURN adr_generale%
  CASE 2
    RETURN adr_auteur%
  DEFAULT
    RETURN adr_desk%
  ENDSELECT
ENDFUNC
> FUNCTION numero_fenetre(n&)
  LOCAL z&
  CLR z&
  DO
    IF INT{ADD(hwind%,SHL(z&,1))}=n&
      RETURN z&
    ENDIF
    INC z&
  LOOP WHILE z&<32
  RETURN -1
ENDFUNC
> FUNCTION enleve_caractere(l%,car|)
  LOCAL pos%,lon%
  IF l%<>0
    pos%=PRED(LEN(CHAR{l%}))
    DO
      EXIT IF BYTE{ADD(l%,pos%)}<>car|
      BYTE{ADD(l%,pos%)}=0
      DEC pos%
    LOOP
    lon%=LEN(CHAR{l%})
    DO
      EXIT IF BYTE{l%}<>car|
      BMOVE SUCC(l%),l%,PRED(lon%)
      BYTE{ADD(l%,PRED(lon%))}=0
      DEC lon%
    LOOP
  ENDIF
  RETURN l%
ENDFUNC
> FUNCTION lower(l%)
  LOCAL i&,l|
  IF LEN(CHAR{l%})
    CLR i&
    DO
      l|=BYTE{ADD(l%,i&)}
      IF l|=>65 AND l|<=90
        ADD l|,32
        BYTE{ADD(l%,i&)}=l|
      ENDIF
      INC i&
    LOOP WHILE i&<LEN(CHAR{l%})
  ENDIF
  RETURN l%
ENDFUNC
'
> PROCEDURE lire_une_alerte(b%)
  LOCAL lig%,f!,cpt&
  CLR cpt&
  lig%=b%
  DO
    BGET #1,lig%,1
    INC cpt&
    f!=EOF(#1)
    IF (BYTE{lig%}=13 OR BYTE{lig%}=10) AND cpt&=1
      BYTE{lig%}=0
      CLR cpt&
    ENDIF
    EXIT IF (BYTE{lig%}=13) OR (BYTE{lig%}=10) OR (f!=TRUE)
    IF cpt&>0
      INC lig%
    ENDIF
  LOOP
RETURN
> FUNCTION test_touche_morte(sg!,sd!,ct!,al!)
  ' Toutes les combinaison des quatres touches morte sont gres ici.
  ' Dans l'ordre : Shift Gauche, Shift Droit, Control et Alternate
  IF BTST(BIOS(&HB,-1),cl_shift_gauche&)=sg!
    IF BTST(BIOS(&HB,-1),cl_shift_droit&)=sd!
      IF BTST(BIOS(&HB,-1),cl_control&)=ct!
        IF BTST(BIOS(&HB,-1),cl_alternate&)=al!
          RETURN TRUE
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  RETURN FALSE
ENDFUNC
> PROCEDURE minuscule(nn%)
  IF multitache!
    CHAR{nn%}=CHAR{@lower(nn%)}+CHR$(0)
  ELSE
    CHAR{nn%}=UPPER$(CHAR{nn%})+CHR$(0)
  ENDIF
RETURN
' ************************ Le selecteur de fichiers GEM ************************
> PROCEDURE definition_fichier(adr_arb%,obj&,sel%,ind!,sel!,liin%)
  LOCAL obspec%
  '
  pdomain(1)
  '
  IF adr_arb%<>-1
    ' Extraire le disque du chemin spcifi
    CHAR{disque%}=LEFT$(CHAR{{OB_SPEC(adr_arb%,obj&)}},2)+CHR$(0)
    minuscule(disque%)
    ' Extraire le chemin proprement dit
    membfill(path%,272,0)
    obspec%=OB_SPEC(adr_arb%,obj&)
    CHAR{path%}=RIGHT$(LEFT$(CHAR{{obspec%}},RINSTR(CHAR{{obspec%}},"\")),SUB(LEN(LEFT$(CHAR{{obspec%}},RINSTR(CHAR{{obspec%}},"\"))),2))+CHR$(0)
    minuscule(path%)
    ' Si dsir, extraire le nom du fichier
    IF ind!
      IF LEN(CHAR{path%})>1
        CHAR{sel%}=MID$(CHAR{{obspec%}},SUCC(RINSTR(CHAR{{obspec%}},"\")),LEN(LEFT$(CHAR{{obspec%}},RINSTR(CHAR{{obspec%}},"\"))))+CHR$(0)
      ELSE
        CHAR{sel%}=RIGHT$(CHAR{{obspec%}},SUB(LEN(CHAR{{obspec%}}),3))+CHR$(0)
      ENDIF
      IF INSTR(CHAR{sel%},".")
        CHAR{masque%}=RIGHT$(CHAR{sel%},SUB(LEN(CHAR{sel%}),INSTR(CHAR{sel%},".")))+CHR$(0)
      ENDIF
    ENDIF
  ENDIF
  minuscule(sel%)
  minuscule(masque%)
  minuscule(msq%)
  extend(sel%,masque%,sel%)
  IF sel!
    IF magic! AND (INSTR(CHAR{sel%},".")=0)     ! Allez, les nom longs de MagiC!
      fslx_do(sel%,liin%)
    ELSE
      IF INT{ADD({ADD(GB,4)},0)}<&H140          ! Ancien GEM/TOS...
        @selecteur(sel%)
      ELSE                                      ! Sinon le nouveau selecteur
        IF liin%<>-1
          @xselecteur(sel%,liin%)
        ELSE
          @selecteur(sel%)
        ENDIF
      ENDIF
      IF CHAR{masque%}<>"*"
        extend(sel%,masque%,sel%)
      ENDIF
    ENDIF
  ENDIF
  minuscule(sel%)
  minuscule(masque%)
  minuscule(msq%)
  minuscule(disque%)
  minuscule(path%)
RETURN
> PROCEDURE selecteur(sel%)
  '
  CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+"*."+CHAR{masque%}+CHR$(0)
  '
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=2
  INT{ADD(GCONTRL,6)}=2
  INT{ADD(GCONTRL,8)}=0
  '
  {ADDRIN}=mem_che%
  {ADD(ADDRIN,4)}=sel%
  '
  GEMSYS 90
  '
  IF INT{ADD(GINTOUT,2)}=1
    CHAR{disque%}=LEFT$(CHAR{mem_che%},2)
    CHAR{path%}=RIGHT$(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\")),SUB(LEN(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\"))),2))+CHR$(0)
  ELSE
    membfill(sel%,LEN(CHAR{sel%}),0)
  ENDIF
  '
RETURN
> PROCEDURE xselecteur(sel%,liin%)
  '
  CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+"*."+CHAR{masque%}+CHR$(0)
  '
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=2
  INT{ADD(GCONTRL,6)}=3
  INT{ADD(GCONTRL,8)}=0
  '
  {ADDRIN}=mem_che%           ! Chemin
  {ADD(ADDRIN,4)}=sel%        ! Nom du fichier
  {ADD(ADDRIN,8)}=liin%       ! Texte d'information
  '
  GEMSYS &H5B
  '
  IF INT{ADD(GINTOUT,2)}=1
    CHAR{disque%}=LEFT$(CHAR{mem_che%},2)
    CHAR{path%}=RIGHT$(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\")),SUB(LEN(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\"))),2))+CHR$(0)
  ELSE
    membfill(sel%,LEN(CHAR{sel%}),0)
  ENDIF
  '
RETURN
> PROCEDURE fslx_do(sel%,liin%)
  LOCAL t%,fsd%
  ' Nouvelle fonction de slecteur de fichier pour MagiC! et les noms longs
  ' tir des travaux de Pierre THONTAT (Rajha LONE de QUEEN MEKA, merci  lui).
  '
  IF CHAR{path%}=""
    CHAR{tr_tmp%}=CHAR{disque%}+"\"+CHR$(0)
    CHAR{mem_che%}=CHAR{disque%}+"\"+CHR$(0)+CHR$(0)
  ELSE
    CHAR{tr_tmp%}=CHAR{disque%}+CHAR{path%}+CHR$(0)
    CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+CHR$(0)+CHR$(0)
  ENDIF
  IF CHAR{path_systeme%}=""
    CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+CHAR{disque_systeme%}+"\"+CHR$(0)
  ELSE
    CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+CHAR{disque_systeme%}+CHAR{path_systeme%}+CHR$(0)
  ENDIF
  CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"u:\"+CHR$(0)+CHR$(0)
  ' CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"u:\bin\"+CHR$(0)
  ' CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"u:\dev\"+CHR$(0)
  ' CHAR{tr_tmp%}=CHAR{tr_tmp%}+CHR$(0)+"c:\clipbrd\"+CHR$(0)+CHR$(0)
  '
  CHAR{masque%}="*"+CHR$(0)+"*."+CHAR{masque%}+CHR$(0)+CHR$(0)
  '
  ' tr_tmp% est une chaine se terminant par deux octets NULL.
  ' avec tout ses paramtres
  INT{ADD(GCONTRL,2)}=4         ! Nombre d'entres dans GINTIN
  INT{ADD(GCONTRL,4)}=4         ! Nombre d'entres dans GINTOUT
  INT{ADD(GCONTRL,6)}=6         ! Nombre d'entres dans ADDRIN
  INT{ADD(GCONTRL,8)}=2         ! Nombre d'entres dans ADDROUT
  '
  INT{GINTIN}=128               ! longueur du chemin dans le slecteur
  INT{ADD(GINTIN,2)}=33         ! longueur nom de fichier dans le du slecteur
  INT{ADD(GINTIN,4)}=0          ! Type de tri (0 = par nom)
  INT{ADD(GINTIN,6)}=8          ! Flags (8 = GETMULTI)
  '
  {ADDRIN}=liin%                ! titre de la boite
  {ADD(ADDRIN,4)}=mem_che%      ! nom du chemin
  {ADD(ADDRIN,8)}=sel%          ! nom du fichier sans le chemin
  {ADD(ADDRIN,12)}=masque%      ! masques possibles
  {ADD(ADDRIN,16)}=0            ! Filtre
  {ADD(ADDRIN,20)}=tr_tmp%      ! chemins par dfaut
  '
  GEMSYS &HC2                   ! L, c'est en fait un fslx_do()
  '
  fsd%={ADDROUT}                ! on rcupre un identificateur qui
  '                               pour fermer le slecteur (c'est un handle)
  IF INT{ADD(GINTOUT,2)}=1      ! si l'appel a march
    '                   on rcupre le nom de fichier, le disque et le chemin
    CHAR{disque%}=LEFT$(CHAR{mem_che%},2)+CHR$(0)
    CHAR{path%}=RIGHT$(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\")),SUB(LEN(LEFT$(CHAR{mem_che%},RINSTR(CHAR{mem_che%},"\"))),2))+CHR$(0)
  ELSE
    '                   Sinon, on vide le nom de fichier
    BYTE{sel%}=0
  ENDIF
  '
  IF INT{GINTOUT}               ! on referme proprement l'appel
    INT{ADD(GCONTRL,2)}=0
    INT{ADD(GCONTRL,4)}=1
    INT{ADD(GCONTRL,6)}=1
    INT{ADD(GCONTRL,8)}=0
    '
    {ADDRIN}=fsd%
    '
    GEMSYS &HBF                 ! L, c'est en fait un fslx_close()
  ENDIF
  '
RETURN
> PROCEDURE pdomain(pdomain&)
  IF multitache!
    ~GEMDOS(&H119,W:pdomain&)
  ENDIF
RETURN
' ************ Vrification des extensions et cration des backups *************
> PROCEDURE extend(pr%,ex%,VAR ps%)
  LOCAL nl%,dn%,i&,j&
  IF (INSTR(CHAR{pr%},".")=0 AND LEN(CHAR{pr%})<9) OR (INSTR(CHAR{pr%},".")<>0)
    dn%=@prendre(272,TRUE,3)
    IF INSTR(CHAR{pr%},".")=0 AND LEN(CHAR{pr%})>0
      i&=LEN(CHAR{pr%})
      BYTE{ADD(pr%,i&)}=ASC(".")
      FOR j&=SUCC(i&) TO ADD(i&,3)
        BYTE{ADD(pr%,j&)}=BYTE{ADD(ex%,SUB(j&,SUCC(i&)))}
      NEXT j&
    ENDIF
    IF RIGHT$(CHAR{pr%})<>"\" AND RIGHT$(CHAR{pr%},5)<>"\."+CHAR{ex%} AND CHAR{pr%}>""
      FOR i&=LEN(CHAR{pr%}) DOWNTO 1
        EXIT IF BYTE{ADD(pr%,i&)}=92
        INC nl%
      NEXT i&
      CHAR{dn%}=RIGHT$(CHAR{pr%},nl%)
      IF INSTR(CHAR{dn%},".")=0
        CHAR{ps%}=CHAR{pr%}+"."+CHAR{ex%}+CHR$(0)
        CHAR{dn%}=CHAR{dn%}+"."+CHAR{ex%}+CHR$(0)
      ENDIF
      IF RIGHT$(CHAR{dn%},4)<>"."+CHAR{ex%}
        IF LEFT$(CHAR{dn%},2)<>"\."
          CHAR{ps%}=LEFT$(CHAR{pr%},LEN(CHAR{pr%})-nl%)+LEFT$(CHAR{dn%},INSTR(CHAR{dn%},"."))+CHAR{ex%}+CHR$(0)
        ELSE
          membfill(ps%,LEN(CHAR{ps%}),0)
        ENDIF
      ELSE
        CHAR{ps%}=LEFT$(CHAR{pr%},LEN(CHAR{pr%})-nl%)+CHAR{dn%}+CHR$(0)
      ENDIF
    ELSE
      membfill(ps%,LEN(CHAR{ps%}),0)
    ENDIF
    libere(*dn%)
  ENDIF
  minuscule(ps%)
RETURN
> PROCEDURE backup(pr%)
  LOCAL xn%
  ' ---- On commence par crer le masque de sauvegarde par remplacement de la
  ' ---- dernire lettre par un K...
  BMOVE masque%,msq%,4
  BYTE{ADD(msq%,2)}=&H4B
  minuscule(msq%)
  '
  xn%=@prendre(272,TRUE,3)
  IF @s_exist(pr%) AND backup!=TRUE
    extend(pr%,msq%,xn%)
    IF CHAR{xn%}<>""
      IF @s_exist(xn%)
        ~GEMDOS(&H41,L:xn%)
      ENDIF
      ~GEMDOS(&H56,L:pr%,L:xn%)
    ENDIF
  ENDIF
  libere(*xn%)
RETURN
' ******************************************************************************
' ****                                                                      ****
' ****       Procdures des fonctions VDI par appels rels de la VDI        ****
' ****                                                                      ****
' ******************************************************************************
' ******************************************************************************
> PROCEDURE line(px&,py&,ox&,oy&)
  INT{emu_xten%}=px&
  INT{ADD(emu_xten%,2)}=py&
  INT{ADD(emu_xten%,4)}=ox&
  INT{ADD(emu_xten%,6)}=oy&
  polyline(1)
RETURN
> PROCEDURE box(px&,py&,ox&,oy&)
  INT{emu_xten%}=px&
  INT{ADD(emu_xten%,2)}=py&
  INT{ADD(emu_xten%,4)}=ox&
  INT{ADD(emu_xten%,6)}=py&
  INT{ADD(emu_xten%,8)}=ox&
  INT{ADD(emu_xten%,10)}=oy&
  INT{ADD(emu_xten%,12)}=px&
  INT{ADD(emu_xten%,14)}=oy&
  INT{ADD(emu_xten%,16)}=px&
  INT{ADD(emu_xten%,18)}=py&
  polyline(4)
RETURN
> PROCEDURE pbox(px&,py&,ox&,oy&)
  INT{emu_xten%}=px&
  INT{ADD(emu_xten%,2)}=py&
  INT{ADD(emu_xten%,4)}=ox&
  INT{ADD(emu_xten%,6)}=py&
  INT{ADD(emu_xten%,8)}=ox&
  INT{ADD(emu_xten%,10)}=oy&
  INT{ADD(emu_xten%,12)}=px&
  INT{ADD(emu_xten%,14)}=oy&
  INT{ADD(emu_xten%,16)}=px&
  INT{ADD(emu_xten%,18)}=py&
  filled_aera(4)
RETURN
' *****************  Procdure de paramtrage de trac (lignes & motifs)  ******
> PROCEDURE set_type_de_ligne(c&,e&,t&,sd&,sf&,user%)
  LOCAL r&,v&,b&
  IF true_color!
    inquire_color_representation(c&,r&,v&,b&,vdihandle%)
    set_color_representation(254,r&,v&,b&,vdihandle%)
    set_polyline_color_index(254)
  ELSE
    set_polyline_color_index(c&)
  ENDIF
  IF t&=7
    set_user_defined_line_style_pattern(-user%)
    set_polyline_line_witdh(e&)
    set_polyline_type(t&)
    set_polyline_end_styles(sd&,sf&)
  ELSE
    set_polyline_line_witdh(e&)
    set_polyline_type(t&)
    set_polyline_end_styles(sd&,sf&)
  ENDIF
RETURN
> PROCEDURE set_remplissage(t&,m&,c&,adr%)
  LOCAL r&,v&,b&
  IF t&=4 AND adr%>0
    set_fill_interior_style(t&)
    set_user_defined_fill_pattern(adr%)
  ELSE
    IF t&>-1
      set_fill_interior_style(t&)
    ENDIF
    IF m&>-1
      set_fill_style_index(m&)
    ENDIF
  ENDIF
  IF c&>-1
    IF true_color!
      inquire_color_representation(c&,r&,v&,b&,vdihandle%)
      set_color_representation(254,r&,v&,b&,vdihandle%)
      set_fill_color_index(254)
    ELSE
      set_fill_color_index(c&)
    ENDIF
  ENDIF
RETURN
> PROCEDURE set_text_mode(col&,atr&,ang&,hau&,fon&,hand%)
  LOCAL r&,v&,b&
  IF true_color!
    inquire_color_representation(col&,r&,v&,b&,hand%)
    set_color_representation(254,r&,v&,b&,hand%)
    set_graphic_text_color_index(254,hand%)
  ELSE
    set_graphic_text_color_index(col&,hand%)
  ENDIF
  set_graphic_text_special_effects(atr&,hand%)
  set_character_baseline_vector(ang&)
  set_text_face(fon&,hand%)
  set_character_height(hau&,hand%)
RETURN
' ************************ Sous procdure utilisant la VDI  ********************
> PROCEDURE clear_workstation                                     ! VDI 3
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  VDISYS 3
RETURN
> PROCEDURE update_workstation                                    ! VDI 4
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  VDISYS 4
RETURN
> PROCEDURE polyline(nb&)                                         ! VDI 6
  INT{ADD(CONTRL,2)}=SUCC(nb&)
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  bmove(emu_xten%,PTSIN,SHL(SUCC(nb&),2))
  VDISYS 6
RETURN
> PROCEDURE polymarker(nb&)                                       ! VDI 7
  INT{ADD(CONTRL,2)}=SUCC(nb&)
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  bmove(emu_xten%,PTSIN,SHL(SUCC(nb&),2))
  VDISYS 7
RETURN
> PROCEDURE text(px%,py%,t%)                                      ! VDI 8
  LOCAL i&
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=LEN(CHAR{t%})
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{PTSIN}=px%
  INT{ADD(PTSIN,2)}=py%
  CLR i&
  DO
    INT{ADD(INTIN,SHL(i&,1))}=BYTE{ADD(t%,i&)}
    INC i&
  LOOP WHILE i&<LEN(CHAR{t%})
  VDISYS 8
RETURN
> PROCEDURE filled_aera(nb&)                                      ! VDI 9
  INT{ADD(CONTRL,2)}=SUCC(nb&)
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  bmove(emu_xten%,PTSIN,SHL(SUCC(nb&),2))
  VDISYS 9
RETURN
> PROCEDURE vdi_11(fnct|,cx&,cy&,ox&,oy&,rayx&,rayy&,ang0&,ang1&) ! VDI 11
  INT{ADD(CONTRL,2)}=2
  INT{ADD(CONTRL,10)}=fnct|
  INT{ADD(CONTRL,12)}=vdihandle%
  $S|,$S>
  SELECT fnct|
  CASE 1,8,9            ! Bar, Rounded rectangle, Filled rounded rectangle
    INT{ADD(CONTRL,6)}=0
    INT{PTSIN}=cx&
    INT{ADD(PTSIN,2)}=cy&
    INT{ADD(PTSIN,4)}=ox&
    INT{ADD(PTSIN,6)}=oy&
  CASE 5                ! Ellipse
    INT{ADD(CONTRL,6)}=0
    INT{PTSIN}=cx&
    INT{ADD(PTSIN,2)}=cy&
    INT{ADD(PTSIN,4)}=rayx&
    INT{ADD(PTSIN,6)}=rayy&
  CASE 6,7              ! Elliptical arc, Elliptical pie
    INT{ADD(CONTRL,6)}=2
    INT{INTIN}=ang0&
    INT{ADD(INTIN,2)}=ang1&
    INT{PTSIN}=cx&
    INT{ADD(PTSIN,2)}=cy&
    INT{ADD(PTSIN,4)}=rayx&
    INT{ADD(PTSIN,6)}=rayy&
  ENDSELECT
  VDISYS 11
RETURN
> PROCEDURE set_character_height(h_d_t&,hand%)                    ! VDI 12
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=hand%
  INT{PTSIN}=0
  INT{ADD(PTSIN,2)}=h_d_t&
  VDISYS 12
RETURN
> PROCEDURE set_character_baseline_vector(a_d_t&)                 ! VDI 13
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=a_d_t&
  VDISYS 13
RETURN
> PROCEDURE set_color_representation(index&,r&,v&,b&,hand%)       ! VDI 14
  '  set_color_representation Fonction 14 de la VDI
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=4
  INT{ADD(CONTRL,12)}=hand%
  INT{INTIN}=index&
  INT{ADD(INTIN,2)}=r&
  INT{ADD(INTIN,4)}=v&
  INT{ADD(INTIN,6)}=b&
  VDISYS 14
RETURN
> PROCEDURE set_polyline_type(t_d_l%)                             ! VDI 15
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=t_d_l%
  VDISYS 15
RETURN
> PROCEDURE set_polyline_line_witdh(l_d_l&)                       ! VDI 16
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{PTSIN}=l_d_l&
  INT{ADD(PTSIN,2)}=0
  VDISYS 16
RETURN
> PROCEDURE set_polyline_color_index(c_d_l&)                      ! VDI 17
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=c_d_l&
  VDISYS 17
RETURN
> PROCEDURE set_polymarker_type(c_d_m&)                           ! VDI 18
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=c_d_m&
  VDISYS 18
RETURN
> PROCEDURE set_polymarker_height(c_d_m&)                         ! VDI 19
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{PTSIN}=0
  INT{ADD(PTSIN,2)}=c_d_m&
  VDISYS 19
RETURN
> PROCEDURE set_polymarker_color_index(c_d_m&)                    ! VDI 20
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=c_d_m&
  VDISYS 20
RETURN
> PROCEDURE set_text_face(f_d_t&,hand%)                           ! VDI 21
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=hand%
  INT{INTIN}=f_d_t&
  VDISYS 21
RETURN
> PROCEDURE set_graphic_text_color_index(c_d_t&,hand%)            ! VDI 22
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=hand%
  INT{INTIN}=c_d_t&
  VDISYS 22
RETURN
> PROCEDURE set_fill_interior_style(s_d_r|)                       ! VDI 23
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=s_d_r|
  VDISYS 23
RETURN
> PROCEDURE set_fill_style_index(i_d_r|)                          ! VDI 24
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=i_d_r|
  VDISYS 24
RETURN
> PROCEDURE set_fill_color_index(c_d_r&)                          ! VDI 25
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=c_d_r&
  VDISYS 25
RETURN
> PROCEDURE inquire_color_representation(index&,VAR r&,v&,b&,hand%) ! VDI 26
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=2
  INT{ADD(CONTRL,12)}=hand%
  INT{INTIN}=index&
  INT{ADD(INTIN,2)}=0        ! 0=couleurs dfinies 1=composition physique
  '                                                   effectivement ralis
  VDISYS 26
  r&=INT{ADD(INTOUT,2)}
  v&=INT{ADD(INTOUT,4)}
  b&=INT{ADD(INTOUT,6)}
RETURN
> PROCEDURE input_locator(mx&,my&)                                ! VDI 28
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{PTSIN}=mx&
  INT{ADD(PTSIN,2)}=my&
  VDISYS 28
RETURN
> PROCEDURE set_writing_mode(mode_de_dessin|)                     ! VDI 32
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=mode_de_dessin|
  VDISYS 32
RETURN
> PROCEDURE set_input_mode(mode&)                                 ! VDI 33
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=2
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=1                          ! Mode 'LOCATOR' (la souris quoi !)
  INT{ADD(INTIN,2)}=mode&
  VDISYS 33
RETURN
> PROCEDURE set_graphic_text_alignment(p_h&,p_v&,hand%)           ! VDI 39
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=2
  INT{ADD(CONTRL,12)}=hand%
  INT{INTIN}=p_h&
  INT{ADD(INTIN,2)}=p_v&
  VDISYS 39
RETURN
> PROCEDURE open_virtuel_screen_workstation(ncndc|)               ! VDI 100
  LOCAL nb&,i&
  INT{ADD(CONTRL,2)}=0         ! Longueur du tableau PTSIN
  INT{ADD(CONTRL,6)}=11        ! Longueur du tableau INTIN
  ' Ren DEPEINT  cherch sur son TT pourquoi cela ne fonctionnait pas
  ' avec sa carte MATRIX. Aprs pas mal de temps, il a fini par dcouvrir
  ' que le driver de la carte avait besoin d'une valeur dans CONTRL(6)
  ' Pour tre propre, nous allons donc y placer l'AP_ID de l'application.
  ' Et ben non. Pierre THONTAT  trouv dans le COMPENDIUM ce qu'il fallait
  ' mettre  cet endroit. C'est en fait la valeur retourne par GRAF_HANDLE;
  INT{ADD(CONTRL,12)}=@graf_handle(i&,i&,i&,i&)
  ' Merci  Ren et  Pierre...
  INT{INTIN}=1                 ! Numro ID du priphrique physique (cran)
  INT{ADD(INTIN,2)}=1          ! Type de ligne
  INT{ADD(INTIN,4)}=1          ! Index de couleur Polyline
  INT{ADD(INTIN,6)}=1          ! Type de marqueur
  INT{ADD(INTIN,8)}=1          ! Index de couleur Polymarker
  INT{ADD(INTIN,10)}=1         ! Fonte de caractres
  INT{ADD(INTIN,12)}=1         ! Index couleur texte
  INT{ADD(INTIN,14)}=1         ! Fill interior Style
  INT{ADD(INTIN,16)}=1         ! Fill style index
  INT{ADD(INTIN,18)}=1         ! Fill index couleur
  INT{ADD(INTIN,20)}=ncndc|    ! Flag coordonnes NDC ou RC
  VDISYS 100
  nb&=INT{ADD(CONTRL,8)}
  vdihandle%=INT{ADD(CONTRL,12)}
  station%=@prendre(SHL(nb&,1),FALSE,3)
  CLR i&
  DO
    INT{ADD(station%,SHL(i&,1))}=INT{ADD(INTOUT,MUL(i&,2))}
    INC i&
  LOOP WHILE i&<nb&
RETURN
> FUNCTION open_virtuel_screen_workstation(ncndc|)                ! VDI 100
  INT{ADD(CONTRL,2)}=0         ! Longueur du tableau PTSIN
  INT{ADD(CONTRL,6)}=11        ! Longueur du tableau INTIN
  INT{ADD(CONTRL,12)}=@graf_handle(i&,i&,i&,i&)
  INT{INTIN}=1                 ! Numro ID du priphrique physique (cran)
  INT{ADD(INTIN,2)}=1          ! Type de ligne
  INT{ADD(INTIN,4)}=1          ! Index de couleur Polyline
  INT{ADD(INTIN,6)}=1          ! Type de marqueur
  INT{ADD(INTIN,8)}=1          ! Index de couleur Polymarker
  INT{ADD(INTIN,10)}=1         ! Fonte de caractres
  INT{ADD(INTIN,12)}=1         ! Index couleur texte
  INT{ADD(INTIN,14)}=1         ! Fill interior Style
  INT{ADD(INTIN,16)}=1         ! Fill style index
  INT{ADD(INTIN,18)}=1         ! Fill index couleur
  INT{ADD(INTIN,20)}=ncndc|    ! Flag coordonnes NDC ou RC
  VDISYS 100
  RETURN INT{ADD(CONTRL,12)}
ENDFUNC
> PROCEDURE close_virtual_screen_workstation(hand%)               ! VDI 101
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=hand%
  VDISYS 101
RETURN
> PROCEDURE extended_inquire_function                             ! VDI 102
  LOCAL nb&,i&
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=1         ! Information tendues sur la station
  VDISYS 102
  nb&=INT{ADD(CONTRL,8)}
  etendue%=@prendre(SHL(nb&,1),FALSE,3)
  CLR i&
  DO
    INT{ADD(etendue%,SHL(i&,1))}=INT{ADD(INTOUT,SHL(i&,1))}
    INC i&
  LOOP WHILE i&<nb&
RETURN
> PROCEDURE contour_fill(px%,py%)                                 ! VDI 103
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=-1
  INT{PTSIN}=px%
  INT{ADD(PTSIN,2)}=py%
  VDISYS 103
RETURN
> PROCEDURE set_fill_perimeter_visibility(p_v&)                   ! VDI 104
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=p_v&
  VDISYS 104
RETURN
> PROCEDURE get_pixel(cx&,cy&,VAR pixel&,index&)                  ! VDI 105
  INT{ADD(CONTRL,2)}=1
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{PTSIN}=cx&
  INT{ADD(PTSIN,2)}=cy&
  VDISYS 105
  pixel&=INT{INTOUT}
  index&=INT{ADD(INTOUT,2)}
RETURN
> PROCEDURE set_graphic_text_special_effects(e_d_t&,hand%)        ! VDI 106
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=hand%
  INT{INTIN}=e_d_t&
  VDISYS 106
RETURN
> PROCEDURE set_character_cell_height_point_mode(e_d_t&)          ! VDI 107
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=e_d_t&
  VDISYS 107
RETURN
> PROCEDURE set_polyline_end_styles(d_d_l&,f_d_l&)                ! VDI 108
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=2
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=d_d_l&
  INT{ADD(INTIN,2)}=f_d_l&
  VDISYS 108
RETURN
'                                                                   VDI 109
> PROCEDURE copy_raster_opaque(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x12&,y12&,x21&,y21&,x22&,y22&,mod|)
  ' Fonction VDI N 109 (COPY RASTER, OPAQUE)
  ' Copie de raster de mme nombre de plans
  ' Dfinition du bloc raster source (MFDB):
  graf_mouse(m_off&,0)
  {mfdb%}=s%                              ! Adresse de la mmoire SOURCE
  IF s%<>0                                ! L'cran, C'est au GEM de bosser
    INT{ADD(mfdb%,4)}=sl&                 ! Largeur en points du raster entier
    INT{ADD(mfdb%,6)}=sh&                 ! Hauteur en points du raster entier
    INT{ADD(mfdb%,8)}=SHR(ADD(sl&,15),4)  ! Largeur en mots du raster entier
    IF mode_entrelace!
      INT{ADD(mfdb%,10)}=1                ! flag standart (conscutif)
    ELSE
      INT{ADD(mfdb%,10)}=-1*(sp&=1)       ! flag standart (consqutif en mono)
    ENDIF                                 ! ou spcifique (entrelac en couleur)
    INT{ADD(mfdb%,12)}=sp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  ' Dfinition du bloc raster cible (MFBD):
  {mfbd%}=d%                              ! Adresse de la mmoire SOURCE
  IF d%<>0                                ! L'cran, C'est au GEM de bosser
    INT{ADD(mfbd%,4)}=dl&                 ! Largeur en points du raster entier
    INT{ADD(mfbd%,6)}=dh&                 ! Hauteur en points du raster entier
    INT{ADD(mfbd%,8)}=SHR(ADD(dl&,15),4)  ! Largeur en mots du raster entier
    IF mode_entrelace!
      INT{ADD(mfbd%,10)}=1                ! flag standart (conscutif)
    ELSE
      INT{ADD(mfbd%,10)}=-1*(dp&=1)       ! flag standart (consqutif en mono)
    ENDIF                                 ! ou spcifique (entrelac en couleur)
    INT{ADD(mfbd%,12)}=dp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  INT{ADD(CONTRL,2)}=4
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  {ADD(CONTRL,14)}=mfdb%
  {ADD(CONTRL,18)}=mfbd%
  INT{INTIN}=mod|                         ! Mode de copie de 0  15
  '
  INT{PTSIN}=x11&                         ! X en haut  gauche source
  INT{ADD(PTSIN,2)}=y11&                  ! Y en haut  gauche source
  INT{ADD(PTSIN,4)}=x12&                  ! X en bas  droite source
  INT{ADD(PTSIN,6)}=y12&                  ! Y en bas  droite source
  INT{ADD(PTSIN,8)}=x21&                  ! X en haut  gauche destination
  INT{ADD(PTSIN,10)}=y21&                 ! Y en haut  gauche destination
  INT{ADD(PTSIN,12)}=x22&                 ! X en bas  droite destination
  INT{ADD(PTSIN,14)}=y22&                 ! Y en bas  droite destination
  VDISYS 109
  graf_mouse(m_on&,0)
  '
RETURN
> PROCEDURE transform_form(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&)         ! VDI 110
  ' Fonction VDI N 110 (TRANSFORM FORM)
  ' Copie de raster standard vers raster spcifique
  ' Dfinition du bloc raster source (MFDB):
  {mfdb%}=s%                              ! Adresse de la mmoire SOURCE
  IF s%<>0                                ! L'cran, C'est au GEM de bosser
    INT{ADD(mfdb%,4)}=sl&                 ! Largeur en points du raster entier
    INT{ADD(mfdb%,6)}=sh&                 ! Hauteur en points du raster entier
    INT{ADD(mfdb%,8)}=SHR(ADD(sl&,15),4)  ! Largeur en mots du raster entier
    IF mode_entrelace!
      INT{ADD(mfdb%,10)}=1                ! flag standart (conscutif)
    ELSE
      INT{ADD(mfdb%,10)}=-1*(sp&=1)       ! flag standart (consqutif en mono)
    ENDIF
    INT{ADD(mfdb%,12)}=sp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  ' Dfinition du bloc raster cible (MFBD):
  {mfbd%}=d%                              ! Adresse de la mmoire SOURCE
  IF d%<>0                                ! L'cran, C'est au GEM de bosser
    INT{ADD(mfbd%,4)}=dl&                 ! Largeur en points du raster entier
    INT{ADD(mfbd%,6)}=dh&                 ! Hauteur en points du raster entier
    INT{ADD(mfbd%,8)}=SHR(ADD(dl&,15),4)  ! Largeur en mots du raster entier
    IF mode_entrelace!
      INT{ADD(mfbd%,10)}=1                ! flag standart (conscutif)
    ELSE
      INT{ADD(mfbd%,10)}=-1*(dp&=1)       ! flag standart (consqutif en mono)
    ENDIF
    INT{ADD(mfbd%,12)}=dp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  {ADD(CONTRL,14)}=mfdb%
  {ADD(CONTRL,18)}=mfbd%
  VDISYS 110
  '
RETURN
> PROCEDURE set_mouse_form(p_h&)                                  ! VDI 111
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=37
  INT{ADD(CONTRL,12)}=vdihandle%
  bmove(ADD(form_mouse%,MUL(p_h&,74)),INTIN,74)
  VDISYS 111
RETURN
> PROCEDURE set_user_defined_fill_pattern(adr%)                   ! VDI 112
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=16
  INT{ADD(CONTRL,12)}=vdihandle%
  bmove(adr%,INTIN,32)
  VDISYS 112
RETURN
> PROCEDURE set_user_defined_line_style_pattern(e_d_l%)           ! VDI 113
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=e_d_l%
  VDISYS 113
RETURN
'                                                                 ! VDI 116
> PROCEDURE inquire_text_extend(t%,hand%,VAR x1&,y1&,x2&,y2&,x3&,y3&,x4&,y4&)
  LOCAL i&
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,4)}=4
  INT{ADD(CONTRL,6)}=LEN(CHAR{t%})
  INT{ADD(CONTRL,8)}=0
  INT{ADD(CONTRL,12)}=hand%
  CLR i&
  DO
    INT{ADD(INTIN,SHL(i&,1))}=BYTE{ADD(t%,i&)}
    INC i&
  LOOP WHILE i&<LEN(CHAR{t%})
  VDISYS 116
  x1&=INT{PTSOUT}
  y1&=INT{ADD(PTSOUT,2)}
  x2&=INT{ADD(PTSOUT,4)}
  y2&=INT{ADD(PTSOUT,6)}
  x3&=INT{ADD(PTSOUT,8)}
  y3&=INT{ADD(PTSOUT,10)}
  x4&=INT{ADD(PTSOUT,12)}
  y4&=INT{ADD(PTSOUT,14)}
RETURN
> PROCEDURE load_fonts                                            ! VDI 119
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=0
  VDISYS 119
  nombre_de_fontes%=INT{INTOUT}
  IF nombre_de_fontes%<1
    nombre_de_fontes%=1
  ENDIF
RETURN
> PROCEDURE unload_fonts                                          ! VDI 120
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=0
  VDISYS 120
RETURN
'                                                                 ! VDI 121
> PROCEDURE copy_raster_transparent(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x12&,y12&,x21&,y21&,x22&,y22&)
  ' Fonction VDI N 121 (COPY RASTER, TRANSPARENT)
  ' Copie de raster monochrome vers raster couleur
  ' Dfinition du bloc raster source (MFDB):
  graf_mouse(m_off&,0)
  {mfdb%}=s%                              ! Adresse de la mmoire SOURCE
  IF s%<>0                                ! L'cran, C'est au GEM de bosser
    INT{ADD(mfdb%,4)}=sl&                 ! Largeur en points du raster entier
    INT{ADD(mfdb%,6)}=sh&                 ! Hauteur en points du raster entier
    INT{ADD(mfdb%,8)}=SHR(ADD(sl&,15),4)  ! Largeur en mots du raster entier
    IF mode_entrelace!
      INT{ADD(mfdb%,10)}=1                ! flag standart (conscutif)
    ELSE
      INT{ADD(mfdb%,10)}=-1*(sp&=1)       ! flag standart (consqutif en mono)
    ENDIF
    INT{ADD(mfdb%,12)}=sp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  ' Dfinition du bloc raster cible (MFBD):
  {mfbd%}=d%                              ! Adresse de la mmoire SOURCE
  IF d%<>0                                ! L'cran, C'est au GEM de bosser
    INT{ADD(mfbd%,4)}=dl&                 ! Largeur en points du raster entier
    INT{ADD(mfbd%,6)}=dh&                 ! Hauteur en points du raster entier
    INT{ADD(mfbd%,8)}=SHR(ADD(dl&,15),4)  ! Largeur en mots du raster entier
    IF mode_entrelace!
      INT{ADD(mfbd%,10)}=1                ! flag standart (conscutif)
    ELSE
      INT{ADD(mfbd%,10)}=-1*(dp&=1)       ! flag standart (consqutif en mono)
    ENDIF
    INT{ADD(mfbd%,12)}=dp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  INT{ADD(CONTRL,2)}=4
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  {ADD(CONTRL,14)}=mfdb%
  {ADD(CONTRL,18)}=mfbd%
  INT{INTIN}=3                            ! Mode REMPLACE
  '
  INT{PTSIN}=x11&                         ! X en haut  gauche source
  INT{ADD(PTSIN,2)}=y11&                  ! Y en haut  gauche source
  INT{ADD(PTSIN,4)}=x12&                  ! X en bas  droite source
  INT{ADD(PTSIN,6)}=y12&                  ! Y en bas  droite source
  INT{ADD(PTSIN,8)}=x21&                  ! X en haut  gauche destination
  INT{ADD(PTSIN,10)}=y21&                 ! Y en haut  gauche destination
  INT{ADD(PTSIN,12)}=x22&                 ! X en bas  droite destination
  INT{ADD(PTSIN,14)}=y22&                 ! Y en bas  droite destination
  VDISYS 121
  graf_mouse(m_on&,0)
  '
RETURN
> PROCEDURE sample_mouse_button_state(VAR mx&,my&,mk&)            ! VDI 124
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=0
  INT{ADD(CONTRL,12)}=vdihandle%
  VDISYS 124
  mk&=INT{INTOUT}
  mx&=INT{PTSOUT}
  my&=INT{ADD(PTSOUT,2)}
RETURN
> PROCEDURE set_clipping_rectangle(flags|,cx&,cy&,ox&,oy&,fx&,fy&) ! VDI 129
  cx&=MAX(cx&,fx&)
  cy&=MAX(cy&,fy&)
  INT{ADD(CONTRL,2)}=2
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=flags|
  INT{PTSIN}=cx&
  INT{ADD(PTSIN,2)}=cy&
  INT{ADD(PTSIN,4)}=ox&
  INT{ADD(PTSIN,6)}=oy&
  VDISYS 129
RETURN
> PROCEDURE inquire_face_name_and_index(num&)                     ! VDI 130
  LOCAL i&,adr%
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=num&
  VDISYS 130
  adr%=ADD(nom_des_fontes%,MUL(PRED(num&),36))
  INT{adr%}=INT{ADD(INTOUT,66)}
  INT{ADD(adr%,2)}=INT{INTOUT}
  CLR i&
  DO
    BYTE{ADD(ADD(adr%,4),i&)}=INT{ADD(ADD(INTOUT,2),SHL(i&,1))}
    INC i&
  LOOP WHILE i&<32
RETURN
> PROCEDURE set_outline_fonte_fkew(ang%)                          ! VDI 253
  INT{ADD(CONTRL,2)}=0
  INT{ADD(CONTRL,6)}=1
  INT{ADD(CONTRL,12)}=vdihandle%
  INT{INTIN}=ang%
  VDISYS 253
RETURN
' ******************************************************************************
' ****                                                                      ****
' ****       Procdures des fonctions AES par appels rels de l'AES         ****
' ****                                                                      ****
' ******************************************************************************
' ************************ Sous procdure utilisant l'AES **********************
> FUNCTION appl_init                                                      !  10
  RETURN WORD{ADD({ADD(GB,4)},4)}
ENDFUNC
> FUNCTION appl_read(ap_rid&,ap_rlength&,ap_rpbuff%)                      !  11
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=ap_rid&
  INT{ADD(GINTIN,2)}=ap_rlength&
  {ADDRIN}=ap_rpbuff%
  GEMSYS 11
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE appl_write(ap_wid&,ap_wlength&,ap_wpbuff%)                    !  12
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=ap_wid&
  INT{ADD(GINTIN,2)}=ap_wlength&
  {ADDRIN}=ap_wpbuff%
  GEMSYS 12
RETURN
> FUNCTION appl_find(ap_fpname%)                                          !  13
  INT{ADD(GCONTRL,2)}=0                 ! 2 sous TOS | 0 sous MAGIC
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  {ADDRIN}=ap_fpname%
  GEMSYS 13
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE appl_exit                                                     !  19
  '  GEMSYS 19
RETURN
> PROCEDURE appl_startprog(prg%,cmd%)                                   ! Gregor
  '
  INT{buf%}=av_startprog&          ! Numro du message
  INT{ADD(buf%,2)}=ap_id&          ! Indentificateur expditeur du message
  INT{ADD(buf%,4)}=0               ! Pas d'excdent au message
  {ADD(buf%,6)}=prg%               ! Adresse de la chaine "nom du programme"
  {ADD(buf%,10)}=cmd%              ! Adresse de la chaine de commande
  INT{ADD(buf%,14)}=0              ! Ici, c'est vide
  '
  appl_write(ap_id&,16,buf%) ! Envoi du message
  '
RETURN
> PROCEDURE appl_auftauen(child_id&)                                    ! Gregor
  '
  INT{buf%}=sm_m_special&               ! 0 Message Identificateur
  INT{ADD(buf%,2)}=ap_id&               ! 1 Application appelante
  INT{ADD(buf%,4)}=0                    ! 2 Ici, c'est vide
  INT{ADD(buf%,6)}=0                    ! 3
  INT{ADD(buf%,8)}=CVI("MA")            ! 4
  INT{ADD(buf%,10)}=CVI("GX")           ! 5
  INT{ADD(buf%,12)}=smc_unfreeze&       ! 6
  INT{ADD(buf%,14)}=child_id&           ! 7
  '
  appl_write(screnmgr&,16,buf%)         ! Envoie par APPL_WRITE
  '
RETURN
> FUNCTION evnt_multi(flags&,cl&,ma&,st&,f1&,x1&,y1&,w1&,h1&,f2&,x2&,y2&,w2&,h2&,buf%,ct%,VAR mx&,my&,mk&,kbd&,key&,click&)
  ' Fonction AES N 25 (EVNT_MULTI)
  INT{ADD(GCONTRL,2)}=16
  INT{ADD(GCONTRL,4)}=7
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=flags&
  INT{ADD(GINTIN,2)}=cl&
  INT{ADD(GINTIN,4)}=ma&
  INT{ADD(GINTIN,6)}=st&
  INT{ADD(GINTIN,8)}=f1&
  INT{ADD(GINTIN,10)}=x1&
  INT{ADD(GINTIN,12)}=y1&
  INT{ADD(GINTIN,14)}=w1&
  INT{ADD(GINTIN,16)}=h1&
  INT{ADD(GINTIN,18)}=f2&
  INT{ADD(GINTIN,20)}=x2&
  INT{ADD(GINTIN,22)}=y2&
  INT{ADD(GINTIN,24)}=w2&
  INT{ADD(GINTIN,26)}=h2&
  INT{ADD(GINTIN,28)}=WORD(ct%)
  INT{ADD(GINTIN,30)}=WORD(SWAP(ct%))
  {ADDRIN}=buf%
  GEMSYS 25
  mx&=INT{ADD(GINTOUT,2)}
  my&=INT{ADD(GINTOUT,4)}
  mk&=INT{ADD(GINTOUT,6)}
  kbd&=INT{ADD(GINTOUT,8)}
  key&=INT{ADD(GINTOUT,10)}
  click&=INT{ADD(GINTOUT,12)}
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE menu_bar(me_btree%,me_bshow&)                                 !  30
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{GINTIN}=me_bshow&
  {ADDRIN}=me_btree%
  GEMSYS 30
RETURN
> PROCEDURE menu_icheck(me_ctree%,me_citem&,me_ccheck&)                   !  31
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=me_citem&
  INT{ADD(GINTIN,2)}=me_ccheck&
  {ADDRIN}=me_ctree%
  GEMSYS 31
RETURN
> PROCEDURE menu_ienable(me_ctree%,me_citem&,me_eenable&)                 !  32
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=me_citem&
  INT{ADD(GINTIN,2)}=me_eenable&
  {ADDRIN}=me_ctree%
  GEMSYS 32
RETURN
> PROCEDURE menu_tnormal(me_ctree%,me_citem&,me_nnormal&)                 !  33
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=me_citem&
  INT{ADD(GINTIN,2)}=me_nnormal&
  {ADDRIN}=me_ctree%
  GEMSYS 33
RETURN
'                                                                         !  42
> PROCEDURE objc_draw(tree%,startob&,depth&,xclip&,yclip&,wclip&,hclip&,deb&)
  LOCAL axclip&,ayclip&,awclip&,ahclip&
  LOCAL ex&,ey&,ew&,eh&,i_&
  LOCAL s%,sl&,sh&,sp&,d%,dl&,dh&,dp&
  IF wclip&>0 AND hclip&>0
    IF startob&=0 AND fond_img! AND fond%<>0
      ' ************************* Dfinition du raster source
      s%=fond%                         ! L'image de fond (marbre ou autre)
      sl&=largeur_fond%                ! Largeur
      sh&=hauteur_fond%                ! Hauteur
      sp&=plan_systeme&
      ' ************************* Dfinition du raster destination
      d%=0                             ! C'est le GEM qui s'occupe de tout
      ' ************************* Definition de la partie  dplacer
      objc_draw_one(tree%,0,0,xclip&,yclip&,wclip&,hclip&)
      ex&=xclip&
      ey&=yclip&
      ew&=wclip&
      eh&=hclip&
      clip_raster(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,ex&,ey&,ex&,ey&,ex&,ey&,ew&,eh&,3)
      IF deb&>-1
        objc_draw_one(tree%,deb&,depth&,xclip&,yclip&,wclip&,hclip&)
      ELSE
        objc_draw_one(tree%,1,depth&,xclip&,yclip&,wclip&,hclip&)
      ENDIF
    ELSE
      objc_draw_one(tree%,startob&,depth&,xclip&,yclip&,wclip&,hclip&)
    ENDIF
  ENDIF
RETURN
> PROCEDURE objc_draw_one(tree%,startob&,depth&,xclip&,yclip&,wclip&,hclip&)
  graf_mouse(m_off&,0)
  INT{ADD(GCONTRL,2)}=6
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=startob&
  INT{ADD(GINTIN,2)}=depth&
  INT{ADD(GINTIN,4)}=xclip&
  INT{ADD(GINTIN,6)}=yclip&
  INT{ADD(GINTIN,8)}=wclip&
  INT{ADD(GINTIN,10)}=hclip&
  {ADDRIN}=tree%
  GEMSYS 42
  graf_mouse(m_on&,0)
RETURN
> FUNCTION objc_find(tree%,startob&,depth&,mx&,my&)                       !  43
  INT{ADD(GCONTRL,2)}=4
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=startob&
  INT{ADD(GINTIN,2)}=depth&
  INT{ADD(GINTIN,4)}=mx&
  INT{ADD(GINTIN,6)}=my&
  {ADDRIN}=tree%
  GEMSYS 43
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE objc_offset(tree%,obj&,VAR x&,y&)                             !  44
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=3
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=obj&
  {ADDRIN}=tree%
  GEMSYS 44
  x&=INT{ADD(GINTOUT,2)}
  y&=INT{ADD(GINTOUT,4)}
RETURN
> PROCEDURE objc_edit(tree%,obj&,char&,idx&,kind&,VAR pos&)               !  46
  INT{ADD(GCONTRL,2)}=4
  INT{ADD(GCONTRL,4)}=2
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=obj&
  INT{ADD(GINTIN,2)}=char&
  INT{ADD(GINTIN,4)}=idx&
  INT{ADD(GINTIN,6)}=kind&
  {ADDRIN}=tree%
  GEMSYS 46
  pos&=INT{ADD(GINTOUT,2)}
RETURN
> PROCEDURE objc_change(adr%,ob&)                                         !  47
  ob_state(adr%,ob&,aes_selected&,NOT BTST(OB_STATE(adr%,ob&),aes_selected&))
  redraw_elem(adr%,ob&)
RETURN
> PROCEDURE objc_change2(adr%,ob&)                                        !  47
  ob_state(adr%,ob&,aes_selected&,NOT BTST(OB_STATE(adr%,ob&),aes_selected&))
  redraw_element_fenetre(2,adr%,ob&)
RETURN
> FUNCTION form_do(fo_dotree%,fo_dostartob&)                              !  50
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=fo_dostartob&
  {ADDRIN}=fo_dotree%
  GEMSYS 50
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE form_dial(flag&,tlx&,tly&,tlw&,tlh&,bigx&,bigy&,bigw&,bigh&)  !  51
  INT{ADD(GCONTRL,2)}=9
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=flag&
  INT{ADD(GINTIN,2)}=tlx&
  INT{ADD(GINTIN,4)}=tly&
  INT{ADD(GINTIN,6)}=tlw&
  INT{ADD(GINTIN,8)}=tlh&
  INT{ADD(GINTIN,10)}=bigx&
  INT{ADD(GINTIN,12)}=bigy&
  INT{ADD(GINTIN,14)}=bigw&
  INT{ADD(GINTIN,16)}=bigh&
  GEMSYS 51
RETURN
> FUNCTION form_alert(defbttn&,string%)                                   !  52
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=defbttn&
  {ADDRIN}=string%
  GEMSYS 52
  RETURN INT{GINTOUT}
ENDFUNC
> FUNCTION form_error(fo_enum&)                                           !  53
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=fo_enum&
  GEMSYS 53
  RETURN 0
ENDFUNC
> PROCEDURE form_center(tree%,VAR x&,y&,w&,h&)                            !  54
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=5
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  {ADDRIN}=tree%
  GEMSYS 54
  x&=INT{ADD(GINTOUT,2)}
  y&=INT{ADD(GINTOUT,4)}
  w&=INT{ADD(GINTOUT,6)}
  h&=INT{ADD(GINTOUT,8)}
RETURN
> PROCEDURE graf_rubberbox(rx&,ry&,rminw&,rminh&,VAR ret&,ww&,hh&)        !  70
  INT{ADD(GCONTRL,2)}=4
  INT{ADD(GCONTRL,4)}=3
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=rx&
  INT{ADD(GINTIN,2)}=ry&
  INT{ADD(GINTIN,4)}=rminw&
  INT{ADD(GINTIN,6)}=rminh&
  GEMSYS 70
  ret&=INT{GINTOUT}
  ww&=INT{ADD(GINTOUT,2)}
  hh&=INT{ADD(GINTOUT,4)}
RETURN
> PROCEDURE graf_dragbox(dw&,dh&,dx&,dy&,dbx&,dby&,dbw&,dbh&,VAR nx&,ny&) !  71
  INT{ADD(GCONTRL,2)}=8
  INT{ADD(GCONTRL,4)}=3
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=dw&
  INT{ADD(GINTIN,2)}=dh&
  INT{ADD(GINTIN,4)}=dx&
  INT{ADD(GINTIN,6)}=dy&
  INT{ADD(GINTIN,8)}=dbx&
  INT{ADD(GINTIN,10)}=dby&
  INT{ADD(GINTIN,12)}=dbw&
  INT{ADD(GINTIN,14)}=dbh&
  GEMSYS 71
  nx&=INT{ADD(GINTOUT,2)}
  ny&=INT{ADD(GINTOUT,4)}
RETURN
> PROCEDURE graf_slidebox(slptree%,slparent&,slobject&,slvh&,VAR pos&)    !  76
  INT{ADD(GCONTRL,2)}=3
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=slparent&
  INT{ADD(GINTIN,2)}=slobject&
  INT{ADD(GINTIN,4)}=slvh&
  {ADDRIN}=slptree%
  GEMSYS 76
  pos&=INT{GINTOUT}
RETURN
> FUNCTION graf_handle(VAR wc&,hc&,cw&,ch&)                               !  77
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=5
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  GEMSYS 77
  wc&=INT{ADD(GINTOUT,2)}
  hc&=INT{ADD(GINTOUT,4)}
  cw&=INT{ADD(GINTOUT,6)}
  ch&=INT{ADD(GINTOUT,8)}
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE graf_mouse(gr_monumber&,gr_mofaddr%)                          !  78
  LOCAL ok!
  ok!=TRUE
  IF ((gr_monumber&=m_on&) OR (gr_monumber&=m_off&)) AND magic!
    ok!=FALSE
  ENDIF
  IF ok!
    INT{ADD(GCONTRL,2)}=1
    INT{ADD(GCONTRL,4)}=1
    INT{ADD(GCONTRL,6)}=1
    INT{ADD(GCONTRL,8)}=0
    INT{GINTIN}=gr_monumber&
    {ADDRIN}=gr_mofaddr%
    GEMSYS 78
  ENDIF
RETURN
> PROCEDURE graf_mkstate(VAR mx&,my&,mk&,kbd&)                            !  79
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=5
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  GEMSYS 79
  mx&=INT{ADD(GINTOUT,2)}
  my&=INT{ADD(GINTOUT,4)}
  mk&=INT{ADD(GINTOUT,6)}
  kbd&=INT{ADD(GINTOUT,8)}
RETURN
> FUNCTION wind_create(code&,wx&,wy&,ww&,wh&)                             ! 100
  INT{ADD(GCONTRL,2)}=5
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=code&
  INT{ADD(GINTIN,2)}=wx&
  INT{ADD(GINTIN,4)}=wy&
  INT{ADD(GINTIN,6)}=ww&
  INT{ADD(GINTIN,8)}=wh&
  GEMSYS 100
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE wind_open(fen&,wx&,wy&,ww&,wh&)                               ! 101
  graf_mouse(m_off&,0)
  INT{ADD(GCONTRL,2)}=5
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=fen&
  INT{ADD(GINTIN,2)}=wx&
  INT{ADD(GINTIN,4)}=wy&
  INT{ADD(GINTIN,6)}=ww&
  INT{ADD(GINTIN,8)}=wh&
  GEMSYS 101
  graf_mouse(m_on&,0)
RETURN
> PROCEDURE wind_close(fen&)                                              ! 102
  graf_mouse(m_off&,0)
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=fen&
  GEMSYS 102
  graf_mouse(m_on&,0)
RETURN
> PROCEDURE wind_delete(fen&)                                             ! 103
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=fen&
  GEMSYS 103
RETURN
> FUNCTION wind_get(fen&,code&,VAR wx&,wy&,ww&,wh&)                       ! 104
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=5
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=fen&
  INT{ADD(GINTIN,2)}=code&
  ' Merci  Franois LE COAT pour le truc de remplir les deux mots suivants
  ' avec 0 pour viter les problmes sous MiNT
  INT{ADD(GINTOUT,6)}=0
  INT{ADD(GINTOUT,8)}=0
  GEMSYS 104
  $S&,$S>
  SELECT code&
  CASE wf_workxywh&,wf_currxywh&,wf_prevxywh&,wf_fullxywh&,wf_firstxywh&,wf_nextxywh&
    wx&=INT{ADD(GINTOUT,2)}
    wy&=INT{ADD(GINTOUT,4)}
    ww&=INT{ADD(GINTOUT,6)}
    wh&=INT{ADD(GINTOUT,8)}
  CASE wf_hslide&,wf_vslide&,wf_top&,wf_hslsize&,wf_vslsize&,wf_winx&
    wx&=INT{ADD(GINTOUT,2)}
  ENDSELECT
  RETURN INT{GINTOUT}
ENDFUNC
> PROCEDURE wind_set(fen&,code&,wx&,wy&,ww&,wh&)                          ! 105
  IF mode_winx!
    ~WIND_GET(fen&,code&,wx&,wy&,ww&,wh&)
  ELSE
    INT{ADD(GCONTRL,2)}=6
    INT{ADD(GCONTRL,4)}=1
    INT{ADD(GCONTRL,6)}=0
    INT{ADD(GCONTRL,8)}=0
    INT{GINTIN}=fen&
    INT{ADD(GINTIN,2)}=code&
    INT{ADD(GINTIN,4)}=wx&
    INT{ADD(GINTIN,6)}=wy&
    INT{ADD(GINTIN,8)}=ww&
    INT{ADD(GINTIN,10)}=wh&
    GEMSYS 105
  ENDIF
RETURN
> FUNCTION wind_find(mx&,my&)                                             ! 106
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=mx&
  INT{ADD(GINTIN,2)}=my&
  GEMSYS 106
  RETURN INT{GINTOUT}
ENDFUNC
'
> PROCEDURE aes_beg_mctrl
  IF NOT flag_aes_mctrl!
    wind_update(beg_mctrl&)
    flag_aes_mctrl&=TRUE
  ENDIF
RETURN
> PROCEDURE aes_end_mctrl
  IF flag_aes_mctrl!
    wind_update(end_mctrl&)
    flag_aes_mctrl!=FALSE
  ENDIF
RETURN
> PROCEDURE aes_beg_update
  IF NOT flag_aes_update!
    wind_update(beg_update&)
    flag_aes_update!=TRUE
  ENDIF
RETURN
> PROCEDURE aes_end_update
  IF flag_aes_update!
    wind_update(end_update&)
    flag_aes_update!=FALSE
  ENDIF
RETURN
> PROCEDURE wind_update(flag&)                                            ! 107
  IF mode_winx!
    ~WIND_UPDATE(flag&)
  ELSE
    INT{ADD(GCONTRL,2)}=1
    INT{ADD(GCONTRL,4)}=1
    INT{ADD(GCONTRL,6)}=0
    INT{ADD(GCONTRL,8)}=0
    INT{GINTIN}=flag&
    GEMSYS 107
  ENDIF
RETURN
'
> PROCEDURE wind_calc(flag&,wk&,wx&,wy&,ww&,wh&,VAR wx1&,wy1&,ww1&,wh1&)  ! 108
  INT{ADD(GCONTRL,2)}=6
  INT{ADD(GCONTRL,4)}=5
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=flag&
  INT{ADD(GINTIN,2)}=wk&
  INT{ADD(GINTIN,4)}=wx&
  INT{ADD(GINTIN,6)}=wy&
  INT{ADD(GINTIN,8)}=ww&
  INT{ADD(GINTIN,10)}=wh&
  GEMSYS 108
  wx1&=INT{ADD(GINTOUT,2)}
  wy1&=INT{ADD(GINTOUT,4)}
  ww1&=INT{ADD(GINTOUT,6)}
  wh1&=INT{ADD(GINTOUT,8)}
RETURN
> FUNCTION rsrc_load(n%)                                                  ! 110
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=ap_id&
  {ADDRIN}=n%
  GEMSYS 110
  RETURN INT{GINTOUT}
ENDFUNC
> FUNCTION rsrc_free                                                      ! 111
  INT{ADD(GCONTRL,2)}=0
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=ap_id&
  GEMSYS 111
  RETURN INT{GINTOUT}
ENDFUNC
> FUNCTION rsrc_gaddr(re_gtype&,re_gindex&,VAR re_gaddr%)                 ! 112
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=0
  INT{ADD(GCONTRL,8)}=1
  INT{GINTIN}=re_gtype&
  INT{ADD(GINTIN,2)}=re_gindex&
  GEMSYS 112
  re_gaddr%={ADDROUT}
  RETURN INT{GINTOUT}
ENDFUNC
> FUNCTION rsrc_saddr(re_gtype&,re_gindex&,VAR re_gaddr%)                 ! 113
  INT{ADD(GCONTRL,2)}=2
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=re_gtype&
  INT{ADD(GINTIN,2)}=re_gindex&
  GEMSYS 113
  re_gaddr%={ADDROUT}
  RETURN INT{GINTOUT}
ENDFUNC
> FUNCTION rsrc_obfix(re_obj&,re_gaddr%)                                  ! 114
  INT{GINTIN}=re_obj&
  {ADDRIN}=re_gaddr%
  GEMSYS 114
  RETURN {ADDROUT}
ENDFUNC
> FUNCTION shel_read(sh_rpcmd%,sh_rptail%)                                ! 120
  {ADDRIN}=sh_rpcmd%
  {ADD(ADDRIN,4)}=sh_rptail%
  GEMSYS 120
  RETURN {ADDROUT}
ENDFUNC
> FUNCTION shel_write(sh_wdoex&,sh_wisgr&,sh_wiscr&,sh_wpcmd%,sh_wptail%) ! 121
  INT{GINTIN}=sh_wdoex&
  INT{ADD(GINTIN,2)}=sh_wisgr&
  INT{ADD(GINTIN,4)}=sh_wiscr&
  {ADDRIN}=sh_wpcmd%
  {ADD(ADDRIN,4)}=sh_wptail%
  GEMSYS 121
  RETURN {ADDROUT}
ENDFUNC
> FUNCTION shel_find(sh_fpbuff%)                                          ! 124
  {ADDRIN}=sh_fpbuff%
  GEMSYS 124
  RETURN INT{GINTOUT}
ENDFUNC
' ******************************************************************************
> PROCEDURE ob_state(arb%,obj&,bit&,ind!)
  IF ind!
    OB_STATE(arb%,obj&)=BSET(OB_STATE(arb%,obj&),bit&)
    IF bit&=aes_selected& AND BTST(OB_STATE(arb%,obj&),wm_xcrossed&)
      ob_state(arb%,SUB(obj&,1),aes_crossed&,TRUE)
    ENDIF
  ELSE
    OB_STATE(arb%,obj&)=BCLR(OB_STATE(arb%,obj&),bit&)
    IF bit&=aes_selected& AND BTST(OB_STATE(arb%,obj&),wm_xcrossed&)
      ob_state(arb%,SUB(obj&,1),aes_crossed&,FALSE)
    ENDIF
  ENDIF
RETURN
> PROCEDURE ob_flags(arb%,obj&,bit&,ind!)
  IF ind!
    OB_FLAGS(arb%,obj&)=BSET(OB_FLAGS(arb%,obj&),bit&)
  ELSE
    OB_FLAGS(arb%,obj&)=BCLR(OB_FLAGS(arb%,obj&),bit&)
  ENDIF
RETURN
' ******************* Calcul manuel du clipping pour COPY RASTER ***************
> PROCEDURE clip_raster(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x21&,y21&,ex&,ey&,ew&,eh&,mod|)
  LOCAL x12&,y12&,x22&,y22&
  ' ********* Bien, alors la on ralise un CLIPPING  la main, parce-que les
  ' ********* COPY RASTER se moque totalement des CLIPPINGs VDIs.
  ' x11&,y11&           (Position dans la zone source)
  ' x12&,y12&           (Calculer dans cette procdure)
  ' x21&,y21&           (Position dans la zone destination)
  ' x22&,y22&           (Calculer dans cette procdure)
  ' ex&,ey&,ew&,eh&     (Rectangle dlimitant la zone copie sur l'cran)
  ' 0,0,xmax&,ymax&     (Rectangle zone dlimitant l'cran)
  ' Premirement, testont si l'ont est dansl'cran
  IF ex&<xmax& AND ey&<ymax& AND PRED(ADD(ex&,ew&))>0 AND PRED(ADD(ey&,eh&))>0
    IF ex&<0
      ADD x11&,-ex&
      CLR x21&
      SUB ew&,-ex&
    ENDIF
    IF PRED(ADD(ex&,ew&))>xmax&    ! ATTENTION on sort de l'cran en X  droite
      x12&=ADD(x11&,SUB(xmax&,ex&))           ! X2 du raster source
      x22&=xmax&                              ! X2 du raster destination
    ELSE                           ! Ah ! l tout va bien
      x12&=PRED(ADD(x11&,ew&))                ! X2 du raster source
      x22&=PRED(ADD(x21&,ew&))                ! X2 du raster destination
    ENDIF
    IF ey&<0
      ADD y11&,-ey&
      CLR y21&
      SUB eh&,-ey&
    ENDIF
    IF PRED(ADD(ey&,eh&))>ymax&    ! ATTENTION on sort de l'cran en Y en bas
      y12&=ADD(y11&,SUB(ymax&,ey&))           ! Y2 du raster source
      y22&=ymax&                              ! Y2 du raster destination
    ELSE                           ! Ah ! l tout va bien
      y12&=PRED(ADD(y11&,eh&))                ! Y2 du raster source
      y22&=PRED(ADD(y21&,eh&))                ! Y2 du raster destination
    ENDIF
    $S|,$S>
    SELECT mod|
    CASE 0 TO 15
      copy_raster_opaque(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x12&,y12&,x21&,y21&,x22&,y22&,mod|)
    CASE 255
      copy_raster_transparent(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x12&,y12&,x21&,y21&,x22&,y22&)
    ENDSELECT
  ENDIF
RETURN
' ******************************************************************************
' ****   Routine de gestion des fichiers ressouces tendus d'INTERFACE II   ****
' ******************************************************************************
> FUNCTION s_exist(n_n%)
  LOCAL ok&
  ' Nouvelle fonction de test d'existance d'un fichier d'aprs les travaux
  ' de Pierre THONTAT (Rajha LONE de QUEEN MEKA, merci  lui) et permettant
  ' la gestion des noms longs des systmes multitches.
  $F%
  '
  minuscule(n_n%)
  '
  IF (LEN(CHAR{n_n%})=0) OR (BYTE{n_n%}=0)      ! Ligne vide, on repart.
    RETURN FALSE
  ELSE
    ok&=GEMDOS(&H3D,L:n_n%,W:0)                 ! On ouvre le fichier
    IF ok&>0                                    ! si c'est positif
      ~GEMDOS(&H3E,W:ok&)                       ! on renferme
      RETURN TRUE                               ! et on dit que c'est bon
    ELSE                                        ! sinon, il y a un problme
      RETURN FALSE                              ! on dit qu'il n'y a rien
    ENDIF
  ENDIF
ENDFUNC
' ******************************************************************************
> PROCEDURE chemin_systeme
  ' ------------------------------------------------------------------------
  ' Si SELECTRIC est install, il va effectu des changments de chemins    !
  ' intenpestifs (par des CHDIR/CHDRIVE), il faut donc inprativement      !
  ' remettre tout en l'tat pour que tout aille bien.                      !
  ' De plus, lors de l'utilisation des modules et autre plug in du modeleur!
  ' les chemins systmes sont modifier et il faut donc les remettre.       !
  ' ------------------------------------------------------------------------
  ' Remettre le lecteur systeme                                            !
  ~GEMDOS(&HE,W:lecteur%)                                                  !
  '                                                                        !
  ' Remettre le chemin systme                                             !
  ~GEMDOS(&H3B,L:path_systeme%)                                            !
  ' ------------------------------------------------------------------------
RETURN
> PROCEDURE chemin_en_cours(d%,p%)
  LOCAL a|,lec%
  '
  a|=65                         ! En cas de majuscule, 65=A
  IF multitache!
    a|=97                       ! En cas de minuscule, 97=a
  ENDIF
  ' ------------------------------------------------------------------------
  ' Pour viter tout problme en multitche, autant changer le chemin      !
  ' systme  chaque fois que l'on veut lancer une application fille       !
  ' du genre modules, programmes externes...etc...                         !
  ' ------------------------------------------------------------------------
  '                                                                        !
  ' Remettre le lecteur systeme                                            !
  lec%=SUB(ASC(CHAR{d%}),a|)                                               !
  ~GEMDOS(&HE,W:lec%)                                                      !
  '                                                                        !
  ' Remettre le chemin systme                                             !
  minuscule(p%)                                                            !
  ~GEMDOS(&H3B,L:p%)                                                       !
  '                                                                        !
  ' ------------------------------------------------------------------------
RETURN
' ******************************************************************************
' ******************************************************************************
> PROCEDURE gestion_des_erreurs
  les_messages_d_erreur(ERR)
  ON ERROR GOSUB gestion_des_erreurs
  CLOSE
  RESUME retour_des_erreurs
RETURN
> PROCEDURE les_messages_d_erreur(nn&)
  LOCAL n%
  n%=@prendre(512,FALSE,3)
  $S&,$S>
  SELECT nn&
  CASE -66
    CHAR{n%}="[3][Ce n'est pas un |programme binaire.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -49
    CHAR{n%}="[3][Pas d'autres donnes.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -46
    CHAR{n%}="[3][Erreur de lecteur de disquette.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -40
    CHAR{n%}="[3][Adresse non valable.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -39
    CHAR{n%}="[3][La mmoire est pleine.|Lancement de module annule ][Dsol]"+CHR$(0)
  CASE -37
    CHAR{n%}="[3][Handle non valable.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -36
    CHAR{n%}="[3][Accs impossible.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -35
    CHAR{n%}="[3][Trop de fichiers ouverts.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -34
    CHAR{n%}="[3][Chemin de slection non trouv.|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -33
    CHAR{n%}="[3][Fichier non trouv|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE -32
    CHAR{n%}="[3][Numro de fonction incorrecte|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 0
    CHAR{n%}="[3][Division par 0|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 1
    CHAR{n%}="[3][Dbordement|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 2
    CHAR{n%}="[3][Le nombre n'est pas un Interger|-2147483648..2147483647|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 3
    CHAR{n%}="[3][Le nombre n'est pas un octet|0..255|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 4
    CHAR{n%}="[3][Le nombre n'est pas un mot|-32768..32767|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 5
    CHAR{n%}="[3][Racine carr d'un nombre|ngatif impossible|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 6
    CHAR{n%}="[3][Logarithme d'un nombre|infrieur  zro impossible|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 7
    CHAR{n%}="[3][Erreur inconnue|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 8
    ~@afficher_alerte(adr_memoire%)
  CASE 9
    CHAR{n%}="[3][Fonction ou instruction|impossible|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 22
    CHAR{n%}="[3][Fichier dj ouvert|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 23
    CHAR{n%}="[3][Mauvais numro de fichier|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 24
    CHAR{n%}="[3][Fichier non ouvert|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 26
    CHAR{n%}="[3][Fin de fichier atteinte|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 34
    CHAR{n%}="[3][Trop peu de donnes|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 35
    CHAR{n%}="[3][Donne non numrique|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 37
    CHAR{n%}="[3][Disque plein|Faites de la place|ou changez de disque][ Merci ]"+CHR$(0)
  CASE 42
    CHAR{n%}="[3][Trop peu de paramtres|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 43
    CHAR{n%}="[3][Expression trop complexe|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 44
    CHAR{n%}="[3][Fonction indfinie|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 45
    CHAR{n%}="[3][Trop de paramtres|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 46
    CHAR{n%}="[3][Paramtre inexact|ce doit tre un nombre|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 47
    CHAR{n%}="[3][Paramtre inexact|ce doit tre une chaine|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 61
    CHAR{n%}="[3][RESERVE erreur|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 64
    CHAR{n%}="[3][Erreur dans pointeur|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 67
    CHAR{n%}="[3][Erreur ASIN/ACOS|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 90
    CHAR{n%}="[3][Erreur dans |variables locales|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 102
    CHAR{n%}="[3][Erreur bus|adressage incorrecte|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 103
    CHAR{n%}="[3][Erreur d'adresse|adresse de mot impaire|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 104
    CHAR{n%}="[3][Excution d'une instruction 680xx|ne convenant pas|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 105
    CHAR{n%}="[3][Division par zro|en langage machine|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 106
    CHAR{n%}="[3][exception CHK|interruption 680xx|par instruction CHK|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 107
    CHAR{n%}="[3][exception TRAPV|interruption 680xx|par instruction TRAPV|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 108
    CHAR{n%}="[3][Interruption 680xx|par excution d'une|instruction privilgie|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 109
    CHAR{n%}="[3][Exception trace|interruption trace avec 680xx|Prvenir l'auteur][ Merci ]"+CHR$(0)
  CASE 997
    CHAR{n%}="[3][Le module TEXBASSE n'est|pas prsent  cot de|EB Model 3.][ Dsol ]"+CHR$(0)
  CASE 998
    CHAR{n%}="[3][Le module CSG n'est|pas prsent  cot de|EB Model 3.][ Dsol ]"+CHR$(0)
  CASE 999
    CHAR{n%}="[3][Le module CSG vient|de stoper son travail|sans prvenir.][ Dsol ]"+CHR$(0)
  DEFAULT
    CHAR{n%}="[3][Erreur "+STR$(nn&)+" inconnue|Notez son numro |et prvenez l'auteur][ Merci ]"+CHR$(0)
  ENDSELECT
  ~@form_alert(1,n%)
  libere(*n%)
RETURN
' ********************************************************************************
' **** (C)BARANGER Emmanuel                                              2006 ****
' ********************************************************************************
