1 ! +++++++++++++++++++++++++++++++++++
2 ! Program ....   SKRIVLIB.800
3 ! Utg}va  1.2    1982-11-27
4 ! av (c) Bo Kullmar
8 ! Ins{nt av Bo Kullmar, 1789.
9 ! +++++++++++++++++++++++++++++++++++
10 ! Se textfilen LIBINSTR.TXT!
15 ! SKRIVLIB, Skrivning av fil som
20 ! inneh}ller alla LIB modulerna.
21 ! Programmet utnyttjar delar av
22 ! Luxors LIB.BAC program.
60 FLOAT 
80 EXTEND 
1000 H$=CHR$(12%)+CUR(0%,6%)+'** ABC800  SKRIV LIB FIL **'
1005 IF PEEK(-17%)=255% THEN Z%=FNTidinst%
1010 ; H$
1020 ; : ; : ; : ; 
1030 Datum=PEEK(-17%)*10000+PEEK(-16%)*100%+PEEK(-15%)
1033 ; 'Datum i filen blir' Datum : ; 
1035 ; CUR(10%,0%) '[r f|rsta disken klar i drive 0? '
1037 GOSUB 4020
1040 GOSUB 2000 ! \ppning av fil
1050 M%=1%
1060 DIM \$(100%)=12%
1070 DIM Volym$=125%
1075 DIM N$=125%
1085 D%=0%
1090 P%=0% : B%=0% : F%=0% : E%=0% : D1%=0% : D2%=0%
1100 ; CUR(10%,0%) 'Jag arbetar hav t}lamod!'
1110 \%=1%
1120 E%=1%
1160 POKE -767%,D%
1170 Z%=CALL(24678%,224%)
1180 IF PEEK(-747%) AND 128% THEN 1630
1190 IF PEEK(-747%) THEN 1680
1200 S%=0%
1210 FOR I%=-2816% TO I%+160%
1220   IF PEEK(I%)=0% THEN S%=S%+8%
1230 NEXT I% 
1240 Z%=CALL(24678%,192%)
1250 IF PEEK(-747%) THEN 1680
1260 FOR I%=0% TO 7%
1270   A%(I%)=PEEK(-2577%+I%)
1280 NEXT I% 
1290 S1%=0%
1300 FOR I%=-2816% TO I%+160%
1310   IF PEEK(I%)=255% THEN 1350
1320   FOR J%=0% TO 7%
1330     S1%=S1%-((PEEK(I%) AND (2%^J%))=0%)
1340   NEXT J% 
1350 NEXT I% 
1360 Z%=CALL(24678%,0%)
1370 IF PEEK(-747%) THEN 1680
1380 N$=''
1390 FOR I%=-2681% TO -2561%
1400   IF PEEK(I%)=13% AND PEEK(I%+1%)=10% THEN 1450
1410   IF PEEK(I%)<32% OR PEEK(I%)>127% THEN N$='' : GOTO 1450
1420   N$=N$+CHR$(PEEK(I%))
1430 NEXT I% 
1440 N$=''
1450 ! 
1460 ! IF LEN(N$)>1 THEN Volym$=N$
1465 Volym$=N$
1470 FOR I%=0% TO 7%
1480   IF A%(I%)<2% THEN 1610
1490   Z%=CALL(24678%,512%+I%*32%)
1500   IF PEEK(-747%) THEN 1680
1510   FOR J%=-2800% TO -2576% STEP 16%
1520     IF PEEK(J%)=0% OR PEEK(J%)=255% THEN 1600
1530     R%=PEEK(J%)*256%+PEEK(J%+1%)
1540     F$=''
1550     FOR K%=4% TO 14%
1560       IF K%=12% THEN F$=F$+'.'
1570       F$=F$+CHR$(PEEK(J%+K%))
1580     NEXT K% 
1590     \$(\%)=F$ : \%=\%+1%
1600   NEXT J% 
1610 NEXT I% 
1630 GOSUB 11000 ! Sortering
1640 GOSUB 5000 ! Skrivning p} fil
1650 GOSUB 3000 ! Nollst{llning av \$
1660 GOSUB 4000 ! Byt disk
1670 GOTO 1090
1680 IF PEEK(-747%)=16% PRINT : ; 'Skivan verkar d}ligt formaterad' ELSE PRINT : ; 'Diskfel'
1690 ; 'Vi hoppar |ver denna skriva!'
1700 ; 
1710 ; 'Tryck p} en tangent! ';
1720 GET \$
1730 ; H$
1740 GOTO 1090
2000 ! \ppning av fil
2010 PREPARE 'DR1:LIBREG.DAT' AS FILE 1%
2020 PUT #1%,CVTF$(Datum)
2030 Filpekare%=7%
2040 POSIT #1%,5%
2050 PUT #1%,CVT%$(Filpekare%)
2060 RETURN 
3000 ! Nollst{llning av \$ variblerna
3010 FOR I%=0% TO \%-1%
3020   \$(I%)=''
3030 NEXT I% 
3040 RETURN 
4000 ! Byte av disk
4005 IF Flagga%=9% THEN 6030
4010 ; CUR(10%,0%) 'Byt disk i drive 0 eller slut? '
4020 ; 'OK? (J/N/S) ? ';
4030 GET \$
4035 ; CUR(10%,0%) SPACE$(60%)
4040 IF \$='J' OR \$='j' THEN RETURN 
4050 IF \$='S' OR \$='s' THEN 6000
4060 GOTO 4010
5000 ! Skrivning p} fil
5010 POSIT #1%,5%
5020 GET #1%,Filpekare$ COUNT 2%
5030 Filpekare%=CVT$%(Filpekare$)
5040 POSIT #1%,Filpekare%
5050 PUT #1%,CVT%$(\%-1%)
5060 Blanka%=120%-LEN(Volym$)
5070 Volym$=Volym$+SPACE$(Blanka%)
5080 PUT #1%,Volym$
5090 FOR I%=0% TO \%-1%
5100   PUT #1%,\$(I%)
5110 NEXT I% 
5120 Filpekare%=POSIT(1%)
5130 POSIT #1%,5%
5140 PUT #1%,CVT%$(Filpekare%)
5150 RETURN 
6000 ! Slutsektion
6010 D%=1%
6016 Flagga%=9%
6020 GOTO 1090
6030 POSIT #1%,Filpekare%
6040 PUT #1%,'&&&&&'
6050 CLOSE 1%
6055 ; CUR(10%,0%) SPACE$(30%)
6060 ; 'Slut!'
6070 END 
11000 ! Quicsort
11010 ! Variabler
11020 ! \$(I)..........Listans element
11030 ! \-1............Antal element
11040 ! I,J............L|pande index
11050 ! C$.............J{mf|relseindex
11060 ! F..............Flagga
11070 ! R,L............Indexregister
11080 I%=0% : J%=0% : C%=0% : F%=0% : R%=0% : L%=0%
11090 F%=1% : L%(1%)=1% : R%(1%)=\%-1%
11100 WHILE F%>0%
11110   L%=L%(F%) : R%=R%(F%) : F%=F%-1%
11120   WHILE L%<R%
11130     I%=L% : J%=R%
11140     ! J{mf|relseelement
11150     C$=\$(L%)
11160     ! J{mf|r
11170     WHILE I%<=J%
11180       WHILE \$(I%)<C$
11190         I%=I%+1%
11200       WEND 
11210       WHILE \$(J%)>C$
11220         J%=J%-1%
11230       WEND 
11240       IF I%<=J% THEN 11260 ELSE 11300
11250       ! Byt
11260       Y$=\$(I%) : \$(I%)=\$(J%) : \$(J%)=Y$
11270       I%=I%+1% : J%=J%-1%
11280     WEND 
11290     ! Index
11300     IF J%-L%<R%-1% AND I%<R% THEN 11310 ELSE 11320
11310     F%=F%+1% : L%(F%)=I% : R%(F%)=R%
11320     R%=J%
11330   WEND 
11340 WEND 
11350 RETURN 
12000 DEF FNTidinst% LOCAL ]r%,M}nad%,Dag%,Tim%,Min%,Sek%,Rad%,Svar$=1
12010   ; CHR$(12%) H$
12015   ; : ; : ; : ; 
12020   ; 'Inst{llning av datum och tid:'
12030   ; 
12040   INPUT ']r? ']r%
12050   INPUT 'M}nad? 'M}nad%
12060   INPUT 'Dag? 'Dag%
12070   INPUT 'Tid (xx,xx,xx,) ? 'Tim%,Min%,Sek%
12080   POKE -17%,]r%,M}nad%,Dag%,Tim%,Min%,Sek%
12090   Rad%=PEEK(-173%)+1%
12100   ; CUR(Rad%,0%) TIME$
12110   ; : ; '[r datum och tid riktig (J) ?'
12120   WHILE SYS(5%)=0%
12130     IF (PEEK(-11%) AND 16%)=0% THEN ; CUR(Rad%+2%,30%) GWHT ''; ELSE ; CUR(Rad%+2%,30%) GWHT ' ';
12140     ; CUR(Rad%,0%) TIME$
12150   WEND 
12160   GET Svar$ : ; CUR(Rad%+2%,30%) WHT Svar$
12170   IF Svar$='N' OR Svar$='n' THEN Z%=FNTidinst% ELSE ; CHR$(12%); : RETURN 0%
12180 FNEND