!Created by Version 11.07 From DBL FLORYANUTIL !
DEFINE PM ADDIT					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.ADDIT
DECLARE
    SUMVAL, n,12,pp=''
    INVAL,  n,12
DETAIL
    Start
        Type ">",nocr; Accept INVAL; Leave if Inval<=0
        Add INVAL to SUMVAL
    Repeat
    Type @CR,"Sum is ",SUMVAL
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM ANYALL				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.ANYALL    Tests the operations of ANY/ALL
!
DECLARE
    FS,c,2,occurs 5
    FI,i,2,occurs 5
    FR,r,2,occurs 5
    FN,n,2,occurs 5
    FD,d,occurs 5
    ND,d
    H,c,6
    Y,c,2

DETAIL

type "First testing the basic ANY/ALL on all 5 data types.  You should"
type "see 'ok S1 ... S4, I1 ..., R1 ..., N1 ..., D1 ...",@cr

type 'ok S1 ',nocr if any FS = ""; type 'ok S2 ',nocr if all FS = ""
'aa' to FS(3); type 'ok S3 ',nocr if any FS # ""
'12' to FS(1),FS(2),FS(3),FS(4),FS(5); type 'ok S4' if all FS # ""

type 'ok I1 ',nocr if any FI = 0; type 'ok I2 ',nocr if all FI = 0
3 to FI(3); type 'ok I3 ',nocr if any FI # 0
12 to FI(1),FI(2),FI(3),FI(4),FI(5); type 'ok I4' if all FI # 0

type 'ok R1 ',nocr if any FR = 0; type 'ok R2 ',nocr if all FR = 0
3 to FR(3); type 'ok R3 ',nocr if any FR # 0
12 to FR(1),FR(2),FR(3),FR(4),FR(5); type 'ok R4' if all FR # 0

type 'ok N1 ',nocr if any FN = 0.; type 'ok N2 ',nocr if all FN = 0.
3. to FN(3); type 'ok N3 ',nocr if any FN # 0.
12. to FN(1),FN(2),FN(3),FN(4),FN(5); type 'ok N4' if all FN # 0.

@nodate to nd
type 'ok D1 ',nocr if any FD = ND; type 'ok D2 ',nocr if all FD = ND
@date to FD(3); type 'ok D3 ',nocr if any FD # ND
@date to FD(1),FD(2),FD(3),FD(4),FD(5); type 'ok D4' if all FD # ND

type @CR,"Now testing the ANY/ALL BETWEEN operations.  You should see a"
type "series of 'OK? ok' if everything's working properly."
@CR+"OK? " to h; "ok" to y

0 to FI(1),FI(2),FI(4),FI(5)
3 to FI(3)
type H,nocr; type Y,nocr if any FI is between 1 and 4
type H,nocr; type Y,nocr unless any FI is between 4 and 8

1 to FI(1);2 to FI(2);3 to FI(3);4 to FI(4);5 to FI(5)
type H,nocr; type Y,nocr if all FI are between 1 and 5
type H,nocr; type Y,nocr unless all FI are between 1 and 4

type H,nocr; type Y,nocr if any FI is not between 1 and 4
type H,nocr; type Y,nocr unless all FI are not between 1 and 4
type
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM BARS					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
DECLARE
    GRA,c,1   ! select line graphics character set
    ALP,c,1   ! select alpha text character set
PROCESS
Routine SET_VT100
    if @system.type = "VAX/VMS" and @terminal.index # 96 and 98 ! VT100/VT102
	96 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    orif @system.type = "DEC-20"  and @terminal.index # 16
	16 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    continue
DETAIL
    perform SET_VT100
    transmit ascii from @esc+"[H"+@esc+"[J"+@esc+")0"+@esc+"(B"
    @chr 14 to GRA; @chr 15 to ALP
    transmit ascii from @esc+"[12H"+GRA+35"x" + @esc+"[13H"+35"x"
    transmit ascii from @esc+"[12H"+@esc+"#6"  !set line 12 to dbl wide
    transmit ascii from @esc+"[15H"+ALP
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM BIO					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.BIO
!
! BIOPLOT  -  Version T3.00  -  Designed for terminal/printer "plotting"
!
! Written by Thad Floryan, 4 May 1975 for IPL/DPL
! Updated and enhanced in 1980 and on 18-JULY-1981 for ACCENT
! Updated 18-FEB-83 to use newly-implemented transcendental functions in V7.30
!
!       . Tests IPL date arithmetic
!       . Tests handling of large processes
!
! NOTE: The output will be formatted differently for the terminal than for a
!       file; the assumption for a file is that the output will be listed on a
!       line printer which prints 60 lines per page.  See the usage of the
!       @REPORT() function in the INITIAL SECTION for the parameter settings.
!-----------------------------------------------------------------
!*****************
CONTROL SECTION !*
!*****************
    Relate SF from Command as REPORT 1
!*****************
DECLARE SECTION !*
!*****************
    ANSWER,     C ,20 !,SIXBIT      !General response from user. Defined
                                  !as SIXBIT so everything is uppercase.
    SAVE.DELIM, C , 1             !Saved @DELIM for names with commas
    NAME,       C ,72             !For whom plotting
    BIRTH.DATE, F                 !When born
    BEG.DATE,   F                 !Starting plot date
    CUR.DATE,   D                 !Current plot date
    END.DATE,   F                 !Ending plot date
    PERIOD,     I, 8              !Number of days to plot
    NARRATIVE,  I, 1              !0=No, 1=Yes to include narrative
    NDAYS,      I, 8              !CUR.DATE - BIRTH.DATE
    PHY,        N,10,5            !PHYSICAL cycle
    PHY.INC,    N,10,5            !    "    increment
    SEN,        N,10,5            !SENSITIVITY cycle
    SEN.INC,    N,10,5            !    "    increment
    COG,        N,10,5            !COGNITIVE/INTELLECTUAL cycle
    COG.INC,    N,10,5            !    "    increment
    PLOT,       I, 2,occurs 61
    PHY.POS,    I, 2
    SEN.POS,    I, 2
    COG.POS,    I, 2
    I,          I, 3
    CNT,        I, 3
    X,          N,10,5
!******************
INITIAL SECTION  !*
!******************
    If @VERSION.NUMBER < @REAL 7.30
        Type "? Need to use ACCENT version 7.30 or later"
        Exit process
    Continue
    Type "BIOPLOT produces a Biorhythm chart for any period of interest to"
    Type "you.  ", nocr
    Start; Type "Would you like instructions? ", nocr; Accept ANSWER
        If:5   ANSWER begins with "N"; Leave
        Orif:5 ANSWER begins with "Y"
            Type @CR,"The questions asked should be self-explanatory.  Most"
            Type "questions are answerable by YES or NO.  Dates may be"
            Type "entered using any of the forms:"
            Type @CR,5s,"MM-DD-YY  or  MM-DD-YYYY"
            Type 5s,"MM/DD/YY  or  MM/DD/YYYY"
            Type 5s,"YYMMDD    or  YYYYMMDD",@CR
            Type "Terminate all input with a carriage return.",@CR,@CR
            Leave
        Else:5 Type "Please answer YES or NO."
    Repeat
    !********************
    ! GET RUN INFORMATION
    !
    @DELIM to SAVE.DELIM; @CHR \o177 to @DELIM !This permits commas in names
    Start; Type "Please tell me your name (for plot annotation)? ",nocr
        Accept NAME; Leave if NAME # ""
        Type "Huh?"
    Repeat; SAVE.DELIM to @DELIM  !Restore the normal 'ACCEPT' delimiter

    Start; Type "What is your birthdate? ",nocr
        Accept BIRTH.DATE; Leave if BIRTH.DATE < @DATE
        Type "Whom are you fooling?"

    Start; Type "Would you like the plot to begin from today? ",nocr
        Accept ANSWER
        If:5   ANSWER begins with "Y"
            @DATE to BEG.DATE; Leave
        Orif:5 ANSWER begins with "N"
            Type "What is the starting date? ",nocr
            Accept BEG.DATE; Leave if BEG.DATE >= BIRTH.DATE
            Type "Cannot start before your birthdate!"
        Else:5 Type "Please answer YES or NO."

    Start; Type "Do you want the plot to finish on a specific date? ",nocr
        Accept ANSWER
        If:5   ANSWER begins with "Y"
            Type "What is the ending date? ",nocr
            Accept END.DATE; END.DATE - BEG.DATE to PERIOD
            Leave if END.DATE > BEG.DATE
            Type "Cannot end before starting!"
        Orif:5 ANSWER begins with "N"
            Type "How many days would you like plotted? ",nocr
            Accept PERIOD; (PERIOD - 1)Days + BEG.DATE to END.DATE
            Leave if PERIOD > 0
            Type "Cannot plot backwards!"
        Else:5 Type "Please answer YES or NO."

    Start; Type "Would you like a description on the plot? ",nocr
        Accept ANSWER
        If:5   ANSWER begins with "Y"
            1 to NARRATIVE; Leave
        Orif:5 ANSWER begins with "N"
            0 to NARRATIVE; Leave
        Else:5 Type "Please answer YES or NO."
    Repeat
    !*********************
    ! SETUP RUN PARAMETERS
    !
    BEG.DATE - BIRTH.DATE to NDAYS; BEG.DATE to CUR.DATE

    ! Compute remainders as a fraction of the value of the date
    ! in each cycle. Note:  360 degrees = circle = full cycle.
    ! Includes increment calculation to speed up the main loop.
    !
    ((NDAYS mod 23.)/23.)*360. to PHY;  360./23. to PHY.INC
    ((NDAYS mod 28.)/28.)*360. to SEN;  360./28. to SEN.INC
    ((NDAYS mod 33.)/33.)*360. to COG;  360./33. to COG.INC

    ! Setup reporting parameters based on whether we're outputting to
    ! the terminal or to a file.  If to a file, the assumption is made
    ! that it will be listed on a line printer with hardware top and
    ! bottom margins and a print region of 60 lines.
    !
    If @REPORT(1) = "TERM"
        "----" to @PAGE.DIVIDER; 65 to @LINES  !Divider uses up one line
        3 to @TOP.MARGIN, @BOTTOM.MARGIN
    Else "" to @PAGE.DIVIDER; 60 to @LINES
        0 to @TOP.MARGIN, @BOTTOM.MARGIN; Turn Fill Off
    Continue
!******************
HEADINGS SECTION !*
!******************
    Print 35"=-","="
    Print "Page ", @PAGE@"", nocr
    Center "BIORHYTHM Chart for "+@LTRIM @RTRIM NAME at 40
    Center @DATSTR BEG.DATE+" through "+@DATSTR END.DATE at 40
    Print 35"=-","="
    If NARRATIVE = 1
        0 to NARRATIVE
PRINT
PRINT"The Biorhythm Theory postulates three metabolic rhythms with a constant"
PRINT"cycle in the human body:"
PRINT
PRINT"      . a 23-day cycle correlated with physical vitality, endurance and"
PRINT"        energy"
PRINT
PRINT"      . a 28-day cycle of sensitivity, intuition and cheerfulness"
PRINT
PRINT"      . a 33-day cognitive or intellectual cycle that relates to mental"
PRINT"        alertness"
PRINT
PRINT"All three cycles start at birth.  The days on which the median line (0)"
PRINT"is crossed are  critical, especially for  the physical and  sensitivity"
PRINT"cycles, and are  when most  accidents are  likely to  occur.  The  high"
PRINT"periods (+) are the times when you should have the most energy, be most"
PRINT"cheerful, outgoing  and  mentally  alert.   The  low  periods  (-)  are"
PRINT"regarded as recuperative periods.", @CR
PRINT"In a  study of  700 random  accidents, nearly  60% were  found to  have"
PRINT"happened on  critical  days  even  though only  20%  of  the  days  are"
PRINT"critical.  Certain bus companies now schedule their drivers in relation"
PRINT"to their biorhythms and have noticed a marked reduction in accidents."
PRINT
PRINT
PRINT"                   _________________________________", @CR@"x",nocr
PRINT"                              L E G E N D"
PRINT"                   P = Physical    (23 days) [Red]"
PRINT"                   S = Sensitivity (28 days) [Blue]"
PRINT"                   C = Cognitive   (33 days) [Green]"
PRINT"                   * = conjunction of several cycles"
    Continue
    Print @CR, 8"_", @CR@"x", "  Date    ", 29"-", " 0 ", 29"+"
!****************
DETAIL SECTION !*
!****************
    !  Programming note regarding integer:character correspondence:
    !
    !        Char      Octal      Decimal
    !        ----      -----      -------
    !        space       40         32
    !          *         52         42
    !          C        103         67
    !          P        120         80
    !          S        123         83
    !          |        174        124
    !
    Start
        32 to PLOT(I) for I=1 to 61         !Fill line with spaces
        124 to PLOT(31)                     !Insert centerline
        @SIN(PHY)*30. + 31. to PHY.POS
        @SIN(SEN)*30. + 31. to SEN.POS
        @SIN(COG)*30. + 31. to COG.POS
        80 to PLOT(PHY.POS)                 !Insert "P" in plot
        If:5   PLOT(SEN.POS) = 80           !Check if "P" at "S" position
               42 to PLOT(SEN.POS)          !Yes, insert a "*"
        Else:5 83 to PLOT(SEN.POS)          !No, insert the "S"
        If:5   PLOT(COG.POS) = 80, 83 or 42 !Check for "P","S" or "*"
               42 to PLOT(COG.POS)          !Yes, insert a "*" at "C" position
        Else:5 67 to PLOT(COG.POS)          !No, insert the "C"
        Continue:5
        Print CUR.DATE, 2s, nocr; CUR.DATE + 1 Days to CUR.DATE
        Start:5 for CNT = 61 to 31 by -1; Leave:5 if PLOT(CNT)#32; Repeat:5
        Print @CHR PLOT(I),nocr for I=1 to CNT; Print
        Leave if CUR.DATE > END.DATE
        Incr PHY by PHY.INC
        Incr SEN by SEN.INC
        Incr COG by COG.INC
    Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM BIRTHDAY				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.BIRTHDAY  Demonstrates some date arithmetic
!

  Type "What is your birthdate? ",nocr
  Accept @STRING; @DVAL @STRING to @VDATE

  Type @CR,@DATSTR(@VDATE,"MMMMMMMMM\ DD, YYYY"),nocr
  Type " was a ",@DATSTR(@VDATE,"WWWWWWWWW\"),".",@CR
  Type "You are presently ",@IFIX((@DATE-@VDATE)/365.24)@""," years young."

  @DVAL(@DATSTR(@VDATE,"MM-DD-")+@STR @YEAR) to @VDATE
  Type @CR,"There have been ",nocr


  IF @DATE > @VDATE
    Type @DATE-@VDATE@""," days since your last birthday, and there are"
    Type @VDATE+1 years-@DATE@""," days 'til your next birthday on ",nocr
    Type @DATSTR(@VDATE+1 years,"WWWWWWWWW\, MMMMMMMMM\ DD, YYYY"),"."

  ELSE
    Type @DATE-(@VDATE-1 years)@""," days since your last birthday, and there are"
    Type @VDATE-@DATE@""," days 'til your next birthday on ",nocr
    Type @DATSTR(@VDATE,"WWWWWWWWW\, MMMMMMMMM\ DD, "),@YEAR,"."

  CONTINUE
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM BLOCKS				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.BLOCKS   Displays artistic blocks randomly on VT100/DT80/Excel 14 screen
!
DECLARE
    X,         I,max     !Column for direct cursor address
    Y,         I,max     !Line for direct cursor address
    RENDITION, I,max
    I,         I,max
    BRIGHT,    C, 4     !INTENSIFIED VIDEO
    REVERSE,   C, 4     !REVERSE VIDEO
    NORMAL,    C, 3     !NORMAL VIDEO
PROCESS

ROUTINE SET.ANSI
    if @system.type = "VAX/VMS" and @terminal.index # 96
	96 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    orif @system.type = "DEC-20"  and @terminal.index # 16
	16 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    continue

ROUTINE HOME.CLEAR
    Transmit ascii from @esc+"[H"+@esc+"[J"

ROUTINE SET.CHAR.SETS
    Transmit ascii from @esc+"(B"+@esc+")0"

INITIAL

  @esc+"[1m" to BRIGHT
  @esc+"[m"  to NORMAL
  @esc+"[7m" to REVERSE
  0          to @RANDOMIZE

  Perform SET.ANSI, HOME.CLEAR, SET.CHAR.SETS

DETAIL
  Transmit ascii from @esc+"["+@str I+"H"+@esc+"#6" for I=7 to 17
  Start for I=1 to 600
    Transmit ascii from NORMAL
    10*@RANDOM+7 to Y
    30*@RANDOM+5 to X
    @RANDOM      to RENDITION

    If:5 RENDITION=0; Transmit ascii from BRIGHT
    Else:5            Transmit ascii from REVERSE
    Continue:5
    Transmit ascii from@esc+"["+@STR Y+";"+@STR X+"H "
  Repeat
  Transmit ascii from NORMAL

FINAL
  Transmit ascii from @esc+"[23H"  ! Home down
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM CKRESP				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
declare
    cin,bb,8,occurs 60
    i,i,max
    num,i,max

process section
routine get.resp
    receive byte to cin count to num wait 1
	
routine disp.resp
    start for i=1 to num
	if:5 cin(i) is between 1 and 31 or cin(i) > 126
	    type " <", nocr
	    type @substr("0123456789ABCDEF", (cin(i)  /  16) + 1, 1), nocr
	    type @substr("0123456789ABCDEF", (cin(i) mod 16) + 1, 1), nocr
	    type ">",nocr
	orif:5 cin(i) is between 32 and 126
	    type 1s, @chr cin(i),nocr
	continue:5
    repeat
    type

detail
    transmit ascii from @esc+"Z"; perform get.resp
    type "Resp to:  $ Z        is  ",nocr; perform disp.resp
    transmit ascii from @esc+"[x"; perform get.resp
    type "Resp to:  $ [  x     is  ",nocr; perform disp.resp

    transmit ascii from @esc+"[c"; perform get.resp
    type "Resp to:  $ [  c     is  ",nocr; perform disp.resp

    transmit ascii from @esc+"[>c"; perform get.resp
    type "Resp to:  $ [ > c    is  ",nocr; perform disp.resp
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM COSMOS				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.COSMOS	Displays randomly one of two different styles of star fields
!		on an assumed VT100-compatible display.
!
DECLARE
    X,       I, max             !Column for direct cursor address
    Y,       I, max             !Line for direct cursor address
    S,       I, max             !Index into STARS
    STARS,   I,  3,occurs 21
    STARMAP, BB, 1,occurs 80*24
    I,       I, max
PROCESS
  ROUTINE SET.ANSI  ! char sets
    TRANSMIT ASCII FROM @ESC+"(B"+@ESC+")0"
  ROUTINE HOME.CLEAR
    TRANSMIT ASCII FROM @ESC+"[H"+@ESC+"[J"
  ROUTINE MOVE.CURSOR
    TRANSMIT ASCII FROM @ESC+"["+@STR Y+";"+@STR X+"H"
  ROUTINE BRIGHTEN
    TRANSMIT ASCII FROM @ESC+"[1m"
  ROUTINE NORMALIZE
    TRANSMIT ASCII FROM @ESC+"[m"
  ROUTINE SET.GRAPHICS  ! ^N (shift-out) for graphics char set
    TRANSMIT ASCII FROM @CHR(@ASC"N"-64)
  ROUTINE SET.NORMAL    ! ^O (shift-in) for normal char set
    TRANSMIT ASCII FROM @CHR(@ASC"O"-64)
  ROUTINE HOME.DOWN
    TRANSMIT ASCII FROM @ESC+"[23H"
  ROUTINE SET.STARS
    0 TO @RANDOMIZE
    0 TO STARMAP(X,Y) FOR X=1 TO 80, Y=1 TO 24
    @ASC "~" TO STARS(I) FOR I= 1 TO 11 BY 2
    @ASC "~" TO STARS(I) FOR I=13 TO 21 BY 2
    @ASC "." TO STARS(I) FOR I= 2 TO 18 BY 4
    IF @INT @RANDOM = 0
      @ASC "f" TO STARS(4),STARS(16)
      @ASC "*" TO STARS(8)
      @ASC "+" TO STARS(12)
      @ASC ":" TO STARS(20)
    ELSE
      @ASC "~" TO STARS(4),STARS(12),STARS(16)
      @ASC "." TO STARS(8),STARS(20)
  ROUTINE DISPLAY.STARS
    IF STARMAP(X,Y)=0
      1 TO STARMAP(X,Y)
      PERFORM BRIGHTEN IF I MOD 7 = 0
      PERFORM MOVE.CURSOR; TRANSMIT ASCII FROM @CHR STARS(S)
      PERFORM NORMALIZE IF I MOD 7 = 0
DETAIL
    PERFORM SET.ANSI, HOME.CLEAR, SET.GRAPHICS, SET.STARS
    START FOR I=1 TO 350
        79*@RANDOM + 1 TO X   ! 1 TO 80
        23*@RANDOM + 1 TO Y   ! 1 to 24
        20*@RANDOM + 1 TO S   ! 1 TO 21
        PERFORM DISPLAY.STARS
    REPEAT
    PERFORM SET.NORMAL, HOME.DOWN
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM CRT2					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.CRT2
!
! [DEC-20]  Interrogates the terminal type and displays a simple chart
!
DECLARE SECTION

ICBUF, I, 3,OCCURS 10 ! Input "word" buffer for terminal IDs
VRESP, C,40           ! Input "char" buffer for VT100 parameters
CCNT,  I, 3           ! Size of response from terminal
TERTYP,I, 2           ! 0=?;1==VT52;2=VT52;3=VT100(VT52);4=VT100,5=VT132
ROW,   I, 3           ! Line number for cursor movement
COL,   I, 3           ! Column number for cursor movement
Q,     C,80
I,     I, 3           ! Loop variable

PROCESS SECTION

ROUTINE ID.TERMINAL
!==================
!
! Sets TERTYP to:
!   0  if terminal is neither a VT52 nor a VT100
!   1  if terminal is reported by TOPS-20 as being a VT52 but
!      the terminal cannot identify itself (thus, a pseudo-VT52)
!   2  if terminal is a real VT52 (properly ID'd after interrogation)
!   3  if terminal is a VT100 in the VT52 mode (per interrogation)
!   4  if terminal is a VT100 in the ANSI mode (per TOPS-20).
!   5  if terminal is a VT132 in the ANSI mode (VT100 per TOPS-20).

0 to TERTYP
Exit routine if @TTY.SOURCE # "ONLINE"
If @TERMINAL.INDEX = 15           !TOPS-20 thinks we have a VT52
   Transmit ASCII from @ESC + "Z" !Ask terminal to ID itself
   Receive ASCII to ICBUF wait .25 seconds count to CCNT
   If:3 CCNT = 3                  !VT5x respond with 3 chars
      If:5 ICBUF(1) = @ASC @ESC and ICBUF(2) = @ASC "/"
         If:7   ICBUF(3) = @ASC "L" or @ASC "K"
                2 to TERTYP       !Real VT52
         Orif:7 ICBUF(3) = @ASC "Z"
                3 to TERTYP       !VT100 in VT52 mode
         Else:7 1 to TERTYP       !Some other VT52 variety
      Else:5    1 to TERTYP       !Maybe reception was garbled
      Continue:5
   Else:3       0 to TERTYP       !Not even similar to a VT52

Orif @TERMINAL.INDEX = 16         !16=Index for a VT100
!********
4 to tertyp ! assume it IS a VT100
exit routine
!********

   Transmit ASCII from @ESC + "[c"!Ask terminal to ID itself
   Receive ASCII to ICBUF wait .5 seconds count to CCNT
   If:3 CCNT = 7               !VT100 responds with 7 characters
      If:6   ICBUF(4) = @ASC"1"
               4 to TERTYP     !VT100 in ANSI mode
      Orif:6 ICBUF(4) = @ASC"4"
               5 to TERTYP     !VT132 in ANSI mode
      Else:6   4 to TERTYP     !Assume a "standard" VT100
   Else:3      0 to TERTYP     !Cannot be a real VT100 (or else is
                               !a shoddy emulation package)
Else 0 to TERTYP               !Anything else

!==========
ROUTINE CXY ! MOVE CURSOR to X,Y
!==========
!
! To move the cursor to a position, put the line and column numbers
! into ROW and COL respectively and PERFORM CXY

If TERTYP = 1, 2 or 3   !VT52 and a VT100 in VT52 mode
     Transmit ASCII from @ESC + "Y" + @CHR(31+ROW) + @CHR(31+COL)
Orif TERTYP = 4 or 5    !VT100 and VT132 in ANSI mode
     Transmit ASCII from @ESC + "[" + @STR ROW + ";" + @STR COL + "H"
Else Transmit ASCII from @CR

!============
ROUTINE CHOME
!============
!
! Homes cursor to upper left corner of the screen for VT52 and VT100

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "H"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[H"
Else                     Transmit ASCII from @CR

!===========
ROUTINE EEOS
!===========
!
! Erases from cursor position to end of screen (bottom right corner)

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "J"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[J"

!===========
ROUTINE EEOL
!===========
!
! Erases from cursor position to end of line

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "K"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[K"

!==========
ROUTINE CUP
!==========
!
! Moves cursor up one position

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "A"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[A"

!============
ROUTINE CDOWN
!============
!
! Moves cursor down one position.  Uses a line feed for efficiency

If   TERTYP is between 1 and 5; Transmit ASCII from @LF
Else                            Transmit ASCII from @CR

!============
ROUTINE CLEFT
!============
!
! Moves cursor left one position.  Uses a backspace for efficiency

Transmit ASCII from @BS

!=============
ROUTINE CRIGHT
!=============
!
! Moves cursor right one position.

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "C"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[C"
Else                     Transmit ASCII from " "

!========
ROUTINE Q
!========
!
! Removes tedium of typing "Transmit ascii from".  Put string in Q

Transmit ascii from @rtrim Q

!*********************************************************************
                            DETAIL SECTION
!*********************************************************************

Perform ID.TERMINAL, CHOME, EEOS
 2 to ROW; 15 to COL; "PROJECT TASK TRACKING Main Menu" to Q; Perform CXY, Q

 4 to ROW; 20 to COL; "1 - RAW REPORT"    to Q; Perform CXY, Q
 6 to ROW;            "2 - Enter update"  to Q; Perform CXY, Q
 8 to ROW;            "3 - Menu option 3" to Q; Perform CXY, Q
10 to ROW;            "4 - Menu option 4" to Q; Perform CXY, Q
12 to ROW;            "5 - Menu option 5" to Q; Perform CXY, Q
14 to ROW;            "Q - Quit"          to Q; Perform CXY, Q
16 to ROW;            "? - Help"          to Q; Perform CXY, Q
18 to ROW; 13 to COL; "Which? "+@rub      to Q; Perform CXY, Q
start
20 to COL; Perform CXY, EEOL
accept Q; perform eeos; type
@ltrim Q to Q; @index(Q,"!") to i
@left(Q,i-1) to Q if i#0
if:5   Q integral and @ival Q between 1 and 5
       type "You selected item ",@ival Q
orif:5 Q begins with "Q"; leave
orif:5 Q begins with "?"
       type "No help yet available"
else:5 type "You dummy, incorrect selection!"
Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM CRT2 has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM CRTAPPLNOTE				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.CRTAPPLNOTE
!
!*********************************************************************
!* "ACCENT R" Application Note        -Thad Floryan
!*
!* Examples using Transmit and Receive.  The assumption is made that
!* this is executed on a standard TOPS-20 Version 4 system in order
!* that the automatic terminal identification can be performed; the
!* techniques shown herein are also applicable to a TOPS-10 system.
!*
!* Illustrated are:
!*   -  routines for identifying the terminal among VT52s, VT100s, VT132s
!*      and properly-designed emulations thereof
!*   -  routines for basic cursor movement, both direct and relative
!*   -  routines for line and screen erasing
!*
!* The "TOPS-10", "TOPS-20", "VT52", "VT100" and "VT132" appearing in
!* this document are trademarks of Digital Equipment Corporation.
!*
!*********************************************************************
                           DECLARE SECTION
!*********************************************************************

ICBUF, I, 3,OCCURS 10 ! Input "word" buffer for terminal IDs
VRESP, C,40           ! Input "char" buffer for VT100 parameters
CCNT,  I, 3           ! Size of response from terminal
TERTYP,I, 2           ! 0=?;1==VT52;2=VT52;3=VT100(VT52);4=VT100,5=VT132
ROW,   I, 3           ! Line number for cursor movement
COL,   I, 3           ! Column number for cursor movement
PVAL,  I, 3           ! Parameter value
I,     I, 3           ! Loop variable

!*********************************************************************
                           PROCESS SECTION
!*********************************************************************

!==================
ROUTINE ID.TERMINAL
!==================
!
! This routine will set TERTYP to:
!   0  if terminal is neither a VT52 nor a VT100
!   1  if terminal is reported by TOPS-20 as being a VT52 but
!      the terminal cannot identify itself (thus, a pseudo-VT52)
!   2  if terminal is a real VT52 (properly ID'd after interrogation)
!   3  if terminal is a VT100 in the VT52 mode (per interrogation)
!   4  if terminal is a VT100 in the ANSI mode (per TOPS-20).  The
!      options present in the terminal will be stored in ICBUF per the
!      interrogation request.  See table (below).
!   5  if terminal is a VT132 in the ANSI mode (VT100 per TOPS-20).  The
!      options present in the terminal will be stored in ICBUF per the
!      interrogation request.  See table (below).
!
! Note that this routine assumes both that the TERMINAL TYPE will have
! been set as appropriate to the TOPS-20 EXEC and that the terminal is
! in a mode consistent with the TERMINAL TYPE setting.

If @TERMINAL.INDEX = 15           !TOPS-20 thinks we have a VT52
   Transmit ASCII from @ESC + "Z" !Ask terminal to ID itself
   Receive ASCII to ICBUF wait .25 seconds count to CCNT
   If:3 CCNT = 3                  !VT5x respond with 3 chars
      If:5 ICBUF(1) = @ASC @ESC and ICBUF(2) = @ASC "/"
         If:7   ICBUF(3) = @ASC "L" or @ASC "K"
                2 to TERTYP       !Real VT52
         Orif:7 ICBUF(3) = @ASC "Z"
                3 to TERTYP       !VT100 in VT52 mode
         Else:7 1 to TERTYP       !Some other VT52 variety
      Else:5    1 to TERTYP       !Maybe reception was garbled
      Continue:5
   Else:3       0 to TERTYP       !Not even similar to a VT52

Orif @TERMINAL.INDEX = 16         !16=Index for a VT100
   Transmit ASCII from @ESC + "[c"!Ask terminal to ID itself
   Receive ASCII to ICBUF wait .5 seconds count to CCNT
   !
   ! Stored response will be (in each occurrence of ICBUF):
   !
   !    (1)   (2)   (3)   (4)   (5)   (6)   (7)    representing
   !    ---   ---   ---   ---   ---   ---   ---    ------------
   !    ESC   "["   "?"    n    ";"   "0"   "c"    no options
   !    ESC   "["   "?"    n    ";"   "1"   "c"    STP
   !    ESC   "["   "?"    n    ";"   "2"   "c"    AVO
   !    ESC   "["   "?"    n    ";"   "3"   "c"    AVO,STP
   !    ESC   "["   "?"    n    ";"   "4"   "c"    GO
   !    ESC   "["   "?"    n    ";"   "5"   "c"    GO,STP
   !    ESC   "["   "?"    n    ";"   "6"   "c"    GO,AVO
   !    ESC   "["   "?"    n    ";"   "7"   "c"    GO,STP,AVO
   !
   !       where: n   = "1" if VT100, "4" if VT132
   !              STP = Processor option
   !              AVO = Advanced Video Option
   !              GO  = Graphics Option
   !
   If:3 CCNT = 7               !VT100 responds with 7 characters
      If:6   ICBUF(4) = @ASC"1"
               4 to TERTYP     !VT100 in ANSI mode
      Orif:6 ICBUF(4) = @ASC"4"
               5 to TERTYP     !VT132 in ANSI mode
      Else:6   4 to TERTYP     !Assume a "standard" VT100
   Else:3      0 to TERTYP     !Cannot be a real VT100 (or else is
                               !a shoddy emulation package)

Else 0 to TERTYP               !Anything else

!==================
ROUTINE MOVE.CURSOR
!==================
!
! This uses the values from ROW and COL and moves the cursor to
! that position.  This sample routine is only for a VT52 and a VT100.
! The screen addressing convention used by this routine is (y,x) also
! stated (row,column) and looks like (assuming a 24 by 80 display):
!
!     (1,1)                                    (1,80)
!       +----------------------------------------+
!       |                                        |
!       |                                        |
!       |                                        |
!       |                                        |
!       |                                        |
!       |                                        |
!       |                                        |
!       |                                        |
!       +----------------------------------------+
!    (24,1)                                   (24,80)
!
! To move the cursor to a position, put the line and column numbers
! into ROW and COL respectively and PERFORM MOVE.CURSOR

If TERTYP = 1, 2 or 3   !VT52 and a VT100 in VT52 mode
   Transmit ASCII from @ESC + "Y" + @CHR(31+ROW) + @CHR(31+COL)
Orif TERTYP = 4 or 5    !VT100 and VT132 in ANSI mode
   Transmit ASCII from @ESC + "[" + @STR ROW + ";" + @STR COL + "H"

!==================
ROUTINE HOME.CURSOR
!==================
!
! Homes cursor to upper left corner of the screen for VT52 and VT100

If TERTYP = 1, 2 or 3
   Transmit ASCII from @ESC + "H"
Orif TERTYP = 4 or 5
   Transmit ASCII from @ESC + "[H"

!================
ROUTINE ERASE.EOS
!================
!
! Erases from cursor position to end of screen (bottom right corner)

If TERTYP = 1, 2 or 3
   Transmit ASCII from @ESC + "J"
Orif TERTYP = 4 or 5
   Transmit ASCII from @ESC + "[J"

!================
ROUTINE ERASE.EOL
!================
!
! Erases from cursor position to end of line

If TERTYP = 1, 2 or 3
   Transmit ASCII from @ESC + "K"
Orif TERTYP = 4 or 5
   Transmit ASCII from @ESC + "[K"

!================
ROUTINE CURSOR.UP
!================
!
! Moves cursor up one position

If TERTYP = 1, 2 or 3
   Transmit ASCII from @ESC + "A"
Orif TERTYP = 4 or 5
   Transmit ASCII from @ESC + "[A"

!==================
ROUTINE CURSOR.DOWN
!==================
!
! Moves cursor down one position.  Uses a line feed for efficiency

Transmit ASCII from @LF

!==================
ROUTINE CURSOR.LEFT
!==================
!
! Moves cursor left one position.  Uses a backspace for efficiency

Transmit ASCII from @BS

!===================
ROUTINE CURSOR.RIGHT
!===================
!
! Moves cursor right one position.

If TERTYP = 1, 2 or 3
   Transmit ASCII from @ESC + "C"
Orif TERTYP = 4 or 5
   Transmit ASCII from @ESC + "[C"

!======================================
ROUTINE DISPLAY.VT100.OPTIONS.INSTALLED
!======================================
!
Type "The options present on your terminal are:"
If   CCNT = 7    ! Verify the terminal sent 7 characters
     Type 4S,"STP (Processor option)"      if ICBUF(6) band 1 # 0
     Type 4S,"AVO (Advanced Video Option)" if ICBUF(6) band 2 # 0
     Type 4S,"GO  (Graphics Option)"       if ICBUF(6) band 4 # 0
     Type 4S,"(none)"                      if ICBUF(6) band 7 = 0
Else Type 4S,"(none)"

!==========================================
ROUTINE INTERPRET.VT100.TERMINAL.PARAMETERS
!==========================================
!
! Interprets and displays the response of a VT100 to REQTPARM as
! received in the VRESP buffer from a VT100 in either ANSI or VT52.

Receive ASCII to VRESP wait 1 second count to CCNT
Exit routine if CCNT < 15  ! Response was not long enough

Type @CR,"Your terminal's reported parameters are:  <ESC>",nocr
Type @SUBSTR(VRESP,2,CCNT-1)
Type "of form: $ [ sol; par; nbits; xspeed; rspeed; clkmul; flags x"
Type "which are interpreted:"

@SUBSTR(VRESP,3,CCNT-3) to VRESP; @INDEX(VRESP,";") to CCNT
@IVAL @LEFT(VRESP,CCNT-1) to PVAL; Type "    <sol>    = ",nocr
If   PVAL = 0; Type "a request, unsolicited reports possible"
Orif PVAL = 1; Type "a request, reports only upon request"
Orif PVAL = 2; Type "a report"
Orif PVAL = 3; Type "a report, reports only upon request"
Else           Type "? (undocumented)"
Continue

@SUBSTR(VRESP,CCNT+1) to VRESP; @INDEX(VRESP,";") to CCNT
@IVAL @LEFT(VRESP,CCNT-1) to PVAL; Type "    <par>    = ",nocr
If   PVAL = 1; Type "no parity set"
Orif PVAL = 2; Type "parity is set, and SPACE"
Orif PVAL = 3; Type "parity is set, and MARK"
Orif PVAL = 4; Type "parity is set, and ODD"
Orif PVAL = 5; Type "parity is set, and EVEN"
Else           Type "? (undocumented)"
Continue

@SUBSTR(VRESP,CCNT+1) to VRESP; @INDEX(VRESP,";") to CCNT
@IVAL @LEFT(VRESP,CCNT-1) to PVAL; Type "    <nbits>  = ",nocr
If   PVAL = 1; Type "8 bits per character"
Orif PVAL = 2; Type "7 bits per character"
Else           Type "? (undocumented)"
Continue

@SUBSTR(VRESP,CCNT+1) to VRESP; @INDEX(VRESP,";") to CCNT
@IVAL @LEFT(VRESP,CCNT-1) to PVAL; Type "    <xspeed> = ",nocr
Perform DISPLAY.VT100.BAUD.RATE

@SUBSTR(VRESP,CCNT+1) to VRESP; @INDEX(VRESP,";") to CCNT
@IVAL @LEFT(VRESP,CCNT-1) to PVAL; Type "    <rspeed> = ",nocr
Perform DISPLAY.VT100.BAUD.RATE

@SUBSTR(VRESP,CCNT+1) to VRESP; @INDEX(VRESP,";") to CCNT
@IVAL @LEFT(VRESP,CCNT-1) to PVAL; Type "    <clkmul> = ",nocr
If   PVAL = 1; Type "16x bit rate"
Else           Type "? (undocumented)"
Continue

@IVAL @SUBSTR(VRESP,CCNT+1) to PVAL; Type "    <flags>  = ",nocr
If PVAL band 8 = 0; Type "0",nocr; Else Type "1",nocr
If PVAL band 4 = 0; Type "0",nocr; Else Type "1",nocr
If PVAL band 2 = 0; Type "0",nocr; Else Type "1",nocr
If PVAL band 1 = 0; Type "0",nocr; Else Type "1",nocr
Continue Type " (SETUP B, block 5 bit settings)"

!==============================
ROUTINE DISPLAY.VT100.BAUD.RATE
!==============================
!
! Converts the encoded transmit or receive baud rate value in PVAL to
! a human-understandable value

If   PVAL =   0; Type "50",nocr
Orif PVAL =   8; Type "75",nocr
Orif PVAL =  16; Type "110",nocr
Orif PVAL =  24; Type "134.5",nocr
Orif PVAL =  32; Type "150",nocr
Orif PVAL =  40; Type "200",nocr
Orif PVAL =  48; Type "300",nocr
Orif PVAL =  56; Type "600",nocr
Orif PVAL =  64; Type "1,200",nocr
Orif PVAL =  72; Type "1,800",nocr
Orif PVAL =  80; Type "2,000",nocr
Orif PVAL =  88; Type "2,400",nocr
Orif PVAL =  96; Type "3,600",nocr
Orif PVAL = 104; Type "4,800",nocr
Orif PVAL = 112; Type "9,600",nocr
Orif PVAL = 120; Type "19,200",nocr
Continue Type " baud"

!*********************************************************************
                            DETAIL SECTION
!*********************************************************************

Perform ID.TERMINAL
If TERTYP = 1
   Type "Your terminal is masquerading as a VT52."
Orif TERTYP = 2
   Type "Your terminal is a VT52."
Orif TERTYP = 3
   Type "Your terminal is a VT100 in the VT52 mode."
   Transmit ASCII from @ESC + "<" + @ESC + "[c" + @ESC + "[?2l"
   Receive ASCII to ICBUF wait .5 seconds count to CCNT
   Perform DISPLAY.VT100.OPTIONS.INSTALLED
   Transmit ASCII from @ESC + "<" + @ESC + "[x" + @ESC + "[?2l"
   Perform INTERPRET.VT100.TERMINAL.PARAMETERS
Orif TERTYP = 4
   Type "Your terminal is a VT100 in the ANSI mode."
   Perform DISPLAY.VT100.OPTIONS.INSTALLED
   Transmit ASCII from @ESC + "[x"
   Perform INTERPRET.VT100.TERMINAL.PARAMETERS
Orif TERTYP = 5
   Type "Your terminal is a VT132 in the ANSI mode."
   Perform DISPLAY.VT100.OPTIONS.INSTALLED
   Transmit ASCII from @ESC + "[x"
   Perform INTERPRET.VT100.TERMINAL.PARAMETERS
Else Type "Your terminal is unknown to me and I cannot continue."
   Exit Section
Continue

! Allow user to read what was just displayed.
!
Type @CR,@CR,"Press RETURN to continue ...", nocr; Accept @STRING

!---------------------------------------------
! The real example starts now.  This works for a VT52 and a VT100.
!
Perform HOME.CURSOR, ERASE.EOS

Type "Notice that the screen was cleared. Now for some quick cursor"
Type "movements and drawing a simple box ..."

! First indicate the corners at (5,10), (5,70), (15,10) and (15,70)
!
 5 to ROW; 10 to COL; Perform MOVE.CURSOR; Type "+",nocr
           70 to COL; Perform MOVE.CURSOR; Type "+",nocr
15 to ROW;            Perform MOVE.CURSOR; Type "+",nocr
           10 to COL; Perform MOVE.CURSOR; Type "+",nocr

 5 to ROW; Incr  COL; Perform MOVE.CURSOR; Type 59"-",nocr

Incr  ROW; Decr  COL; Perform MOVE.CURSOR
   Start:10 for I = 1 to 9
     Type "|",nocr; Perform CURSOR.LEFT, CURSOR.DOWN
   Repeat:10

15 to ROW; Incr  COL; Perform MOVE.CURSOR; Type 59"-",nocr

Decr  ROW; 70 to COL; Perform MOVE.CURSOR
   Start:10 for I = 1 to 9
     Type "|",nocr; Perform CURSOR.LEFT, CURSOR.UP
   Repeat:10

23 to ROW;  1 to COL; Perform MOVE.CURSOR ! Home "down"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM CRTCRT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
DECLARE SECTION

ICBUF, I, 3,OCCURS 10 ! Input "word" buffer for terminal IDs
VRESP, C,40           ! Input "char" buffer for VT100 parameters
CCNT,  I, 3           ! Size of response from terminal
TERTYP,I, 2           ! 0=?;1==VT52;2=VT52;3=VT100(VT52);4=VT100,5=VT132
ROW,   I, 3           ! Line number for cursor movement
COL,   I, 3           ! Column number for cursor movement
Q,     C,80
I,     I, 3           ! Loop variable

PROCESS SECTION

ROUTINE ID.TERMINAL
!==================
!
! Sets TERTYP to:
!   0  if terminal is neither a VT52 nor a VT100
!   1  if terminal is reported by TOPS-20 as being a VT52 but
!      the terminal cannot identify itself (thus, a pseudo-VT52)
!   2  if terminal is a real VT52 (properly ID'd after interrogation)
!   3  if terminal is a VT100 in the VT52 mode (per interrogation)
!   4  if terminal is a VT100 in the ANSI mode (per TOPS-20).
!   5  if terminal is a VT132 in the ANSI mode (VT100 per TOPS-20).

0 to TERTYP
Exit routine if @TTY.SOURCE # "ONLINE"
If @TERMINAL.INDEX = 15           !TOPS-20 thinks we have a VT52
   Transmit ASCII from @ESC + "Z" !Ask terminal to ID itself
   Receive ASCII to ICBUF wait .25 seconds count to CCNT
   If:3 CCNT = 3                  !VT5x respond with 3 chars
      If:5 ICBUF(1) = @ASC @ESC and ICBUF(2) = @ASC "/"
         If:7   ICBUF(3) = @ASC "L" or @ASC "K"
                2 to TERTYP       !Real VT52
         Orif:7 ICBUF(3) = @ASC "Z"
                3 to TERTYP       !VT100 in VT52 mode
         Else:7 1 to TERTYP       !Some other VT52 variety
      Else:5    1 to TERTYP       !Maybe reception was garbled
      Continue:5
   Else:3       0 to TERTYP       !Not even similar to a VT52

Orif @TERMINAL.INDEX = 16         !16=Index for a VT100
!********
4 to tertyp ! assume it IS a VT100
exit routine
!********

   Transmit ASCII from @ESC + "[c"!Ask terminal to ID itself
   Receive ASCII to ICBUF wait .5 seconds count to CCNT
   If:3 CCNT = 7               !VT100 responds with 7 characters
      If:6   ICBUF(4) = @ASC"1"
               4 to TERTYP     !VT100 in ANSI mode
      Orif:6 ICBUF(4) = @ASC"4"
               5 to TERTYP     !VT132 in ANSI mode
      Else:6   4 to TERTYP     !Assume a "standard" VT100
   Else:3      0 to TERTYP     !Cannot be a real VT100 (or else is
                               !a shoddy emulation package)
Else 0 to TERTYP               !Anything else

!==========
ROUTINE CXY ! MOVE CURSOR to X,Y
!==========
!
! To move the cursor to a position, put the line and column numbers
! into ROW and COL respectively and PERFORM CXY

If TERTYP = 1, 2 or 3   !VT52 and a VT100 in VT52 mode
     Transmit ASCII from @ESC + "Y" + @CHR(31+ROW) + @CHR(31+COL)
Orif TERTYP = 4 or 5    !VT100 and VT132 in ANSI mode
     Transmit ASCII from @ESC + "[" + @STR ROW + ";" + @STR COL + "H"
Else Transmit ASCII from @CR

!============
ROUTINE CHOME
!============
!
! Homes cursor to upper left corner of the screen for VT52 and VT100

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "H"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[H"
Else                     Transmit ASCII from @CR

!===========
ROUTINE EEOS
!===========
!
! Erases from cursor position to end of screen (bottom right corner)

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "J"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[J"

!===========
ROUTINE EEOL
!===========
!
! Erases from cursor position to end of line

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "K"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[K"

!==========
ROUTINE CUP
!==========
!
! Moves cursor up one position

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "A"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[A"

!============
ROUTINE CDOWN
!============
!
! Moves cursor down one position.  Uses a line feed for efficiency

If   TERTYP is between 1 and 5; Transmit ASCII from @LF
Else                            Transmit ASCII from @CR

!============
ROUTINE CLEFT
!============
!
! Moves cursor left one position.  Uses a backspace for efficiency

Transmit ASCII from @BS

!=============
ROUTINE CRIGHT
!=============
!
! Moves cursor right one position.

If   TERTYP = 1, 2 or 3; Transmit ASCII from @ESC + "C"
Orif TERTYP = 4 or 5;    Transmit ASCII from @ESC + "[C"
Else                     Transmit ASCII from " "

!========
ROUTINE Q
!========
!
! Removes tedium of typing "Transmit ascii from".  Put string in Q

Transmit ascii from @rtrim Q

!*********************************************************************
                            DETAIL SECTION
!*********************************************************************

Perform ID.TERMINAL, CHOME, EEOS
 2 to ROW; 15 to COL; "PROJECT TASK TRACKING Main Menu" to Q; Perform CXY, Q

 4 to ROW; 20 to COL; "1 - RAW REPORT"    to Q; Perform CXY, Q
 6 to ROW;            "2 - Enter update"  to Q; Perform CXY, Q
 8 to ROW;            "3 - Menu option 3" to Q; Perform CXY, Q
10 to ROW;            "4 - Menu option 4" to Q; Perform CXY, Q
12 to ROW;            "5 - Menu option 5" to Q; Perform CXY, Q
14 to ROW;            "Q - Quit"          to Q; Perform CXY, Q
16 to ROW;            "? - Help"          to Q; Perform CXY, Q
18 to ROW; 13 to COL; "Which? "+@rub      to Q; Perform CXY, Q
start
20 to COL; Perform CXY, EEOL
accept Q; perform eeos; type
@ltrim Q to Q; @index(Q,"!") to i
@left(Q,i-1) to Q if i#0
if:5   Q integral and @ival Q between 1 and 5
       type "You selected item ",@ival Q
orif:5 Q begins with "Q"; leave
orif:5 Q begins with "?"
       type "No help yet available"
else:5 type "You dummy, incorrect selection!"
Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM CRTCRT has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM CRTIDENTIFY				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.CRTIDENTIFY
!
DECLARE SECTION

ICBUF, BI,3,OCCURS 10  ! Input-character buffer for terminal IDs
ICCNT, BI,3
TERTYP,BI,2 ! 0=bad, 1=VT52, 2=Datamedia 3052, 3=VT100/VT132 in VT52 mode
            ! 4=VT100/VT132 in ANSI, 5=VT100/VT132 with AVO in VT52 mode
            ! 6=VT100/VT132 with AVO in ANSI mode
ROW,   BI,3
COL,   BI,3

PROCESS SECTION

ROUTINE ID.TERMINAL

If @TERMINAL.INDEX = 15 !VT52
   Transmit ASCII from @ESC+"Z"
   Receive ASCII to ICBUF wait .25 seconds count to ICCNT
   If:3 ICCNT = 3
      If:5 ICBUF(1) = @ASC @ESC
         If:7   ICBUF(3) = @ASC "K"  !Real VT52
                1 to TERTYP
         Orif:7 ICBUF(3) = @ASC "L"  !Datamedia 3052
                2 to TERTYP
         Orif:7 ICBUF(3) = @ASC "Z"  !VT100 in VT52 mode, interrogate
                Transmit ASCII from @ESC+"<"+@ESC+"[c"+@ESC+"[?2l"
                Receive ASCII to ICBUF wait .5 seconds count to ICCNT
                If:9 ICCNT = 7
                   If:11 ICBUF(6) band 2 # 0
                           5 to TERTYP   !Has AVO
                   Else:11 3 to TERTYP   !Doesn't have AVO
                Else:9     3 to TERTYP   !Assume no AVO
         Else:7 1 to TERTYP       !Some other VT5x variety
      Else:5    1 to TERTYP       !Not a true VT52, but ...
   Else:3       0 to TERTYP       !Not even similar to a VT52
Orif @TERMINAL.INDEX = 16         !16=Index for a VT100
   Transmit ASCII from @ESC + "[c"
   Receive ASCII to ICBUF wait .5 seconds count to ICCNT
   If:3 ICCNT = 7
      If:5 ICBUF(6) band 2 # 0
             6 to TERTYP   !VT100 with AVO in ANSI mode
      Else:5 4 to TERTYP   !VT100 in ANSI mode
   Else:3    4 to TERTYP   !VT100 in ANSI, shoddy emulation
Else 0 to TERTYP           !Anything else

ROUTINE MOVE.CURSOR

If TERTYP = 1, 2, 3 or 5
   Transmit ASCII from @ESC + "Y" + @CHR(31+ROW) + @CHR(31+COL)
Orif TERTYP = 4 or 6
   Transmit ASCII from @ESC + "[" + @STR ROW + ";" + @STR COL + "H"

ROUTINE HOME.CURSOR

If TERTYP = 1, 2, 3 or 5; Transmit ASCII from @ESC + "H"
Orif TERTYP = 4 or 6; Transmit ASCII from @ESC + "[H"

ROUTINE ERASE.EOS

If TERTYP = 1, 2, 3 or 5; Transmit ASCII from @ESC + "J"
Orif TERTYP = 4 or 6; Transmit ASCII from @ESC + "[J"

ROUTINE ERASE.EOL

If TERTYP = 1, 2, 3 or 5; Transmit ASCII from @ESC + "K"
Orif TERTYP = 4 or 6; Transmit ASCII from @ESC + "[K"

ROUTINE CURSOR.UP

If TERTYP = 1, 2, 3 or 5; Transmit ASCII from @ESC + "A"
Orif TERTYP = 4 or 6; Transmit ASCII from @ESC + "[A"

ROUTINE CURSOR.DOWN

Transmit ASCII from @LF

ROUTINE CURSOR.LEFT

Transmit ASCII from @BS

ROUTINE CURSOR.RIGHT

If TERTYP = 1, 2, 3 or 5; Transmit ASCII from @ESC + "C"
Orif TERTYP = 4 or 6; Transmit ASCII from @ESC + "[C"

DETAIL SECTION

Perform ID.TERMINAL; Type "Your terminal is ",nocr
If   TERTYP = 1; Type "a VT52"
Orif TERTYP = 2; Type "a Datamedia DM3052"
Orif TERTYP = 3; Type "a VT100 in the VT52 mode"
Orif TERTYP = 4; Type "a VT100 in the ANSI mode"
Orif TERTYP = 5; Type "a VT100 with AVO in the VT52 mode"
Orif TERTYP = 6; Type "a VT100 with AVO in the ANSI mode"
Else             Type "unknown to me and I cannot continue."
                 Exit Section
Continue
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM DECHEX				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
declare
hexd,c,1,occurs 16
dval,i,12
d0,i,2
d1,i,2
d2,i,2
d3,i,2
initial
"A" to hexd(10);"B" to hexd(11);"C" to hexd(12)
"D" to hexd(13);"E" to hexd(14);"F" to hexd(15)
detail
type "Decimal number: ",nocr; accept dval
 dval          band \17 to d0; (dval brsh  4) band \17 to d1
(dval brsh  8) band \17 to d2; (dval brsh 12) band \17 to d3
type "$",nocr
if d3 <10; type d3@'',nocr; else type hexd(d3),nocr
if d2 <10; type d2@'',nocr; else type hexd(d2),nocr
if d1 <10; type d1@'',nocr; else type hexd(d1),nocr
if d0 <10; type d0@''     ; else type hexd(d0)
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM DECHEX has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM DIRDIR				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.DIRDIR  Performs DBL directory operations.    Thad Floryan, NIS
!
! General instructions:
!
! BUILD:  *DEF PM DIR
!         --USE this.file
!         --SAVE
!
! USE:    *USE PM DIR
!         *USE PM DIR EQUATE dblname TO DIR
!
!         where "dblname" can be whatever Accent accepts as a filename.
!         For example:   *USE PM DIR EQUATE S:ACCLIB TO DIR
!
CONTROL
    Relate DBL from command as DIR
DECLARE
    FIRST,   i, 2
    TYP,     c, 3
    NAM,     c,40
    ANYHELD, i, 2
    NOTEXT,  i, 2
DETAIL
    Start
        Get next DBL entry from DIR hush
        Leave if @AUX="MISSI"
        If:5 FIRST=0; Incr FIRST
            Type "TYP         Created              Changed           Name"
            Type "---  --------------------  --------------------    ----"
        Continue:5
        ENTRY.TYPE to TYP
        ENTRY.NAME to NAM
        Type TYP,2s,@UDTSTR CREATE.TIME,2s,nocr
        If:5 CREATE.TIME # CHANGE.TIME; Type @UDTSTR CHANGE.TIME,nocr
        Else:5 Type "     n e v e r      ",nocr
        If:5 SAVE.STATUS="YES"; Type 2s,nocr
        Else:5 Type " *",nocr; Incr ANYHELD
        Continue:5
        Get next text from DIR hush
        If:5 @AUX="MISSI" and (TYP#"DBL" and TYP#"DS")
                    Type "# ",nocr; Incr NOTEXT
        Else:5      Type 2s,nocr
        Continue:5  Type NAM@""
    Repeat
    Type
    If ANYHELD # 0; Type 10s,"*  means item held and not saved"
    If NOTEXT  # 0; Type 10s,"#  means text was removed for item"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM DOWNLOAD				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.DOWNLOAD    [DEC-20]
!
! Reads a listing file created by M6800 and downloads the code in MIKBUG format
! through Port D of the Black Box CAS-4Q into the ETA-3400's RS-232 port.
!
! Notes:  the special RS-232 cable with alternated pins 2 & 3 must be used
!         between the CAS-4Q and the ETA-3400
!
!         the ETA-3400 should first be RESET and G 1400 before starting this PM
!
!         re DEBUG, 0 invokes actual operation, -1 suppresses CAS-4Q switching
!         and execution of the "receives".
!
!         operation:  USE PM DOWNLOAD EQUATE nnnnnn.LIS to H
!		      OFFSET (0=verbatim, else CODE:LOAD):
!			   0 = load code per listing's addresses
!			   else CODE is 4 hex digits representing the code's
!				base address, and LOAD is 4 hex digit address
!				where code is to be loaded.  For example,
!				if the code starts at $7000 but is to be
!				loaded into the EPROM program buffer at $3000,
!				the following would be entered: 7000:3000
!                     MODE (0=normal, -1=test): n
!
!                     where <n> is set to DEBUG per:
!                          0 = write to CAS-4Q port D and receive echoes
!                         -1 = display only to terminal
!
! The MIKBUG record format comprises:
!
! header:   "S1" = normal record, or
!           "S9" = EOF
!
! Following the header, an "S1" record contains:
!
! count:    hex count of bytes in the record after this count field
!
! address:  starting 2-byte hex address at which to store this record's data
!
! data:     up to 16 contiguous data bytes to be stored starting at address
!
! checksum: 1's complement of sum of the count, address, and data bytes
!
! CR,LF     record terminator
!
! An actual "S1" record is illustrated below:
!
!         S1130100CE0025962A2B046F00200AA700C604CE31
!
! whose fields are:
!
!         S1 13 0100 CE0025962A2B046F00200AA700C604CE 31
!            |  |    |                                |
!            |  |    +-  16 data bytes                +-  1 byte checksum
!            |  +------  2 byte address
!            +---------  1 byte count [ 13hex = 19decimal (2+16+1) ]

CONTROL

    ! Format of the listing file (of interest to this program):
    !
    ! FORM IS LINED
    ! HADR,C, 4      ! hex address
    ! S1,  C, 2      ! 2 spaces
    ! B1,  C, 2      ! hex byte # 1
    ! S2,  C, 1      ! 1 space
    ! B2,  C, 2      ! hex byte # 2
    ! B3,  C, 2      ! hex byte # 3
    ! REST,C,160     ! rest of line
    !
    Relate SD HL as H for input

DECLARE

    DEBUG,     I,  1
    PORT,      BB, 8, occurs 2
    TRUE,      I,  1
    FALSE,     I,  1
    HEXC,      C, 16
    HEXV,      I,  2
    I,         I,  1
    NDX,       I,  1
    FEOF,      I,  1            ! has value TRUE if EOF
    RCRD,      I,  1            ! has value TRUE if a "good" record
    FADR,      I,  5            ! address from file record
    NMFD,      I,  1            ! number of fields found in a "good" record
    FLD,       I,  3, occurs 3  ! fields extracted from a "good" record
    LAST.ADDR, I, 5
    VALS,      I,max, occurs 16
    NBYTES,    I,  2
    ACCUM,     I,max
    BYTE.STR,  C,  2
    TAPE.REC,  C, 50
    IC,        C,  1
    OFFSET,    I,  4
    CODE.ADR,  I,  4
    LOAD.ADR,  I,  4

PROCESS

Routine SELECT.TTY
  Exit routine if DEBUG<0
  31 to PORT(1); 1 to PORT(2); Transmit byte from PORT

Routine SELECT.CPU
  Exit routine if DEBUG<0
  31 to PORT(1); 4 to PORT(2); Transmit byte from PORT

Routine READ.REC
  Get next from H hush
  If @EOF:H = "YES"
       TRUE to FEOF; Exit routine
  Else FALSE to FEOF
  Continue
  FALSE to RCRD; 0 to NMFD, FADR; 0 to FLD(I) for I=1 to 3
  Start
    Exit loop if @SUBSTR(HADR,I,1) is not in HEXC for I=1 to 4
    Exit loop if S1 is not eq " " and S2 is not eq "  "
    Exit loop if @SUBSTR(B1,I,1) is not in HEXC for I=1 to 2
    FADR  *16+@INDEX(HEXC,@SUBSTR(HADR,I,1))-1 to FADR   for I=1 to 4
    FLD(1)*16+@INDEX(HEXC,@SUBSTR(B1,  I,1))-1 to FLD(1) for I=1 to 2
    1 to NMFD; (FADR blsh 18) bor FLD(1) to FLD(1)
    Start:4
      Exit loop:4 if B2 eq "  "
      Exit loop if @SUBSTR(B2,I,1) is not in HEXC for I=1 to 2
      FLD(2)*16+@INDEX(HEXC,@SUBSTR(B2,I,1))-1 to FLD(2) for I=1 to 2
      Incr NMFD; ((FADR+1) blsh 18) bor FLD(2) to FLD(2)
      Exit loop:4 if B3 eq "  "
      Exit loop if @SUBSTR(B3,I,1) is not in HEXC for I=1 to 2
      FLD(3)*16+@INDEX(HEXC,@SUBSTR(B3,I,1))-1 to FLD(3) for I=1 to 2
      Incr NMFD; ((FADR+2) blsh 18) bor FLD(3) to FLD(3)
      Exit loop:4
    Repeat:4
    TRUE to RCRD
    Exit loop
  Repeat

Routine WRITE.BYTES
  Perform DOWN.LOAD if @LHALF FLD(1) # LAST.ADDR or NBYTES = 16
  Start for NDX = 1 to NMFD
    Incr NBYTES
    FLD(NDX) to VALS(NBYTES)
    Perform DOWN.LOAD if NBYTES = 16
  Repeat
  @LHALF FLD(NMFD) + 1 to LAST.ADDR

Routine DOWN.LOAD
  Exit routine if NBYTES = 0
  "S1" to TAPE.REC
  NBYTES + 3 to ACCUM, HEXV; Perform ADDHEX
  ((@LHALF VALS(1)+OFFSET) brsh 8) band \o377 to HEXV
  Incr ACCUM by HEXV; Perform ADDHEX
  (@LHALF VALS(1)+OFFSET)          band \o377 to HEXV
  Incr ACCUM by HEXV; Perform ADDHEX
  Start for I=1 to NBYTES
    Incr ACCUM by @RHALF VALS(I)             ! Add to checksum
    @RHALF VALS(I) to HEXV; Perform ADDHEX
  Repeat
  (bnot ACCUM) band \o377 to HEXV; Perform ADDHEX  ! Append checksum
  TAPE.REC + @CR to TAPE.REC
  If @LEN TAPE.REC > 32
     Transmit ascii from @SUBSTR(TAPE.REC,I,1)  for I= 1 to 22
     Receive  ascii to IC wait .1 if DEBUG >= 0 for I= 1 to 22
     Transmit ascii from @SUBSTR(TAPE.REC,I,1)  for I=23 to @LEN TAPE.REC
     Receive  ascii to IC wait .1 if DEBUG >= 0 for I=23 to @LEN TAPE.REC
  Else
     Transmit ascii from @SUBSTR(TAPE.REC,I,1)  for I= 1 to @LEN TAPE.REC
     Receive  ascii to IC wait .1 if DEBUG >= 0 for I= 1 to @LEN TAPE.REC
  Continue
  Receive ascii to IC wait .1 if DEBUG >= 0  ! Gobble extra LF re TOPS-20 bug
  0 to NBYTES

Routine ADDHEX
  @SUBSTR(HEXC,(HEXV/16)+1,1)+@SUBSTR(HEXC,(HEXV mod 16)+1,1) to BYTE.STR
  TAPE.REC+BYTE.STR to TAPE.REC

INITIAL

    0 to FALSE; 1 to TRUE; "0123456789ABCDEF" to HEXC
    -1 to LAST.ADDR
    Start
      Type "OFFSET (0=verbatim, else CODE:LOAD): ",nocr; Accept @STRING
      If:2 @STRING="0"
	0 to OFFSET; Leave
      Orif:2 @LEN @STRING=9
	0 to CODE.ADR, LOAD.ADR
	Start:4 for I=1 to 4
	  CODE.ADR*16+@INDEX(HEXC,@SUBSTR(@STRING,I,  1))-1 to CODE.ADR
	  LOAD.ADR*16+@INDEX(HEXC,@SUBSTR(@STRING,I+5,1))-1 to LOAD.ADR
	Repeat:4
	LOAD.ADR - CODE.ADR to OFFSET
        Type "Loading code from ",nocr
        Start:4 for I=3 to 0 by -1
          Type @SUBSTR(HEXC,((CODE.ADR brsh 4*I) band \o17)+1,1),nocr
        Repeat:4
        Type " to ",nocr
        Start:4 for I=3 to 0 by -1
          Type @SUBSTR(HEXC,((LOAD.ADR brsh 4*I) band \o17)+1,1),nocr
        Repeat:4
        Type
        Leave
      Else:2 Type "Error"
      Continue:2
    Repeat
    Type "MODE (0=normal, -1=test): ",nocr; Accept DEBUG

DETAIL

    Perform SELECT.CPU   ! TTYMON must be started and at command level
    Start for I=1 to 3   ! Issue "Load MIKBUG format from TTY" command
      Transmit ascii from @SUBSTR("L0"+@LEFT(@CR,1),I,1)
      Receive ascii to IC wait .1 if DEBUG >= 0
    Repeat
    Receive ascii to IC wait .1 if DEBUG >= 0 for I=1 to 4 ! Gobble any echo
    Start
      Perform READ.REC
      Leave if FEOF = TRUE
      Perform WRITE.BYTES if RCRD = TRUE
    Repeat
    Perform DOWN.LOAD    ! In case something left in buffer
    Start for I=1 to 2   ! Send EOF marker of MIKBUG format
      Transmit ascii from @SUBSTR("S9",I,1)  ! ETA-3400 doesn't need CR,LF
      Receive ascii to IC wait .1 if DEBUG >= 0
    Repeat
    Receive ascii to IC wait .1 if DEBUG >= 0 for I=1 to 10 ! Gobble any echoes
    Transmit ascii from @CHR 0    ! Null to enter LEDMON and display "CPU UP."
    Receive ascii to IC wait .1 if DEBUG >= 0
    Perform SELECT.TTY
    Receive ascii to IC wait .1 if DEBUG >= 0 for I=1 to 10 ! Gobble any echoes
    Type "Transfer completed."
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM DOWNLOAD has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM EDITOR				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.EDITOR   Illustrates CRT-based editing using Transmit and Receive
DECLARE
    I,          I,max
    CHAR.INDEX, I, 3
    LINE.IMAGE, I, 3,occurs 80
    CHAR.INPUT, BB,8
PROCESS
Routine SET_VT100
    if @system.type = "VAX/VMS" and @terminal.index # 96
	96 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    orif @system.type = "DEC-20"  and @terminal.index # 16
	16 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    continue
DETAIL
    0 TO CHAR.INDEX
    Perform SET_VT100
    Transmit ascii from @ESC+"[H"+@ESC+"[J"+@ESC+"(B"+@ESC+")0"
    Transmit ascii from @CHR \o16+"l"+40"q"+"k"+@CR+"x"+@ESC+"[40C"+"x"+@CR
    Transmit ascii from "m"+40"q"+"j"+@ESC+"[2;2H"+@ESC+")2"+@ESC+"7"
    Transmit ascii from 40s+@ESC+"8"+@CHR \o17
    Start
        Receive byte to CHAR.INPUT; CHAR.INPUT band \o177 to CHAR.INPUT
        If:5 CHAR.INPUT is between 32 and 126     !Printing char
            If:7 CHAR.INDEX>=40; Type @BELL,nocr
            Else:7 Transmit byte from CHAR.INPUT  !"Echo" back to user
                Incr CHAR.INDEX; CHAR.INPUT to LINE.IMAGE(CHAR.INDEX)
        Orif:5 CHAR.INPUT = 10                    !Line feed
            Type                                  !Give user a CR-LF pair
            Leave                                 !And Leave this loop
        Orif:5 CHAR.INPUT = 8 or 127              !Backspace or rubout
            If:7 CHAR.INDEX > 0                   !Any chars to delete?
                Transmit ascii from @BS+@CHR \o16+1s+@BS+@CHR \o17
                Decr CHAR.INDEX
            Else:7 Transmit ascii from @BELL      !Give user a bell/beep
        Continue:5                                !Ignore anything else input
    Repeat                                        !Get more input from user
    If CHAR.INDEX > 0                             !Check for any input
        Type @CR
        Type @CHR LINE.IMAGE(I),nocr for I=1 to CHAR.INDEX !Type it back
        Type
    Else Type "No input to Type back"
    Continue
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM FFT					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.FFT  Fast Fourier Transform
!
! Designed for use with:
!	VT100,
!	Freedom F240,
!	Selanar 100XL
!	Amiga/VLT
!	Amiga/A-Talk
!
! Graphics output may also be directed to an HP-GL plotter (eventually)
!
!******************************************************************************
DECLARE SECTION
!******************************************************************************

    ASC,	C, 1
    GRA,	C, 1
    CSI,	C, 2	! Control-Sequence-Initiator: <ESC>+"[" for VT100/ANSI
    GPO,	C, 2	! string to enable graphic processor option
    BOLD,	C, 4
    NORM,	C, 3
    YPOS,	I, 3

    TERTYP,	I, 2	! 1=VT100, 2=F240, 3=100XL, 4=VLT, 5=ATalk, 6=UNIXPC
    DPYTYP,	I, 2	! 1=VT100, 2=TEK,  3=HPGL,  4=Curses, 5= table, 6=X

    MODE,	I, 1	! 0=alphanumeric, 1=graphics per DPYTYP
    TEKTYP,	I, 1	! 0=4010, 1=4014, 2=4027, 3=4105

! Old form of Tek positioning, using BB subfields, does not work on VAX:
!
!    GX,bb,12
!        $1  GXH,bb,5
!        $6  GXL,bb,5
!        $11 GX2,bb,2
!    GY,bb,12
!        $1  GYH,bb,5
!        $6  GYL,bb,5
!        $11 GY2,bb,2
! New form, works on all machines with modifications to SEND.XY:
!
    GX,		I, 5
    GY,		I, 5

    DELTA,	N,12   ! sample period in seconds
    SAMP.FREQ,	N,12
    FREQ,	N,12
    AMPL,	N,12
    a1,		N,12
    a2,		N,12
    B,		N,12
    b1,		N,12
    b2,		N,12
    III,	I, 4
    I,		N,12
    I1,		N,12
    i2,		N,12
    i3,		N,12
    i4,		N,12
    i5,		N,12
    k,		N,12
    L,		N,12	! init to 8
    m,		N,12
    n,		N,12	! init to 256
    N1,		N,12
    T,		N,12
    TF,		I, 1
    U,		N,12
    v,		N,12
    w,		N,12
    X,		N,12
    X1,		N,12, 8, occurs 257
    X2,		N,12, 8, occurs 257
    X3,		N,12, 8
    X4,		N,12
    y,		N,12
    Z,		N,12
    z1,		N,12
    z2,		N,12
!******************************************************************************
PROCESS SECTION
!******************************************************************************

!--------------------
Routine FFT
!--------------------
    N/2 to I1
    1 to I2
    @PI*2/N to V
    Start for I=1 to L
	0 to I3
	I1 to I4
	Start:5 for K=1 to I2
	    @int(I3/I1) to X
	    Perform SCRAMBLE
	    Y to I5
	    @COSR (V*I5) to Z1
	    -@SINR(V*I5) to Z2
	    Start:10 for M=I3 to I4-1
		X1(M+1) to A1
		X2(M+1) to A2
		Z1*X1(M+I1+1) - Z2*X2(M+I1+1) to B1
		Z2*X1(M+I1+1) + Z1*X2(M+I1+1) to B2
		A1 + B1 to X1(M+1)
		A2 + B2 to X2(M+1)
		A1 - B1 to X1(M+I1+1)
		A2 - B2 to X2(M+I1+1)
	    Repeat:10
	    I3 + 2*I1 to I3
	    I4 + 2*I1 to I4
	Repeat:5
	I1/2 to I1
	I2*2 to I2
    Repeat

!--------------------
Routine SCRAMBLE
!--------------------
    0 to Y
    N to N1
    Start for W=1 to L
	N1/2 to N1
	If:5 X >= N1
	    Y + 2^(W-1) to Y
	    X - N1 to X
	Continue:5
    Repeat

!--------------------
Routine MAGNITUDE
!--------------------
    Perform SCRAMBLE
    @SQRT(X1(Y+1)^2 + X2(Y+1)^2) to X3

!--------------------
Routine INIT.TIME.FUNCTIONS
!--------------------
    0 to X1(Z+1),X2(Z+1) for Z=0 to N

!--------------------
Routine TIME.FUNCTION.1    ! 12.5 mS pulse over 50 mS
!--------------------
    .050/N to DELTA
    1 to X1(Z+1) for Z=0 to N/4
    0 to X1(Z+1) for Z=N/4 to N

!--------------------
Routine TIME.FUNCTION.2    ! 6.25 mS pulse over 50 mS
!--------------------
    .050/N to DELTA
    1 to X1(Z+1) for Z=0 to N/8
    0 to X1(Z+1) for Z=N/8 to N

!--------------------
Routine TIME.FUNCTION.3    ! 1000 Hz sine wave
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*1000*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.4    ! 1010 Hz sine wave
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*1010*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.5    ! 40 Hz + 1000 Hz sine waves, equal amplitude
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*40*T) + @SINR(2*@PI*1000*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.6    ! 40 Hz + 1000 Hz sine waves, 40 Hz at half ampl.
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*40*T)/2 + @SINR(2*@PI*1000*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.7 !30,60,120,240,480,960,1920 @ 1/8,1/4,1/2,1,1/2,1/4,1/8
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
	    @SINR(2*@PI*  30*T)/8 + @SINR(2*@PI*  60*T)/4 to X1(Z+1)
        Add @SINR(2*@PI* 120*T)/2 + @SINR(2*@PI* 240*T)   to X1(Z+1)
        Add @SINR(2*@PI* 480*T)/2 + @SINR(2*@PI* 960*T)/4 to X1(Z+1)
        Add @SINR(2*@PI*1920*T)/8                         to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.8   !  4000 Hz  (shows aliasing problem)
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*4000*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.9   !  4000 Hz sampled 256 times in 5 mS
!--------------------
    .005/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*4000*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.10   !  20 KHz sampled 256 times in 5 mS
!--------------------
    .005/N to DELTA
    0 to T
    Start for Z=0 to N-1
	@SINR(2*@PI*20000*T) to X1(Z+1)
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.11  ! 1KHz, 2KHz, ... , 20 KHz sampled over 5 mS
!--------------------
    .005/N to DELTA
    0 to T
    Start for Z=0 to N-1
        0 to X1(Z+1)
	Add @SINR(2*@PI*I*T) to X1(Z+1) for I=1000 to 20000 by 1000
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.12  ! 1KHz, 2KHz, ... , 20 KHz sampled over 50 mS
!--------------------
    .050/N to DELTA
    0 to T
    Start for Z=0 to N-1
        0 to X1(Z+1)
	Add @SINR(2*@PI*I*T) to X1(Z+1) for I=1000 to 20000 by 1000
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.13  ! 1KHz, ... , 20 KHz sampled over 5 mS, decr.ampl.
!--------------------
    .005/N to DELTA
    0 to T
    Start for Z=0 to N-1
	0 to X1(Z+1)
        Start:5 for I=1000 to 20000 by 1000
	    Add @SINR(2*@PI*I*T)/((@SQRT I)/10) to X1(Z+1)
        Repeat:5
	Add DELTA to T
    Repeat

!--------------------
Routine TIME.FUNCTION.14    ! 12.5 mS pulse sampled over 10 mS
!--------------------
    .010/N to DELTA
    1 to X1(Z+1) for Z=0 to N-1

!--------------------
Routine TIME.FUNCTION.15    ! 6.25 mS pulse sampled over 10 mS
!--------------------
    .010/N to DELTA
    1 to X1(Z+1) for Z=0 to 5*N/8
    0 to X1(Z+1) for Z=5*N/8 to N

!--------------------
Routine TIME.FUNCTION.16  ! Unlimited user-input sine waves & ampl and sampling
!--------------------
    Type "Sampling frequency: ",nocr; Accept SAMP.FREQ
    1/SAMP.FREQ to DELTA
    0 to X1(Z+1) for Z=0 to N-1
    Start
	Type "Sine wave frequency (-1 to end): ",nocr; Accept FREQ
	Leave if FREQ < 0
	Type "Sine wave amplitude: ",nocr; Accept AMPL
	0 to T
	Start:5 for Z=0 to N-1
	    Add @SINR(2*@PI*FREQ*T)*AMPL to X1(Z+1)
	    Add DELTA to T
	Repeat:5
    Repeat

!--------------------
Routine TIME.FUNCTION.17  ! Unlimited user-input sq. waves & ampl and sampling
!--------------------
    Type "Sampling frequency: ",nocr; Accept SAMP.FREQ
    1/SAMP.FREQ to DELTA
    0 to X1(Z+1) for Z=0 to N-1
    Start
	Type "Square wave frequency (-1 to end): ",nocr; Accept FREQ
	Leave if FREQ < 0
	Type "Square wave amplitude: ",nocr; Accept AMPL
	0 to T
	Start:5 for Z=0 to N-1
	    Add AMPL to X1(Z+1) if @SINR(2*@PI*FREQ*T) >= 0
	    Add DELTA to T
	Repeat:5
    Repeat

!--------------------
Routine ALPHA.CLEAR.SCREEN
!--------------------
   If   TERTYP = 1; transmit ascii from CSI +"H"+CSI +"J"	! VT100
   Orif TERTYP = 2						! F240
   Orif TERTYP = 3						! 100XL
   Orif TERTYP = 4; transmit ascii from CSI +"H"+CSI +"J"	! Amiga/VLT
   Orif TERTYP = 5; transmit ascii from CSI +"H"+CSI +"J"	! Amiga/Atalk
   Orif TERTYP = 6; transmit ascii from CSI +"H"+CSI +"J"	! UNIXPC
   Else             transmit ascii from @RPT(@cr,25)
   Continue

!--------------------
Routine ALPHA.SETUP.ASC.GRA
!--------------------
   If   TERTYP = 1; transmit ascii from @esc+"(B"+@ESC+")0"	! VT100
   Orif TERTYP = 2						! F240
   Orif TERTYP = 3						! 100XL
   Orif TERTYP = 4; transmit ascii from @esc+"(B"+@ESC+")0"	! Amiga/VLT
   Orif TERTYP = 5; transmit ascii from @esc+"(B"+@ESC+")0"	! Amiga/Atalk
   Orif TERTYP = 6; transmit ascii from @esc+"(B"+@ESC+")0"	! UNIXPC
   Else
   Continue

!--------------------
Routine ALPHA.COLUMNS.132
!--------------------
   If   TERTYP = 1; transmit ascii from CSI + "?3h"		! VT100
   Orif TERTYP = 2						! F240
   Orif TERTYP = 3						! 100XL
   Orif TERTYP = 4; transmit ascii from CSI + "?3h"		! Amiga/VLT
   Orif TERTYP = 5; transmit ascii from CSI + "?3h"		! Amiga/Atalk
   Orif TERTYP = 6; transmit ascii from CSI + "?3h"		! UNIXPC
   Else
   Continue

!--------------------
Routine ALPHA.COLUMNS.80
!--------------------
   If   TERTYP = 1; transmit ascii from CSI + "?3l"		! VT100
   Orif TERTYP = 2						! F240
   Orif TERTYP = 3						! 100XL
   Orif TERTYP = 4; transmit ascii from CSI + "?3l"		! Amiga/VLT
   Orif TERTYP = 5; transmit ascii from CSI + "?3l"		! Amiga/Atalk
   Orif TERTYP = 6; transmit ascii from CSI + "?3l"		! UNIXPC
   Else
   Continue

!--------------------
Routine ALPHA.OFF.CURSOR
!--------------------
   If   TERTYP = 1; transmit ascii from ""			! VT100
   Orif TERTYP = 2						! F240
   Orif TERTYP = 3						! 100XL
   Orif TERTYP = 4; transmit ascii from ""			! Amiga/VLT
   Orif TERTYP = 5; transmit ascii from ""			! Amiga/Atalk
   Orif TERTYP = 6; transmit ascii from ""			! UNIXPC
   Else
   Continue

!--------------------
Routine GRAPHIC.TEK.CLEAR.SCREEN
!--------------------
   Transmit ascii from @esc+@chr(12)

!--------------------
Routine ALPHA.ASK.CONTINUE
!--------------------
   If TERTYP = 1, 2, 3, 4, 5 or 6
	transmit ascii from CSI +"24;1H"+ASC
   Continue
   Transmit ascii from "<CR> to CONTINUE"
   Accept @STRING

!--------------------
Routine GRAPHIC.ASK.CONTINUE
!--------------------
    Accept @STRING

!--------------------
Routine MODE.GRAPHIC
!--------------------
   If MODE = 0
      If:5 TERTYP = 1, 2, 3, 5 or 6
         transmit ascii from GPO
      Else:5
         transmit ascii from @ESC+"[?38h"	! Amiga/VLT
      Continue:5
      1 to mode
   Continue

!--------------------
Routine MODE.ALPHA
!--------------------
   If MODE = 1
      If:5 TERTYP = 1, 2, 3, 5 or 6
         transmit ascii from @esc+"2"
      Else:5
         transmit ascii from @ESC+"[?38l"	! Amiga/VLT
      Continue:5
      0 to mode
   Continue

!--------------------
Routine GRAPHIC.TEK.SEND.XY
!--------------------
!
! Old form using BB subfields does NOT work on VAX:
!
!    transmit ascii from @chr(32 bor GYH)
!    transmit ascii from @chr(96 bor (GY2 blsh 2) bor GX2) if TEKTYP=1
!    transmit ascii from @chr(96 bor GYL)
!    transmit ascii from @chr(32 bor GXH)
!    transmit ascii from @chr(64 bor GXL)
!
! New form works on all machines:
!
  transmit ascii from @chr(32 bor (GY brsh 7))
  transmit ascii from @chr(96 bor((GY band 3)blsh 2)bor(GX band 3))if TEKTYP=1
  transmit ascii from @chr(96 bor ((GY brsh 2)band 31))
  transmit ascii from @chr(32 bor (GX brsh 7))
  transmit ascii from @chr(64 bor ((GX brsh 2)band 31))

!--------------------
Routine GRAPHIC.TEK.ALPHABETIC		!submode
!--------------------
    transmit ascii from @chr(31)	! US, 37octal

!--------------------
Routine GRAPHIC.TEK.VECTOR.PLOT		!submode
!--------------------
    transmit ascii from @chr(29)	! GS, 35octal

!--------------------
Routine GRAPHIC.TEK.POINT.PLOT		!submode
!--------------------
    transmit ascii from @chr(28)	! FS, 34octal

!--------------------
Routine GRAPHIC.TEK.INCREMENTAL.PLOT	!submode
!--------------------
    transmit ascii from @chr(30)	! RS, 36octal

!--------------------
Routine GRAPHIC.TEK.LARGEST.CHAR	! 74 columns by 35 lines
!--------------------
    transmit ascii from @esc+"8"

!--------------------
Routine GRAPHIC.TEK.LARGE.CHAR		! 81 columns by 38 lines
!--------------------
    transmit ascii from @esc+"9"

!--------------------
Routine GRAPHIC.TEK.SMALL.CHAR		! 121 columns by 58 lines
!--------------------
    transmit ascii from @esc+":"

!--------------------
Routine GRAPHIC.TEK.SMALLEST.CHAR	! 133 columns by 64 lines
!--------------------
    transmit ascii from @esc+";"

!--------------------
Routine GRAPHIC.TEK.SOLID.LINES
!--------------------
    transmit ascii from @esc+"`"

!--------------------
Routine GRAPHIC.TEK.DOTTED.LINES
!--------------------
    transmit ascii from @esc+"a"

!--------------------
Routine GRAPHIC.TEK.DOT.DASH.LINES
!--------------------
    transmit ascii from @esc+"b"

!--------------------
Routine GRAPHIC.TEK.SHORT.DASH.LINES
!--------------------
    transmit ascii from @esc+"c"

!--------------------
Routine GRAPHIC.TEK.LONG.DASH.LINES
!--------------------
    transmit ascii from @esc+"d"

!--------------------
Routine ALPHA.DISPLAY.TIME.FUNCTION		! VT100 character-cell graphics
!--------------------
    Perform ALPHA.COLUMNS.132, ALPHA.SETUP.ASC.GRA
    transmit ascii from GRA+CSI+"2;H"
    transmit ascii from "x"+@cr for i=1 to 21
    transmit ascii from CSI+"12;1Hn"
    transmit ascii from "q" for i=1 to 128
    transmit ascii from ASC  !  +@esc+")1"  ! special graphics
    transmit ascii from CSI+"7m" ! reverse video

    Perform SCALE.TO.B
    Start for Z=0 to N/2+1
        12-10*X1(Z+1)/B to YPOS
	Transmit ascii from CSI+@str(YPOS)+";"+@str(z+1)+"H "
        If:5 YPOS < 12
	  Transmit ascii from @BS+@LF+" " if YPOS < 11 for I=YPOS+1 to 11
        Orif:5 YPOS > 12
	  Transmit ascii from @BS+CSI+"A "if YPOS>13 for I=YPOS-1 to 13 by -1
    Repeat

    Transmit ascii from NORM
    Perform ALPHA.ASK.CONTINUE, ALPHA.COLUMNS.80

!--------------------
Routine GRAPHIC.DISPLAY.TIME.FUNCTION		! Tek
!--------------------
    Perform ALPHA.CLEAR.SCREEN, ALPHA.OFF.CURSOR
    Perform MODE.GRAPHIC, GRAPHIC.TEK.CLEAR.SCREEN

    Perform GRAPHIC.TEK.DOTTED.LINES
    0 to GX, GY; Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
    3120 to GY;  Perform GRAPHIC.TEK.SEND.XY
    1560 to GY;  Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
    4095 to GX;  Perform GRAPHIC.TEK.SEND.XY

    Perform GRAPHIC.TEK.SOLID.LINES, GRAPHIC.TEK.VECTOR.PLOT, SCALE.TO.B
    Start for Z=0 to N-1
        Z * 16 to GX; (X1(Z+1)/B)*1500 + 1560 to GY
	Perform GRAPHIC.TEK.SEND.XY
    Repeat

    Perform GRAPHIC.ASK.CONTINUE, GRAPHIC.TEK.CLEAR.SCREEN

!--------------------
Routine ALPHA.DISPLAY.CRT.PLOT
!--------------------
    Perform ALPHA.COLUMNS.132, ALPHA.SETUP.ASC.GRA

    ! Draw grid
    !
    transmit ascii from GRA+CSI+"H"
    transmit ascii from "x"+@CR for i=1 to 20
    transmit ascii from bold+"n"+norm+"nnnnnnnnn" for i=1 to 12
    transmit ascii from bold+"n"+norm+"nnnnnnnn"+ASC+@CR+"0 "

    ! First row annotation
    !
    transmit ascii from 7s+@str(i,"3-") for i=10 to 120 by 10
    transmit ascii from @cr+3s

    ! Second row annotation
    !
    Start for i=10 to 120 by 10
	transmit ascii from 3s+@center(@str(i/(DELTA*N),"7-"),7)
    Repeat

    ! Setup for solid bar drawing
    !
    ! transmit ascii from @esc+")1"  ! special graphics
    transmit ascii from CSI+"7m" ! reverse video

    ! Display FFT
    !
    0 to B
    Start for Z=0 to N/2
	Z to X; Perform MAGNITUDE
	@nmax(X3,B) to B
    Repeat
    Start for Z=0 to N/2
	Z to X; Perform MAGNITUDE
	@int(20* X3/B) to X4
        If:5 X4 > 0
            transmit ascii from CSI+"20;"+@str(z+1)+"H"
            transmit ascii from " "+@BS+CSI+"A" for i=1 to X4
	Continue:5
    Repeat

    ! Restore normal alpha mode and wait for user response
    !
    Transmit ascii from NORM
    Perform ALPHA.ASK.CONTINUE, ALPHA.COLUMNS.80

!--------------------
Routine GRAPHIC.DISPLAY.CRT.PLOT
!--------------------
    Perform ALPHA.CLEAR.SCREEN, ALPHA.OFF.CURSOR
    Perform MODE.GRAPHIC, GRAPHIC.TEK.CLEAR.SCREEN, GRAPHIC.TEK.SOLID.LINES

    ! Draw box outline
    !
      50 to GX
     500 to GY; Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
    3110 to GY; Perform GRAPHIC.TEK.SEND.XY
    4050 to GX; Perform GRAPHIC.TEK.SEND.XY
     500 to GY; Perform GRAPHIC.TEK.SEND.XY
      50 to GX; Perform GRAPHIC.TEK.SEND.XY

    ! Display FFT
    !
    0 to B
    Start for Z=0 to N/2
	Z to X; Perform MAGNITUDE
	@nmax(X3,B) to B
    Repeat
    Start for Z=0 to N/2
	Z to X; Perform MAGNITUDE
	@int(2600* X3/B) to GY
        If:5 GY > 0
            Z*30 + 100 to GX; Add 500 to GY
	    Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
            500 to GY; Perform GRAPHIC.TEK.SEND.XY
	Continue:5
    Repeat

    ! Draw end tics
    !
     100 to GX
     450 to GY; Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
     500 to GY; Perform GRAPHIC.TEK.SEND.XY

    ! Draw incremental tics
    !
    Start for III=30 to 3900 by 30
	100 + III to GX; 500 to GY
	Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
	If:5   III mod 150 = 0; 450 to GY
	Else:5                  475 to GY
	Continue:5
	Perform GRAPHIC.TEK.SEND.XY
    Repeat

    ! First row annotation
    !
      90 to GX
     380 to GY; Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
    Perform GRAPHIC.TEK.ALPHABETIC, GRAPHIC.TEK.SMALL.CHAR
    Transmit ascii from '0'
    Start for I=10 to 130 by 10
        (I/10)*300 + 50 to GX
	Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
        Perform GRAPHIC.TEK.ALPHABETIC, GRAPHIC.TEK.SMALL.CHAR
	Transmit ascii from @str(I,'3-')
    Repeat

    ! Second row annotation
    !
    300 to GY
    Start for I=10 to 130 by 10
        (I/10)*300 - 70 to GX
	Perform GRAPHIC.TEK.VECTOR.PLOT, GRAPHIC.TEK.SEND.XY
        Perform GRAPHIC.TEK.ALPHABETIC, GRAPHIC.TEK.SMALL.CHAR
        Transmit ascii from @center(@str(I/(DELTA*N),'7-'),7)
    Repeat

    ! Reenter normal mode and wait for user response
    !
    Perform GRAPHIC.ASK.CONTINUE, GRAPHIC.TEK.CLEAR.SCREEN, MODE.ALPHA

!--------------------
Routine SCALE.TO.B
!--------------------
    X1(1) to B
    @ABS(X1(Z+1)) to B if @ABS(X1(Z+1)) > B for Z=0 to N-1

!--------------------
Routine ALPHA.LIST.TABLE
!--------------------
    Type "Harmonic    Real      Imaginary     Magnitude   Frequency"
    Start for U=0 to N/2
	U to X; Perform MAGNITUDE
	type U@"3-",2s,X1(Y+1),2s,X2(Y+1),2s,X3,U/(DELTA*N)@"12-"
    Repeat


!******************************************************************************
INITIAL SECTION
!******************************************************************************

   256 to N; 8 to L	! setup FFT parameters

   @chr 14 to GRA  ! ^N
   @chr 15 to ASC  ! ^O
   @ESC + "[" to CSI
   CSI + "1m" to bold
   CSI + "m"  to norm

   Type "Enter Terminal type:"
   Type "        1 = VT100/VT102 or clone"
   Type "        2 = Freedom F240"
   Type "        3 = Selanar 100XL"
   Type "        4 = Amiga/VLT"
   Type "        5 = Amiga/ATalk"
   Type "        6 = UNIXPC"
   Start
      Type "Selection: ",nocr
      Accept TERTYP
      Leave if TERTYP is between 1 and 6
    Repeat

   Type "Enter Display Mode:"
   Type "        1 = VT100/VT102 or clone character-cell graphics"
   Type "        2 = Tektronix 4010/4014/4027/4105"
   Type "        3 = HPGL (not implemented)"
   Type "        4 = Curses (not implemented)"
   Type "        5 = Tabular"
   Type "        6 = X11/DEC-Windows (not implemented)"
   Start
      Type "Selection: ",nocr
      Accept DPYTYP
      Leave if DPYTYP = 1, 2 or 5
    Repeat

   If DPYTYP = 2
      Type "Enter Tektronix variant:"
      Type "        1 = 4010"
      Type "        2 = 4014"
      Type "        3 = 4027 (not implemented)"
      Type "        4 = 4105 (not implemented)"
      Start:5
         Type "Selection: ",nocr
         Accept TEKTYP
         Leave:5 if TEKTYP = 1 or 2
      Repeat:5
      Decr TEKTYP
   Continue

!******************************************************************************
DETAIL SECTION
!******************************************************************************

Start
    Perform ALPHA.CLEAR.SCREEN
    Type "FFT Demonstration Program"
    Type "256 samples over 5 mS (51.2 KHz), 10 mS (25.6 KHz), 50 mS (5120 Hz)"
    Type "Generated time function (<CR> for menu, else number): ",nocr
    Accept @STRING
    If:5 @STRING = ""
        Type 5s,"1 - 12.5 mS pulse [5120 Hz]"
	Type 5s,"2 - 6.25 mS pulse [5120 Hz]"
	Type 5s,"3 - 1000 Hz sine wave [5120 Hz]"
	Type 5s,"4 - 1010 Hz sine wave [5120 Hz]"
	Type 5s,"5 - 40 Hz + 1000 Hz sine [5120 Hz]"
	Type 5s,"6 - 40 Hz + 1000 Hz sine, 40 Hz at 1/2 amplitude [5120 Hz]"
	Type 5s,"7 - 30,60,120,240,480,960,1920 at var. amplitudes [5120 Hz]"
	Type 5s,"8 - 4000 Hz sine wave (shows aliasing problem at 5120 Hz)"
	Type 5s,"9 - 4000 Hz sine wave [51.2 KHz]"
	Type 4s,"10 - 20 KHz sine wave [51.2 KHz]"
	Type 4s,"11 - 1 KHz, ..., 20 KHz equal amplitude [51.2 KHz]"
	Type 4s,"12 - 1 KHz, ..., 20 KHz equal amplitude [5120 Hz]"
	Type 4s,"13 - 1 KHz, ..., 20 KHz decreasing amplitude [51.2 KHz]"
	Type 4s,"14 - 12.5 mS pulse [25.6 KHz]"
	Type 4s,"15 - 6.25 mS pulse [25.6 KHz]"
	Type 4s,"16 - User-input sine freqs, amplitudes, and [sampling freq]"
        Type 4s,"17 - User-input square wave freq, ampl, and [sampling freq]"
	Type "Which? ",nocr; Accept @STRING
    Continue:5
    Start:5
	@IVAL @STRING to TF
	Leave:5 if TF is between 1 and 17
        Type "Which? ",nocr; Accept @STRING
    Repeat:5
    Perform INIT.Time.Functions
    If:5   TF= 1; Perform TIME.FUNCTION.1
    Orif:5 TF= 2; Perform TIME.FUNCTION.2
    Orif:5 TF= 3; Perform TIME.FUNCTION.3
    Orif:5 TF= 4; Perform TIME.FUNCTION.4
    Orif:5 TF= 5; Perform TIME.FUNCTION.5
    Orif:5 TF= 6; Perform TIME.FUNCTION.6
    Orif:5 TF= 7; Perform TIME.FUNCTION.7
    Orif:5 TF= 8; Perform TIME.FUNCTION.8
    Orif:5 TF= 9; Perform TIME.FUNCTION.9
    Orif:5 TF=10; Perform TIME.FUNCTION.10
    Orif:5 TF=11; Perform TIME.FUNCTION.11
    Orif:5 TF=12; Perform TIME.FUNCTION.12
    Orif:5 TF=13; Perform TIME.FUNCTION.13
    Orif:5 TF=14; Perform TIME.FUNCTION.14
    Orif:5 TF=15; Perform TIME.FUNCTION.15
    Orif:5 TF=16; Perform TIME.FUNCTION.16
    Orif:5 TF=17; Perform TIME.FUNCTION.17
    Continue:5

    Start:5
        Type "Do you want a display of the generated time function? ",nocr
	Accept @STRING
	Leave:5 if @STRING begins with "Y" or "N"
    Repeat:5

    If:5   @STRING begins with "Y"
	If:10   DPYTYP = 1; Perform ALPHA.DISPLAY.TIME.FUNCTION
	Orif:10 DPYTYP = 2; Perform GRAPHIC.DISPLAY.TIME.FUNCTION
	Orif:10 DPYTYP = 3; Type "HP plotting not implemented"
	Orif:10 DPYTYP = 4; Type "Curses not implemented"
	Orif:10 DPYTYP = 5; Type "Tabular listing not implemented"
	Orif:10 DPYTYP = 6; Type "X11 graphics not implemented"
	Else:10 Type @CR
	Continue:10
    Continue:5

    X1(Z+1)/N to X1(Z+1) for Z=0 to N-1   ! Scale input time function

    Perform FFT

    If:5   DPYTYP = 1; Perform ALPHA.DISPLAY.CRT.PLOT
    Orif:5 DPYTYP = 2; Perform GRAPHIC.DISPLAY.CRT.PLOT
    Orif:5 DPYTYP = 3; Type "HP graphics plotting not yet implemented"
    Orif:5 DPYTYP = 4; Type "Curses graphics not implemented"
    Orif:5 DPYTYP = 5; Perform ALPHA.LIST.TABLE
    Orif:5 DPYTYP = 6; Type "X11 graphics not implemented"
    Continue:5

    Start:5
	Type "Another? ",nocr; Accept @STRING
	Leave:5 if @STRING begins with "Y" or "N"
	Type @CR
    Repeat:5

    Leave if @STRING begins with "N"
Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM FNCTST				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
control
relate sf from command as report 1
declare
vv,n,7,2,occurs 2000
i,i,max
times,i,max
initial
.19273645 to @randomize
@random*1000. to vv(i) for i=1 to 2000
Type "How many times? ",nocr; accept times
detail
print 'A',@sqrt(vv(i)) for i=1 to times
print 'B',1.0123 ^ vv(i) for i=1 to times
print 'C',@log(vv(i)) for i=1 to times
print 'D',@ln (vv(i)) for i=1 to times
print 'E',@exp(vv(i)/100.) for i=1 to times
print 'F',@rnd(vv(i)) for i=1 to times
print 'G',@rnd(-vv(i)) for i=1 to times
print 'H',@trunc(vv(i)) for i=1 to times
print 'I',@trunc(-vv(i)) for i=1 to times
print 'J',@sin(vv(i)) for i=1 to times
print 'K',@sin(-vv(i)) for i=1 to times
print 'L',@sinr(vv(i)) for i=1 to times
print 'M',@sinr(-vv(i)) for i=1 to times
print 'N',@cos(vv(i)) for i=1 to times
print 'O',@cos(-vv(i)) for i=1 to times
print 'P',@cosr(vv(i)) for i=1 to times
print 'Q',@cosr(-vv(i)) for i=1 to times
print 'R',@tan(vv(i)) for i=1 to times
print 'S',@tan(-vv(i)) for i=1 to times
print 'T',@tanr(vv(i)) for i=1 to times
print 'U',@tanr(-vv(i)) for i=1 to times
print 'V',@asin(vv(i)/1000.) for i=1 to times
print 'W',@asin(-vv(i)/1000.) for i=1 to times
print 'X',@acos(vv(i)/1000.) for i=1 to times
print 'Y',@acos(-vv(i)/1000.) for i=1 to times
print 'Z',@atan(vv(i)) for i=1 to times
print '@',@atan(-vv(i)) for i=1 to times
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM GCDIST				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.GCDIST   Great Circle Distance, Written by Thad Floryan
!
! Calculates and displays bearing and distance between any two points on earth
! given the latitude and longitude of both.  The answer is given in terms of
! the direction and "course" from the ORIGIN to the DESTINATION.  The answers
! produced by this program ARE correct: it is possible for the course to be
! northerly for a southern destination since great circle routes are the
! shortest distance between two points on a sphere.
!
! NOTE: The actual calculations use haversine formulae as these avoid the
!	ambiguity arising through use of trigonometric functions which do not
!	indicate the quadrant in which the answer lies (ref. Bowditch, p.232).
!
!	hav = haversine = 1/2 versine = (1-cosine)/2 = sin^2 angle/2
!	sec = 1/cos
!	csc = 1/sin
!
! For reference, the trigonometric formulae are:
!
!	cos D = sin A sin B + cos A cos B cos L
!	sin C = cos B csc D sin L
!
!	where:
!
!	A = origin's latitude in degrees (+N, -S)
!	B = destination's latitude in degrees (+N, -S)
!	L = longitude difference between origin and destination
!	C = course direction to destination in degrees East or West from North
!	D = distance to destination in nautical miles/minutes of arc
!	    (1 minute of arc = 1 nautical mile = 1.1507 statute miles)
!
! The haversine formulae used by this program are:
!
!	hav D = hav DLon cos L1 cos L2 + hav DLat
!	hav C = sec L1 csc D ( hav CoL2 - hav D.CoL1 )
!
!	where:
!
!	DLat	= latitude difference between origin and destination
!	DLon	= longitude difference between origin and destination
!	L1	= origin's latitude in degrees
!	L2	= destination's latitude in degrees
!	D	= distance to destination in nautical miles/minutes of arc
!	CoL1	= 90 - L1
!	CoL2	= if L1 and L2 are same name (both N or S), then 90 - L2
!		  else 90 + L2 if contrary name (one N other S)
!	D.CoL1	= numerical difference between D and CoL1
!	C	= course direction labelled N or S to agree with L1, and
!		  E or W to agree with DLon.  In great-circle routing, L2
!		  may be south of L1 yet have a Northerly component
!
!  The haversine formulae can be reduced (for computer solution) to:
!
!	D = acos ( cos DLat - (1 - cos DLon) * cos L1 * cos L2 )
!
!	C = acos ( 1 - (cos D.CoL1 - cos CoL2)/(cos L1 * sin D) )
CONTROL
    Relate SF from command as report 1

DECLARE
    SAVE.DELIM,  C, 1

    ONAME,       C,45, PP=""
    OLAT.HEM,    C, 1  !  "N" or "S"
    OLAT.DEG,    N, 3
    OLAT.MIN,    N, 2, PP="dd"
    OLAT.SEC,    N, 2, PP="dd.d"
    OLATITUDE,   N,12
    OLON.DIR,    C, 1  !  "W" or "E"
    OLON.DEG,    N, 3
    OLON.MIN,    N, 2, PP="dd"
    OLON.SEC,    N, 2, PP="dd.d"
    OLONGITUDE,  N,12

    DNAME,       C,45, PP=""
    DLAT.HEM,    C, 1  !  "N" or "S"
    DLAT.DEG,    N, 3
    DLAT.MIN,    N, 2, PP="dd"
    DLAT.SEC,    N, 2, PP="dd.d"
    DLATITUDE,   N,12
    DLON.DIR,    C, 1  !  "W" or "E"
    DLON.DEG,    N, 3
    DLON.MIN,    N, 2, PP="dd"
    DLON.SEC,    N, 2, PP="dd.d"
    DLONGITUDE,  N,12

    DLat,        N,12
    DLon,        N,12
    L1,          N,12
    L2,          N,12
    D,           N,12
    D.NM,        N,12
    D.SM,        N,12
    CoL1,        N,12
    CoL2,        N,12
    D.CoL1,      N,12
    C,           N,12

    DIR,         N,12
PROCESS

Routine GETDATA
    @DELIM to SAVE.DELIM; @RUB  to @DELIM
    Type "Origin name: ", nocr; Accept ONAME; SAVE.DELIM to @DELIM

    Start
	Type "Origin latitude(D,M,S,N/S): ",nocr
	Accept OLAT.DEG, OLAT.MIN, OLAT.SEC, OLAT.HEM
	Leave if (OLAT.HEM="N" or "S") and OLAT.DEG between 0. and 90. &
	and OLAT.MIN between 0. and 59.99 and OLAT.SEC between 0. and 59.99
	Type "Error, reenter: ",nocr
    Repeat

    Start
	Type "Origin longitude(D,M,S,E/W): ",nocr
	Accept OLON.DEG, OLON.MIN, OLON.SEC, OLON.DIR
	Leave if (OLON.DIR="W" or "E") and OLON.DEG between 0. and 180. &
	and OLON.MIN between 0. and 59.99 and OLON.SEC between 0. and 59.99
	Type "Error, reenter: ",nocr
    Repeat

    @DELIM to SAVE.DELIM; @RUB to @DELIM
    Type @CR,"Destination name: ",nocr; Accept DNAME; SAVE.DELIM to @DELIM

    Start
	Type "Destination latitude(D,M,S,N/S): ",nocr
	Accept DLAT.DEG, DLAT.MIN, DLAT.SEC, DLAT.HEM
	Leave if (DLAT.HEM="N" or "S") and DLAT.DEG between 0. and 90. &
	and DLAT.MIN between 0. and 59.99 and DLAT.SEC between 0. and 59.99
	Type "Error, reenter: ",nocr
    Repeat

    Start
	Type "Destination longitude(D,M,S,E/W): ",nocr
	Accept DLON.DEG, DLON.MIN, DLON.SEC, DLON.DIR
	Leave if (DLON.DIR="W" or "E") and DLON.DEG between 0. and 180. &
	and DLON.MIN between 0. and 59.99 and DLON.SEC between 0. and 59.99
	Type "Error, reenter: ",nocr
    Repeat

    Type
Routine FIXDATA
    (OLAT.DEG)+(OLAT.MIN/60.)+(OLAT.SEC/3600.) to OLATITUDE, L1
    (OLON.DEG)+(OLON.MIN/60.)+(OLON.SEC/3600.) to OLONGITUDE
    (DLAT.DEG)+(DLAT.MIN/60.)+(DLAT.SEC/3600.) to DLATITUDE, L2
    (DLON.DEG)+(DLON.MIN/60.)+(DLON.SEC/3600.) to DLONGITUDE

    @trunc(OLATITUDE,0)       to OLAT.DEG
    (60.*OLATITUDE) mod 60.   to OLAT.MIN
    (3600.*OLATITUDE) mod 60. to OLAT.SEC

    @trunc(OLONGITUDE,0)       to OLON.DEG
    (60.*OLONGITUDE) mod 60.   to OLON.MIN
    (3600.*OLONGITUDE) mod 60. to OLON.SEC

    @trunc(DLATITUDE,0)       to DLAT.DEG
    (60.*DLATITUDE) mod 60.   to DLAT.MIN
    (3600.*DLATITUDE) mod 60. to DLAT.SEC

    @trunc(DLONGITUDE,0)       to DLON.DEG
    (60.*DLONGITUDE) mod 60.   to DLON.MIN
    (3600.*DLONGITUDE) mod 60. to DLON.SEC

Routine CALCULATE
    90. - L1 to CoL1

    If   OLAT.HEM = DLAT.HEM; OLATITUDE - DLATITUDE to DLat; 90. - L2 to CoL2
    Else                      OLATITUDE + DLATITUDE to DLat; 90. + L2 to CoL2
    Continue

    If   OLON.DIR = DLON.DIR
 	    If:5 OLON.DIR = "W";   OLONGITUDE - DLONGITUDE  to DLon
 	    Else:5                 DLONGITUDE - OLONGITUDE  to DLon
    Else    If:5 OLON.DIR = "W";   OLONGITUDE + DLONGITUDE  to DLon
 	    Else:5               -(OLONGITUDE + DLONGITUDE) to DLon
    Continue

    If @abs(DLon) > 180.
	If:5 DLon >= 0.; DLon - 360. to DLon; Else:5 360. + DLon to DLon
    Continue

    @acos(@cos DLat - (1. - @cos DLon) * @cos L1 * @cos L2) to D

    D - CoL1 to D.CoL1

    If DLON # 0.
	@acos(1. - (@cos D.CoL1 - @cos CoL2)/(@cos L1 * @sin D) ) to C
    Else 0. to C
    Continue

    D*60. to D.NM
    D.NM*(1852./1609.344) to D.SM ! 1nm=1852m exact, 1sm=1609.344m exact

    If OLAT.HEM = "N"
	If:5   DLon >= 0.; C      to DIR
	Else:5             360.-C to DIR
    Else
	If:5   DLon >= 0.; 180.-C to DIR
	Else:5             180.+C to DIR
    Continue
Routine DUMPCALC
    Print @cr
    Print "DLat  = ",dlat@""
    Print "DLon  = ",dlon@""
    Print "L1    = ",l1@""
    Print "L2    = ",l2@""
    Print "D     = ",d@""
    Print "CoL1  = ",col1@""
    Print "CoL2  = ",col2@""
    Print "D.CoL1= ",d.col1@""
    Print "C     = ",c@""

Routine ANSWERS
    Print "From:  ",nocr
    Print OLAT.DEG,"-",OLAT.MIN,"'",OLAT.SEC,"''",OLAT.HEM,", ", nocr
    Print OLON.DEG,"-",OLON.MIN,"'",OLON.SEC,"''",OLON.DIR,"   ", ONAME
    Print "To:    ",nocr
    Print DLAT.DEG,"-",DLAT.MIN,"'",DLAT.SEC,"''",DLAT.HEM,", ", nocr
    Print DLON.DEG,"-",DLON.MIN,"'",DLON.SEC,"''",DLON.DIR,"   ",DNAME
    Print "Bearing = ",@trunc(DIR,0),"-",(60.*DIR) mod 60.@"dd.d","', ",nocr
    Print "Distance = ",nocr
    If D.SM > 1.; Print @rnd(D.NM,1)," nm, ",@rnd(D.SM,1)," miles"
    Else Print @rnd(D.SM*5280.,1)," feet"
    Continue

DETAIL
    Type "GREAT CIRCLE LOCATOR",@CR
    Turn paging off, fill off
    Print "GREAT CIRCLE CALCULATIONS PER PM.GCDIST",@CR if @REPORT(1)="FILE"
    Start
	Perform GETDATA, FIXDATA, CALCULATE, ANSWERS
	Type @CR, "Another? ",nocr; Accept @STRING
	Leave if @STRING begins with "N"
	Print
    Repeat
    Exit section

    ! TEST DATA

    ! Per ARRL Antenna Book, pages 294-295
    ! C = 49-20.5', D = 5323.2 nm, 6125.8 miles
    "Chicago" to ONAME
    41. to OLAT.DEG; 52. to OLAT.MIN; 0. to OLAT.SEC; "N" to OLAT.HEM
    87. to OLON.DEG; 38. to OLON.MIN; 0. to OLON.SEC; "W" to OLON.DIR
    "Cairo" to DNAME
    30. to DLAT.DEG;  0. to DLAT.MIN; 0. to DLAT.SEC; "N" to DLAT.HEM
    31. to DLON.DEG; 14. to DLON.MIN; 0. to DLON.SEC; "E" to DLON.DIR
    Perform FIXDATA, CALCULATE, DUMPCALC, ANSWERS

    ! Per Bowditch, pages 232-234
    ! C = 050.3 = 50-19.3', D = 6185.9 nm, 7118.6 miles
    "Manila" to ONAME
     12. to OLAT.DEG; 45.2 to OLAT.MIN; 0. to OLAT.SEC; "N" to OLAT.HEM
    124. to OLON.DEG; 20.1 to OLON.MIN; 0. to OLON.SEC; "E" to OLON.DIR
    "LA" to DNAME
     33. to DLAT.DEG; 48.8 to OLAT.MIN; 0. to OLAT.SEC; "N" to DLAT.HEM
    120. to DLON.DEG;  7.1 to DLON.MIN; 0. to DLON.SEC; "W" to DLON.DIR
    Perform FIXDATA, CALCULATE, DUMPCALC, ANSWERS
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM HANG					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.HANG  Hangman game.  Originally developed by Karen Blaedow, March 1983.
!                         Enhancement of graphics & efficiency by Thad Floryan
!
DECLARE SECTION
    REPLY,      c, 100
    WORD,       c, 1, occurs 8
    LEN,        i, 1
    L,          i, 2
    GUESS,      c, 1
    LETTERS,    i, 1, occurs 26
    MATCHES,    i, 1
    PART,       i, 1
    MISS,       i, 1
    GPOS,       i, 3
    WPOS,       i, 3, occurs 8
    SPACING,    i, 2
    NORM,       c, 1
    GRAP,       c, 1
PROCESS SECTION
    Routine SET_VT100
	if @system.type = "VAX/VMS" and @terminal.index # 96
	    96 to @terminal.index
	    transmit ascii from @ESC+"<"	! set terminal type to VT100
	orif @system.type = "DEC-20"  and @terminal.index # 16
	    16 to @terminal.index
	    transmit ascii from @ESC+"<"	! set terminal type to VT100
	continue
DETAIL SECTION
Perform SET_VT100
@CHR 15 to NORM; @CHR 14 to GRAP
Transmit ascii from @ESC+"(B"+@ESC+")0"
start:10
  Transmit ascii from @ESC+"[2H"+@ESC+"[2J"+NORM
  -1 to LEN
  start:20
   if:25 len<0
    Transmit ascii from "Make sure that the person who will be guessing is "
    Transmit ascii from @ESC+"[4mnot"+@ESC+"[m"   ! underline
    Transmit ascii from " looking."+@CR+"Type in the word to be guessed: "
   Continue:25
    Transmit ascii from GRAP+8"s"+NORM+@ESC+"[8D"
    accept REPLY
    @LEN(REPLY) to LEN
    if:30 LEN > 8
      Transmit ascii from @ESC+"[5HThe word must be 8 letters or less"
      0 to LEN
    continue:30
    start:30 for L = 1 to LEN
      @uc(@substr(REPLY,L,1)) to WORD(L)
      if:40 WORD(L) not between "A" and "Z"
        Transmit ascii from @ESC+"[6HYou can only use letters between A and Z"
        0 to LEN
      continue:40
      leave:30 if LEN = 0
    repeat:30
    leave:20 if LEN > 0
    transmit ascii from @ESC+"[3;33H"+@ESC+"[K"
  repeat:20
  Transmit ascii from @ESC+"[H"+@ESC+"[J"+@CR+GRAP
  Transmit ascii from @TAB+"l"+22"q"+"k"+@ESC+"[14Cl"+22"q"+"k"+@CR
  Transmit ascii from @TAB+"x"+@ESC+"[22Cx"+@ESC+"[14Cx"+@ESC+"[22Cx"+@CR
  Transmit ascii from @TAB+"x"+@ESC+"[37Cx"+@ESC+"[22Cx"+@CR
  Transmit ascii from @TAB+"x"+@ESC+"[37Cx"+@ESC+"[22Cx"+@CR
  Transmit ascii from @TAB+"x"+@ESC+"[37Cx"+@ESC+"[22Cx"+@CR
  Transmit ascii from @TAB+"x"+@ESC+"[37Cm"+22"q"+"j"+@CR
  Transmit ascii from @TAB+@RPT("x"+@BS+@LF,11)+"x"+@CR+@ESC+"[4m"
  Transmit ascii from 8"q"+"v"+70"q"+@CR+@LF+79"q"+NORM+@ESC+"[m"
  Transmit ascii from @ESC+"[21H"+"Type in the letter you want to guess:"
  Transmit ascii from @CR+@LF+"These are the letters you guessed:"
  Transmit ascii from @ESC+"[3;49HThis is the word you"
  Transmit ascii from @ESC+"[4;49Hare trying to guess:"
  0 to MATCHES
  start:20 for L = 1 to 26
    0 to LETTERS(L)
  repeat:20
  22/(LEN+1) to SPACING
  47 + (23-SPACING*(LEN+1))/2 to GPOS
  Transmit ascii from GRAP  !+@ESC+"[1m"  ! graphics + bold
  start:20 for L = 1 to LEN
    incr GPOS by SPACING
    GPOS to WPOS(L)
    Transmit ascii from @ESC+"[6;"+@STR(WPOS(L))+"Ha"
  repeat:20
  Transmit ascii from NORM+@ESC+"[m"  ! normal chars + unblink
  36 to GPOS
  1 to PART
  start:20
    Transmit ascii from @ESC+"[21;39H"+@ESC+"[K"
    receive normal echo to GUESS
    if:30 @uc(GUESS) not between "A" and "Z"
      Transmit ascii from @ESC+"[24H"
      Transmit ascii from @BELL+"You can only guess letters between A and Z"
    orif:30 LETTERS(@asc(@uc(GUESS))-64) = 1
      Transmit ascii from @ESC+"[24H"+@ESC+"[K"
      Transmit ascii from @BELL+"You already guessed that letter"
    else:30
      1 to MISS
      1 to LETTERS(@asc(@uc(GUESS))-64)
      start:40 for L = 1 to LEN
        if:50 WORD(L) = GUESS
          Transmit ascii from @ESC+"[6;"+@STR(WPOS(L))+"H"+@UC(GUESS)
          incr MATCHES
          0 to MISS
        continue:50
      repeat:40
      Transmit ascii from @ESC+"[23;"+@STR(GPOS)+"H"+@uc(GUESS)
      incr GPOS by 2
    continue:30
    leave:20 if MATCHES >= LEN
    if:30 MISS = 1
      if:40 PART = 1
        Transmit ascii from @ESC+"[4;29H/// \\\"
        Transmit ascii from @ESC+"[5;28H(  o o  )"
        Transmit ascii from @ESC+"[6;30H\ - /"
        Transmit ascii from GRAP+@ESC+"[7;31Hx x"+NORM
      orif:40 PART = 2
        Transmit ascii from @ESC+"[8;29H##\ /##"
        Transmit ascii from @ESC+"[9;29H###V###"
        Transmit ascii from @ESC+"[10;29H#######"
        Transmit ascii from @ESC+"[11;29H#######"
        Transmit ascii from @ESC+"[12;29H:=====:"
        Transmit ascii from @ESC+"[13;28H/       \"
        Transmit ascii from @ESC+"[15;32H^"
      orif:40 PART = 3
        Transmit ascii from @ESC+"[8;27H/#"
        Transmit ascii from @ESC+"[9;26H/##"
        Transmit ascii from @ESC+"[10;25H/##/"
        Transmit ascii from @ESC+"[11;25H##/"
        Transmit ascii from @ESC+"[12;24H/ |"
        Transmit ascii from @ESC+"[13;24HWWU"
      orif:40 PART = 4
        Transmit ascii from @ESC+"[8;36H#\"
        Transmit ascii from @ESC+"[9;36H##\"
        Transmit ascii from @ESC+"[10;36H\##\"
        Transmit ascii from @ESC+"[11;37H\##"
        Transmit ascii from @ESC+"[12;38H| \"
        Transmit ascii from @ESC+"[13;38HUWW"+@CR
      orif:40 PART = 5
        Transmit ascii from @ESC+"[14;28H|"
        Transmit ascii from @ESC+"[15;28H|"
        Transmit ascii from @ESC+"[16;28H|  |"
        Transmit ascii from @ESC+"[17;26H/TT--|"
        Transmit ascii from @ESC+"[18;26H=====|"
      orif:40 PART = 6
        Transmit ascii from @ESC+"[14;36H|"
        Transmit ascii from @ESC+"[15;36H|"
        Transmit ascii from @ESC+"[16;33H|  |"
        Transmit ascii from @ESC+"[17;33H|--TT\"
        Transmit ascii from @ESC+"[18;33H|====="
      orif:40 PART = 7
        Transmit ascii from @ESC+"[8;19r"+@ESC+"[8H"+GRAP
        Transmit ascii from @ESC+"M"+@TAB+"x"+@ESC+"[21Cx x"+@LEFT(@CR,1)
        Transmit ascii from @ESC+"M"+@TAB+"x"+@ESC+"[21Cx x"
        Transmit ascii from NORM+@ESC+"[1;24r"+@ESC+"[5;31H* *"
      orif:40 PART = 8
        Transmit ascii from @ESC+"[10;19r"+@ESC+"[10H"+GRAP+@TAB
        Transmit ascii from @RPT(@ESC+"Mx"+@BS,10)
        Transmit ascii from NORM+@ESC+"[1;24r"
      continue:40
      incr PART
    continue:30
  repeat:20
  Transmit ascii from @ESC+"[21H"+@ESC+"[KDo you want another game? "
  Receive normal echo to GUESS
  leave:10 unless @uc(GUESS) begins with "Y"
repeat:10
Transmit ascii from @CR+@ESC+"[J"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM HEXADDSUB				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.HEXADDSUB    Adds and subtract 4-digit hex numbers
!
DECLARE
    HEXC,      C, 16
    HEXV,      I,  2
    INPS,      C, 20
    I,         I,  1
    VAL1,      I,max
    OPER,      I,max  ! 0=add, 1=sub
    VAL2,      I,max
PROCESS
Routine INHEX
    "0123456789ABCDEF" to HEXC
    Start
      Accept INPS
      If:2 INPS="0"
        0 to HEXV; Leave
      Orif:2 @LEN INPS=4
        0 to HEXV
        HEXV*16+@INDEX(HEXC,@SUBSTR(INPS,I,  1))-1 to HEXV for I=1 to 4
	Leave
      Else:2 Type "Error, 4 (and only 4) digits required, re-enter: ",nocr
    Repeat
Routine OUTHEX
    Type @SUBSTR(HEXC,((HEXV brsh 4*I) band \o17)+1,1),nocr for i=3 to 0 by -1
DETAIL
Start
    Type "1st hex number: ",nocr; Perform INHEX; HEXV to VAL1
    Leave if VAL1=0
    Start:1
	Type "OP (+,-): ",nocr; Accept INPS
	If:2   INPS="+"; 0 to OPER; Leave:1
	Orif:2 INPS="-"; 1 to OPER; Leave:1
	Else:2 Type "Error, ",nocr
    Repeat:1
    Type "2nd hex number: ",nocr; Perform INHEX; HEXV to VAL2
    VAL1 to HEXV; Perform OUTHEX
    If:1   OPER=0; Type " + ",nocr
    Else:1         Type " - ",nocr
    Continue:1
    VAL2 to HEXV; Perform OUTHEX; Type " = ",nocr
    If:1 OPER=0; VAL1 + VAL2 to HEXV
    Else:1       VAL1 - VAL2 to HEXV
    Continue:1 Perform OUTHEX; Type " (",HEXV@"",".)"
Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM HEXOUT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.HEXOUT    Displays hexadecimal counterpart of decimal values
!
! another method is, for example:
!
!	type @substr("0123456789ABCDEF", (HEXME  /  16) + 1, 1), nocr
!	type @substr("0123456789ABCDEF", (HEXME mod 16) + 1, 1), nocr
!
DECLARE
    HEXME, i, max
    HC,    c, 1,occurs 16
PROCESS
    Routine HEXIT
        If HEXME/16 < 10; Type HEXME/16,nocr; Else Type HC(HEXME/16),nocr
        If HEXME mod 16 < 10; Type HEXME mod 16; Else Type HC(HEXME mod 16)
INITIAL
    "A" to HC(10); "B" to HC(11); "C" to HC(12); "D" to HC(13)
    "E" to HC(14); "F" to HC(15)
DETAIL
    Start for HEXME = 1 to 16
        Type HEXME,"  =  ",nocr; Perform HEXIT
    Repeat
    Start for HEXME=20 to 250 by 10
        Type HEXME,"  =  ",nocr; Perform HEXIT
    Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM INITVT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.INITVT
!
! Performs all possible automatic terminal setup modes and interacts
! with the user to adjust those which cannot be set from the computer.
!
! Upon completion, @INTEGER will be set to one of the values:
!
!      -1 = not on a DEC-20, so we really don't know
!       0 = hardcopy (or an unsupported CRT)
!       1 = VT52
!       2 = Datamedia 3052   (a VT52 emulation)
!       3 = VT100/VT132 in VT52 mode
!       4 = VT100/VT132 in ANSI mode
!       5 = VT100/VT132 with AVO in VT52 mode
!       6 = VT100/VT132 with AVO in ANSI mode
!
DECLARE SECTION
    ICBUF,       I, 3, occurs 10  ! Character buffer for terminal IDs
    ICCNT,       I, 3
PROCESS SECTION
    Routine ID.TERMINAL  ! For TOPS-20 V. 4 & 5 "vanilla" systems only
        If @SYSTEM.TYPE does not have "DEC-20"
            Type "You're not on a DEC-20 and this initialization is aborted."
            -1 to @INTEGER; Exit Routine
        If @TERMINAL.INDEX = 15 !VT52
            Transmit ascii from @ESC+"Z"
            Receive ascii to ICBUF wait 1 second count to ICCNT
            If:3 ICCNT = 3
                If:5 ICBUF(1) = @ASC @ESC
                    If:7   ICBUF(3) = @ASC "K"  !Real VT52
                           1 to @INTEGER
                    Orif:7 ICBUF(3) = @ASC "L"  !Datamedia 3052
                           2 to @INTEGER
                    Orif:7 ICBUF(3) = @ASC "Z"  !VT100 in VT52 mode
                           Transmit ascii from @ESC+"<"+@ESC+"[c"+@ESC+"[?2l"
                           Receive ascii to ICBUF wait 1 second count to ICCNT
                           If:9 ICCNT = 7
                               If:11 ICBUF(6) band 2 # 0
                                       5 to @INTEGER !Has AVO
                               Else:11 3 to @INTEGER !Doesn't have AVO
                            Else:9     3 to @INTEGER !Assume no AVO
                    Else:7 1 to @INTEGER     !Some other VT5x variety
                Else:5     1 to @INTEGER     !Not a true VT52, but ...
            Else:3         0 to @INTEGER     !Not even similar to a VT52
        Orif @TERMINAL.INDEX = 16         !16=Index for a VT100
            Transmit ascii from @ESC + "[c"
            Receive ascii to ICBUF wait 1 second count to ICCNT
            If:3 ICCNT = 7
                If:5 ICBUF(6) band 2 # 0
                       6 to @INTEGER !VT100 with AVO in ANSI mode
                Else:5 4 to @INTEGER !VT100 in ANSI mode
            Else:3     4 to @INTEGER !VT100 in ANSI, shoddy emulation
        Else 0 to @INTEGER           !Anything else, hardcopy or CRT
    Routine HOME.CURSOR
        If   @INTEGER = 1, 2, 3 or 5; Transmit ascii from @ESC + "H"
        Orif @INTEGER = 4 or 6;       Transmit ascii from @ESC + "[H"
    Routine ERASE.EOS
        If   @INTEGER = 1, 2, 3 or 5; Transmit ascii from @ESC + "J"
        Orif @INTEGER = 4 or 6;       Transmit ascii from @ESC + "[J"
DETAIL SECTION
    Type @BELL,"Automatic operations in progress; please do not type"
    Type "ahead or enter anything until asked.  Thank you!"
    Perform ID.TERMINAL; Exit Process if @INTEGER < 0
    Perform  HOME.CURSOR, ERASE.EOS
    If @INTEGER = 3 or 5                   ! VT100/VT132 in VT52 mode
        Transmit ascii from @ESC + "<"     ! Enter ANSI mode for now
    If @INTEGER = 3, 4, 5 or 6             ! Any VT100/VT132
        Transmit ascii from @ESC + "[?3h"  ! 132 column display
        Transmit ascii from @ESC + "[3g"   ! Clear all tabs, then set tabs
        Transmit ascii from @ESC+"[8C"+@ESC+"HT"
        Transmit ascii from @ESC+"[7C"+@ESC+"HT" for ICCNT=1 to 15
        Transmit ascii from @ESC + "[m"    ! Normal char attributes
        Transmit ascii from @ESC + "(B"    ! ^O selects ASCII chars
        Transmit ascii from @ESC + ")B"    ! ^N selects ASCII chars
        Transmit ascii from @ESC + "[q"    ! Off any lit LEDs
        Transmit ascii from @ESC + "[?1l"  ! Cursor keys normal
        Transmit ascii from @ESC + "[?3l"  ! 80 column display
        Transmit ascii from @ESC + "[?4h"  ! Smooth scrolling
        Transmit ascii from @ESC + "[?5h"  ! Screen reverse video
        Transmit ascii from @ESC + "[?6l"  ! Absolute cursor origins
        Transmit ascii from @ESC + "[?7l"  ! Wrap-around OFF
        Transmit ascii from @ESC + "[?8h"  ! Auto-repeat ON
        Transmit ascii from @ESC + "[?9l"  ! Video interlace OFF
        Transmit ascii from @ESC + "[20l"  ! Normal line feed mode
        Transmit ascii from @ESC + ">"     ! Keypad in numeric mode
        Transmit ascii from @CHR 15        ! ^O to select ASCII chars
    If @INTEGER = 3 or 5  ! VT100/VT132 in VT52 mode
        Transmit ascii from @ESC + "[?2l"  ! Restore VT52 mode
    Continue
    Enable Terminal Lower Case, Terminal Tab
    Disable Terminal Form
    80 to @TERMINAL.WIDTH
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM LEAP					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.LEAP
! Leap year determiner.  Enter a year as YYYY, program types `YES!' or `no'.
! Terminate loop with just a carriage return as input.
!
DECLARE
    YR, i, max
    QU, i, max
    RE, i, max
DETAIL
    Start
        Type "YR: ",nocr; Accept YR
        Leave if YR<=0
        If:5 YR band 3 = 0
            YR / 100 to QU; YR mod 100 to RE
            If:6 RE = 0
                If:7 QU band 3 = 0; Type "YES!"
                Else:7              Type "no"
            Else:6 Type "YES!"
        Else:5 Type "no"
    Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM LOOPBACK2				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.LOOPBACK2
! tests ASCII loopback thru a network or communication line.
! requires a "special" DB-25 connector (pins 2 and 3 connected remotely).
! all characters are tested except ^S and ESC (all varieties of parity).
CONTROL
    Relate SF from command as report 1
DECLARE
    ICHAR, i,3
    OCHAR, i,3
    CCNT,  i,2
    PVAL,  i,max
PROCESS
Routine DisplayOctal4
    Print 1s, (PVAL brsh 6) band 7, (PVAL brsh 3) band 7, PVAL band 7, nocr
HEADINGS
    Turn paging off, fill off
    Print "Sent  Recd"
    Print "----  ----"
DETAIL
    Receive byte to ICHAR wait 5  !time delay to flip port-switch switches
    Start for OCHAR = 0 to \o377
        If:3 OCHAR#\o23 and #\o33 and #\o223 and #\o233 !don't do ^S and ESC
	    OCHAR to PVAL
	    Perform DisplayOctal4
	    Print 2s,nocr
            Transmit byte from OCHAR
            Receive byte to ICHAR wait .5 count to CCNT
            If:5 CCNT >0
		ICHAR to PVAL
		Perform DisplayOctal4
		Print
            Else:5 Print "none"
    Repeat
FINAL
    Receive byte to ICHAR wait 5 !time delay to reset port-switch switches
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM LUNAR					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.LUNAR    Lunar Lander flight simulation package for VT100/DT80/Excel14
!
DECLARE
    FUEL,     I,10	!FUEL
    VELOCITY, I,10	!SPEED
    DIST,     I,10	!DISTANCE
    GRAV,     I,10	!GRAVITY
    CUR.LOC,  I,10	!LOC OF SHIP: 18=HIGH, 1=LOW
    NEW.LOC,  I,10	!WHERE SHIP IS SUPPOSED TO BE
    DIFF,     I,10	!DELTA SHIP LOCATION
    BURN,     I,10	!FUEL BURN RATE
    ANSWER,   C,20
    C,        I,10
    OFUEL,    I,max
    OSPEED,   I,max
    ODIST,    I,max
    UL,       I,max	!0=UNDERLINE NOT SET, 1=SET
    APREF,    C,2
    RLF,      C,2	!REVERSE LINE-FEED
    RT,       C,3	!CURSOR RIGHT
    GRAPH,    C,1	!SELECT GRAPHICS SET
    CHARS,    C,1	!SELECT CHARS SET
    BRIGHT,   C,4	!INTENSIFIED VIDEO
    NORMAL,   C,3	!NORMAL VIDEO
    BLINK,    C,4	!BLINKING VIDEO
    STEADY,   C,3	!STEADY VIDEO
PROCESS

ROUTINE SET.ANSI
    if @system.type = "VAX/VMS" and @terminal.index # 96
	96 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    orif @system.type = "DEC-20"  and @terminal.index # 16
	16 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    continue

ROUTINE HOME.CLEAR
  transmit ascii from APREF+"H"+APREF+"J"

ROUTINE SET.CHAR.SETS
  transmit ascii from @ESC+"(B"+@ESC+")0"

ROUTINE SET.UNDERLINE
  IF UL=0; transmit ascii from APREF+"4m"; 1 TO UL

ROUTINE RESET.UNDERLINE
  IF UL=1; transmit ascii from APREF+"m"; 0 TO UL

ROUTINE DISP.FUEL
  IF FUEL # OFUEL
  PERFORM SET.UNDERLINE; FUEL TO OFUEL
  transmit ascii from APREF+";26H"+@str(FUEL,"")+2S
  PERFORM RESET.UNDERLINE

ROUTINE DISP.SPEED
  IF VELOCITY # OSPEED
  PERFORM SET.UNDERLINE; VELOCITY TO OSPEED
  transmit ascii from APREF+";45H"+@str(VELOCITY,"")+2S
  PERFORM RESET.UNDERLINE

ROUTINE DISP.DIST
  IF DIST # ODIST
  PERFORM SET.UNDERLINE; DIST TO ODIST
  transmit ascii from APREF+";61H"+@str(DIST,"")+2S
  PERFORM RESET.UNDERLINE

ROUTINE MOVE.SHIP   !Region = 18 lines
  DIST/35 TO NEW.LOC
  IF   NEW.LOC <  0;  0 TO NEW.LOC
  ORIF NEW.LOC > 18; 18 TO NEW.LOC
  CONTINUE EXIT ROUTINE IF NEW.LOC = CUR.LOC
  CUR.LOC - NEW.LOC TO DIFF; NEW.LOC TO CUR.LOC
  PERFORM SET.ANSI
  IF DIFF > 0  !Move ship down
    transmit ascii from APREF+"2H"+@rpt(RLF,DIFF)
  ELSE
    transmit ascii from APREF+"22H"+@rpt(@LF,@ABS DIFF)

INITIAL

  @ESC + "[" TO APREF
  @CHR \o17 TO CHARS	!^O, SHIFT/IN FOR CHARS
  @CHR \o16 TO GRAPH	!^N, SHIFT/OUT FOR GRAPHICS
  @ESC + "M" TO RLF	!REVERSE LINE-FEED
  APREF + "C" TO RT	!CURSOR RIGHT
  APREF + "1m" TO BRIGHT
  APREF + "m" TO NORMAL
  APREF + "5m" TO BLINK
  APREF + "m" TO STEADY

DETAIL

  PERFORM SET.ANSI, HOME.CLEAR
  transmit ascii from APREF+"5;12H"+@ESC+"#3LUNAR LANDER"+@cr
  transmit ascii from APREF+"11C"+@ESC+"#4LUNAR LANDER"+@cr
  transmit ascii from APREF+"8B"+APREF+"13CTry to land the LEM on "
  transmit ascii from "the surface of the Moon by"+@cr+APREF
  transmit ascii from "13Centering a fuel burn rate when requested."
  transmit ascii from APREF+"20;13H"+@ESC+"#6Good Luck!"+@cr
  transmit ascii from @ESC+"#3"    !Hide the cursor for a while
  sleep 7

  START
    0 TO @RANDOMIZE
    100 + @INT(75*@RANDOM) TO FUEL
    @INT(50*@RANDOM) - 100 TO VELOCITY
    430 + @INT(200*@RANDOM) TO DIST
    1 + @INT(8*@RANDOM) TO GRAV

    !DRAW ARENA

    PERFORM HOME.CLEAR, SET.ANSI, SET.CHAR.SETS, SET.UNDERLINE
    transmit ascii from 80S
    PERFORM RESET.UNDERLINE
    transmit ascii from APREF+"23H"+GRAPH+80"o"+CHARS
    PERFORM SET.UNDERLINE
    transmit ascii from APREF+";20HFuel:"
    transmit ascii from APREF+";36HSpeed:"
    transmit ascii from APREF+";53HHeight:"
    PERFORM RESET.UNDERLINE
    transmit ascii from APREF+"24;31HBurn:"
    transmit ascii from APREF+"2;22r"    !Set scrolling margins

Transmit ascii from APREF+"2;20H"+@ESC+")0"+GRAPH+@esc+"#3`"+@LF
Transmit ascii from @ESC+"#4"+@BS+@ESC+")2"+GRAPH+APREF+"4m "+APREF+"m"
Transmit ascii from @esc+"(B"+CHARS+APREF+"4;38H/"+@chr 26+@chr 26+"\"

    18 TO CUR.LOC; -1 TO OFUEL, OSPEED, ODIST
    PERFORM MOVE.SHIP, DISP.FUEL, DISP.SPEED, DISP.DIST
    transmit ascii from APREF+"24;37H"  !Setup for input from user

    START:5

      0 TO FUEL, BURN IF FUEL <= 0
      IF:10 FUEL > 0 AND VELOCITY < 0
        transmit ascii from APREF+"24;37H"+APREF+"K"
        ACCEPT BURN; PERFORM SET.ANSI, SET.CHAR.SETS
        0 TO BURN IF BURN < 0
      IF:10 BURN > FUEL
        FUEL TO BURN
        transmit ascii from APREF+"24;37H"+@str(BURN,"")+5S
      IF:10 BURN > 0
        transmit ascii from APREF+@STR(22-CUR.LOC)+";39H"
        transmit ascii from BRIGHT+GRAPH+"aa"+NORMAL+@BS+@BS+"aa"+CHARS
      CONTINUE:10
      FUEL - BURN TO FUEL
      BURN - GRAV TO C
      DIST + VELOCITY + C/2 TO DIST
      VELOCITY + C TO VELOCITY
      0 TO BURN

      PERFORM DISP.FUEL, DISP.SPEED, DISP.DIST, MOVE.SHIP

      IF:10 DIST <= 0
        IF:15 DIST > -2 AND VELOCITY >= -5
          transmit ascii from APREF+"10;13H"+BLINK
          transmit ascii from @ESC+"#6CONGRATULATIONS!"+STEADY
          transmit ascii from APREF+"12;28HLEM on surface of the Moon."
          LEAVE:5
        ELSE:15      !display exploding ship
          transmit ascii from GRAPH+BLINK+BRIGHT !Graphics & Bright video
          transmit ascii from APREF+"22;40H~"+@rpt(@BS+RLF+"~",3)
          transmit ascii from @BS+RLF+"^"+@LF+@LF+"~"+"]"
          transmit ascii from @BS+@BS+@BS+@BS+"~"+@BS+@BS+"["
          transmit ascii from @LF+@LF+"~"+@BS+@BS+"/"+RT+RT+"~"+"\"

          transmit ascii from APREF+"18;40H~"+@BS+RLF+"~"+@BS+RLF+"^"
          transmit ascii from APREF+"5B~"+RLF+"~"+RLF+"~"+RLF+"]"
          transmit ascii from APREF+"21;39H~"+@BS+@BS+RLF+"~"+@BS+@BS+RLF
          transmit ascii from "~"+@BS+@BS+RLF+"["+APREF+"22;42H~~"+"\"
          transmit ascii from APREF+"7D~"+@BS+@BS+"~"+@BS+@BS+"/"

          transmit ascii from APREF+"16;40H~"+@BS+RLF+"^"
          transmit ascii from APREF+"18;44H~"+"]"+APREF+"10D~"+@BS+@BS
          transmit ascii from "["+APREF+"22;44H~"+"\"
          transmit ascii from APREF+"10D~"+@BS+@BS+"/"

          transmit ascii from NORMAL+STEADY+CHARS  !Characters mode

          transmit ascii from APREF+"2H" !scroll debris down off screen
          transmit ascii from @rpt(RLF,8)

          LEAVE:5
    CONTINUE:10

    REPEAT:5

    transmit ascii from APREF+"24;31HAnother? "
    ACCEPT ANSWER
    LEAVE IF ANSWER BEGINS WITH "N"

  REPEAT

  transmit ascii from APREF+"r"+APREF+"24H" !CLEAR MARGINS & HOME DOWN
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM NBSTIME				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.NBSTIME
!
! Program to interrogate THADLABS Most Accurate Clock and display the
! returned value at the terminal.  There is a kludge due to a TOPS-20 bug
! whereby a <LF> is always returned after a <CR> requiring the string length
! of 25 instead of the 24 specified for the clock's RS-232-C micro.
!
DECLARE
    PORT,     BB, 8, occurs 2
    NBS.TIME, C, 25
PROCESS
Routine SELECT.TERMINAL
    31 to PORT(1); 1 to PORT(2); Transmit byte from PORT
Routine SELECT.CLOCK
    31 to PORT(1); 4 to PORT(2); Transmit byte from PORT
DETAIL
    Type @UDTSTR @UDT                ! Display present SAO Universal Date-Time
    Perform SELECT.CLOCK
    Transmit ascii from @CHR 0       ! Tickle the clock's Receive-Data pin
    Receive ascii to NBS.TIME wait 2 seconds  ! timeout = 2 secs if no response
    Perform SELECT.TERMINAL
    Type @SUBSTR(NBS.TIME, 16, 8), 4s, @LEFT(NBS.TIME, 13)
    Type @UDTSTR @UDT                ! Display present SAO Universal Date-Time
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM PARITY				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.PARITY
! This PM ascertains the number of "1" bits in a word in order to compute
! parity.  This is based on the fact that in any word and its twos complement
! the rightmost "1" is in the same position, both words have all "0" to the
! right of this "1", and no corresponding bits are the same to the left (the
! parts of both words at the left of the rightmost "1" are complements).  Hence
! using the negative of a word as a mask for the word in a test selects only
! the rightmost "1" for modification.  This example has three variables:
!
!       WORD  -  the word to be examined for the number of "1"s.
!                A working copy of this is kept in WORK.
!       TEMP  -  bit mask created in each step.
!       CNT   -  number of "1"s in WORD.
!
!  -Thad Floryan, NIS

DECLARE SECTION
    WORD, I,max
    TEMP, I,max
    WORK, I,max
    CNT,  I,max,PP=''
DETAIL SECTION
    Type "Number to test: ", nocr; Accept WORD
    0 to CNT; WORD to WORK
    Start
        -WORK to TEMP
        Leave if WORK band TEMP = 0
        WORK band (bnot TEMP) to WORK
        Incr CNT
    Repeat
    Type "The number of '1' bits is ", CNT, ", ", nocr
    If CNT band 1 = 0; Type "even ", nocr
    Else               Type "odd ", nocr
    Continue           Type "parity"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM PARITYR				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.PARITYR
! Displays the parity and tallies the EVENS and ODDS over a range using the
! same algorithm as PM.PARITY
!
DECLARE SECTION
    I,     I, 3
    EVENS, I, 3
    ODDS,  I, 3
    WORD,  I,max
    TEMP,  I,max
    WORK,  I,max
    CNT,   I,max,PP=''
DETAIL SECTION
    Start for I=0 to 127
        I to WORD; Type I,nocr
        0 to CNT; WORD to WORK
        Start:5
            -WORK to TEMP
            Leave:5 if WORK band TEMP = 0
            WORK band (bnot TEMP) to WORK
            Incr CNT
        Repeat:5
        Type 2s, CNT, " bits set, ", nocr
        If:5 CNT band 1 = 0; Type "even ", nocr; incr evens
        Else:5               Type "odd ", nocr;  incr odds
        Continue:5           Type "parity"
    Repeat
    Type @CR,EVENS," EVENS",@CR,ODDS," ODDS"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM PASSWD				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
DECLARE
    SAVE.DELIM, c, 1
    PASSWD,     c, 40     ! password string
    ROTATE,     i, max
    I,          i, max
    MASK,       i, max
    TEMP1,      i, max
    TEMP2,      i, max
    ICHAR,      i, max    ! ASCII integer value of a password char
    KEY1,       i, max    ! First generated unique "key"
    KEY2,       i, max    ! Second generated unique "key"
DETAIL

   @DELIM to SAVE.DELIM
   @chr 127 to @DELIM
   Type "Enter password: ", nocr
   disable echo
   Accept PASSWD
   enable echo
   Type
   SAVE.DELIM to @DELIM

   bnot(0) to KEY1, KEY2  ! assure all bits ON, all machines
   KEY1 blsh 1 to MASK    ! all bits ON except the rightmost

   Start for I = 1 to @len PASSWD   ! helps if password > 7 chars

      @asc @substr(PASSWD, I, 1) to ICHAR

      ! the following code is to assure that the password entered will be
      ! treated the same from either lower- or upper-case terminals
      !
      If:5 ICHAR not between 32 and 95
         If:10 ICHAR < 32
            incr ICHAR by 32
         Else:10
            decr ICHAR by 32
         Continue:10
      Continue:5

      ! Now rotate the "doubleword" set of keys 57 places to the "left",
      ! shifting bits between the two words
      !
      Start:5 for ROTATE = 1 to 57
         KEY1 blcy 1 to KEY1; KEY1 band 1 to TEMP1
         KEY2 blcy 1 to KEY2; KEY2 band 1 to TEMP2
         (KEY1 band MASK) bor TEMP2 to KEY1
         (KEY2 band MASK) bor TEMP1 to KEY2
      Repeat:5

      ! Exclusive-OR in the converted character value
      !
      KEY1 bxor ICHAR to KEY1

   Repeat

type  KEY1
type  KEY2
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM PORT					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.PORT  Allows selection of Black Box port
!
DECLARE
    PORT, BB, 8, occurs 2  ! 8-bit bytes
    I,    I,  3
DETAIL
    Start
        Type "Port: ",nocr; Accept I
        Leave if I is between 1 and 4
        Type @BELL,"Must be between 1 and 4 inclusive, ",nocr
    Repeat
    31 to PORT(1); I to PORT(2); Transmit byte from PORT
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM ROUND					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.ROUND   Demonstrates the @RND function
!
CONTROL SECTION
    Relate SF from command as report 1
DECLARE SECTION
    Picture 1 is "18-.18D"
DETAIL SECTION
    Print "1 + @RND 1. + 1           ", 1+@RND 1.+1               @ 1
    Print "1 + @RND 12.345           ", 1 + @RND 12.345           @ 1
    Print "@RND 12.345 + 1           ", @RND 12.345 + 1           @ 1
    Print "1 + @RND(12+.345)         ", 1+@RND(12+.345)           @ 1
    Print "@RND(12+.345)+1           ", @RND(12+.345)+1           @ 1
    Print "1 + @RND(1.234,0)         ", 1+@RND(1.234,0)           @ 1
    Print "@RND(1.234,0) + 1         ", @RND(1.234,0)+1           @ 1
    Print "@RND 1.234                ", @RND 1.234                @ 1
    Print "@RND 123.456              ", @RND 123.456              @ 1
    Print "@RND(12.34,1)             ", @RND(12.34,1)             @ 1
    Print "@RND(12.45,1)             ", @RND(12.45,1)             @ 1
    Print "@RND(12.45,0)             ", @RND(12.45,0)             @ 1
    Print "@RND(12.5,0)              ", @RND(12.5,0)              @ 1
    Print "@RND(1234.,0)             ", @RND(1234.,0)             @ 1
    Print "@RND(1234.,-1)            ", @RND(1234.,-1)            @ 1
    Print "@RND(1234.,-2)            ", @RND(1234.,-2)            @ 1
    Print "@RND(1234.,-3)            ", @RND(1234.,-3)            @ 1
    Print "@RND 121212121212.123     ", @RND 121212121212.123     @ 1
    Print "@RND(121212121212.123,0)  ", @RND(121212121212.123,0)  @ 1
    Print "@RND(121212121212.123,-3) ", @RND(121212121212.123,-3) @ 1
    Print "@RND 1234567891234.567    ", @RND 1234567891234.567    @ 1
    Print "@RND 12345678912345.678   ", @RND 12345678912345.678   @ 1
    Print "@RND 123456789121234.567  ", @RND 123456789121234.567  @ 1
    Turn fill off
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM SCHEMBBC				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! SCHEM.BBC - Draws Battery Backup Circuit schematic
!
DECLARE
    PORT, BB, 8
    I,    I, max
    X1,   I, max
    Y1,   I, max
    X2,   I, max
    Y2,   I, max
    XCUR, I, max
    YCUR, I, max
    DX,   I, max
    DY,   I, max
PROCESS
Routine SELECT.TERMINAL  ! Black Box port A
    type @chr 31,@chr 1, nocr
!    31 to PORT; Transmit byte from PORT
!     1 to PORT; Transmit byte from PORT
Routine SELECT.PLOTTER   ! Black Box port C
    type @chr 31,@chr 3, nocr
!    31 to PORT; Transmit byte from PORT
!     3 to PORT; Transmit byte from PORT
Routine MOVE.TO.POSITION
    Type 'papu',@str X1,',',@str Y1,'pd;',nocr if X1#XCUR or Y1#YCUR
Routine XSTR.NPN.0
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=180 to 540 by 8
	Type @str @int(X1+300+300*@cos I),",",nocr
	Type @str @int(Y1+    300*@sin I),1s,nocr
    Repeat
    Type ';pr 150,0 0,150 0,-300 0,50 300,-160 ',nocr
    Perform XSTR.ARROW.RD30
    Type '0,-40 pu -300,400 pd 300,160 0,40;',nocr
    X1+450 to X1,X2,XCUR; Y1+300 to Y1,Y2,YCUR
Routine XSTR.NPN.90
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=270 to 630 by 8
	Type @str @int(X1+    300*@cos I),",",nocr
	Type @str @int(Y1+300+300*@sin I),1s,nocr
    Repeat
    Type ';pr 0,150 -150,0 300,0 -50,0 160,300 ',nocr
    Perform XSTR.ARROW.RU60
    Type '40,0 pu -400,-300 pd -160,300 -40,0;',nocr
    X1-300 to X1,X2,XCUR; Y1+450 to Y1,Y2,YCUR
Routine XSTR.NPN.180
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=0 to 360 by 8
	Type @str @int(X1-300+300*@cos I),",",nocr
	Type @str @int(Y1+    300*@sin I),1s,nocr
    Repeat
    Type ';pr -150,0 0,-150 0,300 0,-50 -300,160 ',nocr
    Perform XSTR.ARROW.LU30
    Type '0,40 pu 300,-400 pd -300,-160 0,-40;',nocr
    X1-450 to X1,X2,XCUR; Y1-300 to Y1,Y2,YCUR
Routine XSTR.NPN.270
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=90 to 450 by 8
	Type @str @int(X1+    300*@cos I),",",nocr
	Type @str @int(Y1-300+300*@sin I),1s,nocr
    Repeat
    Type ';pr 0,-150 150,0 -300,0 50,0 -160,-300 ',nocr
    Perform XSTR.ARROW.LD60
    Type '-40,0 pu 400,300 pd 160,-300 40,0;',nocr
    X1+300 to X1,X2,XCUR; Y1-450 to Y1,Y2,YCUR
Routine XSTR.PNP.0
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=180 to 540 by 8
	Type @str @int(X1+300+300*@cos I),",",nocr
	Type @str @int(Y1+    300*@sin I),1s,nocr
    Repeat
    Type ';pr 150,0 0,-150 0,300 0,-50 ',nocr
    Perform XSTR.ARROW.LD30
    Type '300,160 0,40 pu -300,-400 pd 300,-160 0,-40;',nocr
    X1+450 to X1,X2,XCUR; Y1-300 to Y1,Y2,YCUR
Routine XSTR.PNP.90
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=270 to 630 by 8
	Type @str @int(X1+    300*@cos I),",",nocr
	Type @str @int(Y1+300+300*@sin I),1s,nocr
    Repeat
    Type ';pr 0,150 150,0 -300,0 50,0 ',nocr
    Perform XSTR.ARROW.RD60
    Type '-160,300 -40,0 pu 400,-300 pd 160,300 40,0;',nocr
    X1+300 to X1,X2,XCUR; Y1+450 to Y1,Y2,YCUR
Routine XSTR.PNP.180
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=0 to 360 by 8
	Type @str @int(X1-300+300*@cos I),",",nocr
	Type @str @int(Y1+    300*@sin I),1s,nocr
    Repeat
    Type ';pr -150,0 0,150 0,-300 0,50 ',nocr
    Perform XSTR.ARROW.RU30
    Type '-300,-160 0,-40 pu 300,400 pd -300,160 0,40;',nocr
    X1-450 to X1,X2,XCUR; Y1+300 to Y1,Y2,YCUR
Routine XSTR.PNP.270
    Perform MOVE.TO.POSITION
    Type 'pa',nocr
    Start for I=90 to 450 by 8
	Type @str @int(X1+    300*@cos I),",",nocr
	Type @str @int(Y1-300+300*@sin I),1s,nocr
    Repeat
    Type ';pr 0,-150 -150,0 300,0 -50,0 ',nocr
    Perform XSTR.ARROW.LU60
    Type '160,-300 40,0 pu -400,300 pd -160,-300 -40,0;',nocr
    X1-300 to X1,X2,XCUR; Y1-450 to Y1,Y2,YCUR
Routine XSTR.ARROW.RU30
    Type '-99,-12 31,-60 68,72 -84,-20 18,-36 66,56 ',nocr
    Type '-70,-26 6,-16 64,42 ',nocr
Routine XSTR.ARROW.RU60
    Type '-12,-99 -60,31 72,68 -20,-84 -36,18 56,66 ',nocr
    Type '-26,-70 -16,6 42,64 ',nocr
Routine XSTR.ARROW.LU60
    Type '12,-99 60,31 -72,68 20,-84 36,18 -56,66 ',nocr
    Type '26,-70 16,6 -42,64 ',nocr
Routine XSTR.ARROW.LU30
    Type '99,-12 -31,-60 -68,72 84,-20 -18,-36 -66,56 ',nocr
    Type '70,-26 -6,-16 -64,42 ',nocr
Routine XSTR.ARROW.LD30
    Type '99,12 -31,60 -68,-72 84,20 -18,36 -66,-56 ',nocr
    Type '70,26 -6,16 -64,-42 ',nocr
Routine XSTR.ARROW.LD60
    Type '12,99 60,-31 -72,-68 20,84 36,-18 -56,-66 ',nocr
    Type '26,70 16,-6 -42,-64 ',nocr
Routine XSTR.ARROW.RD60
    Type '-12,99 -60,-31 72,-68 -20,84 -36,-18 56,-66 ',nocr
    Type '-26,70 -16,-6 42,-64 ',nocr
Routine XSTR.ARROW.RD30
    Type '-99,12 31,60 68,-72 -84,20 18,36 66,-56 ',nocr
    Type '-70,26 6,16 64,-42 ',nocr
Routine CKT.GROUND
    Perform MOVE.TO.POSITION
    Type 'pr pu -100,0 pd 200,0 ',nocr
    Type 'pu -25,-40 pd -150,0 ',nocr
    Type 'pu 25,-40 pd 100,0 ',nocr
    Type 'pu -25,-40 pd -50,0 ',nocr
    Type 'pu 25,-40 pd pu;',nocr
    X1 to X2,XCUR; Y1-160 to Y1,Y2,YCUR
Routine LINE
    Perform MOVE.TO.POSITION
    Type 'pa ',@str(X2),',',@str(Y2),';',nocr
    X2 to X1,XCUR; Y2 to Y1,YCUR
Routine CONNEC.0
    Perform MOVE.TO.POSITION
    Type 'pr -100,-100 100,100 -100,100 100,-100;',nocr
Routine DOT.1
    Perform MOVE.TO.POSITION, DOT.PATTERN
    X1 to XCUR; Y1 to YCUR
Routine DOT.2
    Type 'papu',@str X2,',',@str Y2,'pd;',nocr if X2#XCUR or Y2#YCUR
    Perform DOT.PATTERN
    X2 to X1,XCUR; Y2 to Y1,YCUR
Routine DOT.PATTERN
    Type 'pr 0,7 -7,0 0,-14 14,0 0,22 -22,0 0,-30 ',nocr
    Type '30,0 0,30 -15,-15;',nocr
Routine RESISTOR.0
    Perform MOVE.TO.POSITION
    Type 'pr 20,0 30,60 60,-120 60,120 60,-120 ',nocr
    Type '60,120 60,-120 30,60 20,0;',nocr
    X1+400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine RESISTOR.90
    Perform MOVE.TO.POSITION
    Type 'pr 0,20 -60,30 120,60 -120,60 120,60 ',nocr
    Type '-120,60 120,60 -60,30 0,20;',nocr
    X1 to X2,XCUR; Y1+400 to Y1,Y2,YCUR
Routine RESISTOR.180
    Perform MOVE.TO.POSITION
    Type 'pr -20,0 -30,-60 -60,120 -60,-120 ',nocr
    Type '-60,120 -60,-120 -60,120 -30,-60 -20,0;',nocr
    X1-400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine RESISTOR.270
    Perform MOVE.TO.POSITION
    Type 'pr 0,-20 60,-30 -120,-60 120,-60 -120,-60 ',nocr
    Type '120,-60 -120,-60 60,-30 0,-20;',nocr
    X1 to X2,XCUR; Y1-400 to Y1,Y2,YCUR
Routine DIODE.0
    Perform MOVE.TO.POSITION
    Type 'pr 100,0 0,-100 0,200 0,-100 ',nocr
    Type '200,-100 0,200 -200,-100 10,0 ',nocr
    Start for DX=1 to 18
        Type '10,0 ',nocr
        Type '0,',@str(5*DX),' 0,',@str(-10*DX),1s,nocr
        Type '0,',@str(5*DX),1s,nocr
    Repeat
    Type '110,0;',nocr
    X1+400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine DIODE.90
    Perform MOVE.TO.POSITION
    Type 'pr 0,100 100,0 -200,0 100,0 ',nocr
    Type '100,200 -200,0 100,-200 0,10 ',nocr
    Start for DY=1 to 18
        Type '0,10 ',nocr
        Type @str(5*DY),',0 ',@str(-10*DY),',0 ',nocr
        Type @str(5*DY),',0 ',nocr
    Repeat
    Type '0,110;',nocr
    X1 to X2,XCUR; Y1+400 to Y1,Y2,YCUR
Routine DIODE.180
    Perform MOVE.TO.POSITION
    Type 'pr -100,0 0,100 0,-200 0,100 ',nocr
    Type '-200,100 0,-200 200,100 -10,0 ',nocr
    Start for DX=1 to 18
        Type '-10,0 ',nocr
        Type '0,',@str(5*DX),' 0,',@str(-10*DX),1s,nocr
        Type '0,',@str(5*DX),1s,nocr
    Repeat
    Type '-110,0;',nocr
    X1-400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine DIODE.270
    Perform MOVE.TO.POSITION
    Type 'pr 0,-100 -100,0 200,0 -100,0 ',nocr
    Type '-100,-200 200,0 -100,200 0,-10 ',nocr
    Start for DY=1 to 18
        Type '0,-10 ',nocr
        Type @str(5*DY),',0 ',@str(-10*DY),',0 ',nocr
        Type @str(5*DY),',0 ',nocr
    Repeat
    Type '0,-110;',nocr
    X1 to X2,XCUR; Y1-400 to Y1,Y2,YCUR
Routine ZENER.0
    Perform MOVE.TO.POSITION
    Type 'pr 100,0 0,-100 40,-20 -40,20 0,200 ',nocr
    Type '-40,20 40,-20 0,-100 200,-100 0,200 -200,-100 10,0 ',nocr
    Start for DX=1 to 18
        Type '10,0 ',nocr
        Type '0,',@str(5*DX),' 0,',@str(-10*DX),1s,nocr
        Type '0,',@str(5*DX),1s,nocr
    Repeat
    Type '110,0;',nocr
    X1+400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine ZENER.90
    Perform MOVE.TO.POSITION
    Type 'pr 0,100 100,0 20,40 -20,-40 -200,0 ',nocr
    Type '-20,-40 20,40 100,0 100,200 -200,0 100,-200 0,10 ',nocr
    Start for DY=1 to 18
        Type '0,10 ',nocr
        Type @str(5*DY),',0 ',@str(-10*DY),',0 ',nocr
        Type @str(5*DY),',0 ',nocr
    Repeat
    Type '0,110;',nocr
    X1 to X2,XCUR; Y1+400 to Y1,Y2,YCUR
Routine ZENER.180
    Perform MOVE.TO.POSITION
    Type 'pr -100,0 0,100 -40,20 40,-20 0,-200 ',nocr
    Type '40,-20 -40,20 0,100 -200,100 0,-200 200,100 -10,0 ',nocr
    Start for DX=1 to 18
        Type '-10,0 ',nocr
        Type '0,',@str(5*DX),' 0,',@str(-10*DX),1s,nocr
        Type '0,',@str(5*DX),1s,nocr
    Repeat
    Type '-110,0;',nocr
    X1-400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine ZENER.270
    Perform MOVE.TO.POSITION
    Type 'pr 0,-100 -100,0 -20,-40 20,40 200,0 ',nocr
    Type '20,40 -20,-40 -100,0 -100,-200 200,0 -100,200 0,-10 ',nocr
    Start for DY=1 to 18
        Type '0,-10 ',nocr
        Type @str(5*DY),',0 ',@str(-10*DY),',0 ',nocr
        Type @str(5*DY),',0 ',nocr
    Repeat
    Type '0,-110;',nocr
    X1 to X2,XCUR; Y1-400 to Y1,Y2,YCUR
Routine BATTERY.MC.0
    Perform MOVE.TO.POSITION
    Type 'pr 50,0 0,100 0,-200 0,100 pu ',nocr
    Start for DX=1 to 2
	Type '100,0 pd 0,50 -10,0 0,-100 10,0 0,50 pu ',nocr
	Type '100,0 pd 0,100 0,-200 0,100 pu ',nocr
    Repeat
    Type '100,0 pd 0,50 -10,0 0,-100 10,0 0,50 50,0;',nocr
    X1+600 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine BATTERY.MC.90
    Perform MOVE.TO.POSITION
    Type 'pr 0,50 -100,0 200,0 -100,0 pu ',nocr
    Start for DY=1 to 2
        Type '0,100 pd -50,0 0,-10 100,0 0,10 -50,0 pu ',nocr
        Type '0,100 pd -100,0 200,0 -100,0 pu ',nocr
    Repeat
    Type '0,100 pd -50,0 0,-10 100,0 0,10 -50,0 0,50;',nocr
    X1 to X2,XCUR; Y1+600 to Y1,Y2,YCUR
Routine BATTERY.MC.180
    Perform MOVE.TO.POSITION
    Type 'pr -50,0 0,100 0,-200 0,100 pu ',nocr
    Start for DX= 1 to 2
        Type '-100,0 pd 0,50 10,0 0,-100 -10,0 0,50 pu',nocr
        Type '-100,0 pd 0,100 0,-200 0,100 pu ',nocr
    Repeat
    Type '-100,0 pd 0,50 10,0 0,-100 -10,0 0,50 -50,0;',nocr
    X1-600 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine BATTERY.MC.270
    Perform MOVE.TO.POSITION
    Type 'pr 0,-50 -100,0 200,0 -100,0 pu ',nocr
    Start for DY=1 to 2
        Type '0,-100 pd -50,0 0,10 100,0 0,-10 -50,0 pu ',nocr
        Type '0,-100 pd -100,0 200,0 -100,0 pu ',nocr
    Repeat
    Type '0,-100 pd -50,0 0,10 100,0 0,-10 -50,0 0,-50;',nocr
    X1 to X2,XCUR; Y1-600 to Y1,Y2,YCUR
Routine CAPACITOR.0
    Perform MOVE.TO.POSITION
    Type 'pr 100,0 0,-100 10,0 0,200 -10,0 0,-100 pu;pa ',nocr
    Start for I=180 to 210 by 6
	Type @str @int(X1+400+200*@cos I),",",nocr
	Type @str @int(Y1+    200*@sin I),1s,nocr
	Type 'pd ',nocr if I=180
    Repeat
    Start for I=210 to 150 by -6
	Type @str @int(X1+400+190*@cos I),",",nocr
	Type @str @int(Y1+    190*@sin I),1s,nocr
    Repeat
    Start for I=150 to 180 by 6
	Type @str @int(X1+400+200*@cos I),",",nocr
	Type @str @int(Y1+    200*@sin I),1s,nocr
    Repeat
    Type ';pr 200,0;',nocr
    X1+400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine CAPACITOR.90
    Perform MOVE.TO.POSITION
    Type 'pr 0,100 100,0 0,10 -200,0 0,-10 100,0 pu;pa ',nocr
    Start for I=270 to 300 by 6
	Type @str @int(X1+    200*@cos I),",",nocr
	Type @str @int(Y1+400+200*@sin I),1s,nocr
	Type 'pd ',nocr if I=270
    Repeat
    Start for I=300 to 240 by -6
	Type @str @int(X1+    190*@cos I),",",nocr
	Type @str @int(Y1+400+190*@sin I),1s,nocr
    Repeat
    Start for I=240 to 270 by 6
	Type @str @int(X1+    200*@cos I),",",nocr
	Type @str @int(Y1+400+200*@sin I),1s,nocr
    Repeat
    Type ';pr 0,200;',nocr
    X1 to X2,XCUR; Y1+400 to Y1,Y2,YCUR
Routine CAPACITOR.180
    Perform MOVE.TO.POSITION
    Type 'pr -100,0 0,100 -10,0 0,-200 10,0 0,100 pu;pa ',nocr
    Start for I=0 to 30 by 6
	Type @str @int(X1-400+200*@cos I),",",nocr
	Type @str @int(Y1+   +200*@sin I),1s,nocr
	Type 'pd ',nocr if I=0
    Repeat
    Start for I=30 to -30 by -6
	Type @str @int(X1-400+190*@cos I),",",nocr
	Type @str @int(Y1+    190*@sin I),1s,nocr
    Repeat
    Start for I=330 to 360 by 6
	Type @str @int(X1-400+200*@cos I),",",nocr
	Type @str @int(Y1+    200*@sin I),1s,nocr
    Repeat
    Type ';pr -200,0;',nocr
    X1-400 to X1,X2,XCUR; Y1 to Y2,YCUR
Routine CAPACITOR.270
    Perform MOVE.TO.POSITION
    Type 'pr 0,-100 -100,0, 0,-10 200,0 0,10 -100,0 pu;pa ',nocr
    Start for I=90 to 120 by 6
	Type @str @int(X1+    200*@cos I),",",nocr
	Type @str @int(Y1-400+200*@sin I),1s,nocr
	Type 'pd ',nocr if I=90
    Repeat
    Start for I=120 to 60 by -6
	Type @str @int(X1+    190*@cos I),",",nocr
	Type @str @int(Y1-400+190*@sin I),1s,nocr
    Repeat
    Start for I=60 to 90 by 6
	Type @str @int(X1+    200*@cos I),",",nocr
	Type @str @int(Y1-400+200*@sin I),1s,nocr
    Repeat
    Type ';pr 0,-200;',nocr
    X1 to X2,XCUR; Y1-400 to Y1,Y2,YCUR
Routine AND.0
    Perform MOVE.TO.POSITION
    Type 'prpu 400,0pd;pa',nocr
    Start for I=360 to 270 by -6
        Type @str @int(X1+200+200*@cos I),',',nocr
        Type @str @int(Y1+    200*@sin I),1s,nocr
        Type 'pd',nocr if I=360
    Repeat
    Type ';pr-200,0 0,400 200,0;pa',nocr
    Start for I=90 to 0 by -6
        Type @str @int(X1+200+200*@cos I),',',nocr
        Type @str @int(Y1+    200*@sin I),1s,nocr
    Repeat
    Type ';',nocr
    X1+400 to X1,X2,XCUR; Y1 to Y2,YCUR
INITIAL
    -1 to XCUR,YCUR
DETAIL
    Type "P.7 in left stall, P.3 in right stall, type <CR> when ready",nocr
    Accept @string
    Perform SELECT.PLOTTER
    Type "in;",@esc,".I80;;17:",@esc,".N;19:",nocr
    Type "sp2;vs20;",nocr

600 to x1; 800 to x2; 1100 to y1,y2; perform connec.0, line, resistor.0
1350 to x2; perform line, xstr.npn.0
2000 to y2; perform line, resistor.90
6000 to y2; perform line, dot.2
800 to y1; 600 to y2; perform line, ckt.ground

2200 to x1,x2; 6000 to y1; 5800 to y2; perform dot.1, line, zener.270
5200 to y2; perform line, resistor.270
4200 to y2; perform line, resistor.270
3600 to y2; perform line, ckt.ground

2600 to x2; 4500 to y1,y2; perform dot.1, line, xstr.npn.0
5400 to y2; perform line, resistor.90
6000 to y2; perform line, dot.2
4200 to y1; 3600 to y2; perform line, ckt.ground

3200 to x2; 5000 to y1,y2; perform dot.1, line, resistor.0
3750 to x2; perform line, xstr.pnp.0
4200 to y2; perform line, resistor.270
2800 to y2; perform line, ckt.ground
5300 to y1; 6000 to y2; perform line, dot.2

5000 to x2; 4400 to y1,y2; perform dot.1, line
4200 to y2; perform line, resistor.270
3400 to y2; perform line, capacitor.270
2800 to y2; perform line, ckt.ground

4600 to x2; 3600 to y1,y2; perform dot.1, line
1900 to y2; perform line
5500 to x2; perform line
1800 to x1; 1700 to y1,y2; perform dot.1, line
4200 to x1; 3800 to x2; 4400 to y1,y2; perform line
1800 to y2; perform line
5500 to x2; perform line, and.0

6400 to x2; perform line, resistor.0
7200 to x2; perform line, xstr.npn.0
2600 to y2; perform line, resistor.90
6000 to y2; perform line, dot.2
1500 to y1; 1200 to y2; perform line, ckt.ground
5700 to x1,x2; 6000 to y1; 2000 to y2; perform dot.1, line
1600 to y1; 1200 to y2; perform line, ckt.ground

6200 to x1,x2; 6000 to y1; 5400 to y2; perform dot.1, line, zener.270
4000 to y2; perform line, resistor.270
3400 to y2; perform line, ckt.ground

6550 to x2; 4500 to y1, y2; perform dot.1, line, xstr.npn.0
5000 to y2; perform line, resistor.90
5550 to y2; perform line, xstr.pnp.90
9400 to x2; perform line, connec.0
6700 to x1; 1000 to x2; perform line, connec.0
7000 to x1,x2; 4200 to y1; 3400 to y2; perform line, ckt.ground

8200 to x1,x2; 6000 to y1; 5400 to y2; perform dot.1, line, capacitor.270
4000 to y2; perform line, ckt.ground

9000 to x1,x2; 6000 to y1; 5400 to y2; perform dot.1, line, resistor.270
4800 to y2; perform line, battery.mc.270
4000 to y2; perform line, ckt.ground

7650 to x1; 9400 to x2; 2400 to y1,y2; perform dot.1, line, connec.0

Type 'pu;',nocr

!-------------------- legends

Type 'si.14,.2;',nocr

Type 'pa300,5950;lb+5V PWR',@chr 3,nocr

Type 'pa300,1050;cp0,.8;lb__',@chr 3,'pa300,1050;lbCE',nocr
Type @cr,@cr,@cr,'from 74LS138,',@cr,'74LS154, etc.',@chr 3,nocr

Type 'pa900,1400;lbR1',@cr,'1K',@chr 3,nocr
Type 'pa2050,1200;lbQ1',@cr,'2N2369',@chr 3,nocr
Type 'pa1950,2250;lbR2',@cr,'1K',@chr 3,nocr

Type 'pa2400,5700;lbD1',@cr,'1N5230',@cr,'4.7V',@chr 3,nocr
Type 'pa2350,5050;lbR3',@cr,'1K',@chr 3,nocr
Type 'pa2350,4050;lbR4',@cr,'10K',@chr 3,nocr

Type 'pa3200,5650;lbR5',@cr,'10K',@chr 3,nocr
Type 'pa3350,4800;lbR6',@cr,'1K',@chr 3,nocr
Type 'pa3150,4100;lbQ2',@cr,'2N2369',@chr 3,nocr

Type 'pa4450,5100;lbQ3',@cr,'2N2907',@chr 3,nocr
Type 'pa4350,4050;lbR7',@cr,'1K',@chr 3,nocr
Type 'pa5150,4050;lbR8',@cr,'10K',@chr 3,nocr
Type 'pa5200,3250;lbC1',@cr,'1 uF',@chr 3,nocr

Type 'pa3900,2100;lbP.D.',@chr 3,nocr
Type 'pa4700,2100;lbP.U.',@chr 3,nocr
Type 'pa5800,1500;lbIC1',@cr,'74LS11',@chr 3,nocr
Type 'si.075,.15;',nocr
Type 'pa5350,1920;lb 9',@chr 3,nocr
Type 'pa5350,1820;lb10',@chr 3,nocr
Type 'pa5350,1720;lb11',@chr 3,nocr
Type 'pa5600,1520;lb7',@chr 3,nocr
Type 'pa5940,1820;lb8',@chr 3,nocr
Type 'pa5550,2020;lb14',@chr 3,nocr
Type 'si.14,.2;',nocr

Type 'pa6400,5300;lbD2',@cr,'1N5230',@cr,'4.7V',@chr 3,nocr
Type 'pa6350,3850;lbR9',@cr,'10K',@chr 3,nocr
Type 'pa6500,2100;lbR11',@cr,'1K',@chr 3,nocr

Type 'pa7250,6250;lbQ5',@cr,'2N3906',@chr 3,nocr
Type 'pa7150,5250;lbR10',@cr,'820',@chr 3,nocr
Type 'pa7100,4100;lbQ4',@cr,'2N3904',@chr 3,nocr

Type 'pa7800,2850;lbR12',@cr,'1K',@chr 3,nocr
Type 'pa7900,1900;lbQ6',@cr,'2N2369',@chr 3,nocr

Type 'pa8400,5300;lbC2',@cr,'1 uF',@cr,'TANT.',@chr 3,nocr
Type 'pa9150,5250;lbR13',@cr,'270',@chr 3,nocr
Type 'pa9200,4650;lbB1',@cr,'2.6V',@cr,'NiCd',@chr 3,nocr

Type 'pa9500,5950;lbVcc MEM',@chr 3,nocr
Type 'pa9500,2350;cp0,.8;lb__',@chr 3,nocr
Type 'pa9500,2350;lbCS  MEM',@chr 3,nocr

!-------------------- notes

Type 'si.1,.2;',nocr
Type 'pa7600,650;lbFile: SCHEM.BBC',@chr 3,nocr
Type 'pa7075,450;lbNOTES:',@chr 3,nocr
Type 'pa7600,450;lbAll resistors 1/4 W, 5%',@cr,nocr
Type 'Zeners are 5% (alt. 1N750)',@cr,nocr
Type 'Battery is Saft/Gould CS1602 w/lugs',@chr 3,nocr

!-------------------- borders

Type 'sp1;vs20',nocr
Type 'si.4,1;',nocr
Type 'pa750,7000;lbBattery Backup Circuit Detail',@chr 3,nocr
Type 'si.2,.4;',nocr
Type 'pa8400,7300;lbTHAD FLORYAN',@cr,'May/June 1983',@chr 3,nocr
Type 'pa0,0pd0,7650 10300,7650 10300,0 0,0pu',nocr
Type '0,6600pd10300,6600pu10300,600pd7000,600 7000,0pu;',nocr

    Type "pu;sp;ip;sc;pa0,7650;",nocr
    Perform SELECT.TERMINAL
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM SNOWFALL2				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.SNOWFALL
! Special effect for graphics scene.  Also demonstrates ANSI reverse index.
!
DECLARE
    I, i,2
    J, i,2
PROCESS
    Routine SNOWFLAKES.ARE.DANCING  !Assume starting from VT100 mode
        Type @ESC+"7"+@ESC+"[?4h"+@ESC+"[;23r"+@ESC+"[2J",nocr
        Type @ESC+"[?5l",nocr ! Dark background
        Start for J=1 to 75
            Type @ESC+"[1;"+@STR(@INT(@RANDOM*75))+"H*",nocr for I=1 to 3
            Type @ESC+"M",nocr
        Repeat
        Type @ESC+"[H"+@RPT(@ESC+"M",23),nocr
        Type @ESC+"[?5h",nocr ! Light background
	Type @ESC+"[?4l",nocr ! Jump scroll
        Type @ESC+"[;24r"+@ESC+"8",nocr
DETAIL
    Perform SNOWFLAKES.ARE.DANCING
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM STDDEV				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.STDDEV  Demonstrates the standard deviation calculation
!
DECLARE
    INPUT,  C,20
    NUM.OF, I, 3
    SUM.OF, N, 7, 2
    SUM.SQ, N, 7, 2
    V,      N, 7, 2
    STDDEV, N, 7, 2
DETAIL
    Type "STANDARD DEVIATION CALCULATION (MACHINE METHOD)",@CR
    Start
	Start:2; Type "<",NUM.OF+1@"","> ",nocr; Accept INPUT
	    Leave:2 if @LTRIM INPUT begins with "*"
	    @NVAL INPUT to V       ; NUM.OF + 1 to NUM.OF
	    SUM.OF + V to SUM.OF   ; V * V + SUM.SQ to SUM.SQ
	    If:5 NUM.OF > 1
	    @SQRT((SUM.SQ - (SUM.OF*SUM.OF/NUM.OF))/(NUM.OF - 1)) to STDDEV
        Repeat:2
	Type "STD DEV = ", STDDEV@"5Z.20D"
        Type @CR,"Another? ",nocr; Accept INPUT
	Leave if @LTRIM INPUT does not begin with "Y"
	Type; 0 to NUM.OF, SUM.OF, SUM.SQ, STDDEV
    Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM TALK					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM BBOX.TALK     speak using Votrax and Black Box

DECLARE
  CBUF,        C, 80
  PORT.SELECT, Bb, 8
  SAVE.DELIM,  C,  1

PROCESS

Routine SELECT.TERMINAL  ! Black Box port A
  \o37 to PORT.SELECT; Transmit byte from PORT.SELECT
  1    to PORT.SELECT; Transmit byte from PORT.SELECT

Routine SELECT.VOICE  ! Black Box port B
  \o37 to PORT.SELECT; Transmit byte from PORT.SELECT
  2    to PORT.SELECT; Transmit byte from PORT.SELECT

Routine PSEND.ON  ! Transmit phoneme codes from Votrax
  Perform SELECT.VOICE
  Transmit ascii from @ESC + @CHR 17
  Perform SELECT.TERMINAL

Routine PSEND.OFF ! Queue and speak phoneme codes
  Perform SELECT.VOICE
  Transmit ascii from @ESC + @CHR 18
  Perform SELECT.TERMINAL

Routine INIT.VOTRAX ! Resets, then turns ECHO OFF, TIMER OFF, CAPS ON
  Type "Initializing the Votrax ..."; Perform SELECT.VOICE
  Transmit ascii from @ESC + @CHR 24
  Receive ascii to CBUF wait 1 second ! Gobble any garbage
  Transmit ascii from @ESC+@CHR 20 + @ESC+@CHR 23 + @ESC+@CHR 21
  Receive ascii to CBUF wait .75 seconds ! Gobble any garbage
  Perform SELECT.TERMINAL; Type "Done."

DETAIL

  Perform INIT.VOTRAX
  @DELIM to SAVE.DELIM; @CHR \o177 to @DELIM ! allow "," in user-input
  Start
    Type @CR,@PM.NAME@"",">",nocr; Accept CBUF; Leave if CBUF=1S
    Perform SELECT.VOICE; Type 1S, CBUF@""; Perform SELECT.TERMINAL
  Repeat
  SAVE.DELIM to @DELIM
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM TALKGREET				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM BBOX.TALK     speak using Votrax and Black Box from a database

CONTROL

  Relate DS TALKGREET as NAMES for input

DECLARE
  CBUF,        C, 80
  PORT.SELECT, Bb, 8
  HIGH.TOP,    C,  3
  HIGH.BOTTOM, C,  3
  WIDE,        C,  3
  NORMAL,      C,  3

PROCESS

Routine SELECT.TERMINAL  ! Black Box port A
  \o37 to PORT.SELECT; Transmit byte from PORT.SELECT
  1    to PORT.SELECT; Transmit byte from PORT.SELECT

Routine SELECT.VOICE  ! Black Box port B
  \o37 to PORT.SELECT; Transmit byte from PORT.SELECT
  2    to PORT.SELECT; Transmit byte from PORT.SELECT

Routine PSEND.ON  ! Transmit phoneme codes from Votrax
  Perform SELECT.VOICE
  Transmit ascii from @ESC + @CHR 17
  Perform SELECT.TERMINAL

Routine PSEND.OFF ! Queue and speak phoneme codes
  Perform SELECT.VOICE
  Transmit ascii from @ESC + @CHR 18
  Perform SELECT.TERMINAL

Routine INIT.VOTRAX ! Resets, then turns ECHO OFF, TIMER OFF, CAPS ON
  Type "Initializing the Votrax ..."; Perform SELECT.VOICE
  Transmit ascii from @ESC + @CHR 24
  Receive ascii to CBUF wait 1 second ! Gobble any garbage
  Transmit ascii from @ESC+@CHR 20 + @ESC+@CHR 23 + @ESC+@CHR 21
  Receive ascii to CBUF wait .75 seconds ! Gobble any garbage
  Perform SELECT.TERMINAL; Type "Done."

Routine SAY.IT
  Perform SELECT.VOICE; Type 1S, CBUF@""; Perform SELECT.TERMINAL

INITIAL

  @ESC + "#3" to HIGH.TOP
  @ESC + "#4" to HIGH.BOTTOM
  @ESC + "#5" to NORMAL
  @ESC + "#6" to WIDE

DETAIL

  Perform INIT.VOTRAX

  type @ESC+"[H"+@ESC+"[J"

  "welcome to NIS" to CBUF; Perform SAY.IT
  Type HIGH.TOP,    @CENTER("Welcome to NIS!", 40)
  Type HIGH.BOTTOM, @CENTER("Welcome to NIS!", 40),@CR,@CR

  sleep 3 seconds

  Start
    Get next from NAMES hush
    Leave if @AUX # "YES"
    phone.name:NAMES to CBUF; Perform SAY.IT
    Type WIDE, @CENTER(ascii.name:NAMES, 40), @CR, @CR
    sleep 4 seconds
  Repeat
END
!!This "end" was inserted by			! **REBUILDER CODE**
HOLD						! **REBUILDER CODE**
STOP						! **REBUILDER CODE**
TYPE "(Note: PM TALKGREET has not been saved in executable form because"
TYPE "it was not executable prior to using CM FLATTEN.)"
DEFINE PM TESTSCROLL				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
transmit ascii from @esc+"[H"+@esc+"[JThis is line 1"
transmit ascii from @esc+"[22HThis is line 22"
transmit ascii from @esc+"[2HScroll line #2"
transmit ascii from @esc+"[3HScroll line #3"
transmit ascii from @esc+"[4HScroll line #4"
transmit ascii from @esc+"[2;21r"+@esc+"[2H"
transmit ascii from @rpt(@esc+"M",10)
transmit ascii from @esc+"[21H"
transmit ascii from @rpt(@esc+"D",10)
transmit ascii from @esc+"[1;24r"
transmit ascii from @esc+"[21H"
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM TIMESTAMP				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
DECLARE
   Event.Stamp,    N, max
   Event.Date,     F
   Event.Time,     I, 6
   Event.Hour,     I, 2
   Event.Minute,   I, 2, PP="DD"
   Event.Second,   I, 2, PP="DD"
   Event.MSec,     I, 3, PP="DDD"
DETAIL

!   accept event.stamp  ! 19861225.52426839 produces "12/25/1986  12:34:56.789"

   @TIME.STAMP                                  to Event.Stamp

   @DVAL @STR @IFIX Event.Stamp                 to Event.Date
   86400000.*(Event.Stamp - @IFIX(Event.Stamp)) to Event.Time
   Event.Time   mod 3600000                     to Event.Minute
   Event.Time    /  3600000                     to Event.Hour
   Event.Minute mod   60000                     to Event.Second
   Event.Minute  /    60000                     to Event.Minute
   Event.Second mod    1000                     to Event.Msec
   Event.Second  /     1000                     to Event.Second
   Type @DATSTR Event.Date,2s,nocr
   Type Event.Hour,":",Event.Minute,":",Event.Second,".",Event.Msec
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM UDT					! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.UDT
!----------------------------------------------------------------------
!
! ACCENT-R Technical Note  -  Universal Date & Time
!
! by Thad Floryan, 13-Mar-1981
!
!----------------------------------------------------------------------
!
! This PM illustrates some of the capabilities of the new functions
! supporting UDT (Smithsonian Astronomical Universal Date-Time standard)
! and how they may be used effectively in many accounting applications.
!
! These functions require ACCENT version 6.11 or later.
!
!----------------------------------------------------------------------
!
! Description of the functions:
!
!     @UDT
!
!          This function returns as its integer value the present UDT.
!          The UDT value represents both the number of days since the
!          base date Nov.17,1858 and the time as a fractional part of
!          a day with respect to GMT (Greenwich Mean Time).  On the
!          DECsystem computers the time resolution is approximately
!          1/3 of a second.
!
!          The UDT value from @UDT ideally serves as a "date & time"
!          stamp to be placed in data records.  A field destined to
!          receive a UDT value should be declared "I,12" in an ASCII
!          SD and should be declared "BI,12" in a binary SD, GS or a
!          PM's DECLARE section.  Displaying the stored value is not
!          meaningful; the @UDTSTR function is designed for converting
!          UDT values to a readable form.
!
!
!     @MAKUDT ( date.value , hours.value )
!     @MAKUDT ( date.expression , hours.expression )
!
!          This function returns as its integer value a UDT representing
!          the given date and time.  The date.value is a normal ACCENT-R
!          date such as the values from @DATE, @DVAL, @CAL or @MAKDAT.
!          The hours.value is usually expressed as the hour of the day
!          and a fractional part thereof.  For example, 8:30 AM would be
!          expressed as 8.5, 12 noon as 12 or 12.0 and 5:45 PM as 17.75.
!
!          The range of dates and times that may be created are from
!          17-Nov-1858 00:00:00 thru 27-Sep-2217 23:59:59.  Attempting
!          to create a UDT value outside that range results in a UDT
!          either of 17-Nov-1858 00:00:00 or 27-Sep-2217 23:59:59.
!
!          Note that an hours.value less than zero or >= 24 will change
!          the date accordingly.
!
!          Note also that @MAKUDT can facilitate applications requiring
!          date and time arithmetic.  For example, to add 3 1/2 hours to
!          a UDT value, one can do:
!
!                    udt.value + @MAKUDT( @NODATE , 3.5 )
!
!          Using @NODATE as the base date in the above example causes
!          @MAKUDT to create a value representing only a fractional part
!          of a day.  Likewise, to add one day to a UDT value the usage:
!
!                    udt.value + @MAKUDT( @NODATE , 24 )
!
!          will operate correctly.  Again, attempting to extend beyond
!          the bounds of a proper UDT value will result in either the
!          lower or higher bounds as the value.
!
!
!     @UDTSTR udt.value
!     @UDTSTR( udt.value.expression )
!
!          This function returns as its string value a 20-character
!          string of the form "dd-mmm-yyyy hh:mm:ss".  The date and
!          time values are with respect to the time zone recorded in
!          the system field @TIME.ZONE.  @TIME.ZONE is initialized by
!          ACCENT when it starts up and normally need not be changed.
!          The value in @TIME.ZONE reflects the time displacement as
!          hours west to east of GMT (from 12 to -12 respectively).
!          On some DECsystems the local time zone value may not be
!          available and will thus be recorded as zero; in this case
!          the UDT values will not be strictly correct but all use of
!          UDT values on that system will be correct with one another.
!
!
!     @UDTHRS udt.value.difference
!     @UDTHRS( udt.value.difference.expression )
!
!          This function returns as its `BN' value the number of hours
!          represented by the "udt.value.difference".  The difference
!          value is normally the result of subtracting one UDT value
!          from another, as in the example of subtracting a beginning
!          UDT value from an ending UDT value deriving the elapsed time.
!          Note that the returned value will have the same sign as the
!          input value; to make subsequent operations easier, you should
!          subtract a smaller value (e.g. `earlier' UDT) from a larger
!          value so that the difference is positive.  Note that due to
!          the 1/3 second time resolution on DECsystems, there may be a
!          slight apparent error when the difference value is displayed.
!
!----------------------------------------------------------------------
!
DECLARE SECTION

     UDT.1, I, max    ! arbitrary beginning UDT value
     UDT.2, I, max    ! arbitrary ending UDT value
     DIFF,  I, max    ! difference between UDT.1 and UDT.2
     HRS,   N,  8, 5  ! hours difference

!----------------------------------------------------------------------

DETAIL SECTION

    @UDT to UDT.1          ! Get the present UDT value
    UDT.1 + 12345 to UDT.2 ! Form an "ending" value for this example.
                           ! The arbitrary adding of 12345 is just to
                           ! create a value for UDT.2 that is different
                           ! from the value of UDT.1 in the examples.
    UDT.2 - UDT.1 to DIFF  ! Calculate the difference
    @UDTHRS DIFF to HRS    ! Get the hours difference to simplify some
                           ! of the examples below.

    Type @CR, "The two UDT's we're using in these examples are:",@CR
    Type 10s, @UDTSTR UDT.1, "   and   ", @UDTSTR UDT.2

    Type @CR, "Now let's type out some `fancy' derivations:",@CR

    Type 10s, "The days difference is:    ", HRS/24   @"5-.4D"
    Type 10s, "The hours difference is:   ", HRS      @"5-.4D"
    Type 10s, "The minutes difference is: ", HRS*60   @"5-.4D"
    Type 10s, "The seconds difference is: ", HRS*3600 @"5-.4D"

    Type @CR, "Now for some `accounting-style' information:", @CR

    Type 10s, "   ", @UDTSTR UDT.2, " LOGOFF"
    Type 10s, " - ", @UDTSTR UDT.1, " LOGON"
    Type 10s, 30"="
    Type 10s, "   ", @IFIX   HRS               @"14-", ":", nocr
    Type             @IFIX ( HRS*60   MOD 60 ) @"DD", ":", nocr
    Type             @INT  ( HRS*3600 MOD 60 ) @"DD",@CR

    Type 10s, "Note there probably is no error in the `seconds' column"
    Type 10s, "even though the fractional `seconds difference' in the"
    Type 10s, "first group of examples is significant; reduction using"
    Type 10s, "@INT instead of @IFIX or @TRUNC can minimize the printed"
    Type 10s, "discrepancies for critical applications."

    Type @CR, "Now adding 25 1/2 hours to the first UDT illustrating ",nocr
    Type      "the simplicity",@CR, "of UDT date and time arithmetic:",@CR

    Type 10s, "   ", @UDTSTR UDT.1
    Type 10s, " + ", 12s, "25:30:00", @CR, 10s, 23"="
    Type 10s, "   ", @UDTSTR ( UDT.1 + @MAKUDT ( @NODATE , 25.5 ) )

    Type @CR, "Now creating a UDT for April 15, 1981 5:32:24 PM ",nocr
    Type      "showing the effect",@CR,"of the expression:",@CR
    Type 10s, '@MAKUDT( @DVAL"4-15-81", 17. + 32/60. + 24/3600. )',@CR
    Type 10s, @UDTSTR @MAKUDT(@DVAL"4-15-81",17.+32/60.+24/3600.)
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM UDTCONVERT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
!
! APPLICATION NOTE EXAMPLE                                   Aug.28, 1987  TF
!
!
!              CONVERTING A UDT VALUE TO AN ACCENT DATE VALUE
!
!                              TWO METHODS
!
DECLARE

  UDT.VALUE,   I,max     ! UDT value to adjust
  ADATE,       D         ! Converted UDT value

  ZONE.ADJUST, I,max     ! Time zone correction to local time from GMT
  DAY.DIVISOR, I,max     ! Divisor for converting UDT.VALUE to the number of
                         ! days since November 17, 1858

  YY,          C, 11     ! temp working string
  DATESTRING,  C,  8     ! String form of converted date, method 2

PROCESS
Routine Convert.UDT

! Method 1  (TPF)
!
  @MAKUDT(@NODATE, @TIME.ZONE) to ZONE.ADJUST
  @MAKUDT(@NODATE, 24)         to DAY.DIVISOR

  ! Note: 678940 is the number of days from Jan.1,0000 to Nov.17,1858
  !
  ! NOTE: need to add 16382 for VAX (WHY???)
  !
@NODATE + (678940 +16382 + (UDT.VALUE - ZONE.ADJUST)/DAY.DIVISOR) DAYS to ADATE

! Method 2 (APS)
!
  @LEFT(@UDTSTR UDT.VALUE, 11) to YY
  @STR(@INDEX('XXJANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC',@UC @SUBSTR(YY,4,3))/3)&
      + "/" + @LEFT(YY,2) + "/" + @RIGHT(YY,2) to DATESTRING

DETAIL

  @UDT to UDT.VALUE
  Perform Convert.UDT
  Type @UDTSTR(UDT.VALUE), " = ", ADATE, " = ", DATESTRING

END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM VT100CHAR				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.VT100CHAR  Displays the different character sets
!
DECLARE
    I,I,max
PROCESS
    Routine DO.CHAR.SET
        Transmit ascii from @CR + @ESC + "[10C"
        Transmit ascii from @CHR I + 1s for I=32 to  63 ! space thru ?
        Transmit ascii from @CR + @ESC + "[10C"
        Transmit ascii from @CHR I + 1s for I=64 to  95 ! @ thru _
        Transmit ascii from @CR + @ESC + "[10C"
        Transmit ascii from @CHR I + 1s for I=96 to 126 ! ` thru ~
        Transmit ascii from @CR
    Routine SET_VT100
	if @system.type = "VAX/VMS" and @terminal.index # 96
	    96 to @terminal.index
	    transmit ascii from @ESC+"<"	! set terminal type to VT100
	orif @system.type = "DEC-20"  and @terminal.index # 16
	    16 to @terminal.index
	    transmit ascii from @ESC+"<"	! set terminal type to VT100
	continue

DETAIL

    Perform SET_VT100

    Transmit ascii from @ESC+">"+@ESC+"[?1l" !normal keypad and cursor keys
    Transmit ascii from @ESC+"[2J"+@ESC+"[H"        ! erase screen, set pos.

    Transmit ascii from @ESC+"#6VT100 char set A:"  ! G0 to select set A
    Transmit ascii from @ESC+"(A"+@CHR (@ASC "O" - \o100)
    Perform DO.CHAR.SET

    Transmit ascii from @ESC+"#6VT100 char set B:"  ! G0 to select set B
    Transmit ascii from @ESC+"(B"+@CHR (@ASC "O" - \o100)
    Perform DO.CHAR.SET

    Transmit ascii from @ESC+"(B"+@CHR (@ASC "O" - \o100)
    Transmit ascii from @ESC+"#6VT100 char set 0:"  ! G0 to select set 0
    Transmit ascii from @ESC+"(0"+@CHR (@ASC "O" - \o100)
    Perform DO.CHAR.SET

    Transmit ascii from @ESC+"(B"+@CHR (@ASC "O" - \o100)
    Transmit ascii from @ESC+"#6VT100 char set 1:"  ! G0 to select set 1
    Transmit ascii from @ESC+"(1"+@CHR (@ASC "O" - \o100)
    Perform DO.CHAR.SET

    Transmit ascii from @ESC+"(B"+@CHR (@ASC "O" - \o100)
    Transmit ascii from @ESC+"#6VT100 char set 2:"  ! G0 to select set 2
    Transmit ascii from @ESC+"(2"+@CHR (@ASC "O" - \o100)
    Perform DO.CHAR.SET

    Transmit ascii from @ESC+"(B"+@ESC+")0"         ! select character sets
    Transmit ascii from @CHR (@ASC "O" - \o100)     ! ^O set (G0) (ASCII)
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM VT100TEST				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PM.VT100TEST  Displays graphic character set and all video attributes
!
DECLARE
    I,I,max
PROCESS
    Routine SET.NORMAL
        Transmit ascii from @ESC+"[m"
    Routine SET.BOLD
        Transmit ascii from @ESC+"[;1m"
    Routine SET.UNDERSCORE
        Transmit ascii from @ESC+"[;4m"
    Routine SET.BLINK
        Transmit ascii from @ESC+"[;5m"
    Routine SET.REVERSE
        Transmit ascii from @ESC+"[;7m"
    Routine ADD.BOLD
        Transmit ascii from @ESC+"[1m"
    Routine ADD.UNDER
        Transmit ascii from @ESC+"[4m"
    Routine ADD.BLINK
        Transmit ascii from @ESC+"[5m"
    Routine ADD.REVERSE
    Transmit ascii from @ESC+"[7m"
Routine SAVE.POSATT
    Transmit ascii from @ESC+"7"
Routine REST.POSATT
    Transmit ascii from @ESC+"8"
Routine DO.SEQUENCE
    Perform SAVE.POSATT
    Perform REST.POSATT;             Transmit ascii from @ESC+"[02C"+"test"
    Perform REST.POSATT,ADD.BOLD;    Transmit ascii from @ESC+"[08C"+"test"
    Perform REST.POSATT,ADD.UNDER;   Transmit ascii from @ESC+"[14C"+"test"
    Perform REST.POSATT,ADD.BLINK;   Transmit ascii from @ESC+"[20C"+"test"
    Perform REST.POSATT,ADD.REVERSE; Transmit ascii from @ESC+"[26C"+"test"
    Perform REST.POSATT,ADD.BOLD,ADD.UNDER
                                     Transmit ascii from @ESC+"[32C"+"test"
    Perform REST.POSATT,ADD.BOLD,ADD.BLINK
                                     Transmit ascii from @ESC+"[38C"+"test"
    Perform REST.POSATT,ADD.BOLD,ADD.REVERSE
                                     Transmit ascii from @ESC+"[44C"+"test"
    Perform REST.POSATT,ADD.UNDER,ADD.BLINK
                                     Transmit ascii from @ESC+"[50C"+"test"
    Perform REST.POSATT,ADD.UNDER,ADD.REVERSE
                                     Transmit ascii from @ESC+"[56C"+"test"
    Perform REST.POSATT,ADD.BLINK,ADD.REVERSE
                                     Transmit ascii from @ESC+"[62C"+"test"
    Perform REST.POSATT,ADD.BOLD,ADD.UNDER,ADD.REVERSE
                                     Transmit ascii from @ESC+"[68C"+"test"
    Perform REST.POSATT,ADD.BOLD,ADD.BLINK,ADD.UNDER,ADD.REVERSE
                                     Transmit ascii from @ESC+"[74C"+"test"
    Transmit ascii from @CR+@LF

Routine SET_VT100
    if @system.type = "VAX/VMS" and @terminal.index # 96
	96 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    orif @system.type = "DEC-20"  and @terminal.index # 16
	16 to @terminal.index
	transmit ascii from @ESC+"<"	! set terminal type to VT100
    continue

DETAIL
    Perform SET_VT100

    Transmit ascii from @ESC+">"+@ESC+"[?1l" !normal keypad and cursor keys
    Transmit ascii from @ESC+"(B"+@ESC+")0"         ! select character sets
    Transmit ascii from @CHR (@ASC "O" - \o100)     ! ^O set (G0) (ASCII)

    Transmit ascii from @ESC+"[2J"+@ESC+"[2;8H"     ! erase screen, set pos.
    Transmit ascii from @ESC+"7"+@ESC+"#3VT100 Compatible Graphics"+@ESC+"8"
    Transmit ascii from @LF +    @ESC+"#4VT100 Compatible Graphics"+@CR+@LF

    Transmit ascii from @CHR (@ASC "O" - \o100)+10s ! ^O set (G0) (ASCII)
    Transmit ascii from @CHR I + 1s for I=96 to 126 ! `  thru  ~
    Transmit ascii from @CR+@LF

    Transmit ascii from @CHR (@ASC "N" - \o100)+10s ! ^N set (G1) (graphics)
    Transmit ascii from @CHR I + 1s for I=96 to 126 ! `  thru  ~
    Transmit ascii from @CR

    Transmit ascii from @CHR (@ASC "O" - \o100)     ! ^O set (G0) (ASCII)

    Transmit ascii from @ESC+"[10;10H"     ! set position
    Transmit ascii from @ESC+"7"+@ESC+"#3VT100 Video Attributes"+@ESC+"8"
    Transmit ascii from @LF +    @ESC+"#4VT100 Video Attributes"+@CR+@LF

    Perform SET.NORMAL,     DO.SEQUENCE
    Perform SET.BOLD,       DO.SEQUENCE
    Perform SET.UNDERSCORE, DO.SEQUENCE
    Perform SET.BLINK,      DO.SEQUENCE
    Perform SET.REVERSE,    DO.SEQUENCE

    Perform SET.NORMAL
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DEFINE PM WRITEPLOT				! **REBUILDER CODE**
INSERT						! **REBUILDER CODE**
! PLOT.PM    Model for plot driving
!
DECLARE
    PORT, BB, 8, occurs 2
    ltext,c,80
    save.delim,c,1
PROCESS
Routine SELECT.TERMINAL  ! Black Box port A
    31 to PORT(1); 1 to PORT(2); Transmit byte from PORT
Routine SELECT.PLOTTER   ! Black Box port C
    31 to PORT(1); 3 to PORT(2); Transmit byte from PORT
DETAIL
    @delim to save.delim; @chr \o177 to @delim
    Perform SELECT.PLOTTER
    Transmit ascii from "in;"+@esc+".I80;;17:"+@esc+".N;19:sp1;vs10;pa;di0,-1;"
    Start
        Perform SELECT.TERMINAL
	type "Character size in cm (width,height): ",nocr; accept ltext
        leave if ltext=""
	Perform SELECT.PLOTTER
	Transmit ascii from "si"+@rtrim ltext+";"
	start:5
            Perform SELECT.TERMINAL
	    Type "Position pen, type text <CR>: ",nocr; accept ltext
	    leave:5 if ltext=""
	    Perform SELECT.PLOTTER
	    transmit ascii from "lb"
            if:10   ltext ends with "|"
                    transmit ascii from @left(ltext,@len(ltext)-1)+@chr 3+"CP;"
            orif:10 ltext ends with "\"
                    transmit ascii from @left(ltext,@len(ltext)-1)+@chr 3
                    transmit ascii from "CP-"+@str(@len(ltext)-1)+",0;"
            else:10 transmit ascii from ltext+@chr 3
	repeat:5
    repeat
    Perform SELECT.PLOTTER
    Transmit ascii from "sp;ip;sc;pa0,7650;"
    Perform SELECT.TERMINAL
    save.delim to @delim
END
!!This "end" was inserted by			! **REBUILDER CODE**
SAVE    BUT HOLD AND STOP ON ERROR		! **REBUILDER CODE**

DONE						! **REBUILDER CODE**