|
program spriter_2003;
uses crt,dos,strings,windos,gf_lib;
const
max_car=36;
max_curs=4;
max_file=11;
xn=1;
yn=11;
xg=67;
yg=11;
xc=288;
yc=76;
type
area_carat=record
matr:array [0..4,0..4] of byte;
end;
area_curs=array [1..16*16] of byte;
matrice=array [1..64,1..64] of byte;
var
i,j:integer;
carat:array [0..max_car] of area_carat;
curs:array [1..max_curs] of ^area_curs;
dimx,dimy,offx,offy,zoom:byte;
col_bkg:byte;
sprite:matrice;
copia:matrice;
x,y,xm,ym:integer;
n_fr,max_fr:byte;
tool,tool_prec,colore1,colore2:byte;
zone_n:byte;
ghost,grid,posso_incollare,escape,annulla:boolean;
x1g,x2g,y1g,y2g:integer;
n_pal:byte;
f:file;
file_n:array [0..max_file] of string;
tipo_file_n:array [0..max_file] of byte;
dir_start,cur_dir:string;
nome_corrente:string;
function b1:boolean;
begin
if returnpressedbutton=1 then
b1:=true
else
b1:=false;
end;
function b2:boolean;
begin
if returnpressedbutton=2 then
b2:=true
else
b2:=false;
end;
function b3:boolean;
begin
if returnpressedbutton=3 then
b3:=true
else
b3:=false;
end;
procedure fade_screen;
begin
setpage(0);
for i:=0 to 319 do
for j:=0 to 199 do
putpixel(i,j,fade_out(getpixel(i,j)));
setpage(1);
end;
procedure auto_zoom;
begin
if dimx>dimy then
zoom:=180 div dimx
else
zoom:=180 div dimy;
if zoom>20 then
zoom:=20;
end;
procedure carica_cursori;
var
k,l:integer;
begin
setpage(0);
showbmp(dir_start+'img\cursor.bmp',0,0,false);
for k:=0 to 319 do
for l:=0 to 199 do
if getpixel(k,l)=124 then
putpixel(k,l,255);
for k:=1 to max_curs do begin
new(curs[k]);
getimage(curs[k]^,16*(k-1),0,16,16);
end;
clearallpages;
setpage(1);
end;
procedure carica_small_font;
var
k,l,i,j:integer;
begin
setpage(0);
showbmp(dir_start+'img\font.bmp',0,0,true);
for k:=0 to 319 do
for l:=0 to 199 do
case getpixel(k,l) of
15,31,248..255:putpixel(k,l,255);
else putpixel(k,l,0);
end;
for k:=0 to max_car do
for i:=0 to 4 do
for j:=0 to 4 do
carat[k].matr[i,j]:=getpixel_page((k*6)+i,j,0);
clearpage(0);
setpage(1);
end;
procedure small_font(x,y:integer;text:string;color:byte);
var
k:byte;
i,j:byte;
car:integer;
begin
for k:=1 to length(text) do begin
car:=-1;
text[k]:=upcase(text[k]);
case text[k] of
'0':car:=0;
'1':car:=1;
'2':car:=2;
'3':car:=3;
'4':car:=4;
'5':car:=5;
'6':car:=6;
'7':car:=7;
'8':car:=8;
'9':car:=9;
'A':car:=10;
'B':car:=11;
'C':car:=12;
'D':car:=13;
'E':car:=14;
'F':car:=15;
'G':car:=16;
'H':car:=17;
'I':car:=18;
'J':car:=19;
'K':car:=20;
'L':car:=21;
'M':car:=22;
'N':car:=23;
'O':car:=24;
'P':car:=25;
'Q':car:=26;
'R':car:=27;
'S':car:=28;
'T':car:=29;
'U':car:=30;
'V':car:=31;
'W':car:=32;
'X':car:=33;
'Y':car:=34;
'Z':car:=35;
'-':car:=36;
'.':putpixel(x+((k-1)*6)+2,y+4,color);
end;
if car<>-1 then
for i:=0 to 4 do
for j:=0 to 4 do
if carat[car].matr[i,j]=0 then
putpixel(x+((k-1)*6)+i,y+j,color);
end;
end;
procedure mouse_xy;
begin
xm:=getmousex;
ym:=getmousey;
end;
procedure mouse_coord;
begin
if zoom<>0 then begin
x:=(((xm-xg) div zoom)+1)+offx;
y:=(((ym-yg) div zoom)+1)+offy;
end;
end;
procedure swap(var a,b:integer);
var
temp:integer;
begin
temp:=a;
a:=b;
b:=temp;
end;
function mouse_in(x1,y1,x2,y2:integer):boolean;
begin
if x1>x2 then
swap(x1,x2);
if y1>y2 then
swap(y1,y2);
if (xm>=x1) and (xm<=x2) and (ym>=y1) and (ym<=y2) then
mouse_in:=true
else
mouse_in:=false;
end;
function mouse_in_grid:boolean;
var
xf,yf:integer;
begin
xf:=xg+(dimx-offx)*zoom;
yf:=yg+(dimy-offy)*zoom;
if xf>xg+180-1 then
xf:=xg+180-1;
if yf>yg+180-1 then
yf:=yg+180-1;
if (xm>=xg) and (xm<=xf) and (ym>=yg) and (ym<=yf) then
mouse_in_grid:=true
else
mouse_in_grid:=false;
end;
procedure icone_mouse;
var
k,l:byte;
begin
case tool of
1:begin
putimage(curs[4]^,xm,ym,16,16);
for k:=0 to 10 do
for l:=0 to 6 do
if (k=0) or (k=10) or (l=0) or (l=6) then
if (k+l)/2=int((k+l)/2) then
putpixel(xm+10+k,ym+10+l,15);
end;
5:begin
putimage(curs[1]^,xm,ym,16,16);
end;
6:begin
putimage(curs[2]^,xm,ym,16,16);
end;
7:begin
putimage(curs[4]^,xm,ym,16,16);
line(xm+11,ym+10,xm+20,ym+14,colore2);
line(xm+10,ym+9,xm+19,ym+13,colore1);
end;
8:begin
putimage(curs[3]^,xm,ym,16,16);
end;
9:begin
putimage(curs[4]^,xm,ym,16,16);
rectangle(xm+11,ym+10,xm+21,ym+17,colore2);
rectangle(xm+10,ym+9,xm+20,ym+16,colore1);
end;
10:begin
putimage(curs[4]^,xm,ym,16,16);
fillrectangle(xm+11,ym+10,xm+21,ym+17,colore2);
fillrectangle(xm+10,ym+9,xm+20,ym+16,colore1);
end;
11:begin
putimage(curs[4]^,xm,ym,16,16);
ellipse(xm+16,ym+10,5,3,colore2);
ellipse(xm+15,ym+9,5,3,colore1);
end;
12:begin
putimage(curs[4]^,xm,ym,16,16);
fillellipse(xm+16,ym+10,5,3,colore2);
fillellipse(xm+15,ym+9,5,3,colore1);
end;
end;
end;
procedure scrivi_coord;
begin
setpage(1);
if (mouse_in(xg,yg,xg+(zoom*(dimx-offx))-1,yg+(zoom*(dimy-offy))-1)) and
(mouse_in(xg,yg,xg+180-1,yg+180-1)) then begin
if x<=9 then begin
small_font(51,185,' '+int2str(x),col_bkg);
small_font(52,184,' '+int2str(x),fade_in(col_bkg));
end
else begin
small_font(51,185,int2str(x),col_bkg);
small_font(52,184,int2str(x),fade_in(col_bkg));
end;
if y<=9 then begin
small_font(51,193,' '+int2str(y),col_bkg);
small_font(52,192,' '+int2str(y),fade_in(col_bkg));
end
else begin
small_font(51,193,int2str(y),col_bkg);
small_font(52,192,int2str(y),fade_in(col_bkg));
end;
end
end;
procedure area_zoomata;
var
xf,yf:byte;
begin
if zoom<>0 then begin
xf:=xn+offx+(180 div zoom);
yf:=yn+offy+(180 div zoom);
if xf>xn+dimx then
xf:=xn+dimx;
if yf>yn+dimy then
yf:=yn+dimy;
if (xf<xn+dimx) or (yf<yn+dimy) or (offx<>0) or (offy<>0) then
rectangle(xn+offx-1,yn+offy-1,xf,yf,4);
end;
end;
procedure commento;
var
txt:string;
x1,y1:integer;
begin
setpage(0);
txt:='';
case zone_n of
1:txt:='select';
2:txt:='copy selected area';
3:txt:='cut away selected area';
4:txt:='paste copied area';
5:txt:='point';
6:txt:='rubber';
7:txt:='line';
8:txt:='get colour';
9:txt:='rectangle';
10:txt:='full rectangle';
11:txt:='ellipse';
12:txt:='full ellipse';
21:txt:='vertical axis flipping';
22:txt:='horizontal axis flipping';
23:txt:='90 degrees rotation';
24:txt:='oblique axis flipping';
25:txt:='move frame left';
26:txt:='move frame right';
27:txt:='move frame up';
28:txt:='move frame down';
31:txt:='import BMP file';
32:txt:='frame browser';
33:txt:='view grid';
34:txt:='view transparency';
35:txt:='increase zoom area';
36:txt:='decrease zoom area';
41:txt:='resize all frames';
44:txt:='create bmp in a sub-folder';
51:txt:='exit';
52:txt:='new';
53:txt:='open...';
54:txt:='save';
55:txt:='save as...';
101:txt:='previous frame';
102:txt:='following frame';
103:txt:='add a frame after current one';
104:txt:='delete current frame';
254,255:txt:='other colours';
end;
setpage(1);
x1:=3;
y1:=2;
small_font(x1-1,y1+1,txt,col_bkg);
small_font(x1,y1,txt,fade_in(col_bkg));
end;
procedure wait_mouse;
begin
setpage(1);
repeat
area_zoomata;
commento;
showmouse;
update;
until buttonup;
end;
procedure bigpixel(x,y,colore:byte);
var
k,l:byte;
begin
if (x>=1) and (x<=dimx) and (y>=1) and (y<=dimy) then begin
putpixel(xn+x-1,yn+y-1,colore);
for k:=0 to zoom-1 do begin
for l:=0 to zoom-1 do begin
if (k+(zoom*(x-1-offx))>=0) and (l+(zoom*(y-1-offy))>=0) then
if (k+(zoom*(x-1-offx))<180) and (l+(zoom*(y-1-offy))<180) then
if ((grid) and (zoom>1)) and ((k=zoom-1) or (l=zoom-1)) then
putpixel(xg+((x-1-offx)*zoom)+k,yg+((y-1-offy)*zoom)+l,104)
else
if (ghost) and (colore=0) then begin
if ((((xg+((x-1-offx)*zoom))+((y-1-offy)*zoom)++k+l)/2)
=int((((xg+((x-1-offx)*zoom))+((y-1-offy)*zoom)++k+l)/2))) then
putpixel(xg+((x-1-offx)*zoom)+k,yg+((y-1-offy)*zoom)+l,104)
else
putpixel(xg+((x-1-offx)*zoom)+k,yg+((y-1-offy)*zoom)+l,0);
end
else
putpixel(xg+((x-1-offx)*zoom)+k,yg+((y-1-offy)*zoom)+l,colore);
end;
end;
end;
end;
procedure crea_testata;
var
k,l,dato:byte;
size:integer;
begin
for k:=0 to 19 do begin
case k of
0:dato:=70;
1:dato:=82;
2:dato:=65;
3:dato:=78;
4:dato:=67;
5:dato:=72;
6:dato:=73;
7:dato:=78;
8:dato:=79;
9:dato:=dimx;
10:dato:=dimy;
11..19:dato:=0;
end;
blockwrite(f,dato,1);
end;
end;
procedure crea_file_temp;
var
k,l,dato:byte;
size:integer;
begin
assign(f,dir_start+'temp_00.tmp');
rewrite(f,1);
crea_testata;
size:=dimx*dimy;
dato:=0;
for k:=0 to size-1 do begin
blockwrite(f,dato,1);
end;
end;
procedure finestra_zoom;
begin
fillrectangle(xg-1,yg-1,xg+180,yg+180,col_bkg);
if (dimx*zoom)>180 then
if (dimy*zoom)>180 then
frame(xg-1,yg-1,xg+180,yg+180,1,col_bkg,false)
else
frame(xg-1,yg-1,xg+180,yg+(dimy*zoom),1,col_bkg,false)
else
if (dimy*zoom)>180 then
frame(xg-1,yg-1,xg+(dimx*zoom),yg+180,1,col_bkg,false)
else
frame(xg-1,yg-1,xg+(dimx*zoom),yg+(dimy*zoom),1,col_bkg,false);
end;
procedure visual_sprite;
var
k,l:byte;
xf,yf,s,t:longint;
begin
setpage(0);
frame(xn-1,yn-1,xn+dimx,yn+dimy,1,col_bkg,false);
finestra_zoom;
xf:=xg+(zoom*dimx)-1;
yf:=yg+(zoom*dimy)-1;
if xf>xg+180-1 then
xf:=xg+180-1;
if yf>yg+180-1 then
yf:=yg+180-1;
for t:=xg to xf do
for s:=yg to yf do
if (t+s)/2<>int((t+s)/2) then
putpixel(t,s,col_bkg)
else
putpixel(t,s,1);
setpage(0);
for k:=1 to dimx do begin
for l:=1 to dimy do begin
putpixel(xn+k-1,yn+l-1,sprite[k,l]);
bigpixel(k,l,sprite[k,l]);
end;
end;
setpage(1);
end;
procedure sposta_visual_zoom;
var
dimo,dimv:byte;
begin
setpage(1);
case zone_n of
181:begin
if offx>0 then dec(offx);
frame(66,192,73,199,1,col_bkg,true);
end;
182:begin
if offx<dimx-1 then inc(offx);
frame(240,192,247,199,1,col_bkg,true);
end;
183:begin
if offy>0 then dec(offy);
frame(248,10,255,17,1,col_bkg,true);
end;
184:begin
if offy<dimy-1 then inc(offy);
frame(248,184,255,191,1,col_bkg,true);
end;
185:begin
offx:=round((xm-73-((166/dimx)/2))/((166)/dimx));
if offx<0 then offx:=0;
if offx>dimx-1 then offx:=dimx-1;
setpage(1);
setpage(0);
end;
186:begin
offy:=round((ym-17-((166/dimy)/2))/(166/dimy));
if offy<0 then offy:=0;
if offy>dimy-1 then offy:=dimy-1;
end;
187:begin
offx:=0;
offy:=0;
frame(248,192,255,199,1,col_bkg,true);
end;
end;
setpage(0);
window(74,192,239,199,1,col_bkg,true);
window(248,18,255,183,1,col_bkg,true);
dimo:=166 div dimx;
dimv:=166 div dimy;
if offx=dimx-1 then
dimo:=165-round(166*offx/dimx);
if offy=dimy-1 then
dimv:=165-round(166*offy/dimy);
fillrectangle(74+round(166*offx/dimx),192,74+round(166*offx/dimx)+dimo,199,1);
frame(74+round(166*offx/dimx),192,74+round(166*offx/dimx)+dimo,199,1,col_bkg,false);
fillrectangle(248,18+round(166*offy/dimy),255,18+round(166*offy/dimy)+dimv,1);
frame(248,18+round(166*offy/dimy),255,18+round(166*offy/dimy)+dimv,1,col_bkg,false);
visual_sprite;
setpage(1);
end;
procedure scrivi_n_fr;
begin
setpage(0);
fillrectangle(16,76,29,83,1);
fillrectangle(36,76,49,83,1);
if n_fr<=9 then begin
small_font(17,78,' '+int2str(n_fr),col_bkg);
small_font(18,77,' '+int2str(n_fr),fade_in(col_bkg));
end
else begin
small_font(17,78,int2str(n_fr),col_bkg);
small_font(18,77,int2str(n_fr),fade_in(col_bkg));
end;
if max_fr<=9 then begin
small_font(18,78,' '+int2str(max_fr),col_bkg);
small_font(19,77,' '+int2str(max_fr),fade_in(col_bkg));
end
else begin
small_font(18,78,' '+int2str(max_fr),col_bkg);
small_font(19,77,' '+int2str(max_fr),fade_in(col_bkg));
end;
setpage(1);
end;
procedure zone_normal;
begin
zone_n:=0;
{ 1:selezione
2:copia
3:taglia
4:incolla
5:punto
6:gomma
7:linea
8:pipetta
9:rettang
10:rettang pieno
11:ellisse
12:ellisse piena
21:mirror asse vert
22:mirror asse oriz
23:ruota 90'
24:mirror asse obl
25:sposta sprite sx
26:sposta sprite dx
27:sposta sprite up
28:sposta sprite dw
31:importa BMP
32:browser
33:grid
34:ghost
35:zoom +
36:zoom -
41:attributi
44:salva BMP
51:X esci
52:new
53:open...
54:save
55:save as...
101:inc frame disponibili
102:dec frame disponibili
103:aggiungi frame
104:elimina frame
180:griglia zoomata
181:sx view griglia
182:dx view griglia
183:up view griglia
184:dw view griglia
185:barra view orizz
186:barra view vertic
187:azzera offset X e Y view
254:inc n_pal
255:dec n_pal
}
if mouse_in(34,85,34+14,85+14) then zone_n:=1;
if mouse_in(50,85,50+14,85+14) then zone_n:=2;
if mouse_in(34,85+16,34+14,85+14+16) then zone_n:=3;
if mouse_in(50,85+16,50+14,85+14+16) then zone_n:=4;
if mouse_in(34,85+32,34+14,85+14+32) then zone_n:=5;
if mouse_in(50,85+32,50+14,85+14+32) then zone_n:=6;
if mouse_in(34,85+48,34+14,85+14+48) then zone_n:=7;
if mouse_in(50,85+48,50+14,85+14+48) then zone_n:=8;
if mouse_in(34,85+64,34+14,85+14+64) then zone_n:=9;
if mouse_in(50,85+64,50+14,85+14+64) then zone_n:=10;
if mouse_in(34,85+80,34+14,85+14+80) then zone_n:=11;
if mouse_in(50,85+80,50+14,85+14+80) then zone_n:=12;
if mouse_in(1,85,1+14,85+14) then zone_n:=21;
if mouse_in(17,85,17+14,85+14) then zone_n:=22;
if mouse_in(1,85+16,1+14,85+14+16) then zone_n:=23;
if mouse_in(17,85+16,17+14,85+14+16) then zone_n:=24;
if mouse_in(1,85+32,1+14,85+14+32) then zone_n:=25;
if mouse_in(17,85+32,17+14,85+14+32) then zone_n:=26;
if mouse_in(1,85+48,1+14,85+14+48) then zone_n:=27;
if mouse_in(17,85+48,17+14,85+14+48) then zone_n:=28;
if mouse_in(1,151,1+14,151+14) then zone_n:=31;
if mouse_in(17,151,17+14,151+14) then zone_n:=32;
if mouse_in(1,151+16,1+14,151+14+16) then zone_n:=33;
if mouse_in(17,151+16,17+14,151+14+16) then zone_n:=34;
if mouse_in(1,151+32,1+14,151+14+32) then zone_n:=35;
if mouse_in(17,151+32,17+14,151+14+32) then zone_n:=36;
if mouse_in(258,12,278,31) then zone_n:=41;
if mouse_in(280,33,300, |
