1 REM Ins{nt av 2635
10 ! Konverterat till ABC 800 med program fr}n NAN-KOMPIL 1983-09-09/PSk
20 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
30 ! ! Program ....   DISKREG.800
40 ! ! Utg}va  2.6    84-01-15
50 ! ! av (c) Rolf Nordin
60 ! ! {ndrat av Mats Larsson
70 ! ! Minne 32 Kbytes f|r flexskiva. Disketter dubbelsidiga, dubbel densitet
80 ! ! Modifierat f|r ABC800
90 ! ! av Per Svebeck
100 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
110 ! Detta {r en b{ttre version av DISKREG Ver 1 f|r ABC80.
120 ! Detta program anv{nder sig av en direkt-fil. Detta g|r att det g}r
130 ! mycket fortare att s|ka bland skivorna.
140 ! 
150 ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
160 ! !                                                 ** DIV INIT **
170 EXTEND : INTEGER 
180 Ver$="2.5" ! Version nr
190 ! 
200 DEF FNCl(U,U1)
210   IF U=28666 RETURN FNRa(U1)
220   IF U=28668 RETURN FNRi(U1)
230   IF U=28670 RETURN FNRu(U1)
240   IF U>-1 RETURN CALL(U,U1)
250   IF U>-129 RETURN CALL(U-256,U1)
260   RETURN CALL(U,U1)
270 FNEND 
280 ! 
290 DEF FNRa(U)
300   Ra=U : RETURN 0
310 FNEND 
320 ! 
330 DEF FNRi(U)
340   POSIT #Ra,253*U : GET #Ra,Q0$ COUNT 253 : RETURN 0
350   ! 
360 FNEND 
370 DEF FNRu(U)
380   POSIT #Ra,U*253 : PUT #Ra,Q0$ : RETURN 0
390   ! 
400 FNEND 
410 ! 
420 DEF FNIp(U) LOCAL I
430   IF U=56 I=PEEK(65506) OR PEEK(65507) : POKE 65506,0 : RETURN I
440   RETURN INP(U)
450 FNEND 
460 ! 
470 DEF FNPk(U) LOCAL N$=20,O$=20,U1
480   IF U>-1 RETURN U
490   IF U>-257 RETURN U-256
500   O$=CHR$(10,11,28,29,30,31,32,33,39,40,41,42,43,50,51)
510   N$=CHR$(123,124,12,13,8,9,10,11,14,15,56,57,52,64,65)
520   IF U>-513 U1=INSTR(1,O$,CHR$(U)) : IF U1 RETURN 65280+ASCII(MID$(N$,U1,1)) ELSE RETURN U
530   IF U=65011 RETURN 65363 ELSE IF U=65012 RETURN 65362 ELSE IF U=65013 RETURN 65506 ELSE RETURN U
540 FNEND 
550 ! 
560 DEF FNIr(U,U$,U1$)
570   IF LEN(U1$)=0 RETURN 0 ELSE RETURN INSTR(U,U$,U1$)
580 FNEND 
590 ! 
600 DEF FNFi$(U$) LOCAL U1$=120
610   FOR Slask=1 TO LEN(U$)
620     IF MID$(U$,Slask,1)<>' ' U1$=U1$+MID$(U$,Slask,1)
630   NEXT Slask : RETURN U1$
640 FNEND 
650 ! 
660 DEF FNEnd$
670   END 
680 FNEND 
690 ! 
700 ! !                       ***** OMVANDLA GEMENER TILL VERSALER *********
710 DEF FNVersal(Text$) LOCAL Tecken$=160
720   ! -----------------------------------
730   FOR Tknpos=1 TO LEN(Text$)
740     Tecken$=MID$(Text$,Tknpos,1)
750     Kod=ASCII(Tecken$)
760     IF Kod>95 THEN Kod=Kod-32
770     MID$(Text$,Tknpos,1)=CHR$(Kod)
780   NEXT Tknpos 
790   RETURN 0
800 FNEND 
810 DIM In$=120,Ut$=120
820 ! 
830 DEF FNIn$(U)
840   IF LEN(In$)>0 RETURN FNId$
850   INPUT LINE #U,In$ : IF U=0 ; #U
860   In$=LEFT$(In$,LEN(In$)-2)
870   RETURN FNId$
880 FNEND 
890 ! 
900 DEF FNId$ LOCAL Ut$=120,Kp,De
910   Kp=ASCII(In$) : IF Kp=34 OR Kp=39 De=Kp ELSE De=44
920   Kp=INSTR(2+(De=44),In$,CHR$(De))
930   IF Kp=0 Ut$=In$ : In$='' : RETURN FNFi$(Ut$)
940   Ut$=MID$(In$,1-(De<>44),Kp+(De<>44)-1)
950   IF De<>44 AND LEN(In$)>Kp+1 In$=RIGHT$(In$,Kp+2) ELSE In$=RIGHT$(In$,Kp+1)
960   RETURN Ut$
970 FNEND 
980 ! 
990 ! !                                ****** PREPARERA EN DIREKTFIL ********
1000 DEF FNPrepfil(Fil$,Postantal,Postl{ngd)
1010   ; CHR$(12)
1020   ; "*** PREPARERING av en DIREKTFIL Ver 1.0 ***"
1030   ; 
1040   PREPARE Fil$ AS FILE 1
1050   ; "Nu skapas filen " Fil$
1060   FOR Antal=1 TO Postantal
1070     ; CUR(15,0) "Skapar nu post:" Antal
1080     PUT #1,SPACE$(Postl{ngd)
1090   NEXT Antal 
1100   CLOSE 1
1110   ; CHR$(7) "Nu {r det klart"
1120   RETURN 0
1130 FNEND 
1140 ! 
1150 DEF FNSidcheck$
1160   ON ERROR GOTO 1180
1170   OPEN "SKIVSIDA.DAT" AS FILE 9 : GOTO 1200
1180   IF ERRCODE=21 Z=FNPrep("SKIVSIDA.DAT") : OPEN "SKIVSIDA.DAT" AS FILE 9
1190   POKE 65348,0 ! Nollst{ller ERRCODE
1200   INPUT #9,Sida$
1210   RETURN Sida$
1220   CLOSE 9
1230 FNEND 
1240 ! 
1250 DEF FNPrep(Fil$)
1260   ; CHR$(12) "M{rkning av skivsida"
1270   INPUT "Ange sidans nummer (1 eller 2) : "Sida$
1280   PREPARE Fil$ AS FILE 9
1290   ; #9,Sida$
1300   ; "Nu har sidan m{rkts som nr: " Sida$
1310   RETURN 0
1320 FNEND 
1330 ! 
1340 ! !                          ******** VAL AV REGISTERSYSTEM ********
1350 ; CHR$(12) "V{lj registersystem"
1360 ; "Varje system rymmer 25 skivor"
1370 ; "Skivsida :"; : ; FNSidcheck$ ! Kontrollera vilken sida som {r insatt
1380 D=0 ! Startv{rde skivsida
1390 ; : ; "Du kan v{lja mellan dessa: "
1400 ; : ; "P} framsidan (1)" : ; STRING$(40,137)
1410 ; "0. ABC-Klubbens kassetter"
1420 ; "1. Systemprogram"
1430 ; "2. Spelprogram"
1440 ; "3. Ord/textbehandling/editorer"
1450 ; "4. Andra programspr}k {n BASIC"
1460 ; : ; "P} baksidan (2)" : ; STRING$(40,137)
1470 ; "5. K|pta programskivor (LUXOR t ex)"
1480 ; "6. Grafik"
1490 ; "7. Utbildning/\vning"
1500 ; "8. \vriga program"
1510 ; STRING$(40,137)
1520 ; "9. Avsluta "
1530 ; 
1540 ON ERROR GOTO 1540 : INPUT "Vilket v{ljer du (0-9) ? "Q$
1550 IF LEN(Q$)=0 THEN ; FNEnd$ ELSE Q=VAL(Q$)
1560 IF ASCII(Q$)<48 OR ASCII(Q$)>57 THEN 1540
1570 IF Q<0 OR Q>9 THEN 1540
1580 IF Q=9 THEN ; FNEnd$
1590 IF (Q=0 OR Q=1 OR Q=2 OR Q=3 OR Q=4) AND Sida$="2" THEN ; CHR$(7)+"V[ND p} skivan"
1600 ; "Tryck p}  RETURN   "; : GET Slask$
1610 IF (Q=5 OR Q=6 OR Q=7 OR Q=8) AND Sida$="1" THEN ; CHR$(7)+"V[ND p} skivan,"
1620 ; "Tryck p} RTEURN  "; : GET Slask$
1630 System$="SKIVOR"+Q$+".DAT"
1640 ! 
1650 ON ERROR GOTO 1660 : OPEN FNFi$(System$) AS FILE 1 : GOTO 1700
1660 IF ERRCODE=38 THEN 2840
1670 ; "INGEN DATAFIL FINNS TILL DETTA REGISTER"
1680 INPUT "Skall vi preparera ett system (j/n) ? "Q$
1690 IF LEN(Q$)=0 OR Q$="j" OR Q$="J" THEN Z=FNPrepfil(System$,25,1000) ELSE GOTO 1350
1700 K$='RVBHATS' : DIM F$(91)=12,A$=1012
1710 ! 
1720 ! !***************************** HUVUDPROGRAM ****************************
1730 GOSUB 2490
1740 GOSUB 2770 : GOSUB 2730 : GOSUB 2670 : I$=FNIn$(0) : In$="" : GOSUB 2420
1750 GOSUB 2820 : I=FNIr(1,K$,I$) : IF I=0 THEN 1740
1760 ON I GOSUB 1780,1980,2100,2490,2160,2180,2270 : GOTO 1740
1770 ! !                               ******  REGA SKIVA *********
1780 GOSUB 2460
1790 IF FNIr(1,I$,']') OR FNIr(1,I$,'}') THEN RETURN 
1800 E=4 : ON ERROR GOTO 2840 : D=VAL(I$) : IF D>25 OR D<1 THEN 1780
1810 POKE FNPk(64769),1 : Z=FNCl(24678,192)
1820 IF PEEK(FNPk(64789)) THEN E=1 : GOTO 2840
1830 F=0 : FOR I=0 TO 7 : B(I)=PEEK(FNPk(62959+I)) : NEXT I 
1840 FOR S=0 TO 7 : IF B(S)<2 THEN 1930
1850   Z=FNCl(24678,512+S*32)
1860   FOR A=62736 TO 62960 STEP 16
1870     IF PEEK(FNPk(A))=255 THEN 1920
1880     F$(F)='' : FOR I=4 TO 11 : F$(F)=F$(F)+CHR$(PEEK(FNPk(A+I))) : NEXT I 
1890     F$(F)=F$(F)+'.'
1900     FOR I=12 TO 14 : F$(F)=F$(F)+CHR$(PEEK(FNPk(A+I))) : NEXT I 
1910     F=F+1
1920   NEXT A 
1930 NEXT S 
1940 E=2 : ON ERROR GOTO 2840
1950 GOSUB 3000
1960 GOTO 2010
1970 ! !                                        *******  L[S I REGISTER ******
1980 GOSUB 2460
1990 IF FNIr(1,I$,']') OR FNIr(1,I$,'}') THEN RETURN 
2000 E=4 : ON ERROR GOTO 2840 : D=VAL(I$) : IF D>25 OR D<1 THEN 1980
2010 E=3 : ON ERROR GOTO 2840 : GOSUB 3150
2020 IF F=0 THEN 2840
2030 ; CHR$(12) : GOSUB 2770
2040 GOSUB 2440 : ; CUR(2,0); : T=0 : IF F=0 THEN RETURN ELSE FOR I=0 TO F-1
2050   F$=F$(I)
2060   ; #L,TAB(1+(T)) F$; : T=T+16 : IF T=80 T=0
2070 NEXT I 
2080 RETURN 
2090 ! !                                  ******  BL[DDRA REG **********
2100 M=D : IF M=0 THEN M=25
2110 D=D+1 : IF D=26 D=1
2120 IF D=M RETURN 
2130 ON ERROR GOTO 2840 : GOSUB 3150 : IF F=0 THEN 2110 ELSE 2030
2140 RETURN 
2150 ! !                                  ******  AVSLUTA REG **********
2160 CLOSE 1 : GOTO 1350
2170 ! !                                  ******  TAG BORT REGISTRERING ****
2180 GOSUB 2460
2190 IF FNIr(1,I$,']') OR FNIr(1,I$,'}') THEN RETURN 
2200 E=4 : ON ERROR GOTO 2840 : D=VAL(I$) : IF D>25 OR D<1 THEN 2180
2210 E=1 : ON ERROR GOTO 2840 : Z=FNRa(1)+FNRi((D-1)*4) : IF ASCII(Q0$)=64 THEN E=3 : GOTO 2840
2220 FOR X=(D-1)*4 TO ((D-1)*4)+3
2230   Z=FNRa(1) : Q0$=STRING$(253,64) : Z=FNRu(X)
2240 NEXT X 
2250 RETURN 
2260 ! !                                    ****** S\K FILNAMN ***********
2270 GOSUB 2740
2280 ; CUR(22,0) 'Filnamn.<BAC>............? '; : INPUT LINE I$ : I$=LEFT$(I$,LEN(I$)-2)
2290 IF I$='' THEN 2270
2300 IF LEN(I$)>12 ; "F|r m}nga tecken" : GOTO 2270
2310 Z=FNVersal(I$)
2320 IF FNIr(1,I$,']') OR FNIr(1,I$,'}') THEN RETURN 
2330 GOSUB 3280 : ! FIXA I$ s} att den inneh}ller 12 tecken
2340 X=D+1 : IF X=26 THEN X=1
2350 FOR Y=X TO X+24
2360   D=Y : IF Y>25 THEN D=Y-25
2370   GOSUB 2440
2380   GOSUB 3150 : ! L[S SKIVA
2390   FOR I=0 TO F-1 : F$=F$(I) : IF F$=I$ THEN GOTO 2010 ELSE NEXT I 
2400 NEXT Y 
2410 E=5 : GOTO 2840 ! Filen finns inte
2420 I$=CHR$(ASCII(RIGHT$(I$,1)) AND 223) : RETURN 
2430 ! !                                     ****** SKIVNUMMER ***********
2440 ; CUR(0,50) 'System: ' Q ' Skiva nr: ';D : RETURN 
2450 ! ** TAG IN SKIVNUMMER **
2460 GOSUB 2740 : GOSUB 2700 : I$=FNIn$(0) : In$=""
2470 RETURN 
2480 ! !                                   **** INSTRUKTIONER ****
2490 ; CHR$(12)+SPACE$(10)+'DISKETTREGISTER ABC800 Ver ' Ver$
2500 ; 
2510 ; : ; 'Registerskivan skall sitta i DR0:'
2520 ; 'Skiva som skall registreras s{tts i DR1:'
2530 ; : ; "System inne: " Q
2540 ; 
2550 ; 'Kommandon:'
2560 ; 'Registrera skiva............R'
2570 ; 'Visa en reg. skiva..........V'
2580 ; 'Bl{ddra i registret.........B'
2590 ; 'S|k efter filnamn...........S'
2600 ; 'Hj{lpinstruktioner..........H'
2610 ; ']ngra kommando .............]'
2620 ; 'Tag bort registrering.......T'
2630 ; 'Avsluta eller byt system....A'
2640 ; : ; 'Tryck >RETURN< n{r du har l{st klart'
2650 GET I$ : IF ASCII(I$)=13 THEN ; CHR$(12); : RETURN ELSE 2650
2660 ! !                                      *** KOMMANDOTEXT *** 
2670 ; CUR(21,0) "System: " Q "Skiva: " D ' Kommando (R/V/B/S/H/T/A/]) ';
2680 RETURN 
2690 ! ***********************
2700 ; CUR(22,0) 'Skivans nummer (1-25)....: ';
2710 RETURN 
2720 ! ** RADERA RADER **
2730 ; CUR(21,0) SPACE$(80);
2740 ; CUR(22,0) SPACE$(80);
2750 RETURN 
2760 ! !                                      *** RUBRIK OCH GRAFIK ***
2770 ; CUR(0,10) ' * DISKETTREGISTER ABC800 Ver ' Ver$ ' *'
2780 ; CUR(1,0) STRING$(80,140);
2790 ; CUR(20,0) STRING$(80,61);
2800 ! ; CUR(23,0) STRING$(80,137);
2810 RETURN 
2820 ; CUR(23,0) SPACE$(80); : RETURN 
2830 ! !         **************** FELMEDDELLANDEN *****************
2840 IF ERRCODE=37 THEN E=6 : OPEN FNFi$(System$) AS FILE 1
2850 IF ERRCODE=43 THEN E=7 : OPEN FNFi$(System$) AS FILE 1
2860 IF ERRCODE=38 THEN E=3
2870 ON E RESTORE 2900,2910,2920,2930,2940,2950,2960
2880 READ E$ : ; CUR(23,1) CHR$(7) E$;
2890 RETURN 
2900 DATA 'SKIVAN INTE KLAR!!!'
2910 DATA 'REGISTERSKIVAN SAKNAS!!!'
2920 DATA 'FINNS INTE I REGISTRET!!!'
2930 DATA 'FELAKTIGT SKIVNUMMER!!!'
2940 DATA 'FILNAMNET FINNS INTE !!!'
2950 DATA 'L[SFEL P] SKIVAN!!!'
2960 DATA 'SKIVAN [R SKRIVSKYDDAD!!!'
2970 ! !                                 **** SKRIVA TITTLAR ****
2980 ! D%=SKIVNUMMER
2990 ! F$(F%)=TITTLAR
3000 A$=""
3010 IF F=0 THEN RETURN 
3020 FOR X=0 TO F-1
3030   A$=A$+LEFT$(F$(X),8)+RIGHT$(F$(X),10)
3040 NEXT X 
3050 A$=A$+STRING$(1012-LEN(A$),64)
3060 FOR X=(D-1)*4 TO ((D-1)*4)+3
3070   Z=FNRa(1)
3080   Q0$=LEFT$(A$,253) : A$=RIGHT$(A$,254)
3090   Z=FNRu(X)
3100 NEXT X 
3110 RETURN 
3120 ! !                                  ***** L[S TITTLAR ******
3130 ! IN D%=SKIVNUMMER
3140 ! UT F$(F%)=TITTLAR
3150 A$=""
3160 FOR X=(D-1)*4 TO ((D-1)*4)+3
3170   Z=FNRa(1)+FNRi(X)
3180   A$=A$+Q0$
3190   IF ASCII(RIGHT$(A$,LEN(A$)-2))=64 THEN 3210
3200 NEXT X 
3210 FOR F=0 TO 91
3220   IF ASCII(A$)=64 THEN RETURN 
3230   F$(F)=LEFT$(A$,8)+"."+MID$(A$,9,3)
3240   A$=RIGHT$(A$,12)
3250 NEXT F 
3260 ! !                                 ***** FIXA I$ **********
3270 RETURN 
3280 FOR M=1 TO LEN(I$)
3290   IF MID$(I$,M,1)="." THEN 3310
3300 NEXT M 
3310 I$=LEFT$(I$,M-1)+SPACE$(9-M)+RIGHT$(I$,M)
3320 IF NOT MID$(I$,LEN(I$)-3,1)="." THEN I$=I$+".BAC"
3330 RETURN 
3340 END