Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- //Climb Script Re-coded, v1.0.1, by Squiddy ~ [BR]
- //Última atualização: 09/03/2013
- //Créditos para HackTank pela função IDByName; CurryWurst e DorkeyDear pela função Explode.
- const
- maxtops = 30;
- rankingdisplay = 15;
- maxplayerstats = 500;
- errorcolor = $FF474A;
- type tplayer = record
- timer: integer;
- tracking: byte;
- drawinfo: string;
- drawcolor: longint;
- end;
- var
- player: array[1..32] of tplayer;
- tops: array[1..maxtops] of integer;
- changingmap, dokill, doupdate, compiled: boolean;
- //~~~~~~~~~~~~~~~~~~~~~~
- //GO!
- //créditos para hacktank por essa função
- {FUNÇÃO ADAPTADA!!!!}
- function idbyname(name: string; exc: byte): byte;
- var i: byte;
- begin
- result := 0;
- for i := 1 to 32 do if getplayerstat(i,'active')=true then if getplayerstat(i,'team') <> exc then begin
- if containsstring(lowercase(getplayerstat(i,'name')),lowercase(name)) then begin
- result := i;
- break;
- end;
- end;
- end;
- //créditos para currywurst e dorkeydear por esta função
- function explode(source: string; const delimiter: string): array of string;
- var position, dellength, reslength: integer;
- begin
- dellength := length(delimiter);
- source := source + delimiter;
- position := pos(delimiter, source);
- repeat
- setarraylength(result, reslength + 1);
- result[reslength] := copy(source, 1, position - 1);
- reslength := reslength + 1;
- delete(source, 1, position + dellength - 1);
- position := pos(delimiter, source);
- until (position = 0);
- setarraylength(result, reslength - 1);
- end;
- procedure resetstats(id: byte);
- begin
- player[id].timer := 0;
- player[id].tracking := 0;
- player[id].drawinfo := '';
- player[id].drawcolor := $FEDEBA;
- end;
- procedure updatetops();
- var s: byte; q: array of string;
- begin
- if readfile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt') <> nil then begin
- q := explode(readfile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt'),#13#10);
- for s := 1 to maxtops do if s <= getarraylength(q) then tops[s] := strtoint(getpiece(q[s-1],' ## ',0)) else tops[s] := 0;
- end else for s := 1 to maxtops do tops[s] := 0;
- end;
- function writetopcapper(id: byte): byte;
- var s, q, u: integer; pfile, mfile, info, temp: string; text: array of string; carryon, foundhwid, newfile: boolean;
- begin
- result := 0;
- //PLAYER STATS
- info := getplayerstat(id,'hwid') + ' ## ' + getplayerstat(id,'name') + ' ## ';
- temp := 'scripts/'+scriptname+'/stats/player stats ';
- if not fileexists(temp + '1.txt') then begin
- writefile(temp + '1.txt',info + '1 ## ' + currentmap);
- carryon := false; //não dá pra dar exit aqui né :(
- end else carryon := true;
- if carryon then begin
- for s := 1 to 254 do if fileexists(temp + inttostr(s) + '.txt') then begin
- foundhwid := false;
- newfile := false;
- text := explode(readfile(temp + inttostr(s) + '.txt'),#13#10);
- if getarraylength(text) = maxplayerstats then begin
- pfile := temp + inttostr(s+1) + '.txt';
- newfile := true;
- break;
- end else pfile := temp + inttostr(s) + '.txt';
- foundhwid := containsstring(readfile(pfile),getplayerstat(id,'hwid'));
- if foundhwid then break;
- end else break;
- temp := '';
- if newfile then writefile(pfile,info + '1 ## ' + currentmap) else begin
- if not foundhwid then writefile(pfile,readfile(pfile) + info + '1 ## ' + currentmap) else begin
- for s := 0 to getarraylength(text)-1 do if getpiece(text[s],' ## ',0) = getplayerstat(id,'hwid') then begin
- q := strtoint(getpiece(text[s],' ## ',2));
- q := q + 1;
- for u := 0 to s-1 do temp := temp + text[u] + #13#10;
- temp := temp + info + inttostr(q) + ' ## ' + currentmap + #13#10;
- if s < getarraylength(text)-1 then for u := s+1 to getarraylength(text)-1 do temp := temp + text[u] + #13#10;
- writefile(pfile,temp);
- break;
- end;
- end;
- end;
- end;
- //MAP STATS
- info := inttostr(player[id].timer) + ' ## ' + formatdate('dd.mm.yy') + ' ## ' + formatdate('hh:nn:ss') + ' ## ' + getplayerstat(id,'name');
- mfile := 'scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt';
- if readfile(mfile) = nil then begin
- writefile(mfile,info);
- result := 1;
- exit;
- end;
- text := explode(readfile(mfile),#13#10);
- q := getarraylength(text);
- for s := 0 to q-1 do if player[id].timer <= strtoint(getpiece(text[s],' ## ',0)) then break;
- if q = maxtops then if s = q then exit;
- if q < maxtops then setarraylength(text,q+1);
- q := getarraylength(text);
- for u := q-1 downto s+1 do text[u] := text[u-1];
- text[s] := info;
- info := '';
- for u := 0 to q-1 do info := info + text[u] + iif(u=q-1,'',#13#10);
- writefile(mfile,info);
- result := s+1;
- end;
- function getdrawcolor(id: byte): longint;
- var s, q, u: byte;
- begin
- result := $FEDEBA;
- for s := 1 to maxtops do if tops[s] = 0 then break; //s is now how many tops there are.
- if s <> 1 then q := (s-1) div 6 else q := 1; //q is now the "step sequence".
- if s <> 1 then for s := 1 to maxtops do if (player[id].timer <= tops[s]) or (tops[s] = 0) then break; //s is now the next top position.
- for u := 1 to 6 do if s <= (q*u) then break; //u is now the number in the color scale (1-6). if it is 7, it is because the time surpasses the tops[maxtops] time.
- if q = 0 then for s := 1 to maxtops do if (player[id].timer <= tops[s]) or (tops[s] = 0) then begin //if the number of tops is lower than 6, than this loop starts
- u := s; //u is now the nearest top position
- break;
- end;
- case u of
- 1: result := $25AF00; //greener
- 2: result := $83B000;
- 3: result := $B28200;
- 4: result := $B33F00;
- 5: result := $B51000;
- 6: result := $B60000;
- 7: result := $CE0000; //reder
- end;
- if getplayerstat(id,'team') = 5 then if player[id].tracking <> 0 then result := player[player[id].tracking].drawcolor else result := $FEDEBA;
- end;
- procedure updatedrawinfo(id: byte);
- var s, q: byte; temp: string;
- begin
- player[id].drawcolor := getdrawcolor(id);
- if getplayerstat(id,'team') <> 5 then begin
- for s := 1 to maxtops do if (player[id].timer <= tops[s]) or (tops[s] = 0) then break;
- if tops[1] <> 0 then begin
- if s = maxtops+1 then q := maxtops else if tops[s] = 0 then q := s-1 else q := s;
- temp := #13#10 + 'Top #' + inttostr(q) + ': ' + inttostr(tops[q]) + 's';
- end else temp := #13#10 + 'Sem top!';
- player[id].drawinfo := inttostr(player[id].timer) + 's' + temp;
- end else if player[id].tracking = 0 then player[id].drawinfo := 'Oyunya bakmak icin !bak <nickin bir kismi>' + #13#10 + 'eslik edecek' else player[id].drawinfo := getplayerstat(player[id].tracking,'name') + #13#10 + player[player[id].tracking].drawinfo;
- end;
- //MOTHERFUCKING FUNCTION COST ME LOTS OF HOURS!!
- function retrievepropertext(text, linesplitter, datasplitter, nds, textontop: string; fillwith, corner, fillx, filly: char): array of string; //nds = new data splitter
- var s, q, u, y, datalen: byte; bef, af: array of string; i: array of integer; d: array of array of string; sq: array of array of integer;
- begin
- if (text = nil) or (linesplitter = nil) or (datasplitter = nil) or (nds = '') or (fillwith = '') or (fillx = '') or (filly = '') then exit;
- setarraylength(result,0);
- text := text + linesplitter; //PRECISA fazer isso
- bef := explode(text,linesplitter);
- while bef[getarraylength(bef)-1] = nil do setarraylength(bef,getarraylength(bef)-1); //isso TAMBÉM precisa fazer
- for s := 0 to getarraylength(bef)-1 do bef[s] := bef[s] + datasplitter;
- af := explode(bef[0],datasplitter); //pra poupar variáveis né.. vida de pobre dá nisso
- datalen := getarraylength(af);
- setarraylength(i,datalen);
- setarraylength(d,getarraylength(bef));
- setarraylength(sq,getarraylength(bef));
- setarraylength(af,getarraylength(bef));
- setarraylength(result,getarraylength(bef));
- for s := 0 to getarraylength(d)-1 do setarraylength(d[s],datalen);
- for s := 0 to getarraylength(sq)-1 do setarraylength(sq[s],datalen);
- for s := 0 to getarraylength(af)-1 do begin //loop principal
- af[s] := '';
- for q := 0 to datalen do begin //nesse loop, retirar o velho datasplitter e adicionar o novo no lugar dele (nds)
- u := pos(datasplitter,bef[s]);
- if q < datalen then sq[s][q] := u;
- af[s] := af[s] + copy(bef[s],1,u-1) + iif(q = datalen,'',nds);
- delete(bef[s],1,u + length(datasplitter) - 1);
- end;
- bef[s] := af[s];
- for q := 0 to datalen-1 do begin //nesse loop, verificar quais são as maiores datas de cada linha
- u := pos(nds,bef[s]);
- if u-1 > i[q] then i[q] := u-1;
- delete(bef[s],1,u + length(nds) - 1);
- end;
- end;
- for s := 0 to getarraylength(af)-1 do for q := 0 to datalen-1 do begin //nesse loop, adicionar os chars à variável result
- u := sq[s][q];
- for y := u-1 to i[q] do d[s][q] := d[s][q] + iif(y = i[q],'',fillwith);
- result[s] := result[s] + copy(af[s],1,u-1) + d[s][q] + iif(q = datalen-1,'',nds);
- delete(af[s],1,u + length(nds) - 1);
- end;
- setarraylength(result,getarraylength(result)+2); //adicionar dois "blanks" no final da array
- for s := getarraylength(result)-2 downto 1 do result[s] := result[s-1]; //e agora mover os textos para uma posição acima
- result[0] := '';
- i[0] := 0;
- for s := 0 to getarraylength(result)-1 do if length(result[s])+2 > i[0] then i[0] := length(result[s])+2; //i[0] is now the lenghtiest motherfucking line
- for s := 1 to i[0]-2 do result[getarraylength(result)-1] := result[getarraylength(result)-1] + fillx; //put some filling
- for s := 1 to (((i[0]-2) div 2) - (length(textontop) div 2)) do result[0] := result[0] + fillx; //fill before the text on top
- result[0] := result[0] + textontop; //put the text on top
- for s := length(result[0]) to i[0]-3 do result[0] := result[0] + fillx; //fill after the text on top
- result[0] := corner + result[0] + corner; //put some motherfucking corners
- result[getarraylength(result)-1] := corner + result[getarraylength(result)-1] + corner; //put some more motherfucking corners
- for s := 1 to getarraylength(result)-2 do result[s] := filly + result[s] + filly; //and box it up to finish it!!
- end;
- procedure showranking(id: byte);
- var rawtext: string; s, q, d, y: byte; u, i: array of string;
- begin
- for q := 1 to 254 do if not fileexists('scripts/'+scriptname+'/stats/player stats ' + inttostr(q) + '.txt') then break;
- q := q - 1; //q is now the number of files that actually exist
- if q = 0 then exit;
- for s := 1 to q do rawtext := rawtext + readfile('scripts/'+scriptname+'/stats/player stats ' + inttostr(s) + '.txt') + #13#10; //gather all info in one text
- u := explode(rawtext,#13#10);
- if getarraylength(u) < rankingdisplay then d := getarraylength(u) else d := rankingdisplay; //d is now the ammount of positions displayed on !ranking
- setarraylength(i,d); //i is now the array that will effectively contain the positions
- for s := 0 to d-1 do i[s] := '0 ## ';
- for s := 0 to getarraylength(u)-1 do if (u[s] <> nil) and (u[s] <> #13#10) then if strtoint(getpiece(u[s],' ## ',2)) >= strtoint(getpiece(i[d-1],' ## ',0)) then begin
- for q := 0 to d-1 do if strtoint(getpiece(u[s],' ## ',2)) >= strtoint(getpiece(i[q],' ## ',0)) then break;
- for y := d-1 downto q+1 do i[y] := i[y-1];
- i[q] := getpiece(u[s],' ## ',2) + ' ## ' + getpiece(u[s],' ## ',1);
- end;
- rawtext := '';
- for s := 0 to d-1 do if getpiece(i[s],' ## ',0) <> '0' then rawtext := rawtext + '#'+inttostr(s+1) + ' ## ' + i[s] + #13#10;
- setarraylength(u,0);
- u := retrievepropertext(rawtext,#13#10,'##','-',' Top Players ',' ','+','-','|');
- for s := 0 to getarraylength(u)-1 do writeconsole(id,u[s],$3D9FC1);
- end;
- procedure showhighscores(id: byte);
- var s: byte; q: array of string; rawtext: string;
- begin
- if readfile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt') = nil then begin
- writeconsole(id,'Bu haritada henuz cap yapilmadi!',errorcolor);
- exit;
- end;
- rawtext := '';
- q := explode(readfile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt'),#13#10);
- for s := 0 to getarraylength(q)-1 do rawtext := rawtext + '#'+inttostr(s+1) + ' ## ' + getpiece(q[s],' ## ',0) + 's ## ' + getpiece(q[s],' ## ',3) + #13#10;
- setarraylength(q,0);
- q := retrievepropertext(rawtext,#13#10,'##','-',' '+currentmap+' ',' ','+','-','|');
- for s := 0 to getarraylength(q)-1 do writeconsole(id,q[s],$1CC61C);
- end;
- procedure showstats(id: byte; comp: string);
- var s, q, i, y: byte; u, d: array of string;
- begin
- if comp <> nil then begin
- s := idbyname(comp,0);
- if s = 0 then exit;
- end else s := id;
- for q := 1 to 254 do if fileexists('scripts/'+scriptname+'/stats/player stats '+inttostr(q)+'.txt') then if containsstring(readfile('scripts/'+scriptname+'/stats/player stats '+inttostr(q)+'.txt'),getplayerstat(s,'hwid')) then begin
- u := explode(readfile('scripts/'+scriptname+'/stats/player stats '+inttostr(q)+'.txt'),#13#10);
- for i := 0 to getarraylength(u)-1 do if getpiece(u[i],' ## ',0) = getplayerstat(s,'hwid') then begin
- d := retrievepropertext('Caps registrados ## '+getpiece(u[i],' ## ',2) + #13#10 + 'Último mapa pontuado ## '+getpiece(u[i],' ## ',3),#13#10,'##','-->',' '+iif(s <> id,getplayerstat(s,'name'),'Seus stats')+' ',' ','+','-','|');
- for y := 0 to getarraylength(d)-1 do writeconsole(id,d[y],$8EC4FD);
- exit;
- end;
- end;
- writeconsole(id,iif(s = id,'Oyuncu',getplayerstat(s,'name'))+' kayitli statuye sahip!',errorcolor);
- end;
- procedure showmaps(id, part: byte; source: string);
- var d: array of string; temp, s, q, u: integer; i: string;
- begin
- if source = nil then exit;
- if (part = 255) or (part = -1) then begin
- writeconsole(id,#13#10+' !harita 0 !harita 1',$D1A347);
- writeconsole(id,'Tip , , vb',errorcolor);
- exit;
- end;
- d := explode(source,#13#10);
- s := getarraylength(d);
- temp := 0;
- if s = 1 then begin
- writeconsole(id,'Harita Listesi: '+d[0],$1BE06A);
- exit;
- end;
- while (s >= 4) do begin
- s := s - 4;
- temp := temp + 1; //temp = número de linhas finais (com 4 maps em cada linha)
- end;
- if s > 0 then temp := temp + 1;
- u := 0;
- i := '';
- for q := 0 to temp - iif(s = 0,1,2) do begin
- i := i + d[u] + ' ## ' + d[u+1] + ' ## ' + d[u+2] + ' ## ' + d[u+3] + #13#10;
- u := u + 4;
- end;
- if s <> 0 then for q := 1 to s do begin
- i := i + d[u] + ' ## ';
- u := u + 1;
- end;
- d := retrievepropertext(i,#13#10,'##',' - ',' Lista de mapas ',' ','+','-','|');
- if (part * 30) > getarraylength(d) then begin
- writeconsole(id,'Liste sonu!',errorcolor);
- exit;
- end;
- if ((part * 30) + 30) > getarraylength(d)-1 then s := getarraylength(d)-1 else s := ((part * 30) + 30);
- for q := (part * 30) to s do writeconsole(id,d[q],$1BE06A);
- end;
- procedure oncompile();
- var s: byte;
- begin
- for s := 1 to 32 do resetstats(s);
- dokill := true;
- changingmap := false;
- compiled := true;
- doupdate := true;
- if gamestyle <> 3 then command('/gamemode 3');
- writeln('Climb Script by MrHamsTR basariyla duzenlendi!');
- writeconsole(0,'Climb Script by MrhamsTR basariyla duzenlendi!',$FFFFFF);
- end;
- //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- procedure apponidle(ticks: integer);
- var s: byte;
- begin
- if not compiled then oncompile();
- if doupdate then begin
- doupdate := false;
- updatetops();
- end;
- for s := 1 to 32 do if getplayerstat(s,'active') = true then begin
- if getplayerstat(s,'alive') = true then if not changingmap then player[s].timer := player[s].timer + 1;
- updatedrawinfo(s);
- drawtext(s,player[s].drawinfo,200,player[s].drawcolor,0.12,20,357);
- end;
- if dokill then begin
- for s := 1 to 32 do if getplayerstat(s,'active') = true then begin
- dodamage(s,40000);
- resetstats(s);
- end;
- dokill := false;
- end;
- end;
- procedure onplayerspeak(id: byte; text: string);
- var s: byte;
- begin
- case lowercase(getpiece(text,' ',0)) of
- '!maps','!haritalar','!maplist','!mapslist': showmaps(id,strtoint(getpiece(text,' ',1)),readfile('mapslist.txt'));
- '!rank','!siralama','!ranking': showranking(id);
- '!hi','!derece','!high': showhighscores(id);
- '!puanlar','!stats': showstats(id,getpiece(text,getpiece(text,' ',0)+' ',1));
- '!map','!harita': writeconsole(id,'Gecerli harita '+currentmap,$00A2FF);
- '!bak','!track': begin
- if getplayerstat(id,'team') <> 5 then begin
- writeconsole(id,'Bu komutu kullanmak icin bir izleyici olmali',errorcolor);
- exit;
- end;
- if getpiece(text,' ',1) = nil then begin
- writeconsole(id,#13#10+'Oyuncu nickinin bir kismini yazmaniz gerekiyor!',errorcolor);
- writeconsole(id,'Ornek !bak hams !bak hamstr !bak mrha !',errorcolor);
- writeconsole(id,'Sen de calis senin de olsun!',errorcolor);
- exit;
- end;
- s := idbyname(getpiece(text,getpiece(text,' ',0)+' ',1),5);
- if s = 0 then exit;
- player[id].tracking := s;
- writeconsole(id,'Suan '+getplayerstat(s,'name')+' izleniyor!',$FF99CC);
- end;
- end;
- end;
- function oncommand(id: byte; text: string): boolean;
- var s, top: byte; temp: string; bla: array of string;
- begin
- text := lowercase(text);
- result := false;
- if getpiece(text,' ',0) = '/removetop' then if getpiece(text,' ',1) <> nil then begin // /removetop <top>
- top := strtoint(getpiece(text,' ',1));
- if top = 255 then begin
- writeconsole(id,'Gecerli bir sayi girin!',errorcolor);
- exit;
- end;
- bla := explode(readfile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt'),#13#10);
- if getarraylength(bla) = 1 then begin
- writefile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt','');
- writeconsole(id,'Harita uzerindeki derece silindi!',$FFFFFF);
- exit;
- end;
- if not fileexists('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt') then begin writeln('Arquivo nao existe!'); exit; end;
- for s := 0 to getarraylength(bla)-1 do temp := temp + iif(s+1 <> top,bla[s],'') + iif(s <> getarraylength(bla)-1,iif(s+1 <> top,#13#10,''),'');
- writefile('scripts/'+scriptname+'/stats/maps/'+currentmap+'.txt',temp);
- writeconsole(id,'Oyuncu '+inttostr(top)+' top derecesi kaldirildi!',$FFFFFF);
- updatetops();
- end;
- end;
- procedure onflagscore(id, teamflag: byte);
- var s: byte;
- begin
- changingmap := true;
- command('/nextmap');
- s := writetopcapper(id);
- writeconsole(0,getplayerstat(id,'name')+' atti '+inttostr(player[id].timer)+' saniye!'+iif(s <> 0,' Yerlestirme '+inttostr(s)+'!',''),$FFB21A);
- writeln(getplayerstat(id,'name')+' atti '+inttostr(player[id].timer)+' saniye!'+iif(s <> 0,' Yerlestirme '+inttostr(s)+'!',''));
- end;
- procedure onmapchange(newmap: string);
- begin
- changingmap := false;
- dokill := true;
- updatetops();
- end;
- function onplayercommand(id: byte; text: string): boolean;
- var s: integer; q: array of string; u: string;
- begin
- result := false;
- text := lowercase(text);
- if getpiece(text,' ',0) = '/ara' then if (getpiece(text,' ',2) <> nil) and (strtoint(getpiece(text,' ',2)) <> -1) then begin
- q := explode(readfile('mapslist.txt'),#13#10);
- for s := 0 to getarraylength(q)-1 do if containsstring(lowercase(q[s]),getpiece(text,' ',1)) then u := u + q[s] + #13#10;
- showmaps(id,strtoint(getpiece(text,' ',2)),u);
- end else begin
- writeconsole(id,#13#10+'Aramak icin /ara <haritanin bir kismi> <liste numarasi>',errorcolor);
- writeconsole(id,'Ornek /ara kz 0 /ara kz 1',errorcolor);
- writeconsole(id,'Bu kadar basit',errorcolor);
- end;
- end;
- procedure onjointeam(id, team: byte);
- var s: byte;
- begin
- if team = 5 then for s := 1 to 32 do if player[s].tracking = id then player[s].tracking := 0;
- end;
- procedure onleavegame(id, team: byte; kicked: boolean);
- var s: byte;
- begin
- for s := 1 to 32 do if player[s].tracking = id then player[s].tracking := 0;
- player[id].tracking := 0;
- end;
- procedure onplayerrespawn(id: byte);
- begin
- player[id].timer := 0;
- end;
- procedure activateserver();
- begin
- oncompile();
- doupdate := true;
- end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement