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 <color> and high in <color>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"
*************