' ******************************************************************************
' ****                           Capture d'‚cran pour systŠme               ****
' ****                           TOS/GEM/AES version 0.9.7                  ****
' ****                           en acc‚ssoire                              ****
' **** (C) BARANGER Emmanuel                                      GFA 3.6TT ****
' **** 31, rue de la porte Morard                                           ****
' **** 28000 Chartres                                                       ****
' **** France  T‚l‚phone : 02 37 35 67 02                        02/04/2006 ****
' ****                                                           03/04/2006 ****
' **** e-mail : embaranger@free.fr                               04/04/2006 ****
' **** WEB    : http://ebmodel3.atari.org                        05/04/2006 ****
' ****                                                           14/04/2006 ****
' ****                                                           15/04/2006 ****
' ****                                                           16/04/2006 ****
' ****                                                           31/06/2006 ****
' ****                                                           05/07/2006 ****
' ****                                                           11/07/2006 ****
' ****                                                                      ****
' **** Produit totalement libre de droit. Je vous livre les sources pour    ****
' **** que vous puissiez vous amuser un peu avec.                           ****
' ******************************************************************************
$m64000                                 ! Pour le compilateur
compile!=BYTE{ADD(BASEPAGE,256)}<>96    ! L'‚x‚cution est elle en compil‚
IF NOT compile!                         ! Si ce n'est pas le cas
  RESERVE 64000                         ! On r‚serve un peu de m‚moire
ENDIF                                   ! Sinon, on continue
ap_id&=@appl_init                       ! Recuperer l'AP_ID de l'application
IF ap_id&=-1                            ! AP_ID incorrecte...D‚sol‚, mais
  n%=@prendre(512,FALSE,3)              ! il faut pr‚venir que le lancement
  CHAR{n%}="[1]["                       ! du programme est annul‚
  CHAR{n%}=CHAR{n%}+" Mauvais ID d'application,|"
  CHAR{n%}=CHAR{n%}+" Programme arrˆt‚ !       |"
  CHAR{n%}=CHAR{n%}+" Bad application ID,      |"
  CHAR{n%}=CHAR{n%}+" Programm stopped !       |"
  CHAR{n%}=CHAR{n%}+"][ D‚sol‚ | 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 r‚cupŠre toutes les donn‚es
IF @initialisation                      ! Initialisation complŠte du programme
  IF compile!
    CHAR{a_charger%}="  EB Dump "+CHR$(0)
    me_id&=@menu_register(ap_id&,a_charger%)
  ELSE
    me_id&=1
    ouvrir_generale
  ENDIF
  IF me_id&<>-1                         ! Tiens on est en acc‚ssoire
    ON ERROR GOSUB gestion_des_erreurs  ! Pour les erreurs. Si, si, il y en a !
  retour_des_erreurs:                   ! En cas d'erreur c'est la le retour
    IF compile!
      DO
        boucle_principale               ! Boucle sans fin
      LOOP
    ELSE
      boucle_principale                 ! Boucle sans fin
    ENDIF
  ENDIF
ENDIF
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'‚v‚nement, index de boucle
  '
  souris|=11
  asouris|=100
  DO                                      ! BOUCLE PRINCIPALE DU PROGRAMME
    ' Appel fonction xform_do() qui gŠre 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&  ! Coordonn‚es zone de travail fenˆtre
  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 ac_open&
    ouvrir_generale
  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
      fermeture_fenetre(SHL(dummy&,1))
    ENDIF
  CASE wm_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&
    '
  CASE ap_dragdrop&
    '
  CASE va_start&
    chargement_par_va_start
  CASE shut_down&
    fin_programme!=TRUE
  CASE wm_zero&
    INT{ADD(buf%,8)}=0
    INT{ADD(buf%,10)}=0
    INT{ADD(buf%,12)}=0
    INT{ADD(buf%,14)}=0
  CASE eb_dump_capture_fullscreen&
    mode_capture|=0
    capture(-1,-1,-1,-1)
    sauver_image_tga_type_2
  CASE eb_dump_capture_window&
    mode_capture|=1
    zx&=INT{ADD(buf%,4)}
    capture(zx&,-1,-1,-1)
    sauver_image_tga_type_2
  CASE eb_dump_capture_mouse&
    mode_capture|=2
    zx&=INT{ADD(buf%,4)}
    zy&=INT{ADD(buf%,6)}
    zw&=INT{ADD(buf%,8)}
    zh&=INT{ADD(buf%,10)}
    capture(zx&,zy&,zw&,zh&)
    sauver_image_tga_type_2
  CASE eb_dump_disable_selector&
    mode_selecteur!=FALSE
  CASE eb_dump_enable_selector&
    mode_selecteur!=TRUE
  CASE eb_dump_disable_windframe&
    avec_decors!=FALSE
  CASE eb_dump_enable_windframe&
    avec_decors!=TRUE
  ENDSELECT
  '
RETURN
PROCEDURE evenements_menus            ! Bon, on a cliquer dans les menus
  '
  '
RETURN
PROCEDURE evenements_souris           ! La souris a encore fait des siennes
  LOCAL dummy&
  '
  dummy&=@numero_fenetre(@wind_find(mx&,my&))
  $S&,S>
  SELECT dummy&
  CASE idx_generale&
    gestion_generale
  CASE idx_config&
    gestion_config
  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 interf‚rer 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‚ num‚rique 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 avant%,offset%,seekmode%,retour%
  '
  avant%=@floc(handle%)
  offset%=0
  seekmode%=2
  '
  retour%=GEMDOS(&H42,L:offset%,handle%,seekmode%)
  ~@fseek(handle%,avant%,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 s‚curit‚
    '
    membfill(titre_en_cours%,512,0)
    bmove(adr_nom%,titre_en_cours%,LEN(CHAR{adr_nom%}))
    '
    ' on confirme au programme appelant qu'on a r‚cup‚r‚ quelque chose
    '
    INT{buf%}=av_start&                 ! Num‚ro du message
    INT{ADD(buf%,2)}=ap_id&             ! Indentificateur exp‚diteur du message
    INT{ADD(buf%,4)}=0                  ! Pas d'exc‚dent au message
    {ADD(buf%,6)}=adr_nom%              ! Le nom de fichier en question
    INT{ADD(buf%,8)}=0                  ! Le reste est mis … z‚ro pour
    INT{ADD(buf%,10)}=0                 ! ‚viter tout problŠme.
    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 r‚cup‚re 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 paramŠtre.
    '
    ' 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 fenˆtres.
  '
  CLR objet&                            ! Mise … z‚ro 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 ‚v‚nements
    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&)
    ' ==========================================================================
    ' ==== EvŠnement clavier
    ' ==========================================================================
    IF BTST(evnt&,0)
      IF @xform_do_clavier(address%,evnt&)
        RETURN evnt&
      ENDIF
    ENDIF
    ' ==========================================================================
    ' ==== EvŠnement message
    ' ==========================================================================
    IF BTST(evnt&,4)
      IF @xform_do_message(address%,evnt&)
        RETURN evnt&
      ENDIF
    ENDIF
    ' ==========================================================================
    ' ==== EvŠnement souris
    ' ==========================================================================
    IF BTST(evnt&,1)
      IF @xform_do_souris(address%,evnt&)
        RETURN evnt&
      ENDIF
    ENDIF
    RETURN evnt&                        ! Toujours retourner l'‚v‚nement
  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 fenˆtre formulaire est au 1ø plan
    xfd_dum&=@numero_fenetre(xfd_top&)
    IF xfd_dum&<>-1
      '                                 R‚cup‚rer adresse formulaire en fenˆtre
      xfd_adr%=@arbre_ressource(xfd_dum&)
    ELSE
      xfd_adr%=adr_desk%
    ENDIF
  ELSE                                  ! Si on travaille sur formulaire
    xfd_adr%=address%                   ! R‚cup‚rer 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 s‚lectionner
    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 s‚lectionner
        '                                               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'‚vŠnement
        IF edit&                              ! Si curseur … l'‚cran
          objc_edit(xfd_adr%,edit&,0,pos&,3,pos&) ! le d‚sactiver
          CLR edit&
        ENDIF
        RETURN TRUE                           ! Retourner l'‚v‚nement
      ENDIF
      EXIT IF BTST(OB_FLAGS(xfd_adr%,xfd_i&),aes_lastob&)
      INC xfd_i&                                    ! Objet suivant
    LOOP
    ' ......................................................................
    ' .... L'une des flŠches (avec ou sans <Shift> … ‚t‚ appuy‚e
    ' .... 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 pr‚sent dans le formulaire actif
    ' ......................................................................
  ELSE IF edit&>0
    ' ......................................................................
    ' .... FlŠche 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&)   ! D‚sactiver curseur
            edit&=xfd_cha&                            ! Nouvel ‚ditable
            objc_edit(xfd_adr%,edit&,0,pos&,1,pos&)   ! R‚activer curseur
          ENDIF
        ELSE
          objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)     ! D‚sactiver curseur
        ENDIF
      ELSE
        evnt&=1
        RETURN TRUE
      ENDIF
      ' ....................................................................
      ' .... FlŠche vers le haut
      ' ....................................................................
    ELSE IF key&=&H4800
      IF xfd_adr%<>adr_saisie%
        xfd_cha&=@prev(xfd_adr%,edit&)                ! Chercher champ pr‚c‚dent
        ' 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&)   ! D‚sactiver curseur
            edit&=xfd_cha&                            ! Nouvel ‚ditable
            objc_edit(xfd_adr%,edit&,0,pos&,1,pos&)   ! R‚activer curseur
          ENDIF
        ELSE
          objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)     ! D‚sactiver 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 sp‚ciales
    kbd&=BCLR(kbd&,4)                           ! Annuler bit Capslock
    IF BTST(kbd&,cl_shift_droit&) OR BTST(kbd&,cl_shift_gauche&)
      xfd_ctr|=ASC("")                         ! <Shift> enfonc‚e
    ELSE IF BTST(kbd&,cl_control&)
      xfd_ctr|=ASC("^")                         ! <Control> enfonc‚e
    ELSE IF BTST(kbd&,cl_alternate&)
      xfd_ctr|=ASC("")                         ! <Alternate> enfonc‚e
    ELSE                                        ! Sinon
      CLR xfd_ctr|                              ! Pas de touche sp‚ciale
    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 caractŠre et la touche sp‚ciale correspondent
            IF NOT (BTST(OB_STATE(adr_menu%,xfd_i&),aes_disable&)) ! Si actif
              evnt&=16                          ! Fabriquer un ‚v‚nement
              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&)            ! Fenˆtre cliqu‚e
    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 fenˆtre ?
    IF whandle&>0                   ! Si oui
      ' +++++++++++++++++++ Chercher le num‚ro de la fenˆtre de premier plan
      ~@wind_get(0,wf_top&,top&,dummy&,dummy&,dummy&)
      ' ++++++++++++++ clique sur fenˆtre de 1ø plan
      IF whandle&=top&
        dummy&=@numero_fenetre(top&)
        IF dummy&<>-1
          ' Adresse formulaire en fenˆtre
          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 d‚j… s‚lectionn‚ => gestion des bascules
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obstate&,aes_selected&)
      CLR evnt&
      RETURN TRUE
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' "" Si c'est un objet 'DEFAULT' donc fermer la fenˆtre, retirer EDIT&
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obflags&,aes_default&)
      IF edit&
        objc_edit(xfd_adr%,edit&,0,pos&,3,pos&)       ! D‚sactiver curseur
        CLR edit&
      ENDIF
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """ Si l'objet est d‚sactiv‚, sortir de suite, il n'y a rien … faire
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    IF BTST(obstate&,aes_disable&)
      CLR evnt&
      RETURN TRUE
    ENDIF
    ' """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
    ' """" Si s‚lectable 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 pŠre
      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&)  ! D‚sactiver 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&) ! R‚activer curseur
    ENDIF
  ENDIF
  RETURN FALSE
ENDFUNC
' ..............................................................................
FUNCTION parent(adr%,object&)
  ' Retourne l'objet pŠre 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 pŠre
ENDFUNC
FUNCTION next(adr%,ed&)
  ' Chercher l'‚ditable suivant
  ' Attention : si l'‚ditable, ou l'un de ses pŠres 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 pŠre
    ' Si ce n'est pas la racine et pas HIDETREE
    WHILE ((pere&>0) AND (vu&=TRUE))
      ' Si le pŠre est HIDETREE
      IF BTST(OB_FLAGS(adr%,pere&),aes_hidetree&)
        vu&=FALSE               ! l'objet n'est pas visible
      ENDIF
      pere&=@parent(adr%,pere&)  ! PŠre 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 num‚ro
          ENDIF
        ENDIF
      ENDIF
    ENDIF
    INC ob&
  WEND
  RETURN -1   ! Sinon, -1
ENDFUNC
FUNCTION prev(adr%,ed&)
  ' Chercher l'‚ditable pr‚c‚dent
  ' Attention : si l'‚ditable, ou l'un de ses pŠres est HIDETREE,
  ' il ne faut pas le prendre
  LOCAL pere&,vu&,ob&
  '
  vu&=TRUE
  ob&=PRED(ed&)
  WHILE (ob&>0)                 ! En arriŠre jusqu'… la racine
    pere&=@parent(adr%,ob&)     ! PŠre de l'objet
    ' Si ce n'est pas la racine et pas HIDETREE
    WHILE ((pere&>0) AND (vu&=TRUE))
      ' Si le pŠre est HIDETREE
      IF BTST(OB_FLAGS(adr%,pere&),aes_hidetree&)
        vu&=FALSE               ! L'objet n'est pas visible
      ENDIF
      pere&=@parent(adr%,pere&) ! PŠre 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 num‚ro
          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
' ------------------------------------------------------------------------------
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 fenˆtre 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 derniŠre fenˆtre, alors, on reprend … la premiŠre
      ' De toute fa‡on, il y a toujours plusieurs fenˆtres actives
      ' en mˆme 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 fenˆtre suivante
    INT{buf%}=wm_topped&             ! Num‚ro du message
    INT{ADD(buf%,2)}=ap_id&          ! Indentificateur exp‚diteur
    INT{ADD(buf%,4)}=0               ! Pas d'exc‚dent au message
    '                                   Handle fenˆtre concern‚e
    INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(suivante&,1))}
    INT{ADD(buf%,8)}=global_xb&      ! Cordonn‚e 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-mˆme un message de redimensionnement
  INT{buf%}=wm_redraw&              ! Num‚ro du message (redessin)
  INT{ADD(buf%,2)}=ap_id&           ! Indentificateur exp‚diteur
  INT{ADD(buf%,4)}=0                ! Pas d'exc‚dent au message
  '                                   Handle fenˆtre concern‚e
  INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(@numero_fenetre(whandle&),1))}
  INT{ADD(buf%,8)}=global_xb&       ! Cordonn‚e zone redraw (fenˆtre)
  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-mˆme un message de redimensionnement
  INT{buf%}=wm_redraw&              ! Num‚ro du message (redessin)
  INT{ADD(buf%,2)}=ap_id&           ! Indentificateur exp‚diteur
  INT{ADD(buf%,4)}=0                ! Pas d'exc‚dent au message
  '                                   Handle fenˆtre concern‚e
  INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(@numero_fenetre(whandle&),1))}
  INT{ADD(buf%,8)}=global_xb&       ! Cordonn‚e zone redraw (fenˆtre)
  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&            ! Num‚ro du message
  INT{ADD(buf%,2)}=ap_id&         ! Indentificateur exp‚diteur message
  INT{ADD(buf%,4)}=0              ! Pas d'exc‚dent au message
  '                                   Handle fenˆtre concern‚e
  INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(@numero_fenetre(fen&),1))}
  INT{ADD(buf%,8)}=global_xb&     ! Cordonn‚e 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%
  global_xmax&=INT{station%}
  global_ymax&=INT{ADD(station%,2)}
  haute_resolution!=FALSE
  IF (global_xmax&>640) AND (global_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
  ' physique%=XBIOS(2)                          ! Allez pour faire plaisir … Pierre
  '                                             ! surtout que physique% n'est pas utilis‚
  lecteur%=GEMDOS(&H19)
  '
  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%
  '
  disque_systeme%=@zone(4,adresse%)     ! Le disque systŠme (au lancement)
  path_systeme%=@zone(272,adresse%)     ! Le chemin systŠme (au lancement)
  disque%=@zone(4,adresse%)             ! Le disque de mouvement
  masque%=@zone(128,adresse%)           ! Les masques du s‚lecteur
  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 systŠme dans le SHEL_READ
  eb_temp%=@zone(512,adresse%)          ! Chemin des fichiers de configurations
  mem_nom%=@zone(512,adresse%)          ! M‚moire pour les acc‚s disque
  mem_che%=@zone(512,adresse%)          ! Pour les chemins d'acc‚s disque
  titre_en_cours%=@zone(512,adresse%)   ! Le titre de la scŠne en cours
  tr_tmp%=@zone(1024,adresse%)          ! Pour les trac‚s temporaires
  '
  ' ============================================================================
  ' ==== V‚rifier la validit‚e du chemin systŠme. En cas de problŠme,      =====
  ' ==== essayer par les fonctions GEMDOS (DGETDRV et DGETPATH)            =====
  ' ====                                                                   =====
  ' ==== Si rien ne va, on arrˆte l… et on pr‚vient du problŠme de chemin  =====
  ' ============================================================================
  CHAR{disque_systeme%}=CHR$(ADD(65,lecteur%))+":"+CHR$(0)
  ~GEMDOS(&H47,L:path_systeme%,0)
  CHAR{path_systeme%}=CHAR{path_systeme%}+"\"+CHR$(0)
  CHAR{path%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+"EB_DUMP.RSC"+CHR$(0)
  IF NOT @s_exist(path%)
    CHAR{path%}="[3][|Chemin systŠme non d‚fini|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 systŠme de EB_Dump
  r_resident!=FALSE
  ' ----------------------------------------------------------------------------
  CHAR{disque%}=CHAR{disque_systeme%}+CHR$(0)
  CHAR{path%}=CHAR{path_systeme%}+CHR$(0)
  '
  ' ============================================================================
  ' ==== Faire tout les MALLOC n‚cessaires au bon fonctionnement du programme ==
  ' ============================================================================
  reservation_memoire
  '
  ' ============================================================================
  ' ====                      D‚calage des palettes                           ==
  ' ============================================================================
  BYTE{palette%}=0
  BYTE{ADD(palette%,1)}=2
  BYTE{ADD(palette%,2)}=3
  BYTE{ADD(palette%,3)}=6
  BYTE{ADD(palette%,4)}=4
  BYTE{ADD(palette%,5)}=7
  BYTE{ADD(palette%,6)}=5
  BYTE{ADD(palette%,7)}=8
  BYTE{ADD(palette%,8)}=9
  BYTE{ADD(palette%,9)}=10
  BYTE{ADD(palette%,10)}=11
  BYTE{ADD(palette%,11)}=14
  BYTE{ADD(palette%,12)}=12
  BYTE{ADD(palette%,13)}=15
  BYTE{ADD(palette%,14)}=13
  BYTE{ADD(palette%,15)}=1
  '
  BYTE{palette2%}=0
  BYTE{ADD(palette2%,1)}=2
  BYTE{ADD(palette2%,2)}=3
  BYTE{ADD(palette2%,3)}=1
  '
  ' ............................................................................
  ' .... Ensuite, on recopie la zone  contenant le fichier … charger dans   ....
  ' .... la zone pr‚vue … cet effet.                                        ....
  ' .... et on rempli les diff‚rents champs ASCII pr‚-d‚finis               ....
  ' ............................................................................
  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
  '
  IF NOT haute_resolution!
    forcer_taille_ressource
  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|,mode_capture|
  '
  CLR global_departx&,global_departy&
  CLR global_largeur&,global_hauteur&
  CLR global_taille_ecran%
  CLR global_taille_tga%
  CLR global_ecran%,global_tga%
  CLR global_largeur_preview&
  CLR global_hauteur_preview&
  CLR global_ecran%
  CLR global_tga%
  CLR global_preview%
  mode_selecteur!=FALSE
  '
  fin_programme!=FALSE
  '
  CLR adr_desk%
  ~@wind_get(0,wf_workxywh&,global_xb&,global_yb&,global_wb&,global_hb&)     ! Coordonn‚es du bureau
  graf_mouse(fleche&,0)
  wind_calc(1,&X0,global_xb&,global_yb&,global_wb&,global_hb&,x&,y&,w&,h&)
  '
  CLR mode_capture|
  CLR avec_decors!
  '
  charger_configuration
  '
  ' Par d‚faut, nous partons en mode "Plein ‚cran"
  global_departx&=0
  global_departy&=0
  global_largeur&=SUCC(global_xmax&)
  global_hauteur&=SUCC(global_ymax&)
  faire_image
  '
  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%}+"EB_DUMP.RSC"+CHR$(0)
  IF @xrsrc_load(mem_che%)=0
    CHAR{mem_che%}="[3][|EB_DUMP.RSC non charg‚|EB_DUMP.RSC not loaded|][ Ok ]"+CHR$(0)
    ~@afficher_alerte(mem_che%)
    RETURN FALSE
  ELSE
    initialiser_ressource_1
  ENDIF
  adr_generale%={ress%}                                 !  0
  adr_config%={ADD(ress%,4)}                            !  1
  adr_popup%={ADD(ress%,8)}                             !  2
  '
  RETURN TRUE
ENDFUNC
PROCEDURE lire_la_ligne_de_commande(l0%,l1%)
  ~@shel_read(l0%,l1%)
RETURN
FUNCTION mode_entrelace_256           ! 256 couleurs, ‚cran entrelac‚ ou pas ?
  LOCAL zonevide%,retour%
  LOCAL taillezonevide%
  ' Bon faisont plaisir aux propri‚taires de cartes dont les pilotes de respectent rien
  '
  ' On cr‚‚ une petite zone m‚moire pour y copier le d‚but de l'‚cran
  taillezonevide%=(((10/8)*10)*plan_systeme&)
  zonevide%=@prendre(0,FALSE,3)
  ' On y copie un bout de l'‚cran c'est inutile mais je pr‚fŠre
  clip_raster(0,0,0,0,zonevide%,10,10,plan_systeme&,0,0,10,10,0,0,10,10,3)
  ' On met le premier octet de l'‚cran … 0
  BYTE{zonevide%}=0
  ' On remet tout cela sur l'‚cran
  clip_raster(zonevide%,10,10,plan_systeme&,0,0,0,0,0,0,10,10,0,0,10,10,3)
  '
  ' Choisir une couleur sans d‚calage 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)
  '
  ' On remet l'‚cran dans la zone r‚serv‚e … cette effet
  clip_raster(0,0,0,0,zonevide%,10,10,plan_systeme&,0,0,10,10,0,0,10,10,3)
  '
  ' Lire le premier octet de cette zone en acc‚s direct
  ' Si le contenu est ‚gale … la couleur, l'‚cran n'est pas entrelac‚
  ' et par cons‚quent, nous nous trouvons sur une carte graphique
  retour%=(BYTE{zonevide%}<>4)
  '
  ' Allez on rend la m‚moire
  libere(*zonevide%)
  '
  RETURN retour%
ENDFUNC
FUNCTION mode_entrelace_16            ! 256 couleurs, ‚cran entrelac‚ ou pas ?
  LOCAL zonevide%,retour%
  LOCAL taillezonevide%
  ' Bon faisont plaisir aux propri‚taires de cartes dont les pilotes de respectent rien
  '
  ' On cr‚‚ une petite zone m‚moire pour y copier le d‚but de l'‚cran
  taillezonevide%=(((10/8)*10)*plan_systeme&)
  zonevide%=@prendre(0,FALSE,3)
  ' On y copie un bout de l'‚cran c'est inutile mais je pr‚fŠre
  clip_raster(0,0,0,0,zonevide%,10,10,plan_systeme&,0,0,10,10,0,0,10,10,3)
  ' On met le premier octet de l'‚cran … 0
  BYTE{zonevide%}=0
  ' On remet tout cela sur l'‚cran
  clip_raster(zonevide%,10,10,plan_systeme&,0,0,0,0,0,0,10,10,0,0,10,10,3)
  '
  ' Choisir une couleur sans d‚calage 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)
  '
  ' On remet l'‚cran dans la zone r‚serv‚e … cette effet
  clip_raster(0,0,0,0,zonevide%,10,10,plan_systeme&,0,0,10,10,0,0,10,10,3)
  '
  ' Lire le premier octet de cette zone en acc‚s direct
  ' Si le contenu est ‚gale … la couleur, l'‚cran n'est pas entrelac‚
  ' et par cons‚quent, nous nous trouvons sur une carte graphique
  retour%=(BYTE{zonevide%}<>64)
  '
  ' Allez on rend la m‚moire
  libere(*zonevide%)
  '
  RETURN retour%
ENDFUNC
' ------------------------------------------------------------------------------
PROCEDURE initialiser_ressource_1     ! Mettre en m‚moire adresses ressource 1
  LOCAL adr%
  LOCAL x&,y&,w&,h&
  '
  ~@xrsrc_gaddr(0,generale&,adr%)
  {ress%}=adr%
  ~@xrsrc_gaddr(0,config&,adr%)
  {ADD(ress%,4)}=adr%
  ~@xrsrc_gaddr(0,popup&,adr%)
  {ADD(ress%,8)}=adr%
  '
  form_center({ress%},x&,y&,w&,h&)
  form_center({ADD(ress%,4)},x&,y&,w&,h&)
RETURN
PROCEDURE forcer_taille_ressource     ! Pour des r‚solutions trŠs basses
  '
  OB_H(adr_generale%,0)=176
  OB_H(adr_generale%,nouvelle&)=24
  OB_H(adr_generale%,sauver&)=16
  OB_H(adr_generale%,imprimer&)=16
  OB_H(adr_generale%,mode0&)=16
  OB_H(adr_generale%,mode1&)=16
  OB_H(adr_generale%,quitter&)=16
  OB_H(adr_generale%,aide&)=16
  OB_H(adr_generale%,tmode&)=16
  OB_H(adr_generale%,image&)=120
  OB_H(adr_generale%,tnbp&)=16
  OB_H(adr_generale%,nbp&)=16
  OB_H(adr_generale%,tdecors&)=16
  OB_H(adr_generale%,decors&)=16
  '
  OB_Y(adr_generale%,nouvelle&)=8
  OB_Y(adr_generale%,sauver&)=80
  OB_Y(adr_generale%,imprimer&)=104
  OB_Y(adr_generale%,mode0&)=128
  OB_Y(adr_generale%,mode1&)=128
  OB_Y(adr_generale%,quitter&)=152
  OB_Y(adr_generale%,aide&)=152
  OB_Y(adr_generale%,tmode&)=128
  OB_Y(adr_generale%,image&)=0
  OB_Y(adr_generale%,tnbp&)=48
  OB_Y(adr_generale%,nbp&)=48
  OB_Y(adr_generale%,tdecors&)=152
  OB_Y(adr_generale%,decors&)=152
  '
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 m‚moire
    ' Il est donc impossible de d‚terminer le type d'ATARI sur lequel
    ' on se trouve par le systŠme 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 d‚faut 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 d‚faut)
          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 d‚faut 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 pr‚sent
          son|=0
        ENDIF
        IF BTST(long%,1)                        ! 8 Bit DMA pr‚sent
          son|=1                                        ! (STe, TT et FALCON)
        ENDIF
        IF BTST(long%,2)                        ! 16 Bit CODEC pr‚sent (FALCON)
          son|=2
        ENDIF
        IF BTST(long%,3)                        ! DSP pr‚sent (FALCON)
          son|=3
        ENDIF
        IF BTST(long%,4)                        ! MATRIX pr‚sent (FALCON)
          son|=4
        ENDIF
      CASE "MagX"                               ! Multitƒche 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"                               ! Multitƒche avec Geneva
        geneva!=TRUE
      CASE "MiNT"                               ! Multitƒche 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"
        ' "D‚codeur JPEG pr‚sent"
      CASE "_AFM"
        ' "Audio Fun Machine pr‚sent"
      CASE "WINX"
        mode_winx!=TRUE
      CASE "T2GM"
        tos2gem!=TRUE
        adresse_tos2gem%=long%
      CASE "FSMC"
        IF CHAR{long%}="_FSM"                   ! "FSM GDOS pr‚sent"
          speedogdos!=TRUE
        ELSE IF CHAR{long%}="_SPD"              ! "SPEEDO GDOS pr‚sent"
          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
' ******************************************************************************
PROCEDURE definir_variables           ! Quelques variables globales
  index_ressource_1
  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 r‚serv‚es pour EB_Dump ---------------
  eb_dump_capture_fullscreen&=&H4511
  eb_dump_capture_window&=&H4512
  eb_dump_capture_mouse&=&H4513
  eb_dump_disable_selector&=&H4514
  eb_dump_enable_selector&=&H4515
  eb_dump_disable_windframe&=&H4516
  eb_dump_enable_windframe&=&H4517
  ' ---- Constantes concernant les ‚vŠnements MESSAGE ----
  mn_selected&=10       ! S‚lection d'un menu
  wm_redraw&=20         ! Demande de redessin d'‚cran
  wm_topped&=21         ! R‚activation d'un fenˆtre par clic
  wm_closed&=22         ! Fermeture d'une fenˆtre
  wm_fulled&=23         ! Mise en plein ‚cran d'une fenˆtre
  wm_arrowed&=24        ! Clic sur un des uatres champs fl‚ch‚s
  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 fenˆtre
  wm_moved&=28          ! D‚placement d'une fenˆtre
  wm_newtop&=29         ! R‚activation d'une fenˆtre par femeture d'une autre
  wm_zero&=9999         ! Mise … z‚ro des messages
  ac_open&=40           ! Ouverture d'un acc‚ssoire
  ac_close&=41          ! Fermeture d'un accessoire
  ' Ajouter par moi mˆme pour la gestion des ‚l‚ments non GEM d'une fenˆtre
  wm_xmenu&=9           ! Bouton d'ouverture du popup de gestion fenˆtre
  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      ! R‚duction d'une fenˆtre
  wm_xmoved&=14         ! D‚placement d'une fenˆtre
  wm_xclosed&=15        ! Fermeture d'une fenˆtre
  ' ---- Constantes concernant les ‚vŠnements FENETRE ----
  wf_kind&=1            ! Fixe de nouvelles parties de fenˆtre
  wf_name&=2            ! Fixe un nom de fenˆtre
  wf_info&=3            ! Fixe une nouvelle info de fenˆtre
  wf_workxywh&=4        ! Coordonn‚es de la zone de travail de fenˆtre
  wf_currxywh&=5        ! Coordonnees de la zone total de fenˆtre
  wf_prevxywh&=6        ! Taille globale fenˆtre pr‚c‚dente
  wf_fullxywh&=7        ! Taille globale fenˆtre plein ‚cran
  wf_hslide&=8          ! Position poussoir horizontal
  wf_vslide&=9          ! Position poussoir vertical
  wf_top&=10            ! Code de fenˆtre 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/d‚sactivation 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 accŠs 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_generale&=0
  idx_generale_dbl&=0
  idx_config&=1
  idx_config_dbl&=2
  '
  ' ++SYM
RETURN
PROCEDURE index_ressource_1           ! Constantes globales du ressource nø1
  ' ++SYM
  '
  REM Resource file indices for EB_DUMP.
  '
  LET general&=0 ! Form/Dialog-box
  LET image&=1 ! BOX in tree GENERAL
  LET nouvelle&=2 ! BUTTON in tree GENERAL
  LET sauver&=3 ! BUTTON in tree GENERAL
  LET imprimer&=4 ! BUTTON in tree GENERAL
  LET tmode&=5 ! STRING in tree GENERAL
  LET mode0&=6 ! BUTTON in tree GENERAL
  LET mode1&=7 ! BUTTON in tree GENERAL
  LET quitter&=8 ! BUTTON in tree GENERAL
  LET aide&=9 ! BUTTON in tree GENERAL
  LET nbp&=10 ! BOXTEXT in tree GENERAL
  LET tnbp&=11 ! STRING in tree GENERAL
  LET tdecors&=12 ! STRING in tree GENERAL
  LET decors&=13 ! BOX in tree GENERAL
  '
  LET config&=1 ! Form/Dialog-box
  LET chemin&=1 ! BOXTEXT in tree CONFIG
  LET quitopt&=4 ! BUTTON in tree CONFIG
  '
  LET popup&=2 ! Form/Dialog-box
  LET opt1&=1 ! TEXT in tree POPUP
  LET opt2&=2 ! TEXT in tree POPUP
  LET opt3&=3 ! TEXT in tree POPUP
  '
  ' ++SYM
RETURN
' ******************************************************************************
PROCEDURE reservation_memoire         ! Un peu de m‚moire 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%,20                         ! d‚calage palette 16 couleurs
  ADD taille_totale%,20                         ! d‚calage palette  4 couleurs
  ADD taille_totale%,20                         ! Titre de la fenˆtre
  ADD taille_totale%,24                         ! mem_num%
  ADD taille_totale%,32                         ! buf%
  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%,2048                       ! redraw_mem%
  ' ----------------------------------------------------------------------------
  '
  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
    palette%=@zone(20,adresse%)                 ! D‚calage palette 16 couleurs
    palette2%=@zone(20,adresse%)                ! D‚calage palette  4 couleurs
    titre%=@zone(20,adresse%)                   ! Titre de la fenˆtre
    mem_num%=@zone(24,adresse%)                 ! Pour les tris de faces
    buf%=@zone(32,adresse%)                     ! Le buffer d'‚v‚nement
    hwind%=@zone(64,adresse%)                   ! Les fenˆtres (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'acc‚s 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%)         ! Coordonn‚es des polygones VDI
    temporaire%=@zone(1144,adresse%)            ! Pour les appels externes
    redraw_mem%=@zone(2048,adresse%)            ! Pour effectuer des redraws corrects
    global_ecran%=@zone(ADD(global_taille_ecran%,256),adresse%)         ! le buffer ‚cran
    global_ecran%=SHL(SHR(ADD(global_ecran%,256),8),8)   ! Multiple de 256 |
    global_tga%=@zone(global_taille_tga%,adresse%)       ! L'image sauver
    ' --------------------------------------------------------------------!
  ELSE
    CHAR{path%}="[3][|Manque de m‚moire !|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 m‚moire 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 fenˆtre
        IF INT{ADD(hwind%,SHL(i&,1))}>-1                ! Si la fenˆtre est ouverte
          wind_close(INT{ADD(hwind%,SHL(i&,1))})        ! La fermer
          wind_delete(INT{ADD(hwind%,SHL(i&,1))})       ! La d‚truire
          INT{ADD(hwind%,SHL(i&,1))}=-1
        ENDIF
        DEC i&
      LOOP WHILE i&>-1
    ENDIF
  ENDIF
  ' ----------------------------------------------------------------------------
  graf_mouse(fleche&,0)
  '                           Effacer les vecteurs normaux
  wind_set(0,wf_newdesk&,0,0,0,0)       ! Rendre le bureau
  IF @xrsrc_free<>0
    libere(ADD(f_init%,4))
    xrsrc_exit
  ENDIF
  libere(*global_zone%)
  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
' ********************************************************************************
PROCEDURE charger_configuration               ! Lire "EB_DUMP.CFG"
  LOCAL termine!,handle%
  '
  CHAR{mem_che%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+"eb_dump.cfg"+CHR$(0)
  IF @s_exist(mem_che%)
    handle%=@fopen(mem_che%,gemdos_read%)
    IF @flof(handle%)
      DO
        membfill(mem_che%,512,0)
        termine!=@lire_une_ligne(mem_che%,handle%)
        EXIT IF LEFT$(CHAR{mem_che%},3)="EOF"
        IF LEN(CHAR{mem_che%})>1
          $S$,$S>
          SELECT LEFT$(CHAR{mem_che%},3)
          CASE "CHE"
            enleve_code(mem_che%)
            CHAR{{OB_SPEC(adr_config%,chemin&)}}=CHAR{mem_che%}+CHR$(0)
          CASE "DEC"
            enleve_code(mem_che%)
            avec_decors!=(VAL(CHAR{mem_che%})=-1)
          CASE "MOD"
            enleve_code(mem_che%)
            mode_capture|=VAL(CHAR{mem_che%})
          ENDSELECT
        ENDIF
        EXIT IF termine!
      LOOP
    ENDIF
    ~@fclose(handle%)
  ENDIF
  '
RETURN
PROCEDURE sauver_configuration                ! et sauvegarde
  LOCAL handle%
  '
  CHAR{mem_che%}=CHAR{disque_systeme%}+CHAR{path_systeme%}+"\eb_dump.cfg"+CHR$(0)
  handle%=@fcreate(mem_che%,0)
  '
  CHAR{mem_che%}="# Fichier de configuration EB_DUMP. Ce fichier"+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}=""+CHR$(13)+CHR$(10)+CHR$(0)
  CHAR{mem_che%}="# est mis … jour automatiquement par EB_Dump  "+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="#"+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="#(c) BARANGER Emmanuel - Version 0.1.0 Avril 2006"+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="#------------------------------------------------"+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="#   Chemin de sauvegarde par d‚faut"+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="CHE "+CHAR{{OB_SPEC(adr_config%,chemin&)}}+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="DEC "+STR$(avec_decors!)+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="MOD "+STR$(mode_capture|)+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}="EOF"+CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  CHAR{mem_che%}=CHR$(13)+CHR$(10)+CHR$(0)
  ~@fwrite(handle%,mem_che%,LEN(CHAR{mem_che%}))
  '
  ~@fclose(handle%)
  '
RETURN
' ******************************************************************************
FUNCTION lire_une_ligne(b%,handle%)
  LOCAL lig%,f!,pos%
  LOCAL locf%,flof%
  '
  flof%=@flof(handle%)
  '
  lig%=b%
  DO
    ~@fread(handle%,lig%,1)
    floc%=@floc(handle%)
    f!=(floc%=>flof%)
    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 enlŠve les espaces en trop
  CHAR{b%}=RIGHT$(CHAR{b%},SUB(LEN(CHAR{b%}),3))
  b%=@enleve_caractere(b%,&H20)
RETURN
' **************************** Gestion de la m‚moire ***************************
FUNCTION prendre(tl%,id!,mod|)         ! Prendre un peu de m‚moire
  LOCAL l%,dummy&
  ' Adapter la taille au multiple de 16 imm‚diatement sup‚rieur
  tl%=SHL(SHR(ADD(tl%,16),4),4)
  '
  IF GEMDOS(&H44,L:-1,W:0)<>-32       ! La fonction est elle accept‚e
    IF multitache!
      mod|=mod| OR &X11000            ! Force l'utilisation des informations de
    ENDIF                             ! l'entˆte
    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 m‚moire
  IF GEMDOS(&H44,L:-1,W:0)<>-32         ! La fonction est elle accept‚e
    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 m‚moire … 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 … S‚bastien 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 sup‚rieure ou ‚gale … 256 octets
  IF AND(size%,&HFF00)
    FOR nombre%=1 TO SHR(size%,8)         ! autant de fois que n‚cessaire
      BMOVE precalcul%,vide_adr%,256      ! Remplir de blanc
      ADD vide_adr%,256                   ! Avancer dans la zone m‚moire
    NEXT nombre%
  ENDIF
  BMOVE precalcul%,vide_adr%,AND(size%,&HFF) ! on finit de recopier les donn‚es
  '
RETURN
PROCEDURE garbage_collector            ! Un peu de m‚nage dans la m‚moire
  ~FRE(0)
  ~FRE()
RETURN
FUNCTION zone(tal%,VAR adresse%)       ! D‚calage d'adresse en m‚moire
  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    ! Num‚ro 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      ! Num‚ro 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          ! Num‚ro 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    ! Num‚ro 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                  ! Num‚ro 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          ! Num‚ro 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          ! Num‚ro 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 fenˆtres
  DO
    ' Si la fenˆtre 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-mˆme un message de redraw
      INT{buf%}=wm_redraw&              ! Num‚ro du message
      INT{ADD(buf%,2)}=ap_id&           ! Indentificateur exp‚diteur du message
      INT{ADD(buf%,4)}=0                ! Pas d'exc‚dent au message
      INT{ADD(buf%,6)}=INT{ADD(hwind%,SHL(i&,1))} ! Handle fenˆtre concern‚e
      INT{ADD(buf%,8)}=xw&              ! Cordonn‚e 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&        ! Coordonn‚es rectangle … redessiner
  rdy&=y&
  rdw&=w&
  rdh&=h&
  ' L…, on commence par r‚cup‚rer tout les rectangles … redessiner.
  ' Ainsi, on est sur qu'aucune perturbation ne viendra stoper les
  ' redessins d'‚crans de mˆme que mes routines de dessins qui bloque
  ' les listes de rectangles.
  CLR cp&
  r%=redraw_mem%                ! Zone de m‚morisation 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 r‚serve...
  LOOP
  ' Et voil…. Maintenant, le GEM peut faire ce qu'il veut. La liste des
  ' rectangles est sauv‚e. 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&>global_xmax&
          redrw&=SUB(redrw&,SUB(x_f&,global_xmax&))
        ENDIF
        y_f&=PRED(ADD(redry&,redrh&))
        IF y_f&>global_ymax&
          redrh&=SUB(redrh&,SUB(y_f&,global_ymax&))
        ENDIF
        $S|,S>
        SELECT index&
        CASE idx_generale&
          affiche_image_preview(redrx&,redry&,redrw&,redrh&)
        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 ‚l‚ment … 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&
  '
  ' Coordonn‚es 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 d‚saturer 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 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
' ******************************************************************************
PROCEDURE faire_image
  LOCAL taille_totale%,global_zone%,adresse%
  LOCAL evt&
  '
  ' (160/8) * 120 * nombre de plans pour une pr‚view de base sauf
  ' si la zone … sauver est plus petite en largeur et/ou hauteur
  '
  global_largeur_preview&=160
  IF global_largeur&<global_largeur_preview&
    global_largeur_preview&=global_largeur&
  ENDIF
  '
  global_hauteur_preview&=120
  IF global_hauteur&<global_hauteur_preview&
    global_hauteur_preview&=global_hauteur&
  ENDIF
  OB_W(adr_generale%,image&)=global_largeur_preview&
  OB_H(adr_generale%,image&)=global_hauteur_preview&
  '
  IF global_zone%<>0
    libere(*global_zone%)
  ENDIF
  ' **************** Taille des images utiles
  global_taille_ecran%=(global_largeur&/8)*global_hauteur&*plan_systeme&
  global_taille_tga%=ADD(((global_largeur&/8)*global_hauteur&*24),18)
  global_taille_preview%=(global_largeur_preview&/8)*global_hauteur_preview&*plan_systeme&
  '
  ' **************** R‚servons les zones m‚moire n‚cessaire au bon fonctionnement de tout cela
  '
  CLR taille_totale%
  ADD taille_totale%,ADD(global_taille_ecran%,256)
  ADD taille_totale%,global_taille_tga%
  ADD taille_totale%,global_taille_preview%
  '
  IF taille_totale%<MAX(@memoire_dispo(0),@memoire_dispo(1))
    global_zone%=@prendre(taille_totale%,TRUE,3)
    adresse%=global_zone%
    '
    global_ecran%=@zone(ADD(global_taille_ecran%,256),adresse%)
    global_ecran%=SHL(SHR(ADD(global_ecran%,256),8),8)          ! Multiple de 256
    global_tga%=@zone(global_taille_tga%,adresse%)              ! L'image sauver
    global_preview%=@zone(global_taille_preview%,adresse%)      ! L'image preview
  ENDIF
  '
  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)
  ecran_vers_buffer
  reduction
  '
RETURN
PROCEDURE reduction
  LOCAL s%,sl&,sh&,sp&,x11&,y11&,x21&,y21&
  LOCAL d%,dl&,dh&,dp&
  LOCAL reducx%,taille_reducx%
  LOCAL pasx&
  LOCAL pasy&
  LOCAL sx&,sy&
  LOCAL dx&,dy&
  '
  pasx&=DIV(global_largeur&,global_largeur_preview&)
  pasy&=DIV(global_hauteur&,global_largeur_preview&)
  '
  taille_reducx%=(global_largeur_preview&/8)*global_hauteur&*plan_systeme&
  reducx%=@prendre(taille_reducx%,TRUE,3)
  '
  CLR sx&,dx&
  DO
    ' ************************* D‚finition du raster source
    s%=global_ecran%                 ! L'adresse de l'image de l'‚cran
    sl&=global_largeur&              ! Sa largeur
    sh&=global_hauteur&              ! Sa hauteur
    sp&=plan_systeme&                ! Son nombre de plans (comme l'‚cran)
    ' ************************* D‚finition du raster destination
    d%=reducx%                       ! L'adresse de l'image de l'‚cran
    dl&=global_largeur_preview&      ! Sa largeur
    dh&=global_hauteur&              ! Sa hauteur
    dp&=plan_systeme&                ! Son nombre de plans (comme l'‚cran)
    ' ************************* Definition de la partie … d‚placer
    x11&=sx&                         ! Position X source
    y11&=0                           ! Position Y source
    x21&=dx&                         ! Position X destination
    y21&=0                           ! Position Y destination
    clip_raster(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x21&,y21&,sx&,0,1,global_hauteur&,3)
    '
    INC dx&
    ADD sx&,pasx&
    EXIT IF sx&=>global_largeur&
  LOOP
  '
  CLR sy&,dy&
  DO
    ' ************************* D‚finition du raster source
    s%=reducx%                       ! L'adresse de l'image source
    sl&=global_largeur_preview&      ! Sa largeur
    sh&=global_hauteur&              ! Sa hauteur
    sp&=plan_systeme&                ! Son nombre de plans (comme l'‚cran)
    ' ************************* D‚finition du raster destination
    d%=global_preview%               ! L'adresse de l'image destination
    dl&=global_largeur_preview&      ! Sa largeur
    dh&=global_hauteur_preview&      ! Sa hauteur
    dp&=plan_systeme&                ! Son nombre de plans (comme l'‚cran)
    ' ************************* Definition de la partie … d‚placer
    x11&=0                           ! Position X source
    y11&=sy&                         ! Position Y source
    x21&=0                           ! Position X destination
    y21&=dy&                         ! Position Y destination
    clip_raster(s%,sl&,sh&,sp&,d%,dl&,dh&,dp&,x11&,y11&,x21&,y21&,0,sy&,global_largeur_preview&,1,3)
    '
    INC dy&
    ADD sy&,pasy&
    EXIT IF sy&=>global_hauteur&
  LOOP
  '
  libere(*reducx%)
  '
RETURN
'
PROCEDURE ecran_vers_buffer           ! On sauve l'‚cran complet
  LOCAL ex&,ey&,ew&,eh&
  LOCAL d%,dl&,dh&,dp&
  LOCAL x11&,y11&,x21&,y21&
  '
  ex&=global_departx&
  ey&=global_departy&
  ew&=global_largeur&
  eh&=global_hauteur&
  ' ************************* D‚finition du raster source
  '                                C'est l'‚cran le GEM s'occupe de tout
  ' ************************* D‚finition du raster destination
  d%=global_ecran%                 ! L'adresse de l'image
  dl&=global_largeur&              ! Sa largeur
  dh&=global_hauteur&              ! Sa hauteur
  dp&=plan_systeme&                ! Son nombre de plans (comme l'‚cran)
  ' ************************* Definition de la partie … d‚placer
  x11&=global_departx&             ! Position X source
  y11&=global_departy&             ! Position Y source
  x21&=0                           ! Position X destination
  y21&=0                           ! Position Y destination
  '
  clip_raster(0,0,0,0,d%,dl&,dh&,dp&,x11&,y11&,x21&,y21&,ex&,ey&,ew&,eh&,3)
  '
RETURN
'
PROCEDURE affiche_image_preview(rx&,ry&,rw&,rh&)
  LOCAL zx&,zy&,zw&,zh&
  '
  objc_draw(@arbre_ressource(idx_generale&),0,12,rx&,ry&,rw&,rh&,-1)
  '
  objc_offset(adr_generale%,image&,zx&,zy&)
  zw&=OB_W(adr_generale%,image&)
  zh&=OB_H(adr_generale%,image&)
  IF PRED(ADD(zx&,zw&))>global_xmax&
    zw&=SUB(zw&,SUB(PRED(ADD(zx&,zw&)),global_xmax&))
  ENDIF
  IF PRED(ADD(zy&,zh&))>global_ymax&
    zh&=SUB(global_hf&,SUB(PRED(ADD(zy&,zh&)),global_ymax&))
  ENDIF
  '
  IF RC_INTERSECT(rx&,ry&,rw&,rh&,zx&,zy&,zw&,zh&)
    objc_draw(@arbre_ressource(idx_generale&),image&,0,zx&,zy&,zw&,zh&,-1)
    preview_vers_ecran(zx&,zy&,zw&,zh&)
  ENDIF
  '
RETURN
PROCEDURE preview_vers_ecran(rx&,ry&,rw&,rh&)
  LOCAL ex&,ey&,ew&,eh&,xf&,yf&,wf&,hf&
  LOCAL s%,sl&,sh&,sp&,x11&,y11&,x21&,y21&
  '
  objc_offset(adr_generale%,image&,xf&,yf&)
  wf&=OB_W(adr_generale%,image&)
  hf&=OB_H(adr_generale%,image&)
  '
  ex&=rx&
  ey&=ry&
  ew&=rw&
  eh&=rh&
  ' ************************* D‚finition du raster source
  s%=global_preview%               ! L'adresse de l'image
  sl&=global_largeur_preview&      ! Sa largeur
  sh&=global_hauteur_preview&      ! Sa hauteur
  sp&=plan_systeme&                ! Son nombre de plans (comme l'‚cran)
  ' ************************* D‚finition du raster destination
  '                                C'est l'‚cran le GEM s'occupe de tout
  ' ************************* Definition de la partie … d‚placer
  x11&=SUB(rx&,xf&)                ! Position X source
  y11&=SUB(ry&,yf&)                ! Position Y source
  x21&=rx&                         ! Position X destination
  y21&=ry&                         ! Position Y destination
  clip_raster(s%,sl&,sh&,sp&,0,0,0,0,x11&,y11&,x21&,y21&,ex&,ey&,ew&,eh&,3)
RETURN
' ***
PROCEDURE incrementer_nom_fichier
  LOCAL sort!,num&
  '
  CLR num&
  sort!=FALSE
  DO
    CHAR{nom_divers%}="snap"+RIGHT$("0000"+STR$(num&),4)+".tga"+CHR$(0)
    membfill(mem_che%,512,0)
    CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+CHAR{nom_divers%}+CHR$(0)
    IF @s_exist(mem_che%)
      INC num&
    ELSE
      sort!=TRUE
    ENDIF
    EXIT IF sort!
  LOOP
  '
RETURN
' ******************************************************************************
PROCEDURE sauver_image_tga_type_2
  LOCAL lar_gou&,hau_gou&,n%,handle%
  LOCAL tgax&,tgay&,adr_src%,adr_des%
  LOCAL ro|,ve|,bl|
  LOCAL ro&,ve&,bl&,bit&,pt!,point|,col&
  '
  IF (mode_entrelace!=FALSE) AND ((plan_systeme&=2) OR (plan_systeme&=4))
    CHAR{a_charger%}="[1]["
    CHAR{a_charger%}=CHAR{a_charger%}+" D‚sol‚ les modes 4, 16    |"
    CHAR{a_charger%}=CHAR{a_charger%}+" couleurs non entrelac‚s   |"
    CHAR{a_charger%}=CHAR{a_charger%}+" ne sont pas encore g‚r‚s. |"
    CHAR{a_charger%}=CHAR{a_charger%}+" Suis pas Superman hein :) |"
    CHAR{a_charger%}=CHAR{a_charger%}+"][ D‚sol‚ ]"+CHR$(0)
    ~@afficher_alerte(a_charger%)
  ELSE
    '
    CHAR{masque%}="tga"+CHR$(0)
    CHAR{msq%}="tgk"+CHR$(0)
    CHAR{nom_divers%}="snap0000.tga"+CHR$(0)
    definition_fichier(adr_config%,chemin&,nom_divers%,FALSE,mode_selecteur!,-1)
    IF LEN(CHAR{nom_divers%})<>0
      IF NOT mode_selecteur!
        @incrementer_nom_fichier
      ENDIF
      membfill(mem_che%,512,0)
      CHAR{mem_che%}=CHAR{disque%}+CHAR{path%}+CHAR{nom_divers%}+CHR$(0)
      '
      lar_gou&=global_largeur&                          ! Largeur de la fenˆtre
      hau_gou&=global_hauteur&                          ! Hauteur de la fenˆtre
      '
      ' Tous les mots mots sont invers‚s (Lo/Hi)
      BYTE{ADD(global_tga%,0)}=0                        ! 0= entˆte, taille 17
      BYTE{ADD(global_tga%,1)}=0                        ! Pas de palette
      BYTE{ADD(global_tga%,2)}=2                        ! TGA 2 RGB non compress‚e
      BYTE{ADD(global_tga%,3)}=0                        ! \
      BYTE{ADD(global_tga%,4)}=0                        !  \
      BYTE{ADD(global_tga%,5)}=0                        !   > Ignor‚ (pas de palette)
      BYTE{ADD(global_tga%,6)}=0                        !  /
      BYTE{ADD(global_tga%,7)}=0                        ! /
      BYTE{ADD(global_tga%,8)}=0                        ! \ Position de l'image en X
      BYTE{ADD(global_tga%,9)}=0                        ! /             0
      BYTE{ADD(global_tga%,10)}=0                       ! \ Position de l'image en Y
      BYTE{ADD(global_tga%,11)}=0                       ! /             0
      BYTE{ADD(global_tga%,12)}=BYTE(lar_gou&)          ! \ Largeur de l'image
      BYTE{ADD(global_tga%,13)}=BYTE(ROR&(lar_gou&,8))  ! / en mode UNTEL (Lo/Hi)
      BYTE{ADD(global_tga%,14)}=BYTE(hau_gou&)          ! \ Hauteur de l'image
      BYTE{ADD(global_tga%,15)}=BYTE(ROR&(hau_gou&,8))  ! / en mode UNTEL (Lo/Hi)
      BYTE{ADD(global_tga%,16)}=24                      ! Nombre de plan de l'image
      BYTE{ADD(global_tga%,17)}=32                      ! D‚part : en bas … gauche
      '
      adr_src%=global_ecran%
      adr_des%=ADD(global_tga%,18)
      '
      CLR tgay&
      DO
        CLR tgax&
        DO
          '
          $S&,$S>
          SELECT plan_systeme&
          CASE 1
            bit&=15
            DO
              IF BTST(CARD{adr_src%},bit&)
                ' Point noir
                BYTE{adr_des%}=0
                INC adr_des%
                BYTE{adr_des%}=0
                INC adr_des%
                BYTE{adr_des%}=0
                INC adr_des%
              ELSE
                ' Point blanc
                BYTE{adr_des%}=255
                INC adr_des%
                BYTE{adr_des%}=255
                INC adr_des%
                BYTE{adr_des%}=255
                INC adr_des%
              ENDIF
              DEC bit&
              EXIT IF bit&=-1
            LOOP
            ADD adr_src%,2
            ADD tgax&,15
          CASE 2
            IF mode_entrelace!
              bit&=15
              DO
                CLR point|
                IF BTST(CARD{adr_src%},bit&)
                  point|=BSET(point|,0)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,2)},bit&)
                  point|=BSET(point|,1)
                ENDIF
                col&=BYTE{ADD(palette2%,point|)}
                inquire_color_representation(col&,ro&,ve&,bl&,vdihandle%)
                BYTE{adr_des%}=(bl&/1000)*255
                INC adr_des%
                BYTE{adr_des%}=(ve&/1000)*255
                INC adr_des%
                BYTE{adr_des%}=(ro&/1000)*255
                INC adr_des%
                '
                DEC bit&
                EXIT IF bit&=-1
              LOOP
              ADD adr_src%,4
              ADD tgax&,15
            ENDIF
          CASE 4
            IF mode_entrelace!
              bit&=15
              DO
                CLR point|
                IF BTST(CARD{adr_src%},bit&)
                  point|=BSET(point|,0)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,2)},bit&)
                  point|=BSET(point|,1)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,4)},bit&)
                  point|=BSET(point|,2)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,6)},bit&)
                  point|=BSET(point|,3)
                ENDIF
                col&=BYTE{ADD(palette%,point|)}
                inquire_color_representation(col&,ro&,ve&,bl&,vdihandle%)
                BYTE{adr_des%}=(bl&/1000)*255
                INC adr_des%
                BYTE{adr_des%}=(ve&/1000)*255
                INC adr_des%
                BYTE{adr_des%}=(ro&/1000)*255
                INC adr_des%
                '
                DEC bit&
                EXIT IF bit&=-1
              LOOP
              ADD adr_src%,8
              ADD tgax&,15
            ENDIF
          CASE 8
            IF mode_entrelace!
              bit&=15
              DO
                CLR point|
                IF BTST(CARD{adr_src%},bit&)
                  point|=BSET(point|,0)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,2)},bit&)
                  point|=BSET(point|,1)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,4)},bit&)
                  point|=BSET(point|,2)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,6)},bit&)
                  point|=BSET(point|,3)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,8)},bit&)
                  point|=BSET(point|,4)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,10)},bit&)
                  point|=BSET(point|,5)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,12)},bit&)
                  point|=BSET(point|,6)
                ENDIF
                IF BTST(CARD{ADD(adr_src%,14)},bit&)
                  point|=BSET(point|,7)
                ENDIF
                IF point|<16
                  col&=BYTE{ADD(palette%,point|)}
                ELSE
                  col&=point|
                ENDIF
                inquire_color_representation(col&,ro&,ve&,bl&,vdihandle%)
                '
                DEC bit&
                EXIT IF bit&=-1
              LOOP
              ADD adr_src%,16
              ADD tgax&,15
            ELSE
              point|=BYTE{adr_src%}
              INC adr_src%
              '
              IF point|<16
                col&=BYTE{ADD(palette%,point|)}
              ELSE
                col&=point|
              ENDIF
              inquire_color_representation(col&,ro&,ve&,bl&,vdihandle%)
              '
              BYTE{adr_des%}=(bl&/1000)*255
              INC adr_des%
              BYTE{adr_des%}=(ve&/1000)*255
              INC adr_des%
              BYTE{adr_des%}=(ro&/1000)*255
              INC adr_des%
            ENDIF
          CASE 15,16
            ro|=SHR(CARD{adr_src%},11) AND &X11111
            ve|=SHR(CARD{adr_src%},5) AND &X111111
            bl|=CARD{adr_src%} AND &X11111
            ADD adr_src%,2
            '
            BYTE{adr_des%}=(bl|/32)*255
            INC adr_des%
            BYTE{adr_des%}=(ve|/64)*255
            INC adr_des%
            BYTE{adr_des%}=(ro|/32)*255
            INC adr_des%
          CASE 24
            ro|=BYTE{adr_src%}
            INC adr_src%
            ve|=BYTE{adr_src%}
            INC adr_src%
            bl|=BYTE{adr_src%}
            INC adr_src%
            '
            BYTE{adr_des%}=ro|
            INC adr_des%
            BYTE{adr_des%}=ve|
            INC adr_des%
            BYTE{adr_des%}=bl|
            INC adr_des%
          CASE 32
            INC adr_src%
            bl|=BYTE{adr_src%}
            INC adr_src%
            ve|=BYTE{adr_src%}
            INC adr_src%
            ro|=BYTE{adr_src%}
            INC adr_src%
            '
            BYTE{adr_des%}=ro|
            INC adr_des%
            BYTE{adr_des%}=ve|
            INC adr_des%
            BYTE{adr_des%}=bl|
            INC adr_des%
          ENDSELECT
          '
          INC tgax&
        LOOP WHILE tgax&<lar_gou&
        INC tgay&
      LOOP WHILE tgay&<hau_gou&
      '
      handle%=@fcreate(mem_che%,0)
      ~@fwrite(handle%,global_tga%,global_taille_tga%)
      ~@fclose(handle%)
      '
    ENDIF
  ENDIF
  '
RETURN
' ******************************************************************************
' Les proc‚dures d'ouverture de fenˆtres.
PROCEDURE ouvrir_generale
  ecrire_donnees_dans_generale
  ouvrir_fenetre(idx_generale&,adr_generale%)
RETURN
PROCEDURE ouvrir_config
  ecrire_donnees_dans_config
  ouvrir_fenetre(idx_config&,adr_config%)
RETURN
' ------------------------------------------------------------------------------
PROCEDURE ouvrir_fenetre(index_de_fenetre&,adresse%)
  ' Ouverture fenˆtre formulaire
  LOCAL x&,y&,w&,h&      ! Coordonn‚es du formulaire
  LOCAL attr&            ! Attributs GEM de la fenˆtre
  LOCAL dummy&,adr%,adr1&,adr2&
  '
  attr&=&X1011
  ' Si la fenˆtre formulaire est d‚j… 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 coordonn‚es 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 d‚duire les coordonn‚es totales de la fenˆtre
    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
    IF global_yf&<global_yb&
      global_yf&=global_yb&
    ENDIF
    wind_calc(1,attr&,global_xf&,global_yf&,global_wf&,global_hf&,x&,y&,w&,h&)
    OB_X(adresse%,0)=x&
    ' Cr‚er la fenˆtre
    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 fenˆtre n'a pu ˆtre cr‚‚e
      ' ~@afficher_alerte(adr_nofenetre%)       ! Pr‚venir
    ELSE                                      ! Si la fenˆtre a pu ˆtre cr‚‚e
      CHAR{titre%}="EB Dump V 0.9.7"+CHR$(0)
      adr1&=CARD(ROR(titre%,16))
      adr2&=CARD(titre%)
      wind_set(INT{ADD(hwind%,SHL(index_de_fenetre&,1))},wf_name&,adr1&,adr2&,0,0)
      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_generale
  '
  CHAR{{OB_SPEC(adr_generale%,nbp&)}}=STR$(plan_systeme&,2)
  CHAR{OB_SPEC(adr_generale%,mode0&)}=CHAR{{OB_SPEC(adr_popup%,ADD(opt1&,mode_capture|))}}
  ob_state(adr_generale%,tdecors&,aes_disable&,(mode_capture|<>1))
  ob_state(adr_generale%,decors&,aes_disable&,(mode_capture|<>1))
  ob_state(adr_generale%,decors&,aes_checked&,avec_decors!)
  '
RETURN
PROCEDURE ecrire_donnees_dans_config
  '
  '
RETURN
' ************** Gestion des formulaires en fenˆtre GEM ************************
PROCEDURE gestion_generale
  LOCAL lx&,ly&,rep&
  '
  $S&,$S>
  SELECT objet&
  CASE nouvelle&
    objc_change(adr_generale%,objet&)
    fermeture_fenetre(idx_generale_dbl&)
    fermeture_fenetre(idx_config_dbl&)
    capture(-1,-1,-1,-1)
    ouvrir_generale
  CASE sauver&
    objc_change(adr_generale%,objet&)
    sauver_image_tga_type_2
  CASE imprimer&
    objc_change(adr_generale%,objet&)
  CASE mode0&,mode1&
    objc_change(adr_generale%,objet&)
    objc_offset(adr_generale%,mode0&,lx&,ly&)
    ADD ly&,OB_H(adr_generale%,mode0&)
    rep&=@popup(lx&,ly&,adr_popup%,opt1&,opt3&,0)
    IF rep&<>255
      CHAR{OB_SPEC(adr_generale%,mode0&)}=CHAR{{OB_SPEC(adr_popup%,ADD(opt1&,rep&))}}
      redraw_elem(adr_generale%,mode0&)
      mode_capture|=rep&
      ecrire_donnees_dans_generale
      redraw_force(idx_generale&,idx_generale&)
      sauver_configuration
    ENDIF
  CASE aide&
    objc_change(adr_generale%,objet&)
    ouvrir_config
  CASE decors&
    objc_change(adr_generale%,objet&)
    avec_decors!=NOT avec_decors!
    ob_state(adr_generale%,decors&,aes_checked&,avec_decors!)
    redraw_elem(adr_generale%,decors&)
    sauver_configuration
  CASE quitter&
    objc_change(adr_generale%,objet&)
    fermeture_fenetre(idx_generale_dbl&)
    fermeture_fenetre(idx_config_dbl&)
    fin_programme!=TRUE
  ENDSELECT
RETURN
PROCEDURE gestion_config
  $S&,$S>
  SELECT objet&
  CASE chemin&
    objc_change(adr_config%,objet&)
    CHAR{masque%}="*"+CHR$(0)
    CHAR{nom_divers%}="*.*"+CHR$(0)
    definition_fichier(adr_config%,chemin&,nom_divers%,FALSE,TRUE,-1)
    CHAR{{OB_SPEC(adr_config%,chemin&)}}=CHAR{disque%}+CHAR{path%}+CHR$(0)
    sauver_configuration
  CASE quitopt&
    objc_change(adr_config%,objet&)
    fermeture_fenetre(idx_config_dbl&)
  ENDSELECT
RETURN
' ******************************************************************************
PROCEDURE capture(zx&,zy&,zw&,zh&)
  LOCAL rep&
  LOCAL retx%,rety%,retw%,reth%
  LOCAL x&,y&,w&,h&
  '
  $S|,$S>
  SELECT mode_capture|
  CASE 0
    '                                 Plein ‚cran
    global_departx&=0
    global_departy&=0
    global_largeur&=SUCC(global_xmax&)
    global_hauteur&=SUCC(global_ymax&)
    faire_image
  CASE 1
    '                                 Fenˆtre s‚lectionn‚e
    IF zx&>-1
      rep&=zx&
    ELSE
      graf_mkstate(mx&,my&,mk&,kbd&)
      DO
        graf_mkstate(mx&,my&,mk&,kbd&)
        EXIT IF mk&=1
      LOOP
      '
      rep&=@wind_find(mx&,my&)    ! quelle fenˆtre a t-on cliqu‚ ?
    ENDIF
    IF avec_decors!
      ~@wind_get(rep&,wf_currxywh&,x&,y&,w&,h&)
    ELSE
      ~@wind_get(rep&,wf_workxywh&,x&,y&,w&,h&)
    ENDIF
    '
    ' global_departx&=SHL(SHR(ADD(x&,8),2),2)
    global_departx&=x&
    global_departy&=y&
    global_largeur&=SHL(SHR(ADD(w&,16),4),4)
    global_hauteur&=h&
    faire_image
    '
  CASE 2
    '                                 Zone … la souris
    IF zx&>-1
      retx%=zx&
      rety%=zy%
      retw%=zw&
      reth%=zh&
    ELSE
      graf_mkstate(mx&,my&,mk&,kbd&)
      DO
        graf_mkstate(mx&,my&,mk&,kbd&)
        EXIT IF mk&=1
      LOOP
      retx%=mx&
      rety%=my&
      DO
        graf_mkstate(mx&,my&,mk&,kbd&)
        ~GRAF_RUBBERBOX(retx%,rety%,1,1,retw%,reth%)
        EXIT IF mk&=0
      LOOP
    ENDIF
    '
    ' global_departx&=SHL(SHR(ADD(retx%,8),2),2)
    global_departx&=retx%
    global_departy&=rety%
    global_largeur&=SHL(SHR(ADD(retw%,16),4),4)
    global_hauteur&=reth%
    faire_image
    '
  ENDSELECT
  videsouris
  '
RETURN
' ******************************************************************************
FUNCTION popup(lx&,ly&,adr_arb%,deb&,fin&,ad_f%)
  LOCAL pr_f&
  LOCAL px&,py&,pw&,ph&,apoi&,i&,sortie!,obj_&
  '
  sortie!=FALSE
  form_center(adr_arb%,px&,py&,pw&,ph&)
  lx&=SHL(SHR(lx&,4),4)
  px&=lx&
  py&=ly&
  pw&=OB_W(adr_arb%,0)
  ph&=OB_H(adr_arb%,0)
  OB_X(adr_arb%,0)=lx&
  OB_Y(adr_arb%,0)=ly&
  form_dial(0,px&,py&,ADD(pw&,4),ADD(ph&,4),px&,py&,ADD(pw&,4),ADD(ph&,4))
  '
  pr_f&=@wind_create(0,px&,py&,pw&,ph&)
  IF pr_f&>-1
    wind_open(pr_f&,px&,py&,pw&,ph&)
  ENDIF
  objc_draw(adr_arb%,0,12,px&,py&,pw&,ph&,PRED(deb&))
  '
  videsouris
  '
  apoi&=-1
  DO
    graf_mkstate(mx&,my&,mk&,kbd&)
    obj_&=@objc_find(adr_arb%,0,7,mx&,my&)
    IF obj_&=>deb& AND obj_&<=fin&
      FOR i&=deb& TO fin&
        IF obj_&=i&
          IF apoi&<>obj_&
            IF apoi&<>-1
              ob_state(adr_arb%,apoi&,aes_selected&,FALSE)
              redraw_elem(adr_arb%,apoi&)
            ENDIF
            ob_state(adr_arb%,obj_&,aes_selected&,TRUE)
            redraw_elem(adr_arb%,obj_&)
            apoi&=obj_&
            i&=fin&
          ENDIF
        ENDIF
      NEXT i&
    ENDIF
    IF mk&=1 AND obj_&=>deb& AND obj_&<=fin&
      FOR i&=deb& TO fin&
        IF obj_&=i& AND (NOT BTST(OB_STATE(adr_arb%,obj_&),aes_disable&))
          sortie!=TRUE
          obj_&=SUB(i&,deb&)
          i&=fin&
        ENDIF
      NEXT i&
      videsouris
    ELSE IF mk&=1 AND (obj_&<deb& OR obj_&>fin&)
      videsouris
      obj_&=255
      sortie!=TRUE
    ELSE IF mk&=2 OR click&=2
      videsouris
      obj_&=255
      sortie!=TRUE
    ENDIF
    EXIT IF sortie!
  LOOP
  ob_state(adr_arb%,apoi&,aes_selected&,FALSE)
  form_dial(3,px&,py&,ADD(pw&,4),ADD(ph&,4),px&,py&,ADD(pw&,4),ADD(ph&,4))
  '
  videsouris
  '
  IF pr_f&>-1
    wind_close(pr_f&)
    wind_delete(pr_f&)
  ENDIF
  '
  IF obj_&=255
    mettre_a_jour_les_redraws(px&,py&,ADD(pw&,4),ADD(ph&,4),FALSE)
  ENDIF
  '
  RETURN obj_&
ENDFUNC
' ********************** Fonctions diverses et vari‚es *************************
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_generale%
  CASE 1
    RETURN adr_config%
  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 g‚r‚es 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 sp‚cifi‚
    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 d‚sir‚, 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 s‚lecteur 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 paramŠtres
  INT{ADD(GCONTRL,2)}=4         ! Nombre d'entr‚es dans GINTIN
  INT{ADD(GCONTRL,4)}=4         ! Nombre d'entr‚es dans GINTOUT
  INT{ADD(GCONTRL,6)}=6         ! Nombre d'entr‚es dans ADDRIN
  INT{ADD(GCONTRL,8)}=2         ! Nombre d'entr‚es dans ADDROUT
  '
  INT{GINTIN}=128               ! longueur du chemin dans le s‚lecteur
  INT{ADD(GINTIN,2)}=33         ! longueur nom de fichier dans le du s‚lecteur
  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 d‚faut
  '
  GEMSYS &HC2                   ! L…, c'est en fait un fslx_do()
  '
  fsd%={ADDROUT}                ! on r‚cupŠre un identificateur qui
  '                               pour fermer le s‚lecteur (c'est un handle)
  IF INT{ADD(GINTOUT,2)}=1      ! si l'appel a march‚
    '                   on r‚cupŠre 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
' ************ V‚rification des extensions et cr‚ation 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 cr‚er le masque de sauvegarde par remplacement de la
  ' ---- derniŠre 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
' ******************************************************************************
' ****                                                                      ****
' ****       Proc‚dures des fonctions VDI par appels r‚els 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
' *****************  Proc‚dure de paramŠtrage 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 proc‚dure 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 d‚finies 1=composition physique
  '                                                   effectivement r‚alis‚
  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. AprŠs pas mal de temps, il a fini par d‚couvrir
  ' 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 retourn‚e par GRAF_HANDLE;
  INT{ADD(CONTRL,12)}=@graf_handle(i&,i&,i&,i&)
  ' Merci … Ren‚ et … Pierre...
  INT{INTIN}=1                 ! Num‚ro ID du p‚riph‚rique 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 caractŠres
  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 coordonn‚es 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                 ! Num‚ro ID du p‚riph‚rique 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 caractŠres
  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 coordonn‚es 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 mˆme nombre de plans
  ' D‚finition du bloc raster source (MFDB):
  {mfdb%}=s%                              ! Adresse de la m‚moire SOURCE
  IF s%<>0                                ! 0 = ‚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 (cons‚cutif)
    ELSE
      INT{ADD(mfdb%,10)}=-1*(sp&=1)       ! flag standart (cons‚qutif en mono)
    ENDIF                                 ! ou sp‚cifique (entrelac‚ en couleur)
    INT{ADD(mfdb%,12)}=sp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  ' D‚finition du bloc raster cible (MFBD):
  {mfbd%}=d%                              ! Adresse de la m‚moire SOURCE
  IF d%<>0                                ! 0 = ‚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 (cons‚cutif)
    ELSE
      INT{ADD(mfbd%,10)}=-1*(dp&=1)       ! flag standart (cons‚qutif en mono)
    ENDIF                                 ! ou sp‚cifique (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
  '
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 sp‚cifique
  ' D‚finition du bloc raster source (MFDB):
  {mfdb%}=s%                              ! Adresse de la m‚moire 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 (cons‚cutif)
    ELSE
      INT{ADD(mfdb%,10)}=-1*(sp&=1)       ! flag standart (cons‚qutif en mono)
    ENDIF
    INT{ADD(mfdb%,12)}=sp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  ' D‚finition du bloc raster cible (MFBD):
  {mfbd%}=d%                              ! Adresse de la m‚moire 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 (cons‚cutif)
    ELSE
      INT{ADD(mfbd%,10)}=-1*(dp&=1)       ! flag standart (cons‚qutif 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
  ' D‚finition du bloc raster source (MFDB):
  {mfdb%}=s%                              ! Adresse de la m‚moire SOURCE
  IF s%<>0                                ! 0 = ‚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 (cons‚cutif)
    ELSE
      INT{ADD(mfdb%,10)}=-1*(sp&=1)       ! flag standart (cons‚qutif en mono)
    ENDIF
    INT{ADD(mfdb%,12)}=sp&                ! Nombre de niveaux de couleurs
  ENDIF
  '
  ' D‚finition du bloc raster cible (MFBD):
  {mfbd%}=d%                              ! Adresse de la m‚moire SOURCE
  IF d%<>0                                ! 0 = ‚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 (cons‚cutif)
    ELSE
      INT{ADD(mfbd%,10)}=-1*(dp&=1)       ! flag standart (cons‚qutif 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
  '
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
' ******************************************************************************
' ****                                                                      ****
' ****       Proc‚dures des fonctions AES par appels r‚els de l'AES         ****
' ****                                                                      ****
' ******************************************************************************
' ************************ Sous proc‚dure 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&          ! Num‚ro du message
  INT{ADD(buf%,2)}=ap_id&          ! Indentificateur exp‚diteur du message
  INT{ADD(buf%,4)}=0               ! Pas d'exc‚dent 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
FUNCTION menu_register(ap_rid&,rspring%)                                !  35
  INT{ADD(GCONTRL,2)}=1
  INT{ADD(GCONTRL,4)}=1
  INT{ADD(GCONTRL,6)}=1
  INT{ADD(GCONTRL,8)}=0
  INT{GINTIN}=ap_rid&
  {ADDRIN}=rspring%
  GEMSYS 35
  RETURN INT{GINTOUT}
ENDFUNC
'                                                                         !  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
      ' ************************* D‚finition du raster source
      s%=fond%                         ! L'image de fond (marbre ou autre)
      sl&=largeur_fond%                ! Largeur
      sh&=hauteur_fond%                ! Hauteur
      sp&=plan_systeme&
      ' ************************* D‚finition du raster destination
      d%=0                             ! C'est le GEM qui s'occupe de tout
      ' ************************* Definition de la partie … d‚placer
      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&)
  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
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
  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
RETURN
PROCEDURE wind_close(fen&)                                              ! 102
  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
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 … Fran‡ois LE COAT pour le truc de remplir les deux mots suivants
  ' avec 0 pour ‚viter les problŠmes 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 r‚alise 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 proc‚dure)
  ' x21&,y21&           (Position dans la zone destination)
  ' x22&,y22&           (Calculer dans cette proc‚dure)
  ' ex&,ey&,ew&,eh&     (Rectangle d‚limitant la zone copi‚e sur l'‚cran)
  ' 0,0,global_xmax&,global_ymax&     (Rectangle zone d‚limitant l'‚cran)
  ' PremiŠrement, testont si l'ont est dans l'‚cran
  IF ex&<global_xmax& AND ey&<global_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&))>global_xmax&  ! ATTENTION on sort de l'‚cran en X … droite
      x12&=ADD(x11&,SUB(global_xmax&,ex&))      ! X2 du raster source
      x22&=global_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&))>global_ymax&    ! ATTENTION on sort de l'‚cran en Y en bas
      y12&=ADD(y11&,SUB(global_ymax&,ey&))      ! Y2 du raster source
      y22&=global_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'aprŠs les travaux
  ' de Pierre THONTAT (Rajha LONE de QUEEN MEKA, merci … lui) et permettant
  ' la gestion des noms longs des systŠmes multitƒches.
  $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 problŠme
      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 inp‚rativement      !
  ' 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 systŠmes sont modifier et il faut donc les remettre.       !
  ' ------------------------------------------------------------------------
  ' Remettre le lecteur systeme                                            !
  ~GEMDOS(&HE,W:lecteur%)                                                  !
  '                                                                        !
  ' Remettre le chemin systŠme                                             !
  ~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 problŠme en multitƒche, autant changer le chemin      !
  ' systŠme … 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 systŠme                                             !
  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.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -49
    CHAR{n%}="[3][Pas d'autres donn‚es.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -46
    CHAR{n%}="[3][Erreur de lecteur de disquette.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -40
    CHAR{n%}="[3][Adresse non valable.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -39
    CHAR{n%}="[3][La m‚moire est pleine.|Lancement de module annul‚e ][D‚sol‚]"+CHR$(0)
  CASE -37
    CHAR{n%}="[3][Handle non valable.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -36
    CHAR{n%}="[3][AccŠs impossible.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -35
    CHAR{n%}="[3][Trop de fichiers ouverts.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -34
    CHAR{n%}="[3][Chemin de s‚lection non trouv‚.|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -33
    CHAR{n%}="[3][Fichier non trouv‚|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE -32
    CHAR{n%}="[3][Num‚ro de fonction incorrecte|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 0
    CHAR{n%}="[3][Division par 0|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 1
    CHAR{n%}="[3][D‚bordement|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 2
    CHAR{n%}="[3][Le nombre n'est pas un Interger|-2147483648..2147483647|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 3
    CHAR{n%}="[3][Le nombre n'est pas un octet|0..255|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 4
    CHAR{n%}="[3][Le nombre n'est pas un mot|-32768..32767|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 5
    CHAR{n%}="[3][Racine carr‚ d'un nombre|n‚gatif impossible|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 6
    CHAR{n%}="[3][Logarithme d'un nombre|inf‚rieur … z‚ro impossible|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 7
    CHAR{n%}="[3][Erreur inconnue|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 8
    ~@afficher_alerte(adr_memoire%)
  CASE 9
    CHAR{n%}="[3][Fonction ou instruction|impossible|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 22
    CHAR{n%}="[3][Fichier d‚j… ouvert|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 23
    CHAR{n%}="[3][Mauvais num‚ro de fichier|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 24
    CHAR{n%}="[3][Fichier non ouvert|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 26
    CHAR{n%}="[3][Fin de fichier atteinte|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 34
    CHAR{n%}="[3][Trop peu de donn‚es|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 35
    CHAR{n%}="[3][Donn‚e non num‚rique|Pr‚venir 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 paramŠtres|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 43
    CHAR{n%}="[3][Expression trop complexe|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 44
    CHAR{n%}="[3][Fonction ind‚finie|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 45
    CHAR{n%}="[3][Trop de paramŠtres|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 46
    CHAR{n%}="[3][ParamŠtre inexact|ce doit ˆtre un nombre|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 47
    CHAR{n%}="[3][ParamŠtre inexact|ce doit ˆtre une chaine|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 61
    CHAR{n%}="[3][RESERVE erreur|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 64
    CHAR{n%}="[3][Erreur dans pointeur|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 67
    CHAR{n%}="[3][Erreur ASIN/ACOS|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 90
    CHAR{n%}="[3][Erreur dans |variables locales|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 102
    CHAR{n%}="[3][Erreur bus|adressage incorrecte|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 103
    CHAR{n%}="[3][Erreur d'adresse|adresse de mot impaire|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 104
    CHAR{n%}="[3][Ex‚cution d'une instruction 680xx|ne convenant pas|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 105
    CHAR{n%}="[3][Division par z‚ro|en langage machine|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 106
    CHAR{n%}="[3][exception CHK|interruption 680xx|par instruction CHK|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 107
    CHAR{n%}="[3][exception TRAPV|interruption 680xx|par instruction TRAPV|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 108
    CHAR{n%}="[3][Interruption 680xx|par ex‚cution d'une|instruction privil‚gi‚e|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 109
    CHAR{n%}="[3][Exception trace|interruption trace avec 680xx|Pr‚venir l'auteur][ Merci ]"+CHR$(0)
  CASE 997
    CHAR{n%}="[3][Le module TEXBASSE n'est|pas pr‚sent … cot‚ de|EB Model 3.][ D‚sol‚ ]"+CHR$(0)
  CASE 998
    CHAR{n%}="[3][Le module CSG n'est|pas pr‚sent … cot‚ de|EB Model 3.][ D‚sol‚ ]"+CHR$(0)
  CASE 999
    CHAR{n%}="[3][Le module CSG vient|de stoper son travail|sans pr‚venir.][ D‚sol‚ ]"+CHR$(0)
  DEFAULT
    CHAR{n%}="[3][Erreur "+STR$(nn&)+" inconnue|Notez son num‚ro |et pr‚venez l'auteur][ Merci ]"+CHR$(0)
  ENDSELECT
  ~@form_alert(1,n%)
  libere(*n%)
RETURN
' ******************************************************************************
' **** (C)BARANGER Emmanuel                                            2006 ****
' ******************************************************************************
