home *** CD-ROM | disk | FTP | other *** search
/* Module Sample Extraction Program (C) 1994 Jason Maskell This source code has not been commented much at all because I know pretty much what it does, and maintenance of such a tiny, simple program should not be that hard. So this may not be the ideal source for a beginning E programmer to study. It probably is not, actually. */ OPT OSVERSION=37 MODULE 'asl','libraries/asl','utility/tagitem','dos/dos','workbench/startup' ENUM NOERROR,ER_NOLIBRARY,ER_NOTSUPPORTED,ER_FILENOTFOUND,ER_NOASLREQ,ER_NODIR, ER_NOMEM ENUM FROMCLI,FROMREQ DEF args[3]:LIST,sampname[256]:LIST,sampptr[256]:LIST,samplen[256]:LIST,number, req:PTR TO filerequestr,rdargs,sample_path[256]:STRING PROC main() DEF mod,filesource,off=0,done,p:PTR TO LONG,work[256]:STRING,wba:PTR TO wbarg IF (rdargs:=ReadArgs('Source Module(s)/A/M,Destination Dir/A',args,0))>0 filesource:=FROMCLI ; p:=args[0] ; StrCopy(sample_path,args[1],ALL) FreeArgs(rdargs) ELSE filesource:=FROMREQ /* Choose the source file by requester ... */ IF (aslbase:=OpenLibrary('asl.library',37))=NIL error(ER_NOLIBRARY,'asl') ENDIF IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Choose Module(s) to extract from',ASL_WIDTH,350,ASL_DIR,'ram:',ASL_FUNCFLAGS,FILF_MULTISELECT,0]:tagitem))>0 IF AslRequest(req,0)=0 req:=FreeAslRequest(req) getout(0) ENDIF wba:=req.arglist ELSE error(ER_NOASLREQ,0) ENDIF ENDIF REPEAT IF filesource=FROMCLI IF p[off+1]=0 done:=TRUE ENDIF StrCopy(work,p[off],ALL) ELSE IF req.numargs=1 StrCopy(work,req.dir,ALL) AddPart(work,req.file,256) SetStr(work,StrLen(work)) done:=TRUE ELSE IF off+1=req.numargs done:=TRUE ENDIF StrCopy(work,req.dir,ALL) AddPart(work,wba.name,256) SetStr(work,StrLen(work)) ; wba:=wba+SIZEOF wbarg ENDIF ENDIF INC off IF (mod:=testfile(work))>-1 WriteF('\s Module found.\n',ListItem(['MMD0','MMD1','PT/ST/NT'],mod)) extract(work,mod) savesamples(work) ELSE error(ER_NOTSUPPORTED,work) ENDIF UNTIL done=TRUE getout(0) ENDPROC CHAR '$VER: Sampex V1.1 (C) 1994 Jason Maskell',0 /* This procedure tests to see if the file is an MMD1 file, or exists at all.. */ PROC testfile(filename) DEF fh,buff:PTR TO LONG IF FileLength(filename)>0 fh:=Open(filename,OLDFILE) IF (buff:=New($500))>0 Read(fh,buff,$43c) Close(fh) IF buff[]="MMD0" Dispose(buff) RETURN 0 ENDIF IF buff[]="MMD1" Dispose(buff) RETURN 1 ENDIF IF buff[270]="M.K." Dispose(buff) RETURN 2 ENDIF ELSE error(ER_NOMEM,0) ENDIF ELSE error(ER_FILENOTFOUND,filename) ENDIF ENDPROC -1 /* This procedure handles the actual extraction of samples */ PROC extract(filename,type) DEF a,b,fh,buff,len,p:PTR TO LONG,wp:PTR TO INT,samptr,nameptr, slen,totallen,ptr,sstart len:=FileLength(filename) IF (buff:=New(len))>0 fh:=Open(filename,OLDFILE) Read(fh,buff,len) ; p:=buff IF type<2 samptr:=p[6]+buff ; p:=p[8]+buff IF p[5]=0 WriteF('Instrument names not included!\n') nameptr:=0 ELSE nameptr:=p[5]+buff ENDIF wp:=p ; number:=wp[4] p:=samptr FOR a:=1 TO number slen:=0 IF a=number IF p[0]>0 slen:=len-p[0] ELSE slen:=0 ENDIF ELSE IF p[0]>0 IF p[1]>0 slen:=p[1]-p[0] ELSE b:=0 REPEAT b++ IF p[b]>0 slen:=p[b]-p[0] ENDIF UNTIL (b+a>=number) OR (slen>0) ENDIF ELSE slen:=0 ENDIF ENDIF IF slen>0 sampname[a]:=String(42) IF nameptr>0 StrCopy(sampname[a],nameptr,ALL) ; nameptr:=nameptr+42 ENDIF WriteF('Sample Name:\s[20] Length:\d\n',sampname[a],slen) sampptr[a]:=New(slen) IF sampptr[a]>0 samplen[a]:=slen CopyMem(p[0]+buff,sampptr[a],slen) totallen:=totallen+slen ELSE error(ER_NOMEM,0) ENDIF slen:=0 ELSE sampptr[a]:=0 ; samplen[a]:=0 ENDIF p[]++ ENDFOR ELSE ptr:=buff+20 ; wp:=ptr ; number:=0 FOR a:=0 TO 30 IF wp[11]>0 INC number samplen[number]:=wp[11]*2 ; sampname[number]:=String(22) sampptr[number]:=New(samplen[number]) IF sampptr[number]>0 StrCopy(sampname[number],wp,ALL) WriteF('Sample Name:\s[20] Length:\d\n',sampname[number],samplen[number]) totallen:=totallen+samplen[number] ELSE error(ER_NOMEM,0) ENDIF ENDIF wp:=wp+30 ENDFOR sstart:=(buff+len)-totallen FOR a:=1 TO number CopyMem(sstart,sampptr[a],samplen[a]) sstart:=sstart+samplen[a] ENDFOR ENDIF ELSE error(ER_NOMEM,0) ENDIF WriteF('\nTotal Length of Samples:\d\n',totallen) Close(fh) Dispose(buff) ENDPROC /* This saves the samples... */ PROC savesamples(modfile) DEF req:PTR TO filerequestr,lock,a,work[256]:STRING,result,file[256]:STRING IF EstrLen(sample_path)=0 IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Choose a directory to save samples to',ASL_WIDTH,350,ASL_EXTFLAGS1,FIL1F_NOFILES,ASL_FUNCFLAGS,FILF_SAVE,ASL_DIR,'ram:',0]:tagitem))>0 IF AslRequest(req,0)>0 StrCopy(sample_path,req.dir,ALL) FreeAslRequest(req) ELSE WriteF('Save Aborted!\n') FreeAslRequest(req) getout(0) ENDIF ELSE error(ER_NOASLREQ,0) ENDIF ENDIF IF (lock:=Lock(sample_path,SHARED_LOCK))>0 UnLock(lock) FOR a:=1 TO number IF samplen[a]>0 IF CtrlC() getout(0) ENDIF IF EstrLen(sampname[a])=0 StringF(work,'\s.UNSamp.\d',FilePart(modfile),a) StrCopy(sampname[a],work,ALL) ENDIF cleanupstring(sampname[a]) StrCopy(work,sample_path,ALL) AddPart(work,sampname[a],ALL) ; SetStr(work,StrLen(work)) IF FileLength(work)=-1 savesamp(a,work) ELSE StringF(file,'File "\s" already exists\nOn Disk Size :\d\nNew File Size:\d',work,FileLength(work),samplen[a]) result:=request('Extract Requester',file,'OverWrite|Rename|Cancel',0) IF result=1 savesamp(a,work) ELSE IF result=2 /* Then rename the file! */ IF renamefile(work)>0 savesamp(a,work) ENDIF ENDIF ENDIF ENDIF Dispose(sampptr[a]) ; samplen[a]:=0 ; sampname[a]:=0 ENDIF ENDFOR ELSE error(ER_NODIR,0) ENDIF ENDPROC PROC savesamp(sampnum,filename) DEF fh WriteF('Saving:\s[20] To \s\n',sampname[sampnum],filename) IF (fh:=Open(filename,NEWFILE))>0 Write(fh,sampptr[sampnum],samplen[sampnum]) Close(fh) ELSE WriteF('Unable to open file \s\n',sampname[sampnum]) ENDIF ENDPROC /* This procedure changes illegal characters in a string to '.' and removes ST-xx: prefixes... */ PROC cleanupstring(str:PTR TO CHAR) DEF a,off=0 IF (a:=InStr(str,':',0))>-1 MidStr(str,str,a+1,ALL) ENDIF REPEAT a:=InStr(str,':',off) IF a=-1 a:=InStr(str,'/',off) ENDIF IF a>-1 str[a]:="." ; off:=a ENDIF UNTIL a=-1 ENDPROC PROC renamefile(file) DEF req:PTR TO filerequestr IF (req:=AllocAslRequest(ASL_FILEREQUEST,[ASL_HAIL,'Save sample as:',ASL_WIDTH,350,ASL_DIR,sample_path,ASL_FILE,FilePart(file),ASL_FUNCFLAGS,FILF_SAVE,0]:tagitem))>0 IF AslRequest(req,0)>0 StrCopy(file,req.dir,ALL) ; AddPart(file,req.file,256) ; SetStr(file,StrLen(file)) ELSE FreeAslRequest(req) RETURN 0 ENDIF ELSE error(ER_NOASLREQ,0) ENDIF FreeAslRequest(req) ENDPROC 1 /* Good ole clean exit procedure... */ PROC getout(retcode) IF rdargs FreeArgs(rdargs) ENDIF IF req FreeAslRequest(req) ENDIF IF aslbase CloseLibrary(aslbase) ENDIF CleanUp(retcode) ENDPROC PROC error(err,str) DEF work[256]:STRING,retcode=11 SELECT err CASE ER_NOLIBRARY StringF(work,'Unable to open \s.library V37+',str) CASE ER_NOTSUPPORTED StringF(work,'File: "\s"\nIs not a supported module file.\nSupported: MMD0, MMD1, PT/ST/NT',str) ; retcode:=-1 CASE ER_FILENOTFOUND StringF(work,'File "\s" not found.',str) CASE ER_NOASLREQ StringF(work,'Unable to open Asl Requester...') CASE ER_NODIR StringF(work,'Unable to lock destination dir...') CASE ER_NOMEM StringF(work,'Unable to allocate memory...') DEFAULT StringF(work,'Unknown Error Type') ENDSELECT request('Extract Error Requester',work,'Ok',0) IF retcode>0 getout(retcode) ENDIF ENDPROC PROC request(title,body,gadgets,args) ENDPROC EasyRequestArgs(0,[20,0,title,body,gadgets],0,args) 
