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 och .
790 ! Den senare pekar ut vilken koordinat-triplett som ska anv{ndas f|r objekt-
800 ! et. Dessa r{knas fr}n 0. 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 JTopobj 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 I176 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