PROGRAM ShadeSelect

? This program is based on an AmigaBasic example from Ahoy!'s AmigaUser
? written by Tom Griffin. It was converted to F-Basic by DNS, Inc.

? The program allows the user to select any of the 4096 shades of color
? produced by the Amiga and display ten of them on the screen at once
? for comparision purposes.

? To begin, wait until the screen is fully drawn and the ten palettes
? are set to their random beginning colors. Then, toggle the RED, BLUE,
? and GREEN indicators in the upper left corner ON and OFF using the
? '(', ')', and '/' keys respectively. The Increment box shows the current
? input value and whether it is positive or negative. The numeric keys
? 1-9 will change any of the colors turned ON by the amount of the key.
? The background can be complemented by pressing the '*' key.
? The colors can be "cycled" by hitting the return key. This means that
? the colors are moved across the scale one place to the right. The next
? color can then be generated, starting with the previous color. The display
? can be reset to a random beginning with the '.' key.
? To exit, press the zero key twice in succession.


INTEGER PLUS,A,L,X1,X2,Y1,Y2,M,LCT,LOOP,TOGR,VARY,TOGG,TOGB,BKGD,EXT
INTEGER SCREENPTR,WINDPTR,GINT,R(10),G(10),B(10)
TEXT*13 RD,GR,BL,GG*1

DATA (RD,"<<RED---OFF>>"),(GR,"<<GREEN-OFF>>"),(BL,"<<BLUE--OFF>>")
DATA (PLUS,1),(LOOP,1),(A,3),(X1,119),(Y1,11),(X2,167),(Y2,77)
DATA (GINT,0),(VARY,0),(TOGG,0),(TOGB,0),(TOGR,0),(BKGD,0),(EXT,0)

SCREENPTR=SCREEN #1 (0,200,4,2,0)
WINDPTR=WINDOW #1 (0,0,617,185,30,30,617,185,-1,-1,1,@"ShadeSelect",1)
RANDOMIZE(1001)
CURS_INV

? draw the screen
COLOR_DEFINE #0  (15,15,15)
COLOR_DEFINE #1  (0,0,0)
COLOR_DEFINE #13 (15,0,0)
COLOR_DEFINE #14 (0,15,0)
COLOR_DEFINE #15 (3,6,15)
FOR L=3 TO 13
   COLOR_DEFINE #L (A,A,A) ; INC(A)
NEXT L
CURS_LOC(3,2) ; PRINT RD,
CURS_LOC(4,2) ; PRINT GR,
CURS_LOC(5,2) ; PRINT BL,
CURS_LOC(7,3) ; PRINT "INCREMENT",
CURS_LOC(8,5)    ; PRINT "+",    ; PRINT GINT[4],

? keymap
CURS_LOC(14,56) ; PRINT "Red  Grn  Blu Bkgd."
CURS_LOC(16,56) ; PRINT " 7    8    9    -   "
CURS_LOC(18,56) ; PRINT " 4    5    6    +   "
CURS_LOC(20,56) ; PRINT " 1    2    3  Cycle "
CURS_LOC(22,56) ; PRINT "Exit x 3 Reset",
COLOR_BOX #15 (0,15,47,104,71)
COLOR_BOX #15 (0,432,100,591,179)
COLOR_LINE #15 (0,432,116,591,116)
COLOR_LINE #15 (0,432,131,591,131)
COLOR_LINE #15 (0,432,147,591,147)
COLOR_LINE #15 (0,432,163,551,163)
COLOR_LINE #15 (0,471,100,471,163)
COLOR_LINE #15 (0,511,100,511,179)
COLOR_LINE #15 (0,551,100,551,179)

?scale 1
COLOR_BOXFILL #2 (0,119,2,599,96)
COLOR_BOX #1 (0,119,2,599,96)
FOR L=1 TO 10
   COLOR_BOX #15 (0,X1,Y1,X2,Y2)
   M=L+3
   COLOR_FLOOD #M (X2-1,Y2-1,15)
   INC(X1,48)
   INC(X2,48)
NEXT L
COLOR_BOX #1 (0,119,2,599,96)
COLOR_LINE #1 (0,119,77,125,77)
COLOR_LINE #1 (0,593,77,599,77)

? scale2
FOR L=10 TO 1 STEP -1
   M=L+2
   COLOR_ELLIPSE #M (215,141,20+L*16,20+2*L)
   INC(M)
   COLOR_FLOOD #M (215,141,M-1)
NEXT L

{ResetIt}
COLOR_PENS (1,0)
LCT=16
FOR L=1 TO 10
   M=L+3
   R(L)=RANDOM()\16 ; G(L)=RANDOM()\16 ; B(L)=RANDOM()\16
   COLOR_DEFINE #M (R(L),G(L),B(L))
   CURS_LOC(2,LCT) ; PRINT R(L)[5],
   CURS_LOC(3,LCT) ; PRINT G(L)[5],
   CURS_LOC(4,LCT) ; PRINT B(L)[5],
   INC(LCT,6)
NEXT L

{GetIt}
GG=INCHAR()
IF GG=CHAR(13) THEN
   LOOP=10
   GOTO Cycle
ELSEIF GG>"0" AND GG<="9" THEN
   GOTO Cycle
ELSEIF GG="." THEN
   GOTO ResetIt
ELSEIF GG="+" THEN
   PLUS=1 ; COLOR_PENS(1,0) ; CURS_LOC(7,5) ; PRINT "+",
ELSEIF GG="-" THEN
   PLUS=-1 ; COLOR_PENS(1,0) ; CURS_LOC(7,5) ; PRINT "-",
ELSEIF GG="(" AND TOGR THEN
   DEC(VARY) ; TOGR=0 ; CURS_LOC(2,2) ; RD(9:11)="OFF" ; PRINT RD,
ELSEIF GG="(" THEN
   INC(VARY) ; TOGR=1 ; CURS_LOC(2,2) ; RD(9:11)="-ON" ; PRINT RD,
ELSEIF GG=")" AND TOGG THEN
   DEC(VARY,2) ; TOGG=0 ; CURS_LOC(3,2) ; GR(9:11)="OFF" ; PRINT GR,
ELSEIF GG=")" THEN
   INC(VARY,2) ; TOGG=1 ; CURS_LOC(3,2) ; GR(9:11)="-ON" ; PRINT GR,
ELSEIF GG="/" AND TOGB THEN
   DEC(VARY,4) ; TOGB=0 ; CURS_LOC(4,2) ; BL(9:11)="OFF" ; PRINT BL,
ELSEIF GG="/" THEN
   INC(VARY,4) ; TOGB=1 ; CURS_LOC(4,2) ; BL(9:11)="-ON" ; PRINT BL,
ELSEIF GG="*" AND BKGD THEN
   COLOR_DEFINE #0 (15,15,15) ; COLOR_DEFINE #1 (0,0,0) ; BKGD=0
ELSEIF GG="*" THEN
   COLOR_DEFINE #0 (0,0,0) ; COLOR_DEFINE #1 (15,15,15) ; BKGD=1
ELSE
   GOTO Bottom
ENDIF
GOTO GetIt

{Bottom}
IF EXT>=1 THEN
   SCR_BEEP
   WINDOW_CLOSE #1
   SCREEN_CLOSE #1
   STOP
ENDIF
IF GG="0" THEN
   INC(EXT)
   SCR_BEEP
   GOTO GetIt
ENDIF

{Cycle}
GINT=0
IF GG>"0" AND GG<="9" THEN GINT=IVAL(GG)
COLOR_PENS (1,0)
CURS_LOC(7,7)
PRINT GINT[3],
GINT=GINT*PLUS
FOR L=LOOP TO 2 STEP -1
   R(L)=R(L-1) ; G(L)=G(L-1) ; B(L)=B(L-1)
NEXT L
ON VARY GOSUB VFF,FVF,VVF,FFV,VFV,FVV,VVV
IF R(1)>15 THEN R(1)=15
IF R(1)<0  THEN R(1)=0
IF G(1)>15 THEN G(1)=15
IF G(1)<0  THEN G(1)=0
IF B(1)>15 THEN B(1)=15
IF B(1)<0  THEN B(1)=0
LCT=16
FOR L=1 TO LOOP
   M=L+3
   COLOR_DEFINE #M (15,15,15)
   CURS_LOC(2,LCT) ; PRINT R(L)[5],
   CURS_LOC(3,LCT) ; PRINT G(L)[5],
   CURS_LOC(4,LCT) ; PRINT B(L)[5],
   COLOR_DEFINE #M (R(L),G(L),B(L))
   INC(LCT,6)
NEXT L
LOOP=1 ; EXT=0
GOTO GetIt

{VFF} R(1)=R(1)+GINT ; LRETURN
{FVF} G(1)=G(1)+GINT ; LRETURN
{VVF} R(1)=R(1)+GINT ; G(1)=G(1)+GINT ; LRETURN
{FFV} B(1)=B(1)+GINT ; LRETURN
{VFV} R(1)=R(1)+GINT ; B(1)=B(1)+GINT ; LRETURN
{FVV} G(1)=G(1)+GINT ; B(1)=B(1)+GINT ; LRETURN
{VVV} R(1)=R(1)+GINT ; B(1)=B(1)+GINT ; G(1)=G(1)+GINT ; LRETURN
END