home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Pd / selects.e < prev    next >
Encoding:
Text File  |  1994-12-01  |  9.6 KB  |  262 lines
  1. /***************************************************/
  2. /* SelectScreen v0.0a (c) 1993 NasGûl              */
  3. /***************************************************/
  4. /*
  5. C_DATE=05 Feb 1994
  6. C_TIME=00:06:52
  7. */
  8. ENUM NONE,ER_OPENLIB,ER_WB,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW,ER_MENUS,
  9.      ER_MEM,ER_SIG
  10.  
  11. ENUM JOB_DONE,JOB_CONST,JOB_OBJ,JOB_LIB=6
  12.  
  13. MODULE 'intuition/intuition','gadtools', 'libraries/gadtools',
  14.        'intuition/gadgetclass', 'exec/nodes', 'intuition/screens',
  15.        'exec/lists','exec/tasks','intuition/intuitionbase'
  16. MODULE 'exec/libraries','exec/execbase'
  17. MODULE 'dos/dosasl', 'dos/dos', 'utility','utility/tagitem'
  18. MODULE 'reqtools','libraries/reqtools','graphics/text'
  19.  
  20. CONST L_SCREEN=0, /* Type of the list (screens or windows )*/
  21.       L_WINDOW=1
  22.  
  23. RAISE ER_MEM IF New()=NIL
  24. RAISE ER_MEM IF String()=NIL
  25.  
  26. DEF scr=NIL:PTR TO screen,         /* Ptr sur l'écran */
  27.     visual=NIL,                    /* Ptr sur visual */
  28.     wnd=NIL:PTR TO window,         /* Ptr sur fenêtre */
  29.     glist=NIL,offy,g,g1,gwb,       /* liste des Gadget and listview (g1) WB (gwb)*/
  30.     type,infos                     /* type et infos pour IDCMP */
  31. DEF new_liste:PTR TO lh            /* Ma liste */
  32. DEF add_node[1000]:ARRAY OF LONG   /* Adresse de noeud */
  33. DEF add_texte[1000]:ARRAY OF LONG  /* Texte des noeuds */
  34. DEF add_scr[1000]:ARRAY OF LONG    /* Adresse d'écran */
  35. DEF type_liste=L_SCREEN            /* initialise liste d'écran */
  36. DEF max_node=1                     /* initialise le nombre de noeud */
  37. DEF ac_win,wb_add,check=FALSE      /* Adress e de la première windowAnd WB */
  38.                                    /* vérifie CloseScreen quand selectionné */
  39.                                    /* dans le listview */
  40. DEF tattr
  41. PROC main() HANDLE /*"main()"*/
  42.   /* Initialise my list */
  43.   DEF sig
  44.   new_liste:=[0,0,0,0]
  45.   IF (sig:=AllocSignal(-1))=NIL THEN checkerror(ER_SIG)
  46.   checkerror(initinterface())
  47.   checkerror(openinterface())
  48.   REPEAT
  49.     wait4message()
  50.   UNTIL type=IDCMP_CLOSEWINDOW
  51.   OpenWorkBench()
  52.   Raise(NONE)
  53. EXCEPT
  54.     IF sig THEN FreeSignal(sig)
  55.     closeinterface()
  56.     SELECT exception
  57.         CASE NONE;   NOP
  58.         CASE ER_MEM; WriteF('Mémoire insufisante.\n')
  59.         DEFAULT;     NOP
  60.     ENDSELECT
  61. ENDPROC
  62. PROC initinterface() /*"initinterface()"*/
  63.   /* Open library - Remember the address of firstwindow and wb */
  64.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ER_OPENLIB
  65.   IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN RETURN ER_OPENLIB
  66.   IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN ER_WB
  67.   wb_add:=scr
  68.   /*IF scr THEN UnlockPubScreen(NIL,scr)*/
  69.   ac_win:=wnd
  70. ENDPROC
  71. PROC openinterface() /*"openinterface()"*/
  72.   /* Ouvre l\ainterface */
  73.   tattr:=['topaz.font',8,0,0]:textattr
  74.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN ER_VISUAL
  75.   offy:=scr.wbortop+Int(scr.rastport+58)+1
  76.   IF (g:=CreateContext({glist}))=NIL THEN RETURN ER_CONTEXT
  77.   new_liste:=[0,0,0,0]
  78.   displayscreens()
  79.   /* Gadget pour fermeture (close) et ouverture (open) WB */
  80.   IF (gwb:=CreateGadgetA(CYCLE_KIND,g,[scr.wborleft+92,12,80,12,'',tattr,1,0,visual,0]:newgadget,[GTCY_LABELS,['CloseWB','OpenWB',0],0]))=NIL THEN RETURN ER_GADGET
  81.   /* Gadget pour écran et fenêtre */
  82.   IF (g:=CreateGadgetA(CYCLE_KIND,gwb,[scr.wborleft+2,12,80,12,'',tattr,2,0,visual,0]:newgadget,[GTCY_LABELS,['Screens','Windows',0],0]))=NIL THEN RETURN ER_GADGET
  83.   /* Boite à cocher (Checkbox) pour CloseScreen */
  84.   IF (g:=CreateGadgetA(CHECKBOX_KIND,g,[scr.wborleft+176,13,80,12,'CloseScreen',tattr,4,PLACETEXT_RIGHT,visual,0]:newgadget,NIL))=NIL THEN RETURN ER_GADGET
  85.   /* Gadget du ViewList */
  86.   IF (g1:=CreateGadgetA(LISTVIEW_KIND,g,[scr.wborleft+2,25,315,50,NIL,NIL,3,0,visual,new_liste]:newgadget,
  87.                                         [GTLV_TOP,0,GTLV_SCROLLWIDTH,15,
  88.                                          GTLV_LABELS,new_liste,0]))=NIL THEN RETURN ER_GADGET
  89.   /* Ouvre la fenetre */
  90.   IF (wnd:=OpenW(0,0,325,76,$304 OR LISTVIEWIDCMP,2+4+8+WFLG_HASZOOM,'SelectS v0.0a (c) 1993 NasGûl',scr,15,glist))=NIL THEN RETURN ER_WINDOW
  91.   /* Rafraichit */
  92.   Gt_RefreshWindow(wnd,NIL)
  93.   Gt_SetGadgetAttrsA(g1,wnd,NIL,[GTLV_TOP,0,GTLV_LABELS,new_liste,0])
  94.   /* Active la première fenêtre */
  95.   ActivateWindow(ac_win)
  96. ENDPROC
  97. PROC close_win() /*"close_win()"*/
  98.   IF visual THEN FreeVisualInfo(visual)
  99.   IF wnd THEN CloseWindow(wnd)
  100.   IF glist THEN FreeGadgets(glist)
  101. ENDPROC
  102. PROC closeinterface() /*"closeinterface()"*/
  103.   IF wnd THEN ClearMenuStrip(wnd)
  104.   IF visual THEN FreeVisualInfo(visual)
  105.   IF wnd THEN CloseWindow(wnd)
  106.   IF glist THEN FreeGadgets(glist)
  107.   IF scr THEN UnlockPubScreen(NIL,scr)
  108.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  109.   IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  110.   IF intuitionbase THEN CloseLibrary(intuitionbase)
  111. ENDPROC
  112. PROC checkerror(er) /*"checkerror(er)"*/
  113.   DEF errors:PTR TO LONG
  114.   IF er>0
  115.     closeinterface()
  116.     errors:=['','ouvrir la"gadtools.library" v37','locker le workbench','prendre le visual infos','créer le contexte','créer les gadgets','ouvrir la fenêtre','allouer menus','Erreur mémoire','Erreur signal']
  117.     RtEZRequestA('Ne peut pas \s\n','Ok',0,[errors[er]],[RTEZ_REQTITLE,'SelectS v0.0a',TAG_DONE]:tagitem)
  118.     CleanUp(10)
  119.   ENDIF
  120. ENDPROC
  121. PROC wait4message() /*"wait4message()"*/
  122.   DEF mes:PTR TO intuimessage,g:PTR TO gadget
  123.   DEF change_scr=FALSE,test_wb
  124.   REPEAT
  125.     type:=0
  126.     IF mes:=Gt_GetIMsg(wnd.userport)
  127.       type:=mes.class
  128.       IF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP)
  129.         g:=mes.iaddress
  130.         infos:=g.gadgetid
  131.         SELECT infos
  132.             CASE 1                       /* CloseWB ou gadget OpenWB */
  133.                 IF mes.code=1
  134.                     test_wb:=CloseWorkBench()
  135.                     IF test_wb=0 THEN DisplayBeep(0)
  136.                 ELSEIF mes.code=0
  137.                     test_wb:=OpenWorkBench()
  138.                     IF test_wb=0 THEN DisplayBeep(0)
  139.                 ENDIF
  140.             CASE 2                       /* gadget écran ou fenêtre */
  141.                 IF type_liste=L_SCREEN
  142.                     type_liste:=L_WINDOW
  143.                     displaywindows()
  144.                 ELSE
  145.                    type_liste:=L_SCREEN
  146.                    displayscreens()
  147.                 ENDIF
  148.             CASE 3                       /* ListView */
  149.                 infos:=mes.code+1
  150.                 IF type_liste=L_SCREEN   /* pour écrans */
  151.                     IF check=FALSE       /* CheckBox non coché */
  152.                         ScreenToFront(add_scr[infos])
  153.                         scr:=add_scr[infos]
  154.                         ac_win:=scr.firstwindow
  155.                         change_scr:=TRUE
  156.                     ELSE                 /* CheckBox coché */
  157.                         test_wb:=CloseScreen(add_scr[infos])
  158.                         IF test_wb=0 THEN DisplayBeep(0)
  159.                     ENDIF
  160.                 ELSE                     /* pour fenêtres */
  161.                     WindowToFront(add_scr[infos])
  162.                 ENDIF
  163.             CASE 4                       /* le CheckBox pour CloseScreen */
  164.                 IF mes.code THEN check:=TRUE ELSE check:=FALSE
  165.             DEFAULT; NOP
  166.         ENDSELECT
  167.         /* Rafraichit la ViewList */
  168.         Gt_SetGadgetAttrsA(g1,wnd,NIL,[GTLV_LABELS,new_liste,0])
  169.       ELSEIF type=IDCMP_REFRESHWINDOW    /* pour le gadget Zip */
  170.         Gt_BeginRefresh(wnd)
  171.         Gt_RefreshWindow(wnd,NIL)
  172.         Gt_EndRefresh(wnd,TRUE)
  173.       ELSEIF type<>IDCMP_CLOSEWINDOW
  174.         type:=0
  175.       ENDIF
  176.       Gt_ReplyIMsg(mes)
  177.     ELSE
  178.         Wait(-1)
  179.         /* Rafraichit le ListView */
  180.         IF type_liste=L_SCREEN THEN displayscreens() ELSE displaywindows()
  181.         Gt_SetGadgetAttrsA(g1,wnd,NIL,[GTLV_LABELS,new_liste,0])
  182.     ENDIF
  183.   UNTIL type
  184.   /* Change l'écran */
  185.   IF change_scr=TRUE
  186.       close_win()
  187.       checkerror(openinterface())
  188.   ENDIF
  189. ENDPROC
  190. PROC displayscreens() /*"displayscreens()"*/
  191.   /* Fait la liste de TOUS les écrans (public ou non) */
  192.   DEF slist:PTR TO screen
  193.   DEF intui:PTR TO intuitionbase
  194.   DEF str_piv[256]:STRING,mynode:PTR TO ln,b
  195.   max_node:=1
  196.   add_node[0]:=0
  197.   new_liste:=[0,0,0,0]
  198.   Forbid()
  199.   intui:=intuitionbase
  200.   slist:=intui.firstscreen
  201.   WHILE slist
  202.     add_node[max_node]:=New(SIZEOF ln)
  203.     StringF(str_piv,'\l\s[35]*',
  204.           slist.title)
  205.     add_texte[max_node]:=String(EstrLen(str_piv))
  206.     StrCopy(add_texte[max_node],str_piv,ALL)
  207.     mynode:=add_node[max_node]
  208.     mynode.pri:=0
  209.     mynode.name:=add_texte[max_node]
  210.     add_scr[max_node]:=slist
  211.     INC max_node
  212.     slist:=slist.nextscreen
  213.   ENDWHILE
  214.   Permit()
  215.   FOR b:=1 TO max_node-1
  216.       mynode:=add_node[b]
  217.       mynode.succ:=add_node[b+1]
  218.       mynode.pred:=add_node[b-1]
  219.       mynode.name:=add_texte[b]
  220.       AddTail(new_liste,mynode)
  221.   ENDFOR
  222.   new_liste.head:=add_node[1]
  223.   new_liste.tailpred:=add_node[max_node-1]
  224. ENDPROC
  225. PROC displaywindows() /*"displaywindows()"*/
  226.   /* Make the list of the windows */
  227.   DEF slist:PTR TO screen,wlist:PTR TO window,
  228.       intui:PTR TO intuitionbase
  229.   DEF str_piv[256]:STRING,mynode:PTR TO ln,b
  230.   max_node:=1
  231.   add_node[0]:=0
  232.   new_liste:=[0,0,0,0]
  233.   Forbid()
  234.   intui:=intuitionbase
  235.   slist:=intui.firstscreen
  236.   wlist:=slist.firstwindow
  237.   WHILE wlist
  238.     add_node[max_node]:=New(SIZEOF ln)
  239.     add_scr[max_node]:=wlist
  240.     StringF(str_piv,'\l\s[80]',wlist.title)
  241.     add_texte[max_node]:=String(EstrLen(str_piv))
  242.     StrCopy(add_texte[max_node],str_piv,ALL)
  243.     mynode:=add_node[max_node]
  244.     mynode.pri:=0
  245.     mynode.name:=add_texte[max_node]
  246.     INC max_node
  247.     wlist:=wlist.nextwindow
  248.   ENDWHILE
  249.   slist:=slist.nextscreen
  250.   Permit()
  251.   FOR b:=1 TO max_node-1
  252.       mynode:=add_node[b]
  253.       mynode.succ:=add_node[b+1]
  254.       mynode.pred:=add_node[b-1]
  255.       mynode.name:=add_texte[b]
  256.       AddTail(new_liste,mynode)
  257.   ENDFOR
  258.   new_liste.head:=add_node[1]
  259.   new_liste.tailpred:=add_node[max_node-1]
  260. ENDPROC
  261.  
  262.