1000 ! ---------------------------------------------------------
1010 ! -- MAPP
1020 ! --
1030 ! -- Date   / Vers / Sign / Comment
1040 ! --
1050 ! -- 880402 / 4.0x / Cid  / Main function
1060 ! -- 8804xx / 4.01 / Cid  / Verbose
1070 ! -- 880621 / 4.02 / Cid  / .MAP files will not be mapped
1080 ! --
1090 ! --
1100 ! -- Program f|r att l{gga selekterade filer i en
1110 ! -- mapp.
1120 ! --
1130 ! -- OBSERVERA systemet ej f{rdigutvecklat, men
1140 ! --           de menyval som inte {r sp{rrade
1150 ! --           fungerar.
1160 ! --
1170 ! ---------------------------------------------------------
1180 ! 
1190 INTEGER : EXTEND ! Hmm
1200 IF INSTR(1,TIME$,'I') ; 'St{ll klockan !!!' CHR$(7) : STOP 
1210 DIM A$=253
1220 Source=2 : Map=3 : Nummer=0 : Killer=0 : Te=0
1230 Size.=0 : Over=0
1240 ! 
1250 ; FNScr$
1260 ! 
1270 ; : ; 
1280 ; TAB(15) 'MAPP l{gger in flera filer i en enda, denna fil'
1290 ; TAB(15) 'kallar vi f|r mapp. Mappen kan sedan packas upp'
1300 ; TAB(15) 'Filer kan l{ggas till i mappen, eller tas ut ur'
1310 ; TAB(15) 'den. Mappens inneh}ll samt filinfo kan tas fram.'
1320 ! 
1330 ; CUR(10,15) '1 Skapa ny mapp'
1340 ; TAB(16) '2 Packa upp mapp'
1350 ; TAB(16) '3 -'
1360 ; TAB(16) '4 -'
1370 ; TAB(16) '5 Visa mappinformation'
1380 ; TAB(16) '6 Radera filer'
1390 ; TAB(16) '7 -'
1400 ; : ; TAB(16) '0 Avsluta'
1410 ! 
1420 Z$=FNInput$(1,'',CUR(20,15)+'V{lj alternativ (0-7): ',0)
1430 IF Z$<'0' OR Z$>'7' Ec=FNError('Felaktigt alternativ') : GOTO 1420
1440 ON VAL(Z$)+1 GOTO 1460,1540,2170,1490,1490,1770,2080,1490
1450 ! 
1460 ; FNScr$
1470 END 
1480 ! 
1490 Z=FNError('Funktionen ej definierad')
1500 GOTO 1000
1510 ! 
1520 ! --<Skapa ny mapp>
1530 ! 
1540 ; FNScr$
1550 ; 'Skapa ny mapp' : ; 
1560 ; TAB(15) 'Denna rutin skapar en ny mapp, och l{gger in de'
1570 ; TAB(15) 'filer som markerats i denna.'
1580 Mapp$=FNInmapp$
1590 IF Pf1 1220
1600 ! 
1610 ON ERROR GOTO 1640
1620 OPEN Mapp$ AS FILE 1 : CLOSE 
1630 IF NOT FNQuest(CHR$(7)+'Mappen finns redan, skall den |verskrivas','') THEN 1580
1640 ON ERROR GOTO 1720
1650 PREPARE Mapp$ AS FILE Map
1660 PUT #Map STRING$(2100,0)
1670 ON ERROR GOTO 1690
1680 Z=FNMarkera : CLOSE 
1690 CLOSE : Z=FNError('Rutinen klar')
1700 GOTO 1220
1710 ! 
1720 Z=FNError('Kan ej skapa mappen, felkod = '+NUM$(ERRCODE))
1730 GOTO 1580
1740 ! 
1750 ! --<Visa mappinformation>
1760 ! 
1770 ; FNScr$
1780 ; 'Visa mappinformation' : ; 
1790 ; TAB(15) 'Denna rutin visar aktuell information f|r ang-'
1800 ; TAB(15) 'mapp. Filnamn, storlek, datum visas.'
1810 Mapp$=FNInmapp$
1820 IF Pf1 1220
1830 ! 
1840 ON ERROR GOTO 2030
1850 OPEN Mapp$ AS FILE Map
1860 ; FNScr$
1870 GET #Map A$ COUNT 23
1880 WHILE ASCII(A$)<>0
1890   Nummer=Nummer+1
1900   ; CUR(3+Nummer,Over);
1910   ; MID$(A$,1,8)+'.'+MID$(A$,9,3)+' - ';
1920   ; USING '###### bytes - ' CVT$F(MID$(A$,16,4));
1930   Size.=Size.+CVT$F(MID$(A$,16,4))
1940   ; CVT$F(MID$(A$,20,4))
1950   GET #Map A$ COUNT 23
1960   IF Nummer=16 Te=Te+1
1970   IF Nummer=16 IF Over=0 Over=40 ELSE Over=0 : Z=FNError('Tryck CE f|r n{sta sida') : ; FNScr$
1980   IF Nummer=16 Nummer=0
1990 WEND 
2000 CLOSE Map : Z=FNError('Mappen inneh}ller '+NUM$(Nummer+Te*16)+' fil(er) - '+NUM$(Size.)+' bytes,')
2010 GOTO 1220
2020 ! 
2030 Z=FNError('Mappen finns ej')
2040 GOTO 1810
2050 ! 
2060 ! --<Radera filer>
2070 ! 
2080 ; FNScr$ : ; 'Radera filer' : ; 
2090 ; TAB(15) 'Denna rutin radera markerade filer fr}n an-'
2100 ; TAB(15) 'given enhet.'
2110 Killer=1
2120 Z=FNMarkera
2130 GOTO 1220
2140 ! 
2150 ! --<Packa upp mapp>
2160 ! 
2170 ; FNScr$
2180 ; 'Packa upp mapp'
2190 ; 
2200 ; TAB(15) 'Denna rutin anv{nds f|r uppackning av mappar.'
2210 ; TAB(15) 'Vanligtvis kan ej mappen ligga p} samma skiva'
2220 ; TAB(15) 'som de uppackade filerna om ej h}rddisk anv{nds'
2230 ! 
2240 ON ERROR GOTO 2310
2250 Mapp$=FNInmapp$
2260 IF Pf1 THEN 1220
2270 OPEN Mapp$ AS FILE Map
2280 Z=FNGetmap
2290 GOTO 1220
2300 ! 
2310 Z=FNError('Hittar ej mappen')
2320 GOTO 2240
2330 ! 
2340 DEF FNInput$(L{ngd,Default$,Text$,Psw) LOCAL G$=1,Z,A$=159,Edit$=159,I
2350   ! 
2360   ! 
2370   ; Text$ STRING$(L{ngd,95) STRING$(L{ngd,8); : Edit$=Default$
2380   Pf1=0
2390   WHILE -1
2400     ! 
2410     GET G$
2420     Z=ASCII(G$)
2430     ! 
2440     IF Z=192 THEN Pf1=1 : A$='' : Z=13
2450     IF Z=8 IF LEN(A$) A$=LEFT$(A$,LEN(A$)-1) : ; CHR$(8,95,8);
2460     IF Z=9 IF LEN(Edit$) G$=LEFT$(Edit$,1)
2470     IF Z=9 IF LEN(Edit$) Edit$=RIGHT$(Edit$,2)
2480     IF Z=13 ; SPACE$(L{ngd-LEN(A$)) : RETURN A$
2490     ! 
2500     WHILE Z=24
2510       I=1
2520       WHILE I<=LEN(A$)
2530         ; CHR$(8,95,8);
2540         I=I+1
2550       WEND 
2560       A$=''
2570       ! 
2580     IF 0 WEND 
2590     ! 
2600     WHILE G$>=' ' AND G$<='' AND LEN(A$)<L{ngd
2610       IF Psw ; '*'; ELSE ; G$;
2620       A$=A$+G$
2630       ! 
2640     IF 0 WEND 
2650     ! 
2660   WEND 
2670 FNEND 
2680 ! 
2690 DEF FNRise$(I$) LOCAL X$=159,Z,I
2700   ! 
2710   I=1
2720   WHILE I<=LEN(I$)
2730     Z=ASCII(MID$(I$,I,1))
2740     ! 
2750     IF Z>95 AND Z<127 Z=(Z AND 223)
2760     X$=X$+CHR$(Z)
2770     I=I+1
2780   WEND 
2790   ! 
2800   RETURN X$
2810 FNEND 
2820 ! 
2830 DEF FNSpc$(A$) LOCAL Ed$=80,I,Z
2840   ! 
2850   I=1
2860   WHILE I<=LEN(A$)
2870     Z=ASCII(MID$(A$,I,1))
2880     IF Z<>32 Ed$=Ed$+CHR$(Z)
2890     I=I+1
2900   WEND 
2910   ! 
2920   RETURN Ed$
2930 FNEND 
2940 ! 
2950 DEF FNMarkera LOCAL Dir$=3085,Enhet$=66,Unit$=4,Select$=12,Le$=12,Lf,Lg
2960   P=1 : Lf=8
2970   Enhet$='UFDDR0DR1DR2DR3HD0HD1HD2HD3SF0SF1SF2SF3MF0MF1MF2MF3MO0MO1MO2MO3RAM'
2980   Z=FNMess('PF1 = Avbryter')
2990   Dir$=STRING$(1+2+10+256*12,255)
3000   PRINT CUR(10,17) 'Enhet: ';
3010   Unit$=FNRise$(FNInput$(4,'','',0))
3020   IF Pf1 RETURN 0
3030   IF LEN(Unit$)<>4 THEN Z=FNError('Felaktig enhet. Tryck CE') : GOTO 2980
3040   IF INSTR(1,Enhet$,LEFT$(Unit$,3))=0 OR RIGHT$(Unit$,LEN(Unit$))<>':' THEN Z=FNError('Felaktig enhet. Tryck CE') : GOTO 2980
3050   PRINT CUR(12,10) 'S|kt filnamn: ';
3060   Select$=FNInput$(12,'','',0)
3070   ; FNScr$
3080   Dir$=FNR15030$(Unit$,Select$,Lf,RIGHT$(Dir$,12))
3090   IF ASCII(Dir$)<>0 THEN 3350
3100   Dir$=RIGHT$(Dir$,14)
3110   Dir$=FNR4962$(Dir$)
3120   IF Dir$='' THEN 3320
3130   IF Killer IF NOT FNQuest('Radera markerade filer','') THEN 3320
3140   IF Killer=0 IF NOT FNQuest('L{gga markerade filer i mapp','') THEN 3320
3150   ; FNScr$
3160   ON ERROR GOTO 3370
3170   WHILE Lg<LEN(Dir$)
3180     IF (ASCII(MID$(Dir$,Lg+1,1)) AND 128)=0 THEN 3300
3190     Le$=CHR$(ASCII(MID$(Dir$,Lg+1,1)) AND 127)+FNR16881$(MID$(Dir$,Lg+2,11))
3200     WHILE Killer
3210       ; CUR(10,0) 'Tar bort ' LEFT$(Le$,1)+MID$(Dir$,Lg+2,11)
3220       KILL FNSpc$(LEFT$(Le$,1)+MID$(Dir$,Lg+2,11))
3230     IF 0 WEND 
3240     WHILE Killer=0 AND INSTR(1,(MID$(Dir$,Lg+2,11)),'.MAP')=0
3250       PRINT CUR(10,0) 'L{gger in ' LEFT$(Le$,1)+MID$(Dir$,Lg+2,11) ' i mapp "' Mapp$ '"'
3260       Nummer=Nummer+1
3270       OPEN FNSpc$(LEFT$(Le$,1)+MID$(Dir$,Lg+2,11)) AS FILE Source
3280       IF FNPutmap(LEFT$(Le$,1)+MID$(Dir$,Lg+2,11),Nummer) THEN 3370
3290     IF 0 WEND 
3300     Lg=Lg+12
3310   WEND 
3320   P=0
3330   ON ERROR GOTO 
3340   RETURN 0
3350   Z=FNError('Kan inte l{sa bibliotek. Tryck CE')
3360   GOTO 2980
3370   Z=FNError('Fel vid bearbetning av fil - felkod '+NUM$(ERRCODE))
3380   IF FNQuest('Skall rutinen avbrytas','') THEN 3320
3390   ON ERROR GOTO 3370
3400   Z=FNMess('')
3410   GOTO 3300
3420 FNEND 
3430 ! 
3440 DEF FNSwitch$(File$)
3450   IF (ASCII(File$) AND 128)=128 THEN RETURN '  * '+CHR$(ASCII(File$) AND 127)+RIGHT$(File$,2)
3460   RETURN '    '+File$
3470 FNEND 
3480 ! 
3490 DEF FNR4894$(La$)
3500   IF (ASCII(La$) AND 128)=128 THEN RETURN CHR$(ASCII(La$) AND 127)+RIGHT$(La$,2)
3510   RETURN CHR$(ASCII(La$) OR 128)+RIGHT$(La$,2)
3520 FNEND 
3530 DEF FNR4962$(Dir$) LOCAL Lb,Lc,Ld$=1,Le$=13,Lf,Lg,Lh,Li
3540   IF Dir$='' THEN RETURN Dir$
3550   Li=4 ! 80/20
3560   P=1
3570   PRINT CUR(3,0) 'X = Markera inget  A = Markera resten'
3580   K=FNMess('RETURN = M{rk/ej PF1 = Avsluta  PF3 = V{nster  PF4 = H|ger  PF5 = Upp  PF7 = Ned')
3590   I1=0
3600   WHILE I1<Li
3610     PRINT CUR(5,I1*18+4) 'Filnamn'
3620     PRINT CUR(6,I1*18+4) '============'
3630     I1=I1+1
3640   WEND 
3650   Lf=7
3660   Lh=0
3670   Lb=0
3680   WHILE Lf<=20
3690     PRINT CUR(Lf,0) TAB(80);
3700     I1=0
3710     WHILE I1<Li AND Lb<LEN(Dir$)
3720       PRINT CUR(Lf,I1*18) FNSwitch$(MID$(Dir$,Lb+1,12))
3730       Lb=Lb+12
3740       I1=I1+1
3750     WEND 
3760     Lf=Lf+1
3770   WEND 
3780   Lf=7
3790   Lb=Lg/18*12
3800   Le$=CHR$(13,65,88,97,120,192,193,194,195,196,198,212,214)
3810   A1$=Le$
3820   PRINT CUR(Lf,Lg+2);
3830   Ld$=FNR12642$('0V','')
3840   Lc=ASCII(S$)
3850   IF INSTR(1,Le$,S$)=0 THEN 3810
3860   IF Lc=13 THEN MID$(Dir$,Lb+1,12)=FNR4894$(MID$(Dir$,Lb+1,12)) : PRINT CUR(Lf,Lg) FNSwitch$(MID$(Dir$,Lb+1,12))
3870   IF Lc=ASCII('A') OR Lc=ASCII('a') THEN K=FNR6419(RIGHT$(Dir$,Lb+1))+FNR6249(Dir$,0,Lh,Li) : RETURN Dir$
3880   IF Lc=ASCII('X') OR Lc=ASCII('x') THEN RETURN ''
3890   IF Lc=192 THEN RETURN Dir$
3900   IF Lc=194 AND Lb>=12 THEN Lg=Lg-18 : Lb=Lb-12
3910   IF Lc=195 AND Lb<LEN(Dir$)-12 THEN Lg=Lg+18 : Lb=Lb+12
3920   IF Lc=196 AND Lb>=(Li*12) THEN Lf=Lf-1 : Lb=Lb-(Li*12)
3930   IF Lc<>198 THEN 3960
3940   IF Lb<(LEN(Dir$)-Li*12) THEN Lf=Lf+1 : Lb=Lb+Li*12 : GOTO 4030
3950   IF (Lb+(Li-Lg/18)*12)<LEN(Dir$) AND (Lh*Li*12+14*12*Li)<LEN(Dir$) THEN Lh=FNR6249(Dir$,1,Lh,Li) : Lf=18
3960   IF Lc<>212 THEN 3980
3970   IF Lh<>0 THEN 3650 ELSE Lf=7
3980   IF Lc<>214 THEN 4030
3990   Lh=INT((LEN(Dir$)-14*12*Li)/12/4)
4000   IF Lh>0 THEN Lh=FNR6249(Dir$,1,Lh,Li) ELSE Lh=0
4010   Lf=7+INT(((LEN(Dir$)-(Lh*Li*12))/12-Lg/18-1)/Li)
4020   Lb=LEN(Dir$)-((LEN(Dir$)-Lh*Li*12)-(((Lf-7)*Li+Lg/18)*12))
4030   IF Lg>(Li*18-18) THEN Lg=0 : Lf=Lf+1
4040   IF Lg<0 THEN Lg=Li*18-18 : Lf=Lf-1
4050   IF Lf>20 AND (Lh*Li*12)<LEN(Dir$) THEN Lh=FNR6249(Dir$,1,Lh,Li)
4060   IF Lf>20 THEN Lf=20
4070   IF Lf<7 AND Lh>0 THEN Lh=FNR6249(Dir$,-1,Lh,Li) : Lf=7 : IF Lf<7 THEN Lf=7
4080   GOTO 3810
4090 FNEND 
4100 ! 
4110 DEF FNR6249(La$,Lb,Lc,Ld) LOCAL Le,Lf,Lg
4120   Lf=(Lc+Lb)*Ld*12
4130   Le=7
4140   WHILE Le<=20
4150     PRINT CUR(Le,0) TAB(80);
4160     Lg=0
4170     WHILE Lg<Ld AND Lf<LEN(La$)
4180       PRINT CUR(Le,Lg*18) FNSwitch$(MID$(La$,Lf+1,12))
4190       Lf=Lf+12
4200       Lg=Lg+1
4210     WEND 
4220     Le=Le+1
4230   WEND 
4240   RETURN Lc+Lb
4250 FNEND 
4260 ! 
4270 DEF FNR6419(La$) LOCAL Lb
4280   WHILE Lb<LEN(La$)
4290     MID$(La$,Lb+1,1)=CHR$(ASCII(MID$(La$,Lb+1,1)) OR 128)
4300     Lb=Lb+12
4310   WEND 
4320   RETURN 0
4330 FNEND 
4340 ! 
4350 DEF FNR9448(La,Lb$) LOCAL Lc
4360   Lc=ASCII(RIGHT$(Lb$,La))
4370   RETURN 10*(Lc AND 240)/16+(Lc AND 15)
4380 FNEND 
4390 ! 
4400 DEF FNR10354$(La$) LOCAL Lb$=16,Lc$=16,Ld$=16,Le
4410   Lb$=La$
4420   Lc$=SPACE$(8+3+3)
4430   Ld$=CHR$(33,VARPTR(Lb$),SWAP%(VARPTR(Lb$)),1,LEN(Lb$),0,205,99,0,33,255,255,216,35,201)
4440   IF CALL(VARPTR(Ld$),VARPTR(Lc$)) THEN RETURN ''
4450   Le=PEEK2(-133)
4460   WHILE Le
4470     IF CHR$(PEEK(Le+2),PEEK(Le+3),PEEK(Le+4))=MID$(Lc$,12,3) THEN RETURN CHR$(PEEK(Le+7),255)+Lc$
4480     Le=PEEK2(Le)
4490   WEND 
4500   RETURN CHR$(254,255)+Lc$
4510 FNEND 
4520 ! 
4530 DEF FNR11266$ LOCAL La,Lb,Lc,Ld$=80
4540   READ La
4550   FOR I1=1 TO La
4560     READ Lb,Lc,Ld$
4570     ; CUR(Lb,Lc) Ld$
4580   NEXT I1 
4590   RETURN ""
4600 FNEND 
4610 ! 
4620 DEF FNQuest(La$,Lb$)=FNR12529(La$,Lb$) 
4630 ! 
4640 DEF FNR11590$=CUR(PEEK(65363),PEEK(65362)) 
4650 ! 
4660 DEF FNR12160$ LOCAL La$=1,Lb$=4
4670   Lb$=FNR11590$
4680   POKE 32767, NOT PEEK(31743)
4690   IF PEEK(32767)=PEEK(31743) THEN 4730
4700   H2=30720+80*PEEK(65363)+PEEK(65362)
4710   OUT 56,14,57,SWAP%(H2),56,15,57,H2,56,10,57,103
4720   GOTO 4750
4730   H2=31744+PEEK(65363)*128-PEEK(65363)/8*984+PEEK(65362)
4740   POKE H2,PEEK(H2) OR 128
4750   IF SYS(5)=0 THEN 4750
4760   GET La$
4770   IF La$=CHR$(247) THEN ; FNR12427$; : GOTO 4750 ELSE ; Lb$; : RETURN La$
4780 FNEND 
4790 ! 
4800 DEF FNR12427$='' 
4810 ! 
4820 DEF FNMess(Text$)
4830   PRINT CUR(22,0) SPACE$(80) CUR(22,0) Text$;
4840   RETURN 0
4850 FNEND 
4860 ! 
4870 DEF FNR12478$(La) LOCAL Lb
4880   Lb=21
4890   RETURN CUR(2*La+0,Lb)
4900 FNEND 
4910 ! 
4920 DEF FNR12529(La$,Lb$) LOCAL Lc$=1,Ld
4930   Ld=FNMess(La$+" (J/N)? ")
4940   Lc$=FNInput$(1.,Lb$,'',0)
4950   Lc$=FNRise$(Lc$) : IF Lc$<>'J' AND Lc$<>'N' THEN 4940
4960   ; CUR(22,0) SPACE$(80);
4970   RETURN INSTR(1," jJ",Lc$)>1
4980 FNEND 
4990 ! 
5000 DEF FNR12642$(La$,Lb$) LOCAL Lc,Ld,Le,Lf,Lg,Lh$=1,Li$=4,Lj$=80,Lk,Ll,Lm$=1,Ln,Lo,Lp,Lq,Lr
5010   S$="NF"
5020   D2=-1
5030   Le=-1
5040   Lc=1
5050   ON ERROR GOTO 5710
5060   Lf=VAL(LEFT$(La$,1))
5070   Lg=ASCII(RIGHT$(La$,2))
5080   Lf=VAL(LEFT$(La$,2))
5090   Lg=ASCII(RIGHT$(La$,3))
5100   ON ERROR GOTO 
5110   Lh$=RIGHT$(La$,LEN(La$))
5120   Li$=FNR11590$
5130   Lj$=Lb$
5140   IF LEN(Lj$)>Lf THEN Lj$=LEFT$(Lj$,Lf)
5150   IF (Lg AND 95)=65 OR Lg=86 THEN GOTO 5170
5160   IF ASCII(Lj$)=45 THEN Lp=1 : Lj$=RIGHT$(Lj$,2)
5170   Lk=LEN(Lj$)
5180   IF Ll<1 THEN Ll=1 ELSE IF Ll>Lk THEN Ll=Lk+1
5190   IF Lk+Lp=0 THEN Le=-1
5200   ; Li$ CHR$(45*Lp);
5210   IF Lg=ASCII('a') THEN ; STRING$(LEN(Lj$),ASCII('*')); ELSE ; Lj$;
5220   ; STRING$(Lf-Lk-Lp,32+Lc*63) STRING$(Lf-Ll-Lp+1,8);
5230   Lm$=FNR12160$
5240   IF INSTR(1,A1$,Lm$)>0 AND Le THEN D2=0 : S$=Lm$ : GOTO 5630
5250   Ln=ASCII(Lm$)
5260   IF Ln>31 AND Ln<128 AND Lc THEN GOTO 5360
5270   IF Ln=13 THEN GOTO 5590
5280   IF Ln=24 THEN Lj$="" : Lc=1 : Lp=0 : Le=-1
5290   Ll=Ll+(Ln=8)-(Ln=9)
5300   IF Ln=199 AND Lg=80 THEN IF ASCII(RIGHT$(Lj$,Ll))=46 THEN Lj$=LEFT$(Lj$,Ll)
5310   IF Ln=199 THEN Lc=1 : IF Lk>0 THEN Lj$=LEFT$(Lj$,Ll-1+(Ll>Lk))+RIGHT$(Lj$,Ll-(Ll<=Lk)) ELSE Lp=0
5320   IF INSTR(1,CHR$(8,9,215,199,247),Lm$) THEN Le=0 : GOTO 5170
5330   Lo=INSTR(1,CHR$(196,212,192,198,214),Lm$)
5340   IF Lo=0 THEN 5170 ELSE IF NOT Le THEN 5170
5350   IF Lo=3 AND P<>1 THEN 5170 ELSE S$=MID$("CUCHEXCDCE",Lo*2-1,2) : D2=0 : GOTO 5590
5360   Ld=INSTR(1,R1$,Lm$)
5370   IF (Lg AND 95)=65 THEN 5480 ELSE IF Lg=86 THEN IF Ld THEN 5480 ELSE 5460
5380   IF Ld AND Le THEN Lc=0 : Ll=2 : Lj$=Lm$ : Lp=0 : GOTO 5170
5390   Lq=Lm$="-" AND Lh$="-"
5400   IF Lq AND Le THEN GOTO 5560
5410   IF Lq AND Lg=80 AND INSTR(1,Lj$+".",".")>Lf-3+Lp THEN GOTO 5460
5420   IF Lq AND Lk<Lf+Lp THEN Lp=1-Lp : GOTO 5560
5430   IF Lm$="." AND Lg<>72 AND (INSTR(1,Lj$,".")=0 OR Le) THEN GOTO 5480
5440   IF Lg=80 AND INSTR(1,Lj$+".",".")>Lf-3-Lp AND Ll<=INSTR(1,Lj$+".",".") AND Le=0 THEN GOTO 5460
5450   IF Lm$>="0" AND Lm$<="9" THEN GOTO 5480
5460   ; CHR$(7);
5470   GOTO 5170
5480   IF Le THEN 5540
5490   IF LEN(Lj$)=Lf-Lp THEN 5460
5500   Lj$=LEFT$(Lj$,Ll-1)+Lm$+RIGHT$(Lj$,Ll)
5510   IF (Lg AND 95)=65 OR Lg=86 THEN 5540
5520   IF ASCII(Lj$)=48 AND CVT$%(Lj$+".")<>11824 THEN Lj$=RIGHT$(Lj$,2) : Ll=Ll-1
5530   IF Lg=80 AND INSTR(1,Lj$+".",".")<LEN(Lj$)-2 THEN Lj$=LEFT$(Lj$,Ll-1)+RIGHT$(Lj$,Ll+1) : GOTO 5460
5540   Ll=Ll+1
5550   IF Le THEN Lp=0
5560   IF Le THEN Lj$=Lm$
5570   Le=0
5580   GOTO 5150
5590   ON ERROR GOTO 5720
5600   IF Lg=80 AND LEN(Lj$) THEN Lj$=ADD$(Lj$,"0",2)
5610   IF (Lg=70 OR Lg=80 OR Lg=72) AND (Lj$="." OR (Lp AND Lj$="")) THEN 5460
5620   IF Lp THEN Lj$="-"+Lj$
5630   Lr=Lf-LEN(Lj$)
5640   IF Lr<0 THEN Lr=0
5650   ; Li$;
5660   IF Lg=ASCII('a') THEN ; STRING$(LEN(Lj$),ASCII('*')); ELSE ; Lj$;
5670   ; SPACE$(Lr) Li$;
5680   R1$=""
5690   A1$=""
5700   RETURN Lj$
5710   GOTO 5100
5720   GOTO 5610
5730 FNEND 
5740 ! 
5750 DEF FNError(Text$) LOCAL Z
5760   Z=FNMess(CHR$(7)+"> "+Text$+" <")
5770   IF INSTR(1,CHR$(24),FNR12160$)=0 THEN 5770 ELSE ; CUR(22,0) SPACE$(80); : RETURN 0
5780 FNEND 
5790 ! 
5800 DEF FNR14513$(La,Lb$) LOCAL Lc$=2,Ld
5810   Lc$='  '
5820   Ld=ASCII(MID$(Lb$,La-3,1))
5830   IF (Ld AND 1)=1 THEN Lc$='S '
5840   IF (Ld AND 2)=2 THEN MID$(Lc$,2,1)='R'
5850   RETURN Lc$
5860 FNEND 
5870 ! 
5880 DEF FNR14604$(La,Lb,Lc,Ld$,Le) LOCAL Lf$=12,Lg$=33,Lh$=6,Li,Lj
5890   Lg$=CHR$(17,0,245,33,0,0,26,254,255,40,15,6,8,203,39,56,6,197,1,1,0,9,193,5,32,243,19,62,161,187,32,230,201)
5900   Li=Lc+1
5910   IF Le=0 AND Lc=192 AND Lb=1 THEN Li=32*(Lc/32+1)
5920   IF Le=0 AND Lb=4 THEN Li=Lb*(((Li AND 3)+8*(Li AND 65532))/32)
5930   Lj=FNR16767(La,Li)
5940   IF Lj THEN 6060
5950   Lj=CALL(VARPTR(Lg$))*Lb
5960   Lh$=NUM$(-(Lj AND 32768)*2.+Lj)
5970   Lf$=SPACE$(5-LEN(Lh$))+Lh$
5980   Li=Lc
5990   IF Le=0 AND Lb=4 THEN Li=Lb*(((Li AND 3)+8*(Li AND 65532))/32)
6000   Lj=FNR16767(La,Li)
6010   IF Lj THEN 6060
6020   Lj=CALL(VARPTR(Lg$))*Lb
6030   Lh$=NUM$(-(Lj AND 32768)*2.+Lj)
6040   Lf$=Lf$+SPACE$(5-LEN(Lh$))+Lh$
6050   Lj=0
6060   RETURN CHR$(Lj)+Lf$
6070 FNEND 
6080 ! 
6090 DEF FNR15030$(La$,Lb$,Lc,Ld$) LOCAL Le,Lf,Lg,Lh,Li,Lj,Lk,Ll,Lm,Ln$=0,Lo$=16,Lp$=19,Lq,Lr,Ls,Lt,Lu,Lv$=4,Lw
6100   POKE VAROOT(Ln$),256,SWAP%(256),62720,SWAP%(62720),256,SWAP%(256)
6110   IF LEN(La$)<>4 THEN Le=-1 : GOTO 7000
6120   IF MID$(La$,3,1)<'0' OR MID$(La$,3,1)>'9' THEN Lv$=LEFT$(La$,3) ELSE Lv$=LEFT$(La$,2)
6130   IF MID$(La$,3,1)<'0' OR MID$(La$,3,1)>'9' THEN Lw=0 ELSE Lw=VAL(MID$(La$,3,1))
6140   Lv$=FNR16675$(Lv$)
6150   Le=FNR17309(Lv$)
6160   IF Lv$='RAM' THEN Lv$='RM' : Lw=1
6170   IF Le=-1 THEN 7000
6180   Lf=FNR17456
6190   IF Lf<>0 THEN 6300
6200   Lh=FNR17518
6210   IF Lh=-1 OR INSTR(1,'DR',Lv$)=0 THEN Le=-1 : GOTO 7000
6220   Li=16
6230   IF Lh=44 THEN Lj=16 ELSE Lj=8
6240   IF Lh=44 THEN Lk=1 ELSE Lk=0
6250   IF Lh=44 THEN Lg=4 ELSE Lg=1
6260   IF Lh=44 THEN Lm=14 ELSE Lm=6
6270   Ll=Ll+Lw
6280   Lo$='DR'
6290   GOTO 6600
6300   IF Lf<>1 THEN 6430
6310   Ll=FNR17622
6320   IF Ll=-1 OR INSTR(1,'DRMFSF',Lv$)=0 THEN Le=-1 : GOTO 7000
6330   IF Lv$='MF' THEN Ll=8
6340   IF Lv$='SF' THEN Ll=0
6350   IF Ll=8 THEN Lo$='MF' ELSE Lo$='SF'
6360   IF Ll=8 THEN Lh=45 ELSE Lh=44
6370   Ll=Ll+Lw
6380   Li=16
6390   Lj=16
6400   Lm=14
6410   Lg=4
6420   GOTO 6600
6430   IF INSTR(1,'DRHDMOMFSFUFDRM',Lv$)=0 THEN Le=-1 : GOTO 7000
6440   Lt=PEEK2(24683)
6450   Ll=PEEK(Lt)
6460   Lj=16
6470   Lm=14
6480   Lg=2^(PEEK(Lt+Ll+1) AND 7)
6490   IF Lv$<>'UFD' THEN 6540
6500   Li=PEEK2(65527)
6510   Ll=PEEK(65529)
6520   Lg=2^(PEEK(Lt+Ll+1) AND 7)
6530   GOTO 6600
6540   IF Lv$<>'' AND Lv$<>'DR' THEN Ll=FNR17369(Lv$)
6550   Li=16
6560   Lo$=CHR$(PEEK(Lt+Ll+2),PEEK(Lt+Ll+3))
6570   Lg=2^(PEEK(Lt+Ll+1) AND 7)
6580   IF (PEEK(Lt+Ll+1) AND 64)=64 THEN Lk=1 ELSE Lk=0
6590   Ll=Ll+Lw
6600   IF Lf=0 AND Lj=8 THEN Lq=32 ELSE Lq=1
6610   IF Lo$='MO' OR Lj=8 THEN Lu=6*Lq ELSE Lu=14
6620   Lm=Lu
6630   IF Lk=1 AND Li=16 THEN Lu=(Lu AND 3)+8*(Lu AND 65532)
6640   IF Lv$='UFD' THEN Lu=Li-1
6650   Le=FNR16767(Ll,Lu)
6660   IF Le THEN 7000
6670   Lo$=MID$(Ln$,240,16)
6680   MID$(Ld$,1,2)=CHR$(0,0)
6690   Lr=0
6700   WHILE Lr<Lj
6710     IF ASCII(MID$(Lo$,Lr+1,1))<1 THEN MID$(Ld$,1,1)=CHR$(ASCII(Ld$)+16) : GOTO 6930
6720     Lu=(Li+Lr)*Lq
6730     IF Lk=1 AND Li=16 THEN Lu=(Lu AND 3)+8*(Lu AND 65532)
6740     Le=FNR16767(Ll,Lu)
6750     IF Le THEN 7000
6760     Ls=5
6770     WHILE Ls<LEN(Ln$)
6780       Lp$=MID$(Ln$,Ls,11)
6790       IF ASCII(Lp$)<>0 THEN MID$(Ld$,1,1)=CHR$(ASCII(Ld$)+1)
6800       IF ASCII(Lp$)<32 OR ASCII(Lp$)>127 THEN Lp$='' ELSE Lp$=LEFT$(Lp$,8)+'.'+RIGHT$(Lp$,9)
6810       IF Lp$='' THEN 6910
6820       MID$(Ld$,2,1)=CHR$(ASCII(MID$(Ld$,2,1))+1)
6830       IF FNR16881$(Lb$)='' THEN 6850
6840       IF FNR16951(FNR16881$(Lb$),FNR16881$(Lp$))<>-1 THEN 6910
6850       IF Lc AND 1 THEN STOP ! Lp$=Lp$+FNR14176$(Ls,Ln$,Lg,Lf)
6860       IF Lc AND 2 THEN Lp$=Lp$+FNR14513$(Ls,Ln$)
6870       IF Lc AND 8 THEN IF INSTR(1,Lp$,'.Ufd')<>0 THEN 6910
6880       IF Lc AND 8 THEN IF Lp$='SYSDIR  .SYS' THEN 6910
6890       Le=LEN(Lp$)
6900       IF Lc AND 4 THEN MID$(Ld$,3,LEN(Ld$)-2)=FNR17125$(RIGHT$(Ld$,3),Lp$) ELSE MID$(Ld$,INSTR(1,Ld$,STRING$(Le,255)),Le)=Lp$
6910       Ls=Ls+16
6920     WEND 
6930     Lr=Lr+1
6940   WEND 
6950   Le=INSTR(1,Ld$,STRING$(12,255))
6960   Lo$=FNR14604$(Ll,Lg,Lm,Ln$,Lf)
6970   Le=ASCII(Lo$)
6980   IF Le THEN 7000
6990   Lo$=RIGHT$(Lo$,2)
7000   IF INSTR(3,Ld$,STRING$(12,255))<>0 THEN RETURN CHR$(Le)+Lo$+LEFT$(Ld$,INSTR(3,Ld$,STRING$(12,255))-1) ELSE RETURN CHR$(Le)+Lo$+Ld$
7010 FNEND 
7020 ! 
7030 DEF FNR16675$(La$)
7040   IF LEN(La$)=0 THEN RETURN ''
7050   IF ASCII(La$)>95 AND ASCII(La$)<127 THEN RETURN CHR$(ASCII(La$) AND 95)+FNR16675$(RIGHT$(La$,2))
7060   RETURN LEFT$(La$,1)+FNR16675$(RIGHT$(La$,2))
7070 FNEND 
7080 ! 
7090 DEF FNR16767(La,Lb) LOCAL Lc
7100   POKE 64769,La
7110   Lc=CALL(24678,Lb)
7120   IF PEEK(64789)=0 THEN RETURN 0
7130   IF (PEEK(64789) AND 128)=128 THEN RETURN 42
7140   IF (PEEK(64789) AND 16)=16 THEN RETURN 48
7150   IF (PEEK(64789) AND 8)=8 THEN RETURN 48
7160   RETURN -1
7170 FNEND 
7180 ! 
7190 DEF FNR16881$(La$)
7200   IF LEN(La$)=0 THEN RETURN ''
7210   IF ASCII(La$)=32 THEN RETURN FNR16881$(RIGHT$(La$,2))
7220   RETURN LEFT$(La$,1)+FNR16881$(RIGHT$(La$,2))
7230 FNEND 
7240 ! 
7250 DEF FNR16951(La$,Lb$) LOCAL Lc$=60,Ld$=12
7260   Lc$=FNR16675$(La$)
7270   Ld$=FNR16675$(Lb$)
7280   IF INSTR(1,Lc$,'*')<>0 THEN RETURN 0
7290   IF INSTR(1,Lc$,'?')<>0 THEN RETURN 0
7300   IF INSTR(1,Lc$,'/')<>0 THEN RETURN 0
7310   IF LEN(Ld$)<LEN(Lc$) THEN RETURN 0
7320   IF LEFT$(Lc$,1)='.' THEN IF INSTR(1,Ld$,Lc$)<>0 THEN RETURN -1
7330   IF LEFT$(Lc$,LEN(Lc$))=LEFT$(Ld$,LEN(Lc$)) THEN RETURN -1
7340   RETURN 0
7350 FNEND 
7360 ! 
7370 DEF FNR17125$(La$,Lb$) LOCAL Lc,Ld,Le,Lf
7380   Lf=LEN(Lb$)
7390   Le=LEN(La$)/Lf-1
7400   WHILE Lc<>Le
7410     Ld=(Lc+Le)/2
7420     IF Lb$<MID$(La$,Ld*Lf+1,Lf) THEN Le=Ld ELSE Lc=Ld+1
7430   WEND 
7440   MID$(La$,Lc*Lf+1,LEN(La$)-Lc*Lf)=Lb$+MID$(La$,Lc*Lf+1,LEN(La$)-Lc*Lf-Lf)
7450   RETURN La$
7460 FNEND 
7470 ! 
7480 DEF FNR17309(La$)
7490   IF INSTR(1,'DR MF MO SF HD UFD RAM ',La$+' ')=0 THEN RETURN -1 ELSE RETURN 0
7500 FNEND 
7510 ! 
7520 DEF FNR17369(La$) LOCAL Lb,Lc
7530   Lb=PEEK2(24683)
7540   Lc=2
7550   WHILE CHR$(PEEK(Lc+Lb),PEEK(Lb+Lc+1))<>La$ AND Lc<=32
7560     Lc=Lc+4
7570   WEND 
7580   RETURN Lc-2
7590 FNEND 
7600 ! 
7610 DEF FNR17456
7620   IF PEEK(24678)<>195 THEN RETURN 0
7630   IF PEEK2(PEEK2(24681)+2)<>ASCII("R")*256+ASCII("D") THEN RETURN 1
7640   RETURN PEEK(24687)
7650 FNEND 
7660 ! 
7670 DEF FNR17518 LOCAL La,Lb
7680   OUT 1,44
7690   IF INP(1)=255 THEN La=0 ELSE La=-1
7700   OUT 1,45
7710   IF INP(1)=255 THEN Lb=0 ELSE Lb=-1
7720   IF La=Lb THEN RETURN -1
7730   IF La THEN RETURN 44
7740   RETURN 45
7750 FNEND 
7760 ! 
7770 DEF FNR17622
7780   IF PEEK(PEEK2(24682))=8 THEN RETURN 0
7790   IF PEEK(PEEK2(24682))=16 THEN RETURN 8
7800   RETURN -1
7810 FNEND 
7820 ! 
7830 DEF FNScr$=CHR$(12)+'** MAPP **'+CUR(1,0)+STRING$(80,45) 
7840 ! 
7850 DEF FNPutmap(Fil$,Nr)
7860   POSIT #Map,23*(Nr-1)
7870   PUT #Map,LEFT$(Fil$,8)+RIGHT$(Fil$,10) ! 11 tkn filnamn
7880   PUT #Map,CVTF$(0)+CVTF$(0)+CVTF$(VAL(FNGt$))
7890   ! 
7900   Pos.=2100.
7910   WHILE Nr<>1
7920     POSIT #Map,23*(Nr-2)+11 ! L{s f|reg}ende pos.
7930     GET #Map A$ COUNT 4
7940     Pos.=CVT$F(A$)
7950     GET #Map A$ COUNT 4
7960     Pos.=Pos.+CVT$F(A$)
7970   IF 0 WEND 
7980   ! 
7990   POSIT #Map,23*(Nr-1)+11
8000   PUT #Map CVTF$(Pos.)
8010   POSIT #Map,Pos.
8020   ! 
8030   L{ngd.=0
8040   ON ERROR GOTO 8120
8050   WHILE 1
8060     GET #Source A$ COUNT 253
8070     L{ngd.=L{ngd.+253
8080     PUT #Map A$
8090     ; CUR(12,0); : ; USING '##### bytes inlagda' L{ngd.
8100   WEND 
8110   ! 
8120   IF ERRCODE<>38 RETURN 1
8130   CLOSE Source
8140   POSIT #Map,(Nr-1)*23+15
8150   PUT #Map CVTF$(L{ngd.)
8160   RETURN 0
8170 FNEND 
8180 ! 
8190 DEF FNGt$=MID$(TIME$,3,2)+MID$(TIME$,6,2)+MID$(TIME$,9,2) 
8200 ! 
8210 DEF FNInmapp$ LOCAL Mapp$=16,Z
8220   Mapp$=FNInput$(12,'',CUR(8,14)+'Mappnamn: ',0)
8230   IF Pf1 RETURN ''
8240   IF INSTR(1,Mapp$,'.') Z=FNError('Mappnamnet f}r ej inneh}lla extension') : GOTO 8220
8250   Mapp$=FNRise$(Mapp$)+'.MAP'
8260   RETURN Mapp$
8270 FNEND 
8280 ! 
8290 DEF FNGetmap LOCAL A$=253,Fil$=12,L{ngd,L{ngd2,Z,Nummer
8300   ! 
8310   ON ERROR GOTO 8600
8320   ; FNScr$
8330   GET #Map A$ COUNT 23
8340   WHILE ASCII(A$)<>0 ! Slut p} listan
8350     Fil$=LEFT$(A$,8)+'.'+MID$(A$,9,3)
8360     ; CUR(10,0) 'Packar upp ' Fil$
8370     Fil$=FNSpc$(Fil$)
8380     ON ERROR GOTO 8420
8390     OPEN Fil$ AS FILE 1 : CLOSE 1
8400     IF NOT FNQuest('Filen "'+Fil$+'" finns redan, |verskrivas','') 8330
8410     ON ERROR GOTO 8600
8420     PREPARE Fil$ AS FILE 1
8430     POSIT #Map,CVT$F(MID$(A$,12,4)) ! Position i mappen
8440     L{ngd=CVT$F(MID$(A$,16,4))
8450     L{ngd2=0
8460     ! 
8470     WHILE L{ngd2<>L{ngd
8480       GET #Map A$ COUNT 253
8490       L{ngd2=L{ngd2+253
8500       PUT #1,A$
8510     WEND 
8520     ! 
8530     CLOSE 1 : Nummer=Nummer+1
8540     POSIT #Map,Nummer*23
8550     GET #Map A$ COUNT 23
8560   WEND 
8570   CLOSE Map
8580   Z=FNError('Rutinen klar')
8590   RETURN 0
8600   Z=FNError('Rutinen ej klar, felkod '+NUM$(ERRCODE))
8610   CLOSE : RETURN 1
8620 FNEND