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="`" THEN RETURN CHR$(ASCII(S$)-32) ELSE RETURN S$ 2340 FNEND