home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Boldly Go Collection
/
version40.iso
/
TS
/
17A
/
DCFG203.ZIP
/
DCFGT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-08
|
13KB
|
398 lines
{Dirt Cheap Frame Grabber V2.03T (Text version)}
{as of 8 Feb 1992 - by Michael Day}
{public domain}
program DCFGT;
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;
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) }
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);
end;
var Frame : FrameObj;
prnarray : array[0..3] of word absolute $40:$08;
crtmode : byte absolute $40:$49;
oldmode : byte;
i:word;
ib:byte;
cx:char;
{-----------------------------------------------------------}
{ 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);
end;
Destructor FrameObj.Done;
begin
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 := 40;
IntrpSize := IntrpWidth*(262-12);
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;
{=====================================================================}
{now we are gonna display the video on the screen}
procedure 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,0B800h {point es to the display segment}
mov es,ax
mov cx,ss:[IWidth] {put intrp right edge offset}
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
add si,cx
mov di,fnum {start at top left corner of screen}
and di,2 {offset by frame number count (even/odd)}
@dlp1:
push di
@dlp2:
lodsb {get a intrp byte}
xlat {translate it to gray scale number}
push bx
mov ah,al
lea bx,@ahxlat
segcs
xlat
xchg ah,al
lea bx,@alxlat
segcs
xlat
pop bx
and di,$fffe
stosw {display it}
{ stosw } {display it}
inc di
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,160 {add display width to it}
mov cx,ss:[IWidth] {restore Iwidth to cx}
add si,cx {skip three video scan lines}
add si,cx
add si,cx {skip three video scan lines}
add si,cx
add si,cx {skip three video scan lines}
add si,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}
jmp @done
@alxlat: db 32,176,177,178,219,176,177,178,219,176,177,178,219
@ahxlat: db 7,8,8,8,8,7,7,7,7,15,15,15,15
@done:
pop ds {ok, we're done}
end;
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}
{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;
{ ************************************************************** }
{ program start }
begin
cx := #55;
directvideo := false;
OldMode := CrtMode;
Frame.Init;
if ParamCount > 0 then
Frame.SetFramePort(ParamStr(1))
else
Frame.SetFramePort('1');
repeat
if Frame.GrabOne then
begin
Frame.F2Iconvert(Frame.Framenum,Frame.GrabSize,
Frame.IntrpWidth,Frame.IntrpSize,
Frame.Iary, Frame.Fary[Frame.framenum]);
end;
IntrpDisplay(Frame.framenum,Frame.IntrpWidth,Frame.IntrpSize,Frame.Iary);
if keypressed then cx := readkey;
until cx < #32;
end.