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<Max
1820     I=I+1
1830     R{knare(I)=0
1840   WEND 
1850   RETURN 0
1860 FNEND 
1870 ! 
1880 DEF FNSintab(Delar,L{ngd) LOCAL I,Vsteg.
1890   DIM Sintab.(0:Delar),Costab.(0:Delar)
1900   Vsteg.=PI/(Delar/2.)
1910   WHILE I<=Delar
1920     Sintab.(I)=SIN(Vsteg.*I)*L{ngd
1930     Costab.(I)=COS(Vsteg.*I)*L{ngd
1940     I=I+1
1950   WEND 
1960   RETURN 0
1970 FNEND 
1980 ! 
1990 DEF FNInitgr
2000   IF Abc=800 THEN Xmax=239 : Ymax=239 : Maxf{rg=3 : FGCTL 30
2010   IF Abc=806 THEN Xmax=511 : Ymax=239 : Maxf{rg=3
2020   IF Abc=806 THEN FGCTL BLK+GYEL+GCYA+GMAG ! Ta bort denna rad p} ABC1600
2030   IF Abc=1600 THEN Xmax=767 : Ymax=1023 : Maxf{rg=1 : FGCTL 1
2040   IF Abc=1601 THEN Xmax=1023 : Ymax=767 : Maxf{rg=1 : FGCTL 1
2050   RETURN FNGcls
2060 FNEND 
2070 ! 
2080 DEF FNGcls
2090   FGPOINT 0,0,0 : FGFILL Xmax,Ymax,0
2100   ; Cls$;
2110   RETURN 0
2120 FNEND 
2130 ! 
2140 DEF FNAbc
2150   ON ERROR GOTO 2170 : Z=PEEK(39)
2160   IF Z=4 THEN RETURN 806 ELSE IF Z=3 THEN RETURN 802 ELSE RETURN 800
2170   RETURN 1600 ! eller 1601 f|r liggande sk{rm
2180 FNEND 
2190 ! 
2200 DEF FNSvar(Alt$) LOCAL I$=160,P
2210   WHILE 1
2220     ON ERROR GOTO 2270 : INPUT LINE I$
2230     P=LEN(I$)-2 : ; STRING$(P,8) SPACE$(P) STRING$(P,8);
2240     I$=FNCaps$(LEFT$(I$,1))
2250     IF ASCII(I$)=13 OR ASCII(I$)=10 THEN P=1 ELSE P=INSTR(1,Alt$,I$)
2260     IF P THEN ; MID$(Alt$,P,1) : RETURN P ELSE 2280
2270     IF ERRCODE=53 THEN P=SYS(6) : GET I$ : GOTO 2250
2280     ; CHR$(7);
2290   WEND 
2300 FNEND 
2310 ! 
2320 DEF FNCaps$(S$)
2330   IF S$>="`" THEN RETURN CHR$(ASCII(S$)-32) ELSE RETURN S$
2340 FNEND