Listing 2. ColorChange Deck ************* * Deck "ColorChange" * Time 01:15:43 * Date 01/23/94 ************* ************* * Card(s) in deck. * Card "ChangePalette" ************* * 1 Card(s), 1 were printed. ************* ************* * Natural order of Cards * Card "ChangePalette" ************* ************* * Global Routine(s) in deck. * Routine "Box" * Routine "GetColors" * Routine "ResetColors" * Routine "SetProps" ************* * 4 Global routines(s), 4 were printed. ************* ************* * Card "ChangePalette" AfterAttachment ; used to be AfterStartup Nop ;Get number of colors on screen and Nop ; determine number of rows and columns for palette Let MaxColor=WindowColors-1 Let NumRows=WindowColors%8 If NumRows=0 Let NumRows=1 Let NumCols=WindowColors Else Let NumCols=8 EndIf Nop ;Set upper left corner of palette area and Nop ; the increment size between color blocks Let StartX=100 Let StartY=17 Let IncX=80/NumCols Let IncY=40/NumRows Nop ;Loop to create rows and columns of the color palette Let I=0 Let J=0 Let X=0 Let Y=0 Loop Loop SetPen I+J*NumCols AreaRectangle StartX+X,StartY+Y,IncX-1,IncY-1 Let I=I+1 Let X=X+IncX Until I=NumCols Let I=0 Let J=J+1 Let X=0 Let Y=Y+IncY Until J=NumRows Nop ;Set draw mode and print RGB beside the sliders SetDrawMode JAM2 SetPen 1 PrintText "R",10,69 PrintText "G",10,79 PrintText "B",10,89 Nop ;Draw a rectangle around color 0 SetPen 0 Do "Box",1 Nop ;Set the sliders' positions for color 0 Do "SetProps" Nop ;Get the screen's initial colors Do "GetColors" Nop ;No pending command when user clicks on palette Let PendingCommand="None" EndScript Window "UserWindow" Definition Origin 20,20 Size 200,140 Title "Change Palette" NumberOfColors 2,69632 WindowColors 0,1,0 ; Detail, Block, Background WindowObjects CLOSEBUTTON DRAGBAR WindowFlags ACTIVATE TOFRONT EndScript OnCloseButton SendToParentDeck "Quit" Quit EndScript EndObject AreaButton "Palette" Definition Origin 97,15 Size 85,43 Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight NONE ButtonFlags NONE EndScript OnRelease Do "Box",0 ;Un-highlight current color Nop ;Determine newly selected color number Let CurX=MouseX Let CurY=MouseY Let CurRow=Min((CurY-StartY)%IncY+1,NumRows) Let CurCol=Min((CurX-StartX)%IncX+1,NumCols) Let PenNum=8*(CurRow-1)+(CurCol-1) Nop ;Get current pen's colors and handle pending commands GetRGB PenA,Red,Green,Blue If PendingCommand="Copy" SetRGB PenNum,Red,Green,Blue ElseIf PendingCommand="Exchange" GetRGB PenNum,Red2,Green2,Blue2 SetRGB PenA,Red2,Green2,Blue2 SetRGB PenNum,Red,Green,Blue ElseIf PendingCommand="Spread" Let PenDiff=Absolute(PenNum-PenA) If PenDiff>1 ;Only do this is pen spread is 2 or more Let StartPen=Min(PenA,PenNum) ;lowest pen number Nop ;Make sure low pen in and high in 2 If StartPen=PenA GetRGB PenA,Red,Green,Blue GetRGB PenNum,Red2,Green2,Blue2 Else GetRGB PenNum,Red,Green,Blue GetRGB PenA,Red2,Green2,Blue2 EndIf Nop ;Determine the color diffs between adjacent pens Let RedInc=(Red2-Red)/PenDiff Let GreenInc=(Green2-Green)/PenDiff Let BlueInc=(Blue2-Blue)/PenDiff Nop ;Loop to set intermediate pen colors Let CurPen=StartPen+1 While CurPen<=StartPen+PenDiff-1 Let NewRed=Red+(CurPen-StartPen)*RedInc Let NewGreen=Green+(CurPen-StartPen)*GreenInc Let NewBlue=Blue+(CurPen-StartPen)*BlueInc SetRGB CurPen,NewRed,NewGreen,NewBlue Let CurPen=CurPen+1 EndLoop EndIf EndIf SetPen PenNum ;Now make current pen the selected pen Nop ;Reset pending command and pointer Let PendingCommand="None" SetPointer AreaRectangle 10,17,20,39 ;Update current pen box Do "SetProps" ;Set the proportional objects' values for new pen Do "Box",1 ;Highlight new pen color EndScript EndObject AreaButton "CurrentColor" Definition Origin 8,15 Size 24,43 Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight NONE ButtonFlags NONE EndScript EndObject AreaProp "Red" Definition Origin 24,69 Size 140,8 MoveType HORIZONTAL Range 0,264,1,10 VisibleRange 10,1 InitialPosition 0,1 PropBorder TRUE EndScript OnNewPosition GetPropPosition "Red",NewPos GetRGB PenA,Red,Green,Blue ;Get old color SetRGB PenA,NewPos,Green,Blue ;Set new color Nop ;Print new Red value using color PenA PrintText FormatValue(NewPos,"000"),170,69 EndScript OnRelease Nop ;Print Red value using color 1 Let APen=PenA SetPen 1 PrintText FormatValue(NewPos,"000"),170,69 SetPen APen Nop ;In case this button was pressed after the Copy, Exchange, Nop ; or Spread buttons, reset pending command and pointer Let PendingCommand="None" SetPointer EndScript EndObject AreaProp "Green" Definition Origin 24,79 Size 140,8 MoveType HORIZONTAL Range 0,264,1,10 VisibleRange 10,1 InitialPosition 0,1 PropBorder TRUE EndScript OnNewPosition GetPropPosition "Green",NewPos GetRGB PenA,Red,Green,Blue ;Get old color SetRGB PenA,Red,NewPos,Blue ;Set new color Nop ;Print the new Green value using color PenA PrintText FormatValue(NewPos,"000"),170,79 EndScript OnRelease Nop ;Print new Green value using color 1 Let APen=PenA SetPen 1 PrintText FormatValue(NewPos,"000"),170,79 SetPen APen Nop ;In case this button was pressed after the Copy, Exchange, Nop ; or Spread buttons, reset pending command and pointer Let PendingCommand="None" SetPointer EndScript EndObject AreaProp "Blue" Definition Origin 24,89 Size 140,8 MoveType HORIZONTAL Range 0,264,1,10 VisibleRange 10,1 InitialPosition 0,1 PropBorder TRUE EndScript OnNewPosition GetPropPosition "Blue",NewPos GetRGB PenA,Red,Green,Blue ;Get old color SetRGB PenA,Red,Green,NewPos ;Set new color Nop ;Print the new Blue value using color PenA PrintText FormatValue(NewPos,"000"),170,89 EndScript OnRelease Nop ;Print Blue value using color 1 Let APen=PenA SetPen 1 PrintText FormatValue(NewPos,"000"),170,89 SetPen APen Nop ;In case this button was pressed after the Copy, Exchange, Nop ; or Spread buttons, reset pending command and pointer Let PendingCommand="None" SetPointer EndScript EndObject TextButton "Copy" Definition Origin 38,13 Font "topaz",8 ; FontName, PointSize PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2 TextColors 1,0,NORMAL ; PenA, PenB, DrawMode Text " Copy " Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight COMPLEMENT ButtonFlags NONE EndScript OnRelease Nop ;Turn on Copy pointer and assign pending command for Nop ; the Palette button SetPointer "CanDo:Brushes/Copy.br" Let PendingCommand="Copy" EndScript EndObject TextButton "Exchange" Definition Origin 38,31 Font "topaz",8 ; FontName, PointSize PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2 TextColors 1,0,NORMAL ; PenA, PenB, DrawMode Text " Exch " Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight COMPLEMENT ButtonFlags NONE EndScript OnRelease Nop ;Turn on the Exchange pointer and set the pending command Nop ; for the Palette button SetPointer "CanDo:Brushes/Exchange.br" Let PendingCommand="Exchange" EndScript EndObject TextButton "OK" Definition Origin 12,123 Font "topaz",8 ; FontName, PointSize PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2 TextColors 1,0,NORMAL ; PenA, PenB, DrawMode Text " OK " Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight COMPLEMENT ButtonFlags NONE EndScript OnRelease SendToParentDeck "Quit" ;Let parent know we are quitting Quit EndScript EndObject TextButton "Cancel" Definition Origin 121,123 Font "topaz",8 ; FontName, PointSize PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2 TextColors 1,0,NORMAL ; PenA, PenB, DrawMode Text " Cancel " Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight COMPLEMENT ButtonFlags NONE EndScript OnRelease Do "ResetColors" ;Restore original colors SendToParentDeck "Quit" ;Let parent know we are quitting Quit EndScript EndObject TextButton "Restore" Definition Origin 64,104 Font "topaz",8 ; FontName, PointSize PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2 TextColors 1,0,NORMAL ; PenA, PenB, DrawMode Text " Restore " Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight COMPLEMENT ButtonFlags NONE EndScript OnRelease Do "ResetColors" ;Restore the original colors Nop ;In case this button was pressed after the Copy, Exchange, Nop ; or Spread buttons, reset pending command and pointer Let PendingCommand="None" SetPointer EndScript EndObject TextButton "Spread" Definition Origin 38,49 Font "topaz",8 ; FontName, PointSize PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2 TextColors 1,0,NORMAL ; PenA, PenB, DrawMode Text " Sprd " Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen Highlight COMPLEMENT ButtonFlags NONE EndScript OnRelease Nop ;Turn on the Spread pointer and set the pending command Nop ; for the Palette button SetPointer "CanDo:Brushes/Spread.br" Let PendingCommand="Spread" EndScript EndObject * End of Card "ChangePalette" ************* ************* * Global routine "Box" Nop ;Determine the row and column of PenA Let Row=PenA%8 Let Column=PenA//8 Nop ;Determine the top left corner for the highlight box Let Top=StartY+Row*IncY-1 Let Left=StartX+Column*IncX-1 Nop ;Draw the highlight box using the pen number passed as Nop ; an argument to this routine Let APen=PenA SetPen Arg1 DrawRectangle Left,Top,IncX+1,IncY+1 SetPen APen * End of routine "Box" ************* ************* * Global routine "GetColors" Nop ;Loop to get all the RGB values for the pens Let I=0 Loop GetRGB I,R[I],G[I],B[I] Let I=I+1 Until I>MaxColor * End of routine "GetColors" ************* ************* * Global routine "ResetColors" Nop ;Loop to set all pen colors to original colors obtained Nop ; in GetColors routine Let I=0 Loop SetRGB I,R[I],G[I],B[I] Let I=I+1 Until I>MaxColor Do "SetProps" ;Set the proportional objects' values * End of routine "ResetColors" ************* ************* * Global routine "SetProps" Nop ;Get PenA's colors, print values, and set proportional Nop ; objects' values accordingly Let APen=PenA SetPen 1 GetRGB APen,Red,Green,Blue PrintText FormatValue(Red,"000"),170,69 PrintText FormatValue(Green,"000"),170,79 PrintText FormatValue(Blue,"000"),170,89 SetPropPosition "Red",Red SetPropPosition "Blue",Blue SetPropPosition "Green",Green SetPen APen * End of routine "SetProps" *************