114 lines
		
	
	
	
		
			5.1 KiB
		
	
	
	
		
			Groff
		
	
	
	
	
	
			
		
		
	
	
			114 lines
		
	
	
	
		
			5.1 KiB
		
	
	
	
		
			Groff
		
	
	
	
	
	
00025 .PR POINT .PR
 | 
						|
00050 .COMMENT TRANSPUT TEST .COMMENT
 | 
						|
00060 # NEEDS TO BE RUN WITH LARGISH FIELDLENGTH AND REDUCE,- #
 | 
						|
00070 .PR NOGO .PR
 | 
						|
00110 ( .PROC TWOLINES = (.REF.FILE F).VOID: (NEWLINE(F); NEWLINE(F))
 | 
						|
00112       # A USER-WRITTEN LAYOUT ROUTINE #
 | 
						|
00120 ; .LOC.FILE FYLA, FYLB
 | 
						|
00130 ; .STRING S = "THIS IS A VERY LONG STRING AND IT WILL USE MORE THAN ONE LINE"
 | 
						|
00140     " IN FACT IT WILL PROBABLY USE LOTS OF LINES: IT MAY EVEN GO "
 | 
						|
00150     "ONTO MORE THAN ONE PAGE, THEN AGAIN IT MAY NOT. BY GUM THIS "
 | 
						|
00160     "IS A VERY LONG STRING; PLEASE STOP WRITING THIS RUBBISH."
 | 
						|
00170 , [].CHAR T = "************************************************************"
 | 
						|
00180 , U = "THIS IS THE END"
 | 
						|
00190 ; .INT K = 9876#54321#
 | 
						|
00192 .COMMENT NOFLOAT
 | 
						|
00200 ; .REAL X = 1234.5E4#100#, Y = 67.89E4#100#
 | 
						|
00210 ; .COMPL Z = (X, Y)
 | 
						|
00212 .COMMENT
 | 
						|
00220 ; .CHAR CHA = ":", CHB = "<"
 | 
						|
00230 ; .BOOL BOOL = .TRUE, BOO = .FALSE
 | 
						|
00240 ; .BITS BIT = 2R111100001110001#10010#
 | 
						|
00250 ; .BYTES BYT = BYTESPACK("BT")
 | 
						|
00252     # #
 | 
						|
00254 ; # TEST OF ASSOCIATE #
 | 
						|
00260     .LOC .FILE FYLX
 | 
						|
00290 ; .INT COLS=30, ROWS=15
 | 
						|
00300 ; .LOC.INT LINENO := 1
 | 
						|
00310 ; .LOC [1:ROWS, 1:COLS].CHAR BUFFER
 | 
						|
00320 ; .PROC CLEAR = (.REF [] .CHAR B).VOID: .FOR I .TO .UPB B .DO B[I] := " " .OD
 | 
						|
00330 ; .LOC [1:COLS].FILE FF
 | 
						|
00340 ; .FOR I .TO COLS
 | 
						|
00350   .DO ASSOCIATE(FF[I], BUFFER[ , I])
 | 
						|
00360     ; ON LINE END(FF[I], (.REF.FILE F).BOOL:
 | 
						|
00370             ( LINENO +:= 1
 | 
						|
00380             ; ( LINENO+1>COLS
 | 
						|
00382               ! (LINENO=COLS ! CLEAR(BUFFER[ , LINENO]))
 | 
						|
00390               ; .FOR I .TO ROWS
 | 
						|
00400                 .DO PUT(STANDOUT, (BUFFER[I, ], NEWLINE)) .OD
 | 
						|
00402               ; NEWLINE(STANDOUT)
 | 
						|
00410               ; NEWPAGE(STANDOUT)
 | 
						|
00420               ; LINENO := 0
 | 
						|
00432               ! CLEAR(BUFFER[ , LINENO])
 | 
						|
00434               )
 | 
						|
00436             ; RESET(FYLX)
 | 
						|
00440             ; FYLX := FF[LINENO+:=1]
 | 
						|
00450             ; CLEAR(BUFFER[ , LINENO])
 | 
						|
00460             ; .TRUE
 | 
						|
00470             ))
 | 
						|
00480   .OD
 | 
						|
00490 ; FYLX := FF[LINENO]
 | 
						|
00500 ; .PROC NEXTLINE = (.REF.FILE F).VOID:
 | 
						|
00510     ( .WHILE SPACE(F); CHAR NUMBER(F)>2 .DO .SKIP .OD
 | 
						|
00512         # UNTIL LINE END EVENT HAS HAPPENED #
 | 
						|
00520     )
 | 
						|
00521 ; PUT(FYLX, (S, NEXTLINE))
 | 
						|
00522 ; .WHILE NEXTLINE(FYLX); LINENO>1 .DO .SKIP .OD
 | 
						|
00523     # UNTIL 'COLS' LINES HAVE BEEN FILLED #
 | 
						|
00524     # #
 | 
						|
00525 ; # TEST ALL OUTTYPES #
 | 
						|
00526   ESTABLISH(FYLA, "FYLA", STANDOUTCHANNEL, 3, 10, 58)
 | 
						|
00527 ; ON PAGE END(FYLA, (.REF.FILE F).BOOL: (NEWPAGE(F); PUT(F, ("CLEAN PAGE", PAGENUMBER(F), NEWLINE)); .TRUE))
 | 
						|
00528 ; ON PHYSICAL FILE END(FYLA, (.REF.FILE F).BOOL: (CLOSE(F); ESTABLISH(F, "FYLB", STANDOUTCHANNEL, 60, 6, 60); .TRUE))
 | 
						|
00530 ; PUT(FYLA, (T, #X, Y, Z,# K, S, NEWLINE)); PUT(FYLA, (BIT, SPACE, BIT, SPACE)); PUT(FYLA, (BYT, CHA, CHB, BOOL, BOO, NEWLINE))
 | 
						|
00540 ; .TO #20#40 .DO PUT(FYLA, BYT) .OD
 | 
						|
00550 ; PUT(FYLA, (NEWPAGE, "DELIBERATE CLEAN PAGE", NEWLINE))
 | 
						|
00560 ; .FOR J .TO 10 .DO PUT(FYLA, (J, TWOLINES)) .OD
 | 
						|
00562     # SHOULD CHANGE TO "FYLB" IN THE MIDDLE OF HERE #
 | 
						|
00570 ; ( .LOC.INT I := 0
 | 
						|
00580   ; .LOC.FILE FYLC := FYLA
 | 
						|
00590   ; ON LINE END(FYLC, (.REF.FILE F).BOOL: (NEWLINE(F); PUT(F, (WHOLE(I+:=1, -3), SPACE)); .TRUE))
 | 
						|
00600   ; PUT(FYLC, (NEWLINE, T, S, NEWLINE, T))# LINES SHOULD BE NUMBERED #
 | 
						|
00610   ; .FOR J .TO 6 .DO PUT(FYLA, (J, K)) .OD # LINES SHOULD NOT BE NUMBERED #
 | 
						|
00620   )
 | 
						|
00630 ; PUT(FYLA, U)
 | 
						|
00640 ; NEWPAGE(FYLA)
 | 
						|
00641     # #
 | 
						|
00642 ; # READ BACK CONTENTS OF "FYLA" #
 | 
						|
00650   OPEN(FYLB, "FYLA", STANDINCHANNEL)
 | 
						|
00660 ; .LOC[1:60].CHAR TT, .LOC.STRING SS, ST, #.LOC.REAL XX, YY, .LOC.COMPL ZZ,# .LOC.INT KK
 | 
						|
00670 , .LOC.BITS BITBIT, .LOC.BYTES BYTBYT, .LOC.CHAR CHACHA, CHBCHB, .LOC.BOOL BOOLBOOL, BOOBOO
 | 
						|
00671 .COMMENT NOFLOAT
 | 
						|
00672 ; .PRIO .NEQ = 4
 | 
						|
00674 ; .OP .NEQ = (.REAL A, B).BOOL:
 | 
						|
00675     ( A/=0.0!.ABS((A-B)/A)>SMALLREAL*2!B/=0.0)
 | 
						|
00676 ; .OP .NEQ = (.COMPL A, B).BOOL:
 | 
						|
00677     RE .OF A .NEQ RE .OF B .OR IM .OF A .NEQ IM .OF B
 | 
						|
00678 .COMMENT
 | 
						|
00680 ; ON PAGE END(FYLB, (.REF.FILE F).BOOL: (NEWPAGE(F); GET(F, SS); PRINT((NEWLINE, SS, NEWLINE)); NEWLINE(F); .TRUE))
 | 
						|
00690 ; ON LOGICAL FILE END(FYLB, (.REF.FILE F).BOOL: (PRINT(("""FYLA"" READ BACK OK", NEWLINE)); GET(F, CLOSE); .GOTO CLOSED))
 | 
						|
00700 ; GET(FYLB, (TT,# XX, YY, ZZ,# KK))
 | 
						|
00702 ; .FOR I .TO 60 .DO .IF TT[I]/=T[I] .THEN SQRT(-1) .FI .OD
 | 
						|
00710 ; ( .LOC.FILE FYLC := FYLB
 | 
						|
00720   ; ON LINE END(FYLC, (.REF.FILE F).BOOL: (NEWLINE(F); .TRUE))
 | 
						|
00730   ; MAKE TERM(FYLC, ".")
 | 
						|
00740   ; GET(FYLC, SS)
 | 
						|
00750   ; GET(FYLC, (CHACHA, ST))
 | 
						|
00760   ; .IF S /= SS+CHACHA+ST+"." .THEN SQRT(-1) .FI
 | 
						|
00780   )
 | 
						|
00790 ; GET(FYLB, (NEWLINE, BITBIT, BITBIT, SPACE)); GET(FYLB, (BYTBYT, CHACHA, CHBCHB, BOOLBOOL, BOOBOO, NEWLINE))
 | 
						|
00798 .COMMENT NOFLOAT
 | 
						|
00800 ; .IF XX.NEQ X.OR YY.NEQ Y.OR ZZ.NEQ Z.OR KK/=K.OR BITBIT/=BIT.OR BYTBYT/=BYT
 | 
						|
00810         .OR CHACHA/=CHA.OR CHBCHB/=CHB.OR BOOLBOOL/=BOOL.OR BOOBOO/=BOO
 | 
						|
00820   .THEN SQRT(-1)
 | 
						|
00830   .FI
 | 
						|
00832 .COMMENT
 | 
						|
00840 ; .TO #20#40 .DO GET(FYLB, BYTBYT); .IF BYTBYT/=BYT .THEN SQRT(-1) .FI .OD
 | 
						|
00850 ; .FOR J .TO 10
 | 
						|
00860   .DO GET(FYLB, (KK, TWOLINES))
 | 
						|
00870     ; .IF KK/=J .THEN SQRT(-1) .FI
 | 
						|
00872         # SHOULD REACH LOGICAL END OF "FYLA" IN HERE #
 | 
						|
00880   .OD
 | 
						|
00890 ; CLOSED:
 | 
						|
00970     CLOSE(FYLA)
 | 
						|
00990 )
 |