home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.lbl.gov / 2014.05.ftp.ee.lbl.gov.tar / ftp.ee.lbl.gov / mtrek.shar.Z / mtrek.shar / wrthpt.mac < prev    next >
Text File  |  1990-04-02  |  2KB  |  93 lines
  1.     .ENABL    LC
  2.     .TITLE    WRITE
  3.     .IDENT    /MTREK/
  4. ; 
  5. ;    ***  Hewlett Packard 2645A  ***
  6. ;
  7. ;    FORTRAN callable routine to postion the cursor on a crt
  8. ;    terminal and write a string. There is also a routine to
  9. ;    clear the screen.
  10. ; 
  11. ;    Calling sequence:
  12. ; 
  13. ;        CALL WRITE(LINE,ICOL,STRING[,ICNT])
  14. ; 
  15. ;    LINE    Line to position cursor on
  16. ;    ICOL    Column to position cursor on
  17. ;    STRING    String of text to output
  18. ;    ICNT    Optional character count
  19. ;
  20. ;    Calling sequence:
  21. ; 
  22. ;        CALL CLEAR
  23. ; 
  24.     .GLOBL    WRITE,CLEAR
  25.  
  26.     LUN=1            ; LUN FOR QIOS
  27.  
  28. WRITE:    MOV    @2(R5),R1    ; GET LINE POSITION
  29.     DEC    R1        ; ADJUST 1,1 POSTION
  30.     MOV    #LINE,R0    ; LOC OF BUFFER
  31.     MOV    #11012,R2    ; UNSIGNED BASE 10 TWO CHARS WIDE
  32.     CALL    $CBTA        ; GO DO IT
  33.     MOV    @4(R5),R1    ; AND COLUMN POSITION
  34.     DEC    R1        ; ADJUST 1,1 POSTION
  35.     MOV    #COL,R0        ; LOC OF COL BUFFER
  36.     MOV    #11012,R2    ; UNSIGNED BASE 10 TWO CHARS WIDE
  37.     CALL    $CBTA        ; GO DO IT
  38.  
  39.     MOV    6(R5),BUFADR    ; MOVE STRING ADDRESS TO LIST
  40.     CMPB    #4,(R5)        ; CHARACTER COUNT INPUT?
  41.     BEQ    10$        ; BRANCH IF COUNT INPUT
  42.     MOV    #1,BUFARG    ; ONLY ONE ARGUMENT TO FILL
  43.     BR    20$        ; GO DO IT
  44. 10$:    MOV    #2,BUFARG    ; TWO ARGUMENTS TO FILL
  45.     MOV    10(R5),BUFCNT    ; COPY ADDRESS OF COUNT TO LIST
  46. 20$:    MOV    #WRTARG,R5    ; SET UP ARGUMENTS FOR CURSOR
  47.     CALL    FILL        ; AND SEND CURSOR
  48.     MOV    #BUFARG,R5    ; SET UP ARGUMENTS FOR STRING
  49.     TSTB    @2(R5)        ; CHECK FOR ZERO LENGTH STRING
  50.     BEQ    30$        ; BAIL OUT IF ZERO LENGTH
  51.     CALL    FILL        ; AND SEND STRING
  52. 30$:    RETURN            ; AND RETURN
  53. ;
  54. ;    Here is the entry for clear screen
  55. ;
  56. CLEAR:    MOV    #CLRARG,R5    ; SET UP THE ARGUMENTS FOR FILL
  57.     CALL    FILL        ; AND CALL FILL
  58.     RETURN            ; AND RETURN
  59. ;
  60. ;    Here are the argument lists
  61. ;
  62. WRTARG:    .WORD    2        ; NUMBER OF ARGUMENTS TO FILL
  63.     .WORD    WRTSEQ        ; ADDRESS OF CURSOR SEQUENCE
  64.     .WORD    100$        ; CHAR COUNT
  65.     .WORD    0
  66. 100$:    .WORD    WRTNUM
  67.  
  68. BUFARG:    .WORD    0        ; NUMBER OF ARGUMENTS TO FILL
  69. BUFADR:    .WORD    0        ; ADDRESS OF STRING
  70. BUFCNT:    .WORD    0        ; CHAR COUNT
  71.     .WORD    0
  72.  
  73. CLRARG:    .WORD    2        ; NUMBER OF ARGUMENTS TO FILL
  74.     .WORD    CLRSEQ        ; ADDRESS OF CLEAR SCREEN SEQUENCE
  75.     .WORD    200$        ; CHAR COUNT
  76.     .WORD    0
  77. 200$:    .WORD    CLRNUM
  78. ;
  79. ;    Here are the escape sequences
  80. ;
  81.     .NLIST    BIN
  82. CLRSEQ:    .BYTE    33,110,33,'J    ; ESCAPE SEQUENCE TO CLEAR SCREEN
  83. CLRNUM=.-CLRSEQ
  84.  
  85. WRTSEQ:    .BYTE    33,'&,'a    ; ESCAPE SEQUENCE FOR CURSOR POSITION
  86. LINE:    .BLKB    2        ; LINE POSITION
  87.     .BYTE    'r        ; LOWER CASE "R"
  88. COL:    .BLKB    2        ; COLUMN POSITION
  89.     .BYTE    'C        ; UPPERCASE "C"
  90. WRTNUM=.-WRTSEQ
  91.     .EVEN
  92.     .END
  93.