********************************************************
***	Drawing program for HIGH RESOLUTION Graphics	***
********************************************************
*	6*
* The picture will be stored in a special format	*
*	6*
* Copyright (C) W. Schwotzer 27.06.1982	*
* modified	W. Schwotzer 08.01.1997	*
********************************************************

**************
** Equates	**
**************

OUTCH	EQU	$F018
OUT2H	EQU	$F01B
OUT4H	EQU	$F01E
PIAD	EQU	$FCF0
PIAC	EQU	$FCF1
SWITCH	EQU	$F036
SWTCHB	EQU	$F038
WARMS	EQU	$CD03
VICO2	EQU	$FCF7

BASE	EQU	$0000
ESC	EQU	$1B
ENTER	EQU	$0D
KP1	EQU	$F1
KP5	EQU	$F5
KP9	EQU	$F9

****************************
**	Main program	***
****************************

 
 ORG $8000	

KALT JMP KALT1
WARM JMP WARM1

ZEIGER FCB $10,$10,$10,$EE,$10,$10,$10
GROPNT FCB $FE,$FE,$FE,$FE,$FE,$FE,$FE
GESBIL FDB 2044,2048,2052,-4,0,4,-2052,-2048,-2044
WINDOW FDB 511,512,513,-1,0,1,-513,-512,-511
ZWSP	RMB 2
ZWSP1	RMB 1
ZWSP2	RMB 1
ZWSP3	RMB 2
GEBIPO RMB 2 Gesamtbildpointer
WIBIPO RMB 2 Windowpointer
STATUS RMB 1 paint in white(1) or black(0)
BYTE	RMB 1 
BIT	RMB 1
FARBE	RMB 1 actual color during saving of picture
ZAELER RMB 1 dotcounter
CURPOS RMB 2 latch for cursorposition

* cold start entry point

KALT1 LDX #$0C0C
 LDY #$0C0C
 LDB #$E0
 JSR [SWITCH]
 LDX #-1
 LBSR TVCLR
WARM1 LDX #BASE+$2010
 STX WIBIPO
 LDX #BASE
 STX GEBIPO
WARM2 CLR VICO2
 LBSR TRANS0
 LBSR KA816
 LBSR ZCOMPG
LOOPBW LBSR BEWR
 CMPA #$FF
 BEQ KEINEB
 LBSR ZCOMPG
 LDU #GESBIL
 LDX GEBIPO
 LBSR NEWADR
 STX GEBIPO
 LBSR ZCOMPG
 LDY #10
 LBSR VERZ
KEINEB LBSR BEFIN
 CMPA #$FF
 BEQ LOOPBW
 CMPA #ENTER
 BEQ WECHSEL
 CMPA #'D
 LBEQ STO
 CMPA #'B
 BNE LOOPBW
 LBSR KA816
 LDY #10
 LBSR VERZ
 BRA LOOPBW
WECHSEL LDX #BASE+$FFFF	switch to window
 LBSR TVCLR
 LBSR KA3232
 LDX GEBIPO
 LEAX $4000,X
 CLR STATUS
 LBSR STACOM
 LDY GEBIPO
 LEAY $4000,Y
 LDX #BASE+$FFFF
 STX ZWSP3
 LDU #BASE+$1C27
 LDB #32
 STB ZWSP1
 LDA #4
 STA ZWSP2
ZW2OK LDA ,Y+
 STA ,U+
 STA BYTE
 CLRB
 ORCC #1
KEINP LDX ZWSP3
 LEAX 1,X
 STX ZWSP3
 RORB
 BEQ NEXBYT
 STB BIT
 ANDB BYTE
 BNE LOOPA1
NEX LDB BIT
 ANDCC #$FE
 BRA KEINP
LOOPA1 LDX ZWSP3
 LBSR GRSTCL
 BRA NEX
NEXBYT LDX ZWSP3
 LEAX -1,X
 STX ZWSP3
 DEC ZWSP2
 LBNE ZW2OK
 LDA #4
 STA ZWSP2
 DEC ZWSP1
 BEQ FERTIG
 LDX ZWSP3
 LEAX $1E0,X
 STX ZWSP3
 LEAU 60,U
 LEAY 60,Y
 BRA ZW2OK
FERTIG LBSR STACOM
 LDX WIBIPO
 LBSR ZCOMP
LOOPZE LBSR BEWR
 CMPA #$FF
 BEQ KEINZE
 LDX WIBIPO
 LBSR ZCOMP
 LDU #WINDOW
 LDX WIBIPO
 LBSR NEWADR
 STX WIBIPO
 LBSR GRSTCW
 LBSR ZCOMP
 LDU GEBIPO
 LEAU $4000,U
 LDY WIBIPO
 LBSR SETKLP
 LDU #BASE+$1C27
 LBSR SETKLP
 INC ZAELER
 BSR OUTZAE
 LDY #10
 LBSR VERZ
KEINZE LBSR BEFIN
 CMPA #$FF
 BEQ LOOPZE
 CMPA #ENTER
 LBEQ WARM2
 CMPA #'A
 BEQ CLRZAE
 CMPA #KP5
 BNE CMP43
 LBSR STACOM
 LDY #10
 LBSR VERZ
 BRA LOOPZE
CMP43 CMPA #'C
 BNE LOOPZE
 LDX GEBIPO
 LEAX $4000,X
 LBSR ALLSC
 LDX #BASE+$1C27
 LBSR ALLSC
 LDB #32
 STB ZWSP1
 STB ZWSP2
 LDX #BASE+$FFFF
LOOPAG LEAX 1,X
 LBSR GRSTCL
 DEC ZWSP1
 BNE LOOPAG
 LEAX 480,X
 LDB #32
 STB ZWSP1
 DEC ZWSP2
 BNE LOOPAG
 LDX WIBIPO
 LBSR ZCOMP
 LBRA LOOPZE
CLRZAE CLR ZAELER 
 BSR OUTZAE
 LBRA LOOPZE

*************************
***	Subprograms	***
*************************

* output counter value

OUTZAE LDA #ESC
 JSR OUTCH
 LDA #'E
 JSR OUTCH
 LDA #$20+6
 JSR OUTCH
 LDA #$20+46
 JSR OUTCH
 LDX #ZAELER
 JSR OUT2H
 RTS 

* clear page 0 or 1

TVCLR PSHS A,B
 LDD #$4000
LOESCH CLR D,X
 SUBD #1
 BNE LOESCH
 PULS A,B
 RTS

* copy page 1 to page 0

TRANS0 PSHS A,X
 LDX #$4000
TRANS LDA $3FFF,X
 STA -1,X
 LEAX -1,X
 BNE TRANS
 PULS A,X
 RTS

* complement horizontal line

WALCOM PSHS A,B
COMLIW LDB #$FF
 EORB A,X
 STB A,X
 DECA
 BNE COMLIW
 PULS A,B
 RTS

* complement vertical line

SLICOM PSHS B,X
COMLIS LDB #1
 EORB ,X
 STB ,X
 LEAX 64,X
 CMPX #BASE+$4000
 BLO COMLIS
 PULS B,X
 RTS

* complement 8 x 16 sqare pattern 

KA816 LDX #BASE+$07BF
 LDA #$40
KAROWA BSR WALCOM
 LEAX $800,X
 CMPX #BASE+$4000
 BLO KAROWA
 LDX #BASE+$0003
KAROSE BSR SLICOM
 LEAX 4,X
 CMPX #BASE+$0040
 BLO KAROSE
 RTS

* complement 32 x 32 square pattern

KA3232 LDX #BASE+$01BF
 LDA #$20
KARWA1 BSR WALCOM
 LEAX $200,X
 CMPX #BASE+$4000
 BLO KARWA1
 LDX #BASE+$0000
KARSE1 BSR SLICOM
 LEAX 1,X
 CMPX #BASE+$0020
 BLO KARSE1
 RTS

* complement pointer

ZCOMP PSHS A,B,U,Y
 TFR X,D
 ANDB #$3F
 ANDA #$FE
 TFR D,X
 LDA #2
 LDU #ZEIGER
 BSR U77M
 PULS A,B,U,Y
 RTS

* set, reset or complement	7 x 7 dot-matrix

U77M LEAY $1C0,X
 STY ZWSP
LOOPU7 LDB ,U+
 CMPA #0
 BEQ CLR
 CMPA #1
 BEQ SET 
 EORB ,X
 BRA SAMMEL
SET ORB ,X
 BRA SAMMEL
CLR COMB
 ANDB ,X
SAMMEL STB ,X
 LEAX $40,X
 CMPX ZWSP
 BLO LOOPU7
 LEAX -$100,X
 RTS

* delay loop

VERZ PSHS A,Y
LOOPY LDA #$90
LOOPA DECA
 BNE LOOPA
 LEAY -1,Y
 BNE LOOPY
 PULS A,Y,PC

* insert direction

BEWR LBSR INKEY
 CMPA #KP1
 BLO KEININ
 CMPA #KP9
 BHI KEININ
 CMPA #KP5
 BEQ KEININ
 SUBA #KP1
 LSLA
 RTS
KEININ LDA #$FF
 RTS

* calculate new address

NEWADR PSHS A,B
 LDD A,U
 NOP
 ADDD #$40
 LEAX D,X
 CMPX #BASE+$0000
 BHS INR
 LEAX $4000,X
INR CMPX #BASE+$3FFF
 BLS INR1
 LEAX -$4000,X
INR1 TFR X,D
 ANDA #$FE
 ANDB #$3F
 TFR D,X
 CMPU #WINDOW
 BLO RETNEW 
 ROLB
 ROLB
 ROLB
 BCC RETNEW
 LEAX -$20,X
RETNEW PULS A,B
 RTS

* input command

BEFIN LBSR INKEY 
 CMPA #ENTER
 BEQ BEFEIN
 CMPA #KP5	Keypad 5
 BEQ BEFEIN
 CMPA #'A
 BLO KEBEF
 CMPA #'D
 BLS BEFEIN
KEBEF LDA #$FF
BEFEIN RTS

* set little dot

SETKLP PSHS A,B,X
 TFR Y,D
 ANDB #$1F
 ANDA #$3E
 STB ZWSP2
 ANDB #7
 STB ZWSP1
 LDB ZWSP2
 LSRB
 LSRA
 LSRA
 RORB
 LSRA
 RORB
 LEAU D,U
 LDB ZWSP1
 INCB
 CLRA
 ORCC #1
ROTRI RORA
 DECB
 BNE ROTRI
 TFR A,B
 LDA STATUS
 CMPA #0
 BNE SETZ
 COMB
 ANDB ,U
 BRA ZUS
SETZ ORB ,U
ZUS STB ,U
 PULS A,B,X
 RTS

ZCOMPG LDX GEBIPO
 LEAX $2C1,X
 LBSR ZCOMP
 RTS

* check for a key hit
*	return it's ASCII-value in A
*	if no key hit return $ff in A

INKEY LDA PIAC
 BPL KEING
LOOPBR LDA PIAD
 RTS
KEING LDA #$FF no key hit, return $ff
 RTS

* set big point

GRSTCL PSHS A,B,U,X,Y
 TFR X,D
 ANDA #$FE
 ANDB #$3F
 TFR D,X
 LDA STATUS
 LDU #GROPNT
 LBSR U77M 
 PULS A,B,U,X,Y
 RTS

GRSTCW LDX WIBIPO
 BSR GRSTCL
 RTS

* complement status

STACOM PSHS A,X
 LDA STATUS
 BEQ SET1
 CLRA
 BRA STOR
SET1 LDA #1
STOR STA STATUS
 LDX #BASE+$0425
 LBSR GRSTCL
 PULS A,X
 RTS

* set or clear total window

ALLSC PSHS A,B,X,Y
 LDA STATUS
 BEQ OK
 LDA #$FF
OK LDB #32
OK1 LEAY 4,X
 STY ZWSP3
LOOPAL STA ,X+
 CMPX ZWSP3
 BLO LOOPAL
 LEAX 60,X
 DECB
 BNE OK1
 PULS A,B,X,Y
 RTS

* count bytes with same contents

BYTZAE PSHS A,B,Y
 LDY #1
 LDA ,X+
 CMPA ,X
 BNE ONLY1
LOOPBY CMPA ,X+
 BNE ZUR 
 LEAY 1,Y
 LBSR XEND
 BCS LOOPBY
 BRA RETBY
ZUR STA FARBE
 DEX
 ORCC #1
RETBY STY ,U++
RETBY1 PULS A,B,Y
 RTS
ONLY1 STA FARBE
 LDA #$FC
 STA ,U+
 BSR XEND
 BRA RETBY1

* save bytes with different values

GEMBYT PSHS A,B,Y
 CLR ZWSP2
 STU ZWSP3
 LEAU 1,U
LOOPGE LDA ,X+
 CMPA #$FF
 BEQ ZUR2
 CMPA #0
 BEQ ZUR2
 BSR XEND
 BCC ZUR1
 STA ,U+
 BSR INCZW
 BRA LOOPGE
ZUR2 ORCC #1
ZUR1 PSHS CC
 CMPA FARBE
 BEQ FANGEW
 LDA #$8F
 BRA FAGEWE
FANGEW STA FARBE
 LDA #$3F
FAGEWE LDB ZWSP2
 CMPB #$50
 BLS ADANZ
 CMPA #$8F
 BEQ ADA
 LDA #$8E
ADA ADDA #$70
 CLR ,U+
 BRA STOU
ADANZ ADDA ZWSP2
STOU LDY ZWSP3
 STA ,Y
 DEX 
 PULS CC
 PULS A,B,Y
 RTS

INCZW PSHS A
 INC ZWSP2
 BNE ZUKL
 LDA #$FF
 STA ZWSP2
ZUKL PULS A
 RTS

XEND CMPX #BASE+$0000
 RTS

* save picture

STO LDU #BIL
 CLR FARBE
 LDX #$0
 LDA ,X
 CMPA #0
 BEQ UNIBYT
 CMPA #$FF
 BNE GEMB
UNIBYT STA ,U+
 STA FARBE
LOOPCO LBSR BYTZAE
 BCC ENDSTO
 LDA FARBE 
 COMA
 CMPA ,X
 BEQ LOOPCO
GEMBY LBSR GEMBYT
 BCC ENDSTO
 BRA LOOPCO
GEMB CLR ,U+
 CLR FARBE
 BRA GEMBY
ENDSTO LDA #$FD
 STA ,U+
 STU ZWSP3
 LBSR TVCLR
 LDA #ENTER
 JSR OUTCH
 LDX #ZWSP3
 JSR OUT4H
 JSR [SWTCHB]
 JMP WARMS
 JSR BILANF	Start, wenn Bilds.0 auf Bilds.1 uebertr.wird
 LDX #BASE+$0000
FRO1T0 LDA $3FFF,X
 STA -1,X
 LEAX -1,X
 BNE FRO1T0
 JMP WARM


 ORG $8500	reading compressed picture
 BSR BILANF
LOOPEV BRA LOOPEV
 BSR BILCOM
 BRA LOOPEV
BILANF BSR SETU
 CLR ,U
 BRA ANF
BILCOM BSR SETU
 LDA #$FF
 STA ,U
ANF CLR VICO2
 LEAX BIL,PCR
 LDA ,U
 EORA ,X+
 STA 1,U
 LDY #BASE+$0000
 STY 2,U
NEXT LDA ,X+
 CMPA #$FD
 BEQ BACK1
 CMPA #$FF
 BEQ BITMOD
 CMPA #$FE
 BEQ BITMO1
 CMPA #$FC
 BEQ ONLY1B
 CMPA #$3F
 BHI BITS
 LEAX -1,X
 LDY ,X++
 PSHS X
 LDX 2,U
 LDA 1,U
LOOPTE STA ,X+
 LEAY -1,Y
 BNE LOOPTE
 STX 2,U
 PULS X
 COM 1,U
 BRA NEXT
SETU LEAU SPEI,PCR
 RTS
SPEI RMB 4
BACK1 RTS
BITMO1 COM 1,U
BITMOD LDY 2,U
LOOPBI LDB ,X+
 BEQ BACBIT
 EORB ,U
 STB ,Y+
 BRA LOOPBI
BACBIT STY 2,U
 BRA NEXT
BITS CMPA #$8F
 BLS BITS1
 COM 1,U
 SUBA #$50
BITS1 COM 1,U
 LDY 2,U
 SUBA #$3F
LOOPB1 LDB ,X+
 EORB ,U
 STB ,Y+
 DECA
 BNE LOOPB1
 BRA BACBIT
ONLY1B LDB 1,U
 LDY 2,U
 STB	,Y+
 STY 2,U
 COM 1,U
 BRA NEXT

BIL EQU *

 END KALT

