PDP-10 Archive: utilities/crock.mid from SRI_NIC_PERM_SRC_3

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/crock.mid

There is 1 other file named crock.mid in the archive. Click here to see a list.

	; Original program hacked up by GLS
	; 10X/20X version hacked by KLH.

.symtab 4000.,4000.	; Necessary until true 20X MIDAS made.

TITLE CROCK

IFE .OSMIDAS-SIXBIT/ITS/, os%its==1 ? os%tnx==0
  .else os%its==0 ? os%tnx==1
ifn os%tnx,[	; If TNX and nothing specified, assume SRI-KL.
	ifndef srikl, ifndef srika, srikl==1
	ifndef srikl, srikl==0
	ifndef srika, srika==0
]
ife os%its,[	; if not ITS, can't use ^P codes.  Must define
		; terminal type explicitly.
	t%vt52==1		; For VT52
]
ifndef t%hz15, t%hz15==0	; Hazeltine 1500
ifndef t%dm25, t%dm25==0
ifndef t%vt52, t%vt52==0

	; ACC DEFINITIONS

H=1	;HOURS IN 6-DEGREE UNITS - Don't change this assignment!
M=H+1	;MINUTES (don't change these either)
S=M+1	;SECONDS

B=4	;OUTPUT BUFFER POINTER
HC=5	;HORIZ CURSOR POS
VC=6	;VERT CURSOR POS
;R=7	; now unused.
T=10	;TEMP
TT=11	;TEMP
Q=12	;HOLDS 3-BIT BYTE FROM SOME HAND
C=13	;POINTS TO INSTR TO FETCH CHAR
A=14	;AOBJN PTR FOR TESTING OVERWRITE
Z=15	;AOBJN PTR FOR SAVING UP NEW DATA
N=16	;BYTE PTR FOR LOADING Q
P=17	; PDL ptr

TTYC=17	;TTY OUTPUT channel

ifn os%tnx, oldmod:	0

pdl:	-40,,pdl
	block 40

GO:	move p,pdl	; set up PDL
ifn os%its,[
	.OPEN TTYC,[%tjdis+.uao,,'tty]
	 .VALUE
]
ife os%its,[
ifn t%dm25,[
	movei	1, .cttrm
	gttyp
ifn srikl, caie	2,5	; see if datamedia. (.TTDM symbol not def yet)
ifn srika, caie 2,14
	 jrst	[hrroi	1, [asciz /?Currently works only on datamedias/]
		 psout
		 haltf
		 jrst	.+1]	; If continued, go ahead.
] ; ifn t%dm25
	movei 1,.priin
	rfmod
	movem 2,oldmod	; save old status
	trz 2,tt%dam	; set to 8-bit i/o
	sfmod		; zap

]
	; Output initial clock picture
	move 2,[440700,,ibuf]	; bp to cruft
ifn os%its,[
	movei 3,libuf		; cnt of bytes (pos)
	.call [setz ? sixbit /siot/ ? 1000,,ttyc
		2 ? setz 3]
	 .value
]
ifn os%tnx,[
	movni 3,libuf		; TNX has it backwards - negative cnt
	movei 1,.priou
;	pushj p,cpsout		; Perform SOUT simulation for ^P codes
	sout
]
	SETOM OLDH
	SETOM OLDM
	SETOM OLDS
	SETZB H,M
	SETZB S,HPOSH
	MOVE T,[HPOSH,,HPOSH+1]
	BLT T,EPOS

	; Start a new clock picture here
LOOP:
ifn os%its,[		; Get ITS time into H,M,S
	.RTIME TT,
IRPC X,,[HMS]
	ROTC T,6
	TRZ T,777760
	IMULI T,10.
	MOVEI X,(T)
	ROTC T,6
	TRZ T,777760
	ADDI X,(T)
TERMIN
]
ifn os%tnx,[		; Get TNX time into H,M,S (must be 1,2,3!)
	seto 2,		; get current time
	setz 4,		; with no funny daylight savings or timezone stuff
	odcnv		; get time
	movei h,(4)	; get # secs since midnite into H (from RH of 4)
	idivi h,60.*60.	; get # hours in 1
	idivi m,60.	; get # mins in 2, # secs in 3
]
	MOVEI T,(H)
	IDIVI T,12.
	MOVEI H,(TT)
	IMULI H,5
	MOVEI T,(M)
	IDIVI T,12.
	ADDI H,(T)
	MOVE B,[440700,,BUF]
IRPC X,,[HMS]
	CAMN X,OLD!X
	 JRST FOO!X	; no need to draw anything
	SKIPGE T,OLD!X
	 JRST BAR!X	; if neg, skip erasing (first-time)
	MOVE C,[5+.IRPCNT,,CHKILL]
	MOVE A,X!PTR
	SETZ Z,
	PUSHJ P,DRAW
BAR!X:	MOVEI T,(X)
	MOVE C,[5+.IRPCNT,,X!CHAR]
	MOVE A,X!PTR
	MOVE Z,PTR!X
	PUSHJ P,DRAW
	MOVEM X,OLD!X
FOO!X:
TERMIN
	move 2,b
	subi 2,buf	; get bp rel to start of buffer
	muli 2,5	; set up for...
	add 3,uadbp7(2)	; finding # chars in buffer.
	caile 3,lbufch	; make sure it didn't exceed bounds
	 ifn os%its, .value
	 ifn os%tnx, jrst 4,

	; Now before outputting, make sure user hasn't typed anything.
ifn os%its, .LISTEN T,     ? SKIPE T
ifn os%tnx, movei 1,.priin ? sibe
	 jrst die	; Input buff not empty, go die.

	; No input, go ahead and chunk the stuff out!
	jumpe 3,slptic		; Unless of course nothing to output.
	move 2,[440700,,buf]	; BP for output
ifn os%its,[
	.call [setz ? sixbit /siot/ ? 1000,,ttyc
		2 ? setz 3]
	 .value
]
ifn os%tnx,[
	movni 3,(3)		; Get neg count
	movei 1,.priou
;	pushj p,cpsout		; simulate SOUT for ^P codes.
	sout
]

	; Now sleep for one second before looping again.
slptic:
ifn os%its, MOVEI TT,30 ? .SLEEP TT,
ifn os%tnx, movei 1,1000. ? disms

	JRST LOOP

die:
ifn os%its, .BREAK 16,140000
ifn os%tnx,[
	movei 1,.priou	; Before halting, move to bottom of screen.
ifn t%dm25, hrroi 2,[.byte 7 ? ^L ? 0#140 ? 23.#140 ? ^M ? 0]
ifn t%hz15, hrroi 2,[.byte 7 ? 176 ? ^Q ? 140 ? 23.+140 ? ^M ? 0]
ifn t%vt52, hrroi 2,[.byte 7 ? 33 ? "Y ? 40+23. ? 40 ? ^M ? 0]
	setz 3,
	sout
	movei 1,.priin
	move 2,oldmod
	sfmod		; Restore old modes
	haltf
]

; Super hairy hand drawer.
; Inputs are:
; T - value (0-59) of hand to draw
; C - points to instr to fetch char
; A - aobjn ptr for testing overwrite, from HPTR, MPTR, or SPTR.
; Z - 0 if erasing, else aobjn ptr for saving up new data.(PTRH,PTRM, or PTRS)
; B - BP to deposit stuff in buffer (7-bit)
; Other acs used are:
;  N - BP for loading Q
;  Q - 3-bit byte from HANDnn tables
;  HC - Horiz cursor pos, plus 8
;  VC - Vert cursor pos, plus 8

DRAW:	SETOM OLDHC	; zap old cursor positions so always move first thing.
	SETOM OLDVC
	MOVEI HC,10+20.	; desired cursor pos begins at center of clock.
	MOVEI VC,10+11.
	IDIVI T,15.	; Find quadrant hand is in (0,1,2,3 clockwise)
	TRNE T,1	; if in quad 1 or 3,
	 MOVNI TT,-15.(TT) ; set remainder to mirror image of that for 0 or 2
	MOVE N,HANDTB(TT)	; using remainder, get proper hand-slope.

	; Loop once for each hand position.
DRAW9:	ILDB Q,N	; Get 1st byte of hand
	XCT VINCR(T)	; add or subtract vertical movement by Q positions.
	ILDB Q,N	; get 2nd byte,
	XCT HINCR(T)	; add or subtract horiz movement by Q positions.
	ILDB Q,N	; now check 3rd byte of position
	CAIGE Q,5	; Is it a special marker?
	 JRST DRAW0	; No, go continue hacking normally.

	; Special marker seen in hand description, check it
	HLRZ TT,C	; get type of hand being done
	CAIE TT,(Q)	; If same, we've hit end of road for this hand.
	 JRST DRAW9	; not same, continue drawing hand.

	; Stop drawing hand.
	JUMPGE Z,APOPJ	; if erasing or all positions covered, done - return.
	SETOM (Z)	; else must zap remaining positions in
	SETOM POSX(Z)	; POSH and POSV tables.
	AOBJN Z,.-2
APOPJ:	POPJ P,

	; Output a char of the hand in current HC,VC cursor position if safe.
DRAW0:	JUMPE A,DRAW2	;If ptr to overwrite table 0, don't bother checking.
	MOVE TT,A	; Else must check, get copy for munging in TT.
DRAW1:	CAMN HC,(TT)	; current X matches anything in table?
	 CAME VC,POSX(TT) ; if X matches, does Y also match?  If both do match,
	  CAIA
	   JRST DRAW9	; then this position occupied already! Don't write.
	AOBJN TT,DRAW1

	; Safe, can actually output char.
DRAW2:
ifn os%its,[
IRPC W,,[HV]
	CAMN W!C,OLD!W!C
	 JRST QUUX!W
	MOVEI TT,^P
	IDPB TT,B
	MOVEI TT,"W
	IDPB TT,B
	IDPB W!C,B
	MOVEM W!C,OLD!W!C
QUUX!W:
TERMIN
]
ifn os%tnx,[
	camn hc,oldhc		; see if either different from old.
	 came vc,oldvc
	  caia			; one of them different, must send coords
	   jrst quuxv		; Nope, same, can skip positioning.

	; Must send new coords, HC and VC.  Note that these are +8 !!
	movem hc,oldhc	; Save old
	movem vc,oldvc

ifn t%dm25,[
	movei tt,^L	; dm2500 abs move
	idpb tt,b
	movei tt,-10(hc)	; move to scratch reg, flushing +8 lossage.
	trc tt,140
	idpb tt,b
	movei tt,-10(vc)
	trc tt,140
	idpb tt,b
]
ifn t%hz15,[		; H1500 abs move
	movei tt,176	; leadin
	idpb tt,b
	movei tt,^Q
	idpb tt,b
	movei tt,(hc)
	caige tt,40
	 addi tt,140
	idpb tt,b
	movei tt,140(vc)
	idpb tt,b
]
ifn t%vt52,[
	movei tt,33
	idpb tt,b
	movei tt,"Y
	idpb tt,b
	movei tt,40-10(vc)	; move to scratch reg, flushing +8 lossage.
	idpb tt,b
	movei tt,40-10(hc)
	idpb tt,b
]
quuxv:
]
	AOS OLDHC	; always bump horiz pos since output will move cursor.
	XCT (C)		; Get appropriate char for this hand.
	 JRST ZAPZAP	; If it skips, means char should be killed...
ifn os%its,[		; This stuff actually only needed for terms
	MOVEI TT,^P	; that can overprint.
	IDPB TT,B
	MOVEI TT,"K
	IDPB TT,B
]
	MOVEI TT,40	; for other non-overprinting terms, a space suffices.
ZAPZAP:	IDPB TT,B	; store output char (at long last)
	JUMPGE Z,DRAW9	; if erasing or hit end of table, don't remember pos.
	MOVEM HC,(Z)	; otherwise do remember it - save new H pos
	MOVEM VC,POSX(Z) ; and V pos
	AOBJN Z,DRAW9	; and bump down table count and draw another char
	POPJ P,		; unless out of room.

	; Table for quickly deriving char addr of a BP
	133500,,0	; to handle -5 produced by 440700
	repeat 4,0
UADBP7:	-54300,,5
	-104300,,4
	-134300,,3
	-164300,,2
	-214300,,1


OLDH:	0
OLDM:	0
OLDS:	0
OLDHC:	0
OLDVC:	0

CHKILL:	CAIA
HCHAR:	MOVEI TT,"*
MCHAR:	MOVEI TT,"O
SCHAR:	LDB TT,.+1(Q)	; char used for sec hand is selected by 3rd byte
	350700,,CHARS(T)	; (also depending on quadrant)
	260700,,CHARS(T)
	170700,,CHARS(T)
	100700,,CHARS(T)
	010700,,CHARS(T)

CHARS:	ASCII #I-/',#
	ASCII #I-\,'#
	ASCII #I-/,'#
	ASCII #I-\',#

VINCR:	SUBI VC,(Q)
	ADDI VC,(Q)
	ADDI VC,(Q)
	SUBI VC,(Q)

HINCR:	ADDI HC,(Q)
	ADDI HC,(Q)
	SUBI HC,(Q)
	SUBI HC,(Q)

HPOSH:	BLOCK 12.
MPOSH:	BLOCK 18.
HPOSV:	BLOCK 12.
MPOSV:	BLOCK 18.
EPOS==.-1
POSX==HPOSV-HPOSH

HPTR:	0
MPTR:	-12.,,HPOSH
SPTR:	-30.,,HPOSH

PTRH:	-12.,,HPOSH
PTRM:	-18.,,MPOSH
PTRS:	434343		;ANYTHING >0 IS OKAY!

DEFINE IHACK X
IRPC W,,[X]
IFE "W-"F,	%H==%H+1
IFE "W-"U,	%V==%V-1
IFE "W-"B,	%H==%H-1
IFE "W-"D,	%V==%V+1
IFL "W-"@,[	; Check for doing abs positioning.
ifn os%its, IFN %H-$H,	^P  ?  "H  ?  10+%H
ifn os%its, IFN %V-$V,	^P  ?  "V  ?  10+%V
ifn t%dm25, IFN <%H-$H>\<%V-$V>, ^L ? %H#140 ? %V#140	; Abs positioning
ifn t%vt52, IFN <%H-$H>\<%V-$V>, 33 ? "Y ? %V+40 ? %H+40
ifn t%hz15,[IFN <%H-$H>\<%V-$V>,[
		176 ? ^Q
		ifl %H-40,{140+%H} .else %H
		%V+140]]
	"W
%H==%H+1
$H==%H
$V==%V
]
TERMIN
TERMIN

$H==-1
$V==-1
%H==0
%V==0

	; Cruft sent out to terminal at initial startup.
IBUF:
.BYTE 7		; First thing is to clear screen
ifn os%its,	^P  ?  "C
ifn t%dm25,	^^ ? ^^		; twice required at 9600 baud
ifn t%vt52,	33 ? "H ? 33 ? "J
ifn t%hz15,	176 ? 34
	IHACK [FFFFFFFFF11F,F,F,F,12F,F,F,F,FF1]
	IHACK [FD'FD'FD'FD'D2BD,BD,BDD'BD'BD3]
	IHACK [BD,BD,BDD'BD'BD4BBD,BBBD,BBBD,BBBD,BBBD5]
	IHACK [BBBB'BBB'BBB'BBB'BBB6BBB'BBB'BBB'BBB'BBBB7]
	IHACK [BBBU,BBBU,BBBU,BBBU,BBU8BU'BU'BUU,BU,BU9]
	IHACK [BU'BU'BUU,BU,BU10BU'FU'FU'FU']
	; Picture done, now one more abs-pos to middle.
ifn os%its,	^P  ?  "H  ?  10+20.  ?  ^P  ?  "V  ?  10+11.
ifn t%dm25,	^L ? 20.#140 ? 11.#140
ifn t%vt52,	33 ? "Y ? 11.+40 ? 20.+40
ifn t%hz15,	176 ? ^Q ? 20.+140 ? 11.+140
	"*

libuf==.bytc	; Get # bytes in initial buffer picture.
.BYTE


DEFINE HAND X
.BYTE 9
IRPS F,G,[X]
	F
IFSE G,",	005
IFSE G,',	006
TERMIN
	007
.BYTE
TERMIN

HANDTB:	440300,,HAND0
	440300,,HAND1
	440300,,HAND2
	440300,,HAND3
	440300,,HAND4
	440300,,HAND5
	440300,,HAND6
	440300,,HAND7
	440300,,HAND8
	440300,,HAND9
	440300,,HAND10
	440300,,HAND11
	440300,,HAND12
	440300,,HAND13
	440300,,HAND14
	440300,,HAND15

HAND0:	HAND 100 100 100 100 100 100"100 100 100'100
HAND1:	HAND 100 100 102 110 100 100"102 110 100'100
HAND2:	HAND 100 102 110 102 110 102"110 102 110'100
HAND3:	HAND 100 112 112 110 102 110"102 110 102'110
HAND4:	HAND 112 112 110 102 112 110"102 112 112'110
HAND5:	HAND 112 112 112 112 112 112"112 112 112'112
HAND6:	HAND 112 112 112 114 013 112 112"114 013 112'112 114
HAND7:	HAND 114 013 112 114 013 112 114 013"112 114 013 112'114 013
HAND8:	HAND 013 114 013 114 013 114 013 114 013 114"013 114 013 114'013 114
HAND9:	HAND 013 112 013 114 013 114 011 013 114 011 013"112 114 011 013 114'011 013
HAND10:	HAND 011 013 114 011 013 114 011 013 114 011 013"114 011 013 114 011 013'114
HAND11:	HAND 011 013 114 011 011 013 114 011 011 013 114"011 011 013 114 011 011'013 114
HAND12:	HAND 011 011 013 114 014 011 011 013 114 014 011"011 013 114 014 011 011'013 114
HAND13:	HAND 011 011 011 013 013 114 014 011 011 011 013"013 114 014 011 011 011'013 013
HAND14:	HAND 011 011 011 011 013 013 013 013 114 014 014"014 011 011 011 011 013'013 013
HAND15:	HAND 011 011 011 011 011 011 011 011 011 011 011"011 011 011 011 011 011'011 011

PATCH:	BLOCK 20
litter:
constants
variables

LBUFCH==<6*20.*7>+20 	; calculated plus 20 chs safety margin.
BUF:	BLOCK <LBUFCH+4>/5

ifn os%its,	-1	; to ensure core loaded.

END GO