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