L'école compresser et lire une image en screen 8 sous basic
Bonjour
Pour un project de noel, j'ai besoin de compresser mes images en screen 8 sous basic.
Et comment les lires ??
Je n'ai rien trouvé apres avoir fait le tour dans les forums. Il me semble que l'on en avait parlé
Si vous avez une solution avant noel
Pour un project de noel, j'ai besoin de compresser mes images en screen 8 sous basic.
Et comment les lires ??
Je n'ai rien trouvé apres avoir fait le tour dans les forums. Il me semble que l'on en avait parlé
Si vous avez une solution avant noel
Visiteur
Vagabond
Message : 0
Ca existe, mais la difficulté est de pouvoir le faire en BASIC ... 
La seule solution à mon avis est de créer un fichier unique qui contient l'image compressée et son décompresseur assembleur que l'on activerai en BASIC par "BLOAD "image_comprimée",R".
La seule solution à mon avis est de créer un fichier unique qui contient l'image compressée et son décompresseur assembleur que l'on activerai en BASIC par "BLOAD "image_comprimée",R".
MSX1: Daewoo DPC-200 / Yamaha CX5M
MSX2: Sony HB-F9P
MSXVR
Vidéo: V9990 (GFX-9)
Audio: MSX-Music (FM-PAC) / MSX-Audio (Audiowave) / OPL4 (Monster Sound FM Blaster) / OPNB (Neotron)
MSXlegend,
Ce que je te propose :
1) Tu m'envoies l'image SCREEN8
2) Je la compresse et je te dit quelle taille elle prend en RAM
3) Et si c'est compatible avec ton programme, je te prépare un fichier que tu pourras utiliser par BLOAD"image_compressée",R
Ce que je te propose :
1) Tu m'envoies l'image SCREEN8
2) Je la compresse et je te dit quelle taille elle prend en RAM
3) Et si c'est compatible avec ton programme, je te prépare un fichier que tu pourras utiliser par BLOAD"image_compressée",R
MSX1: Daewoo DPC-200 / Yamaha CX5M
MSX2: Sony HB-F9P
MSXVR
Vidéo: V9990 (GFX-9)
Audio: MSX-Music (FM-PAC) / MSX-Audio (Audiowave) / OPL4 (Monster Sound FM Blaster) / OPNB (Neotron)
6502man :
La meilleur solution (à mon avis) en utilisant le Basic c'est BARGAIN
Je sais pas si c'est la meilleure solution mais elle a l'air très simple en effet. Dommage qu'il n'y ait pas de visionneuse pour le DOS.
Merci les gars, je note
@Metalion, oui je t enverrais ça
@6502man, quand j'ai vu la taille du listing, j'ai vite abandonné
Sinon j'ai testé MIF disponible sur le site de Bibizen http://multidatas.free.fr/msosx/index.php?option=com_content&task=view&id=27&Itemid=160
Malheureusement, n'est pas compatible sur mon windows 7 64 bits
edit: bon en fin de compte j'ai tout simplement converti quelque sc8 en sc5, le rendu n'est pas si different avec seulement 16 couleurs. ça reduit l'image de 54k a 29k j'en gagne presque la moitié !! Edité par MSXlegend Le 24/11/2015 à 16h31
@Metalion, oui je t enverrais ça
@6502man, quand j'ai vu la taille du listing, j'ai vite abandonné
Sinon j'ai testé MIF disponible sur le site de Bibizen http://multidatas.free.fr/msosx/index.php?option=com_content&task=view&id=27&Itemid=160
Malheureusement, n'est pas compatible sur mon windows 7 64 bits
edit: bon en fin de compte j'ai tout simplement converti quelque sc8 en sc5, le rendu n'est pas si different avec seulement 16 couleurs. ça reduit l'image de 54k a 29k j'en gagne presque la moitié !! Edité par MSXlegend Le 24/11/2015 à 16h31
Visiteur
Vagabond
Message : 0
c'est bien ce que j'ai dit, quand j'ai vu la taille du listing, je me suis sauvé
Il faudrait aussi compresser le listing
Il faudrait aussi compresser le listing
Caché :
Edité par
MSXlegend
Le 24/11/2015 à 22h21
10 ' BARGAIN 14.23 (C)Katsuhiro Noguchi 2013.04.01
20 ' Initialize
30 KEYOFF:CLEAR 777,&HCE85:MAXFILES=1:OPEN "GRP:" AS #1:VDP(9)=10:POKE &HF346,1
40 DEFINT A-Z: DIM FX(8),FY(8),ML(1),LK(63),LG$(9),ML$(1),DV$(1),MD$(1)
50 DEFUSR=342: DEFUSR7=65: DEFUSR8=68:ID=(PEEK(&HFFE8)AND8)8:A=RND(-TIME)
60 DEFUSR6=&HDCB4: DEFUSR5=&HDD1E: DEFUSR4=&HDD28: DEFUSR2=&HDD3D: DEFUSR3=&HDD99
70 ON ERROR GOTO 2200:_ANK: DB=1:IL=1:C0=PEEK(&HF3E9):C1=PEEK(&HF3EA)
80 ML$(0)="BN142BN39 BN135BN124BN116BN108BN96 BN89 BN79 BN69":IN$="H:#1"
90 ML$(1)="ce86 d15e ce71 cebc cee8 cf69 cf4b cf8f cfd9 d199":FL$=SPACE$(12)
100 DV$(0)="A:":DV$(1)="H:":DC$="ABH":DL=LEN(DC$):VD=VAL(MID$(ML$(0),3,3))
110 MD$(0)=".SC":M0$=".S1":M1$=".BN":M2$=".B1":VL=VD:AD=&HDDC0:_RAMDISK(4000)
120 LK$="Lock.key":NAME LK$:CLS:PRINT LK$;" Initializing":PRINT:FOR I=0 TO 63
130 A=RND(1)*256:FOR J=0 TO I:IF A=LK(J) THEN J=I:NEXT:GOTO 130 ELSE NEXT:LK(I)=A:PRINT A;:POKE AD+I,A:NEXT:BSAVE LK$,AD,AD+63
140 FOR I=0 TO 4:READ LG$:LG$(I)=LG$+" ":LG$(I+5)="T"+LG$:NEXT:GOSUB 440
150 FOR I=1 TO 8:READ FX(I):FY((I+1)MOD8+1)=FX(I):NEXT:LK$="LOCK ":GOSUB 520
160 DATA PSET ,AND ,OR ,XOR ,PRESET,0,1,1,1,0,-1,-1,-1
170 ' Main
180 A=USR(0):LOCATE 10,0:PRINT USING"##.#";VD/10
190 LOCATE 0,1:PRINT MID$(" ._",DT+1,1);TAB(7);MID$(" _",TF+1,1);TAB(13);MID$(" ._",EN+1,1);TAB(21);MID$(" _",IL+1,1)
200 LOCATE 57,Q2:PRINT"/ Logical( ";LG$(LG);" )"
210 IF V0 THEN LOCATE 31,1:PRINT MID$(" _",OV+1,1)
220 A$=INKEY$:IFA$=""GOTO220ELSEA=ASC(A$):IF27<AANDA<32THENGOSUB400:GOTO220
230 CM$="OoTtRrCcMmQqVvIiDdLlEe":GOSUB 890
240 IF A=13THEN LOCATE R,Q:PRINT FL$:A=USR3(0):GOSUB 1060:GOTO 180
250 IF A=9 THEN GOSUB 490:GOTO 220
260 IF B=9 THEN BEEP: DT=DT+1: DT=DT MOD 3:GOTO 190
270 IF B=11THEN EN=EN+1:EN=EN MOD 3:GOSUB 900:GOTO 180
280 IF B=10THEN LG=(LG+2*CS-1)MOD 10+10*(LG=0)*(CS=0):GOTO 190
290 IF B=2 THEN BEEP:TF=1-TF:GOTO 190 ELSEIF B=4 THEN GOSUB 670:GOTO 200
300 IF B=1 AND V0 THEN BEEP:OV=1-OV:GOTO 210 ELSEIF B=5 THEN GOSUB 810
310 IF B=8 THEN IL=1-IL:GOSUB 900 ELSEIF B=3 THEN GOSUB 550
320 IF B=7 THEN BEEP:ML=5-ML:VB=VD:VD=VAL(MID$(ML$(0),ML+3,3)):GOSUB 440
330 IF A=8 THEN DV=1-DV:GOSUB 520 ELSEIF A=127 THEN GOSUB 610
340 IF A=42 OR 52<A AND A<57 THEN SC$=A$:GOSUB 900
350 IF 47<A AND A<51 THEN SC$=HEX$(A-38):GOSUB 900 ELSEIF B=6 GOTO 370
360 IF A=27THEN NAME "a:msxdos*.sys":GOSUB 380:_SYSTEM:ELSE 180
370 GOSUB 380:COLOR C0,C1:ON ERROR GOTO 0:VDP(9)=8:KEY ON:END
380 LOCATE 0,Q1+1:PRINT:RETURN
390 '' Cursol Move
400 LOCATER,Q:PRINTFL$;:IF(PEEK(&HFBEB)AND1)ORMID$(FL$,9,1)=" "GOTO420
410 IS=VPEEK(R+12+80*Q):IFIS=32THENBEEP:PRINT"!":SH=SH+1ELSEIFIS=33THENPRINT" ":SH=SH-1
420 Q=USR6(A):R=PEEK(&HDE6F)
430 LOCATER,Q:FL$=USR2(FL$):RETURN
440 '' Version Change
450 VS=VD
460 MP=INSTR(ML$(0),"BN"+MID$(STR$(VS),2,LEN(STR$(VS))-2+(VS>VL)*(VS10=VL10))):IF MP=MB THEN RETURN
470 BLOAD "A:"+MID$(ML$(0),MP,5)+".BIN"
480 DEFUSR1=VAL("&h"+MID$(ML$(1),MP,4)):MB=MP:RETURN
490 '' Device Change
500 D1=(D1+1)MOD DL:D1=(D1-(D0=D1))MOD DL: DV$(1-DV)=MID$(DC$,D1+1,1)+":"
510 BEEP:LOCATE 41,0:PRINT DV$(1-DV): DF=-1:RETURN
520 '' Drive Change
530 D0=INSTR(DC$,LEFT$(DV$(DV),1))-1:D1=INSTR(DC$,LEFT$(DV$(1-DV),1))-1
540 DV$=DV$(DV):SC$="":DF=-1:HP=1:GOSUB 900:RETURN
550 '' File Rename
560 LOCATE 61,0:PRINT"[Renam]":LOCATE R,Q:PRINT FL$:LOCATE R,Q:LINEINPUT RN$
570 RN$=LEFT$(RN$,12):IF CSRLIN-1<>Q OR(INSTR(RN$,".")<>9 AND INSTR(RN$,"*")=0) THEN LOCATE R,Q:PRINT FL$:GOTO 600
580 COLOR=(C0,1,7,1):NAME DV$+FL$ AS RN$:GOSUB 860
590 IF IN THEN NAME M3$ AS LEFT$(RN$,10)+"1"+MID$(RN$,12)
600 COLOR:LOCATE 61,0:PRINT" Renam ":GOSUB 430:RETURN
610 '' File Delete
620 LOCATE 56,0:PRINT"[DEL]":GOSUB 840:IF A=127 THEN GOSUB 640
630 LOCATE 56,0:PRINT" DEL ":RETURN
640 IF FS THEN COLOR=(C0,7,1,1):GOSUB 730:KILL DV$+FL$ ELSE 630
650 IF IN THEN KILL M3$
660 GOSUB 900:RETURN
670 '' File Copy
680 LOCATE 44,0:PRINT"[Copy]":GOSUB 840:IF B=1 THEN GOSUB 700
690 LOCATE 44,0:PRINT" Copy ":RETURN
700 IF FS THEN COLOR=(C0,1,7,7):GOSUB 730:COPY DV$+FL$ TO DV$(1-DV) ELSE 690
710 IF IN THEN COPY M3$ TO DV$(1-DV)
720 IF B=1 THEN SH=0:COLOR:RETURN ELSE RETURN
730 IF SH=0 THEN RETURN ELSE LOCATE R,Q:PRINT FL$
740 FOR I=0 TO (Q1-3)*6-1:LX=(IMOD6)*13:LY=I6+4
750 IF VPEEK(LX+12+80*LY)<>33 THEN 800
760 A$="":FOR J=0 TO 11:A$=A$+CHR$(VPEEK(LX+J+80*LY)):NEXT:B$=DV$+LEFT$(A$,10)+"1"+RIGHT$(A$,1)
770 IF A=127 THEN KILL DV$+A$:IF IL THEN KILL B$
780 IF A<>127 THEN COPY DV$+A$ TO DV$(1-DV):IF IL THEN COPY B$ TO DV$(1-DV)
790 IF A=127 OR B=1 THEN LOCATE LX+12,LY:PRINT" "
800 NEXT:IF A=127 THEN RETURN 660 ELSE GOSUB 430:RETURN 720
810 '' File Move
820 LOCATE 50,0:PRINT"[Move]":GOSUB 840:IF B=2 THEN GOSUB 700:A=127:GOSUB 640
830 LOCATE 50,0:PRINT" Move ":RETURN
840 ''' Command
850 FS=(LEFT$(FL$,1)<>" ")OR SH:KL$=DV$(1-DV)+FL$:CM$="CcMm":GOSUB 880
860 MD$=MID$(FL$,9,3):MK$=MID$(" "+M0$+M2$,INSTR(MD$(0)+M1$,MD$)+1,3)
870 M3$=DV$+LEFT$(FL$,8)+MK$+MID$(FL$,12):IN=IL AND(MK$<>" .S"):RETURN
880 A$=INKEY$:IF A$="" GOTO 880 ELSE A=ASC(A$)
890 CS=PEEK(&HFBEB)AND 1:B=(INSTR(CM$,A$)+1)2:RETURN
900 '' Main Screen
910 SCREEN 0,,,,,ID:WIDTH 80:COLOR C0,C1:Q1=4:POKE &HDE71,4:Q2=3:VJ=0:EC=0:SH=0
920 HE$="Dither Trans Encrypt Interlace":A$=STRING$(34,"_")
930 HD$="Overld(re-Compress_SEL,Infor_SPACE,Bsave_HOME)"
940 PRINT"=BARGAIN V14.23= BS>";DV$;TAB(37);"TAB>";DV$(1-DV);TAB(45);"Copy Move DEL Renam Quit/ESC"
950 LOCATE,4-DB:FILES DV$+"*"+MD$(0)+"*":GOSUB 1050:Q2=Q1+1:VJ=1
960 IF IL=0 THEN FILES DV$+"*"+M0$+"*":GOSUB 1050:Q2=Q1+1:VJ=1
970 IF VJ THEN LOCATE 0,3:PRINT A$;LEFT$("Compress__"+A$,43)
980 LOCATE,Q2+1-DB:FILES DV$+"*"+M1$+SC$+"*":GOSUB 1050:VJ=VJ+2
990 IF IL=0 THEN FILES DV$+"*"+M2$+SC$+"*":GOSUB 1050:VJ=VJ-2*(VJ<2)
1000 IF VJ>1 THEN LOCATE 31,2:PRINT HD$:LOCATE,Q2:PRINT A$;LEFT$("Decompress_"+SC$+A$,23)
1010 IF EN=1 THEN LOCATE,Q1+2-DB:FILES DV$+"*.key":POKE &HDE73,Q1:GOSUB 1050:POKE &HDE77,Q1:VJ=3:LOCATE 0,Q1-1:PRINT "WWWWKeyWWWW< ";LK$;" >" ELSE POKE &HDE77,0:POKE &HDE73,0:GOSUB 1210
1020 LOCATE 0,2:PRINT HE$:GOSUB 1040:V0=(VJ>1):V1=VJ AND 1:IF HP THEN R=0:Q=4:POKE &HDE6F,R:POKE &HDE70,Q
1030 POKE &HDE74,Q1-3:POKE &HDE75,(VJ=3)AND255:Q5=Q2-(Q2>3):POKE &HDE76,Q5:POKE &HDE72,Q5+2*(Q5<=Q1):Q=-Q*(Q<=Q1)-Q1*(Q>Q1):POKE &HDE70,Q:HP=0:GOSUB 430:RETURN
1040 DN=ASC(DV$)-64:A=3-USR5(DN): DF=DSKF(DN)A:LOCATE 23,0:PRINT USING"#### KBfree";DF:RETURN
1050 Q1=CSRLIN+(POS(X)=0):POKE &HDE71,Q1:RETURN
1060 '' File Decide
1070 IF RIGHT$(FL$,3)="KEY" THEN BEEP:BLOAD DV$+FL$:GOSUB 430:LK$=LEFT$(FL$,8):LOCATE 13,PEEK(&HDE73)+1:PRINT LK$:RETURN
1080 COLOR 0,0,0:SM$=RIGHT$(FL$,1):SM=VAL("&h"+SM$):CW=255+240*(SM<8 OR SM=10)
1090 MD=-(MID$(FL$,9,2)<>LEFT$(MD$(0),2)):SD=SM:POKE &HDE6E,3-EN+3*(EN=0)
1100 IF MD=0 THEN IF MID$(FL$,11,1)="1" THEN MD$(1)=M2$ ELSE MD$(1)=M1$
1110 F$=LEFT$(FL$,8):L$=MD$(1-MD)+SM$:FM$=F$+L$:X0=255-256*(SM=6ORSM=7):Y0=211
1120 PL!=54271!+23904*(SM<7)-9888*(SM=7 OR SM=10):PT!=PL!-31:GOSUB 860
1130 IF SM<5 THEN SM=8:PL!=14335+12288*(SD=0)+6080*(SD=3):IF MD=0 THEN SCREEN SD:COLOR C0,C1:BLOAD DV$+FL$,S:COLOR=RESTORE:A=ASC(INPUT$(1)):IF A<>13 THEN 1200
1140 SCREEN SM:SET PAGE,1:IF SM>7 THEN COLOR=NEW
1150 IF LG+OV THEN COLOR=RESTORE:SET PAGE 1 ELSEIF MD THEN A=USR7(0) ELSE CLS
1160 POKE &HDE4F,1:IF IN THEN FILES M3$:IF OV THEN COPY(0,0)-(X0,Y0),1TO(0,0),0
1170 ER=0:SET PAGE 1,1-MD:BLOAD DV$+FL$,S:ON MD+1 GOSUB 1250,1440
1180 IF MD+BK=0 AND IN THEN I0$=IN$:IN$=M3$:GOSUB 1230:IN$=I0$:GOSUB 1270
1190 IF ER THEN GOSUB 900:RETURN ELSEIF SM>7 THEN COLOR C0,C1
1200 SCREEN 0,,,,,ID:COLOR C0,C1:A=USR3(1):GOSUB 430:IF EC THEN GOSUB 1040:EC=0
1210 IF EN=2 THEN LOCATE 0,Q1+1:PRINT "WWWWPerWWWW< ";PE$;" >"
1220 RETURN
1230 COLOR,0:SCREEN SM:SET PAGE 1,1:COLOR=RESTORE:BLOAD IN$,S
1240 FL$=MID$(M3$,3):F1$=LEFT$(F1$,8)+M2$+SM$:BK=1:POKE &HDE6E,1:RETURN
1250 ''' Compress V14.2 / 3.9
1260 BK=0:COLOR=RESTORE:GOSUB 440:X1=0:Y1=0:X2=X0:Y2=Y0:TG=0:GOSUB 1960
1270 SET PAGE,0:CLS:COPY(X1,Y1)-(X2,Y2),1 TO (X1,Y1),0
1280 DS=DT+(2-DT)*(DT<2)*(SM>8):VPOKE3,64*DS+16*(BK OR 3-EN+3*(EN=0))+LG-3*(LG>4):A=&HDE00
1290 POKE A,X2 AND 255:POKE A+1,X2 256:POKE A+2,Y2
1300 POKE A+4,X1 AND 255:POKE A+5,X1 256:POKE A+6,Y1:SET PAGE 0
1310 VA=USR1(SM+256):KL$=DV$+"#":IF TF THEN KILL DV$+FL$:EC=(MD$=M1$)
1320 BSAVE KL$,0,VA-1,S:IF BK GOTO 1430
1330 SCREEN 0,,,,,ID:COLOR C0,C1
1340 PRINT" Sale Off % Matrix Encrypt Logical Pixel Version"
1350 PRINT STRING$(66,"-"):X3=X2-X1:Y3=Y2-Y1:GOSUB 1770:IF SD<5 THEN Y4=192
1360 PRINT USING"###,###-####,###(###.#) "+MID$("NorMixDitYJK",3*(DS-(SM>8))+1,3)+" "+MID$("IV KeyPer",3*EN+1,3)+" "+LG$(LG)+" ###x###"+MID$("i ",2-IN,2)+" ##.#";VA!*IP;(VA!-BM!)*IP;OF!;X4;Y4*IP;VD/10
1370 F=0:LOCATE 0,7:PRINT SPC(46):LOCATE 0,4:PRINT"File Name: ";FM$;SPC(22)
1380 IF TF=0 THEN LOCATE 3,5:PRINT"Cancel: _"
1390 LOCATE 11,4:A=USR(0):LINE INPUT F1$:F1$=LEFT$(F1$,12)
1400 IF TF=0 AND CSRLIN<>5 THEN KILL KL$:BK=1:PE$="** Break! **":RETURN
1410 IF MID$(F1$,9,1)<>"." GOTO 1370
1420 IF (F1$=FM$)*F THEN KILL DV$+F1$:EC=(MD$=M1$ OR MD$=M2$)
1430 NAME KL$ AS F1$:FM$=F1$:ER=1+EC*(1-TF):PE$=FM$:RETURN
1440 ''' Decompress V14.x - 6.x / 3.x
1450 VY=0:VE=0:GOSUB 1690
1460 IF VE THEN ER$="Version error"+LEFT$(STR$((VS+.1)/10),LEN(STR$(VS))+1)+"x":GOSUB 2380:VE=0:RETURN
1470 X1=VPEEK(0)+VPEEK(1)*256:Y1=VPEEK(2):X3=VPEEK(4)+VPEEK(5)*256:Y3=VPEEK(6)
1480 IF OV+LG=0 THEN SET PAGE,1:CLS
1490 A=USR8(0):X2=X1+X3:Y2=Y1+Y3:X0=X0-X3:Y0=Y0-Y3:RL=0:CS=0:IF OV=0 GOTO 1530
1500 TG=2:X5=X1:Y5=Y1:GOSUB 1960:IF CS=0 OR(LG>0 AND LG<>4)OR(LG=0 AND OP>0 AND OP<>4) GOTO 1520
1510 IF Y1<Y5 OR Y1>Y5+Y3 OR(X1<X5 AND Y1=<Y5)OR X1>X5+X3 OR X1+X3<X5 OR(X1=X5 AND Y1=Y5) GOTO 1580
1520 IF RL THEN GOSUB 1670 ELSE GOSUB 1680
1530 A=USR(0):VA=USR1(SM):QQ=PEEK(&HF570):PE$=FL$:A$=INKEY$:A=USR(0)
1540 IF IN=0 OR A$<>"" THEN IN=0:GOTO 1600 ELSE RL=1
1550 SET PAGE,1:BSAVE IN$,0,VA+6000,S:COPY(X1,Y1)-(X2,Y2),1 TO (X1,Y1),0
1560 SET PAGE,0:BLOAD M3$,S:GOSUB 1680:VA=USR1(SM)
1570 SET PAGE,0:BLOAD IN$,S:SCREEN,,,,,3:KILL IN$:GOTO 1600
1580 FOR I=0 TO IN:COPY(X5,Y5)-STEP(X3,Y3),1-I TO (X1,Y1),1-I:NEXT
1590 SCREEN,,,,,3*IN+ID*(1-IN)
1600 IF SD<5 THEN SET PAGE,1:BSAVE IN$,0,PL!,S:SCREEN SD:A=USR7(0):BLOAD IN$,S:COLOR=RESTORE:IF SD=0 THEN COLOR C0,C1
1610 A=USR8(0):PG=0:CM$="BbCc":IF VY+IN=0 AND SD>4 THEN GOSUB 1720:COLOR C0
1620 GOSUB 880:IF (A=32 OR A=18)AND SD>4 THEN SET PAGE PG:PG=1-PG:GOTO 1620
1630 IF A>27 AND A<32 AND SD>4 GOTO 1500 ELSEIF A=11 OR B=1 THEN GOSUB 1800
1640 IF A=127 AND SD>4 THEN SET PAGE,1:CLS:CS=0:IF IN THEN SET PAGE,0:CLS:GOTO 1500 ELSE 1500
1650 IF A=24 OR B=2 THEN GOSUB 1890
1660 RETURN
1670 SCREEN,,,,,ID:SET PAGE,0:BLOAD DV$+FL$,S
1680 SET PAGE,0:VPOKE 0,X1 AND 255:VPOKE 1,X1 256:VPOKE 2,Y1
1690 VS=VPEEK(7):VS=VS-(VS=0)*VPEEK(3):VB=VD:GOSUB 460:KL$=IN$
1700 LD=VPEEK(3):OP=LD AND15:IF LG THEN VPOKE 3,(LD AND240)+LG-(LG>4)*3
1710 ES=(LD AND 48)16:POKE &HDE6E,ES+2*(ES=3):RETURN
1720 '''' Information
1730 GOSUB 1770:VY=(VA!-7)*(1-(SM<7))/256+2:PRESET(0,VY):COLOR CW
1740 OP$=LG$(OP+3*(OP>4)):IF VY>196 THEN RETURN
1750 PRINT #1,USING"##,### ##.#%Off "+MID$("NorMixDitYJK",3*(LD64+(SM>8)*(VS>65))+1,3)+" "+MID$("IV PerKey",3*(ES+2*(ES=3))+1,3)+" "+OP$;VA!;OF!
1760 PRESET(0,VY+8):PRINT #1,USING"Ver##.# "+FL$+STR$(X4)+" x"+STR$(Y4*(IN+1));VS/10:RETURN
1770 X4=X3+1:Y4=Y3+1:BM!=(X3PEEK(&HDE2D)+1)*Y4+7-32*(SM<8)
1780 IF X4*Y4/(1-(SM=6 OR SM=7))=54272! OR SD<5 THEN BM!=PL!+8
1790 VA!=VA+7-65536!*(VA<0):OF!=100*(1-VA!/BM!):IP=IN+1:RETURN
1800 '''' Bsave
1810 BEEP:KL$=DV$+FM$:COLOR,,28+20*(CW=15):SET PAGE 1,1:IF IN=0 GOTO 1830
1820 IF SM<8 OR SM=10 THEN A$=LEFT$(IN$,3)+"2":BSAVE A$,PT!,PT!+31,S:SET PAGE 0,0:BLOAD A$,S:KILL A$ ELSE SET PAGE 0,0
1830 GOSUB 1860:BSAVE KL$,0,PL!,S:ER=1
1840 IF IN THEN KL$=DV$+F$+M0$+SM$:SET PAGE 1,1:GOSUB 1860:BSAVE KL$,0,PL!,S
1850 COLOR,,0:RETURN
1860 IF SM<8 OR SM=10 THEN A=USR4(0)
1870 IF SD<5 THEN COPY IN$ TO KL$:ER=1
1880 RETURN
1890 '''' Re-Compress
1900 IF SD<5 THEN SCREEN 8:SET PAGE,1:BLOAD IN$,S
1910 IF CS=0 THEN X0=X0+X3:Y0=Y0+Y3:TG=0:GOSUB 1960 ELSE BEEP
1920 VB=VS:GOSUB 440:VS=VB:IF IN THEN SCREEN,,,,,ID:SET PAGE,1:BSAVE IN$,0,PL!,S:COPY(X1,Y1)-(X2,Y2),0 TO (X1,Y1),1
1930 L$=MD$(1)+SM$:FM$=FL$:BK=0:EB=EN:EN=EN*-(EN<2):POKE &HDE6E,3-EN+3*(EN=0):GOSUB 1270:EN=EB:IF IN=0 THEN RETURN
1940 IF BK THEN KILL IN$ ELSE GOSUB 1230:KILL IN$:GOSUB 1270
1950 RETURN
1960 '''' Position Set
1970 IF SD<5 THEN X1=0:Y1=0:X2=255:Y2=55+48*(SD=0)+22*(SD=3):RETURN
1980 SET PAGE 1,1:X=X1:Y=Y1:COLOR CW:GOSUB 2190:G=1:G2=0
1990 F=STICK(0):IF F THEN GOSUB 2110:GOTO 1990
2000 A=USR(0):A=ASC(INPUT$(1)):G=1:G2=0
2010 IF A=27 OR A=113 OR A=8 AND(TG=0 OR TG=2) THEN BK=1:RETURN 2100
2020 IF TG<2 GOTO 2050
2030 IF A=127 THEN CLS:CS=0:IF IN THEN SET PAGE,0:CLS:SET PAGE,1:RL=1:GOSUB 2190 ELSE GOSUB 2190
2040 IF A=13 GOTO 2100 ELSE 1990
2050 IF A=8 THEN COLOR,,0:X=X1:Y=Y1:TG=0
2060 IF A=13 THEN BEEP:COLOR,,3+(SM=6):X=X2:Y=Y2:TG=TG+1
2070 IF TG<2 GOTO 1990
2080 IF X1>X2 THEN SWAP X1,X2
2090 IF Y1>Y2 THEN SWAP Y1,Y2
2100 GOSUB 2190:COLOR,,0:RETURN
2110 ''''' Frame
2120 X=X+G*FX(F):Y=Y+G*FY(F)
2130 IF X<0 THEN X=0 ELSEIF X>X0 THEN X=X0
2140 IF Y<0 THEN Y=0 ELSEIF Y>Y0 THEN Y=Y0
2150 ON TG GOTO 2160,2170:X1=X:Y1=Y:GOTO 2180
2160 X2=X:Y2=Y:GOTO 2180
2170 X1=X:Y1=Y:X2=X+X3:Y2=Y+Y3
2180 LINE(B,C)-(D,E),,B,XOR:GOSUB 2190:G=G*(1-(G<10)+(G2=0)):G2=1:RETURN
2190 LINE(X1,Y1)-(X2,Y2),,B,XOR:B=X1:C=Y1: D=X2:E=Y2:RETURN
2200 ' Error
2210 IF ERL=110 AND ERR<>75 THEN DV$(1)="B:":DB=0:IN$="A:#1":RESUME NEXT
2220 IF ERL=120 THEN IF ERR=53 THEN RESUME NEXT ELSEIF ERR=2 THEN BLOAD LK$:RESUME 140
2230 IF (ERL=1140 OR ERL=1230)AND SM>8 THEN SCREEN 8:RESUME NEXT
2240 IF ERL=470 AND MP<>1 THEN VE=1:VD=VB:ML=ML*(1+(B=7)):RESUME 1660
2250 IF ERR=66 AND ERL=700 AND FS AND INSTR(KL$,"*")=0 AND INSTR(KL$,"?")=0 THEN KILL KL$
2260 IF ERL=70 OR ERL=110 OR ERL=580 OR ERL=590 OR ERL=640 OR ERL=650 OR ERL=700 OR ERL=710 OR ERL=770 OR ERL=780 OR ERL=1040 OR ERL=1820 OR ERL=1940 THEN RESUME NEXT
2270 IF ERL=950 THEN RESUME 960 ELSEIF ERL=700 THEN FS=0:RESUME NEXT
2280 IF ERL=960 THEN IF VJ THEN RESUME NEXT ELSE RESUME 980
2290 IF ERL=980 THEN HP=1:IF IL THEN RESUME 1010 ELSE RESUME 990
2300 IF ERL=990 THEN RESUME 1000 ELSEIF ERL=1010 THEN POKE &HDE77,0:POKE &HDE73,0:RESUME 1020
2310 IF ERL=1160 THEN IN=0:POKE &HDE4F,0:RESUME 1170
2320 IF ERL=1140 OR ERL=1170 THEN ER=1:HP=1: DF=-1:SC$="":RESUME 1190
2330 IF ERL=1430 THEN IF ERR=56 THEN RESUME 1370 ELSEIF BK THEN KILL DV$+F1$:RESUME ELSE BEEP:LOCATE 0,7:PRINT"(!) File already exists. Replace ?":F=1:FM$=F1$:RESUME 1380
2340 IF ERR=66 AND(ERL=1320 OR ERL=1550 OR ERL=1600 OR ERL=1830 OR ERL=1840 OR ERL=1870 OR ERL=1920) THEN ER$=" Poor disk spaces in "+LEFT$(KL$,2)+"('c`)~":KILL KL$:BK=1:GOSUB 2380:RESUME 1660
2350 IF ERL=360 THEN IF ERR=2 OR ERR=65 THEN RESUME NEXT ELSE RESUME 370
2360 IF ERL=1130 THEN RESUME 1200 ELSEIF ERL=1810 THEN RESUME 1870
2370 CLS:GOTO 370
2380 '' Message
2390 IF SD<5 THEN SCREEN 8:SET PAGE,1:CLS:CW=255
2400 SCREEN,,,,,ID:SET PAGE 1,1-MD:CLS:SET PAGE 1-MD:COLOR=NEW
2410 COLOR CW,0:PRESET(128-128*(SM=6 OR SM=7)-4*LEN(ER$),80)
2420 A=USR8(0):PRINT #1,ER$:BEEP:A=USR(0):A$=INPUT$(1):RETURN
20 ' Initialize
30 KEYOFF:CLEAR 777,&HCE85:MAXFILES=1:OPEN "GRP:" AS #1:VDP(9)=10:POKE &HF346,1
40 DEFINT A-Z: DIM FX(8),FY(8),ML(1),LK(63),LG$(9),ML$(1),DV$(1),MD$(1)
50 DEFUSR=342: DEFUSR7=65: DEFUSR8=68:ID=(PEEK(&HFFE8)AND8)8:A=RND(-TIME)
60 DEFUSR6=&HDCB4: DEFUSR5=&HDD1E: DEFUSR4=&HDD28: DEFUSR2=&HDD3D: DEFUSR3=&HDD99
70 ON ERROR GOTO 2200:_ANK: DB=1:IL=1:C0=PEEK(&HF3E9):C1=PEEK(&HF3EA)
80 ML$(0)="BN142BN39 BN135BN124BN116BN108BN96 BN89 BN79 BN69":IN$="H:#1"
90 ML$(1)="ce86 d15e ce71 cebc cee8 cf69 cf4b cf8f cfd9 d199":FL$=SPACE$(12)
100 DV$(0)="A:":DV$(1)="H:":DC$="ABH":DL=LEN(DC$):VD=VAL(MID$(ML$(0),3,3))
110 MD$(0)=".SC":M0$=".S1":M1$=".BN":M2$=".B1":VL=VD:AD=&HDDC0:_RAMDISK(4000)
120 LK$="Lock.key":NAME LK$:CLS:PRINT LK$;" Initializing":PRINT:FOR I=0 TO 63
130 A=RND(1)*256:FOR J=0 TO I:IF A=LK(J) THEN J=I:NEXT:GOTO 130 ELSE NEXT:LK(I)=A:PRINT A;:POKE AD+I,A:NEXT:BSAVE LK$,AD,AD+63
140 FOR I=0 TO 4:READ LG$:LG$(I)=LG$+" ":LG$(I+5)="T"+LG$:NEXT:GOSUB 440
150 FOR I=1 TO 8:READ FX(I):FY((I+1)MOD8+1)=FX(I):NEXT:LK$="LOCK ":GOSUB 520
160 DATA PSET ,AND ,OR ,XOR ,PRESET,0,1,1,1,0,-1,-1,-1
170 ' Main
180 A=USR(0):LOCATE 10,0:PRINT USING"##.#";VD/10
190 LOCATE 0,1:PRINT MID$(" ._",DT+1,1);TAB(7);MID$(" _",TF+1,1);TAB(13);MID$(" ._",EN+1,1);TAB(21);MID$(" _",IL+1,1)
200 LOCATE 57,Q2:PRINT"/ Logical( ";LG$(LG);" )"
210 IF V0 THEN LOCATE 31,1:PRINT MID$(" _",OV+1,1)
220 A$=INKEY$:IFA$=""GOTO220ELSEA=ASC(A$):IF27<AANDA<32THENGOSUB400:GOTO220
230 CM$="OoTtRrCcMmQqVvIiDdLlEe":GOSUB 890
240 IF A=13THEN LOCATE R,Q:PRINT FL$:A=USR3(0):GOSUB 1060:GOTO 180
250 IF A=9 THEN GOSUB 490:GOTO 220
260 IF B=9 THEN BEEP: DT=DT+1: DT=DT MOD 3:GOTO 190
270 IF B=11THEN EN=EN+1:EN=EN MOD 3:GOSUB 900:GOTO 180
280 IF B=10THEN LG=(LG+2*CS-1)MOD 10+10*(LG=0)*(CS=0):GOTO 190
290 IF B=2 THEN BEEP:TF=1-TF:GOTO 190 ELSEIF B=4 THEN GOSUB 670:GOTO 200
300 IF B=1 AND V0 THEN BEEP:OV=1-OV:GOTO 210 ELSEIF B=5 THEN GOSUB 810
310 IF B=8 THEN IL=1-IL:GOSUB 900 ELSEIF B=3 THEN GOSUB 550
320 IF B=7 THEN BEEP:ML=5-ML:VB=VD:VD=VAL(MID$(ML$(0),ML+3,3)):GOSUB 440
330 IF A=8 THEN DV=1-DV:GOSUB 520 ELSEIF A=127 THEN GOSUB 610
340 IF A=42 OR 52<A AND A<57 THEN SC$=A$:GOSUB 900
350 IF 47<A AND A<51 THEN SC$=HEX$(A-38):GOSUB 900 ELSEIF B=6 GOTO 370
360 IF A=27THEN NAME "a:msxdos*.sys":GOSUB 380:_SYSTEM:ELSE 180
370 GOSUB 380:COLOR C0,C1:ON ERROR GOTO 0:VDP(9)=8:KEY ON:END
380 LOCATE 0,Q1+1:PRINT:RETURN
390 '' Cursol Move
400 LOCATER,Q:PRINTFL$;:IF(PEEK(&HFBEB)AND1)ORMID$(FL$,9,1)=" "GOTO420
410 IS=VPEEK(R+12+80*Q):IFIS=32THENBEEP:PRINT"!":SH=SH+1ELSEIFIS=33THENPRINT" ":SH=SH-1
420 Q=USR6(A):R=PEEK(&HDE6F)
430 LOCATER,Q:FL$=USR2(FL$):RETURN
440 '' Version Change
450 VS=VD
460 MP=INSTR(ML$(0),"BN"+MID$(STR$(VS),2,LEN(STR$(VS))-2+(VS>VL)*(VS10=VL10))):IF MP=MB THEN RETURN
470 BLOAD "A:"+MID$(ML$(0),MP,5)+".BIN"
480 DEFUSR1=VAL("&h"+MID$(ML$(1),MP,4)):MB=MP:RETURN
490 '' Device Change
500 D1=(D1+1)MOD DL:D1=(D1-(D0=D1))MOD DL: DV$(1-DV)=MID$(DC$,D1+1,1)+":"
510 BEEP:LOCATE 41,0:PRINT DV$(1-DV): DF=-1:RETURN
520 '' Drive Change
530 D0=INSTR(DC$,LEFT$(DV$(DV),1))-1:D1=INSTR(DC$,LEFT$(DV$(1-DV),1))-1
540 DV$=DV$(DV):SC$="":DF=-1:HP=1:GOSUB 900:RETURN
550 '' File Rename
560 LOCATE 61,0:PRINT"[Renam]":LOCATE R,Q:PRINT FL$:LOCATE R,Q:LINEINPUT RN$
570 RN$=LEFT$(RN$,12):IF CSRLIN-1<>Q OR(INSTR(RN$,".")<>9 AND INSTR(RN$,"*")=0) THEN LOCATE R,Q:PRINT FL$:GOTO 600
580 COLOR=(C0,1,7,1):NAME DV$+FL$ AS RN$:GOSUB 860
590 IF IN THEN NAME M3$ AS LEFT$(RN$,10)+"1"+MID$(RN$,12)
600 COLOR:LOCATE 61,0:PRINT" Renam ":GOSUB 430:RETURN
610 '' File Delete
620 LOCATE 56,0:PRINT"[DEL]":GOSUB 840:IF A=127 THEN GOSUB 640
630 LOCATE 56,0:PRINT" DEL ":RETURN
640 IF FS THEN COLOR=(C0,7,1,1):GOSUB 730:KILL DV$+FL$ ELSE 630
650 IF IN THEN KILL M3$
660 GOSUB 900:RETURN
670 '' File Copy
680 LOCATE 44,0:PRINT"[Copy]":GOSUB 840:IF B=1 THEN GOSUB 700
690 LOCATE 44,0:PRINT" Copy ":RETURN
700 IF FS THEN COLOR=(C0,1,7,7):GOSUB 730:COPY DV$+FL$ TO DV$(1-DV) ELSE 690
710 IF IN THEN COPY M3$ TO DV$(1-DV)
720 IF B=1 THEN SH=0:COLOR:RETURN ELSE RETURN
730 IF SH=0 THEN RETURN ELSE LOCATE R,Q:PRINT FL$
740 FOR I=0 TO (Q1-3)*6-1:LX=(IMOD6)*13:LY=I6+4
750 IF VPEEK(LX+12+80*LY)<>33 THEN 800
760 A$="":FOR J=0 TO 11:A$=A$+CHR$(VPEEK(LX+J+80*LY)):NEXT:B$=DV$+LEFT$(A$,10)+"1"+RIGHT$(A$,1)
770 IF A=127 THEN KILL DV$+A$:IF IL THEN KILL B$
780 IF A<>127 THEN COPY DV$+A$ TO DV$(1-DV):IF IL THEN COPY B$ TO DV$(1-DV)
790 IF A=127 OR B=1 THEN LOCATE LX+12,LY:PRINT" "
800 NEXT:IF A=127 THEN RETURN 660 ELSE GOSUB 430:RETURN 720
810 '' File Move
820 LOCATE 50,0:PRINT"[Move]":GOSUB 840:IF B=2 THEN GOSUB 700:A=127:GOSUB 640
830 LOCATE 50,0:PRINT" Move ":RETURN
840 ''' Command
850 FS=(LEFT$(FL$,1)<>" ")OR SH:KL$=DV$(1-DV)+FL$:CM$="CcMm":GOSUB 880
860 MD$=MID$(FL$,9,3):MK$=MID$(" "+M0$+M2$,INSTR(MD$(0)+M1$,MD$)+1,3)
870 M3$=DV$+LEFT$(FL$,8)+MK$+MID$(FL$,12):IN=IL AND(MK$<>" .S"):RETURN
880 A$=INKEY$:IF A$="" GOTO 880 ELSE A=ASC(A$)
890 CS=PEEK(&HFBEB)AND 1:B=(INSTR(CM$,A$)+1)2:RETURN
900 '' Main Screen
910 SCREEN 0,,,,,ID:WIDTH 80:COLOR C0,C1:Q1=4:POKE &HDE71,4:Q2=3:VJ=0:EC=0:SH=0
920 HE$="Dither Trans Encrypt Interlace":A$=STRING$(34,"_")
930 HD$="Overld(re-Compress_SEL,Infor_SPACE,Bsave_HOME)"
940 PRINT"=BARGAIN V14.23= BS>";DV$;TAB(37);"TAB>";DV$(1-DV);TAB(45);"Copy Move DEL Renam Quit/ESC"
950 LOCATE,4-DB:FILES DV$+"*"+MD$(0)+"*":GOSUB 1050:Q2=Q1+1:VJ=1
960 IF IL=0 THEN FILES DV$+"*"+M0$+"*":GOSUB 1050:Q2=Q1+1:VJ=1
970 IF VJ THEN LOCATE 0,3:PRINT A$;LEFT$("Compress__"+A$,43)
980 LOCATE,Q2+1-DB:FILES DV$+"*"+M1$+SC$+"*":GOSUB 1050:VJ=VJ+2
990 IF IL=0 THEN FILES DV$+"*"+M2$+SC$+"*":GOSUB 1050:VJ=VJ-2*(VJ<2)
1000 IF VJ>1 THEN LOCATE 31,2:PRINT HD$:LOCATE,Q2:PRINT A$;LEFT$("Decompress_"+SC$+A$,23)
1010 IF EN=1 THEN LOCATE,Q1+2-DB:FILES DV$+"*.key":POKE &HDE73,Q1:GOSUB 1050:POKE &HDE77,Q1:VJ=3:LOCATE 0,Q1-1:PRINT "WWWWKeyWWWW< ";LK$;" >" ELSE POKE &HDE77,0:POKE &HDE73,0:GOSUB 1210
1020 LOCATE 0,2:PRINT HE$:GOSUB 1040:V0=(VJ>1):V1=VJ AND 1:IF HP THEN R=0:Q=4:POKE &HDE6F,R:POKE &HDE70,Q
1030 POKE &HDE74,Q1-3:POKE &HDE75,(VJ=3)AND255:Q5=Q2-(Q2>3):POKE &HDE76,Q5:POKE &HDE72,Q5+2*(Q5<=Q1):Q=-Q*(Q<=Q1)-Q1*(Q>Q1):POKE &HDE70,Q:HP=0:GOSUB 430:RETURN
1040 DN=ASC(DV$)-64:A=3-USR5(DN): DF=DSKF(DN)A:LOCATE 23,0:PRINT USING"#### KBfree";DF:RETURN
1050 Q1=CSRLIN+(POS(X)=0):POKE &HDE71,Q1:RETURN
1060 '' File Decide
1070 IF RIGHT$(FL$,3)="KEY" THEN BEEP:BLOAD DV$+FL$:GOSUB 430:LK$=LEFT$(FL$,8):LOCATE 13,PEEK(&HDE73)+1:PRINT LK$:RETURN
1080 COLOR 0,0,0:SM$=RIGHT$(FL$,1):SM=VAL("&h"+SM$):CW=255+240*(SM<8 OR SM=10)
1090 MD=-(MID$(FL$,9,2)<>LEFT$(MD$(0),2)):SD=SM:POKE &HDE6E,3-EN+3*(EN=0)
1100 IF MD=0 THEN IF MID$(FL$,11,1)="1" THEN MD$(1)=M2$ ELSE MD$(1)=M1$
1110 F$=LEFT$(FL$,8):L$=MD$(1-MD)+SM$:FM$=F$+L$:X0=255-256*(SM=6ORSM=7):Y0=211
1120 PL!=54271!+23904*(SM<7)-9888*(SM=7 OR SM=10):PT!=PL!-31:GOSUB 860
1130 IF SM<5 THEN SM=8:PL!=14335+12288*(SD=0)+6080*(SD=3):IF MD=0 THEN SCREEN SD:COLOR C0,C1:BLOAD DV$+FL$,S:COLOR=RESTORE:A=ASC(INPUT$(1)):IF A<>13 THEN 1200
1140 SCREEN SM:SET PAGE,1:IF SM>7 THEN COLOR=NEW
1150 IF LG+OV THEN COLOR=RESTORE:SET PAGE 1 ELSEIF MD THEN A=USR7(0) ELSE CLS
1160 POKE &HDE4F,1:IF IN THEN FILES M3$:IF OV THEN COPY(0,0)-(X0,Y0),1TO(0,0),0
1170 ER=0:SET PAGE 1,1-MD:BLOAD DV$+FL$,S:ON MD+1 GOSUB 1250,1440
1180 IF MD+BK=0 AND IN THEN I0$=IN$:IN$=M3$:GOSUB 1230:IN$=I0$:GOSUB 1270
1190 IF ER THEN GOSUB 900:RETURN ELSEIF SM>7 THEN COLOR C0,C1
1200 SCREEN 0,,,,,ID:COLOR C0,C1:A=USR3(1):GOSUB 430:IF EC THEN GOSUB 1040:EC=0
1210 IF EN=2 THEN LOCATE 0,Q1+1:PRINT "WWWWPerWWWW< ";PE$;" >"
1220 RETURN
1230 COLOR,0:SCREEN SM:SET PAGE 1,1:COLOR=RESTORE:BLOAD IN$,S
1240 FL$=MID$(M3$,3):F1$=LEFT$(F1$,8)+M2$+SM$:BK=1:POKE &HDE6E,1:RETURN
1250 ''' Compress V14.2 / 3.9
1260 BK=0:COLOR=RESTORE:GOSUB 440:X1=0:Y1=0:X2=X0:Y2=Y0:TG=0:GOSUB 1960
1270 SET PAGE,0:CLS:COPY(X1,Y1)-(X2,Y2),1 TO (X1,Y1),0
1280 DS=DT+(2-DT)*(DT<2)*(SM>8):VPOKE3,64*DS+16*(BK OR 3-EN+3*(EN=0))+LG-3*(LG>4):A=&HDE00
1290 POKE A,X2 AND 255:POKE A+1,X2 256:POKE A+2,Y2
1300 POKE A+4,X1 AND 255:POKE A+5,X1 256:POKE A+6,Y1:SET PAGE 0
1310 VA=USR1(SM+256):KL$=DV$+"#":IF TF THEN KILL DV$+FL$:EC=(MD$=M1$)
1320 BSAVE KL$,0,VA-1,S:IF BK GOTO 1430
1330 SCREEN 0,,,,,ID:COLOR C0,C1
1340 PRINT" Sale Off % Matrix Encrypt Logical Pixel Version"
1350 PRINT STRING$(66,"-"):X3=X2-X1:Y3=Y2-Y1:GOSUB 1770:IF SD<5 THEN Y4=192
1360 PRINT USING"###,###-####,###(###.#) "+MID$("NorMixDitYJK",3*(DS-(SM>8))+1,3)+" "+MID$("IV KeyPer",3*EN+1,3)+" "+LG$(LG)+" ###x###"+MID$("i ",2-IN,2)+" ##.#";VA!*IP;(VA!-BM!)*IP;OF!;X4;Y4*IP;VD/10
1370 F=0:LOCATE 0,7:PRINT SPC(46):LOCATE 0,4:PRINT"File Name: ";FM$;SPC(22)
1380 IF TF=0 THEN LOCATE 3,5:PRINT"Cancel: _"
1390 LOCATE 11,4:A=USR(0):LINE INPUT F1$:F1$=LEFT$(F1$,12)
1400 IF TF=0 AND CSRLIN<>5 THEN KILL KL$:BK=1:PE$="** Break! **":RETURN
1410 IF MID$(F1$,9,1)<>"." GOTO 1370
1420 IF (F1$=FM$)*F THEN KILL DV$+F1$:EC=(MD$=M1$ OR MD$=M2$)
1430 NAME KL$ AS F1$:FM$=F1$:ER=1+EC*(1-TF):PE$=FM$:RETURN
1440 ''' Decompress V14.x - 6.x / 3.x
1450 VY=0:VE=0:GOSUB 1690
1460 IF VE THEN ER$="Version error"+LEFT$(STR$((VS+.1)/10),LEN(STR$(VS))+1)+"x":GOSUB 2380:VE=0:RETURN
1470 X1=VPEEK(0)+VPEEK(1)*256:Y1=VPEEK(2):X3=VPEEK(4)+VPEEK(5)*256:Y3=VPEEK(6)
1480 IF OV+LG=0 THEN SET PAGE,1:CLS
1490 A=USR8(0):X2=X1+X3:Y2=Y1+Y3:X0=X0-X3:Y0=Y0-Y3:RL=0:CS=0:IF OV=0 GOTO 1530
1500 TG=2:X5=X1:Y5=Y1:GOSUB 1960:IF CS=0 OR(LG>0 AND LG<>4)OR(LG=0 AND OP>0 AND OP<>4) GOTO 1520
1510 IF Y1<Y5 OR Y1>Y5+Y3 OR(X1<X5 AND Y1=<Y5)OR X1>X5+X3 OR X1+X3<X5 OR(X1=X5 AND Y1=Y5) GOTO 1580
1520 IF RL THEN GOSUB 1670 ELSE GOSUB 1680
1530 A=USR(0):VA=USR1(SM):QQ=PEEK(&HF570):PE$=FL$:A$=INKEY$:A=USR(0)
1540 IF IN=0 OR A$<>"" THEN IN=0:GOTO 1600 ELSE RL=1
1550 SET PAGE,1:BSAVE IN$,0,VA+6000,S:COPY(X1,Y1)-(X2,Y2),1 TO (X1,Y1),0
1560 SET PAGE,0:BLOAD M3$,S:GOSUB 1680:VA=USR1(SM)
1570 SET PAGE,0:BLOAD IN$,S:SCREEN,,,,,3:KILL IN$:GOTO 1600
1580 FOR I=0 TO IN:COPY(X5,Y5)-STEP(X3,Y3),1-I TO (X1,Y1),1-I:NEXT
1590 SCREEN,,,,,3*IN+ID*(1-IN)
1600 IF SD<5 THEN SET PAGE,1:BSAVE IN$,0,PL!,S:SCREEN SD:A=USR7(0):BLOAD IN$,S:COLOR=RESTORE:IF SD=0 THEN COLOR C0,C1
1610 A=USR8(0):PG=0:CM$="BbCc":IF VY+IN=0 AND SD>4 THEN GOSUB 1720:COLOR C0
1620 GOSUB 880:IF (A=32 OR A=18)AND SD>4 THEN SET PAGE PG:PG=1-PG:GOTO 1620
1630 IF A>27 AND A<32 AND SD>4 GOTO 1500 ELSEIF A=11 OR B=1 THEN GOSUB 1800
1640 IF A=127 AND SD>4 THEN SET PAGE,1:CLS:CS=0:IF IN THEN SET PAGE,0:CLS:GOTO 1500 ELSE 1500
1650 IF A=24 OR B=2 THEN GOSUB 1890
1660 RETURN
1670 SCREEN,,,,,ID:SET PAGE,0:BLOAD DV$+FL$,S
1680 SET PAGE,0:VPOKE 0,X1 AND 255:VPOKE 1,X1 256:VPOKE 2,Y1
1690 VS=VPEEK(7):VS=VS-(VS=0)*VPEEK(3):VB=VD:GOSUB 460:KL$=IN$
1700 LD=VPEEK(3):OP=LD AND15:IF LG THEN VPOKE 3,(LD AND240)+LG-(LG>4)*3
1710 ES=(LD AND 48)16:POKE &HDE6E,ES+2*(ES=3):RETURN
1720 '''' Information
1730 GOSUB 1770:VY=(VA!-7)*(1-(SM<7))/256+2:PRESET(0,VY):COLOR CW
1740 OP$=LG$(OP+3*(OP>4)):IF VY>196 THEN RETURN
1750 PRINT #1,USING"##,### ##.#%Off "+MID$("NorMixDitYJK",3*(LD64+(SM>8)*(VS>65))+1,3)+" "+MID$("IV PerKey",3*(ES+2*(ES=3))+1,3)+" "+OP$;VA!;OF!
1760 PRESET(0,VY+8):PRINT #1,USING"Ver##.# "+FL$+STR$(X4)+" x"+STR$(Y4*(IN+1));VS/10:RETURN
1770 X4=X3+1:Y4=Y3+1:BM!=(X3PEEK(&HDE2D)+1)*Y4+7-32*(SM<8)
1780 IF X4*Y4/(1-(SM=6 OR SM=7))=54272! OR SD<5 THEN BM!=PL!+8
1790 VA!=VA+7-65536!*(VA<0):OF!=100*(1-VA!/BM!):IP=IN+1:RETURN
1800 '''' Bsave
1810 BEEP:KL$=DV$+FM$:COLOR,,28+20*(CW=15):SET PAGE 1,1:IF IN=0 GOTO 1830
1820 IF SM<8 OR SM=10 THEN A$=LEFT$(IN$,3)+"2":BSAVE A$,PT!,PT!+31,S:SET PAGE 0,0:BLOAD A$,S:KILL A$ ELSE SET PAGE 0,0
1830 GOSUB 1860:BSAVE KL$,0,PL!,S:ER=1
1840 IF IN THEN KL$=DV$+F$+M0$+SM$:SET PAGE 1,1:GOSUB 1860:BSAVE KL$,0,PL!,S
1850 COLOR,,0:RETURN
1860 IF SM<8 OR SM=10 THEN A=USR4(0)
1870 IF SD<5 THEN COPY IN$ TO KL$:ER=1
1880 RETURN
1890 '''' Re-Compress
1900 IF SD<5 THEN SCREEN 8:SET PAGE,1:BLOAD IN$,S
1910 IF CS=0 THEN X0=X0+X3:Y0=Y0+Y3:TG=0:GOSUB 1960 ELSE BEEP
1920 VB=VS:GOSUB 440:VS=VB:IF IN THEN SCREEN,,,,,ID:SET PAGE,1:BSAVE IN$,0,PL!,S:COPY(X1,Y1)-(X2,Y2),0 TO (X1,Y1),1
1930 L$=MD$(1)+SM$:FM$=FL$:BK=0:EB=EN:EN=EN*-(EN<2):POKE &HDE6E,3-EN+3*(EN=0):GOSUB 1270:EN=EB:IF IN=0 THEN RETURN
1940 IF BK THEN KILL IN$ ELSE GOSUB 1230:KILL IN$:GOSUB 1270
1950 RETURN
1960 '''' Position Set
1970 IF SD<5 THEN X1=0:Y1=0:X2=255:Y2=55+48*(SD=0)+22*(SD=3):RETURN
1980 SET PAGE 1,1:X=X1:Y=Y1:COLOR CW:GOSUB 2190:G=1:G2=0
1990 F=STICK(0):IF F THEN GOSUB 2110:GOTO 1990
2000 A=USR(0):A=ASC(INPUT$(1)):G=1:G2=0
2010 IF A=27 OR A=113 OR A=8 AND(TG=0 OR TG=2) THEN BK=1:RETURN 2100
2020 IF TG<2 GOTO 2050
2030 IF A=127 THEN CLS:CS=0:IF IN THEN SET PAGE,0:CLS:SET PAGE,1:RL=1:GOSUB 2190 ELSE GOSUB 2190
2040 IF A=13 GOTO 2100 ELSE 1990
2050 IF A=8 THEN COLOR,,0:X=X1:Y=Y1:TG=0
2060 IF A=13 THEN BEEP:COLOR,,3+(SM=6):X=X2:Y=Y2:TG=TG+1
2070 IF TG<2 GOTO 1990
2080 IF X1>X2 THEN SWAP X1,X2
2090 IF Y1>Y2 THEN SWAP Y1,Y2
2100 GOSUB 2190:COLOR,,0:RETURN
2110 ''''' Frame
2120 X=X+G*FX(F):Y=Y+G*FY(F)
2130 IF X<0 THEN X=0 ELSEIF X>X0 THEN X=X0
2140 IF Y<0 THEN Y=0 ELSEIF Y>Y0 THEN Y=Y0
2150 ON TG GOTO 2160,2170:X1=X:Y1=Y:GOTO 2180
2160 X2=X:Y2=Y:GOTO 2180
2170 X1=X:Y1=Y:X2=X+X3:Y2=Y+Y3
2180 LINE(B,C)-(D,E),,B,XOR:GOSUB 2190:G=G*(1-(G<10)+(G2=0)):G2=1:RETURN
2190 LINE(X1,Y1)-(X2,Y2),,B,XOR:B=X1:C=Y1: D=X2:E=Y2:RETURN
2200 ' Error
2210 IF ERL=110 AND ERR<>75 THEN DV$(1)="B:":DB=0:IN$="A:#1":RESUME NEXT
2220 IF ERL=120 THEN IF ERR=53 THEN RESUME NEXT ELSEIF ERR=2 THEN BLOAD LK$:RESUME 140
2230 IF (ERL=1140 OR ERL=1230)AND SM>8 THEN SCREEN 8:RESUME NEXT
2240 IF ERL=470 AND MP<>1 THEN VE=1:VD=VB:ML=ML*(1+(B=7)):RESUME 1660
2250 IF ERR=66 AND ERL=700 AND FS AND INSTR(KL$,"*")=0 AND INSTR(KL$,"?")=0 THEN KILL KL$
2260 IF ERL=70 OR ERL=110 OR ERL=580 OR ERL=590 OR ERL=640 OR ERL=650 OR ERL=700 OR ERL=710 OR ERL=770 OR ERL=780 OR ERL=1040 OR ERL=1820 OR ERL=1940 THEN RESUME NEXT
2270 IF ERL=950 THEN RESUME 960 ELSEIF ERL=700 THEN FS=0:RESUME NEXT
2280 IF ERL=960 THEN IF VJ THEN RESUME NEXT ELSE RESUME 980
2290 IF ERL=980 THEN HP=1:IF IL THEN RESUME 1010 ELSE RESUME 990
2300 IF ERL=990 THEN RESUME 1000 ELSEIF ERL=1010 THEN POKE &HDE77,0:POKE &HDE73,0:RESUME 1020
2310 IF ERL=1160 THEN IN=0:POKE &HDE4F,0:RESUME 1170
2320 IF ERL=1140 OR ERL=1170 THEN ER=1:HP=1: DF=-1:SC$="":RESUME 1190
2330 IF ERL=1430 THEN IF ERR=56 THEN RESUME 1370 ELSEIF BK THEN KILL DV$+F1$:RESUME ELSE BEEP:LOCATE 0,7:PRINT"(!) File already exists. Replace ?":F=1:FM$=F1$:RESUME 1380
2340 IF ERR=66 AND(ERL=1320 OR ERL=1550 OR ERL=1600 OR ERL=1830 OR ERL=1840 OR ERL=1870 OR ERL=1920) THEN ER$=" Poor disk spaces in "+LEFT$(KL$,2)+"('c`)~":KILL KL$:BK=1:GOSUB 2380:RESUME 1660
2350 IF ERL=360 THEN IF ERR=2 OR ERR=65 THEN RESUME NEXT ELSE RESUME 370
2360 IF ERL=1130 THEN RESUME 1200 ELSEIF ERL=1810 THEN RESUME 1870
2370 CLS:GOTO 370
2380 '' Message
2390 IF SD<5 THEN SCREEN 8:SET PAGE,1:CLS:CW=255
2400 SCREEN,,,,,ID:SET PAGE 1,1-MD:CLS:SET PAGE 1-MD:COLOR=NEW
2410 COLOR CW,0:PRESET(128-128*(SM=6 OR SM=7)-4*LEN(ER$),80)
2420 A=USR8(0):PRINT #1,ER$:BEEP:A=USR(0):A$=INPUT$(1):RETURN
Visiteur
Vagabond
Message : 0
MSXlegend :
c'est bien ce que j'ai dit, quand j'ai vu la taille du listing, je me suis sauvé
Il faudrait aussi compresser le listing
Il faudrait aussi compresser le listing
Non, là tu regardes l'utilitaire basic qui permet de lister les fichiers sur la disquette, de compresser ou décompresser les images. Dans l'exemple de mise en oeuvre il faut regarder AFFICHE.BAS qui fait 11 lignes de commandes !
soit :
Code TEXT :
100 ' Example for MSX2 BASIC 110 ' 120 ' Initialization 130 CLEAR 200,&HD513 140 DEFINT A-Z 150 DEFUSR=&HD514 160 BLOAD "BARGAIN.BIN" 170 SM=8 :SCREEN SM 180 SET PAGE 1,0 190 BLOAD "KINCHOU.BN8",S 200 POKE &HDE6E,(VPEEK(3)AND16)16 210 VA=USR(SM) 220 A$=INPUT$(1) 230 END
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie