10
20
30
40 MODE&84:ver$="2.11":oflg%=0:*K.10O.|MRUN|M
50 ONERRORPROC_ERROR:IFoflg%:GOTO180ELSEGOTO260
60 DIMctrl%31,b%7:os%=FNbyte(0,1,0):VDU23;10,96AND(os%<>32);0;0;0:IFos%=6:*POINTER 1
70 totalI%=(HIMEM-LOMEM-1024-(8192 AND HIMEM>&FFFF))/32:DIMicons% 32*totalI%
80 ic%=0:thisI%=0:mx%=0:my%=0:ms%=0:mL%=0:mM%=0:mR%=0:xo%=640:yo%=382:X%=ctrl%:Y%=X%DIV256
90 VDU23,132,255,129,129,129,129,129,129,255
100 *FX219,9
110 *FX225,1
120 *FX226,128
130 *K.11|!K
140 *K.12|!L
150 *K.13|!M
160 *K.14|!N
170 *K.15|!O
180 IFoflg%:CLS
190 PROC_CSET:oflg%=0:PRINTTAB(23,21);"Type ";F%AND3;TAB(15,26)"Icon area start: &";~icons%;TAB(12,27)"Display area start: &";~icons%;TAB(17,28)"Maximum icons: ";totalI%
200 RESTORE:Q=9:REPEAT:READ A$:PRINTTAB(18,Q);A$:Q=Q+1:UNTIL A$=""
210 Q=9:REPEAT:READA$:PRINTTAB(28,Q);A$:Q=Q+1:UNTIL A$=""
220 DATA Get,Put,Load,Save,Display,Quit," ",Cursors,to move,& scroll,
230 DATA I Invert,M Mirror <>,T Tip ^v,+ Rotate +90,- Rotate -90,\ Reflect,/ Reflect,V Reflect ^v,H Reflect <>,F Icon Type,
240 PRINTTAB(22,23)"DefIcon "ver$;TAB(18,24)"1985-2019 J.G.Harston"
250 x%=0:y%=0:PROC_EXPAND(thisI%):*FX4,2
260 VDU31,x%+1,y%+9
270 REPEAT:X%=ctrl%:Y%=X%DIV256:PROCwait:ch%=TRUE
280 IFmx%>196ANDmx%<1216ANDmy%>764:PROCmsChr
290 IFmx%>8ANDmx%<564ANDmy%>200ANDmy%<756:PROCmsKlk
300 IFmy%<736AND((mx%>576ANDmy%>544)OR(mx%>899ANDmy%>412))ANDmL%:PROCklik2
310 UNTILA$<>"":GCOL0,7:IFA$>"`"ANDA$<"{":A$=CHR$(ASCA$-32)
320 A%=ch%>TRUE:IFA%:IFA$="C":thisI%=ch%:GOTO250ELSEIFA%:GOTO930
330 A%=ASCA$AND&CF:IFA%>&CB:A$=CHR$(A%+64*INKEY-1)
340 IFA$=CHR$&CC:x%=(x%-1)AND15
350 IFA$=CHR$&CD:x%=(x%+1)AND15
360 IFA$=CHR$&CE:y%=(y%+1)AND15
370 IFA$=CHR$&CF:y%=(y%-1)AND15
380 IFA$>CHR$139ANDA$<CHR$144:PROC_SCROLL((ASCA$)-140)
390 IFA$=CHR$13ORA$="P":GOTO920
400 IFA$="*":GOTO1000
410 IFA$="S":GOTO1050
420 IFA$="L":GOTO1080
430 IF(A$=CHR$203ORA$=CHR$9)ANDPOINT(xo%+x%*4,yo%-y%*4)=0:A$="1"
440 IF(A$=CHR$203ORA$=CHR$9):A$="0"
450 IFA$="1":PLOT69,xo%+x%*4,yo%-y%*4:COLOUR135:VDU31,x%+1,y%+9,32,8:COLOUR128:GOTO270
460 IFA$="0":PLOT71,xo%+x%*4,yo%-y%*4:PROCsave128:VDU31,x%+1,y%+9,128,8:PROCget128:GOTO270
470 IFA$="G"ORA$="C":PRINTFNbot;:INPUT"Get which icon: "thisI%:PRINTFNbot;FNclr:GOTO250
480 IFA$="F":F%=(F%+1)MOD4:PRINTTAB(28,21);F%AND3:PROC_CSET:GOTO260
490 IFA$="I":PROCinv:GOTO260
500 IFA$="T":PROCtip:GOTO260
510 IFA$="M":PROCmir:GOTO260
520 IFA$="+"ORA$=";":PROCrotP:GOTO260
530 IFA$="-"ORA$="=":PROCrotM:GOTO260
540 IFA$="/"ORA$="?":PROCrefD1:GOTO260
550 IFA$="\"ORA$="|":PROCrefD2:GOTO260
560 IFA$="H":PROCrefH:GOTO260
570 IFA$="V":PROCrefV:GOTO260
580 IFA$="Q":PROCquit:GOTO260
590 IFA$="D":PRINTFNbot;:INPUT"Display start icon "ic%:ic%=(ic%AND&FFF0):PROC_CSET:PRINTFNbot;FNclr;TAB(33,27);~icons%+32*ic%" ";:GOTO260
600 GOTO260
610 DEFPROC_ERROR:IFms%=-1:PROCp
620 PRINTFNbot;CHR$11;FNclr'FNclr;:CLOSE#0:IFERR<>17:GOTO650
630 IFINKEY-1ANDINKEY-2:OSCLI"FX4":PRINTFNbot:END
640 OSCLI"FX4,2":ENDPROC
650 REPORT:IF ERR<128 AND INKEY-1:PRINT" at line ";ERL:OSCLI"FX4":END ELSE A$=GET$:PRINTFNbot;FNclr;:ENDPROC
660 DEFPROC_CSET:VDU30:FORA=ic%TOic%+63:IF(A AND15)=0:PRINTSPC(5-LENSTR$A);A;" ";
670 PROCicon(A):IF(A AND15)=15:PRINT'
680 NEXT:ENDPROC
690 DEFPROCpic(I%):PRINTTAB((I%AND15)*2+6,((I%-ic%)AND&70)DIV8);:PROCicon(I%):ENDPROC
700 DEFPROCicon(I%):IFI%>totalI%:ENDPROC
710 FORA%=0TO3
720 IF(F%AND3)=0:C%=icons%+I%*32+A%*8
730 IF(F%AND3)=1:C%=icons%+I%*32+(A%DIV2)*8+(A%AND1)*16
740 IF(F%AND3)=2:C%=icons%+I%*32+(A%AND1)+(A%AND2)*8
750 IF(F%AND3)=3:C%=icons%+I%*32+(A%AND1)-(A%AND2)*8+16
760 VDU 23,A%+128
770 IF(F%AND2)=0:FORB%=0TO7:VDUC%?B%:NEXT
780 IF(F%AND3)=2:FORB%=0TO7:VDUC%?(B%*2):NEXT
790 IF(F%AND3)=3:FORB%=7TO0 STEP-1:VDUC%?(B%*2):NEXT
800 NEXT:VDU128,129,8,8,10,130,131,11:ENDPROC
810 DEFPROC_EXPAND(C%):PRINTTAB(22,20);" Icon ";C%;" ";TAB(20,20);:PROCicon(C%):PROC_BIGGER:ENDPROC
820 DEFPROCsave128:?X%=128:A%=10:CALL&FFF1:g128=TRUE:VDU&8017;&81FF;&8181;&8181;&FF81;:ENDPROC
830 DEFPROCget128:IFNOTg128:ENDPROC
840 VDU23,128:FORA%=1TO8:VDUX%?A%:NEXT:g128=0:ENDPROC
850 DEFFNd(A%):=RIGHT$("00"+STR$A%,3)
860 DEFPROC_BIGGER:FORY=0TO15:PRINTTAB(1,9+Y);:FORX=0TO15
870 IFPOINT(xo%+X*4,yo%-Y*4):COLOUR135:VDU 32:COLOUR128:A=A+1 ELSE VDU 132
880 NEXT:NEXT:ENDPROC
890 DEFPROCwait:REPEATPROCmse:UNTILmL%+mM%+mR%=0:IFms%=0:A$=INKEY$(50):ENDPROC
900 ox%=mx%:oy%=my%:PROCp:REPEATPROCmse:A$=INKEY$(5):UNTILLENA$OR(mL%ORmM%ORmR%)OR(mx%<>ox%)OR(oy%<>my%):PROCp:ENDPROC
910 DEFPROCp:GCOL4,0:MOVEox%-12,oy%:DRAWox%+12,oy%:MOVEox%,oy%-12:DRAWox%,oy%+12:ms%=ms%EOR1:ENDPROC
920 PRINTFNbot;:INPUT"Enter onto icon "ch%:PRINTFNbot;FNclr;
930 D%=icons%+32*ch%:I%=D%:IFch%>totalI%:PRINT" Out of range";:A%=GET:PRINTFNbot;FNclr;:GOTO260
940 IF(F%AND3)=3:PRINT" Can't store!";:A%=GET:PRINTFNbot;FNclr;:GOTO260
950 FORC%=0TO3:IF(F%AND2)=2:I%=D%+8*(C%AND2)+(C%AND1)
960 FORA%=0TO7:Q%=0:FORB%=0TO7:Q%=Q%*2:IFPOINT(xo%+B%*4+32*(C%AND1),yo%-A%*4-16*(C%AND2)):Q%=Q%+1
970 NEXT:IF(F%AND3)=2:?I%=Q%:I%=I%+2 ELSE IF(F%AND1):?(I%+((C%DIV2)+2*(C%AND1))*8+A%)=Q% ELSE ?(I%+C%*8+A%)=Q%
980 NEXT:NEXT:PRINTTAB(0,29)SPC(20):IFch%-ic%<64:IFch%-ic%>=0:PROCpic(ch%)
990 GOTO260
1000 PRINTTAB(0,26);SPC(120);TAB(0,26);"*";
1010 OSCLI"FX4":oflg%=TRUE:REPEAT:INPUTLINE""A$:OSCLIA$:PRINT":";:REPEATA$=GET$:UNTILINSTR(CHR$13+"LlSs*",A$):IFA$="*":VDU127,42
1020 UNTILA$<>"*":PRINT':IFA$="L"ORA$="l":GOTO1080 ELSE IFA$=CHR$13:GOTO180
1050 A$=FNfn("save"):IFA$="":GOTO180
1060 INPUT" End at icon "end:IFos%=32:IFINSTR(A$,".")=0:A$=A$+"."
1070 OSCLI"SAVE "+A$+" "+STR$~(icons%+start*32)+" "+STR$~(icons%+end*32+32)+" FFFFFF00 FFFFFD00":GOTO180
1080 A$=FNfn("load"):IFA$="":GOTO180
1090 ch=OPENIN(A$):IFch:CLOSE#ch ELSE IFos%=32:A$=A$+"."
1100 OSCLI"LOAD "+A$+" "+STR$~(icons%+start*32):GOTO180
1101 DEFFNfn(A$):oflg%=TRUE:OSCLI"FX4":PRINTFNbot;CHR$11;:PRINT"Filename to ";A$;:INPUTLINE": "A$:IFA$="":=A$
1102 INPUT" Start at icon "start:=A$
1110 DEFPROC_SCROLL(A):LOCAL X,Y,xs,xe,xst,ys,ye,yst,temp
1120 ON A+1 GOSUB1140,1130,1180,1190:PROC_BIGGER:GCOL0,7:ENDPROC
1130 xs=15:xe=1:xst=-1:GOTO1150
1140 xs=0:xe=14:xst=1
1150 FORY=0TO15:tmp=POINT(xo%+xs*4,yo%-Y*4):FORX=xs TO xe STEP xst
1160 GCOL0,POINT(xo%+(X+xst)*4,yo%-Y*4):PLOT69,xo%+X*4,yo%-Y*4:NEXT
1170 GCOL0,tmp:PLOT69,xo%+(xe+xst)*4,yo%-Y*4:NEXT:RETURN
1180 ys=15:ye=1:yst=-1:GOTO1200
1190 ys=0:ye=14:yst=1
1200 FORX=0TO15:tmp=POINT(xo%+X*4,yo%-ys*4):FORY=ys TO ye STEP yst
1210 GCOL0,POINT(xo%+X*4,yo%-(Y+yst)*4):PLOT69,xo%+X*4,yo%-Y*4:NEXT
1220 GCOL0,tmp:PLOT69,xo%+X*4,yo%-(ye+yst)*4:NEXT:RETURN
1230 DEFPROCmsKlk:IFmL%+mM%+mR%=0:ENDPROC
1240 IFmx%<32:A$=CHR$140:ENDPROC
1250 IFmx%>539:A$=CHR$141:ENDPROC
1260 IFmy%<224:A$=CHR$142:ENDPROC
1270 IFmy%>732:A$=CHR$143:ENDPROC
1280 IFmL%:A$="1"
1290 IFmM%:A$=CHR$9
1300 IFmR%:A$="0"
1310 x%=mx%DIV32-1:y%=22-my%DIV32:VDU31,x%+1,y%+9
1320 IFmM%:REPEATPROCmse:UNTILNOTmM%
1330 ENDPROC
1340 DEFPROCmsChr:IFmL%+mR%=0:ENDPROC
1350 ch%=ic%+(mx%DIV64-3+16*(15-my%DIV64)):IFmL%:A$="C"ELSEA$=CHR$13
1360 ENDPROC
1370 DEFPROCklik2:x0%=mx%DIV32:IFx0%>27:x0%=28ELSEx0%=18
1380 VDU31,x0%,31-my%DIV32:A$=CHR$FNbyte(135,0,0):VDU31,x%+1,y%+8:ENDPROC
1390 DEFPROCmse:IFPAGE>&FFFFF:MOUSEmx%,my%,A% ELSE mx%=ADVAL(7):my%=ADVAL(8)
1400 ms%=mx%<&FFF:IFms%:mL%=INKEY-10:mM%=INKEY-11:mR%=INKEY-12
1410 ENDPROC
1420 DEFPROCinv:GCOL4,0:FORX=0TO15:FORY=0TO15:PLOT69,xo%+X*4,yo%-Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
1430 DEFPROCtip:FORX=0TO15:FORY=0TO7:A=POINT(xo%+X*4,yo%-Y*4):GCOL0,POINT(xo%+X*4,yo%-60+Y*4):PLOT69,xo%+X*4,yo%-Y*4:GCOL0,A:PLOT69,xo%+X*4,yo%-60+Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
1440 DEFPROCmir:FORY=0TO15:FORX=0TO7:A=POINT(xo%+X*4,yo%-Y*4):GCOL0,POINT(xo%+60-X*4,yo%-Y*4):PLOT69,xo%+X*4,yo%-Y*4:GCOL0,A:PLOT69,xo%+60-X*4,yo%-Y*4:NEXT:NEXT:PROC_BIGGER:ENDPROC
1450 DEFPROCrefD1:PRINTFNbot;"Copy Topleft or Bottomright?";:A=FNupDn("TB"):PROCclr
1460 FORY=0TO15:FORX=Y TO15:IF A:GCOL 0,POINT(xo%+60-4*Y,yo%-4*X):PLOT 69,xo%+60-4*X,yo%-4*Y ELSE GCOL 0,POINT(xo%+60-4*X,yo%-4*Y):PLOT 69,xo%+60-4*Y,yo%-4*X
1470 NEXT:NEXT:PROC_BIGGER:ENDPROC
1480 DEFPROCrefD2:PRINTFNbot;"Copy Topright or Bottomleft?";:A=FNupDn("TB"):PROCclr
1490 FORX=0TO15:FORY=X TO15:IFA:GCOL0,POINT(xo%+4*X,yo%-4*Y):PLOT69,xo%+4*Y,yo%-4*X ELSE GCOL0,POINT(xo%+4*Y,yo%-4*X):PLOT69,xo%+4*X,yo%-4*Y
1500 NEXT:NEXT:PROC_BIGGER:ENDPROC
1510 DEFFNupDn(B$):x0%=POS*32:REPEAT:PROCmse:UNTILmL%+mM%+mR%=0:REPEAT:PROCwait:IFA$>"`":A$=CHR$(ASCA$-32)
1520 IFmR%ANDB$="NY":A$="N"
1530 IFmL%ANDmy%<64ANDmx%<x0%:A$=MID$(B$,1+(mx%DIV(x0%DIV2)),1):IFB$="NY":A$="Y"
1540 UNTILINSTR(B$,A$)ANDA$<>"":PRINTA$;:=INSTR(B$,A$)=2
1550 DEFPROCrotP:PROCrotD2:PROCmir:ENDPROC
1560 DEFPROCrotM:PROCrotD1:PROCtip:ENDPROC
1570 DEFPROCrotD1:FORX=0TO15:FORY=X TO15:A=POINT(xo%+4*X,yo%-4*Y):GCOL0,POINT(xo%+4*Y,yo%-4*X):PLOT69,xo%+4*X,yo%-4*Y:GCOL0,A:PLOT69,xo%+4*Y,yo%-4*X:NEXT:NEXT:ENDPROC
1580 DEFPROCrotD2:FORY=0TO15:FORX=Y TO15:A=POINT(xo%+4*X,yo%-4*Y):GCOL0,POINT(xo%+4*Y,yo%-4*X):PLOT69,xo%+4*X,yo%-4*Y:GCOL0,A:PLOT69,xo%+4*Y,yo%-4*X:NEXT:NEXT:ENDPROC
1590 DEFPROCrefV:PRINTFNbot;"Copy Top or Bottom?";:A=NOTFNupDn("TB"):PROCclr
1600 FORX=0TO15:FORY=0TO7:IFA:GCOL0,POINT(xo%+4*X,yo%-4*Y):PLOT69,xo%+X*4,yo%-60+Y*4 ELSE GCOL0,POINT(xo%+4*X,yo%-60+4*Y):PLOT69,xo%+X*4,yo%-Y*4
1610 NEXT:NEXT:PROC_BIGGER:ENDPROC
1620 DEFPROCrefH:PRINTFNbot;"Copy Left or Right?";:A=NOTFNupDn("LR"):PROCclr
1630 FORY=0TO15:FORX=0TO7:IFA:GCOL0,POINT(xo%+4*X,yo%-4*Y):PLOT69,xo%+60-X*4,yo%-Y*4 ELSE GCOL0,POINT(xo%+60-4*X,yo%-4*Y):PLOT69,xo%+X*4,yo%-Y*4
1640 NEXT:NEXT:PROC_BIGGER:ENDPROC
1650 DEFPROCquit:PRINTFNbot"Quit program? ";:A=FNupDn("NY"):PROCclr:IFA:OSCLI"FX4":PROCend ELSE ENDPROC
1660 DEFPROCend:VDU23;10,103;0;0;0:ok%=TRUE:ONERRORok%=FALSE
1670 IFok%:IFPAGE>&8000:*QUIT
1680 END:ENDPROC
1690 DEFFNbot:PRINTTAB(1,30);:=""
1700 DEFPROCclr:PRINTFNclr;:ENDPROC
1710 DEFFNclr:PRINTCHR$13;SPC40;STRING$(40,CHR$8);:=""
1720 DEFFNbyte(A%,X%,Y%):=((USR&FFF4)AND&FF00)DIV256