1 REM Ins{nd av Bo Kullmar <1789> 1985-01-06 10.19.30
2 ! +++++++++++++++++++++++++++++++++++
3 ! Program .... START.800
4 ! Utg}va 2.1 1984-02-13
5 ! av (c) Bo Kullmar
8 ! Ins{nt av Bo Kullmar, medl 1789.
9 ! Startprogram f|r ABCTERM
10 ! +++++++++++++++++++++++++++++++++++
80 EXTEND : INTEGER
100 COMMON Parv24$=16,Parpr$=15,Dimbuff,Pf(32),Pf$(32)=81,Meny$(32)=14
110 COMMON Logginnr,Medlemsnr,L|senord$=5,Prom.,Duplex$=11,Enh$=4
120 COMMON Pftkn$(32)=1,Tscreen$=2048,Curpos,]ter,Dator$=8,Inifil$=16,Pfpekare
130 COMMON R|d$=1,Gul$=1,Bl}$=1,Gr|n$=1,Cyan$=1,Magneta$=1,Dubel$=1
300 DIM In$=80,Pftext$=1000
1000 ! Huvudrutin
1010 Dator$=FNDator$
1020 IF Dator$='ABC800 C' OR Dator$='ABC806' THEN Z=FNF{rg
1030 Enh$=FNRunenh$
1040 Z=FNIni
1045 IF Prom.=7.1 THEN Z=FNBortspace
1050 CHAIN Enh$+'ABCTERM.BAC'
2000 DEF FNIni
2010 Pver=PEEK2(PEEK2(65500))
2020 IF Pver<>8 AND Pver<>10 THEN Prom.=7.1
2030 IF Pver=8 THEN Prom.=7.2
2040 IF Pver=10 THEN Prom.=7.21
2050 ; CHR$(12) Gul$ Dubel$ 'ABCTERM' : ; : ; : ;
2060 ; Cyan$ 'Ange vilken initieringsfil du vill ange, ange det med max }tta bokst{ver'
2070 ; Cyan$ 'utan enhetsnamn och extension. Default {r ABCTERM.INI. Om du anger'
2080 ; Cyan$ 'en initieringsfil som inte finns, s} skapas den med defaultv{rden.'
2090 ; Cyan$ 'Vill du anv{da ABCTERM.INI s} beh|ver du bara tycka p} vid fr}gan.'
2100 ; : ; : ; Gul$; : INPUT 'Ange initieringsfil (ABCTERM) ! 'Inifil$
2110 IF Inifil$='' THEN Inifil$='ABCTERM' : ; CUR(10,32) Gul$ Inifil$
2120 IF LEN(Inifil$)>8 THEN ; R|d$ 'F|r l}ngt filnamn!' : GOTO 2100
2130 Inifil$=Inifil$+'.INI'
2140 POKE 65348,0 ! Nollst{ller ERRCODE
2150 ON ERROR GOTO 2190
2160 OPEN Enh$+Inifil$ AS FILE 10
2170 Err=FNInifil : IF Err THEN ; R|d$ 'Fel nr ' Err 'vid inl{sning av initeringstabellen' : STOP
2180 GOTO 2260
2190 IF ERRCODE THEN Err=ERRCODE : RESUME 2200
2200 POKE 65348,0 ! Nollst{ller ERRCODE
2210 ON ERROR GOTO 2230
2220 IF Err=21 THEN CHAIN Enh$+'ABCFIL.BAC' ELSE IF Err THEN ; R|d$ 'Fel nr ' Err : STOP
2230 RESUME 2240
2240 IF ERRCODE=21 THEN ; R|d$ 'ABCFIL.BAC saknas! Progrmmet kan inte anv{ndas utan detta program!' : STOP
2250 IF ERRCODE<>21 THEN ; R|d$ 'Fel nr ' ERRCODE : STOP
2260 F|rsta=-1
2270 RETURN 0
2280 FNEND
3000 DEF FNInifil
3010 ON ERROR GOTO 3180
3020 GET #10,Parv24$ COUNT 16
3030 GET #10,Parpr$ COUNT 15
3040 GET #10,Dimbuff$ COUNT 2 : Dimbuff=CVT$%(Dimbuff$)
3050 FOR I=1 TO 32
3060 GET #10 Pf$ : Pf(I)=ASCII(Pf$)
3070 NEXT I
3080 FOR I=1 TO 32
3090 GET #10,Antal$ : Antal=ASCII(Antal$)
3100 GET #10,Pf$(I) COUNT 81
3110 IF Antal<>0 THEN Pftkn$(I)=LEFT$(Pf$(I),1) : Pf$(I)=MID$(Pf$(I),2,Antal-1)
3115 IF Antal=0 THEN Pftkn$(I)=' ' : Pf$(I)=MID$(Pf$(I),2,80)
3120 GET #10,Meny$(I) COUNT 14
3130 NEXT I
3140 GET #10,Logginnr$ COUNT 2 : Logginnr=CVT$%(Logginnr$)
3150 GET #10,Medlemsnr$ COUNT 2 : Medlemsnr=CVT$%(Medlemsnr$)
3160 GET #10,L|senord$ COUNT 5
3170 RETURN 0
3180 RESUME 3190
3190 RETURN ERRCODE
3200 FNEND
4000 DEF FNDator$ LOCAL Typ$=8,Z
4010 DIM Enh$(30)=30 : Z=FNEnhet
4020 IF Mem THEN RETURN 'ABC802'
4030 IF NOT Cas THEN RETURN 'ABC806'
4040 ON ERROR GOTO 4060
4050 Z=TXPOINT(1,1) : RETURN 'ABC800 C'
4060 RESUME 4070
4070 RETURN 'ABC800 M'
4080 FNEND
4090 DEF FNEnhet LOCAL Adrenhl,Pos,I
4100 Adrenhl=SYS(10)+123
4110 Adrenhl=PEEK2(Adrenhl)
4120 WHILE Adrenhl<>0
4130 Enh$(I)=CHR$(PEEK(Adrenhl+2),PEEK(Adrenhl+3),PEEK(Adrenhl+4),58)
4140 Adrenhl=PEEK2(Adrenhl)
4150 WHILE INSTR(1,Enh$(I),' ')<>0
4160 Pos=INSTR(1,Enh$(I),' ')
4170 Enh$(I)=LEFT$(Enh$(I),Pos-1)+RIGHT$(Enh$(I),Pos+1)
4180 WEND
4190 IF Enh$(I)=':' THEN Enh$(I)=SPACE$(4)
4200 IF Enh$(I)='CAS:' THEN Cas=-1
4210 IF Enh$(I)='MEM:' THEN Mem=-1
4220 IF Enh$(I)='RAM:' THEN Ram=-1
4230 I=I+1
4240 WEND : RETURN 0
4250 FNEND
5000 DEF FNRunenh$ LOCAL Drive,Adrenhl,Enh$=4,Dselect
5010 Drive=PEEK(64769) AND 31
5020 Adrenhl=PEEK2(SYS(10)+123)
5030 WHILE Adrenhl<>0
5040 Enh$=CHR$(PEEK(Adrenhl+2),PEEK(Adrenhl+3),PEEK(Adrenhl+4),58)
5050 Dselect=PEEK(Adrenhl+7)
5060 IF Drive=Dselect THEN RETURN Enh$
5070 Adrenhl=PEEK2(Adrenhl)
5080 I=I+1
5090 WEND
5100 RETURN ''
5110 FNEND
6000 DEF FNF{rg
6010 R|d$=RED : Bl}$=BLU : Gul$=YEL : Gr|n$=GRN : Cyan$=CYA : Magneta$=MAG : Dubel$=DBLE
6020 RETURN 0
6030 FNEND
7000 DEF FNBortspace
7010 Parv24$=LEFT$(Parv24$,14)
7030 Parpr$=LEFT$(Parpr$,13)
7040 RETURN 0
7050 FNEND