DataMuseum.dk

top - download

    Length: 8192 (0x2000)
    Types: TextFile
    Names: »danmark«

└─⟦c825e2ecf⟧ Bits:30003906 EL-FI Undervisningsprogrammer til Piccolo
    └─ ⟦this⟧ »danmark« 

TextFile

0010 ENABLE esc
0011 CLOSE 
0020 // KOSTBEREGNING    * version  01.01 *   10.OKT.1981  
0030 // ***  Præliminær version  ***  
0040 // Meddelelser om fejl samt forslag til forbedringer sendes til:  
0050 // DAKS - Dataafdelingen ved Aalborg Kommunale Skolevæsen  
0060 // Sofiendalskolen, Hobrovej 324, 9200 Aalborg SV.  
0070 // Tlf.: (08) 18 19 88   eller   (08) 18 66 85  
0080 // (Programmet findes også i en version til RC7000/RC8000)  
0090 // //------------------------------------------------------------//  
0095 MARGIN 0
0097 PROC kostliste EXTERNAL "kostlist"
0100 PROC xy(xc,yc)
0110   dum:=crt(6); dum:=crt(95+xc-(xc>32)*64-(xc>64)*64); dum:=crt(95+yc)
0120 ENDPROC xy
0130 DIM stip1$ OF 80,stip$ OF 80,buf$ OF 128,vn$(20) OF 15,v(20,20),facit(20),ok$ OF 1
0140 stip$:="---------------!------!------!------!------!------!"
0150 stip$:=stip$+"------!------!------!------!"; ant:=0; indflag:=0
0160 stip1$:="---------------------------------------------------"
0170 stip1$:=stip1$+"----------------------------"; side:=0
0180 PRINT CHR$(12)
0190 OPEN FILE 1,"kostfil", RANDOM 145
0200 EXEC eskema(0)
0210 REPEAT  //// monitor//  
0220   EXEC xy(1,1)
0230   PRINT " F)orklaring  I)ndsæt  R)ette  E)nergi  V)itamineraler  P)rint";
0231   PRINT "  L)iste  S)top"
0240   dummy:=keyq(0)
0241   IF dummy=108 THEN EXEC kostliste
0242   ENABLE esc
0250   IF dummy=112 AND ant<>0 THEN
0260     SELECT OUTPUT "printer"
0265     PRINT CHR$(30)
0270     EXEC eskema(0)
0271     PRINT CHR$(30)
0272     EXEC vskema(0)
0274     IF ant>10 THEN
0275       PRINT CHR$(30)
0280       EXEC eskema(1)
0282       PRINT CHR$(30)
0283       EXEC vskema(1)
0285     ENDIF 
0286     PRINT 
0287     PRINT CHR$(30)
0290     SELECT OUTPUT "console"
0291   ENDIF 
0300   IF dummy=69 THEN EXEC eskema(1)
0310   IF dummy=101 THEN EXEC eskema(0)
0320   IF dummy=86 THEN EXEC vskema(1)
0330   IF dummy=118 THEN EXEC vskema(0)
0340   IF dummy=82 THEN EXEC ret(1)
0350   IF dummy=114 THEN EXEC ret(0)
0360   IF dummy=73 OR dummy=105 THEN EXEC indsæt
0370   IF dummy=102 OR dummy=70 THEN EXEC forklar
0380 UNTIL dummy=83 OR dummy=115
0385 CLOSE 
0386 CHAIN "logon"
0390 PROC eskema(side)
0400   indflag:=1
0410   PRINT CHR$(12)
0420   PRINT stip1$
0430   PRINT "     SIDE: ";side+1;"  !      !      !       ENERGIGIVENDE ";
0440   PRINT "NÆRINGSSTOFFER I GRAM      !"
0450   PRINT "               ! VÆGT !ENERGI!        FEDT        !";
0460   PRINT "      KULHYDRAT     ! PRO- !"
0470   PRINT "     NAVN      ! GRAM !  kJ  ! IALT ! MÆTT.! POLY.!";
0480   PRINT " IALT ! STIV.! SUKK.! TEIN !"
0490   PRINT stip$
0500   tttx:=ant
0510   FOR ttt:=1+side*10 TO ant+(ant>10 AND side=0)*(10-ant) DO
0520     EXEC linud(ttt)
0530   NEXT ttt
0540   IF ant>0 THEN EXEC total
0550 ENDPROC eskema
0560 PROC indsæt
0570   IF indflag=0 OR ant DIV 10<>side THEN
0580     indflag:=1
0590     EXEC eskema(ant DIV 10)
0600   ENDIF 
0610   ant:=ant+1
0620   IF ant=10 THEN indflag:=0
0630   EXEC xy(1,1)
0635   PRINT AT(35,1);CHR$(128)
0640   IF ant>20 THEN
0650     PRINT "FOR MANGE VARER !!!";CHR$(7)
0660     ant:=ant-1
0670   ELSE 
0680     REPEAT 
0690       EXEC xy(1,1)
0700       dummy:=crt(30)
0710       INPUT AT(2,1),"VARENUMMER: ": vnr
0720     UNTIL vnr>=1 AND vnr<=315
0730     READ FILE 1,vnr: vn$(ant),q,w,e,r,t,y,u,i,o,p,å,a,s,d,f,g
0735     PRINT AT(36,1);CHR$(128)
0740     EXEC xy(20,1)
0750     PRINT CHR$(144);vn$(ant);CHR$(128);"    ";
0760     INPUT "ANTAL GRAM: ": v(ant,1)
0770     IF v(ant,1)>0 THEN
0780       EXEC beregn
0790       EXEC linud(ant)
0800       EXEC facitind(ant)
0810     ELSE 
0820       ant:=ant-1
0830     ENDIF 
0840     IF ant>0 THEN EXEC total
0850   ENDIF 
0860 ENDPROC indsæt
0870 PROC facitud(lnr)
0880   FOR tæl:=1 TO 20 DO
0890     facit(tæl):=facit(tæl)-v(lnr,tæl)
0900   NEXT tæl
0910 ENDPROC facitud
0920 PROC beregn
0930   fak:=v(ant,1)/100
0940   v(ant,2):=q*fak; v(ant,3):=w*fak; v(ant,4):=e*fak; v(ant,5):=r*fak
0950   v(ant,6):=t*fak; v(ant,7):=y*fak; v(ant,8):=u*fak; v(ant,9):=i*fak
0960   v(ant,10):=o*fak; v(ant,11):=p*fak; v(ant,12):=å*fak; v(ant,13):=a*fak
0970   v(ant,14):=s*fak; v(ant,15):=d*fak; v(ant,16):=f*fak; v(ant,17):=g*fak
0980 ENDPROC beregn
0990 PROC facitind(lnr)
1000   FOR tæl:=1 TO 20 DO
1010     facit(tæl):=facit(tæl)+v(lnr,tæl)
1020   NEXT tæl
1030 ENDPROC facitind
1040 PROC linud(lnr)
1050   IF dummy<>112 THEN EXEC xy(1,lnr+6-((ant DIV 11)*10))
1060   PRINT vn$(lnr);
1070   PRINT USING "!######!######": v(lnr,1);v(lnr,2);
1080   FOR tæl:=3 TO 9 DO
1090     PRINT USING "!####.#": v(lnr,tæl);
1100   NEXT tæl
1110   PRINT "!"
1120 ENDPROC linud
1130 PROC total
1140   IF dummy<>112 THEN EXEC xy(1,17)
1150   PRINT stip$
1160   PRINT " INDHOLD IALT: ";
1170   PRINT USING "!######!######": facit(1);facit(2);
1180   FOR tæl:=3 TO 9 DO
1190     PRINT USING "!####.#": facit(tæl);
1200   NEXT tæl
1210   PRINT "!"
1220   PRINT stip$
1230   totkj:=facit(3)*38+facit(6)*17+facit(9)*17
1240   PRINT USING " ENERGIFORDELING i % af######": totkj;
1245   IF totkj>0 THEN
1250     PRINT USING "!### % ": facit(3)*3800/totkj;
1255   ELSE 
1256     PRINT USING "!### % ": 0;
1257   ENDIF 
1260   IF facit(4)>0 THEN
1270     PRINT USING "! P:S = ##.## ": facit(5)/facit(4);
1280   ELSE 
1290     PRINT "!             ";
1300   ENDIF 
1305   IF totkj>0 THEN
1310     PRINT USING "!### % ": facit(6)*1700/totkj;
1320     PRINT USING "!(###%)": facit(7)*1700/totkj;
1330     PRINT USING "!(###%)": facit(8)*1700/totkj;
1340     PRINT USING "!### % ": facit(9)*1700/totkj;
1345   ELSE 
1346     PRINT USING "!### % ": 0;
1347     PRINT USING "!(###%)": 0;
1348     PRINT USING "!(###%)": 0;
1349     PRINT USING "!### % ": 0;
1350   ENDIF 
1355   PRINT "!"
1360   PRINT stip$
1370   PRINT " INDHOLD PR. 1000 kJ :       ";
1375   IF facit(2)>0 THEN
1380     PRINT USING "!####.#": facit(3)/facit(2)*1000;
1390     PRINT USING "!      !      !####.#": facit(6)/facit(2)*1000;
1400     PRINT USING "!      !      !####.#": facit(9)/facit(2)*1000;
1401   ELSE 
1402     PRINT USING "!####.#": 0;
1403     PRINT USING "!      !      !####.#": 0;
1404     PRINT USING "!      !      !####.#": 0;
1405   ENDIF 
1410   PRINT "!"
1420   PRINT " NORMER  PR. 1000 kJ :       !   9.8!      !      ";
1430   PRINT "!  30.0!      !      !   7.0!"
1440   PRINT stip$
1450   dummy:=crt(31)
1460 ENDPROC total
1470 CLOSE  // CHECK STRØMNUMMER 
1480 PROC vskema(side)
1490   indflag:=0
1500   PRINT CHR$(12)
1510   PRINT stip1$
1520   PRINT "    SIDE: ";side+1;"   !      !SLAGGE!         VITAMINER  ";
1530   PRINT "       !      MINERALER     !"
1540   PRINT "               ! VÆGT ! STOF !   A  !   C  !  B1  !";
1550   PRINT "  B2  !  Ca  !  Fe  !  Na  !"
1560   PRINT "    NAVN       ! GRAM ! GRAM ! mic.G! mil.G! mic.G!";
1570   PRINT " mic.G! mil.G! mil.G! mil.G!"
1580   PRINT stip$
1590   FOR ttt:=1+10*side TO ant+(ant>10 AND side=0)*(10-ant) DO
1600     PRINT vn$(ttt);
1610     PRINT USING "!######!####.#": v(ttt,1);v(ttt,10);
1620     FOR tæl:=11 TO 17 DO
1630       PRINT USING "!######": v(ttt,tæl);
1640     NEXT tæl
1650     PRINT "!"
1660   NEXT ttt
1670   EXEC xy(1,17)
1680   PRINT stip$
1690   PRINT " INDHOLD IALT: ";
1700   PRINT USING "!######!####.#": facit(1);facit(10);
1710   FOR tæl:=11 TO 17 DO
1720     PRINT USING "!######": facit(tæl);
1730   NEXT tæl
1740   PRINT "!"
1750   PRINT stip$
1