home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Boldly Go Collection
/
version40.iso
/
TS
/
17A
/
DCFG203.ZIP
/
DCFG2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-08
|
19KB
|
638 lines
{Dirt Cheap Frame Grabber - Version 2.03}
{as of 8 Feb 1992 - by Michael Day}
{public domain}
program DCFG2;
uses crt;
const maxframe = 30000;
maxintrp = 30000;
type frametype = array[0..maxframe] of byte;
frameptr = ^frametype;
intrptype = array[0..maxintrp] of byte;
intrpptr = ^intrptype;
string8 = string[8];
FrameObj = object
fary : array[0..3] of frameptr;
iary : intrpptr;
dary : intrpptr;
inport : word; {frame port data input address (video data)}
outport : word; {frame port data output address (control)}
frameport : word; {printer port number to use for frame grabber}
grabsize : word; {size of data to grab from port}
framenum : byte; {frame sequence number}
IntrpWidth : word; {width of the intrp array (scan width) }
IntrpSize : word; {size of the intrp array (width*lines) }
Filenum:word; {next file frame number to use}
DiskFrameSize:word;
FrameCount:word;
constructor Init;
destructor Done;
procedure SetFramePort(what:string8);
function GrabFrame(inprt,size:word; Fptr:frameptr):boolean;
function GrabOne:boolean;
procedure F2IConvert(Fnum:byte; GSize,IWidth,ISize:word;
Iptr:IntrpPtr; Fptr:FramePtr);
procedure IntrpDisplay(fnum,IWidth,ISize:word; Iptr:IntrpPtr);
procedure MakeDiskArray(fnum,IWidth,ISize:word;
Iptr:IntrpPtr; Dptr:IntrpPtr);
end;
var Frame : FrameObj;
prnarray : array[0..3] of word absolute $40:$08;
screen : array[0..65520] of byte absolute $A000:0;
crtmode : byte absolute $40:$49;
oldmode : byte;
i:word;
ib:byte;
cx:char;
mf:file;
filenum:word;
showframe : boolean;
fns:string;
MovieEnabled:boolean;
{-----------------------------------------------------------}
{ gray level interpretation chart }
{ }
{ frame data }
{gray F3 F2 F1 F0 F3 = frame 3, F2 = frame 2 }
{level: 76 54 32 10 F1 = frame 1, F0 = frame 0 }
{ 12: 11 xx xx xx each group of two bits }
{ 11: <11 11 xx xx represent the video level }
{ 10: <11 <11 11 xx for the frame indicated }
{ 9: <11 <11 <11 11 }
{ 8: 10 <11 <11 <11 xx = any bit pattern }
{ 7: <10 10 <11 <11 <11 = less than 11; (10, 01, 00) }
{ 6: <10 <10 10 <11 <10 = less than 10; (01 or 00) }
{ 5: <10 <10 <10 10 11, 10, 01, or 00 = the indicated }
{ 4: 01 <10 <10 <10 absolute bit pattern }
{ 3: 00 01 <10 <10 }
{ 2: 00 00 01 <10 the gray level for the specified }
{ 1: 00 00 00 01 bit pattern is shown at the left }
{ 0: 00 00 00 00 }
{-----------------------------------------------------------}
{this array is used to translate from the interpretation }
{array data into a gray level for display on the screen }
const IntrpXlat : array[0..255] of byte = (
0,1,5,9,2,2,5,9, 6,6,6,9,10,10,10,10,
3,3,5,9,3,3,5,9, 6,6,6,9,10,10,10,10,
7,7,7,9,7,7,7,9, 7,7,7,9,10,10,10,10,
11,11,11,11,11,11,11,11, 11,11,11,11,11,11,11,11,
4,4,5,9,4,4,5,9, 6,6,6,9,10,10,10,10,
4,4,5,9,4,4,5,9, 6,6,6,9,10,10,10,10,
7,7,7,9,7,7,7,9, 7,7,7,9,10,10,10,10,
11,11,11,11,11,11,11,11, 11,11,11,11,11,11,11,11,
8,8,8,9,8,8,8,9, 8,8,8,9,10,10,10,10,
8,8,8,9,8,8,8,9, 8,8,8,9,10,10,10,10,
8,8,8,9,8,8,8,9, 8,8,8,9,10,10,10,10,
11,11,11,11,11,11,11,11, 11,11,11,11,11,11,11,11,
12,12,12,12,12,12,12,12, 12,12,12,12,12,12,12,12,
12,12,12,12,12,12,12,12, 12,12,12,12,12,12,12,12,
12,12,12,12,12,12,12,12, 12,12,12,12,12,12,12,12,
12,12,12,12,12,12,12,12, 12,12,12,12,12,12,12,12);
{-----------------------------------------------------------}
{grab a chunk of video from inprt size bytes in length into fary}
function FrameObj.GrabFrame(inprt,size:word; Fptr:frameptr):boolean; assembler;
asm
mov bx,17000 {timeout if we go over 50ms without sync}
mov dx,[inprt]
les di,[Fptr] {now collect a frame}
mov cx,0
@vsloop1:
mov ah,8 {[vsyncslice]} {if we are in a vert sync, get out of it first}
@vsloop2:
dec bx
jz @vdone
in al,dx
shl al,1
jc @vsloop1
dec ah
jnz @vsloop2
@vsloop3:
mov ah,8 {[vsyncslice]} {find the start of a vert sync}
@vsloop4:
dec bx
jz @vdone
in al,dx
shl al,1
jnc @vsloop3
dec ah
jnz @vsloop4
cld
mov cx,[size] {start collecting data}
rep
db 6ch
@vdone:
xor al,al {return error code}
or bh,bl {one = all ok}
jz @vexit {zero = no sync}
inc al
@vexit:
end;
Constructor FrameObj.Init;
var i:byte;
begin
for i := 0 to 3 do
begin
new(fary[i]);
fillchar(fary[i]^,sizeof(fary[i]^),0);
end;
new(iary);
fillchar(iary^,sizeof(iary^),0);
move(IntrpXlat,iary^,256);
new(dary);
fillchar(dary^,sizeof(dary^),0);
move(IntrpXlat,dary^,256);
end;
Destructor FrameObj.Done;
var i:byte;
begin
for i := 0 to 3 do
begin
dispose(fary[i]);
end;
dispose(iary);
dispose(dary);
end;
procedure FrameObj.SetFramePort(what:string8);
begin
frameport := 0;
if length(what) > 0 then
begin
case what[1] of
'2': frameport := 1;
'3': frameport := 2;
'4': frameport := 3;
end;
end;
outport := prnarray[frameport]; {- $378} {get port base addr}
inport := outport+1; {- $379}
port[outport+2] := $04; {- $37A} {init output control lines}
port[outport] := $ff; {init data lines}
grabsize := 20000; {default grab size}
framenum := 0;
IntrpWidth := 70;
IntrpSize := IntrpWidth*(262-12);
framecount := 0;
end;
function FrameObj.GrabOne:boolean;
var Fptr : framePtr;
begin
inc(framenum);
framenum := framenum and 3;
port[frame.outport] := (framenum shl 6) or $3f;
Fptr := fary[framenum];
asm CLI; end;
GrabOne := GrabFrame(inport,grabsize,Fptr);
asm STI; end;
port[frame.outport] := $3f;
end;
{==================================================================}
{note: this assumes that the frame grab array has been preformated}
{with starting with a valid scan line at the top of the screen}
procedure FrameObj.F2Iconvert(Fnum:byte; GSize,IWidth,ISize:word;
Iptr:IntrpPtr; Fptr:FramePtr);
var Bottom:word;
begin
asm
cld
mov cl,ss:[Fnum] {get gray scale frame number}
and cl,03H
add cl,cl {*2 = shifter count}
mov ch,0FCH {create intrp data mask}
rol ch,cl
mov dx,ss:[GSize] {get size of grabbed data to convert}
inc dx
les di,ss:[Iptr] {get intrp array pointer}
add di,256 {first 256 bytes has xlat array}
mov ax,di
add ax,ss:[ISize] {compute intrp bottom address offset}
mov ss:[Bottom],ax {and save it}
mov bx,ss:[IWidth] {put intrp right edge offset into bx}
push ds {save current data segment}
lds si,ss:[Fptr] {get video frame pointer to DS:SI}
add si,500 {ignore the vertical sync}
{data conversion loop starts here}
@loop1:
dec dx {did we run out of data?}
jz @done
lodsb {get a frame scan byte}
shl al,1 {if it is a sync, try again}
jc @loop1
@loop2:
dec dx {did we run out of data?}
jz @done
lodsb {get a frame scan byte}
shl al,1 {if it is a sync, we are}
jc @loop4 {done with the scan line}
{convert scan input data to intrp level reference}
xor ah,ah {init to zero level}
shl al,1 {if highest level on}
adc ah,0 {add one to level count}
shl al,1 {if next high level on}
adc ah,0 {add one to level count}
shl al,1 {if lowest level on}
adc ah,0 {add one to level count}
shl ah,cl {adjust result to position}
mov al,es:[di] {get current intrp value}
and al,ch {strip old intrp value}
or al,ah {insert new intrp value}
mov es:[di],al {save the new intrp value}
inc di
dec bx {if not at end of intrp line}
jnz @loop2 {go process the next byte}
{ran against right edge of intrp window}
{so throw away rest of the scan data}
@loop3: {suck up extra scan data}
dec dx {did we run out of data?}
jz @done
lodsb {get a frame scan byte}
shl al,1 {if it is not a sync, }
jnc @loop3 {keep looping}
jmp @loopd
@loop4: {fill out rest of intrp data}
and es:[di],ch {strip old intrp value to 0}
inc di
dec bx {loop until right edge reached}
jnz @loop4
@loopd:
mov bx,ss:[IWidth] {restore width to reg BX}
cmp di,ss:[Bottom] {are we at bottom?}
jc @loop1 {do more if not at bottom}
@done:
pop ds {restore DS and we are done}
end;
end;
{=====================================================================}
{now we are gonna display the video on the screen}
procedure FrameObj.IntrpDisplay(fnum,IWidth,ISize:word; Iptr:IntrpPtr);
var Bottom:word;
begin
asm
cld
push ds
lds si,ss:[Iptr] {get intrp array pointer}
mov bx,si {point bx at the start of the array}
add si,256 {first 256 bytes has intpr array}
mov ax,ss:[ISize] {compute intrp bottom address offset}
add ax,si
mov ss:[Bottom],ax {and save it}
mov ax,0A000h {point es to the display segment}
mov es,ax
mov cx,ss:[IWidth] {put intrp right edge offset}
mov di,fnum {start at top left corner of screen}
and di,1 {offset by frame number count (even/odd)}
jz @dlp1
add si,cx {use odd scan lines on odd video frames}
@dlp1:
push di
@dlp2:
lodsb {get a intrp byte}
xlat {translate it to gray scale number}
stosb {display it}
inc di {skip a display pixel (we get it next time)}
dec cx {end of the scan line?}
jnz @dlp2 {loop until done}
pop di {restore original display start offset}
add di,320 {add display width to it}
mov cx,ss:[IWidth] {restore Iwidth to cx}
add si,cx
add si,cx {skip three video scan lines}
add si,cx
cmp si,ss:[Bottom] {are we at the bottom?}
jc @dlp1 {keep going if not}
@done:
pop ds {ok, we're done}
end;
end;
{=====================================================================}
{now we are gonna display the video on the screen}
procedure FrameObj.MakeDiskArray(fnum,IWidth,ISize:word;
Iptr:IntrpPtr; Dptr:IntrpPtr);
var Bottom:word;
begin
asm
cld
push ds
lds si,ss:[Iptr] {get intrp array pointer}
mov bx,si {point bx at the start of the array}
add si,256 {first 256 bytes has intpr array}
mov ax,ss:[ISize] {compute intrp bottom address offset}
add ax,si
mov ss:[Bottom],ax {and save it}
les di,Dptr {point es:di at the disk array}
mov cx,ss:[IWidth] {put intrp right edge offset}
mov dx,si
add dx,cx
@dlp1:
lodsb {get a intrp byte}
xlat {translate it to gray scale number}
mov ah,al
xchg si,dx
lodsb
xlat
xchg ah,al
xchg si,dx
stosw {save it in the array}
dec cx {end of the scan line?}
jnz @dlp1 {loop until done}
@dlp3:
mov cx,ss:[IWidth] {restore Iwidth to cx}
add si,cx
add si,cx {skip three video scan lines}
add si,cx
mov dx,si
add dx,cx
cmp si,ss:[Bottom] {are we at the bottom?}
jc @dlp1 {keep going if not}
@done:
pop ds {ok, we're done}
end;
end;
procedure DisplayMovieFrame(DWidth,DSize:word; Dptr:IntrpPtr);
var Bottom:word;
begin
asm
cld
push ds
lds si,ss:[Dptr] {get intrp array pointer}
mov ax,ss:[DSize] {compute intrp bottom address offset}
add ax,si
mov ss:[Bottom],ax {and save it}
mov ax,0A000h {point es to the display segment}
mov es,ax
mov di,0
mov cx,ss:[DWidth] {put intrp right edge offset}
@dlp1:
push di
rep movsb {get a movie byte and display it}
pop di {restore original display start offset}
add di,320 {add display width to it}
mov cx,ss:[DWidth] {restore Iwidth to cx}
cmp si,ss:[Bottom] {are we at the bottom?}
jc @dlp1 {keep going if not}
@done:
pop ds {ok, we're done}
end;
end;
{================================================================}
function fstr(W:word):string8;
var s:string8;
begin
str(W,S);
fstr := S;
end;
{------------------------------------------------------------}
{format of disk file is: }
{ number of frames : word }
{ frame size in bytes : word }
{ frame width in bytes : word }
{ video frame data : array[0..frames] of dary^ }
{------------------------------------------------------------}
procedure OpenMovie;
var MovieWidth : word;
MovieSize : word;
MovieCount : word;
begin
Frame.FrameCount := 0;
if Frame.filenum > 9 then frame.filenum := 0;
MovieWidth := Frame.IntrpWidth*2;
MovieSize := (Frame.IntrpSize*2) div 3;
MovieCount := Frame.Framecount;
fns := 'DCFG'+fstr(Frame.filenum)+'.MOV';
Assign(mf,fns);
inc(Frame.filenum);
rewrite(mf,1);
blockwrite(mf,MovieCount,2);
blockwrite(mf,MovieSize,2);
blockwrite(mf,MovieWidth,2);
end;
procedure WriteMovie;
var MovieSize:word;
begin
MovieSize := (Frame.IntrpSize*2) div 3;
inc(frame.framecount);
Frame.MakeDiskArray(Frame.framenum,Frame.IntrpWidth,
Frame.IntrpSize, Frame.Iary, Frame.Dary);
blockwrite(mf,Frame.Dary^,MovieSize);
end;
procedure CloseMovie;
begin
reset(mf,1);
dec(Frame.FrameCount);
blockwrite(mf,Frame.framecount,2);
close(mf);
end;
procedure ShowMovie(what:char; Rep:boolean);
var MovieWidth:word;
MovieSize:word;
MovieCount:word;
done:boolean;
begin
showframe := false;
done := false;
While not(done) do
begin
if not(Rep) then fns := 'DCFG'+what+'.MOV';
Assign(mf,fns);
reset(mf,1);
blockread(mf,MovieCount,2);
blockread(mf,MovieSize,2);
blockread(mf,MovieWidth,2);
inc(MovieCount);
i := 0;
while i < MovieCount do
begin
blockread(mf,Frame.Dary^,MovieSize);
DisplayMovieFrame(MovieWidth,MovieSize,Frame.Dary);
if keypressed then i := MovieCount;
gotoxy(1,24);
write('Showing Movie:',fns,' Frame:',i,' ');
inc(i);
delay(50);
end;
close(mf);
if not(Rep) then done := true;
if keypressed then done := true;
end;
gotoxy(1,24);
write(' ');
end;
procedure SaveToFrame;
begin
OpenMovie;
WriteMovie;
CloseMovie;
end;
{ ************************************************************** }
{ program start }
begin
writeln;
cx := #255;
filenum := 0;
showframe := true;
MovieEnabled := false;
directvideo := false;
OldMode := CrtMode;
asm
mov ax,$0013 {switch to vga graphics mode}
mov bx,0
int $10
end;
ib := 0;
while ib < 15 do {load palettes with gray levels}
begin
asm
mov ax,1010h
mov ch,[ib] {green}
add ch,ch
add ch,ch
mov cl,ch {blue}
mov dh,ch {red}
mov bl,[ib]
mov bh,0
int 10h
end;
inc(ib);
end;
fillchar(screen,sizeof(screen),0);
Frame.Init;
if ParamCount > 0 then
Frame.SetFramePort(ParamStr(1))
else
Frame.SetFramePort('1');
gotoxy(1,20);
write('X:',Frame.IntrpWidth * 2,' Y:',Frame.IntrpSize div (Frame.Intrpwidth *2),' ');
repeat
if Frame.GrabOne then
begin
Frame.F2Iconvert(Frame.Framenum,Frame.GrabSize,
Frame.IntrpWidth,Frame.IntrpSize,
Frame.Iary, Frame.Fary[Frame.framenum]);
if MovieEnabled then
begin
WriteMovie;
gotoxy(1,24);
write('Movie:',fns,' Frame:',Frame.framecount,' ');
gotoxy(1,25);
write('Movie on ');
end
else
begin
gotoxy(1,25);
write('Movie off ');
end;
gotoxy(1,22);
write(' ');
end
else
begin
gotoxy(1,22);
write('Lost Sync');
end;
if ShowFrame then
Frame.IntrpDisplay(Frame.framenum,Frame.IntrpWidth,
Frame.IntrpSize,Frame.Iary);
if keypressed then {key pressed? If so, process it}
begin
cx := readkey;
if cx = #0 then cx := char($80+ord(readkey));
if MovieEnabled then
begin
MovieEnabled := false;
CloseMovie;
end;
if upcase(cx) = 'F'then SaveToFrame
else if upcase(cx) = 'M' then begin OpenMovie; MovieEnabled := true; end
else if upcase(cx) = 'R' then ShowMovie(cx,true)
else if upcase(cx) = 'S' then Showframe := false
else if (cx >= '0') and (cx <= '9') then ShowMovie(cx,false)
else showframe := true;
gotoxy(1,20);
write('X:',Frame.IntrpWidth * 2,' Y:',Frame.IntrpSize div (Frame.Intrpwidth *2),' ');
end;
until cx < #32;
asm
mov ah,$00 {restore original display mode}
mov al,[oldmode]
mov bx,0
int $10
end;
end.