10 REM>!Turtle
20 REM Version 2.1
30 REM 7.3.1991
40 REM Modified version of A&B Computing (date ?) LINE 100
50 REM by J.T.Sutton, M.Charlton & C.Williams
55 
60 MODE 15
70 OSCLI ("SCREENLOAD "+"<turtle$dir>.pic")
72 BG$=INKEY$(300):BG=128
90 MODE 12
100 VDU 23,123,0,0,31,63,127,255,96,192
110 VDU 23,125,0,28,156,240,240,224,192,96
230 CLOSE#0
240 PROCinit
250 *FX21,0
260 ON ERROR GOTO 5460
270 PROCmode
275 PRINT"Do you wish to load a file of procedures?"
276 REPEAT:g$=GET$:UNTIL INSTR("YyNn",g$)<>0
280 IF g$="Y" OR g$="y" THEN PROCload
310 CLS
320 C$=FNinput:IF C$="" THEN 320
330 PROCchoose
340 GOTO 320
350 
360 DEFPROCsysex:LOCALx%,y%
370 ON C% GOSUB 392,410,440,480,510,540,570,650,1190,1440,650,710,750,780,840,810,890,970,940,1010,1040,1070,1510,1100,1130,1160,1250,1220,1280,1310,1540,1370,1340,600,1470,680
380 ENDPROC
390
391 REM OSCLI
392 OSCLI(P$)
393 RETURN
396  
400 REM CLEAR
410 S%=0:CLG:GOTO 450
420 
430 REM HOME CURSOR
440 PROCcursor
450 K%=K% AND 175:BE=0:X=0:Y=0:MOVE X,Y:PROCcursor:RETURN
460 
470 REM PEN UP
480 IF K% AND 2 THEN RETURN ELSE K%=K% AND 174:RETURN
490 
500 REM PEN DOWN
510 K%=K% OR 1:RETURN
520 
530 REM END FILL
540 K%=K% AND 175:RETURN
550 
560 REM FILL
570 IF K% AND 80 THEN RETURN ELSE K%=K% OR 81:FOR I=0 TO 7:fx(I)=X:fy(I)=Y:NEXT:RETURN
580 
590 REM DISPLAY
600 PROCcursor:F%=F% EOR 16:PROCcursor:x%=POS:y%=VPOS:VDU 28,0,31,SW%,0,30
610 IF F% AND 64 THEN VDU 28,0,31,SW%,28: ELSE VDU 28,0,31,SW%,26
620 VDU 31,x%,y%:RETURN
630 
640 REM CIRCLE
650 PROCcursor:GCOL0,CO:PROCcircle(P):MOVE X,Y:PROCcursor:RETURN
660 
670 REM QUIT
680 S%=0:PROCquit:RETURN
690 
700 REM COLOUR
710 CO=P:IF L%>0 THEN RETURN ELSE IF CO<0 OR CO>15 THEN 720 ELSE RETURN
720 PROCmsg(22,""):PROCmsg(23,""):CO=V%:RETURN
730 
740 REM CURSOR RIGHT
750 K%=K% AND 175:PROCcursor:X=X+P*XL%:MOVE X,Y:PROCcursor:RETURN
760 
770 REM CURSOR UP
780 K%=K% AND 175:PROCcursor:Y=Y+P*XL%:MOVE X,Y:PROCcursor:RETURN
790 
800 REM LEFT
810 P=-P
820 
830 REM RIGHT
840 PROCcursor:BE=BE+P:IF BE<0 THEN BE=360+(BE MOD 360)
850 IF BE>360 THEN BE=BE MOD 360
860 PROCcursor:RETURN
870 
880 REM BEARING
890 PROCcursor:BE=P:IF BE>360 THEN BE=BE MOD 360
900 IF BE<0 THEN BE=360+(BE MOD 360)
910 PROCcursor:RETURN
920 
930 REM BACKWARDS
940 P=-P
950 
960 REM FORWARDS
970 PROCcursor:X=X+FNx(P,BE):Y=Y+FNy(P,BE)
980 PROCplot:RETURN
990 
1000 REM NUMBER
1010 NM=P:NUMBER=P:RETURN
1020 
1030 REM TURN
1040 TR=P:TURN=P:RETURN
1050 
1060 REM SIZE
1070 SZ=P:SIZE=P:RETURN
1080 
1090 REM REPEAT
1100 PROCrepeat:RETURN
1110 
1120 REM DEFINE
1130 PROCdefine:RETURN
1140 
1150 REM EDIT
1160 S%=0:PROCedit:RETURN
1170 
1180 REM END REPEAT
1190 IF L%=0 THEN F%=F% AND 253:S%=0:RETURN ELSE RETURN
1200 
1210 REM DESCRIBE
1220 PROCdescribe:RETURN
1230 
1240 REM DELETE
1250 PROCdelete:RETURN
1260 
1270 REM HELP
1280 CLS:FOR J%=1 TO 36:PRINT MID$(COM$,J%*2-1,2);" - ";COM$(J%):G%=GET:NEXT:RETURN
1290 
1300 REM LIST
1310 CLS:FOR J%=1 TO D%:PRINT D$(J%,0);"  ";:NEXT:RETURN
1320 
1330 REM PALETTE
1340 PROCcolour:RETURN
1350 
1360 REM VALUES
1370 CLS:PRINT"NUMBER  (NM) = ";NM
1380 PRINT"SIZE    (SZ) = ";SZ
1390 PRINT"TURN    (TR) = ";TR
1400 PRINT
1410 PRINT"COLOUR  (CO) = ";CO;:RETURN
1420 
1430 REM END DEFINE
1440 IF L%=0 THEN S%=0:RETURN ELSE RETURN
1450 
1460 REM PRINT
1470 PROCdump
1480 RETURN
1490 
1500 REM WRITE
1510 PROCcursor:VDU 5:GCOL3,CO:PRINT P$:VDU 4:MOVE X,Y:PROCcursor:RETURN
1520 
1530 REM LOAD
1540 PROCload:RETURN
1550 
1560 DEFPROCdefex(C%)
1570 C%=C% AND 127:L%=L%+1
1580 W%?L%=C%:E%?L%=1
1590 PROCextract
1600 IF C%=24 THEN R%?L%=E%?L%:N%?L%=ABS(INT(P)):GOTO 1630
1610 IF C%=9 AND N%?L%>1 THEN E%?L%=R%?L%:N%?L%=N%?L%-1:GOTO 1630
1620 PROCchoose
1630 IF C%<>10 THEN 1590
1640 L%=L%-1
1650 ENDPROC
1660 
1670 DEFPROCchoose
1680 IF C% AND 128 THEN PROCdefex(C%) ELSE PROCsysex
1690 ENDPROC
1700 
1730 DEFPROCextract
1740 P%=INSTR(MID$(D$(W%?L%,1),E%?L%),CHR$10)
1750 T$=MID$(D$(W%?L%,1),E%?L%,P%):E%?L%=E%?L%+P%
1760 C%=ASC(T$):IF LEN(T$)>2 AND (C%<>23 AND C%<>1) THEN P=EVAL(MID$(T$,2)) ELSE P=0
1770 IF C%=23 OR C%=1 THEN P$=MID$(T$,2,LEN(T$)-2)
1780 ENDPROC
1790 
1800 DEFPROCundo
1810 IF S%=0 THEN PROCmsg(14,""):PROCmsg(18,""):GOTO 1880
1820 IF F% AND 2 THEN PROCdel(0):GOTO 1840
1830 IF F% AND 1 THEN PROCdel(D%)
1840 PROCreset
1850 IF C%=23 THEN PROCchoose:GOTO 1870
1860 IF C%=11 OR C%=18 OR C%=19 OR C%>128 THEN PROCreplot:K%=K% OR 2:PROCchoose:K%=K% AND 253:PROCreset:PROCreplot
1870 S%=S%-1:T%=T%-1-5*(T%=0)
1880 ENDPROC
1890 
1900 DEFPROCrecord
1910 S%=S%+1+(S%=5):T%=T%+1+5*(T%=4)
1920 C%(T%)=C%:BE(T%)=BE:X(T%)=X:Y(T%)=Y:TR(T%)=TR:NM(T%)=NM:SZ(T%)=SZ:P(T%)=P:F%(T%)=F%:K%(T%)=K%:CO(T%)=CO:P$(T%)=P$
1930 ENDPROC
1940 
1950 DEFPROCreset
1960 PROCcursor
1970 C%=C%(T%):BE=BE(T%):X=X(T%):Y=Y(T%):TR=TR(T%):TURN=TR(T%):NM=NM(T%):NUMBER=NM(T%):SZ=SZ(T%):SIZE=SZ(T%):P=P(T%):F%=F%(T%):K%=K%(T%):CO=CO(T%):P$=P$(T%)
1980 MOVE X,Y:PROCcursor
1990 ENDPROC
2000 
2010 DEFPROCdel(DL%)
2020 REPEAT:D$(DL%,1)=LEFT$(D$(DL%,1),LEN(D$(DL%,1))-1):UNTIL RIGHT$(D$(DL%,1),1)=CHR$(10) OR LEN(D$(DL%,1))=0
2030 ENDPROC
2040 
2050 DEFPROCreplot
2060 Q%=Q%-1-7*(Q%=0)
2070 ENDPROC
2080 
2090 DEFPROCplot
2100 GCOL 0,CO
2110 IF K% AND 80 THEN 2140
2120 PLOT K%,X,Y
2130 PROCcursor:GOTO 2160
2140 IF fy(Q%)<(Y+1) AND fy(Q%)>(Y-1) AND fy(Q%-1-7*(Q%=0))<(Y+1) AND fy(Q%-1-7*(Q%=0))>(Y-1) THEN PLOT K% AND 175,X,Y:Q%=Q%+1+7*(Q%=6):fx(Q%)=X:fy(Q%)=Y:GOTO 2130
2150 MOVE fx(Q%),fy(Q%):MOVE fx(Q%-1-7*(Q%=0)),fy(Q%-1-7*(Q%=0)):Q%=Q%+1+7*(Q%=6):fx(Q%)=X:fy(Q%)=Y:GOTO 2120
2160 ENDPROC
2170 
2180 DEFFNx(D,BE)
2190 =(COS(RAD(BE-90)))*D*XL%
2200 
2210 DEFFNy(D,BE)
2220 =-(SIN(RAD(BE-90)))*D*XL%
2230 
2240 DEFPROCcircle(r)
2250 LOCALx,y,xx,yy
2260 VDU 29,642+X;610+Y;
2270 FOR I%=0 TO 4
2280 xx=C(I%)*r*XL%
2290 yy=S(I%)*r*XL%
2300 x=C(I%+1)*r*XL%
2310 y=S(I%+1)*r*XL%
2320 MOVE 0,0:MOVE xx,yy:PLOT K%,x,y
2330 MOVE 0,0:MOVE xx,-yy:PLOT K%,x,-y
2340 MOVE 0,0:MOVE -xx,yy:PLOT K%,-x,y
2350 MOVE 0,0:MOVE -xx,-yy:PLOT K%,-x,-y
2360 MOVE 0,0:MOVE yy,xx:PLOT K%,y,x
2370 MOVE 0,0:MOVE yy,-xx:PLOT K%,y,-x
2380 MOVE 0,0:MOVE -yy,xx:PLOT K%,-y,x
2390 MOVE 0,0:MOVE -yy,-xx:PLOT K%,-y,-x
2400 NEXT:VDU 29,642;610;
2410 ENDPROC
2420 
2430 DEFPROCcursor
2440 IF F% AND 16 THEN GCOL3,2: ELSE GOTO 2500
2450 PLOT 1,FNx(6,BE),FNy(6,BE)
2460 PLOT 0,FNx(6,BE),FNy(6,BE)
2470 PLOT 0,FNx(6,BE+150),FNy(6,BE+150)
2480 PLOT 81,FNx(6,BE+270),FNy(6,BE+270)
2490 MOVE X,Y
2500 ENDPROC
2510 
2520 DEFPROCrepeat
2530 F%=F% OR 2:IF F% AND 64 THEN 2690 ELSE ?N%=ABS(INT(P)):D$(0,1)=""
2540 REPEAT
2550 C$=FNinput
2560 IF C%=24 THEN 2700
2570 IF C$="" THEN 2550
2580 IF C%>27 AND C%<35 THEN 2600
2590 D$(0,1)=D$(0,1)+C$
2600 PROCchoose
2610 UNTIL C%=9
2620 IF F% AND 1 THEN D$(D%,1)=D$(D%,1)+D$(0,1)
2630 FOR J%=2 TO ?N%:E%?L%=1:W%?L%=0
2640 REPEAT
2650 PROCextract
2660 PROCchoose
2670 UNTIL C%=9
2680 NEXT
2690 GOTO 2710
2700 UNTILC$=""
2710 ENDPROC
2720 
2730 DEFPROCdefine
2740 F%=F% OR 1:D%=D%+1
2750 D$(0,0)=P$:D$(D%,1)=""
2760 REPEAT
2770 C$=FNinput
2780 IF C%=25 THEN 2870
2790 IF C$="" THEN 2770
2800 IF C%>28 AND C%<35 THEN 2820
2810 D$(D%,1)=D$(D%,1)+C$
2820 PROCchoose
2830 UNTIL C%=10
2840 D$(D%,0)=D$(0,0)
2850 F%=F% AND 254
2860 GOTO 2890
2870 UNTILC$=""
2880 D%=D%-1
2890 ENDPROC
2900 
2910 DEFPROCedit
2920 GOSUB 410:CLS:PRINT"E nter","D elete","I nsert","R eplace"
2930 F%=F% OR 65
2940 VDU 28,0,31,SW%,28
2950 D$(0,1)="":?W%=P AND 127:?E%=1
2960 REPEAT
2970 PROCextract
2980 IF C% AND 128 THEN PRINTD$(C% AND 127,0); ELSE PRINT COM$(C%);
2990 PRINT" ";MID$(T$,2);CHR$13;
3000 A$=GET$:IF C%=10 AND (F% AND 2)=2 THEN ON INSTR("EI",A$)+1 GOTO 3000,3030,3050
3010 IF C%=10 THEN ON INSTR("EI",A$)+1 GOTO 3000,3040,3050
3020 ON INSTR("EDIR",A$)+1 GOTO 3000,3040,3080,3050,3050
3030 PROCmsg(132,"still"):PRINT:GOTO 2980
3040 D$(0,1)=D$(0,1)+T$:GOTO 3060
3050 D$(0,1)=D$(0,1)+FNinput:PRINT:IF A$="I" THEN ?E%=?E%-P%
3060 PROCchoose:IF C%=24 THEN ?R%=LEN(D$(0,1))+1:?N%=ABS(INT(P))
3070 IF C%=9 THEN Z%?0=?W%:Z%?1=?E%:?W%=0:FOR J%=2 TO ?N%:?E%=?R%:REPEAT:PROCextract:PROCchoose:UNTIL C%=9:NEXT:?W%=Z%?0:?E%=Z%?1
3080 UNTIL C%=10
3090 D$(?W%,1)=D$(0,1)
3100 VDU 28,0,31,SW%,26,12:F%=F% AND 190
3110 ENDPROC
3120 
3130 DEFPROCdescribe
3140 CLS
3150 ?W%=P AND 127:?E%=1
3160 REPEAT
3170 PROCextract
3180 IF C% AND 128 THEN PRINTD$(C% AND 127,0); ELSE PRINT COM$(C%);
3190 PRINT" ";MID$(T$,2);CHR$13;
3200 G%=GET
3210 UNTIL C%=10
3220 ENDPROC
3230 
3240 DEFPROCdelete
3250 FOR J%=1 TO D%:IF INSTR(D$(J%,1),CHR$P+CHR$10) THEN PROCmsg(13,""):PROCmsg(81,D$(J%,0)):J%=D%+10
3260 NEXT
3270 IF J%>D%+10 THEN 3330
3280 P=P AND 127:IF P=D% THEN D$(D%,0)="":D$(D%,1)="":GOTO 3320
3290 FOR J%=P TO D%-1:D$(J%,0)=D$(J%+1,0):D$(J%,1)=D$(J%+1,1):NEXT
3300 P=P OR 128:FOR J%=1 TO D%:PROCchange(J%,P,-1)
3310 NEXT
3320 D%=D%-1
3330 ENDPROC
3340 
3350 DEFPROCchange(j%,t%,d%)
3360 LOCALl%
3370 FOR l%=1 TO LEN(D$(j%,1))
3380 IF ASC(MID$(D$(j%,1),l%,1))>t% THEN D$(j%,1)=LEFT$(D$(j%,1),l%-1)+CHR$(ASC(MID$(D$(j%,1),l%,1))+d%)+MID$(D$(j%,1),l%+1)
3390 NEXT
3400 ENDPROC
3410 
3420 DEFPROCcolour
3440 CLS:PRINT"This is your colour palette, the background is black."
3470 PRINT"0-black 1-red 2-green 3-yellow 4-blue 5-magenta 6-cyan 7-white 8-light grey     9-mid grey 10-dark grey 11-orange 12-cream 13-dark green 14-purple 15-brown."
3480 PRINT"Enter the number of new colour required after the CO command."
3560 ENDPROC
3570 
3580 DEFPROCquit
3590 LOCALq%,a$
3600 CLS:PRINT"Do you wish to save your procedures?"'
3602 REPEAT:g$=GET$:UNTIL INSTR("YyNn",g$)<>0
3610 IF g$="N" OR g$="n" THEN 3810
3620 INPUT"Enter file name "''a$:IF a$ = "" OR LEN(a$)>10 THEN GOTO 3620
3630 q%=OPENOUT(a$)
3640 FOR J%=1 TO D%:BPUT#q%,D$(J%,0)
3650 p%=1
3660 WHILE p%<=LEN(D$(J%,1))
3670 IF ASC(MID$(D$(J%,1),p%,1))>128 THEN BPUT#q%,D$(ASC(MID$(D$(J%,1),p%,1))-128,0):p%+=1:GOTO 3760
3680 IF ASC(MID$(D$(J%,1),p%,1))=10 THEN p%+=1:GOTO 3760
3690 IF ASC(MID$(D$(J%,1),p%,1))<11 THEN
3700 BPUT#q%,COM$(ASC(MID$(D$(J%,1),p%,1))):p%+=1
3710 ELSE
3720 PP$=COM$(ASC(MID$(D$(J%,1),p%,1))):p%+=1
3730 P$="":REPEAT:P$+=MID$(D$(J%,1),p%,1):p%+=1:UNTIL ASC(MID$(D$(J%,1),p%,1))<25
3740 PP$=PP$+" "+P$:BPUT#q%,PP$
3750 ENDIF
3760 ENDWHILE
3770 BPUT#q%,"END":BPUT#q%,""
3780 NEXT
3790 CLOSE#q%
3800 OSCLI("SETTYPE "+a$+" BAD")
3810 VDU 22,7,12
3811 OSCLI("DIR $")
3820 END
3830 
3840 
3850 DEFFNinput
3860 IF F% AND 2 THEN PT$=RP$ ELSE IF F% AND 1 THEN PT$=DF$ ELSE PT$=CM$
3870 PRINT'PT$;:C$="":P$=""
3880 G%=GET
3890 IF (G%>96 AND G%<123) THEN G%-=32
3900 IF (G%>39 AND G%<58 AND G%<>44) OR (G%>64 AND G%<91) OR (G%>127 AND G%<138) THEN 3970
3910 IF G%=127 AND LEN(C$)>0 THEN C$=LEFT$(C$,LEN(C$)-1):PRINTCHR$G%;:GOTO 3880
3920 IF G%=13 AND (C$="F" OR C$="B" OR C$="R" OR C$="L") THEN 3980
3930 IF LEN(C$)>1 AND G%=13 THEN 3980
3940 IF G%=32 AND (LEN(C$)=3 OR (LEN(C$)=4 AND ASC(C$)=72) OR (LEN(C$)=5 AND ASC(C$)=67) OR (LEN(C$)=6 AND C$="CURSOR")) THEN 3970
3950 IF G%=32 THEN 3980
3960 VDU 7:GOTO 3880
3970 PRINTCHR$G%;:C$=C$+CHR$G%:GOTO 3880
3980 C%=FNfind(C$):IF C%=0 THEN PROCmsg(65,C$):GOTO 3860
3990 IF FNcheck THEN 3860
3991 IF C%=1 THEN 4060
4000 IF C%=8 AND (F% AND 64) THEN PROCmsg(20,""):PROCmsg(24,""):=""
4010 IF C%=8 THEN PROCundo:=""
4020 IF C%<11 OR C%>128 THEN PROCrecord
4030 IF C%<11 OR C%>28 THEN P=0:C$=CHR$(C%):=C$+CHR$10
4040 IF G%=32 THEN 4060
4050 IF C%<25 AND C%<>23 THEN PROCmsg(2,""):PRINT'C$;:ELSE PROCmsg(3,""):PRINT'C$;
4060 PRINT" ";
4070 P$=""
4080 G%=GET
4090 IF (G%>96 AND G%<123) THEN G%-=32
4095 IF C%=1 AND INSTR(" |$<>",CHR$(G%)) THEN PRINTCHR$G%;:P$=P$+CHR$G%:GOTO 4080
4100 IF (G%>39 AND G%<58 AND G%<>44) OR (G%>64 AND G%<91) OR (G%>127 AND G%<138) THEN PRINTCHR$G%;:P$=P$+CHR$G%:GOTO 4080
4110 IF G%=127 AND LEN(P$)>0 THEN P$=LEFT$(P$,LEN(P$)-1):PRINTCHR$G%;:GOTO 4080
4120 IF G%<>13 THEN VDU 7:GOTO 4080
4125 IF C%=1 THEN 4150
4130 G%=FNfind(P$):IF FNvalid THEN 3860
4140 IF C%<25 AND C%<>23 THEN P=EVAL(P$) ELSE IF C%>25 AND C%<29 THEN P=G% ELSE P=0
4150 IF C%<26 THEN PROCrecord
4160 C$=CHR$(C%)
4170 =C$+P$+CHR$10
4180 
4190 DEFFNfind(F$)
4200 LOCALc%
4210 c%=INSTR(COM$,F$):IF c%/2<>INT(c%/2) THEN =((c%+1)/2) ELSE c%=0
4220 REPEAT:c%=c%+1:UNTIL F$=COM$(c%) OR c%=37:IF c%<37 THEN =c%
4230 c%=0:REPEAT:c%=c%+1:UNTIL F$=D$(c%,0) OR D$(c%,0)=""
4240 IF D$(c%,0)="" THEN =0 ELSE =c% OR 128
4250 
4260 DEFFNcheck
4270 IF (F% AND 2) AND ((C%>24 AND C%<29) OR C%=10 OR C%=35 OR C%=36) THEN PROCmsg(4,""):PROCmsg(80,C$):=TRUE
4280 IF (F% AND 64) AND C%>25 AND C%<37 THEN PROCmsg(15,""):PROCmsg(80,C$):=TRUE
4290 IF (F% AND 1) AND ((C%>25 AND C%<29) OR C%=35 OR C%=36) THEN PROCmsg(5,""):PROCmsg(80,C$):=TRUE
4300 IF (F% AND 2) AND C%=24 THEN PROCmsg(6,""):=TRUE
4310 IF (F% AND 1) AND C%=25 THEN PROCmsg(7,""):=TRUE
4320 IF (NOT F% AND 2) AND C%=9 THEN PROCmsg(8,""):=TRUE
4330 IF (NOT F% AND 1) AND C%=10 THEN PROCmsg(9,""):=TRUE
4340 IF C%=25 AND D%=COMS THEN PROCmsg(19,""):=TRUE
4350 =FALSE
4360 
4370 DEFFNvalid
4380 IF G%>128 AND C%=25 THEN PROCmsg(10,""):=TRUE
4390 IF G%=0 AND C%>25 AND C%<29 THEN PROCmsg(140,P$):=TRUE
4400 IF G%<>0 AND G%<128 AND C%>24 AND C%<29 THEN PROCmsg(80,P$):PROCmsg(11,""):=TRUE
4410 =FALSE
4420 
4430 DEFPROCmsg(n%,c$)
4440 LOCALm%,l%,t$
4450 m%=n% AND 63:l%=0:RESTORE:REPEAT:l%=l%+1:READ t$:UNTIL l%=m%
4460 IF n% AND 128 THEN t$=c$+" "+t$
4470 IF n% AND 64 THEN t$=t$+" "+c$
4480 PRINT'"* ";t$;
4490 VDU 7
4500 ENDPROC
4510 
4520 DATA don't know,value please,name please,repeating,defining,already repeating,already defining,not repeating,not defining
4530 DATA already defined,system command,not defined,I can't delete,I've forgotten,editing,can't use,required by,that command sorry,my chips are full
4540 DATA sorry I can't,evaluate,that colour no.,is not available,UNDO in EDIT mode
4550 
4560 DEFPROCload
4570 LOCALq%,d%,a$
4580 CLS:PRINTTAB(0,2)
4590 OSCLI "CAT"
4600 INPUT"Enter file name :  "a$
4605 IF a$ = "" OR LEN(a$)>10 THEN GOTO 4590
4610 quit=FALSE:D%+=1:st%=D%
4620 q%=OPENUP(a$)
4630 IF q%=0 THEN PRINT"File not found!":GOTO 5190
4640 WHILE (NOT EOF#q%) AND (NOT quit)
4650 g$=GET$#q%
4660 IF g$="" THEN 5010
4670 IF LEFT$(g$,1)=" " THEN g$=MID$(g$,2):GOTO 4660
4680 D$(D%,0)=g$
4690 WHILE LEFT$(g$,11)<>"END" AND g$<>"EN"
4700 g$=GET$#q%
4710 IF g$="" THEN 4990
4720 IF RIGHT$(g$,1)=" " THEN g$=LEFT$(g$,LEN(g$)-1):GOTO 4720
4730 IF LEFT$(g$,1)=" " THEN g$=MID$(g$,2):GOTO 4730
4740 IF g$="" THEN 4990
4750 p%=INSTR(g$,"  "):IF p%<>0 THEN g$=LEFT$(g$,p%)+MID$(g$,p%+2):GOTO 4750
4760 p%=0:REPEAT:p%+=1:UNTIL MID$(g$,p%,1)=" " OR p%=LEN(g$)
4770 IF p%<LEN(g$) THEN com$=LEFT$(g$,p%-1):param$=MID$(g$,p%+1) ELSE com$=g$:param$=""
4780 IF INSTR("CURSORENDPENHOME",com$) THEN
4790 IF INSTR("CURSOR",com$) THEN
4800 p%=INSTR(g$," ",8)
4810 com$=LEFT$(g$,p%-1):param$=MID$(g$,p%+1)
4820 ELSE
4830 com$=g$:param$=""
4840 ENDIF
4850 ENDIF
4860 p%=0:REPEAT:p%+=1:UNTIL com$=COM$(p%) OR p%=37
4870 IF p%=37 THEN
4880 IF LEN(com$)=2 THEN
4890 p%=-1:REPEAT:p%+=2:UNTIL MID$(COM$,p%,2)=com$ OR p%=73
4900 IF p%=73 THEN D$(D%,1)=D$(D%,1)+"#"+com$+"#" ELSE D$(D%,1)=D$(D%,1)+CHR$((p% DIV 2)+1)
4910 ELSE
4920 D$(D%,1)=D$(D%,1)+"#"+com$+"#"
4930 ENDIF
4940 ELSE
4950 D$(D%,1)=D$(D%,1)+CHR$(p%)
4960 ENDIF
4970 IF param$<>"" THEN D$(D%,1)=D$(D%,1)+param$
4980 D$(D%,1)=D$(D%,1)+CHR$(10)
4990 ENDWHILE
5000 D%+=1:IF D%>COMS THEN PRINT'"* sorry, no room"''"LOADING ABANDONED"':VDU7:CLOSE#q%:quit=TRUE
5010 ENDWHILE
5020 CLOSE#q%:D%-=1
5030 FOR i%=st% TO D%:p%=INSTR(D$(i%,1),"#")
5040 WHILE p%<>0
5050 p1%=INSTR(D$(i%,1),"#",p%+1):p1$=LEFT$(D$(i%,1),p%-1):p3$=MID$(D$(i%,1),p1%+1)
5060 p%+=1:p2$=MID$(D$(i%,1),p%,p1%-p%)
5070 j%=0:REPEAT:j%+=1:UNTIL p2$=D$(j%,0) OR j%>D%
5080 IF j%<=D% THEN
5090 D$(i%,1)=p1$+CHR$(j%+128)+p3$
5100 ELSE
5110 PRINT"Unknown procedure <";p2$;"> in ";D$(i%,0)
5120 PRINT"Loading abandonned":VDU7:D%=st%-1:GOTO 5190
5130 ENDIF
5140 p%=INSTR(D$(i%,1),"#")
5150 ENDWHILE
5160 NEXT
5170 PRINT'"Data file is loaded"
5180 G%=INKEY(200)
5190 ENDPROC
5200 
5210 DEFPROCinit
5220 COMS=500
5230 DIM COM$(37),D$(COMS,1),W% COMS,E% COMS,R% COMS,N% COMS,Z% 2,O% 5
5240 COM$="OSCSHMPUPDEFFLUDERENCICOCRCURTLTBEFDBKNMTRSZWRRPTOEDDLDSHELILOVLPADIPRQU"
5250 RESTORE 5320:FOR J%=1 TO 36:READ COM$(J%):NEXT
5260 S%=0:T%=0:Q%=0
5270 DIM C%(4),BE(4),X(4),Y(4),TR(4),NM(4),SZ(4),P(4),F%(4),K%(4),CO(4),P$(4),fx(7),fy(7)
5280 K%=5:F%=24:L%=0:D%=0:NM=10:NUMBER=10:TR=90:TURN=90:SZ=20:SIZE=20:X=0:Y=0:BE=0:P=0:B$=STRING$(5,CHR$8):OSWORD=&FFF1:A%=&0B:X%=O% MOD 256:Y%=O% DIV 256
5290 DIM S(5),C(5):FOR J%=0 TO 5:S(J%)=SIN(RAD(9*J%)):C(J%)=COS(RAD(9*J%)):NEXT
5300 ENDPROC
5310 
5320 DATA OSCLI,CLEAR,HOME CURSOR,PEN UP,PEN DOWN,END FILL,FILL,UNDO,END REPEAT,END,CIRCLE,COLOUR,CURSOR RIGHT,CURSOR UP,RIGHT,LEFT,BEARING,FORWARD,BACKWARDS
5330 DATA NUMBER,TURN,SIZE,WRITE,REPEAT,TO,EDIT,DELETE,DESCRIBE,HELP,LIST,LOAD,VALUES,PALETTE,DISPLAY,PRINT,QUIT
5340 
5350 DEFPROCmode
5360 SW%=79:XL%=4:CM$="{} ":DF$=" ..":RP$=" ....":t%=2:V%=15:VDU 22,12
5365 COLOUR 8,200,200,200:COLOUR 9,128,128,128:COLOUR 10,64,64,64:COLOUR 11,255,187,0:COLOUR 12,238,238,187:COLOUR13,85,136,0:COLOUR14,170,0,171:COLOUR15,181,98,57
5370 CO=1:PROCwindows
5380 ENDPROC
5390 
5400 DEFPROCwindows
5410 VDU 28,0,31,SW%,26,24,0;220;1279;1023;29,642;610;
5420 GCOL BG:GCOL 4
5430 C%=2:PROCsysex
5440 ENDPROC
5450 
5460 IF ERR=26 AND ERL=4140 THEN PROCmsg(20,""):PROCmsg(85,P$):GOTO 5490
5465 IF ERL=392 THEN 320
5470 IF ERR=17 THEN 5490
5480 VDU 22,7:REPORT:PRINT" at line ";ERL:END
5490 IF F% AND 64 THEN VDU28,0,31,SW%,26:PRINT'"EDIT ABANDONED"':F%=F% AND 188:GOTO 5520
5500 IF F% AND 1 THEN PRINT'"DEFINING ABANDONED"':F%=F% AND 252:D%=D%-1:GOTO 5520
5510 IF F% AND 2 THEN PRINT'"REPEATING ABANDONED"':F%=F% AND 253
5520 L%=0:VDU 29,642;610;:MOVE X,Y:GOTO 320
5530 
5540 DEFPROCdump
5550 *DVDUMP
5560 ENDPROC
