home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
microcrn
/
issue_40.arc
/
SCANNER.ARC
/
SCRNSTUF.MOD
< prev
next >
Wrap
Text File
|
1988-01-11
|
10KB
|
329 lines
(* Code from Pascal column in Micro Cornucopia Issue #39 *)
IMPLEMENTATION MODULE ScrnStuff;
FROM SYSTEM IMPORT BYTE, ADDRESS, GETREG, SETREG, AX, BX, CX, DX,
SWI, ADR, CODE, OUTBYTE, DOSCALL;
FROM Config IMPORT Xsize, Ysize, Interleave, Unused, ScrSegment;
(* The EXPORT list has changed since the previous version *)
(* Depending on the compiler, you may need this EXPORT *)
(*EXPORT QUALIFIED Raster, Screen, ArrayLen, Lines, ClrScr, GrabClock, RlsClock,
FastClock, SlowClock, Scan, GraphMode, PixAddress, SetBit,
ClrBit, InvertBit, TextMode, Buffer, SetClock; *)
CONST
PUSHBP = 55H; (* machine code for push BP *)
POPBP = 5DH; (* likewise for pop BP *)
VAR
GReg6845 : ARRAY [0..15] OF BYTE;
TReg6845 : ARRAY [0..15] OF BYTE;
Scanning : POINTER TO BOOLEAN;
A : ADDRESS;
PROCEDURE ClrScr (VAR S:Screen);
(* Clear the graphics screen by filling its memory with zeroes *)
(* Not horribly fast, but adequate *)
VAR
I, J : CARDINAL;
BEGIN
FOR J := 0 TO ArrayLen DO
S[0,J] := CHR(0);
END;
FOR J := 1 TO Interleave-1 DO
S[J] := S[0];
END;
END ClrScr;
PROCEDURE GrabClock (IntNum : CARDINAL; TickLen : CARDINAL; VAR OldTick : CARDINAL)
:ADDRESS;
(* On further reflection it appears that this procedure is not needed *)
(* Its function is performed when the external resident routine is installed *)
BEGIN
END GrabClock;
PROCEDURE RlsClock (OldVector : ADDRESS; IntNum : CARDINAL; OldTick : CARDINAL);
(* The functions of this procedure are implemented in SlowClock *)
BEGIN
END RlsClock;
PROCEDURE FastClock;
(* The functions of this procedure are performed automatically by Scan *)
BEGIN
END FastClock;
PROCEDURE SetClock(t:CARDINAL);
(* Set a new divisor for the clock hardware. The normal divisor is 65536
(0), which gives a 55mS clock tick. Do NOT call this routine with a
parameter of zero or the real time clock interrupt processing will be
halted. Use SlowClock below to restore the clock to its normal function.
It is also unrealistic to expect everything to get done if the divisor
is set to a value much smaller than about 512 but feel free to
experiment *)
BEGIN
SETREG(CX,t); (* new time constant for timer chip *)
SETREG(AX,3); (* external resident function 3 *)
CODE(PUSHBP);
SWI(60H);
CODE(POPBP);
END SetClock;
PROCEDURE SlowClock;
(* Restore the clock hardware and interrupt vector to their original state *)
(* Do not execute this procedure until you are finished with all scans. *)
(* If you plan to scan more than one image, execute this procedure only *)
(* after the last one has been scanned. The called routine restores the *)
(* clock to normal operation but does NOT de-install the resident code. *)
BEGIN
SETREG(AX,1); (* Function code for resident routine *)
CODE(PUSHBP);
SWI(60H); (* accessed through a software interrupt *)
CODE(POPBP);
END SlowClock;
PROCEDURE StartPrinter;
CONST
(* Change these constants and add or delete DOSCALLs to match your printer *)
ESC = 33C;
L = 'L';
VAR
I, J : CARDINAL;
BEGIN
DOSCALL(5H,ESC); (* output graphics prefix *)
DOSCALL(5H, L);
DOSCALL(5H, Xsize MOD 256); (* Low order byte of Xsize *)
DOSCALL(5H, Xsize DIV 256); (* high order of Xsize *)
FOR I := 1 TO Xsize DO
DOSCALL(5H,0);
END;
(* With my printer, the print head does not return to home position after
a line of print until until you start sending the next line of data.
This delay allows the print head to return to home, then begin it's
movement before data capture is begun. You will have to experiment
to determine the proper loop values for your hardware. You may want
to make these values variables, entered from the keyboard *)
FOR J := 0 TO 1 DO
FOR I := 0 TO 23000 DO END; (* Short Delay to allow printhead to start *)
END;
END StartPrinter;
PROCEDURE StepPrinter;
CONST
(* Change these constants and add or delete DOSCALLs to match your printer *)
(* For the Star Micronics printer, this performs a 2/144" line feed *)
CR = 15C;
ESC = 33C;
J = 'J';
N = 2C;
SPACE = ' ';
VAR
I : CARDINAL;
BEGIN
DOSCALL(5H,SPACE);
DOSCALL(5H,CR);
DOSCALL(5H,ESC);
DOSCALL(5H,J);
DOSCALL(5H,N);
END StepPrinter;
PROCEDURE Scan (VAR R : Buffer);
VAR
A : ADDRESS;
BEGIN
StartPrinter;
A := ADR(R); (* address of where Modula needs the data *)
SETREG(AX,2);
SETREG(BX,A.OFFSET);
SETREG(DX,A.SEGMENT);
SETREG(CX,Xsize);
CODE(PUSHBP);
SWI(60H);
CODE(POPBP);
WHILE Scanning^ DO END; (* This is a quick and dirty method. More
elegant would be to have the resident scan
software act as a M2 coroutine. *)
StepPrinter;
END Scan;
(* I have tested GraphMode and TextMode on my video card in all three
modes, CGA, EGA and HGA. (My card emulates all three) I have NOT
tested the routines on the individual adapters *)
PROCEDURE GraphMode;
(* For CGA and EGA, call BIOS procedures to set the high resolution *)
(* monochrome graphics mode. For Hercules, directly re-program the *)
(* hardware. *)
CONST
Idx6845 = 3b4h; (* 6845 index register *)
Data6845 = 3b5h; (* 6845 data register *)
VideoMode = 3b8h; (* mode control register *)
VAR
I : CARDINAL;
BEGIN
CASE Interleave OF
1 : (* EGA Mode *)
SETREG(AX,000FH);
SWI(10H); |
2 : (* CGA Mode *)
SETREG(AX,0006H);
SWI(10H); |
4 : (* HGA Mode *)
FOR I := 0 TO 15 DO
OUTBYTE(Idx6845,I);
OUTBYTE(Data6845,GReg6845[I]);
END;
OUTBYTE(VideoMode, 0eh);
ELSE;
END;
END GraphMode;
PROCEDURE TextMode;
(* Same comments as for GraphMode above *)
CONST
Idx6845 = 3b4h; (* 6854 index register *)
Data6845 = 3b5h;
VideoMode = 3b8h;
VAR
I : CARDINAL;
BEGIN
CASE Interleave OF
1 : (* EGA Mode *)
SETREG(AX,0002H);
SWI(10H); |
2 : (* CGA Mode *)
SETREG(AX,0002H);
SWI(10H); |
4 : (* HGA Mode *)
FOR I := 0 TO 15 DO
OUTBYTE(Idx6845,I);
OUTBYTE(Data6845,TReg6845[I]);
END;
OUTBYTE(VideoMode, 20h);
SETREG(AX,0002H);
SWI(10H);
ELSE;
END;
END TextMode;
PROCEDURE PixAddress (X:Xpos; Y:Ypos; VAR B:BitPos ): ADDRESS;
(* From x and y pixel positions, calculate the physical address of the *)
(* proper byte to modify. Also returns the bit position within the *)
(* byte of the pixel. *)
CONST
Xbytes = Xsize DIV 8;
VAR
A : ADDRESS;
BEGIN
A.SEGMENT := ScrSegment;
IF Interleave = 1 THEN
A.OFFSET := (Y * Xbytes) + (X DIV 8);
ELSE
A.OFFSET := (ArrayLen +1) * (Y MOD Interleave)
+(Xbytes * (Y DIV Interleave))
+(X DIV 8);
END;
B := 7 - (X MOD 8);
RETURN A;
END PixAddress;
PROCEDURE SetBit (SrcByte:CHAR; BitNum:BitPos): CHAR;
VAR
Temp : CARDINAL;
BEGIN
Temp := ORD(SrcByte)*256+1;
SETREG(AX,Temp);
SETREG(CX,BitNum);
CODE(08H, 0C9H); (* OR CL,CL *)
CODE(74H, 02H); (* JZ NOROT *)
CODE(0D2H,0C0H); (* ROL AL,CL *)
CODE(8,0C4H); (* NOROT: OR AH,AL *)
GETREG(AX,Temp);
RETURN CHR(Temp DIV 256);
END SetBit;
PROCEDURE ClrBit (SrcByte:CHAR; BitNum:BitPos): CHAR;
VAR
Temp : CARDINAL;
BEGIN
Temp := ORD(SrcByte)*256+0feh;
SETREG(AX,Temp);
SETREG(CX,BitNum);
CODE(08H, 0C9H); (* OR CL,CL *)
CODE(74H, 02H); (* JZ NOROT *)
CODE(0D2H,0C0H); (* ROL AL,CL *)
CODE(20H,0C4H); (* NOROT: AND AH,AL *)
GETREG(AX,Temp);
RETURN CHR(Temp DIV 256);
END ClrBit;
PROCEDURE InvertBit (SrcByte:CHAR; BitNum:BitPos): CHAR;
VAR
Temp : CARDINAL;
BEGIN
Temp := ORD(SrcByte)*256+1;
SETREG(AX,Temp);
SETREG(CX,BitNum);
CODE(08H, 0C9H); (* OR CL,CL *)
CODE(74H, 02H); (* JZ NOROT *)
CODE(0D2H,0C0H); (* ROL AL,CL *)
CODE(30h,0C4H); (* NOROT: XOR AH,AL *)
GETREG(AX,Temp);
RETURN CHR(Temp DIV 256);
END InvertBit;
BEGIN
(* Initialize the values for 6845 graphics mode *)
GReg6845[0] := BYTE(37h);
GReg6845[1] := BYTE(2dh);
GReg6845[2] := BYTE(30h);
GReg6845[3] := BYTE(05h);
GReg6845[4] := BYTE(60h);
GReg6845[5] := BYTE(00h);
GReg6845[6] := BYTE(57h);
GReg6845[7] := BYTE(57h);
GReg6845[8] := BYTE(02h);
GReg6845[9] := BYTE(03h);
GReg6845[10] := BYTE(00h);
GReg6845[11] := BYTE(00h);
GReg6845[12] := BYTE(00h);
GReg6845[13] := BYTE(00h);
GReg6845[14] := BYTE(00h);
GReg6845[15] := BYTE(00h);
(* Initialize values for 6845 text mode *)
TReg6845[0] := BYTE(61h);
TReg6845[1] := BYTE(50h);
TReg6845[2] := BYTE(52h);
TReg6845[3] := BYTE(0fh);
TReg6845[4] := BYTE(19h);
TReg6845[5] := BYTE(06h);
TReg6845[6] := BYTE(19h);
TReg6845[7] := BYTE(19h);
TReg6845[8] := BYTE(02h);
TReg6845[9] := BYTE(0dh);
TReg6845[10] := BYTE(0bh);
TReg6845[11] := BYTE(0ch);
TReg6845[12] := BYTE(00h);
TReg6845[13] := BYTE(00h);
TReg6845[14] := BYTE(00h);
TReg6845[15] := BYTE(00h);
(* Get address of scanning flag from external routine *)
SETREG(AX,0); (* report address function *)
CODE(PUSHBP);
SWI(60H);
CODE(POPBP);
GETREG(DX,A.SEGMENT);
GETREG(BX,A.OFFSET);
Scanning := A;
END ScrnStuff.