1 REM Ins{nd av Kristoffer Eriksson <5357>    1988-06-20 00.34.23 (KERMIT)
10 ! save GROTERA
20 ! +-------------------------------------------------+
30 ! ! GROTERA 1.0 - 3/4/5-dimensionell grafik-rotation!
40 ! ! Av Kristoffer Eriksson <5357>, 1988             !
50 ! ! F}r fritt kopieras och anv{ndas.                !
60 ! ! F|r ABC806 och ABC800 med HR-grafik, ej ABC802. !
70 ! +-------------------------------------------------+
80 ! 1.0 / 880619 / <5357> /
90 !
100 ! Detta {r ett experimentellt program som roterar grafiska figurer i val-
110 ! fritt antal dimensioner (f|retr{desvis 2-5). F|r att f} st|rst utbyte av
120 ! det b|r man g} in i programmet och g|ra egna {ndringar, egna figurer,
130 ! eller vissa beskrivna till{gg. Men {ven den programmeringsokunnige kan
140 ! provk|ra programmet i befintligt skick. Programmet h}ller acceptabel
150 ! hastighet f|r en ABC. Bakgrund till det finns i Scientific American
160 ! April 1986.
170 !
180 ! Programmet fungerar b{st p} 806, och har bara testats d{r. B|r fungera
190 ! {ven p} 800. F}r du vid inladdning av programmet p} 800 n}gra stycken
200 ! meddelanden om felaktiga grafikinstruktioner, ska det {nd} fungera att
210 ! k|ra.
220 !
230 ! Figurerna som roteras l{ggs in i (kryptiska) DATA-satser, som beskrivs
240 ! nedan. N}gra 3D-figurer och en 4D-figur finns med. Ju mer komplicerade
250 ! figurer, desto l}ngsammare rotation f|rst}s.
260 !
270 ! Grxykorr. i FNInitgr b|r justeras till ett l{gre v{rde om ABC815 i
280 ! st{llet f|r 812 anv{nds, f|r att f} r{tt f|rh}llande mellan h|jd och
290 ! bredd (dvs s} kvadrater ser ut som riktiga kvadrater). Jag vet tyv{rr
300 ! vilket v{rde som beh|vs, bara att det inte {r samma.
310 !
320 ! Styrningen:
330 ! Sker med entangentskommandon. Koordinataxlarnas namn (xyzwq) anv{nds f|r
340 ! att ange vilken rotationsriktning som |nskas. Vid 3D anger man den axel
350 ! runt vilken rotationen ska ske. Den angivna axeln blir kvar, medan de tv}
360 ! andra vrids mot varandra. Vid annat {n 3D anger man tv} axlar. De vrids
370 ! d} mot varandra. (Rotationen sker i det plan som bildas av de tv}
380 ! axlarna.) \vriga axlar p}verkas ej. Stor eller liten bokstav best{mmer
390 ! fram- eller bakl{nges vridning. Mellanslag upprepar senaste vridning.
400 ! Observera att rotationen utg}r fr}n skr{mens "fasta" koordinataxlar, och
410 ! inte fr}n n}gra axlar som f|ljer med det avbildade f|rem}let.
420 !
430 ! M = \ka f|rstoringen, m = minska f|rstoringen. Om figuren inte f}r plats
440 ! p} sk{rmen, kommer bara en del av den att visas.
450 !
460 ! F,f = Mata in exakt f|rstoring.
470 ! V,v = Mata in stegvinkelns storlek.
480 !
490 ! D,d = Djupverkan p}/av. G|r att avl{gsnare delar blir mindre. Ger st|rre
500 ! realism, men l}ngsammare bildbyte. Parametrarna f|r djupverkan kan
510 ! justeras i FNTodevkoor.
520 !
530 ! S,s = Stereoskopisk visning p}/av. Bilden visas dubbelt: en r|d bild f|r
540 ! v{nster |ga och en gr|n f|r h|ger |ga, f|r betraktande genom r|d-gr|na
550 ! glas|gon. Den som har kvar sina fr}n TV:s 3D-serie har tur. Parametrarna
560 ! (framf|rallt vinkelavst}ndet mellan |gonen) kan justeras i FNDisppic.
570 ! Tar naturligtvis dubbelt s} l}ng tid per bild att }stadkomma.
580 !
590 ! A,a = Automatisk rotation tills ny tangent nedtrycks. F|r varje steg
600 ! anv{nds h{r tv} separata rotationer }t olika h}ll f|r att f} en "sned"
610 ! vridning. [ndra g{rna sj{lv i FNRot-anropen.
620 !
630 ! R,r = Slumpstyrd automatik.
640 ! T,t = Ledtext p}/av.
650 ! PF1 = Sluta.
660 !
670 !
680 ! Koordinater anges i f|ljande ordning: X, Y, Z, W, Q.
690 ! X {r horisontellt p} sk{rmen, Y vertikalt, Z inn}t i sk{rmen, och W
700 ! och Q {r den 4 resp 5 dimensionen. Fler dimensioner kan hanteras i ber{k-
710 ! ningarna, men bara dessa 5 har f}tt n}gon ben{mning i den interaktiva
720 ! styrningen.
730 !
740 ! DATA inleds med en angivelse av antalet dimensioner, normalt 3 eller 4,
750 ! och l{mplig f|rstoringsgrad.
760 !
770 ! Sen f|ljer en sektion koordinat-tripletter (X,Y,Z), avslutat med en tom
780 ! str{ng, och sist en sektion med par av <objekttyp> och <koordinat-index>.
790 ! Den senare pekar ut vilken koordinat-triplett som ska anv{ndas f|r objekt-
800 ! et. Dessa r{knas fr}n 0. <objekttyp> kan vara 1=Punkt, 2=Linje fr}n
810 ! senaste {ndpunkt, 3=R{tblock (kub), 4=Pyramid.
820 !
830 ! Syftet med denna tv}delade datastruktur {r att {ven om en viss punkt
840 ! anv{nds i t ex flera linjer, {nd} bara lagra och rotera den en enda g}ng.
850 ! Flera alternativa DATA-upps{ttningar kan finnas. En av dem v{ljs med
860 ! nedanst}ende RESTORE-sats. Uppdatera den om du l{gger till DATA-satser.
870 !
880 ! F|rstoringsgraden v{ljs s} att bilden blir lagom stor, utan att komma
890 ! utanf|r sk{rmen n{r den st}r som v{rst, dvs med diagonalen tv{rs |ver
900 ! sk{rmens smalaste del (240 pixels).
910 !
920 ! De befintliga figurerna har definierats med koordinater mellan -1 och +1,
930 ! men det {r inte n|dv{ndigt att h}lla sig till det. Djup-visningen {r
940 ! dock inst{lld p} att visa Z-koordinaten +1 med normal storlek. H|gre
950 ! v{rden f|rstoras, och mindre v{rden f|rminskas. (Borde kanske ocks}
960 ! p}verkas av f|rstoringen?)
970 !
980 ! Diagonalen i en 3D kub med sidan 2, blir SQR(2**2+2**2+2**2). I en 4D
990 ! kub med samma sida, blir den SQR(2**2+2**2+2**2+2**2).
1000 !
1010 !
1020 INTEGER : EXTEND : SINGLE : OPTION BASE 0 : RANDOMIZE
1030 Mv=5 ! Vinkel i antal grader f|r manuell stegning
1040 Djup=0
1050 Stereo=0
1060 Text=-1
1070 F{rg=3
1080 Maxobj=100
1090 ON ERROR GOTO 1090 : INPUT "Ange figurnummer (f.r.o.m 1): ";I
1100 ON I RESTORE 1140,1190,1240,1330
1110 ON ERROR GOTO
1120 !
1130 ! Koordinater f|r kub centrerad p} origo:
1140 DATA 3,65
1150 DATA -1,1,-1,  -1,-1,-1, 1,-1,-1,  1,1,-1
1160 DATA -1,1,1,   -1,-1,1,  1,-1,1,   1,1,1
1170 DATA "", 3,0, ""
1180 ! Pyramid lite obalancerat runt origo:
1190 DATA 3,65
1200 DATA -1,-1,-1, 1,-1,-1,  1,-1,1,   -1,-1,1,  0,1,0
1210 DATA "", 4,0, ""
1220 !
1230 ! Enkel kyrka:
1240 DATA 3,75
1250 DATA -1,0,-.5, -1,-1,-.5, 1,-1,-.5, 1,0,-.5
1260 DATA -1,0,.5,  -1,-1,.5,  1,-1,.5,  1,0,.5
1270 DATA 0,-1,-.5,  0,0,-.5,   0,-1,.5,  0,0,.5
1280 DATA -1,.5,0,  0,.5,0,    .5,1,0,   ""
1290 DATA 3,0,  1,8, 2,9, 2,14, 2,3,  1,10, 2,11, 2,14, 2,7
1300 DATA 1,0, 2,12, 2,4,  1,9, 2,13, 2,11,  1,12, 2,13, ""
1310 !
1320 ! 4-dimensionell hyperkub
1330 DATA 4,55
1340 DATA -1,1,-1,-1,  -1,-1,-1,-1, 1,-1,-1,-1,  1,1,-1,-1
1350 DATA -1,1,1,-1,   -1,-1,1,-1,  1,-1,1,-1,   1,1,1,-1
1360 DATA -1,1,-1,1,   -1,-1,-1,1,  1,-1,-1,1,   1,1,-1,1
1370 DATA -1,1,1,1,    -1,-1,1,1,   1,-1,1,1,    1,1,1,1
1380 DATA "", 1,0, 2,1, 2,2, 2,3, 2,7, 2,15, 2,11, 2,8, 2,9, 2,10, 2,2, 2,6
1390 DATA 2,14, 2,15, 2,12, 2,13, 2,9, 2,1, 2,5, 2,6, 2,7, 2,4, 2,12, 2,8, 2,0
1400 DATA 2,4, 2,5, 2,13, 2,14, 2,10, 2,11, 2,3, 2,0, ""
1410 !
1420 ! Koordinatordning som passar f|r kub och pyramid:
1430 ! , 4----7          4
1440 ! ,/!   /!         !!!,
1450 ! 0----3 !        !! ! ',
1460 ! ! 5--!-6       ! 3--!--2
1470 ! !/   !/       !/     !/
1480 ! 1----2        0------1
1490 !
1500 READ Dims,Magn. ! Antal dimensioner, f|rstoringsgrad
1510 IF Dims<2 THEN ; "F|r f} dimensioner!" : STOP
1520 DIM Objekt.(Maxobj,Dims-1) ! Lista p} objekts koordinater.
1530 DIM Struct(Maxobj/3*2,1) ! Lista p} objekt (ungef{r lagom m}nga).
1540 DIM Dev(Maxobj,1) ! Device coordinates under utritning av delobjekt.
1550 Z=FNInitsin
1560 Z=FNInitgr
1570 !
1580 ! L{s in DATA
1590 I=0
1600 READ Z$ : WHILE LEN(Z$)
1610   Objekt.(I,0)=VAL(Z$)
1620   J=1 : WHILE J<Dims : READ Objekt.(I,J) : J=J+1 : WEND
1630   I=I+1
1640 READ Z$ : WEND
1650 Topobj=I
1660 !
1670 I=0
1680 READ Z$ : WHILE LEN(Z$)
1690   Struct(I,0)=VAL(Z$) : READ Struct(I,1)
1700   IF Struct(I,1)>Topobj THEN ; "Felaktiga DATA." : STOP
1710   I=I+1
1720 READ Z$ : WEND
1730 Topstruc=I
1740 !
1750 ! Anv{ndarstyrning
1760 Z=FNDisppic
1770 IF Text THEN Z=FNLedtext
1780 A1=0 : A2=0
1790 WHILE 1
1800   GET Z$
1810   I=INSTR(1," XxYyZzWwQqMmFfVvDdSsTtAaRr"+CHR$(192),Z$)
1820   IF I<12 THEN 1910
1830   ON (I-10)/2 GOTO 1840,1850,1860,1870,1880,1890,2040,2160,2000
1840   IF Magn.>0. THEN Magn.=Magn.+(I>12)-(I=12) : Z=FNInitmagn : GOTO 1980 ELSE 1990
1850   Magn.=FNInm.("F|rstoringsgrad",Magn.) : Z=FNInitmagn : GOTO 1980
1860   Mv=FNMin(90,FNInm.("Stegningsvinkel i antal grader",Mv)) : GOTO 1990
1870   Djup=Djup=0 : GOTO 1980
1880   Stereo=Stereo=0 : GOTO 1980
1890   IF Text ; CHR$(12); : Text=0 : GOTO 1990 ELSE Z=FNLedtext : GOTO 1990
1900   !
1910   IF I<2 THEN IF I=0 OR A2=-1 THEN ; CHR$(7); : GOTO 1990 ELSE 1960
1920   IF I AND 1 THEN Dv=Mv ELSE Dv=-Mv
1930   IF Dims=3 THEN A1=1 AND I<4 : A2=1-(I<6) : GOTO 1960
1940   IF A2<>-1 THEN A1=I/2-1 : ; CUR(1,0) Z$ " " CHR$(8); : A2=-1 : GOTO 1990
1950   A2=I/2-1 : ; CUR(1,1) Z$;
1960   IF A1>=Dims OR A2>Dims THEN ; CHR$(7); : GOTO 1990
1970   Z=FNRot(0,Topobj,A1,A2,Dv)
1980   Z=FNDisppic
1990 WEND
2000 ; CHR$(12);
2010 END
2020 !
2030 ! Auto
2040 ; CHR$(12);
2050 Z=FNRot(0,Topobj,1,2,Mv) ! Rotation runt X-axeln med 5 grader.
2060 Z=FNDisppic
2070 WHILE SYS(5)=0
2080   Z=FNRot(0,Topobj,0,2,Mv) ! Rotation runt Y-axeln med 5 grader.
2090   Z=FNRot(0,Topobj,1,2,2) ! Rotation runt X-axeln med 2 grader.
2100   Z=FNDisppic
2110 WEND
2120 GET Z$
2130 GOTO 1770
2140 !
2150 ! Random
2160 ; CHR$(12);
2170 IF Djup THEN Maxsyns=2 ELSE Maxsyns=1
2180 WHILE SYS(5)=0
2190   A1=INT(Dims*RND) : A2=INT(Dims*RND) : IF A1=A2 THEN 2190
2200   I=RND*8+3
2210   IF A1>Maxsyns AND A2>Maxsyns THEN Z=FNRot(0,Topobj,A1,A2,FNMin(Mv*I,90)) : GOTO 2250
2220   WHILE SYS(5)=0 AND I
2230     Z=FNRot(0,Topobj,A1,A2,Mv)+FNDisppic
2240   I=I-1 : WEND
2250 WEND
2260 GET Z$
2270 GOTO 1770
2280 !
2290 DEF FNLedtext LOCAL Rad
2300   Rad=24+(Abc<>806)
2310   ; CUR(Rad-1,0) MAG "M= F|rstoring, A= Auto, R= Slump";
2320   ; ", Blank= Rept rot, PF1= Sluta, Ej/Shift= +/-";
2330   ; CUR(Rad,0) MAG "D= Djup, S= Stereo, V= Stegvinkel, F= S{tt f|rstoring";
2340   ; ", T= Ledtext";
2350   ; CUR(0,0);
2360   IF Dims=3 THEN ; "X,Y,Z = Rotera runt resp axel" ELSE ; "Ange rotationsplan med tv} axlar - XYZWQ"
2370   Text=-1
2380   RETURN 0
2390 FNEND
2400 !
2410 DEF FNMin(A,B) : IF A<=B THEN RETURN A ELSE RETURN B
2420 FNEND
2430 !
2440 DEF FNInm.(T$,D.) LOCAL S$=10,S.
2450   S.=D.
2460   ; CUR(3,0) T$ " (" NUM$(D.) "): ";
2470   ON ERROR GOTO 2490
2480   INPUT ""S$ : S.=VAL(S$)
2490   ; CUR(3,0) SPACE$(80) CUR(1,0);
2500   RETURN S.
2510 FNEND
2520 !
2530 ! Rotation i det plan som formas av axlarna A1 och A2.
2540 ! Vinkel V grader, -90 <= V <= 90 (beroende p} FNInitsinus).
2550 ! Objektkoordinater I1 till I2-1 roteras. Koordinater i andra axlar
2560 ! p}verkas ej.
2570 !
2580 DEF FNRot(I1,I2,A1,A2,V) LOCAL I,C.,S.,T1.,T2.
2590   S.=Sinus.(V)
2600   IF V<0 THEN C.=Sinus.(90+V) ELSE C.=Sinus.(90-V)
2610   I=I1 : WHILE I<I2
2620     T1.=Objekt.(I,A1)
2630     T2.=Objekt.(I,A2)
2640     Objekt.(I,A1)=T1.*C.-T2.*S.
2650     Objekt.(I,A2)=T1.*S.+T2.*C.
2660   I=I+1 : WEND
2670   RETURN 0
2680 FNEND
2690 ! Rotationsmatris X-Y:
2700 ! C  S  0
2710 ! -S C  0
2720 ! 0  0  1
2730 ! X-Z:
2740 ! C  0  S
2750 ! 0  1  0
2760 ! -S 0  C
2770 ! Y-Z:
2780 ! 1  0  0
2790 ! 0  C  S
2800 ! 0 -S  C
2810 !
2820 ! Fullst{ndig matrismultiplikation (f|r j{mf|relse)
2830 DEF FNTrans(I1,I2) LOCAL I,X.,Y.,Z.
2840   I=I1 : WHILE I<I2
2850     X.=Objekt.(I,0)*Trans.(0,0)+Objekt.(I,1)*Trans.(1,0)+Objekt.(I,2)*Trans.(2,0)
2860     Y.=Objekt.(I,0)*Trans.(0,1)+Objekt.(I,1)*Trans.(1,1)+Objekt.(I,2)*Trans.(2,1)
2870     Z.=Objekt.(I,0)*Trans.(0,2)+Objekt.(I,1)*Trans.(1,2)+Objekt.(I,2)*Trans.(2,2)
2880     Objekt.(I,0)=X.
2890     Objekt.(I,1)=Y.
2900     Objekt.(I,2)=Z.
2910   I=I+1 : WEND
2920   RETURN 0
2930 FNEND
2940 !
2950 DEF FNInitsin LOCAL I
2960   DIM Sinus.(-90:90) ! Sinus f|r olika gradtal
2970   Grad.=2.*PI/360. ! 1 grad angiven i radianer
2980   WHILE I<=90
2990     Sinus.(I)=SIN(I*Grad.)
3000     Sinus.(-I)=-Sinus.(I)
3010   I=I+1 : WEND
3020   RETURN 0
3030 FNEND
3040 !
3050 DEF FNInitgr
3060   Grxykorr.=1.65 ! F|r ABC812. [ndra f|r 815.
3070   IF PEEK(39)=3 THEN Abc=802 ELSE IF PEEK(39)=4 THEN Abc=806 ELSE Abc=800
3080   IF Abc=802 THEN ; "ABC802 har ingen HR-grafik." : STOP
3090   IF Abc=806 THEN Grmaxx=511 : Grmaxy=239
3100   IF Abc=800 THEN Grmaxx=239 : Grmaxy=239 : Grxykorr.=Grxykorr./2.
3110   Curpic=0
3120   Grorix=Grmaxx/2
3130   Groriy=Grmaxy/2
3140   Z=FNInitmagn
3150   ; CHR$(12);
3160   ON ERROR GOTO 3240
3170   FGPICTURE 0,0,2
3180   FGCTL BLK
3190   FGPOINT 0,0,0 : FGFILL Grmaxx,Grmaxy,0
3200   ON ERROR GOTO 3210 : FGPICTURE 1,0 ! Arbeta med 1, se 0
3210   FGCTL BLK+GRED+GGRN+GYEL
3220   RETURN 0
3230   !
3240   WHILE ERRCODE=201 ! Minnet fullt
3250     ; "F|r f} grafiksidor. Ta bort eller minska storleken p} RAM-floppyn f|r att f}    momentana bildbyten!"
3260     GET Z$ : ; CHR$(12); : GOTO 3180
3270   WEND
3280   ! Otill}ten rad/Enheten ej ansluten
3290   FGCTL 0
3300   FGPOINT 0,0,0 : FGFILL Grmaxx,Grmaxy,0
3310   FGCTL 2
3320   RETURN 0
3330 FNEND
3340 !
3350 DEF FNInitmagn
3360   Magnx.=Grxykorr.*Magn.
3370   Magny.=Magn.
3380   RETURN 0
3390 FNEND
3400 !
3410 DEF FNDisppic
3420   IF Bildfel THEN ; CUR(3,0) SPACE$(30) CUR(1,0); : Bildfel=0
3430   FGPOINT 0,0,0 : FGFILL Grmaxx,Grmaxy,0
3440   IF Stereo THEN Z=FNDispstruc(1)+FNRot(0,Topobj,0,2,6)+FNDispstruc(2)+FNRot(0,Topobj,0,2,-6)
3450   IF NOT Stereo THEN Z=FNDispstruc(F{rg)
3460   Curpic=Curpic XOR 1
3470   ON ERROR GOTO 3480 : FGPICTURE Curpic XOR 1,Curpic
3480   RETURN 0
3490 FNEND
3500 !
3510 DEF FNDispstruc(F) LOCAL I
3520   Z=FNTodevcoor(0,Topobj)
3530   ON ERROR GOTO 3640
3540   WHILE I<Topstruc
3550     ON Struct(I,0) GOSUB 3590,3600,3610,3620
3560   I=I+1 : WEND
3570   RETURN 0
3580   !
3590   Z=Struct(I,1) : FGPOINT Dev(Z,0),Dev(Z,1),F : RETURN
3600   Z=Struct(I,1) : FGLINE Dev(Z,0),Dev(Z,1),F : RETURN
3610   Z=FNDispcube(Struct(I,1),F) : RETURN
3620   Z=FNDisppyramid(Struct(I,1),F) : RETURN
3630   !
3640   ; CUR(3,0);
3650   IF ERRCODE<>176 THEN ; "Ov{ntat fel, kod" ERRCODE ELSE ; "F|r stor bild"
3660   Bildfel=-1
3670   ON ERROR GOTO 3640
3680   RETURN
3690 FNEND
3700 !
3710 DEF FNDispcube(I1,F) LOCAL I
3720   FGPOINT Dev(I1,0),Dev(I1,1),F
3730   I=I1+3 : WHILE I>=I1 : FGLINE Dev(I,0),Dev(I,1) : I=I-1 : WEND
3740   FGLINE Dev(I1+4,0),Dev(I1+4,1)
3750   I=I1+7 : WHILE I>=I1+4 : FGLINE Dev(I,0),Dev(I,1) : I=I-1 : WEND
3760   I=I1+3 : WHILE I>I1
3770     FGPOINT Dev(I,0),Dev(I,1)
3780     FGLINE Dev(I+4,0),Dev(I+4,1)
3790   I=I-1 : WEND
3800   RETURN 0
3810 FNEND
3820 !
3830 DEF FNDisppyramid(I1,F)
3840   FGPOINT Dev(I1,0),Dev(I1,1),F
3850   I=I1+3 : WHILE I>=I1 : FGLINE Dev(I,0),Dev(I,1) : I=I-1 : WEND
3860   FGLINE Dev(I1+4,0),Dev(I1+4,1) : FGLINE Dev(I1+1,0),Dev(I1+1,1)
3870   FGPOINT Dev(I1+2,0),Dev(I1+2,1)
3880   FGLINE Dev(I1+4,0),Dev(I1+4,1) : FGLINE Dev(I1+3,0),Dev(I1+3,1)
3890   RETURN 0
3900 FNEND
3910 !
3920 ! Omvandla logiska rymdkoordinater till sk{rmkoordinater
3930 ! Divisionen med 6 best{mmer hur stor inverkan bildens djup f}r.
3940 ! .8333 (1-1/6) {r vald s} att Z=+1 visas med op}verkad storlek.
3950 DEF FNTodevcoor(I1,I2) LOCAL I
3960   WHILE Djup
3970     I=I1 : WHILE I<I2
3980       Z=Objekt.(I,0)*Magnx.*(.8333+Objekt.(I,2)/6.) : Dev(I-I1,0)=Z+Grorix
3990       Z=Objekt.(I,1)*Magny.*(.8333+Objekt.(I,2)/6.) : Dev(I-I1,1)=Z+Groriy
4000     I=I+1 : WEND
4010     RETURN 0
4020   WEND
4030   I=I1 : WHILE I<I2
4040     Z=Objekt.(I,0)*Magnx. : Dev(I-I1,0)=Z+Grorix
4050     Z=Objekt.(I,1)*Magny. : Dev(I-I1,1)=Z+Groriy
4060   I=I+1 : WEND
4070   RETURN 0
4080 FNEND