10 REM >DefIcon 2.11
   20 REM Icon defining program
   30 REM By J.G.Harston
   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%=7TOSTEP-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):IF(ch%AND&FFC0)=ic%: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
 1030 DEFFNfn(A$):oflg%=TRUE:OSCLI"FX4":PRINTFNbot;CHR$11;:PRINT"Filename to ";A$;:INPUTLINE":   "A$:IFA$="":=A$
 1040 INPUT" Start at icon "start:=A$
 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
 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