10 REM ********************************
11 REM * KALNDRTM.BAS                 *
12 REM * VER 1.0 / 1980-0929          *
13 REM * (C) ------------------------ *
14 REM * Av.      Tommy Melander      *
15 REM *          Kommendantsbacken 5 *
16 REM *          62157 Visby         *
17 REM *          tel 0498/18381      *
18 REM ********************************
20 REM 
30 REM ******* FL\DES SCHEMA *******
40 GOTO 240 : REM VARIABEL INFO
50 GOTO 360 : REM DIM OCH TILLDELNING
60 GOTO 440 : REM INFORMATION
70 GOTO 530 : REM EV. AVSLUTNING
80 GOTO 560 : REM INPUT
90 GOTO 590 : REM INHOPP och kontroll
100 GOTO 610 : REM SKOTT]R
110 GOTO 670 : REM P]SK DAGEN
120 GOTO 800 : REM P]SKD BEROENDEHELGD
130 GOTO 1030 : REM MIDSOMMAR DAGEN
140 GOTO 1060 : REM ALLA HELGONS DAG
150 GOTO 1100 : REM SAMMANST[LLNING
160 GOTO 1150 : REM UTSKRIFT KALENDER
170 GOTO 1270 : REM VAL AV TJ[NST
180 GOTO 1410 : REM UTSKRIFT ]RETSHELGD
190 GOTO 1480 : REM SUB VECKODAGS KOD
200 GOTO 1520 : REM SUB VECKO NUMRERING
210 GOTO 1650 : REM SUB VECKODAG FAKTOR
220 GOTO 1700 : REM FELBEHANDLING
230 GOTO 1720 : REM INPUT UTANF\R RAM
240 REM VARIABEL INFO
250 REM H   VARIANTER HELG
260 REM KLM    -"-    P]SKFORMEL
270 REM NOPQ   -"-    -"-
280 REM N      -"-    VECKO NR
290 REM P,Q    -"-    SLASK
300 REM S      -"-    VECKO DAG M-S 1-7
310 REM ]      -"-    ]R
320 REM [      -"-    M]NAD
330 REM \      -"-    DATUM
340 REM U% ART AV UTSKRIFT
350 REM V% V[GVISARE
360 REM DIM OCH TILLDELNING
370 DIM H%(14%),[%(12%),]1$=11%,H$(14%)=18%,[$(12%)=9%
380 FOR Q%=1% TO 12% : READ [$(Q%),[%(Q%) : NEXT Q%
390 DATA JANUARI,31,FEBRUARI,28,MARS,31,APRIL,30,MAJ,31,JUNI,30
400 DATA JULI,31,AUGUSTI,31,SEPTEMBER,30,OKTOBER,31,NOVEMBER,30,DECEMBER,31
410 FOR Q%=0% TO 14% : READ H$(Q%) : NEXT Q%
420 DATA NY]RSDAGEN,TRETTONDAGEN,MARIABEB]DELSEDAG,L]NGFREDAGEN,P]SKDAGEN,ANNANDAGP]SK,TREDJEDAGP]SK,'F\RSTA MAJ'
430 DATA 'KR.HIMMELSF[RDSDAG',PINGSTDAGEN,ANNANDAGPINGST,MIDSOMMARDAGEN,'ALLA HELGONS DAG',JULDAGEN,ANNANDAGJUL
440 REM INFORMATION
450 ; CHR$(12%)CUR(0%,11%)'K A L E N D E R' : ; : ; ' GREGORIANSKA KALENDERN "NYA STILEN"' : ; 
460 ; 'Efter initiativ av  P}ven, 24 Feb 1582. Utgavs 1603.  G{ller fr}n  15 Okt 1582.'
470 ; 'Inf|rdes i Sverige 1753  genom att man  p} den  17 Feb.  l{t f|lja den  1 Mars.'
480 ; 'F|re 1753 f|ljde Sverige den Julianska  kalendern,  men ibland egen tidr{kning. P}skr{kning enl.  ';
490 ; 'Gregorius  inf. 1844. 1953  genomf|rdes  Helgdags  {ndringar. Fr}n 1973 veckonummer enl ISO standard.'
500 ; CUR(15%,2%)'*********** KOMMANDON: ************'
510 ; : ; '  NY... M]N/]R RETURN'TAB(24%)'KALENDER... ^' : ; '  N[STA M]N/]R   +';
520 ; TAB(24%)']RETSHELGD. @' : ; '  F\RRA M]N/]R   -'TAB(24%)'PRINTER.... *'
530 REM EVENTUELL AVSLUTNING
540 ; CUR(21%,0%)'VILL DU AVSLUTA? (J) '; : GET Q$ : ; CUR(21%,0%)STRING$(39%,32%) : IF Q$<>'J' THEN 560
550 ; CUR(21%,0%)'SLUT !' : END 
560 REM INPUT UPPGIFT Ink kontroll.
570 ONERRORGOTO 1700 : ; CUR(21%,0%)'VILKET ]R(ex 1980)'; : INPUT Q$ : ]%=VAL(Q$)
580 ; CUR(21%,25%)'M]NAD(ex 9)'; : INPUT Q$ : [%=VAL(Q$) : IF [%<1% OR [%>12% THEN 1710
590 REM INHOPP och kontroll
600 ]1%=]%/100% : ]2%=]%-]1%*100% : IF ]%<1582% OR ]%>2599% THEN 1720
610 REM SKOTT]R
620 IF ]%/4=]%/4% THEN 640
630 ]1$=' EJ SKOTT]R' : [%(2%)=28% : GOTO 670
640 IF ]2%<>0% THEN 660
650 IF ]1%/4<>]1%/4% THEN 630
660 ]1$=' SKOTT]R' : [%(2%)=29%
670 REM P]SKDAGEN
680 RESTORE 690 : FOR Q%=15% TO ]1% : READ P,Q : NEXT Q%
690 DATA 22,2,22,2,23,3,23,4,24,5,24,5,24,6,25,0,26,1,25,1,26,2
700 J=]%-INT(]%/19)*19 : K=]%-INT(]%/4)*4 : L=]%-INT(]%/7)*7
710 M=(19*J+P)-INT((19*J+P)/30)*30
720 N=(2*K+4*L+6*M+Q)-INT((2*K+4*L+6*M+Q)/7)*7
730 O=22+M+N : IF O<=31 THEN O=O+300 : GOTO 800
740 O=M+N-9+400 : IF O=426 THEN 790
750 IF O<>425 THEN 800
760 IF M<>28 THEN 800
770 IF N<>6 THEN 800
780 IF J<10 THEN 800
790 O=O-7
800 REM HELGDAGAR beroende av P]SKD.
810 REM Q(0-6) enl.
820 REM 0=ANNAND.P       1=TREDJED.P
830 REM 2=KRISI HFD      3=PINGSTD.
840 REM 4=ANNAND.PINGST  5=L]NGFD.
850 REM 6=MARIABD.
860 Q%=0% : Q1%=0% : O1=INT(O/100) : O2=O-O1*100%
870 Q%=Q%+1% : O2=O2+1%
880 IF O1=3 AND O2>31 OR O1=4 AND O2>30 OR O1=5 AND O2>31 OR O1=6 AND O2>30 THEN 920
890 IF Q%=1% OR Q%=2% OR Q%=39% OR Q%=49% OR Q%=50% THEN 900 ELSE 910
900 Q(Q1%)=O1*100+O2 : Q1%=Q1%+1%
910 IF Q%>50% THEN 930 ELSE 870
920 O1=O1+1 : O2=0 : Q%=Q%-1% : GOTO 870
930 IF O>402 OR O<=331 THEN 970
940 IF O=401 THEN 960
950 Q(5)=331 : GOTO 980
960 Q(5)=330 : GOTO 980
970 Q(5)=O-2
980 IF O>=323 AND O<=327 THEN 1020
990 IF O>=328 AND O<=331 THEN 1010
1000 Q(6)=325 : Q(1)=0 : GOTO 1030
1010 Q(6)=O-8 : Q(1)=0 : GOTO 1030
1020 Q(6)=Q(1)
1030 REM MIDSOMMARD 24/6 <1953> 20-26/6
1040 IF ]%<1953% THEN H%(11%)=624% : GOTO 1060
1050 Q2%=]% : Q1%=6% : FOR Q%=20% TO 26% : GOSUB 1480 : IF S%=6% THEN H%(11%)=600%+Q% ELSE NEXT Q%
1060 REM ALLA HELGONSD-<1953>31/10-6/11
1070 IF ]%<1953% THEN H%(12%)=0% : GOTO 1100
1080 Q2%=]% : Q1%=10% : Q%=31% : GOSUB 1480 : IF S%=6% THEN H%(12%)=1031% : GOTO 1100
1090 Q2%=]% : Q1%=11% : FOR Q%=1% TO 6% : GOSUB 1480 : IF S%=6% THEN H%(12%)=1100%+Q% ELSE NEXT Q%
1100 REM HELGDAGS DATUM SAMMANST[LLNING
1110 H%(0%)=101% : H%(1%)=106% : H%(3%)=Q(5%) : H%(4)=O : H%(5%)=Q(0%)
1120 H%(8%)=Q(2%) : H%(9%)=Q(3%) : H%(10%)=Q(4%) : H%(13%)=1225% : H%(14%)=1226%
1130 IF ]%<1939% THEN H%(7%)=0% ELSE H%(7%)=501%
1140 IF ]%<1953% THEN H%(2%)=Q(6%) : H%(6%)=Q(1%) ELSE H%(2%)=0% : H%(6%)=0%
1150 REM UTSKRIFT KALENDER
1160 IF V%=1% THEN 1410
1170 IF U%=0% THEN ; CHR$(12%);TAB(11%)'K A L E N D E R' : ; 
1180 ; #U%,TAB(16%-LEN([$([%))/2%-LEN(]1$)/2%)[$([%)]%]1$
1190 ; #U%,CHR$(13%,10%)'     M]N-TIS-ONS-TOR-FRE-L\R-S\N-'CHR$(13%,10%)
1200 Q2%=]% : Q1%=[% : Q%=1% : GOSUB 1480 : P%=S%*4%
1210 FOR \%=1% TO [%([%) : IF P%>29% THEN P%=4% : GOSUB 1520
1220 IF \%<10% THEN P1%=1% ELSE P1%=0%
1230 Q$='' : FOR Q%=0% TO 14% : IF [%*100%+\%=H%(Q%) THEN Q$='*' ELSE NEXT Q%
1240 ; #U%,TAB(P%+P1%)\%Q$; : P%=P%+4% : NEXT \% : GOSUB 1520
1250 FOR Q%=0% TO 14% : IF [%=H%(Q%)/100% THEN ; #U%,TAB(7%-LEN(NUM$(H%(Q%)-100%*[%)))H%(Q%)-[%*100%' 'H$(Q%)
1260 NEXT Q%
1270 REM VAL AV TJ[NST
1280 CLOSE 1 : U%=0% : ; CUR(23%,6%)'"RETURN",+,-,^,@ eller * ?'; : GET Q$
1290 ; CUR(23%,6%)'   *** A R B E T A R ***  '; : Q%=ASC(Q$)
1300 IF Q%=64% THEN V%=1% : GOTO 1410
1310 IF Q%=94% THEN V%=0% : GOTO 1150
1320 IF Q%=43% AND V%=0% THEN [%=[%+1% : GOTO 1390
1330 IF Q%=43% AND V%=1% THEN ]%=]%+1% : GOTO 590
1340 IF Q%=45% AND V%=0% THEN [%=[%-1% : GOTO 1390
1350 IF Q%=45% AND V%=1% THEN ]%=]%-1% : GOTO 590
1360 IF Q%<>42% THEN IF Q%=13% THEN 440 ELSE 1700
1370 OPEN 'PR:' ASFILE 1 : U%=1% : ; #U%,STRING$(2%,10%)
1380 IF V%=0% THEN 1150 ELSE 1410
1390 IF [%<1% THEN [%=12% : ]%=]%-1% : GOTO 590
1400 IF [%>12% THEN [%=1% : ]%=]%+1 : GOTO 590 ELSE 1150
1410 REM UTSKRIFT ]RETS HELGDAGAR
1420 IF U%=0% THEN ; CHR$(12%)
1430 ; #U%,TAB(12%)'HELG DAGAR']% : ; #U%,'' : ; #U%,TAB(19%-LEN(]1$)/2%)]1$ : ; #U%,''
1440 FOR Q%=0% TO 14%
1450 IF H%(Q%)<>0% THEN Q$=NUM$(H%(Q%)-100%*INT(H%(Q%)/100%)) : ; #U%,TAB(5%)H$(Q%)TAB(26%-LEN(Q$))Q$' '; ELSE 1470
1460 ; #U%,[$(INT(H%(Q%)-VAL(Q$))/100%)
1470 NEXT Q% : GOTO 1270
1480 REM VECKODAG F\R BEST[MT DATUM
1490 GOSUB 1650 : S%=Q+(-1*INT(Q/7)*7) : S%=S%-1%
1500 IF S%>0 THEN 1510 ELSE S%=S%+7%
1510 RETURN 
1520 REM VECKO NUMRERING OCH UTSKRIFT
1530 IF ]%<1973% THEN N$='' : GOTO 1640
1540 Q2%=]% : Q1%=1% : Q%=1% : GOSUB 1650 : Q1=Q : GOSUB 1480 : S1%=S%
1550 Q1%=[% : Q%=\%-1% : GOSUB 1650 : Q2=Q
1560 Q3=Q2-Q1 : IF S1%<5% THEN Q3=Q3+6+S1% ELSE Q3=Q3-8+S1%+7
1570 N%=INT(Q3/7) : IF N%>0 THEN 1600
1580 Q2%=]%-1% : Q1%=1% : Q%=1% : GOSUB 1650 : Q1=Q : GOSUB 1480 : S1%=S%
1590 Q1%=12% : Q%=31% : GOSUB 1650 : Q2=Q : GOTO 1560
1600 IF N%<52% THEN 1630
1610 IF \%-1%<>31% THEN 1630
1620 GOSUB 1480 : IF S%<4% THEN N%=1%
1630 N$=NUM$(N%)
1640 ; #U%,TAB(36%-LEN(N$))N$CHR$(13%,10%) : RETURN 
1650 REM VECKODAGS FAKTOR RUTIN
1660 IF Q1%>2% THEN 1680
1670 Q=365*Q2%+Q%+31*(Q1%-1)+INT((Q2%-1)/4)-INT(3/4*INT(((Q2%-1)/100)+1)) : GOTO 1690
1680 Q=365*Q2%+Q%+31*(Q1%-1)-INT(.4*Q1%+2.3)+INT(Q2%/4)-INT((3/4)*(INT(Q2%/100)+1))
1690 RETURN 
1700 REM FEL BEHANDLING
1710 ; CHR$(7%)CUR(23%,6%)'F\LJ INSTRUKTIONERNA TACK. '; : GET Q$ : GOTO 440
1720 REM INPUT UTANF\R RAM
1730 ; CHR$(7%)CUR(23%,3%)'M]STE VARA FR]N 1582 TILL 2599. '; : GET Q$ : GOTO 440