;GRAFIX for M100/102 (Source code)
;base=GRFASM.DO(c)12/31/89 R H Pigford
;GRFAS2.DO Update 2/3/93 added ESCs
;For use with SKETCH.BA by R H Pigford.
CURSON:	EQU 4249H   ;like ESC "P"
CUROFF:	EQU 424EH   ;like ESC "Q"
TOPRT:	EQU 6D3FH   ;A regis to LPT
PLOT:	EQU 744CH   ;turn pixel on
UNPLOT:	EQU 744DH   ;turn pixel off
POSIT:	EQU 427CH   ;H=col,L=row pos
LCD:	EQU 4B44H   ;A to LCD
KYREAD:	EQU 7242H   ;like INKEY$
INLIN:	EQU 4644H   ;LINEINPUT
KEYBUF:	EQU F685H   ;Kybd Buff start,0
CAPS:	EQU 0FE8H   ;2/89 P100 pg22
BEEP:	EQU 4229H   ;better than 7662H
PUTTXT:	EQU 11A2H   ;to LCD point HL,0
ERAEOL:	EQU 425DH   ;Oppendahl pg225
CNVERT:	EQU 08EBH   ;ROMMAP pg 19
	ORG 60000
START:	JMP MENU
GF:	DW START    ;Hold 5 addrs
PF:	DW PRFLAG   ;for PEEKing
BS:	DW BUFFER   ;by SKETCH.BA.
BE:	DW END
FZ:	DW FILLCD
MENU:	MVI A,1     ;Flag =1 when enter
	STA PRFLAG  ; here.
	LXI H,0108H ;Start col 1, row 8
	CALL GETROW
MENU1:	CALL CLR8
	LXI H,MSG1  ;Point to msg
	CALL PUTTXT ;Send it to LCD
MENU2:	CALL GETKY
	CALL CAPS
	CPI 'P' ;print options
	JZ PSXY
	CPI 'S' ;save
	JZ FILBUF
	CPI 27 ;quit
	JZ MENU3
	JMP MENU2
MENU3:	CALL RSL1P
	MVI E,56
	CALL PUTROW
	RET
MSG1:	DB 27,'pGRAFIX',27,'q',' ',171,
	DB 'RHP <P>rint '
	DB '<S>ave ..<ESC>',0
;=== Puts LCD image into BUFFER:
;Save when RET to SKETCH.BA. 
;PRFLAG =0 if so.
FILBUF:	CALL RSL1P
	MVI E,56 ;line to put row(0-63)
	CALL PUTROW
	MVI A,0
	STA PRFLAG  ;set pntr=0 for RAM
	LXI H,0101H ;start at 1,1
	JMP SCNROW
;=== CALLed only from BASIC
;to fill LCD w/vals from .CO file
;found and pointed to by SKETCH.BA 
FILLCD:	SHLD L1PNTR ;saves file RAM 
	;addr passed from SKETCH.BA
	MVI A,5 ; not 0
	STA PRFLAG
	LXI D,0900H
FILLC1:	DCR D   ;Do 8 rows of 240 bytes
	RZ      ;Direct RET to basic
	PUSH D
	CALL PUTROW
	LXI D,240
	LHLD L1PNTR
	DAD D   ;incr Mem pointer + 240
	SHLD L1PNTR
	POP D
	MOV A,E ;incr E, pass to PUTROW
	ADI 8   ; (0,7,15,...,56)
	MOV E,A
	JMP FILLC1
;===
GETKY:	ORA A     ;clear carry status
	CALL KYREAD
	JZ GETKY  ;if nothing there
	CALL CAPS ;conv to caps
	RET	  ;if something in A
;===
CLR8:	LXI H,0108H ;col 1, row 8
	CALL POSIT
	CALL ERAEOL
	RET
;=== find Ht/Wdth combination for Prt
PSXY:	CALL CLR8
	LXI H,HGTMSG
	CALL PUTTXT ;height multiplier
PSXYH:	CALL GETKY  ; 1,2, or 4
	CPI 27
	JZ MENU1
	CPI '1'
	JM PSXYH
	CPI '3'
	JZ PSXYH
	CPI '5'
	JP PSXYH
	SUI 30H ;ascii -> decimal val
	STA PRFLAG
PSXYH1:	CALL CLR8
	LXI H,WIDMSG ;width multiplier
	CALL PUTTXT  ;1, 2, 3, or 4
PSXYW:	CALL GETKY
	CPI 27
	JZ PSXY
	CPI '1'
	JM PSXYW
	CPI '5'
	JP PSXYW
	SUI 30H
	STA PRWIDE ;save this value
;@@ new lft mrgn attempt
GETMGN:	CALL CLR8
	LXI H,MGNMSG
	CALL PUTTXT
	CALL INLIN
	LXI H,KEYBUF ;point buff,0/Ltr
;	ANA A ;clear carry to 0
	CALL CNVERT ;rets w/ val in DE
;	MOV A,D  ;D is supposed = 0
;	CPI 0
;	JP GETMGN  ; NOT WORKING!
	MOV A,E ;get the lsb value=num
	JM GETMGN
	CPI 80
	JP GETMGN
	STA LFTMGN ;a keeper
	CALL SETMGN
;@@ end test
	CALL SETMD ;to get GMODE vals
	CALL RSL1P
	MVI E,56    ;y row val to start
	CALL PUTROW ;restore graphics
	LXI H,0101H ;col=row=1
	CALL LNSPC  ;Set lnsp LPT value
	JC FINISH    ;Bailout if BRK
;=== Print/Save loop starts here
SCNROW:	CALL GETROW
	PUSH H
	LDA PRFLAG ;get RAM/LPT pointr.
	ANA A	   ;strobe Z flag.
	JZ ENDROW  ;if 0 fill buffer,
	CPI 01H    ; else Prt. Ht = ?
	JZ PR1HI
	CPI 02H
	JZ PR2HI
	CPI 04H
	JZ PR4HI
ENDROW:	POP H
NXTROW:	INR L	    ;row = row + 1
	MVI A,09H
	CMP L	    ;Is row = 9 ?
	JZ FINISH   ;Ret if L>8 (done).
	MVI H,01H   ;Start on left.
	JMP SCNROW  ;Do next row.
;=== Print/Save loop ends
HGTMSG:	DB 'Prt HEIGHT multiple? '
	DB '<1,2,4>...<ESC>',0
WIDMSG:	DB 'Prt WIDTH multiple? '
	DB '<1,2,3,4>...<ESC>',0
MGNMSG:	DB 'Left Margin <0-80> ?',0
;== SETMGN assumes 0-80 in A
SETMGN: MOV C,A ;save lft mgn value
	MVI A,27
	CALL TOPRT
	MVI A,108
	CALL TOPRT
	LDA LFTMGN
	CALL TOPRT
	RET
LFTMGN: DS 1
;== SETMD assumes a good val PRWIDE,
; looks up table, sets GMODE mode 
; values N1, N2
SETMD:	LDA PRWIDE
	MOV B,A
	LXI D,BASE
	LXI H,TABLE
SETMD1:	MOV A,M
	CMP B
	JZ FOUND
	DAD D
	JMP SETMD1
BASE:	EQU 0003D ;the TABLE increment
FOUND:	INX H ;move past PRWIDE val
	MOV A,M
	STA N1
	INX H
	MOV A,M
	STA N2
	RET
PRFLAG:	DB 1 ;default
PRWIDE:	DB 1 ;default
N1:	DS 1
N2:	DS 1
TABLE:	DB 1,240,0,2,224,1
	DB 3,208,2,4,192,3
;===
; PR1HI to just dump the 240 values
; in BUFFER to PRNTIT then reset
PR1HI:	CALL GMODE
	MVI E,240
	LXI H,BUFFER
PR1HI1:	MOV A,M
	CALL PRNTIT
	JC BRKOUT
	INX H
	DCR E
	JNZ PR1HI1
	CALL PCRLF
	JMP ENDROW ;exit or PR1HI
;===
; PR2HI tests the bytes in BUFFER and
; builds new bytes, two bits for each
PR2HI:	MVI B,2 ;prt pass counter
	MVI D,10000000B ;test word
PR2HI1:	CALL GMODE
	MVI E,240 ;start count
	LXI H,BUFFER
PR2HI2:	MVI C,0 ;clear for new byte
	MOV A,M ;get BUFFER val
	ANA D
	CNZ T2BITS
	MOV A,D ;get test word
	RRC
	MOV D,A
	MOV A,M ;get orig val
	ANA D
	CNZ U2BITS
	MOV A,D
	RRC
	MOV D,A
	MOV A,M ;get orig val again
	ANA D
	CNZ L2BITS
	MOV A,D
	RRC
	MOV D,A
	MOV A,M
	ANA D
	CNZ B2BITS
	MOV A,D
	RLC ;test word back to begin
	RLC ;to test next BUFFER val
	RLC 
	MOV D,A
	MOV A,C ;get the new word
	CALL PRNTIT
	JC BRKOUT
	INX H ;go to next BUFFER val
	DCR E ;BUFFER count -1
	JNZ PR2HI2
	CALL PCRLF
	MVI D,00001000B ;for 2nd pass
	DCR B ;prt pass count -1
	JNZ PR2HI1 ;do 240 more times
	JMP ENDROW ;all done so return
T2BITS:	MOV A,C ;get newword
	ORI 11000000B
	MOV C,A
	RET
U2BITS:	MOV A,C
	ORI 00110000B
	MOV C,A
	RET
L2BITS:	MOV A,C
	ORI 00001100B
	MOV C,A
	RET
B2BITS:	MOV A,C
	ORI 00000011B
	MOV C,A
	RET
;====== PR4HI is to test the 240 values
; in mem at BUFFER and print 4 rows x2
PR4HI:	MVI B,04 ;set decr counter
	MVI D,10000000B	;test val in D
NXTPAS:	CALL GMODE ;refresh grph mode
	MVI E,240  ;start count at 240
	LXI H,BUFFER ;get begin BUFFER
		     ; addr into HL
NXTVAL:	MVI C,0	;clear 2 build new word
	MOV A,M     ;get val from mem 
	ANA D 	;test if 'on'
	CNZ T4BITS ;since on, build new
	MOV A,D	;get test word
	RRC	;rotate 1 right
	MOV D,A ;save rotated test word
	MOV A,M ;get orig val again
	ANA D	;test if 'on'
	CNZ B4BITS ;since on build 4
	MOV A,D	;get test word
	RLC	;restore test bit word
	MOV D,A	;save test word
	MOV A,C	;get newword
	CALL PRNTIT ;send to PRT twice
	JC BRKOUT  ;bail out if S-Brk
	INX H	   ;HL=HL+1
	DCR E	   ;count=count - 1
	JNZ NXTVAL ;do another row
	CALL PCRLF
	MOV A,D	;get test value
	RRC	;shift to right 1 bit
	RRC	;rotate again
	MOV D,A	;save rsult
	DCR B	;pas# = pas#-1
	JNZ NXTPAS ;do 240 more
	JMP ENDROW ;end of PR4HI
T4BITS:	MOV A,C	;get NEWWRD
	ORI 11110000B ;fill in top 4
	MOV C,A	;put T4BITS back in C
	RET
B4BITS:	MOV A,C	;get NEWWRD
	ORI 00001111B ;fill in btm 4
	MOV C,A
	RET
;==== store a 40 chr row of data bytes
GETROW:	CALL RSL1P
	CALL CURSON
NXTCOL:	CALL POSIT  ;Go to col 1,row 1.
	PUSH PSW    ;Save value.
	CALL TIMER  ;Illumination time.
	POP PSW	    ;Get val back.
	PUSH H	;save for later
	CALL READ6  ;Go do 6 curs vals.
	POP H	;get r & c back
	INR H	    ;Col pos +1
	MVI A,41    ;Ready for test.
	CMP H	    ;Count > 40 ?
	JNZ NXTCOL  ;If not, do another
	CALL CUROFF
	RET
;PUTROW puts the graphics back by pixs
; assumes E = start row (0-55) for 8 
; rows of pixels. Uses C as a counter.
; D = x = 1->240.
PUTROW:	MVI B,10000000B
	MVI C,0 ;count up to 8 pix rows
NXTY:	MVI D,0 ;the x pixel col count
	LHLD L1PNTR
	INR C
	MOV A,C
	CPI 9
	RZ
BYTE:	PUSH H
	MOV A,M
	ANA B	   ; test: is it on?
	PUSH D
	PUSH B
	JNZ PSET   ;if so PSET it
	JZ PRESET  ;of not PRESET it
BACK:	POP B
	POP D
	POP H
	INX H
	INR D	   ;x=x+1
	MOV A,D    ;x val
	CPI 240
	JNZ BYTE
	MOV A,B
	RRC	   ; rotate it 
	MOV B,A    ; put it back
	INR E	;next y pixel row
	JMP NXTY
PSET:	CALL PLOT
	JMP BACK
PRESET:	CALL UNPLOT
	JMP BACK
;==== read 6 cursor vals and store 
READ6:	LXI H,65515 ;1st mem pointr - 1
POINTR:	INR L	    ;Goto next mem val.
	MOV A,M	    ;Get val @ cursor.
	CMA	    ;For reverse video.
	CALL FLIPER ;Invert bits
	PUSH H
	CALL STOREA ;put vals in mem
	POP H
	MOV A,L	    ;Curs lo bit val
	CPI F1H	    ;Last curs row? If
	JNZ POINTR  ; not last,do next.
	RET         ;Last, so next col.
;====== store values in reserved mem
STOREA:	LHLD L1PNTR ;get addr pointer
	MOV M,A	 ;put ORIG WORD there
	INX H	   ;incr the val in HL
	SHLD L1PNTR ;save incremented
	RET	    ; addr pointer
;====== inverts vals, bit by bit
; FLIPER to invert 8 bit vertical row
; B = original, C = new value built
; E = loop counter
FLIPER:	MOV B,A	    ;Save value in B
	MVI E,08H   ;Set decr counter
	MVI C,00H   ;Set new word to 0
	CALL FLIP1  ;Go do the invert
	MOV A,C	    ;Return the invert
	RET
FLIP1:	MOV A,B	    ;Put val back in.
	CALL CHKBIT ;Are bits on/off ?
	MOV A,B	    ;Put old word in
	RRC	    ;Rotate to next bit
	MOV B,A     ;Save value.
	MOV A,C     ;Get newword.
	RLC	    ;Rotate to next bit
	MOV C,A     ;Save back to C reg
	DCR E	    ;Take 1 from count
	MOV A,E	    ;Test count, if not
	JNZ FLIP1   ; 0, go back thru.
	RET	    ;If so then return.
CHKBIT:	ANI 00000001B ;Test bit on/off.
	CNZ BLDWRD  ;If on, build new.
	RET
BLDWRD:	MOV A,C	    ;Get new word.
	ORI 10000000B ;Add bit to word.
	MOV C,A	    ;Keep the new word.
	RET
;===== sends 24/144 spacing for GRAFIX
LNSPC:	MVI A,27   ; ESC
	CALL TOPRT ;Send ESC to LPT.
	MVI A,51   ;51="3" envoke lnsp
	CALL TOPRT ;Send 51 to LPT.
	MVI A,24   ; spacing for EPSON
	CALL TOPRT ; 9-pin graphics.
	RET
;=== refresh Graphics mode in LPT
GMODE:	MVI A,27
	CALL TOPRT
	MVI A,76    ;76="L"= dbl den
	CALL TOPRT ;graphics mode.
	LDA N1	   ;from TABLE
	CALL TOPRT ;dump as graphics.
	LDA N2	   ;from TABLE
	CALL TOPRT
	RET
;=== reset prt out of graphics mode
RSTPRT:	MVI A,27    ; ESC
	CALL TOPRT  ;Send to LPT
	MVI A,50    ; 50 = reset lnfd
	CALL TOPRT ; to 1/6 inch.
	RET
;=== send Carriage ret and Line feed
PCRLF:	MVI A,13
	CALL TOPRT
;	MVI A,10
;	CALL TOPRT
	RET
;=====  send A value to printer
PRNTIT:	ANA A	    ;Set Carry Flag = 0
	PUSH B
	PUSH H
	LXI H,PRWIDE
	MOV B,M ;get the width multpl.
	POP H
PRNTI1:	CALL TOPRT  ;Send A val to LPT.
	DCR B
	JZ PRNTI2
	JMP PRNTI1
PRNTI2:	POP B
	RET
;=== allow time to illuminate LCD
TIMER:	MVI A,255   ;255 X # NOPs =
TIME?:	NOP	    ;Do nothing
	NOP
	NOP
	NOP
	NOP
	DCR A
	RZ
	JMP TIME?
BRKOUT:	POP H	    ;If BRK from GMODE
	CALL BEEP   ;BEEP signals ERR.
	CALL BEEP
	JMP MENU    ;then this = END
FINISH:	LDA PRFLAG
	ANA A	    ;strobe Z flag
	JZ BEEP2    ;0 only if Save
	CALL RSTPRT ;Val for LPT reset.
BEEP1:	CALL BEEP
	CALL CUROFF ;Return LCD to prev
	JMP MENU
BEEP2:	CALL BEEP
	CALL BEEP
	RET ;to Basic (image in BUFFER)
;=== reset mem pointer value
RSL1P:	PUSH H	    ;save row/col
	LDA PRFLAG
	ANA A    ;strobe Z flag
	JZ RSL11 ;bypass if PRFLAG=0
	LXI H,BUFFER ;get actual addr
	SHLD L1PNTR ;store that as pntr
RSL11:	POP H	    ;get row/col back
	RET
L1PNTR:	DS 2	    ;reserve 2 bytes
BUFFER:	DS 1920	    ;reserve 240 bytes
END:	END