home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Utils / GDU.e < prev    next >
Encoding:
Text File  |  1994-10-02  |  6.5 KB  |  235 lines
  1. /* Graphical Disk Usage (GDU), basé sur D.e
  2.  
  3.    affiche toutes les partitions du disque dur et du même style sur l'écran
  4.    et est capable de zoomer dedans, d'afficher les infos etc. [voir requester]
  5.  
  6. */
  7.  
  8. OPT OSVERSION=37
  9.  
  10. MODULE 'class/stack', 'tools/clonescreen',
  11.        'dos/dosasl', 'dos/dos', 'utility', 'intuition/intuition'
  12.  
  13. CONST MAXPATH=250
  14.  
  15. ENUM ER_NONE,ER_BADARGS,ER_MEM,ER_UTIL,ER_COML
  16. ENUM ARG_DIR,NUMARGS
  17.  
  18. RAISE ER_MEM IF New()=NIL, ERROR_BREAK IF CtrlC()=TRUE, ER_MEM IF String()=NIL
  19.  
  20. OBJECT dir
  21.   name,size,sub,x,y,xs,ys
  22. ENDOBJECT
  23.  
  24. DEF dir,dirw[100]:STRING,rdargs=NIL,dirno=0,s[200]:STRING,b:PTR TO dir,
  25.     screen=NIL,font=NIL,win=NIL,xsize,ysize,depth,st:PTR TO stack
  26.  
  27. PROC consdir(name,size,sub) IS NEW [StrCopy(String(StrLen(name)),name),size,sub]:dir
  28.  
  29. PROC main() HANDLE
  30.   DEF args[NUMARGS]:LIST,templ,x,lock,fib:fileinfoblock,do=TRUE,code,qual,mx,my
  31.   IF EasyRequestArgs(win,[20,0,'Welcome to GraphicDiskUsage',
  32.       'cli usage = GDU <volume>\nbouton gauche = affiche info\nbouton droit = quit\nshift + bouton gauche = zoom interieur\nshift + bouton droit = zoom dehors\nctrl c = quitte [pendant la lecture du disque]\n',
  33.       'On y va|Cancel'],0,NIL)=1
  34.     NEW st.stack()
  35.     IF (utilitybase:=OpenLibrary('utility.library',37))=NIL THEN Raise(ER_UTIL)
  36.     FOR x:=0 TO NUMARGS-1 DO args[x]:=0
  37.     templ:='DIR'
  38.     rdargs:=ReadArgs(templ,args,NIL)
  39.     IF rdargs=NIL THEN Raise(ER_BADARGS)
  40.     dir:=args[ARG_DIR]
  41.     IF dir THEN StrCopy(dirw,dir,ALL)
  42.     lock:=Lock(dirw,-2)
  43.     IF lock                  /* Si oui, le rép prob. dir, sinon car. génériques */
  44.       IF Examine(lock,fib) AND (fib.direntrytype>0)
  45.         AddPart(dirw,'#?',100)
  46.       ENDIF
  47.       UnLock(lock)
  48.     ENDIF
  49.     screen,font:=openclonescreen('Workbench','Graphic Disk Usage ($%#!)')
  50.     win:=backdropwindow(screen,$8,$10000)
  51.     depth,xsize,ysize:=getcloneinfo(screen)
  52.     WriteF('Scanning...\n')
  53.     b:=recdir(dirw)
  54.     SetTopaz(8)
  55.     refresh()
  56.     WHILE do
  57.       WaitIMessage(win)
  58.       code:=MsgCode()
  59.       qual:=MsgQualifier()
  60.       mx:=MouseX(win); my:=MouseY(win)
  61.       IF code=MENUDOWN
  62.         IF qual AND 1
  63.           zoomout()
  64.         ELSE
  65.           IF EasyRequestArgs(win,[20,0,'Quitter?','T'es sûr, mec?','Voui|Meuh nooon!'],0,NIL)=1 THEN do:=FALSE
  66.         ENDIF
  67.       ELSEIF code=SELECTDOWN
  68.         IF qual AND 1
  69.           zoomin(mx,my)
  70.         ELSE
  71.           findxy(b,mx,my)
  72.         ENDIF
  73.       ENDIF
  74.     ENDWHILE
  75.   ENDIF
  76. EXCEPT DO
  77.   closeclonescreen(screen,font,win)
  78.   IF rdargs THEN FreeArgs(rdargs)
  79.   IF utilitybase THEN CloseLibrary(utilitybase)
  80.   SELECT exception
  81.     CASE "SCR";                 WriteF('Pas d'écran!\n')
  82.     CASE "WIN";                 WriteF('Pas de fenêtre!\n')
  83.     CASE ER_BADARGS;            WriteF('Mauvais arguments pour GDU!\n')
  84.     CASE ER_MEM;                WriteF('Pas de mémoire!\n')
  85.     CASE ER_COML;               WriteF('Pas de ligne de commande spécifié\n')
  86.     CASE ER_UTIL;               WriteF('Nepeut pas ouvrir l''"utility.library" v37\n')
  87.     CASE ERROR_BREAK;           WriteF('Arrêt de GDU par l''utilisateur\n')
  88.     CASE ERROR_BUFFER_OVERFLOW; WriteF('Erreur interne\n')
  89.     DEFAULT;                    PrintFault(exception,'Dos Error')
  90.   ENDSELECT
  91. ENDPROC
  92.  
  93. PROC refresh()
  94.   SetRast(stdrast,0)
  95.   dogfx(b,5,20,xsize-10,ysize-30,TRUE)
  96. ENDPROC
  97.  
  98. PROC recdir(dirr) HANDLE
  99.   DEF er,i:PTR TO fileinfoblock,size=0,anchor=NIL:PTR TO anchorpath,
  100.       fullpath,x,num=0,l=NIL,rl:PTR TO dir
  101.   CtrlC()
  102.   anchor:=New(SIZEOF anchorpath+MAXPATH)
  103.   anchor.breakbits:=4096
  104.   anchor.strlen:=MAXPATH-1
  105.   er:=MatchFirst(dirr,anchor)               /* collecte toutes les chaines */
  106.   WHILE er=0
  107.     fullpath:=anchor+SIZEOF anchorpath
  108.     i:=anchor.info
  109.     IF i.direntrytype<0
  110.       size:=size+Shr(i.size+1023,9)
  111.       num++
  112.     ELSE
  113.       x:=StrLen(fullpath)
  114.       IF x+5<MAXPATH THEN CopyMem('/#?',fullpath+x,4)
  115.       rl:=recdir(fullpath)
  116.       size:=size+rl.size
  117.       fullpath[x]:=0
  118.       ->l:=NEW [l,rl]
  119.       l:=addsorted(l,rl)
  120.     ENDIF
  121.     er:=MatchNext(anchor)
  122.   ENDWHILE
  123.   IF er<>ERROR_NO_MORE_ENTRIES THEN Raise(er)
  124.   MatchEnd(anchor)
  125.   Dispose(anchor)
  126.   anchor:=NIL
  127.   INC dirno
  128. EXCEPT
  129.   IF anchor THEN MatchEnd(anchor)
  130.   Raise(exception)
  131. ENDPROC consdir(dirr,IF size THEN size ELSE 1,l)
  132.  
  133. PROC addsorted(l:PTR TO LONG,d:PTR TO dir)
  134.   DEF d2:PTR TO dir,p:PTR TO LONG,c:PTR TO LONG
  135.   IF l=NIL
  136.     RETURN NEW [NIL,d]
  137.   ELSE
  138.     d2:=l[1]
  139.     IF d.size>d2.size
  140.       RETURN NEW [l,d]
  141.     ELSE
  142.       c:=l
  143.       REPEAT
  144.         p:=c; c:=c[]
  145.       UNTIL IF c THEN (d2:=c[1]) BUT d.size>d2.size ELSE TRUE
  146.       p[]:=NEW [c,d]
  147.     ENDIF
  148.   ENDIF
  149. ENDPROC l
  150.  
  151. PROC dogfx(b:PTR TO dir,x,y,xs,ys,isx)
  152.   DEF l:PTR TO LONG,cs=0,sb:PTR TO dir,mc,last
  153.   b.x:=x; b.y:=y; b.xs:=xs; b.ys:=ys
  154.   IF (xs>2) AND (ys>2)
  155.     Line(x,y,x+xs,y)
  156.     Line(x,y,x,y+ys)
  157.     Line(x+xs,y,x+xs,y+ys)
  158.     Line(x,y+ys,x+xs,y+ys)
  159.     l:=b.sub
  160.     WHILE l
  161.       l <=> [l,sb]
  162.       dogfx(sb,IF isx THEN Div(Mul(cs,xs),b.size)+x ELSE x,
  163.                IF isx THEN y ELSE Div(Mul(cs,ys),b.size)+y,
  164.                IF isx THEN Div(Mul(sb.size,xs),b.size) ELSE xs,
  165.                IF isx THEN ys ELSE Div(Mul(sb.size,ys),b.size),
  166.                Not(isx))
  167.       cs:=cs+sb.size
  168.     ENDWHILE
  169.     IF isx
  170.       x:=x+xs; xs:=xs-Div(Mul(cs,xs),b.size); x:=x-xs
  171.     ELSE
  172.       y:=y+ys; ys:=ys-Div(Mul(cs,ys),b.size); y:=y-ys
  173.     ENDIF
  174.     IF ys>10
  175.       IF xs>20
  176.         mc:=xs-4/8
  177.         last:=b.name+EstrLen(b.name)
  178.         WHILE (last>b.name) AND (last[]<>"/") AND (last[]<>":") DO last--
  179.         mc:=last-mc
  180.         IF mc<b.name THEN mc:=b.name
  181.         IF mc=last THEN StrCopy(s,'#?') ELSE StrCopy(s,mc,last-mc)
  182.         TextF(xs/2+x-(EstrLen(s)*4),ys/2+y+3,s)
  183.       ENDIF
  184.     ENDIF
  185.   ENDIF
  186. ENDPROC
  187.  
  188. PROC zoomin(x,y)
  189.   DEF l:PTR TO LONG,b2:PTR TO dir
  190.   l:=b.sub
  191.   WHILE l
  192.     b2:=l[1]
  193.     IF x>=b2.x
  194.       IF y>=b2.y
  195.         IF x<(b2.x+b2.xs)
  196.           IF y<(b2.y+b2.ys) THEN st.push(b) BUT (b:=b2) BUT refresh()
  197.         ENDIF
  198.       ENDIF
  199.     ENDIF
  200.     l:=l[]
  201.   ENDWHILE
  202. ENDPROC
  203.  
  204. PROC zoomout()
  205.   IF st.is_empty()
  206.     DisplayBeep(screen)
  207.   ELSE
  208.     b:=st.pop()
  209.     refresh()
  210.   ENDIF
  211. ENDPROC
  212.  
  213. PROC findxy(b:PTR TO dir,x,y)
  214.   DEF f=FALSE,l:PTR TO LONG,numsub=0
  215.   IF x>=b.x
  216.     IF y>=b.y
  217.       IF x<(b.x+b.xs)
  218.         IF y<(b.y+b.ys)
  219.           l:=b.sub
  220.           WHILE l
  221.             f:=f OR findxy(l[1],x,y)
  222.             l:=l[]
  223.             numsub++
  224.           ENDWHILE
  225.           IF f=FALSE
  226.             f:=TRUE
  227.             StringF(s,IF numsub THEN '\s, \d octets [incluant \d sous répertoire(s)].' ELSE '\s, \d octets.',b.name,Shl(b.size,9),numsub)
  228.             SetWindowTitles(win,s,s)
  229.           ENDIF
  230.         ENDIF
  231.       ENDIF
  232.     ENDIF
  233.   ENDIF
  234. ENDPROC f
  235.