github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-07 00:47:06 +00:00
Code Issues Releases Wiki Activity

New text functions added to MIGS.

Browse Source
This commit is contained in:
Lars Brinkhoff
2021-12-13 15:17:23 +01:00
parent a73b2dff03
commit a6ab4a346a
3 changed files with 102 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/rrs/swchar.urs007
View File

Binary file not shown.

75
src/rrs/swchar.urs016 → src/rrs/swchar.urs017
View File

@@ -1,6 +1,6 @@
<PACKAGE "SWCHAR">
<ENTRY CHARGE MCHARG SHEAR SWTEXT>
<ENTRY CHARGE MCHARG SHEAR SWTEXT SWTXT2 SWTXT3>
<USE "SMCELLS">
<USE "DISPLA">
<BLOCK (<GET IDISPLA OBLIST> <ROOT>)>
@@ -1817,16 +1817,6 @@
<SET S <+ .S .SP>>
<COND (<G? .S 1000> <SET S 0> <SET T <- .T 25>>)>>>
<DEFINE SWTEXT (STR "OPT" (X 0) (Y 500) (SP 12) )
#DECL ((STR) STRING (X Y SP ) FIX (VALUE) ATOM)
<REPEAT ((S .X) (T .Y) (ST .STR) CHR)
#DECL ((S T)FIX (ST) STRING (CHR) CHARACTER)
<COND (<EMPTY? .ST> <RETURN ,NULL>)
(T <SET CHR <1 .ST>>)>
<CHARGE .CHR .S .T>
<SET S <+ .S .SP>>
<COND (<G? .S 1000> <SET S 0> <SET T <- .T 25>>)>
<SET ST <REST .ST>> >>
<DEFINE CHARGE (CHAR X Y "OPTIONAL" (SIZE 1.0) "AUX" (CHARS ,CHARS))
@@ -1843,6 +1833,69 @@
<SCALE .SIZE>
<XLATE .X .Y>>>
<DEFINE SWTEXT (STR "OPT" (X 0) (Y 500) (SP 12) )
#DECL ((STR) STRING (X Y SP ) FIX (VALUE) ATOM)
<REPEAT ((S .X) (T .Y) (ST .STR) CHR)
#DECL ((S T)FIX (ST) STRING (CHR) CHARACTER)
<COND (<EMPTY? .ST> <RETURN ,NULL>)
(T <SET CHR <1 .ST>>)>
<CHARGE .CHR .S .T>
<SET S <+ .S .SP>>
<COND (<G? .S 1000> <SET S 0> <SET T <- .T 25>>)>
<SET ST <REST .ST>> >>
<DEFINE SWTXT2 (STR "OPT" (X 0) (Y 500) (SP 12)
"AUX" (LX .X) (LY .Y) (YSP 25) )
#DECL ((STR) STRING (X Y SP YSP) FIX (VALUE) ATOM)
<REPEAT ((S .X) (T .Y) (ST .STR) CHR)
#DECL ((S T)FIX (ST) STRING (CHR) CHARACTER)
<COND (<EMPTY? .ST> <RETURN ,NULL>)
(T <SET CHR <1 .ST>>)>
<COND (<==? .CHR <ASCII 13>> <SET S .LX>)
(<==? .CHR <ASCII 10>> <SET T <- .T .YSP>>)
(T <CHARGE .CHR .S .T>)>
<SET S <+ .S .SP>>
<COND (<G? .S 1000> <SET S 0> <SET T <- .T .YSP>>)>
<SET ST <REST .ST>> >>
<DEFINE SWTXT3 (STR ;"INPUT TEXT STRING"
"OPT" (X 0) (Y 500) (SP 12)
"AUX" (LX .X) (LY .Y) (YSP 25) )
#DECL ((STR) STRING (X Y SP YSP) FIX (VALUE) ATOM)
<REPEAT ((S .X) (T .Y) (ST .STR) CHR)
#DECL ((S T)FIX (ST) STRING (CHR) CHARACTER)
<COND (<EMPTY? .ST> <RETURN ,NULL>)
(T <SET CHR <1 .ST>>)>
<COND (<==? .CHR <ASCII 13>> <SET S .LX>) ;"CR HANDLER "
(<==? .CHR <ASCII 10>> <SET T <- .T .YSP>>) ;"LF HANDLER"
(<==? .CHR <ASCII 09>> ;"TAB HANDLER"
<SET S <+ .S <* .SP <TB2SP .S>>> >) ;" INC S BY WIDTH OF N SPACES"
(T <CHARGE .CHR .S .T>)>
<SET S <+ .S .SP>>
<COND (<G? .S 1000> <SET S 0> <SET T <- .T .YSP>>)>
<SET ST <REST .ST>> >>
<SETG SPCTAB 4> ;"SPACES PER TAB"
<DEFINE TB2SP (CRP "AUX" (SPCTAB ,SPCTAB))
#DECL((VALUE SPCTAB CRP NSP) FIX)
;" calculate number of spaces needed to the
; reach the next tab postion"
<SET NSP <- .SPCTAB <MOD .CRP .SPCTAB>>> >
<SETG TSTSTR "THIS IS A TEST OF
MULT-LINE TEXT
ABC DEF GHI JKL MNO PQR STU VWX YZ
0 1 2 3 4">
<SETG TSTSTR2 "THIS IS A TEST OF
MULT-LINE TEXT
ABC DEF GHI JKL MNO PQR STU VWX YZ
0 1 2 3 4">
<BLOCK ( !.OBLIST <GET IDISPLA OBLIST>)>
<SET 3DSTK ('T)>;"COMPILER CAUSED KLUDGE"