Trailing-Edge
-
PDP-10 Archives
-
mit_emacs_170_teco_1220
-
emacs/crock.mid
There is 1 other file named crock.mid in the archive. Click here to see a list.
; -*-MIDAS-*-
TITLE CROCK
; Original program hacked up by GLS
; 10X/20X version hacked by KLH.
; Some 10X modifications done by EAK.
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
ifndef t%hz15, t%hz15==0 ; Hazeltine 1500
ifndef t%dm25, t%dm25==0 ; Datamedia 2500
ifndef t%vt52, t%vt52==0 ; VT52
ife t%its\t%hz15\t%dm25\t%vt52, t%vt52==1 ; default to vt52
; 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
call=pushj p,
return=popj p,
ifn 20x,{
TM%DPY=1_35.
VTSOP=JSYS 635
RTMOD=JSYS 636
STMOD=JSYS 637
RTCHR=JSYS 640
}
ifn its,{
ttyc=17 ;TTY output channel
}
ifn 10x,{
.ttdm==14
.ttv52==10.
}
ifn 20x,{
.ttdm==5
}
ifn tnx, oldmod: 0
pdl: -40,,pdl
block 40
crock: move p,pdl ; set up PDL
ifn its,[
.open ttyc,[%tjdis+.uao,,'tty]
.lose %lsfil
]
ifn tnx,[
ifn t%dm25,[
movei 1,.cttrm
gttyp
caie 2,.ttdm ; datamedia?
jrst [ hrroi 1,[asciz "?Currently works only on datamedias"]
psout
haltf
jrst .+1] ; If continued, go ahead.
] ; ifn t%dm25
ifn t%vt52,[
movei 1,.cttrm
gttyp
caie 2,.ttv52 ; VT52?
jrst [ hrroi 1,[asciz "?Currently works only on VT52s"]
psout
haltf
jrst .+1] ; If continued, go ahead.
] ; ifn t%vt52
movei 1,.priin
rfmod
movem 2,oldmod ; save old status
trz 2,tt%dam ; set to 8-bit i/o
ifn t%its,{ ; VTS
tro 2,1_7 ; turn on output translation
}
sfmod ; zap
ifn t%its,{
rtmod
tlo 2,(tm%dpy)
stmod
}
]
; Output initial clock picture
move 2,[440700,,ibuf] ; bp to cruft
ifn its,[
movei 3,libuf ; cnt of bytes (pos)
.call [setz ? sixbit /siot/ ? 1000,,ttyc
2 ? setz 3]
.value
]
ifn 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 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 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 its, .lose 0
ifn tnx, jrst 4,
; Now before outputting, make sure user hasn't typed anything.
ifn its,{
.listen t,
jumpn t,die ; Input buff not empty, go die.
}
ifn 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 its,[
.call [setz ? sixbit /siot/ ? 1000,,ttyc
2 ? setz 3]
.value
]
ifn 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 its,{
movei tt,30
.sleep tt,
}
ifn tnx,{
movei 1,1000.
disms
}
jrst loop
die:
ifn its, .break 16,140000
ifn tnx,[
ife t%its,{
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,[asciz "Y7 K"]
setz 3,
sout
}
movei 1,.priin
move 2,oldmod
sfmod ; Restore old modes
haltf
jrst crock
]
; 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 t%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
]
ife t%its,[
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)
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 t%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 t%its, IFN %H-$H, ^P ? "H ? 10+%H
ifn t%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%hz15,[IFN <%H-$H>\<%V-$V>,[
176 ? ^Q
ifl %H-40,{140+%H} .else %H
%V+140]]
ifn t%vt52, ifn <%h-$h>\<%v-$v>, 33 ? "Y ? %v+40 ? %h+40
"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 t%its, ^P ? "C
ifn t%dm25, ^^ ? ^^ ; twice required at 9600 baud
ifn t%hz15, 176 ? 34
ifn t%vt52, 33 ? "H ? 33 ? "J
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 t%its, ^P ? "H ? 10+20. ? ^P ? "V ? 10+11.
ifn t%dm25, ^L ? 20.#140 ? 11.#140
ifn t%hz15, 176 ? ^Q ? 20.+140 ? 11.+140
ifn t%vt52, 33 ? "Y ? 11.+40 ? 20.+40
"*
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 characters safety margin
buf: block <lbufch+4>/5
ifn its, -1 ; to ensure core loaded.
end crock