![]() 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; |
Projects >