home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / CONSOLE.I < prev    next >
Encoding:
Modula Implementation  |  1990-05-03  |  3.2 KB  |  158 lines
  1. IMPLEMENTATION MODULE Console;
  2.  
  3. (*$Y+,L-,N+*)
  4.  
  5. FROM SYSTEM IMPORT ASSEMBLER;
  6.  
  7. (*
  8.  * Ausgaben über GEMDOS.Write mit Handle = 1, Eingaben mit Handle = 0
  9.  * Negative Handles lassen sich offenbar nicht umleiten!
  10.  *)
  11.  
  12.  
  13. PROCEDURE Write (ch: CHAR);
  14.   BEGIN
  15.     ASSEMBLER
  16.         SUBQ.L  #2,A3
  17.         MOVE.L  A3,-(A7)
  18.         MOVE.L  #1,-(A7)
  19.         MOVE.L  #$00400001,-(A7)
  20.         TRAP    #1
  21.         ADDA.W  #12,A7
  22.     END
  23.   END Write;
  24.  
  25. PROCEDURE WriteString (REF str: ARRAY OF CHAR);
  26.   BEGIN
  27.     ASSEMBLER
  28.         MOVE.W  -(A3),D1
  29.         MOVE.L  -(A3),A0
  30.         
  31.         ; Length (str) bestimmen
  32.         MOVE.L  A0,D0
  33. l       TST.B   (A0)+
  34.         DBEQ    D1,l
  35.         BNE     c
  36.         SUBQ.L  #1,A0
  37. c       SUBA.L  D0,A0
  38.  
  39.         MOVE.L  D0,-(A7)
  40.         MOVE.L  A0,-(A7)
  41.         MOVE.L  #$00400001,-(A7)
  42.         TRAP    #1
  43.         ADDA.W  #12,A7
  44.     END
  45.   END WriteString;
  46.  
  47. PROCEDURE WriteLn;
  48.   BEGIN
  49.     Write (15C);
  50.     Write (12C);
  51.   END WriteLn;
  52.  
  53. PROCEDURE Read (VAR ch: CHAR);
  54.   BEGIN
  55.     ASSEMBLER
  56.         MOVE.L  -(A3),-(A7)
  57.         MOVE.L  #1,-(A7)
  58.         MOVE.L  #$003F0001,-(A7)
  59.         TRAP    #1
  60.         ADDA.W  #12,A7
  61.     END
  62.   END Read;
  63.  
  64. PROCEDURE ReadLine (VAR str: ARRAY OF CHAR);
  65.   BEGIN
  66.     ASSEMBLER
  67.         MOVEQ   #0,D0
  68.         MOVE.W  -(A3),D0
  69.         MOVE.L  -(A3),-(A7)
  70.         ADDQ.L  #1,D0
  71.         MOVE.L  D0,-(A7)
  72.         MOVE.L  #$003F0001,-(A7)
  73.         TRAP    #1
  74.         ADDQ.L  #4,A7
  75.         MOVE.L  (A7)+,D1
  76.         MOVE.L  (A7)+,A0
  77.         TST.L   D0
  78.         BMI     error
  79.         
  80.         ; nun kann Zeile auch ohne Return-Taste beendet worden sein.
  81.         ; Das ist der Fall, wenn der String voll ist.
  82.         ; In diesem Fall wird dann auf Return noch gewartet.
  83.         ; Jede andere Taste wird mit einem Bing (CHR (7)), und zwar IMMER
  84.         ; an die Console ohne Umleitung, bestätigt
  85.         CMP.L   D1,D0
  86.         BCS     ok
  87.         
  88.         SUBQ.L  #2,A7
  89.  
  90.       wait
  91.         MOVE.L  A7,-(A7)
  92.         MOVE.L  #1,-(A7)
  93.         MOVE.L  #$003F0001,-(A7)
  94.         TRAP    #1
  95.         ADDA.W  #12,A7
  96.         TST.L   D0
  97.         BEQ     wait
  98.         BMI     ende
  99.         CMPI.B  #13,(A7)
  100.         BEQ     ende
  101.         
  102.         MOVE.B  #7,(A7)
  103.         MOVE.L  A7,-(A7)
  104.         MOVE.L  #1,-(A7)
  105.         MOVE.L  #$0040FFFF,-(A7)
  106.         TRAP    #1
  107.         ADDA.W  #12,A7
  108.         BRA     wait
  109.         
  110.       ende
  111.         ADDQ.L  #2,A7
  112.         RTS
  113.         
  114.       ok
  115.         CLR.B   0(A0,D0.W)
  116.         RTS
  117.         
  118.       error
  119.         CLR.B   (A0)
  120.     END
  121.   END ReadLine;
  122.  
  123. PROCEDURE BusyRead (VAR c: CHAR);
  124.   BEGIN
  125.     ASSEMBLER
  126.         MOVE    #$FF,-(A7)
  127.         MOVE    #6,-(A7)
  128.         TRAP    #1
  129.         ADDQ.L  #4,A7
  130.         MOVE.L  -(A3),A0
  131.         MOVE.B  D0,(A0)
  132.     END
  133.   END BusyRead;
  134.  
  135. PROCEDURE KeyPressed (): BOOLEAN;
  136.   BEGIN
  137.     ASSEMBLER
  138.         MOVE    #$B,-(A7)
  139.         TRAP    #1
  140.         ADDQ.L  #2,A7
  141.         TST     D0
  142.         SNE     D0
  143.         ANDI    #1,D0
  144.         MOVE    D0,(A3)+
  145.     END
  146.   END KeyPressed;
  147.  
  148. VAR c: CHAR; (* muß global sein wg. $L- *)
  149.  
  150. PROCEDURE FlushKbd;
  151.   BEGIN
  152.     WHILE KeyPressed () DO
  153.       BusyRead (c)
  154.     END;
  155.   END FlushKbd;
  156.  
  157. END Console.
  158.