1 REM Ins{nd av Kristoffer Eriksson <5357> 1986-05-01 00.35.34
20 ! -----------------------------------------------
30 ! FIGITER Ver 1.00 - Figur-iteration (M|nster som upprepar sig sj{lva)
40 ! F|r ABC800, 806, 1600 med HR-grafik.
50 ! F}r kopieras fritt i icke-kommersiella syften.
60 !
70 ! Ver X.00 86-03-20 Av <5357> Kristoffer Eriksson.
80 ! Ver 1.00 86-04-30 Av <5357> Release.
90 ! -----------------------------------------------
100 !
110 ! Programmet ritar linjem|nster som i fler och fler niv}er upprepar sig
120 ! i sig sj{lvt. Anta att du b|rjar med ett rakt streck. Dela strecket i
130 ! tre delar och byt ut den mittersta mot toppen av en triangel. Upprepa
140 ! nu detta f|rfarande med var och en av de fyra linjerna i den nya figuren.
150 ! Upprepa igen, osv.
160 !
170 ! Figurerna beh|ver inte n|dv{ndigtvis bygga p} trianglar, utan vilket
180 ! grundl{ggande m|nster som helst kan anv{ndas. Resultatet blir dock
190 ! b{st med m|nster vars sammanlagda vinklar {r noll, men {ven andra
200 ! varianter kan ge intressanta resultat.
210 !
220 ! Grundm|nstret beskrivs genom att dess vinklar anges.
230 !
240 ! I levererat skick anv{nder programmet samma grundm|nster hela tiden,
250 ! men detta kan {ndras i variabeln M|nster$ i b|rjan av programmet. Om
260 ! man {ndrar till M|nster$="" kommer programmet att fr}ga om m|nstret.
270 !
280 ! Ska programmet k|ras p} ABC1600 m}ste n}gra {ndringar g|ras. Dessa finns
290 ! utm{rkta med kommentarer h{r i b|rjan och i FNTagglinje och FNGcls.
300 !
310 INTEGER : EXTEND
320 !
330 ! ; CHR$(27)":1l"; : Abc=1600 ! S{tt portr{ttl{ge p} ABC1600
340 ! ; CHR$(27)":1h"; : ABC=1601 ! S{tt landskapsl{ge p} ABC1600
350 Cls$=CHR$(12)
360 ! Cls$=CLS ! F|r ABC1600
370 IF Abc=0 THEN Abc=FNAbc
380 Z=FNInitgr
390 !
400 ! ------- Genom att variera f|ljande variabler f}r man olika m|nster ------
410 ! De flesta variabler kan st{llas till 9 f|r att ge fr}gor eller automatval.
420 ! Maxniv} = H|gsta antal m|nsterniv}er. Beh|ver knappast |kas.
430 ! R{knemetod = 0 f|r snabb heltalsr{kning med m}nga avrundningsfel,
440 ! ' 1 f|r flyttalsr{kning, 9 f|r automatval.
450 ! L{ngddelning = Minskning av linjernas l{ngd f|r varje ny bild. (9=auto)
460 ! L{ngd = Linjel{ngd (som potens av L{ngddelning f|r att bli j{mt delbar)
470 ! Vdelar = Enhet f|r vinklar i delar av en hel cirkel (360/Vdelar grader).
480 ! X0, Y0 = Startkoordinater.
490 ! M|nster$ = M|nsterbeskrivning. Varje siffra anger en vinkel. Siffran 5
500 ! ' motsvarar vinkeln 0, 6 ger +1 Vdelar, 4 ger -1 Vdelar osv.
510 ! ' Tom ger fr}ga.
520 !
530 Maxniv}=20
540 R{knemetod=9
550 L{ngddelning=3
560 L{ngd=4
570 X0=0
580 Y0=1
590 Vdelar=6 ! 60 grader (2*PI/6 radianer)
600 !
610 M|nster$="636" : X0=0 : Y0=1
620 ! M|nster$="6446"
630 ! M|nster$="644466" : X0=0 : Y0=Ymax/5*4
640 ! M|nster$="6626" : X0=Xmax/3*2 : Y0=1
650 ! M|nster$="4844" : X0=0 : Y0=L{ngd*2
660 ! M|nster$="663366" : Vdelar=12 : X0=0 : Y0=1
670 ! M|nster$="744447" : Vdelar=12 : X0=0 : Y0=1
680 ! M|nster$="84444448" : Vdelar=12 : X0=0 : Y0=1
690 ! M|nster$="8443448" : Vdelar=12 : X0=0 : Y0=1
700 Ettitaget=9
710 Paint=9
720 !
730 !
740 ! --------------------- Fr}gor och automatval -----------------------------
750 WHILE Ettitaget=9
760 ; "Ska m|nstren skrivas ovanp} varandra (N/J) ? ";
770 Ettitaget=FNSvar("NJ")-2
780 IF Ettitaget=0 THEN Paint=0
790 WEND
800 !
810 WHILE Paint=9
820 ; "Ska m|nstren fyllas med f{rg (N/J) ? ";
830 Paint=1-FNSvar("NJ")
840 WEND
850 !
860 WHILE M|nster$=""
870 ON ERROR GOTO 870 : INPUT "M|nsterbeskrivning: "M|nster$ : ON ERROR GOTO
880 WEND
890 !
900 WHILE Vdelar<=0
910 ON ERROR GOTO 910 : INPUT "Grundvinkel (grader):"Vdelar
920 Vdelar=360/Vdelar : ON ERROR GOTO
930 WEND
940 !
950 WHILE L{ngd<=0
960 ON ERROR GOTO 960 : INPUT "Linjel{ngd: "L{ngd : ON ERROR GOTO
970 WEND
980 !
990 WHILE X0<0 OR Y0<0
1000 ON ERROR GOTO 1000 : INPUT "Startkoordinater (x,y): "X0,Y0
1010 ON ERROR GOTO
1020 WEND
1030 !
1040 IF R{knemetod=9 THEN R{knemetod=1-(Ettitaget=0)
1050 IF L{ngddelning=9 THEN L{ngddelning=LEN(M|nster$)
1060 !
1070 ! --------- Utritning, med succesiv f|rminskning -------------------------
1080 L{ngd=L{ngddelning^L{ngd
1090 F{rg=1
1100 WHILE L{ngd>0
1110 Z=FNSintab(Vdelar,L{ngd)
1120 IF R{knemetod AND 1 THEN Z=FNTagglinje(M|nster$,Vdelar,X0,Y0,L{ngd,F{rg)
1130 IF R{knemetod AND 2 THEN Z=FNTagglinje.(M|nster$,Vdelar,X0,Y0,L{ngd,F{rg)
1140 WHILE Paint
1150 IF Z<0 THEN Z=0 ELSE IF Z>Ymax THEN Z=Ymax
1160 FGLINE Xmax,Z,F{rg
1170 FGPAINT Xmax/2,0,F{rg
1180 IF 0 WEND
1190 L{ngd=L{ngd/L{ngddelning
1200 F{rg=MOD(F{rg,Maxf{rg)+1
1210 ; Cls$;
1220 WHILE Ettitaget OR SYS(5) ! SYS(5) kan ge problem p} {ldre BASIC-III
1230 ; "PF1 eller S=Avbryt, Annat=N{sta ";
1240 GET I$
1250 IF INSTR(1,CHR$(192,27)+"Ss",I$) THEN 1290
1260 IF Ettitaget AND L{ngd>0 THEN Z=FNGcls
1270 IF 0 WEND
1280 WEND
1290 END
1300 !
1310 ! ----------- Ritar det best{llda m|nstret. Snabb heltalsversion ----------
1320 DEF FNTagglinje(M|nster$,Vdelar,X0,Y0,L{ngd,F) LOCAL X,Y,Niv},Gr{ns,Vrid,V
1330 Z=FNInittagglinje(Maxniv})
1340 Niv}=1
1350 Gr{ns=LEN(M|nster$)
1360 X=X0 : Y=Y0
1370 FGPOINT X,Y,F
1380 WHILE 1
1390 X=X+Costab.(V)
1400 Y=Y+Sintab.(V)
1410 IF X>Xmax THEN RETURN Y
1420 IF Y>=0 AND Y<=Ymax THEN FGLINE X,Y,F
1430 !
1440 Niv}=1
1450 WHILE R{knare(Niv})=Gr{ns
1460 R{knare(Niv})=0
1470 Niv}=Niv}+1
1480 WEND
1490 R{knare(Niv})=R{knare(Niv})+1
1500 Vrid=ASCII(MID$(M|nster$,R{knare(Niv}),1))-53
1510 V=MOD(V+Vrid,Vdelar) ! V+Vrid ska vara V+Vrid+Vdelar p} ABC1600
1520 WEND
1530 FNEND
1540 !
1550 ! Flyttalsversion, l{mplig om f|rminskningar visas p} varandra
1560 DEF FNTagglinje.(M|nster$,Vdelar,X0,Y0,L{ngd,F) LOCAL X.,Y.,Niv},Gr{ns,Vrid,V
1570 Z=FNInittagglinje(Maxniv})
1580 Niv}=1
1590 Gr{ns=LEN(M|nster$)
1600 X.=X0 : Y.=Y0
1610 FGPOINT X.,Y.,F
1620 WHILE 1
1630 X.=X.+Costab.(V)
1640 Y.=Y.+Sintab.(V)
1650 IF X.>Xmax THEN RETURN Y.
1660 IF Y.>=0. AND Y.<=Ymax THEN FGLINE X.,Y.,F
1670 !
1680 Niv}=1
1690 WHILE R{knare(Niv})=Gr{ns
1700 R{knare(Niv})=0
1710 Niv}=Niv}+1
1720 WEND
1730 R{knare(Niv})=R{knare(Niv})+1
1740 Vrid=ASCII(MID$(M|nster$,R{knare(Niv}),1))-53
1750 V=MOD(V+Vrid,Vdelar) ! V+Vrid ska vara V+Vrid+Vdelar p} ABC1600
1760 WEND
1770 FNEND
1780 !
1790 DEF FNInittagglinje(Max) LOCAL I
1800 DIM R{knare(1:Max)
1810 WHILE I