ScriptScoreColorScale

From 40tude Dialog Wiki

Program ScoreColorScale;

// by Vladimir Panteleev
// tested on 2.0.14.1 (beta 37)
// last update: 28-11-2004

// Description:
// This script will generate a set of scoring actions to set the 
// background color of articles in the article pane in shades of 
// user-specified colors, so articles with a bigger score will 
// be colored in darker shades. See the above screenshot - the 
// green number is the article score.
// Best used with body scoring (see [[ScriptXBody]]).

// Usage: 
// Put it in custom scripts, adjust the parameters below and run.
// Copy the text from the window and paste it into the "Scoring 
// and actions" window.

uses
  Forms, StdCtrls;

const   // some pre-defined colors
  Gray        = $010101;
  Blue        = $000101;
  Green       = $010001;
  Cyan        = $000001;
  Red         = $010100;
  Magenta     = $000100;
  Yellow      = $010000;
  Default     = $000000;
  
const   // settings start here
  YourName              = 'Vladimir Panteleev';
  
  // the maximum score articles can get by your rules
  // articles with score higher than this value will be 
  // colored like the ones with score = MaxScore
  MaxScore              = 30;
  
  // if you don't want posts with 1-2 score points to look ugly,
  // let's give all posts a starting color boost
  StartingColor         = 15;

  // MaxScore/Resolution rule lines will be generated, 
  // so the lower the more color definitions you will get
  Resolution            = 1;

  PostBGColor           = Blue;
  PostBGColorDepth      = 3*30;
  PostFGColor           = Default;
  
  // settings for posts with YourName in the From field
  MyBGColor             = Red;
  MyBGColorDepth        = 3*30;
  MyFGColor             = Default;
  
var
  Output: String;

function MakeColor(Score, BaseColor, ColorDepth: Integer): Integer;
begin
  Result:=$FFFFFF - (BaseColor * ColorDepth * Score) div MaxScore - (BaseColor*StartingColor);
end;

function ColorToString(Color: Integer): string;
begin
  if(Color=0)or(Color=$FFFFFF) then
    Result:='default'
  else
    Result:='$'+IntToHex(Color,6);
end;

procedure Work;
var
  Score: Integer;
begin
  Output:='';
  for Score:=1 to MaxScore do
    if Score mod Resolution=0 then
      Output:=Output+'!setcolor('+ColorToString(MyFGColor)+';'+
        ColorToString(MakeColor(Score, MyBGColor, MyBGColorDepth))+
        ') score %>'+IntToStr(Score-1)+#13#10;
        
  Output:=Output+#13#10;
  
  for Score:=1 to MaxScore do
    if Score mod Resolution=0 then
      Output:=Output+'!setcolor('+ColorToString(PostFGColor)+';'+
        ColorToString(MakeColor(Score, PostBGColor, PostBGColorDepth))+
        ') score %>'+IntToStr(Score-1)+' -@From:"'+YourName+'"'#13#10;
end;
  
var
  Form: TForm;
  Memo: TMemo;

begin
  Work;
  
  Form:=TForm.Create(nil);
  Form.Width:=500;
  Form.Height:=600;
  Form.Caption:='Scoring color scale generator';
  Memo:=TMemo.Create(Form);
  Memo.Parent:=Form;
  Memo.Align:=alClient;
  Memo.Font.Name:='Lucida Console';
  Memo.Font.Size:=8;
  Memo.Text:=Output;
  Memo.ScrollBars:=ssBoth;

  Form.ShowModal;
  Form.Free;
end.