Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/oper_sys/emerald/emrldsys.lha/Language/Compiler/Builtins/real_OutStream.m

Text File | 1990-08-16 | 2.2 KB | 89 lines

%
% @(#)real_OutStream.mX
    1.2  3/16/88
%
import _BufferObject from "Builtins"
export _OutStreamObject to "Builtins"


const _OutStreamObject == immutable object _OutStreamObject
  export getSignature, create

  const OutStreamType == type OutStreamType
    operation putChar [Character]
    operation putInt [Integer, Integer]
    operation putReal [ Real ]
    operation putString [ String ]
    operation flush
    operation close
  end OutStreamType

  function getSignature -> [ r : Signature ]
    r <- OutStreamType
  end getSignature

  operation create [ fd : Integer ] -> [r : OutStreamType]
    r <- object aUnixOutStream
      export putChar, putInt, putReal, putString, flush, close
      const myfd : Integer == fd
      monitor
    var isBroken :    Boolean <- false
    var isClosed :       Boolean <- false
    const buffer == _BufferObject.create[myfd]

    operation putChar [r : Character]
      if isBroken or isClosed then returnAndFail end if
      buffer.addChar[r]
      on failure returnAndFail end failure
    end putChar

    operation putInt [number : Integer, width : Integer]
      const chars == number.asString
      var theWidth : Integer
      var pad : Character

      if isBroken or isClosed then returnAndFail end if
      if width < 0 then
        pad <- '0'
        theWidth <- ~width
      else
        pad <- ' '
        theWidth <- width
      end if
      buffer.pad[pad, theWidth - chars.length]
      buffer.addString[chars]
      on failure returnAndFail end failure
    end putInt

    operation putReal [r : Real]
      const chars == r.asString

      if isBroken or isClosed then returnAndFail end if
      buffer.addString[chars]
      on failure returnAndFail end failure
    end putReal

    operation putString [r : String]
      if isBroken or isClosed then returnAndFail end if
      buffer.addString[r]
      on failure returnAndFail end failure
    end putString

    operation flush
      if isBroken or isClosed then returnAndFail end if
      buffer.write
    end flush

    operation close
      if isBroken then returnAndFail end if
      buffer.write
      if myfd != 1 then
        isClosed <- true
        primitive 117 [] <- [myfd]
      end if
      on failure returnAndFail end failure
    end close
      end monitor
    end aUnixOutStream
  end create
end _OutStreamObject