SRL Archive - Other Scripts

I dont think this has been made before in scar.. Type your question and change the font if you want and press start. Script then draws the question and the answer on a canvas.

// Magic eightball
// ask a question and SCAR will answer ;)
// answer is drawn on a canvas. I may actually make it look like a ball in next
// version.
// made by Harled.
program M8B;

const
  Question = 'Does SCAR pwn?';
  DaFont = 'Arial'; // Font to use? i recommend not touching

type
  TAnswer = record
    Ans: string;  // text for answer
    Col: Integer; // color.
  end;

var
  Answer: array of TAnswer;
  BackGround, I: Integer;
  TheCanvas: TCanvas;

procedure LoadAnswers;
begin
  SetArrayLength(Answer, 13);
  
  Answer[0].Ans := 'Yes...'; // text.
  Answer[1].Ans := 'No...';
  Answer[2].Ans := 'Maybe...';
  Answer[3].Ans := 'I hope so...';
  Answer[4].Ans := 'Im not sure...';
  Answer[5].Ans := 'You never know..';
  Answer[6].Ans := 'Perhaps...';
  Answer[7].Ans := 'Of course... Not?';
  Answer[8].Ans := 'Most likely...';
  Answer[9].Ans := 'Yep...';
  Answer[10].Ans := 'Nop...';
  Answer[11].Ans := 'I cant answer that...';
  Answer[12].Ans := 'Sure...';
  	
  Answer[0].Col := clRed; // colors.
  Answer[1].Col := clBlack;
  Answer[2].Col := clGreen;
  Answer[3].Col := clPurple;
  Answer[4].Col := clBlue;
  Answer[5].Col := clNavy;
  Answer[6].Col := clDarkBrown;
  Answer[7].Col := clMaroon;
  Answer[8].Col := clBronze;
  Answer[9].Col := clNeonBlue;
  Answer[10].Col := clMonkeyGreen;
  Answer[11].Col := clQuartz;
  Answer[12].Col := clFirebrick;
end;

procedure MakeCanvas;
begin
  BackGround := BitmapFromString(250, 45, ''); // make blank bitmap
  FastDrawClear(Background, clWhite); // Make it white
  DisplayDebugImgWindow(250, 45); // display debug window
  SafeDrawBitmap(BackGround, GetDebugCanvas, 0, 0); // draw it.
end;

begin
  ClearDebug;
  MakeCanvas;
  LoadAnswers;
  I := Random(13); // randomizes answer.
  TheCanvas := GetDebugCanvas;
  with TheCanvas do
  begin
    Font.Name := DaFont;
    Font.Size := 7;
    Font.Color := clNavy;
    TextOut(0, 0, 'Your question: '+Question);
  end;
  Writeln('Just a second...');
  Wait(2000);
  with TheCanvas do
  begin
    Font.Name := DaFont;
    Font.Size := 20;
    Font.Color := Answer[I].Col;
    TextOut(0, 11, Answer[I].Ans);
  end;
end.

It comes up with the question when it is run…
but then it closes and says succesfully executed without giving an answer