940 REM Save Pro
1000 REM *******************************
1010 REM * PROWORD .BAC *
1020 REM * VER 1.2 / 1984-02-24 *
1030 REM * Gjort av Nils H{ggblom *
1040 REM * Mod. av Nils H{ggblom *
1050 REM *******************************
1060 REM
1070 DATA 7,7,10,14,13,16,13,7,7,7,12,12,7,12,7,12,12,12,12,12,12,12,12,12,12,12,7,7,12,12,12,12,13,16,15
1080 DATA 14,15,15,15,14,15,9,13,12,13,17,16,15,13,16,15,12,14,15,16,17,11,14,11,13,13,13,13,12,12,12,12,10,12,12,10
1090 DATA 12,12,8,7,10,8,16,12,12,12,12,10,12,10,12,12,16,12,12,10,13,13,13,14,0
1100 REM File to proportional text
1110 REM Attention! C-ITOH 8510 only
1120 DEFFNA%(X$,X%)=ASC(RIGHT$(X$,X%))
1130 DIM W%(127%),Y$=130%,I$=130%,B$=350%,T$=130%,K%(350%),W$=350%,X$=350%,A$(1%)=2%,B$(3%)=2%,T%(10%)
1140 A$(0%)='(*' : A$(1%)='*)' : U%=0%
1150 B$(0%)='<*' : B$(1%)='*>'
1160 B$(2%)='<#' : B$(3%)='#>'
1170 RESTORE
1180 FOR X%=32% TO 127%
1190 READ W%(X%)
1200 NEXT X%
1210 REM Init
1220 ; CHR$(12%)TAB(10%)'Proportionell skrift'
1230 ; TAB(9%)CHR$(23%)'####################'
1240 ; : ; : ; 'Procent marginal (0-60%) :'
1250 ; : ; 'Standard mellanrum (0-6) :'
1260 ; : ; 'Procent oanv{nda rader (0-40%) :'
1270 ; : ; 'Standard radmellanrum (0-40) :'
1280 ; : ; 'Filnamn :'
1290 ; : ; 'Antal kopior :'
1300 ; : ; '[r f{rgbandet gammalt ? '
1310 ; : ; 'Vanligt skrivmaskinspapper ? '
1320 L%=3% : F1%=0%
1330 FOR W%=1% TO 4%
1340 Z$=CUR(2%+W%*2%,33%)+' '+STRING$(3%,8%) : ; Z$;
1350 IF F1% X$='' ELSE GOSUB 4240
1360 ONERRORGOTO 1340
1370 IF (X$='^' OR X$='~') IF W%>1% W%=W%-1% : GOTO 1340 ELSE X$='' : F1%=65535%
1380 IF X$<>'' V%=VAL(X$)
1390 ON W% GOTO 1410,1480,1530,1600
1400 REM Marginal
1410 IF X$='' IF N3%=0% V%=35% ELSE V%=N3%
1420 N3%=V%
1430 IF V%>60% 1340
1440 M%=6.4*V%
1450 N%=1280%-2%*M%
1460 GOTO 1630
1470 REM Mellanrum mellan bokst{verna
1480 IF X$='' IF S%=0% V%=0% ELSE V%=S%
1490 IF V%>6% 1340
1500 S%=V%
1510 GOTO 1630
1520 REM Procent oanv{nda rader
1530 IF X$='' IF R%=0% V%=20% ELSE V%=R%
1540 IF V%>40% 1340
1550 M1%=8.64*V%
1560 M2%=M1%
1570 R%=V%
1580 GOTO 1630
1590 REM Radmellanrum
1600 IF X$='' IF I%=0% V%=8% ELSE V%=I%
1610 IF V%>40% 1340
1620 I%=V%
1630 ; Z$V%
1640 NEXT W%
1650 REM Filnamn
1660 W%=0%
1670 Z$=CUR(12%,10%)+SPACE$(16%)+STRING$(16%,8%)
1680 ; Z$;
1690 IF ERRCODE<>65535% ; CHR$(7%);
1700 GOSUB 4330
1710 ONERRORGOTO 1680
1720 IF X$='' F1%=0% : GOTO 1320
1730 IF INSTR(1%,X$,'.')=0% X$=X$+'.txt'
1740 OPEN X$ ASFILE 2%
1750 F$=X$
1760 REM Antal kopior
1770 ; CUR(14%,15%)' 'CUR(14%,15%); : W%=65535% : L%=3%
1780 IF F1% X$='' ELSE GOSUB 4240
1790 ONERRORGOTO 1770
1800 IF X$='' N7%=1% : ; '1'; : GOTO 1820
1810 N7%=VAL(X$)
1820 REM Gammalt f{rgband ?
1830 ; CUR(16%,24%); : GET Y$
1840 ON INSTR(1%,' JjNn'+CHR$(13%,13%),Y$)/2%+1% GOTO 1830,1850,1870,1870
1850 F5%=65535% : ; 'Ja';
1860 GOTO 1880
1870 F5%=0% : ; 'Nej';
1880 GOSUB 2280
1890 REM Skrivmaskinspapper ?
1900 ; CUR(18%,29%);
1910 IF F1% Y$=CHR$(13%) ELSE GET Y$
1920 ON INSTR(1%,' JjNn'+CHR$(13%,13%),Y$)/2%+1% GOTO 1900,1930,1950,1950
1930 ; 'Ja' : ; 'S{tt i ett ark :'; : A0%=11%
1940 GOTO 1960
1950 ; 'Nej' : ; 'Justera papperet :'; : A0%=12%
1960 GET Y$ : ; CHR$(13%)SPACE$(39%) : ;
1970 A1%=144%*A0%
1980 P%=(A1%-M1%*2%)/(V%+16%)
1990 M2%=M2%+A1%-M1%*2%-P%*(V%+16%)
2000 M9%=M% : N9%=N%
2010 ; CUR(23%,0%)'Utskrift p}g}r...';
2020 L%=0%
2030 REM LOOP - kopior
2040 FOR N8%=1% TO N7%
2050 D%=1% : REM Sidnummer
2060 X2%=65535%
2070 X4%=0%
2080 GOSUB 3500
2090 IF NOT N8%=1% OPEN F$ ASFILE 2%
2100 ONERRORGOTO 2160
2110 REM HUVUD-LOOP
2120 GOSUB 3080
2130 GOSUB 2390
2140 GOSUB 2690
2150 IF N0% GOSUB 2870 : GOTO 2140 ELSE 2130
2160 IF ERRCODE=34% GOSUB 3180 ELSE ; 'Fel'ERRCODE : STOP
2170 REM Close
2180 X2%=0%
2190 IF D%=1% X4%=65535%
2200 GOSUB 3320
2210 NEXT N8%
2220 REM
2230 GOSUB 2340
2240 END
2250 REM
2260 REM //////////////////////////////////////////////////////////////////////
2270 REM
2280 REM \ppna skrivaren
2290 OPEN 'Pr:T' ASFILE 1%
2300 Z%=CALL(30744%,17%)
2310 ; #1%CHR$(27%)'P'CHR$(27%,34%+F5%,15%,27%)'T01'CHR$(27%)'Y'CHR$(13%);
2320 ; #1%CHR$(29%,0%,0%);
2330 RETURN
2340 REM St{ng skrivaren
2350 ; #1%CHR$(13%,27%)'Q'CHR$(27%)'"'CHR$(15%)CHR$(27%)'A'CHR$(27%)'Y';
2360 ; #1%CHR$(29%,0%,13%);
2370 CLOSE 1%
2380 RETURN
2390 REM Input and Cut
2400 F0%=0% : IF T$='' 2470
2410 GOSUB 3180 : X%=T%(ASC(T$)-48%)+M9%
2420 IF X%-M9%'' 2410 ELSE GOSUB 3180 : GOSUB 3080 : GOTO 2470
2520 IF X$=CHR$(12%) GOSUB 3180 : GOSUB 3260 : L%=1% : GOTO 2470
2530 IF INSTR(1%,'0123456789-*:;.,',LEFT$(X$,1%)) F0%=65535% : GOSUB 3180 : F0%=0%
2540 X%=LEN(X$) : IF X%=0% RETURN
2550 IF RIGHT$(X$,LEN(X$))='-' AND LEN(X$)>1% X$=LEFT$(X$,LEN(X$)-1%) : GOTO 2570
2560 X$=X$+' '
2570 X%=LEN(X$)
2580 IF MID$(X$,X%,1%)<' ' GOSUB 2680 : GOTO 2570
2590 X%=X%-1%
2600 IF X%<>0% 2580
2610 FOR Y%=0% TO 1% : X%=0%
2620 X%=INSTR(X%+1%,X$,A$(Y%))
2630 IF X%=0% 2660
2640 X$=LEFT$(X$,X%-1%)+CHR$(Y%)+RIGHT$(X$,X%+2%)
2650 GOTO 2620
2660 NEXT Y%
2670 W$=W$+X$ : RETURN
2680 X$=LEFT$(X$,X%-1%)+RIGHT$(X$,X%+1%) : RETURN
2690 REM Kumulativa W$
2700 Y%=P0%
2710 FOR X%=1% TO LEN(W$)
2720 Y%=Y%+W%(FNA%(W$,X%))
2730 IF Y%>N% N0%=X%-1% : GOTO 2760
2740 K%(X%)=Y% : Y%=Y%+S%
2750 NEXT X% : N0%=0% : RETURN
2760 IF N0%=0% RETURN
2762 FOR Y%=N0% TO 1% STEP 65535%
2770 IF MID$(W$,Y%,1%)<>' ' NEXT Y% : Y%=N0% : GOTO 2790
2780 X$=W$ : X%=Y% : GOSUB 2680 : W$=X$ : N0%=Y%-1%
2790 B$=LEFT$(W$,Y%-1%) : W$=RIGHT$(W$,Y%)
2800 RETURN
2810 REM X% bit-spaces
2820 ; #1%SPACE$(X%/7%);
2830 X%=X%-X%/7%*7%
2840 IF X%=0% RETURN
2850 ; #1%CHR$(27%)RIGHT$(NUM$(X%),2%);
2860 RETURN
2870 REM Print a Line
2880 Y%=N%-K%(N0%) : REM . spaces
2890 S0%=Y%/(N0%-1%) : REM Hur m}nga extra spaces per bokstavsmellanrum
2900 Y0%=Y%-S0%*(N0%-1%) : REM \verlopps att sprida ut j{mnt
2910 IF Y0% M0%=(N0%-1%)/Y0%
2920 IF U% ; #1%CHR$(27%)'Y';
2930 IF P0%=0% X%=M% : GOSUB 2810
2940 IF U% ; #1%CHR$(27%)'X';
2950 FOR Y%=1% TO N0%
2960 Y$=MID$(B$,Y%,1%)
2970 IF Y$=CHR$(0%) ; #1%CHR$(27%)'X'; : U%=65535% ELSE IF Y$=CHR$(1%) ; #1%CHR$(27%)'Y'; : U%=0% ELSE 2990
2980 GOTO 3000
2990 IF INSTR(1%,'pgq',Y$) AND U% ; #1%CHR$(27%)'Y'Y$CHR$(27%)'X'; ELSE ; #1%Y$;
3000 IF Y%=N0% 3040
3010 X%=S%+S0%
3020 IF Y0% IF (Y%-1%)/M0%=(Y%-1)/M0% Y0%=Y0%-1% : X%=X%+1%
3030 GOSUB 2810
3040 NEXT Y%
3050 P0%=K%(N0%)
3060 IF (T$='' AND N0%) OR F0% GOSUB 3080
3070 RETURN
3080 REM Line Feed
3090 P0%=0% : F3%=0%
3100 IF L%>1% ; CUR(23%,0%)'Utskriften p}g}r... ';
3110 IF L%=P% GOSUB 3320 : L%=0%
3120 IF L%=0% ; #1%CHR$(13%)STRING$(M1%,10%)CHR$(13%); : GOTO 3140
3130 ; #1%CHR$(13%)STRING$(V%+16%,10%)CHR$(13%);
3140 L%=L%+1%
3150 IF M6% M%=M6% : M6%=0%
3160 IF N6% N%=N6% : N6%=0%
3170 RETURN
3180 REM T|m resten
3190 IF LEN(W$)=0% RETURN
3200 N0%=LEN(W$)
3210 IF FNA%(W$,N0%)=32% W$=LEFT$(W$,N0%-1%) : GOTO 3200
3220 B$=W$ : N0%=LEN(W$) : S0%=0% : Y0%=0%
3230 GOSUB 2920
3240 W$=''
3250 RETURN
3260 REM ;#1% Chr$(12%); och VTAB
3262 IF F3% RETURN
3270 GOSUB 3320
3280 IF A1%=11% THEN RETURN
3290 ; #1%CHR$(13%)STRING$(M1%,10%)CHR$(13%);
3300 L%=0%
3310 RETURN
3320 REM ;#1% Chr$(12%);
3330 IF F3% RETURN ELSE F3%=65535%
3340 X%=64%
3350 Z%=(V%+16%)*(P%-L%+1%)+M2%
3360 IF Z%57% 3800
3690 I0%=Z%-48% : GOTO 3770
3700 IF Z%<>61% 3800 ELSE 3770
3710 Z%=INSTR(X%,T$,',')
3720 ONERRORGOTO 3800
3730 IF Z% T%=VAL(MID$(T$,X%,Z%-X%)) : X%=Z%-1% ELSE T%=VAL(MID$(T$,X%,Z0%-X%)) : X%=Z0%-1%
3740 IF T%>=0% AND T%<100% T%(I0%)=T%/100*N%
3750 ONERRORGOTO 2160 : GOTO 3770
3760 IF Z%<>44% 3800 ELSE F%=0%
3770 F%=F%+1%
3780 NEXT X%
3790 GOTO 3560
3800 ONERRORGOTO 2160 : IF I0%=10% X$=T$
3810 GOTO 3580
3820 REM To Dot-Tab X%
3830 ; #1%CHR$(27%)'Y';
3840 ; #1%CHR$(27%)'F'STRING$(5%-LEN(NUM$(X%)),48%)RIGHT$(NUM$(X%),2%);
3850 IF U% ; #1%CHR$(27%)'X';
3860 RETURN
3870 REM Kolla om tabulering
3880 X%=0% : T$=''
3890 X%=INSTR(X%+1%,X$,B$(1%))
3900 Z0%=INSTR(1%,X$,B$(2%))
3910 Z1%=INSTR(1%,X$,B$(3%))
3920 IF Z1% 4160
3930 IF Z0% 4000
3940 IF X%=0% RETURN
3950 Y%=FNA%(X$,X%+2%)
3960 IF Y%<48% OR Y%>58% 3890
3970 T$=RIGHT$(X$,X%+2%)
3980 X$=LEFT$(X$,X%-1%)
3990 RETURN
4000 REM Kolla om centrering
4010 Y%=FNA%(X$+' ',Z0%+2%)-48%
4020 IF Y%>-1% AND Y%<10% AND Z0% 4100
4030 Y$=MID$(X$,Z0%+2%,Z1%-Z0%-2%)
4040 IF Z1%=0% 3940
4050 GOSUB 4960
4060 T%(10%)=(1280%-Y%)/2%-M9%
4070 T$=':'+MID$(X$,Z0%+2%,Z1%-Z0%-2%)+RIGHT$(X$,Z1%+2%)
4080 X$=LEFT$(X$,Z0%-1%)
4090 RETURN
4100 REM [ndra p} v{nster marginal
4110 X$=LEFT$(X$,Z0%-1%)+RIGHT$(X$,Z0%+3%)
4120 IF Y%=0% M6%=M9% : N6%=N%+M%-M9% : GOTO 3870
4130 M6%=M9%+T%(Y%) : N6%=N9%-T%(Y%)
4140 IF N6%<=100% M6%=M9% : N6%=N9%
4150 GOTO 3870
4160 REM [ndra p} h|ger marginal
4170 Y%=FNA%(X$+' ',Z1%+2%)-48%
4180 IF Y%<0% OR Y%>9% 3930
4190 X$=LEFT$(X$,Z1%-1%)+RIGHT$(X$,Z1%+3%)
4200 IF Y%=0% N6%=N9%-M%+M9% : GOTO 3870
4210 N6%=N9%-T%(Y%)
4220 IF N6%<=100% N6%=N9% : M6%=M9%
4230 GOTO 3870
4240 REM Inmatning
4250 X$=''
4260 X%=LEN(X$) : GET Y$ : Y%=ASC(Y$) : IF Y%=13% RETURN
4270 IF X%=L% AND Y%<>8% AND Y%<>24% 4260
4280 IF Y%=8% IF X% X$=LEFT$(X$,X%-1%) : ; CHR$(8%)' 'CHR$(8%);
4290 IF Y%=24% ; STRING$(X%,8%)SPACE$(X%)STRING$(X%,8%); : X$='' : GOTO 4260
4300 IF W% IF Y%<48% OR Y%>57% AND NOT (Y%=94% OR Y%=126%) 4260 ELSE 4310 ELSE IF Y%<32% 4260
4310 ; Y$; : X$=X$+Y$
4320 GOTO 4260
4330 REM Inmatning av filnamn
4340 REM Till}tna enheter, !=Filnamn m}ste finnas, +=Default extension
4350 D9$='DR0!+*DR1!+*'
4360 X$='' : E9$='.TXT' : REM Default
4370 GOSUB 4390
4380 RETURN
4390 REM Inmatning av filnamn
4400 D8$=':' : D8%=ASC(D8$)
4410 C9$='_' : C9%=ASC(C9$)
4420 L7%=12% : L8%=4% : L9%=L7%+L8%
4430 ; X$STRING$(L9%-LEN(X$),C9%)STRING$(L9%-LEN(X$),8%);
4440 X%=LEN(X$) : X0%=X%-INSTR(1%,X$,D8$) : GET Y$ : Y%=ASC(Y$)
4450 IF Y%=13% 4750
4460 IF ((X%=L7% AND X%=X0%) OR (X%=L9% AND X%<>X0%)) AND Y%<>8% AND Y%<>24% 4440
4470 IF Y%<>24% OR X%=0% 4510
4480 IF X0%=0% Z%=X% ELSE Z%=X0%
4490 ; STRING$(Z%,8%)STRING$(Z%,C9%)STRING$(Z%,8%);
4500 X$=LEFT$(X$,X%-Z%) : GOTO 4440
4510 IF Y%<>8% OR X%=0% 4590
4520 IF INSTR(1%,D8$+'.',RIGHT$(X$,X%))=0% X$=LEFT$(X$,X%-1%) : ; CHR$(8%,C9%,8%); : GOTO 4590
4530 IF X0%=0% AND X% Z%=1% ELSE Z%=X%-X0%
4540 Z1%=INSTR(Z%,X$,' ')
4550 IF Z1%=0% Z1%=LEN(X$)
4560 IF Z1% Z%=X%-Z1%+1%
4570 ; STRING$(Z%,8%)STRING$(Z%,C9%)STRING$(Z%,8%);
4580 X$=LEFT$(X$,Z1%-1%)
4590 IF Y%<>D8% 4670
4600 IF X%>3% OR X%=0% 4670
4610 Z1%=0%
4620 Z0%=Z1%+1%
4630 Z1%=INSTR(Z0%,D9$,'*')
4640 IF Z1%=0% 4670
4650 IF X$<>MID$(D9$,Z0%,Z1%-Z0%-L8%+X%-1%) 4620
4660 ; SPACE$(L8%-X%-1%)D8$; : X$=X$+SPACE$(L8%-X%-1%)+D8$ : GOTO 4440
4670 IF Y%=46% AND X0%<9% AND X0% Y$=SPACE$(L7%-4%-X0%)+'.' : GOTO 4730
4680 IF Y%>64% AND Y%<94% 4720
4690 IF Y%>96% AND Y%<126% Y$=CHR$(ASC(Y$)-32%) : GOTO 4720
4700 IF Y%>47% AND Y%<58% AND X% 4720
4710 GOTO 4440
4720 IF X0%=8% Y$='.'+Y$
4730 ; Y$; : X$=X$+Y$
4740 GOTO 4440
4750 Z%=0%
4760 IF X0%=0% 4820
4770 IF X0%=X% 4810
4780 DEFFNO0%(C%)=ASC(MID$(D9$,INSTR(1%,D9$,LEFT$(X$,INSTR(1%,X$,D8$)-1%))+2%+C%,1%))
4790 IF FNO0%(2%)=ASC('+') Z%=1%
4800 GOTO 4840
4810 Z%=1% : GOTO 4840
4820 IF X%=0% Z%=0% : GOTO 4840
4830 IF FNO0%(1%)=ASC('!') 4440
4840 IF INSTR(1%,X$,'.')=0% AND Z% X$=X$+SPACE$(8%-X0%)+E9$ : ; SPACE$(8%-X0%)E9$;
4850 ; SPACE$(L9%-LEN(X$));
4860 Y%=0%
4870 Y%=INSTR(Y%+1%,X$,' ') : IF Y%=0% 4900
4880 X$=LEFT$(X$,Y%-1%)+RIGHT$(X$,Y%+1%) : Y%=Y%-1%
4890 GOTO 4870
4900 ; STRING$(L9%,8%);
4910 RETURN
4920 REM Anv{ndaren byter ark
4930 Z$=CUR(23%,0%)+SPACE$(39%)+CUR(23%,0%)+CHR$(7%)
4940 ; Z$'S{tt i ett nytt ark :';
4950 RETURN
4960 REM Dot-l{ngd p} Y$
4970 Y%=0%
4980 FOR Z%=1% TO LEN(Y$)
4990 Y%=Y%+W%(FNA%(Y$,Z%))
5000 NEXT Z%
5010 RETURN