From: Arthur Gleckler Date: Thu, 19 Dec 1991 20:51:42 +0000 (+0000) Subject: Extend X graphics support to handle the new primitives X-Git-Tag: 20090517-FFI~10028 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6ccde19054aab0903964872592dc665475a77387;p=mit-scheme.git Extend X graphics support to handle the new primitives X-FONT-STRUCTURE and X-GRAPHICS-COPY-AREA. Add a selector operations for X-FONT-STRUCTURE, the object returned by the X-FONT-STRUCTURE operation, and for X-CHARACTER-BOUNDS, part of the X-FONT-STRUCTURE. --- diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index e7f63df3c..0a4f2fa43 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.128 1991/11/26 07:07:00 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.129 1991/12/19 20:50:17 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -2046,7 +2046,22 @@ MIT in each case. |# x-image/set-pixel x-image/width x-image? - x-open-display) + x-open-display + x-font-structure/name + x-font-structure/direction + x-font-structure/all-chars-exist + x-font-structure/default-char + x-font-structure/min-bounds + x-font-structure/max-bounds + x-font-structure/start-index + x-font-structure/character-bounds + x-font-structure/max-ascent + x-font-structure/max-descent + x-character-bounds/lbearing + x-character-bounds/rbearing + x-character-bounds/width + x-character-bounds/ascent + x-character-bounds/descent) (initialization (initialize-package!))) (define-package (runtime starbase-graphics) diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index c19651b2c..e325f775a 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.142 1991/11/26 07:07:15 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.143 1991/12/19 20:51:42 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 142)) + (add-identification! "Runtime" 14 143)) (define microcode-system) diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm index ccf8599da..fdecb2505 100644 --- a/v7/src/runtime/x11graph.scm +++ b/v7/src/runtime/x11graph.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.10 1991/07/23 08:19:26 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.11 1991/12/19 20:49:59 arthur Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -46,6 +46,7 @@ MIT in each case. |# (x-display-flush 1) (x-display-get-default 3) (x-display-process-events 2) + (x-font-structure 2) (x-window-x-size 1) (x-window-y-size 1) (x-window-map 1) @@ -75,6 +76,7 @@ MIT in each case. |# (x-graphics-draw-line 5) (x-graphics-draw-point 3) (x-graphics-draw-string 4) + (x-graphics-copy-area 7) (x-graphics-set-function 2) (x-graphics-set-fill-style 2) (x-graphics-set-line-style 2) @@ -140,6 +142,7 @@ MIT in each case. |# (clear ,operation/clear) (close ,operation/close) (coordinate-limits ,operation/coordinate-limits) + (copy-area ,operation/copy-area) (create-colormap ,operation/create-colormap) (create-image ,operation/create-image) (device-coordinate-limits ,operation/device-coordinate-limits) @@ -148,6 +151,7 @@ MIT in each case. |# (draw-point ,operation/draw-point) (draw-text ,operation/draw-text) (flush ,operation/flush) + (font-structure ,operation/font-structure) (get-colormap ,operation/get-colormap) (get-default ,operation/get-default) (map-window ,operation/map-window) @@ -224,6 +228,16 @@ MIT in each case. |# (vector-ref limits 2) (vector-ref limits 3)))) +(define (operation/copy-area device + source-x-left source-y-top + width height + destination-x-left destination-y-top) + (x-graphics-device/process-events! device) + (x-graphics-copy-area (x-graphics-device/window device) + source-x-left source-y-top + width height + destination-x-left destination-y-top)) + (define (operation/device-coordinate-limits device) (x-graphics-device/process-events! device) (let ((xw (x-graphics-device/window device))) @@ -250,6 +264,10 @@ MIT in each case. |# (x-display-flush (x-graphics-device/display device)) (x-graphics-device/process-events! device)) +(define (operation/font-structure device string) + (x-graphics-device/process-events! device) + (x-font-structure (x-graphics-device/display device) string)) + (define (operation/get-default device resource-name class-name) (x-graphics-device/process-events! device) (x-display-get-default (x-graphics-device/display device) @@ -488,4 +506,27 @@ MIT in each case. |# (x-store-color (colormap/descriptor colormap) position r g b)) (define (x-colormap/store-colors colormap color-vector) - (x-store-colors (colormap/descriptor colormap) color-vector)) \ No newline at end of file + (x-store-colors (colormap/descriptor colormap) color-vector)) + +;;;; Fonts + +(define-structure (x-font-structure (conc-name font-structure/) + (type vector)) + (name false read-only true) + (direction false read-only true) + (all-chars-exist? false read-only true) + (default-char false read-only true) + (min-bounds false read-only true) + (max-bounds false read-only true) + (start-index false read-only true) + (character-bounds false read-only true) + (max-ascent false read-only true) + (max-descent false read-only true)) + +(define-structure (x-character-bounds (conc-name character-bounds/) + (type vector)) + (lbearing false read-only true) + (rbearing false read-only true) + (width false read-only true) + (ascent false read-only true) + (descent false read-only true)) \ No newline at end of file diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 89f04e741..7632ff23d 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.128 1991/11/26 07:07:00 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.129 1991/12/19 20:50:17 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -2046,7 +2046,22 @@ MIT in each case. |# x-image/set-pixel x-image/width x-image? - x-open-display) + x-open-display + x-font-structure/name + x-font-structure/direction + x-font-structure/all-chars-exist + x-font-structure/default-char + x-font-structure/min-bounds + x-font-structure/max-bounds + x-font-structure/start-index + x-font-structure/character-bounds + x-font-structure/max-ascent + x-font-structure/max-descent + x-character-bounds/lbearing + x-character-bounds/rbearing + x-character-bounds/width + x-character-bounds/ascent + x-character-bounds/descent) (initialization (initialize-package!))) (define-package (runtime starbase-graphics)