10 'by A.Stroiczek
20 MODE 2:DEFINT a-z
30 INK 0,26:INK 1,0:BORDER 23
40 IF PEEK(&BB01)=&5C THEN dadr=&B075 ELSE dadr=&B091
50 POKE dadr,0:MEMORY &8CFF:LOAD"HC.BIN",&8D00:CALL &8D00
60 POKE dadr,4:POKE dadr+1,&3D:POKE dadr+2,&93:MEMORY &45FE
70 DIM fk(78,19),m1(11),n1(11),m2(11),n2(11)
80 FOR i=1 TO 9:READ a:k$=k$+CHR$(a):NEXT
90 DATA 120,11,10,13,240,241,103,54,53
100 Init=&4600:Linie=&4603:Box=&4606
110 Pointer=&4609:xdehn=&460C:ydehn=&460F
120 Winopen=&4612:Winclose=&4615:Invbalk=&4618
130 Kursiv=&461B:Schrift=&461E:SchriftLen=&4621
140 TeilClear=&4624:Catalog=&4627:Copy=&462A
150 Zoomviereck=&462D:Mbox=&4630:Gracop=&4633
160 Grahol=&4636:Swap180=&4639:Cgra=&463C
170 einst=&4645:loa=&4648:sav=&464B
180 Cur=&463F:GK=&4642:temp=&4600:buff=&72BF
190 mark(0)=&5493:mark(1)=&553F:mark(3)=&55C2
200 Frme=&BD19
210 LOAD"G.BIN",&4600:CALL Init
220 a$(0)="Text":a$(1)="Grafik":a$(2)="Datei":a$(3)="Drucker"
230 d$(0)=">> LADEN <<":d$(2)=d$(0):d$(4)=">> CATALOG <<"
240 n$=SPACE$(12)
250 p(0)=354:p(1)=418:p(2)=499:p(3)=570
260 b(0)=42:b(1)=50:b(2)=60:b(3)=69
270 le(0)=8:le(1)=10:le(2)=9:le(3)=11
280 wp(0)=29:wp(1)=50:wp(2)=60:wp(3)=61
290 bl(0)=18:bl(1)=21:bl(2)=20:bl(3)=19
300 bp(0)=42:bp(1)=50:bp(2)=60:bp(3)=61
310 anz(0)=17:anz(1)=15:anz(2)=5:anz(3)=4
320 dy(1)=16:dy(2)=-16:dy2(1)=-1:dy2(2)=1
330 h(0)=8:h(1)=8:h(2)=8:h(3)=10:h(4)=11
340 j(3)=2:j(4)=4:g(0)=1:g(1)=2:g(2)=4
350 a=90:b=350:c=a+10:d=b-8:e=0:f=0
360 FOR i=0 TO 10:m1(i)=a:n1(i)=b:m2(i)=c:n2(i)=d
370 a=a+10:c=c+10+e:b=b-5:d=d-5-f:e=e+4:f=f+2:NEXT
380 m1(i)=a:n1(i)=b:m2(i)=a+239:n2(i)=b-126
390 x=340:y=370:t=0:k=0
400 CALL Gracop,t,t,t,t
410 cpx=61:cpy=370
420 x1=0:y1=0:x2=0:y2=0
430 bd=0:rout=0:routine=0
440 swp=0:ov=1:mnr=0
450 um=0:art=0:ku=0:th=0:tb=0:yx=78
460 mp(0)=58:mp(1)=69:mp(2)=78:mp(3)=78
470 z1=0:z2=1:txt$=""
480 WINDOW#1,44,79,15,19
490 FOR i=1 TO 5:READ a,b,c,d
500 FOR j=a TO b:FOR k=c TO d
510 fk(j,k)=i:NEXT:NEXT:NEXT
520 DATA 42,49,19,19,50,59,19,19,60,68,19,19,69,78,19,19,43,78,0,6
530 GOSUB 810
540 '
550 'Hauptschleife
560 CALL Cur,x,y,t,t
570 GOSUB 3180:GOSUB 3360
580 a=fk(x 8,y 16-5)
590 IF a=0 THEN 570
600 CALL Cur,x,y,t,t
610 IF a=5 THEN 1230
620 '
630 'Menue
640 w=a-1:b=anz(w):c=bp(w):d=bl(w)
650 my=0:ay=0:mgy=390:amy=0
660 GOSUB 910
670 GOSUB 3160
680 a$=LOWER$(INKEY$):IF a$=""THEN 680
690 a=(INSTR(k$,a$)-1)MOD 3
700 IF a<0 THEN 680
710 IF a=0 THEN 770
720 ay=my:my=MIN(my+dy2(a),b):my=MAX(my,0):IF ay=my THEN 680
730 amy=mgy:mgy=mgy+dy(a)
740 IF ay THEN CALL Invbalk,c,amy,d
750 IF my THEN CALL Invbalk,c,mgy,d
760 GOTO 680
770 y=mgy:IF my THEN ON w+1 GOTO 1480,1510,1540,1580
780 GOSUB 940:GOTO 560
790 '
800 'Bildaufbau
810 FOR i=0 TO 3:t$=a$(i):CALL Schrift,p(i),398,t$,0:NEXT
820 t$=">>> Texteingabe <<<":CALL Schrift,426,206,t$,0
830 bd=1:GOSUB 3390
840 PLOT 0,80:DRAW 639,80
850 PLOT 639,382:DRAW 336,382:DRAW 336,80
860 PLOT 336,190:DRAW 639,190
870 PLOT 336,210:DRAW 639,210
880 RETURN
890 '
900 'W.oeffnen
910 CALL InvBalk,b(w),398,le(w):CALL Winopen,wp(w),382,w:GOTO 3180
920 '
930 'W.schliessen
940 CALL InvBalk,b(w),398,le(w):CALL Winclose
950 GOSUB 3180:IF w OR txt$=""THEN RETURN
960 CALL TeilClear,0,yx,80,33
970 ON art+1 GOSUB 1020,1030,1050,1060,1100
980 IF th THEN GOSUB 1150
990 IF tb THEN GOSUB 1160
1000 IF ku THEN GOSUB 1130
1010 RETURN
1020 i=0:b=0:GOTO 1170
1030 FOR i=0 TO 1:b=i+1:GOSUB 1170:NEXT:RETURN
1040 FOR i=0 TO 1:GOSUB 1170:NEXT:RETURN
1050 b=1:GOTO 1040
1060 b=1:c=0:d=2
1070 FOR a=yx TO yx-4 STEP-2
1080 GOSUB 1200:NEXT
1090 b=3:i=1:a=yx-2:GOTO 1180
1100 c=0:d=2:a=yx:b=1:GOSUB 1200
1110 d=4:GOSUB 1190:GOSUB 1190
1120 c=2:GOSUB 1190:GOTO 1090
1130 CALL TeilClear,75,yx,5,33
1140 CALL Kursiv,0,yx,75,(th+1)*h(art),ku-1:RETURN
1150 CALL ydehn,0,yx,80,11,th-1:RETURN
1160 b=tb-1:CALL xdehn,0,yx,40-20*b,33,b:RETURN
1170 a=yx
1180 CALL Schrift,i,a,txt$,b:RETURN
1190 a=a-2
1200 FOR i=c TO d:GOSUB 1180:NEXT:RETURN
1210 '
1220 'Texteingabe
1230 t$="":WINDOW SWAP 1,0
1240 GOSUB 3160:GOSUB 3180
1250 IF z2=5 THEN LOCATE 1,6:PRINT
1260 LOCATE z1+1,z2:PRINT CHR$(143);
1270 a$=INKEY$:IF a$=""THEN 1270
1280 IF a$=CHR$(13)THEN 1410
1290 a=ASC(a$):IF a>127 OR a<32 THEN 1270
1300 a=LEN(t$)
1310 IF a$=CHR$(127)THEN 1380
1320 IF a>70 THEN 1270
1330 IF z1>35 THEN PRINT:z2=MIN(z2+1,5):z1=0
1340 t$=t$+a$:z1=z1+1
1350 LOCATE z1,z2:PRINT a$;
1360 IF z1>35 AND z2=5 THEN PRINT:z1=0
1370 GOTO 1260
1380 IF a=0 THEN 1270 ELSE IF z1=0 THEN z1=36:z2=z2-1
1390 LOCATE z1,z2:PRINT"  ";
1400 z1=z1-1:t$=LEFT$(t$,a-1):GOTO 1260
1410 LOCATE z1+1,z2:PRINT" ";
1420 z2=MIN(z2+1,5):z1=0
1430 WINDOW SWAP 1,0
1440 IF t$<>""THEN txt$="":txt$=t$:GOSUB 960
1450 GOTO 560
1460 '
1470 'W0
1480 ON my GOTO 2150,1960,1960,1970,1970,1970,1970,1970,1980,1980,1980,1990,1990,1990,2000,2000,2000
1490 '
1500 'W1
1510 ON my GOTO 3130,2700,2760,2820,2820,2840,2840,2220,2440,2480,2870,2610,2560,2520,3100
1520 '
1530 'W2
1540 GOSUB 3240
1550 ON my GOTO 1610,1710,1750,1890,1930
1560 '
1570 'W3
1580 ON my GOTO 2030,2030,2030,2040
1590 '
1600 'Button l.
1610 a$="Button ":GOSUB 1650
1620 a=0:IF ASC(n$)AND a$="J"THEN CALL loa,a,buff,6678,n$ELSE 560
1630 IF a=1 THEN 560
1640 bd=0:GOSUB 3390:GOTO 560
1650 GOSUB 3490:IF ASC(n$)THEN t$=a$+n$+" laden (j/n)?":GOSUB 3550 ELSE RETURN
1660 a$=UPPER$(INKEY$):IF a$="J"OR a$="N"THEN 3470 ELSE 1660
1670 '
1680 'Button s.
1690 t$="Bitte den Filenamen eingeben:"
1700 GOSUB 3550:GOSUB 3580:GOTO 3470
1710 GOSUB 1690:IF LEFT$(t$,1)<>" "THEN CALL sav,buff,6678,0,t$
1720 GOTO 560
1730 '
1740 'Bild l.
1750 a$="Bild ":GOSUB 1650
1760 a=0:IF ASC(n$)AND a$="J"THEN CALL loa,a,&C000,&4000,n$ELSE 560
1770 IF a=1 THEN 560
1780 e=x:f=y:x=320:y=200
1790 rout=0:GOSUB 3790:x2=x:y2=y:rout=1:GOSUB 3790:x1=x:y1=y
1800 IF x2<x1 THEN x1=x2:x2=x
1810 IF y2>y1 THEN y1=y2:y2=y
1820 IF(x2-x1)>335 THEN x2=x1+335
1830 IF(y1-y2)>316 THEN y2=y1-316
1840 x=e:y=f
1850 GOSUB 2710:CLS:bd=0:GOSUB 3390
1860 bd=0:GOSUB 3390:GOTO 2090
1870 '
1880 'Bild s.
1890 GOSUB 1690:IF LEFT$(t$,1)<>" "THEN CALL sav,&C000,&4000,0,t$
1900 GOTO 560
1910 '
1920 'Cat
1930 GOSUB 3490:GOTO 560
1940 '
1950 'W0-Marker
1960 um=my-2:mnr=0:GOTO 3710
1970 art=my-4:mnr=1:GOTO 3710
1980 ku=my-9:mnr=2:GOTO 3710
1990 th=my-12:mnr=3:GOTO 3710
2000 tb=my-15:mnr=4:GOTO 3710
2010 '
2020 'W3-'Drucker'
2030 qual=my-1:mnr=0:GOTO 3710
2040 GOSUB 3240:t$="Bitte X-Position angeben (0-51):":GOSUB 3550
2050 a=m1(11) 8+4:b=29-n1(11) 16
2060 LOCATE a,b:INPUT c:c=MAX(0,c):c=MIN(51,c)
2070 CLS:bd=0:GOSUB 3390
2080 HLOCATE,c:HARDCOPY,qual
2090 GOSUB 810:IF txt$=""THEN 560
2100 LOCATE#1,1,1:PRINT#1,txt$
2110 z2=2+LEN(txt$) 36:GOSUB 960
2120 GOTO 560
2130 '
2140 'Text einfuegen
2150 IF txt$=""THEN 680
2160 GOSUB 3240:b=h(art)*(th+1):x1=0:y1=yx:y2=yx-2*b+2
2170 CALL SchriftLen,a,txt$:x2=MIN(335,(a+j(art))*g(tb)+ku*b 2)
2180 GOSUB 2710:IF(swp XOR um)THEN CALL swap180
2190 c=0:GOTO 2770
2200 '
2210 'Punkte
2220 GOSUB 3240:CALL Cur,x,y,t,t
2230 CALL Pointer,temp,201,x,y,x,y,t,t
2240 a=fk(x 8,y 16-5):IF a THEN 600
2250 GOSUB 3180:GOTO 2230
2260 '
2270 'x1/y1-x2/y2
2280 rout=Box
2290 GOSUB 3240:CALL Cur,x,y,t,t
2300 GOSUB 3360
2310 a=fk(x 8,y 16-5):IF a THEN 600
2320 IF x>335 THEN 2400
2330 GOSUB 3210
2340 GOSUB 3310
2350 a=fk(x 8,y 16-5):IF a THEN 600
2360 IF x>335 THEN 2400
2370 CALL Cur,x,y,t,t
2380 ON routine GOSUB 2450,2490,2530,2570,2710
2390 CALL Cur,x,y,t,t
2400 GOSUB 3180
2410 GOTO 2300
2420 '
2430 'Box
2440 routine=1:GOTO 2280
2450 PLOT x1,y1:DRAW x2,y1:DRAW x2,y2:DRAW x1,y2:DRAW x1,y1:RETURN
2460 '
2470 'Line
2480 routine=2:rout=Linie:GOTO 2290
2490 PLOT x1,y1:DRAW x2,y2:RETURN
2500 '
2510 'Ausschnitt loeschen
2520 routine=3:GOTO 2280
2530 CALL Cgra,x1,y1,x2,y2:RETURN
2540 '
2550 'Ausschnitt invertieren
2560 routine=4:GOTO 2280
2570 IF y1=y2 THEN CALL Linie,x1,y1,x2,y1:RETURN
2580 FOR i=y1 TO y2 STEP SGN(y2-y1)*2:CALL Linie,x1,i,x2,i:NEXT:RETURN
2590 '
2600 'Radierg.
2610 GOSUB 3240
2620 CALL einst,624,96,15,14
2630 CALL Pointer,Mbox,18,x,y,x,y,t,t
2640 GOSUB 850:CALL Mbox,x,y,t,t
2650 GOSUB 3180:CALL Mbox,x,y,t,t
2660 a=fk(x 8,y 16-5):IF a THEN 610
2670 GOTO 2630
2680 '
2690 'Kopieren
2700 routine=5:GOTO 2280
2710 CALL Gracop,x1,y1,x2,y2:xa=x1:ya=y1:xb=x2:yb=y2
2720 IF swp THEN CALL Swap180
2730 FOR i=1 TO 8:CALL Box,x1,y1,x2,y2:CALL Frme:CALL Frme:NEXT:RETURN
2740 '
2750 'Einsetzen
2760 GOSUB 3240:c=ov
2770 a=ABS(xa-xb):b=ABS(ya-yb):CALL einst,335-a,82+b,a,b
2780 CALL Pointer,Mbox,6,x,y,x,y,t,t
2790 IF c THEN CALL Cgra,x,y,x+a,y-b
2800 CALL Grahol,x,y
2810 GOSUB 3180:GOTO 560
2820 swp=my-4:IF PEEK(mark(w))=my-1 THEN 680
2830 CALL swap180:mnr=0:GOTO 3710
2840 ov=(my-6)XOR 1:mnr=1:GOTO 3710
2850 '
2860 'Zoom
2870 GOSUB 3240:t=1
2880 CALL winopen,50,376,4
2890 PRINT CHR$(23)CHR$(1);
2900 CALL Cur,x,y,t,t
2910 CALL einst,639,0,0,0:CALL Pointer,temp,225,x,y,x,y,t,t
2920 IF PEEK(&AEFF)THEN c=0:d=0
2930 IF x<336 THEN 2960
2940 e=x 8:f=(y-4) 16:IF e>50 AND e<75 AND f<23 AND f>6 THEN 3030 ELSE IF e>49 AND e<76 AND f<24 AND f>5 THEN 2950 ELSE a=fk(x 8,y 16-5):IF a THEN 3070
2950 GOTO 2910
2960 CALL einst,312,112,23,30
2970 GOSUB 3210:IF t THEN 3000
2980 FOR i=1 TO 30:CALL GK,k:IF(k AND 16)THEN x=x1:y=y1
2990 NEXT
3000 CALL Pointer,Zoomviereck,6,x,y,x,y,t,t:t=0
3010 CALL zoomviereck,x,y,t,t:CALL zoomviereck,x,y,t,t
3020 x1=x:y1=y:GOSUB 3210:GOTO 2910
3030 IF t OR(c=e AND d=f)THEN 2910
3040 j=TEST(x1+e-51,y1-2*(22-f)):IF c=0 AND d=0 THEN b=j XOR 1
3050 IF b<>j THEN PLOTR 0,0:CALL InvBalk,e,f*16+16,1
3060 c=e:d=f:GOTO 2910
3070 CALL Cur,x,y,t,t:CALL Winclose:PRINT CHR$(23)CHR$(0);:GOTO 610
3080 '
3090 'Arbeitsflaeche loeschen
3100 GOSUB 3240:CALL TeilClear,0,398,42,159:GOTO 560
3110 '
3120 'UnDo
3130 bd=0:GOSUB 3390:GOTO 680
3140 '
3150 'ClearInput
3160 WHILE INKEY$<>"":WEND:RETURN
3170 '
3180 CALL GK,k:IF k AND 16 THEN 3180
3190 RETURN
3200 '
3210 GOSUB 3180
3220 CALL Cur,x,y,t,t:RETURN
3230 '
3240 FOR i=1 TO 4
3250 FOR j=1 TO 2
3260 CALL Invbalk,c,mgy,d:CALL Frme:CALL Frme
3270 NEXT j,i
3280 GOSUB 940
3290 bd=1:GOTO 3390
3300 '
3310 x1=x:y1=y:x2=x:y2=y
3320 CALL Pointer,rout,135,x,y,x1,y1,x2,y2
3330 x1=x:y1=y
3340 RETURN
3350 '
3360 CALL einst,639,0,0,0:CALL Pointer,temp,193,x,y,x,y,t,t
3370 RETURN
3380 '
3390 CALL Copy,0,398,42,159,bd
3400 RETURN
3410 '
3420 a=10
3430 FOR i=0 TO a:CALL Box,m1(i),n1(i),m2(i),n2(i):NEXT:RETURN
3440 a=11:GOSUB 3430:GOSUB 3420:CALL Winopen,m1(11) 8,n1(11),5:RETURN
3450 a=10
3460 FOR i=a TO 0 STEP-1:CALL Box,m1(i),n1(i),m2(i),n2(i):NEXT:RETURN
3470 CALL Winclose:GOSUB 3450:a=11:GOTO 3460
3480 '
3490 t$=d$(my-1):CALL SchriftLen,a,t$
3500 CALL Winopen,cpx,cpy,6
3510 CALL Schrift,cpx*8+(108-a) 2,cpy-8,t$,1
3520 t$="--------------":CALL Schrift,cpx*8+3,cpy-24,t$,1
3530 CALL Catalog,n$:CALL Winclose:GOTO 3180
3540 '
3550 GOSUB 3440:CALL SchriftLen,a,t$:a=(m2(11)-m1(11)-a) 2+m1(11):b=n1(11)-24
3560 CALL Schrift,a,b,t$,1:RETURN
3570 '
3580 a=m1(11) 8+4:b=29-n1(11) 16
3590 t$="":LOCATE a,b:PRINT"...........":GOSUB 3180
3600 WHILE INKEY$<>"":WEND
3610 FOR i=1 TO 11
3620 a$=UPPER$(INKEY$):IF a$=""THEN 3620 ELSE c=ASC(a$)
3630 IF c=127 THEN i=MAX(i-2,0):t$=LEFT$(t$,MAX(LEN(t$)-1,0)):GOTO 3670
3640 IF c=13 THEN i=11:GOTO 3670
3650 IF(c>64 AND c<91)OR(c>47 AND c<58)THEN 3660 ELSE 3620
3660 t$=t$+a$
3670 LOCATE a,b:PRINT t$+STRING$(11-LEN(t$),46)
3680 NEXT:t$=t$+STRING$(11-LEN(t$),32):t$=LEFT$(t$,8)+"."+RIGHT$(t$,3):RETURN
3690 '
3700 'Marker
3710 a=PEEK(mark(w)+mnr)+1:IF a=my THEN 3760 ELSE POKE mark(w)+mnr,my-1
3720 i=mp(w):a=(my-a)*16+mgy
3730 CALL TeilClear,i,a,1,8
3740 MOVE i*8,mgy
3750 PRINT CHR$(23)CHR$(1)CHR$(5)CHR$(6)CHR$(23)CHR$(0);
3760 GOSUB 3180:GOTO 680
3770 '
3780 'CrossCur
3790 c=x:d=y:GOSUB 3910
3800 a=8:b=8
3810 CALL GK,k:IF(k AND 31)=0 THEN 3800
3820 IF k AND 1 THEN y=MIN(y+b 4,398)
3830 IF k AND 2 THEN y=MAX(y-b 4,0)
3840 IF k AND 4 THEN x=MAX(x-a 8,0)
3850 IF k AND 8 THEN x=MIN(x+a 8,639)
3860 GOSUB 3910
3870 IF k AND 16 THEN 3180
3880 c=x:d=y:GOSUB 3910
3890 a=MIN(a+2,64):b=MIN(b+2,32)
3900 IF k AND 32 THEN CALL GK,k:IF(k AND 31)THEN 3900 ELSE 3800 ELSE 3810
3910 IF rout THEN CALL Box,c,d,x2,y2 ELSE CALL Linie,0,d,639,d:CALL Linie,c,0,c,398
3920 RETURN
