From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:29 -0800
Subject: Import Upstream version 3a1

---
 tek41.scm | 147 --------------------------------------------------------------
 1 file changed, 147 deletions(-)
 delete mode 100644 tek41.scm

(limited to 'tek41.scm')

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))
-- 
cgit v1.2.3