home *** CD-ROM | disk | FTP | other *** search
/ ST-Computer Leser 2002 January / STC_CD_01_2002.iso / GAMES / DGEM / DGEM_DEV / DGEMDEV / DTEXT / DTEXT.GFA (.txt) next >
GFA-BASIC Atari  |  2002-01-04  |  16KB  |  892 lines
  1. RESERVE
  2. IF FRE()<204800
  3.   ~FORM_ALERT(1,"[1][| Insufficient memory. |][ Quit ]")
  4.   EDIT
  5. ELSE
  6.   ON BREAK GOSUB sortir
  7.   init1
  8.   init2
  9.   init3
  10.   boucle_generale
  11. ENDIF
  12. '
  13. > PROCEDURE demande_sortie
  14.   IF text_changed! AND msg_nb&>0 AND msg_adr%>0
  15.     reponse&=@alerte(5)
  16.   ELSE
  17.     reponse&=1
  18.   ENDIF
  19.   IF reponse&=1
  20.     sortir
  21.   ELSE IF reponse&=2
  22.     @save_text_as
  23.     sortir
  24.   ENDIF
  25. RETURN
  26. > PROCEDURE sortir
  27.   ~GRAF_MOUSE(0,0)
  28.   ferme_win(0)
  29.   v_clsvwk(vdi_handle&)
  30.   IF m_adr%>0
  31.     ~GEMDOS(73,L:m_adr%) ! libération mémoire
  32.   ENDIF
  33.   IF msg_adr%>0
  34.     ~GEMDOS(73,L:msg_adr%)
  35.   ENDIF
  36.   ~RSRC_FREE()
  37.   ~APPL_EXIT()
  38.   QUIT 0
  39. RETURN
  40. '
  41. > PROCEDURE init1
  42.   ap_id&=APPL_INIT()
  43.   IF ap_id&<0
  44.     sortir
  45.   ENDIF
  46.   vdi_handle&=@v_opnvwk
  47.   '
  48.   dummy%=LPEEK(&H4F2)
  49.   dummy$=CHR$(ADD(48,PEEK(ADD(dummy%,2))))
  50.   dummy$=dummy$+CHR$(ADD(48,PEEK(ADD(dummy%,4))))+CHR$(ADD(48,PEEK(ADD(dummy%,3))))
  51.   tos_version%=VAL(dummy$)
  52.   '
  53.   ~GRAF_MOUSE(0,0)
  54.   '
  55.   ~WIND_UPDATE(1)
  56.   ~WIND_UPDATE(3)
  57.   '
  58.   ~WIND_GET(0,4,screenx&,screeny&,screenl&,screenh&)
  59.   '
  60.   magic!=@test_cookie("MagX",dummy%)
  61.   mint!=@test_cookie("MiNT",dummy%)
  62.   IF ap_id&>0 AND (magic! OR mint!)
  63.     multi!=TRUE
  64.   ELSE
  65.     multi!=FALSE
  66.   ENDIF
  67.   '
  68.   @declare
  69.   @declare_champs_editables
  70.   @declare_text
  71.   RESERVE 15360
  72.   @declare_mem
  73.   '
  74.   IF @s_exist(chemin$+exemple_rsc$)=TRUE
  75.     IF RSRC_LOAD(chemin$+exemple_rsc$)=0
  76.       ~FORM_ALERT(1,"[1][DTEXT could not| be loaded as RSC file.][ Quit ]")
  77.       sortir
  78.     ELSE
  79.       FOR i&=0 TO nb_tree&
  80.         ~RSRC_GADDR(0,i&,adtree%(i&))
  81.         hd&(i&)=OB_H(adtree%(i&),0)
  82.         ld&(i&)=OB_W(adtree%(i&),0)
  83.       NEXT i&
  84.     ENDIF
  85.   ELSE
  86.     ~FORM_ALERT(1,"[1][|DTEXT.RSC not found.][ Quit ]")
  87.     sortir
  88.   ENDIF
  89.   '
  90. RETURN
  91. > PROCEDURE declare
  92.   lect&=GEMDOS(25)
  93.   chemin$=CHR$(ADD(lect&,65))+":"+DIR$(SUCC(lect&))+"\"
  94.   c0$=CHR$(0)
  95.   '
  96.   exemple_rsc$="DTEXT.RSC"+c0$
  97.   '
  98.   nb_tree&=1
  99.   '
  100.   DIM adtree%(nb_tree&),xd&(nb_tree&),yd&(nb_tree&),ld&(nb_tree&),hd&(nb_tree&)
  101.   DIM hand_win&(nb_tree&),wx&(nb_tree&),wy&(nb_tree&),wl&(nb_tree&),wh&(nb_tree&)
  102.   '
  103.   DIM win!(nb_tree&),cp_win&(nb_tree&),aff!(nb_tree&)
  104.   '
  105.   FOR i&=0 TO nb_tree&
  106.     win!(i&)=FALSE
  107.     aff!(i&)=FALSE
  108.     cp_win&(i&)=0
  109.   NEXT i&
  110.   '
  111.   cp_win&(0)=&X1010
  112.   '
  113. RETURN
  114. > PROCEDURE declare_mem
  115.   '
  116.   m_adr%=GEMDOS(72,L:16)
  117.   IF m_adr%<1
  118.     sortir
  119.   ENDIF
  120.   '
  121. RETURN
  122. > PROCEDURE declare_text
  123.   '
  124.   default_msg$="LABYRINT.MSG"+c0$
  125.   ext_msg$=".MSG"+c0$
  126.   text_changed!=FALSE
  127.   '
  128.   msg_adr%=0
  129.   msg_len%=0
  130.   msg_ptr%=0
  131.   msg_id&=0
  132.   msg_nb&=0
  133.   '
  134. RETURN
  135. > PROCEDURE declare_champs_editables
  136.   '
  137.   DIM edit_pos&(1,30)
  138.   '
  139. RETURN
  140. > PROCEDURE init2
  141.   '
  142.   CHAR{{OB_SPEC(adtree%(0),2)}}=""
  143.   CHAR{{OB_SPEC(adtree%(0),9)}}=""
  144.   CHAR{{OB_SPEC(adtree%(0),11)}}=""
  145.   '
  146.   CHAR{{OB_SPEC(adtree%(0),4)}}=""
  147.   CHAR{{OB_SPEC(adtree%(0),5)}}=""
  148.   CHAR{{OB_SPEC(adtree%(0),6)}}=""
  149.   CHAR{{OB_SPEC(adtree%(0),7)}}=""
  150.   '
  151. RETURN
  152. > PROCEDURE init3
  153.   '
  154.   ~WIND_UPDATE(2)
  155.   ~WIND_UPDATE(0)
  156.   '
  157.   IF multi!=FALSE
  158.     ~FORM_DIAL(3,0,0,0,0,screenx&,screeny&,screenl&,screenh&)
  159.   ENDIF
  160.   win(0)
  161.   '
  162. RETURN
  163. '
  164. > PROCEDURE boucle_generale
  165.   DO
  166.     evnt&=EVNT_MULTI(&X110011,2,1,1,0,0,0,0,0,0,0,0,0,0,m_adr%,500,mo_x&,mo_y&,mo_k&,m_touche&,m_clavier&,mo_c&)
  167.     '
  168.     IF BTST(evnt&,0)
  169.       boucle_clavier_generale
  170.     ENDIF
  171.     '
  172.     IF BTST(evnt&,1)
  173.       clic_win&=WIND_FIND(mo_x&,mo_y&)
  174.       ~WIND_GET(0,10,top_win&,dummy&,dummy&,dummy&)
  175.       IF clic_win&=hand_win&(0) AND win!(0)=TRUE
  176.         boucle_generale_suite
  177.       ENDIF
  178.     ENDIF
  179.     '
  180.     IF BTST(evnt&,4)
  181.       '
  182.       m_type&=INT{m_adr%}
  183.       m_id&=INT{ADD(m_adr%,2)}
  184.       m_dummy&=INT{ADD(m_adr%,4)}
  185.       m_6&=INT{ADD(m_adr%,6)}
  186.       m_8&=INT{ADD(m_adr%,8)}
  187.       m_10&=INT{ADD(m_adr%,10)}
  188.       m_12&=INT{ADD(m_adr%,12)}
  189.       m_14&=INT{ADD(m_adr%,14)}
  190.       '
  191.       SELECT m_type&
  192.       CASE 10 ! MENU_SELECTED
  193.       CASE 20 ! WM_REDRAW
  194.         redraw
  195.       CASE 21 ! WM_TOPPED
  196.         win_topped
  197.       CASE 29,31 ! WM_NEWTOP, WM_ONTOP
  198.         win_ontop
  199.       CASE 30 ! WM_UNTOPPED
  200.       CASE 22 ! WM_CLOSED
  201.         win_closed
  202.       CASE 23 ! WM_FULLED
  203.       CASE 24 ! WM_ARROWED
  204.       CASE 26 ! WM_SLIDED
  205.       CASE 28 ! WM_MOVED
  206.         win_moved
  207.       CASE 27 ! WM_SIZED
  208.       CASE 34 ! WM_ICONIFY
  209.       CASE 35 ! WM_UNICONIFY
  210.       CASE 50 ! SHUT_DOWN
  211.         shut_down
  212.       CASE 63 ! DRAGDROP
  213.       CASE 18193 ! VA_START
  214.       CASE 22360 ! WM_SHADOWED     ! propriété de MagiC
  215.         IF m_fenetre&=hand_win&(0) AND win!(0)=TRUE
  216.           aff!(0)=FALSE
  217.         ENDIF
  218.       CASE 22361 ! WM_UNSHADOWED  ! son corrolaire
  219.         IF m_fenetre&=hand_win&(0) AND win!(0)=TRUE
  220.           aff!(0)=TRUE
  221.         ENDIF
  222.       ENDSELECT
  223.       '
  224.     ENDIF
  225.     '
  226.     IF BTST(evnt&,5)
  227.       INC forme&
  228.       IF forme&=30
  229.         ~FRE()
  230.         ~FRE(0)
  231.         forme&=0
  232.       ENDIF
  233.     ENDIF
  234.     '
  235.     FOR i&=0 TO 3
  236.       LONG{ADD(m_adr%,MUL(i&,4))}=0
  237.     NEXT i&
  238.     '
  239.   LOOP
  240. RETURN
  241. > PROCEDURE boucle_generale_suite
  242.   IF clic_win&=hand_win&(0) AND win!(0)=TRUE
  243.     gere_form
  244.   ENDIF
  245. RETURN
  246. > PROCEDURE boucle_clavier_generale
  247.   '
  248.   m_clavier|=BYTE(m_clavier&)
  249.   '
  250.   ~WIND_GET(0,10,top_win&,dummy&,dummy&,dummy&)
  251.   '
  252.   SELECT m_clavier&
  253.   CASE 7181 ! enter
  254.     @valid_message
  255.   CASE 18432
  256.     IF m_touche&=4
  257.       @previous_message
  258.     ENDIF
  259.   CASE 20480
  260.     IF m_touche&=4
  261.       @next_message
  262.     ENDIF
  263.   CASE 18176
  264.     @first_message
  265.   CASE 18231
  266.     @last_message
  267.   CASE 15104 ! f1
  268.   CASE 15360 ! f2
  269.   CASE 15616 ! f3
  270.   CASE 15872 ! f4
  271.   CASE 16128 ! f5
  272.   CASE 16384 ! f6
  273.   CASE 16640 ! f7
  274.   CASE 16896 ! f8
  275.   CASE 17152 ! f9
  276.   CASE 17408 ! f10
  277.   CASE 23808 ! s+f10
  278.   CASE 24832 ! Undo
  279.   ENDSELECT
  280.   '
  281.   SELECT m_clavier|
  282.   CASE 17,21  ! ^Q = quitter ou ^U = fermer
  283.     demande_sortie
  284.   CASE 9  ! info
  285.     @info
  286.   CASE 15 ! open
  287.     @load_text_as
  288.   CASE 19 ! save
  289.     @save_text_as
  290.   DEFAULT
  291.     '
  292.     ' test texte champs éditables
  293.     '
  294.     IF aff!(0)=TRUE
  295.       IF m_touche&<>4 AND m_touche&<>2 ! on évite les bizarries
  296.         boucle_mesag
  297.       ENDIF
  298.     ENDIF
  299.     '
  300.   ENDSELECT
  301. RETURN
  302. '
  303. > PROCEDURE boucle_mesag
  304.   SELECT m_clavier&
  305.   CASE 18432 ! flèche haut
  306.     edit_efface
  307.     get_previous_ligne(0)
  308.     edit_pose
  309.   CASE 20480,3849 ! flèche bas et Tab
  310.     edit_efface
  311.     get_next_ligne(0)
  312.     edit_pose
  313.   DEFAULT
  314.     IF aff!(0)
  315.       ~OBJC_EDIT(adtree%(0),edit_ligne&,m_clavier&,edit_pos&(0,edit_ligne&),2,edit_pos&(0,edit_ligne&))
  316.     ENDIF
  317.   ENDSELECT
  318. RETURN
  319. > PROCEDURE get_previous_ligne(tree&)  ! recherche du champ éditable précédent
  320.   exit!=FALSE
  321.   old_edit_ligne&=edit_ligne&
  322.   dommy&=MAX(1,PRED(edit_ligne&))
  323.   FOR k&=dommy& TO 1 STEP -1
  324.     IF BTST(OB_FLAGS(adtree%(tree&),k&),3) AND k&>3 ! champ éditable ?
  325.       exit!=TRUE    ! oui !
  326.       edit_ligne&=k& ! on on change bien l'index de l'objet
  327.     ENDIF
  328.     EXIT IF exit!
  329.   NEXT k&
  330. RETURN
  331. > PROCEDURE get_next_ligne(tree&)  ! recherche du prochain champ éditable
  332.   exit!=FALSE
  333.   old_edit_ligne&=edit_ligne&
  334.   dommy&=OB_TAIL(adtree%(tree&),0)
  335.   FOR k&=MIN(SUCC(edit_ligne&),dommy&) TO dommy&
  336.     IF BTST(OB_FLAGS(adtree%(tree&),k&),3)
  337.       edit_ligne&=k&
  338.       exit!=TRUE
  339.     ENDIF
  340.     EXIT IF exit!
  341.   NEXT k&
  342.   IF edit_ligne&=old_edit_ligne& OR edit_ligne&>7
  343.     get_first_ligne(tree&) ! si c'était le dernier, on revient au 1er
  344.   ENDIF
  345. RETURN
  346. > PROCEDURE get_first_ligne(tree&)
  347.   edit_ligne&=4
  348. RETURN
  349. > PROCEDURE edit_efface   ! on enlève le curseur
  350.   IF aff!(0)
  351.     ~OBJC_EDIT(adtree%(0),edit_ligne&,0,edit_pos&(0,edit_ligne&),3,dummy&)
  352.   ENDIF
  353. RETURN
  354. > PROCEDURE edit_pose     ! on met le curseur
  355.   IF aff!(0)
  356.     ~OBJC_EDIT(adtree%(0),edit_ligne&,0,0,1,edit_pos&(0,edit_ligne&))
  357.   ENDIF
  358. RETURN
  359. '
  360. > PROCEDURE win(dial&)
  361.   IF win!(dial&)
  362.     force_top(dial&)
  363.   ELSE
  364.     IF win!(dial&)=FALSE
  365.       win_untopped
  366.       create_win(dial&)
  367.     ENDIF
  368.   ENDIF
  369. RETURN
  370. > PROCEDURE create_win(dial&)
  371.   hand_win&(dial&)=@window_create(cp_win&(dial&))
  372.   IF hand_win&(dial&)>0
  373.     win!(dial&)=TRUE
  374.     ~FORM_CENTER(adtree%(dial&),xd&(dial&),yd&(dial&),dummy%,dummy%)
  375.     ~WIND_CALC(0,cp_win&(dial&),xd&(dial&),yd&(dial&),ld&(dial&),hd&(dial&),wx&(dial&),wy&(dial&),wl&(dial&),wh&(dial&))
  376.     wx&(dial&)=MAX(SUCC(screenx&),wx&(dial&))
  377.     wy&(dial&)=MAX(SUCC(screeny&),wy&(dial&))
  378.     move_win(dial&,wx&(dial&),wy&(dial&),wl&(dial&),wh&(dial&))
  379.     ~WIND_SET(hand_win&(dial&),24,&X1,0,0,0)
  380.     dummy&=WIND_OPEN(hand_win&(dial&),wx&(dial&),wy&(dial&),wl&(dial&),wh&(dial&))
  381.     IF dummy&=0  ! échec
  382.       win!(dial&)=FALSE
  383.     ENDIF
  384.     aff!(dial&)=win!(dial&)
  385.     get_first_ligne(dial&)
  386.   ELSE
  387.     ~@alerte(4)
  388.     sortir
  389.   ENDIF
  390. RETURN
  391. > PROCEDURE ferme_win(dial&)
  392.   IF win!(dial&)=TRUE
  393.     ~WIND_CLOSE(hand_win&(dial&))
  394.     ~WIND_DELETE(hand_win&(dial&))
  395.     win!(dial&)=FALSE
  396.     aff!(dial&)=FALSE
  397.   ENDIF
  398. RETURN
  399. > PROCEDURE move_win(dial&,x0&,y0&,l0&,h0&)
  400.   IF win!(dial&)=TRUE
  401.     ~WIND_CALC(1,cp_win&(dial&),x0&,y0&,l0&,h0&,xd&(dial&),yd&(dial&),dummy&,dummy&)
  402.     OB_X(adtree%(dial&),0)=xd&(dial&)
  403.     OB_Y(adtree%(dial&),0)=yd&(dial&)
  404.   ENDIF
  405. RETURN
  406. > PROCEDURE black_white(fils&,etat&)
  407.   '
  408.   SELECT etat&
  409.   CASE 0
  410.     OB_STATE(adtree%(0),fils&)=BCLR(OB_STATE(adtree%(0),fils&),0)
  411.   CASE 1
  412.     OB_STATE(adtree%(0),fils&)=BSET(OB_STATE(adtree%(0),fils&),0)
  413.   ENDSELECT
  414.   '
  415.   ~WIND_GET(hand_win&(0),4,xf&,yf&,lf&,hf&)
  416.   ~WIND_GET(hand_win&(0),11,rx&,ry&,rl&,rh&)
  417.   '
  418.   IF win!(0)=TRUE AND aff!(0)=TRUE
  419.     control
  420.     WHILE rl&<>0 AND rh&<>0
  421.       IF RC_INTERSECT(xf&,yf&,lf&,hf&,rx&,ry&,rl&,rh&)
  422.         ~OBJC_DRAW(adtree%(0),fils&,3,rx&,ry&,rl&,rh&)
  423.       ENDIF
  424.       ~WIND_GET(hand_win&(0),12,rx&,ry&,rl&,rh&)
  425.     WEND
  426.     uncontrol
  427.   ENDIF
  428. RETURN
  429. '
  430. > PROCEDURE force_top(bar&)
  431.   ~WIND_GET(0,10,top_win&,dummy&,dummy&,dummy&)
  432.   IF top_win&<>hand_win&(bar&) AND win!(bar&)=TRUE
  433.     INT{m_adr%}=21
  434.     INT{m_adr%+2}=ap_id&
  435.     INT{m_adr%+4}=0
  436.     INT{m_adr%+6}=hand_win&(bar&)
  437.     INT{m_adr%+8}=0
  438.     INT{m_adr%+10}=0
  439.     INT{m_adr%+12}=0
  440.     INT{m_adr%+14}=0
  441.     ~APPL_WRITE(ap_id&,16,m_adr%)
  442.   ENDIF
  443. RETURN
  444. '
  445. > PROCEDURE shut_down
  446.   ~APPL_EXIT()
  447.   QUIT 0
  448. RETURN
  449. > PROCEDURE win_moved
  450.   m_8&=MAX(SUCC(screenx&),m_8&)
  451.   m_10&=MAX(SUCC(screeny&),m_10&)
  452.   ~WIND_SET(m_6&,5,m_8&,m_10&,m_12&,m_14&)
  453.   IF m_6&=hand_win&(0) AND win!(0)=TRUE
  454.     move_win(0,m_8&,m_10&,m_12&,m_14&)
  455.   ENDIF
  456. RETURN
  457. > PROCEDURE win_topped
  458.   win_untopped
  459.   IF m_6&=hand_win&(0) AND win!(0)=TRUE
  460.     ~WIND_SET(hand_win&(0),10,0,0,0,0)   ! on active la fenêtre
  461.     get_first_ligne(0)
  462.     edit_pose
  463.   ENDIF
  464. RETURN
  465. > PROCEDURE redraw
  466.   '
  467.   control
  468.   win_untopped
  469.   ~WIND_GET(hand_win&(0),4,xf&,yf&,lf&,hf&)
  470.   ~WIND_GET(hand_win&(0),11,rx&,ry&,rl&,rh&)
  471.   WHILE rl&<>0 AND rh&<>0
  472.     IF RC_INTERSECT(xf&,yf&,lf&,hf&,rx&,ry&,rl&,rh&)
  473.       ~OBJC_DRAW(adtree%(0),0,3,rx&,ry&,rl&,rh&)
  474.     ENDIF
  475.     ~WIND_GET(hand_win&(0),12,rx&,ry&,rl&,rh&)
  476.   WEND
  477.   win_ontop
  478.   uncontrol
  479.   '
  480. RETURN
  481. > PROCEDURE win_untopped
  482.   ~WIND_GET(0,10,top_win&,dummy&,dummy&,dummy&)
  483.   IF top_win&=hand_win&(0) AND aff!(0)=TRUE
  484.     edit_efface
  485.   ENDIF
  486. RETURN
  487. > PROCEDURE win_ontop
  488.   ~WIND_GET(0,10,top_win&,dummy&,dummy&,dummy&)
  489.   IF top_win&=hand_win&(0) AND m_6&=top_win& AND aff!(0)=TRUE
  490.     get_first_ligne(0)
  491.     edit_pose
  492.   ENDIF
  493. RETURN
  494. > PROCEDURE win_closed
  495.   IF hand_win&(0)=m_6& AND win!(0)=TRUE
  496.     demande_sortie
  497.   ENDIF
  498. RETURN
  499. '
  500. > PROCEDURE gere_form
  501.   ihm_obj&=OBJC_FIND(adtree%(0),0,3,mo_x&,mo_y&)
  502.   SELECT ihm_obj&
  503.   CASE 13
  504.     @info
  505.   CASE 14
  506.     @load_text_as
  507.   CASE 15
  508.     @save_text_as
  509.   CASE 8
  510.     @previous_message
  511.   CASE 10
  512.     @next_message
  513.   CASE 12
  514.     @valid_message
  515.   CASE 4,5,6,7
  516.     edit_efface
  517.     edit_ligne&=ihm_obj&
  518.     edit_pose
  519.   DEFAULT
  520.     win(0)
  521.   ENDSELECT
  522. RETURN
  523. '
  524. > PROCEDURE info
  525.   black_white(13,1)
  526.   ~@alerte(1)
  527.   black_white(13,0)
  528. RETURN
  529. > PROCEDURE load_text_as
  530.   black_white(14,1)
  531.   IF LEN(text_file$)>0
  532.     chemin$=LEFT$(text_file$,RINSTR(text_file$,"\"))
  533.   ENDIF
  534.   dummy$=@fileselector2$(6,chemin$+"*"+ext_msg$,default_msg$)
  535.   IF LEN(dummy$)>1
  536.     IF INSTR(UPPER$(RIGHT$(dummy$,5)),"MSG")>0
  537.       text_file$=dummy$
  538.       @load_text
  539.     ENDIF
  540.   ENDIF
  541.   black_white(14,0)
  542. RETURN
  543. > PROCEDURE load_text
  544.   LOCAL msg_handle&
  545.   '
  546.   ~FRE()
  547.   ~FRE(0)
  548.   '
  549.   text_changed!=FALSE
  550.   IF @s_exist(text_file$)=TRUE
  551.     msg_handle&=GEMDOS(61,L:V:text_file$,W:0)
  552.     IF msg_handle&>0
  553.       msg_len%=GEMDOS(66,L:0,W:msg_handle&,W:2)
  554.       ~GEMDOS(66,L:0,W:msg_handle&,W:0)
  555.       '
  556.       IF msg_adr%>0
  557.         ~GEMDOS(73,L:msg_adr%)
  558.         msg_ptr%=0
  559.       ENDIF
  560.       '
  561.       msg_adr%=GEMDOS(72,L:SHL(SHR(ADD(msg_len%,15),4),4))
  562.       IF msg_adr%>0
  563.         IF GEMDOS(63,W:msg_handle&,L:msg_len%,L:msg_adr%)=msg_len%
  564.           IF MKL$(LONG{msg_adr%})="_MSG"
  565.             '
  566.             msg_ptr%=ADD(msg_adr%,4)
  567.             msg_nb&=DIV(SUB(msg_len%,4),64)
  568.             msg_id&=0
  569.             '
  570.           ELSE
  571.             ~GEMDOS(73,L:msg_adr%)
  572.             msg_adr%=0
  573.             msg_nb&=0
  574.             ~@alerte(2)
  575.           ENDIF
  576.         ENDIF
  577.       ENDIF
  578.       ~GEMDOS(62,W:msg_handle&)
  579.     ENDIF
  580.   ENDIF
  581.   '
  582.   first_message
  583.   '
  584. RETURN
  585. > PROCEDURE save_text_as
  586.   IF LEN(text_file$)>0 AND msg_nb&>0
  587.     black_white(15,1)
  588.     dummy$=@fileselector2$(7,LEFT$(text_file$,RINSTR(text_file$,"\"))+"*"+ext_msg$,MID$(text_file$,SUCC(RINSTR(text_file$,"\"))))
  589.     IF LEN(dummy$)>1
  590.       IF INSTR(UPPER$(RIGHT$(dummy$,5)),"MSG")>0
  591.         text_file$=dummy$
  592.         @save_text
  593.       ENDIF
  594.     ENDIF
  595.     black_white(15,0)
  596.   ENDIF
  597. RETURN
  598. > PROCEDURE save_text
  599.   '
  600.   LOCAL sav_handle&
  601.   '
  602.   ~FRE()
  603.   ~FRE(0)
  604.   '
  605.   IF @s_exist(text_file$)
  606.     ~GEMDOS(65,L:V:text_file$)
  607.   ENDIF
  608.   '
  609.   IF @s_exist(text_file$)=FALSE AND msg_adr%>0
  610.     sav_handle&=GEMDOS(60,L:V:text_file$,W:0)
  611.     IF sav_handle&>0
  612.       '
  613.       IF GEMDOS(64,W:sav_handle&,L:msg_len%,L:msg_adr%)=msg_len%
  614.         text_changed!=FALSE
  615.       ELSE
  616.         ~@alerte(3)
  617.       ENDIF
  618.       '
  619.       ~GEMDOS(62,W:sav_handle&)
  620.     ENDIF
  621.   ENDIF
  622.   '
  623. RETURN
  624. > PROCEDURE first_message
  625.   IF msg_nb&>0
  626.     black_white(8,1)
  627.     delai
  628.     msg_id&=0
  629.     display_message
  630.     black_white(8,0)
  631.   ELSE
  632.     init2
  633.     black_white(2,0)
  634.     black_white(9,0)
  635.     black_white(11,0)
  636.     edit_efface
  637.     black_white(3,0)
  638.     edit_pose
  639.   ENDIF
  640. RETURN
  641. > PROCEDURE last_message
  642.   IF msg_nb&>0
  643.     black_white(10,1)
  644.     delai
  645.     msg_id&=PRED(msg_nb&)
  646.     display_message
  647.     black_white(10,0)
  648.   ENDIF
  649. RETURN
  650. > PROCEDURE previous_message
  651.   IF msg_nb&>0
  652.     black_white(8,1)
  653.     delai
  654.     msg_id&=MAX(0,PRED(msg_id&))
  655.     display_message
  656.     black_white(8,0)
  657.   ENDIF
  658. RETURN
  659. > PROCEDURE next_message
  660.   IF msg_nb&>0
  661.     black_white(10,1)
  662.     delai
  663.     msg_id&=MIN(SUCC(msg_id&),PRED(msg_nb&))
  664.     display_message
  665.     black_white(10,0)
  666.   ENDIF
  667. RETURN
  668. > PROCEDURE display_message
  669.   '
  670.   msg_ptr%=ADD(ADD(msg_adr%,4),MUL(msg_id&,64))
  671.   '
  672.   CHAR{{OB_SPEC(adtree%(0),2)}}=LEFT$(STR$(INT{msg_ptr%}),3)
  673.   CHAR{{OB_SPEC(adtree%(0),9)}}=LEFT$(STR$(INT{ADD(msg_ptr%,2)}),3)
  674.   CHAR{{OB_SPEC(adtree%(0),11)}}=LEFT$(STR$(INT{ADD(msg_ptr%,4)}),3)
  675.   '
  676.   CHAR{{OB_SPEC(adtree%(0),4)}}=LEFT$(CHAR{ADD(msg_ptr%,6)},12)
  677.   CHAR{{OB_SPEC(adtree%(0),5)}}=LEFT$(CHAR{ADD(msg_ptr%,20)},12)
  678.   CHAR{{OB_SPEC(adtree%(0),6)}}=LEFT$(CHAR{ADD(msg_ptr%,34)},10)
  679.   CHAR{{OB_SPEC(adtree%(0),7)}}=LEFT$(CHAR{ADD(msg_ptr%,46)},10)
  680.   '
  681.   black_white(2,0)
  682.   black_white(9,0)
  683.   black_white(11,0)
  684.   edit_efface
  685.   black_white(3,0)
  686.   edit_pose
  687.   '
  688. RETURN
  689. > PROCEDURE valid_message
  690.   delai
  691.   IF msg_nb&>0
  692.     black_white(12,1)
  693.     delai
  694.     '
  695.     msg_ptr%=ADD(ADD(msg_adr%,4),MUL(msg_id&,64))
  696.     '
  697.     CHAR{ADD(msg_ptr%,6)}=LEFT$(CHAR{{OB_SPEC(adtree%(0),4)}},12)
  698.     CHAR{ADD(msg_ptr%,20)}=LEFT$(CHAR{{OB_SPEC(adtree%(0),5)}},12)
  699.     CHAR{ADD(msg_ptr%,34)}=LEFT$(CHAR{{OB_SPEC(adtree%(0),6)}},10)
  700.     CHAR{ADD(msg_ptr%,46)}=LEFT$(CHAR{{OB_SPEC(adtree%(0),7)}},10)
  701.     '
  702.     text_changed!=TRUE
  703.     black_white(12,0)
  704.     '
  705.     next_message
  706.   ENDIF
  707. RETURN
  708. '
  709. > FUNCTION alerte(id&)
  710.   RETURN FORM_ALERT(1,CHAR{OB_SPEC(adtree%(1),id&)})
  711. ENDFUNC
  712. > FUNCTION s_exist(exist_name$)
  713.   exist_name$=exist_name$+c0$
  714.   LOCAL existe&
  715.   IF LEN(exist_name$)=0 OR LEFT$(exist_name$)=c0$
  716.     RETURN FALSE
  717.   ELSE
  718.     existe&=GEMDOS(61,L:V:exist_name$,W:0)
  719.     IF existe&>0
  720.       ~GEMDOS(62,W:existe&)
  721.       RETURN TRUE
  722.     ELSE
  723.       RETURN FALSE
  724.     ENDIF
  725.   ENDIF
  726. ENDFUNC
  727. > FUNCTION test_cookie(cookie_name$,VAR cookie_valeur%)
  728.   LOCAL read_cook%,nom_cook%,cookie%
  729.   '
  730.   nom_cook%=CVL(cookie_name$)
  731.   cookie%=LPEEK(&H5A0)
  732.   cookie_valeur%=0
  733.   '
  734.   IF cookie%<>0
  735.     REPEAT
  736.       read_cook%=LPEEK(cookie%)
  737.       cookie_valeur%=LPEEK(cookie%+4)
  738.       ADD cookie%,8
  739.     UNTIL read_cook%=0 OR read_cook%=nom_cook%
  740.     IF read_cook%=nom_cook%
  741.       RETURN TRUE
  742.     ELSE
  743.       RETURN FALSE
  744.     ENDIF
  745.   ELSE
  746.     RETURN FALSE
  747.   ENDIF
  748. ENDFUNC
  749. > FUNCTION window_create(cp_win_recu&)
  750.   '
  751.   GCONTRL(0)=100
  752.   GCONTRL(1)=5
  753.   GCONTRL(2)=1
  754.   GCONTRL(3)=0
  755.   GCONTRL(4)=0
  756.   '
  757.   GINTIN(0)=cp_win_recu&
  758.   GINTIN(1)=30
  759.   GINTIN(2)=30
  760.   GINTIN(3)=30
  761.   GINTIN(4)=30
  762.   '
  763.   GEMSYS
  764.   '
  765.   RETURN GINTOUT(0)
  766. ENDFUNC
  767. > PROCEDURE v_hide_c
  768.   '
  769.   CONTRL(0)=123
  770.   CONTRL(1)=0
  771.   CONTRL(3)=0
  772.   CONTRL(6)=vdi_handle&
  773.   VDISYS
  774.   '
  775. RETURN
  776. > PROCEDURE v_show_c
  777.   CONTRL(0)=122
  778.   CONTRL(1)=0
  779.   CONTRL(3)=1
  780.   CONTRL(6)=vdi_handle&
  781.   INTIN(0)=1
  782.   VDISYS
  783. RETURN
  784. > PROCEDURE control
  785.   ~WIND_UPDATE(1)
  786.   ~WIND_UPDATE(3)
  787.   v_hide_c
  788. RETURN
  789. > PROCEDURE uncontrol
  790.   ~WIND_UPDATE(2)
  791.   ~WIND_UPDATE(0)
  792.   v_show_c
  793. RETURN
  794. > PROCEDURE delai
  795.   ~EVNT_TIMER(75)
  796. RETURN
  797. > FUNCTION v_opnvwk
  798.   $F&
  799.   '
  800.   INT{ADD(CONTRL,2)}=0
  801.   INT{ADD(CONTRL,6)}=11
  802.   INT{ADD(CONTRL,12)}=@graf_handle
  803.   '
  804.   INT{INTIN}=1           ! Numéro ID du périphérique physique (écran)
  805.   INT{ADD(INTIN,2)}=1    ! Type de ligne
  806.   INT{ADD(INTIN,4)}=1    ! Index de couleur Polyline
  807.   INT{ADD(INTIN,6)}=1    ! Type de marqueur
  808.   INT{ADD(INTIN,8)}=1    ! Index de couleur Polymarker
  809.   INT{ADD(INTIN,10)}=1   ! Fonte de caractères
  810.   INT{ADD(INTIN,12)}=1   ! Index couleur texte
  811.   INT{ADD(INTIN,14)}=1   ! Fill interior Style
  812.   INT{ADD(INTIN,16)}=1   ! Fill style index
  813.   INT{ADD(INTIN,18)}=1   ! Fill index couleur
  814.   INT{ADD(INTIN,20)}=2   ! Flag coordonnées NDC ou RC
  815.   '
  816.   VDISYS 100
  817.   '
  818.   RETURN INT{ADD(CONTRL,12)}
  819.   '
  820. ENDFUNC
  821. > PROCEDURE v_clsvwk(vdi_handle0&)
  822.   INT{ADD(CONTRL,12)}=vdi_handle0&
  823.   VDISYS 101,0,0
  824. RETURN
  825. > FUNCTION graf_handle
  826.   $F&
  827.   '
  828.   INT{ADD(GCONTRL,2)}=0
  829.   INT{ADD(GCONTRL,4)}=5
  830.   LONG{ADD(GCONTRL,6)}=0
  831.   '
  832.   GEMSYS 77
  833.   '
  834.   RETURN INT{GINTOUT}
  835.   '
  836. ENDFUNC
  837. > FUNCTION fileselector2$(type_msg&,path$,name$)
  838.   LOCAL path1$,name1$,choix_file&,retour_file&
  839.   LET path1$=path$
  840.   LET name1$=name$
  841.   retour_file&=@fi_input(type_msg&,path1$,name1$,choix_file&)
  842.   IF name1$=c0$ OR name1$=""
  843.     choix_file&=0
  844.   ENDIF
  845.   IF retour_file&=0 OR choix_file&=0
  846.     RETURN c0$
  847.   ELSE
  848.     RETURN LEFT$(path1$,RINSTR(path1$,"\"))+name1$
  849.   ENDIF
  850. ENDFUNC
  851. > FUNCTION fi_input(type_msg&,VAR fi_path$,fi_name$,fi_choix&)
  852.   $F&
  853.   '
  854.   ~FRE()
  855.   ~FRE(0)
  856.   '
  857.   IF tos_version%<104
  858.     type_msg&=0
  859.   ENDIF
  860.   '
  861.   IF type_msg&>0
  862.     GCONTRL(0)=91
  863.   ELSE
  864.     GCONTRL(0)=90
  865.   ENDIF
  866.   GCONTRL(1)=0
  867.   GCONTRL(2)=2
  868.   IF type_msg&>0
  869.     GCONTRL(3)=3
  870.   ELSE
  871.     GCONTRL(3)=2
  872.   ENDIF
  873.   GCONTRL(4)=0
  874.   '
  875.   fi_path$=fi_path$+SPACE$(300)
  876.   fi_name$=fi_name$+SPACE$(100)
  877.   '
  878.   ADDRIN(0)=V:fi_path$
  879.   ADDRIN(1)=V:fi_name$
  880.   IF type_msg&>0
  881.     ADDRIN(2)=OB_SPEC(adtree%(1),type_msg&)
  882.   ENDIF
  883.   '
  884.   GEMSYS
  885.   '
  886.   fi_path$=CHAR{V:fi_path$}+c0$
  887.   fi_name$=CHAR{V:fi_name$}+c0$
  888.   fi_choix&=GINTOUT(1)
  889.   '
  890.   RETURN GINTOUT(0)
  891. ENDFUNC
  892.