Category : Modula II Source Code
Archive   : MODULA2.ZIP
Filename : MACHDEP.MOD
FROM SYSTEM IMPORT AX,BX,CX,DX,SETREG,GETREG,CODE,SWI,WORD,BYTE,DOSCALL,
INBYTE,OUTBYTE;
FROM Keyboard IMPORT KeyPressed;
FROM Strings IMPORT Concat;
FROM TimeDate IMPORT Time,GetTime;
FROM Functions IMPORT StringReplace;
FROM NumberConversion IMPORT CardToString;
CONST
RowMax = 25;
ColMax = 80;
PROCEDURE RowAdjust(Row:CARDINAL) : CARDINAL;
BEGIN
RETURN(Row-1) MOD RowMax+1
END RowAdjust;
PROCEDURE ColAdjust(Col:CARDINAL) : CARDINAL;
BEGIN
RETURN(Col-1) MOD ColMax+1
END ColAdjust;
PROCEDURE Locate( row,col : CARDINAL );
VAR
row1,col1 : CARDINAL;
dx : WORD;
BEGIN
row1 := row-1;
col1 := col-1;
dx := WORD(col1 + (row1 * 256));
CODE(55H); (* push BP *)
SETREG(AX,200H); (* position cursor function *)
SETREG(DX,dx); (* row in dh, col in dl *)
SETREG(BX,0H); (* current page *)
SWI(10H); (* Video ROM call *)
CODE(5DH); (* pop BP *)
END Locate;
PROCEDURE GotoXY( col,row : CARDINAL );
VAR
row1,col1 : CARDINAL;
dx : WORD;
BEGIN
row1 := row-1;
col1 := col-1;
dx := WORD(col1 + (row1 * 256));
CODE(55H); (* push BP *)
SETREG(AX,200H); (* position cursor function *)
SETREG(DX,dx); (* row in dh, col in dl *)
SETREG(BX,0H); (* current page *)
SWI(10H); (* Video ROM call *)
CODE(5DH); (* pop BP *)
END GotoXY;
PROCEDURE Cls();
VAR
dx : WORD;
BEGIN
dx := WORD(79 + (24 * 256));
CODE(55H); (* push BP *)
SETREG(AX,600H); (* Scroll up *)
SETREG(CX,000H); (* upper left row and column *)
SETREG(DX,dx); (* lower right row in dh, col in dl *)
SETREG(BX,700H); (* blank line attribute *)
SWI(10H); (* Video ROM call *)
CODE(5DH); (* pop BP *)
Locate(1,1);
END Cls;
PROCEDURE CursorOff;
BEGIN
SETREG(AX,0100h);
SETREG(CX,2607h);
SWI(10h);
END CursorOff;
PROCEDURE CursorOn;
BEGIN
SETREG(AX,0100h);
SETREG(CX,0607h);
SWI(10h);
END CursorOn;
PROCEDURE InKey(VAR special : BOOLEAN; VAR keychar : CHAR) : BOOLEAN;
VAR
keyfetch : BYTE;
BEGIN
IF KeyPressed() THEN
DOSCALL(8H,keyfetch);
IF ORD(keyfetch) = 0 THEN
special := TRUE;
DOSCALL(8H,keyfetch);
keychar := CHR(ORD(keyfetch));
RETURN(TRUE);
ELSE
special := FALSE;
keychar := CHR(ORD(keyfetch));
RETURN(TRUE);
END
ELSE
special := FALSE;
RETURN(FALSE);
END;
END InKey;
PROCEDURE GetDateString( VAR D : ARRAY OF CHAR); (* put date in d$ *)
VAR
curTime : Time;
date,month,year : CARDINAL;
daymask,monthmask,yearmask,timebit : BITSET;
dateTemp,monthTemp,yearTemp : ARRAY[0..2] OF CHAR;
BEGIN
daymask := {0,1,2,3,4};
monthmask := {5,6,7,8};
yearmask := {9,10,11,12,13,14,15};
GetTime(curTime);
timebit := BITSET(curTime.day);
date := CARDINAL(timebit * daymask); (* curTime.day MOD 32 *)
month := CARDINAL(timebit * monthmask) DIV 32;
year := (CARDINAL(timebit * yearmask) DIV 512);
CardToString(date,dateTemp,2);
CardToString(month,monthTemp,2);
CardToString(year,yearTemp,2);
StringReplace(dateTemp,' ','0');
StringReplace(monthTemp,' ','0');
Concat(monthTemp,'/',D);
Concat(D,dateTemp,D);
Concat(D,'/',D);
Concat(D,yearTemp,D);
END GetDateString;
PROCEDURE Delay( delayM : CARDINAL);
VAR
curTime : Time;
startM,curM : CARDINAL;
BEGIN
GetTime(curTime);
startM := curTime.millisec;
curM := startM;
WHILE (curM < (startM + delayM)) DO
GetTime(curTime);
curM := curTime.millisec;
END;
END Delay;
PROCEDURE ToneInit;
VAR
sc,rl,mode,bcd,cnword : CARDINAL;
cnWord : BITSET;
BEGIN
sc := 2;
rl := 3;
mode := 3;
bcd := 0;
cnword := sc*040H + rl * 010H + mode * 2 + bcd;
cnWord := BITSET(cnword);
OUTBYTE(043H,cnWord);
END ToneInit;
PROCEDURE Tone( Freq,dur : CARDINAL);
VAR
F,FHi,FLo : CARDINAL;
contents : BITSET;
Frequency : WORD;
BEGIN
F := TRUNC( 1.193182E6 / FLOAT(Freq));
FHi := F DIV 256;
FLo := F MOD 256;
(* Frequency := WORD(F); *)
OUTBYTE(042H,CHR(FLo)); (* toneset *)
OUTBYTE(042H,CHR(FHi));
INBYTE(061H,contents); (* toneon *)
INCL(contents,0);
INCL(contents,1);
OUTBYTE(061H,contents);
Delay(dur);
INBYTE(061H,contents); (* turn off tone *)
EXCL(contents,0); (* turn off lower 2 bits *);
EXCL(contents,1);
OUTBYTE(061H,contents);
END Tone;
PROCEDURE TimeDifference( start, end: Time): REAL;
VAR
dif1, dif2: REAL;
BEGIN
IF end.minute >= start.minute THEN
dif1 := FLOAT( end.minute - start.minute );
ELSE
dif1 := 1440.0 (* 60*24 *) - FLOAT( start.minute - end.minute );
END;
IF end.millisec >= start.millisec THEN
dif2 := FLOAT( end.millisec - start.millisec );
ELSE
dif2 := - FLOAT( start.millisec - end.millisec );
END;
RETURN dif1 * 60.0 + dif2 / 1000.0;
END TimeDifference;
PROCEDURE Pause(secs: REAL);
VAR
start, end: Time;
BEGIN
GetTime(start);
REPEAT
GetTime(end);
UNTIL TimeDifference(start,end) >= secs;
END Pause;
END MachDep.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/