10 REM > PCHANGE v2.1
   20 REM R/G/B palette control
   30 REM Mike Cook's Beeb Body Building Course Feb 1990
   40 REM Updated to allow VDU 19, vNULA, Clwyd, CTS500, PaletteMate
   50 :
   60 MODE&87:A%=HIMEM-LOMEM-20200:IFA%<0:PAGE=PAGE+A%:CHAIN$&600
   70 DIMR%(15),G%(15),B%(15),RT(7),GT(7),BT(7),SCOL%16
   80 PROCdefault:HW%=5:REM Default hardware
   90 ONERROR:MODE&87:PROCerr
  100 CLS:PRINTSPC5"12-BIT COLOUR PALETTE SELECTOR"'
  110 PRINT"Press digit to select a colour."
  120 PRINT"SHIFT+digit to select colours 8+."'
  130 PRINT"R/G/B - Add more Red/Green/Blue"
  140 PRINT"        Press SHIFT to subtract"'
  150 PRINT"A - Alter the saturation"
  160 PRINT"V - Alter the brightness"
  170 PRINT"H - Alter the hue"
  180 PRINT"T - Toggle the R/G/B"'
  190 PRINT"E - Exchange main & alternate palettes"
  200 PRINT"I - Interpolate between two colours"
  210 PRINT"D - Select default palette"
  220 PRINT"L - Load a palette file"
  230 PRINT"S - Save a palette file"
  240 PRINT"P - Select palette hardware"'
  250 PRINT"Escape - to Quit"'
  260 PRINT"PRESS ANY KEY TO CONTINUE";:A%=GET
  270 MODE&82:PROCall:VDU5:FORL%=0TO15:GCOL0,L%
  280   MOVE160*(L%AND7),1015-16*(L%AND8):PLOT0,0,-120
  290   PLOT81,144,0:PLOT0,0,120:PLOT81,-144,0
  300   GCOL0,L%EOR7:MOVE160*(L%AND7)+40,964-16*(L%AND8):PRINT;~L%;
  310 NEXT:GCOL0,0:MOVE0,1023:DRAW0,760
  320 VDU4,28,0,31,19,9,23,1;0;0;0;0:N=1:REPEAT
  330   COLOUR7:PRINTTAB(3,0);FNhw(HW%);TAB(2,1);"WORKING COLOUR ";~N;'
  340   PRINT"RED   =";R%(N)" "'"GREEN =";G%(N)" "'"BLUE  =";B%(N)" "
  350   FORA=0TO15:COLOUR15-A:COLOURA:PRINT"COLOUR ";~A;"  ";FNd(R%(A));" ";FNd(G%(A));" ";FNd(B%(A)):NEXT
  360   REPEAT:PRINTTAB(0,2);:C$=GET$:INC=1+2*INKEY-1:OSCLI"FX15":IF C$>"_":C$=CHR$(ASCC$AND&DF)
  370     IFC$="R":R%(N)=R%(N)+INC:IFR%(N)<0ORR%(N)>15:R%(N)=R%(N)-INC
  380     IFC$="G":G%(N)=G%(N)+INC:IFG%(N)<0ORG%(N)>15:G%(N)=G%(N)-INC
  390     IFC$="B":B%(N)=B%(N)+INC:IFB%(N)<0ORB%(N)>15:B%(N)=B%(N)-INC
  400     IFC$="T":R%(N)=R%(N)EOR15:G%(N)=G%(N)EOR15:B%(N)=B%(N)EOR15
  410     IFC$="E":PROCPSWAP
  420     IFC$="I":PROCINTER
  430     IFC$="H":PROCHVAL(R%(N),G%(N),B%(N))
  440     IFC$="V":PROCVVAL(R%(N),G%(N),B%(N))
  450     IFC$="A":PROCSVAL(R%(N),G%(N),B%(N))
  460     IFINSTR("RGBTIHVA",C$):PROCDCOL(N,R%(N),G%(N),B%(N))
  470     COLOURN:PRINTTAB(10,N+6);FNd(R%(N))" "FNd(G%(N))" "FNd(B%(N))
  480     COLOUR7:PRINTTAB(7,3);R%(N)" ";TAB(7,4);G%(N)" ";TAB(7,5);B%(N)" "
  490   UNTILC$<":"ORINSTR("DSLPE",C$)
  500   IFC$="D":PROCdefault:PROCall
  510   IFC$="S":PROCFILE(1)
  520   IFC$="L":PROCFILE(0)
  530   IFC$<":":IFC$>=" ":N=ASCC$AND15:IFC$<"(":N=N+8
  540   IFC$="P":PRINTTAB(0,3)"1:Native 4:Pal'Mate 2:Clwyn  5:Chameleon3:CTS    6:VideoNULA":A%=GET:CLS:IFA%>48:IFA%<55:HW%=A%-49:PROCall
  550 UNTILFALSE
  560 DEFFNd(A%)=RIGHT$(" "+STR$A%,2)
  570 DEFFNhw(A%)=MID$("NATIVE VDU 19    CLWYD      CTS CC500   PALETTEMATE   CHAMELEON    VIDEONULA  ",A%*13+1,13)
  580 DEFPROCdefault
  590 A=0:FORL%=0TO7
  600   IFL%AND1:R%(L%)=15ELSER%(L%)=0
  610   IFL%AND2:G%(L%)=15ELSEG%(L%)=0
  620   IFL%AND4:B%(L%)=15ELSEB%(L%)=0
  630   R%(L%+8)=A:G%(L%+8)=A:B%(L%+8)=A:A=A+2
  640 NEXT:ENDPROC
  650 DEFPROCwr(Y%):FORX%=1TO2:PROCio(96,Y%):PROCio(96,Y%+8):NEXT:ENDPROC
  660 DEFPROCio(X%,Y%):A%=151-X%DIV256:IF0THEN
  670   CALL&FFF4:ENDPROC
  680 ELSE
  690   LOCALERROR:ONERRORLOCAL:ENDPROC
  700   CALL&FFF4:ENDPROC
  710   DEFPROCall:IFHW%=5:PROCio(34,64)
  720   FORA=0TO15:PROCDCOL(A,R%(A),G%(A),B%(A)):NEXT:ENDPROC
  730   DEFPROCDCOL(N%,R%,G%,B%)
  740   IFHW%=0:VDU19,N%,16,R%*16,G%*16,B%*16:ENDPROC:REM NATIVE
  750   VDU19,N%,N%AND(23-HW%*8);0;:*FX19
  760   IFHW%=5:PROCio(35,N%*16+R%):PROCio(35,G%*16+B%):ENDPROC:REM VIDEONULA
  770   IFHW%=4:PROCio(98,&FF):PROCio(108,&AE):PROCio(96,&E0+N%):PROCio(96,R%EOR15)
  780   IFHW%=4:PROCio(96,(G%EOR15)+64):PROCio(96,(R%EOR15)+128):PROCio(96,&E0):ENDPROC
  790   IFHW%=2:PROCio(&4A0+N%,R%):PROCio(&4A8+N%,G%):PROCio(&4B0+N%,B%):ENDPROC:REM CTS
  800   IFHW%=1:PROCio(98,&FF):PROCwr(N%*16):PROCwr(R%*16+1):PROCwr(G%*16+2):PROCwr(B%*16+3):ENDPROC
  810   ENDPROC
  820   DEFPROCPSWAP:FORA=0TO7
  830     T=R%(A):R%(A)=R%(A+8):R%(A+8)=T
  840     T=G%(A):G%(A)=G%(A+8):G%(A+8)=T
  850     T=B%(A):B%(A)=B%(A+8):B%(A+8)=T
  860   NEXT:PROCall:ENDPROC
  870   DEFPROCINTER
  880   FORA=0TO7:RT(A)=R%(A):GT(A)=G%(A):BT(A)=B%(A):NEXT
  890   PRINTTAB(0,3);SPC(60);TAB(0,3);"INTERPOLATE BETWEEN"
  900   PRINT"    COLOUR: ";:S%=GETAND7:PRINT;S%
  910   PRINT"AND COLOUR: ";:F%=GETAND7:PRINT;F%
  920   IFS%>F%:T%=S%:S%=F%:F%=T%
  930   D%=F%-S%:IFD%<1:ENDPROC
  940   RI=(R%(F%)-R%(S%))/D%:GI=(G%(F%)-G%(S%))/D%:BI=(B%(F%)-B%(S%))/D%
  950   AGR=R%(S%):AGG=G%(S%):AGB=B%(S%)
  960   FORA=S%+1TOF%-1
  970     AGR=AGR+RI:RT(A)=INT(AGR)
  980     AGG=AGG+GI:GT(A)=INT(AGG)
  990     AGB=AGB+BI:BT(A)=INT(AGB)
 1000     PROCDCOL(A,RT(A),GT(A),BT(A))
 1010   NEXT:PRINT"KEEP/REJECT? (K/R)";
 1020   REPEATC$=CHR$(GETAND&DF):UNTILINSTR("KR",C$)
 1030   IFC$="K":FORA=0TO7:R%(A)=RT(A):G%(A)=GT(A):B%(A)=BT(A):NEXT
 1040   PROCall:CLS:C$=STR$N:ENDPROC
 1050   DEFPROCHVAL(RI,GI,BI)
 1060   PROCRGB_HSV(RI,GI,BI):H=H+INC*60
 1070   IFH<0:H=0
 1080   IFH>430:H=180:S=1/15
 1090   IFH>360:H=H-360
 1100   PROCSET_RGB:ENDPROC
 1110   DEFPROCVVAL(RI,GI,BI)
 1120   PROCRGB_HSV(RI,GI,BI):V=V+(INC/15)
 1130   IFV>1:V=1
 1140   IFV<0:V=0
 1150   PROCSET_RGB:ENDPROC
 1160   DEFPROCSVAL(RI,GI,BI)
 1170   PROCRGB_HSV(RI,GI,BI):S=S+(INC/15)
 1180   IFS>1:S=1
 1190   IFS<0:S=0
 1200   IFS<>0 AND H>400:H=180
 1210   PROCSET_RGB:ENDPROC
 1220   DEFPROCSET_RGB
 1230   PROCHVS_RGB:IFCERR=0:R%(N)=RI:G%(N)=GI:B%(N)=BI
 1240   ENDPROC
 1250   DEFPROCRGB_HSV(RI,GI,BI)
 1260   RI=RI/15:GI=GI/15:BI=BI/15:MAX=RI
 1270   IFRI<GI:MAX=GI
 1280   IFMAX<BI:MAX=BI
 1290   MIN=RI
 1300   IFMIN>GI:MIN=GI
 1310   IFMIN>BI:MIN=BI
 1320   IFMAX=0:S=0:V=0:GOTO1360
 1330   V=MAX
 1340   S=(MAX-MIN)/MAX
 1350   IFMAX=MIN:S=0
 1360   IFS=0:H=999:GOTO1440
 1370   RC=(MAX-RI)/(MAX-MIN)
 1380   GC=(MAX-GI)/(MAX-MIN)
 1390   BC=(MAX-BI)/(MAX-MIN)
 1400   IFRI=MAX:H=BC-GC
 1410   IFGI=MAX:H=2+RC-BC
 1420   IFBI=MAX:H=4+GC-RC
 1430   H=H*60:IFH<0:H=H+360
 1440   ENDPROC
 1450   DEFPROCHVS_RGB
 1460   LOCALI,F,P,Q
 1470   CERR=0
 1480   IFH>400:RI=V:GI=V:BI=V:GOTO1580
 1490   IFS=0ANDH<361:CERR=1:ENDPROC
 1500   IFH=360:H=0
 1510   H=H/60:I=INTH:F=H-I:P=V*(1-S):Q=V*(1-(S*F)):T=V*(1-(S*(1-F)))
 1520   IFI=0:RI=V:GI=T:BI=P
 1530   IFI=1:RI=Q:GI=V:BI=P
 1540   IFI=2:RI=P:GI=V:BI=T
 1550   IFI=3:RI=P:GI=Q:BI=V
 1560   IFI=4:RI=T:GI=P:BI=V
 1570   IFI=5:RI=V:GI=P:BI=Q
 1580   RI=INT(RI*15+.5):GI=INT(GI*15+.5):BI=INT(BI*15+.5)
 1590   ENDPROC
 1600   DEFPROCFILE(D%):CLS:*.
 1610   PRINT"Enter file to ";:IFD%:PRINT"save"ELSEPRINT"load"
 1620   INPUTLINE": "C$
 1630   IFD%=1:P%=OPENOUTC$ELSEP%=OPENINC$
 1640   IFP%=0:PRINT"Can't open file";:A=GET:CLS:ENDPROC
 1650   IFD%=0:D%=BGET#P%:PTR#P%=0:IFD%<>19:D%=255
 1660   FORA=0TO15:L=A
 1670     IFD%=1:BPUT#P%,19:BPUT#P%,L:BPUT#P%,16:BPUT#P%,R%(L)*17:BPUT#P%,G%(L)*17:BPUT#P%,B%(L)*17
 1680     IFD%=255:INPUT#P%,R%(L),G%(L),B%(L)
 1690     IFD%=19:A%=BGET#P%:L=BGET#P%:A%=BGET#P%:R%(L)=BGET#P%DIV16:G%(L)=BGET#P%DIV16:B%(L)=BGET#P%DIV16
 1700   NEXT:CLOSE#P%:C$=CHR$(N+48):CLS:PROCall:ENDPROC
 1710   DEFPROCerr:REPORT:PRINT''" Press SPACE to continue,"
 1720   PRINT"  Q to quit,"''" or insert your games disk and press"
 1730   PRINT"  B to boot it."
 1740   A=GETAND&DF:IFA=81:END ELSE IFA<>66:ENDPROC
 1750   ONERROROFF
 1760   *DIR $
 1770   *EXEC !BOOT