gcc/m2/gm2-libs-pim/Termbase.mod

   1 (* Termbase.mod provides GNU Modula-2 with a PIM 234 compatible Termbase.
   2
   3 Copyright (C) 2004-2023 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE Termbase ;
  28
  29 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  30 FROM M2RTS IMPORT Halt ;
  31 IMPORT Display, Keyboard ;
  32
  33 TYPE
  34    ReadMethods = POINTER TO RECORD
  35                                r   : ReadProcedure ;
  36                                s   : StatusProcedure ;
  37                                next: ReadMethods ;
  38                             END ;
  39
  40    WriteMethod = POINTER TO RECORD
  41                                w   : WriteProcedure ;
  42                                next: WriteMethod ;
  43                             END ;
  44
  45 VAR
  46    rStack: ReadMethods ;
  47    wStack: WriteMethod ;
  48
  49
  50 (*
  51    AssignRead - assigns a read procedure and status procedure for terminal
  52                 input. Done is set to TRUE if successful. Subsequent
  53                 Read and KeyPressed calls are mapped onto the user supplied
  54                 procedures. The previous read and status procedures are
  55                 uncovered and reused after UnAssignRead is called.
  56 *)
  57
  58 PROCEDURE AssignRead (rp: ReadProcedure; sp: StatusProcedure;
  59                       VAR Done: BOOLEAN) ;
  60 VAR
  61    t: ReadMethods ;
  62 BEGIN
  63    t := rStack ;
  64    NEW(rStack) ;
  65    IF rStack=NIL
  66    THEN
  67       Done := FALSE
  68    ELSE
  69       WITH rStack^ DO
  70          r := rp ;
  71          s := sp ;
  72          next := t
  73       END ;
  74       Done := TRUE
  75    END
  76 END AssignRead ;
  77
  78
  79 (*
  80    UnAssignRead - undo the last call to AssignRead and set Done to TRUE
  81                   on success.
  82 *)
  83
  84 PROCEDURE UnAssignRead (VAR Done: BOOLEAN) ;
  85 VAR
  86    t: ReadMethods ;
  87 BEGIN
  88    IF rStack=NIL
  89    THEN
  90       Done := FALSE
  91    ELSE
  92       Done := TRUE
  93    END ;
  94    t := rStack ;
  95    rStack := rStack^.next ;
  96    DISPOSE(t)
  97 END UnAssignRead ;
  98
  99
 100 (*
 101    Read - reads a single character using the currently active read
 102           procedure.
 103 *)
 104
 105 PROCEDURE Read (VAR ch: CHAR) ;
 106 BEGIN
 107    IF rStack=NIL
 108    THEN
 109       Halt(__FILE__, __LINE__, __FUNCTION__, 'no active read procedure')
 110    ELSE
 111       rStack^.r(ch)
 112    END
 113 END Read ;
 114
 115
 116 (*
 117    KeyPressed - returns TRUE if a character is available to be read.
 118 *)
 119
 120 PROCEDURE KeyPressed () : BOOLEAN ;
 121 BEGIN
 122    IF rStack=NIL
 123    THEN
 124       Halt(__FILE__, __LINE__, __FUNCTION__, 'no active status procedure')
 125    ELSE
 126       RETURN( rStack^.s() )
 127    END
 128 END KeyPressed ;
 129
 130
 131 (*
 132    AssignWrite - assigns a write procedure for terminal output.
 133                  Done is set to TRUE if successful. Subsequent
 134                  Write calls are mapped onto the user supplied
 135                  procedure. The previous write procedure is
 136                  uncovered and reused after UnAssignWrite is called.
 137 *)
 138
 139 PROCEDURE AssignWrite (wp: WriteProcedure; VAR Done: BOOLEAN) ;
 140 VAR
 141    t: WriteMethod ;
 142 BEGIN
 143    t := wStack ;
 144    NEW(wStack) ;
 145    IF wStack=NIL
 146    THEN
 147       Done := FALSE
 148    ELSE
 149       WITH wStack^ DO
 150          w := wp ;
 151          next := t
 152       END ;
 153       Done := TRUE
 154    END
 155 END AssignWrite ;
 156
 157
 158 (*
 159    UnAssignWrite - undo the last call to AssignWrite and set Done to TRUE
 160                    on success.
 161 *)
 162
 163 PROCEDURE UnAssignWrite (VAR Done: BOOLEAN) ;
 164 VAR
 165    t: WriteMethod ;
 166 BEGIN
 167    IF wStack=NIL
 168    THEN
 169       Done := FALSE
 170    ELSE
 171       Done := TRUE
 172    END ;
 173    t := wStack ;
 174    wStack := wStack^.next ;
 175    DISPOSE(t)
 176 END UnAssignWrite ;
 177
 178
 179 (*
 180    Write - writes a single character using the currently active write
 181            procedure.
 182 *)
 183
 184 PROCEDURE Write (VAR ch: CHAR) ;
 185 BEGIN
 186    IF wStack=NIL
 187    THEN
 188       Halt(__FILE__, __LINE__, __FUNCTION__, 'no active write procedure')
 189    ELSE
 190       wStack^.w(ch)
 191    END
 192 END Write ;
 193
 194
 195 (*
 196    Init -
 197 *)
 198
 199 PROCEDURE Init ;
 200 VAR
 201    Done: BOOLEAN ;
 202 BEGIN
 203    rStack := NIL ;
 204    wStack := NIL ;
 205    AssignRead(Keyboard.Read, Keyboard.KeyPressed, Done) ;
 206    IF NOT Done
 207    THEN
 208       Halt(__FILE__, __LINE__, __FUNCTION__, 'failed to assign read routines from module Keyboard')
 209    END ;
 210    AssignWrite(Display.Write, Done) ;
 211    IF NOT Done
 212    THEN
 213       Halt(__FILE__, __LINE__, __FUNCTION__, 'failed to assign write routine from module Display')
 214    END
 215 END Init ;
 216
 217
 218 BEGIN
 219    Init
 220 END Termbase.