1 REM Ins{nd av Leif Hoffman-Laurse <4888>    1985-10-27 22.21.52
100 REM 
110 REM  SAVE KALENPR.80T, V 2.1  
120 REM                           
130 REM  Kalender f|r }ren        
140 REM  1583 - 2499.             
150 REM  Efter id` av Lars-Owe    
160 REM  Gradin (463), och kraf-  
170 REM  tigt omarbetad av        
180 REM                           
190 REM  (C) Leif Hoffmann <4888> 
200 REM          85 10 14         
210 REM                           
220 REM  F|r 16K minne o. printer 
230 REM      (80 tecken/rad)      
240 REM 
250 REM 
260 REM  Programmet ger ett }rs ka-
270 REM  lender p} eet A4-ark.
280 REM 
290 REM   Evt. f}r man {ndra p}
300 REM  printerkoden i rad 680, f|r
310 REM  anpassning till egen prin-
320 REM  tertyp.
330 REM   Har man 80 t. sk{rm kan
340 REM  programmet l{tt konver-
350 REM  teras till sk{rmutskrift.
360 REM 
370 REM   Programmet ger korrekt
380 REM  veckonumrering i hela in-
390 REM  tervallet 1583 - 2499, {-
400 REM  ven om denna SIS - standard
410 REM  f|rst inf|rdes 1973 !
420 REM 
430 REM 
440 DIM V(6%,2%)
450 ; INP(3%) : ; CHR$(12%)
460 RESTORE 
470 ; TAB(15%)"KALENDER"
480 ; CUR(9%,3%)'Resultat visas p} printer'
490 ; CUR(5%,3%)'F|r vilket }r mellan 1583 o. 2499' : ; '   |nskas kalender (t.ex. 1985)';
500 ONERRORGOTO 450
510 INPUT X$ : X%=VAL(X$)
520 IF X%<1583% OR X%>2499% GOTO 450
530 ; CUR(9%,3%)STRING$(25%,32%)
540 ; CUR(12%,4%)'Nu behandlas }r'
550 C%=5%
560 FOR I%=1583% TO X%
570 ; CUR(12%,20%)I%
580 IF I%=X% THEN 640
590 I=I% : IF I/4<>INT(I/4) THEN 630
600 IF I/100=INT(I/100) AND I/400<>INT(I/400) THEN 630
610 C%=C%+2%
620 GOTO 640
630 C%=C%+1%
640 IF C%<7% THEN 660
650 C%=C%-7%
660 NEXT I%
670 C1%=C% : F%=0% : V1%=0%
680 OPEN 'PR:CSA36D72' ASFILE 1
690 FOR M%=1% TO 12% STEP 2%
700 READ M$
710 ; #1TAB(3%)M$;""X%; : READ N$ : ; #1TAB(43%)N$;""X%
720 ; #1"**************************************";TAB(42%)"**************************************"
730 ; #1"    M]N  TIS  ONS  TOR  FRE  L\R  S\N";TAB(46%)' M]N TIS  ONS  TOR  FRE  L\R  S\N'
740 ; #1"**************************************";TAB(42%)"**************************************"
750 READ D%
760 E%=1%
770 FOR R%=1% TO 6%
780 IF C%>6% THEN C%=0%
790 IF F%=0% AND C1%>3% THEN V1%=-1% : F%=1%
800 FOR K%=C% TO 7%
810 D1(R%,K%)=E% : E%=E%+1%
820 IF E%>D% THEN E%=1% : V(R%,1%)=V1%+1% : GOTO 870
830 C%=C%+1% : IF C%>6% THEN C%=0% : GOTO 850
840 NEXT K%
850 V1%=V1%+1% : V(R%,1%)=V1%
860 NEXT R%
870 IF C%=6% THEN V1%=V1%+1%
880 C%=C%+1%
890 READ D% : X=X% : IF X/4<>INT(X/4) THEN 920
900 IF N$<>'FEBRUARI' THEN 920
910 D%=D%+1%
920 FOR R%=1% TO 6%
930 IF C%>6% THEN C%=0%
940 FOR K%=C% TO 6%
950 D2(R%,K%)=E% : E%=E%+1%
960 IF E%>D% THEN E%=1% : V(R%,2%)=V1%+1% : GOTO 1010
970 C%=C%+1% : IF C%>6% THEN C%=0% : GOTO 990
980 NEXT K%
990 V1%=V1%+1% : V(R%,2%)=V1%
1000 NEXT R%
1010 IF C%=6% THEN V1%=V1%+1%
1020 C%=C%+1%
1030 FOR R%=1% TO 6%
1040 V$=NUM$(V(R%,1%))+')'
1050 IF V(R%,1%)=0% THEN V$=''
1060 FOR K%=0% TO 6%
1070 D1$=NUM$(D1(R%,K%)) : IF D1$=NUM$(0%) THEN D1$=' '
1080 IF K%=0% ; #1V$;
1090 ; #1TAB(5%*K%+4%)D1$;
1100 NEXT K%
1110 FOR K%=0% TO 6%
1120 D2$=NUM$(D2(R%,K%)) : IF D2$=NUM$(0%) THEN D2$=' '
1130 V$=NUM$(V(R%,2%))+')' : IF V(R%,2%)=0% THEN V$=''
1140 IF K%=0% ; #1TAB(41%)V$;
1150 ; #1TAB(5%*K%+46%)D2$;
1160 NEXT K%
1170 ; #1
1180 NEXT R%
1190 ; #1
1200 FOR R%=1% TO 6% : FOR K%=0% TO 7%
1210 D1(R%,K%)=0% : D2(R%,K%)=0%
1220 V(R%,1%)=0% : V(R%,2%)=0%
1230 NEXT K% : NEXT R%
1240 NEXT M%
1250 CLOSE 1 : GOTO 450
1260 DATA "JANUARI","FEBRUARI",31,28,"MARS","APRIL",31,30,"MAJ","JUNI",31,30,"JULI","AUGUSTI",31,31,"SEPTEMBER"
1270 DATA "OKTOBER",30,31,"NOVEMBER","DECEMBER",30,31