From a0f2529bf21f22f9c010623767cacbfd819e1b69 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Sun, 4 Dec 2016 22:18:42 +0100 Subject: [PATCH] Build CROCK. --- README.md | 1 + build/build.tcl | 4 + src/sysen1/crock.1008 | 533 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 538 insertions(+) create mode 100755 src/sysen1/crock.1008 diff --git a/README.md b/README.md index 62888792..79ac30a5 100644 --- a/README.md +++ b/README.md @@ -118,6 +118,7 @@ from scratch. - RMTDEV, MLDEV for non-ITS hosts - IDLE, list idle users - SPELL, ESPELL spell checker + - CROCK, analog watch. - DCROCK, digital watch. - JOBS, list jobs by category - HSNDEV, HSNAME device diff --git a/build/build.tcl b/build/build.tcl index f3f858c4..83220443 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -345,6 +345,10 @@ respond "*" ":link channa; rakash pfthmg,dragon; rakash pfthmg\r" respond "*" ":link sys; ts p,sys; ts peek\r" +respond "*" ":midas sys1;ts crock_sysen1;crock\r" +respond "System?" "ITS\r" +expect ":KILL" + respond "*" ":midas sys1;ts dcrock_sysen1;dcrock\r" respond "System?" "ITS\r" expect ":KILL" diff --git a/src/sysen1/crock.1008 b/src/sysen1/crock.1008 new file mode 100755 index 00000000..c0548e8f --- /dev/null +++ b/src/sysen1/crock.1008 @@ -0,0 +1,533 @@ +; -*-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 its&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 /5 + +ifn its, -1 ; to ensure core loaded. + +end crock