Category : Miscellaneous Language Source Code
Archive   : ADAMENU2.ZIP
Filename : VIDEO.PKG

 
Output of file : VIDEO.PKG contained in archive : ADAMENU2.ZIP
-- .asis
package body video is

procedure gotoxy (x, y : in positive) is
-- move cursor to location x, y
begin
xloc := x; -- copy params to package data segment
yloc := y;
asm
16#8A#, 16#36#,
yLOC'address, -- mov dh,[>xloc]
16#FE#, 16#CE#, -- dec dh ; Match Turbo's base
16#8A#, 16#16#,
xLOC'address, -- mov dl,[>yloc]
16#FE#, 16#CA#, -- dec dl ; Match Turbo's base
16#B4#, 16#02#, -- mov ah,02
16#28#, 16#FF#, -- sub bh, bh ; page #0
16#CD#, 16#10#; -- int 16#10
end gotoxy;

procedure clrscr is
-- Clear the screen and home the cursor
begin
asm
16#50#, -- push ax
16#53#, -- push bx
16#B4#, 16#0F#, -- mov ah,15 ; read video mode
16#CD#, 16#10#, -- int 16#10
16#B4#, 16#00#, -- mov ah,0 ; set video mode
16#CD#, 16#10#, -- int 16#10
16#5B#, -- pop bx
16#58#; -- pop ax
end clrscr;

function wherex return positive is
-- Return the cursor's current column position ( 1..80 )
begin
xloc := 0;
asm
16#53#, -- push bx
16#B4#, 16#03#, -- mov ah,03
16#B7#, 16#00#, -- mov bh,00
16#CD#, 16#10#, -- int 16#10
16#88#, 16#D0#, -- mov al,dl ; Column position
16#FE#, 16#C0#, -- inc al ; Offset by 1
16#A2#,
XLOC'address, -- mov [>xloc],al
16#5B#; -- pop bx
return xloc;
end wherex;

function wherey return positive is
-- Return the cursor's current row position ( 1..25 )
begin
yloc := 0;
asm
16#53#, -- push bx
16#B4#, 16#03#, -- mov ah,03
16#B7#, 16#00#, -- mov bh,00
16#CD#, 16#10#, -- int 16#10
16#88#, 16#F0#, -- mov al,dh ; Row position
16#FE#, 16#C0#, -- inc al ; Offset by 1
16#A2#,
YLOC'address, -- mov [>yloc],al
16#5B#; -- pop bx
return yloc;
end wherey;

procedure textcolor (c : in color) is
-- set default foreground color for subsequent calls to
-- showat or setfield.
begin
colr := c; -- copy param to package data segment
asm
16#A0#,
COLR'address, -- mov al,[>colr] ; al holds new foregrnd attrib.
16#28#, 16#E4#, -- sub ah,ah ; clear ah
16#80#, 16#26#,
attributebyte'address,
16#F0#, -- and byte [>attribute_byte],16#f0
16#08#, 16#06#, -- clear low nibble of attr. byte
attributebyte'address; -- or [>attribute_byte],al
-- insert new low nibble
end textcolor;

procedure textbackground (c : in color) is
-- set default background color for subsequent calls to
-- showat or setfield.
begin
colr := c; -- copy param to package data segment
asm
16#A0#,
COLR'address, -- mov al,[>colr] ; al = new backgrnd attrib.
16#B9#,16#04#,
16#00#, -- mov cx,4 ; shift left 4
16#D2#,16#E0#, -- shl al,cl ; move low nibble to high
16#28#,16#E4#, -- sub ah,ah ; clear ah
16#80#,16#26#,
attributebyte'address,
-- and byte [>attribute_byte],16#0f
-- ; clear high nibble of attr. byte
16#0F#, -- or [>attribute_byte],al
-- ; insert new high nibble
16#08#, 16#06#,
attributebyte'address;
end textbackground;

procedure write (str : in string) is
-- Display string.
-- Note : Because this routine uses int 10h, the standard ASCII
-- formatting characters like BS and TAB are not recognized and
-- will be displayed as a graphic symbol (unless a screen driver
-- is installed).
begin
strbuf (1..str'last) := str;
-- copy param to package data segment
len := str'last;
asm
16#8a#,16#1e#,
attributebyte'address,
-- mov bl,[attributebyte] ; put attr. byte in bl
16#28#,16#ff#, -- sub bh,bh ; page #0
16#8d#,16#36#,
strbuf'address, -- lea si,[str] ; put addr. of string in si
--loop1:
16#b9#,16#01#,
16#00#, -- mov cx,1 ; turn off repititions
16#8a#,16#04#, -- mov al,[si] ; get char ready to display
16#b4#,16#09#, -- mov ah,16#09 ; display character/attr.
16#cd#,16#10#, -- int 16#10 ; call bios
16#b4#,16#03#, -- mov ah,03 ; find cursor location
16#28#,16#ff#, -- sub bh, bh ; page #0
16#cd#,16#10#, -- int 16#10 ; call bios
16#46#, -- inc si ; point to next char to display
16#fe#,16#c2#, -- inc dl ; get next column pos
16#b4#,16#02#, -- mov ah,02 ; set cursor location
16#28#,16#ff#, -- sub bh,bh ; page #0
16#cd#,16#10#, -- int 16#10 ; advance the cursor
16#ff#,16#0e#,
len'address, -- dec word [len]
16#81#,16#3e#,
len'address,
16#00#,16#00#, -- cmp word [len],0 ; last character written?
16#7f#,16#dc#; -- jg loop1 ; no. then loop again
end write;

procedure write (str : in string; l : in positive) is
-- Display string.
-- Note : Because this routine uses int 10h, the standard ASCII
-- formatting characters like BS and TAB are not recognized and
-- will be displayed as a graphic symbol (unless a screen driver
-- is installed).
begin
strbuf (1..str'last) := str;
-- copy param to package data segment
len := l;
asm
16#8a#,16#1e#,
attributebyte'address,
-- mov bl,[attributebyte] ; put attr. byte in bl
16#28#,16#ff#, -- sub bh,bh ; page #0
16#8d#,16#36#,
strbuf'address, -- lea si,[str] ; put addr. of string in si
--loop1:
16#b9#,16#01#,
16#00#, -- mov cx,1 ; turn off repititions
16#8a#,16#04#, -- mov al,[si] ; get char ready to display
16#b4#,16#09#, -- mov ah,16#09 ; display character/attr.
16#cd#,16#10#, -- int 16#10 ; call bios
16#b4#,16#03#, -- mov ah,03 ; find cursor location
16#28#,16#ff#, -- sub bh, bh ; page #0
16#cd#,16#10#, -- int 16#10 ; call bios
16#46#, -- inc si ; point to next char to display
16#fe#,16#c2#, -- inc dl ; get next column pos
16#b4#,16#02#, -- mov ah,02 ; set cursor location
16#28#,16#ff#, -- sub bh,bh ; page #0
16#cd#,16#10#, -- int 16#10 ; advance the cursor
16#ff#,16#0e#,
len'address, -- dec word [len]
16#81#,16#3e#,
len'address,
16#00#,16#00#, -- cmp word [len],0 ; last character written?
16#7f#,16#dc#; -- jg loop1 ; no. then loop again
end write;

procedure write (ascii_val : in natural) is
-- display a graphic character.
-- ascii_val is in the range 0..255
-- Mainly for use with the hibit characters that Ada
-- considers out of the character range.
begin
len := ascii_val;
asm
16#8a#,16#1e#,
attributebyte'address,
-- mov bl,[attributebyte] ; put attr. byte in bl
16#28#,16#ff#, -- sub bh,bh ; page #0
16#B9#,16#01#,
16#00#, -- mov cx,1 ; turn off repititions
16#A0#,
LEN'address, -- mov al,[>len] ; get char ready to display
16#B4#,16#09#, -- mov ah,16#09 ; display character#,attribute
16#CD#,16#10#, -- int 16#10 ; call bios
16#B4#,16#03#, -- mov ah,03 ; find cursor location
16#28#,16#FF#, -- sub bh, bh ; page #0
16#CD#,16#10#, -- int 16#10 ; call bios
16#b4#,16#03#, -- mov ah,03 ; find cursor location
16#28#,16#ff#, -- sub bh, bh ; page #0
16#cd#,16#10#, -- int 16#10 ; call bios
16#46#, -- inc si ; point to next char to display
16#fe#,16#c2#, -- inc dl ; get next column pos
16#b4#,16#02#, -- mov ah,02 ; set cursor location
16#28#,16#ff#, -- sub bh,bh ; page #0
16#cd#,16#10#; -- int 16#10 ; advance the cursor
end write;

procedure setmode (m : in videomode) is
-- set the graphics mode

begin
md := m; -- copy param to package data segment
asm
16#a0#,md'address, -- mov al,[m] ; move it to al
16#b4#,16#00#, -- mov ah,00 ; set video mode
16#cd#,16#10#; -- int 16#10 ; call bios
end setmode;

procedure CursorOn is
begin
asm
16#B4#,16#01#, -- mov ah,01 ; Set Cursor size
16#B5#,16#06#, -- mov ch,06 ; Start scan line
16#B1#,16#07#, -- mov cl,07 ; End scan line
16#CD#,16#10#; -- int 16#10
end CursorOn;

procedure CursorOff is
begin
asm
16#B4#,16#01#, -- mov ah,01 ; Set Cursor size
16#B5#,16#07#, -- mov ch,07 ; Start scan line
16#B1#,16#07#, -- mov cl,00 ; End scan line
16#CD#,16#10#; -- int 16#10
end CursorOff;

begin -- Video, package initialization

-- Initialize the attribute byte to white on black
attributebyte := character'val (7);

end video;


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : ADAMENU2.ZIP
Filename : VIDEO.PKG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/