home *** CD-ROM | disk | FTP | other *** search
/ Dream 57 / Amiga_Dream_57.iso / Amiga / Programmation / e / Exemples / capus.lha / SModule / SMGui.e < prev    next >
Encoding:
Text File  |  1994-05-02  |  30.1 KB  |  818 lines
  1. /*******************************************************************************************/
  2. /* Source code generate by Gui2E v0.1 ⌐ 1994 NasG√l                                        */
  3. /*******************************************************************************************/
  4. /********************************************************************************
  5.  * << EUTILS HEADER >>
  6.  ********************************************************************************
  7.  ED
  8.  EC
  9.  PREPRO
  10.  SOURCE
  11.  EPPDEST
  12.  EXEC
  13.  ISOURCE
  14.  HSOURCE
  15.  ERROREC
  16.  ERROREPP
  17.  VERSION
  18.  REVISION
  19.  NAMEPRG
  20.  NAMEAUTHOR
  21.  ********************************************************************************
  22.  * HISTORY :
  23.  *******************************************************************************/
  24.  
  25. OPT OSVERSION=37
  26.  
  27. MODULE 'intuition/intuition','gadtools','libraries/gadtools','intuition/gadgetclass','intuition/screens',
  28.        'graphics/text','exec/lists','exec/nodes','exec/ports','eropenlib','utility/tagitem'
  29. MODULE 'smgui','reqtools','libraries/reqtools'
  30. ENUM ER_NONE,ER_LOCKSCREEN,ER_VISUAL,ER_CONTEXT,ER_MENUS,ER_GADGET,ER_WINDOW,
  31.      ER_LIST,ER_MEM
  32. ENUM JOB_DONE,JOB_CONST,JOB_OBJ,JOB_LIB=6
  33.  
  34. CONST F_OBJ=0,
  35.       F_CONST=1,
  36.       F_FUNC=2
  37. CONST MODE_LOAD=0,
  38.       MODE_SAVE=1,
  39.       FUNC_MOD=0,
  40.       FUNC_CONF=1
  41. CONST ID_SMOD=$534D4F44,
  42.       ID_MODU=$4D4F4455
  43. DEF screen:PTR TO screen,
  44.     visual=NIL,
  45.     tattr:PTR TO textattr,
  46.     reelquit=FALSE,
  47.     offy
  48. /****************************************
  49.  * sm Definitions
  50.  ****************************************/
  51. DEF sm_window=NIL:PTR TO window
  52. DEF sm_glist=NIL
  53. /* Gadgets */
  54. CONST GA_G_ADDMOD=0
  55. CONST GA_G_REMMOD=1
  56. CONST GA_G_SAVEMOD=2
  57. CONST GA_G_FINDOBJ=3
  58. CONST GA_G_FINDCONST=4
  59. CONST GA_G_FINDFUNC=5
  60. CONST GA_G_LOADCONG=6
  61. CONST GA_G_SAVECONF=7
  62. CONST GA_G_QUIT=8
  63. CONST GA_G_MODLIST=9
  64. CONST GA_G_DATALIST=10
  65. /* Gadgets labels of sm */
  66. DEF g_addmod
  67. DEF g_remmod
  68. DEF g_savemod
  69. DEF g_findobj
  70. DEF g_findconst
  71. DEF g_findfunc
  72. DEF g_loadcong
  73. DEF g_saveconf
  74. DEF g_quit
  75. DEF g_modlist
  76. DEF g_datalist
  77. /***********************/
  78. /* Application         */
  79. /***********************/
  80. DEF mysm:PTR TO smbase
  81. DEF currentmodule=0
  82. /***********************/
  83. /* OpenClose Libraries */
  84. /***********************/
  85. PROC p_OpenLibraries() HANDLE /*"p_OpenLibraries()"*/
  86.     IF (intuitionbase:=OpenLibrary('intuition.library',37))=NIL THEN Raise(ER_INTUITIONLIB)
  87.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ER_GADTOOLSLIB)
  88.     IF (gfxbase:=OpenLibrary('graphics.library',37))=NIL THEN Raise(ER_GRAPHICSLIB)
  89.     IF (reqtoolsbase:=OpenLibrary('reqtools.library',38))=NIL THEN Raise(ER_REQTOOLSLIB)
  90.     Raise(ER_NONE)
  91. EXCEPT
  92.     RETURN exception
  93. ENDPROC
  94. PROC p_CloseLibraries()  /*"p_CloseLibraries()"*/
  95.     IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  96.     IF gfxbase THEN CloseLibrary(gfxbase)
  97.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  98.     IF intuitionbase THEN CloseLibrary(intuitionbase)
  99. ENDPROC
  100. /***********************/
  101. /* List fonctions      */
  102. /***********************/
  103. PROC p_InitList() HANDLE /*"p_InitList()"*/
  104. /********************************************************************************
  105.  * Para         : NONE
  106.  * Return       : address of the new list if ok,else NIL.
  107.  * Description  : Initialise a list.
  108.  *******************************************************************************/
  109.     DEF i_list:PTR TO lh
  110.     i_list:=New(SIZEOF lh)
  111.     i_list.tail:=0
  112.     i_list.head:=i_list.tail
  113.     i_list.tailpred:=i_list.head
  114.     i_list.type:=0
  115.     i_list.pad:=0
  116.     IF i_list THEN Raise(i_list) ELSE Raise(NIL)
  117. EXCEPT
  118.     RETURN exception
  119. ENDPROC
  120. PROC p_RemoveList(list:PTR TO lh) /*"p_RemoveList(list:PTR TO lh)"*/
  121. /********************************************************************************
  122.  * Para         : address of list
  123.  * Return       : NONE
  124.  * Description  : p_CleanList() and dispose the list.
  125.  *******************************************************************************/
  126.     list:=p_CleanList(list)
  127.     IF list THEN Dispose(list)
  128. ENDPROC
  129. PROC p_CleanList(list:PTR TO lh) /*"p_CleanList(list:PTR TO lh)"*/
  130. /********************************************************************************
  131.  * Para         : address of list
  132.  * Return       : address of clean list
  133.  * Description  : Remove all nodes in the list.
  134.  *******************************************************************************/
  135.     DEF node:PTR TO ln
  136.     node:=list.head
  137.     WHILE node
  138.         IF node.succ=0 THEN RemTail(list)
  139.         IF node.pred=0 THEN RemHead(list)
  140.         IF (node.succ<>0) AND (node.pred<>0) THEN Remove(node)
  141.         node:=node.succ
  142.     ENDWHILE
  143.     RETURN list
  144. ENDPROC
  145. PROC p_GetAdrNode(ptr_list,num_node) /*"p_GetAdrNode(ptr_list,num_node)"*/
  146. /********************************************************************************
  147.  * Para         : address of list,number's node.
  148.  * Return       : address of node or NIL.
  149.  * Description  : Find the address of a node.
  150.  *******************************************************************************/
  151.     DEF g_list:PTR TO lh
  152.     DEF g_node:PTR TO ln
  153.     DEF count=0
  154.     g_list:=ptr_list
  155.     g_node:=g_list.head
  156.     WHILE g_node
  157.         IF count=num_node THEN RETURN g_node
  158.         INC count
  159.         g_node:=g_node.succ
  160.     ENDWHILE
  161.     RETURN NIL
  162. ENDPROC
  163. PROC p_GetNumNode(ptr_list,adr_node) /*"p_GetNumNode(ptr_list,adr_node)"*/
  164. /********************************************************************************
  165.  * Para         : address of list,address of node
  166.  * Return       : the number of the node.
  167.  * Description  : Find the number of a node.
  168.  *******************************************************************************/
  169.     DEF g_list:PTR TO lh
  170.     DEF g_node:PTR TO ln
  171.     DEF count=0
  172.     g_list:=ptr_list
  173.     g_node:=g_list.head
  174.     WHILE g_node
  175.         IF g_node=adr_node THEN RETURN count
  176.         INC count
  177.         g_node:=g_node.succ
  178.     ENDWHILE
  179.     RETURN NIL
  180. ENDPROC
  181. PROC p_AjouteNode(ptr_list,node_name) HANDLE /*"p_AjouteNode(ptr_list,node_name)"*/
  182. /********************************************************************************
  183.  * Para         : address of list,the name of a node.
  184.  * Return       : the number of the new selected node in the list.
  185.  * Description  : Add a node and return the new current node (for LISTVIEW_KIND).
  186.  *******************************************************************************/
  187.     DEF a_list:PTR TO lh
  188.     DEF a_node:PTR TO ln
  189.     DEF nn=NIL
  190.     a_list:=ptr_list
  191.     a_node:=New(SIZEOF ln)
  192.     a_node.succ:=0
  193.     a_node.name:=String(EstrLen(node_name))
  194.     StrCopy(a_node.name,node_name,ALL)
  195.     AddTail(a_list,a_node)
  196.     nn:=p_GetNumNode(a_list,a_node)
  197.     IF nn=0
  198.         a_list.head:=a_node
  199.         a_node.pred:=0
  200.    /**********************************************
  201.         a_node.succ:=0
  202.         a_list.tailpred:=a_node
  203.     ELSE
  204.         a_node.succ:=0
  205.         a_node.pred:=p_GetAdrNode(a_list,nn-1)
  206.         a_list.tailpred:=a_node
  207.     **********************************************/
  208.     ENDIF
  209.     Raise(nn)
  210. EXCEPT
  211.     RETURN exception
  212. ENDPROC
  213. PROC p_EmptyList(adr_list) /*"p_EmptyList(adr_list)"*/
  214. /********************************************************************************
  215.  * Para         : address of list.
  216.  * Return       : TRUE if list is empty,else address of list.
  217.  * Description  : Look if a list is empty.
  218.  *******************************************************************************/
  219.     DEF e_list:PTR TO lh,count=0
  220.     DEF e_node:PTR TO ln
  221.     e_list:=adr_list
  222.     e_node:=e_list.head
  223.     WHILE e_node
  224.         IF e_node.succ<>0 THEN INC count
  225.         e_node:=e_node.succ
  226.     ENDWHILE
  227.     IF count=0 THEN RETURN TRUE ELSE RETURN e_list
  228. ENDPROC
  229. PROC p_RemoveModuleList(list:PTR TO lh,action) /*"p_RemoveModuleList(list:PTR TO lh,action)"*/
  230.     DEF rmod:PTR TO modulenode
  231.     DEF node:PTR TO ln
  232.     rmod:=list.head
  233.     WHILE rmod
  234.         node:=rmod
  235.         IF node.succ<>0
  236.             IF rmod.datalist THEN p_RemoveList(rmod.datalist)
  237.             IF rmod THEN Dispose(rmod)
  238.         ENDIF
  239.         IF node.succ=0 THEN RemTail(list)
  240.         IF node.pred=0 THEN RemHead(list)
  241.         IF (node.succ<>0) AND (node.pred<>0) THEN Remove(node)
  242.         rmod:=node.succ
  243.     ENDWHILE
  244.     IF action=TRUE
  245.         IF list THEN Dispose(list)
  246.     ENDIF
  247. ENDPROC
  248. PROC p_RemoveModuleNode(list:PTR TO lh,numnode) /*"p_RemoveModuleNode(list:PTR TO lh,numnode)"*/
  249.     DEF rmod:PTR TO modulenode
  250.     DEF node:PTR TO ln,count=0
  251.     DEF retour=NIL,newnode:PTR TO ln
  252.     rmod:=list.head
  253.     WHILE rmod
  254.         node:=rmod
  255.         IF count=numnode
  256.             IF node.succ<>0
  257.                 IF rmod.datalist THEN p_RemoveList(rmod.datalist)
  258.                 IF rmod THEN Dispose(rmod)
  259.             ENDIF
  260.             IF node.succ=0
  261.                 RemTail(list)
  262.                 retour:=numnode-1
  263.             ELSEIF node.pred=0
  264.                 RemHead(list)
  265.                 retour:=numnode
  266.                 newnode:=p_GetAdrNode(list,numnode)
  267.                 list.head:=newnode
  268.                 newnode.pred:=0
  269.             ELSEIF (node.succ<>0) AND (node.pred<>0)
  270.                 Remove(node)
  271.                 retour:=numnode-1
  272.             ENDIF
  273.         ENDIF
  274.         INC count
  275.         rmod:=node.succ
  276.     ENDWHILE
  277.     RETURN retour
  278. ENDPROC
  279. /***********************/
  280. /* Window Proc         */
  281. /***********************/
  282. PROC p_SetUpScreen() HANDLE /*"p_SetUpScreen()"*/
  283.     IF (screen:=LockPubScreen('Workbench'))=NIL THEN Raise(ER_LOCKSCREEN)
  284.     IF (visual:=GetVisualInfoA(screen,NIL))=NIL THEN Raise(ER_VISUAL)
  285.     offy:=screen.wbortop+Int(screen.rastport+58)+1
  286.     Raise(ER_NONE)
  287. EXCEPT
  288.     RETURN exception
  289. ENDPROC
  290. PROC p_SetDownScreen() /*"p_SetDownScreen()"*/
  291.     IF visual THEN FreeVisualInfo(visual)
  292.     IF screen THEN UnlockPubScreen(NIL,screen)
  293. ENDPROC
  294. PROC p_InitsmWindow() HANDLE /*"p_InitsmWindow()"*/
  295.     IF (sm_glist:=CreateContext({sm_glist}))=NIL THEN Raise(ER_CONTEXT)
  296.     IF (g_addmod:=CreateGadgetA(BUTTON_KIND,sm_glist,[21,20,151,12,'Charger Module',tattr,0,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  297.     IF (g_remmod:=CreateGadgetA(BUTTON_KIND,g_addmod,[21,33,151,12,'Enlever Module',tattr,1,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  298.     IF (g_savemod:=CreateGadgetA(BUTTON_KIND,g_remmod,[21,46,151,12,'Sauver Module',tattr,2,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  299.     IF (g_findobj:=CreateGadgetA(BUTTON_KIND,g_savemod,[206,20,151,12,'Trouver Objet',tattr,3,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  300.     IF (g_findconst:=CreateGadgetA(BUTTON_KIND,g_findobj,[206,33,151,12,'Trouver Const.',tattr,4,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  301.     IF (g_findfunc:=CreateGadgetA(BUTTON_KIND,g_findconst,[206,46,151,12,'Trouver Fonct.',tattr,5,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  302.     IF (g_loadcong:=CreateGadgetA(BUTTON_KIND,g_findfunc,[392,20,151,12,'Charger Conf.',tattr,6,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  303.     IF (g_saveconf:=CreateGadgetA(BUTTON_KIND,g_loadcong,[392,33,151,12,'Sauver Conf.',tattr,7,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  304.     IF (g_quit:=CreateGadgetA(BUTTON_KIND,g_saveconf,[392,46,151,12,'Quitter.',tattr,8,16,visual,0]:newgadget,[GA_RELVERIFY,TRUE,GA_DISABLED,FALSE,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  305.     IF (g_modlist:=CreateGadgetA(LISTVIEW_KIND,g_quit,[13,65,540,41,'',tattr,9,0,visual,0]:newgadget,[GTLV_SHOWSELECTED,NIL,GTLV_LABELS,-1,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  306.     IF (g_datalist:=CreateGadgetA(LISTVIEW_KIND,g_modlist,[15,107,540,129,'',tattr,10,0,visual,0]:newgadget,[GTLV_READONLY,TRUE,GTLV_LABELS,-1,GT_UNDERSCORE,"_",TAG_DONE,0]))=NIL THEN Raise(ER_GADGET)
  307.     Raise(ER_NONE)
  308. EXCEPT
  309.     RETURN exception
  310. ENDPROC
  311. PROC p_RendersmWindow() /*"p_RendersmWindow()"*/
  312.     DEF infomod:PTR TO modulenode
  313.     IF p_EmptyList(mysm.modulelist)=-1
  314.         Gt_SetGadgetAttrsA(g_modlist,sm_window,NIL,[GA_DISABLED,TRUE,GTLV_LABELS,mysm.emptylist,TAG_DONE,0])
  315.         Gt_SetGadgetAttrsA(g_datalist,sm_window,NIL,[GA_DISABLED,TRUE,GTLV_LABELS,mysm.emptylist,TAG_DONE,0])
  316.         Gt_SetGadgetAttrsA(g_remmod,sm_window,NIL,[GA_DISABLED,TRUE,TAG_DONE,0])
  317.         Gt_SetGadgetAttrsA(g_savemod,sm_window,NIL,[GA_DISABLED,TRUE,TAG_DONE,0])
  318.         Gt_SetGadgetAttrsA(g_findobj,sm_window,NIL,[GA_DISABLED,TRUE,TAG_DONE,0])
  319.         Gt_SetGadgetAttrsA(g_findconst,sm_window,NIL,[GA_DISABLED,TRUE,TAG_DONE,0])
  320.         Gt_SetGadgetAttrsA(g_findfunc,sm_window,NIL,[GA_DISABLED,TRUE,TAG_DONE,0])
  321.         Gt_SetGadgetAttrsA(g_saveconf,sm_window,NIL,[GA_DISABLED,TRUE,TAG_DONE,0])
  322.     ELSE
  323.         infomod:=p_GetAdrNode(mysm.modulelist,currentmodule)
  324.         Gt_SetGadgetAttrsA(g_modlist,sm_window,NIL,[GA_DISABLED,FALSE,GTLV_SHOWSELECTED,TRUE,GTLV_SELECTED,currentmodule,GTLV_LABELS,mysm.modulelist,TAG_DONE,0])
  325.         Gt_SetGadgetAttrsA(g_datalist,sm_window,NIL,[GA_DISABLED,FALSE,GTLV_LABELS,infomod.datalist,TAG_DONE,0])
  326.         Gt_SetGadgetAttrsA(g_remmod,sm_window,NIL,[GA_DISABLED,FALSE,TAG_DONE,0])
  327.         Gt_SetGadgetAttrsA(g_savemod,sm_window,NIL,[GA_DISABLED,FALSE,TAG_DONE,0])
  328.         Gt_SetGadgetAttrsA(g_findobj,sm_window,NIL,[GA_DISABLED,FALSE,TAG_DONE,0])
  329.         Gt_SetGadgetAttrsA(g_findconst,sm_window,NIL,[GA_DISABLED,FALSE,TAG_DONE,0])
  330.         Gt_SetGadgetAttrsA(g_findfunc,sm_window,NIL,[GA_DISABLED,FALSE,TAG_DONE,0])
  331.         Gt_SetGadgetAttrsA(g_saveconf,sm_window,NIL,[GA_DISABLED,FALSE,TAG_DONE,0])
  332.     ENDIF
  333.     DrawBevelBoxA(sm_window.rport,10,15,545,48,[GT_VISUALINFO,visual,TAG_DONE,0])
  334.     RefreshGList(g_addmod,sm_window,NIL,-1)
  335.     Gt_RefreshWindow(sm_window,NIL)
  336. ENDPROC
  337. PROC p_OpensmWindow() HANDLE /*"p_OpensmWindow()"*/
  338.     IF (sm_window:=OpenWindowTagList(NIL,
  339.                       [WA_LEFT,10,
  340.                        WA_TOP,0,
  341.                        WA_WIDTH,565,
  342.                        WA_HEIGHT,234,
  343.                        WA_IDCMP,$400278+IDCMP_REFRESHWINDOW,
  344.                        WA_FLAGS,$102E+WFLG_HASZOOM,
  345.                        WA_ZOOM,[10,0,565,11]:INT,
  346.                        WA_GADGETS,sm_glist,
  347.                        WA_TITLE,'SModule v0.5 ⌐ 1992/1994 $#%!/NasG√l',
  348.                        WA_SCREENTITLE,'Made With GadToolsBox v2.0 ⌐ 1991-1993',
  349.                        TAG_DONE]))=NIL THEN Raise(ER_WINDOW)
  350.     p_RendersmWindow()
  351.     Raise(ER_NONE)
  352. EXCEPT
  353.     RETURN exception
  354. ENDPROC
  355. PROC p_RemsmWindow() /*"p_RemsmWindow()"*/
  356.     IF sm_window THEN CloseWindow(sm_window)
  357.     IF sm_glist THEN FreeGadgets(sm_glist)
  358. ENDPROC
  359. PROC p_LockListView() /*"p_LockListView()"*/
  360.     Gt_SetGadgetAttrsA(g_modlist,sm_window,NIL,[GTLV_LABELS,-1,TAG_DONE,0])
  361.     Gt_SetGadgetAttrsA(g_datalist,sm_window,NIL,[GTLV_LABELS,-1,TAG_DONE,0])
  362. ENDPROC
  363. /***********************/
  364. /* Message Proc        */
  365. /***********************/
  366. PROC p_LookAllMessage() /*"p_LookAllMessage()"*/
  367.     DEF sigreturn
  368.     DEF smport:PTR TO mp
  369.     IF sm_window THEN smport:=sm_window.userport ELSE smport:=NIL
  370.     sigreturn:=Wait(Shl(1,smport.sigbit) OR
  371.                     $F000)
  372.     IF (sigreturn AND Shl(1,smport.sigbit))
  373.         p_LooksmMessage()
  374.     ENDIF
  375.     IF (sigreturn AND $F000)
  376.         reelquit:=TRUE
  377.     ENDIF
  378. ENDPROC
  379. PROC p_LooksmMessage() /*"p_LooksmMessage()"*/
  380.    DEF mes:PTR TO intuimessage
  381.    DEF g:PTR TO gadget
  382.    DEF type=0,infos=NIL
  383.    WHILE (mes:=Gt_GetIMsg(sm_window.userport))
  384.        type:=mes.class
  385.        SELECT type
  386.            CASE IDCMP_MENUPICK
  387.               infos:=mes.code
  388.               SELECT infos
  389.               ENDSELECT
  390.            CASE IDCMP_REFRESHWINDOW
  391.               p_LockListView()
  392.               p_RendersmWindow()
  393.            CASE IDCMP_CLOSEWINDOW
  394.               reelquit:=TRUE
  395.            CASE IDCMP_GADGETDOWN
  396.               type:=IDCMP_GADGETUP
  397.            CASE IDCMP_GADGETUP
  398.               g:=mes.iaddress
  399.               infos:=g.gadgetid
  400.               SELECT infos
  401.                   CASE GA_G_ADDMOD
  402.                     p_LockListView()
  403.                     p_FileRequester(MODE_LOAD,FUNC_MOD)
  404.                     p_RendersmWindow()
  405.                   CASE GA_G_REMMOD
  406.                     p_LockListView()
  407.                     currentmodule:=p_RemoveModuleNode(mysm.modulelist,currentmodule)
  408.                     p_RendersmWindow()
  409.                   CASE GA_G_SAVEMOD
  410.                     p_LockListView()
  411.                     p_FileRequester(MODE_SAVE,FUNC_MOD)
  412.                     p_RendersmWindow()
  413.                   CASE GA_G_FINDOBJ
  414.                     p_LockListView()
  415.                     p_ReqStringFind(mysm.modulelist,F_OBJ)
  416.                     p_RendersmWindow()
  417.                   CASE GA_G_FINDCONST
  418.                     p_LockListView()
  419.                     p_ReqStringFind(mysm.modulelist,F_CONST)
  420.                     p_RendersmWindow()
  421.                   CASE GA_G_FINDFUNC
  422.                     p_LockListView()
  423.                     p_ReqStringFind(mysm.modulelist,F_FUNC)
  424.                     p_RendersmWindow()
  425.                   CASE GA_G_LOADCONG
  426.                     p_LockListView()
  427.                     p_FileRequester(MODE_LOAD,FUNC_CONF)
  428.                     p_RendersmWindow()
  429.                   CASE GA_G_SAVECONF
  430.                     p_LockListView()
  431.                     p_FileRequester(MODE_SAVE,FUNC_CONF)
  432.                     p_RendersmWindow()
  433.                   CASE GA_G_QUIT
  434.                     reelquit:=TRUE
  435.                   CASE GA_G_MODLIST
  436.                     currentmodule:=mes.code
  437.                     p_RendersmWindow()
  438.                   CASE GA_G_DATALIST
  439.               ENDSELECT
  440.        ENDSELECT
  441.        Gt_ReplyIMsg(mes)
  442.    ENDWHILE
  443. ENDPROC
  444. /***********************/
  445. /* Application         */
  446. /***********************/
  447. PROC p_InitSMAPP() HANDLE /*"p_InitSMAPP()"*/
  448.     mysm:=New(SIZEOF smbase)
  449.     mysm.emptylist:=p_InitList()
  450.     mysm.modulelist:=p_InitList()
  451.     IF (mysm.emptylist=NIL) OR (mysm.modulelist=NIL) THEN Raise(ER_LIST)
  452.     p_AjouteNode(mysm.emptylist,'')
  453.     Raise(ER_NONE)
  454. EXCEPT
  455.     RETURN exception
  456. ENDPROC
  457. PROC p_RemSMAPP() /*"p_RemSMAPP()"*/
  458.     IF mysm.emptylist THEN p_RemoveList(mysm.emptylist)
  459.     IF mysm.modulelist THEN p_RemoveModuleList(mysm.modulelist,TRUE)
  460.     IF mysm THEN Dispose(mysm)
  461. ENDPROC
  462. PROC p_FileRequester(mode,fonction) /*"p_FileRequester(mode,fonction)"*/
  463. /********************************************************************************
  464.  * Para         : NONE
  465.  * Return       : FALSE if Cancel selected.
  466.  * Description  : PopUp a MultiFileRequester.
  467.  *******************************************************************************/
  468.     DEF reqfile:PTR TO rtfilerequester
  469.     DEF liste:PTR TO rtfilelist
  470.     DEF buffer[120]:STRING
  471.     DEF add_liste
  472.     DEF ret=TRUE
  473.     DEF the_fullname[256]:STRING
  474.     DEF the_reelname[256]:STRING
  475.     IF reqfile:=RtAllocRequestA(RT_FILEREQ,NIL)
  476.         buffer[0]:=0
  477.         RtChangeReqAttrA(reqfile,[RTFI_DIR,'Emodules:'])
  478.         add_liste:=RtFileRequestA(reqfile,buffer,'SModule v0.5',
  479.                                   [RTFI_FLAGS,FREQF_MULTISELECT,RTFI_OKTEXT,'_Ok',RTFI_HEIGHT,200,
  480.                                    RT_UNDERSCORE,"_",TAG_DONE,0])
  481.         liste:=add_liste
  482.         IF buffer[0]<>0
  483.             WHILE liste
  484.                 StringF(the_reelname,'\s',liste.name)
  485.                 AddPart(reqfile.dir,'',256)
  486.                 StringF(the_fullname,'\s\s',reqfile.dir,liste.name)
  487.                 SELECT mode
  488.                     CASE MODE_LOAD
  489.                         SELECT fonction
  490.                             CASE FUNC_MOD
  491.                                 p_LoadModule(the_fullname)
  492.                             CASE FUNC_CONF
  493.                                 p_ReadConfigFile(the_fullname)
  494.                                 JUMP plus
  495.                         ENDSELECT
  496.                     CASE MODE_SAVE
  497.                         SELECT fonction
  498.                             CASE FUNC_MOD
  499.                                p_SaveModule(mysm.modulelist,the_fullname)
  500.                                JUMP plus
  501.                             CASE FUNC_CONF
  502.                                 p_SaveConfigFile(mysm.modulelist,the_fullname)
  503.                                 JUMP plus
  504.                         ENDSELECT
  505.                 ENDSELECT
  506.                 liste:=liste.next
  507.             ENDWHILE
  508.             plus:
  509.             IF add_liste THEN RtFreeFileList(add_liste)
  510.         ELSE
  511.             ret:=FALSE
  512.         ENDIF
  513.         IF reqfile THEN RtFreeRequest(reqfile)
  514.     ELSE
  515.         ret:=FALSE
  516.     ENDIF
  517.  
  518. ENDPROC
  519. PROC p_ReqStringFind(list:PTR TO lh,type) /*"p_ReqStringFind(list:PTR TO lh,type)"*/
  520.     DEF my_sreq:PTR TO rtfilerequester
  521.     DEF bodyreq[256]:STRING
  522.     DEF buffer[256]:STRING
  523.     DEF return_string[256]:STRING
  524.     DEF ret,taglist,stringtag:PTR TO LONG
  525.     DEF rmod:PTR TO modulenode
  526.     DEF node:PTR TO ln
  527.     DEF datlist:PTR TO lh
  528.     DEF datnode:PTR TO ln
  529.     DEF findnummod=NIL,findnumdat=NIL,pos
  530.     stringtag:=['Un Objet.','Une Constante.','Une Fonction.']
  531.     StringF(bodyreq,'Chercher \s',stringtag[type])
  532.     StrCopy(buffer,'',ALL)
  533.     taglist:=[RT_WINDOW,sm_window,RT_LOCKWINDOW,TRUE,RTEZ_REQTITLE,'SModule',RTGS_GADFMT,'_Ok|_Cancel',RTGS_TEXTFMT,bodyreq,RT_UNDERSCORE,"_",0]
  534.     IF my_sreq:=RtAllocRequestA(RT_REQINFO,NIL)
  535.         ret:=RtGetStringA(buffer,200,NIL,my_sreq,taglist)
  536.         IF ret
  537.             NOP
  538.         ELSE
  539.             buffer:=NIL
  540.         ENDIF
  541.         SELECT type
  542.             CASE F_OBJ;   StringF(return_string,'(---) OBJECT \s',buffer)
  543.             CASE F_CONST
  544.                 StringF(return_string,'\s',buffer)
  545.                 UpperStr(return_string)
  546.             CASE F_FUNC
  547.                 StringF(return_string,'\s',buffer)
  548.         ENDSELECT
  549.         IF my_sreq THEN RtFreeRequest(my_sreq)
  550.     ELSE
  551.         RETURN NIL
  552.     ENDIF
  553.     rmod:=list.head
  554.     WHILE rmod
  555.         node:=rmod
  556.         IF node.succ<>0
  557.             datlist:=rmod.datalist
  558.             datnode:=datlist.head
  559.             findnumdat:=0
  560.             WHILE datnode
  561.                 IF datnode.succ<>0
  562.                     pos:=InStr(datnode.name,return_string,0)
  563.                     IF pos<>-1 THEN JUMP fini
  564.                 ENDIF
  565.                 INC findnumdat
  566.                 datnode:=datnode.succ
  567.             ENDWHILE
  568.         ENDIF
  569.         INC findnummod
  570.         rmod:=node.succ
  571.     ENDWHILE
  572.     fini:
  573.     IF pos<>-1
  574.         currentmodule:=findnummod
  575.         p_RendersmWindow()
  576.         rmod:=p_GetAdrNode(mysm.modulelist,currentmodule)
  577.         Gt_SetGadgetAttrsA(g_datalist,sm_window,NIL,[GA_DISABLED,FALSE,GTLV_TOP,findnumdat,GTLV_LABELS,rmod.datalist,TAG_DONE,0])
  578.         Gt_SetGadgetAttrsA(g_modlist,sm_window,NIL,[GA_DISABLED,FALSE,GTLV_TOP,findnummod,GTLV_LABELS,mysm.modulelist,TAG_DONE,0])
  579.     ELSE
  580.         RtEZRequestA('\s non trouvΘ.\n','Ok',0,[return_string],[RT_LOCKWINDOW,TRUE,RT_WINDOW,sm_window,RTEZ_REQTITLE,'SModule v0.5',TAG_DONE,0])
  581.     ENDIF
  582. ENDPROC
  583. PROC p_LoadModule(fichier) /*"p_LoadModule(fichier)"*/
  584. /********************************************************************************
  585.  * Para         : Num of list.
  586.  * Return       : FALSE if error.
  587.  * Description  : PopUp a filerequester and load module (routine par $#%!).
  588.  *******************************************************************************/
  589.   DEF end,job,len,val,f,off,types:PTR TO LONG,c,r,c2
  590.   DEF flen,o:PTR TO INT,mem,handle=NIL
  591.   DEF my_string[256]:STRING
  592.   DEF piv_string[256]:STRING
  593.   DEF node:PTR TO ln
  594.   DEF modnode:PTR TO modulenode
  595.   DEF nn,list:PTR TO lh
  596.   flen:=FileLength(fichier)
  597.   handle:=Open(fichier,OLDFILE)
  598.   IF (flen<8) OR (handle=NIL)
  599.     RETURN FALSE
  600.   ELSE
  601.     mem:=New(flen)
  602.     IF mem=NIL
  603.       Raise(ER_MEM)
  604.     ELSE
  605.       IF Read(handle,mem,flen)<>flen THEN RETURN FALSE
  606.       Close(handle)
  607.       handle:=NIL
  608.       o:=mem
  609.       end:=o+flen
  610.       types:=['substructure','CHAR','INT','','LONG']
  611.       IF ^o++<>"EMOD" THEN RETURN FALSE
  612.       node:=New(SIZEOF ln)
  613.       modnode:=New(SIZEOF modulenode)
  614.       node.succ:=0
  615.       node.name:=String(EstrLen(fichier))
  616.       StrCopy(node.name,fichier,ALL)
  617.       CopyMem(node,modnode.node,SIZEOF ln)
  618.       AddTail(mysm.modulelist,modnode.node)
  619.       nn:=p_GetNumNode(mysm.modulelist,modnode.node)
  620.       IF nn=0
  621.         list:=mysm.modulelist
  622.         list.head:=modnode.node
  623.         node.pred:=0
  624.       ENDIF
  625.       modnode.datalist:=p_InitList()
  626.       currentmodule:=nn
  627.       WHILE o<end
  628.         job:=o[]++
  629.         SELECT job
  630.           CASE JOB_CONST
  631.             len:=o[]++; f:=TRUE
  632.             p_AjouteNode(modnode.datalist,'')
  633.             WHILE len
  634.               val:=^o++
  635.               IF f THEN StrCopy(my_string,'CONST ',ALL) ELSE StrCopy(my_string,'      ',ALL)
  636.               StringF(piv_string,'\s=',o);StrAdd(my_string,piv_string,ALL)
  637.               IF (val>=-$20) AND (val<$20)
  638.                   StringF(piv_string,'\d',val)
  639.                   StrAdd(my_string,piv_string,ALL)
  640.               ELSE
  641.                   StringF(piv_string,'$\h',val)
  642.                   StrAdd(my_string,piv_string,ALL)
  643.               ENDIF
  644.               o:=o+len; len:=o[]++; f:=FALSE
  645.               IF len
  646.                   StrAdd(my_string,',',ALL)
  647.               ENDIF
  648.               p_AjouteNode(modnode.datalist,my_string)
  649.             ENDWHILE
  650.           CASE JOB_OBJ
  651.             p_AjouteNode(modnode.datalist,'')
  652.             len:=o[]++;
  653.             StringF(piv_string,'(---) OBJECT \s',o+4)
  654.             StrCopy(my_string,piv_string,ALL)
  655.             p_AjouteNode(modnode.datalist,my_string)
  656.             o:=o+4+len
  657.             WHILE len:=o[]++
  658.               val:=o[]++
  659.               off:=o[]++
  660.               StringF(piv_string,'(\d[3])   \s:\s',off,o,types[val])
  661.               StrCopy(my_string,piv_string,ALL)
  662.               p_AjouteNode(modnode.datalist,my_string)
  663.               o:=o+len
  664.             ENDWHILE
  665.             val:=o[]++
  666.             StrCopy(my_string,'(---) ENDOBJECT     /* SIZEOF=',ALL)
  667.             IF val<>$FFFF
  668.                 StringF(piv_string,'\d */',val)
  669.                 StrAdd(my_string,piv_string,ALL)
  670.             ELSE
  671.                 StrAdd(my_string,'NONE !!! */',ALL)
  672.             ENDIF
  673.             p_AjouteNode(modnode.datalist,my_string)
  674.           CASE JOB_LIB
  675.             p_AjouteNode(modnode.datalist,'')
  676.             c:=o
  677.             WHILE c[]++ DO NOP
  678.             StringF(piv_string,'LIBRARY \a\s\a, \s         /* informal notation */',o,c)
  679.             StrCopy(my_string,piv_string,ALL)
  680.             p_AjouteNode(modnode.datalist,my_string)
  681.             WHILE c[]++ DO NOP
  682.             WHILE (c[]<>$FF) AND (c<end)
  683.               c2:=c
  684.               WHILE c[]++>" " DO NOP; c--
  685.               r:=c[]; c[]++:=0
  686.               StringF(piv_string,'  \s\c',c2,"(")
  687.               StrCopy(my_string,piv_string,ALL)
  688.               WHILE r<" "
  689.                 IF r<16
  690.                     IF r<8
  691.                         StringF(piv_string,'D\d',r)
  692.                         StrAdd(my_string,piv_string,ALL)
  693.                     ELSE
  694.                         StringF(piv_string,'A\d',r-8)
  695.                         StrAdd(my_string,piv_string,ALL)
  696.                     ENDIF
  697.                 ENDIF
  698.                 r:=c[]++
  699.                 IF r<16
  700.                     StrAdd(my_string,',',ALL)
  701.                 ENDIF
  702.               ENDWHILE
  703.               c--
  704.               StrAdd(my_string,')',ALL)
  705.               p_AjouteNode(modnode.datalist,my_string)
  706.             ENDWHILE
  707.             StrCopy(my_string,'ENDLIBRARY',ALL)
  708.             p_AjouteNode(modnode.datalist,my_string)
  709.             o:=end
  710.           CASE JOB_DONE
  711.             o:=end
  712.           DEFAULT
  713.             /* Raise(ER_JOBID) */
  714.             NOP
  715.         ENDSELECT
  716.       ENDWHILE
  717.     ENDIF
  718.   ENDIF
  719.   RETURN TRUE
  720. ENDPROC
  721. PROC p_SaveModule(list:PTR TO lh,fichier) /*"p_SaveModule(list:PTR TO lh,fichier)"*/
  722.     DEF snode:PTR TO modulenode
  723.     DEF node:PTR TO ln
  724.     DEF datlist:PTR TO lh
  725.     DEF pv[256]:STRING,h
  726.     snode:=p_GetAdrNode(list,currentmodule)
  727.     datlist:=snode.datalist
  728.     IF h:=Open(fichier,1006)
  729.         node:=datlist.head
  730.         WHILE node
  731.             IF node.succ<>0
  732.                 StringF(pv,'\s\n',node.name)
  733.                 Write(h,pv,EstrLen(pv))
  734.             ENDIF
  735.             node:=node.succ
  736.         ENDWHILE
  737.         IF h THEN Close(h)
  738.     ENDIF
  739. ENDPROC
  740. PROC p_SaveConfigFile(list:PTR TO lh,fichier) /*"p_SaveConfigFile(list:PTR TO lh,fichier)"*/
  741.     DEF smod:PTR TO modulenode
  742.     DEF node:PTR TO ln
  743.     DEF h
  744.     IF h:=Open(fichier,1006)
  745.         Write(h,[ID_SMOD]:LONG,4)
  746.         smod:=list.head
  747.         WHILE smod
  748.             node:=smod
  749.             IF node.succ<>0
  750.                 Write(h,[ID_MODU]:LONG,4)
  751.                 Write(h,node.name,EstrLen(node.name))
  752.                 Out(h,0)
  753.             ENDIF
  754.             smod:=node.succ
  755.         ENDWHILE
  756.         IF h THEN Close(h)
  757.     ENDIF
  758. ENDPROC
  759. PROC p_ReadConfigFile(source) /*"p_ReadConfigFile(source)"*/
  760.     DEF len,a,adr,buf,handle,flen=TRUE,pos
  761.     DEF chunk
  762.     DEF pv[256]:STRING
  763.     IF (flen:=FileLength(source))=-1 THEN RETURN FALSE
  764.     IF (buf:=New(flen+1))=NIL THEN RETURN FALSE
  765.     IF (handle:=Open(source,1005))=NIL THEN RETURN FALSE
  766.     len:=Read(handle,buf,flen)
  767.     Close(handle)
  768.     IF len<1 THEN RETURN FALSE
  769.     adr:=buf
  770.     chunk:=Long(adr)
  771.     IF chunk<>ID_SMOD
  772.         Dispose(buf)
  773.         RETURN FALSE
  774.     ENDIF
  775.     p_RemoveModuleList(mysm.modulelist,FALSE)
  776.     FOR a:=0 TO len-1
  777.         pos:=adr++
  778.         chunk:=Long(pos)
  779.         SELECT chunk
  780.             CASE ID_MODU
  781.                 StringF(pv,'\s',pos+4)
  782.                 p_LoadModule(pv)
  783.         ENDSELECT
  784.     ENDFOR
  785.     Dispose(buf)
  786.     RETURN TRUE
  787. ENDPROC
  788. /***********************/
  789. /* Main Proc           */
  790. /***********************/
  791. PROC main() HANDLE /*"main()"*/
  792.     DEF testmain
  793.     tattr:=['topaz.font',9,0,0]:textattr
  794.     IF (testmain:=p_OpenLibraries())<>ER_NONE THEN Raise(testmain)
  795.     IF (testmain:=p_SetUpScreen())<>ER_NONE THEN Raise(testmain)
  796.     IF (testmain:=p_InitsmWindow())<>ER_NONE THEN Raise(testmain)
  797.     IF (testmain:=p_InitSMAPP())<>ER_NONE THEN Raise(testmain)
  798.     IF (testmain:=p_OpensmWindow())<>ER_NONE THEN Raise(testmain)
  799.     REPEAT
  800.         p_LookAllMessage()
  801.     UNTIL reelquit=TRUE
  802.     Raise(ER_NONE)
  803. EXCEPT
  804.     p_RemsmWindow()
  805.     p_RemSMAPP()
  806.     p_SetDownScreen()
  807.     p_CloseLibraries()
  808.     CleanUp(0)
  809.     SELECT exception
  810.         CASE ER_LOCKSCREEN; WriteF('Lock Screen Failed.')
  811.         CASE ER_VISUAL;     WriteF('Error Visual.')
  812.         CASE ER_CONTEXT;    WriteF('Error Context.')
  813.         CASE ER_MENUS;      WriteF('Error Menus.')
  814.         CASE ER_GADGET;     WriteF('Error Gadget.')
  815.         CASE ER_WINDOW;     WriteF('Error Window.')
  816.     ENDSELECT
  817. ENDPROC
  818.