10 REM PROGRAM :  EMBMAKE
20 REM VERSION :  1.0
30 REM (C)    :  Ulf Dahl`n, <2422>
40 REM B]STAD 1984-06-25
50 REM 
60 DIM Q0$=253%,Q$=253%,R1$=44%,R2$=11%,R3$=4%,R4$=11%
70 FOR J%=1% TO 44% : READ I% : R1$=R1$+CHR$(I%) : NEXT J%
80 REM Rad 10
90 DATA 130,43,10,0,134,128,199,128,0,204,194,146,92,0,0,191,58,131,193,145
100 DATA 92,0,0,199,41,254,206,54,199,42,254,206,54,199,0,1,250,245,199,6,0
110 DATA 245,183,13
120 REM 
130 FOR J%=1% TO 11% : READ I% : R2$=R2$+CHR$(I%) : NEXT J%
140 DATA 134,129,193,145,92,0,0,213,186,44,199
150 REM 
160 R3$=CHR$(0%,186%,44%,199%)
170 REM 
180 FOR J%=1% TO 11% : READ I% : R4$=R4$+CHR$(I%) : NEXT J%
190 DATA 0,186,58,131,194,146,92,0,0,203,34
200 REM 
210 ; INP(3%)CHR$(12%)TAB(14%)"EMBMAKE"
220 ; TAB(13%)"========="
230 ; CUR(3%,0%)"Detta program skapar en EMB-fil av en"
240 ; "eller flera delar av minnet."
250 ; CUR(6%,0%)"Ange antal minnesfragment (1-9): "; : L%=1% : GOSUB 850
260 GOSUB 970 : A%=I-1 : IF E% OR A%<0% GOTO 250
270 DIM F(1%,A%)
280 ; CUR(8%,0%)"Fragment"TAB(12)"Startadress"TAB(28)"Slutadress"
290 FOR I%=0% TO A%
300 ; CUR(9%+I%,3%)I%+1%
310 ; CUR(9%+I%,14%); : L%=5% : GOSUB 850 : GOSUB 970
320 IF E% GOTO 310 ELSE F(0%,I%)=I
330 ; CUR(9%+I%,30%); : L%=5% : GOSUB 850 : GOSUB 970
340 IF E% OR I<F(0%,I%) GOTO 330 ELSE F(1%,I%)=I
350 NEXT I%
360 ; CUR(11%+A%,0%)"Ska koden exekveras efter laddning? ";
370 L%=3% : GOSUB 850 : I$=LEFT$(I$+"J",1%)
380 IF I$="N" OR I$="n" E=-1 : GOTO 430
390 ; CUR(11%+A%,0%)SPACE$(40%)
400 ; CUR(11%+A%,0%)"Ange exekveringsadress: ";
410 L%=5% : GOSUB 850 : GOSUB 970
420 IF E% GOTO 360 ELSE E=I
430 ; CUR(13%+A%,0%)"Ange filnamn: ";
440 L%=16% : GOSUB 850 : F$=I$
450 IF INSTR(1%,F$,".")=0% F$=F$+".BAC" : ; CUR(13%+A%,14%)F$
460 ONERRORGOTO 430 : PREPARE F$ ASFILE 1% : ONERRORGOTO 0
470 ; CUR(15%+A%,0%)"V{nta - sparar minnesfragment";
480 IF A% ; "en."; ELSE ; ".";
490 REM 
500 REM Plats f|r sk{rmrutin
510 REM 
520 ONERRORGOTO 740
530 P%=0% : Q$=R1$ : R%=10%
540 FOR I%=0% TO A%
550 L=F(1%,I%)-F(0%,I%)+1%
560 I=F(0%,I%)
570 IF LEN(Q$)+40%>253% GOSUB 800
580 L%=128% : IF L%>L L%=L
590 IF LEN(Q$)+L%+40%>253% L%=253%-LEN(Q$)-40%
600 R%=R%+10%
610 Q$=Q$+CHR$(34%+L%,R%,R%/256%)+R2$
620 Q$=Q$+CHR$(I)+R3$+CHR$(I/256%)+R4$+CHR$(L%)
630 FOR J=I TO I+L%-1%
640 Q$=Q$+CHR$(PEEK(J)) : NEXT J
650 Q$=Q$+CHR$(184%,13%)
660 I=I+L% : L=F(1%,I%)-I+1%
670 IF L GOTO 570
680 NEXT I% : Q$=Q$+CHR$(1%) : GOSUB 800
690 CLOSE 1%
700 REM 
710 ; : ; : ; "KLART."
720 END 
730 REM 
740 REM --- FEL ---
750 ; : ; : ; CHR$(7%)"FEL"ERRCODE"!"
760 ; "AVBRYTER."
770 CLOSE 1%
780 END 
790 REM 
800 REM --- SKRIV BLOCK ---
810 Q$=Q$+STRING$(253%-LEN(Q$),0%)
820 Z%=CALL(28666%,1%) : Q0$=Q$ : Z%=CALL(28670%,P%)
830 P%=P%+1% : Q$="" : RETURN 
840 REM 
850 REM --- GENERELL INPUT-RUTIN ---
860 I$="" : G%=PEEK(65011%)+SWAP%(PEEK(65012%)) : ; SPACE$(L%)STRING$(L%,8%);
870 GET G$ : IF G$=CHR$(13%) RETURN 
880 IF G$=CHR$(8%) IF LEN(I$) I$=LEFT$(I$,LEN(I$)-1%) : GOTO 930 ELSE 950
890 IF G$=CHR$(9%) IF LEN(J$) G$=LEFT$(J$,1%) : J$=RIGHT$(J$,2%) ELSE 950
900 IF G$=CHR$(24%) I$="" : GOTO 930
910 IF LEN(I$)=L% 950
920 I$=I$+G$
930 ; CUR(G%,SWAP%(G%))I$SPACE$(L%-LEN(I$))STRING$(L%-LEN(I$),8%);
940 GOTO 870
950 ; CHR$(7%); : GOTO 870
960 REM 
970 REM --- TALKONTROLL ---
980 E%=0% : ONERRORGOTO 1000
990 I=VAL(I$) : GOTO 1010
1000 E%=-1%
1010 ONERRORGOTO 0 : RETURN