ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/ASSEMBLY/ZSIM12.ZIP/EMUMENU.MOD

Modula Implementation | 1992-01-12 | 16.8 KB | 683 lines

(* Modula 2 Unterprogramme fuer den CP/M Emulator
   Fitted Modula2 2.0

   (C) 1990 by Jürgen Weber

*)

(* $A-,$S-,$R-,$T- *)

IMPLEMENTATION MODULE EmuMenu;

FROM SYSTEM IMPORT ASSEMBLER,BYTE,WORD,ADR;


(*
TYPE PhysDiskPars = RECORD
           cpm_drive       : BYTE;
                     first_phys_sec  : BYTE;
                     phys_tracks     : BYTE;
           phys_sec_pt     : BYTE;
           bytes_per_sec   : BYTE;
           autologin_flag  : BYTE;
       END;

dpb = RECORD
             spt  : WORD;
             bsh  : BYTE;
             blm  : BYTE;
             exm  : BYTE;
             dsm  : WORD;
             drm  : WORD;
             al0  : BYTE;
             al1  : BYTE;
             cks  : WORD;
             off  : WORD;
           END;
     DPBPtr = POINTER TO dpb;
     PDPPtr = POINTER TO PhysDiskPars;
*)

CONST
      TOUPPER=ORD('a')-ORD('A');
      SEPERATOR='|';
      BACKSLASH='\';

      SCR_NORMAL=7H;
      SCR_INVERS=70H;
      SCR_HIGHLIT=7H+8H;

      CSR_RIGHT = 115C;
      CSR_LEFT  = 113C;
      PAGE_UP   = 111C;
      PAGE_DOWN = 121C;
      CSR_DOWN  = 120C;
      CSR_UP    = 110C;
      HOME      = 107C;
      C_END     = 117C;
      INSERT    = 122C;
      ENTER        = 015C;
      ESC       = 033C;

      BS        = 010C;
      DEL       = 177C;
      CR        = 015C;
      LF        = 012C;


PROCEDURE Read(VAR c,cx:CHAR);
(* c:=char, cx:=extended *)
BEGIN
     ASM
        MOV  AH,0
        INT  16H
        LES  DI,c
        MOV  BYTE ES:[DI],AL
        LES  DI,cx
        MOV  BYTE ES:[DI],AH
     END;
END Read;

PROCEDURE ScrRead(VAR c,Attrib:CHAR);
(* c:=Zeichen an Cursorpos *)
BEGIN
     ASM
        MOV  AH,8
        MOV  BL,0
        INT  10H
        LES  DI,c
        MOV  BYTE ES:[DI],AL
        LES  DI,Attrib
        MOV  BYTE ES:[DI],AH
     END;
END ScrRead;

PROCEDURE Write(c:CHAR);
BEGIN
     IF c>037C THEN  (* bei druckbaren Zeichen auch Attribute *)
      ASM
        MOV  AX,c
        MOV  BX,attribute
        MOV  BH,0
        MOV  AH,9
        MOV  CX,1
        INT  10H
      END;
     END;
      ASM
        MOV  AX,c
        MOV  BX,attribute
        MOV  AH,0EH
        INT  10H
     END;
END Write;

PROCEDURE WriteString(s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
     i:=0;
     (* ACHTUNG: Zuerst muss auf <=HIGH getestet werden *)
     WHILE  (i<=HIGH(s)) AND (s[i]<>0C) DO
        Write(s[i]);
        INC(i);
     END;
END WriteString;


PROCEDURE ReadString(VAR s:ARRAY OF CHAR);
VAR c,cx:CHAR;
    i,x,y:CARDINAL;
BEGIN
    attribute:=SCR_NORMAL;
    i:=0;
    LOOP
       Read(c,cx);
       c:=Upper(c);
       IF ((c=DEL) OR (c=BS)) AND (i>0) THEN
          DEC(i);
          WhereXY(x,y);
          DEC(x);
          GotoXY(x,y);
          Write(' ');
          GotoXY(x,y);
       ELSIF (((c>=' ') AND (c<='~')) AND (i<=HIGH(s))) THEN
          Write(c);
          s[i]:=c;
          INC(i);
       ELSIF (c=CR) THEN
          s[i]:=0C;
          done:=TRUE;
          EXIT;
       ELSIF (c=ESC) THEN
          i:=0;
          done:=FALSE;
          EXIT;
       END;
    END;
END ReadString;


PROCEDURE WriteLn;
BEGIN
     Write(CR);
     Write(LF);
END WriteLn;


PROCEDURE GotoXY(x,y:CARDINAL);
BEGIN
     ASM
        MOV  DX,x
        MOV  AX,y
        MOV  DH,AL
        MOV  BH,0
        MOV  AH,2
        INT  10H
     END;
END GotoXY;

PROCEDURE WhereXY(VAR x,y:CARDINAL);
BEGIN
     ASM
        MOV  BH,0
        MOV  AH,3
        INT  10H
        LES  DI,x
        MOV  BYTE ES:[DI],DL
        LES  DI,y
        MOV  BYTE ES:[DI],DH
     END;
END WhereXY;


PROCEDURE Upper(c:CHAR):CHAR;
BEGIN
IF (c>='a') AND (c<='z') THEN
   RETURN CHR(ORD(c)-TOUPPER);
ELSE
   RETURN c;
END;
END Upper;

(*
PROCEDURE ReadCard(VAR n:CARDINAL);
CONST HIGHNUM=5;
VAR s:ARRAY[0..HIGHNUM] OF CHAR;
    c,cx:CHAR;
    z,i,j,x,y:CARDINAL;
BEGIN
    attribute:=SCR_NORMAL;
    i:=0;
    LOOP
       Read(c,cx);
       IF ((c=DEL) OR (c=BS)) AND (i>0) THEN
          DEC(i);
          WhereXY(x,y);
          DEC(x);
          GotoXY(x,y);
          Write(' ');
          GotoXY(x,y);
       ELSIF ((c>='0') AND (c<='9')) AND (i<HIGHNUM) THEN
          Write(c);
          s[i]:=c;
          INC(i);
       ELSIF (c=CR) THEN
          s[i]:=0C;
          EXIT;
       ELSIF (c=ESC) THEN
          i:=0;
          EXIT;
       END;
    END;
    IF (i>0) THEN (* es wurde was eingegeben *)
       DEC(i);
       z:=0;
       FOR j:=0 TO i DO
          z:=z*10;
          INC(z,ORD(s[j])-ORD('0'));
       END;
       n:=z;
    END;
END ReadCard;
*)

PROCEDURE ReadHex(VAR n:WORD;d:CARDINAL);
VAR s:ARRAY[0..4] OF CHAR;
    c,cx:CHAR;
    z,i,j,x,y:CARDINAL;
BEGIN
    attribute:=SCR_NORMAL;
    i:=0;
    done:=TRUE;
    LOOP
       Read(c,cx);
       c:=Upper(c);
       IF ((c=DEL) OR (c=BS)) AND (i>0) THEN
          DEC(i);
          WhereXY(x,y);
          DEC(x);
          GotoXY(x,y);
          Write(' ');
          GotoXY(x,y);
       ELSIF (((c>='0') AND (c<='9')) OR ((c>='A') AND (c<='F')))
             AND (i<d) THEN
          Write(c);
          s[i]:=c;
          INC(i);
       ELSIF (c=CR) THEN
          s[i]:=0C;
          EXIT;
       ELSIF (c=ESC) THEN
          i:=0;
          done:=FALSE;
          EXIT;
       END;
    END;
    IF (i>0) THEN (* es wurde was eingegeben *)
       DEC(i);
       z:=0;
       FOR j:=0 TO i DO
          z:=z*16;
          IF s[j]<'A' THEN
             INC(z,ORD(s[j])-ORD('0'));
          ELSE
             INC(z,ORD(s[j])-ORD('A')+10);
          END;
       END;
       n:=WORD(z);
    END;
END ReadHex;

PROCEDURE ReadHexByte(VAR b:BYTE);
VAR w:WORD;
BEGIN
     w:=WORD(ORD(b));
     ReadHex(w,2);
     b:=BYTE(CHR(CARDINAL(w)));
END ReadHexByte;


PROCEDURE WriteHexByte(b:BYTE);
VAR  n:CARDINAL;
  PROCEDURE WriteHexNib(w:WORD);
  VAR  n:CARDINAL;
  BEGIN (* WriteHexNib *)
       n:=CARDINAL(w);
       IF n>9 THEN
          Write(CHR(n-10+ORD('A')));
       ELSE
          Write(CHR(n+ORD('0')));
       END;
  END WriteHexNib;
BEGIN (* WriteHexByte *)
     n:=ORD(b);
     WriteHexNib(n DIV 16);
     WriteHexNib(n MOD 16);
END WriteHexByte;

PROCEDURE WriteHex(w:WORD);
VAR  n:CARDINAL;
BEGIN (* WriteHex *)
     n:=CARDINAL(w);
     WriteHexByte(CHR(n DIV 256));
     WriteHexByte(CHR(n MOD 256));
END WriteHex;

(* Alten Bildschirminhalt merken *)
(* Width,Height=Breite,Hoehe *)
(* KEINE Plausibilitaetstests*)
PROCEDURE SaveWin(x,y,Width,Height:CARDINAL;VAR WinSave:ARRAY OF CHAR);
VAR WinStorPtr,x0,y0:CARDINAL;
BEGIN
     WinStorPtr:=0;
     FOR y0:=0 TO Height-1 DO
         FOR x0:=0 TO Width-1 DO
             GotoXY(x+x0,y+y0);
             ScrRead(WinSave[WinStorPtr],WinSave[WinStorPtr+1]);
             INC(WinStorPtr,2);
         END;
     END;
END SaveWin;

(* Alten Bildschirminhalt wiederherstellen *)
(* Width,Height=Breite,Hoehe *)
(* KEINE Plausibilitaetstests*)
PROCEDURE RestorWin(x,y,Width,Height:CARDINAL;VAR WinSave:ARRAY OF CHAR);
VAR WinStorPtr,x0,y0:CARDINAL;
BEGIN
     WinStorPtr:=0;
     FOR y0:=0 TO Height-1 DO
         FOR x0:=0 TO Width-1 DO
             GotoXY(x+x0,y+y0);
               attribute:=ORD(WinSave[WinStorPtr+1]);
               Write(WinSave[WinStorPtr]);
             INC(WinStorPtr,2);
         END;
     END;
END RestorWin;

(* Width,Height=Breite,Hoehe *)
(* KEINE Plausibilitaetstests*)
PROCEDURE DrawBox(x,y,Width,Height:CARDINAL);
VAR x0,y0:CARDINAL;
BEGIN
     GotoXY(x,y);
     Write('┌');
     FOR x0:=1 TO Width-2 DO
         Write('─');
     END;
     Write('┐');
     FOR y0:=1 TO Height-2 DO
         GotoXY(x,y+y0);Write('│');
         FOR x0:=1 TO Width-2 DO
             Write(' ');
         END;
         Write('│');
     END;
     GotoXY(x,y+Height-1);
     Write('└');
     FOR x0:=1 TO Width-2 DO
         Write('─');
     END;
     Write('┘');
END DrawBox;

PROCEDURE DoMenue(x,y:CARDINAL;messages:ARRAY OF CHAR;
                  VAR WinSave:ARRAY OF CHAR;VAR res:CARDINAL);
CONST MAXMSG=19;
VAR p,i,LenCount,MsgCount,
    oldX,oldY,
    MaxItemLen,item:CARDINAL;
    MsgStart:ARRAY [0..MAXMSG] OF CARDINAL;
    frstLet:ARRAY [0..MAXMSG] OF CHAR;
    c,cx:CHAR;
    ExtendedChar:BOOLEAN;

PROCEDURE DisplayItem(p:CARDINAL); (* z.B. \edit|e\xit| *)
VAR x0:CARDINAL;
BEGIN
     p:=MsgStart[p-1];
     x0:=0;
     WHILE (messages[p]<>SEPERATOR) DO
        IF (attribute=SCR_NORMAL) THEN
           IF (messages[p]=BACKSLASH) THEN
              (* Schreibe das helle Zeichen *)
              INC(p);
              attribute:=SCR_HIGHLIT;
              Write(messages[p]);
              attribute:=SCR_NORMAL;
            ELSE
              Write(messages[p]);
            END;
         ELSE (* im gerade gewaehlten Bereich *)
           IF (messages[p]=BACKSLASH) THEN
              INC(p);
           END;
           Write(messages[p]);
        END;
        INC(p);INC(x0);
     END;
     WHILE (x0<MaxItemLen) DO
        Write(' ');
        INC(x0);
     END;
END DisplayItem;


BEGIN
     (* erstmal Anzahl und laengste Message finden *)
     p:=0;MaxItemLen:=0;MsgCount:=0;
     WHILE (messages[p]<>0C) DO
        LenCount:=0;
        MsgStart[MsgCount]:=p;
        WHILE (messages[p]<>SEPERATOR) DO
           IF (messages[p]=BACKSLASH) THEN
              INC(p);
              frstLet[MsgCount]:=messages[p];
           END;
           INC(p);INC(LenCount);
        END;
        INC(p);
        IF LenCount>MaxItemLen THEN MaxItemLen:=LenCount;END;
        INC(MsgCount);
     END;
(* Alten Cursorpos und Bildschirminhalt merken *)
     WhereXY(oldX,oldY);
     SaveWin(x,y,MaxItemLen+2,MsgCount+2,WinSave);
(* Rahmen und Menuepunkte schreiben *)
     attribute:=SCR_NORMAL;
     DrawBox(x,y,MaxItemLen+2,MsgCount+2);
     FOR item:=1 TO MsgCount DO
         GotoXY(x+1,y+item);
         DisplayItem(item);
     END;

(* aktuelles Element invers darstellen, Zeichen lesen
   und Element wieder normal darstellen *)
     item:=1;
     LOOP

         attribute:=SCR_INVERS;
         GotoXY(x+1,y+item);
         DisplayItem(item);
         attribute:=SCR_NORMAL;

         Read(c,cx);
         IF (c=0C) THEN c:=cx;ExtendedChar:=TRUE ELSE ExtendedChar:=FALSE END;
         GotoXY(x+1,y+item);
         DisplayItem(item);
         IF c=ESC THEN
            item:=0;
            EXIT;
         ELSIF c=ENTER THEN
            EXIT;
         END;
         IF ExtendedChar THEN
            CASE c OF
               HOME      :  item:=1
            |  C_END     :  item:=MsgCount
            |  CSR_UP    :  IF item>1 THEN DEC(item) ELSE item:=MsgCount END
            |  CSR_DOWN  :  IF item<MsgCount THEN INC(item) ELSE item:=1 END
            END;
         ELSE
(* um zufaellige Uebereinstimmung von Extended
   und highlight Char auszuschliessen *)
            FOR i:=0 TO MsgCount DO
                IF (Upper(c)=Upper(frstLet[i]))  THEN
                   item:=i+1; (* Da Anfang bei 0 *)
                   EXIT;
                END;
            END;
         END;

     END;
     res:=item;
     (* Alten Bildschirminhalt und Cursorpos wiederherstellen *)
     RestorWin(x,y,MaxItemLen+2,MsgCount+2,WinSave);
     GotoXY(oldX,oldY);
END DoMenue;

PROCEDURE Tab(t:CARDINAL);
VAR x0,y0:CARDINAL;
BEGIN
     WhereXY(x0,y0);
     GotoXY(t,y0);
END Tab;


PROCEDURE EditDPB(p:DPBPtr;q:PDPPtr;
                  VAR WinSave:ARRAY OF CHAR;VAR OK:BOOLEAN);
CONST XCORN=5;
      YCORN=5;
      RDX=12;
      LENX=20;
      LENY=19;
VAR oldX,oldY:CARDINAL;

BEGIN
(* Alten Cursorpos und Bildschirminhalt merken *)
     WhereXY(oldX,oldY);
     attribute:=SCR_NORMAL;
     SaveWin(XCORN,YCORN,LENX,LENY,WinSave);
     DrawBox(XCORN,YCORN,LENX,LENY);
     GotoXY(XCORN+1,YCORN+1);WriteString('SPT: ');WriteHex    (p^.spt);
     GotoXY(XCORN+1,YCORN+2);WriteString('BSH:   ');WriteHexByte(p^.bsh);
     GotoXY(XCORN+1,YCORN+3);WriteString('BLM:   ');WriteHexByte(p^.blm);
     GotoXY(XCORN+1,YCORN+4);WriteString('EXM:   ');WriteHexByte(p^.exm);
     GotoXY(XCORN+1,YCORN+5);WriteString('DSM: ');WriteHex      (p^.dsm);
     GotoXY(XCORN+1,YCORN+6);WriteString('DRM: ');WriteHex      (p^.drm);
     GotoXY(XCORN+1,YCORN+7);WriteString('AL0:   ');WriteHexByte(p^.al0);
     GotoXY(XCORN+1,YCORN+8);WriteString('AL1:   ');WriteHexByte(p^.al1);
     GotoXY(XCORN+1,YCORN+9);WriteString('CKS: ');WriteHex      (p^.cks);
     GotoXY(XCORN+1,YCORN+10);WriteString('OFF :');WriteHex      (p^.off);

     GotoXY(XCORN+1,YCORN+12);WriteString('DRV:   ');
     WriteHexByte(q^.cpm_drive);
     GotoXY(XCORN+1,YCORN+13);WriteString('PTR:   ');
     WriteHexByte(q^.phys_tracks);
     GotoXY(XCORN+1,YCORN+14);WriteString('PST:   ');
     WriteHexByte(q^.phys_sec_pt);
     GotoXY(XCORN+1,YCORN+15);WriteString('BPS:   ');
     WriteHexByte(q^.bytes_per_sec);
     GotoXY(XCORN+1,YCORN+16);WriteString('FSC:   ');
     WriteHexByte(q^.first_phys_sec);
     GotoXY(XCORN+1,YCORN+17);WriteString('LOG:   ');
     WriteHexByte(q^.autologin_flag);


LOOP
     OK:=FALSE;
     GotoXY(XCORN+RDX,YCORN+1); WriteString(': ');ReadHex    (p^.spt,4);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+2); WriteString(': ');ReadHexByte(p^.bsh);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+3); WriteString(': ');ReadHexByte(p^.blm);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+4); WriteString(': ');ReadHexByte(p^.exm);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+5); WriteString(': ');ReadHex    (p^.dsm,4);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+6); WriteString(': ');ReadHex    (p^.drm,4);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+7); WriteString(': ');ReadHexByte(p^.al0);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+8); WriteString(': ');ReadHexByte(p^.al1);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+9); WriteString(': ');ReadHex    (p^.cks,4);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+10);WriteString(': ');ReadHex    (p^.off,4);
     IF NOT done THEN
        EXIT;
     END;

     GotoXY(XCORN+RDX,YCORN+12);WriteString(': ');ReadHexByte(q^.cpm_drive);
     IF NOT done THEN
        EXIT;
     END;
     IF ORD(q^.cpm_drive)>1 THEN
        q^.cpm_drive:=BYTE(CHR(0)); (* nur Disklaufwerke zulaessig *)
     END;
     GotoXY(XCORN+RDX,YCORN+13);WriteString(': ');ReadHexByte(q^.phys_tracks);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+14);WriteString(': ');ReadHexByte(q^.phys_sec_pt);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+15);WriteString(': ');ReadHexByte(q^.bytes_per_sec);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+16);WriteString(': ');ReadHexByte(q^.first_phys_sec);
     IF NOT done THEN
        EXIT;
     END;
     GotoXY(XCORN+RDX,YCORN+17);WriteString(': ');ReadHexByte(q^.autologin_flag);
     OK:=done; (* nur TRUE, wenn auch letztes Lesen o.k. war *)
     EXIT;
END;

     RestorWin(XCORN,YCORN,LENX,LENY,WinSave);
     GotoXY(oldX,oldY);
END EditDPB;



PROCEDURE About(VAR WinSave:ARRAY OF CHAR);
CONST XCORN=30;
      YCORN=8;
      LENX=20;
      LENY=10;
VAR oldX,oldY:CARDINAL;
    c,cx:CHAR;

BEGIN
(* Alten Cursorpos und Bildschirminhalt merken *)
     WhereXY(oldX,oldY);
     attribute:=SCR_NORMAL;
     SaveWin(XCORN,YCORN,LENX,LENY,WinSave);
     DrawBox(XCORN,YCORN,LENX,LENY);
     GotoXY(XCORN+7,YCORN+1);
     attribute:=SCR_HIGHLIT;WriteString('ZSIM');attribute:=SCR_NORMAL;
     GotoXY(XCORN+2,YCORN+3);WriteString('THE Z80 Emulator');
     GotoXY(XCORN+2,YCORN+5);WriteString('(C) 1990,1991 by');
     GotoXY(XCORN+2,YCORN+6);WriteString('Jürgen G. Weber');
     GotoXY(XCORN+4,YCORN+8);
     attribute:=SCR_HIGHLIT;WriteString('PRESS ESC');attribute:=SCR_NORMAL;
     REPEAT
        Read(c,cx);
     UNTIL c=ESC;
     RestorWin(XCORN,YCORN,LENX,LENY,WinSave);
     GotoXY(oldX,oldY);
END About;

PROCEDURE InputString(VAR WinSave,s,p:ARRAY OF CHAR);
(* Es wird vorrausgesetzt, daß prompt p < 30 und string s < 30 *)

CONST XCORN=10;
      YCORN=15;
      LENX=40;
      LENY=5;
VAR oldX,oldY:CARDINAL;
    c,cx:CHAR;

BEGIN
(* Alten Cursorpos und Bildschirminhalt merken *)
     WhereXY(oldX,oldY);
     attribute:=SCR_NORMAL;
     SaveWin(XCORN,YCORN,LENX,LENY,WinSave);
     DrawBox(XCORN,YCORN,LENX,LENY);
     GotoXY(XCORN+2,YCORN+2);WriteString(p);
     GotoXY(XCORN+2,YCORN+3);
     ReadString(s);
     RestorWin(XCORN,YCORN,LENX,LENY,WinSave);
     GotoXY(oldX,oldY);
END InputString;

VAR attribute:CARDINAL;
    done:BOOLEAN;

BEGIN
END EmuMenu.