Implement procedures to manipulate basic presentation parameters of

the console window.

diff --git a/v7/src/runtime/os2winp.scm b/v7/src/runtime/os2winp.scm
index be4496f4b7ee0c44210e0ec7755cee1372231df9..a962d35bb061cb0d1e112b1567e21e5e7802017b 100644 (file)
--- a/v7/src/runtime/os2winp.scm
+++ b/v7/src/runtime/os2winp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2winp.scm,v 1.7 1995/05/16 09:21:01 cph Exp $
+$Id: os2winp.scm,v 1.8 1995/05/20 03:03:14 cph Exp $
 
 Copyright (c) 1995 Massachusetts Institute of Technology
 
@@ -33,7 +33,7 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 ;;;; OS/2 PM Interface -- Primitives
-;;; package: (runtime os2-window)
+;;; package: (runtime os2-window-primitives)
 
 (declare (usual-integrations))
 \f
@@ -104,7 +104,7 @@ MIT in each case. |#
   (os2win-show 2)
   (os2win-show-cursor 2)
   (os2win-update-frame 2))
-
+\f
 (define-integrable (event-type event) (vector-ref event 0))
 (define-integrable (event-wid event) (vector-ref event 1))
 (define-integrable (set-event-wid! event wid) (vector-set! event 1 wid))
@@ -142,6 +142,43 @@ MIT in each case. |#
   (width #f read-only #t)
   (height #f read-only #t)
   (descender #f read-only #t))
+
+(define (os2-console/set-font! font-name)
+  (let ((metrics
+        (os2ps-set-font (os2win-ps (os2win-console-wid)) 1 font-name)))
+    (if (not metrics)
+       (error "Unknown font name:" font-name))
+    (values (font-metrics/width metrics)
+           (font-metrics/height metrics))))
+
+(define (os2-console/set-colors! foreground background)
+  (let ((wid (os2win-console-wid)))
+    (os2ps-set-colors (os2win-ps wid)
+                     (->color foreground 'OS2-CONSOLE/SET-COLORS!)
+                     (->color background 'OS2-CONSOLE/SET-COLORS!))
+    (let ((w.h (os2win-get-size wid)))
+      (os2win-invalidate wid 0 (car w.h) 0 (cdr w.h)))))
+
+(define (os2-console/get-pel-size)
+  (let ((w.h (os2win-get-size (os2win-console-wid))))
+    (values (car w.h)
+           (cdr w.h))))
+
+(define (os2-console/set-pel-size! width height)
+  (os2win-set-size (os2win-console-wid) width height))
+
+(define (os2-console/get-frame-size)
+  (let ((w.h (os2win-get-frame-size (os2win-console-wid))))
+    (values (car w.h)
+           (cdr w.h))))
+
+(define (os2-console/get-frame-position)
+  (let ((x.y (os2win-get-pos (os2win-console-wid))))
+    (values (car x.y)
+           (cdr x.y))))
+
+(define (os2-console/set-frame-position! x y)
+  (os2win-set-pos (os2win-console-wid) x y))
 \f
 ;;; Constants from OS/2 header file "pmwin.h":
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 6388aca6db0f3442bee26077e8b652b29dcd399a..cb608476727d99de807463d3378babb2b5cbc06c 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.257 1995/05/16 09:20:48 cph Exp $
+$Id: runtime.pkg,v 14.258 1995/05/20 03:03:22 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -2347,6 +2347,8 @@ MIT in each case. |#
   (export ()
          os2-graphics-device-type
          os2-image/set-colormap)
+  (export (runtime os2-window-primitives)
+         ->color)
   (initialization (initialize-package!)))
 
 (define-package (runtime os2-window-primitives)
@@ -2354,6 +2356,14 @@ MIT in each case. |#
     ((os/2) "os2winp")
     (else))
   (parent ())
+  (export ()
+         os2-console/get-frame-position
+         os2-console/get-frame-size
+         os2-console/get-pel-size
+         os2-console/set-colors!
+         os2-console/set-font!
+         os2-console/set-frame-position!
+         os2-console/set-pel-size!)
   (export (runtime os2-graphics)
          bbo_and
          bbo_ignore

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 6388aca6db0f3442bee26077e8b652b29dcd399a..cb608476727d99de807463d3378babb2b5cbc06c 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.257 1995/05/16 09:20:48 cph Exp $
+$Id: runtime.pkg,v 14.258 1995/05/20 03:03:22 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -2347,6 +2347,8 @@ MIT in each case. |#
   (export ()
          os2-graphics-device-type
          os2-image/set-colormap)
+  (export (runtime os2-window-primitives)
+         ->color)
   (initialization (initialize-package!)))
 
 (define-package (runtime os2-window-primitives)
@@ -2354,6 +2356,14 @@ MIT in each case. |#
     ((os/2) "os2winp")
     (else))
   (parent ())
+  (export ()
+         os2-console/get-frame-position
+         os2-console/get-frame-size
+         os2-console/get-pel-size
+         os2-console/set-colors!
+         os2-console/set-font!
+         os2-console/set-frame-position!
+         os2-console/set-pel-size!)
   (export (runtime os2-graphics)
          bbo_and
          bbo_ignore