home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / luxorabc800 / kmain.bas < prev    next >
BASIC Source File  |  2020-01-01  |  35KB  |  815 lines
  1. 2 ! **********************************************************************
  2. 3 ! Program          KMAIN.BAS        Utg}va  4.11     1990-02-17
  3. 4 ! av Bo Kullmar, 1789
  4. 6 ! F|r ABC800M ABC802 ABC806 DTC2
  5. 8 ! Testad p} ABC806
  6. 9 ! Se vidare K.BAS.
  7. 21 ! [ndra inte radnummreringen f|r Kermitrutinerna, f|r d} upph|r likheten
  8. 22 ! med monitorns Kermitrutiner!
  9. 23 ! **********************************************************************
  10. 30 EXTEND : INTEGER : OPTION BASE 0
  11. 60 COMMON V24def$=16,Oldprom,Mtyp,Key99,Enh$=4,Enh,Printer$=16,Version$=4,Mqbin,Pack$=376,Csum$=40
  12. 80 IF PEEK(39)=6 THEN Dtc2=-1 ! ta reda p} om det {r en DTC 2
  13. 1000 Dummy=FNInit
  14. 1010 IF FNF|rbindelse Rutin=FNMeny(1) ELSE Slut=-1
  15. 1020 WHILE NOT Slut
  16. 1030   IF Rutin=2 Eko=0 : Rutin=1
  17. 1040   IF Rutin=3 Eko=-1 : Rutin=1
  18. 1050   WHILE Rutin=4 ! Ta emot filer med Kermit
  19. 1060     Dummy=FNDisplaykermit
  20. 1070     ; CUR(3,0) FNF$(YEL) 'Mottag filer med Kermit'+Avbryt$
  21. 1075     ; FNF$(YEL) 'Avbryt fil|verf|ringen med PF1' SPACE$(9)+'Avbryt |verf|ringen av alla filer med PF8'
  22. 1080     CLOSE 20,30 : S{nd=0 : Dump=0 : Nfile=FNFiles(-1) : IF Nfile=-1 OR Ec=-1 GOTO 1260
  23. 1090     IF Mqbin=89 Dummy=FNMaskabit7(0,V24)
  24. 1100     Dummy=FNRe(Im,1,5)
  25. 1110     IF Dummy=0 Dummy=FNFel('Ok, klart')
  26. 1115     IF Dummy=-2 Rutin=100
  27. 1120     IF Mqbin=89 Dummy=FNMaskabit7(-1,V24)
  28. 1130   IF 0 WEND
  29. 1140   IF Rutin=5 AND Dump=0 IF FNRfil Rutin=1
  30. 1150   IF Rutin=7 Dump=0 : CLOSE 30 : Rutin=1
  31. 1160   WHILE Rutin=6 ! S{nd filer med Kermit
  32. 1170     Dummy=FNDisplaykermit
  33. 1180     ; CUR(3,0) FNF$(YEL) 'S{nd filer med Kermit  '+Avbryt$
  34. 1185     ; FNF$(YEL) 'Avbryt fil|verf|ringen med PF1' SPACE$(9)+'Avbryt |verf|ringen av alla filer med PF8'
  35. 1190     CLOSE 20,30 : S{nd=0 : Dump=0 : Nfile=FNFiles(0)
  36. 1200     IF Nfile=0 OR Nfile=-1 OR Ec=-1 GOTO 1260
  37. 1210     IF Mqbin=89 Dummy=FNMaskabit7(0,V24)
  38. 1220     IF Nfile>0 Dummy=FNSw('',Im,1,ASCII('#'),Chktyp,5) : GOTO 1240
  39. 1230     IF Nfile-2 Dummy=FNSw(File$(1),Im,1,ASCII('#'),Chktyp,5)
  40. 1240     IF Dummy=0 Dummy=FNFel('Ok, klart')
  41. 1245     IF Dummy=-2 Rutin=100
  42. 1250     IF Mqbin=89 Dummy=FNMaskabit7(-1,V24)
  43. 1260   IF 0 WEND
  44. 1270   IF Rutin=8 AND S{nd=0 IF FNSfil Rutin=1
  45. 1280   IF Rutin=9 Im=NOT Im
  46. 1290   IF Rutin=10 Enh$=FNDefenh$
  47. 1295   IF Rutin=11 IF Chktyp=1 Chktyp=2 ELSE Chktyp=1
  48. 1300   IF Rutin=1 Dummy=FNConnect
  49. 1305   IF Rutin=100 Rutin=1 : Dummy=FNTerm
  50. 1310   IF Rutin=12 Slut=-1 : GOTO 1330
  51. 1320   Rutin=FNMeny(Rutin)
  52. 1330 WEND
  53. 1340 END
  54. 1350 DEF FNInit
  55. 1351   ON ERROR GOTO 1495
  56. 1357   IF V24def$='' ; CHR$(12) FNF$(RED) 'Du m}ste starta med '+Enh$+'K, detta g|rs nu automatiskt!' : CHAIN Enh$+'K'
  57. 1358   ON ERROR GOTO
  58. 1370   DIM Oldsk{rm$=2048,Dirmap$=16,Dirrec$=256,File$(20)=16,Enh$(20)=4,Esc$=1,V24buff$=400
  59. 1380   POKE VAROOT(Sk{rm$),0,8,30720,SWAP%(30720),0,8
  60. 1390   POKE VAROOT(Dosbuff$),0,1,0,245,0,1
  61. 1400   POKE VAROOT(Textbuff$),0,2,0,250,0,0
  62. 1405   POKE PEEK2(65500)+2,VAROOT(V24buff$),SWAP%(VAROOT(V24buff$))
  63. 1410   V24=9 : Inlu=2 : Outlu=3 : Chktyp=1
  64. 1420   ; CHR$(12)
  65. 1430   Huvud$=CUR(0,0)+FNF$(CYA)+'K, KERMIT-program f|r ABC800-serien, version '+Version$
  66. 1440   Cu=PEEK2(SYS(10)+64)+6
  67. 1450   IF PEEK2(PEEK2(65500))>=10 THEN V24xoff=PEEK2(65500)+37 ! (Trol 33 f|r ver 8)
  68. 1455   V24tkn=PEEK2(65500)+6 : V24ut=PEEK2(65500)+4
  69. 1460   IF Key99 Avbryt$=SPACE$(16)+'Avbryt inmatningen med STOP' ELSE Avbryt$=SPACE$(16)+'Avbryt inmatningen med PF1'
  70. 1480   Eko=-1 : Im=0
  71. 1490   RETURN 0
  72. 1495   ; FNF$(RED) 'Beklagar, hittar ej '+Enh$+'K och kan d{rf|r inte starta programmet!' : STOP
  73. 1500 FNEND
  74. 1510 DEF FNConnect LOCAL I
  75. 1520   ; CUR(16,0) FNF$(YEL) 'Kermit: uppkopplad - terminalmod - PF1 till meny.'
  76. 1530   WHILE I<1200 : I=I+1 : WEND
  77. 1540   RETURN FNTerm
  78. 1550 FNEND
  79. 1560 DEF FNDefenh$ LOCAL E$=4
  80. 1570   ; CUR(17,0) FNF$(YEL) 'Specificera standardenhet'+Avbryt$
  81. 1580   E$=FNVersal$(FNSpbort$(FNInmata$('',18,0,1,2,4,CYA+CHR$(138)))) : IF E$=CHR$(27) OR E$='' RETURN Enh$
  82. 1590   WHILE FNEnhcs(E$)=-1
  83. 1600     Dummy=FNFel('Felaktig enhet!')
  84. 1610     E$=FNVersal$(FNSpbort$(FNInmata$('',18,0,1,2,4,CYA+CHR$(138)))) : IF E$=CHR$(27) OR E$='' RETURN Enh$
  85. 1620   WEND
  86. 1630   RETURN E$
  87. 1640 FNEND
  88. 1650 DEF FNFiles(Rsw) LOCAL Nfile,Aa$=162,I,Bin$=10
  89. 1655   IF Im Bin$='Bin{rfiler' ELSE Bin$='Textfiler'
  90. 1660   Nfile=0
  91. 1665   ; CUR(5,0) FNF$(YEL) 'Standardenhet: ' FNF$(CYA) Enh$ : ; CUR(5,39) FNF$(YEL) 'Filtyp: ' FNF$(CYA) Bin$ : ; CUR(7,0) FNF$(YEL) 'Ange filnamn:';
  92. 1670   IF Rutin=4 ; TAB(40) 'Lokalt filnamn beh|ver ej anges'
  93. 1680   IF Rutin=6 AND (PEEK(24688)=0 OR PEEK(24688)=8) ; TAB(40) 'Jokertecken "*" och "?" kan anv{ndas'
  94. 1690   Aa$=FNVersal$(FNSpbort$(FNInmata$('',8,0,1,2,75,CYA+CHR$(138)))) : IF Aa$=CHR$(27) RETURN -1
  95. 1700   ; CUR(8,0) FNF$(CYA) Aa$+SPACE$(77-LEN(Aa$))
  96. 1710   WHILE Rsw=0 AND (INSTR(1,Aa$,'?') OR INSTR(1,Aa$,'*'))
  97. 1720     IF PEEK(24688)<>0 AND PEEK(24688)<>8 RETURN FNFel('Jokertecken kan enbart anv{ndas f|r UFD och LUX-NET DOS!')
  98. 1730     IF LEN(Aa$)>16 RETURN FNFel('F|r l}ngt filnamn!')
  99. 1740     File$(1)=Aa$
  100. 1750     Ec=FNKollenh(1) : IF Ec=-1 RETURN FNFel('Felaktig enhet!')
  101. 1760     RETURN -2
  102. 1770   WEND
  103. 1780   IF Aa$='' Enh$(1)='' : RETURN 0
  104. 1790   Nfile=Nfile+1
  105. 1800   K=INSTR(1,Aa$,',')
  106. 1810   WHILE K
  107. 1820     IF LEN(LEFT$(Aa$,K-1))>16 RETURN FNFel('F|r l}ngt filnamn!')
  108. 1830     File$(Nfile)=LEFT$(Aa$,K-1) : Aa$=RIGHT$(Aa$,K+1)
  109. 1840     Ec=FNKollenh(Nfile) : IF Ec=-1 RETURN FNFel('Felaktig enhet!')
  110. 1850     Nfile=Nfile+1
  111. 1860     K=INSTR(1,Aa$,',')
  112. 1870     IF Nfile>20 ; FNFel('Max 20 filnamn kan matas in!') : RETURN 0
  113. 1880   WEND
  114. 1890   IF LEN(Aa$)>16 RETURN FNFel('F|r l}ngt filnamn!')
  115. 1900   File$(Nfile)=Aa$
  116. 1910   Ec=FNKollenh(Nfile) : IF Ec=-1 RETURN FNFel('Felaktig enhet!')
  117. 1920   IF Rsw RETURN Nfile
  118. 1930   ON ERROR GOTO 1960
  119. 1940   I=1
  120. 1942   WHILE I<=Nfile
  121. 1943     IF Enh$(I)='' Enh$(I)=Enh$
  122. 1944     OPEN Enh$(I)+File$(I) AS FILE 2
  123. 1946     CLOSE 2 : I=I+1
  124. 1948   WEND
  125. 1950   ON ERROR GOTO : RETURN Nfile
  126. 1960   ON ERROR GOTO : RETURN FNFel('Fil: '+Enh$(I)+File$(I)+' finns inte - avbryter !')
  127. 1970 FNEND
  128. 1980 DEF FNTerm LOCAL Ctrlc
  129. 1990   Ctrlc=PEEK2(65413) : POKE 65413,0,0
  130. 1994   ; CHR$(12);
  131. 2000   IF Sk{rmstart=30720 Sk{rm$=Oldsk{rm$ ELSE Sk{rm$=RIGHT$(Oldsk{rm$,Sk{rmstart-30719)+LEFT$(Oldsk{rm$,Sk{rmstart-30720)
  132. 2010   POKE Cu,Kol,Rad
  133. 2015   IF V24xoff THEN POKE V24xoff,PEEK(V24xoff) AND 253 ! Bryt XOFF
  134. 2020   Slut=0
  135. 2030   Dummy=FNCursor
  136. 2040   WHILE NOT Slut
  137. 2050     IF PEEK2(V24tkn)<>0 Z=FNV24in
  138. 2060     IF SYS(5)>127 OR S{nd Z=FNTeckin
  139. 2070   WEND
  140. 2080   POKE 65413,Ctrlc,SWAP%(Ctrlc)
  141. 2090   RETURN 0
  142. 2100 FNEND
  143. 2110 DEF FNTeckin LOCAL A$=1
  144. 2120   IF S{nd ; #V24,FNS{ndline$; : RETURN 0 ELSE GET A$
  145. 2130   IF NOT Eko ; A$; : IF Dump ; #30,A$;
  146. 2140   IF ASCII(A$)=192 Slut=-1 : RETURN 0
  147. 2150   IF NOT Dtc2 IF ASCII(A$)=(130 AND Key99 OR 215 AND NOT Key99) THEN RETURN FNDump
  148. 2160   ; #V24,A$;
  149. 2170   RETURN 0
  150. 2180 FNEND
  151. 2190 DEF FNV24in LOCAL A,Buff$=80,I
  152. 2195   A=PEEK2(PEEK2(65500)+6) : IF A>80 A=80
  153. 2200   GET #V24,Buff$ COUNT A
  154. 2205   WHILE Oldprom : I=LEN(Buff$) : WHILE I
  155. 2210       MID$(Buff$,I,1)=CHR$(ASCII(MID$(Buff$,I,1)) AND 127) : I=I-1
  156. 2215   WEND : WEND
  157. 2220   RETURN FNSk{rm(Buff$)
  158. 2225 FNEND
  159. 2250 DEF FNCursor LOCAL Rad,Kol,A
  160. 2252   IF Dtc2 2302
  161. 2260   Rad=PEEK(Cu+1) : Kol=PEEK(Cu) : A=30720+Rad*80+Kol
  162. 2270   OUT 56,14,57,SWAP%(A),56,15,57,A,56,10,57,104
  163. 2300   RETURN 0
  164. 2302   Rad=PEEK(Cu+1) : Kol=PEEK(Cu) : A=PEEK2(PEEK2(121)+8)+Rad*80+Kol
  165. 2303   IF A>32767 A=A-2048
  166. 2304   GOTO 2270
  167. 2305 FNEND
  168. 2310 DEF FNSk{rm(Buff$) LOCAL J,Buff1$=4,Buff2$=1
  169. 2315   Z=FNCursor : J=1
  170. 2320   WHILE J<=LEN(Buff$)
  171. 2325     Buff1$=CHR$(ASCII(RIGHT$(Buff$,J))) : Buff2$=Buff1$
  172. 2330     IF Buff1$=CHR$(27) Esc=-1
  173. 2335     IF Buff1$=CHR$(30) Buff1$=CUR(0,0)
  174. 2340     IF Buff1$=CHR$(11) Buff1$=CUR(PEEK(Cu+1)-1,PEEK(Cu))
  175. 2345     IF Buff1$=CHR$(12) IF PEEK(Cu)>=PEEK(Cu+2) Buff1$=CUR(PEEK(Cu+1)+1,0) ELSE Buff1$=CUR(PEEK(Cu+1),PEEK(Cu)+1)
  176. 2350     IF Buff1$=CHR$(26) Buff1$=CHR$(12)
  177. 2360     IF Esc IF LEN(Styr$)=3 ; Styr$+Buff1$ : Styr$='' : Esc=0 ELSE Styr$=Styr$+Buff1$
  178. 2362     IF Esc AND LEN(Styr$)=2 IF Buff1$<>'=' Buff1$=Styr$ : Styr$='' : Esc=0
  179. 2364     IF NOT Esc ; Buff1$; : IF Dump ; #30 Buff2$;
  180. 2365     J=J+1
  181. 2370   WEND
  182. 2380   RETURN FNCursor
  183. 2385 FNEND
  184. 2390 DEF FNMeny(Alt) LOCAL Rutin,F$=1,Bin$=10
  185. 2395   Slut=0
  186. 2400   IF Alt=1 Oldsk{rm$=Sk{rm$ : Rad=PEEK(Cu+1) : Kol=PEEK(Cu) : IF Dtc2 Sk{rmstart=PEEK2(PEEK2(121)+8) ELSE Sk{rmstart=30720
  187. 2405   IF Im Bin$='Bin{rfiler' ELSE Bin$='Textfiler'
  188. 2410   ; CHR$(12) : Dummy=FNClr
  189. 2420   ;
  190. 2425   ; FNF$(CYA) 'Pf 1        Koppla upp terminalf|rbindelse'
  191. 2430   ; FNF$(CYA) 'Pf 2        Lokalt eko av tecken'
  192. 2435   ; FNF$(CYA) 'SHIFT Pf 2  Ingen lokal ekning av tecken'
  193. 2440   ; FNF$(CYA) 'Pf 3        Mottag fil fr}n v{rddator med Kermit'
  194. 2445   ; FNF$(CYA) 'SHIFT Pf 3  Dumpa data till lokal fil (utan Kermit)'
  195. 2450   ; FNF$(CYA) 'CTRL  Pf 3  Avbryt dumpning till lokal fil'
  196. 2455   ; FNF$(CYA) 'Pf 4        S{nd fil till v{rddator med Kermit'
  197. 2460   ; FNF$(CYA) 'SHIFT Pf 4  Dumpa fil till v{rddator (utan Kermit)'
  198. 2465   ; FNF$(CYA) 'Pf 5        [ndra filtyp f|r Kermit,        nu = ' FNF$(YEL) Bin$
  199. 2470   ; FNF$(CYA) 'Pf 6        [ndra standardenhet f|r Kermit, nu = ' FNF$(YEL) Enh$
  200. 2472   ; FNF$(CYA) 'Pf 7        [ndra blockchecktyp f|r Kermit, nu =' FNF$(YEL) Chktyp
  201. 2475   ; FNF$(CYA) 'Pf 8        Avsluta programmet och bryt terminalf|rbindelsen'
  202. 2480   ; FNF$(CYA); : IF (Key99=0 AND NOT Dtc2) ; 'SHIFT Pf 8'; ELSE ; 'PRINT     ';
  203. 2485   ; '  Dumpa bildsk{rmen till skrivare ({ven direkt i terminalmode)'
  204. 2490   WHILE Rutin=0
  205. 2495     ; CUR(17,0) FNF$(YEL) 'V{lj funktion:  ' CHR$(8); : F$=FNTkn$(YEL)
  206. 2500     Rutin=INSTR(1,CHR$(192,193,209,194,210,195,226,211,196,197,198,199),F$) : IF Rutin RETURN Rutin
  207. 2505   WEND
  208. 2510 FNEND
  209. 2515 DEF FNSfil LOCAL Fil$=16
  210. 2520   ; CUR(17,0) FNF$(YEL) 'S{nda fil (utan Kermit)'+Avbryt$
  211. 2525   ; FNF$(YEL) 'Filnamn:';
  212. 2530   Fil$=FNVersal$(FNSpbort$(FNInmata$('',18,9,1,2,16,CYA+CHR$(138))))
  213. 2535   ON ERROR GOTO 2550
  214. 2540   OPEN Fil$ AS FILE 20
  215. 2545   S{nd=-1 : RETURN S{nd
  216. 2550   RETURN 0
  217. 2555 FNEND
  218. 2560 DEF FNRfil LOCAL Fil$=16
  219. 2565   ; CUR(17,0) FNF$(YEL) 'Dumpa fil (utan Kermit)'+Avbryt$
  220. 2570   ; FNF$(YEL) 'Filnamn:';
  221. 2575   Fil$=FNVersal$(FNSpbort$(FNInmata$('',18,9,1,2,16,CYA+CHR$(138))))
  222. 2580   ON ERROR GOTO 2595
  223. 2585   PREPARE Fil$ AS FILE 30
  224. 2590   Dump=-1 : RETURN Dump
  225. 2595   RETURN 0
  226. 2600 FNEND
  227. 2605 DEF FNS{ndline$ LOCAL Sp,St$=80
  228. 2610   IF LEN(Textbuff$) GOTO 2625
  229. 2615   ON ERROR GOTO 2645
  230. 2620   INPUT LINE #20,Textbuff$ : Textbuff$=LEFT$(Textbuff$,LEN(Textbuff$)-1)
  231. 2625   ON ERROR GOTO
  232. 2630   Sp=PEEK2(PEEK2(65500)+4)-1
  233. 2635   IF LEN(Textbuff$)<=Sp THEN St$=Textbuff$ : Textbuff$='' ELSE St$=LEFT$(Textbuff$,Sp) : Textbuff$=RIGHT$(Textbuff$,Sp+1)
  234. 2640   RETURN St$
  235. 2645   S{nd=0 : CLOSE 20
  236. 2650   RETURN ''
  237. 2655 FNEND
  238. 2660 DEF FNF|rbindelse
  239. 2860   OPEN V24def$ AS FILE V24
  240. 2870   ; CHR$(12);
  241. 2880   RETURN -1
  242. 2890   ! *** F|re RETURN kan kod l{ggas upp f|r uppringning om man har ett
  243. 2900   ! *** modem som klarar detta. Exempel p} s}dan kod finns i programmet
  244. 2910   ! *** KERM.BAS f|r TGC modem. Detta program finns i programbanken.
  245. 2920   ; 'Kan ej |ppna V24:an! Errcode: ' ERRCODE : STOP
  246. 2930 FNEND
  247. 2940 DEF FNClr
  248. 2950   ; CUR(1,0) FNF$(GYEL) STRING$(80,127);
  249. 2960   ; CUR(21,0) FNF$(GYEL) STRING$(80,127);
  250. 2970   ; CUR(0,22) SPACE$(36)
  251. 2980   ; Huvud$
  252. 2990   ; CUR(2,0);
  253. 3000   RETURN 0
  254. 3010 FNEND
  255. 3020 DEF FNF$(F{rg$)
  256. 3030   IF Mtyp=0 RETURN F{rg$ ELSE RETURN ''
  257. 3050 FNEND
  258. 3060 DEF FNSpbort$(In$) LOCAL A$=100,I,A
  259. 3070   I=1
  260. 3080   WHILE I<=LEN(In$)
  261. 3090     A=ASCII(RIGHT$(In$,I))
  262. 3100     IF A<>32 A$=A$+CHR$(A)
  263. 3110     I=I+1
  264. 3120   WEND
  265. 3400   RETURN A$
  266. 3410 FNEND
  267. 3420 DEF FNFeltext(In$)
  268. 3430   ; CUR(21,0) CHR$(7) FNF$(RED+NWBG+WHT+FLSH) '<' FNF$(NRML+STDY) In$ FNF$(FLSH) '>' SPACE$(78-LEN(In$)) FNF$(CHR$(128)+NWBG+WHT);
  269. 3440   RETURN 0
  270. 3450 FNEND
  271. 3460 DEF FNFel(In$) LOCAL A$=1
  272. 3470   Z=FNFeltext(In$+'  Kvittera med CE ')
  273. 3480   ; CUR(21,LEN(In$)+22); : A$=FNTkn$(RED)
  274. 3490   WHILE A$<>CHR$(24)
  275. 3500     A$=FNTkn$(RED)
  276. 3510   WEND
  277. 3520   ; CUR(21,0) FNF$(GYEL) STRING$(80,127)
  278. 3530   RETURN 0
  279. 3540 FNEND
  280. 3550 DEF FNTkn$(F{rg$) LOCAL B$=1,Rad,Kol
  281. 3560   Rad=PEEK(Cu+1) : Kol=PEEK(Cu)
  282. 3570   Z=FNCursor
  283. 3580   IF Mtyp=0 ; F{rg$ CHR$(PEEK(30720+Rad*80+Kol));
  284. 3610   ; CUR(0,61) FNF$(CYA) TIME$
  285. 3620   WHILE SYS(5)=0 : ; CUR(0,61) FNF$(CYA) TIME$ : WEND
  286. 3630   GET B$ : IF NOT Dtc2 IF ASCII(B$)=(130 AND Key99 OR 215 AND NOT Key99) THEN Z=FNDump
  287. 3640   POKE Cu,Kol,Rad
  288. 3650   RETURN B$
  289. 3660 FNEND
  290. 3670 DEF FNPropen(Fil)
  291. 3680   WHILE -1
  292. 3690     ON ERROR GOTO 3720
  293. 3700     PREPARE Printer$ AS FILE Fil
  294. 3710     RETURN 0
  295. 3720     Z=FNFel('Skrivaren ej p}slagen, kontrollera !  ')
  296. 3730   WEND
  297. 3740 FNEND
  298. 3750 DEF FNInmata$(In$,Rad,Kol,Inpos,Pa,Max,F{rg$) LOCAL Ut$=100,L{ngd,Pos,Fval,A,Ins,M1$=1,M2$=1,M3$=10,O8
  299. 3760   Ut$=In$ : Pos=Inpos : Fval=Pa AND 15 : Z=FNKom99(9)
  300. 3770   WHILE -1
  301. 3780     ; CUR(Rad,Kol) FNF$(F{rg$) Ut$ STRING$(Max-LEN(Ut$),32-63*(Mtyp<>0)) CHR$(139) ' ';
  302. 3790     IF Pos>Max Pos=Max
  303. 3800     L{ngd=LEN(Ut$)
  304. 3810     ; CUR(Rad,Kol+Pos-1);
  305. 3820     A=ASCII(FNTkn$(F{rg$+CHR$(138))) : IF INSTR(1,CHR$(3,4,27,192,129),CHR$(A)) RETURN CHR$(27)
  306. 3830     Z=INSTR(1,CHR$(128,161,163,177,179,172,164,127),CHR$(A))
  307. 3840     IF Z A=ASCII(RIGHT$(CHR$(193,196,198,212,214,8,9,194),Z))
  308. 3850     IF A=24 Ut$='' : Pos=1
  309. 3860     IF Pa>15 OR A=13 IF INSTR(1,CHR$(192,193,196,197,198,199,212,214,240,208,13),CHR$(A)) Z=FNKom99(9) : RETURN Ut$
  310. 3870     IF A=8 IF Pos>1 Pos=Pos-1 ELSE IF Pa>15 Z=FNKom99(9) : RETURN Ut$
  311. 3880     IF A=9 IF Pos<Max Pos=Pos+1 ELSE IF Pa>15 Z=FNKom99(9) : RETURN Ut$
  312. 3890     WHILE A=194
  313. 3900       IF Pos<=L{ngd Ut$=LEFT$(Ut$+' ',Pos-1)+RIGHT$(Ut$,Pos+1)
  314. 3910       IF L{ngd<Pos AND L{ngd>0 IF Pos-L{ngd=1 Ut$=LEFT$(Ut$,L{ngd-1) : Pos=Pos-1 ELSE Pos=L{ngd+1
  315. 3920       A=0
  316. 3930     WEND
  317. 3940     IF A=132 Ins=(Ins=0) : Z=FNKom99(9-128*Ins)
  318. 3950     IF Fval=3 A=A AND 223
  319. 3960     IF A=195 AND Pos<=L{ngd Ut$=LEFT$(Ut$+' ',Pos-1)+' '+RIGHT$(Ut$,Pos) : IF LEN(Ut$)>Max Ut$=LEFT$(Ut$,Max)
  320. 3970     RESTORE 4060
  321. 3980     WHILE O8<=Fval : READ M1$,M2$,M3$ : O8=O8+1 : WEND
  322. 3990     WHILE ((A>=ASCII(M1$) AND A<=ASCII(M2$)) OR INSTR(1,M3$,CHR$(A))>0) AND Pos<=Max
  323. 4000       IF L{ngd<Pos Ut$=Ut$+SPACE$(Pos-L{ngd)
  324. 4010       Ut$=LEFT$(Ut$,Pos-1)+CHR$(A)+RIGHT$(Ut$,Pos-( NOT Ins))
  325. 4020       IF LEN(Ut$)>Max Ut$=LEFT$(Ut$,Max)
  326. 4030       Pos=Pos+1 : A=0
  327. 4040     WEND
  328. 4050   WEND
  329. 4060   DATA 0,9,' ',0,9,' .-',' ',~,' ',A,],' ',J,J,JjNn,A,],A
  330. 4070 FNEND
  331. 4080 DEF FNKom99(K)
  332. 4090   IF Key99 OUT 34,K
  333. 4100   RETURN 0
  334. 4110 FNEND
  335. 4210 DEF FNDump LOCAL Rad$=0,I
  336. 4220   Z=FNPropen(8)
  337. 4230   ; #8,CHR$(10,10,10)
  338. 4240   I=30720
  339. 4250   WHILE I<32640
  340. 4260     POKE VAROOT(Rad$),80,0,I,SWAP%(I),80,0 : ; #8 Rad$
  341. 4270     I=I+80
  342. 4280   WEND
  343. 4290   CLOSE 8 : RETURN 0
  344. 4300 FNEND
  345. 4400 DEF FNEsc LOCAL Tkn$=1,Tkn
  346. 4410   GET Tkn$
  347. 4420   Tkn=ASCII(Tkn$)
  348. 4430   IF Tkn<>192 AND Tkn<>199 RETURN 0
  349. 4440   ; : ; FNF$(RED) '\verf|ringen av '; : IF Tkn=192 ; 'aktuell fil avbrytes!' : RETURN 1
  350. 4450   ; 'alla filer avbrytes!' : RETURN 2
  351. 4460 FNEND
  352. 4500 DEF FNKillfile(Lu,File$)
  353. 4510   ON ERROR GOTO 4540
  354. 4520   CLOSE Lu
  355. 4530   KILL File$ : RETURN 0
  356. 4540   ; CHR$(13,10) FNF$(RED) 'Kan ej ta bort inkommande fil p} grund av fel: ' ERRCODE : RETURN 0
  357. 4550 FNEND
  358. 4600 DEF FNClose(Lu,File$)
  359. 4610   ON ERROR GOTO 4630
  360. 4620   CLOSE Lu : RETURN 0
  361. 4630   ; CHR$(13,10) FNF$(RED) 'Kan ej st{nga ' File$ ' p} grund av fel: ' ERRCODE : RETURN 0
  362. 4640 FNEND
  363. 10000 DEF FNReadsec(Disk,Sec) LOCAL D
  364. 10010   POKE SYS(10)-511,Disk
  365. 10020   D=CALL(24678,Sec)
  366. 10030   IF PEEK(SYS(10)-491) RETURN -1
  367. 10040   RETURN 0
  368. 10050 FNEND
  369. 10060 DEF FNDiscerror$ LOCAL I
  370. 10070   RESTORE 10140
  371. 10080   WHILE I<4
  372. 10090     READ Kod,Text$
  373. 10100     IF (PEEK(SYS(10)-491) AND Kod) RETURN Text$
  374. 10110     I=I+1
  375. 10120   WEND
  376. 10130   RETURN 'ok{nd typ av diskfel!'
  377. 10140   DATA 8, 'checksummafel!
  378. 10150   DATA 16, 'd}lig disk!
  379. 10160   DATA 64, 'skivan skrivskyddad!
  380. 10170   DATA 128,'luckan |ppen!
  381. 10180 FNEND
  382. 10190 DEF FNEnhcs(Drive$) LOCAL Adrenhl,Enh$=4,Dselect
  383. 10200   Adrenhl=PEEK2(SYS(10)+123) : IF Drive$='' RETURN PEEK(PEEK2(24683))
  384. 10210   WHILE Adrenhl<>0
  385. 10220     Enh$=CHR$(PEEK(Adrenhl+2),PEEK(Adrenhl+3),PEEK(Adrenhl+4),58)
  386. 10230     IF Enh$='CON:' OR Enh$='NUL:' OR Enh$='PR:' OR Enh$='V24:' Enh$=''
  387. 10240     Dselect=PEEK(Adrenhl+7)
  388. 10250     IF Enh$=Drive$ RETURN Dselect
  389. 10260     Adrenhl=PEEK2(Adrenhl)
  390. 10270   WEND
  391. 10280   RETURN -1
  392. 10290 FNEND
  393. 10300 DEF FNKollenh(Ix) LOCAL Kolon,Enh$=4,Ec
  394. 10310   Enh$(Ix)=''
  395. 10320   Kolon=INSTR(1,File$(Ix),':') : IF Kolon=0 RETURN 0
  396. 10330   Enh$=LEFT$(File$(Ix),Kolon) : Ec=FNEnhcs(Enh$)
  397. 10340   IF Ec=-1 OR Ec=30 AND PEEK2(65527)=0 RETURN -1
  398. 10350   Enh$(Ix)=Enh$ : File$(Ix)=RIGHT$(File$(Ix),Kolon+1)
  399. 10360   Enh=Ec : RETURN Ec
  400. 10370 FNEND
  401. 10380 DEF FNIx(Fd) LOCAL P
  402. 10390   P=PEEK2(65344)
  403. 10400   WHILE PEEK(P+2)<>Fd AND P<>0
  404. 10410     P=PEEK2(P)
  405. 10420   WEND
  406. 10430   RETURN P
  407. 10440 FNEND
  408. 10450 DEF FNMaskabit7(Maska,Fd) LOCAL Ix
  409. 10455   IF Oldprom RETURN 0
  410. 10460   Ix=FNIx(Fd) : IF Ix=0 ; 'Stopp, filen ej |ppnad!' : STOP
  411. 10470   IF Maska POKE PEEK2(Ix+18)+10,((PEEK(PEEK2(Ix+18)+10)-1) OR 4)+1 ELSE POKE PEEK2(Ix+18)+10,((PEEK(PEEK2(Ix+18)+10)-1) AND 251)+1
  412. 10480   RETURN 0
  413. 10490 FNEND
  414. 10500 DEF FNDisplaykermit
  415. 10520   ; CHR$(12) CUR(1,0) FNF$(GYEL) STRING$(80,127) Huvud$
  416. 10550   RETURN 0
  417. 10560 FNEND
  418. 20040 DEF FNSw(Wc$,Im,Synk,Mqctl,Mchkt,Mt) LOCAL T$=1,S$=1,Ib$=100,Ib,Ub$=101,Ub,Tb$=256,Tb,Npad,Padc,Eol,Time,Chkt,Qctl,Qbin,Rept,Maxl,N,Eof,Fs,F$=40,D,F
  419. 20050   Npad=0 : Padc=0 : Eol=13 : Time=8 : Chkt=Mchkt : Rept=126
  420. 20060   Ib$=SPACE$(100) : Ib=VARPTR(Ib$) : Tb=VARPTR(Tb$) : Ub=VARPTR(Ub$)
  421. 20070   POKE VAROOT(Ub$),100,0,Ub+1,SWAP%(Ub+1)
  422. 20080   S$='S' : F=1
  423. 20090   N=0
  424. 20100   IF INSTR(1,Wc$,'*') OR INSTR(1,Wc$,'?') LET Fs=-1 ELSE LET Fs=0
  425. 20110   F$=Wc$
  426. 20120   WHILE Fs
  427. 20140     Sector=FNOpendir(Enh$(1)) : IF Sector<0 GOTO 20766
  428. 20150     WHILE -1
  429. 20155       WHILE -1
  430. 20160         F$=FNReaddir$ : IF Ec AND Ec<>38 GOTO 20766
  431. 20165         IF F$='' GOTO 20765
  432. 20170         WHILE MID$(F$,14,1)='D' OR FNWild(Wc$,FNPackfilnamn$(LEFT$(F$,12)))=0
  433. 20180           F$=FNReaddir$ : IF Ec AND Ec<>38 GOTO 20766
  434. 20182           IF F$='' GOTO 20765
  435. 20186         WEND
  436. 20190         F$=FNPackfilnamn$(LEFT$(F$,12))
  437. 20195         ; : ; FNF$(CYA) 'S{nder:';
  438. 20200       IF FNOpen(Enh$(1),F$,Inlu,1) WEND
  439. 20210     IF 0 WEND
  440. 20220   IF 0 WEND
  441. 20222   WHILE NOT Fs
  442. 20223     ; : ; FNF$(CYA) 'S{nder:';
  443. 20225     Ec=FNOpen(Enh$(F),File$(F),Inlu,1) : F$=File$(F) : Oms{ndning=0
  444. 20228     IF Ec RETURN FNSendpack('E','Fel nr '+NUM$(Ec)+' under |ppnignen av '+F$+'!',1,Chkt,Synk,Npad,Padc,Eol,V24)-2
  445. 20229   IF 0 WEND
  446. 20230   WHILE -1
  447. 20240     WHILE S$='S'
  448. 20250       Ub$=CHR$(FNChar(94),FNChar(Time),FNChar(Npad),FNCtl(Padc),FNChar(Eol),Mqctl)+CHR$(Mqbin)+NUM$(Mchkt)+CHR$(Rept)
  449. 20260       T$=FNSendbuff$(N,'S',Ub$,Ib,Synk,Npad,Padc,Eol,Mt,Time,1,V24)
  450. 20270       WHILE T$='Y'
  451. 20280         Maxl=FNUnchar(PEEK(Ib+2)) : Time=FNUnchar(PEEK(Ib+3))
  452. 20290         Npad=FNUnchar(PEEK(Ib+4)) : Padc=FNCtl(PEEK(Ib+5))
  453. 20300         Eol=FNUnchar(PEEK(Ib+6)) : Qctl=PEEK(Ib+7)
  454. 20310         Qbin=PEEK(Ib+8) : IF Qbin=89 Qbin=Mqbin : IF Qbin=89 Qbin=0
  455. 20315         IF Qbin<33 OR Qbin>62 AND Qbin<96 OR Qbin>126 Qbin=0
  456. 20320         IF Mchkt<>(PEEK(Ib+9)-48) Chkt=1 ELSE Chkt=Mchkt
  457. 20330         IF PEEK(Ib+10)<>Rept Rept=0
  458. 20340       IF 0 WEND
  459. 20350       N=(N+1) AND 63
  460. 20360       IF T$='Y' S$='F' ELSE S$=T$
  461. 20370     WEND
  462. 20380     WHILE S$='F'
  463. 20390       T$=FNSendbuff$(N,'F',F$,Ib,Synk,Npad,Padc,Eol,Mt,Time,Chkt,V24)
  464. 20400       IF INSTR(1,'NY',T$) S$='D' ELSE S$=T$
  465. 20410       N=(N+1) AND 63
  466. 20420     WEND
  467. 20430     WHILE S$='D'
  468. 20440       Eof=FNFileread(Tb,Im,Inlu)
  469. 20450       WHILE Eof=0
  470. 20460         POKE Ub,1 : WHILE FNPackbuff(Ub,Maxl-Chkt,Tb,Mqctl,Qbin,Rept) AND Eof=0 : Eof=FNFileread(Tb,Im,Inlu) : WEND
  471. 20465         Paket=Paket+1 : ; CUR(PEEK(Cu+1),38); : ; USING '#####' Paket;
  472. 20470         POKE VAROOT(Ub$)+4,PEEK(Ub)-1,0 : T$=FNSendbuff$(N,'D',Ub$,Ib,Synk,Npad,Padc,Eol,Mt,Time,Chkt,V24)
  473. 20480         N=(N+1) AND 63
  474. 20483         IF PEEK(Ib+1)>2+Chkt AND PEEK(Ib+2)=88 Eof=1
  475. 20484         IF PEEK(Ib+1)>2+Chkt AND PEEK(Ib+2)=90 Eof=1 : LET Fs=0 : F=Nfile+1
  476. 20485         IF SYS(5) D=FNEsc : IF D=1 Eof=1 ELSE IF D=2 Eof=1 : LET Fs=0 : F=Nfile+1
  477. 20490       IF T$='Y' WEND
  478. 20500       IF Eof S$='Z' ELSE S$=T$
  479. 20510     WEND
  480. 20520     WHILE S$='Z'
  481. 20530       IF Eof=38 OR Eof=34 Ub$='' ELSE Ub$='D'
  482. 20540       Dummy=FNClose(Inlu,F$)
  483. 20550       T$=FNSendbuff$(N,'Z',Ub$,Ib,Synk,Npad,Padc,Eol,Mt,Time,Chkt,V24)
  484. 20560       IF T$='Y' S$='B' ELSE S$=T$
  485. 20570       N=(N+1) AND 63
  486. 20575       IF Eof<>34 AND Eof<>38 AND Eof<>1 RETURN FNSendpack('E','Fel nr '+NUM$(Eof)+' vid l{sning av '+F$+'!',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  487. 20580     WEND
  488. 20590     WHILE S$='B'
  489. 20595       WHILE Fs
  490. 20600         F$=FNReaddir$ : IF Ec AND Ec<>38 GOTO 20767
  491. 20610         WHILE F$<>''
  492. 20620           WHILE MID$(F$,14,1)='D' OR FNWild(Wc$,FNPackfilnamn$(LEFT$(F$,12)))=0
  493. 20630             F$=FNReaddir$ : IF Ec AND Ec<>38 GOTO 20767
  494. 20631           IF F$<>'' WEND
  495. 20633           WHILE F$<>''
  496. 20635             F$=FNPackfilnamn$(LEFT$(F$,12))
  497. 20637             ; : ; FNF$(CYA) 'S{nder:';
  498. 20640             D=FNOpen(Enh$(1),F$,Inlu,1)
  499. 20655           IF 0 WEND
  500. 20660         IF Ec WEND
  501. 20670         IF F$<>'' AND Ec=0 S$='F' ELSE S$='C'
  502. 20675       IF 0 WEND
  503. 20676       F=F+1
  504. 20677       WHILE NOT Fs AND F<=Nfile
  505. 20678         ; : ; FNF$(CYA) 'S{nder:';
  506. 20679         Ec=FNOpen(Enh$(F),File$(F),Inlu,1) : F$=File$(F) : S$='F'
  507. 20680         IF Ec RETURN FNSendpack('E','Fel nr '+NUM$(Ec)+' under |ppningnen av '+F$+'!',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  508. 20681       IF 0 WEND
  509. 20685       IF NOT Fs AND F>Nfile F$=''
  510. 20689       WHILE F$='' OR FNDcd
  511. 20690         T$=FNSendbuff$(N,'B','',Ib,Synk,Npad,Padc,Eol,Mt,Time,Chkt,V24)
  512. 20700         N=(N+1) AND 63
  513. 20710         IF T$='Y' S$='C' ELSE S$=T$
  514. 20720       IF 0 WEND
  515. 20730     WEND
  516. 20732     IF S$='e' RETURN -2
  517. 20733     IF S$='E' RETURN FNFel(MID$(Ib$,3,PEEK(Ib+1)-2-Chkt))-2
  518. 20740     IF S$='C' Ec=0 : RETURN 0
  519. 20750     IF INSTR(1,'SFDZBC',S$)=0 RETURN FNSendpack('E','OK[ND pakettyp: '+S$+'!!!',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  520. 20760   WEND
  521. 20765   RETURN FNFel(Wc$+' ger ej tr{ff p} n}gon fil!')-2
  522. 20766   RETURN FNFel('Kan ej l{sa '+Enh$(1)+', '+FNDiscerror$)-2
  523. 20767   RETURN FNSendpack('E','Kan ej l{sa '+Enh$(1)+', '+FNDiscerror$,1,Chkt,Synk,Npad,Padc,Eol,V24)-2
  524. 20770 FNEND
  525. 21040 DEF FNRe(Im,Synk,Mt) LOCAL N,S$=1,T$=1,Ib$=100,Ib,Ub$=50,Buff$=254,Buff,Maxl,Time,Npad,Padc,Eol,Qctl,Qbin,Chkt,Rept,Fo$=20,Fl$=12,Wferr,F,En$=4,D
  526. 21050   Maxl=94 : Time=40 : Npad=0 : Padc=0 : Eol=13 : Qctl=0 : Chkt=1 : Rept=0
  527. 21055   Wferr=0
  528. 21060   Ib=VARPTR(Ib$) : POKE VAROOT(Ib$)+4,100,0
  529. 21061   Buff=VARPTR(Buff$)
  530. 21070   N=0 : F=0
  531. 21072   T$=' '
  532. 21080   WHILE -1
  533. 21090     S$=FNRpack$(Ib,N,Synk,Time,Mt,Chkt,Npad,Padc,Eol,V24)
  534. 21092     WHILE Wferr
  535. 21094       Dummy=FNKillfile(Outlu,En$+Fl$)
  536. 21096       RETURN FNSendpack('E','Fel vid skrivning p} filen '+En$+Fl$+'. Fel nr '+NUM$(Wferr)+'.',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  537. 21098     WEND
  538. 21100     WHILE S$='S'
  539. 21110       IF (PEEK(Ib)<>N AND PEEK(Ib)<>((N-1) AND 63)) OR INSTR(1,' S',T$)=0 RETURN FNSendpack('E','Send-init ???',PEEK(Ib),1,Synk,Npad,Padc,Eol,V24)-2
  540. 21120       WHILE S$='S'
  541. 21130         Maxl=FNUnchar(PEEK(Ib+2)) : Time=FNUnchar(PEEK(Ib+3))
  542. 21140         Npad=FNUnchar(PEEK(Ib+4)) : Padc=FNCtl(PEEK(Ib+5))
  543. 21150         Eol=FNUnchar(PEEK(Ib+6)) : Qctl=PEEK(Ib+7)
  544. 21160         IF PEEK(Ib+1)<8 Qbin=0 ELSE Qbin=PEEK(Ib+8) : IF Qbin=89 Qbin=Mqbin
  545. 21165         IF Qbin<33 OR Qbin>62 AND Qbin<96 OR Qbin>126 THEN Qbin=0
  546. 21170         IF PEEK(Ib+1)<9 Chkt=1 ELSE Chkt=PEEK(Ib+9)-48 : IF Chkt<>2 Chkt=1
  547. 21180         IF PEEK(Ib+1)<10 Rept=0 ELSE Rept=PEEK(Ib+10) : IF Rept<33 OR Rept>62 AND Rept<96 OR Rept>126 Rept=0
  548. 21190         Ub$=CHR$(FNChar(75),FNChar(8),FNChar(0),FNCtl(0),FNChar(13),Qctl,Qbin OR 78 AND Qbin=0)+NUM$(Chkt)
  549. 21195         IF Rept THEN Ub$=Ub$+CHR$(Rept) ELSE Ub$=Ub$+' '
  550. 21200         D=FNSendpack('Y',Ub$,PEEK(Ib),1,Synk,Npad,Padc,Eol,V24)
  551. 21205         N=((PEEK(Ib)+1) AND 63)
  552. 21210       IF 0 WEND
  553. 21220     IF 0 WEND
  554. 21230     WHILE S$='F'
  555. 21240       IF INSTR(1,'SZF',T$)=0 RETURN FNSendpack('E','Fil-huvud ???',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  556. 21241       IF T$='F' AND Fo$<>FNVersal$(MID$(Ib$,3,PEEK(Ib+1)-2-Chkt)) RETURN FNSendpack('E','Tv} fil-huvuden ???',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  557. 21250       WHILE S$='F'
  558. 21260         Fo$=FNVersal$(MID$(Ib$,3,PEEK(Ib+1)-2-Chkt)) : Fl$=''
  559. 21270         D=1 : WHILE D<=LEN(Fo$)
  560. 21280           WHILE (LEN(Fl$)<8 AND INSTR(1,Fl$,'.')=0) OR (LEN(Fl$)-INSTR(1,Fl$,'.'))<3
  561. 21290             IF INSTR(1,'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ][\',MID$(Fo$,D,1))<>0 Fl$=Fl$+MID$(Fo$,D,1)
  562. 21300           IF 0 WEND
  563. 21310           IF MID$(Fo$,D,1)='.' Fl$=Fl$+'.'
  564. 21320         D=D+1 : WEND
  565. 21325         En$='' : F=F+1 : IF F<=20 IF F<=Nfile AND File$(F)<>'' Fl$=File$(F) : En$=Enh$(F)
  566. 21327         ; : ; FNF$(CYA) 'Mottar:'; : Radpos=0 : Oms{ndning=0
  567. 21330         Ec=FNOpen(En$,Fl$,Outlu,2) : IF Ec RETURN FNSendpack('E','Kan ej skapa '+En$+Fl$+', fel nr '+NUM$(Ec)+'!',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  568. 21510         IF S$='F' D=FNSendpack('Y','',N,Chkt,Synk,Npad,Padc,Eol,V24) : N=((N+1) AND 63)
  569. 21520       IF 0 WEND
  570. 21521       POKE Buff,1
  571. 21530     IF 0 WEND
  572. 21600     WHILE S$='D'
  573. 21605       D=FNSendpack('Y',Esc$,N,Chkt,Synk,Npad,Padc,Eol,V24) : N=((N+1) AND 63)
  574. 21610       POKE Ib,2
  575. 21615       IF Esc$='' Paket=Paket+1 : ; CUR(PEEK(Cu+1),38); : ; USING '#####' Paket;
  576. 21620       WHILE FNUnpbuff(Ib,PEEK(Ib+1)-1-Chkt,Buff,253,Qctl,Qbin,Rept)<=0 : Ec=FNFilewrite(Buff,Im,Outlu) : IF Ec Wferr=Ec ELSE WEND
  577. 21630       Esc$='' : IF SYS(5) Dummy=FNEsc : IF Dummy=1 Esc$='X' ELSE IF Dummy=2 Esc$='Z'
  578. 21640     IF 0 WEND
  579. 21700     WHILE S$='Z'
  580. 21705       IF PEEK(Buff)>1 Ec=FNFilewrite(Buff,Im,Outlu) : IF Ec Wferr=Ec
  581. 21706       WHILE S$='Z' AND Wferr=0
  582. 21710         IF (PEEK(Ib+1)>=3+Chkt AND MID$(Ib$,3,PEEK(Ib+1)-2-Chkt)='D') OR Esc$='X' OR Esc$='Z' D=FNKillfile(Outlu,En$+Fl$) ELSE D=FNClose(Outlu,En$+Fl$)
  583. 21720         D=FNSendpack('Y','',N,Chkt,Synk,Npad,Padc,Eol,V24) : N=((N+1) AND 63)
  584. 21722       IF 0 WEND
  585. 21730     IF 0 WEND
  586. 21740     WHILE S$='B'
  587. 21741       D=FNSendpack('Y','',N,Chkt,Synk,Npad,Padc,Eol,V24) : N=((N+1) AND 63)
  588. 21750       Ec=0 : RETURN 0
  589. 21760     IF 0 WEND
  590. 21762     IF S$='e' RETURN -2
  591. 21763     IF S$='E' RETURN FNFel(MID$(Ib$,3,PEEK(Ib+1)-2-Chkt))-2
  592. 21770     IF INSTR(1,'SFDZB',S$)=0 RETURN FNSendpack('E','OK[ND pakettyp: '+S$+'!!!',N,Chkt,Synk,Npad,Padc,Eol,V24)-2
  593. 21810     T$=S$
  594. 25000   WEND
  595. 25010 FNEND
  596. 30010 DEF FNRpack$(Buff,N,Synk,Time,Mtrye,Check,Npad,Padc,Eol,Lu) LOCAL Maxtrye,T$=1,D
  597. 30020   Maxtrye=Mtrye
  598. 30030   WHILE Maxtrye
  599. 30040     T$=FNGetpack$(Buff,Synk,Time,Check,Lu)
  600. 30045     IF T$='E' RETURN 'E'
  601. 30050     IF INSTR(1,' T',T$)=0 AND (PEEK(Buff)=N) RETURN T$
  602. 30060     IF PEEK(Buff)=((N+1) AND 63) D=FNSendpack('E','Jag har tappat bort ett paket!!!',N,Check,Synk,Npad,Padc,Eol,Lu) : RETURN 'e'
  603. 30065     IF T$='D' Oms{ndning=Oms{ndning+1 : ; CUR(PEEK(Cu+1),50); : ; USING '#####' Oms{ndning;
  604. 30070     Maxtrye=Maxtrye-1
  605. 30080     D=FNSendpack('N','',N,Check,Synk,Npad,Padc,Eol,Lu)
  606. 30090   WEND
  607. 30100   D=FNSendpack('E','Avbryter! F|r m}nga oms{ndningar!!!',N,Check,Synk,Npad,Padc,Eol,Lu)
  608. 30110   RETURN 'e'
  609. 30120 FNEND
  610. 40030 DEF FNSendbuff$(N,Tp$,Buff$,Inbuff,Synk,Npad,Padc,Eol,Mt,Time,Check,Lu) LOCAL Nt,D,S$=1
  611. 40040   Nt=Mt
  612. 40060   WHILE Nt
  613. 40065     D=FNTom(Lu)
  614. 40070     D=FNSendpack(Tp$,Buff$,N,Check,Synk,Npad,Padc,Eol,Lu)
  615. 40080     S$=FNGetpack$(Inbuff,Synk,Time,Check,Lu)
  616. 40082     IF S$='E' RETURN 'E'
  617. 40085     IF Tp$='D' AND Nt<>Mt Oms{ndning=Oms{ndning+1 : ; CUR(PEEK(Cu+1),50); : ; USING '#####' Oms{ndning;
  618. 40090     IF S$='N' AND N IF ((PEEK(Inbuff)-1) AND 63)=N RETURN 'Y'
  619. 40100     IF S$='Y' IF PEEK(Inbuff)=N RETURN 'Y'
  620. 40110     IF INSTR(1,' TNY',S$)=0 D=FNSendpack('E','Avbryter! OK[ND pakettyp: '+S$+'!!!',N,Check,Synk,Npad,Padc,Eol,Lu) : RETURN 'e'
  621. 40120     Nt=Nt-1
  622. 40130   WEND
  623. 40135   D=FNSendpack('E','Avbryter! F|r m}nga oms{ndningar!!!',N,Check,Synk,Npad,Padc,Eol,Lu)
  624. 40140   RETURN 'e'
  625. 40150 FNEND
  626. 40220 DEF FNFilewrite(Buff,Im,Lu) LOCAL B$=0,Le
  627. 40230   POKE VAROOT(B$),253,0,Buff+1,SWAP%(Buff+1),253,0
  628. 40240   Le=PEEK(Buff)-1
  629. 40250   ON ERROR GOTO 40290
  630. 40260   IF Im PUT #Lu LEFT$(B$,Le) ELSE ; #Lu FNExpandtab$(LEFT$(B$,Le));
  631. 40270   POKE Buff,1
  632. 40280   RETURN 0
  633. 40290   RETURN ERRCODE
  634. 40300 FNEND
  635. 40380 DEF FNUnpbuff(Inbuff,Inbuffl,Utbuff,Utbuffl,Qctl,Qbin,Rept) LOCAL A$=9
  636. 40390   A$=CHR$(Inbuff,SWAP%(Inbuff),Inbuffl,Utbuff,SWAP%(Utbuff),Utbuffl,Qctl,Qbin,Rept)
  637. 40400   RETURN CALL(VARPTR(Pack$),VARPTR(A$))
  638. 40410 FNEND
  639. 40580 DEF FNFileread(Buff,Im,Lu) LOCAL B$=0
  640. 40590   POKE VAROOT(B$),253,0,Buff+2,SWAP%(Buff+2),253,0
  641. 40600   ON ERROR GOTO 40640
  642. 40610   IF Im GET #Lu B$ COUNT 253 ELSE INPUT LINE #Lu B$
  643. 40620   POKE Buff,2,LEN(B$)+2
  644. 40630   RETURN 0
  645. 40640   POKE Buff,2,0 : RETURN ERRCODE
  646. 40650 FNEND
  647. 40730 DEF FNPackbuff(Buff,Buffl,Tmpb,Qctl,Qbin,Rept) LOCAL A$=9
  648. 40740   A$=CHR$(Buff,SWAP%(Buff),Buffl,Tmpb,SWAP%(Tmpb),0,Qctl,Qbin,Rept)
  649. 40750   RETURN CALL(VARPTR(Pack$)+163,VARPTR(A$))
  650. 40760 FNEND
  651. 40950 DEF FNTom(Lu) LOCAL D,D$=50
  652. 40960   D=FNAntalintecken
  653. 40970   WHILE D
  654. 40980     IF D>50 D=50
  655. 40990     GET #Lu D$ COUNT D
  656. 41000     D=FNAntalintecken
  657. 41010   WEND
  658. 41020   RETURN 0
  659. 41030 FNEND
  660. 41080 DEF FNAntalintecken=PEEK2(V24tkn)
  661. 41150 DEF FNGetpack$(Buff,Synk,Time,Check,Lu) LOCAL D,B$=0,T$=1,P,A
  662. 41160   POKE VAROOT(B$),100,0,Buff,SWAP%(Buff),100,0
  663. 41170   IF FNAntalintecken=0 IF FNTimeout(Time) RETURN 'T'
  664. 41180   D=ASCII(FNGchr$(1,Lu)) : IF INSTR(1,CHR$(3,4,26),CHR$(D)) RETURN 'T'
  665. 41190   WHILE D<>Synk : IF FNAntalintecken=0 IF FNTimeout(Time) RETURN 'T'
  666. 41200     D=ASCII(FNGchr$(1,Lu)) : IF INSTR(1,CHR$(3,4,26),CHR$(D)) RETURN 'T'
  667. 41210   WEND
  668. 41220   IF FNAntalintecken=0 IF FNTimeout(Time) RETURN 'T'
  669. 41230   A=FNUnchar(ASCII(FNGchr$(1,Lu))) : P=1
  670. 41240   WHILE P-2<A
  671. 41250     D=FNAntalintecken : IF D=0 IF FNTimeout(Time) RETURN 'T' ELSE D=FNAntalintecken
  672. 41260     IF D>A-P+2 D=A-P+2
  673. 41270     MID$(B$,P,D)=FNGchr$(D,Lu) : P=P+D
  674. 41280   WEND
  675. 41290   IF MID$(B$,2,1)<>'S' IF MID$(B$,A-Check+1,Check)<>FNCsum$(CHR$(FNChar(A))+LEFT$(B$,A-Check),Check) RETURN ' '
  676. 41291   IF MID$(B$,2,1)='S' IF MID$(B$,A,1)<>FNCsum$(CHR$(FNChar(A))+LEFT$(B$,A-1),1) RETURN ' '
  677. 41300   T$=MID$(B$,2,1)
  678. 41310   POKE Buff,FNUnchar(PEEK(Buff)),A
  679. 41320   RETURN T$
  680. 41330 FNEND
  681. 41380 DEF FNGchr$(A,Lu) LOCAL B$=100,I
  682. 41390   GET #Lu B$ COUNT A
  683. 41391   IF Mqbin<>38 OR Oldprom=0 THEN RETURN B$
  684. 41392   I=A : WHILE I
  685. 41396     MID$(B$,I,1)=CHR$(ASCII(MID$(B$,I,1)) AND 127) : I=I-1
  686. 41398   WEND
  687. 41400   RETURN B$
  688. 41410 FNEND
  689. 41460 DEF FNTimeout(T) LOCAL D.
  690. 41470   D.=T*198.
  691. 41480   WHILE D.<>0. AND FNAntalintecken=0 : D.=D.-1. : IF FNDcd D.=0. ELSE WEND
  692. 41490   RETURN D.=0.
  693. 41500 FNEND
  694. 41550 DEF FNAntaluttecken=PEEK2(V24ut)
  695. 41600 DEF FNDcd
  696. 41610   OUT 65,16 : RETURN (INP(65) AND 8)=0
  697. 41620 FNEND
  698. 41690 DEF FNPutpack(Buff$,Npad,Padc,Lu) LOCAL P,D
  699. 41700   P=Npad
  700. 41710   D=FNAntaluttecken
  701. 41720   WHILE P AND FNDcd=0
  702. 41730     IF D>P D=P
  703. 41740     PUT #Lu STRING$(D,Padc)
  704. 41750     P=P-D : D=FNAntaluttecken
  705. 41760   WEND
  706. 41770   P=1 : WHILE P<=LEN(Buff$) AND FNDcd=0
  707. 41780     IF D>LEN(Buff$)-P+1 D=LEN(Buff$)-P+1
  708. 41790     PUT #Lu MID$(Buff$,P,D)
  709. 41800     P=P+D : D=FNAntaluttecken
  710. 41810   WEND
  711. 41820   RETURN 0
  712. 41830 FNEND
  713. 41880 DEF FNSendpack(T$,Buff$,N,Check,Synk,Npad,Padc,Eol,Lu) LOCAL D,B$=100
  714. 41890   B$=CHR$(Synk,FNChar(LEN(Buff$)+Check+2),FNChar(N))+T$+Buff$
  715. 41900   D=FNPutpack(B$+FNCsum$(RIGHT$(B$,2),Check)+CHR$(Eol),Npad,Padc,Lu)
  716. 41910   IF T$='E' RETURN FNFel(Buff$) ELSE RETURN 0
  717. 41920 FNEND
  718. 41960 DEF FNCtl(T)=T XOR 64
  719. 41970 DEF FNChar(T)=T+32
  720. 41980 DEF FNUnchar(T)=T-32
  721. 42040 DEF FNCsum$(B$,C) LOCAL Sum
  722. 42050   IF C<>1 AND C<>2 THEN ; 'Ej implementerad typ av checksumma' : STOP
  723. 42060   Sum=CALL(VARPTR(Csum$),PEEK2(PEEK2(65304)))
  724. 42070   IF C=1 RETURN CHR$(FNChar(Sum+SWAP%(Sum AND 768) AND 63))
  725. 42080   RETURN CHR$(FNChar(SWAP%(Sum) AND 63),FNChar(Sum AND 63))
  726. 42090 FNEND
  727. 42460 DEF FNWild(Wc$,St$)
  728. 42470   IF LEN(St$)=0 IF LEN(Wc$)=0 OR Wc$='*' THEN RETURN -1 ELSE RETURN 0
  729. 42480   IF LEN(Wc$)=0 THEN RETURN 0
  730. 42490   IF ASCII(Wc$)=ASCII(St$) RETURN FNWild(RIGHT$(Wc$,2),RIGHT$(St$,2))
  731. 42500   IF ASCII(Wc$)=63 THEN RETURN FNWild(RIGHT$(Wc$,2),RIGHT$(St$,2))
  732. 42510   IF ASCII(Wc$)<>42 THEN RETURN 0
  733. 42520   IF FNWild(RIGHT$(Wc$,2),St$) RETURN -1
  734. 42530   RETURN FNWild(Wc$,RIGHT$(St$,2))
  735. 42550 FNEND
  736. 42650 DEF FNPackfilnamn$(Fl$) LOCAL F$=12,P
  737. 42660   F$=Fl$
  738. 42670   P=INSTR(1,F$,' ')
  739. 42680   WHILE P : F$=LEFT$(F$,P-1)+RIGHT$(F$,P+1) : P=INSTR(1,F$,' ') : WEND
  740. 42690   RETURN F$
  741. 42700 FNEND
  742. 42800 DEF FNExpandtab$(In$) LOCAL I,Sp
  743. 42810   ON ERROR GOTO 42920
  744. 42820   Textbuff$=In$ : I=0
  745. 42830   WHILE I<LEN(Textbuff$)
  746. 42840     I=I+1 : Radpos=Radpos+1
  747. 42850     IF ASCII(MID$(Textbuff$,I,1))=10 Radpos=0
  748. 42860     WHILE ASCII(MID$(Textbuff$,I,1))=9
  749. 42870       Sp=MOD(Radpos,8) : Sp=8-Sp : IF Sp=8 Sp=0
  750. 42880       Textbuff$=LEFT$(Textbuff$,I-1)+SPACE$(1+Sp)+RIGHT$(Textbuff$,I+1) : Radpos=Radpos+Sp : I=I+Sp
  751. 42890     IF 0 WEND
  752. 42900   WEND
  753. 42910   RETURN Textbuff$
  754. 42920   Ec=ERRCODE : RETURN ''
  755. 42930 FNEND
  756. 60280 DEF FNOpendir(En$) LOCAL Enhet$=4,Adr,Ufd,Bitmap0$=16,Bitmap1$=16,I
  757. 60281   Enhet$=En$ : IF Enhet$='' Enhet$=Enh$
  758. 60282   IF Enh>=0 AND Enh<=3 Enh=PEEK(PEEK2(24683))+Enh
  759. 60283   IF Enh>=12 AND Enh<=15 Adr=6 ELSE Adr=14
  760. 60284   IF Enh=30 Enh=PEEK(65529) : Ufd=-1 : Adr=PEEK2(65527)-1
  761. 60291   Ec=FNReadsec(Enh,Adr) : IF Ec RETURN -1
  762. 60292   Bitmap0$=MID$(Dosbuff$,240,16) : Adr=Adr+1 : Dirmap$=SPACE$(16)
  763. 60294   IF Ufd Bitmap1$=STRING$(16,0) ELSE Ec=FNReadsec(Enh,Adr) : IF Ec RETURN -1
  764. 60296   IF NOT Ufd Bitmap1$=MID$(Dosbuff$,240,16) : Adr=Adr+1
  765. 60300   WHILE I<16
  766. 60302     I=I+1
  767. 60304     MID$(Dirmap$,I,1)=CHR$(ASCII(MID$(Bitmap0$,I,1))-ASCII(MID$(Bitmap1$,I,1)))
  768. 60306   WEND
  769. 60308   Dirrec$='' : IF Enh>=12 AND Enh<=15 AND NOT Ufd Adr=Adr+8
  770. 60309   RETURN Adr
  771. 60310 FNEND
  772. 60340 DEF FNReaddir$ LOCAL N$=14,A
  773. 60342   ON ERROR GOTO 60380
  774. 60343   !
  775. 60344   WHILE LEN(Dirmap$)
  776. 60346     WHILE LEN(Dirrec$) : N$=MID$(Dirrec$,5,8)+"."+MID$(Dirrec$,13,3)
  777. 60348       Dirrec$=RIGHT$(Dirrec$,17)
  778. 60349       IF ASCII(N$)>=48 AND ASCII(N$)<95 GOTO 60356
  779. 60350     WEND : A=ASCII(Dirmap$) : Dirmap$=RIGHT$(Dirmap$,2)
  780. 60352     IF A Ec=FNReadsec(Enh,Sector) : IF Ec RETURN -1
  781. 60353     Dirrec$=Dosbuff$ : Sector=Sector+1
  782. 60354   WEND : Ec=38 : RETURN ''
  783. 60355   !
  784. 60356   IF MID$(N$,10,3)='Ufd' N$=LEFT$(N$,8)+'     D'
  785. 60358   RETURN N$+SPACE$(39-LEN(N$))
  786. 60359   !
  787. 60380   Ec=ERRCODE : RETURN ''
  788. 60390 FNEND
  789. 60420 DEF FNOpen(Enhet$,File$,Nr,Typ) LOCAL En$=4
  790. 60430   Paket=0 : Oms{ndning=0
  791. 60460   ON ERROR GOTO 60490
  792. 60465   IF Enhet$='' En$=Enh$ ELSE En$=Enhet$
  793. 60470   OPEN En$+File$ AS FILE Nr
  794. 60475   ; TAB(9) En$+File$ TAB(30) 'Paket:';
  795. 60480   RETURN 0
  796. 60490   IF Typ<>2 Ec=ERRCODE : RETURN Ec
  797. 60500   IF ERRCODE<>21 Ec=ERRCODE : RETURN Ec
  798. 60510   ON ERROR GOTO 60540
  799. 60520   PREPARE En$+File$ AS FILE Nr
  800. 60525   ; TAB(9) En$+File$ TAB(30) 'Paket:';
  801. 60530   RETURN 0
  802. 60540   Ec=ERRCODE : RETURN Ec
  803. 60550 FNEND
  804. 62650 DEF FNVersal$(In$) LOCAL Ut$=100,Pekare,V{rde
  805. 62660   IF In$='' RETURN ''
  806. 62670   Pekare=1
  807. 62680   WHILE Pekare<=LEN(In$)
  808. 62690     V{rde=ASCII(MID$(In$,Pekare,1))
  809. 62700     IF V{rde>95 AND V{rde<127 V{rde=V{rde AND 95
  810. 62710     IF V{rde<128 Ut$=Ut$+CHR$(V{rde)
  811. 62720     Pekare=Pekare+1
  812. 62730   WEND
  813. 62740   RETURN Ut$
  814. 62750 FNEND
  815.