Gold Fish 2

home *** CD-ROM | disk | FTP | other *** search

/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / misc / emu / card / cardapp.e < prev next >

Wrap

Text File | 1994-04-06 | 12.7 KB | 489 lines

OPT OSVERSION=37 MODULE 'workbench/startup', 'workbench/workbench', 'icon', 'wb', 'dos/dos', 'utility/date', 'utility' CONST MEMSTART=$600000, BLOCKSIZE=$100, FILEINFOSIZE=$20, MAGIC=$2000 CONST HEADEROFF=2*BLOCKSIZE, BLKPTRSIZE=2, FILELEN=13, DEL=0, START=0 CONST FREEOFF=HEADEROFF+BLOCKSIZE, HEADER=HEADEROFF+MEMSTART CONST FREEBLOCKS=FREEOFF+MEMSTART, EOFB=$FFFE, EOC=$FFFF, LEN=FILELEN-1 CONST VERB_COLS=2, NOVERB_COLS=3, SECSPERDAY=24*60*60 ENUM NO_ERR, BAD_CARD, NO_FREE, IN_USE, W_PROTECT, SHORT_FILE, DUP_FILE, OPEN_LIB, MSG_PORT, DISK_OBJ, APP_ICON, APP_MENU, OPEN_ERR, MEM, BAD_DIR, EXAM_ERR, LOCK_ERR, BAD_ARGS, TOO_BIG ENUM MY_ICON, MY_EXTR, MY_QUIT OBJECT fileinfo file, next ENDOBJECT RAISE OPEN_LIB IF OpenLibrary()=NIL, OPEN_ERR IF Open()=NIL, MSG_PORT IF CreateMsgPort()=NIL, DISK_OBJ IF GetDiskObject()=NIL, APP_ICON IF AddAppIconA()=NIL, APP_MENU IF AddAppMenuItemA()=NIL, EXAM_ERR IF Examine()=NIL, EXAM_ERR IF ExamineFH()=NIL, LOCK_ERR IF Lock()=NIL, MEM IF New()=NIL /* lastinfo is a block pointer with MAGIC, e.g., $213A (not $13A) */ DEF thefiles:PTR TO fileinfo, lastfile:PTR TO fileinfo, lastinfo PROC main() HANDLE DEF myport=NIL, dobj=NIL:PTR TO diskobject, fh=NIL, oldstdout=NIL, appicon=NIL, appmsg=NIL:PTR TO appmessage, appquit=NIL, appextr=NIL, verbose=FALSE fh:=Open('CON:0/11/640/110/Notepad Card/AUTO/CLOSE/WAIT', OLDFILE) oldstdout:=SetStdOut(fh) iconbase:=OpenLibrary('icon.library', 33) workbenchbase:=OpenLibrary('workbench.library', 37) utilitybase:=OpenLibrary('utility.library', 37) myport:=CreateMsgPort() dobj:=GetDiskObject('progdir:cardapp') dobj.type:=NIL verbose:=FindToolType(dobj.tooltypes, 'VERBOSE') appicon:=AddAppIconA(MY_ICON,NIL,'- Notepad Card -',myport,NIL,dobj,NIL) appextr:=AddAppMenuItemA(MY_EXTR,NIL,'Extract',myport,NIL) appquit:=AddAppMenuItemA(MY_QUIT,NIL,'Quit CardApp',myport,NIL) LOOP WaitPort(myport) WHILE appmsg:=GetMsg(myport) IF appmsg.id=MY_QUIT Raise(NO_ERR) ELSEIF appmsg.id=MY_ICON getinfo() doicon(appmsg, verbose) freeinfo(thefiles, thefiles.next) ELSEIF appmsg.id=MY_EXTR getinfo() doextract(appmsg) freeinfo(thefiles, thefiles.next) ENDIF ReplyMsg(appmsg) appmsg:=NIL ENDWHILE ENDLOOP Raise(NO_ERR) EXCEPT IF appmsg THEN ReplyMsg(appmsg) IF appquit THEN RemoveAppMenuItem(appquit) IF appextr THEN RemoveAppMenuItem(appextr) IF appicon THEN RemoveAppIcon(appicon) IF dobj THEN FreeDiskObject(dobj) IF myport WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg) DeleteMsgPort(myport) ENDIF IF utilitybase THEN CloseLibrary(utilitybase) IF workbenchbase THEN CloseLibrary(workbenchbase) IF iconbase THEN CloseLibrary(iconbase) IF fh SetStdOut(oldstdout) Close(fh) ENDIF SELECT exception CASE MEM WriteF('- Could not allocate memory -\n') CASE OPEN_ERR WriteF('- Cannot open output window -\n') CASE OPEN_LIB WriteF('- Cannot open required libraries -\n') CASE MSG_PORT WriteF('- Cannot create msg port -\n') CASE DISK_OBJ WriteF('- Cannot locate icon for CardApp -\n') CASE APP_ICON WriteF('- Cannot add AppIcon to Workbench -\n') CASE APP_MENU WriteF('- Cannot add AppMenuItem to Workbench -\n') CASE BAD_CARD WriteF('- No PCMCIA card, or not from Notepad -\n') CASE IN_USE WriteF('- PCMCIA card is in use, or not from Notepad -\n') CASE W_PROTECT WriteF('- No PCMCIA card, or write protected -\n') CASE NO_FREE setwrite() WriteF('- No more free blocks -- card is full -\n') ENDSELECT ENDPROC PROC doextract(appmsg:PTR TO appmessage) HANDLE DEF f:PTR TO fileinfo, oldlock=NIL, lock=NIL, fib:fileinfoblock, wargs:PTR TO wbarg, s wargs:=appmsg.arglist IF appmsg.numargs=1 IF wargs.lock=NIL THEN Raise(BAD_DIR) IF s:=wargs.name IF s[]<>0 THEN Raise(BAD_DIR) ENDIF Examine(wargs.lock,fib) IF fib.direntrytype<0 THEN Raise(BAD_DIR) oldlock:=CurrentDir(wargs.lock) ELSEIF appmsg.numargs=0 lock:=Lock('Ram Disk:', ACCESS_READ) oldlock:=CurrentDir(lock) ELSE Raise(BAD_ARGS) ENDIF f:=thefiles.next WHILE f extractfile(f.file) f:=f.next ENDWHILE WriteF('* Finished extracting files -- safe to remove card *\n\n') Raise(NO_ERR) EXCEPT IF oldlock THEN CurrentDir(oldlock) IF lock THEN UnLock(lock) SELECT exception CASE BAD_ARGS WriteF('- Select at most one directory -\n') CASE BAD_DIR WriteF('- Can only Extract to a directory -\n') CASE LOCK_ERR WriteF('- Cannot lock Ram: disk -\n') CASE EXAM_ERR WriteF('- Examine failed -\n') ENDSELECT ENDPROC PROC extractfile(file) HANDLE DEF b, fh, i IF deleted(file)=FALSE fh:=Open(filename(file), NEWFILE) WriteF('Extracting file "\s"\n', filename(file)) b:=firstblock(file) i:=filesize(file) WHILE (b<>EOC) AND (b<>DEL) Write(fh, address(b), IF i<BLOCKSIZE THEN i ELSE BLOCKSIZE) i:=i-BLOCKSIZE b:=follow(b) ENDWHILE Raise(NO_ERR) ENDIF EXCEPT IF fh THEN Close(fh) SELECT exception CASE OPEN_ERR WriteF('- Cannot open output file "\s" -\n', filename(file)) ENDSELECT ENDPROC PROC doicon(appmsg:PTR TO appmessage, verbose) HANDLE DEF i, err, f:PTR TO fileinfo, wargs:PTR TO wbarg, oldlock=NIL, s, add IF appmsg.numargs=0 f:=thefiles.next i:=0 WHILE f printfile(f.file, {i}, verbose) f:=f.next ENDWHILE printfile(NIL, {i}, verbose) /* Trailing linefeed? */ WriteF('* End of Listing *\n\n') ELSE IF (err:=checkwrite())<>NO_ERR THEN Raise(err) wargs:=appmsg.arglist add:=FALSE FOR i:=1 TO appmsg.numargs /* Loop through the arguments */ IF (wargs.lock<>NIL) AND (s:=wargs.name) IF s[]<>0 oldlock:=CurrentDir(wargs.lock) WriteF('Adding file "\s"\n', wargs.name) IF addfile(wargs.name) THEN add:=TRUE CurrentDir(oldlock) /* Important: restore current dir */ oldlock:=NIL ELSE WriteF('- Ignoring directory -\n') ENDIF ELSE WriteF('- Ignoring directory -\n') ENDIF wargs++ ENDFOR setwrite() IF add WriteF('* Finished adding files -- safe to remove card *\n\n') ELSE WriteF('* No files selected *\n\n') ENDIF ENDIF EXCEPT IF oldlock THEN CurrentDir(oldlock) Raise(exception) ENDPROC PROC printfile(file, count, verbose) IF file IF deleted(file)=FALSE ^count:=^count+1 IF verbose WriteF('\l\s[12] \r\d[5]', filename(file), filesize(file)) printdate(file) WriteF(IF Mod(^count, VERB_COLS)=0 THEN '\n' ELSE ' ') ELSE WriteF('\l\s[12] \r\d[5]\s', filename(file), filesize(file), IF Mod(^count, NOVERB_COLS)=0 THEN '\n' ELSE ' ') ENDIF ENDIF ELSE IF Mod(^count, IF verbose THEN VERB_COLS ELSE NOVERB_COLS)<>0 WriteF('\n') ENDIF ENDIF ENDPROC PROC printdate(file) DEF date, year, month, day, hour, min date:=filedate(file) year:=Mod(90+Shr(date, 25), 100) month:=Shr(date AND $1FFFFFF, 21) IF (month>12) OR (month<1) THEN month:=0 day:=Shr(date AND $1FFFFF, 16) hour:=Shr(date AND $FFFF, 11) min:=Shr(date AND $7FF, 5) WriteF(' \r\d[2]-\s-\z\d[2] \r\d[2]:\z\d[2]', day, ListItem(['XXX', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'], month), year, hour, min) ENDPROC PROC addfile(fname) HANDLE DEF fh=NIL, file, b=START, next, len, i=0, going=TRUE, f:PTR TO fileinfo, found=NIL, name, fib:fileinfoblock fh:=Open(fname, OLDFILE) name:=FilePart(fname) ExamineFH(fh, fib) IF fib.direntrytype>0 THEN Raise(BAD_DIR) len:=fib.size IF (len<=0) OR (len>$FFFF) THEN Raise(TOO_BIG) f:=thefiles.next WHILE f IF deleted(f.file) IF found=NIL THEN found:=f.file ELSE IF equal(name, filename(f.file)) THEN Raise(DUP_FILE) ENDIF f:=f.next ENDWHILE IF found file:=found ELSE file:=FILEINFOSIZE+lastfile.file IF Mod(file, BLOCKSIZE)=0 IF (b:=findfree(b))=EOFB THEN Raise(NO_FREE) initblock(b) useblock(lastinfo, b) lastinfo:=b useblock(b, EOC) file:=address(b) ENDIF ENDIF IF (b:=findfree(b))=EOFB THEN Raise(NO_FREE) lastfile.next:=newfile(file) lastfile:=lastfile.next setfirstblock(file, b) setname(file, name) setdate(file, fib.datestamp) going:=TRUE WHILE (i<len) AND going Read(fh, address(b), BLOCKSIZE) i:=i+BLOCKSIZE IF (next:=findfree(b))=EOFB going:=FALSE ELSE useblock(b, next) b:=next ENDIF ENDWHILE useblock(b, EOC) IF going=FALSE THEN Raise(SHORT_FILE) setsize(file, len) Raise(NO_ERR) EXCEPT IF fh THEN Close(fh) SELECT exception CASE BAD_DIR WriteF('- Cannot add a directory -\n') RETURN FALSE CASE TOO_BIG WriteF('- File "\s" is too large (or empty) -\n', fname) CASE OPEN_ERR WriteF('- Unable to open file "\s" -\n', fname) CASE EXAM_ERR WriteF('- Examine failed -\n') CASE DUP_FILE WriteF('- File "\s" already exists as "\s" -\n', fname, filename(f.file)) CASE MEM Raise(MEM) CASE NO_FREE Raise(NO_FREE) CASE SHORT_FILE setsize(file, i) WriteF('- File "\s" will be short -\n', filename(file)) Raise(NO_FREE) ENDSELECT ENDPROC TRUE PROC getinfo() DEF info, nofiles=FALSE, atend=FALSE, file, d file:=HEADER lastinfo:=firstblock(file) thefiles:=lastfile:=newfile(file) IF validate(file) d:=filedate(file) file:=file+FILEINFOSIZE REPEAT /* for all info blocks */ REPEAT /* for all files */ IF blank(file) nofiles:=TRUE ELSE lastfile.next:=newfile(file) lastfile:=lastfile.next d:=filedate(file) file:=file+FILEINFOSIZE IF Mod(file, BLOCKSIZE)=0 THEN atend:=TRUE ENDIF UNTIL atend OR nofiles IF atend info:=follow(lastinfo) IF (info<>EOC) AND (info<>DEL) lastinfo:=info file:=address(lastinfo) atend:=FALSE ELSE nofiles:=TRUE ENDIF ENDIF UNTIL nofiles ELSE Raise(BAD_CARD) ENDIF ENDPROC PROC freeinfo(this, next:PTR TO fileinfo) Dispose(this) IF next THEN freeinfo(next, next.next) ENDPROC PROC checkwrite() DEF err=NO_ERR, p p:=HEADER+12 Forbid() IF p[]=0 p[]:=1 IF p[]<>1 THEN err:=W_PROTECT ELSE err:=IN_USE ENDIF Permit() ENDPROC err PROC setwrite() DEF p p:=HEADER+12 Forbid() p[]:=0 Permit() ENDPROC PROC equal(s, t) DEF a[LEN]:STRING, b[LEN]:STRING StrCopy(a, s, ALL) StrCopy(b, t, ALL) UpperStr(a) UpperStr(b) RETURN StrCmp(a, b, ALL) ENDPROC PROC follow(block) RETURN int(blockaddr(block)) PROC blockaddr(block) RETURN (block-MAGIC)*BLKPTRSIZE+FREEBLOCKS PROC blockptr(addr) RETURN (addr-FREEBLOCKS)/BLKPTRSIZE+MAGIC PROC address(block) RETURN (block-MAGIC)*BLOCKSIZE+MEMSTART PROC useblock(block, next) putint(blockaddr(block), next) ENDPROC PROC initblock(block) DEF p, i p:=address(block) FOR i:=1 TO BLOCKSIZE DO p[]++:=0 ENDPROC PROC validate(file) RETURN StrCmp(filename(file), 'NC', 2) AND (firstblock(file)=HEADEROFF+MAGIC) ENDPROC PROC blank(file) DEF n FOR n:=0 TO FILEINFOSIZE-1 DO IF file[]++<>0 THEN RETURN FALSE ENDPROC TRUE PROC newfile(ptr) DEF p:PTR TO fileinfo p:=New(SIZEOF fileinfo) p.file:=ptr p.next:=NIL ENDPROC p PROC findfree(block) DEF p, b p:=IF block<>START THEN blockaddr(block+1) ELSE FREEBLOCKS WHILE (b:=int(p))<>EOFB IF b=0 THEN RETURN blockptr(p) p:=p+BLKPTRSIZE ENDWHILE RETURN EOFB ENDPROC PROC setname(file, name) DEF i, p p:=file FOR i:=0 TO FILELEN DO p[]++:=0 i:=StrLen(name) CopyMem(name, file, IF i>=FILELEN THEN FILELEN-1 ELSE i) ENDPROC PROC setdate(file, ds:PTR TO datestamp) DEF secs, cd:clockdata, date secs:=Mul(ds.days,SECSPERDAY)+(ds.minute*60)+(ds.tick/50) Amiga2Date(secs, cd) date:=Shl(cd.year-1990, 25) OR Shl(cd.month, 21) OR Shl(cd.mday, 16) OR Shl(cd.hour, 11) OR Shl(cd.min, 5) putlong(file+16, date) ENDPROC PROC setsize(file, size) putint(file+14, size) ENDPROC PROC setfirstblock(file, block) putint(file+20, block) ENDPROC PROC putint(p, v) p[]++:=v AND $FF p[]:=Shr(v, 8) AND $FF ENDPROC PROC putlong(p, v) p[]++:=v AND $FF p[]++:=Shr(v, 8) AND $FF p[]++:=Shr(v, 16) AND $FF p[]:=Shr(v, 24) AND $FF ENDPROC PROC deleted(file) RETURN file[]=0 PROC filename(file) RETURN file PROC filesize(file) RETURN int(file+14) PROC filedate(file) RETURN long(file+16) PROC firstblock(file) RETURN int(file+20) PROC int(p) RETURN p[]++ OR Shl(p[],8) PROC long(p) RETURN p[]++ OR Shl(p[]++,8) OR Shl(p[]++,16) OR Shl(p[],24)