.title crock .enabl lc ; ; -*-MACRO-*- ; Original program hacked up by GLS (Guy Steele) ; 10X/20X version hacked by KLH (Ken Harrenstien) ; Some 10X modifications done by EAK ; PDP-11 version by JOHNW (John Wilson) ; .mcall .exit,.gtim,.mrkt,.print,.rsum,.spnd ; bs= 10 lf= 12 esc= 33 ; crock: ; Output initial clock picture .print #ibuf ;do it mov #-1,r0 ;load trash mov r0,oldh ;trash old values (guarantee first picture) mov r0,oldm mov r0,olds mov r0,oldhvc ;make sure we always move first thing movb r0,busy ;we're busy mov #marea,r0 ;point at area .mrkt ;queue a timer interrupt loop: ; Start a new clock picture here mov #tarea,r0 ;point at area .gtim ;get time mov time,r1 ;get highword mov time+2,r0 ;low word mov #60.,r2 ;# ticks/second call div2 ;find # of seconds since midnight call div2 ;# of minutes mov r3,-(sp) ;save second within minute call div2 ;# of hours mov r3,-(sp) ;save minute within hour mov #12.,r1 ;we'll be using this a few times cmp r0,r1 ;AM or PM? blo 10$ ;AM sub r1,r0 ;PM, normalize 10$: ; move hour hand to 5-minute interval plus 1/5's of an hour movb times5(r0),r0 ;H*5 (hours are at 5-minute marks) mov (sp),r2 ;get minutes 20$: sub r1,r2 ;divide by 12 (loop 4 times or less) bcs 30$ ;skip inc r0 ;+1 br 20$ ;loop 30$: mov #buf,r5 ;pt at buf mov oldh,r4 ;get old hour hand cmp r0,r4 ;has it moved? beq 50$ ;no ; hour hand has moved; erase old one mov r0,oldh ;update clr ovrcnt ;don't check for overwrite clr poscnt ;nothing in buf yet mov #hpos,posptr ;it will overwrite what's already there tst r4 ;negative? bmi 40$ ;yes, skip erasing (first time) mov #5*400+<' >,mrkchr ;save hand type call draw ;erase the old hand 40$: ; draw new hour hand mov oldh,r4 ;get new hand posn mov #5*400+'*,mrkchr ;set hand type call draw ;draw the new hand mov poscnt,mcnt ;update hour hand size 50$: ; see if we need a new minute hand mov (sp)+,r0 ;get value mov oldm,r4 ;get old value cmp r0,r4 ;same as before? beq 70$ ;yes, skip ; minute hand has moved; erase old one mov r0,oldm ;update posn mov mcnt,r0 ;get length of hour hand mov r0,ovrcnt ;# of posns to check mov r0,poscnt ;# posns already written asl r0 ;*2 add #hpos,r0 ;pt at base of table mov r0,posptr ;addr to save next posn in tst r4 ;negative? bmi 60$ ;yes, skip erasing (first time) mov #6*400!<' >,mrkchr ;set hand type call draw ;erase old one 60$: ; draw new minute hand mov oldm,r4 ;get new hand posn mov #6*400+'O,mrkchr ;set hand type call draw ;draw the new hand mov poscnt,scnt ;update hour hand+minute hand size 70$: ; see if we need a new second hand mov (sp)+,r0 ;get value mov olds,r4 ;get old value cmp r0,r4 ;same as before? beq 90$ ;yes, skip ; second hand has moved; erase old one mov r0,olds ;update posn mov scnt,r0 ;get length of hour+minute hands mov r0,ovrcnt ;# of posns to check mov r0,poscnt ;# posns already written asl r0 ;*2 add #hpos,r0 ;pt at base of table mov r0,posptr ;addr to save next posn in tst r4 ;negative? bmi 80$ ;yes, skip erasing (first time) mov #7*400!<' >,mrkchr ;set hand type call draw ;erase old one 80$: ; draw new second hand mov olds,r4 ;get new hand posn mov #7*400,mrkchr ;set hand type call draw ;draw the new hand 90$: ; flush buffer movb #200,(r5) ;mark end .print #buf ;dump it clrb busy ;feel free to restart me... .spnd ;wait until something happens comb busy ;not now jmp loop ; .exit ; Time interrupt completion routine tcrtn: tstb busy ;are they ready? bne 10$ ;no, skip this second .rsum ;yes, restart mainline 10$: mov #marea,r0 ;pt at args .mrkt ;queue a timer interrupt rts pc ; Mixed-precision unsigned divide ; Enter with divisor in r2, dividend in r1:r0. ; Exit with r4=0, remainder in r3, r2 unchanged, quotient in r1:r0. div2: mov #40,r4 ;# of bits clr r3 ;init rem 10$: asl r0 ;left a bit rol r1 ;through r1 rol r3 ;into r2 cmp r3,r2 ;will divisor fit? bcs 20$ ;no sub r2,r3 ;yes, take it out 20$: adc r0 ;save the bit sob r4,10$ ;loop com r0 ;flip com r1 rts pc ; Super hairy hand drawer. ; Inputs are: ; r5 - buffer to put stuff in ; r4 - value (0-59) of hand to draw ; ovrcnt - # of posns to check for overwrite ; posptr - ptr for saving posn of chars written ; poscnt - # of posns saved ; marker - 5 for hour hand, 6 for minute hand, 7 for second hand ; char - '* for hour hand, 'O for minute hand, ^@ for second hand draw: mov #20.*400!11.,hvc ;init hc, vc clr r0 ;quadrant # mov #15.,r1 ;load a 15. 10$: ; find quadrant hand is in (divide r4 by 15.) sub r1,r4 ;done yet? bcs 20$ ;yep inc r0 ;no br 10$ ;loop 20$: add r1,r4 ;correct bit #1,r0 ;in quad 1 or 3? beq 30$ ;no sub r4,r1 ;if so, set remainder to mirror image mov r1,r4 ;of that for 0 or 2 30$: asl r4 ;*2 mov handtb(r4),r4 ;using remainder, get proper hand-slope asl r0 ;quotient *2 mov r0,r1 ;copy asl r0 ;*4 add r1,r0 ;*6 (add r1,foo ? rts pc) 40$: ; Loop once for each hand position movb (r4)+,r1 ;get next byte asr r1 ;right a bit (get vertical change) call vincr(r0) ;increment asr r1 ;right a bit (get horizontal change) call hincr(r0) ;increment cmp r1,#5 ;special marker? bhis 190$ ;yes, skip ; Output a char of the hand in current HC, VC cursor posn if safe mov ovrcnt,r2 ;get length of table beq 60$ ;if ptr is 0, don't bother checking mov #hpos,r3 ;get addr 50$: cmp hvc,(r3)+ ;match? beq 40$ ;this position occupied already - don't write sob r2,50$ ;loop 60$: ; Safe, can actually output char ; movb hc,r2 ;get horizontal pos movb oldhc,r3 ;get old value sub r2,r3 ;find - mov r3,-(sp) ;save bpl 70$ ;moving to the left, skip neg r3 ;take abs val asl r3 ;*2 (non-destructive move - ESC C) 70$: mov r3,-(sp) ;save movb vc,r2 ;get vertical pos movb oldvc,r3 ;get old value sub r3,r2 ;find change mov (sp)+,r3 ;restore horizontal count mov r2,-(sp) ;save change bpl 80$ ;moving down, skip neg r2 ;take abs val asl r2 ;*2 (ESC A) 80$: add r3,r2 ;find total # of chars for relative move cmp r2,#4 ;same or better than DCA? bhi 160$ ;no, skip ; Move to proper row mov (sp)+,r2 ;get count bmi 100$ ;negative, skip beq 120$ ;already there, skip 90$: movb #lf,(r5)+ ;line feed sob r2,90$ ;as many as necessary br 120$ ;skip 100$: neg r2 ;take abs val 110$: movb #esc,(r5)+ ;up a line movb #'A,(r5)+ sob r2,110$ ;loop 120$: ; Move to proper col mov (sp)+,r2 ;get - bmi 140$ ;negative, skip beq 170$ ;already there, skip 130$: movb #bs,(r5)+ ;backspace sob r2,130$ ;as many as necessary br 170$ ;skip 140$: neg r2 ;take abs val 150$: movb #esc,(r5)+ ;right a col movb #'C,(r5)+ sob r2,150$ ;loop br 170$ 160$: ; Not close enough; use direct cursor addressing add #4,sp ;clear stack movb #esc,(r5)+ ;ESC Y movb #'Y,(r5)+ mov hvc,r2 add #40*400+40,r2 movb r2,(r5)+ swab r2 movb r2,(r5)+ ; 170$: mov hvc,oldhvc ;update posn incb oldhc ;always bump col since char will move cursor ; movb char,r2 ;get char to write bne 180$ ;got it, skip add r0,r1 ;quad*6 + byte from lookup table movb chars(r1),r2 ;get char to write 180$: movb r2,(r5)+ ;put in buf cmpb r2,#<' > ;erasing? beq 40$ ;yes, never mind mov hvc,@posptr ;save position add #2,posptr ;bump ptr inc poscnt ;bump length br 40$ ;loop 190$: ; special marker in r1 cmpb r1,marker ;is that what we were drawing? bne 40$ ;no, loop rts pc vincr: sbcb vc rts pc adcb vc rts pc adcb vc rts pc sbcb vc rts pc hincr: adcb hc rts pc adcb hc rts pc sbcb hc rts pc sbcb hc rts pc times5: .byte 0,5,10.,15.,20.,25.,30.,35.,40.,45.,50.,55. ;*5 lookup table chars: .asciz #|-/',# ;must be 6 bytes long .asciz #|-\,'# .asciz #|-/,'# .asciz #|-\',# .macro ihack x .irpc w, .iif idn ,, .h=.h+1 ;forwards .iif idn ,, .v=.v-1 ;up .iif idn ,, .h=.h-1 ;back .iif idn ,, .v=.v+1 ;down .if lt ''w-'@ ; Check for doing abs positioning .dh=.h-$h .iif lt .dh, .dh=-.dh ; abs val .dv=.v-$v .iif lt .dv, .dv=-2*.dv ; CUP is 2 bytes .if le .dh+.dv-4 ; Use relative cursor addressing? .if ne .h-$h .if gt .h-$h ; Right .rept .dh .byte <' > .endr .iff ; Left .rept .dh .byte bs .endr .endc .endc .if ne .v-$v .if gt .v-$v ; Down .rept .dv .byte lf .endr .iff ; Up .rept .dv/2 .byte esc,'A .endr .endc .endc .iff ; Use direct cursor addressing .byte esc,'Y,.v+40,.h+40 .endc .byte ''w ; The character itself .h=.h+1 $h=.h $v=.v .endc .endr .endm ihack ; ibuf: .ascii "[?7;2l" ; VT100s in VT52 mode, no autowrap .ascii "\" ; Out of hold-screen mode if real '52 .ascii "H""J" ; Clear the screen $h=0 $v=0 .h=0 .v=0 ; ihack ihack ihack ihack ihack ihack ; ; Picture done, now one more abs-pos to middle. .byte esc,'Y,11.+40,20.+40 .ascii "*" .byte 200 ; End of string ; .macro hand x .irp f, .byte <*4>!</4>!</100> .endr .endm hand hand0: hand <100,100,100,100,100,100,005,100,100,100,006,100,007> hand1: hand <100,100,102,110,100,100,005,102,110,100,006,100,007> hand2: hand <100,102,110,102,110,102,005,110,102,110,006,100,007> hand3: hand <100,112,112,110,102,110,005,102,110,102,006,110,007> hand4: hand <112,112,110,102,112,110,005,102,112,112,006,110,007> hand5: hand <112,112,112,112,112,112,005,112,112,112,006,112,007> hand6: hand <112,112,112,114,013,112,112,005,114,013,112,006,112,114,007> hand7: hand <114,013,112,114,013,112,114,013,005,112,114,013,112,006,114> hand <013,007> hand8: hand <013,114,013,114,013,114,013,114,013,114,005,013,114,013,114> hand <006,013,114,007> hand9: hand <013,112,013,114,013,114,011,013,114,011,013,005,112,114,011> hand <013,114,006,011,013,007> hand10: hand <011,013,114,011,013,114,011,013,114,011,013,005,114,011,013> hand <114,011,013,006,114,007> hand11: hand <011,013,114,011,011,013,114,011,011,013,114,005,011,011,013> hand <114,011,011,006,013,114,007> hand12: hand <011,011,013,114,014,011,011,013,114,014,011,005,011,013,114> hand <014,011,011,006,013,114,007> hand13: hand <011,011,011,013,013,114,014,011,011,011,013,005,013,114,014> hand <011,011,011,006,013,013,007> hand14: hand <011,011,011,011,013,013,013,013,114,014,014,005,014,011,011> hand <011,011,013,006,013,013,007> hand15: hand <011,011,011,011,011,011,011,011,011,011,011,005,011,011,011> hand <011,011,011,006,011,011,007> ; .even marea: .byte 0,22 ;.MRKT .word 60. ;60 ticks .word tcrtn ;completion routine .word 0 tarea: .byte 0,21 ;.GTIM .word time ;ptr to time handtb: .word hand0,hand1,hand2,hand3,hand4,hand5,hand6,hand7,hand8 .word hand9,hand10,hand11,hand12,hand13,hand14,hand15 time: .blkw 2 ;# ticks since midnight oldh: .blkw 1 ;old hour oldm: .blkw 1 ;old minute olds: .blkw 1 ;old second hvc: vc: .blkb 1 ;vert coord hc: .blkb 1 ;horiz coord oldhvc: oldvc: .blkb 1 ;old h + v coord oldhc: .blkb 1 ovrcnt: .blkw 1 ;# of words to check for overlay hpos: .blkw 11.+17.+19. ;pos of each occupied space mcnt: .blkw 1 ;# of words in hpos containing hour hand scnt: .blkw 1 ;# of words in hpos containing hour & minute hands mrkchr: char: .blkb 1 ;char to draw, or 0 if we should index into CHARS marker: .blkb 1 ;marker in HAND entry to stop at (5=H, 6=M, 7=S) posptr: .blkw 1 ;ptr to save at poscnt: .blkw 1 ;# posns saved busy: .blkb 1 ;<>0 if busy buf: .blkb 1000 ; .end crock