10 ! ====================================================
20 ! program MENY.BAC
30 ! version 1.2
40 ! 1984-06-11
45 ! 
50 ! ( C ) Leif Eriksson   < 397 >
51 ! G{vle    026-195271
60 ! 
70 ! ===================================================
80 ! 
90 EXTEND : INTEGER 
100 DIM L{ngd(12)
110 ! 
120 DEF FNRam$ ! ram p} sk{rm
130   PRINT CUR(0,0) STRING$(80,61)
140   PRINT CUR(22,0) STRING$(80,61)
150   PRINT CUR(2,0) STRING$(80,61)
160   RETURN ''
170 FNEND 
180 ! 
190 DEF FNMeny$
200   PRINT CUR(1,0) '   ABC800      DATABAS       MENY  ver. 1.2 ' TAB(80) ''
210   PRINT CUR(6,3) 'In- och utmatning i register.' TAB(40) 'PF1:'
220   PRINT CUR(7,3) STRING$(40,95)
230   PRINT CUR(10,3) 'Skapa ett nytt ISAM-register.' TAB(40) 'PF2:'
240   PRINT CUR(12,3) 'L{gga in ett f{lt till.' TAB(40) 'PF3:'
250   PRINT CUR(14,3) 'En till s|knyckel.' TAB(40) 'PF4:'
260   PRINT CUR(16,3) 'Hj{lprutiner.' TAB(40) 'PF5:'
270   PRINT CUR(19,3) 'Avslut.' TAB(40) 'PF6:'
280   RETURN ''
290 FNEND 
300 ! 
310 DEF FNPftangent
320   ON ERROR GOTO 370
330   PRINT CUR(23,3) 'Vilket alternativ  >>';
340   PRINT CUR(1,50) TIME$
350   IF SYS(5) THEN 360 ELSE 340
360   PRINT CUR(23,24); : INPUT ''I : GOTO 360
370   IF ERRCODE<>53 THEN RESUME 320
380   I=SYS(6) ! l{gg tillbaka tecken i buffert
390   GET P$
400   I=ASCII(P$)-191
410   IF I>6 THEN RESUME 320
420   RESUME 430
430   RETURN I
440 FNEND 
450 ! 
460 DEF FNSudda
470   FOR I=3 TO 21
480     PRINT CUR(I,0) SPACE$(80);
490   NEXT I 
500   RETURN 0
510 FNEND 
520 ! 
530 ! 
540 DEF FNKoll LOCAL Temp
550   OPEN 'DR1:DATA.ID' AS FILE 2
560   OPEN 'DR1:DATA.ISM' AS FILE 3
570   POSIT #2,2
580   GET #2,P$ COUNT 2
590   Antalf{lt=CVT$%(P$)
600   GET #2,P$ COUNT 2
610   Nyckelant=CVT$%(P$)
620   POSIT #2,18
630   POSIT #3,27
640   DIM Namn$(Antalf{lt),Indextyp(Antalf{lt)
650   FOR I=1 TO Antalf{lt
660     GET #2,P$ COUNT 2
670     L{ngd(I)=CVT$%(P$)
680     GET #2,Namn$(I) COUNT 12
690   NEXT I 
700   ! 
710   FOR I=1 TO Nyckelant
720     GET #3,P$ COUNT 20
730     Start(I)=CVT$%(MID$(P$,13,2))
740     L(I)=ASCII(MID$(P$,15,1))
750     Typ(I)=ASCII(MID$(P$,16,1))
760   NEXT I 
770   POSIT #3,25
780   GET #3,P$ COUNT 2
790   Postl{ngd=CVT$%(P$)
800   DIM St(Antalf{lt)
810   St(1)=1
820   FOR I=1 TO Antalf{lt-1
830     Temp=Temp+L{ngd(I)+1
840     St(I+1)=Temp
850   NEXT I 
860   ! 
870   Z=FNSudda
880   ! 
890   FOR I=1 TO Antalf{lt
900     PRINT CUR(I+4,0) Namn$(I)
910     FOR J=1 TO Nyckelant
920       IF Start(J)=St(I) THEN 930 ELSE 980
930       ! kolla vilken typ av s|knyckel
940       IF Typ(J)<2 THEN PRINT CUR(I+4,13) 'G}r ej att g|ra ber{kningar p}.'
950       IF Typ(J)=2 THEN PRINT CUR(I+4,13) 'Heltal.'
960       IF Typ(J)=3 THEN PRINT CUR(I+4,13) 'Flyttal enkel precicion.'
970       IF Typ(J)=4 THEN PRINT CUR(I+4,13) 'Flyttal dubbel precicion.'
980     NEXT J 
990   NEXT I 
991   RETURN 0
992 FNEND 
1000 ! 
1010 ! 
1020 DEF FNText$
1030   Z=FNSudda
1040   PRINT CUR(4,0) 'Kolumnform:'
1050   PRINT 'F{lt 1:  XXXXXXXXXXXXXXXXXXXXXXXXXXXX'
1060   PRINT 'F{lt 2:  UUUUUUUUUUUUUUUUUUUUUUUUUUUU'
1070   PRINT 'F{lt 3:  YYYYYYYYYYYYYYYYYYYYYYYYYYYY'
1080   PRINT 'F{lt 4:  OOOOOOOOOOOOOOOOOOOOOOOOO'
1090   PRINT 'F{lt 5:  TTTTTTTTTTTTT'
1100   PRINT 
1110   PRINT 
1120   PRINT 'Packad form:'
1130   PRINT 'F{lt 1: ZZZZZZZZZZZZZZZZZZZ  F{lt 2: HHHHHHHHHHHHHHH  F{lt 3: ]]]]]]]]]]]]]]]'
1140   PRINT 'F{lt 4: EEEEEEEEEEEEE  F{lt 5: QQQQQQQQQQQQQQQQQQQQQQQQ'
1150   PRINT 
1160   PRINT 
1170   INPUT 'Tryck  >>'P$
1180   Z=FNSudda
1190   PRINT CUR(4,0) 'F{lt 1:        F{lt 2:                  F{lt 3:           F{lt 4:'
1200   PRINT '============================================================================='
1210   PRINT 'YYYYYYYYYYY    IIIIIIIIIIIIIIIIII      ((((((((((((((((   wwwwwwwwwwwwww'
1220   PRINT 'wwwwwwwwwwww   bbbbbbbbbbbbbbbbbbb     BBBBBBBBBBBBBBB    ooooooooo'
1230   PRINT 'gggggggggggg   GGGGGGGGGGGGGGGGGGG     rrrrrrrrrrrr       rrrrrrrrrrrrr'
1240   PRINT 
1250   PRINT 
1260   PRINT 'Detta {r utskriften med ett Huvud p} varje sida, och en post p} varje rad.'
1270   PRINT 
1280   INPUT 'Tryck  >>'P$
1290   ! 
1300   RETURN ''
1310 FNEND 
1320 ! 
1330 ! 
1340 DEF FNForm
1350   ON ERROR GOTO 2700
1360   OPEN 'DR1:DATA.ID' AS FILE 1
1370   POSIT #1,2
1380   GET #1,P$ COUNT 2
1390   Antalf{lt=CVT$%(P$)
1400   POSIT #1,18
1410   FOR I=1 TO Antalf{lt
1420     GET #1,P$ COUNT 14
1430     L{ngd(I)=CVT$%(LEFT$(P$,2))
1440   NEXT I 
1450   CLOSE 
1460   ! 
1470   OPEN 'DR1:PRINTER.DAT' AS FILE 1
1480   POSIT #1,20
1490   GET #1,P$ COUNT 2
1500   Typ=CVT$%(P$)
1510   GET #1,P$ COUNT 2
1520   Tab1=CVT$%(P$)
1530   CLOSE 
1540   Z=FNSudda
1550   PRINT CUR(1,0) SPACE$(30)
1560   PRINT CUR(1,10) 'FORMATTERING av utskrift.'
1570   PRINT CUR(4,0) 'Utskriften kan f}s i 4 olika former enl. nedan.'
1580   PRINT 
1590   PRINT 'Typ 1 - Kolumnform                                     PF1:'
1600   PRINT 'Typ 2 - Packad form                                    PF2:'
1610   PRINT 'Typ 3 - Egen formattering                              PF3:'
1620   PRINT 'Typ 4 - Huvud p} varje sida och en post p} varje rad   PF4:'
1630   ; 
1640   PRINT '** OBS  max. 132 tecken inkl. marginal p} Typ 4 **'
1650   PRINT '** Vid mer {n 80 tecken, kommer utskriften att ske med f|rminskad text. **'
1660   PRINT 
1670   PRINT 'F|r exempel tryck   PF5:'
1680   PRINT 
1690   PRINT 'Utskriften {r nu inst{lld p} Typ ' Typ ' och marginalen ' Tab1 ' steg in.'
1700   PRINT 'Om detta {r till bel}tenhet, tryck RETURN'
1710   GET P$
1720   IF P$=CHR$(13) THEN RETURN 0
1730   ! 
1740   IF P$=CHR$(192) THEN V{lj=1 : GOTO 1800
1750   IF P$=CHR$(193) THEN V{lj=2 : GOTO 1800
1760   IF P$=CHR$(194) THEN V{lj=3 : GOTO 1800
1770   IF P$=CHR$(195) THEN V{lj=4 : GOTO 1800
1780   IF P$=CHR$(196) THEN PRINT FNText$ : Z=FNSudda : GOTO 1560
1790   Z=FNSudda : GOTO 1570
1800   ! 
1810   IF V{lj=3 THEN 1880
1820   ; 
1830   INPUT 'Vilken v{nstermarginal 'P$
1840   ON ERROR GOTO 1860
1850   Tab1=VAL(P$) : GOTO 1880
1860   PRINT CUR(6,40) 'Svara med ett tal!' : RESUME 1830
1870   ! 
1880   IF V{lj>1 THEN 1980
1890   PRINT CUR(17,0) SPACE$(80);
1900   PRINT CUR(17,0) 'Kolumnform med Tab ' Tab1 ' {r vald.' : GOSUB 2660 ! tid
1910   OPEN 'DR1:PRINTER.DAT' AS FILE 1
1920   POSIT #1,20
1930   PUT #1 CVT%$(1)
1940   PUT #1 CVT%$(Tab1)
1950   CLOSE 
1960   RETURN 0
1970   ! 
1980   IF V{lj>2 THEN 2240
1990   PRINT CUR(17,0) SPACE$(80);
2000   PRINT CUR(17,0) 'Packad form med Tab ' Tab1 ' {r vald.' : GOSUB 2660 ! tid
2010   OPEN 'DR1:PRINTER.DAT' AS FILE 1
2020   POSIT #1,20
2030   PUT #1 CVT%$(2)
2040   PUT #1 CVT%$(Tab1)
2050   ! r{kna ut hur m}nga f{lt som ska skrivas p} varje rad.
2060   Rad=1 : Rader=1
2070   WHILE Rad<Antalf{lt
2080     IF L{ngd(Rad)+L{ngd(Rad+1)>80-(27+Tab1) THEN Rad(Rader)=1 : Rad=Rad+1 : GOTO 2140
2090     Rad(Rader)=2 : Rad=Rad+2
2100     IF Rad+2>Antalf{lt THEN 2140
2110     IF L{ngd(Rad)+L{ngd(Rad+1)+L{ngd(Rad+2)>80-(42+Tab1) THEN 2140
2120     Rad=Rad-2
2130     Rad(Rader)=3 : Rad=Rad+3
2140     Rader=Rader+1
2150   WEND 
2160   IF Rad=Antalf{lt THEN Rad(Rader)=1 ELSE Rader=Rader-1
2170   PUT #1 CVT%$(Rader)
2180   FOR I=1 TO Rader
2190     PUT #1 CVT%$(Rad(I))
2200   NEXT I 
2210   CLOSE 
2220   RETURN 0
2230   ! 
2240   ! egen formattering
2250   IF V{lj>3 THEN 2550
2260   PRINT CHR$(12)
2270   PRINT FNRam$
2280   ON ERROR GOTO 2300
2290   PRINT CUR(5,0) 'P} hur m}nga rader ska varje post skrivas '; : INPUT Rader : GOTO 2310
2300   RESUME 2280
2310   FOR I=1 TO Rader
2320     ON ERROR GOTO 2350
2330     PRINT 'Hur m}nga f{lt p} rad ' I;
2340     INPUT Rad(I) : GOTO 2360
2350     RESUME 2320
2360     FOR J=1 TO Rad(I)
2370       ON ERROR GOTO 2400
2380       PRINT 'Vilken TAB p} f{lt ' J ' p} rad ' I;
2390       INPUT Tab2(I,J) : GOTO 2410
2400       RESUME 2370
2410     NEXT J 
2420   NEXT I 
2430   OPEN 'DR1:PRINTER.DAT' AS FILE 1
2440   POSIT #1,20
2450   PUT #1 CVT%$(3)
2460   PUT #1 CVT%$(Rader)
2470   FOR I=1 TO Rader
2480     PUT #1 CVT%$(Rad(I))
2490     FOR J=1 TO Rad(I)
2500       PUT #1 CVT%$(Tab2(I,J))
2510     NEXT J 
2520   NEXT I 
2530   CLOSE 
2540   RETURN 0
2550   ! 
2560   ! Typ 4
2570   ! 
2580   OPEN 'DR1:PRINTER.DAT' AS FILE 1
2590   POSIT #1,20
2600   PUT #1,CVT%$(4)
2610   PUT #1,CVT%$(Tab1)
2620   CLOSE 
2630   RETURN 0
2640   ! 
2650   ! 
2660   FOR I.=1 TO 2000
2670   NEXT I. 
2680   RETURN 
2690   ! 
2700   PRINT 'S{tt i en DATA skiva i Drive 1, och tryck Return. '; : GET P$
2710   RESUME 2720
2720   Z=FNSudda : GOTO 1350
2730 FNEND 
2740 ! 
2750 ! ********************* huvudprogram *****************************
2760 PRINT CHR$(12)
2770 PRINT FNRam$
2780 PRINT FNMeny$
2790 V{lj=FNPftangent
2800 ON V{lj GOTO 2810,2820,2830,2840,3000,2860
2810 PRINT CUR(6,45) CHR$(127) : CHAIN 'REGISTER'
2820 PRINT CUR(10,45) CHR$(127) : CHAIN 'CREINDEX'
2830 PRINT CUR(12,45) CHR$(127) : CHAIN 'F[LTKOMP'
2840 PRINT CUR(14,45) CHR$(127) : CHAIN 'INDKOMP'
2850 ! 
2860 PRINT CHR$(12)
2870 DIM Text$=160 : Text$='Tack f|r idag. '+CHR$(10,13)+'Ha en trevlig dag.'+CHR$(10,10,13)
2880 Text$=Text$+'Gl|m inte att g|ra en s{kerhetskopia p} DATA skivan, om du har gjort'+CHR$(10,13)
2890 Text$=Text$+'n}gon {ndring eller inmatning i registret.'
2900 ON ERROR GOTO 2980
2910 K=1
2920 WHILE 1
2930   FOR I.=0. TO 60.
2940   NEXT I. 
2950   PRINT MID$(Text$,K,1);
2960   K=K+1
2970 WEND 
2980 PRINT CUR(22,0);
2990 END 
3000 ! --------------- hj{lprutiner ---------------
3010 PRINT CHR$(12)
3020 PRINT FNRam$
3030 PRINT CUR(1,3) '## Hj{lprutiner ##'
3040 PRINT CUR(5,0) 'Du kan v{lja mellan:'
3050 ; : PRINT 'Formattera om utskrift p} printer:                PF1:'
3060 ; : PRINT 'Kolla / {ndra printerkoder:                       PF2:'
3070 ; : PRINT 'R{kna om alla numeriska v{rden i ett f{lt i'
3080 PRINT 'hela registret:                                   PF3:'
3090 ; : PRINT 'R{kna om alla numeriska v{rden i ett f{lt mellan'
3100 PRINT 'vissa gr{nsv{rden i hela registret:               PF4:'
3104 ; : PRINT 'Skriva ut registrets status p} printer:           PF5:'
3110 ; : PRINT ']ter till menyn:                                  PF6:'
3120 V{lj=FNPftangent
3130 IF V{lj>6 THEN 3120
3140 ON V{lj GOSUB 6010,3190,3600,5000,3170,3170
3145 IF V{lj=5 THEN CHAIN 'STATUS'
3150 GOTO 2760 ! }ter meny
3160 ! 
3170 RETURN ! dummy
3180 ! 
3190 ! 
3200 ! ----------------- printerkoder --------------------------------
3210 Z=FNSudda
3220 OPEN 'DR1:PRINTER.DAT' AS FILE 1
3230 GET #1,Printer$ COUNT 16
3240 GET #1,P$ COUNT 2
3250 F|rm=CVT$%(P$)
3260 GET #1,P$ COUNT 2
3270 Norm=CVT$%(P$)
3280 CLOSE 
3290 ! 
3300 PRINT CUR(4,0) '1 - Printerkod:  ' Printer$
3310 PRINT CUR(8,0) '2 - F|rminskade tecken : CHR$(' F|rm ') '
3320 PRINT CUR(12,0) '3 - Normala tecken : CHR$(' Norm ') '
3330 PRINT CUR(20,0) '[r allt OK, tryck Return, annars ange f{lt att {ndra (1-3)';
3340 INPUT P$
3350 IF LEN(P$)>0 THEN 3410
3360 OPEN 'DR1:PRINTER.DAT' AS FILE 1
3370 PUT #1,Printer$
3380 PUT #1,CVT%$(F|rm)
3390 PUT #1,CVT%$(Norm)
3400 CLOSE : RETURN ! allt ok
3410 IF P$<>'1' THEN 3460
3420 INPUT 'Printerkod  >> 'Printer$
3430 IF LEN(Printer$)<16 THEN Printer$=Printer$+SPACE$(16-LEN(Printer$))
3440 IF LEN(Printer$)>16 THEN Printer$=LEFT$(Printer$,16)
3450 PRINT CUR(21,0) SPACE$(80);
3460 ! 
3470 IF P$<>'2' THEN 3530
3480 ON ERROR GOTO 3500
3490 PRINT CUR(21,0) 'Kod f|rminskade tecken >> '; : INPUT F|rm : GOTO 3510
3500 RESUME 3480
3510 PRINT CUR(21,0) SPACE$(80);
3520 ! 
3530 IF P$<>'3' THEN 3300 ! g|r om
3540 ON ERROR GOTO 3560
3550 PRINT CUR(21,0) 'Kod normala tecken >> '; : INPUT Norm : GOTO 3570
3560 RESUME 3540
3570 PRINT CUR(21,0) SPACE$(80);
3580 GOTO 3300 ! klar
3590 ! 
3600 ! ----------------- r{kna om numeriska v{rden -------------------
3610 Z=FNKoll
3620 GET P$
3630 RETURN 
5000 ! -------- r{kna om v{rden mellan vissa gr{nsv{rden -------------
5010 RETURN 
5020 ! 
6000 ! ----------------- formattera om utskrift ----------------------
6010 Z=FNForm
6020 RETURN 
6030 ! 
6040 ! =====================================================================