SRL Archive - Other Scripts

No, not the game..I've already made one of them :) Wrote this on an impulse, I saw a neat effect and decided to remake it in SCAR.

program DragSnake;
//Ported to SCAR by Smartzkid
//Based on code from Keith Peters ([noparse]www.bit-101.com[/noparse])

const
  Size_X = 400;
  Size_Y = 400;
  
  SegLen = 5;
  Segments = 30;
  
  DrawThick = true;

var
  x, y: Array [0..Segments] of integer;
  segLength: integer;
  mx, my, i, bitmap: integer;
  can: TCanvas;
  
procedure setup;
begin
  bitmap := BitmapFromString(SIZE_X, SIZE_Y, '');
  DisplayDebugImgWindow(SIZE_X, SIZE_Y);
  FindWindow('Debug Image');
  segLength := SEGLEN;
  can := GetBitmapCanvas(bitmap);
  //can := GetClientCanvas;
  //^^Would have to implement an API call to SendMessage, then invalidate windows
  //as they are drawn apon, else you end up with bits and pieces of snake everywhere
  //(try it ;])
end;

procedure segment(j, xx, yy: integer);
begin
  can.Brush.Color := 16777215;
  can.MoveTo(xx, yy);
  can.LineTo(x[j + 1], y[j + 1]);
  if(DrawThick)then
    can.Ellipse(xx, yy, x[j + 2], y[j + 2]);
  SafeCopyCanvas(can, GetBitmapCanvas(bitmap), 0, 0, SIZE_X, SIZE_Y, 0, 0, SIZE_X, SIZE_Y);
end;

procedure dragSegment(i: integer; xin, yin: integer);
var
  dx, dy, angle: extended;
begin
  dx := xin - x[i];
  dy := yin - y[i];
  angle := ArcTan2(dy, dx);
  x[i] := Round(xin - cos(angle) * segLength);
  y[i] := Round(yin - sin(angle) * segLength);
end;

procedure draw;
begin
  GetBitmapCanvas(bitmap).FloodFill(1, 1, 14869218, 1);
  GetMousePos(mx, my);
  if(mx > SIZE_X)then
    mx := SIZE_X;
  if(my > SIZE_Y)then
    my := SIZE_Y;
  if(mx < 0)then
    mx := 0;
  if(my < 0)then
    my := 0;
  x[0] := mx;
  y[0] := my;
  for i := 0 to High(x) - 1 do
    dragSegment(i + 1, x[i], y[i]);
  for i := 0 to High(x) - 2 do
    segment(i, x[i], y[i]);
end;

procedure ScriptTerminate;
begin
  FreeBitmap(bitmap);
  can.free;
end;

begin
  setup;
  repeat
    draw;
    SafeDrawBitmap(bitmap, GetDebugCanvas, 0, 0);
    wait(1);
  until(IsFKeyDown(12))
end.

Not too complicated, but nice and funny nevertheless. ;)

I thought it was pretty cool. Better canvasing than I can do :D

wow :). i loves it =D

Nice :)

That's rly nice, you mind if I put it in with SCAR?

Not at all, that'd be pretty neat :)

EDIT:
If you put PointToWindow into SCAR, I think I could make this work across the entire screen :)

It'd take API calls, though (to force windows to redraw themselves), so It'd be a somewhat ugly solution.