6502/acme
1
0
Fork 0
mirror of https://github.com/uffejakobsen/acme.git synced 2024-11-20 05:36:14 +00:00
Code Issues Projects Releases Wiki Activity
a57a7b6c68
acme/examples/me/core.a
marcobaye 0ec58e8b15 reformatted example sources (some slightly, some not so slightly). 
git-svn-id: https://svn.code.sf.net/p/acme-crossass/code-0/trunk@12 4df02467-bbd4-4a76-a152-e7ce94205b78
2013-04-07 21:29:09 +00:00

801 lines
16 KiB
Plaintext
Raw Blame History

;ACME 0.94.4
!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 +
jsr newframe ; yes = >
+ lda updatewbi ; update flags?
beq +
jsr showwbi ; yes = >
+ jsr getchar ; get CHARACTER
tax ; & buffer
and #%.##..... ; command ?
beq + ; yes = >
eor #%.##..... ; command ?
beq + ; yes = >
jsr chrout ; char out
jmp mainloop
+ jsr execom ; execute command
jmp mainloop
!zone
; Pseudo-Sub: (ESC uses jmp)
F_esc clc ; 'ESC' on!
lda clraktv
ldx #hFlag_Escape
jsr setflagdata
- jsr getkey ; get KEY
beq -
sta byte ; & buffer
clc ; 'ESC' off!
lda clrinak
ldx #hFlag_Escape
jsr setflagdata
ldx byte ; get byte
txa ; & buffer
eor #%.#...... ; a-z ?
and #%.##.....
bne + ; no = >
txa ; get byte
and #%...##### ; & short
asl ; *2 &
tax ; as index
lda etab + 1, x ; get Hi
beq .no ; 0 = >
sta .m + 1 ; set
lda etab, x ; get Lo
sta .m ; set
.m = * + 1: jmp MODIFIED16 ; execute sequence
.no rts ; nothing...
+ 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 + ; (therefore strange
eor #%#.#..... ; vectorlist)
+ asl
tax
lda ctab + 1, x ; get Hi
beq noroutine ; 0 = >
sta .m + 1 ; and set
lda ctab, x ; get Lo
sta .m ; and set
.m = * + 1: jmp MODIFIED16 ; use command
noroutine rts ; not defined (fixme - could save a byte here)
!zone
F_new jsr willblost
beq noroutine
jsr newtext
jsr needline
ldx #$0f ; use counter as "TRUE"
stx nwfrm
stx updatewbi
stx unnamed
- lda newname, x
sta txtname, x
dex
bpl -
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
- lda keybuffer - 255 + 9, x
sta keybuffer - 255 + 8, x
inx ; (f7 to ff)
bne -
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 + ; bigger = >
sta scrx ; else set screen-X
sta nwfrm ; and NewFrame
bcc .UpDown
+ 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 + ; if Hi = 0
cpx #scrlins ; & Lo ok,
bcc ++ ; ready = >
+ lda posy + 1 ; else: copy Hibyte
sta scry + 1
sec ; for sbc
lda posy ; calculate & save
sbc #scrlins - 1 ; new Hibyte
sta scry
bcs + ; ggfs. = >
dec scry + 1 ; correct Hibyte
+ lda #TRUE ; NewFrame
sta nwfrm
++ 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 ; in SBC #$dummy
lda maxmem0 ; holt MAX-MEM-0
sta txts ; und nimmt es als
lda maxmem0 + 1 ; Obergrenze !
sta txts + 1
lda mod_id ; Holt ID-Adresse (Lo)
tax ; sichern
lsr ; Bit 0 ins Carry
txa ; zurueck
adc #6 ; +ID-2+C
sta memin ; wird Vektorstart (Lo)
lda mod_id + 1 ; 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 = * + 1: sbc #MODIFIED8 ; -Zeilenlänge
sta tmp1 ; wird gepuffert
ldx txts + 1
bcs +
dex
+ 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
- sta (lvek), y ; Space setzen
dey ; zurueck
bne - ; 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 + ; 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öscht...
+ rts
cmp16bit lda scry + 1, x ; Hi-Bytes vergleichen
cmp scry + 1, y
bne + ; wenn gleich,
lda scry, x ; Lo-Bytes vergleichen
cmp scry, y
+ rts
F_gcr inc posx
jmp proofpos
F_gcl dec posx
jmp proofpos
F_gcu ldx posy
bne +
dec posy + 1
+ dec posy
jmp proofpos
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 + ; CRSR zu weit,
jsr needline ; Zeile anfordern
bcc + ; Bei Fehlschlag
jsr memfull ; Warnung zeigen
+ 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 + ; ggfs. kein
jsr insert1 ; insert
+ 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 ; fixme - could save a byte here
!zone
insert1 ldy scrx, x ; X-Wert holen & in
sty .mod ; Immediate
ldy lvek + 1 ; Quell-Vektor =
ldx lvek ; aktueller Vektor-1
bne +
dey
+ dex
stx tmp1
sty tmp1 + 1
ldy llen ; Shiftstart LineEnd
-
.mod = * + 1: cpy #MODIFIED8 ; X
beq + ; Ende = >
lda (tmp1), y ; Zeichen holen
sta (lvek), y ; und shiften
dey ; neue Pos
jmp -
+ 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
ldx lvek ; Zielvektor = aktueller
ldy lvek + 1 ; Vektor+1
inx
bne +
iny
+ stx tmp1
sty tmp1 + 1
.m = * + 1: ldy #MODIFIED8 ; X
- cpy llen ; Zeilenende ?
beq + ; Dann = >
lda (tmp1), y ; Zeichen holen
sta (lvek), y ; und shiften
iny ; neue Pos
jmp -
+ 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 ++ ; 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
- tya ; Y pruefen
bne + ; ggfs
dec tmp1 + 1 ; Page sichern
dec vvek + 1
+ 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 - ; pruefen, ggfs loop
inc tmpy + 1
bne -
lda lvek ; alten Vektor holen
sta (tmp1), y ; und in letzte
iny ; Position setzen
lda lvek + 1
sta (tmp1), y
++ 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 ++ ; 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
- 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 + ; Page sichern
inc tmp1 + 1
inc vvek + 1
+ inc tmpy ; Anzahl Shifts
bne - ; pruefen, ggfs loop
inc tmpy + 1
bne -
lda lvek ; alten Vektor an die
sta (vvek), y ; letzte Pos setzen
iny
lda lvek + 1
sta (vvek), y
++ lda #TRUE ; NewFrame fordern
sta nwfrm
sta changes ; Veraendert !
rts
!zone
howmany jsr cmp16bit ; Sicherheit
bcs + ; ggfs Abbruch = >
sec ; Negativ, 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
+ lda #0 ; Zeilen
rts
!zone
movx2y lda scrx, x ; Copy X-indexed Werte in Y-indexed Variablen
sta scrx, y
lda scry, x
sta scry, y
lda scry + 1, x
sta scry + 1, y
rts
ESC_at rts ; fixme - could save one byte here
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 ++ ; anf<end: ok
bne + ; anf>end: not ok
lda scrx, y ; Bei Gleichheit noch
cmp scrx, x ; X pruefen
bcs ++ ; end> = anf: ok
+ 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
++ 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 +
dec zzbe + 1
+ dec zzbe
bne + ; Low = 0 ?
lda zzbe + 1 ; Dann High pruefen und ggfs Zeile fordern
bne +
jsr needline
+ 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 ; fixme - could save a byte here
!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 Cursor
iny
sty posx
jmp proofpos
ESC_o lda blockflag ; toggle Flag
eor #$ff
sta blockflag
rts
ESC_p
ESC_q rts ; fixme - could save a byte here
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 +
dec posy + 1
+ 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 +
inc posy + 1
+ 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
-
mod_id = * + 1: lda MODIFIED16, x; Schleife, um evtl. vorhandenen Text zu
cmp idtext, x
bne makeid ; erkennen & zu reaktivieren
dex
bpl -
clc ; 'OldText'
rts
makeid lda texttop ; Neue ID wird ans Basic-Ende gesetzt
sta mod_id
sta .m1
lda texttop + 1
sta mod_id + 1
sta .m1 + 1
ldx #7
- lda idtext, x
.m1 = * + 1: sta MODIFIED16, x
dex
bpl -
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
Reference in New Issue View Git Blame Copy Permalink