home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Pd / brush2image.e < prev    next >
Encoding:
Text File  |  1994-12-02  |  5.8 KB  |  132 lines
  1. /*
  2.         ILBM brush to Image.
  3. */
  4. MODULE 'dos/dos','intuition/intuition','asl','libraries/asl',
  5. 'libraries/iffparse','iffparse','utility/tagitem'
  6. ENUM NOERROR,ER_LIBRARY,ER_NOMEM,ER_NOASLREQUEST,ER_FILENOTFOUND,ER_IFFERROR,
  7.         ER_NOBMHD
  8. CONST ID_ILBM=$494C424D
  9. CONST ID_BMHD=$424D4844
  10. CONST ID_BODY=$424F4459
  11. CONST ID_CMAP=$434D4150
  12.  
  13. DEF iff:PTR TO iffhandle
  14.  
  15. PROC main()
  16.         DEF req:PTR TO filerequester,source[256]:STRING,err,xsize,ysize,depth,bmhd,
  17.         body,cmap,camg,cflag,p:PTR TO INT,bp:PTR TO CHAR,sp:PTR TO storedproperty
  18.  
  19.         IF KickVersion(37)=FALSE
  20.                 WriteF('Sorry, Kickstart V37+ Required.\n')
  21.                 getout(0)
  22.         ENDIF
  23.         IF (aslbase:=OpenLibrary('asl.library',37))=0
  24.                 error(ER_LIBRARY,'asl')
  25.         ENDIF
  26.         IF (iffparsebase:=OpenLibrary('iffparse.library',37))=0
  27.                 error(ER_LIBRARY,'iffparse')
  28.         ENDIF
  29.         IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Choisissez l'ILBM à convertir',0]:tagitem))>0
  30.                 IF AslRequest(req,0)=0
  31.                         FreeAslRequest(req)
  32.                         getout(0)
  33.                 ELSE
  34.                         StrCopy(source,req.drawer,ALL) ; AddPart(source,req.file,256) ; SetStr(source,StrLen(source))
  35.                 ENDIF
  36.         ELSE
  37.                 error(ER_NOASLREQUEST,0)
  38.         ENDIF
  39.         IF FileLength(source)>0
  40.                 IF (iff:=AllocIFF())>0
  41.                         iff.stream:=Open(source,MODE_OLDFILE)
  42.                         InitIFFasDOS(iff)
  43.                         IF (err:=OpenIFF(iff,IFFF_READ))=0
  44.                                 IF (err:=PropChunk(iff,"ILBM","BMHD"))=0
  45.                                         IF (err:=ParseIFF(iff,IFFPARSE_SCAN)=IFFERR_EOF)
  46.                                                 IF (sp:=FindProp(iff,"ILBM","BMHD"))>0
  47.                                                         bmhd:=sp.data
  48.                                                         bp:=p:=bmhd ;xsize:=p[2] ; ysize:=p[3]
  49.                                                         depth:=bp[13] ; cflag:=bp[14]
  50.                                                 ELSE
  51.                                                         error(ER_NOBMHD,0)
  52.                                                 ENDIF
  53.                                                 WriteF('Commence:\z\h[8]Taille X:\d Taille Y:\d Compression:\d Profondeur:\d\n',bmhd,xsize,ysize,cflag,depth)
  54.                                                 getout(0)
  55.                                         ELSE
  56.                                                 error(ER_IFFERROR,err)
  57.                                         ENDIF
  58.                                 ELSE
  59.                                         error(ER_IFFERROR,err)
  60.                                 ENDIF
  61.                         ELSE
  62.                                 error(ER_IFFERROR,err)
  63.                         ENDIF
  64.                 ELSE
  65.                         error(ER_IFFERROR,IFFERR_NOMEM)
  66.                 ENDIF
  67.         ELSE
  68.                 error(ER_FILENOTFOUND,source)
  69.         ENDIF
  70. ENDPROC
  71. CHAR '$VER: ILBM2Image v.01 (C) 1994 Jason Maskell',0
  72.  
  73. PROC getout(retcode)
  74.         IF iff
  75.                 CloseIFF(iff)
  76.                 Close(iff.stream)
  77.                 FreeIFF(iff)
  78.         ENDIF
  79.         IF aslbase
  80.                 CloseLibrary(aslbase)
  81.         ENDIF
  82.         IF iffparsebase
  83.                 CloseLibrary(iffparsebase)
  84.         ENDIF
  85.         CleanUp(retcode)
  86. ENDPROC
  87.  
  88. PROC error(errnum,str)
  89.         DEF work[80]:STRING
  90.         SELECT errnum
  91.                 CASE ER_LIBRARY
  92.                         StringF(work,'Ne peut pas ouvrir la \s.library V37+',str)
  93.                 CASE ER_NOMEM
  94.                         StringF(work,'Imposible d'allouer la mémoire.')
  95.                 CASE ER_NOASLREQUEST
  96.                         StringF(work,'Impossible d'alouer la requête ASL.')
  97.                 CASE ER_FILENOTFOUND
  98.                         StringF(work,'Fichier "\s" non trouvé.',str)
  99.                 CASE ER_IFFERROR
  100.                         SELECT str
  101.                                 CASE IFFERR_EOC
  102.                                         StringF(work,'Erreur Iffparse: End Of Context')
  103.                                 CASE IFFERR_NOSCOPE
  104.                                         StringF(work,'Erreur Iffparse: Novalid scope')
  105.                                 CASE IFFERR_NOMEM
  106.                                         StringF(work,'Erreur Iffparse: allocation mémoire interne a failli.')
  107.                                 CASE IFFERR_READ
  108.                                         StringF(work,'Erreur Iffparse: Erreur de lecture.')
  109.                                 CASE IFFERR_WRITE
  110.                                         StringF(work,'Erreur Iffparse: Erreur d'écriture.')
  111.                                 CASE IFFERR_SEEK
  112.                                         StringF(work,'Erreur Iffparse: Erreur de Seek.')
  113.                                 CASE IFFERR_MANGLED
  114.                                         StringF(work,'Erreur Iffparse: fichier IFF corrompu.')
  115.                                 CASE IFFERR_SYNTAX
  116.                                         StringF(work,'Erreur Iffparse: Erreur de syntaxe IFF.')
  117.                                 CASE IFFERR_NOTIFF
  118.                                         StringF(work,'Erreur Iffparse: Pas un fichier IFF.')
  119.                                 DEFAULT
  120.                                         StringF(work,'Erreur Iffparse: code erreur inconnu: \d',str)
  121.                         ENDSELECT
  122.                 CASE ER_NOBMHD
  123.                         StringF(work,'Pas d'entête bitmap trouvé.Pas un FORM utilisable')
  124.                 DEFAULT
  125.                         StringF(work,'Code erreur inconnu: \d',errnum)
  126.         ENDSELECT
  127.         request('Erreur ILBM2Image',work,'Ok',0)
  128.         getout(11)
  129. ENDPROC
  130. PROC request(title,body,gadgets,args)
  131. ENDPROC EasyRequestArgs(0,[20,0,title,body,gadgets],0,args)
  132.