⟦875f11595⟧

Text

0100 // *****************************************************************
0110 // ***   MONSTER80  (COMAL80 VER)               Peter Sierst 2YF  **
0120 // ***                                                            **
0130 // ***   Programmet vil definerer en af dine rummelige figurer    **
0140 // ***   i et 3-AKSE koordinatsystem                       **
0150 // ***   omregner disse til koordinater i planen og               **
0160 // ***   udtegner plankoordinaterne på plotteren                  **
0170 // ***                                                            **
0180 // ***   A: Sigtepunkt er midtpunktet for det rummelige           **
0190 // ***      koordinatsystem                                       **
0200 // ***                                                            **
0210 // ***   B: Øjepunkt er hvor man ser figuren   fra i forhold til  **
0220 // ***      sigtepunktet                                          **
0230 // ***                                                            **
0240 // ***   C: Skala er hvor meget man vil forlænge hver af          **
0250 // ***      akserne med                                           **
0260 // ***                                                            **
0270 // ***   D: Udtegner figuren   på plotteren                       **
0280 // ***                                         (under udvikling)  **
0290 // *****************************************************************
0300 FIGURANT:=20;MATRIXANT:=6;PI:=3.14159265
0310 DIM FMATRICE(FIGURANT,MATRIXANT*4)
0320 DIM C(4)
0330 DIM SVAR$ OF 4
0340 REPEAT 
0350 CLEAR 
0360 PRINT "A=SIGTEPUNKT"
0370 PRINT "B=ØJEPUNKT"
0380 PRINT "C=SKALA"
0390 PRINT "D=UDTEGN"
0400 PRINT "E=DEFINER"
0410 INPUT SVAR$
0420 CASE SVAR$ OF 
0430 PRINT "KOMMANDOEN EKSISTERER IKKE"
0440 FOR A:=1 TO 500 DO 
0450 NEXT A
0460 WHEN "A"
0470 EXEC SIGTEPUNKT
0480 WHEN "B"
0490 EXEC ØJEPUNKT
0500 WHEN "C"
0510 EXEC SKALA
0520 WHEN "D"
0530 EXEC UDTEGN
0540 WHEN "E"
0550 EXEC DEFINER
0560 ENDCASE 
0570 UNTIL 0
0580 PROC SIGTEPUNKT
0590 INPUT "SIGTEPUNKT :":X7,Y7,Z7
0600 ENDPROC SIGTEPUNKT
0610 PROC SKALA
0620 INPUT "SKALA      :":X8,Y8,Z8
0630 ENDPROC SKALA
0640 PROC ØJEPUNKT
0650 INPUT "ØJEPUNKT   :":X9,Y9,Z9
0660 A:=SQR(X9*X9+Y9*Y9)
0670 C1:=Y9/A
0680 S1:=X9/A
0690 B:=SQR(X9*X9+Y9*Y9+Z9*Z9)
0700 C2:=A/B
0710 S2:=Z9/B
0720 ENDPROC ØJEPUNKT
0730 PROC PLOTINIT
0740 PRINT "I;: I;: U H"
0750 MX:=3500/2;MY:=2300/2
0760 PRINT "U A";MX;",";MY
0770 PRINT "O"
0780 ENDPROC PLOTINIT
0790 PROC PLOTSLUT
0800 PRINT "U H @"
0810 ENDPROC PLOTSLUT
0820 PROC UDTEGN
0830 SELECT OUTPUT "P2"
0840 X:=C(1)+X7;Y:=C(2)+Y7;Z:=C(3)+Z7
0850 EXEC TRANSFORM
0860 IF NOT (X2>3500-MX OR X2<-MX OR Y2>2300-MY OR Y2<-MY) THEN 
0870 IF C(4)=1 THEN 
0880 PRINT "D A L0";X2;",";Y2
0890 ELSE 
0900 PRINT "U A";X2;",";Y2
0910 ENDIF 
0920 ENDIF 
0930 SELECT OUTPUT "T"
0940 ENDPROC TEGNSTREG
0950 PROC TRANSFORM
0960 X1:=X8*(-X*C1+Y*S1+X9*C1-Y9*S1)
0970 Y1:=Y8*(-X*S1*S2-Y*S2*C2+Z*C2-Z9*C2+X9*S1*S2+Y9*S2*C2)
0980 Z1:=Z8*(-X*S1*C2-Y*C1*C2-Z*S2+Z9*S2+X9*S1*C2+Y9*C1*C2)
0990 X2:=INT(1000*X1/Z1)
1000 Y2:=INT(1000*Y1/Z1)
1010 ENDPROC TRANSFORM
1020 PROC GLOBUS
1030 INPUT "ANTAL BREDDE OG LÆNGDEGRADER ?":B,L
1040 PRINT "VENT ET ØJEBLIK - JEG SKAL LIGE ERKLÆRE ET PAR VARIABLER !"
1050 R:=50;TEL:=4;D:=L
1060 FOR A:=0 TO PI-PI/D STEP PI/D DO 
1070 R1:=SIN(A)*R
1080 R2:=SIN(A+PI/D)*R
1090 H1:=SIN(A+PI/2)*R
1100 H2:=SIN(A+PI/2+PI/D)*R
1110 FOR S:=0 TO 2*PI STEP PI/B DO 
1120 TEL:=TEL+3
1130 X:=COS(S);Y:=SIN(S)
1140 X1:=X*R1;Y1:=Y*R1
1150 C(1):=X1;C(2):=Y1;C(3):=H1;C(4):=0
1160 X2:=X*R2;Y2:=Y*R2
1170 C(TEL+1,1):=X2;C(TEL+1,2):=Y2;C(TEL+1,3):=H2;C(TEL+1,4):=1
1180 X3:=COS(S+PI/B)*R2
1190 Y3:=SIN(S+PI/B)*R2
1200 C(1):=X3;C(TEL+2,2):=Y3;C(TEL+2,3):=H2;C(TEL+2,4):=1
1210 NEXT S
1220 NEXT A
1230 ENDPROC GLOBUS
1240 PROC ORIGO
1250 INPUT "AKSERNES LÆNGDE ?  ":LÆN
1260 LÆN:=LÆN/2
1270 // C(1,1)=LÆN;C(1,2)=0;C(1,3)=0;C(1,4)=0
1280 // C(2,1)=-LÆN;C(2,2)=0;C(2,3)=0;C(2,4)=1
1290 // C(3,1)=0;C(3,2)=LÆN;C(3,3)=0;C(3,4)=0
1300 // C(4,1)=0;C(4,2)=-LÆN;C(4,3)=0;C(4,4)=1
1310 // C(5,1)=0;C(5,2)=0;C(5,3)=LÆN;C(5,4)=0
1320 // C(6,1)=0;C(6,2)=0;C(6,3)=-LÆN;C(6,4)=1
1330 ENDPROC S
1340 PROC DEFINER
1350 REPEAT 
1360 CLEAR 
1370 PRINT "HVILKEN FIGUR ØNSKES ?"
1380 PRINT 
1390 PRINT "1=STREG","2=FLADE","3=KASSE","4=PYRAMIDE"
1400 PRINT "5=CIRKEL","6=GLOBUS"
1410 INPUT SVAR$
1420 IF SVAR$="1" THEN EXEC DEFSTREG
1430 IF SVAR$="2" THEN EXEC DEFFLADE
1440 IF SVAR$="3" THEN EXEC DEFKASSE
1450 IF SVAR$="4" THEN EXEC DEFPYRAMIDE
1460 IF SVAR$="5" THEN EXEC DEFCIRKEL
1470 IF SVAR$="6" THEN EXEC DEFGLOBUS
1480 INPUT "IGEN ? ":SVAR$
1490 UNTIL SVAR$="N"
DataMuseum.dk

MIKADOS

⟦875f11595⟧

Derivation

Text
