Code:
// ==============================================================================
// ColorX
// 1/21/2017
// adapted from ColorCube - jfs 2014-06-06
//
// View and select colors from an RGB pallete.
// Displays RGB color values.
//
// Px, 1="8 Colors", 2="27 Colors", 3="64 Colors", 4="125 Colors",
// 5="216 Colors",//6="729 Colors", 7="Toggle Outlines",
// 8="Change Z-Axis", 9="", 10="", 11="Exit");<-once a choose box
//
// ==============================================================================
TRC:=0; // Help locate the cause of errors since HP' doesn't help
Px,Wt,Xcur:=0,Ycur:=0; // Mode, WAIT(-1) results, X,Y cursors
Xoff,Yoff; // X,Y cursor erase locations
Fine:=0,RBas:=0,GBas:=0,BBas:=0; // fine display flag, Color Bases
Drgx,Drgy,Wta; // drag variables
Dfg,Sfg,Rfg,Gfg; // Drag, Stretch, Rotate, GreyScale flags
Swfg:=0,Swx,Swy; // Swipe flags
Tfg,Dwfg; // outline transpositions flag,Draw all rectangles flag
RB:={"R","G","B"}; //
RR,GG,BB; // save R,G,B for outlining transpositions
Rd,Gn,Bu; // RGB color values (reassigned by Z-axis selections)
Rd1,Gn1,Bu1; // alternate storage of RGB color values
X0,Y0,dX,dY,Gp; // current slice base X,Y; display sheet dX,dY;Gap
CO,Clr,Ct:=3,Ch;
Csl;
Csel:={1,2,3};
Px0:=2,St,Bs,OL:=0;
a,b;
Rw,Cl;
Sel:=#FF00h,Hst:=#FFh;
NRw,NCl,dC,dC0:=#20h;
Xmn:=12,Ymn,Xmx,Ymx,Xln,Yln;
// Reference Matrix [[available color steps], [X length of display color bars], [Y height of displayed color bars]]
M10:=[[#FFh,#80h,#55h,#40h,#33h,#20h],
[73,32,37,19,15,10],
[73,40,23,18,15,6]];
// Subroutine declarations
Button();Drag();Stretch();Touch();Keypress();ColorBase();int2byt();
Rot();Cursr();Intensity();Decomp();Outlines();Help();Swipe();
EXPORT Ref:=#FF0000h;
EXPORT ColorX()
BEGIN
LOCAL X,Y,R,G,B; // current X,Y;For/Nxt R,G,B;
IFERR
SUBGROB(G0,G3); // Save caller's display, just in case
Px:=Px0; // Px=last Px
Dfg:=0;Sfg:=0;Rfg:=0; // zero drag,stretch,Rot, flags
Tfg:=0;Dwfg:=1;Xoff:=0;Yoff:=0; // transpose,draw flags, old X,Y
RECT;DRAWMENU(8,27,64,125,216,729); // draw menu one time
DIMGROB_P(G1,320,220); // 0,0 to 319,219; won't overdraw buttons
REPEAT
TRC:=20;
IF Dwfg THEN // From here through for/next loops only if Dwfg
IF Px==11 THEN BREAK; END; // ColorX Exit; Break from Repeat
IF Px==7 THEN OL:=(OL+1)MOD5;END; // Sequence Outline Mode
IF Px==8 THEN // Change Z-axis alike changing vertices of hexagon
a:=Csel(2);Csel(2):=Csel(Ct); // 123-132-312-321-231-213-123...
Csel(Ct):=a;Ct:=2+(-1)^(Ct>2); // Ct toggles between 1&3
END; // the Ct manipulation is a toggle between 1 and 3
IF Px>6 THEN Px:=Px0;END; // restore previous Px seclectn and draw
Xln:=M10(2,Px);
Yln:=M10(3,Px);
Xmn:=12;Ymn:=22+23*(Px<3); // Ymn= 45,45,22,22,22,22
NRw:=1+(Px>2)+(Px>5); // Number of display rows = 1,1,2,2,2,3
NCl:=2+(Px==2)+(Px>3); // Number of display columns = 2,3,2,3,3,3
Gp:=2+(Px==5); // Gap between Display Slices
TRC:=40; // Color values current mode to CO
IF Fine THEN
CO:=dC*{0,1,2};
ELSE
a:=1; CO:={0};dC:=M10(1,Px);
WHILE CO(a)<#FFh DO
a:=a+1;CO(a):=CO(a-1)+dC;
END;// WEnd
CO:=BITAND(CO,#1F8h);
//MAKELIST(BITAND(X*dC,#1F8h),X,0,IP((#100h)/dC)));causes error
END; // EndIf Fine
Bs:=SIZE(CO); // Bs is the number of slices & bars per slice
dX:=Bs*(Xln+1)+Gp; // dX,dY are the X,Y change per slice
dY:=Bs*(Yln+1)+Gp; // Gp is the gap between slices
Xmx:=Xmn+NCl*dX-Gp; // These are min max of the palette area
Ymx:=Ymn+NRw*dY-Gp;
TRC:=60;
RECT_P(G1,0,0,319,219); //enough preliminaries, draw the display
a:=RGB(255*(Csel(1)=1),
255*(Csel(1)==2),255*(Csel(1)==3)); //store first triangle color
TRIANGLE_P(G1,0,0,0,15,15,15,a); // draw lower left triangle
TRIANGLE_P(G1,1,0,16,0,16,15,RGB(255*(Csel(3)=1),255*(Csel(3)==2),255*(Csel(3)==3))); // draw upper right triangle
LINE_P(G1,0,0,15,15,a); //draw line since lwr left 3ang obstructed
St:=RB(Csel(1))+"↕"+ RB(Csel(3))+"↔"+RB(Csel(2))+"↗"; // RB is {"R","G","B"}
TEXTOUT_P(St,G1,17,0,1); // print the "R!B!G!" text
// print the current outline mode
TRC:=65;
CASE
IF OL==0 THEN St:="OUTLINES.0";END;
IF OL==1 THEN St:="TRANSP0SE";END;
IF OL==2 THEN St:=" MAIN 8";END;
IF OL==3 THEN St:=" MAIN 27";END;
IF OL==4 THEN St:=" GRAYS";END;
END;//EndCase
TEXTOUT_P(St,G1,61,0,1);
LINE_P(G1,17,9,114,9);LINE_P(G1,60,0,60,9); // Box those touch areas
LINE_P(G1,114,0,114,9);
TRC:=70;
IF Fine THEN
TRC:=75;
RECT_P(G1,2,Ymx+10,Xmn+3*Xln-2,216,#C0C0C0h); // dC slide bar
TEXTOUT_P("ΔColor = "+SETBASE(dC,4),G1, 13,185,2); // print dC in slide bar
TEXTOUT_P("! or -,+ Keys",G1,15,202,2); // a little help info
RECT_P(G1,Xmn+3*Xln+2,Ymx+10,Xmx-3*Xln-3, 216,255*256^(3-Csel(2))); // "Gn" slide bar,bounds are Xmn+3*Xln & Xmx-3*Xln-1
TEXTOUT_P("!",G1,151,175,7);
TEXTOUT_P("or Plot,View Keys",G1,122,205,1);
RECT_P(G1,Xmx-3*Xln+1,Ymx+10,317,216,#C0C0C0h); // Brightness Bar
TEXTOUT_P("Brightness x",G1,236,180,2); // The intensity factor is
TEXTOUT_P("! or Num,Menu",G1,230,205,1); // drawn later.
TEXTOUT_P("Fine",G1,116,0,2); // For my fellow densitrons
ELSE
TEXTOUT_P((Bs+2*(Bs==7))^3,G1,118,0,2); // Print number of colors
END; //EndIf Fine
// ----------------------------------------------------------------
// Main For / Next Loops
// These are still part of the big If Dwfg test
// ----------------------------------------------------------------
G:=0;//G will increment to 1 to begin following FOR/NEXT loops
FOR Rw FROM 1 TO NRw DO
FOR Cl FROM 1 TO NCl DO
TRC:=80;
G:=G+1;
IF G>Bs THEN BREAK; END; // Will happen in 125 color mode
X0:=Xmn+dX*(Cl-1); // X0,Y0 are minimum coords of each slice
Y0:=Ymn+dY*(Rw-1);
Gn:=GBas+CO(G);Gn:=Gn*(Gn>0)-8*(Gn==256);
// print the "green" color value if Bs^3 <= 27
IF Px<3 THEN
St:=STRING(SETBASE(Gn,4)); // It might actually be green, red, or
St:=RB(Csel(2))+"="+MID(St,2,DIM(St)-2); // blue if colors are
TEXTOUT_P(St,G1,X0+.5*dX-12,Ymx+1,1); // transposed.
END; //EndIF Px<3
// show that the HP' is working on something
IF NOT Fine THEN
TEXTOUT_P(".",265+5*G,206,3); // particularly in 729 mode
END; //EndIf not Fine
FOR R FROM 1 TO Bs DO
TRC:=100;
Y:=Y0+(Yln+1)*(R-1);
Rd:=RBas+CO(R);Rd:=Rd*(Rd>0)-8*(Rd==256);
IF Cl==1 THEN
St:=STRING(SETBASE(Rd)); // output left side "red" color values
St:=MID(St,2,DIM(St)-2);
If DIM(St)==1 then St:="0"+St;END;
TEXTOUT_P(St,G1,Xmn-12,Y+.5*Yln-3+5*(Px<3),1);
// also print R for red, etc. Bs^3 <= 27
IF Px<3 THEN
TEXTOUT_P(RB(Csel(1)),G1,3,Y+.5*Yln-8,1);
END; //EndIf Px<3
END; //EndIf Cl=1
FOR B FROM 1 TO Bs DO
TRC:=120;
X:=X0+(Xln+1)*(B-1);
Bu:=BBas+CO(B);Bu:=Bu*(Bu>0)-8*(Bu==256);
a:=X+.5*Xln-4; // print Bu value
IF (Rw+R)<3 THEN
St:=STRING(SETBASE(Bu,4));
St:=MID(St,2,DIM(St)-2);
If St=="0" then St:="00";END;
IF Px==6 THEN St:=LEFT(St,1);a:=a+3;END; // room for 1 digit Px=6
IF Px<3 THEN St:=RB(Csel(3))+"="+St;a:=a-7;END;
TEXTOUT_P(St,G1,a,Ymn-9,1);
END; //EndIf (Rw+R)<3
TRC:=140;
Csl:={0,0,0};Csl(Csel(1)):=Rd; // get color and draw the rectangles
Csl(Csel(2)):=Gn;Csl(Csel(3)):=Bu;
Rd1:=Csl(1);Gn1:=Csl(2);Bu1:=Csl(3); // Rd, Gn, Bu now true
Clr:=RGB(Rd1,Gn1,Bu1);
RECT_P(G1,X,Y,X+Xln,Y+Yln,Clr); // draw the rectangles
Ch:=#FFFFFFh*((Rd1+9*Gn1+Bu1)<1683); // white to black switch point
IF OL>1 THEN
Outlines(X,Y);END; // process outlines except transpose
END; //Next B
END; //Next R
END; //Next Cl
END; //Next Rw
TRC:=150; // This is still part of the bonus size "If Dwg" qualification.
IF NOT Tfg THEN
BLIT_P(0,22,G1,0,22,319,219);//G1 to G0 (If Dwfg, NOT Tfg)
END;
//meaning if not Dwfg
ELSE
BLIT_P(Xmn,Ymn,G1,Xmn,Ymn,Xmx,Ymx); // blit palette area only
END; //EndIf Dwfg
// ----------------------------------------------------------------
// Paint over old cursor, Draw cursor and Outline transpositions
// ----------------------------------------------------------------
TRC:=160; // paint over old cursor
Clr:=GETPIX_P(G1,Xoff-4,Yoff); // get over paint color
RECT_P(Xoff-3,Yoff-3,Xoff+3,Yoff+3,Clr); // overdraw old cursor G0
TRC:=190; // draw current cursor If cursor is in palette area
IF (Xcur>Xmn)*(Xcur<Xmx)*(Ycur>Ymn)*(Ycur<Ymx) THEN
Sel:=GETPIX_P(Xcur,Ycur); // rectangle color -> selected color
Decomp(Sel); // Get cursor color to Ch
ARC_P(Xcur,Ycur,3,Ch); // draw a circle to indicate selection
// If OL=1, outline the transpositions.
IF (OL==1)*(NOT Fine) THEN
Csl:={RR,GG,BB};
// R and Csl are just handy variables here
FOR b FROM 1 TO 5 DO
a:=Csl(2);Csl(2):=Csl(Ct); // RBG-BRG-BGR-GBR-GRB-RGB...
Csl(Ct):=a;Ct:=2+(-1)^(Ct>2); // Ct toggles between 1&3
R:=Csl(1);G:=Csl(2);B:=Csl(3);
Cl:=G MOD NCl;Rw:=IP(G/NCl);
X:=Xmn+Cl*dX+B*(Xln+1); // As a matter of preference you could
Y:=Ymn+Rw*dY+R*(Yln+1); // make this for b=1 to 6 and also
RECT_P(X,Y,X+Xln,Y+Yln,#FFFFFFh*((R+G+B+3)<1.8*Bs),#80000000h); // outline the current cursor position.
END; //Next b
END; //EndIf OL=1
END; //EndIF cursor in palette area
Dwfg:=1; // set drawing flag
// ----------------------------------------------------------------
// Draw Reference, Selection, History, Brightness Color Bars
// ----------------------------------------------------------------
TRC:=200; // draw reference color bar
b:=20-9*(OL>0)*(Px>2); // only half rectangles if Outlines
Ref:=SETBASE(Ref,4); // make sure it is printed hex
Decomp(Ref); // Decompose Ref and get Ch
RECT_P(G1,140,0,200,b,0,Ref); // outlined cursor selected color bar
TEXTOUT_P(Ref,G1,147,2,1,Ch); // print the selected color
IF (NOT OL)+(Px<3) THEN
TEXTOUT_P("Reference",G1,149,11,1,Ch); // Label the bar if room
END; //EndIf OL
Sel:=Decomp(Sel); // Decompose Sel, strip off 3 LSBs, get Ch
RECT_P(G1,200,0,260,b,0,Sel); // outlined cursor selected color bar
TEXTOUT_P(Sel,G1,207,2,1,Ch); // print the selected color
IF (NOT OL)+(Px<3) THEN
TEXTOUT_P("Selection",G1,210,11,1,Ch); // Label the bar if room
END; //EndIf OL
Hst:=Decomp(Hst); // Decompose Hst, strip off 3 LSBs, get Ch
RECT_P(G1,260,0,320,b,0,Hst); // draw an outlined history color bar
TEXTOUT_P(Hst,G1,267,2,1,Ch); // print the selected color
IF (NOT OL)+(Px<3) THEN
TEXTOUT_P("History",G1,274,11,1,Ch); // Label the bar if room
END; //EndIf OL
// The following upper portion blit reduces circumstantial flicker
BLIT_P(0,0,G1,0,0,319,21); // Ref,Sel,Hst G1->G0
IF Fine THEN
RECT_P(240,193,300,203,#C0C0C0h); // a small pre-print blank
St:=STRING(ROUND(2^(Gfg/4),5)); // Print Brightness factor
TEXTOUT_P(St,265-2.6*SIZE(St),193,2); // which may have changed and thus is printed in this unusual place.
END; //EndIf Fine
// ----------------------------------------------------------------
// Wait for Keypress or Touch Event
// ----------------------------------------------------------------
TRC:=210;
Px0:=Px;
Wt:=WAIT(-1); // Wait for touchpad or keypad event
MOUSE;
TRC:=211; // TRC=210 means program interrupt while waiting
// If Wt is a list, this is a touchpad even
IF TYPE(Wt)==6 THEN
// The first touch events would usually be code 0 or 3
CASE
// end of drag, stretch, rotate event
IF Wt(1)==2 THEN Dfg:=0;Sfg:=0;Rfg:=0;Dwfg:=0;END; // clean-up, reset flags
IF Wt(1)==3 THEN Button;END;
IF Wt(1)==7 THEN Dwfg:=0;END; // Can follow a pinch series; ignore
IF Swfg*(Wt(1)==1)THEN
Swfg:=Swfg+3; // An indicator for otherwise
TEXTOUT_P(".",Swfg,12,3);
END; // ignored AutoDrags.
IF Dfg+(Wt(1)==1) THEN Drag;END; // If Drg flag, execute Drag
IF Sfg+(Wt(1)==5) THEN Stretch;END; // If Stretch flag, Stretch
IF Rfg+(Wt(1)==6) THEN Rot;END; // If Rotate flag, Rot
DEFAULT
TRC:=250;
Wta:=Wt;Swfg:=0; // first touch for drag, stretch, rotate events
// Wait for type identification
WHILE (Wt(1)==0)+(Wt(1)==7) DO
Wt:=WAIT(-1);MOUSE;
END; //WEnd 0or7
Dwfg:=0; // don't draw palette on next scan
CASE
IF Wt(1)==1 THEN
Dfg:=1;Drag;
END; // set drag flag and process
IF Wt(1)==6 THEN
Rfg:=1;Rot;
END; // set rotate flag and process
IF Wt(1)==5 THEN
Sfg:=1;dC0:=dC;Drgx:=0; // set stretch flg, save dC, preset Drgx
Stretch;
END; // process Stretch
IF (Wt(1)==2) THEN
// wait for 3 to signify touch completed
WHILE Wt(1)<>3 DO
Wt:=WAIT(-1);
MOUSE;
END; //WEnd Wt<>3
// go process the touch
Touch
END; //EndIf 2
END; //EndCase
END; //EndCase
//meaning wait(-1) didn't return a list, it's a keypress
ELSE
Keypress;
END; //EndIf TYPE(Wt)==6
UNTIL Px=11; // Repeat, but exit ColorX upon Px=11
//----------------------------------------------------------------
//Exit ColorX, return Sel
//________________________________________________________________
RECT(Sel);WAIT(.5); // draw a sample screen
BLIT(G3); // restore caller's screen
DIMGROB(G1,0,0); // No use wasting memory...
DIMGROB(G2,0,0); // or is this stupid caution?
DIMGROB(G3,0,0);
// --------------------------------------------------------------
// Error Processing
// --------------------------------------------------------------
// From the IFERR Error on line# 50, executing just about any code in ColorX
// Pressing On key during screen draw creates error
THEN
CASE
// On key pressed while waiting,
If (TRC==210)+(TRC==490) THEN
// (User hit ATTN key [Off]) to get here
//
// MSGBOX( "RGB Color Code: " + Sel +
// CHAR(10)+ " Red: "+ L9(1)+" = "+B→R(L9(1))+
// CHAR(10)+ " Green: " + L9(2)+" = "+B→R(L9(2))+
// CHAR(10)+ " Blue: "+L9(3)+" = "+B→R(L9(3)) );
END; //Wait(-1)=210; Choose=490
DEFAULT
St:="Error at trace "+TRC;
MSGBOX(St);
MSGBOX("You may need to recompile to clear the error");
END; //EndCase
END; //END IFERR
int2byt(Sel);
IF SIZE(L9) == 3 THEN
MSGBOX( "RGB Color Code: " + Sel +
CHAR(10)+ " Red: "+ L9(1)+" = "+B→R(L9(1))+
CHAR(10)+ " Green: " + L9(2)+" = "+B→R(L9(2))+
CHAR(10)+ " Blue: "+L9(3)+" = "+B→R(L9(3)) );
ELSE
MSGBOX( CHAR(10)+ "RGB Color Code: " + Sel + CHAR(10)+" ");
END;
RETURN Sel;
END;
// ======================================================= END MAinline ===============================================================================
// ====================================================== BEGIN SUBROUTINES ===========================================================================
Touch()
BEGIN
TRC:=300;
Dwfg:=1; // Draw rectangles next scan if Dwfg <> 0
CASE
// If upper buttons touch
IF Wt(3)<21 THEN
// If not ref or history or selection,
IF Wt(2)<140 THEN
Px:=7+(Wt(2)<60); // touches along top row change Px to 7 or 8.
//Go to fine mode by touching one of three upper right bars
ELSE
TRC:=320; // Going to Fine mode
IF Wt(2)>260 THEN Sel:=Hst;END; // history color if X>260
IF Wt(2)<200 THEN Sel:=Ref;END; // reference color if X<200
Px:=2;Fine:=1;Gfg:=0;dC:=dC0;
Xln:=M10(2,2);Yln:=M10(3,2);
dX:=3*(Xln+1)+Gp;
Xoff:=0;Yoff:=0;ColorBase; // no false cursor erase;get colorbase
END; //EndIF Wt(2)<140
END; //EndIF Wt(3)<19
// touch on fine mode the slide bars
IF Wt(3)>(Ymx+5) THEN
CASE
// touch in delta Color bar
IF Wt(2)<(Xmn+3*Xln) THEN
IF Wt(2)<.5*(Xmn+3*Xln) THEN
dC:=dC-8*(dC>8); // left of left; decrease dC
ELSE
dC:=dC+8*(dC<#60h); // right of left; increase dC
END ;//EndIf LofL
ColorBase;
END; //EndIf Wt(2) left
//mid; touch in "Gn" color bar
IF Wt(2)<(Xmx-3*Xln-1) THEN
Xoff:=Xcur;Yoff:=Ycur; // in case a stale cursor needs death
IF Wt(2)<.5*(Xmn+Xmx-1) THEN // If left of mid;
Xcur:=Xcur-dX; // left of mid; reduce Gn
Dwfg:=0;Gfg:=0; // next scan cursor maintenance;reset GyScl flg
IF Xcur<Xmn THEN
GBas:=GBas-dC*((GBas-dC)>=0);
Xcur:=Xcur+dX;Dwfg:=1; // gotta draw it after all
END; // EndIf Xcur<Xmn
//meaning we are right of mid and need to increase "Green"
ELSE
CASE
IF Xcur<X0 THEN
Xcur:=Xcur+dX;Dwfg:=0;
END; // next scan cursor maintenance
IF (GBas+3*dC)<256 THEN
GBas:=GBas+dC;END;
END; //EndCase
END; //EndIf LofM
END; //EndIf Wt(2) mid
//Wt(2) right; touch in Brightness bar
DEFAULT
IF NOT Gfg THEN Hst:=Sel;END; // Sel->Hst when first mod GyScale
Gfg:=Gfg-1+2*(Wt(2)>(.5*(320+Xmx-3*Xln))); // increase or decrease GyScl flag
Intensity; // apply the intesity factor to Sel
END; //EndCase
END; //EndIf Wt(3)>(Ymx+5); End slide bar touches
// Default is a touch in the palette area
DEFAULT
Xoff:=Xcur;Yoff:=Ycur;Dwfg:=0; // Next scan cursor maintenance only
Xcur:=Wt(2);Ycur:=Wt(3);Gfg:=0; // new cursor loctn; GraySclFg off
Cursr; // lock cursor to rectangle center
Xcur:=Xcur-dX*(Px==4)*(Xcur>(Xmn+2*dX))*(Ycur>(Ymn+dY)); // 5 slice display always a pain
Hst:=Sel; // auto save selection if you touch the palette
END; //EndCase
END; //Touch
// =============================================== END Touch Subroutine =========================================================
//----------------------------------------------------------------
//Keypress Subroutine
//________________________________________________________________
Keypress()
BEGIN
TRC:=400;
Xoff:=Xcur;Yoff:=Ycur; //save cursor loc to over paint if required
Gfg:=Gfg*((Wt==11)+(Wt==13)+(Wt==45)+(Wt==50)); // Gfg reset unless deltaC keys or change brightness key.
CASE
IF Wt==-1 THEN END; // Do Nothing if Timeout (or Shift Key?41)
IF Wt==2 THEN a:=Ycur-Yln; // Cursor Up
If a>Ymn THEN
Ycur:=a;Cursr;Dwfg:=0; // Next scan cursor maintenance
ELSE RBas:=RBas-Fine*dC*((RBas-dC)>=0);
END;
END; //EndIf Wt==2
IF Wt==7 THEN a:=Xcur-Xln; // Cursor Left
If a>Xmn THEN
Xcur:=a;Cursr;Dwfg:=0; // Next scan cursor maintenance
ELSE BBas:=BBas-Fine*dC*((BBas-dC)>=0);
END;
END; //EndIf Wt==7
IF Wt==8 THEN a:=Xcur+Xln; // Cursor Right
IF (a<Xmx)*((Ycur<(Ymn+dY))+(Bs<>5))+(a<(Xmn+2*dX)) THEN
Xcur:=a;Cursr;Dwfg:=0; //Next scan cursor maintenance
ELSE BBas:=BBas+Fine*dC*((BBas+3*dC)<=#F8h);
END; //EndIf (a<Xmx)*...
END; //EndIf Wt==8
IF Wt==12 THEN a:=Ycur+Yln; // Cursor Down
IF (a<Ymx)*((Xcur<(Xmn+2*dX))+(Bs<>5))+(a<(Ymn+dY)) THEN
Ycur:=a;Cursr;Dwfg:=0; // Next scan cursor maintenance
ELSE RBas:=RBas+Fine*dC*((RBas+3*dC)<=#F8h);
END; //EndIf (a<Ymx)
END; //EndIf Wt==12
// "-" Key decrease dC
IF Fine*(Wt==45) THEN
dC:=dC-8*(dC>8);ColorBase;
END; //EndIf Wt==12
// "+" key increase dC
IF Fine*(Wt==50) THEN
dC:=dC+8*(dC<#60h);ColorBase;
END; //EndIf Wt==13
//Menu key incr, Num decr GryScl
IF Fine*((Wt==11)+(Wt==13)) THEN
IF NOT Gfg THEN Hst:=Sel;END; // Sel->Hst when first mod Gray Scl
Gfg:=Gfg+2*(Wt==13)-1; // increase or decrease Gfg
Intensity; // apply the intesity factor to Sel
END;
// Plot Key decrease Gn
IF Wt==6 THEN
TRC:=440;
Xcur:=Xcur-dX;Dwfg:=0; // next scan cursor maintenance
IF Xcur<Xmn THEN
IF Fine THEN
GBas:=GBas-dC*((GBas-dC)>=0);
Xcur:=Xcur+dX;Dwfg:=1; // gotta draw it after all
ELSE
Xcur:=Xcur+dX*NCl;
Ycur:=Ycur-dY; // next scan cursor maintenance
END; //EndIf Fine
END; //EndIf Xcur<Xmn
IF Ycur<Ymn THEN
Xcur:=Xcur-dX*(NCl-1);
Ycur:=Ycur+dY; // next scan cursor maintenance
END;
END; //EndIf Wt==6
// View Key increase Gn
IF Wt==9 THEN
TRC:=450;
IF Fine THEN
CASE
IF Xcur<X0 THEN
Xcur:=Xcur+dX;Dwfg:=0;
END; // next scan cursor maintenance
IF (GBas+3*dC)<256 THEN GBas:=GBas+dC;END;
END; //EndCase
ELSE
Dwfg:=0; // next scan cursor maintenance
IF (Xcur<X0)+(Ycur<Y0) THEN
Xcur:=Xcur+dX;
IF Xcur>Xmx THEN
Xcur:=Xcur-dX*NCl;Ycur:=Ycur+dY;
END; //EndIf Xcur>
END; //EndIf Xcur<
END; //EndIf Fine
END; //EndIf Wt=9
IF Wt==3 THEN Help;END; // Help -> Help Screen
IF (Wt=4)+(Wt==30) THEN Px:=11;END; // End program if Esc or Enter
// any other key, go to a RGB entry choose box
DEFAULT
TRC:=490;
Hst:=Sel;Gfg:=0; // reset Grey Scale flag when Hst modified
Sel:=B→R(Sel); // allow real or integer input after 6030 firmware update
INPUT(Sel,"Enter Color Selection", "Sel= ","Enter 0-#FFFFFFh or 0-16,777,215(decimal)");
TRC:=491;
If Fine THEN
ColorBase; // ColorBase only if Fine
ELSE
Sel:=Decomp(Sel); // ColorBase could cause error so don't
Xcur:=0;Ycur:=0; // Need this in case of coarse mode
END; //EndIf Fine
DRAWMENU(8,27,64,125,216,729); // "CHOOSE" wiped out our button menu
END; //EndCase
END; //Keypress
// ================================================== END Keypress Subroutine ==================================================================
//----------------------------------------------------------------
//Button Subroutine
//________________________________________________________________
// For touches of "buttons" at bottom of screen
Button()
BEGIN
TRC:=500;
//toward eliminating false Button detections
IF Wt(3)>218 THEN
Px:=1+IP(Wt(2)/53); // touches below 218 line are menu touches
IF Fine THEN dC0:=dC;END; // save for next entry to Fine Mode
Xcur:=0;Ycur:=0;Xoff:=0;Yoff:=0;
Fine:=0; RBas:=0;GBas:=0;BBas:=0;
END; //EndIf Wt(3)>218
END; //Button
// ========================================================= End Button Subroutine =============================================================
//----------------------------------------------------------------
//Drag Subroutine
//
//First entry should be Wt= current touch and Wta= 0or7 touch
//and Dfg=1.
//________________________________________________________________
Drag()
BEGIN
TRC:=600;
IF (Dfg==0)+(Wt(1)<>1) THEN Dfg:=0;RETURN;END; // usually won't happen; punt
TRC:=605;
// 1 if first time through subroutine
// 2 if reference or anything left of it
// 3 if selection,
// 4 if history,
// 5 if with color slices
// 6 if lower left screen (dC)
// 7 if lower mid screen "Gn"
// 8 if lower right (gray scale)
// Dfg >99 if incoherent Flick;
IF Dfg==1 THEN
Dfg:=2+(Wta(3)<25)*((Wta(2)>199)+(Wta(2)>259))+3*(Wta(3)>24)*(Wta(3)<(Ymx+5))+
(Wta(3)>=(Ymx+5))*(4+(Wta(2)>(Xmn+3*Xln))+(Wta(2)>(Xmx-3*Xln-1)))+ 99*Swipe;
END; // touch boundaries are Xmn+3*Xln & Xmx-3*Xln-1
TRC:=610;
// an incoherent Flick (swipe)
IF (Dfg>99) THEN
WHILE Wt(1)==1 DO
Wt:=WAIT(-1);MOUSE;
IF TYPE(Wt)<>6 THEN Wt:={2};END; //shouldn't happen... but
END;//WEnd
Dfg:=0;RETURN;
END; //EndIf Dfg>99
TRC:=620;
// drag sel>ref, sel>hst, hst>ref, ref>hst
IF Dfg<5 THEN
Drgx:=(Wt(2)-Wta(2))>0;
// any drag left from Sel ->Ref
IF (Dfg==3)*(NOT Drgx) THEN
Ref:=Sel;
END;
//any drag right from Sel ->Hst
IF (Dfg==3)*Drgx THEN
Hst:=Sel;Gfg:=0;
END; // reset Grey Scale flag when Hst modified
// any drag from Ref ->Hst
IF Dfg==2 THEN
Hst:=Ref;Gfg:=0;
END; // reset Grey Scale flag when Hst modified
//any drag from Hst ->Ref
IF Dfg==4 THEN
Ref:=Hst;
END;
// Wait for finger lift
While Wt(1)==1 DO
Wt:=WAIT(-1);MOUSE;
END; //WEnd
Dfg:=0;Dwfg:=0;RETURN; // Ref, Sel, Hst drag complete
END; //Dfg<5
TRC:=640;
Gfg:=Gfg*((Dfg==6)+(Dfg==8)); // Reset Gfg unless dC or intsty drag
IF Swipe THEN
Dfg:=Dfg+10; // flag swipes by Dfg>10
ELSE
Drgx:=Wt(2)-Wta(2); // Dragx = change since last saved x
Drgy:=Wt(3)-Wta(3); // Dragy ditto
END; //EndIf Swipe
TRC:=650;
// Dragging initialized in palette
IF Fine*(Dfg==5) THEN
// X scan gain less than Y because
IF Drgx<-.6*dC THEN
BBas:=BBas-dC*((BBas-dC)>=0); //palette area is broad & short.
Wta(2):=Wta(2)+Drgx;
END;
// seat of the pants scale factors
IF Drgx>.6*dC THEN
BBas:=BBas+dC*((BBas+3*dC)<256);
Wta(2):=Wta(2)+Drgx;
END;
IF Drgy<-.2*dC THEN
RBas:=RBas-dC*((RBas-dC)>=0);
Wta(3):=Wta(3)+Drgy;
END;
IF Drgy>.2*dC THEN
RBas:=RBas+dC*((RBas+3*dC)<256);
Wta(3):=Wta(3)+Drgy;
END;
RETURN;
END; //Dfg 5
TRC:=660;
// Dragging initialized in "Gn" bar
IF Fine*(Dfg==7) THEN
IF Drgx<-.2*dC THEN
GBas:=GBas-dC*((GBas-dC)>=0);
Wta(2):=Wta(2)+Drgx;
END;
IF Drgx>.2*dC THEN
GBas:=GBas+dC*((GBas+3*dC)<256);
Wta(2):=Wta(2)+Drgx;
END;
RETURN;
END; //Dfg 7
TRC:=665;// This section scales down dC, Brightness drags
//Must move 5 pixels to modify
WHILE (Dfg<10)*(ABS(Drgx)<5) DO
Wt:=WAIT(-1);Dfg:=Dfg*(Wt(1)==1); // dC or Brightness factor
MOUSE;
IF NOT Dfg THEN RETURN;END; // get out of town if not drag
Swipe; // check for swipe
IF Swx THEN // is it a horizontal swipe?
Dfg:=Dfg+10; // if so idicate by Dfg in teens
ELSE
Drgx:=Wt(2)-Wta(2); // Drgy not a concern here
END; //EndIf Wt(2)>319
END; //WEnd
TRC:=680;
// Dragging initialized in dC bar
IF Fine*(Dfg==6) THEN
dC:=dC-8*(dC>8)*(Drgx<0)+8*(dC<#60h)*(Drgx>0);
Wta(2):=Wta(2)+Drgx;
ColorBase;
RECT_P(50,24,100,34);
TEXTOUT_P(SETBASE(dC,4),50,24,1);
WAIT(.1); // more flicker elimination than text visibility
RETURN;
END; //Dfg 6
TRC:=690;
// also Gray Scale Flick // Dragging initialized in Gray Scale Bar
IF Fine*((Dfg==8)+(Dfg==18)) THEN
IF NOT Gfg THEN Hst:=Sel;END; //Sel->Hst when first mod Gray Scale
// Adust Gfg up down by one
REPEAT
Gfg:=Gfg+(Drgx>0)-(Drgx<0); // If flick, skip by powers of 2
UNTIL (Dfg==8)+((Gfg MOD4)==0);
RECT_P(250,24,319,34); // Blank a high visibility
TEXTOUT_P(ROUND(2^(Gfg/4),5), 250,24,1); // area and print GrySl Factor
Intensity; // apply the intesity factor to Sel
Wta(2):=Wta(2)+Drgx;
WAIT(.1); // wait a little so you can see the print
RETURN;
END;//Dfg 8
//Fall though if a swipe was detected. Swipe directions are
//preserved in Swx and Swy. Dfg is now 15 Palette,16 dC,
//17 "Gn". 18 Gray Scale is handled above, same as Dfg=8.
TRC:=700;
//palette flick left
IF Fine*(Dfg==15)*(Swx<0) THEN
BBas:=0;
END;
//palette flick right
IF Fine*(Dfg==15)*(Swx>0) THEN
BBas:=#F8h-2*dC;
END;
//palette flick up
IF Fine*(Dfg==15)*(Swy<0) THEN
RBas:=0;
END;
//palette flick down
IF Fine*(Dfg==15)*(Swy>0) THEN
RBas:=#F8h-2*dC;
END;
//"Gn" flick left
IF Fine*(Dfg==17)*(Swx<0) THEN
GBas:=0;
END;
//"Gn" flick right
IF Fine*(Dfg==17)*(Swx>0) THEN
GBas:=#F8h-2*dC;
END;
IF Fine*Swx*(Dfg==16) THEN
dC:=8+#58h*(Swx>0);ColorBase;
END; //dC flick L=1, R=40h
//as of firmware 6030, we will get no {2} to signify completion
Dfg:=0;
END; //Drag
// ======================================================== END Drag Subroutine ============================================================
//----------------------------------------------------------------
//Stretch Subroutine
//
//Expand or contract color via dC (delta Color)
//Alternate to pressing "-" and "+" keys
//Honestly this is fairly useless and should probably be
//neutered like Rotate.
//________________________________________________________________
Stretch()
BEGIN
TRC:=800;
Sfg:=(Wt(1)==5); // Should stay Wt(1)=5 until fingers lifted
IF NOT(Sfg*Fine) THEN RETURN;END;
Drgy:=Drgx; // save previous dC factor at Drgy
REPEAT
Wt:=WAIT(-1);MOUSE;
// Are we still stretching?
IF Wt(1)==5 THEN
Drgx:=IP((Wt(4)+Wt(5))/25); // simple but adequate here
ELSE Sfg:=0;RETURN;
END; // get out of here if not still stretching
UNTIL Drgx<>Drgy;
dC:=dC0+8*Drgx; // increase or decrease dC by x8 multiple
dC:=8*(dC<8)+dC*((dC>=8)*(dC<=#60h)) +#60h*(dC>#60h); // stay within dC limits
RECT_P(50,24,100,34); // print dC where you can see it
TEXTOUT_P(SETBASE(dC,4),50,24,1);
ColorBase; // keeps color selection coherent;
WAIT(.1); // for text visibilty and flicker reduction
END; //Stretch
// =========================================================== END Stretch Subroutine ============================================================
//----------------------------------------------------------------
//Rotate Subroutine (Does nothing
//________________________________________________________________
// Rotate sensed but it does nothing
Rot()
BEGIN
TRC:=890;
WHILE Wt(1)==6 DO
Wt:=WAIT(-1);MOUSE;
END; // do nothing if rotate
Rfg:=0;
END; //Rot
// ================================================================ End Rotate Subroutine ==========================================================
//----------------------------------------------------------------
//Decomp Subroutine
//________________________________________________________________
Decomp(a)
BEGIN
TRC:=900;
a:=BITAND(a,#F8F8F8h);
Rd1:=IP(a/65536);Gn1:=a MOD 65536; // decompose color to Rd,Gn,Bu
Bu1:=Gn1 MOD 256;Gn1:=IP(Gn1/256);
Ch:=#FFFFFFh*((Rd1+9*Gn1+Bu1)<1683); // white to black switch point
RETURN(SETBASE(a,4)); // return in hex with 3 LSBs stripped
END;
// =========================================================== END Decomp Subroutine ===============================================================
//----------------------------------------------------------------
//ColorBase Subroutine
//________________________________________________________________
// Set color base entering or adjusting fine mode
ColorBase()
// In course mode, the color bases are zero
BEGIN
TRC:=1000;
Xcur:=162;Ycur:=106;
Sel:=Decomp(Sel); // decompose sel to Rd,Gn,Bu with 3 LSBs stripped
Csl:={0,0,0}; // This section accounts for RG:B permutations
Csl(1):=Rd1;Csl(2):=Gn1;Csl(3):=Bu1;
Rd:=Csl(Csel(1));Gn:=Csl(Csel(2));
Bu:=Csl(Csel(3));
RBas:=Rd-dC;GBas:=Gn-dC;BBas:=Bu-dC;
WHILE RBas<0 DO
RBas:=RBas+dC;Ycur:=Ycur-Yln;
END;
WHILE BBas<0 DO
BBas:=BBas+dC;Xcur:=Xcur-Xln;
END;
WHILE GBas<0 DO
GBas:=GBas+dC;Xcur:=Xcur-dX;
END;
WHILE (RBas+2*dC)>#F8h DO
RBas:=RBas-dC;Ycur:=Ycur+Yln;
END;
WHILE (BBas+2*dC)>#F8h DO
BBas:=BBas-dC;Xcur:=Xcur+Xln;
END;
WHILE (GBas+2*dC)>#F8h DO
GBas:=GBas-dC;Xcur:=Xcur+dX;
END;
END; //ColorBase
// =============================================================== END Colorbase Subroutine =================================================
//----------------------------------------------------------------
//Intensity Subroutine
//________________________________________________________________
// apply Brighness changes to Sel
Intensity()
BEGIN
TRC:=1100;
Decomp(Hst);a:=2^(Gfg/4);
Rd:=a*Rd1*((a*Rd1)<256)+255*(a*Rd1>=256); // err if Rd,Gn,Bu>256
Gn:=a*Gn1*((a*Gn1)<256)+255*(a*Gn1>=256);
Bu:=a*Bu1*((a*Bu1)<256)+255*(a*Bu1>=256);
Sel:=RGB(Rd,Gn,Bu);
ColorBase;
END; //Intensity
// =============================================================== END Intensity Subroutine =================================================
//----------------------------------------------------------------
//Outlines Subroutine
//________________________________________________________________
// Check for Gray, Main27, Main8 conditions
Outlines(X,Y)
// while drawing palette and outline
BEGIN
TRC:=1200;
CASE
IF (OL==4) THEN
// Gray outlines if OL = 4
IF (Rd==Gn)*(Rd==Bu) THEN
RECT_P(G1,X,Y,X+Xln,Y+Yln,
Ch,#80000000h);
END; //EndIf Rd...
END; //EndIf OL=4
// main 27 oultines if OL=3
IF OL==3 THEN
IF ((Rd==0)+(Rd==#80h)+(Rd==#F8h))*((Gn==0)+(Gn==#80h)+(Gn==#F8h))*((Bu==0)+(Bu==#80h)+(Bu==#F8h)) THEN
RECT_P(G1,X,Y,X+Xln,Y+Yln,
Ch,#80000000h);
END; //EndIf Rd...
END; //EndIf OL=3
// main 8 oultines if OL=2
DEFAULT
IF ((Rd==0)+(Rd==#F8h))* ((Gn==0)+(Gn==#F8h))*((Bu==0)+(Bu==#F8h)) THEN
RECT_P(G1,X,Y,X+Xln,Y+Yln,
Ch,#80000000h);
END; //EndIf Rd...
END; //End Case
END; //Outlines
// =============================================================== END Outlines Subroutine =================================================
//----------------------------------------------------------------
//Cursor Subroutine
//________________________________________________________________
Cursr()
// Lock Xcur, Ycur to rectangle centers
BEGIN
TRC:=1300; // Row,Col(Xcur,Ycur)->Rw,Cl
Cl:=IP((Xcur-Xmn)/dX);a:=Xmn+dX*Cl; // R,G,B(Xcur,Ycur)->RR,GG,BB
BB:=IP((Xcur-a)/(Xln+1)); // RR,GG,BB saved for transpose outline
a:=a+(Xln+1)*BB;
Rw:=IP((Ycur-Ymn)/dY);b:=Ymn+dY*Rw;
RR:=IP((Ycur-b)/(Yln+1));
b:=b+(Yln+1)*RR;
Xcur:=a+.5*Xln;Ycur:=b+.5*Yln;
GG:=1+Rw*NCl+Cl; // compute GG
GG:=GG*(GG<=Bs)+Bs*(GG>Bs); //GG may be greater than 5 case Bs=5
GG:=GG-1; // RR,BB,GG vary from 0 to (Bs-1)
END; //Cursr
// =============================================================== END Cursr Subroutine =================================================
//----------------------------------------------------------------
//Swipe Subroutine
//________________________________________________________________
Swipe()
BEGIN
TRC:=1400;
Swx:=(Wt(2)>319)-(Wt(2)<0);
Swy:=(Wt(3)>239)-(Wt(3)<0);
Swfg:=Swx OR Swy;
Return(Swfg);
END; //Swipe
// =============================================================== END Swipe Subroutine =================================================
//----------------------------------------------------------------
//Help Subroutine
//________________________________________________________________
Help()
BEGIN
TRC:=1500;
SUBGROB(G0,G2);RECT;//Grid(X,1,A);
BLIT_P(80,60,239,179,G2);
a:=#FFFFFFh;
LOCAL L10:={80,60,239,60,80,70,239,70,
80,57,80,70,110,57,110,70,
150,57,150,70,180,57,180,70,
210,57,210,70,239,57,239,70,
90,180,100,190,100,190,105,190,
80+.5*Xmx,109,244,109,239,65,250,54,
95,60,85,50,85,50,52,50,
130,60,103,14,98,14,103,14,
165,60,150,45,195,60,203,52,
230,60,254,40};
TRC:=1510;
LOCAL L11:={"Touch Buttons to enter",106,186,
"Coarse Mode Displaying",106,196,
"8,27,64,125,216,729 Colors",106,206,
"Palette Area:",245,105,
"Touch to place",245,115,
"cursor.",245,125,
"Up, Dwn, Lft, Rt,",245,135,
"Plot, View keys",245,145,
"move the cursor.",245,155,
"The cursor",245,165,
"color fills",245,175,
"the Selection",245,185,
"touch/slide",245,195,
"bar above.",245,205,
"Touch Ref, Sel,",250,50,
"or Hst to enter",250,60,
"Fine Mode at",250,70,
"respective",250,80,
"selection.",250,90,
"Touch to",10,46,
"sequence",10,56,
"through",10,66,
"six possible",10,76,
"X,Y,Z Axis",10,86,
"color",10,96,
"assignments",10,106,
"Touch to sequence",10,10,
"through outlines of",10,20,
"interesting colors",10,30,
"Reference:",123,15,
"Global Var Ref",123,25,
"Slide to Hist",123,35,
"Selection:",192,15,
"Returned Val",192,25,
"Slide to Ref",192,35,
"or to Hist",192,45,
"History:",255,15,
"Auto from Sel",255,25,
"Slide to Ref",255,35};
TRC:=1520;
RECT_P(80+.5*Xmn,60+.5*Ymn,80+.5*Xmx,60+.5*Ymx,0,#80000000h);
IF Fine THEN
TEXTOUT_P("Fine",108,0,2);
L10:=CONCAT(L10,68,139,80,151,59,139,68,139);
L11:=CONCAT(L11,"Fine Mode",10,135, "Drags, Swipes,",10,145,"and Left/Right",10,155,
"Touches:",10,165, "Delta Color",10,175); //Concat / append limited to 16 items. why?
L11:=CONCAT(L11,"Z-Axis Color",10,185, "Brightness",10,195);
ELSE
TEXTOUT_P("Coarse",93,0,2);
L10:=CONCAT(L10,64,139,85,139);
L11:=CONCAT(L11,"Pallete Area",10,135, "Drags and",10,145,"Swipes",10,155,
"Inactive in",10,165, "Coarse Mode",10,175);
END; //EndIf Fine
TEXTOUT_P("Mode Overview",133,0,2);
TRC:=1530;
FOR b FROM 1 TO SIZE(L10) STEP 4 DO
LINE_P(L10(b),L10(b+1),L10(b+2),L10(b+3));
END; //next b
TRC:=1540;
FOR b FROM 1 TO SIZE(L11) STEP 3 DO
TEXTOUT_P(L11(b),L11(b+1),L11(b+2),1);
END; //next b
TRC:=1550;
L10:={};L11:={};
//DRAWMENU("","Keys","Outline","More","","");
//TEXTOUT_P("General",0,222,3,a);
DRAWMENU("");RECT_P(0,220,264,239);
// TEXTOUT_P(Rev,2,225,2);
TEXTOUT_P("RunAway",268,225,2,a);
WAIT(-1);MOUSE;
BLIT_P(G2); // Restore ColorX display
END; //End Help
// ============================================================ END Help Subroutine ===================================================================
// =======================================
// int2byt
// 01/22/2017
// -drd-
// Input: Integer
// Output: List of bytes in L9
// =======================================
int2byt(n)
BEGIN
n:=R→B(n);L9:={};
FOR I FROM IP(16 NTHROOT n) DOWNTO 0 DO
L9(0):=BITSR(n,I*8) AND #FF;
END;
RETURN L9;
END;
// ======================================================== END int2byt ==================================================================================
Search
Member List
Calendar
Help
/
How do you change the window title at the top...
