Finger Paint Pro was released as shareware for low level pixel editing of VGA images. I have an official copyright filled and granted for the program. It could load many different data types, edit palettes, copy and paste, and everything you could think of that an early Photoshop program might have. It was written in Pascal and Assembly. One major technology used was EMS and EMM memory.
procedure loadGIFfile(s: string; h: pCPR_HEADER; n: integer);
const
wordmasktable: array[0..15] of word=
($0000,$0001,$0003,$0007,
$000f,$001f,$003f,$007f,
$00ff,$01ff,$03ff,$07ff,
$0fff,$1fff,$3fff,$7fff);
starttable: array[0..4] of word= (0,4,2,1,0);
inctable: array[0..4] of word= (8,8,4,2,0);
type
buffertype= array[0..4095] of integer;
buffertype2= array[0..4095] of byte;
var
hb1: GIF_HEADER1;
hb2: GIF_HEADER2;
f: file;
err,num: word;
size: byte;
bits2,codesize,line,codesize2,nextcode,thiscode,oldtoken,currentcode,pass,
oldcode,bitsleft,bt,p,q: word;
interlace: boolean;
u: integer;
blocksize: byte;
b: array[0..255] of byte;
firstcodestack: ^buffertype2;
lastcodestack: ^buffertype2;
codestack: ^buffertype;
procedure handleerror;
begin
h^.version:=CPR_ERROR;
close(f);
if firstcodestack<>nil then dispose(firstcodestack);
if lastcodestack<>nil then dispose(lastcodestack);
if codestack<>nil then dispose(codestack);
firstcodestack:=nil;
lastcodestack:=nil;
codestack:=nil;
j:=ioresult;
end;
procedure loadpalette(n: integer);
begin
num:=n*3;
blockread(f,colors,num,err);
if (ioresult<>0) or (num<>err) then
begin
handleerror;
exit;
end;
for j:=1 to 768 do
colors[0,j]:=colors[0,j] shr 2;
set256colors(colors);
end;
function getheader1: boolean;
begin
getheader1:=false;
num:=sizeof(GIF_HEADER1);
blockread(f,hb1,num,err);
with hb1 do
begin
if (ioresult<>0) or (num<>err) or (signature[0]<>'G') or (signature[1]<>'I')
or (signature[2]<>'F') then exit;
if (flag and 128)>0 then loadpalette(2 shl (flag and 7));
end;
interlace:=false;
getheader1:=true;
end;
function getheader2: boolean;
var
sig: char;
skip: byte;
begin
getheader2:=false;
done:=false;
repeat
num:=1;
blockread(f,sig,num,err);
if (ioresult<>0) or (num<>err) then exit;
if sig='!' then
begin
num:=1;
blockread(f,skip,num,err);
if (ioresult<>0) or (num<>err) then exit;
seek(f,filepos(f)+skip);
if (ioresult<>0) then exit;
end
else if sig<>',' then exit;
until sig=',';
num:=sizeof(GIF_HEADER2);
blockread(f,hb2,num,err);
if (hb2.flag and 128)>0 then loadpalette(2 shl (hb2.flag and 7));
if hb2.w>MAXWIDTH then h^.width:=MAXWIDTH else h^.width:=hb2.w;
if hb2.h>MAXHEIGHT then h^.height:=MAXHEIGHT else h^.height:=hb2.h;
h^.version:=CPR_GIF;
h^.flags:=1;
if (hb2.flag and 64)>0 then interlace:=true;
getheader2:=true;
end;
procedure getbuffer;
begin
blockread(f,blocksize,1,err);
if ioresult<>0 then
begin
handleerror;
exit;
end;
blockread(f,b,blocksize,err);
if (ioresult<>0) or (blocksize<>err) then
begin
handleerror;
exit;
end;
q:=blocksize;
p:=0;
end;
procedure decode(bits: integer);
label loop;
begin
fillchar(lastcodestack^,sizeof(buffertype2),0);
bt:=0;
line:=0;
bitsleft:=8;
bits2:=1 shl bits;
nextcode:=bits2+2;
codesize:=bits+1;
codesize2:=1 shl codesize;
oldtoken:=$FFFF;
oldcode:=$FFFF;
q:=0;
p:=0;
pass:=0;
loop:
if bitsleft=8 then
begin
inc(p);
if p>=q then getbuffer;
bitsleft:=0;
end;
thiscode:=b[p];
currentcode:=codesize+bitsleft;
if currentcode<=8 then
begin
b[p]:=b[p] shr codesize;
bitsleft:=currentcode;
end
else
begin
inc(p);
if p>=q then getbuffer;
thiscode:=thiscode or (b[p] shl (8-bitsleft));
if (currentcode<=16) then
begin
bitsleft:=currentcode-8;
b[p]:=b[p] shr bitsleft;
end
else
begin
inc(p);
if p>=q then getbuffer;
thiscode:=thiscode or (b[p] shl (16-bitsleft));
bitsleft:=currentcode-16;
b[p]:=b[p] shr bitsleft;
end;
end;
thiscode:=thiscode and wordmasktable[codesize];
currentcode:=thiscode;
if thiscode=bits2+1 then exit;
if thiscode>nextcode then exit;
if thiscode=bits2 then
begin
nextcode:=bits2+2;
codesize:=bits+1;
codesize2:=1 shl codesize;
oldcode:=$FFFF;
oldtoken:=$FFFF;
goto loop;
end;
u:=0;
if thiscode=nextcode then
begin
firstcodestack^[u]:=oldtoken;
inc(u);
thiscode:=oldcode;
end;
while thiscode>=bits2 do
begin
firstcodestack^[u]:=lastcodestack^[thiscode];
inc(u);
thiscode:=codestack^[thiscode];
end;
oldtoken:=thiscode;
repeat
if bt=hb2.w then
begin
dumpline(line);
if interlace then
begin
inc(line,inctable[pass]);
if line>=hb2.h then
begin
inc(pass);
line:=starttable[pass];
end;
end
else inc(line);
bt:=0;
end;
dec(u);
if u>=0 then thiscode:=firstcodestack^[u];
until u<0;
if (nextcode<4096) and (oldcode<>$FFFF) then
begin
codestack^[nextcode]:=oldcode;
lastcodestack^[nextcode]:=oldtoken;
inc(nextcode);
if (nextcode>=codesize2) and (codesize<12) then
begin
inc(codesize);
codesize2:=1 shl codesize;
end;
end;
oldcode:=currentcode;
goto loop;
end;
begin
new(firstcodestack);
new(lastcodestack);
new(codestack);
assign(f,s);
reset(f,1);
if n>0 then seek(f,n);
if ioresult<>0 then
begin
handleerror;
exit;
end;
if not getheader1 then
begin
handleerror;
exit;
end;
if not getheader2 then
begin
handleerror;
exit;
end;
size:=0;
blockread(f,size,1,err);
decode(size);
close(f);
if firstcodestack<>nil then dispose(firstcodestack);
if lastcodestack<>nil then dispose(lastcodestack);
if codestack<>nil then dispose(codestack);
end;