.TITLE GD2648 - HP 2648 DRIVER .IDENT /VERS20/ .SBTTL CONFIGURATION .ENABLE LC ; This file contains the HP 2648 driver for DIGLIB. ; DIGLIB is a "device independant" graphics library. ; This file is conditionally assembled for RT-11 or RSX-11M ; The following are the conditionals: ;1) SET THE SYMBOL OS TO: ; 1 ==> RT11 ; 2 ==> TSX ; 3 ==> RSX11M (IMPLIES F4P/F77) .IF NDF OS OS = 3 .ENDC ;2) DEFINE THE SYMBOL "HAVEIS" IF YOUR MACHINE HAS EIS, ELSE ; LEAVE IT UNDEFINED (COMMENTED OUT) ; HAVEIS = 1 .SBTTL DEFINATIONS, ECT. ;;;;;;;;;; MACHINES RUNNING TSX AND RSX HAVE EIS .IF NDF HAVEIS .IF NE OS-1 HAVEIS = 1 .ENDC ;NE OS-1 .ENDC ;NDF HAVEIS .IF NE OS-3 .MCALL .PRINT, .TTYIN JSW = 44 TTSPC = 50000 ;SPECIAL MODE + LOWER CASE ENABLE .IFF .MCALL QIOW$, DIR$ .ENDC ;EQ OS-3 .GLOBL GDAID, GDGAID F0 = %0 ;FLOATING PT. REG. 0 FOR RSX11M BUFSIZ = 80. ESC = 33 CR = 15 LF = 12 DC1 = 21 ;ERROR MACRO DEFINATION .MACRO ERROR TEXT JSR R0,ERROR1 .ASCIZ @TEXT@ .EVEN .ENDM ERROR .PSECT GD2648 ;WE ARE RELOCATABLE .SBTTL ENTRY POINT GD2648:: TST (R5)+ ;SKIP ARG COUNT MOV @(R5)+,R0 ;GET FUNCTION TO PERFORM BLE 1$ ;ITS A BADDY ASL R0 ;MAKE WORD OFFSET ADD #DSPTBL-2,R0 ;R0 ==> ADDRESS OF PROCESSING ROUTINE CMP R0,#TBLEND ;SEE IF UNSUPPORTED FUNCTION BGE 1$ ;YES JMP @(R0)+ ;NO, DISPATCH TO ROUTINE 1$: ERROR DSPTBL: .WORD INIT, BGNPLT, MOVE, DRAW, ENDPLT, RLSDEV .WORD GETCHR,SETCOL,GIN TBLEND: .SBTTL INIT AND BGNPLT ; ;INITIALIZE - FUNCTION 1 ; INIT: .IF EQ OS-2 ;IF BLOODY TSX, THEN MOV #ON,R0 ;TELL TSX TO LEAVE OUR TTY I/O ALONE EMT 375 .IFTF JSR PC,DOINIT JSR PC,IN2648 JSR PC,FLUSH MOV 2(R5),R4 ;R4 ==> YA(1) CLR (R4)+ ;YA(1) = 0.0 CLR (R4)+ ;MEANS NO ERROR ON INIT. RTS PC .IFT ON: .BYTE 1,120 ;FROM BILL MCDONALD .ENDC ;EQ OS-2 ; ;BGNPLT - FUNCTION 2 ; BGNPLT: JSR PC,DOINIT ;KILL ANY LEFT OVER GRAPHICS JSR PC,IN2648 JSR R4,COMAND ;REQUEST A GRAPHICS ERASE .ASCIZ '*dA' ;CLEAR GRAPHICS MEMORY .EVEN JSR PC,FLUSH ;FORCE BGNPLT OUT WHEN IT IS DONE RTS PC ;DONE IN2648: JSR R4,COMAND ;INIT. 2648 (WITHOUT ERASING SCREEN) .ASCII 'H' ;HOME ALPHA CURSOR .ASCII 'J' ;ERASE ALPHA MEMORY TO END OF SCREEN .ASCII '*dc' ;ENABLE GRAPHICS MEMORY .ASCII '*m2a' ;DRAWING COLOR IS FOREGROUND (DOTS ON) .ASCIZ '*m1B' ;SOLID LINES .EVEN RTS PC .SBTTL MOVE AND DRAW ; ;MOVE - FUNCTON 3 ; MOVE: JSR PC,GO2VEC ;MAKE SURE IN VECTOR MODE JSR R4,INSERT ;DO A TEMPORARY PEN-UP .ASCIZ 'a' .EVEN BR DOXY ;GO DO A HP COORDINATE ; ;DRAW - FUNCTION 4 ; DRAW: JSR PC,GO2VEC ;MAKE SURE IN VECTOR MODE DOXY: JSR PC,MAKINT ;CONVERT SCREEN CM COORD. TO GDU JSR PC,CCOORD ;CONVERT IX,IY TO HP BINARY SCHEME ;AND PLACE IN BUFFER RTS PC GO2VEC: JSR R4,TFLUSH ;MAKE SURE ROOM ENOUGH .WORD 12. TSTB VMODE ;NOW MAKE SURE IN VECTOR MODE BNE 9$ ;ALREADY THERE, DO NOTHING BUT RETURN JSR R4,INSERT ;NOT THERE, GO TO VECTOR MODE .ASCIZ '*pi' .EVEN COMB VMODE ;SHOW THAT WE ARE IN VECTOR MODE 9$: RTS PC ;DONE .SBTTL ENDPLT AND RLSDEV ; ;END OF PLOTTING (FLUSH BUFFER) - FUNCTION 5 ; ENDPLT: JSR R4,COMAND ;ERASE ALPHA AREA .ASCII 'H' ;HOME ALPHA CURSOR .ASCIZ 'J' ;ERASE ALPHA TO END OF SCREEN .EVEN JSR PC,FLUSH ;SEND GRAPHICS BUFFER RTS PC ; ;RELEASE DEVICE - FUNCTION 6 RLSDEV: JSR R4,COMAND .ASCIZ '*dD' ;TURN OFF GRAPHICS .EVEN JSR PC,FLUSH ;SEND TO HP .IF EQ OS-2 MOV #OFF,R0 EMT 375 .IFTF RTS PC .IFT OFF: .BYTE 0,120 .ENDC ;EQ OS-2 .SBTTL GETCHR - GET CHARACTERISTICS ; ;GET DEVICE CHARACTERISTICS - FUNCTION 7 ; GETCHR: MOV (R5)+,R4 ;R4 ==> OUTPUT ARRAY MOV #CHRTBL,R0 ;R0 ==> OUR CHARACTERISTICS MOV #CWORDS,R1 ;R1 = NUMBER OF WORDS TO MOVE 1$: MOV (R0)+,(R4)+ ;MOVE CHARACTERISTICS SOB R1,1$ RTS PC CHRTBL: .FLT2 2648.0 .FLT2 23.9667 .FLT2 11.9667 XGUPCM: .FLT2 30.0 YGUPCM: .FLT2 30.0 .FLT2 1.0 ;1 FOREGROUND COLOR .FLT2 133.0 ;RASTER, BACKGROUND WRITE, AND GIN AVAILABLE .FLT2 1.0 ;FILL EVERY LINE CWORDS = <.-CHRTBL>/2 .SBTTL SELECT COLOR ; ;SELECT COLOR - FUNCTION 8 ; SETCOL: JSR PC,FLUSH ;FLUSH OUT ALL VECTORS JSR PC,GETINT ;GET COLOR NUMBER CMP R1,#1 ;MAKE SURE A 0 OR 1 BLE 1$ ;YES ERROR 1$: ADD #61,R1 ;MAKE "1" FROM 0 AND "2" FROM 1 MOVB R1,ONOFF ;MAKE HP ESCAPE SEQUENCE JSR R4,COMAND ;SEND DOTS MESSAGE .ASCII '*m' ONOFF: .BYTE '0, 'A, 0 .EVEN RTS PC .SBTTL GIN COMMAND COMMON ; ;GRAPHICS INPUT WITH PICK CHARACTER - FUNCTION 8 ; GIN: JSR PC,FLUSH ;FLUSH VECTORS JSR PC,GETLIN ;PROMPT FOR CURSOR INPUT, GET THE RESPONSE ;R0 = GIN CHARACTER MOV (R5)+,R4 ;R4 ==> ARRAY FOR CHAR,X,Y .IF EQ OS-3 ;RSX11M SO FPU SETF SETI LDCIF R0,F0 ;FLOAT R0 INTO F0 STF F0,(R4)+ ;PLACE CHARACTER FIRST IN ARRAY .IFF ;RT11 AND TSX JSR PC,FLOAT ;FLOAT THE NUMBER MOV R0,(R4)+ ;PLACE IT FIRST IN THE ARRAY MOV R1,(R4)+ .ENDC ;EQ OS-3 MOV R4,UNXADD ;SHOW WHERE TO STORE X IN CM. ADD #4,R4 ;FIGURE OUT WHERE Y IN CM. GOES MOV R4,UNYADD ;SHOW WHERE TO STORE Y IN CM. MOV #UNSCR5,R5 ;PREPARE TO UNSCALE IX,IY TO X,Y JSR PC,GDGAID ;CALL FTN TO UNSCALE RTS PC ;AND DONE UNSCR5: .WORD 6 .WORD GINX,GINY,XGUPCM,YGUPCM UNXADD: .WORD 0 UNYADD: .WORD 0 .SBTTL HP 2648 GIN STUFF GETLIN: .IF EQ OS-3 ;RSX-11M MOV #FTTBUF,QDPB+Q.IOPL ;SET ADDRESS OF FLUSH TYPE AHEAD MOV #FTTSIZ,QDPB+Q.IOPL+2 ;NUMBER OF BYTES MOV #SF.SMC,QDPB+Q.IOFN ;SET FUNCTION TO SET MULT. CHAR DIR$ #QDPB ;FLUSH THE TYPEAHEAD BUFFER MOV #BUFST,QDPB+Q.IOPL ;SET BUFFER START ADD. MOV #18.,QDPB+Q.IOPL+2 ;SET EXPECTED NUMBER OF BYTES MOV #IO.RPR!TF.RNE,QDPB+Q.IOFN ;SET FUNCTION TO READ AFTER PROMPT ;WITH NO ECHO MOV #PROMPT,QDPB+Q.IOPL+6 ;SET PROMPT ADDRESS MOV #PRSIZE,QDPB+Q.IOPL+10 ;SET PROMPT SIZE CLR QDPB+Q.IOPL+12 ;VFC IS NORMAL DIR$ #QDPB ;EXECUTE THE READ BCS RDERR ;ERROR ON DIRECTIVE REJECTED CMPB IOSB,#IS.SUC ;MAKE SURE IT WORKED BNE RDERR .IFF ;RT11 AND TSX .PRINT #PROMPT ;ASK FOR A CURSOR READING MOV #BUFST,R1 ;PREPARE TO READ DATA INTO BUFFER MOV @#JSW,-(SP) ;SAVE OLD JSW BIS #TTSPC,@#JSW ;INHIBIT ECHO 11$: .TTYIN ;GET A CHAR INTO R0 CMPB R0,#LF ;SEE IF A LF BEQ 2$ ;IF SO, NEARLY ALL DONE MOVB R0,(R1)+ ;INSERT CHARACTER INTO BUFFER BR 11$ ;GO GET ANOTHER CHARACTER 2$: MOV (SP)+,@#JSW ;RESTORE JSW .IFTF ;RT11, TSX, AND RSX MOV #BUFST,R4 ;R4 ==> GIN BUFFER 1$: CMPB (R4)+,#'+ ;LOOK FOR PLUS SIGN OF X COORD. BNE 1$ ;NOT FOUND YET ADD #2,R4 ;SKIP THE TWO LEADING ZEROS JSR PC,GETHP ;CONVERT X MOV R0,GINX ;SAVE IT ADD #4,R4 ;SKIP ",+00" JSR PC,GETHP ;CONVERT Y MOV R0,GINY ;SAVE IY INC R4 ;SKIP "," JSR PC,GETHP ;CONVERT CHARACTER BIC #200,R0 ;MAKE SURE 7 BIT ASCII RTS PC ;DONE, WITH GIN CHARACTER IN R0 .IFT ;RSX RDERR: ERROR FTTBUF: .BYTE TC.TBF .BYTE 0 FTTSIZ = . - FTTBUF .ENDC ;EQ OS-3 PROMPT: .ASCII '*s4^' PRSIZE = . - PROMPT .IIF NE OS-3 .BYTE 200 .EVEN GETHP: MOV #3,R0 ;PREPARE FOR 3 DIGITS CLR R1 ;ZERO OUR NUMBER BR 2$ ;GO INTO LOOP 1$: .IF DF HAVEIS MUL #10.,R1 ;ADJUST FOR ENTRY OF NEXT DIGIT .IFF ASL R1 ;MULT. BY 2 MOV R1,-(SP) ;SAVE X2 ASL R1 ;X4 ASL R1 ;X8 ADD (SP)+,R1 ;X8+X2 = X10 .ENDC 2$: MOVB (R4)+,R2 ;GET ASCII CHAR SUB #60,R2 ;MAKE NUMBER ADD R2,R1 ;ADD IT IN SOB R0,1$ ;DO ALL CHARS. INC R3 ;SKIP OVER COMMA MOV R1,R0 ;PLACE IN R0 RTS PC .SBTTL HP COORDINATE CONVERSION ROUTINE CCOORD: MOV NEWX,R0 ;CONVERT X FIRST MOV BINPTR,R1 ;R1 ==> VECTOR BUFFER JSR PC,CONVRT ;DO X MOV NEWY,R0 ;PREPARE TO DO Y JSR PC,CONVRT ;DO Y MOV R1,BINPTR ;SAVE POINTER ADD #4,BUFCNT ;SHOW 4 CHARS ADDED RTS PC ;WE DID IT ALL CONVRT: MOV R0,-(SP) ;SAVE COORD. VALUE .REPT 5 ASR R0 ;DIVIDE BY 32 .ENDR BIC #177740,R0 ;ONLY GOOD 5 BITS BIS #32.,R0 ;ADD HP OFFSET CODING MOVB R0,(R1)+ ;PLACE FOR CALLER MOV (SP)+,R0 ;GET BACK VALUE BIC #177740,R0 ;GET 5 LSB BIS #32.,R0 ;ADD HP OFFSET CODING MOVB R0,(R1)+ ;PLACE FOR CALLER RTS PC .SBTTL MAKINT SUBROUTINE MAKINT: MOV (R5)+,XADD ;PASS X ARG ON MOV (R5)+,YADD ;PASS Y ARG ON MOV #SCLR5,R5 ;PREPARE TO CALL A FTN CALC. ROUTINE JSR PC,GDAID RTS PC SCLR5: .WORD 6 XADD: .WORD 0 YADD: .WORD 0 .WORD XGUPCM .WORD YGUPCM IXADD: .WORD NEWX IYADD: .WORD NEWY GETINT: MOV (R5)+,R4 ;POINT TO FLOATING VALUE GETIN2: .IF EQ OS-3 ;RSX11M HAS FPU SETF SETI LDF (R4)+,F0 ;GET FLOATING VALUE STCFI F0,R1 ;PLACE 16 LSB IN R1 RTS PC ;THATS IT .IFF ;NO FPU MOV (R4)+,R0 ;GET HIGH PART MOV (R4)+,R1 ;GET LOW PART MOV R0,R3 ;COPY EXPONENT MOV R0,-(SP) ;SAVE SIGN ALSO BIC #177600,R0 ;GET MANTISSA (ALMOST) BIS #200,R0 ;RESTORE HIDDEN BIT TO MANTISSA ASL R3 ;ALIGN EXPON. IN HIGH BYTE SWAB R3 ;PUT IN LOW BYTE BIC #177400,R3 ;GET ONLY EXPON. SUB #200,R3 ;TAKE OUT EXCESS 200 FROM EXPON. BLE 2$ ;IF <0 THEN NUMBER <1 SUB #24.,R3 ;COMPUTE RIGHT SHIFT COUNT CMP R3,#8. ;SEE IF > 2**32 -1 BGE 2$ ;IF THAT BIG, USE ZERO ASHC R3,R0 ;SHIFT RIGHT PROPER NUMBER OF BITS TST (SP)+ ;SEE IF MINUS BPL 1$ COM R0 ;NEG. D.P. INTEGER NEG R1 ADC R0 ;PROPAGE CARRY 1$: RTS PC ;AND DONE 2$: CLR R1 ;RETURN 0 CLR R0 TST (SP)+ ;FORGET STUFF ON STACK RTS PC FLOAT: MOV R0,R1 ;PREPARE TO FLOAT BEQ 9$ ;ALL DONE SIZE ITS ZERO CLR R0 ;ZERO HIGH PART MOV R2,-(SP) ;SAVE R2 MOV #46000,R2 ;R2=EXPONENT OF 24 BIT NUMBER 1$: SUB #200,R2 ;WHACK DOWN EXPONENT AS WE NORMALIZE ASL R1 ;SHIFT LOW LEFT ROLB R0 ;SHIFT HIGH LEFT BPL 1$ ;NOPE, KEEP ON SHIFTING BIC #177600,R0 ;KILL MSB BIS R2,R0 ;MAKE FLOATING PT. EXP + MANTISSA MOV (SP)+,R2 ;RESTORE R2 9$: RTS PC ;DONE .ENDC ;EQ OS-3 .SBTTL VECTOR BUFFER MANAGEMENT ROUTINES TFLUSH: MOV BUFCNT,-(SP) ;SEE IF BUFFER IS NEARLY FULL ADD (R4)+,(SP) ;BUFCNT+USERS_EXTRA CMP (SP)+,#BUFSIZ ;SEE IF MORE THAN BUFFER CAN HOLD BLOS 9$ ;NOPE, NO ACTION JSR PC,FLUSH ;TO MUCH, SO FLUSH BUFFER 9$: RTS R4 FLUSH: TST BUFCNT ;SEE IF ANY CHARACTERS IN BUFFER BEQ EXIT ;IF NOT, JUST EXIT MOV R1,-(SP) ;PRESERVE R1 MOV BINPTR,R1 ;PLACE A CAPITOL "Z" AT END OF BUFFER TSTB VMODE ;IF IN VECTOR MODE, EXIT WITH CAPITOL "Z" BEQ 1$ ;BRANCH IF NOT IN VECTOR MODE MOVB #'Z,(R1)+ ;PLACE THE "Z" INC BUFCNT ;AND COUNT IT 1$: .IF NE OS-3 ;RT11 MOVB #200,(R1)+ ;ZERO BYTE TERMINATES WITH CR/LF .PRINT #BUFST ;DO THE I/O NOW .IFF ;RSX JSR PC,DOQIO ;SEND TO THE TERMINAL .ENDC ;NE OS-3 MOV (SP)+,R1 ;RESTORE R1 DOINIT: CLR BUFCNT ;NO CHARS LEFT IN BUFFER ANY MORE MOV #BUFST,BINPTR ;RESTORE TO START OF BUFFER CLRB VMODE ;SHOW NOT IN VECTOR MODE EXIT: RTS PC ;AND DONE COMAND: JSR R4,TFLUSH ;MAKE SURE ROOM EXISTS FOR COMMAND .WORD 8. CLRB VMODE ;SHOW LEAVING VECTOR MODE ;FALL THRU TO INSERT INSERT: MOV R1,-(SP) ;SAVE R1 MOV BINPTR,R1 ;GET POINTER TO BUFFER 1$: MOVB (R4)+,(R1)+ ;INSERT A CHAR BEQ 2$ ;BRANCH ON END OF STRING INC BUFCNT ;ADD UP CHARS CMP BUFCNT,#BUFSIZ-1 ;CHECK FOR TOO MANY BMI 1$ ;NOPE ERROR 2$: DEC R1 ;BACK UP TO REAL CHAR MOV R1,BINPTR ;RESTORE POINTER MOV (SP)+,R1 ;RESTORE R1 INC R4 ;MAKE R4 EVEN BIC #1,R4 RTS R4 .SBTTL ERROR PROCESSING .IF NE OS-3 ;RT AND TSX ERROR1: MOV R0,-(SP) ;SAVE POINTER TO ERROR CODE .PRINT #NAME ;OUTPUT DRIVER NAME MOV (SP)+,R0 ;RESTORE POINTER TO TEXT .PRINT ;MAKE .PRINT CALL TRAP 300+63. ;GIVE FORTRAN ERROR MESSAGE .IFF ;RSX11M ERROR1: MOV #BUFST,R1 ;R1 ==> ERROR MESSAGE AREA MOV #NAME,R2 ;R2 ==> START OF MESSAGE 1$: MOVB (R2)+,(R1)+ ;MOVE START OF MESSAGE BNE 1$ ;GO TILL ALL MOVED DEC R1 ;BACK UP TO NEXT FREE BYTE 2$: MOVB (R0)+,(R1)+ ;PLACE SECOND HAVE OF MESSAGE IN BUFFER BNE 2$ CLR -(SP) ;2ND WORK OF MESSAGE BLOCK MOV #BUFST,-(SP) ;SET ADDRESS OF TEXT MOV SP,R0 ;R0 ==> MSG BLOCK CLR R1 ;SIGNAL NOT AN ERROR YET JSR PC,$ERRLG ;TYPE OUR MESSAGE CMP (SP)+,(SP)+ ;CLEAN UP THE STACK TRAP +341 ;GIVE NON-FTN4PLUS ERROR MESSAGE .ENDC ;NE OS-3 NAME: .ASCIZ "GD2648 - " .EVEN .IF EQ OS-3 .SBTTL QIO DRIVER DOQIO: MOV #BUFST,QDPB+Q.IOPL ;SET BUFFER ADDRESS MOV BUFCNT,QDPB+Q.IOPL+2 ;SET BYTE COUNT MOV #'+,QDPB+Q.IOPL+4 ;SET TO FORT. VFC - SUPPRESS LF MOV #IO.WAL,QDPB+Q.IOFN ;SET TO WRITE PASS ALL MOV #5,QDPB+Q.IOLU ;SET LUN=5 (TI:) DIR$ #QDPB ;EXECUTE THE QIO BCS WRTERR ;OOPS TSTB IOSB ;MAKE SURE TRANSFER WORKED BMI WRTERR ;OOPS RTS PC ;WHEW, WE DID IT UNDER RSX WRTERR: ERROR QDPB: QIOW$ IO.WAL,0,24.,0,IOSB,0, IOSB: .BLKW 2 .ENDC ;EQ OS-3 .SBTTL VARIABLES AND BUFFER XPOSN: .WORD 0 YPOSN: .WORD 0 NEWX: .WORD 0 NEWY: .WORD 0 GINX: .WORD 0 GINY: .WORD 0 VMODE: .BYTE 0 .EVEN BINPTR: .WORD BUFST ;MUST BE INITIALIZED TO "BUFST" BUFCNT: .WORD 0 BUFST: .BLKB BUFSIZ .END