home *** CD-ROM | disk | FTP | other *** search
-
- PROCEDURE RESETWINPAR(NR:BYTE);
- BEGIN
- WP[NR].X := 1;
- WP[NR].Y := 1;
- WP[NR].L := 0;
- WP[NR].W := 0;
- WP[NR].F := FALSE;
- END;
-
-
- PROCEDURE REMOVEWINDOW(NR:BYTE);
- VAR I : BYTE;
- BEGIN
- FOR I := LENGTH(WS) DOWNTO 1 DO IF ORD(WS[I]) = NR THEN DELETE(WS,I,1);
- END;
-
-
- PROCEDURE CLOSEWINDOW(NR:BYTE);
- VAR WDP : WINDOWPTR;
- BEGIN
- REMOVEWINDOW(NR);
- IF LENGTH(WS) > 0 THEN WN := ORD(WS[LENGTH(WS)]);
- IF (NR = 2) OR (NR = WNM) THEN WNM := 0;
- IF WP[NR].F THEN BEGIN { NUR FÜR AKTIVIERTE WINDOWS AUSFÜHREN ! }
- DISPOSEVSCREEN(SC[NR]);
- IF ACTIVATEWINDOW(WI[NR]) THEN WDP := ERASETOPWINDOW;
- RESETWINPAR(NR);
- END;
- END;
-
-
- PROCEDURE CLOSEWINDOWS;
- VAR I : BYTE;
- BEGIN
- FOR I := 1 TO MAXWIND DO CLOSEWINDOW(I);
- END;
-
-
- PROCEDURE AUSDIEMAUS;
- BEGIN
- CLOSEWINDOWS;
- IF KT1 <> '' THEN BEGIN
- FASTTEXT(KT1,1,1);
- WRITEATTRIBUTE(KA1,1,1);
- FASTTEXT(KT2,2,1);
- WRITEATTRIBUTE(KA2,2,1);
- END;
- TEXTATTR := TA;
- IF MAUSAKT THEN BEGIN
- DISABLEEVENTHANDLING;
- HIDEMOUSE;
- RESTOREMOUSESTATE(MSP,FALSE);
- FREEMEM(MSP,MSPSIZE);
- END;
- IF CY > 1 THEN BEGIN
- GOTOXY(CX,CY-1);
- CLREOL;
- GOTOXY(CX,CY-2);
- END ELSE GOTOXY(CX,CY);
- NORMALCURSOR;
- HALT;
- END;
-
-
- PROCEDURE ALERT(TEXT:STRING);
- VAR CH1 : CHAR;
- BEGIN
- IF NOT MAKEWINDOW(AWIN,10,11,70,16,TRUE,TRUE,FALSE,$4E,$4F,$CE,' Fehler ') THEN BEGIN
- WRITELN('FEHLER MAKEWINDOW');
- HALT;
- END;
- IF NOT ACTIVATEWINDOW(AWIN) THEN BEGIN
- WRITELN('FEHLER ACTIVATEWINDOW');
- HALT;
- END;
- HIDDENCURSOR;
- GOTOXY( ((LO(WINDMAX)-LO(WINDMIN))-LENGTH(TEXT)) SHR 1 ,2);
- WRITE(TEXT);
- GOTOXY( ((LO(WINDMAX)-LO(WINDMIN))-13) SHR 1 ,4);
- WRITE('Taste drücken');
- WHILE KEYPRESSED DO CH1 := READKEY;
- CH1 := READKEY;
- WHILE KEYPRESSED DO CH1 := READKEY;
- AUSDIEMAUS;
- END;
-
-
- PROCEDURE VWRITE;
- VAR S : STRING;
- BEGIN
- READSTR(S);
- IF LENGTH(S) > WP[WN].W0 THEN S[0] := CHAR(WP[WN].W0);
- IF QUIET THEN EXIT;
- FASTWRITE(S,ZEI,SPA,TEXTATTR);
- INC(SPA,LENGTH(S));
- IF SPA > SPM THEN SPM := SPA;
- END;
-
-
- PROCEDURE VWRITELN;
- BEGIN
- IF NOWIN THEN WRITELN;
- VWRITE;
- INC(ZEI);
- SPA := 1;
- END;
-
-
- PROCEDURE VWRITELNS(TEXT:STRING);
- BEGIN
- WRITE(TPSTR,TEXT);
- VWRITELN;
- END;
-
-
- PROCEDURE MESSAGE(TEXT:STRING);
- VAR P : WINDOWPTR;
- CH1 : CHAR;
- BEGIN
- IF QUIET THEN BEGIN
- WRITELN(TEXT);
- EXIT;
- END;
- IF NOT ACTIVATEWINDOW(BWIN) THEN ALERT('FEHLER ACTIVATEWINDOW');
- HIDDENCURSOR;
- CLRSCR;
- GOTOXY( ((LO(WINDMAX)-LO(WINDMIN))-LENGTH(TEXT)) SHR 1 ,2);
- WRITE(TEXT);
- WHILE KEYPRESSED DO CH1 := READKEY;
- CH1 := READKEY;
- WHILE KEYPRESSED DO CH1 := READKEY;
- P := ERASETOPWINDOW;
- END;
-
-
- FUNCTION MHEX1(B:BYTE):STRING;
- BEGIN
- B := B AND $F;
- IF B > 9 THEN MHEX1 := CHR(B+$37) ELSE MHEX1 := CHR(B+$30);
- END;
-
-
- FUNCTION MHEX2N(B:BYTE):STRING;
- BEGIN
- IF B SHR 4 = 0 THEN MHEX2N := MHEX1(B)
- ELSE MHEX2N := MHEX1(B SHR 4) + MHEX1(B);
- END;
-
-
- FUNCTION ENTFERNE(ADRESSE:WORD):BOOLEAN;
- VAR R : REGISTERS;
- BEGIN
- ENTFERNE := FALSE;
- WITH R DO BEGIN
- AH := $49;
- ES := ADRESSE;
- MSDOS(R);
- IF (FLAGS AND FCARRY) = 0 THEN ENTFERNE := TRUE;
- END; { WITH }
- END;
-
-
- PROCEDURE PSPDISP;
- VAR CH : CHAR;
- PSPP : ^PSPTYP;
- CMDL : STRING;
-
- PROCEDURE CHECKCMDL;
- VAR I : INTEGER;
- BEGIN
- IF (LENGTH(CMDL) > 127) THEN BEGIN
- CMDL := #237;
- EXIT;
- END;
- FOR I := 1 TO LENGTH(CMDL) DO BEGIN
- IF (CMDL[I] < ' ') AND (CMDL[I] > #0) THEN BEGIN
- CMDL := #237;
- EXIT;
- END;
- END;
- END; { CHECKCMDL }
-
- BEGIN { PSPDISP }
- IF MCB^.LEN < 16 THEN EXIT; { ZU KLEIN FÜR PSP ! }
- PSPP := NIL;
- SOF(PSPP).S := MCB^.PSP;
- IF (SOF(PSPP).S = $9FFF) OR
- (SOF(PSPP).S = $A000) OR
- (SOF(PSPP).S = $B000) OR
- (SOF(PSPP).S = $B800) THEN BEGIN
- WRITE(TPSTR,' VIDEO- RAM');
- IF (SOF(MCB).S+MCB^.LEN >= $C000) THEN WRITE(TPSTR,' & EPROM');
- MCBA[MCBAP].ATTR := 5;
- EXIT;
- END;
- WITH PSPP^ DO BEGIN
- IF INTR20 <> $20CD THEN EXIT;
- CMDL := CMDLIN;
- CHECKCMDL;
-
- END; { WITH }
-
- IF MCB^.PSP = 0 THEN EXIT; { MCB IST FREIGEGEBEN }
- IF SUCC(SOF(MCB).S) <> MCB^.PSP THEN EXIT; { NUR DEN MCB DES PSP SELBST ! }
-
- WRITE(TPSTR,'≥',CMDL,'≤');
- MCBA[MCBAP].ATTR := 2;
- END; { PSPDISP }
-
-
- FUNCTION HOLENAME(P:POINTER):STRING;
- VAR ENV : ^CHARRAY ABSOLUTE P;
- PNAME : STRING;
- I : WORD;
- BEGIN
- HOLENAME := '';
- I := 1;
- IF NOT(ENV^[I] IN [' '..'z']) THEN EXIT;
- REPEAT
- WHILE ENV^[I] <> #0 DO INC(I);
- INC(I);
- UNTIL (ENV^[I] = #0);
- INC(I);
- IF ENV^[I] <> #1 THEN EXIT;
- INC(I);
- IF ENV^[I] <> #0 THEN EXIT;
- INC(I);
- PNAME := '';
- WHILE ENV^[I] <> #0 DO BEGIN
- PNAME := PNAME + ENV^[I];
- INC(I);
- END;
- HOLENAME := PNAME;
- END;
-
-
- FUNCTION SUCHNAME:BOOLEAN;
- VAR PNAME : STRING;
- P,N : BYTE;
- I : WORD;
- ENV : ^CHARRAY;
- G : BOOLEAN;
- BEGIN
- SUCHNAME := FALSE;
- ENV := MP;
- N := 0;
- G := FALSE;
- I := 1;
- IF NOT(ENV^[I] IN [' '..'z']) THEN EXIT;
- REPEAT
- WHILE ENV^[I] <> #0 DO BEGIN
- IF ENV^[I] = '=' THEN G := TRUE;
- INC(I);
- END;
- INC(N);
- IF (N = 1) AND NOT G THEN EXIT;
- INC(I);
- UNTIL (ENV^[I] = #0);
- MCBA[MCBAP].ATTR := 1;
- INC(I);
- IF ENV^[I] <> #1 THEN EXIT;
- INC(I);
- IF ENV^[I] <> #0 THEN EXIT;
- INC(I);
- WRITE(TPSTR,' ');
- PNAME := '';
- WHILE ENV^[I] <> #0 DO BEGIN
- PNAME := PNAME + ENV^[I];
- INC(I);
- END;
- WRITE(TPSTR,PNAME);
- SUCHNAME := TRUE;
- P := POS('MCBLIST.EXE',PNAME);
- IF (P > 0) AND ((P+10) = LENGTH(PNAME)) THEN BEGIN
- OLDMEM := HP;
- END;
- END; { SUCHNAME }
-
-
- FUNCTION BATDISP(MSEG:WORD;UPDATE:BOOLEAN):BOOLEAN;
- VAR I : INTEGER;
- BEGIN
- BATDISP := FALSE;
- IF UPDATE THEN IF SUCHNAME THEN EXIT;
- FOR I := $18 TO $1E DO IF MEM[MSEG:I] <> $FF THEN EXIT;
- I := $1F;
- IF NOT (MEM[MSEG:I] IN [$21..$7A]) THEN EXIT;
- WRITE(TPSTR,'≡');
- WHILE MEM[MSEG:I] <> 0 DO BEGIN
- WRITE(TPSTR,CHR(MEM[MSEG:I]));
- INC(I);
- END;
- WRITE(TPSTR,'≡');
- IF UPDATE THEN MCBA[MCBAP].ATTR := 3;
- BATDISP := TRUE;
- END; { BATDISP }
-
-
- PROCEDURE CLRVSCREEN(NR,ATTR:BYTE);
- BEGIN
- CLEARVSCREEN(SC[NR],ATTR,' ');
- ZEI := 1; SPA := 1; SPM := 0;
- ACTIVATEVSCREEN(SC[NR]);
- TEXTATTR := ATTR;
- CLRSCR;
- END;
-
-
- FUNCTION SETWINDOW(NR,ATTR,LEN,WID:BYTE;VS:BOOLEAN):BOOLEAN;
- BEGIN
- SETWINDOW := TRUE;
- WN := NR;
- REMOVEWINDOW(WN);
- WS := WS + CHR(WN);
- IF NOT ACTIVATEWINDOW(WI[NR]) THEN ALERT('FEHLER ACTIVATEWINDOW');
- IF SETTOPTILEDWINDOW(WI[NR]) THEN {};
- HIDDENCURSOR;
- IF WP[NR].F THEN EXIT;
- WP[NR].W0 := WID;
- SETWINDOW := FALSE;
- IF VS THEN BEGIN
- IF NOT MAKEVSCREEN(SC[NR],LEN,WID) THEN ALERT('FEHLER MAKEVSCREEN');
- CLRVSCREEN(NR,ATTR);
- END;
- END;
-
-
- PROCEDURE CLOSEVSCREEN(NR:BYTE);
- BEGIN
- TEXTATTR := TA;
- DEACTIVATEVSCREEN;
- WP[NR].L := ZEI; WP[NR].W := SPM;
- MOVEVSCREENTOWINDOW(SC[NR],1,1);
- WP[NR].F := TRUE;
- END;
-
-
- FUNCTION READTEXTFILE(NAME:STRING):BOOLEAN;
- VAR F : TEXT;
- S : STRING;
- CH1 : CHAR;
- NBL,NBB : WORD;
- L : LONGINT;
- BEGIN
- READTEXTFILE := FALSE;
- IF NOT EXISTFILE(NAME) THEN EXIT;
- ASSIGN(F,NAME);
- RESET(F);
- IF POS('.EXE',NAME) > 0 THEN BEGIN
- READ(F,CH1);
- READ(F,CH2); { 2 BYTE EXE- HEADER }
- READ(F,CH1);
- READ(F,CH2);
- NBL := ORD(CH1) + 256 * ORD(CH2);
- READ(F,CH1);
- READ(F,CH2);
- NBB := ORD(CH1) + 256 * ORD(CH2);
- L := NBB; L := L * 512; L := L - (512 - NBL);
- IF NOT TEXTSEEK(F,L) THEN EXIT;
- END;
- WHILE NOT EOF(F) DO BEGIN
- READLN(F,S);
- VWRITELNS(S);
- END;
- CLOSE(F);
- {$I+}
- READTEXTFILE := TRUE;
- END; { READTEXTFILE }
-
-
- PROCEDURE HELP;
- BEGIN
- WNM := WN;
- IF SETWINDOW(2,$70,250,80,TRUE) THEN EXIT;
- IF NOT READTEXTFILE('MCBLIST.EXE') THEN ;
- IF ZEI < 2 THEN BEGIN
- IF NOT READTEXTFILE('MCBLIST.HLP') THEN BEGIN
- VWRITELN;
- VWRITELNS(' Datei '+ZIELDIR+'MCBLIST.HLP nicht gefunden');
- END;
- END;
- CLOSEVSCREEN(2);
- END; { HELP }
-
-
- PROCEDURE CONFIGDIS;
- BEGIN
- IF SETWINDOW(6,$70,100,80,TRUE) THEN EXIT;
- VWRITELNS(' ┌─────────────────────────────────────┐');
- VWRITELNS(' │ C:\CONFIG.SYS │');
- VWRITELNS(' └─────────────────────────────────────┘');
- IF NOT READTEXTFILE('C:\CONFIG.SYS') THEN BEGIN
- VWRITELN;
- VWRITELNS(' C:\CONFIG.SYS nicht gefunden');
- VWRITELN;
- END;
- VWRITELNS(' ┌─────────────────────────────────────┐');
- VWRITELNS(' │ C:\AUTOEXEC.BAT │');
- VWRITELNS(' └─────────────────────────────────────┘');
- IF NOT READTEXTFILE('C:\AUTOEXEC.BAT') THEN BEGIN
- VWRITELN;
- VWRITELNS(' C:\AUTOEXEC.BAT nicht gefunden');
- END;
- CLOSEVSCREEN(6);
- END; { CONFIGDIS }
-
-
- PROCEDURE SAVEINTS;
- VAR I : INTEGER;
- AMEM : LONGINT;
- P : POINTER;
- BEGIN
- ASSIGN(F,INTFNAME);
- {$I-}
- REWRITE(F);
- WRITE(F,FILEID); { KONSTANTE AUS DEM PROGRAMMKOPF }
- WRITE(F,OLDMEM); { FREIER MCB VOR VIDEO- ADAPTER }
- WRITE(F,OLDMEMJ); { FREIER MCB HINTER VIDEO- ADAPTER }
- P := PTR(MEMW[$40:$13],0);
- WRITE(F,P);
- FOR I := 0 TO LASTVEC DO WRITE(F,IP[I]);
- FILERR := NOT (IORESULT = 0);
- {$I+}
- WRITELN;
- IF NOT FILERR THEN BEGIN
- CLOSE(F);
- MESSAGE('##### INTERRUPT- VEKTOREN GESPEICHERT #####');
- END ELSE BEGIN
- MESSAGE('***** Fehler bei schreiben File '+INTFNAME+' *****');
- END;
- END; { SAVEINTS }
-
-
- PROCEDURE READFILE(MELDEN:BOOLEAN);
- VAR P : POINTER;
- BEGIN
- OLDMEMF := NIL;
- OLDMEMG := NIL;
- MEMSIZE := MEMW[$40:$13];
- ASSIGN(F,INTFNAME);
- {$I-}
- RESET(F);
- FILERR := NOT (IORESULT = 0);
- IF FILERR THEN BEGIN
- IF MELDEN THEN MESSAGE('*** File MCBLIST.SAV nicht gefunden ***');
- EXIT;
- END;
- READ(F,P);
- IF P <> FILEID THEN BEGIN
- FILERR := TRUE;
- CLOSE(F);
- MESSAGE(' falsches SAVE- File- Format ');
- END ELSE BEGIN
- READ(F,OLDMEMF);
- READ(F,OLDMEMG);
- READ(F,P);
- MEMSIZE := SOF(P).S;
- FOR I := 0 TO LASTVEC DO READ(F,BUF[I]);
- FILERR := NOT (IORESULT = 0);
- END;
- {$I+}
- IF FILERR THEN BEGIN
- OLDMEMF := NIL;
- OLDMEMG := NIL;
- MEMSIZE := MEMW[$40:$13];
- MESSAGE('*** Lesefehler MCBLIST.SAV ***');
- END ELSE CLOSE(F);
- END; { READFILE }
-
-
- PROCEDURE RESTOREINTS(MAUSWEG,GEWALT:BOOLEAN);
- VAR I : WORD;
- P : POINTER;
- R : REGISTERS;
-
- FUNCTION GEHTS(VONWO:POINTER;BISWO:WORD):BOOLEAN;
- VAR HP : ^MCBTYP;
- BEGIN { GEHTS }
- GEHTS := TRUE;
- IF VONWO = NIL THEN EXIT;
- HP := VONWO;
- REPEAT
- IF SUCC(SOF(HP).S) = CHEF THEN BEGIN
- GEHTS := FALSE;
- EXIT;
- END;
- IF (HP^.ID <> 'Z') THEN SOF(HP).S := SOF(HP).S + SUCC(HP^.LEN);
- UNTIL (HP^.ID = 'Z') OR (SUCC(SOF(HP).S) >= BISWO);
- END; { GEHTS }
-
- PROCEDURE FREIGABE(VONWO:POINTER;BISWO:WORD);
- VAR FRECNT : INTEGER;
- ERROR,ENDE : BOOLEAN;
- HP : ^MCBTYP;
- R : REGISTERS;
- BEGIN { FREIGABE }
- IF NOT QUIET THEN CLRSCR;
- ERROR := FALSE;
- ENDE := FALSE;
- FRECNT := 0;
- HP := VONWO;
- WITH R DO BEGIN
- REPEAT
- AX := $4900;
- ES := SUCC(SOF(HP).S);
- IF HP^.PSP <> 0 THEN BEGIN
- WRITELN('Memory- Block ',HEXW(ES),':0000 freigeben');
- MSDOS(R);
- IF (FLAGS AND FCARRY) <> 0 THEN BEGIN
- WRITELN('Memory- Block ',HEXW(ES),':0000 Fehler ',HEXW(AX));
- ERROR := TRUE;
- END ELSE BEGIN
- INC(FRECNT);
- FILLCHAR(HP^.N,SIZEOF(HP^.N),#0);
- END;
- END;
- IF HP^.ID = 'Z' THEN ENDE := TRUE;
- IF (HP^.ID <> 'Z') THEN SOF(HP).S := SOF(HP).S + SUCC(HP^.LEN);
- UNTIL ERROR OR ENDE OR (SUCC(SOF(HP).S) >= BISWO);
- IF ERROR THEN BEGIN
- MESSAGE('***** Fehler beim Freigeben des Speichers *****');
- END;
- END; { WITH }
- END; { FREIGABE }
-
- BEGIN { RESTOREINTS }
- READFILE(TRUE);
- IF NOT FILERR THEN BEGIN
- { NUR FREIGEBEN, WENN DER EIGENE MUTTERPROZESS NICHT BETROFFEN IST }
- IF NOT GEWALT THEN BEGIN
- IF NOT GEHTS(OLDMEMF,$9FFE) OR
- NOT GEHTS(OLDMEMG,$FFFF) THEN BEGIN
- MESSAGE(' Der eigene Mutterprozess darf nicht freigegeben werden');
- EXIT;
- END;
- END; { IF NOT GEWALT }
-
- { DIE INTERRUPT VEKTOREN RESTAURIEREN }
- INLINE($FA); { CLI }
- FOR I := 0 TO LASTVEC DO IP[I] := BUF[I];
- INLINE($FB); { STI }
- MESSAGE('##### Interrupt- Vektoren restauriert #####');
-
- { GGF. DEN MAUSEVENT ABSCHALTEN }
- IF MAUSWEG THEN BEGIN
- GETINTVEC($33,P);
- IF P <> NIL THEN BEGIN
- R.AX := $0C;
- R.CX := 0;
- R.ES := 0;
- R.DX := 0;
- INTR($33,R);
- MESSAGE('Der Maus- Event- Interrupt ist deaktiviert');
- END ELSE BEGIN
- MESSAGE('*** kein Maustreiber installiert ***');
- END;
- END;
- { FREIGEBEN VOR VIDEO- ADAPTER }
- IF OLDMEMF <> NIL THEN FREIGABE(OLDMEMF,$9FFE);
- { FREIGEBEN HINTER VIDEO- ADAPTER }
- IF OLDMEMG <> NIL THEN FREIGABE(OLDMEMG,$FFFF);
- END;
- END; { RESTOREINTS }
-
-
- PROCEDURE INTMAP;
- VAR I : INTEGER;
- COL,TC : BYTE;
- IRET,ILL : BOOLEAN;
- TA : BYTE;
- ILLP : POINTER;
- BEGIN
- IF SETWINDOW(3,$07,54,72,TRUE) THEN EXIT;
-
- ILLP := NIL;
- IF NOT FILERR THEN BEGIN
- IF (BUF[$54] = BUF[$55]) AND
- (BUF[$54] = BUF[$56]) AND
- (BUF[$54] = BUF[$57]) AND
- (BUF[$54] = BUF[$58]) THEN ILLP := BUF[$54];
- END;
-
- TA := TEXTATTR;
- WRITE(TPSTR,' SHUTDOWN- POINTER = ',HEXPTR(SDP));
- WRITE(TPSTR,' MODE- POINTER = ',HEXPTR(MODVEC));
- VWRITELN;
-
- COL := 14;
- TEXTCOLOR(COL);
- I := 0;
- REPEAT
- IF LCD THEN TEXTATTR := $07;
- IF NOT FILERR THEN BEGIN
- IF BUF[I] = IP[I] THEN TEXTBACKGROUND(0) ELSE BEGIN
- IF LCD THEN TEXTATTR := $70 ELSE TEXTBACKGROUND(1); { $47 }
- END;
- END;
-
- IRET := FALSE;
- ILL := FALSE;
- IF IP[I] = NIL THEN TEXTATTR := TAFREI ELSE BEGIN
- IRET := MEM[SOF(IP[I]).S:SOF(IP[I]).O] = $CF;
- ILL := (ILLP <> NIL) AND (IP[I] = ILLP);
- IF NOT IRET AND (I > 0) AND (IP[I] <> IP[I-1]) THEN BEGIN
- IF NOT LCD THEN BEGIN
- DEC(COL);
- IF COL < 9 THEN COL := 14;
- IF LO(LASTMODE) = 7 THEN COL := 14;
- TEXTCOLOR(COL);
- END;
- END;
- END;
-
- IF NOT LCD THEN BEGIN
- IF IRET THEN TEXTCOLOR(6) ELSE
- IF ILL THEN TEXTCOLOR(4) ELSE
- IF SOF(IP[I]).S = $F000 THEN TEXTCOLOR(7);
- END ELSE BEGIN
- IF SOF(IP[I]).S = $F000 THEN TEXTATTR := $04;
- END;
- WRITE(TPSTR,I:3,',',HEXB(I),'H=',HEXW(SOF(IP[I]).S),':');
- VWRITE;
- IF NOT LCD THEN BEGIN
- IF IRET THEN TEXTCOLOR(6) ELSE
- IF ILL THEN TEXTCOLOR(4) ELSE
- IF IP[I] <> NIL THEN TEXTCOLOR(COL);
- END;
- WRITE(TPSTR,HEXW(SOF(IP[I]).O));
- VWRITE;
-
- TEXTBACKGROUND(0);
- IF IRET THEN WRITE(TPSTR,'!') ELSE
- IF ILL THEN WRITE(TPSTR,'*') ELSE
- WRITE(TPSTR,' ');
- IF (I AND 3) = 3 THEN VWRITELN ELSE VWRITE;
- INC(I);
- UNTIL (I > LASTVEC);
-
- CLOSEVSCREEN(3);
- END; { INTMAP }
-
-
- PROCEDURE VECTANZ;
- VAR I,VON1,BIS1 : WORD;
- LV,L1 : INTEGER;
- A : BOOLEAN;
- IVS : POINTER;
- BEGIN { VECTANZ }
- A := FALSE;
- LV := -2;
- IF VON = BIS THEN EXIT;
- IF VON > BIS THEN BEGIN
- VON1 := BIS;
- BIS1 := VON;
- END ELSE BEGIN
- VON1 := VON;
- BIS1 := BIS;
- END;
-
- TEXTATTR := TAVEKT;
-
- IF (VON1 <> $F000) THEN BEGIN
- IF (SOF(SDP).S >= VON1) AND
- (SOF(SDP).S < BIS1) AND
- (SDP <> NIL) THEN BEGIN
- WRITE(TPSTR,' SDP');
- END;
- IF (SOF(MODVEC).S >= VON1) AND
- (SOF(MODVEC).S < BIS1) AND
- (MODVEC <> NIL) THEN BEGIN
- WRITE(TPSTR,' MODE');
- END;
- VWRITE;
- END;
-
- FOR I := 0 TO LASTVEC DO BEGIN
- IVS := IP[I];
- IF ( (VON1 <> $F000) AND
- (SOF(IVS).S <> $F000) ) OR
- ( (VON1 = $F000) AND
- (SOF(IVS).S = $F000) ) THEN BEGIN
-
- IF (SOF(IVS).S >= VON1) AND
- (SOF(IVS).S < BIS1) AND
- (IVS <> NIL) THEN BEGIN
- IF I = SUCC(LV) THEN BEGIN
- IF NOT A THEN WRITE(TPSTR,'-');
- A := TRUE;
- END ELSE BEGIN
- WRITE(TPSTR,' ');
- IF NOT FILERR THEN BEGIN
- IF BUF[I] = IP[I] THEN TEXTATTR := TAVEKT
- ELSE TEXTATTR := TAVNEU;
- END;
- WRITE(TPSTR,MHEX2N(I));
- A := FALSE;
- END;
- LV := I;
- END;
- END;
- IF LV = PRED(I) THEN BEGIN
- IF A THEN WRITE(TPSTR,MHEX2N(LV));
- END;
- VWRITE;
- END; { NEXT I }
-
- TEXTBACKGROUND(0);
- IF NOT FILERR THEN BEGIN
- TEXTATTR := TAVALT;
- FOR I := 0 TO LASTVEC DO BEGIN
- IVS := BUF[I];
- IF ( (VON1 <> $F000) AND
- (SOF(IVS).S <> $F000) ) OR
- ( (VON1 = $F000) AND
- (SOF(IVS).S = $F000) ) THEN BEGIN
- IF BUF[I] <> IP[I] THEN BEGIN
- IF (SOF(IVS).S >= VON1) AND
- (SOF(IVS).S < BIS1) AND
- (IVS <> NIL) THEN BEGIN
- WRITE(TPSTR,' ',MHEX2N(I));
- END;
- END;
- END;
- VWRITE;
- END; { NEXT I }
- END;
-
- TEXTATTR := TA;
- END; { VECTANZ }
-