;GRF200.DO updated 2/6/2004
;GRF201.DO = v0.0 src code T200 7/25/91
;GRF v0.0 (c) 11/14/90 RHP
;for T200, adapted from GRAFIX.CO
;for M100 (c) RHPigford
;for use with SKT200.BA (SKETCH.BA)
;	T200	   M100
;	----	   ----
CURSON:	EQU 20328 ;4249H ESC "P"
CUROFF:	EQU 20333 ;424EH ESC "Q"
TOPRT:	EQU 33993 ;6D3FH A to LPT
PLOT:	EQU 36214 ;744CH pixel on
UNPLOT:	EQU 36215 ;744DH pixel off
POSIT:	EQU 20379 ;427CH H=col,L=row
LCD:	EQU 23045 ;4B44H A to LCD, ret
KYREAD:	EQU 35587 ;7242H INKEY$
CAPS:	EQU 4115  ;0FE8H 2/89 P100 pg22
BEEP:	EQU 20293 ;4229H ruins BC
PUTTXT:	EQU 28155 ;11A2H to LCD pointed
		  ;to by HL, ended by 0
ERAEOL:	EQU 20348 ;425DH Opndl pg225
CURVAL:	EQU 64864 ;65516 ?
;--[ start MENU loop ]-----------------
	ORG  56300 ;=61103-(880+3840) 
START:	JMP MENU
GF:	DW START
PF:	DW PRFLAG
BS:	DW BUFFER
BE:	DW END
FZ:	DW FILLCD
MENU:	MVI A,1
	STA PRFLAG
	LXI H,0110H ;row 01D,col 16D
	CALL GETROW
MENU1:	CALL CLR16
	LXI H,MSG1
	CALL PUTTXT
MENU2:	CALL GETKY
	CALL CAPS
	CPI 'P'
	JZ PSXY
	CPI 'S'
	JZ FILBUF
	CPI 'Q'
	JZ MENU3
	JMP MENU2
MENU3:	CALL RSL1P
	MVI E,120
	CALL PUTROW
	RET
;end Menu
MSG1:	DB 27,'pGRF200',27,'q',' ',171,
	DB 'RHP <P>rint '
	DB '<S>ave ..<Q>uit',0
;LCD to BUFFER
;save when ret SKETCH
;if so,PRFLAG=0
FILBUF:	CALL RSL1P
	MVI E,120
	CALL PUTROW
	XRA A ;A=0
	STA PRFLAG ;pntr=0 for RAM
	LXI H,0101H
	JMP SCNROW
;=called only from BASIC
;fill LCD w/vals from .CO file
;pointed to by SKETCH
FILLCD:	SHLD L1PNTR
	MVI A,5
	STA PRFLAG
	LXI D,1100H ;16d=10h
FILLC1:	DCR D
	RZ ;to basic
	PUSH D
	CALL PUTROW
	LXI D,240
	LHLD L1PNTR
	DAD D
	SHLD L1PNTR
	POP D
	MOV A,E
	ADI 8
	MOV E,A
	JMP FILLC1
;=
GETKY:	ORA A     ;clear carry
	CALL KYREAD
	JZ GETKY 
	CALL CAPS
	RET
;=
CLR16:	LXI H,0110H ;16d=10h
	CALL POSIT
	CALL ERAEOL
	RET
;=
; PSXY (c)1989 RHP
; Store val from last row, send prompt.
PSXY:	CALL CLR16
	LXI H,HGTMSG
	CALL PUTTXT ;height
PSXYH:	CALL GETKY
	CPI '1'
	JM PSXYH
	CPI '3'
	JZ PSXYH
	CPI '5'
	JP PSXYH
	SUI 30H
	STA PRFLAG
	CALL CLR16
	LXI H,PRTMSG ;width
	CALL PUTTXT
PSXYW:	CALL GETKY
	CPI '1'
	JM PSXYW
	CPI '5'
	JP PSXYW
	SUI 30H ; make readable
	STA PRWIDE
	CALL SETMD
	CALL RSL1P
	MVI E,120
	CALL PUTROW
	LXI H,0101H
	CALL LNSPC
	JC FINISH ;BRK?
;-print LOOP
SCNROW:	CALL GETROW
	PUSH H
	LDA PRFLAG
	ANA A ;A=0?
	JZ ENDROW
	CPI 01H
	JZ PR1HI  ;1-1=0
	CPI 02H
	JZ PR2HI
	CPI 04H
	JZ PR4HI
ENDROW:	POP H
NXTROW:	INR L
	MVI A,11H ;17d=11h
	CMP L
	JZ FINISH
	MVI H,01H
	JMP SCNROW
;= msgs
HGTMSG:	DB 'Prt HEIGHT multiple? '
	DB '<1,2,4>',0
PRTMSG:	DB 'Prt WIDTH multiple? '
	DB '<1,2,3,4>',0
;= SETMD sets GMODE,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
FOUND:	INX H
	MOV A,M
	STA N1
	INX H
	MOV A,M
	STA N2
	RET
PRFLAG:	DB 1
PRWIDE:	DB 1
N1:	DS 1
N2:	DS 1
TABLE:	DB 1,240,0,2,224,1
	DB 3,208,2,4,192,3
;======
; PR1HI dump 240 BUFFER values
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
;=======
; PR2HI tests BUFFER builds new bytes
PR2HI:	MVI B,2
	MVI D,10000000B
PR2HI1:	CALL GMODE
	MVI E,240
	LXI H,BUFFER
PR2HI2:	MVI C,0
	MOV A,M
	ANA D
	CNZ T2BITS
	MOV A,D
	RRC
	MOV D,A
	MOV A,M
	ANA D
	CNZ U2BITS
	MOV A,D
	RRC
	MOV D,A
	MOV A,M
	ANA D
	CNZ L2BITS
	MOV A,D
	RRC
	MOV D,A
	MOV A,M
	ANA D
	CNZ B2BITS
	MOV A,D
	RLC
	RLC
	RLC
	MOV D,A
	MOV A,C
	CALL PRNTIT
	JC BRKOUT
	INX H
	DCR E
	JNZ PR2HI2
	CALL PCRLF
	MVI D,00001000B
	DCR B
	JNZ PR2HI1
	JMP ENDROW
T2BITS:	MOV A,C
	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 tests BUFFER print 4 rows x2
PR4HI:	MVI B,04
	MVI D,10000000B
NXTPAS:	CALL GMODE
	MVI E,240
	LXI H,BUFFER
NXTVAL:	MVI C,0
	MOV A,M
	ANA D
	CNZ T4BITS
	MOV A,D
	RRC
	MOV D,A
	MOV A,M
	ANA D
	CNZ B4BITS
	MOV A,D
	RLC
	MOV D,A
	MOV A,C
	CALL PRNTIT
	JC BRKOUT
	INX H
	DCR E
	JNZ NXTVAL
	CALL PCRLF
	MOV A,D
	RRC
	RRC
	MOV D,A
	DCR B
	JNZ NXTPAS
	JMP ENDROW
T4BITS:	MOV A,C
	ORI 11110000B
	MOV C,A
	RET
B4BITS:	MOV A,C
	ORI 00001111B
	MOV C,A
	RET
;==== store row graphic vals
GETROW:	CALL RSL1P
	CALL CURSON
NXTCOL:	CALL POSIT
	PUSH PSW
	CALL TIMER
	POP PSW
	PUSH H
	CALL TWSTCR
	POP H
	INR H
	MVI A,41
	CMP H
	JNZ NXTCOL
	CALL CUROFF
	RET
;PUTROW puts the graphics back by pixs
; assumes E = start row (0-120) for 16
; rows of pixels
PUTROW:	MVI B,10000000B
	MVI C,0
NXTY:	MVI D,0
	LHLD L1PNTR
	INR C
	MOV A,C
	CPI 9
	RZ
BYTE:	PUSH H
	MOV A,M
	ANA B
	PUSH D
	PUSH B
	JNZ PSET
	JZ PRESET
BACK:	POP B
	POP D
	POP H
	INX H
	INR D
	MOV A,D
	CPI 240
	JNZ BYTE
	MOV A,B
	RRC
	MOV B,A
	INR E
	JMP NXTY
PSET:	CALL PLOT
	JMP BACK
PRESET:	CALL UNPLOT
	JMP BACK
;= read 6 curs vls,store 
TWSTCR:	LXI H,CBUF
	SHLD CBPNTR
	MVI B,00000001B
	MVI D,6
NX_BUF:	LHLD CBPNTR
	XRA A ;A=0
	MOV M,A ;clear RAM addr
	MVI E,8
	MVI C,10000000B
	LXI H,CURVAL-1
NX_CUR:	INX H
	MOV A,M ;get orig val
	ANA B ;is this pix on?
	JZ BYPASS
	PUSH H
	LHLD CBPNTR
	MOV A,M ;get the CBUF val
	ORA C ;add a corresp.bit
	MOV M,A
	POP H
BYPASS:	MOV A,C
	RRC ;rot to next bit
	MOV C,A
	DCR E
	JNZ NX_CUR
	LHLD CBPNTR
	MOV A,M ;get new byte
	CMA ;reverse video
	LHLD L1PNTR
	MOV M,A ;save it where L1PNTR
		;points
	INX H
	SHLD L1PNTR
	LHLD CBPNTR
	INX H
	SHLD CBPNTR
	MOV A,B
	RLC ;rot to next build bit
	MOV B,A
	DCR D ;last byte?
	JNZ NX_BUF
	RET
CBPNTR:	DS 2
CBUF:	DS 6
;= sends 24/144 spacing
LNSPC:	MVI A,27
	CALL TOPRT
	MVI A,51
	CALL TOPRT
	MVI A,24
	CALL TOPRT
	RET
;= refresh Graphics
GMODE:	MVI A,27
	CALL TOPRT
	MVI A,76
	CALL TOPRT
	LDA N1
	CALL TOPRT
	LDA N2
	CALL TOPRT
	RET
;= reset prt out of graphics
RSTPRT:	MVI A,27
	CALL TOPRT
	MVI A,50
	CALL TOPRT
	RET
;= send CR+LF
PCRLF:	MVI A,13
	CALL TOPRT
	MVI A,10
	CALL TOPRT
;	NOP
;	NOP
;	NOP
;	NOP
;	NOP
	RET
;=  send to prt
PRNTIT:	ANA A ;carry=0
	PUSH B
	PUSH H
	LXI H,PRWIDE
	MOV B,M
	POP H
PRNTI1:	CALL TOPRT
	DCR B
	JZ PRNTI2
	JMP PRNTI1
PRNTI2:	POP B
	RET
;= time to illuminate
TIMER:	MVI A,200
TIME?:	NOP
	NOP
	NOP
	NOP
	NOP
	DCR A
	RZ
	JMP TIME?
BRKOUT:	POP H ;if BRK from GMODE
	CALL BEEP
	CALL BEEP
	JMP MENU
FINISH:	LDA PRFLAG
	ANA A
	JZ BEEP2 ;if save is active
	CALL RSTPRT
BEEP1:	CALL BEEP
	CALL CUROFF
	JMP MENU
BEEP2:	CALL BEEP
	CALL BEEP
	RET
;= reset mem pointer
RSL1P:	PUSH H
	LDA PRFLAG
	ANA A
	JZ RSL11
	LXI H,BUFFER
	SHLD L1PNTR
RSL11:	POP H
	RET
L1PNTR:	DS 2
BUFFER:	DS 3840
END:	END