summaryrefslogtreecommitdiffstats
path: root/tek41.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit8466d8cfa486fb30d1755c4261b781135083787b (patch)
treec8c12c67246f543c3cc4f64d1c07e003cb1d45ae /tek41.scm
parent87b82b5822ca54228cfa6df29be3ad9d4bc47d16 (diff)
downloadslib-8466d8cfa486fb30d1755c4261b781135083787b.tar.gz
slib-8466d8cfa486fb30d1755c4261b781135083787b.zip
Import Upstream version 3a1upstream/3a1
Diffstat (limited to 'tek41.scm')
-rw-r--r--tek41.scm147
1 files changed, 0 insertions, 147 deletions
diff --git a/tek41.scm b/tek41.scm
deleted file mode 100644
index 7d4c6b6..0000000
--- a/tek41.scm
+++ /dev/null
@@ -1,147 +0,0 @@
-;"tek41.scm", Tektronix 4100 series graphics support in Scheme.
-;Copyright (C) 1992, 1994 Aubrey Jaffer
-;
-;Permission to copy this software, to modify it, to redistribute it,
-;to distribute modified versions, and to use it for any purpose is
-;granted, subject to the following restrictions and understandings.
-;
-;1. Any copy made of this software must include this copyright notice
-;in full.
-;
-;2. I have made no warrantee or representation that the operation of
-;this software will be error-free, and I am under no obligation to
-;provide any services, by way of maintenance, update, or otherwise.
-;
-;3. In conjunction with products arising from the use of this
-;material, there shall be no use of my name in any advertising,
-;promotional, or sales literature without prior written consent in
-;each case.
-
-;THIS FILE NEEDS MORE WORK. Let me know if you test or fix it.
-
-;The graphics control codes are sent over the current-output-port and
-;can be mixed with regular text and ANSI or other terminal control
-;sequences.
-
-(define esc-string (string (integer->char #o33)))
-
-(define tek41:init
- (string-append
- esc-string "%!0"
- ;;1. set tek mode
- esc-string "MN0"
- ;;2. set character path to 0 (characters placed equal to rotation)
- esc-string "MCB7C;"
- ;;3. set character size to 59 height
- esc-string "MQ1"
- ;;4. set character precision to string
- esc-string "MT1"
- ;;5. set character text index to 1
- esc-string "MG1"
- ;;6. set character write mode to overstrike
- esc-string "RK!"
- ;;7. clear the view
- esc-string "SK!"
- ;;8. clear the segments
- esc-string "LZ"
- ;;9. clear the dialog buffer
- esc-string "%!1"
- ;;10. set ansi mode
- ))
-
-(define (tek41:init) (display tek41:init-str) (force-output))
-
-(define (tek41:reset)
- (string-append
- esc-string "%!0"
- ;;1. set tek mode
- esc-string "LZ"
- ;;2. clear the dialog buffer
- esc-string "%!1"
- ;;3. set ansi mode
- ))
-
-(define (tek41:reset) (display tek41:reset-str) (force-output))
-
-(define tek41:graphics-str
- (string-append
- esc-string "%!0"
- ;;1. set tek mode
- esc-string (string (integer->char #o14))
- ;;2. clear the screen
- esc-string "LV0"
- ;;3. set dialog area invisible
- ))
-
-(define (tek41:graphics) (display tek41:graphics-str) (force-output))
-
-(define tek41:text-str
- (string-append
- esc-string "LV1"
- ;;1. set dialog area visible
- esc-string "%!1"
- ;;2. set ansi mode
- ))
-
-(define (tek41:text) (display tek41:text-str) (force-output))
-
-(define tek41:move-str
- (string-append esc-string "LF"))
-
-(define (tek41:move x y)
- (display tek41:move-str)
- (tek41:encode-x-y x y)
- (force-output))
-
-(define tek41:draw-str
- (string-append esc-string "LG"))
-
-(define (tek41:draw x y)
- (display tek41:draw-str)
- (tek41:encode-x-y x y)
- (force-output))
-
-(define tek41:set-marker-str (string-append esc-string "MM"))
-(define tek41:draw-marker-str (string-append esc-string "LH"))
-
-(define (tek41:point x y number)
- (display tek41:set-marker-str)
- (tek41:encode-int (remainder (max number 0) 11))
- (display tek41:draw-marker-str)
- (tek41:encode-x-y x y)
- (force-output))
-
-(define (tek41:encode-x-y x y)
- (let ((hix (+ (quotient x 128) 32))
- (lox (+ (modulo (quotient x 4) 32) 64))
- (hiy (+ (quotient y 128) 32))
- (loy (+ (modulo (quotient y 4) 32) 96))
- (eb (+ (* (modulo y 4) 4) (modulo x 4) 96)))
- (if (positive? hiy) (write-char (integer->char hiy)))
- (if (positive? eb) (write-char (integer->char eb)))
- (if (positive? (+ loy eb hix)) (write-char (integer->char loy)))
- (if (positive? hix) (write-char (integer->char hix)))
- (write-char (integer->char lox))))
-
-(define (tek41:encode-int number)
- (let* ((mag (abs number))
- (hi1 (+ (quotient mag 1024) 64))
- (hi2 (+ (modulo (quotient mag 16) 64) 64))
- (lo (+ (modulo mag 16) 32)))
- (if (>= number 0) (set! lo (+ lo 16)))
- (if (not (= hi1 64)) (write-char (integer->char hi1)))
- (if (or (not (= hi2 64))
- (not (= hi1 64)))
- (write-char (integer->char hi2)))
- (write-char (integer->char lo))))
-
-(define (test)
- (tek41:init)
- (tek41:reset)
- (tek41:graphics)
- (do ((i 0 (+ 1 i)))
- ((> i 15))
- (tek41:linetype i)
- (tek41:move (+ (* 200 i) 1000) 1000)
- (tek41:draw (+ (* 200 i) 2000) 2000))
- (tek41:text))