#11 Article 272 Posted at 1987/08/17 06:39:16 by W.M. (MAP009) [PRG.WML]
Subject: WMLOADER in F-BASIC
10 '
20 ' W.M. LOADER (All BASIC ﾊﾞﾝ) : "WMLOADB"
30 '
40 ' Original ﾊﾌﾏﾝ code ﾆ ﾖﾙ､ ﾖｺ640 dot ﾉ ｶﾞｿﾞｳ ﾃﾝｶｲ
50 '
60 ' COPYRIGHT (C) 1987 by W.M.
70 '
100 CLEAR 1000,&H5FFF
110 DEFINT A-Z:DIM HC$(74),GD(40)
120 YMAX=199
130 FOR I=0 TO 74:READ HC$(I):NEXT
140 '
150 LINEINPUT "Input filename: ",F$
160 IF F$="" THEN 290 ELSE OPEN "I",#1,F$
170 '
180 CLS
190 C=1:GOSUB 660
200 FOR Y=0 TO YMAX:GOSUB 330:NEXT
210 C=2:GOSUB 660
220 FOR Y=0 TO YMAX:GOSUB 330:NEXT
230 C=4:GOSUB 660
240 FOR Y=0 TO YMAX:GOSUB 330:NEXT
250 '
260 CLOSE
270 WHILE INKEY$="":WEND
280 '
290 END
300 '
310 ' draw 1 line
320 '
330 PACKTYPE=0
340 GOSUB 710:IF FGETBD$="1" THEN PACKTYPE=PACKTYPE+4
350 GOSUB 710:IF FGETBD$="1" THEN PACKTYPE=PACKTYPE+2
360 GOSUB 710:IF FGETBD$="1" THEN PACKTYPE=PACKTYPE+1
370 '
380 X=0:FLAGDOT=0
390 WHILE X<640
400 GOSUB 970
410 IF RL=0 THEN 430
420 IF FLAGDOT THEN LINE(X,Y)-(X+RL-1,Y),OR,C
430 FLAGDOT=-1-FLAGDOT:X=X+RL
440 WEND
450 '
460 ON PACKTYPE+1 GOTO 470,480,490,500,510,520,530,540
470 GOTO 550
480 YG=Y-1:XG0=0:XG1=639:GOSUB 590:PUT@(0,Y)-(639,Y),GD,XOR,C:GOTO 550
490 YG=Y-2:XG0=0:XG1=639:GOSUB 590:PUT@(0,Y)-(639,Y),GD,XOR,C:GOTO 550
500 YG=Y-3:XG0=0:XG1=639:GOSUB 590:PUT@(0,Y)-(639,Y),GD,XOR,C:GOTO 550
510 YG=Y-4:XG0=0:XG1=639:GOSUB 590:PUT@(0,Y)-(639,Y),GD,XOR,C:GOTO 550
520 YG=Y-1:XG0=0:XG1=638:GOSUB 590:PUT@(1,Y)-(639,Y),GD,XOR,C:GOTO 550
530 YG=Y-1:XG0=0:XG1=637:GOSUB 590:PUT@(2,Y)-(639,Y),GD,XOR,C:GOTO 550
540 YG=Y-1:XG0=1:XG1=639:GOSUB 590:PUT@(0,Y)-(638,Y),GD,XOR,C:GOTO 550
550 RETURN
560 '
570 ' GET@
580 '
590 IF C=1 THEN GET@(XG0,YG)-(XG1,YG),GD,G,1,3,5,7:GOTO 620
600 IF C=2 THEN GET@(XG0,YG)-(XG1,YG),GD,G,2,3,6,7:GOTO 620
610 IF C=4 THEN GET@(XG0,YG)-(XG1,YG),GD,G,4,5,6,7:GOTO 620
620 RETURN
630 '
640 ' initialize for 1 screen
650 '
660 FGETBC=0:' FGETB INIT
670 RETURN
680 '
690 ' FGETB: read 1 bit
700 '
710 IF FGETBC>0 THEN 800
720 FGETB=ASC(INPUT$(1,1))
730 IF FGETB=&H0A OR FGETB=&H0D THEN 720
740 IF FGETB<>ASC("{") THEN 770
750 WHILE INPUT$(1,1)<>"}":WEND:IF INPUT$(1,1)<>"}" THEN 750 ELSE 720
760 '
770 IF FGETB>=&HA1 THEN FGETB=FGETB-&H51 ELSE FGETB=FGETB-&H21
780 FGETBC=7
790 '
800 FGETBD$=CHR$(FGETB\64+&H30):FGETB=(FGETB AND 63)*2:FGETBC=FGETBC-1
810 RETURN
820 '
830 ' search RUN LENGTH
840 '
850 RL=-1
860 IF RL$="0" THEN RL=1:GOTO 930
870 IF LEN(RL$)=2 OR LEN(RL$)=4 THEN 930
880 I=0
890 WHILE RL<0 AND I<=74
900 IF HC$(I)=RL$ THEN RL=I:IF RL>65 THEN RL=(RL-63)*64
910 I=I+1
920 WEND
930 RETURN
940 '
950 ' read RUN LENGTH
960 '
970 RL$=""
980 GOSUB 710:RL$=RL$+FGETBD$:GOSUB 850:IF RL<0 THEN 980
990 IF RL<64 THEN 1030
1000 RL2=RL:RL$=""
1010 GOSUB 710:RL$=RL$+FGETBD$:GOSUB 850:IF RL<0 THEN 1010
1020 RL=RL2+RL
1030 RETURN
1040 '
1050 ' ﾊﾌﾏﾝ ｺｰﾄﾞ
1060 '
1070 ' 0 - 63
1080 DATA 100001, 0, 101, 10010
1090 DATA 11010, 11110, 100110, 110001
1100 DATA 111000, 111110, 1000101, 1001110
1110 DATA 1100001, 1100110, 1110100, 1111110
1120 DATA 10001000, 10001100, 10001111, 10011111
1130 DATA 11000000, 11001010, 11001110, 11100101
1140 DATA 11100111, 11101011, 11101101, 100000100
1150 DATA 100010010, 100010011, 100011010, 100011100
1160 DATA 100011101, 100111100, 100111101, 110000010
1170 DATA 110000011, 110010010, 110010011, 110010110
1180 DATA 110010111, 110011110, 111001000, 111001001
1190 DATA 111001100, 111001101, 111010100, 111010101
1200 DATA 111011000, 111011001, 111011100, 111011101
1210 DATA 111011110, 111011111, 111111100, 111111101
1220 DATA 111111111, 1000001010, 1000001011, 1000001100
1230 DATA 1000001101, 1000001110, 1000001111, 1000110110
1240 ' 64, 128, 192, 256, 320, 384, 448, 512, 576, 640, extend
1250 DATA 11011, 1000000, 11001000, 111111110
1260 DATA 1100111110, 1100111111, 10001101111, 100011011101
1270 DATA 10001101110011, 10001101110010, 1000110111000
1280 '
1290 '-------------------------------
1300 '
1310 ' W.M. LOADER (All BASIC ﾊﾞﾝ)
1320 '
1330 ' 87/08/17 programed by W.M.
1340 '