wudsn-ide/com.wudsn.ide.ref/ASM/C64/ACME/examples/Core.a

;ACME 0.07

!zone
; Programm:
mainloop
;Cursor setzen:
	lda  posy;screeny = posy-spry
	sec
	sbc  scry
	tay;y in Y
;ab hier X
	lda  posx;screenx = posx-scrx
	sec
	sbc  scrx
	jsr  crsrset;set crsr
;hier eigentliche Hauptroutine
	lda  nwfrm;new frame ?
	beq .j3
	jsr  newframe;yes = >
.j3	lda  updatewbi;update flags?
	beq .j2
	jsr  showwbi;yes = >
.j2	jsr  getchar;get CHARACTER
	tax; & buffer
	and #%.##.....;command ?
	beq .j; yes = >
	eor #%.##.....;command ?
	beq .j; yes = >
	jsr  chrout;char out
	jmp  mainloop
.j	jsr  execom;execute command
	jmp  mainloop

!zone
; Pseudo-Sub: (ESC uses jmp)
F_esc
	clc;'ESC' on!
	lda  clraktv
	ldx #hFlag_Escape
	jsr  setflagdata
.l	jsr  getkey;get KEY
	beq .l
	sta  byte; & buffer
	clc;'ESC' off!
	lda  clrinak
	ldx #hFlag_Escape
	jsr  setflagdata
	ldx  byte;get byte
	txa; & buffer
	eor #%.#......;a-z ?
	and #%.##.....
	bne .j;no = >
	txa;get byte
	and #%...#####; & short
	asl;*2 &
	tax; as index
	lda  etab+1,x;get Hi
	beq .no;0 = >
	sta .m+2;set
	lda  etab,x;get Lo
	sta .m+1;set
.m	jmp MODIFIED16;execute sequence
.no	rts;nothing...
.j	txa;get byte ( = FKey?)
	bpl .no; out = >
	eor #%..#.....;convert
	and #%.##.....;test
	beq .no; out = >
	txa;get byte
	and #%...#####;convert
	cmp #$05;test bottom border
	bcc .no; too low = >
	cmp #$0d;test upper border
	bcs .no; too high = >
; here: define f-keys !
	rts

!zone
; NMI
nmirtn
	lda #0;clear keybuffers
	sta  ndx
	sta  kyndx
	jmp  nmiend

!zone
; Subs:
execom
	txa;get & convert Byte
	bpl .j; (therefore strange
	eor #%#.#.....; vectorlist)
.j	asl
	tax
	lda  ctab+1,x;get Hi
	beq  noroutine;0 = >
	sta .m+2; and set
	lda  ctab,x;get Lo
	sta .m+1; and set
.m	jmp MODIFIED16;use command

noroutine
	rts;not defined

!zone
F_new
	jsr  willblost
	beq  noroutine
	jsr  newtext
	jsr  needline
	ldx #$0f; use counter as "TRUE"
	stx  nwfrm
	stx  updatewbi
	stx  unnamed
.l	lda  newname,x
	sta  txtname,x
	dex
	bpl .l
	inx
	stx  changes
	rts

!zone
newtext
	ldx #1   ;'1'
	stx  scrx; as X of screen,
	stx  anfx; blockstart, -end &
	stx  endx; crsr.
	stx  posx
	stx  scry;...as Y-Lo
	stx  anfy
	stx  endy
	stx  posy
	dex      ;'0'
	stx  scry+1; ...as Y-Hi
	stx  anfy+1
	stx  endy+1
	stx  posy+1
	stx  zzbe;no lines
	stx  zzbe+1; used
	rts

!zone
; 'key' ist der Kern, holt einen Code
; ausm Puffer. 'char' wuerde, wenns ein
; F-Key oder Accent ist, den Puffer
; aendern und dann das erste Byte
; abliefern. Hier nur das Standardprog:
getchar
	jmp  getkey
.defrag	;{check fragjob}

getkey
	;{check mousejob}
	;{check clockjob}
	ldx  kyndx;F-keys as standard
	beq .std
	ldy  keyidx
	lda  pkydef,y
	dec  kyndx
	inc  keyidx
	rts
.std	ldx  ndx;chars in buffer ?
	beq .defrag;0 = >
	sei;else
	ldy  keybuffer; get first byte
	ldx #255 - 8;loop to shift other 9 chars down
.l	lda  keybuffer - 255 + 9,x
	sta  keybuffer - 255 + 8,x
	inx; (f7 to ff)
	bne .l
	dec  ndx;dec number
	tya;byte = >A
	stx  keybuffer+9;clear lastbyte
	cli
	rts

!zone
getvvek
	lda  scry,x;get y-Lo
	asl;*2
	tay;buffer
	lda  scry+1,x;get y-Hi
	rol;*2 ( = clc)
	sta  vvek+1;in Hi
	tya;get Lo
	adc  memin;+ BaseLo
	sta  vvek; = VectorLo
	lda  vvek+1;get Hi
	adc  memin+1;+ BaseHi
	sta  vvek+1; = VectorHi
	rts;(VekVek)

; stellt Vektor auf Cursor-Y
poslvek
	ldx #POS

; stellt Vektor auf Zeile
!zone
getlvek
	jsr  getvvek;get VekVek
	ldy #0;Y-Init
	lda (vvek),y;get Lo-Byte
	sta  lvek;store
	iny;inc vector
	lda (vvek),y;get Hi-Byte
	sta  lvek+1;store
	rts

!zone
windowproof
	lda  posx;crsr-X
	cmp  scrx;screen(home)-X
	bcs .j;bigger = >
	sta  scrx;else set screen-X
	sta  nwfrm; and NewFrame
	bcc .UpDown
.j	sbc  scrx;difference
	cmp #scrcols;cmp screenwidth
	bcc .UpDown;ok = >
	lda  posx;else NewFrame,
	sta  nwfrm;
	sbc #scrcols-1;set screen-X
	sta  scrx;& store
.UpDown	lda  scry+1;HiByte screen-
	cmp  posy+1; Y and crsr-Y
	bcc  crsrweiter;shorter = >
	bne .set;equal = >
	lda  posy;else cmp Lo-bytes
	cmp  scry
	bcs  crsrweiter;shorter = >
.set	ldx  posy;get crsrpos as
	lda  posy+1; new screenstart
	stx  scry
	sta  scry+1
	lda #TRUE;NewFrame
	sta  nwfrm
	rts

!zone
crsrweiter
	sec;for sbc
	lda  posy;calculate
	sbc  scry; Lo-difference
	tax; in X
	lda  posy+1;calculate
	sbc  scry+1; Hi-difference
	bne .j3;if Hi = 0
	cpx #scrlins; & Lo ok,
	bcc .j; ready = >
.j3	lda  posy+1;else: copy Hibyte
	sta  scry+1
	sec;for sbc
	lda  posy;calculate & save
	sbc #scrlins-1; new Hibyte
	sta  scry
	bcs .j2;ggfs. = >
	dec  scry+1;correct Hibyte
.j2	lda #TRUE;NewFrame
	sta  nwfrm
.j	rts
; Scrollroutines missing !

!zone
; fuellt Speicher mit Zeilen
fillmem
	lda #0;Keine Zeilen da
	sta  zzan
	sta  zzan+1
	ldx  llen;Zeilenlaenge
	inx;+ Info-Byte
	stx .m1+1; in SBC #$dummy
	lda  maxmem0;holt MAX-MEM-0
	sta  txts; und nimmt es als
	lda  maxmem0+1; Obergrenze !
	sta  txts+1
	lda  getid+1;Holt ID-Adresse (Lo)
	tax;sichern
	lsr;Bit 0 ins Carry
	txa;zurueck
	adc #6;+ID-2+C
	sta  memin;wird Vektorstart (Lo)
	lda  getid+2;Hi-Byte
	adc #0; entsprechend
	sta  memin+1; anpassen  (Auto-CLC)
;Carry wird addiert, damit Vektoren bei
;einer GERADEN Adresse starten !
	lda  memin;Die VekVeks
	adc #2; werden ab dem
	sta  vvek; Vektorstart+2
	lda  memin+1; abgelegt, da es
	adc #0; keine nullte Zeile
	sta  vvek+1; gibt
.Check	lda  txts;TextstartLo
	sec
.m1	sbc #MODIFIED8; -Zeilenl<6E>nge
	sta  tmp1; wird gepuffert
	ldx  txts+1
	bcs .j2
	dex
.j2	stx  tmp1+1
	cpx  vvek+1;Vektorkollision ?
	bcc .NoLine; Ja = > keine Zeile !
	bne .MakeLn; Nein = > neue Zeile !
	ldx  vvek;Gleich: Lo-Bytes
	inx; vergleichen
	cpx  tmp1;Wieder: Kollision ?
	bcs .NoLine; Ja = > keine Zeile !
.MakeLn	lda  tmp1; Nein: dann temp als
	sta  txts; Textstart und in den
	ldy #0; Linevektor
	sta (vvek),y
	lda  tmp1+1;dito, Highbyte
	sta  txts+1
	iny
	sta (vvek),y
	inc  vvek;VekVek 2 Byte weiter
	+inc16 vvek
	inc  zzan;angelegte Zeilen
	bne .Check; eins hoeher
	inc  zzan+1
	jmp .Check
.NoLine	rts

!zone
clearline
	lda #" ";Space
	ldy  llen;Y auf Zeilenende
.l	sta (lvek),y;Space setzen
	dey ;zurueck
	bne .l;Infobyte ?
	tya ;Dann auf
	sta (lvek),y; Null setzen
	dey ;Y auf $ff fuer
	sty  nwfrm; NewFrame
	sty  changes;Veraendert !
; WordWrap sinnlos !
	rts

!zone
; stellt Zeilen zur Verfuegung oder
; gibt Fehlermeldung
needline
	+cmp16bit ZZA, ZZB;vergleichen
	beq .j;Wenn gleich, wirds
; gesetzte Carry 'failure'
	+inc16 zzbe;sonst: Zahl der genutzten Zeilen hoeher
	ldx #ZZB
	stx  changes;Veraendert !
	jsr  getlvek;Holt Vektor
	jsr  clearline; und leert Zeile
	clc ;'success'
; EIGENTLICH ist das Carrybit hier schon
; durch die beiden Subs gel<65>scht...
.j	rts

!zone
cmp16bit
	lda  scry+1,x;Hi-Bytes vergleichen
	cmp  scry+1,y
	bne .j;wenn gleich,
	lda  scry,x;Lo-Bytes vergleichen
	cmp  scry,y
.j	rts

!zone
F_gcr
	inc  posx
	jmp  proofpos

F_gcl
	dec  posx
	jmp  proofpos

!zone
F_gcu
	ldx  posy
	bne .j
	dec  posy+1
.j	dec  posy
	jmp  proofpos

!zone
F_gcd
	+inc16 posy
!zone
proofpos
	ldx  posx;CRSR-X
	beq .jBack;Null = >
	dex; verringern und mit
	cpx  llen; Laenge vergl.
	bcs  jump;zu weit rechts = >
	lda  posy+1;CRSR-Y (Hi)
	bmi  firstline;>32K = > 1. Zeile = >
	ora  posy;ODERt Low-Byte
	beq  firstline; = 0 = > 1. Zeile = >
	+cmp16bit ZZB, POS;vergleichen
	bcc  F_geot;CRSR zu weit = >
	jmp  windowproof;okay
.jBack
	ldx  llen;Zeilenlaenge wird
	stx  posx; neue Position & hoch
	jsr  F_gcu
	jsr  poslvek;LineVek holen
	jsr  findend;Ende suchen
	iny;dahintersetzen
	sty  posx
	jmp  proofpos
jump
	jsr  newline;naechste Zeile
	bcs .j;CRSR zu weit,
	jsr  needline; Zeile anfordern
	bcc .j;Bei Fehlschlag
	jsr  memfull; Warnung zeigen
.j	jmp  proofpos

!zone
firstline
	ldx #1;CRSR in erste Zeile
	stx  posy
	dex
	stx  posy+1
	jmp  windowproof

F_geot
	+cp16 zzbe, posy;CRSR in letzte Zeile
	jmp  windowproof

!zone
newline
	lda #1;X-Pos : = 1 & Y += 1
	sta  posx
	+inc16 posy
	+cmp16bit ZZB, POS;vergleichen
	rts

!zone
F_cs
	lda #1;CRSR 2 next linestart
	sta  posx
	+inc16 posy
	jmp  proofpos

!zone
chrout
	stx  byte;sichert Zeichen
	jsr  poslvek;LineVek
	ldy  esca;Autoinsert ?
	beq .j;ggfs. kein
	jsr  insert1; insert
.j	ldy  posx;Versatz
	lda  byte;Akku holen
	sta (lvek),y;und setzen
	jsr  poswrap;Wrap ?
	lda #TRUE;NewFrame fordern
	sta  nwfrm
	sta  changes;Veraendert !
	jmp  F_gcr

!zone
F_insert
	jsr  poslvek;LineVek
	jsr  insert1;insert
	jsr  poswrap;Wrap ?
	rts

!zone
insert1
	ldy  scrx,x;X-Wert holen & in
	sty .lm+1; Immediate
	ldy  lvek+1;Quell-Vektor =
	ldx  lvek; aktueller Vektor-1
	bne .j2
	dey
.j2	dex
	stx  tmp1
	sty  tmp1+1
	ldy  llen;Shiftstart LineEnd
.lm	cpy #MODIFIED8; X
	beq .j;Ende = >
	lda (tmp1),y;Zeichen holen
	sta (lvek),y; und shiften
	dey ;neue Pos
	jmp .lm
.j	lda #" ";'Space' an
	sta (lvek),y; Pos setzen
	sta  nwfrm;NewFrame fordern
	sta  changes;Veraendert !
	rts

!zone
F_dcl
	jsr  F_gcl
F_dcr
	jsr  poslvek;LineVek
	jsr  delchr1;Delete
	jsr  poswrap;Wrap ?
	jmp  proofpos

!zone
delchr1
	ldy  scrx,x;X-Wert in Immediate
	sty .m+1
	ldx  lvek;Zielvektor = aktueller
	ldy  lvek+1; Vektor+1
	inx
	bne .j2
	iny
.j2	stx  tmp1
	sty  tmp1+1
.m	ldy #MODIFIED8; X
.l	cpy  llen;Zeilenende ?
	beq .j; Dann = >
	lda (tmp1),y;Zeichen holen
	sta (lvek),y; und shiften
	iny;neue Pos
	jmp .l
.j	lda #" ";Space an letzte
	sta (lvek),y; Pos setzen
	lda #TRUE;NewFrame fordern
	sta  nwfrm
	sta  changes;Veraendert !
	rts

!zone
; Einsprung: X = StartIndex, Y = EndIndex
; Bewegt Zeilenbloecke: X bis Y-1 werden
;  nach X+1 bis Y geschoben. Danach
; liegt die Endzeile in der Startzeile
rollfwd
	jsr  howmany;Zeilenanzahl ?
	beq .j; ggfs Abbruch !
	tya ;Y in X
	tax
	jsr  getlvek;lvek in lvek puffern
	sec ;Quellvektor = Vektor-2
	lda  vvek
	sbc #2
	sta  tmp1
	lda  vvek+1
	sbc #0
	sta  tmp1+1
	ldy #2;Versatz 2
.l	tya ; Y pruefen
	bne .j2;ggfs
	dec  tmp1+1;Page sichern
	dec  vvek+1
.j2	dey ; Versatz runter
	lda (tmp1),y;High-Byte oben setzen
	sta (vvek),y
	dey ; Versatz runter
	lda (tmp1),y;Low-Byte oben setzen
	sta (vvek),y
	inc  tmpy;Anzahl der Shifts
	bne .l; pruefen, ggfs loop
	inc  tmpy+1
	bne .l
	lda  lvek;alten Vektor holen
	sta (tmp1),y; und in letzte
	iny ; Position setzen
	lda  lvek+1
	sta (tmp1),y
.j	lda #TRUE;NewFrame fordern
	sta  nwfrm
	sta  changes;Veraendert !
	rts

!zone
; Einsprung: X = StartIndex, Y = Endzeile
; Bewegt Zeilenbloecke: X+1 bis Y werden
;  nach X bis Y-1 geschoben. Danach
; liegt die Startzeile in der Endzeile !
rollrwd
	jsr  howmany;Zeilenanzahl ?
	beq .j; ggfs Abbruch !
	jsr  getlvek;lvek in lvek puffern
	clc;Quellvektor = Vektor+2
	lda  vvek
	adc #2
	sta  tmp1
	lda  vvek+1
	adc #0
	sta  tmp1+1
	ldy #0;Versatz 0
.l	lda (tmp1),y;Hi-Byte unten setzen
	sta (vvek),y
	iny;weiter
	lda (tmp1),y;Lo-Byte unten setzen
	sta (vvek),y
	iny;weiter
	bne .j2;Page sichern
	inc  tmp1+1
	inc  vvek+1
.j2	inc  tmpy;Anzahl Shifts
	bne .l; pruefen, ggfs loop
	inc  tmpy+1
	bne .l
	lda  lvek;alten Vektor an die
	sta (vvek),y; letzte Pos setzen
	iny
	lda  lvek+1
	sta (vvek),y
.j	lda #TRUE;NewFrame fordern
	sta  nwfrm
	sta  changes;Veraendert !
	rts

!zone
howmany
	jsr  cmp16bit;Sicherheit
	bcs .j; ggfs Abbruch = >
	sec ; Negativer Wert, um INC statt DEC nutzen zu k<>nnen
	lda  scry,x
	sbc  scry,y
	sta  tmpy
	lda  scry+1,x
	sbc  scry+1,y
	sta  tmpy+1
	rts
.j	lda #0; Zeilen
	rts

!zone
movx2y
	lda  scrx,x; Copy X-indizierte Werte in Y-indizierte Variablen
	sta  scrx,y
	lda  scry,x
	sta  scry,y
	lda  scry+1,x
	sta  scry+1,y
	rts

ESC_at
	rts

ESC_a
	lda #TRUE;Set AutoInsert
	sta  esca
	sta  updatewbi;Update fordern
	rts

ESC_b
	ldx #POS;BlockEnd: = Cursorposition
	ldy #END
	jsr  movx2y

!zone
; Block legal ? Vertauscht ggfs Zeiger
nblck
	+cmp16bit ANF, END;Blockstart und -Ende vergleichen
	bcc .j;anf<end: ok
	bne .j2;anf>end: not ok
	lda  scrx,y;Bei Gleichheit noch
	cmp  scrx,x; X pruefen
	bcs .j;end> = anf: ok
.j2	ldy #TMP;(Anf) in Temp
	jsr  movx2y
	ldx #END;Ende in Anf
	ldy #ANF
	jsr  movx2y
	ldx #TMP;Temp in Ende
	ldy #END
	jsr  movx2y
.j	lda #TRUE;NewFrame fordern
	sta  nwfrm; (Blockanzeige)
	sta  blockflag;Block ein
	rts

!zone
ESC_c
	ldx #FALSE;Clear AutoInsert
	stx  esca
	dex;Update fordern
	stx  updatewbi
	rts

ESC_d
	ldx #POS;Start: Cursorposition
	jsr  delline; Zeile weg
	jmp  poswrap; und wrap

!zone
delline
	ldy #ZZB;Ende: LastLine
	jsr  rollrwd;runterrollen
	lda  zzbe; Anzahl der benutzten Zeilen runter
	bne .j2
	dec  zzbe+1
.j2	dec  zzbe
	bne .j; Low = 0 ?
	lda  zzbe+1;Dann High pruefen und ggfs Zeile fordern
	bne .j
	jsr  needline
.j	jmp  proofpos

!zone
ESC_g
	ldx #FALSE;Beep On
	stx  beep
	dex;Update fordern
	stx  updatewbi
	rts

ESC_h
	lda #TRUE;Beep Off
	sta  beep
	sta  updatewbi;Update fordern
	rts

!zone
ESC_i
	jsr  needline;Zeile fordern
	+bcs memfull; bei Fehlschlag Warnung = >
	ldx #POS;Start: Cursorposition
	ldy #ZZB;Ende: LastLine
	jsr  rollfwd;raufrollen
	rts

!zone
F_gsol
ESC_j
	lda #1;Cursor-X: = 1
	sta  posx
	jmp  windowproof

F_geol
ESC_k
	jsr  poslvek; LineVek
	jsr  findend; sucht letztes Byte, dahinter steht dann der Cursor
	iny
	sty  posx
	jmp  proofpos

ESC_o
	lda  blockflag;toggle Flag
	eor #$ff
	sta  blockflag
	rts

ESC_p
ESC_q
	rts

ESC_t
	ldx #POS; Blockstart = Cursorposition
	ldy #ANF
	jsr  movx2y
	jmp  nblck; legal ?

F_home
	ldx  scrx;Normal HOME only,
	ldy  scry; if CRSR not there
	lda  scry+1
	cpx  posx;Otherwise ScreenUp
	bne  scrnhome
	cpy  posy
	bne  scrnhome
	cmp  posy+1
	bne  scrnhome

!zone
F_scrnu
	lda  posy;Displaystart =
	sec; Displaystart
	sbc #scrlins; - Zeilenzahl
	sta  posy
	bcs .j
	dec  posy+1
.j	lda #TRUE;NewFrame fordern
	sta  nwfrm
	jmp  proofpos

!zone
scrnhome
	stx  posx;Cursor: = Display
	sty  posy
	sta  posy+1
	jmp  proofpos

F_ahome
	clc;errechnet Werte
	lda  scry; fuer antih1
	adc #scrlins-1; in A, X, Y
	tax
	lda  scry+1
	adc #0
	tay
	lda  scrx;CRSR dort ?
	cmp  posx
	bne  antih1
	cpx  posy; Nein = > dorthin
	bne  antih1
	cpy  posy+1; Ja = > ScreenDown !
	bne  antih1

!zone
F_scrnd
	lda  posy;One screen down
	clc
	adc #scrlins
	sta  posy
	bcc .j
	inc  posy+1
.j	lda #TRUE;NewFrame fordern
	sta  nwfrm
	jmp  proofpos

!zone
antih1	sta  posx;Cursor: = DisplayEnd
	stx  posy
	sty  posy+1
	jmp  proofpos

F_gsot	ldx #1;X = Y = 1
	stx  posx
	stx  posy
	stx  nwfrm; NewFrame fordern
	dex; Y-Hi: = 0
	stx  posy+1
	jmp  proofpos

!zone
handleid
	ldx #7;8 Byte Kennung
getid	lda MODIFIED16,x;Schleife, um evtl. vorhandenen Text zu
	cmp  idtext,x
	bne  makeid; erkennen & zu reaktivieren
	dex
	bpl  getid
	clc  ;'OldText'
	rts
makeid
	lda  texttop; Neue ID wird ans Basic-Ende gesetzt
	sta  getid+1
	sta .m1+1
	lda  texttop+1
	sta  getid+2
	sta .m1+2
	ldx #7
.l	lda  idtext,x
.m1	sta MODIFIED16,x
	dex
	bpl .l
	sec;'NewText'
	rts

F_cr	jsr  F_lfeed
	jmp  jump

F_c       :F_f       :F_ffeed   :F_dir
F_fbox    :F_hlp     :F_bell    :F_tab
F_text    :F_middle  :F_graphic
F_fn      :F_ff      :F_un      :F_uf      :F_rn      :F_rf
F_sf      :F_sk      :F_su      :F_st      :F_sl
F_gld     :F_glu     :F_gad     :F_gau     :F_gpd     :F_gpu
F_gtr     :F_gtl     :F_gwr     :F_gwl
F_bttnn   :F_bttnf   :F_find    :F_print   :F_mode    :F_dword
F_cut     :F_copy    :F_paste   :F_move
F_fmtl    :F_fmtr    :F_fmtm    :F_fmtb

	rts;(yet) missing