home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / luxorabc800 / k.bas next >
BASIC Source File  |  2020-01-01  |  11KB  |  221 lines
  1. 2 ! **********************************************************************
  2. 3 ! Program          K.BAS            Utg}va  4.11     1990-02-17
  3. 4 ! av Bo Kullmar
  4. 5 ! Ins{nd av Bo Kullmar
  5. 6 ! F|r ABC800M ABC800C ABC802 ABC806
  6. 8 ! Testad p} ABC806
  7. 9 ! **********************************************************************
  8. 10 !
  9. 11 ! KMAIN.BAS:
  10. 12 !
  11. 20 ! Kermitrutinerna har Lars-G|ran G|ransson, 495, skrivit.
  12. 21 ! Vissa rutiner f|r menyhantering mm har Mikael Lid`n, 5651, skrivit.
  13. 22 ! En del maskinkodsrutiner av Kristoffer Eriksson, 5357.
  14. 23 !
  15. 24 ! Enbart med UFD-DOS och LUX-NET (med priv. att l{sa bibl. med CALL) kan
  16. 25 ! wildcards anv{ndas vid s{ndning av filer med Kermit.
  17. 26 ! Programmet kr{ver ej inbyggd terminalrutin eller TERMOPT.REL p} ABC806.
  18. 27 ! Cursoradressering och blankning av bildsk{rmen f|ljer ADM3A.
  19. 28 ! Kermitrutinerna klarar s}v{l text som bin{rfiler och med eller utan
  20. 29 ! paddning av 8:e biten. Checksumma 1 och 2 hanteras. Programmet b|r
  21. 30 ! squezas f|r att inte ta f|r mycket minne. Det {r tveksamt om det g}r
  22. 31 ! att k|ra osquezat. I squezad version heter programmet KMAIN.BAC.
  23. 32 ! [ndra inte radnumreringen f|r Kermitrutinerna, f|r d} upph|r likheten
  24. 33 ! med monitorns Kermitrutiner!
  25. 34 !
  26. 35 ! Har du optionsprom ver 10, och f}r din s{ndning stoppad av mottaget XOFF,
  27. 36 ! kan du g} tillbaks till menyn, och in i terminall{ge igen, s} ska stoppet
  28. 37 ! brytas.
  29. 38 !
  30. 39 ! KMAIN g}r delvis att k|ra osquezat om man tar bort de inledande
  31. 40 ! kommentarerna och g{rna kommentarerna i FNF|rbindelse, rad 2890-2910.
  32. 400 !
  33. 401 ! K:
  34. 402 !
  35. 500 ! Detta program anv{nds f|r att s{tta defaultparametrar f|r Kermit-
  36. 510 ! programmet KMAIN. Anv{nds {ldre prom i datorn som ej kan maska 7:e biten
  37. 520 ! b|r oldprom s{ttas till "Oldprom=-1" i rad 1010. Kan ej tv} siffror i
  38. 530 ! hastigheten anges s} kan detta {ndras ocks}, men d} fungerar ej val av
  39. 540 ! split speed i programmet!
  40. 550 !
  41. 560 ! Detta {r en l|sning som jag har valt eftersom det verkar finnas en bugg
  42. 570 ! om V24:an |ppnas med fel parameter s} kraschar systemet. Anv{nds gammalt
  43. 580 ! prom eller vill Du ha n}gon annan defaulthastighet s} {ndra parameter
  44. 590 ! nedan, men kom ih}g om Du {ndrar fel kan KMAIN g} fel!!!
  45. 600 !
  46. 610 ! OBServera att om Du {ndrar parametrar felaktigt h{r s} kommer inte Kermit
  47. 620 ! att fungera! S{tt ej Oldprom och beh}ll E som sista bokstav f|r d} g}r
  48. 630 ! det inte s} bra! Oldprom anv{nds n{r Du har ett system som inte kan maska
  49. 640 ! bort 7:e biten och det {r detta om E:et g|r. Dvs om Du s{tter Oldprom f}r
  50. 650 ! Du aldrig ha maskning av 7:e biten p} med den sista siffran i parametern.
  51. 660 !
  52. 990 INTEGER : EXTEND
  53. 1000 COMMON V24def$=16,Oldprom,Mtyp,Key99,Enh$=4,Enh,Printer$=16,Version$=4,Mqbin,Pack$=376,Csum$=40
  54. 1010 Version$='4.11'
  55. 1020 Dummy=FNInit
  56. 1030 ON ERROR GOTO 1050
  57. 1040 CHAIN Enh$+'KMAIN'
  58. 1050 CHAIN 'KMAIN'
  59. 1500 DEF FNInit
  60. 1510   ; CHR$(12)
  61. 1520   Huvud$=CUR(0,0)+FNF$(CYA)+'K, KERMIT-program f|r ABC800-serien, version '+Version$
  62. 1530   Oldprom=0 : V24defhast$='D' : V24defpar$='S' : V24defdatabit$='7'
  63. 1540   V24def$='V24:VSA70C24.40E'
  64. 1550   Cu=PEEK2(SYS(10)+64)+6
  65. 1560   Mtyp=FNMtest : Key99=FNKey99
  66. 1570   IF Mtyp=0 POKE 65266,1 ! ATTRIBUTE 1
  67. 1580   Enh$=FNRunenh$ : Enh=FNEnhcs(Enh$)
  68. 1590   Printer$='PR:VSA58C72.5'
  69. 1600   Dummy=FNV24def+FNInitpack+FNInitcsum
  70. 1610   RETURN 0
  71. 1620 FNEND
  72. 2000 DEF FNMtest LOCAL A
  73. 2010   A=INP(53) : OUT 53,4
  74. 2020   IF INP(53)=4 OUT 53,A : RETURN 0
  75. 2030   ON ERROR GOTO 2070
  76. 2040   PREPARE 'MEM:' AS FILE 99
  77. 2050   CLOSE 99
  78. 2060   RETURN 1
  79. 2070   RETURN 2
  80. 2080 FNEND
  81. 2090 DEF FNKey99 LOCAL A$=40,S$=10
  82. 2100   S$=CHR$(0,0,0,0,0,0,0)
  83. 2110   A$=CHR$(62,24,211,34,6,7,33,226,255,197,1,232,3,126,246,0)
  84. 2120   A$=A$+CHR$(32,7,11,120,177,32,246,193,201,193,35,126,18,19,43,62)
  85. 2130   A$=A$+CHR$(0,119,16,229,201)
  86. 2140   Z=CALL(VARPTR(A$),VARPTR(S$))
  87. 2150   IF (ASCII(RIGHT$(S$,3)) AND 35)=35 RETURN -1
  88. 2160   RETURN 0
  89. 2170 FNEND
  90. 2180 DEF FNRunenh$ LOCAL Drive,Adrenhl,Enh$=4,Dselect
  91. 2190   Drive=PEEK(64769) AND 31
  92. 2200   Adrenhl=PEEK2(SYS(10)+123)
  93. 2210   WHILE Adrenhl<>0
  94. 2220     Enh$=CHR$(PEEK(Adrenhl+2),PEEK(Adrenhl+3),PEEK(Adrenhl+4),58)
  95. 2230     Dselect=PEEK(Adrenhl+7)
  96. 2240     IF Drive=Dselect THEN RETURN Enh$
  97. 2250     Adrenhl=PEEK2(Adrenhl)
  98. 2260   WEND
  99. 2270   RETURN ''
  100. 2280 FNEND
  101. 2290 DEF FNEnhcs(Drive$) LOCAL Adrenhl,Enh$=4,Dselect
  102. 2300   Adrenhl=PEEK2(SYS(10)+123) : IF Drive$='' RETURN PEEK(PEEK2(24683))
  103. 2310   WHILE Adrenhl<>0
  104. 2320     Enh$=CHR$(PEEK(Adrenhl+2),PEEK(Adrenhl+3),PEEK(Adrenhl+4),58)
  105. 2330     IF Enh$='CON:' OR Enh$='NUL:' OR Enh$='PR:' OR Enh$='V24:' Enh$=''
  106. 2340     Dselect=PEEK(Adrenhl+7)
  107. 2350     IF Enh$=Drive$ RETURN Dselect
  108. 2360     Adrenhl=PEEK2(Adrenhl)
  109. 2370   WEND
  110. 2380   RETURN -1
  111. 2390 FNEND
  112. 2660 DEF FNV24def LOCAL A$=1,In$=1,P$=1,Tmph$=2
  113. 2670   Dummy=FNClr
  114. 2680   ; CUR(4,0) FNF$(CYA) 'A  300 bps' : ; FNF$(CYA) 'B  1200/75 bps'
  115. 2690   ; FNF$(CYA) 'C  75/1200 bps' : ; FNF$(CYA) 'D  1200 bps' : ; FNF$(CYA) 'E  2400 bps'
  116. 2700   ; FNF$(CYA) 'F  4800 bps' : ; FNF$(CYA) 'G  9600 bps' : ; FNF$(CYA) 'H  19200 bps'
  117. 2710   ; CUR(13,0) FNF$(YEL) 'V{lj kommunikationshastighet ( A - H ): ';
  118. 2720   A$=''
  119. 2730   WHILE A$<'A' OR A$>'H' : A$=CHR$(ASCII(FNInmata$(V24defhast$,13,62,1,2,1,CYA+CHR$(138))) AND 223) : WEND
  120. 2740   ; CUR(13,62) FNF$(CYA) A$
  121. 2750   ; : ; FNF$(CYA) 'S  Space (0)    M  Mark (1)    O  Odd (Udda)    E  Even (J{mn)'
  122. 2760   ; CUR(17,0) FNF$(YEL) 'V{lj paritet (S, M, O, E): ';
  123. 2770   WHILE In$<>'S' AND In$<>'M' AND In$<>'O' AND In$<>'E' : In$=CHR$(ASCII(FNInmata$(V24defpar$,17,62,1,2,1,CYA+CHR$(138))) AND 223) : WEND
  124. 2775   ; CUR(17,62) FNF$(CYA) In$
  125. 2780   IF In$='S' P$='D'
  126. 2790   IF In$='M' P$='C'
  127. 2800   IF In$='O' P$='B'
  128. 2810   IF In$='E' P$='A'
  129. 2830   Tmph$=MID$('2240044455667788',2*(ASCII(A$)-65)+1,2)
  130. 2840   MID$(V24def$,6,1)=P$
  131. 2850   IF LEN(V24def$)>=15 MID$(V24def$,14,2)=Tmph$ ELSE MID$(V24def$,14,1)=LEFT$(Tmph$,1)
  132. 2860   ; CUR(19,0) FNF$(YEL) 'V{lj 8 eller 7 databitar vid Kermit fil|verf|ring ( 8, 7 ): ';
  133. 2870   WHILE In$<>'8' AND In$<>'7' : In$=FNInmata$(V24defdatabit$,19,62,1,2,1,CYA+CHR$(138)) : WEND
  134. 2880   IF In$='8' Mqbin=89 ELSE Mqbin=38
  135. 2890   RETURN 0
  136. 2900 FNEND
  137. 2940 DEF FNClr
  138. 2950   ; CUR(1,0) FNF$(GYEL) STRING$(80,127);
  139. 2960   ; CUR(21,0) FNF$(GYEL) STRING$(80,127);
  140. 2970   ; CUR(0,22) SPACE$(36)
  141. 2980   ; Huvud$
  142. 2990   ; CUR(2,0);
  143. 3000   RETURN 0
  144. 3010 FNEND
  145. 3020 DEF FNF$(F{rg$)
  146. 3030   IF Mtyp=0 RETURN F{rg$
  147. 3040   RETURN ''
  148. 3050 FNEND
  149. 3550 DEF FNTkn$(F{rg$) LOCAL B$=1,Rad,Kol
  150. 3560   Rad=PEEK(Cu+1) : Kol=PEEK(Cu)
  151. 3570   IF Mtyp=0 ; F{rg$ CHR$(PEEK(30720+Rad*80+Kol));
  152. 3580   OUT 56,14,57,SWAP%(30720+Rad*80+Kol)
  153. 3590   OUT 56,15,57,30720+Rad*80+Kol
  154. 3600   OUT 56,10,57,104
  155. 3610   ; CUR(0,61) FNF$(CYA) TIME$
  156. 3620   WHILE SYS(5)=0 : ; CUR(0,61) FNF$(CYA) TIME$ : WEND
  157. 3630   GET B$
  158. 3640   POKE Cu,Kol,Rad
  159. 3650   RETURN B$
  160. 3660 FNEND
  161. 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
  162. 3760   Ut$=In$ : Pos=Inpos : Fval=Pa AND 15 : Z=FNKom99(9)
  163. 3770   WHILE -1
  164. 3780     ; CUR(Rad,Kol) FNF$(F{rg$) Ut$ STRING$(Max-LEN(Ut$),32-63*(Mtyp<>0)) CHR$(139) ' ';
  165. 3790     IF Pos>Max Pos=Max
  166. 3800     L{ngd=LEN(Ut$)
  167. 3810     ; CUR(Rad,Kol+Pos-1);
  168. 3820     A=ASCII(FNTkn$(F{rg$+CHR$(138))) : IF INSTR(1,CHR$(3,4,27,192,129),CHR$(A)) RETURN CHR$(27)
  169. 3830     Z=INSTR(1,CHR$(128,161,163,177,179,172,164,127),CHR$(A))
  170. 3840     IF Z A=ASCII(RIGHT$(CHR$(193,196,198,212,214,8,9,194),Z))
  171. 3850     IF A=24 Ut$='' : Pos=1
  172. 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$
  173. 3870     IF A=8 IF Pos>1 Pos=Pos-1 ELSE IF Pa>15 Z=FNKom99(9) : RETURN Ut$
  174. 3880     IF A=9 IF Pos<Max Pos=Pos+1 ELSE IF Pa>15 Z=FNKom99(9) : RETURN Ut$
  175. 3890     WHILE A=194
  176. 3900       IF Pos<=L{ngd Ut$=LEFT$(Ut$+' ',Pos-1)+RIGHT$(Ut$,Pos+1)
  177. 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
  178. 3920       A=0
  179. 3930     WEND
  180. 3940     IF A=132 Ins=(Ins=0) : Z=FNKom99(9-128*Ins)
  181. 3950     IF Fval=3 A=A AND 223
  182. 3960     IF A=195 AND Pos<=L{ngd Ut$=LEFT$(Ut$+' ',Pos-1)+' '+RIGHT$(Ut$,Pos) : IF LEN(Ut$)>Max Ut$=LEFT$(Ut$,Max)
  183. 3970     RESTORE 4060
  184. 3980     WHILE O8<=Fval : READ M1$,M2$,M3$ : O8=O8+1 : WEND
  185. 3990     WHILE ((A>=ASCII(M1$) AND A<=ASCII(M2$)) OR INSTR(1,M3$,CHR$(A))>0) AND Pos<=Max
  186. 4000       IF L{ngd<Pos Ut$=Ut$+SPACE$(Pos-L{ngd)
  187. 4010       Ut$=LEFT$(Ut$,Pos-1)+CHR$(A)+RIGHT$(Ut$,Pos-( NOT Ins))
  188. 4020       IF LEN(Ut$)>Max Ut$=LEFT$(Ut$,Max)
  189. 4030       Pos=Pos+1 : A=0
  190. 4040     WEND
  191. 4050   WEND
  192. 4060   DATA 0,9,' ',0,9,' .-',' ',~,' ',A,],' ',J,J,JjNn,A,],A
  193. 4070 FNEND
  194. 4080 DEF FNKom99(K)
  195. 4090   IF Key99 OUT 34,K
  196. 4100   RETURN 0
  197. 4110 FNEND
  198. 53000 !
  199. 53010 DEF FNInitpack
  200. 53020   ! KERMPACK.ASM. 87-08-22 19.49
  201. 53030   DIM Pack$=376
  202. 53040   Pack$=CHR$(213,221,225,221,110,3,221,102,4,78,6,0,9,235,121,217,87,221,94,5,217,221,110,0,221,102,1,78,9,197,217,193,123,214,94,186,56,101,120)
  203. 53050   Pack$=Pack$+CHR$(167,32,97,221,126,2,185,56,91,3,217,126,35,1,0,1,167,40,70,221,190,8,32,17,126,35,214,32,254,94,56,2,62,94,71,126,35,217,3,3,217)
  204. 53060   Pack$=Pack$+CHR$(221,190,7,32,7,14,128,126,35,217,3,217,221,190,6,32,31,126,35,217,3,111,230,127,40,15,221,190,8,40,15,221,190,7,40,10,221,190,6,40)
  205. 53070   Pack$=Pack$+CHR$(5,125,238,64,24,1,125,217,177,18,19,217,20,217,16,249,217,24,149,221,110,3,221,102,4,114,221,110,0,221,102,1,113,105,96,221,78,2)
  206. 53080   Pack$=Pack$+CHR$(175,71,237,66,201,213,221,225,221,110,0,221,102,1,78,6,0,9,235,121,217,87,221,94,2,217,221,110,3,221,102,4,78,35,70,43,197,6,0,9)
  207. 53090   Pack$=Pack$+CHR$(217,225,69,76,123,214,10,186,56,6,121,184,40,2,48,24,221,110,0,221,102,1,114,221,110,3,221,102,4,112,35,113,120,185,33,0,0,192,43)
  208. 53100   Pack$=Pack$+CHR$(201,4,217,221,126,8,167,40,55,126,43,190,35,32,40,4,120,254,5,56,31,197,221,126,8,217,119,35,241,198,32,119,229,43,221,86,5,20,20)
  209. 53110   Pack$=Pack$+CHR$(217,209,19,254,126,32,18,6,0,24,14,24,169,61,32,9,6,1,213,217,225,221,114,5,217,126,35,79,254,128,56,15,221,126,7,167,40,9,18,19)
  210. 53120   Pack$=Pack$+CHR$(217,20,217,121,230,127,79,221,126,6,167,40,40,121,230,127,254,127,40,21,254,32,56,17,221,190,6,40,16,221,190,7,40,11,221,190,8,40)
  211. 53130   Pack$=Pack$+CHR$(6,24,12,121,238,64,79,221,126,6,18,19,217,20,217,121,18,19,217,20,24,167)
  212. 53140   RETURN 0
  213. 53150 FNEND
  214. 53160 !
  215. 53170 DEF FNInitcsum
  216. 53180   ! KERMCSUM.ASM. 87-08-16 16.16
  217. 53190   DIM Csum$=40
  218. 53200   Csum$=CHR$(235,35,35,94,35,86,35,78,35,70,33,0,0,121,176,40,11,26,133,111,62,0,140,103,11,19,24,241,125,7,203,20,7,203,20,125,230,63,111,201)
  219. 53210   RETURN 0
  220. 53220 FNEND
  221.