100 ' 105 '======================================= 110 ' 115 ' <<< PMx88 Version 1.00 >>> 120 ' 125 ' for PC-8801 series V1/V2 mode 130 ' 135 ' Copyright(C) 1990 by Yoshihiko Mino 140 ' 145 '======================================= 150 ' 155 *INITIALIZE. 160 ' 165 CLEAR,&HBE00:DEFINT A-Z 170 DEF FNH$(AD)=RIGHT$("0"+HEX$(PEEK(AD)),2) 175 ON ERROR GOTO *ERR. 180 SCREEN 0,3:WIDTH 80,25:CONSOLE 0,25,0,1:COLOR 7,0:CLS 185 COLOR 5:PRINT"============================================================" 190 COLOR 6:PRINT" PMx88 Version 1.00 Copyright(C) 1990 by Yoshihiko Mino " 195 COLOR 5:PRINT"============================================================" 200 COLOR 7:CONSOLE 4,21 205 BLOAD"PMx88.bin" 210 DEF USR=&HBF00:U=USR(0) 215 B1=VARPTR(#1)+9:B2=VARPTR(#2)+9 220 POKE &HBF10,B1 AND 255:POKE &HBF11,INT(B1/256) AND 255 225 POKE &HBF12,B2 AND 255:POKE &HBF13,INT(B2/256) AND 255 230 ' 235 *INPUT.FILENAME 240 ' 245 COLOR 7:PRINT:LINE INPUT"Archive filename>",AF$ 250 IF AF$="" THEN GOTO *END. 255 DV=VAL(AF$):IF LEN(AF$)=1 AND DV>0 THEN PRINT:FILES DV:GOTO 245 260 IF INSTR(AF$,".")=0 THEN AF$=AF$+".PMA" 265 OPEN AF$ FOR INPUT AS #1:CLOSE #1 270 OPEN AF$ AS #1 275 PRINT 280 PRINT" Filename Original Packed Ratio Date Time Type CRC " 285 PRINT"============== ======== ======== ====== ======== ======== ===== ====" 290 US$= " & &.& & ######## ######## ###.#% & & & & & & & &" 295 N=0:TPS#=0:TOS#=0 300 ' 305 *MAIN. 310 ' 315 R1=1+PEEK(&HBF15)+PEEK(&HBF16)*256:GET #1,R1 320 U=USR(1) 325 IF U<0 THEN COLOR 2:PRINT"Archive header is broken.":BEEP:GOTO *END. 330 IF U=0 THEN GOTO *END.OF.ARCHIVE 335 IF U=1 THEN R1=1+PEEK(&HBF15)+PEEK(&HBF16)*256:GET #1,R1:U=USR(4):GOTO 325 340 F1$="":FOR I=&HBF2C TO &HBF33:F1$=F1$+CHR$(PEEK(I)):NEXT 345 F2$="":FOR I=&HBF34 TO &HBF36:F2$=F2$+CHR$(PEEK(I)):NEXT 350 MT$="":FOR I=&HBF17 TO &HBF1B:MT$=MT$+CHR$(PEEK(I)):NEXT 355 DT$=FNH$(&HBF24)+"-"+FNH$(&HBF25)+"-"+FNH$(&HBF26) 360 TM$=FNH$(&HBF27)+":"+FNH$(&HBF28)+":"+FNH$(&HBF29) 365 CR$=FNH$(&HBF2B)+FNH$(&HBF2A) 370 IF PEEK(&HBF38)=&H7A THEN CR$="****" 375 PS#=PEEK(&HBF1C)+PEEK(&HBF1D)*256+PEEK(&HBF1E)*65536! 380 OS#=PEEK(&HBF20)+PEEK(&HBF21)*256+PEEK(&HBF22)*65536! 385 RT#=100*PS#/OS# 390 PRINT USING US$;F1$,F2$,OS#,PS#,RT#,DT$,TM$,MT$,CR$ 395 TPS#=TPS#+PS#:TOS#=TOS#+OS#:N=N+1 400 IF U=3 THEN GOTO *SKIP. 405 COLOR 6:PRINT"Extract? (Y) "; 410 K$=INPUT$(1):PRINT CHR$(13); 415 IF K$="Y" OR K$="y" THEN GOTO *EXTRACT. 420 IF K$="Q" OR K$="q" THEN GOTO *END.OF.ARCHIVE 425 ' 430 *SKIP. 435 ' 440 R1=USR(2)+1:COLOR 7:GOTO *MAIN. 445 ' 450 *EXTRACT. 455 ' 460 COLOR 6:LINE INPUT"Extraction filename>",E$ 465 IF E$="" THEN GOTO *SKIP. 470 IF LEN(E$)=1 AND VAL(E$)>0 THEN E$=E$+":"+LEFT$(F1$,6)+"."+F2$ 475 OPEN E$ FOR INPUT AS #2:CLOSE #2 480 PRINT"Overwrite? (Y) "; 485 K$=INPUT$(1):PRINT CHR$(13); 490 IF K$<>"Y" AND K$<>"y" THEN GOTO *EXTRACT. 495 COLOR 4:PRINT" Extracting..."; 500 OPEN E$ AS #2:R2=0 505 U=USR(3) 510 IF U<0 THEN COLOR 2:PRINT"CRC error detected.":BEEP:GOTO *END. 515 IF U=1 THEN R1=R1+1:GET #1,R1:U=USR(4):GOTO 510 520 IF U=2 THEN R2=R2+1:PUT #2,R2:U=USR(4):GOTO 510 525 CLOSE #2:PRINT"OK" 530 GOTO *SKIP. 535 ' 540 *END.OF.ARCHIVE 545 ' 550 COLOR 7:PRINT"============== ======== ======== ======" 555 IF N=0 THEN PRINT" No file":GOTO *END. 560 RT#=100*TPS#/TOS# 565 PRINT USING" ### files ######## ######## ###.#%";N,TOS#,TPS#,RT# 570 ' 575 *END. 580 ' 585 CLOSE:COLOR 7:CONSOLE 0,25:END 590 ' 595 *ERR. 600 ' 605 IF ERR=53 AND ERL=265 THEN COLOR 2:PRINT"File not found.":BEEP:RESUME 245 610 IF ERR=56 AND ERL=265 THEN COLOR 2:PRINT"Bad filename.":BEEP:RESUME 245 615 IF ERR=53 AND ERL=475 THEN RESUME 495 620 IF ERR=56 AND ERL=475 THEN COLOR 2:PRINT"Bad filename.":BEEP:RESUME 460 625 COLOR 2:PRINT "Error";ERR;"in";ERL:COLOR 7:CONSOLE 0,25:ERROR ERR:STOP 630 ' 635 '<<< PMx88 Version 1.00 Copyright(C) 1990 by Yoshihiko Mino >>> 640 '