10 ! ARTST7.BAC
11 ! Ritprogram f|r ABC806 512*240 4 f{rger
12 ! Program av Magnus <8042> 1990-1991
13 ! HRLOAD,HRSAVE andv{nds i det h{r programet.
14 ! 
15 ! [ndrar man variabeln "Start" (rad 1620, 1910) till 120, s}
16 ! fungerar "LOAD"- och "SAVE"-rutinerna med 512 kB RAM internt
17 ! 
18 ! Programmet skulle kunna "st{das" en aning ("dublettfunktioner" - en i
19 ! INTEGER - en i FLOAT), och dessutom finns, enligt mina erfarenheter,
20 ! en och annan bugg...  <7759>
21 ! 
100 EXTEND : INTEGER 
110 ATTRIBUTE 0
120 FGCTL BLK : FGPICTURE 1.,1.,2. : FGPOINT 0.,0.,0. : FGFILL 511.,239.
130 FGPICTURE 0.,0.,2.
140 PRINT CHR$(12.)
150 ON ERROR GOTO 2620
160 GOSUB 2700
170 ! Artstudio    av Magnus 1990-91 in Tyres|
180 PRINT DBLE RED "          Artstudio v5.1"
190 PRINT : PRINT EL GRN "    Program av Magnus 1990 "
200 PRINT SPACE$(500.)
210 PRINT TAB(30.);"( a )  F|r att b|rja"
220 PRINT 
230 PRINT TAB(30.);"( m )  Hl{lp meny "
240 GOSUB 960
250 GET A$
260 IF A$="a" THEN 310
270 IF A$="b" THEN 290
280 GOTO 250
290 ! 
300 END 
310 INPUT "R{nsa bilden j/n ";A$
320 PRINT CHR$(12)
330 FGCTL E$+F$+G$+H$
340 IF A$<>"j" THEN 360
350 FGPOINT 0.,0.,0. : FGFILL 511.,239.
360 X.=200. : Y.=100. : A.=1.
370 ; CUR(0.,40.);"x ";X.;"  y ";Y.;"  F{rg:";A.; : IF B.=4. THEN GOTO 390
380 FGPOINT X.,Y.,A.
390 GET A$
400 IF A$="8" THEN Y.=Y.+1.
410 IF A$="2" THEN Y.=Y.-1.
420 IF A$="6" THEN X.=X.+1.
430 IF A$="4" THEN X.=X.-1.
440 IF A$="1" THEN X.=X.-1. : Y.=Y.-1.
450 IF A$="7" THEN Y.=Y.+1. : X.=X.-1.
460 IF A$="9" THEN Y.=Y.+1. : X.=X.+1.
470 IF A$="3" THEN Y.=Y.-1. : X.=X.+1.
480 IF A$="a" THEN A.=0. : B.=3.
490 IF A$="b" THEN A.=1. : B.=3.
500 IF A$="c" THEN A.=2. : B.=3.
510 IF A$="d" THEN A.=3. : B.=3.
520 IF A$="e" THEN B.=4.
530 IF A$="f" THEN 620
540 IF A$="g" THEN 670
550 IF A$="l" THEN 870
560 IF A$="h" THEN 900
570 IF A$="k" THEN 920
580 IF A$="s" THEN 1110
590 IF A$="z" THEN 1990
600 IF A$="m" THEN GOSUB 2430
610 GOTO 370
620 ; CHR$(12.)
630 ; "Med rutnet j/n" : INPUT A$
640 IF A$="n" THEN FGPAINT X.,Y.,A. : GOTO 390
650 Z.=FNPaint.(X.,Y.,A.)
660 GOTO 390
670 ! CIRKEL
680 FGCTL BLK+RED+GRN+BLU
690 PRINT CHR$(12.)
700 PRINT EL RED "       Cirkel"
710 PRINT : PRINT 
720 INPUT "storlek Ra'dius i punkter:";R.
730 INPUT "Y Procent 1%-100% ";].
740 INPUT "X Procent 1%-100% ";[.
750 INPUT "H|g eller l}g kvallite h/l ";Y$
760 IF Y$="h" THEN \.=200. : GOTO 780
770 IF Y$="l" THEN \.=36. ELSE 750
780 FGCTL E$+F$+G$+H$
790 F.=0. : E.=(2.*PI/\.)
800 FGPOINT X.+(2.*([./100.))*R.,Y.
810 WHILE F.<2.*PI
820   F.=F.+E.
830   FGLINE X.+(2.*([./100.))*(R.*COS(F.)),Y.+(1.2*(]./100.))*(R.*SIN(F.)),A.
840 WEND 
850 ; CHR$(12.)
860 GOTO 390
870 ! line 
880 X1.=X. : Y1.=Y.
890 GOTO 390
900 FGPOINT X.,Y.,A. : FGLINE X1.,Y1.,A.
910 GOTO 390
920 ! spr{ja
930 FOR ].=0. TO 20. : N.=INT(RND*12.)-6. : M.=INT(RND*20.)-10.
940 FGPOINT X.+M.,Y.+N. : NEXT ]. 
950 GOTO 390
960 ; : ; "F{rger : blk,";RED;"red,";GRN;"grn,";YEL;"yel,";
970 ; BLU;"blu,";MAG;"mag,";CYA;"cya,";WHT;"wht"
980 INPUT "bakrunds F{rg 0";E$
990 P$=E$ : GOSUB 1280
1000 E$=O$
1010 INPUT "F{rg 1 ";F$
1020 P$=F$ : GOSUB 1280
1030 F$=O$
1040 INPUT "F{rg 2 ";G$
1050 P$=G$ : GOSUB 1280
1060 G$=O$
1070 INPUT "F{rg 3 ";H$
1080 P$=H$ : GOSUB 1280
1090 H$=O$
1100 RETURN 
1110 ! spara ladd pic
1120 FGCTL BLK+RED+BLU+GRN
1130 PRINT CHR$(12)
1140 PRINT TAB(20);"****** SAVE LOAD MENY ********"
1150 PRINT TAB(20);"*    Tryck a f|r artstudio   *"
1160 PRINT TAB(20);"*    Tryck s f|r save pic    *"
1170 PRINT TAB(20);"*    Tryck l f|r load pic    *"
1180 PRINT TAB(20);"******************************"
1190 GET A$
1200 IF A$="a" THEN 1240
1210 IF A$="s" THEN 1450
1220 IF A$="l" THEN 1710
1230 GOTO 1190
1240 FGCTL E$+F$+G$+H$
1250 ; CHR$(12.)
1260 GOTO 370
1270 END 
1280 IF P$="gblk" THEN O$=GBLK
1290 IF P$="blk" THEN O$=BLK
1300 IF P$="gred" THEN O$=GRED
1310 IF P$="red" THEN O$=RED
1320 IF P$="ggrn" THEN O$=GGRN
1330 IF P$="grn" THEN O$=GRN
1340 IF P$="gyel" THEN O$=GYEL
1350 IF P$="yel" THEN O$=YEL
1360 IF P$="gblu" THEN O$=GBLU
1370 IF P$="blu" THEN O$=BLU
1380 IF P$="gmag" THEN O$=GMAG
1390 IF P$="mag" THEN O$=MAG
1400 IF P$="gcya" THEN O$=GCYA
1410 IF P$="cya" THEN O$=CYA
1420 IF P$="gwht" THEN O$=GWHT
1430 IF P$="wht" THEN O$=WHT
1440 RETURN 
1450 ! Sparar HRminne p} disk
1460 INTEGER : EXTEND 
1470 POKE 64256,243,213,197,245,229,123,6,192,203,255,14,52,237,121,225,241
1480 POKE 64272,193,209,251,201,0,0,0,0,243,213,197,245,229,123,6,192
1490 POKE 64288,203,191,14,52,237,121,225,241,193,209,251,201
1500 DEF FNInblk.(Addr.)
1510   Z=CALL(64256,Addr.)
1520   RETURN True.
1530 FNEND 
1540 DEF FNUtblk.(Addr.)
1550   Z=CALL(64280,Addr)
1560   RETURN True
1570 FNEND 
1580 DIM Graf$=0
1590 POKE VAROOT(Graf$),4096,SWAP%(4096),49152,SWAP%(49152),4096,SWAP%(4096)
1600 INPUT "SAVE PIC namn:";A$
1610 PREPARE A$+".pic" AS FILE 1
1620 Start=24
1630 FOR X=Start+7 TO Start STEP -1
1640   Z=FNInblk(X)
1650   PUT #1,Graf$
1660   Z=FNUtblk(X)
1670 NEXT X 
1680 CLOSE 1
1690 GOTO 310
1700 ! 
1710 ! Laddar HRminne fr}n fil p} diskett
1720 FOR ].=0. TO 10. : FGPOINT ].,0.,2. : FGLINE ].,239. : NEXT ]. 
1730 INTEGER : EXTEND 
1740 POKE 64256,243,213,197,245,229,123,6,192,203,255,14,52,237,121,225,241
1750 POKE 64272,193,209,251,201,0,0,0,0,243,213,197,245,229,123,6,192
1760 POKE 64288,203,191,14,52,237,121,225,241,193,209,251,201
1770 DEF FNInblk(Addr)
1780   Z=CALL(64256,Addr)
1790   RETURN True
1800 FNEND 
1810 DEF FNUtblk(Addr)
1820   Z=CALL(64280,Addr)
1830   RETURN True
1840 FNEND 
1850 DIM Graf$=0
1860 POKE VAROOT(Graf$),4096,SWAP%(4096),49152,SWAP%(49152),4096,SWAP%(4096)
1870 INPUT "LOAD PIC namn:";A$
1880 FGPICTURE 0,0,4
1890 FGCTL E$+F$+G$+H$
1900 OPEN A$+".pic" AS FILE 1
1910 Start=24
1920 FOR X=Start+7 TO Start STEP -1
1930   Z=FNInblk(X)
1940   GET #1,Graf$ COUNT 4096
1950   Z=FNUtblk(X)
1960 NEXT X 
1970 CLOSE 1
1980 GOTO 1240
1990 [.=0.
2000 FGPICTURE 0.,1.,2.
2010 ATTRIBUTE 1.
2020 GOTO 2230
2030 PRINT CUR(0.,0.);"\vere v{stra h|rnet."
2040 INPUT "y x";Y.,X.
2050 ; CHR$(12.)
2060 ; TAB(20.);"***********Zoom***************"
2070 ; TAB(20.);"* (Space) s{tter en punkt    *"
2080 ; TAB(20.);"* (`) suddar en punkt        *"
2090 ; TAB(20.);"* (e) Exit }terg}r           *"
2100 ; TAB(20.);"******************************"
2110 GET A$
2120 ; CHR$(12.)
2130 FOR A.=Y. TO Y.-21. STEP -1.
2140   FOR B.=X. TO X.+79.
2150     C.=FGPOINT(B.,A.)
2160     GOSUB 2210
2170     ; CHR$(F.);CHR$(127.);
2180 NEXT B. : NEXT A. 
2190 GOTO 2250
2200 GOTO 2210
2210 F.=144.+C.
2220 RETURN 
2230 FGCTL BLK+RED+GRN+YEL
2240 GOTO 2040
2250 A.=1. : B.=1. : C.=1.
2260 X.=X.+1.
2270 F.=144.+C.
2280 IF SYS(5.)<>0. THEN GOSUB 2310
2290 IF [.=1. THEN ; CHR$(12.) : FGPICTURE 0.,0.,1. : GOTO 390
2300 GOTO 2270
2310 GET A$
2320 IF A$="4" THEN X.=X.-1. : B.=B.-1.
2330 IF A$="6" THEN X.=X.+1. : B.=B.+1.
2340 IF A$="8" THEN Y.=Y.+1. : A.=A.-1.
2350 IF A$="2" THEN Y.=Y.-1. : A.=A.+1.
2360 IF A$=" " THEN FGPOINT X.,Y.,C. : ; CUR(A.,B.);CHR$(F.);CHR$(127.)
2370 IF A$="`" THEN FGPOINT X.,Y.,0. : ; CUR(A.,B.);CHR$(144.);CHR$(127.)
2380 IF A$="a" THEN C.=1.
2390 IF A$="b" THEN C.=2.
2400 IF A$="c" THEN C.=3.
2410 IF A$="e" THEN [.=1.
2420 RETURN 
2430 ; CHR$(12.)
2440 ; TAB(20.);"******************";RED;"Hj{lp meny";WHT;"********************"
2450 ; TAB(20.);"*  (a) F{rg val 0                              *"
2460 ; TAB(20.);"*  (b) F{rg val 1                              *"
2470 ; TAB(20.);"*  (c) F{rg val 2                              *"
2480 ; TAB(20.);"*  (d) F{rg val 3                              *"
2490 ; TAB(20.);"*  (e) Ingen f{rg alls suddar ej.              *"
2500 ; TAB(20.);"*  (f) Fyller en sluten yta                    *"
2510 ; TAB(20.);"*  (g) Ritar en cirkel                         *"
2520 ; TAB(20.);"*  (l) Defenerar punkt 1 i en line             *"
2530 ; TAB(20.);"*  (h) Ritar en line fr}n 1 till ponkt 2       *"
2540 ; TAB(20.);"*  (k) Spr{j                                   *"
2550 ; TAB(20.);"*  (s) Hoppar till save/load meny.             *"
2560 ; TAB(20.);"*  (z) Zoomar in en bit av bilden              *"
2570 ; TAB(20.);"*  (m) Hj{lp menyn                             *"
2580 ; TAB(20.);"************************************************"
2590 GET A$
2600 ; CHR$(12.)
2610 RETURN 
2620 ! ---------------- on error ------------------
2630 IF ERRCODE=21. THEN ; "Hittar ej Filen" : GET A$ : GOTO 1110
2640 IF ERRCODE=41. THEN ; "Disketten full" : GET A$ : GOTO 1110
2650 IF ERRCODE=42. THEN ; "Enheten ej klar" : GET A$ : GOTO 1110
2660 IF ERRCODE=43. THEN ; "Skivan skrivskyddad" : GET A$ : GOTO 1110
2670 ; "ERROR code=";ERRCODE
2680 GOTO 370
2690 ! ------------------ Paint ---------------------
2700 DEF FNPaint.(X.,Y.,F{.) LOCAL A.,E.,Nx.,F.
2710   GOSUB 3010
2720   GOSUB 3050
2730   A.=Y./2. : E.=INT(Y./2.) : IF A.=E. THEN 2740 ELSE 2830
2740   ! y j{mn
2750   A.=X./2. : E.=INT(X./2.) : IF A.<>E. THEN X.=X.+1. : GOTO 2750
2760   IF FGPOINT(X.,Y.)<>0. THEN 3090
2770   FGPOINT X.,Y.,F{. : IF FGPOINT(X.,Y.+1.)=0. THEN Nx.=X.-1. : GOTO 2800
2780   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 3090
2790   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 3090 ELSE 2770
2800   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 2920
2810   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 2920
2820   FGPOINT X.,Y.,F{. : GOTO 2800
2830   ! y oj{mn
2840   A.=X./2. : E.=INT(X./2.) : IF A.<>E. THEN 2850 ELSE X.=X.+1. : GOTO 2840
2850   IF FGPOINT(X.,Y.)<>0. THEN 3090
2860   FGPOINT X.,Y.,F{. : IF FGPOINT(X.,Y.+1.)=0. THEN Nx.=X.-1. : GOTO 2890
2870   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 3090
2880   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 3090 ELSE 2860
2890   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 2920
2900   X.=X.+1. : IF FGPOINT(X.,Y.)<>0. THEN 2920
2910   FGPOINT X.,Y.,F{. : GOTO 2890
2920   Y.=Y.+1. : X.=Nx.
2930   IF Nx.=0. THEN 2960 ELSE 2940
2940   IF FGPOINT(Nx.+2.,Y.)<>0. THEN 3090 ELSE 2720
2950   IF FGPOINT(Nx.,Y.)=Then. 2720 ELSE 2940
2960   WHILE F.<>0.
2970     X.=X.-1.
2980     F.=FGPOINT(X.,Y.)
2990   WEND 
3000   X.=X.+1. : GOTO 2720
3010   IF FGPOINT(X.,Y.)<>0. THEN 3090
3020   Y.=Y.-1.
3030   F.=FGPOINT(X.,Y.)
3040   IF F.<>0. THEN Y.=Y.+1. : RETURN ELSE 3020
3050   X.=X.+1.
3060   X.=X.-1.
3070   F.=FGPOINT(X.,Y.)
3080   IF F.<>0. THEN X.=X.+1. : RETURN ELSE 3060
3090   RETURN 0.
3100 FNEND 
3110 RETURN