DataMuseum.dk

top - download

    Length: 12640 (0x3160)
    Types: TextFile
    Notes: Mikados_K
    Names: »OPMODUL.K«

└─⟦e5337a0bc⟧ Bits:30008987 DDE SPC/1 COMAL programmer: BUD, GR85, LØN
    └─⟦this⟧ »OPMODUL.K« 

Mikados K File

0010 DIM RES$(15),OP1$(12),OP2$(12),TAH$(12)
0015 TAH$="0+"
0020 PROC CALC(AR3,B1,B2,ES)
0025 RES$=ES$;OP1$=B1$;OP2$=B2$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
0030 CALL "DDE:REGN"
0035 IF AR3<6 THEN 
0040 IF FLAG THEN STOP 
0045 ENDIF 
0050 ES$=RES$
0055 ENDPROC 
0060 DIM ST$(12),GT$(12),HJ$(12),P1$(12)
0065 ST$=TAH$;GT$=TAH$
0100 TRUE=1
0120 FALSE=0
0140 DIM SPLIT$(66),BL$(66),FIL$(20)
0160 DIM B$(133),SYM$(66),S$(1),SIDE$(22,66),LINE$(133),SV$(2),FIL1$(20)
0180 FOR I=1 TO 66
0200 BL$(I)=" "
0220 NEXT I
0240 FIL$="P641216:MODUL"
0260 REPEAT 
0280 INPUT "Oprettelse, ændring eller stop O/Æ/S ",S$
0300 UNTIL S$="O" OR S$="Æ" OR S$="o" OR S$="æ" OR S$="S" OR S$="s"
0320 IF S$="S" OR S$="s" THEN GO TO 8260
0340 IF S$="Æ" OR S$="æ" THEN 
0360 REPEAT 
0380 INPUT "MODULNR ",SV$
0400 EXEC CHECK1
0420 UNTIL OKAY=TRUE
0440 EXEC CONVERT(NR)
0460 FIL1$=FIL$+SV$
0480 OPEN FIL1$,W
0500 IF STATUS(FIL1$)<>0 THEN GO TO 0360
0501 L=1
0502 GET FIL1$:SIDE$(L)
0510 WHILE STATUS(FIL1$)=0 DO 
0520 L=1+L
0540 GET FIL1$:SIDE$(L)
0560 ENDWHILE 
0580 LAST=L-1
0600 CLOSE FIL1$
0620 OPEN FIL1$,W
0630 ST$=TAH$;GT$=TAH$
0640 EXEC SKRIV
0660 ELSE 
0680 I=0
0700 LAST=-1
0720 CLEAR 
0740 REPEAT 
0760 I=I+1
0780 CURSOR 2,I
0790 PRINT USING "###":I;
0800 INPUT "        ",LINE$
0820 IF LEN(LINE$)=0 THEN LAST=I-1
0840 IF LAST=-1 THEN SIDE$(I)=LINE$+BL$
0860 UNTIL I=20 OR LAST<>-1
0880 IF LAST=-1 THEN LAST=20
0900 ENDIF 
0920 IF LAST=0 THEN GO TO 0260
0945 I0=1
0950 REPEAT 
0955 CURSOR 1,23
0960 INPUT "T,TL,S,SL,R,E,C,F,BL,ST,GT ",SV$
0965 EXEC CHECK
0970 IF OKAY=TRUE THEN 
0975 I=I0-1
0980 EXEC FINDPOS
0985 I0=I
0990 IF I0=>LAST THEN I0=1
0995 IF J>0 THEN 
1000 CASE SV$ OF 
1005 WHEN "TL","tl","Tl","tL"
1010 IF LAST<22 THEN 
1015 CURSOR 1,23
1020 PRINT BL$
1025 REPEAT 
1030 CURSOR 1,23
1035 INPUT "           ",LINE$
1040 UNTIL LEN(LINE$)>0 AND LEN(LINE$)<67
1045 I1=I
1050 EXEC INDSÆT
1055 ENDIF 
1060 WHEN "T","t"
1065 J1=J
1070 I1=I
1075 CURSOR 1,23
1080 PRINT BL$
1085 REPEAT 
1090 CURSOR 1,23
1095 INPUT "           ",LINE$
1100 UNTIL LEN(LINE$)>0 AND LEN(LINE$)<67
1105 EXEC INSERT
1110 WHEN "S","s"
1115 EXEC SLUTPOS
1120 EXEC DELETE
1125 WHEN "SL","sl","Sl","sL"
1130 I1=I
1135 EXEC SLET
1140 WHEN "R","r"
1145 EXEC SLUTPOS
1150 CURSOR 1,23
1155 PRINT BL$
1160 REPEAT 
1165 CURSOR 1,23
1170 INPUT "           ",LINE$
1175 UNTIL LEN(LINE$)>0 AND LEN(LINE$)<67
1180 IF I1=I THEN 
1185 IF LEN(LINE$)<=J-J1+1 THEN 
1190 SIDE$(I1,J1:LEN(LINE$))=LINE$
1195 J1=J1+LEN(LINE$)
1200 IF J1<=J THEN EXEC DELETE
1205 ELSE 
1210 SIDE$(I1,J1:J-J1+1)=LINE$(1:J-J1+1)
1215 LINE$=LINE$(J-J1+2,LEN(LINE$))
1220 J1=J+1
1225 EXEC INSERT
1230 ENDIF 
1235 ELSE 
1240 IF LEN(LINE$)<=66-J1 THEN 
1245 SIDE$(I1,J1:LEN(LINE$))=LINE$
1250 J1=J1+LEN(LINE$)
1255 IF J1>66 THEN 
1260 J1=1
1265 I1=I1+1
1270 ENDIF 
1275 EXEC DELETE
1280 ELSE 
1285 P=67
1290 IF J1>1 THEN LINE$=SIDE$(I1,1,J1-1)+LINE$
1295 EXEC FLÆK(LINE$)
1300 SIDE$(I1)=SPLIT$+BL$
1305 I1=I1+1
1310 J1=1
1315 IF I1=I THEN 
1320 IF LEN(LINE$)<=J-J1 THEN 
1325 IF LEN(LINE$)>0 THEN SIDE$(I1,J1:LEN(LINE$))=LINE$
1330 J1=J1+LEN(LINE$)
1335 EXEC DELETE
1340 ELSE 
1345 SIDE$(I1,J1:J-J1+1)=LINE$(1:J-J1+1)
1350 LINE$=LINE$(J-J1+2,LEN(LINE$))
1355 J1=J+1
1360 EXEC INSERT
1365 ENDIF 
1370 ELSE 
1375 SIDE$(I1)=LINE$
1380 J1=LEN(LINE$)+1
1385 EXEC DELETE
1390 ENDIF 
1395 ENDIF 
1400 ENDIF 
1405 WHEN "E","e"
1410 LINE$=SIDE$(I)
1415 CURSOR 1,23
1420 PRINT BL$
1425 REPEAT 
1430 CURSOR 1,23
1435 EDIT "           ",LINE$
1440 UNTIL LEN(LINE$)>0 AND LEN(LINE$)<67
1442 IF SIDE$(I,65,66)="##" OR SIDE$(I,65,66)="@@" THEN 
1443 LINE$=LINE$+BL$;LINE$(65,66)=SIDE$(I,65,66)
1444 ENDIF 
1445 SIDE$(I)=LINE$(1,66)
1450 WHEN "C","c"
1455 V=1
1460 WHILE SIDE$(I,V)=" " AND V<66
1465 V=V+1
1470 ENDWHILE 
1475 H=66
1480 WHILE SIDE$(I,H)=" " AND H>1
1485 H=H-1
1490 ENDWHILE 
1495 IF H=>V THEN 
1500 SS=INT((65-H+V)/2)+1
1505 SYM$=BL$
1510 SYM$(SS:H-V+1)=SIDE$(I,V,H)
1515 SIDE$(I)=SYM$
1520 ENDIF 
1525 WHEN "ST","GT"
1530 IF LAST<22 THEN 
1535 LINE$=BL$
1540 IF SV$="ST" THEN 
1545 LINE$(65,66)="##"
1550 ELSE 
1555 LINE$(65,66)="@@"
1560 ENDIF 
1565 I1=I
1570 EXEC INDSÆT
1575 ENDIF 
1580 WHEN "BL"
1585 IF LAST<22 THEN 
1590 LINE$=BL$
1595 CURSOR 1,23
1600 PRINT BL$
1605 REPEAT 
1610 CURSOR 1,23
1615 INPUT "Faktor 1   ",SPLIT$
1620 SPLIT$=SPLIT$+"+"
1625 EXEC CALC(6,SPLIT$,TAH$,HJ$)
1630 UNTIL FLAG=0
1635 LINE$(2,12)=HJ$(2,12);P1$=HJ$
1640 IF LINE$(12)="+" THEN LINE$(12)=" "
1645 REPEAT 
1650 CURSOR 1,23
1655 INPUT "Faktor 2   ",SPLIT$
1660 SPLIT$=SPLIT$+"+"
1665 EXEC CALC(6,SPLIT$,TAH$,HJ$)
1670 UNTIL FLAG=0
1675 EXEC CALC(4,HJ$,TAH$,HJ$)
1680 IF SI>0 THEN 
1685 EXEC CALC(2,HJ$,P1$,P1$)
1690 LINE$(13,24)="*"+HJ$(2,12)
1695 IF LINE$(24)="+" THEN LINE$(24)=" "
1700 REPEAT 
1705 CURSOR 1,23
1710 INPUT "Faktor 3   ",SPLIT$
1715 SPLIT$=SPLIT$+"+"
1720 EXEC CALC(6,SPLIT$,TAH$,HJ$)
1725 UNTIL FLAG=0
1730 EXEC CALC(4,HJ$,TAH$,HJ$)
1735 IF SI>0 THEN 
1740 LINE$(25,36)="*"+HJ$(2,12)
1745 EXEC CALC(2,HJ$,P1$,P1$)
1750 IF LINE$(36)="+" THEN LINE$(36)=" "
1755 ENDIF 
1760 ENDIF 
1765 REPEAT 
1770 CURSOR 1,23
1775 INPUT "Prisfaktor ",SPLIT$
1780 SPLIT$=SPLIT$+"+"
1785 EXEC CALC(6,SPLIT$,TAH$,HJ$)
1790 UNTIL FLAG=0
1795 LINE$(37,50)="a"+HJ$(2,12)+"Kr"
1800 IF LINE$(48)="+" THEN LINE$(48)=" "
1805 EXEC CALC(2,HJ$,P1$,P1$)
1810 IF P1$(12)="+" THEN P1$(12)=" "
1815 LINE$(51,66)=P1$(2,12)+"Kr %%"
1820 I1=I
1825 EXEC INDSÆT
1830 ENDIF 
1835 ENDCASE 
1840 ST$=TAH$;GT$=TAH$
1845 EXEC SKRIV
1850 ENDIF 
1855 ENDIF 
1860 UNTIL SV$="F" OR SV$="f"
3060 IF LAST>20 THEN 
3080 CURSOR 1,22
3100 PRINT "SIDEN ER FOR ";LAST-20;"LINIER FOR LANG"
3120 GO TO 0960
3140 ENDIF 
3160 IF (S$="O") OR (S$="o") THEN 
3180 REPEAT 
3200 INPUT "MODULNR ",SV$
3220 EXEC CHECK1
3240 UNTIL OKAY=TRUE
3260 EXEC CONVERT(NR)
3280 FIL1$=FIL$+SV$
3300 CREATE FIL1$,6
3320 IF STATUS(FIL1$)<>0 THEN GO TO 3180
3340 OPEN FIL1$,W
3360 ENDIF 
3380 FOR L=1 TO LAST
3400 PUT FIL1$:SIDE$(L)
3420 NEXT L
3450 ENDFILE FIL1$
3500 CLOSE FIL1$
3520 GO TO 0240
3540 PROC FINDPOS
3560 REPEAT 
3580 I=I+1
3600 CURSOR 1,I
3620 INPUT "           ",LINE$
3640 UNTIL I=22 OR LEN(LINE$)>0
3660 J=LEN(LINE$)
3680 IF J>66 THEN J=66
3700 ENDPROC 
3860 PROC INDSÆT
3880 LAST=LAST+1
3900 IF I1>LAST THEN LAST=I1
3920 FOR L=LAST TO I1+1 STEP -1
3940 SIDE$(L)=SIDE$(L-1)
3960 NEXT L
3980 SIDE$(I1)=LINE$+BL$
4000 ENDPROC 
4020 PROC SLET
4040 FOR L=I1 TO LAST-1
4060 SIDE$(L)=SIDE$(L+1)
4080 NEXT L
4100 SIDE$(LAST)=""
4120 LAST=LAST-1
4140 ENDPROC 
4160 PROC SLUTPOS
4180 I1=I
4200 J1=J
4220 CURSOR J+10,I
4240 INPUT " ",LINE$
4260 IF LEN(LINE$)=0 THEN 
4280 EXEC FINDPOS
4300 ELSE 
4320 J=LEN(LINE$)+J1-1
4340 IF J>66 THEN J=66
4360 ENDIF 
4380 ENDPROC 
4400 PROC FLÆK(LIN)
4410 Q=0
4420 SPLIT$=""
4440 FOUND=FALSE
4460 Q=LEN(LIN$)
4480 WHILE Q>0
4500 IF LIN$(Q)=" " THEN 
4520 LIN$(Q)=""
4540 Q=Q-1
4560 ELSE 
4580 Q=0
4600 ENDIF 
4620 ENDWHILE 
4640 IF P>LEN(LIN$) THEN 
4660 FOUND=TRUE
4680 P=LEN(LIN$)+1
4700 ELSE 
4720 IF P<66 THEN P=P+1
4740 IF LIN$(P)<>" " THEN 
4760 CURSOR 1,23
4762 PRINT "            ";LIN$(1,P),BL$
4764 CURSOR 1,23
4766 INPUT "Del         ",SPLIT$
4768 P=LEN(SPLIT$)
4770 IF P>0 THEN 
4772 FOUND=TRUE
4774 IF SPLIT$(P)="-" THEN Q=1
4776 ELSE 
4778 FOUND=FALSE
4780 ENDIF 
4840 ELSE 
4860 FOUND=TRUE
4880 ENDIF 
4900 ENDIF 
4920 IF FOUND THEN 
4940 IF P=1 THEN 
4960 SPLIT$=""
4980 IF P<LEN(LIN$) THEN LIN$=LIN$(P+1,LEN(LIN$))
5000 ELSE 
5010 IF Q=0 THEN P=P+1
5020 SPLIT$=LIN$(1,P-1)
5030 IF Q=1 THEN 
5032 SPLIT$(P)="-"
5034 P=P-1
5036 ENDIF 
5040 IF P<LEN(LIN$) THEN 
5060 LIN$=LIN$(P+1,LEN(LIN$))
5080 ELSE 
5100 LIN$=""
5120 ENDIF 
5140 ENDIF 
5160 ENDIF 
5180 ENDPROC 
5200 PROC INSERT
5220 B$=""
5240 IF J1>1 THEN B$=SIDE$(I1,1,J1-1)
5260 B$=B$+LINE$
5280 IF J1<67 THEN B$=B$+SIDE$(I1,J1,66)
5300 P=67
5320 EXEC FLÆK(B$)
5340 SIDE$(I1)=SPLIT$+BL$
5360 I1=I1+1
5380 J1=1
5400 LINE$=B$
5420 WHILE SIDE$(I1,1)<>" " AND LEN(LINE$)>0 AND LEN(SIDE$(I1))>0
5440 B$=SIDE$(I1)
5460 IF LINE$(LEN(LINE$))="-" THEN 
5480 LINE$(LEN(LINE$))=""
5500 ELSE 
5520 IF LEN(LINE$)<66 THEN LINE$=LINE$+" "
5540 ENDIF 
5560 SIDE$(I1,1,LEN(LINE$))=LINE$
5580 P=67-LEN(LINE$)
5600 EXEC FLÆK(B$)
5620 IF LEN(SPLIT$)>0 THEN SIDE$(I1,LEN(LINE$)+1,66)=SPLIT$+BL$
5640 LINE$=B$
5660 I1=I1+1
5680 ENDWHILE 
5700 IF LEN(LINE$)>0 THEN 
5720 EXEC INDSÆT
5740 ENDIF 
5760 ENDPROC 
5780 PROC DELETE
5800 J=J+1
5820 IF J>66 THEN 
5840 J=1
5860 I=I+1
5880 ENDIF 
5900 P=67-J1
5920 IF I=LAST+1 THEN 
5940 IF J1>1 THEN 
5960 SIDE$(I1,J1,66)=BL$
5980 ELSE 
6000 I1=I1-1
6020 ENDIF 
6040 FOR Q=I1+1 TO LAST
6060 SIDE$(Q)=BL$
6080 NEXT Q
6100 LAST=I1
6120 ELSE 
6140 LINE$=SIDE$(I,J,66)
6160 EXEC FLÆK(LINE$)
6180 REPEAT 
6200 HYPHEN=0
6220 IF LEN(SPLIT$)>0 THEN 
6240 IF SPLIT$(LEN(SPLIT$))="-" THEN 
6260 HYPHEN=LEN(SPLIT$)+J1-1+100*I1
6280 SPLIT$(LEN(SPLIT$))=""
6300 ELSE 
6320 SPLIT$=SPLIT$+" "
6340 ENDIF 
6360 ENDIF 
6380 SIDE$(I1,J1,66)=SPLIT$+BL$
6400 IF J1+LEN(SPLIT$)<66 AND LEN(LINE$)=0 THEN 
6420 J1=J1+LEN(SPLIT$)
6440 P=67-J1
6460 IF I<22 THEN 
6480 IF SIDE$(I+1,1)<>" " THEN 
6500 LINE$=SIDE$(I+1)
6520 I=I+1
6540 EXEC FLÆK(LINE$)
6560 IF LEN(SPLIT$)>0 THEN 
6580 SIDE$(I1,J1,66)=SPLIT$+BL$
6600 IF LEN(LINE$)>0 THEN I=I-1
6620 SPLIT$=LINE$
6640 LINE$=""
6660 HYPHEN=0
6680 ELSE 
6700 SIDE$(I1+1)=LINE$
6720 LINE$=""
6740 I1=I1+1
6760 ENDIF 
6780 ELSE 
6800 LINE$=""
6820 SPLIT$=""
6840 ENDIF 
6860 ELSE 
6880 LINE$=""
6900 SPLIT$=""
6920 ENDIF 
6940 ELSE 
6960 B$=LINE$
6980 LINE$=SIDE$(I+1)
7000 SIDE$(I1+1)=B$
7020 J1=LEN(B$);P=67-J1
7040 EXEC FLÆK(LINE$)
7060 ENDIF 
7080 IF HYPHEN>0 THEN SIDE$(HYPHEN DIV 100,HYPHEN MOD 100)="-"
7100 J1=1
7120 J=1
7140 I1=I1+1
7160 I=I+1
7180 IF I>22 THEN I=22
7200 UNTIL (LEN(SPLIT$)=0 AND LEN(LINE$)=0) OR (J=1 AND SIDE$(I,1)=" ")
7220 J=I1
7240 WHILE J<I
7260 EXEC SLET
7280 J=J+1
7300 ENDWHILE 
7320 ENDIF 
7330 ENDPROC 
7340 PROC CHECK1
7360 NR=0
7380 I=1
7400 IF LEN(SV$)>0 AND LEN(SV$)<3 THEN 
7420 OKAY=TRUE
7440 ELSE 
7460 OKAY=FALSE
7480 ENDIF 
7500 WHILE I<=LEN(SV$)
7520 IF SV$(I)<"0" OR SV$(I)>"9" THEN 
7540 OKAY=FALSE
7560 I=LEN(SV$)+1
7580 ELSE 
7600 NR=NR*10+ORD(SV$(I))-48
7620 I=I+1
7640 ENDIF 
7660 ENDWHILE 
7680 ENDPROC 
7700 PROC CONVERT(NO)
7720 SV$=CHR(NO DIV 10+48)+CHR(NO MOD 10+48)
7740 ENDPROC 
7780 PROC SKRIV
7782 LINENR=0
7785 CLEAR 
7790 FOR X=1 TO 22
7795 CURSOR 1,X
7800 PRINT USING "####":LINENR+X;
7805 IF X>LAST THEN 
7810 PRINT " "
7815 ELSE 
7820 CASE SIDE$(X,65,66) OF 
7825 PRINT "       ";SIDE$(X)
7830 WHEN "##"
7835 IF ST$(12)="+" THEN ST$(12)=" "
7840 PRINT "       ";SIDE$(X,1,49);ST$;"Kr"
7845 ST$=TAH$
7850 WHEN "@@"
7855 IF GT$(12)="+" THEN GT$(12)=" "
7860 PRINT "       ";SIDE$(X,1,49);GT$;"Kr"
7865 GT$=TAH$
7870 WHEN "%%"
7875 HJ$=SIDE$(X,51,61)
7880 IF HJ$(11)=" " THEN HJ$(11)="+"
7885 EXEC CALC(0,HJ$,ST$,ST$)
7890 EXEC CALC(0,HJ$,GT$,GT$)
7895 PRINT "       ";SIDE$(X,1,64);"  "
7900 ENDCASE 
7905 ENDIF 
7910 NEXT X
7915 ENDPROC 
7920 PROC CHECK
7925 OKAY=FALSE
7930 CURSOR 22,23
7935 CASE SV$ OF 
7940 WHEN "T","t"
7945 OKAY=TRUE
7950 PRINT "Tilføjelse"
7955 WHEN "TL","tl","Tl","tL"
7960 OKAY=TRUE
7965 PRINT "Tilføj linie"
7970 WHEN "s","S"
7975 OKAY=TRUE
7980 PRINT "Sletning"
7985 WHEN "SL","sl","Sl","sL"
7990 OKAY=TRUE
7995 PRINT "Slet linie"
8000 WHEN "R","r"
8005 OKAY=TRUE
8010 PRINT "Retning"
8015 WHEN "e","E"
8020 OKAY=TRUE
8025 PRINT "Editering"
8030 WHEN "C","c"
8035 OKAY=TRUE
8040 PRINT "Centrer linie"
8045 WHEN "BL","Bl","bL","bl"
8050 SV$="BL"
8055 OKAY=TRUE
8060 PRINT "Indsæt beregningslinie"
8065 WHEN "ST","St","sT","st"
8070 SV$="ST"
8075 OKAY=TRUE
8080 PRINT "Subtotallinie indsættes"
8085 WHEN "GT","Gt","gT","gt"
8090 SV$="GT"
8095 OKAY=TRUE
8100 PRINT "Grandtotallinie indsættes"
8105 ENDCASE 
8110 ENDPROC 
8260 CHAIN "P641216:START"