home *** CD-ROM | disk | FTP | other *** search
/ ST-Computer Leser 2002 January / STC_CD_01_2002.iso / GAMES / DGEM / DGEM_DEV / DGEMDEV / DCONVERT / MAKE_DGX.GFA (.txt) < prev    next >
Encoding:
GFA-BASIC Atari  |  2001-12-08  |  27.8 KB  |  1,599 lines
  1. $m 128000
  2. IF FRE()<128000
  3.   ~FORM_ALERT(1,"[1][ Insufficient or fragmented | memory. ][ Quit ]")
  4.   QUIT 0
  5. ELSE
  6.   ' ON ERROR GOSUB gest_err
  7.   init_1
  8.   init_2
  9.   init_parx
  10.   boucle_generale
  11. ENDIF
  12. '
  13. > PROCEDURE sortir2
  14.   tout_fermer
  15.   IF parx_adr_mem%>0
  16.     parx_trm_exit
  17.     FOR i&=0 TO PRED(parx_nb_slot&)
  18.       parx_libere_blk(i&)
  19.     NEXT i&
  20.     ~C:parx_manag_free%()
  21.     mxfree(parx_adr_mem%)
  22.   ENDIF
  23.   effacement_stock_dgi
  24.   mxfree(raster_image%)
  25.   mxfree(m_adr%)
  26.   mxfree(dd_mem%)
  27.   mxfree(aa_start%)
  28.   '
  29.   ~MENU_BAR(adtree%(0),0)
  30.   ~RSRC_FREE()
  31.   ~APPL_EXIT()
  32.   QUIT 0
  33. RETURN
  34. '
  35. > PROCEDURE init_1
  36.   ap_id&=APPL_INIT()
  37.   vdi_handle&=V~H
  38.   ~GRAF_MOUSE(0,0)
  39.   '
  40.   mx_mask%=@mx_mask
  41.   '
  42.   IF ap_id&=-1 OR vdi_handle&<0
  43.     sortir2
  44.   ENDIF
  45.   '
  46.   ~WIND_UPDATE(1)
  47.   ~WIND_UPDATE(3)
  48.   '
  49.   ~WIND_GET(0,4,screenx&,screeny&,screenl&,screenh&)
  50.   '
  51.   @declare_1
  52.   @declare_parx
  53.   @declare_parx_mem
  54.   @declare_parx_trm
  55.   @declare_parx_rim
  56.   RESERVE 32128
  57.   '
  58.   @declare_mem
  59.   '
  60.   ~RSRC_FREE()
  61.   IF @s_exist(application_rsc$)=TRUE
  62.     IF RSRC_LOAD(application_rsc$)=0
  63.       ~FORM_ALERT(1,"[1][ MAKE_DGX.RSC couldn't be loaded as | RSC file.][ Quit ]")
  64.       sortir2
  65.     ELSE
  66.       FOR i&=0 TO nb_tree&
  67.         ~RSRC_GADDR(0,i&,adtree%(i&))
  68.       NEXT i&
  69.       FOR i&=1 TO nb_tree&
  70.         ~FORM_CENTER(adtree%(i&),xd&(i&),yd&(i&),ld&(i&),dummy&)
  71.         hd&(i&)=OB_H(adtree%(i&),0)
  72.       NEXT i&
  73.     ENDIF
  74.   ELSE
  75.     ~FORM_ALERT(1,"[1][ MAKE_DGX.RSC not found.| Put it beside MAKE_DGX.PRG |][ Quit ]")
  76.     sortir2
  77.   ENDIF
  78.   '
  79.   folder_image$=""
  80.   '
  81. RETURN
  82. > PROCEDURE declare_1
  83.   '
  84.   c0$=CHR$(0)
  85.   lect%=GEMDOS(25)
  86.   chemin$=CHR$(ADD(lect%,65))+":"+DIR$(SUCC(lect%))+"\"
  87.   masque$="*.*"+c0$
  88.   ext_vdi$=".DGI"+c0$
  89.   fi_path$=SPACE$(512)
  90.   fi_name$=SPACE$(128)
  91.   '
  92.   application_rsc$=chemin$+"MAKE_DGX.RSC"+c0$
  93.   application_inf$=chemin$+"MAKE_DGX.INF"+c0$
  94.   '
  95.   dummy$=SPACE$(128)
  96.   nom_image$=SPACE$(128)
  97.   folder_image$=SPACE$(256)
  98.   nom_sav$=SPACE$(128)
  99.   nom_courant$=SPACE$(128)
  100.   '
  101.   nb_tree&=5
  102.   '
  103.   DIM adtree%(nb_tree&),xd&(nb_tree&),yd&(nb_tree&),ld&(nb_tree&),hd&(nb_tree&)
  104.   DIM hand_win&(nb_tree&),wx&(nb_tree&),wy&(nb_tree&),wl&(nb_tree&),wh&(nb_tree&)
  105.   '
  106.   DIM win!(nb_tree&),aff!(nb_tree&)
  107.   FOR i&=0 TO nb_tree&
  108.     win!(i&)=FALSE
  109.     aff!(i&)=FALSE
  110.   NEXT i&
  111.   '
  112.   DIM cp_win&(nb_tree&)
  113.   cp_win&(1)=&X1011
  114.   cp_win&(2)=&X1011
  115.   '
  116.   DIM img_mfdb%(2)
  117.   '
  118.   dgi_nb_slot&=128
  119.   '
  120.   DIM dgi_name$(dgi_nb_slot&),dgi_len%(dgi_nb_slot&),dgi_ptr%(dgi_nb_slot&)
  121.   FOR i&=0 TO PRED(dgi_nb_slot&)
  122.     dgi_name$(i&)=SPACE$(8)
  123.     dgi_len%(i&)=0
  124.     dgi_ptr%(i&)=0
  125.   NEXT i&
  126.   '
  127.   dd_ok&=0
  128.   dd_nak&=1
  129.   dd_ext&=2
  130.   dd_len&=3
  131.   dd_trash&=4
  132.   dd_printer&=5
  133.   dd_clipboard&=6
  134.   dd_path$="U:\PIPE\DRAGDROP."
  135.   '
  136. RETURN
  137. > PROCEDURE declare_mem
  138.   '
  139.   m_adr%=MALLOC(16)
  140.   IF m_adr%=<0
  141.     sortir2
  142.   ELSE
  143.     ABSOLUTE m_type&,m_adr%
  144.     ABSOLUTE m_ap_id&,ADD(m_adr%,2)
  145.     ABSOLUTE m_nothing&,ADD(m_adr%,4)
  146.     ABSOLUTE m_titre&,ADD(m_adr%,6)
  147.     ABSOLUTE m_fenetre&,ADD(m_adr%,6)
  148.     ABSOLUTE m_entree&,ADD(m_adr%,8)
  149.     ABSOLUTE m_x&,ADD(m_adr%,8)
  150.     ABSOLUTE m_y&,ADD(m_adr%,10)
  151.     ABSOLUTE m_l&,ADD(m_adr%,12)
  152.     ABSOLUTE m_h&,ADD(m_adr%,14)
  153.   ENDIF
  154.   '
  155.   raster_image%=MALLOC(128)
  156.   IF raster_image%>0
  157.     FOR i&=0 TO 2
  158.       img_mfdb%(i&)=ADD(raster_image%,MUL(i&,20))
  159.       make_zero_mfdb(img_mfdb%(i&))
  160.     NEXT i&
  161.   ELSE
  162.     sortir2
  163.   ENDIF
  164.   '
  165.   aa_start%=@mxalloc_global(2048,3)
  166.   '
  167. RETURN
  168. > PROCEDURE declare_parx
  169.   '
  170.   parx_size_image%=0
  171.   parx_hand_image&=0
  172.   '
  173.   parx_sys$=SPACE$(128)
  174.   '
  175.   parx_lire_rim!=TRUE
  176.   parx_lire_mem!=TRUE
  177.   parx_lire_trm!=TRUE
  178.   '
  179.   parx_choix_config_mem&=2
  180.   parx_choix_taille_mem&=150
  181.   '
  182.   parx_trm$="PARX.TRM"+c0$
  183.   parx_mem$="PARX.MEM"+c0$
  184.   application_trm$="MAKE_DGX.TRM"+c0$
  185.   application_mem$="MAKE_DGX.MEM"+c0$
  186.   '
  187.   parx_adr_mem%=0
  188.   @declare_parx_mem
  189.   parx_nb_slot&=10
  190.   DIM parx_tab_adr%(PRED(parx_nb_slot&)),parx_size_tab%(PRED(parx_nb_slot&))
  191.   '
  192.   ptr_rim%=parx_tab_adr%(1)
  193.   nombre_rim%=0
  194.   @declare_parx_rim
  195.   '
  196. RETURN
  197. > PROCEDURE declare_parx_mem
  198.   parx_manag_malloc%=ADD(parx_adr_mem%,10)
  199.   parx_manag_free%=ADD(parx_adr_mem%,14)
  200.   parx_manag_shrink%=ADD(parx_adr_mem%,18)
  201.   parx_manag_grow%=ADD(parx_adr_mem%,22)
  202.   parx_manag_size%=ADD(parx_adr_mem%,26)
  203.   parx_manag_version%=ADD(parx_adr_mem%,30)
  204.   parx_blk_malloc%=ADD(parx_adr_mem%,50)
  205.   parx_blk_free%=ADD(parx_adr_mem%,54)
  206.   parx_blk_shrink%=ADD(parx_adr_mem%,58)
  207.   parx_blk_grow%=ADD(parx_adr_mem%,62)
  208. RETURN
  209. > PROCEDURE declare_parx_trm
  210.   parx_do_trm%=ADD(parx_tab_adr%(0),1960)
  211. RETURN
  212. > PROCEDURE declare_parx_rim
  213.   parx_test_file%=ADD(ptr_rim%,56)
  214.   parx_get_palette%=ADD(ptr_rim%,60)
  215.   parx_do_file%=ADD(ptr_rim%,64)
  216. RETURN
  217. > PROCEDURE init_2
  218.   '
  219.   effacement_stock_dgi
  220.   '
  221.   IF @s_exist(application_inf$)
  222.     OPEN "i",#14,application_inf$
  223.     INPUT #14,parx_sys$
  224.     INPUT #14,parx_lire_rim!
  225.     INPUT #14,parx_lire_mem!
  226.     INPUT #14,parx_lire_trm!
  227.     INPUT #14,working_folder$
  228.     CLOSE #14
  229.   ELSE
  230.     parx_sys$="C:\PARX.SYS\"
  231.     working_folder$=chemin$+c0$
  232.   ENDIF
  233.   '
  234.   IF LEN(working_folder$)<2
  235.     working_folder$=chemin$+c0$
  236.   ENDIF
  237.   '
  238.   ~WIND_UPDATE(2)
  239.   ~WIND_UPDATE(0)
  240.   ~MENU_BAR(adtree%(0),1)
  241.   '
  242.   multi!=@test_cookie("MagX",dummy%)
  243.   IF multi!=FALSE
  244.     multi!=@test_cookie("MiNT",dummy%)
  245.   ENDIF
  246.   '
  247.   IF multi!=FALSE
  248.     ~FORM_DIAL(3,0,0,0,0,screenx&,screeny&,screenl&,screenh&)
  249.   ENDIF
  250.   '
  251.   CHAR{{OB_SPEC(adtree%(3),3)}}=RIGHT$(parx_sys$,29)+c0$
  252.   OB_STATE(adtree%(3),5)=ABS(parx_lire_rim!)
  253.   OB_STATE(adtree%(3),7)=ABS(parx_lire_mem!)
  254.   OB_STATE(adtree%(3),10)=ABS(parx_lire_trm!)
  255.   CHAR{{OB_SPEC(adtree%(3),15)}}=RIGHT$(working_folder$,29)+c0$
  256.   '
  257.   CHAR{{OB_SPEC(adtree%(2),2)}}=RIGHT$(working_folder$,29)+c0$
  258.   CHAR{{OB_SPEC(adtree%(2),5)}}=""
  259.   nom_image$=c0$
  260.   '
  261. RETURN
  262. > PROCEDURE init_parx
  263.   '
  264.   init_parx_mem
  265.   IF dummy&=0
  266.     gere_preference_parx
  267.     init_parx_mem
  268.   ENDIF
  269.   init_parx_trm_rim
  270.   '
  271. RETURN
  272. > PROCEDURE init_parx_mem
  273.   '
  274.   IF parx_adr_mem%>0
  275.     ~C:parx_manag_free%()
  276.     mxfree(parx_adr_mem%)
  277.     parx_adr_mem%=0
  278.   ENDIF
  279.   '
  280.   dummy&=0
  281.   IF parx_lire_mem!
  282.     IF @s_exist(parx_sys$+parx_mem$)=TRUE
  283.       dummy&=1
  284.     ELSE IF @s_exist(chemin$+application_mem$)=TRUE
  285.       dummy&=2
  286.     ENDIF
  287.   ELSE
  288.     IF @s_exist(chemin$+application_mem$)=TRUE
  289.       dummy&=2
  290.     ELSE IF @s_exist(parx_sys$+parx_mem$)=TRUE
  291.       dummy&=1
  292.     ENDIF
  293.   ENDIF
  294.   '
  295.   IF dummy&=0
  296.     ~@alerte(1,14)
  297.   ELSE
  298.     IF dummy&=1
  299.       dummy$=parx_sys$+parx_mem$
  300.     ELSE
  301.       dummy$=chemin$+application_mem$
  302.     ENDIF
  303.     OPEN "i",#49,dummy$
  304.     lof_mem%=ADD(LOF(#49),ABS(ODD(LOF(#49))))
  305.     parx_adr_mem%=MALLOC(lof_mem%)
  306.     IF parx_adr_mem%>0
  307.       BGET #49,parx_adr_mem%,LOF(#49)
  308.       @declare_parx_mem
  309.       retour_mem%=C:parx_manag_version%()
  310.       IF retour_mem%<500 OR MKL$(LONG{parx_adr_mem%})+MKL$(LONG{parx_adr_mem%+4})<>"PARX_MEM"
  311.         ~@alerte(1,13)
  312.         mxfree(parx_adr_mem%)
  313.         parx_adr_mem%=0
  314.       ELSE
  315.         CHAR{{OB_SPEC(adtree%(3),9)}}=LEFT$(STR$(retour_mem%),3)
  316.       ENDIF
  317.     ENDIF
  318.     CLOSE #49
  319.   ENDIF
  320.   '
  321. RETURN
  322. > PROCEDURE init_parx_trm_rim
  323.   LOCAL retour_fs%,taille_rim%,taille_totale_rim%
  324.   '
  325.   IF parx_adr_mem%>0
  326.     '
  327.     @declare_parx_mem
  328.     taille_parx_reserve%=C:parx_manag_malloc%(L:V:parx_tab_adr%(0),L:V:parx_size_tab%(0),W:0,W:parx_nb_slot&,L:SUB(MALLOC(-1),51200))
  329.     '
  330.     IF taille_parx_reserve%>0
  331.       dummy&=0
  332.       IF parx_lire_trm!
  333.         IF @s_exist(parx_sys$+parx_trm$)=TRUE
  334.           dummy&=1
  335.         ELSE IF @s_exist(chemin$+application_trm$)=TRUE
  336.           dummy&=2
  337.         ENDIF
  338.       ELSE
  339.         IF @s_exist(chemin$+application_trm$)=TRUE
  340.           dummy&=2
  341.         ELSE IF @s_exist(parx_sys$+parx_trm$)=TRUE
  342.           dummy&=1
  343.         ENDIF
  344.       ENDIF
  345.       '
  346.       IF dummy&=0
  347.         ~@alerte(1,16)
  348.       ELSE
  349.         IF dummy&=1
  350.           dummy$=parx_sys$+parx_trm$
  351.         ELSE
  352.           dummy$=chemin$+application_trm$
  353.         ENDIF
  354.         endroit%=50
  355.         REPEAT
  356.           err_choix&=1
  357.           OPEN "i",#50,dummy$
  358.           parx_libere_blk(0)
  359.           parx_reserve_blk(0,SHL(SHR(ADD(LOF(#50),15),4),4))
  360.           IF parx_tab_adr%(0)>0
  361.             BGET #50,parx_tab_adr%(0),LOF(#50)
  362.             @declare_parx_trm
  363.             retour_trm%=WORD{ADD(parx_tab_adr%(0),8)}
  364.             IF retour_trm%<200 OR retour_trm%>299 OR MKL$(LONG{parx_tab_adr%(0)})+MKL$(LONG{parx_tab_adr%(0)+4})<>"PARX_TRM"
  365.               ~@alerte(1,15)
  366.               parx_libere_blk(0)
  367.             ELSE
  368.               CHAR{{OB_SPEC(adtree%(3),12)}}=LEFT$(STR$(retour_trm%),3)
  369.               parx_trm_init
  370.             ENDIF
  371.           ENDIF
  372.         endroit50:
  373.           CLOSE #50
  374.         UNTIL err_choix&=1
  375.       ENDIF
  376.       '
  377.       parx_reserve_blk(1,MAX(4096,SUB(C:parx_manag_size%(),32128)))
  378.       exit!=FALSE
  379.       IF parx_lire_rim!
  380.         dummy$=parx_sys$
  381.       ELSE
  382.         dummy$=chemin$
  383.       ENDIF
  384.       '
  385.       ptr_rim%=parx_tab_adr%(1)
  386.       taille_totale_rim%=0
  387.       nombre_rim&=0
  388.       retour_fs%=FSFIRST(dummy$+"RIM\*.RIM"+c0$,1)
  389.       DO
  390.         EXIT IF retour_fs%<>0
  391.         fichier_rim$=dummy$+"RIM\"+CHAR{FGETDTA()+30}+c0$
  392.         OPEN "i",#51,fichier_rim$
  393.         taille_rim%=ADD(LOF(#51),ABS(ODD(LOF(#51))))
  394.         IF ADD(taille_totale_rim%,taille_rim%)=<parx_size_tab%(1)
  395.           BGET #51,ptr_rim%,LOF(#51)
  396.           IF MKL$(LONG{ptr_rim%})+MKL$(LONG{ADD(ptr_rim%,4)})="READ_IMG"
  397.             SELECT WORD{ADD(ptr_rim%,12)}
  398.             CASE 0,1
  399.               LONG{ptr_rim%}=taille_rim%
  400.               ADD taille_totale_rim%,taille_rim%
  401.               ADD ptr_rim%,taille_rim%
  402.               INC nombre_rim&
  403.             ENDSELECT
  404.           ENDIF
  405.         ENDIF
  406.         CLOSE #51
  407.         retour_fs%=FSNEXT()
  408.       LOOP
  409.       parx_shrink_blk(1,ADD(taille_totale_rim%,ABS(ODD(taille_totale_rim%))))
  410.     ENDIF
  411.   ENDIF
  412. RETURN
  413. '
  414. > PROCEDURE boucle_generale
  415.   win(2)
  416. boucle_principale:
  417.   endroit%=0
  418.   DO
  419.     evnt&=@ev_multi(&X110011,258,3,0,300,mo_x&,mo_y&,mo_k&,m_touche&,m_clavier&,mo_c&)
  420.     IF BTST(evnt&,0)
  421.       boucle_clavier_generale
  422.       mo_c&=0
  423.       mo_k&=0
  424.     ENDIF
  425.     IF BTST(evnt&,1)
  426.       boucle_souris_generale
  427.     ENDIF
  428.     IF BTST(evnt&,4)
  429.       SELECT m_type&
  430.       CASE 10
  431.         boucle_menu
  432.       CASE 20
  433.         redraw
  434.       CASE 21
  435.         win_topped
  436.       CASE 22
  437.         win_closed
  438.       CASE 28
  439.         win_moved
  440.       CASE 29,31
  441.         win_ontop
  442.       CASE 30
  443.         win_untopped
  444.       CASE 50
  445.         shut_down
  446.       CASE 63
  447.         dd_message
  448.         evnt&=0
  449.       CASE 22360
  450.         FOR i&=1 TO 2
  451.           IF m_fenetre&=hand_win&(i&) AND win!(i&)=TRUE
  452.             aff!(i&)=FALSE
  453.           ENDIF
  454.         NEXT i&
  455.       CASE 22361
  456.         FOR i&=1 TO 2
  457.           IF m_fenetre&=hand_win&(i&) AND win!(i&)=TRUE
  458.             aff!(i&)=TRUE
  459.           ENDIF
  460.         NEXT i&
  461.       ENDSELECT
  462.       clear_m
  463.     ENDIF
  464.     IF BTST(evnt&,5)=TRUE
  465.       INC cpt_garbage%
  466.       IF cpt_garbage%>20
  467.         ~FRE(0)
  468.         ~FRE()
  469.         cpt_garbage%=0
  470.       ENDIF
  471.     ENDIF
  472.   LOOP
  473. RETURN
  474. '
  475. > PROCEDURE boucle_menu
  476.   ~MENU_TNORMAL(adtree%(0),m_titre&,1)
  477.   SELECT m_entree&
  478.   CASE 7
  479.     win(1)
  480.   CASE 16 ! ouvrir
  481.     win(2)
  482.   CASE 18 ! prefs
  483.     gere_preference_parx
  484.   CASE 20
  485.     sortir2
  486.   ENDSELECT
  487. RETURN
  488. > PROCEDURE boucle_souris_generale
  489.   IF mo_c&=1 AND mo_k&=1
  490.     clic_win&=WIND_FIND(mo_x&,mo_y&)
  491.     delai
  492.     IF clic_win&=hand_win&(2) AND aff!(2)=TRUE
  493.       gere_conversion
  494.     ENDIF
  495.   ENDIF
  496. RETURN
  497. > PROCEDURE boucle_clavier_generale
  498.   m_clavier|=BYTE(m_clavier&)
  499.   '
  500.   SELECT m_clavier|
  501.   CASE 3 ! ^C
  502.   CASE 5 ! ^E
  503.   CASE 7 ! ^G
  504.   CASE 9 ! ^I
  505.     win(1)
  506.   CASE 14 ! ^N
  507.   CASE 15 ! ^O
  508.     win(2)
  509.   CASE 16 ! ^P
  510.     gere_preference_parx
  511.   CASE 17 ! ^Q
  512.     sortir2
  513.   CASE 19 ! ^S
  514.   CASE 24 ! ^X
  515.   DEFAULT
  516.     '
  517.   ENDSELECT
  518. RETURN
  519. '
  520. > PROCEDURE win_closed
  521.   FOR i&=1 TO 3
  522.     IF m_fenetre&=hand_win&(i&) AND win!(i&)=TRUE
  523.       ferme_win(i&)
  524.     ENDIF
  525.   NEXT i&
  526.   win_untopped
  527. RETURN
  528. > PROCEDURE win_moved
  529.   m_x&=MAX(SUCC(screenx&),m_x&)
  530.   m_y&=MAX(SUCC(screeny&),m_y&)
  531.   FOR i&=1 TO 3
  532.     IF m_fenetre&=hand_win&(i&) AND win!(i&)=TRUE
  533.       ~WIND_SET(hand_win&(i&),5,m_x&,m_y&,m_l&,m_h&)
  534.       move_win(i&,m_x&,m_y&,m_l&,m_h&)
  535.     ENDIF
  536.   NEXT i&
  537. RETURN
  538. > PROCEDURE win_topped
  539.   win_untopped
  540.   FOR i&=1 TO 3
  541.     IF m_fenetre&=hand_win&(i&) AND win!(i&)=TRUE
  542.       ~WIND_SET(hand_win&(i&),10,0,0,0,0)
  543.     ENDIF
  544.   NEXT i&
  545.   win_ontop
  546. RETURN
  547. > PROCEDURE win_untopped
  548. RETURN
  549. > PROCEDURE win_ontop
  550. RETURN
  551. > PROCEDURE shut_down
  552.   ~APPL_EXIT()
  553.   QUIT
  554. RETURN
  555. > PROCEDURE dd_message
  556.   dd_receive(m_fenetre&,MKI$(m_h&),dd_data$,dd_mem%,dd_byte_len%)
  557.   IF dd_mem%>0 AND dd_data$="ARGS"
  558.     FOR i%=0 TO PRED(dd_byte_len%)
  559.       IF BYTE{ADD(dd_mem%,i%)}=32
  560.         BYTE{ADD(dd_mem%,i%)}=0
  561.       ENDIF
  562.     NEXT i%
  563.     BYTE{ADD(dd_mem%,SUCC(dd_byte_len%))}=0
  564.     BYTE{ADD(dd_mem%,ADD(dd_byte_len%,2))}=0
  565.     dummy$=CHAR{dd_mem%}
  566.     IF RINSTR(dummy$,"\")=0
  567.       dummy$=chemin$+dummy$
  568.     ENDIF
  569.     IF RIGHT$(dummy$)<>c0$
  570.       dummy$=dummy$+c0$
  571.     ENDIF
  572.     '
  573.     IF LEN(dummy$)>0 AND dummy$<>c0$
  574.       folder_image$=LEFT$(dummy$,RINSTR(dummy$,"\"))
  575.       CHAR{{OB_SPEC(adtree%(2),2)}}=RIGHT$(folder_image$,29)
  576.     ENDIF
  577.     black_white(2,2,0)
  578.     '
  579.     mxfree(dd_mem%)
  580.     dd_mem%=0
  581.   ENDIF
  582. RETURN
  583. '
  584. > PROCEDURE win(dial&)
  585.   IF win!(dial&)
  586.     force_top(dial&)
  587.   ELSE
  588.     create_win(dial&)
  589.   ENDIF
  590. RETURN
  591. > PROCEDURE create_win(dial&)
  592.   hand_win&(dial&)=@window_create(cp_win&(dial&))
  593.   IF hand_win&(dial&)>0
  594.     win!(dial&)=TRUE
  595.     ~FORM_CENTER(adtree%(dial&),dummy&,dummy&,ld&(dial&),dummy&)
  596.     xd&(dial&)=ADD(screenx&,50)
  597.     yd&(dial&)=ADD(screeny&,50)
  598.     ~WIND_CALC(0,cp_win&(dial&),xd&(dial&),yd&(dial&),ld&(dial&),hd&(dial&),wx&(dial&),wy&(dial&),wl&(dial&),wh&(dial&))
  599.     ~WIND_SET(hand_win&(dial&),2,CARD(SWAP(OB_SPEC(adtree%(nb_tree&),dial&))),CARD(OB_SPEC(adtree%(nb_tree&),dial&)),0,0)
  600.     wx&(dial&)=MAX(SUCC(screenx&),wx&(dial&))
  601.     wy&(dial&)=MAX(SUCC(screeny&),wy&(dial&))
  602.     move_win(dial&,wx&(dial&),wy&(dial&),wl&(dial&),wh&(dial&))
  603.     ~WIND_SET(hand_win&(dial&),24,&X1,0,0,0)
  604.     dummy%=WIND_OPEN(hand_win&(dial&),wx&(dial&),wy&(dial&),wl&(dial&),wh&(dial&))
  605.     aff!(dial&)=win!(dial&)
  606.   ELSE
  607.     ~@alerte(1,26)
  608.     win!(dial&)=FALSE
  609.     aff!(dial&)=FALSE
  610.   ENDIF
  611. RETURN
  612. > PROCEDURE ferme_win(dial&)
  613.   IF win!(dial&)
  614.     ~WIND_CLOSE(hand_win&(dial&))
  615.     ~WIND_DELETE(hand_win&(dial&))
  616.     win!(dial&)=FALSE
  617.     aff!(dial&)=FALSE
  618.   ENDIF
  619. RETURN
  620. > PROCEDURE move_win(dial&,x0&,y0&,l0&,h0&)
  621.   IF win!(dial&) AND dial&>0
  622.     ~WIND_CALC(1,cp_win&(dial&),x0&,y0&,l0&,h0&,xd&(dial&),yd&(dial&),dummy&,dummy&)
  623.     OB_X(adtree%(dial&),0)=xd&(dial&)
  624.     OB_Y(adtree%(dial&),0)=yd&(dial&)
  625.   ENDIF
  626. RETURN
  627. '
  628. > PROCEDURE force_update(bar&)
  629.   IF aff!(bar&)=TRUE
  630.     INT{m_adr%}=20
  631.     INT{ADD(m_adr%,2)}=ap_id&
  632.     INT{ADD(m_adr%,4)}=0
  633.     INT{ADD(m_adr%,6)}=hand_win&(bar&)
  634.     INT{ADD(m_adr%,8)}=screenx&
  635.     INT{ADD(m_adr%,10)}=screeny&
  636.     INT{ADD(m_adr%,12)}=screenl&
  637.     INT{ADD(m_adr%,14)}=screenh&
  638.     ~APPL_WRITE(ap_id&,16,m_adr%)
  639.   ENDIF
  640. RETURN
  641. > PROCEDURE force_top(bar&)
  642.   ~WIND_GET(0,10,top_win&,dummy&,dummy&,dummy&)
  643.   IF top_win&<>hand_win&(bar&) AND win!(bar&)
  644.     clear_m
  645.     INT{m_adr%}=21
  646.     INT{ADD(m_adr%,2)}=ap_id&
  647.     INT{ADD(m_adr%,6)}=hand_win&(bar&)
  648.     ~APPL_WRITE(ap_id&,16,m_adr%)
  649.   ENDIF
  650. RETURN
  651. > PROCEDURE clear_m
  652.   FOR i&=0 TO 12 STEP 4
  653.     LONG{ADD(m_adr%,i&)}=0
  654.   NEXT i&
  655. RETURN
  656. '
  657. > PROCEDURE redraw
  658.   '
  659.   control
  660.   '
  661.   win_untopped
  662.   '
  663.   ~WIND_GET(m_fenetre&,11,rx&,ry&,rl&,rh&)
  664.   WHILE rl&<>0 AND rh&<>0
  665.     IF RC_INTERSECT(m_x&,m_y&,m_l&,m_h&,rx&,ry&,rl&,rh&)
  666.       FOR i&=1 TO 3
  667.         IF m_fenetre&=hand_win&(i&) AND win!(i&)=TRUE AND aff!(i&)=TRUE
  668.           ob_draw(adtree%(i&),0,3,rx&,ry&,rl&,rh&)
  669.         ENDIF
  670.       NEXT i&
  671.     ENDIF
  672.     ~WIND_GET(m_fenetre&,12,rx&,ry&,rl&,rh&)
  673.   WEND
  674.   '
  675.   win_ontop
  676.   '
  677.   uncontrol
  678. RETURN
  679. > PROCEDURE black_white(arbre&,fils&,etat&)
  680.   IF fils&>0
  681.     SELECT etat&
  682.     CASE 0
  683.       OB_STATE(adtree%(arbre&),fils&)=BCLR(OB_STATE(adtree%(arbre&),fils&),0)
  684.     CASE 1
  685.       OB_STATE(adtree%(arbre&),fils&)=BSET(OB_STATE(adtree%(arbre&),fils&),0)
  686.     ENDSELECT
  687.   ENDIF
  688.   IF win!(arbre&)=TRUE AND aff!(arbre&)=TRUE
  689.     ~WIND_GET(hand_win&(arbre&),4,xf&,yf&,lf&,hf&)
  690.     ~WIND_GET(hand_win&(arbre&),11,rx&,ry&,rl&,rh&)
  691.     control
  692.     WHILE rl&<>0 AND rh&<>0
  693.       IF RC_INTERSECT(xf&,yf&,lf&,hf&,rx&,ry&,rl&,rh&)
  694.         ob_draw(adtree%(arbre&),fils&,1,rx&,ry&,rl&,rh&)
  695.       ENDIF
  696.       ~WIND_GET(hand_win&(arbre&),12,rx&,ry&,rl&,rh&)
  697.     WEND
  698.     uncontrol
  699.   ENDIF
  700. RETURN
  701. '
  702. > PROCEDURE gere_conversion
  703.   SELECT OBJC_FIND(adtree%(2),0,3,mo_x&,mo_y&)
  704.   CASE 2
  705.     black_white(2,2,1)
  706.     dummy$=@fileselector2$(working_folder$+"*.GIF"+c0$,c0$)
  707.     IF LEN(dummy$)>0 AND dummy$<>c0$
  708.       folder_image$=LEFT$(dummy$,RINSTR(dummy$,"\"))
  709.       CHAR{{OB_SPEC(adtree%(2),2)}}=RIGHT$(folder_image$,29)
  710.     ENDIF
  711.     black_white(2,2,0)
  712.   CASE 3
  713.     black_white(2,3,1)
  714.     '
  715.     abort&=0
  716.     dgi_id&=-1
  717.     retour_fs%=FSFIRST(folder_image$+masque$,1)
  718.     DO
  719.       EXIT IF retour_fs%<>0 OR abort&>0
  720.       nom_image$=CHAR{FGETDTA()+30}+c0$
  721.       IF RINSTR(UPPER$(nom_image$),".GIF")>0
  722.         CHAR{{OB_SPEC(adtree%(2),5)}}=nom_image$
  723.         black_white(2,5,0)
  724.         parx_ouvrir(folder_image$+nom_image$)
  725.       ENDIF
  726.       retour_fs%=FSNEXT()
  727.     LOOP
  728.     IF abort&=0 AND dgi_id&>-1
  729.       sauvegarde_fichier_dgx
  730.     ENDIF
  731.     effacement_stock_dgi
  732.     '
  733.     CHAR{{OB_SPEC(adtree%(2),5)}}=STR$(dgi_nb&)+" FILES"
  734.     black_white(2,5,0)
  735.     black_white(2,3,0)
  736.   DEFAULT
  737.     win(2)
  738.   ENDSELECT
  739. RETURN
  740. > PROCEDURE gere_preference_parx
  741.   control_form(3)
  742.   DO
  743.     result&=FORM_DO(adtree%(3),0)
  744.     IF BTST(OB_STATE(adtree%(3),5),0)
  745.       parx_lire_rim!=TRUE
  746.     ELSE
  747.       parx_lire_rim!=FALSE
  748.     ENDIF
  749.     IF BTST(OB_STATE(adtree%(3),7),0)
  750.       parx_lire_mem!=TRUE
  751.     ELSE
  752.       parx_lire_mem!=FALSE
  753.     ENDIF
  754.     IF BTST(OB_STATE(adtree%(3),10),0)
  755.       parx_lire_trm!=TRUE
  756.     ELSE
  757.       parx_lire_trm!=FALSE
  758.     ENDIF
  759.     IF result&=3
  760.       dummy$=@fileselector2$(chemin$+c0$,c0$)
  761.       dummy$=LEFT$(dummy$,MAX(0,PRED(LEN(dummy$))))
  762.       IF LEN(dummy$)>0 AND dummy$<>""
  763.         parx_sys$=dummy$
  764.         CHAR{{OB_SPEC(adtree%(3),3)}}=RIGHT$(parx_sys$,29)+c0$
  765.       ENDIF
  766.     ENDIF
  767.     IF result&=15
  768.       dummy$=@fileselector2$(chemin$+c0$,c0$)
  769.       dummy$=LEFT$(dummy$,MAX(0,PRED(LEN(dummy$))))
  770.       IF LEN(dummy$)>0 AND dummy$<>""
  771.         working_folder$=dummy$
  772.         CHAR{{OB_SPEC(adtree%(3),15)}}=RIGHT$(working_folder$,29)+c0$
  773.       ENDIF
  774.     ENDIF
  775.     IF result&=4 OR result&=15 OR result&=16
  776.       OB_STATE(adtree%(3),result&)=BCLR(OB_STATE(adtree%(3),result&),0)
  777.     ENDIF
  778.     IF result&=4 OR result&=15
  779.       ~OBJC_DRAW(adtree%(3),0,3,screenx&,screeny&,screenl&,screenh&)
  780.     ENDIF
  781.   LOOP UNTIL result&=16
  782.   uncontrol_form(3)
  783.   '
  784.   endroit%=14
  785.   REPEAT
  786.     err_choix&=1
  787.     OPEN "o",#14,application_inf$
  788.     PRINT #14,parx_sys$
  789.     PRINT #14,parx_lire_rim!
  790.     PRINT #14,parx_lire_mem!
  791.     PRINT #14,parx_lire_trm!
  792.     PRINT #14,working_folder$
  793.   endroit14:
  794.     CLOSE #14
  795.   UNTIL err_choix&=1
  796.   '
  797. RETURN
  798. '
  799. > PROCEDURE parx_ouvrir(nom_fichier$)
  800.   abort&=0
  801.   IF @s_exist(nom_fichier$)=TRUE
  802.     IF parx_adr_mem%>0 AND parx_tab_adr%(0)>0
  803.       ~WIND_UPDATE(1)
  804.       ~WIND_UPDATE(3)
  805.       FOR i&=2 TO 9
  806.         parx_libere_blk(i&)
  807.       NEXT i&
  808.       parx_hand_image&=GEMDOS(61,L:V:nom_fichier$,W:0)
  809.       IF parx_hand_image&>0
  810.         IF @parx_load_reco=TRUE
  811.           IF @parx_load_palette=TRUE
  812.             IF @parx_load_image=TRUE
  813.               IF @parx_tramage=TRUE
  814.                 stockage_dgi
  815.               ELSE
  816.                 abort&=@alerte(1,22)
  817.               ENDIF
  818.             ELSE
  819.               abort&=@alerte(1,24)
  820.             ENDIF
  821.           ELSE
  822.             abort&=@alerte(1,25)
  823.           ENDIF
  824.         ELSE
  825.           abort&=@alerte(1,19)
  826.         ENDIF
  827.         ~GEMDOS(62,W:parx_hand_image&)
  828.       ELSE
  829.         abort&=@alerte(1,23)
  830.       ENDIF
  831.       ~WIND_UPDATE(0)
  832.       ~WIND_UPDATE(2)
  833.       FOR i&=2 TO 9
  834.         parx_libere_blk(i&)
  835.       NEXT i&
  836.       IF multi!=FALSE
  837.         ~FORM_DIAL(3,0,0,0,0,screenx&,screeny&,screenl&,screenh&)
  838.       ENDIF
  839.     ELSE
  840.       abort&=@alerte(1,18)
  841.       gere_preference_parx
  842.     ENDIF
  843.     ~GRAF_MOUSE(0,0)
  844.   ENDIF
  845. RETURN
  846. > FUNCTION parx_load_reco
  847.   '
  848.   exit!=FALSE
  849.   parx_reserve_blk(2,2048)
  850.   IF retour_mem%>=parx_size_tab%(2)
  851.     '
  852.     parx_size_image%=GEMDOS(66,L:0,W:parx_hand_image&,W:2)
  853.     ~GEMDOS(66,L:0,W:parx_hand_image&,W:0)
  854.     dummy%=GEMDOS(63,W:parx_hand_image&,L:MIN(parx_size_image%,parx_size_tab%(2)),L:parx_tab_adr%(2))
  855.     '
  856.     parx_ext%=CVL(LEFT$(RIGHT$(nom_fichier$,5),4))
  857.     '
  858.     ptr_rim%=parx_tab_adr%(1)
  859.     i&=0
  860.     DO
  861.       INC i&
  862.       '
  863.       LONG{img_mfdb%(0)}=XBIOS(3)
  864.       WORD{ADD(img_mfdb%(0),4)}=SUCC(WORK_OUT(0))
  865.       WORD{ADD(img_mfdb%(0),6)}=SUCC(WORK_OUT(1))
  866.       WORD{ADD(img_mfdb%(0),8)}=SUCC(WORK_OUT(0))/16
  867.       WORD{ADD(img_mfdb%(0),10)}=0
  868.       WORD{ADD(img_mfdb%(0),12)}=nb_plan&
  869.       LONG{ADD(img_mfdb%(0),14)}=0
  870.       WORD{ADD(img_mfdb%(0),18)}=parx_hand_image&
  871.       '
  872.       @declare_parx_rim
  873.       retour_rim%=C:parx_test_file%(W:0,L:parx_tab_adr%(2),L:dummy%,L:parx_size_image%,L:parx_ext%,L:img_mfdb%(0))
  874.       SELECT retour_rim%
  875.       CASE 2
  876.         exit!=TRUE
  877.         parx_image_sans_palette!=FALSE
  878.       CASE 3
  879.         exit!=TRUE
  880.         parx_image_sans_palette!=TRUE
  881.       ENDSELECT
  882.       EXIT IF exit!=TRUE
  883.       '
  884.       ADD ptr_rim%,LONG{ptr_rim%}
  885.       '
  886.     LOOP UNTIL i&=nombre_rim&
  887.   ENDIF
  888.   parx_libere_blk(2)
  889.   '
  890.   IF parx_image_sans_palette!=TRUE AND WORD{ADD(img_mfdb%(0),12)}<10
  891.     RETURN FALSE
  892.   ELSE
  893.     RETURN exit!
  894.   ENDIF
  895. ENDFUNC
  896. > FUNCTION parx_load_palette
  897.   '
  898.   exit!=FALSE
  899.   parx_seek_pal%=LONG{img_mfdb%(0)}
  900.   parx_leng_pal%=LONG{ADD(img_mfdb%(0),14)}
  901.   parx_nb_plan&=WORD{ADD(img_mfdb%(0),12)}
  902.   parx_nb_coul%=2^MAX(1,parx_nb_plan&)
  903.   '
  904.   parx_reserve_blk(2,SHL(SHR(ADD(MUL(parx_nb_coul%,6),15),4),4))
  905.   IF retour_mem%>=MUL(parx_nb_coul%,6)
  906.     parx_reserve_blk(3,SHL(SHR(ADD(parx_leng_pal%,15),4),4))
  907.     IF retour_mem%>=parx_leng_pal%
  908.       '
  909.       dummy%=0
  910.       ~GEMDOS(66,L:parx_seek_pal%,W:parx_hand_image&,W:0)
  911.       dummy%=GEMDOS(63,W:parx_hand_image&,L:parx_leng_pal%,L:parx_tab_adr%(3))
  912.       '
  913.       LONG{img_mfdb%(0)}=parx_size_image%
  914.       WORD{ADD(img_mfdb%(0),18)}=parx_hand_image&
  915.       '
  916.       @declare_parx_rim
  917.       retour_rim%=C:parx_get_palette%(W:0,L:parx_tab_adr%(3),L:dummy%,L:parx_tab_adr%(2),L:parx_nb_coul%,L:img_mfdb%(0))
  918.       IF retour_rim%=2 OR retour_rim%=0
  919.         exit!=TRUE
  920.       ENDIF
  921.       '
  922.     ENDIF
  923.     parx_libere_blk(3)
  924.   ENDIF
  925.   '
  926.   RETURN exit!
  927. ENDFUNC
  928. > FUNCTION parx_load_image
  929.   '
  930.   exit!=FALSE
  931.   parx_seek_data%=LONG{img_mfdb%(0)}
  932.   parx_leng_data%=LONG{ADD(img_mfdb%(0),14)}
  933.   parx_size_data%=2*WORD{ADD(img_mfdb%(0),8)}*WORD{ADD(img_mfdb%(0),6)}*WORD{ADD(img_mfdb%(0),12)}
  934.   '
  935.   parx_reserve_blk(3,SHL(SHR(ADD(parx_leng_data%,15),4),4))
  936.   IF retour_mem%>=parx_leng_data%
  937.     parx_reserve_blk(4,SHL(SHR(ADD(parx_size_data%,15),4),4))
  938.     IF retour_mem%>=parx_size_data%
  939.       '
  940.       dummy%=0
  941.       ~GEMDOS(66,L:parx_seek_data%,W:parx_hand_image&,W:0)
  942.       dummy%=GEMDOS(63,W:parx_hand_image&,L:parx_leng_data%,L:parx_tab_adr%(3))
  943.       '
  944.       LONG{img_mfdb%(0)}=parx_tab_adr%(4)
  945.       WORD{ADD(img_mfdb%(0),18)}=parx_hand_image&
  946.       '
  947.       @declare_parx_rim
  948.       retour_rim%=C:parx_do_file%(W:0,L:parx_tab_adr%(3),L:dummy%,L:img_mfdb%(0))
  949.       IF retour_rim%=3 OR retour_rim%>4
  950.         exit!=TRUE
  951.       ENDIF
  952.     ENDIF
  953.   ENDIF
  954.   parx_libere_blk(3)
  955.   '
  956.   RETURN exit!
  957. ENDFUNC
  958. > FUNCTION parx_tramage
  959.   '
  960.   IF WORD{ADD(img_mfdb%(0),10)}<>1 OR parx_image_sans_palette!=TRUE
  961.     exit!=FALSE
  962.     '
  963.     IF parx_nb_coul%>0
  964.       IF parx_size_tab%(3)>0
  965.         parx_libere_blk(3)
  966.       ENDIF
  967.       parx_reserve_blk(3,SHL(SHR(ADD(MUL(parx_nb_coul%,6),15),4),4))
  968.     ENDIF
  969.     IF retour_mem%>=MUL(parx_nb_coul%,6) OR parx_image_sans_palette!=TRUE
  970.       '
  971.       IF parx_nb_coul%>0
  972.         dummy%=parx_tab_adr%(0)
  973.         SELECT MUL(parx_nb_coul%,6)
  974.         CASE 1
  975.           ADD dummy%,12
  976.         CASE 2
  977.           ADD dummy%,26
  978.         CASE 4
  979.           ADD dummy%,54
  980.         CASE 8
  981.           ADD dummy%,166
  982.         ENDSELECT
  983.         BMOVE dummy%,parx_tab_adr%(3),MUL(parx_nb_coul%,6)
  984.       ENDIF
  985.       '
  986.       parx_options_trm&=&X100100
  987.       '
  988.       LONG{img_mfdb%(0)}=parx_tab_adr%(4)
  989.       '
  990.       LONG{img_mfdb%(1)}=0
  991.       WORD{ADD(img_mfdb%(1),4)}=WORD{ADD(img_mfdb%(0),4)}
  992.       WORD{ADD(img_mfdb%(1),6)}=WORD{ADD(img_mfdb%(0),6)}
  993.       WORD{ADD(img_mfdb%(1),8)}=WORD{ADD(img_mfdb%(0),8)}
  994.       WORD{ADD(img_mfdb%(1),10)}=1
  995.       IF parx_image_sans_palette!
  996.         WORD{ADD(img_mfdb%(1),12)}=24
  997.       ELSE
  998.         WORD{ADD(img_mfdb%(1),12)}=parx_nb_plan&
  999.       ENDIF
  1000.       '
  1001.       @declare_parx_trm
  1002.       retour_trm%=C:parx_do_trm%(W:0,W:1,L:0,L:img_mfdb%(0),L:parx_tab_adr%(2),L:img_mfdb%(1),L:parx_tab_adr%(3),W:parx_options_trm&)
  1003.       parx_trm_error
  1004.       IF retour_trm%>0
  1005.         '
  1006.         parx_taille_trame%=2*WORD{ADD(img_mfdb%(1),8)}*WORD{ADD(img_mfdb%(1),6)}*WORD{ADD(img_mfdb%(1),12)}
  1007.         '
  1008.         IF retour_trm%=&H7FFFFFFF
  1009.           parx_reserve_blk(5,MAX(16,SUB(C:parx_manag_size%(),ADD(parx_taille_trame%,12800))))
  1010.         ELSE
  1011.           parx_reserve_blk(5,SHL(SHR(ADD(retour_trm%,15),4),4))
  1012.         ENDIF
  1013.         IF retour_mem%>=4
  1014.           LONG{parx_tab_adr%(5)}=retour_mem%
  1015.         ENDIF
  1016.         IF retour_mem%<retour_trm%
  1017.           exit!=TRUE
  1018.           retour_trm%=-2
  1019.         ENDIF
  1020.       ENDIF
  1021.       '
  1022.       parx_reserve_blk(6,SHL(SHR(ADD(parx_taille_trame%,15),4),4))
  1023.       IF retour_mem%>=parx_taille_trame%
  1024.         LONG{img_mfdb%(1)}=parx_tab_adr%(6)
  1025.       ELSE
  1026.         exit!=TRUE
  1027.         retour_trm%=-2
  1028.       ENDIF
  1029.       '
  1030.       LONG{img_mfdb%(0)}=parx_tab_adr%(4)
  1031.       LONG{img_mfdb%(1)}=parx_tab_adr%(6)
  1032.       '
  1033.       IF exit!=FALSE
  1034.         retour_trm%=C:parx_do_trm%(W:1,W:1,L:parx_tab_adr%(5),L:img_mfdb%(0),L:parx_tab_adr%(2),L:img_mfdb%(1),L:parx_tab_adr%(3),W:parx_options_trm&)
  1035.       ENDIF
  1036.       parx_trm_error
  1037.       IF retour_trm%=0 AND exit!=FALSE
  1038.         exit!=TRUE
  1039.       ELSE
  1040.         exit!=FALSE
  1041.       ENDIF
  1042.     ENDIF
  1043.   ELSE
  1044.     WORD{ADD(img_mfdb%(1),4)}=WORD{ADD(img_mfdb%(0),4)}
  1045.     WORD{ADD(img_mfdb%(1),6)}=WORD{ADD(img_mfdb%(0),6)}
  1046.     WORD{ADD(img_mfdb%(1),8)}=WORD{ADD(img_mfdb%(0),8)}
  1047.     WORD{ADD(img_mfdb%(1),10)}=1
  1048.     WORD{ADD(img_mfdb%(1),12)}=parx_nb_plan&
  1049.     parx_tab_adr%(6)=parx_tab_adr%(4)
  1050.     parx_size_tab%(6)=parx_size_tab%(4)
  1051.     parx_tab_adr%(3)=parx_tab_adr%(2)
  1052.     parx_size_tab%(3)=parx_size_tab%(2)
  1053.     exit!=TRUE
  1054.   ENDIF
  1055.   RETURN exit!
  1056. ENDFUNC
  1057. > PROCEDURE stockage_dgi
  1058.   '
  1059.   ' address of the MFDB: mfdb%(1) (size=20 bytes)
  1060.   ' address of the palette: parx_tab_adr%(3) (size=parx_size_tab%(3))
  1061.   ' address of the VDI format(=standard mode): parx_tab_adr%(6) (size=parx_size_tab%(6))
  1062.   '
  1063.   INC dgi_id&
  1064.   dgi_name$(dgi_id&)=@nom_seulement$(nom_fichier$)
  1065.   LONG{img_mfdb%(1)}=CVL("_DGI")
  1066.   LONG{ADD(img_mfdb%(1),14)}=0
  1067.   WORD{ADD(img_mfdb%(1),18)}=0
  1068.   '
  1069.   dgi_len%(dgi_id&)=ADD(parx_size_tab%(6),20)
  1070.   dgi_ptr%(dgi_id&)=MALLOC(SHL(SHR(ADD(dgi_len%(dgi_id&),32),4),4))
  1071.   '
  1072.   IF dgi_ptr%(dgi_id&)>0 AND NOT parx_image_sans_palette!
  1073.     BMOVE img_mfdb%(1),dgi_ptr%(dgi_id&),20
  1074.     BMOVE parx_tab_adr%(6),ADD(dgi_ptr%(dgi_id&),20),parx_size_tab%(6)
  1075.   ENDIF
  1076.   '
  1077.   IF parx_tab_adr%(6)=parx_tab_adr%(4)
  1078.     parx_tab_adr%(6)=0
  1079.     parx_size_tab%(6)=0
  1080.     parx_tab_adr%(3)=0
  1081.     parx_size_tab%(3)=0
  1082.   ENDIF
  1083.   '
  1084. RETURN
  1085. > PROCEDURE sauvegarde_fichier_dgx
  1086.   '
  1087.   mxfree(dgx_head_adr%)
  1088.   '
  1089.   dgi_nb&=SUCC(dgi_id&)
  1090.   '
  1091.   dgx_head_len%=ADD(6,MUL(12,dgi_nb&))
  1092.   dgx_head_adr%=MALLOC(SHL(SHR(ADD(dgx_head_len%,32),4),4))
  1093.   dgx_head_ptr%=ADD(dgx_head_adr%,6)
  1094.   dgx_offset%=dgx_head_len%
  1095.   '
  1096.   dgx_name$=LEFT$(folder_image$,PRED(LEN(folder_image$)))+".DGX"+c0$
  1097.   '
  1098.   IF dgx_head_adr%>0
  1099.     '
  1100.     LONG{dgx_head_adr%}=CVL("_DGX")
  1101.     INT{ADD(dgx_head_adr%,4)}=dgi_nb&
  1102.     FOR i&=0 TO PRED(dgi_nb&)
  1103.       CHAR{dgx_head_ptr%}=dgi_name$(i&)
  1104.       ADD dgx_head_ptr%,8
  1105.       LONG{dgx_head_ptr%}=dgx_offset%
  1106.       ADD dgx_head_ptr%,4
  1107.       ADD dgx_offset%,dgi_len%(i&)
  1108.     NEXT i&
  1109.     '
  1110.     IF @s_exist(dgx_name$)=TRUE
  1111.       ~GEMDOS(65,L:V:dgx_name$)
  1112.     ENDIF
  1113.     handle&=GEMDOS(60,L:V:dgx_name$,W:0)
  1114.     IF handle&>0
  1115.       IF GEMDOS(64,W:handle&,L:dgx_head_len%,L:dgx_head_adr%)<>dgx_head_len%
  1116.         abort&=@alerte(1,27)
  1117.       ELSE
  1118.         FOR i&=0 TO PRED(dgi_nb&)
  1119.           IF GEMDOS(64,W:handle&,L:dgi_len%(i&),L:dgi_ptr%(i&))<>dgi_len%(i&)
  1120.             abort&=@alerte(1,28)
  1121.           ENDIF
  1122.           EXIT IF abort&>0
  1123.         NEXT i&
  1124.       ENDIF
  1125.       ~GEMDOS(62,W:handle&)
  1126.     ELSE
  1127.       ~@alerte(1,29)
  1128.     ENDIF
  1129.   ELSE
  1130.     ~@alerte(1,26)
  1131.   ENDIF
  1132.   '
  1133. RETURN
  1134. > PROCEDURE effacement_stock_dgi
  1135.   FOR i&=0 TO PRED(dgi_nb_slot&)
  1136.     mxfree(dgi_ptr%(i&))
  1137.     dgi_ptr%(i&)=0
  1138.     dgi_len%(i&)=0
  1139.     dgi_name$(i&)=""
  1140.   NEXT i&
  1141.   mxfree(dgx_head_adr%)
  1142.   dgx_head_adr%=0
  1143.   dgx_head_len%=0
  1144. RETURN
  1145. '
  1146. > PROCEDURE parx_reserve_blk(parx_index%,parx_taille%)
  1147.   IF parx_tab_adr%(parx_index%)=0
  1148.     retour_mem%=C:parx_blk_malloc%(L:V:parx_tab_adr%(0),L:V:parx_size_tab%(0),W:parx_index%,W:parx_nb_slot&,L:parx_taille%,W:0)
  1149.     IF retour_mem%<parx_taille%
  1150.       ~@alerte(1,23)
  1151.       parx_libere_blk(parx_index%)
  1152.     ENDIF
  1153.   ENDIF
  1154. RETURN
  1155. > PROCEDURE parx_shrink_blk(parx_index%,parx_taille%)
  1156.   IF parx_tab_adr%(parx_index%)<>0 OR parx_size_tab%(parx_index%)<>0
  1157.     retour_mem%=C:parx_blk_shrink%(L:V:parx_tab_adr%(0),L:V:parx_size_tab%(0),W:parx_index%,W:parx_nb_slot&,L:parx_taille%,L:-1)
  1158.   ENDIF
  1159. RETURN
  1160. > PROCEDURE parx_agrand_blk(parx_index%,parx_taille%)
  1161.   IF parx_tab_adr%(parx_index%)<>0 OR parx_size_tab%(parx_index%)<>0
  1162.     retour_mem%=C:parx_blk_grow%(L:V:parx_tab_adr%(0),L:V:parx_size_tab%(0),W:parx_index%,W:parx_nb_slot&,L:parx_taille%,W:0,L:-1)
  1163.   ENDIF
  1164. RETURN
  1165. > PROCEDURE parx_libere_blk(parx_index%)
  1166.   IF parx_tab_adr%(parx_index%)>0
  1167.     ~C:parx_blk_free%(L:V:parx_tab_adr%(0),L:V:parx_size_tab%(0),W:parx_index%,W:parx_nb_slot&)
  1168.   ENDIF
  1169. RETURN
  1170. > PROCEDURE parx_trm_init
  1171.   IF parx_tab_adr%(0)>0
  1172.     @declare_parx_trm
  1173.     retour_trm%=C:parx_do_trm%(W:2,W:0,L:0,L:0,L:0,L:0,L:0,W:0)
  1174.     parx_trm_error
  1175.   ENDIF
  1176. RETURN
  1177. > PROCEDURE parx_trm_exit
  1178.   IF parx_tab_adr%(0)>0
  1179.     @declare_parx_trm
  1180.     ~C:parx_do_trm%(W:3,W:0,L:0,L:0,L:0,L:0,L:0,W:0)
  1181.   ENDIF
  1182. RETURN
  1183. > PROCEDURE parx_trm_error
  1184.   IF retour_trm%<>-2 AND retour_trm%<0
  1185.     ~FORM_ALERT(1,"[1][| TRM: "+STR$(retour_trm%)+" error.|][ Ok ]")
  1186.   ENDIF
  1187. RETURN
  1188. '
  1189. > PROCEDURE tout_fermer
  1190.   FOR i&=1 TO 3
  1191.     ferme_win(i&)
  1192.   NEXT i&
  1193. RETURN
  1194. > PROCEDURE control
  1195.   ~WIND_UPDATE(1)
  1196.   ~WIND_UPDATE(3)
  1197.   v_hide_c
  1198. RETURN
  1199. > PROCEDURE uncontrol
  1200.   ~WIND_UPDATE(2)
  1201.   ~WIND_UPDATE(0)
  1202.   v_show_c
  1203. RETURN
  1204. > PROCEDURE delai
  1205.   ~EVNT_TIMER(75)
  1206. RETURN
  1207. > PROCEDURE gest_err
  1208.   SELECT ERR
  1209.   CASE -33
  1210.     err_type&=0
  1211.   CASE -36
  1212.     err_type&=1
  1213.   CASE -46
  1214.     err_type&=2
  1215.   CASE 37
  1216.     err_type&=3
  1217.   CASE -13
  1218.     err_type&=4
  1219.   CASE -11
  1220.     err_type&=5
  1221.   CASE -10
  1222.     err_type&=6
  1223.   DEFAULT
  1224.     err_type&=7
  1225.   ENDSELECT
  1226.   uncontrol
  1227.   IF err_type&=7
  1228.     ~FORM_ALERT(1,ERR$(ERR))
  1229.   ENDIF
  1230.   err_choix&=@alerte(1,SUCC(err_type&))
  1231.   IF err_type&<7
  1232.     SELECT endroit%
  1233.     CASE 1
  1234.       RESUME endroit1
  1235.     CASE 2
  1236.       RESUME endroit2
  1237.     CASE 3
  1238.       RESUME endroit3
  1239.     CASE 14
  1240.       RESUME endroit14
  1241.     CASE 15
  1242.       RESUME endroit15
  1243.     CASE 16
  1244.       RESUME endroit16
  1245.     CASE 17
  1246.       RESUME endroit17
  1247.     CASE 18
  1248.       RESUME endroit18
  1249.     CASE 23
  1250.       RESUME endroit23
  1251.     ENDSELECT
  1252.   ENDIF
  1253. RETURN
  1254. > PROCEDURE control_form(dial&)
  1255.   ~WIND_UPDATE(1)
  1256.   ~WIND_UPDATE(3)
  1257.   ~FORM_CENTER(adtree%(dial&),xd&(dial&),yd&(dial&),ld&(dial&),hd&(dial&))
  1258.   DEC xd&(dial&)
  1259.   DEC yd&(dial&)
  1260.   ADD ld&(dial&),5
  1261.   ADD hd&(dial&),5
  1262.   ~FORM_DIAL(0,0,0,0,0,xd&(dial&),yd&(dial&),ld&(dial&),hd&(dial&))
  1263.   ~OBJC_DRAW(adtree%(dial&),0,3,screenx&,screeny&,screenl&,screenh&)
  1264. RETURN
  1265. > PROCEDURE uncontrol_form(dial&)
  1266.   ~WIND_UPDATE(2)
  1267.   ~WIND_UPDATE(0)
  1268.   ~FORM_DIAL(3,0,0,0,0,xd&(dial&),yd&(dial&),ld&(dial&),hd&(dial&))
  1269. RETURN
  1270. > FUNCTION alerte(mes_type&,mes&)
  1271.   $F&
  1272.   RETURN FORM_ALERT(mes_type&,CHAR{OB_SPEC(adtree%(6),mes&)})
  1273. ENDFUNC
  1274. > PROCEDURE v_hide_c
  1275.   CONTRL(0)=123
  1276.   CONTRL(1)=0
  1277.   CONTRL(3)=0
  1278.   CONTRL(6)=vdi_handle&
  1279.   VDISYS
  1280. RETURN
  1281. > PROCEDURE v_show_c
  1282.   CONTRL(0)=122
  1283.   CONTRL(1)=0
  1284.   CONTRL(3)=1
  1285.   CONTRL(6)=vdi_handle&
  1286.   INTIN(0)=1
  1287.   VDISYS
  1288. RETURN
  1289. > FUNCTION fileselector2$(path$,name$)
  1290.   LOCAL path1$,name1$,choix_file&,retour_file&
  1291.   LET path1$=path$
  1292.   LET name1$=name$
  1293.   retour_file&=@fi_input(path1$,name1$,choix_file&)
  1294.   IF retour_file&=0 OR choix_file&=0
  1295.     RETURN chemin$+c0$
  1296.   ELSE
  1297.     RETURN LEFT$(path1$,RINSTR(path1$,"\"))+c0$
  1298.   ENDIF
  1299. ENDFUNC
  1300. > FUNCTION fi_input(VAR fi_path$,fi_name$,fi_choix&)
  1301.   $F&
  1302.   '
  1303.   GCONTRL(0)=90
  1304.   GCONTRL(1)=0
  1305.   GCONTRL(2)=2
  1306.   GCONTRL(3)=2
  1307.   GCONTRL(4)=0
  1308.   '
  1309.   fi_path$=fi_path$+SPACE$(300)
  1310.   fi_name$=fi_name$+SPACE$(100)
  1311.   '
  1312.   ADDRIN(0)=V:fi_path$
  1313.   ADDRIN(1)=V:fi_name$
  1314.   '
  1315.   GEMSYS
  1316.   '
  1317.   fi_path$=CHAR{V:fi_path$}+c0$
  1318.   fi_name$=CHAR{V:fi_name$}+c0$
  1319.   fi_choix&=GINTOUT(1)
  1320.   '
  1321.   RETURN GINTOUT(0)
  1322. ENDFUNC
  1323. > FUNCTION nom_seulement$(nom_recu$)
  1324.   dummy$=LEFT$(MID$(nom_recu$,SUCC(RINSTR(nom_recu$,"\"))),13)
  1325.   dummy$=LEFT$(dummy$,PRED(INSTR(dummy$,".")))
  1326.   WHILE LEN(dummy$)<8
  1327.     dummy$=dummy$+" "
  1328.   WEND
  1329.   RETURN LEFT$(dummy$,8)
  1330. ENDFUNC
  1331. > FUNCTION window_create(cp_win_recu&)
  1332.   $F&
  1333.   '
  1334.   GCONTRL(0)=100
  1335.   GCONTRL(1)=5
  1336.   GCONTRL(2)=1
  1337.   GCONTRL(3)=0
  1338.   GCONTRL(4)=0
  1339.   '
  1340.   GINTIN(0)=cp_win_recu&
  1341.   GINTIN(1)=30
  1342.   GINTIN(2)=30
  1343.   GINTIN(3)=30
  1344.   GINTIN(4)=30
  1345.   '
  1346.   GEMSYS
  1347.   '
  1348.   RETURN GINTOUT(0)
  1349. ENDFUNC
  1350. > FUNCTION ev_multi(em_flags&,em_cl&,em_ma&,em_st&,em_ct%,VAR em_mx&,em_my&,em_mk&,em_kbd&,em_key&,em_click&)
  1351.   $F&
  1352.   '
  1353.   GCONTRL(0)=25
  1354.   GCONTRL(1)=16
  1355.   GCONTRL(2)=7
  1356.   GCONTRL(3)=1
  1357.   GCONTRL(4)=0
  1358.   '
  1359.   GINTIN(0)=em_flags&
  1360.   GINTIN(1)=em_cl&
  1361.   GINTIN(2)=em_ma&
  1362.   GINTIN(3)=em_st&
  1363.   GINTIN(4)=0
  1364.   GINTIN(5)=0
  1365.   GINTIN(6)=0
  1366.   GINTIN(7)=0
  1367.   GINTIN(8)=0
  1368.   GINTIN(9)=0
  1369.   GINTIN(10)=0
  1370.   GINTIN(11)=0
  1371.   GINTIN(12)=0
  1372.   GINTIN(13)=0
  1373.   INT{ADD(GINTIN,28)}=WORD(em_ct%)
  1374.   INT{ADD(GINTIN,30)}=WORD(SWAP(em_ct%))
  1375.   '
  1376.   ADDRIN(0)=m_adr%
  1377.   '
  1378.   GEMSYS
  1379.   '
  1380.   em_mx&=GINTOUT(1)
  1381.   em_my&=GINTOUT(2)
  1382.   em_mk&=GINTOUT(3)
  1383.   em_kbd&=GINTOUT(4)
  1384.   em_key&=GINTOUT(5)
  1385.   em_click&=GINTOUT(6)
  1386.   '
  1387.   RETURN GINTOUT(0)
  1388. ENDFUNC
  1389. > PROCEDURE ob_draw(ob_adr%,ob_start&,ob_dept&,ob_xclip&,ob_yclip&,ob_lclip&,ob_hclip&)
  1390.   '
  1391.   GCONTRL(0)=42
  1392.   GCONTRL(1)=6
  1393.   GCONTRL(2)=1
  1394.   GCONTRL(3)=1
  1395.   GCONTRL(4)=0
  1396.   '
  1397.   GINTIN(0)=ob_start&
  1398.   GINTIN(1)=ob_dept&
  1399.   GINTIN(2)=ob_xclip&
  1400.   GINTIN(3)=ob_yclip&
  1401.   GINTIN(4)=ob_lclip&
  1402.   GINTIN(5)=ob_hclip&
  1403.   '
  1404.   ADDRIN(0)=ob_adr%
  1405.   '
  1406.   GEMSYS
  1407.   '
  1408. RETURN
  1409. > FUNCTION s_exist(exist_name$)
  1410.   $F!
  1411.   LOCAL existe&
  1412.   IF LEN(exist_name$)=0 OR exist_name$=c0$
  1413.     RETURN FALSE
  1414.   ELSE
  1415.     existe&=GEMDOS(61,L:V:exist_name$,W:0)
  1416.     IF existe&>0
  1417.       ~GEMDOS(62,W:existe&)
  1418.       RETURN TRUE
  1419.     ELSE
  1420.       RETURN FALSE
  1421.     ENDIF
  1422.   ENDIF
  1423. ENDFUNC
  1424. > FUNCTION test_cookie(cookie_name$,VAR cookie_valeur%)
  1425.   $F!
  1426.   LOCAL read_cook%,nom_cook%,cookie%
  1427.   '
  1428.   nom_cook%=CVL(cookie_name$)
  1429.   cookie%=LPEEK(&H5A0)
  1430.   cookie_valeur%=0
  1431.   '
  1432.   IF cookie%<>0
  1433.     REPEAT
  1434.       read_cook%=LPEEK(cookie%)
  1435.       cookie_valeur%=LPEEK(cookie%+4)
  1436.       ADD cookie%,8
  1437.     UNTIL read_cook%=0 OR read_cook%=nom_cook%
  1438.     IF read_cook%=nom_cook%
  1439.       RETURN TRUE
  1440.     ELSE
  1441.       RETURN FALSE
  1442.     ENDIF
  1443.   ELSE
  1444.     RETURN FALSE
  1445.   ENDIF
  1446. ENDFUNC
  1447. > PROCEDURE make_zero_mfdb(pmfdb%)
  1448.   LONG{pmfdb%}=0
  1449.   LONG{ADD(pmfdb%,4)}=0
  1450.   LONG{ADD(pmfdb%,8)}=0
  1451.   LONG{ADD(pmfdb%,12)}=0
  1452.   LONG{ADD(pmfdb%,16)}=0
  1453. RETURN
  1454. > PROCEDURE make_xyarray(xq0&,yq0&,xq1&,yq1&,xz0&,yz0&,xz1&,yz1&)
  1455.   WORD{pxyarray%}=xq0&
  1456.   WORD{ADD(pxyarray%,2)}=yq0&
  1457.   WORD{ADD(pxyarray%,4)}=xq1&
  1458.   WORD{ADD(pxyarray%,6)}=yq1&
  1459.   WORD{ADD(pxyarray%,8)}=xz0&
  1460.   WORD{ADD(pxyarray%,10)}=yz0&
  1461.   WORD{ADD(pxyarray%,12)}=xz1&
  1462.   WORD{ADD(pxyarray%,14)}=yz1&
  1463. RETURN
  1464. > PROCEDURE trns_form(pscr_mfdb%,pdes_mfdb%)
  1465.   CONTRL(1)=0
  1466.   CONTRL(3)=0
  1467.   CONTRL(6)=vdi_handle&
  1468.   LONG{ADD(CONTRL,14)}=pscr_mfdb%
  1469.   LONG{ADD(CONTRL,18)}=pdes_mfdb%
  1470.   VDISYS 110
  1471. RETURN
  1472. '
  1473. > PROCEDURE dd_receive(m_fenetre&,dd_ext$,VAR dd_data$,dd_mem%,dd_byte_len%)
  1474.   '
  1475.   dd_open(dd_path$+dd_ext$+c0$,dd_f_hand&)
  1476.   IF dd_f_hand&>0
  1477.     '
  1478.     dd_reply(dd_f_hand&,dd_ok&)
  1479.     '
  1480.     dd_datatypes(dd_f_hand&)
  1481.     '
  1482.     dd_msg&=dd_ext&
  1483.     dd_cnt%=0
  1484.     dd_mem%=0
  1485.     dd_byte_len%=0
  1486.     REPEAT
  1487.       '
  1488.       fread(dd_f_hand&,aa_start%,2)
  1489.       IF retour_g%>0
  1490.         '
  1491.         dd_len%=MIN(CARD{aa_start%},1024)
  1492.         fread(dd_f_hand&,aa_start%,dd_len%)
  1493.         IF retour_g%>0
  1494.           '
  1495.           dd_data$=MKL$(LONG{aa_start%})
  1496.           dd_byte_len%=LONG{ADD(aa_start%,4)}
  1497.           '
  1498.           IF dd_data$="ARGS"
  1499.             dd_msg&=dd_ok&
  1500.           ELSE
  1501.             dd_msg&=dd_ext&
  1502.           ENDIF
  1503.           '
  1504.           IF dd_msg&>=0
  1505.             IF dd_msg&=dd_ok&
  1506.               dd_mem%=MALLOC(SHL(SHR(ADD(dd_byte_len%,32),4),4))
  1507.               IF dd_mem%<=0
  1508.                 dd_msg&=dd_len&
  1509.               ENDIF
  1510.             ENDIF
  1511.             '
  1512.             dd_reply(dd_f_hand&,dd_msg&)
  1513.             '
  1514.             IF dd_msg&=dd_len&
  1515.               dd_datatypes(dd_f_hand&)
  1516.             ENDIF
  1517.             '
  1518.             INC dd_cnt%
  1519.             '
  1520.           ENDIF
  1521.           retour_g%=1
  1522.         ENDIF
  1523.       ENDIF
  1524.     UNTIL dd_msg&<=0 OR dd_cnt%>8 OR retour_g%<=0
  1525.     '
  1526.     IF retour_g%>0
  1527.       IF dd_cnt%>8 AND dd_msg&=dd_ok&
  1528.         dd_reply(dd_f_hand&,dd_nak&)
  1529.       ELSE IF dd_msg&=dd_ok& AND dd_cnt%<=8
  1530.         IF dd_mem%>0
  1531.           fread(dd_f_hand&,dd_mem%,dd_byte_len%)
  1532.         ENDIF
  1533.       ENDIF
  1534.     ENDIF
  1535.     '
  1536.     dd_close(dd_f_hand&)
  1537.     '
  1538.   ENDIF
  1539. RETURN
  1540. > PROCEDURE dd_open(dd_f$,VAR dd_f_hand&)
  1541.   fopen(dd_f$,2,dd_f_hand&)
  1542. RETURN
  1543. > PROCEDURE dd_close(dd_f_hand&)
  1544.   fclose(dd_f_hand&)
  1545. RETURN
  1546. > PROCEDURE dd_reply(dd_f_hand&,dd_flg&)
  1547.   BYTE{aa_start%}=dd_flg&
  1548.   fwrite(dd_f_hand&,aa_start%,1)
  1549. RETURN
  1550. > PROCEDURE dd_datatypes(dd_f_hand&)
  1551.   CHAR{aa_start%}="ARGS"
  1552.   FOR i&=4 TO 28 STEP 4
  1553.     CHAR{ADD(aa_start%,i&)}=STRING$(4,0)
  1554.   NEXT i&
  1555.   fwrite(dd_f_hand&,aa_start%,32)
  1556. RETURN
  1557. '
  1558. > PROCEDURE fcreate(dd_f$,flg%,VAR dd_f_hand&)
  1559.   dd_f_hand&=GEMDOS(60,L:V:dd_f$,W:flg%)
  1560. RETURN
  1561. > PROCEDURE fopen(dd_f$,flg%,VAR dd_f_hand&)
  1562.   dd_f_hand&=GEMDOS(61,L:V:dd_f$,W:flg%)
  1563. RETURN
  1564. > PROCEDURE fclose(dd_f_hand&)
  1565.   retour_g%=GEMDOS(62,W:dd_f_hand&)
  1566. RETURN
  1567. > PROCEDURE fread(dd_f_hand&,adr%,flg%)
  1568.   retour_g%=GEMDOS(63,W:dd_f_hand&,L:flg%,L:adr%)
  1569. RETURN
  1570. > PROCEDURE fwrite(dd_f_hand&,adr%,flg%)
  1571.   retour_g%=GEMDOS(64,W:dd_f_hand&,L:flg%,L:adr%)
  1572. RETURN
  1573. '
  1574. > FUNCTION mx_mask
  1575.   $F%
  1576.   IF GEMDOS(68,L:-1,0)=-32
  1577.     RETURN 0
  1578.   ELSE IF GEMDOS(290,-1)=-32
  1579.     RETURN 3
  1580.   ELSE
  1581.     RETURN -1
  1582.   ENDIF
  1583. ENDFUNC
  1584. > FUNCTION mxalloc_global(mx_len%,mx_mode&)
  1585.   $F%
  1586.   '
  1587.   IF mx_mask%<>0
  1588.     mx_mode&=OR(mx_mode&,&X100000)
  1589.     RETURN GEMDOS(68,L:mx_len%,W:mx_mode& AND mx_mask%)
  1590.   ELSE
  1591.     RETURN MALLOC(mx_len%)
  1592.   ENDIF
  1593. ENDFUNC
  1594. > PROCEDURE mxfree(mx_adr%)
  1595.   IF mx_adr%>0
  1596.     ~MFREE(mx_adr%)
  1597.   ENDIF
  1598. RETURN
  1599.