Artifact c6e648ccc0c5b3f0752f4a8aee55453a01aed1efe0ad860ff7316ea6dcc8e481:

• File psl-1983/3-1/windows/9836-alpha.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4214) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/windows/9836-alpha.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4214) [annotate] [blame] [check-ins using]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 9836-Alpha.SL - Terminal Interface for 9836 Alpha Memory
% 
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        13 December 1982
% Revised:     27 January 1983
%
% Note: uses efficiency hacks that require 80-column width!
% Note: contains 68000 LAP code; must be compiled!
% Note: uses all 25 lines; assumes keyboard input buffer has been relocated
%
% 27-Jan-83 Alan Snyder
%  Revise to use all 25 lines of the screen.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(BothTimes (load objects))
(CompileTime (load display-char fast-int syslisp))
  
(defflavor 9836-alpha (
  (height 25)           % number of rows (0 indexed)
  (maxrow 24)           % highest numbered row
  (width 80)            % number of columns (0 indexed)
  (maxcol 79)           % highest numbered column
  (cursor-row 0)        % cursor position
  (cursor-column 0)     % cursor position
  (raw-mode NIL)
  (buffer-address (int2sys 16#512000)) % an absolute address
  )
  ()
  (gettable-instance-variables height width maxrow maxcol raw-mode)
  )

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(defmethod (9836-alpha get-character) ()
  (keyboard-input-character)
  )

(defmethod (9836-alpha ring-bell) ()
  (ChannelWriteChar 1 #\Bell)
  )

(defmethod (9836-alpha move-cursor) (row column)
  (setf cursor-row row)
  (setf cursor-column column)
  (screen-set-cursor-position row column)
  )

(defmethod (9836-alpha enter-raw-mode) ()
  (when (not raw-mode)
    % (EchoOff)
    % Enable Keypad?
    (setf raw-mode T)
    ))

(defmethod (9836-alpha leave-raw-mode) ()
  (when raw-mode
    (setf raw-mode NIL)
    % Disable Keypad?
    % (EchoOn)
    ))

(defmethod (9836-alpha erase) ()
  % This method should be invoked to initialize the screen to a known state.
  (setf cursor-column 0)
  (for (from row 0 maxrow)
       (do (setf cursor-row row)
	   (=> self clear-line)
	   ))
  (setf cursor-row 0)
  )

(defmethod (9836-alpha clear-line) ()
  (=> self write-line cursor-row #.(make-vector 80 32))
  )

(defmethod (9836-alpha convert-character) (ch)
  (setq ch (& ch (display-character-cons
		     (dc-make-enhancement-mask INVERSE-VIDEO
					       BLINK
					       UNDERLINE
					       INTENSIFY)
		     (dc-make-font-mask 0)
		     16#FF)))
  ch)

(defmethod (9836-alpha normal-enhancement) ()
  (dc-make-enhancement-mask)
  )

(defmethod (9836-alpha highlighted-enhancement) ()
  (dc-make-enhancement-mask INVERSE-VIDEO)
  )

(defmethod (9836-alpha supported-enhancements) ()
  (dc-make-enhancement-mask INVERSE-VIDEO BLINK UNDERLINE INTENSIFY)
  )

(defmethod (9836-alpha write-char) (row column ch)
  (screen80-write-char buffer-address row column ch)
  )

(defmethod (9836-alpha write-line) (row data)
  (screen80-write-line buffer-address row data)
  )

(defmethod (9836-alpha read-char) (row column)
  (let ((offset (+ column (* row width))))
    (halfword buffer-address offset)
    ))

% The following methods are provided for INTERNAL use only!

(defmethod (9836-alpha init) ()
  )

(lap '((*entry screen80-write-char expr 4) % buffer-address row column word
       (move!.l (reg 2) (reg t1))
       (moveq 80 (reg t2))
       (mulu (reg t1) (reg t2))
       (add!.l (reg 3) (reg t2))
       (lsl!.l 1 (reg t2))
       (move!.w (reg 4) (indexed (reg t2) (displacement (reg 1) 0)))
       (rts)
       ))

(lap '((*entry screen80-write-line expr 3) % buffer-address row data
       (move!.l (reg 2) (reg t1))       % move row address to T1
       (moveq 80 (reg t2))              % move 80 to T2
       (mulu (reg t1) (reg t2))         % multiply row address by 80
       (lsl!.l 1 (reg t2))              % convert to byte offset
       (adda!.l (reg t2) (reg 1))       % A1: address of line in buffer
       (move!.l (minus 80) (reg t1))
       (addq!.l 4 (reg 3))              % skip data header word
       (*lbl (label loop))
       (addq!.l 2 (reg 3))              % skip upper halfword in data 
       (move!.w (autoincrement (reg 3)) (autoincrement (reg 1)))
       (addq!.l 1 (reg t1))
       (bmi (label loop))
       (rts)
       ))