home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er Special 12
/
64er_Magazin_Sonderheft_12_86-12_1986_Markt__Technik_de_Side_A.d64
/
window.src
(
.txt
)
< prev
Wrap
Commodore BASIC
|
2022-10-26
|
9KB
|
334 lines
10 sys9*4096:.opt o,oo
15 *=$c000
20 xlo = $f7 ;koordinaten der linken
21 ylo = $f8 ;oberen ecke des windows
22 xru = $f9 ;koordinaten der rechten
23 yru = $fa ;unteren ecke des windows
24 zsp = $aa ;zwischenspeicher
26 fkey = $fb ;speicher f. ftasten
28 cnt = $57 ;zaehler
30 cux = $a8 ;relative cursorposition
31 cuy = $a9 ;innerhalb des windows
32 pol = $aa ;zwei-byte zaehler
33 poh = $ab ;fuer diverse zwecke
34 pos = $fc ;position im textspeicher
36 zbr = $fd ;breite des windows
38 zan = $fe ;hoehe des windows
40 mpos = $ff ;laenge des textspeichers
42 stz = $22 ;stringzeiger
44 stat = $90 ;status - byte
46 cflg = $cc ;flag fuer cursor
48 crep = $cd ;zaehler f. cursorblinken
50 iflg = $11 ;flag f. input,get,read
52 tflg = $0d ;typflag (numer./string)
54 cgl = $7a
56 cgh = $7b ;zeiger d. chrget-routine
58 zcgl = $4b ;zwischenspeicher fuer
59 zcgh = $4c ;chrget-zeiger
60 zvl = $49 ;zeiger auf
61 zvh = $4a ;variablenwert
62 coll = $14
63 colh = $15 ;zeiger in farbram
64 vram =$288 ;high-byte video-ram
66 ccol =$286 ;farbe des cursors
68 erlzt =$33c;tab. f. erlaubte zeichen
100 rbyte = $b79e ;1-byte-wert lesen
102 pkom = $aefd ;auf komma pruefen
103 pchar = $aeff ;auf zeichen pruefen
104 frmevl = $ad9e ;ausdruck auwerten
106 frestr = $b6a3 ;stringverwaltung
108 c(NULL)t = $0079 ;letztes z. holen
110 cget = $0073 ;naechstes z. holen
112 get = $ffe4 ;get
114 zanfl = $ecf0 ;tab. d. bildschirm-
115 zanfh = $d9 ;zeilenanfaenge
116 cset = $fff0 ;cursor setzen
118 plet = $b113 ;pruef. auf buchst.
120 svar = $b08b ;variable suchen
122 cgset = $ab76 ;chrgetzeiger setzen
124 sthol = $b487 ;string holen
126 prset = $b7e2 ;prgzeiger setzen
128 strvar = $a9da ;string an var zuw.
130 prbyte = $b7f1 ;s.o. nach komma
132 crbyte = $b79b ;s.o. mit chrget
200 ;
205 ; ausgabe in window
210 ;
215 print jsr posread ;text holen
220 jmp wtext ;und in window schreiben
300 ;
305 ; eingabe in window
310 ;
312 ; - parameter einlesen
313 ;
315 input jsr posread ;koord. & text
320 lda #<erlzt:ldx #>erlzt
325 jsr rstring ;erlaubte zeichen lesen
330 txa:bne peb ;alte einstellung
332 sta (pol),y ;tab mit 0 abschliessen
335 peb jsr c(NULL)t:cmp #",":bne pea
340 jsr crbyte ;anzahl d. ftasten holen
345 cpx #09 ;vgl. <= 8
347 bcs pea ;nein - nicht beachten
350 txa:adc #133 ;in ascii umrechnen
351 sta fkey ;und speichern
355 pea lda #";"
360 jsr pchar ;auf semikolon pruefen
400 ;
405 ; - eingabe vorbereiten
410 ;
415 hom ldy #00:sty cux ;cursor in
420 sty cuy ;linke obere ecke
425 sty cflg ;cursor ein
430 sty pos ;an textanfang
500 ;
505 ; - eingabe
510 ;
515 ein jsr cuswrt ;text schreiben
520 eia jsr get ;zeichen von tastatur
522 beq eia ;holen
525 ldx #02:stx crep ;repeatfunktion
526 ;
527 ; - pruefung auf sonderzeichen
528 ;
530 cmp #"[133]":bcc e4 ;auf ftaste pruefen
535 cmp fkey ;pr. erlaubte ftaste
537 bcc e5 ;ja - wie return
540 cmp #"[140]"+1 ;pr. nicht def. ftaste
542 bcc eia ;ja - nicht beachten
545 e4 cmp #13 ;pr. return
547 bne e3 ;nicht return
550 e5 jmp ret ;return
555 e3 ldx cux ;cursorposition in
557 ldy cuy ;x/y - register
560 cmp # 19:beq hom ;home
565 cmp #141:beq sret ;shift-return
570 cmp # 29:beq cusr ;cursor right
575 cmp # 17:beq cusd ;cursor down
580 cmp #145:beq cusu ;cursor up
585 cmp #157:beq cusl ;cursor left
590 cmp # 20:beq del ;delete
595 cmp #148:beq inst ;insert
600 cmp #147:beq clr ;clear
605 ;
610 ; - pruefung auf erlaubte zeichen
615 ;
620 ldy #255 ;y als zeiger in tab.
625 eib iny ;zeiger erhoehen
627 ldx erlzt,y ;zeichen aus tab. holen
630 beq eia ;tabellenende
635 cmp erlzt,y ;pr. erlaubtes zeichen
637 beq eie ;erlaubtes zeichen
640 cpx #"[133]":bne eic ;auf f1 pruefen
645 cmp #"0" ;f1 - auf ziffer pruefen
647 bcc eib
650 cmp #"9"+1
652 bcc eie ;ziffer - erlaubt
655 eic cpx #"[134]" ;auf f3 pruefen
657 bne eid
660 jsr plet ;f3 - auf buchst. pruefen
665 bcs eie ;buchstabe - erlaubt
670 eid cpx #"[135]" ;auf f5 pruefen
672 bne eib
675 cmp #"[193]":bcc eib ;f5 - auf geshift.
680 cmp #"[218]"+1 ;buchstaben pruefen
685 bcs eib ;kein buchstabe
690 eie ldy pos ;position im textsp.
695 ptext sta textt,y ;zeichen speichern
700 ;
705 ; - sonderzeichen-behandlung
710 ;
715 cusr jmp incu ;cursor n. rechts
720 sret ldx #00 ;cus. an zeilenanfang
725 lda pos:sbc cux ;pos neu berechnen
730 .byte $2c ;naechsten bef. auslassen
735 cusd lda pos:iny ;cursorzeile+1
740 cpy zan
745 bcs cdb ;cuy zu gross
750 adc zbr ;pos neu berechnen
755 .byte $24 ;naechsten bef. auslassen
760 cdb dey ;cursorzeile-1
765 cda sta pos ;pos speichern
770 jmp scurs ;cursor setzen
775 cusu lda pos
780 cpy #00:beq cda ;curs. in 1. zeile
785 sbc zbr ;pos neu berechnen
790 bcs cdb ;unbedingter sprung
795 clr jsr clear ;text loeschen
800 jmp hom ;zur home-routine
805 del ldy pos:beq incb ;textanfang
810 deb lda textt,y:sta textt-1,y
815 iny:bne deb ;text verschieben
820 lda #32:ldx mpos
825 sta textt-1,x ;space an textende
830 cusl jmp decu ;cursor links
835 inst ldy mpos
840 ina lda textt-1,y:sta textt,y
845 dey:cpy pos ;text verschieben
850 bne ina ;bis zur augenbl. position
855 lda #32
860 sta textt,y ;space einfuegen
865 bne incb ;unbedingter sprung
900 ;
905 ; - cursorbewegungen
910 ;
915 incu ldx cux ;cursor right
920 ldy cuy ;cpos laden
925 inx ;spalte + 1
930 cpx zbr:bne incc ;keine neue zeile
935 ldx #00 ;zeilenanfang
940 iny ;zeile + 1
945 cpy zan
950 beq incb ;cursor right unmoeglich
955 incc inc pos ;pos. in text + 1
960 scurs stx cux ;rel. cursorposition
962 sty cuy ;speichern
965 incb jmp ein ;zur eingabeschleife
970 decu ldy cuy ;cursor left
975 ldx cux
980 bne decb ;nicht am zeilenanfang
985 ldx zbr ;zeilenende
990 tya
992 beq incb ;cursor left unmoeglich
995 dey ;zeile - 1
1000 decb dex ;spalte - 1
1005 dec pos ;pos. in text - 1
1010 jmp scurs
1100 ;
1105 ; - ende der eingabe
1110 ;
1115 ret stx cflg ;cursor aus
1120 sbc #"[133]"-2 ;ftastennr. errechnen
1125 bcs rea ;nicht return
1130 lda #00 ;00 fuer return
1135 rea sta stat ;in st speichern
1140 jsr wtext ;text auf bs ausgeben
1145 reb lda textt-1,x:cmp #32
1150 bne rec ;text nach ueber-
1152 dex ;fluessigen leerzeichen
1155 bne reb ;durchsuchen
1160 rec lda #00
1165 sta textt,x ;00 fuer textende
1170 sta iflg ;00 fuer input
1175 jsr svar ;variable suchen
1180 bit tflg
1185 bpl synerr ;numerische variable
1190 sta zvl ;zeiger auf variable
1195 sty zvh ;speichern
1200 lda cgl:ldy cgh ;chrget-zeiger
1205 sta zcgl
1210 sty zcgh ;zwischenspeichern
1215 lda ptext+1 ;anfangsadresse des
1220 ldy ptext+2 ;textes uebergeben
1225 jsr sthol:jsr prset ;string holen
1230 jsr strvar ;und der var. zuweisen
1235 lda zcgl:ldy zcgh ;chrget-zeiger
1240 jmp cgset ;wiederherstellen
1245 ;
1250 synerr jmp $af08 ;syntax error
2000 ;
2005 ; - unterroutinen
2010 ;
2015 ; - cursor setzen
2020 ;
2025 cuswrt clc:lda cuy ;aus relativer
2030 adc ylo:tax ;cursorposition
2035 lda cux ;absolute cursorposition
2040 adc xlo:tay ;berechnen
2045 jsr cset ;cursor setzen
2100 ;
2105 ; - text in window schreiben
2110 ;
2115 wtext ldx #00 ;zeiger in text
2120 lda ylo:sta cnt ;zeilenzaehler
2125 wta ldy cnt ;bs-zeile
2130 lda zanfl,y ;zeiger in
2135 sta pol ;bildschirmspeicher
2140 sta coll ;und farbram setzen
2145 lda zanfh,y:and #03
2150 pha:ora vram:sta poh
2155 pla:ora #$d8:sta colh
2160 ldy xlo ;spalten - zaehler
2165 wtb lda textt,x ;zeichen holen
2170 bcwand bmi bca ;umwandlung ascii-
2175 cmp #96:bcc bca ;code in
2180 and #%11011111 ;bildschirmcode
2185 bne bcb
2190 bca and #%10111111
2195 bcb bpl bce:eor #%11000000
2200 bce sta (pol),y ;zeichen in bsram
2205 lda ccol ;schreiben und
2210 sta (coll),y ;farbe setzen
2215 inx ;zeiger in text + 1
2220 iny ;spaltenzaehler + 1
2225 cpy xru
2230 bcc wtb ;noch nicht letzte spalte
2235 inc cnt ;zeilenzaehler + 1
2240 cpx mpos ;pr. auf textende
2245 bcc wta ;noch nicht textende
2250 rts
2300 ;
2305 ; - koordinatenpaar lesen
2310 ;
2315 rkoord jsr pkom ;auf komma pruefen
2320 stx zsp ;zaehler fuer koordinaten
2325 jsr rbyte ;byte-wert lesen
2330 cpx #40 ;pr. < 40 (x-koordinate)
2335 bcs illerr ;nein - fehlermeldung
2340 ldy zsp:stx xlo,y ;wert speichern
2345 jsr prbyte ;byte-wert lesen
2350 cpx #25 ;pr. < 25 (y-k.)
2355 bcs illerr ;nein
2360 ldy zsp:stx xlo+1,y ;speichern
2365 rts
2370 ;
2375 illerr jmp $b248 ;illegal q. error
2400 ;
2405 ; - windowparameter & text-
2410 ; string lesen
2411 ;
2420 posread ldx #00 ;1.koordinatenpaar
2425 jsr rkoord+3 ;lesen
2430 ldx #02:jsr rkoord ;2. ''
2435 inc xru ;(besser verarbeitbar)
2440 sec:lda xru ;breite des windows +1
2445 sbc xlo ;berechnen
2450 bcc illerr ;<0 - fehler
2455 sta zbr ;und speichern
2460 txa ;hoehe des windows + 1
2465 sbc ylo ;berechnen
2470 bcc illerr:adc #00:sta zan
2475 tax ;hoehe (in x-reg.) mit
2480 lda #00 ;breite malnehmen = laenge
2485 poa adc zbr ;des eingabetextes
2490 bcs illerr ;>255 - fehler
2495 dex:bne poa
2500 sta mpos ;laenge speichern
2505 clear ldy #00 ;textspeicher
2510 lda #32 ;loeschen
2515 clea sta textt,y:iny:bne clea
2600 ;
2605 ; - string lesen & speichern
2610 ;
2615 rstringt lda ptext+1 ;zeiger auf
2620 ldx ptext+2 ;textspeicher
2625 rstring sta pol ;zeiger fuer
2630 stx poh ;speicherung d. strings
2635 jsr c(NULL)t ;letztes zeichen holen
2640 cmp #"," ;pr. auf komma
2645 bne rste ;nein - kein string folgt
2650 jsr cget:jsr frmevl ;string lesen
2655 jsr frestr ;& parameter holen
2660 ldy #00
2665 tax ;laenge d. string in x-reg.
2670 beq rste ;laenge = 0
2675 rstb lda (stz),y ;string in
2680 sta (pol),y ;speicher (pol/h =
2685 iny ;anfangsadresse) verschieben
2690 dex:bne rstb
2695 rste rts
3000 ;
3005 ; - textspeicher
3010 ;
3015 textt = *