SRL Archive - Other Scripts

Well, currently it only has a few functions:

clear;
fill;
pickeraser;
pickpencil;
pickbrush;
drawh(startx,starty:integer);
procedure draww(startx,starty,targx,targy:integer;erasing:boolean);
^^erasing(boolean) will instantly move the mouse to the target instead of smoothly moving it, added to speed up certain functions, mainly, erasing

I'm planning on a color changer procedure, and a procedure to select any of the tools…

please post any bugs you find (and yes, I know, theres tons)

WARNING: THIS IS A WORK-IN-PROGRESS! :stirthepot: BUGS CAN BE EXPECTED!

program Painter;
{.include SRL/SRL.scar}
var
pencil,pencildtm:integer;
eraser,eraserdtm:integer;
xmax,ymax,item,brush,brushdtm:integer;

procedure SetupAll;
var
kx,ky:integer;
begin
pencil   := BitmapFromString(9, 15, 'z78DA7373C3070C30801B11EA9DDCD' +
       '049FC7A9175618AE37715B22E626CC1EE2BDCB640581011670310' +
       '24D6166C21488C7AD26C41F53B2DFC822BDC884F33C4A71CE2D51' +
       '3E36B62E38838000043A5C4FC');
pencildtm:= DTMFromString('78DA6314656060E8644001FBA134238C16061' +
       '23DA86AFEFF4753238AA9E6C08103286A00497A06E2');
eraser   := BitmapFromString(14, 11, 'z78DA737576B574B1702582342002' +
       'B892689A1B1CE066136332A9A6E1379354D39CDC9CF0B8933CD37' +
       '09939F84D73260212631A25661213BFC49B497CDA36201A10631A' +
       '004BDCD761');
eraserdtm:= DTMFromString('78DA63146160600863C00A186134484D04AAD' +
       'CFFFF686A44814434AA9AFDFBD1D4F00389385435070E1C405523' +
       '042462F0DB0500EA3409E6');
brush    := BitmapFromString(9, 15, 'z78DA7373C3070C30801B11EA9DDCD' +
       '049FC7A9175618AE37715B22E626CC1EE2BDCB640581011670310' +
       '24D6166C21488C7AD26C41F53B2DFC822BDC884F33C4A71CE2D51' +
       '3E36B62E38838000043A5C4FC');
brushdtm := DTMFromString('78DA63D4656060E866C00A1861B40E90E8449' +
       '5DBBF1F4D8D16A61A0C733480C414026AF489500372CF54FC6A00' +
       '02FE05EB');
       
GetClientDimensions(xmax,ymax);
if(findcolor(kx,ky,16777088,1,1,xmax,ymax))then
ymax:=ky-25;
xmax:=xmax-10;
SetupSRL;
ActivateClient;
ClearDebug;
end;

procedure move(x,y:integer);
begin
MMouse(x,y,0,0);
end;

procedure draww(startx,starty:integer;targx,targy:integer;erasing:boolean);
//var
//xn,yn:integer;
begin
//getmousepos(xn,yn);
if(not(erasing))then
move(startx,starty);
holdmouse(startx,starty,true);
movemousesmooth(targx,targy);
releasemouse(targx,targy,true);
//move(xn,yn);
end;

procedure getitem(x2,y2,xo,yo:integer);
begin
getmousepos(xo,yo);
move(x2,y2);
clickmouse(x2,y2,true);
movemouse(xo,yo);
end;

procedure geteraser;
var
x2,y2,xo,yo:integer;
begin
if(FindDTM(eraserdtm,x2,y2,0,0,xmax,ymax))then
begin
getitem(x2,y2,xo,yo);
item:=2;
end else
begin
writeln('Eraser not found.');
writeln('Searching for bitmap.');
if(FindBitmap(eraser,x2,y2))then
begin
getitem(x2,y2,xo,yo);
item:=2;
end else
writeln('Eraser lost');
end;
end;

procedure getpencil;
var
x2,y2,xo,yo:integer;
begin
if(FindDTM(pencildtm,x2,y2,0,0,xmax,ymax))then
begin
getitem(x2,y2,xo,yo);
item:=1;
end else
begin
writeln('Pencil not found.');
writeln('Searching for bitmap.');
if(FindBitmap(pencil,x2,y2))then
begin
getitem(x2,y2,xo,yo);
item:=1;
end else
writeln('Pencil lost');
end;
end;

procedure getbrush;
var
x2,y2,xo,yo:integer;
begin
if(FindDTM(brushdtm,x2,y2,0,0,xmax,ymax))then
begin
getitem(x2,y2,xo,yo);
item:=3;
end else
begin
writeln('Brush not found.');
writeln('Searching for bitmap.');
if(FindBitmap(brush,x2,y2))then
begin
getitem(x2,y2,xo,yo);
item:=3;
end else
writeln('Brush lost');
end;
end;

procedure pickbrush;
begin
if(not(item=3))then
getbrush;
end;

procedure pickeraser;
begin
if(not(item=2))then
geteraser;
end;

procedure pickpencil;
begin
if(not(item=1))then
getpencil;
end;

procedure clear;
var
cx,cy,erased:integer;
begin
repeat
if(findcolor(cx,cy,0,70,55,xmax,ymax))then
//if(getcolor(cx+1,cy)=0)then
//if(getcolor(cx-1,cy)=0)then
//if(getcolor(cy,cy+1)=0)then
//if(getcolor(cy,cy-1)=0)then
begin
pickeraser;
draww(cx,cy,cx+20,cy+20,true);
//erased:=erased+1;
//if(erased>=15)then
//movemouse(1,1);
wait(10);
end;
until(not(findcolor(cx,cy,0,70,55,xmax,ymax)))
end;

procedure fill;
var
cx,cy,xold,yold,erased:integer;
begin
erased:=0;
repeat
pickbrush;
xold:=cx;
yold:=cy;
if(findcolor(cx,cy,16777215,70,55,xmax,ymax))then
begin
if(not(cx=xold))and(not(yold=cy))then
draww(cx,cy,cx+20,cy+20,true);
//erased:=erased+1;
//if(erased>=150)then
//movemouse(1,1);
wait(10);
end;
until(not(findcolor(cx,cy,16777215,70,55,xmax,ymax)))
end;

procedure drawh(startx,starty:integer);
begin
pickbrush;
draww(startx,starty,startx,starty+90,false);
draww(startx+60,starty,startx+60,starty+90,false);
draww(startx,starty+45,startx+60,starty+45,false);
end;

begin
SetupAll;
clear;
drawh(110,110);
clear;
fill;
end.

where is it?

OH SHOOT!!!
:P Sorry, gimme a minute here…

EDIT: Ok, fixed. Sorry about that…

wow thats a great job there, a little bit of ironing and it will be amazing

looks good, could you explain it in a bit more detail? like what it actually does becaose at just drew alot of lines for me.

I dunno what exactly it's supposzed to do, but it did it pretty good :P
Nice job

Right now, it's pretty much a bunch of paint procedures packed into one script.
You can make it draw/erase stuff pretty easily; it's made for you to tell it what to do, so it's kinda useless if you don't know some basic SCAR.
If you download it and run it without modifying the main loop at all, it will erase everything in the paint window, then fill it back up using a paintbrush