home *** CD-ROM | disk | FTP | other *** search
/ Dream 57 / Amiga_Dream_57.iso / Amiga / Programmation / e / Exemples / capus.lha / ViewText / VText.e next >
Encoding:
Text File  |  1994-05-02  |  10.2 KB  |  293 lines
  1. /********************************************************************************
  2.  * << AUTO HEADER XDME >>
  3.  ********************************************************************************
  4.  ED            "EDG"
  5.  EC            "EC"
  6.  PREPRO        "EPP"
  7.  SOURCE        "Vtext.e"
  8.  EPPDEST       "VText_EPP.e"
  9.  EXEC          "Vtext"
  10.  ISOURCE       " "
  11.  HSOURCE       " "
  12.  ERROREC       " "
  13.  ERROREPP      " "
  14.  VERSION       "0"
  15.  REVISION      "1"
  16.  NAMEPRG       "Vtext"
  17.  NAMEAUTHOR    "NasG√l"
  18.  ********************************************************************************
  19.  * HISTORY :
  20.  *******************************************************************************/
  21. ENUM ER_NONE,ER_OPENLIB,ER_WB,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW,ER_MENUS,
  22.      ER_MEM,ER_BA,ER_SCREEN,ER_SIG
  23. ENUM ARG_FICHIER,NUMARGS
  24. MODULE 'intuition/intuition', 'gadtools', 'libraries/gadtools',
  25.        'intuition/gadgetclass', 'exec/nodes', 'intuition/screens',
  26.        'exec/lists','graphics/displayinfo' ,'graphics/text'
  27. MODULE 'utility','utility/tagitem','wb','workbench/startup','dos/dosextens'
  28. MODULE 'asl','libraries/asl'
  29. RAISE ER_MEM IF New()=NIL
  30. RAISE ER_MEM IF String()=NIL
  31. DEF new_screen=NIL:PTR TO screen,
  32.     visual=NIL,
  33.     wnd=NIL:PTR TO window,
  34.     glist=NIL,g,g1,type
  35. DEF new_liste:PTR TO lh,fichier[256]:STRING,base_lock,task,sig=-1
  36. DEF tattr
  37. PROC main() HANDLE /*"main()"*/
  38. /********************************************************************************
  39.  * Para         : NONE
  40.  * Return       : NONE
  41.  * Description  : Main Porc.
  42.  *******************************************************************************/
  43.   DEF test
  44.   task:=FindTask(0)
  45.   tattr:=['topaz.font',8,0,0]:textattr
  46.   SetTopaz(8)
  47.   VOID {prg_banner}
  48.   IF wbmessage<>NIL
  49.       IF (test:=start_from_wb())<>ER_NONE THEN Raise(test)
  50.   ELSE
  51.       IF (test:=start_from_cli())<>ER_NONE THEN Raise(test)
  52.   ENDIF
  53.   new_liste:=New(SIZEOF lh)
  54.   new_liste.tail:=0
  55.   new_liste.head:=new_liste.tail
  56.   new_liste.tailpred:=new_liste.head
  57.   new_liste.type:=0
  58.   new_liste.pad:=0
  59.   IF (test:=readfile())<>ER_NONE THEN Raise(test)
  60.   checkerror(openinterface())
  61.   REPEAT
  62.     wait4message()
  63.   UNTIL type=IDCMP_CLOSEWINDOW
  64.   Raise(ER_NONE)
  65. EXCEPT
  66.     CurrentDir(base_lock)
  67.     IF new_liste THEN Dispose(new_liste)
  68.     IF wnd
  69.         closeinterface()
  70.         IF new_screen.firstwindow<>0
  71.             Wait(Shl(1,sig))            /* wait until all windows closed */
  72.         ENDIF
  73.         IF sig THEN FreeSignal(sig)
  74.         IF new_screen THEN CloseScreen(new_screen)
  75.     ENDIF
  76.     SetDefaultPubScreen('Workbench')    /* workbench is default again */
  77.     SELECT exception
  78.         CASE ER_NONE;   NOP
  79.         CASE ER_MEM;     WriteF('MΘmoire insuffisante.\n')
  80.         CASE ER_BA;      WriteF('Bad Args !.\n')
  81.         CASE ER_SCREEN;  WriteF('Ouverture de l\aΘcran impossible.\n')
  82.         DEFAULT;     NOP
  83.     ENDSELECT
  84. ENDPROC
  85. PROC start_from_cli() /*"start_from_cli()"*/
  86. /********************************************************************************
  87.  * Para         : NONE
  88.  * Return       : NONE
  89.  * Description  : Start from Cli (lock current dir).
  90.  *******************************************************************************/
  91.     DEF pro:PTR TO process
  92.     DEF myargs:PTR TO LONG,rdargs
  93.     DEF ret=ER_NONE
  94.     myargs:=[0]
  95.     pro:=task
  96.     base_lock:=CurrentDir(pro.currentdir)
  97.     IF rdargs:=ReadArgs('SOURCE',myargs,NIL)
  98.         IF myargs[0] THEN StrCopy(fichier,myargs[0],ALL) ELSE ret:=ER_BA
  99.         FreeArgs(rdargs)
  100.     ELSE
  101.         ret:=ER_BA
  102.     ENDIF
  103.     RETURN ret
  104. ENDPROC
  105. PROC start_from_wb() /*"start_from_wb()"*/
  106. /********************************************************************************
  107.  * Para         : NONE
  108.  * Return       : NONE
  109.  * Description  : Start from wb (Lock the dir of the first arg).
  110.  *******************************************************************************/
  111.     DEF wb:PTR TO wbstartup /*wb_args:PTR TO wbarg */
  112.     DEF args:PTR TO wbarg
  113.     wb:=wbmessage
  114.     args:=wb.arglist
  115.     StrCopy(fichier,args[1].name,ALL)
  116.     base_lock:=CurrentDir(args[1].lock)
  117.     RETURN ER_NONE
  118. ENDPROC
  119. PROC openinterface() HANDLE /*"openinterface()"*/
  120. /********************************************************************************
  121.  * Para         : NONE
  122.  * Return       : ER_NONE if ok,else the error.
  123.  * Description  : Open lib,Call getdisplayid().
  124.  *                open screen and window.
  125.  *******************************************************************************/
  126.   DEF name,wb_scr,id_wb=HIRES_KEY
  127.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN ER_OPENLIB
  128.   IF (aslbase:=OpenLibrary('asl.library',37))=NIL THEN RETURN ER_OPENLIB
  129.   name:=fichier
  130.   IF wb_scr:=LockPubScreen('Workbench')
  131.       IF (id_wb:=getdisplayid(wb_scr))=FALSE THEN id_wb:=HIRES_KEY
  132.       UnlockPubScreen(wb_scr,NIL)
  133.       id_wb:=PAL_MONITOR_ID+id_wb
  134.   ENDIF
  135.   IF (new_screen:=OpenScreenTagList(NIL,          /* get ourselves a public screen */
  136.          [SA_TOP,0,
  137.           SA_DEPTH,2,
  138.           SA_FONT,tattr,
  139.           SA_DISPLAYID,id_wb,
  140.           SA_PUBNAME,name,
  141.           SA_TITLE,name,
  142.           SA_PUBSIG,IF (sig:=AllocSignal(-1))=NIL THEN Raise(ER_SIG) ELSE sig,
  143.           SA_PUBTASK,task,
  144.           SA_AUTOSCROLL,TRUE,
  145.           SA_OVERSCAN,OSCAN_TEXT,
  146.           SA_PENS,[0,0,1,2,1,3,1,0,1,1,2]:INT,
  147.           0,0]))=NIL THEN Raise(ER_SCREEN)
  148.   PubScreenStatus(new_screen,0)                 /* make it available */
  149.   SetDefaultPubScreen(fichier)
  150.   SetPubScreenModes(SHANGHAI)
  151.   IF (visual:=GetVisualInfoA(new_screen,NIL))=NIL THEN RETURN ER_VISUAL
  152.   IF (g:=CreateContext({glist}))=NIL THEN RETURN ER_CONTEXT
  153.   IF (g1:=CreateGadgetA(LISTVIEW_KIND,g,[new_screen.wborleft,
  154.                                          new_screen.topedge+new_screen.barheight,
  155.                                          new_screen.width-new_screen.wborright,
  156.                                          new_screen.height-new_screen.barheight,'',tattr,2,16,visual,0]:newgadget,[GTLV_READONLY,TRUE,GTLV_SCROLLWIDTH,15,GTLV_LABELS,new_liste,0]))=NIL THEN RETURN ER_GADGET
  157.   IF (wnd:=OpenW(0,0,new_screen.width,new_screen.height,$700 OR LISTVIEWIDCMP,$190E,'Viewtext v0.0 (c) 1993 NasG√l',new_screen,15,glist))=NIL THEN RETURN ER_WINDOW
  158.   wnd.screentitle:=arg
  159.   Gt_RefreshWindow(wnd,NIL)
  160.   Gt_SetGadgetAttrsA(g1,wnd,NIL,[GTLV_TOP,0,GTLV_LABELS,new_liste,0])
  161. EXCEPT
  162.     RETURN exception
  163. ENDPROC
  164. PROC closeinterface() /*"closeinterface()"*/
  165. /********************************************************************************
  166.  * Para         : NONE
  167.  * Return       : NONE
  168.  * Description  : Free All and Close lib.
  169.  *******************************************************************************/
  170.   IF glist THEN FreeGadgets(glist)
  171.   IF visual THEN FreeVisualInfo(visual)
  172.   IF wnd THEN CloseWindow(wnd)
  173.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  174.   IF aslbase THEN CloseLibrary(aslbase)
  175. ENDPROC
  176. PROC checkerror(er) /*"checkerror(er)"*/
  177. /********************************************************************************
  178.  * Para         : the error.
  179.  * Return       : NONE
  180.  * Description  : Check error.
  181.  *******************************************************************************/
  182.   DEF errors:PTR TO LONG
  183.   IF er>0
  184.     closeinterface()
  185.     errors:=['','open "gadtools.library" v37','lock workbench','get visual infos','create context','create gadget','open window','allocate menus','allocate signal']
  186.     WriteF('Could not \s !\n',errors[er])
  187.     CleanUp(10)
  188.   ENDIF
  189. ENDPROC
  190. PROC wait4message() /*"wait4message()"*/
  191. /********************************************************************************
  192.  * Para         : NONE
  193.  * Return       : NONE
  194.  * Description  : Wait Message.
  195.  *******************************************************************************/
  196.   DEF mes:PTR TO intuimessage
  197.   DEF ret
  198.   REPEAT
  199.     type:=0
  200.     IF mes:=Gt_GetIMsg(wnd.userport)
  201.       type:=mes.class
  202.       IF type:=IDCMP_RAWKEY
  203.           ret:=mes.code
  204.           SELECT ret
  205.               CASE $45; type:=IDCMP_CLOSEWINDOW
  206.               CASE $4D  /* Down */
  207.               CASE $4C  /* Up   */
  208.               DEFAULT; NOP
  209.           ENDSELECT
  210.       ELSEIF type=IDCMP_REFRESHWINDOW
  211.         Gt_BeginRefresh(wnd)
  212.         Gt_EndRefresh(wnd,TRUE)
  213.         type:=0
  214.       ELSEIF type<>IDCMP_CLOSEWINDOW
  215.         type:=0
  216.       ENDIF
  217.       Gt_ReplyIMsg(mes)
  218.     ELSE
  219.       Wait(-1)
  220.     ENDIF
  221.   UNTIL type
  222. ENDPROC
  223. PROC readfile() /*"readfile()"*/
  224. /********************************************************************************
  225.  * Para         : NONE
  226.  * Return       : ER_NONE if ok,else the error.
  227.  * Description  : read file and build a list (For ListView).
  228.  *******************************************************************************/
  229.   DEF len,a,adr,buf,handle,flen=TRUE
  230.   DEF my_string[256]:STRING,p=0,num_node=0
  231.   DEF node:PTR TO ln
  232.   IF (flen:=FileLength(fichier))=-1 THEN RETURN ER_BA
  233.   IF (buf:=New(flen+1))=NIL THEN RETURN ER_BA
  234.   IF (handle:=Open(fichier,1005))=NIL THEN RETURN ER_BA
  235.   len:=Read(handle,buf,flen)
  236.   Close(handle)
  237.   IF len<1 THEN RETURN ER_BA
  238.   adr:=buf
  239.   FOR a:=0 TO len-1
  240.     IF buf[a]=10
  241.         IF a-p<>0
  242.             StrCopy(my_string,adr,a-p)
  243.         ELSE
  244.             StrCopy(my_string,'',ALL)
  245.         ENDIF
  246.         node:=New(SIZEOF ln)
  247.         node.succ:=0
  248.         node.name:=String(EstrLen(my_string))
  249.         StrCopy(node.name,my_string,ALL)
  250.         AddTail(new_liste,node)
  251.         IF num_node=0
  252.             new_liste.head:=node
  253.             node.pred:=0
  254.         ENDIF
  255.         new_liste.tailpred:=node
  256.         p:=a+1
  257.         adr:=buf+a+1
  258.         num_node:=num_node+1
  259.     ENDIF
  260.   ENDFOR
  261.   Dispose(buf)
  262.   RETURN ER_NONE
  263. ENDPROC
  264. PROC getdisplayid(wb_scr) /*"getdisplayid(wb_scr)"*/
  265. /********************************************************************************
  266.  * Para         : Address of screen.
  267.  * Return       : DisplayId.
  268.  * Description  : Retrun the DisplayId of a screen.
  269.  *******************************************************************************/
  270.     DEF s:PTR TO screen,w=NIL,h=NIL
  271.     s:=wb_scr
  272.     w:=s.width
  273.     h:=s.height
  274.     IF (w=320) AND (h=256)
  275.         RETURN LORES_KEY
  276.     ELSEIF (w=320) AND (h=512)
  277.         RETURN LORESLACE_KEY
  278.     ELSEIF (w=640) AND (h=256)
  279.         RETURN HIRES_KEY
  280.     ELSEIF (w=640) AND (h=512)
  281.         RETURN HIRESLACE_KEY
  282.     ELSEIF (w=1280) AND (h=256)
  283.         RETURN SUPER_KEY
  284.     ELSEIF (w=1280) AND (h=512)
  285.         RETURN SUPERLACE_KEY
  286.     ENDIF
  287.     RETURN FALSE
  288. ENDPROC
  289. prg_banner:
  290. INCBIN 'Vtext.header'
  291.  
  292.  
  293.