Skip to content

Instantly share code, notes, and snippets.

@Fortyseven

Fortyseven/CRTASM11.PAS

Last active August 29, 2015 14:06
Show Gist options
  • Save Fortyseven/15700de3457f2e7a8287 to your computer and use it in GitHub Desktop.
Save Fortyseven/15700de3457f2e7a8287 to your computer and use it in GitHub Desktop.
Download ZIP
CRTASM v1.2 - Old Turbo Pascal DOS library from my early years
Raw
CRTASM11.PAS
{$G+,A+,S-,R-,I-,D-,L-,Q-}
Unit CRTASM;
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍCRTASM v1.1}
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ(c)1995 Hacsoft Developments}
Interface
Type
tTxt=record
c,a:byte;
end;
Var
scr :array[1..25,1..80] of tTxt absolute $B800:0;
Const
Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4;
Magenta = 5; Brown = 6; Gray = 7; DarkGray = 8;
LightBlue = 9; LightGreen = 10; LightCyan = 11;
LightRed = 12; LightMagenta = 13; Yellow = 14;
White = 15; Blink = 128;
Function WhereY :Byte;
Function WhereX :Byte;
Procedure GotoXY (X, Y: Byte);
Function KeyPressed : Boolean;
Function ReadKey:Char;
Procedure Delay (ms : Word);
Procedure MoveDW (Var z, X; siz: Word);
procedure Sound( hertz : word);
procedure NoSound;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Implementation
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function WhereY: Byte;
Var
z :byte;
Begin
Asm
mov AH, 3;
mov BH, 0;
Int $10;
mov byte ptr z,DL;
End;
wherey:=z;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function WhereX: Byte;
Var
z:byte;
Begin
Asm
mov AH, 3;
mov BH, 0;
Int $10;
mov Byte Ptr z,DH;
End;
wherex:=z;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure GotoXY (X, Y: Byte); Assembler;
Asm
mov AH, 2;
mov BH, 0;
mov DH, Byte Ptr Y;
mov DL, Byte Ptr X;
Int $10;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
(* Function KeyPressed : Boolean; Assembler;
Asm
Mov AH, 0BH
Int 21h
End;*)
(* Procedure ReadKey; Assembler;
Asm
XOr AX, AX;
Int 16h
cmp AL, 0
jz @fin
Int 16h
@fin:
End;*)
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Delay (ms : Word); Assembler;
{ms is the number of milliseconds to delay. 1000ms = 1second}
Asm
mov AX, 1000
mul ms
mov CX, DX
mov DX, AX
mov AH, $86
Int $15
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure MoveDW (Var z, X; siz: Word); Assembler; {32-Bit Data Move 386+}
Asm
push DS
{xor ecx,ecx} db $66, $33, $C9
mov CX, [BP + 04];
ShR CX, 02;
les DI, [BP + 06];
lds SI, [BP + $0A];
cld;
{ rep movsd} db $F3, $66, $A5;
pop DS
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function ReadKey:Char; Assembler;
asm mov ah, $07;
int $21;
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function KeyWaiting:Word;Assembler;
asm
Mov ax,0100h
int 16h
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function Keypressed:Boolean;Assembler;
asm
Mov ax,0100h;
int 16h;
Mov al,False;
jz @1;
Inc al;
@1:
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure sound( hertz : word); Assembler;
asm
MOV BX,SP
MOV BX,&hertz
MOV AX,34DDh
MOV DX,0012h
CMP DX,BX
JNB @J1
DIV BX
MOV BX,AX
IN AL,61h
TEST AL,03h
JNZ @J2
OR AL,03h
OUT 61h,AL
MOV AL,-4Ah
OUT 43h,AL
@J2:
MOV AL,BL
OUT 42h,AL
MOV AL,BH
OUT 42h,AL
@J1:
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure nosound; Assembler;
{turns the speaker off}
asm
in al,$61
and al,$0fc
out $61,AL
end;
End.
Raw
CRTASM12.PAS
{$G+,A+,S-,R-,I-,D-,L-,Q-,N-,E-}
Unit CRTASM;
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍCRTASM v1.2}
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ(c)1996 Hacsoft Developments}
Interface
Const RTMVer='CRTASM12';
Type
tTxt=record
c,a:byte;
end;
Var
scr :array[1..25,1..80] of tTxt absolute $B800:0000;
at, fg, bg :byte; {Foreground and Background bytes}
{$I C:\DATE.}
Const
Black = 0; Blue = 1;
Green = 2; Cyan = 3;
Red = 4; Magenta = 5;
Brown = 6; Gray = 7;
DarkGray = 8; LightBlue = 9;
LightGreen = 10; LightCyan = 11;
LightRed = 12; LightMagenta = 13;
Yellow = 14; White = 15;
Blink = 128;
Procedure WriteCh(ch:char);
{ procedure out(s:string);
procedure OutLn(s:string);}
Function WhereY :Byte;
Function WhereX :Byte;
Procedure TextColor(c:byte);
Procedure TextBackground(c:byte);
Procedure ClrScr;
Procedure GotoXY (X, Y: Byte);
Function KeyPressed : Boolean;
Function ReadKey:Char;
Procedure Delay (ms : Word);
Procedure MoveDW (Var z, X; siz: Word);
procedure Sound( hertz : word);
procedure NoSound;
procedure outpipe(s:string);
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Implementation
Uses CRT, UTILS;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function WhereY: Byte;
Var
z :byte;
Begin
Asm
mov AH, 3;
mov BH, 0;
Int $10;
mov byte ptr z,DL;
End;
wherey:=z;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function WhereX: Byte;
Var
z:byte;
Begin
Asm
mov AH, 3;
mov BH, 0;
Int $10;
mov Byte Ptr z,DH;
End;
wherex:=z;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure GotoXY (X, Y: Byte); Assembler;
Asm
mov AH, 2;
mov BH, 0;
mov DH, Byte Ptr Y;
mov DL, Byte Ptr X;
Int $10;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
(* Function KeyPressed : Boolean; Assembler;
Asm
Mov AH, 0BH
Int 21h
End;*)
(* Procedure ReadKey; Assembler;
Asm
XOr AX, AX;
Int 16h
cmp AL, 0
jz @fin
Int 16h
@fin:
End;*)
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Delay (ms : Word); Assembler;
{ms is the number of milliseconds to delay. 1000ms = 1second}
Asm
mov AX, 1000
mul ms
mov CX, DX
mov DX, AX
mov AH, $86
Int $15
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure MoveDW (Var z, X; siz: Word); Assembler; {32-Bit Data Move 386+}
Asm
push DS
{xor ecx,ecx} db $66, $33, $C9
mov CX, [BP + 04];
ShR CX, 02;
les DI, [BP + 06];
lds SI, [BP + $0A];
cld;
{ rep movsd} db $F3, $66, $A5;
pop DS
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function ReadKey:Char; Assembler;
asm mov ah, $07;
int $21;
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function KeyWaiting:Word;Assembler;
asm
Mov ax,0100h
int 16h
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function Keypressed:Boolean;Assembler;
asm
Mov ax,0100h;
int 16h;
Mov al,False;
jz @1;
Inc al;
@1:
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure sound( hertz : word); Assembler;
asm
MOV BX,SP
MOV BX,&hertz
MOV AX,34DDh
MOV DX,0012h
CMP DX,BX
JNB @J1
DIV BX
MOV BX,AX
IN AL,61h
TEST AL,03h
JNZ @J2
OR AL,03h
OUT 61h,AL
MOV AL,-4Ah
OUT 43h,AL
@J2:
MOV AL,BL
OUT 42h,AL
MOV AL,BH
OUT 42h,AL
@J1:
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
procedure nosound; Assembler;
{turns the speaker off}
asm
in al,$61
and al,$0fc
out $61,AL
end;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure WriteCh(ch:char);
{var at:byte;}
Begin
{ at:=(16*bg)+fg;}
with scr[wherex+1, wherey+1] do begin c:=byte(ch); a:=at; end;
GotoXY(wherex+1, wherey);
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure TextColor(c:byte);
Begin
fg:=c;
at:=(16*bg)+fg;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure TextBackground(c:byte);
Begin
bg:=c;
at:=(16*bg)+fg;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ClrScr;
Begin
FillChar(mem[$B800:0000], 16000, #0);
GotoXY(0,0);
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{Procedure OutLn(s:string);
Begin
out(s);
writeln;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure OutPipe(s:string);
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetPipeColor(c:byte);
Begin
case c of
0..15 : crt.TextColor(c);
20..27 : crt.TextBackground(c-20);
end;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure HandlePipe(p:string);
Begin
if p='RC' then SetPipeColor(random(14)+1); {Random Color}
if p='ME' then write(MaxAvail); {Return free memory}
if p='EO' then ClrEol;
End;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
var c:byte;
z:string[2];
Begin
c:=1; z:=' ';
while c<=length(s) do
begin
if s[c]='|' then begin {Pipe Codes}
if (c+2)>length(s) then exit;
if s[c+1]='|' then begin inc(c,2); write('|'); continue; end;
if (c+3)>length(s) then exit;
z[1]:=upcase(s[c+1]);
z[2]:=upcase(s[c+2]);
if (z[1] in ['0'..'9']) then setpipecolor(stow(z))
else handlepipe(z);
inc(c,3);
continue;
end;
if s[c]='^' then case upcase(s[c+1]) of {Control codes}
'^' :begin inc(c,2); write('^'); continue; end;
'M' :begin inc(c,2); writeln; continue; end;
'[' :begin inc(c,2); write(^[); continue; end;
end;
write(s[c]);
inc(c);
end;
End;
Begin
TextColor(7);
TextBackground(black);
End.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment