DataMuseum.dk

top - metrics - download

    Length: 5056 (0x13c0)
    Notes: Mikados TextFile, Mikados_K
    Names: »IDEALVÆG«

└─⟦92e6f589c⟧ Bits:30003895/4xCOMAL3b.imd 4 * COMAL - SPC/1 - Disketter til bogen
    └─⟦this⟧ »IDEALVÆG« 
└─⟦faca42ef2⟧ Bits:30003895/4xCOMAL1.imd 4 * COMAL - SPC/1 - Disketter til bogen
    └─⟦this⟧ »IDEALVÆG« 

Text

0010 // ------------------------- Idealvægt ------------------------
0020 // 
0030 CLEAR 
0040 DIM MAKVI$ OF 10,SV$ OF 2,SVAR$ OF 5,PRØV$ OF 8
0050 // -----------------------------------------------------
0060 EXEC MENU
0070 PROC MENU
0080 REPEAT 
0090 EXEC HOVED
0100 EXEC SPØRG
0120 UNTIL SV$ IN "nN"
0130 ENDPROC MENU
0140 // -----------------------------------------------------
0150 PROC HOVED
0160 CLEAR 
0170 FOR X:=10 TO 70 DO 
0180 CURSOR X,2
0190 PRINT "*"
0200 NEXT X
0210 FOR Y:=3 TO 13 DO 
0220 CURSOR 70,Y
0230 PRINT "*"
0240 NEXT Y
0250 FOR X:=69 TO 10 STEP -1 DO 
0260 CURSOR X,13
0270 PRINT "*"
0280 NEXT X
0290 FOR Y:=13 TO 3 STEP -1 DO 
0300 CURSOR 10,Y
0310 PRINT "*"
0320 NEXT Y
0330 CURSOR 10,6
0340 PRINT "*                    I D E A L V Æ G T   "
0350 CURSOR 10,8
0360 PRINT "*                          h o s"
0370 CURSOR 10,10
0380 PRINT "*              K V I N D E R   O G   M Æ N D "
0390 CURSOR 10,20
0400 PRINT "Programmet udskriver idealvægt hos kvinder og mænd, når man "
0410 CURSOR 10,22
0420 PRINT "indtaster højden i cm.                                   "
0440 CURSOR 72,23
0450 INPUT "Return! ":SVAR$
0480 ENDPROC HOVED
0490 // -----------------------------------------------------------------
0500 PROC SPØRG
0510 CLEAR 
0520 REPEAT 
0530 CURSOR 5,5
0540 PRINT "<ZS>Skriv om du er mand eller kvinde.  (mand/kvinde)     "
0550 INPUT MAKVI$
0560 CASE MAKVI$ OF 
0570 WHEN " "
0580 EXEC FORTSÆTTE
0590 WHEN "mand"
0600 EXEC MAND
0610 EXEC UDSKRIV
0620 EXEC FORTSÆTTE
0630 WHEN "kvinde"
0640 EXEC KVINDE
0650 EXEC FORTSÆTTE
0660 OTHERWISE 
0670 PRINT 
0680 ENDCASE 
0690 UNTIL ","+MAKVI$+"," IN ",mand,kvinde,"
0700 ENDPROC SPØRG
0710 // ------------------------------------------------------------------
0720 PROC MAND
0730 CURSOR 5,7
0740 INPUT "Du skal her indtaste din højde i cm:                   ":HØJDE
0750 VÆGT:=(HØJDE-100)*90/100
0760 VÆGT:=INT(VÆGT)
0770 IF HØJDE<120 OR HØJDE>200 THEN EXEC UNORMAL
0780 ENDPROC MAND
0790 // ---------------------------------------------------------------------
0800 PROC UDSKRIV
0810 CURSOR 5,15
0820 PRINT "****************************************************************"
0830 CURSOR 5,16
0840 PRINT "*****                                                      *****"
0850 CURSOR 5,17
0859 PRINT "*****    Du skal med en højde på: ";
0860 PRINT USING "#####.# cm. veje:        *****":HØJDE
0870 CURSOR 5,18
0879 PRINT "*****                   ";
0880 PRINT USING "####.# kg.                         *****":VÆGT
0890 CURSOR 5,19
0900 PRINT "*****                                                      *****"
0910 CURSOR 5,20
0920 PRINT "****************************************************************"
0930 ENDPROC UDSKRIV
0940 // ---------------------------------------------------------------------
0950 PROC FORTSÆTTE
0960 PRINT 
0970 PRINT 
0980 // POKE 256, 0
0990 CURSOR 5,22
1000 INPUT "Ønsker du at fortsætte?    (j/n)  ":SV$
1030 IF SV$ IN "nN" THEN 
1040 EXEC SLUT
1050 ENDIF 
1060 ENDPROC FORTSÆTTE
1070 // ---------------------------------------------------------------------
1080 PROC UNORMAL
1090 REPEAT 
1110 CURSOR 5,15
1120 PRINT "Du ligger vist uden for de normale rammer.";
1125 INPUT " Skal vi prøve igen? (j/n)":SV$
1130 CURSOR 75,15
1160 IF SV$="j" OR SV$="J" THEN 
1170 EXEC MENU
1180 ENDIF 
1190 IF SV$ IN "nN" THEN 
1200 EXEC SLUT
1210 ENDIF 
1220 UNTIL SV$ IN "nN"
1230 ENDPROC UNORMAL
1240 // ---------------------------------------------------------------------
1250 PROC KVINDE
1260 PRINT 
1270 PRINT 
1280 INPUT "   Du skal indtaste din højde i cm:                       ":HØJDE
1290 IF HØJDE<130 OR HØJDE>190 THEN 
1300 EXEC UNORMAL
1310 ELSE 
1320 VÆGT:=(HØJDE-100)*0.88
1330 IF VÆGT MOD 10=6 THEN VÆGT:=VÆGT+1
1340 VÆGT:=INT(VÆGT)
1350 EXEC UDSKRIV
1360 ENDIF 
1370 ENDPROC KVINDE
1380 // ---------------------------------------------------------------------
1390 PROC SLUT
1400 CURSOR 5,24
1410 PRINT "Så slutter vi for i dag."
1420 END 
1430 ENDPROC SLUT