PDP-10 Archive: emacs/dcrock.mid from mit_emacs_170_teco

Trailing-Edge - PDP-10 Archives - mit_emacs_170_teco_1220 - emacs/dcrock.mid

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

; -*-MIDAS-*-

TITLE DIGITAL CROCK

; Original program hacked up by GLS.
; 10X/20X version hacked by EAK.
; Modified by KLH for DM2500's.

if1 {
its==1				; can run on either ITS or
tnx==1				; 10X or 20X
.insrt system
}

; If not ITS, can't use ^P codes.  Must define terminal type explicitly.
ifndef t%its, t%its==its	; ITS ^P codes
ifndef t%hz15, t%hz15==0	; Hazeltine 1500
ifndef t%dm25, t%dm25==0	; Datamedia 2500
ifndef t%vt52, t%vt52==0	; VT52
ifndef t%c100, t%c100==0	; Concept 100
ifn t%its+t%hz15+t%dm25+t%vt52+t%c100-1, .fatal You must specify exactly one terminal type.


; ACs
A=1
B=2
C=3
D=4
E=5
F=6
G=7
H=10
S=14
X=15
Y=16
P=17

call=pushj p,
return=popj p,

ifn its,{
toch=17
.insrt syseng;$call macro
}
ifn 20x,{
TM%DPY=1_35.
VTSOP=JSYS 635
RTMOD=JSYS 636
STMOD=JSYS 637
RTCHR=JSYS 640
}

equals var,.scalar

ifn tnx, var oldmod
lpdl==40
var pdl(lpdl)


dcrock:	move p,[-lpdl,,pdl-1]
ifn its,{
	$call open,[#toch,[sixbit/tty/]][][#%tjdis+.uao]
	 .lose %lsfil
}
ifn tnx,{
	movei a,.priin
	rfmod
	movem b,oldmod		; save old status
	trz b,tt%dam		; set to 8-bit i/o
ifn t%its,{			; VTS
	tro b,1_7		; turn on output translation
}
	sfmod			; zap
ifn t%its,{
	rtmod
	tlo b,(tm%dpy)
	stmod
}
}
ifn its,{
	move a,[440700,,frame]
	movei b,lframe
	.call [	setz ? sixbit /siot/
		1000,,toch ? a ? b ((setz))]
	 .lose %lsfil
}
ifn tnx,{
	movei a,.priou
	hrroi b,frame
	movni c,lframe
	sout
}
	move a,[440700,,ob]
	movem a,obp
	movei a,lob
	movem a,obc
repeat 6, setzm screen+.rpcnt
	seto h,
hackit:
ifn its,{
	.rdtime s,
	.rtime c,
	camn c,h
	 jrst hackit
	move h,c
}
ifn tnx,{
	time
	move s,a
	seto 2,		; get current time
	setz 4,		; with no funny daylight savings or timezone stuff
	odcnv		; get time
	movei a,(d)
	camn a,h
	 jrst hackit
	move h,a
	movei c,0
	idivi a,60.*60.
	call sixn
	move a,b
	idivi a,60.
	call sixn
	move a,b
	call sixn
}
	MOVNI D,6
LOOP:	LSHC B,6
	ANDI B,17
	MOVE E,DIGITS(B)
	MOVE F,E
	EXCH F,SCREEN+6(D)
	XOR F,E
	JUMPE F,NEXT
	MOVNI G,43
CYCLE:	JUMPGE F,NXTBIT
	hlrz x,chpos+43(g)
	add x,horiz+6(d)
	hrrz y,chpos+43(g)
	addi y,4+2
	call movcur
	jumpge e,blank
	movei a,"#
	call outb
	jrst nxtbit
blank:	call clchar
nxtbit:	lshc e,1
	aojl g,cycle
next:	aojl d,loop
	movei y,22.
	movei x,69.
	call movcur
	call force
ifn its,{
	.listen a,
	jumpn a,quit
	addi s,28.
	movn s,s
	.sleep s,
	jrst hackit
}
ifn tnx,{
	movei a,.priin
ife t%vt52,{
	sibe
	 jrst quit
}
ifn t%vt52,{
	sibe
	 jrst [	bin
		caie b,^S
		 jrst quit
;X;		sibe
;X;		 caia
;X;		  jrst quit
		bin
		caie b,^Q
		 jrst quit
		jrst .+1 ]

}
	time
	add a,b
	sub a,s
	jumpl a,hackit
	imuli a,1000.
	idiv a,b
	subi a,7
	disms
	jrst hackit
}

subttl	Output

lob==200.
var ob(<lob+4>/5)
var obp
var obc

outb:	idpb a,obp
	sosg obc
	 call force
	return


subttl	Operating system subroutines

ifn its,{

force:	push p,b
	movei b,lob
	sub b,obc
	jumpe b,for1
	push p,a
	move a,[440700,,ob]
	movem a,obp
	addm b,obc
	$call siot,[#toch,a,b]
	 .lose %lsfil
	pop p,a
for1:	pop p,b
	return


quit:	.logout 1,
}

ifn tnx,{


force:	push p,c
	movei c,lob
	exch c,obc
	subi c,lob
	jumpe c,for1
	push p,a
	push p,b
	movei a,.priou
	move b,[440700,,ob]
	movem b,obp
	sout
	pop p,b
	pop p,a
for1:	pop p,c
	return


quit:	movei x,0
	movei y,23.
	call movcur
	call force
	movei 1,.priin
	move 2,oldmod
	sfmod		; Restore old modes
	haltf
	jrst dcrock


sixn:	push p,a
	push p,b
	idivi a,10.
	lsh c,6
	addi c,'0(a)
	lsh c,6
	addi c,'0(b)
	pop p,b
	pop p,a
	return
}

subttl	Terminal subroutines

movcur:	push p,a
ifn t%its,{
	movei a,^P
	call outb
	movei a,"V
	call outb
	movei a,10(y)
	call outb
	movei a,^P
	call outb
	movei a,"H
	call outb
	movei a,10(x)
	call outb
}
ifn t%dm25,{
	movei a,^L	; DM2500 abs move
	call outb
	movei a,(x)
	trc a,140
	call outb
	movei a,(y)
	trc a,140
	call outb
}
ifn t%hz15,{
	movei a,"~
	call outb
	movei a,^Q
	call outb
	movei a,(x)
	caig a,30.
	 addi a,140
	call outb
	movei a,140(y)
	call outb
}
ifn t%vt52,{
	movei a,33
	call outb
	movei a,"Y
	call outb
	movei a,40(y)
	call outb
	movei a,40(x)
	call outb
}
ifn t%c100,{
	movei a,33
	call outb
	movei a,"a
	call outb
	movei a,40(y)
	call outb
	movei a,40(x)
	call outb
}
	pop p,a
	return


clchar:	push p,a
ifn t%its,{
	movei a,^P
	call outb
	movei a,"K
	call outb
}
ife t%its,{
	movei a,40
	call outb
;X;	movei a,^H
;X;	call outb
}
	pop p,a
	return

SCREEN:	BLOCK 6

RADIX 2.
DIGITS:	011101000110011101011100110001011100
	001000110000100001000010000100011100
	011101000100001000100010001000111110
	011101000100001011100000110001011100
	000100011001010100101111100010000100
	111111000010000111100000110001011100
	011101000110000111101000110001011100
	111110000100001000100010001000100000
	011101000110001011101000110001011100
	011101000110001011110000110001011100
RADIX 8.

; For each terminal definition, HAKCLR specifies bytes to clear screen,
; HAKMOV to move cursor to given X, Y, and HACK takes a string
; generating the appropriate bytes for commands Up, Down, Back, and Forward.
; Unrecognized chars are simply output (eg "$").

ifn t%its,{
DEFINE HAKCLR
^P ? "C
TERMIN
DEFINE HAKMOV X,Y
^P ? "H ? 10+<X>
^P ? "V ? 10+<Y>
TERMIN
DEFINE HACK CHARS
IRPC X,,[CHARS]
IFSE X,$,	"$
IFSE X,U,	^P ? "U
IFSE X,D,	^P ? "D
IFSE X,B,	^P ? "B
IFSE X,F,	40
TERMIN
TERMIN
}
ifn t%vt52,{
DEFINE HAKCLR
33 ? "H ? 33 ? "J
TERMIN
DEFINE HAKMOV H,V
33 ? "Y ? 40+<V> ? 40+<H>
TERMIN
DEFINE HACK CHARS
IRPC X,,[CHARS]
IFSE X,$,	"$
IFSE X,U,	33 ? "A
IFSE X,D,	^J
IFSE X,B,	^H
IFSE X,F,	40
TERMIN
TERMIN
}
ifn t%c100,{
DEFINE HAKCLR
^L
TERMIN
DEFINE HAKMOV H,V
33 ? "a ? 40+<V> ? 40+<H>
TERMIN
DEFINE HACK CHARS
IRPC X,,[CHARS]
IFSE X,$,	"$
IFSE X,U,	33 ? ";
IFSE X,D,	^J
IFSE X,B,	^H
IFSE X,F,	40
TERMIN
TERMIN
}
ifn t%dm25,{
DEFINE HAKCLR
37 ? 37
TERMIN
DEFINE HAKMOV X,Y
^L ? 140#<X> ? 140#<Y>
TERMIN
DEFINE HACK CHARS
IRPC X,,[CHARS]
IFSE X,U,	^Z .STOP
IFSE X,D,	^J .STOP
IFSE X,B,	^H .STOP
IFSE X,F,	^\ .STOP
"X
TERMIN
TERMIN
}
ifn t%hz15,{
DEFINE HAKCLR
"~ ? 34
TERMIN
DEFINE HAKMOV X,Y
"~ ? ^Q
IFG <X>-30.,{<X>} .ELSE {140+<X>}
140+<Y>
TERMIN
DEFINE HACK CHARS
IRPC X,,[CHARS]
IFSE X,U,	"~ ? ^L .STOP
IFSE X,D,	"~ ? ^K .STOP
IFSE X,B,	^H .STOP
IFSE X,F,	^P .STOP
"X
TERMIN
TERMIN
}
FRAME:	.BYTE 7
	HAKCLR
	HAKMOV 8.,4.
	HACK $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
	HACK DB$DB$DB$DB$DB$DB$DB$DB$DB$DB$
	HACK BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$
	HACK BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$
	HACK BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$BB$
	HACK BB$BB$
	HACK UB$UB$UB$UB$UB$UB$UB$UB$UB$
	HAKMOV 8.+1+2+5+3+5+2, 4+3
	HACK $$BBD$$BBDD$$BBD$$
	HAKMOV  8.+1+2+5+3+5+6+5+3+5+2, 4+3
	HACK $$BBD$$BBDD$$BBD$$
LFRAME==.BYTC
	.BYTE


CHPOS:
IRPC Y,,[0123456]
IRPC X,,[01234]
	X,,Y
TERMIN
TERMIN

HORIZ:	8+1+2
	8+1+2+5+3
	8+1+2+5+3+5+6
	8+1+2+5+3+5+6+5+3
	8+1+2+5+3+5+6+5+3+5+6
	8+1+2+5+3+5+6+5+3+5+6+5+3

PATCH:	BLOCK 40

END DCROCK