;; -*-midas-*- TITLE PICTURE INPUT ;; Type TVREAD CR to read binary image file onto your TV-screen. ;; [Parameter following "/" is sent along as expansion factor to ZAP] ;; [Parameter following "" is another user's tty number, to snarf his ;; screen instead.] ;; [$ means quick exit after putting up picture - without waiting for user] ;; (If file is not a binary image file, bits are packed onto your screen ;; as they are found in file. The result may not look very informative.) ;; ;; Image is placed at the top of the screen and left-justified (for now). ;; Default file-name is SCREEN >. ;; ;; Type CR to refresh display -- that is do it over again. ;; Type anything else to quit (:KILL). ;; ;; (Type RUBOUT to dump your screen in XGP ;SCAN format using bkph;zap.) ;; A=1 B=2 C=3 D=4 E=5 F=6 G=7 P=17 tvpage==370 ;last ten pages in core tv==tvpage*2000 ;address of beg of tv buffin tvend==tvpage*2000+10*2000-1 ;black/white bit and frame start number ttyin==1 ttyot==2 dtyoc==3 BEG: MOVE P,[-20,,pdl] .open ttyin,[sixbit / $TTY/] jrst losers .CALL [SETZ SIXBIT /CNSGET/ 1000,,TTYIN 2000,,A 2000,,B 402000,,C] JRST losers CAIE C,5 ;CHECK IF TV CONSOLE JRST KILL ;NO -- STOP THE LOSER ! PUSHJ P,TVMAPC SETZM TTYNUM' PUSHJ P,READNM ;get file name if any SKIPN B,TTYNUM ;if ttynum is 0, don't need to hack .TVCREG JRST RESTAR tlo b,400000 ; .call [setz ? 'tvwher ? b ? movem b ? setzm b] .lose %lssys .suset [.rtvcreg,,a] ;get our tvcreg tlz a,1774 ;mask out our buffer number lsh b,2 tso a,b ;put in his .suset [.stvcreg,,a] ;set it (isn't memory mapping fun?) restar: pushj p,readhd ;read headin of image file .open dtyoc,[sixbit / 1TTY/] jrst failur pushj p,saver ;save screen pushj p,bull ;move cursor pushj p,unpack ;unpack things onto screen .call [ setz sixbit \close \ setz inchn] jrst failur surlp: skipe quick ;quick exit? leaving screen as is! jrst kill .iot ttyin,a ;await user's command cain a,177 .value valmes ;magic .value stuff -- call ZAP for XGP cain a,15 jrst restar ;do it again cain a,40 ;restore screen if he types a space exit: pushj p,restore pushj p,cow kill: .close dtyoc, .break 16,124000 failur: pushj p,restore losers: .value [asciz /:err :vp /] jrst kill ;an open failed -- exit badfil: movei a,[asciz $Not an Image File$] loser: .open ttyot,[1,,(sixbit /tty/)] jrst failur pushj p,string ;type bad file message pushj p,carret jrst kill badbts: movei a,[asciz $Too many Bits per Pixel$] jrst loser badlin: movei a,[asciz $Image lines too long$] jrst loser string: hrli a,440700 ;turn into byte pointer strlop: ildb b,a skipn b popj p, ;hit a zero byte .iot ttyot,b jrst strlop carret: .iot ttyot,[15] .iot ttyot,[12] popj p, TVMAPC: MOVE A,[-10,,tvpage] MOVEI B,0 .CALL [ SETZ SIXBIT \CORBLK\ 1000,,600000 1000,,-1 A 1000,,-2 SETZ B] jrst failur POPJ P, unpack: movei c,tv ;destination address move e,headin+4 sub e,headin+3 ;YHIGH-YLOW aoj e, caile e,454. movei e,454. ;454. lines max on screen movn a,headin+2 ;words per line hrlz a,a hrri a,buffin ;make up i/o pointer movem a,bufpnt readlp: move a,bufpnt ;read a line of image .call [ setz sixbit /iot / ,,inchn setz a] jrst failur movei d,buffin ;source address pushj p,blknup ;unpack 8 words of it addi c,9. addi d,8. pushj p,blknup ;unpack another 8. words addi c,9. ; addi d,8. sojg e,readlp popj p, bull: .iot dtyoc,[^P] .iot dtyoc,["T] ;home cursor up .iot dtyoc,[^P] .iot dtyoc,["B] ;MOVE TO RIGHT OF FRAME popj p, cow: .iot dtyoc,[^P] .iot dtyoc,["H] hrrz a,mppos movei a,10(a) .iot dtyoc,a .iot dtyoc,[^P] .iot dtyoc,["V] hlrz a,mppos movei a,10(a) .iot dtyoc,a popj p, blknup: move a,(d) ;get first word lshc a,-4. ;shift 4 bits out lsh a,4. ;left justify movem a,(c) ;store in TV screen lshc a,32.-28. move b,1(d) lshc a,28. lsh a,4. movem a,1(c) lshc a,32.-24. move b,2(d) lshc a,24. lsh a,4. movem a,2(c) lshc a,32.-20. move b,3(d) lshc a,20. lsh a,4 movem a,3(c) lshc a,32.-16. move b,4(d) lshc a,16. lsh a,4 movem a,4(c) lshc a,32.-12. move b,5(d) lshc a,12. lsh a,4 movem a,5(c) lshc a,32.-8. move b,6(d) lshc a,8. lsh a,4 movem a,6(c) lshc a,32.-4. move b,7(d) lshc a,4. lsh a,4 movem a,7(c) movem b,8(c) popj p, READHD: .call [ setz sixbit /open / 5000,,6 ,,inchn ,,infnm ,,infnm+1 ,,infnm+2 setz infnm+3] jrst failur MOVE A,[-200,,headin] .call [ setz sixbit /iot / ,,inchn setz a] jrst failur move a,headin ;test first word aojn a,badfil move a,headin+1 ;bits per pixel caile a,44 jrst badbts move a,headin+2 ;words per line caile a,4000 jrst badlin POPJ P, readnm: .break 12,[5,,jcl] ;get job control language move c,[440700,,jcl] movei f,infnm+1 scanon: move d,[440600,,g] ;first file name ? setz g, cntrlp: ildb a,c skipn a ;look for end of jcl popj p, cain a," jrst param cain a,^q jrst quoted caig a,40 jrst cntrlp goblop: cain a,": jrst colons cain a,"; jrst semico cain a,"/ jrst slash cain a,"$ jrst quiset cain a,^q jrst quoted caig a,40 jrst spacer ;space putint: caige a,140 subi a,40 ;lower case idpb a,d ildb a,c jrst goblop quoted: ildb a,c jrst putint spacer: jumpe g,scanon movem g,(f) movei f,infnm+2 ;ready for second file name jrst scanon semico: movem g,infnm+3 ;user name jrst scanon colons: movem g,infnm ;device jrst scanon slash: ildb a,c move b,[260700,,valmes+2] ;yech! what a way to do it! idpb a,b jrst spacer param: ildb a,c ;ignore for now (the slash) cain a,"t jrst param ;flush the T in T53... cain a,"T jrst param cail a,"0 caile a,"7 jrst spacer subi a,"0 move b,ttynum imuli b,10 add b,a movem b,ttynum jrst param quiset: setom quick ;quick return flag jrst spacer saver: .call [ setz sixbit /rcpos/ 1000,,dtyoc 2000,,mppos 402000,,echpos] .value move a,[tv,,saved] blt a,saved+10*2000-1 popj p, restor: move a,[saved,,tv] blt a,tv+10*2000-1 popj p, clears: movsi f,-10*2000+1 ;no longer used move a,[setzm tv(f)] move b,[aobjn f,a] move c,[popj p,] jrst a inchn: 4 infnm: sixbit /dsk / sixbit /screen/ sixbit /> / 0 valmes: asciz $:bkph;zap /1 :vp $ mppos: 0 echpos: 0 quick: 0 ;QUICK EXIT FLAG bufpnt: 0 ;i/o pointer constants variables jcl: block 20 pdl: block 20 headin: block 200 buffin: block 4000 saved: block 10*2000 -1 end beg