home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er Special 28
/
64er_Magazin_Sonderheft_28_19xx_Markt__Technik_de_Side_B.d64
/
convert.src
< prev
next >
Wrap
Text File
|
2022-10-26
|
27KB
|
1,594 lines
;
; {CBM-A}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{CBM-S}
; {SHIFT--} BitmapConverter V1.44 {SHIFT--}
; {SHIFT--} (C) 1987 by Carsten Clasohm {SHIFT--}
; {CBM-Q}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{CBM-W}
; {SHIFT--} V 1.0 written from 28.12.1987 {SHIFT--}
; {SHIFT--} to 4. 1.1988 {SHIFT--}
; {SHIFT--} last modified on 20. 1.1988 {SHIFT--}
; {CBM-Z}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{SHIFT-*}{CBM-X}
;
; *** Geos-Librarian V1.4, (C) 1987 by Carsten Clasohm ***
; ** **
; ** Stand: 20.1.1987 **
org $0402
jmp ende
;
; *** Labels,allgemeine ***
;
:r0=$02 ;Arbeitsregister
:r1=$04 ;der Geos-Routinen
:r2=$06
:r3=$08
:r4=$0a
:r5=$0c
:r6=$0e
:r7=$10
:r9=$14
:r10=$16
:zp1=$46 ;Zeropage-Zeiger fuer
:zp2=$48 ;Applikatioen
:zp3=$4a
:zp4=$4c
:zp5=$4e
:zp8=$54
:zp9=$56
:zp10=$58
:zp28=$7c
:zp29=$7e
:null=0
:cia1=56320 ;Basisadr. der Cia1
:mousex=$3a ;X-Koord. der Maus
:mousey=$3c ;Y-Koord. der Maus
:bordo=$84b8
:bordu=$84b9 ;Grenzen
:bordl=$84ba ;fuer Maus
:bordr=$84bc
:recvboxr=$c12d ;Routinenadr.
:set=$ff ;Flag setzen
:clear=0 ;Flag loeschen
;
; *** Labels,PUTCHAR ***
;
:cr=13
:boldon=24
:italicon=25
:outline=26
:plaintext=27
;
; *** Labels,DIALBOX ***
;
:ok=$01
:cancel=$02
:yes=$03
:no=$04
;
; *** Makros ***
;
;
; *** BYTES + WORTE KOPIEREN + VERSCHIEBEN ***
;
; * Wert in Speicherstelle schreiben *
:poke m 2 ;(Adresse;Wert)
lda #@1
sta @0
/
; * Wort 'wert' in 'register' laden *
:loadw m 2 ;(wert;register)
poke @1,<@0
poke @1+1,>@0
/
; * Byte kopieren *
:cop m 2 ;(Srcbyte;Destbyte)
lda @0
sta @1
/
; * Wort kopieren *
:transw m 2 ;(srcreg;destreg)
cop @0,@1
cop @0+1,@1+1
/
;
; *** GRAFIK ***
;
; * Bildschirm loeschen *
:cls m 0 ;()
jsr clsrout
/
; * Muster setzen *
:pattern m 1 ;(Muster)
lda #@0
jsr $c139
/
; * Ausgefuelltes Rechteck zeichnen *
:box m 5 ;(Y-l.o.;Y-r.u.;X-l.o.;X-r.u.;Muster)
pattern @4
jsr $c19f
b @0,@1
w @2,@3
/
; * Rechteck zeichnen *
:frame m 0 ;()
jsr $c127
/
; * Rechteckigen Bereich invertieren *
:invbox m 0 ;()
jsr $c12a
/
; * komprimierte Bitmap anzeigen *
:bitmap m 5 ;(Adr.d.Bitmap;X-Koord.;Y-Koord.;Breitadr.;Hoehadr.)
loadw @0,r0
poke 4,@1
poke 5,@2
cop @3,6
cop @4,7
jsr $c142
/
; * Dialbox erzeugen *
:dialbox m 1 ;(Adresse)
loadw @0,r0
jsr $c256
/
; * Makros fuer DIALBOX *
;
; * Werte fuer Dialbox festlegen *
:initdialbox m 5 ;(Muster;Yo;Yu;Xl;Xr)
b @0,@1,@2
w @3,@4
/
; * Standarddialbox erzeugen *
:stddialbox m 1 ;(Muster)
b $80+@0
;es folgen die Kommandos
/
;
; * Feld in Dialbox bringen *
:feld m 3 ;(Feldopcode;X;Y)
b @0,@1/8,@2
/
; * festen Text in Dialbox anzeigen *
:textaus m 3 ;(X;Y;Textadresse)
b $0b,@0,@1
w @2
/
; * variablen Text anzeigen *
:vartextaus m 3 ;(X;Y;Register)
b $0c,@0,@1,@2
/
; * Files auswaehlen (Findtype-Param.nicht vergessen!) *
:getfiles m 2 ;(X;Y)
b $10,@0,@1
/
; * auf GETFILES vorbereiten *
:initgetfiles m 3 ;(Filetyp;Ablageadr.;class)
poke $10,@0
loadw @1,r5
loadw @1,r6
loadw @2,r10
/
; * Icon in DB-Box generieren *
:usricon m 3 ;(X;Y;Icontabellenadr.)
b $12,@0/8,@1
w @2
/
; * Icontabelle *
:icon m 6 ;(Zg.auf Bitmap;X;Y;Breite;Hoehe;Routadr.)
w @0
b @1,@2,@3,@4
w @5
/
; * Von eigener Routine zurueck zur DB *
:rstdial m 1 ;(Code fuer $851d)
poke $851d,@0
jmp $c2bf
/
; *** Ende DIALBOX-Makros ***
;
; * Flaeche aus 2. in 1.Bitmap holen *
:recvbox m 4 ;(Xl.o;Yl.o.;Xr.u.;Yr.u.)
jsr $c1a5
b @1,@3
w @0,@2
/
; * Adresse einer Zeile in Bitmap berechnen *
:scan m 0 ;()
jsr $c13c
/
;
; *** TEXT ***
;
; * Text in Geosformat konvertieren *
:txtconv m 1 ;(Adresse)
loadw @0,$fb
jsr convert
/
; * variablen Text konvertieren *
:vtxtconv m 1 ;(Zeigeradr.)
transw @0,$fb
jsr convert
/
; * Untermakros zu IPUTSTR und PUTCHAR *
:gotox m 1 ;(X-Koord.)
b $14
w @0
/
; * Ende PUTCHAR-Makros *
;
; * Strings bekannter Groesse vergleichen *
:cmpfstr m 3 ;(Adr.1;Adr.2;Laenge)
ldx #@0
ldy #@1
lda #@2
jsr $c26e
/
;
; *** SONSTIGES ***
;
; * Desktop laden und starten *
:desktop m 0
jmp $c22c
/
; * cpu Inhalte sichern *
:pushcpu m 0
sta $fd
stx $fe
sty $ff
php
/
; * cpu Inhalte zurueckladen *
:popcpu m 0
lda $fd
ldx $fe
ldy $ff
plp
/
; * X Sekunden warten *
:wait m 1 ;(Sekunden)
loadw @0,zp1
jsr waitrout
/
; * MAIN aufrufen *
:main m 1 ;(Returnadr.)
loadw @0,$849b
jmp $c1c3
/
; * Ein/Ausgabe ueber alte Routinen vorbereiten *
:initio m 0 ;()
jsr $c25c
/
; * Ein/Ausgabe ueber alte Routinen beenden *
:doneio m 0 ;()
jsr $c25f
/
; * I/O-Fehler anzeigen *
:error m 1 ;(Ruecksprungadr.)
loadw @0,zp28
jmp errorrout
/
;
; *** MAUS ***
;
; * Mauszeiger anschalten *
:mouseon m 0 ;()
jsr $c18a
/
; * Mauszeiger ausschalten *
:mouseoff m 0 ;()
jsr $c18d
/
; * Maus"spielwiese" einstellen *
:mouseborder m 4 ;(obere;untere;linke;rechte Grenze)
poke bordo,@0
poke bordu,@1
loadw @2,bordl
loadw @3,bordr
/
;
; *** DISK ***
;
; * File laden (weitere Parameter) *
:read m 2 ;(Ladeadr.;Maxlaenge)
loadw @0,r7
loadw @1,r2
jsr $c1ff
/
; * Diskette oeffnen *
:opendisk m 0 ;()
jsr $c2a1
/
; * Fileeintrag im Dir. suchen *
:findfile m 1 ;(Filenamenadr.)
loadw @0,r6
jsr $c20b
/
; * File umbenennen *
:rename m 2 ;(neuer Name;alter Name)
loadw @0,r0
loadw @1,r6
jsr $c259
/
; * Block von Disk einlesen (weitere Parameter!) *
:getblk m 1 ;(Speicheradr.)
loadw @0,r4
jsr $c1e4
/
; * Speicherbereich speichern *
:save m 2 ;(Infoblockadr.;Dirseite)
loadw @0,r9
poke $16,@1
jsr $c1ed
/
;
; *** RECHNEN ***
;
; * Wort dekrementieren *
:ddec m 1 ;(Zpadr.)
ldx #@0
jsr $c175
/
; * Wort inkrementieren *
:dinc m 1 ;(Adr.)
loadw @0,zp29
jsr dincrout
/
; * Quotient zweier Worte bilden *
:ddiv m 2 ;(Divid.adr;Divisoradr)
ldx #@0
ldy #@1
jsr $c169
/
; * Zwei Bytes multiplizieren *
:bbmult m 2 ;(Produkteadr;Ergebnisadr)
ldy #@0
ldx #@1
jsr $c160
/
; * Byte mit Wort multiplizieren *
:bmult m 2 ;(Byteadr;Wortadr)
ldy #@0
ldx #@1
jsr $c163
/
; * Zwei Worte subtrahieren *
:dsubtr m 3 ;(Minuendadr;Subtrahend;Differenz)
sec
lda @0
sbc @1
sta @2
lda @0+1
sbc @1+1
sta @2+1
/
;
; *** SPEICHER VERSCHIEBEN + KOPIEREN ***
;
; * Speicherbloecke verschieben *
:moveram m 3 ;(Anfadr.Quelle,Anfadr.Ziel,Laenge)
jsr $c1b7
w @0,@1,@2
/
; * Speicherbereich mit $00 fuellen *
:clearam m 2 ;(Anfangsadr.;Anzahl)
loadw @0,r1
loadw @1,r0
jsr $c178
/
; * File loeschen *
:delete m 1 ;(Namenadr.)
loadw @0,r0
jsr $c238
/
;
;*** Routinen ***
;
; * Konvertierung von Text ins *
; * Geos-Format *
:convert
ldy #0
:cnvt
lda ($fb),y
beq endcnv
cmp #$10
beq endcnv
cmp #$14
beq zwei
cmp #$15
beq eins
cmp #$16
beq drei
cmp #$17
beq drei
cmp #65
bcc next
cmp #91
bcs next
eor #$20
:next
sta ($fb),y
iny
jmp cnvt
:endcnv
rts
:eins
iny
iny
jmp cnvt
:zwei
iny
jmp eins
:drei
iny
jmp zwei
;
; * Warten *
;
:waitrout
initio
cop cia1+9,zp2
:warte
lda cia1+9
cmp zp2
beq warte
sta zp2
doneio
ddec zp1
bne warteweiter
rts
:warteweiter
initio
jmp warte
;
; * I/O-Fehlermeldung ausgeben *
;
:errorrout
txa
cmp #10 ;kleiner als 10 ?
bcc kleiner10 ;<-ja
poke zp29,$ff ;<-nein
:abziehen
inc zp29 ;Zehnerstelle merken
sec
sbc #10 ;kleiner 10 machen
bcs abziehen
clc ;kleiner 0!
adc #10+48 ;wieder -1>Akku<10 und
;in Zeichencode wandeln
sta fehlernr+3 ;und als Einerstelle sp.
lda zp29
clc ;und das gleiche mit der
adc #48 ;Zehnerstelle
sta fehlernr+2
jmp ausgeben
:kleiner10
clc
adc #48 ;1stellige Zahl umrechnen
sta fehlernr+3 ;und
poke fehlernr+2,32 ;Leerzeichen als 1.Stelle
:ausgeben
dialbox iofehler
jmp (zp28)
;
; ** Wort inkrementieren **
;
:dincrout
ldy #0
lda (zp29),y ;Lowbyte
tax
inx ;erhoehen
txa
sta (zp29),y
bne keinueberlauf
iny
lda (zp29),y ;Highbyte
tax
inx ;erhoehen
txa
sta (zp29),y
:keinueberlauf
rts
;
; ** Bildschirm loeschen **
;
:clsrout
box 0,199,0,319,2
rts
;
; *** Daten, Texte, ... ***
;
:fehlernr
b "I:00"
b null
:ende
;
;***> ENDE GEOS-LIBRARIAN <***
;
;***> ANFANG BITMAPCONVERTER <***
;
; ** Programmspezifische Labels **
;
:kopf=zp1
:bytes=zp2
:lese=zp3
:write=zp4
:kacheln=zp5
:titeltxt=$5a
:insertdisktxt=$5c
:fehlermeldung=$5e
:filetyp=$60
:bildoktxt=$62
:schnittoktxt=$64
:newdisktxt=$66
:stoptxt=$68
;
; *** Sprache auswaehlen ***
;
txtconv sprtxt ;Texte fuer erste
txtconv langtx ;Box konvertieren
txtconv quittx
cls
:langu
dialbox sprache ;Sprache waehlen
jmp konvertieren ;Routinen ueberspringen
;
; *** Zeiger auf Texte setzen ***
;
:englrt
loadw titeltxte,titeltxt
loadw insertxte,insertdisktxt
loadw fehlermeldunge,fehlermeldung
loadw filetype,filetyp
loadw bildoktxte,bildoktxt
loadw schnittoktxte,schnittoktxt
loadw newdisktxte,newdisktxt
loadw stoptxte,stoptxt
rstdial $0e
;
:germrt
loadw titeltxtd,titeltxt
loadw insertxtd,insertdisktxt
loadw fehlermeldungd,fehlermeldung
loadw filetypd,filetyp
loadw bildoktxtd,bildoktxt
loadw schnittoktxtd,schnittoktxt
loadw newdisktxtd,newdisktxt
loadw stoptxtd,stoptxt
rstdial $0e
;
:quitrt
desktop
;
; *** Titel + File auswaehlen ***
;
:konvertieren
vtxtconv titeltxt
vtxtconv insertdisktxt
vtxtconv fehlermeldung
vtxtconv filetyp
txtconv fehlernr
vtxtconv bildoktxt
vtxtconv schnittoktxt
vtxtconv newdisktxt
vtxtconv stoptxt
cop $851e,farben
cls
dialbox titel ;Titelbox anzeigen
:neuedisk
dialbox insertdisk ;Disk einlegen!
lda r0
cmp #cancel ;zurueck zur 1. Box ?
bne weiter
jmp langu
:weiter
opendisk
txa
beq ok1
error neuedisk
:ok1
initgetfiles 0,puffer,0
dialbox choosefiles ;File auswaehlen
lda r0
cmp #cancel ;andere Disk?
bne nichtzurueck
jmp neuedisk
:nichtzurueck
;
; *** 1.Track/Block suchen ***
;
findfile puffer
txa
beq ok1a
error neuedisk
:ok1a
cop $8400+1,track
cop $8400+2,block
lda $8400 ;auf Filetyp (Prg.)
cmp #130 ;pruefen
beq typrichtig
dialbox filetypebox
jmp weiter ;neues File waehlen
:typrichtig
;
; ** Bild laden und anzeigen **
;
cop track,4
cop block,5
read $6000-2,8194 ;Bild "zwischen"laden
moveram $6000,$a000,8000 ;und anzeigen
wait 4
:neuerscrap
dialbox bildok
lda r0
cmp #yes
beq bildrichtig
jmp weiter ;anderes File waehlen
:bildrichtig
dialbox autostop
lda r0
cmp #yes
bne nostop
poke flag1,set ;Flag setzen
jmp vorbereit
:nostop
poke flag1,clear ;Flag loeschen
:vorbereit
initio
poke 53280,0 ;Rahmen schwarz
doneio
mouseon
mouseborder 0,199,0,319
loadw knopf1,$84a1 ;Vektor fuer Feuerknopf
:nichtstun
main nichtstun ;auf Knopf warten
:knopf1
poke $2f,%10000000 ;nur in sichtbare Bitmap schreiben
transw mousex,x1
transw x1,x2
transw x1,aktx
transw x1,altx
lda mousey ;Koord. fuer Bereich
sta y1 ;kopieren
sta y2
sta akty
sta alty
sta 6
sta 7
transw x1,r3
transw x1,r4
invbox
loadw trick1,$849b ;Ruecksprungadr. fuer MAIN
rts ;zurueck zu MAIN
:trick1
loadw trick2,$84a1 ;Trick
main trick1 ;(Geos wertet "Knopf los-
:trick2 ; lassen" auch als akti-
loadw vektor,$849b ; vierten Feuerknopf)
rts
;
; ** Bereich invertieren **
;
:vektor
loadw knopf2,$84a1
poke puffer+10,0 ;Farbe setzen
poke flag2,clear
poke flag5,clear
lda flag1 ;Autostop ?
beq warteschleife ;nein
;
; ** Grenze fuer Maus festlegen **
sec
lda alty
sbc #143 ;obere Grenze
bcs groesser1
lda #0
:groesser1
sta bordo
clc
lda alty
adc #143 ;untere Grenze
sta bordu
bcs ueberl
cmp #199
bcc kleiner1
:ueberl
poke bordu,199
:kleiner1
loadw 263,zp1
dsubtr altx,zp1,bordl
bcs groesser2
loadw 0,bordl
:groesser2
clc
lda altx
adc #<263
sta bordr
lda altx+1
adc #>263
sta bordr+1
loadw 319,zp1
dsubtr bordr,zp1,zp1
bcc warteschleife
loadw 319,bordr
;
; *** auf Bewegung reagieren ***
:warteschleife
poke flag3,clear ;Flag fuer Ygleich loeschen
cop y1,zp1 ;Koord. sichern
cop y2,zp1+1 ;(fuer "JSR RECVBOXR")
transw x1,zp2
transw x2,zp3
lda mousey
cmp akty ;Y gleichgeblieben ?
bne yngleich
jmp ygleich
:yngleich
sta akty ;nein,
:rulo
lda akty ;und oben bzw.
cmp alty ;unten festlegen
bcs ygroesser
cop alty,y2
cop akty,y1
jmp xpruefen
:ygroesser
cop alty,y1
cop akty,y2
jmp xpruefen
:ygleich
poke flag3,set ;Flag fuer Ygleich
:xpruefen
lda mousex
cmp aktx ;X veraendert?
bne nichtgleich ;ja
lda mousex+1
cmp aktx+1
bne nichtgleich ;ja
:xgleich
lda flag3
bne ninvertieren ;wenn nur X gleich,neuen B.invertieren
jmp invertieren
:ninvertieren
main warteschleife
:nichtgleich
transw mousex,aktx
sec
lda aktx
sbc altx ;links und rechts
lda aktx+1 ;festlegen
sbc altx+1
bcs xgroesser
transw altx,x2
transw aktx,x1
poke flag6,clear ;Akty-links-Flag
jmp invertieren
:xgroesser
transw altx,x1
transw aktx,x2
poke flag6,set ;Akty-rechts-Flag
:invertieren
poke farbe,0
lda flag1 ;wenn Autostop,
bne aufruf ;dann ueberspringen
sec ;Farbe des Bild-
lda y2 ;schirmrandes
sbc y1 ;berechnen
cmp #144
bcc schwarz
poke farbe,2
jmp xfarbe
:schwarz
poke farbe,0
:xfarbe
sec
lda x2
sbc x1
sta puffer+1
lda x2+1
sbc x1+1
sta puffer+2
lda puffer+2
beq xschwarz
lda puffer+1
cmp #9
bcc xschwarz
poke farbe,2
jmp aufruf
:xschwarz
lda farbe
bne aufruf
poke farbe,0
:aufruf
lda flag5
beq nknopf2
rts
:nknopf2
lda farbe
cmp puffer+10
beq altefarbe
sta puffer+10
initio
cop farbe,53280 ;Farbe setzen
doneio
:altefarbe
transw zp2,r3 ;alten Bereich
transw zp3,r4 ;wiederherstellen,
cop zp1,6
cop zp1+1,7
jsr recvboxr
transw x1,r3
transw x2,r4 ;neuen Bereich
cop y1,6 ;invertieren
cop y2,7
invbox
transw x1,r3
transw x2,r4 ;und Rechteck zeichnen
cop y1,6
cop y2,7
lda #%11110000 ;Zeichenmuster
frame
main warteschleife ;und weiter warten
;
; ** auf 2. Knopfdruck reagieren **
;
:knopf2
loadw erweitern,$849b ;Ruecksprungadr. fuer MAIN
rts ;zurueck zu MAIN
:erweitern
loadw $e6b9,$84a1 ;alten Vektor herstellen
;
; ** X-Koord. auf "X/8" erweitern **
;
transw x1,r3 ;Bild
transw x2,r4 ;wiederherstellen
cop y1,6
cop y2,7
jsr recvboxr
lda x1 ;bei X1=0
bne keinenull ;ueberspringen
lda x1+1
beq x2erweit
:keinenull
transw x1,r0
loadw 8,r1
ddiv r0,r1 ;X1/8 steht in r0 (Lowbyte)
poke r0+1,8
bbmult r0,r1 ;X1*8,Ergebnis in r1
transw r1,x1 ;x1 jetzt durch 8 teilbar
:x2erweit
lda x2 ;bei X2=0
bne nonull ;ueberspringen
lda x2+1
bne nonull
jmp darstellen
:nonull
transw x2,r0
dinc r0 ;X2 erhoehen (0=1,7=8,...)
loadw 8,r1
ddiv r0,r1 ;X2/8 steht in r0 (Lowbyte)
poke r0+1,8
bbmult r0,r1 ;X2*8,Ergebnis in r1
ddec r1 ;X2 wieder -1 (8=7,...)
transw r1,puffer ;x2 jetzt durch 8 teilbar
lda puffer
cmp x2
beq keinrest
clc ;aufrunden
lda puffer ;(plus 8)
adc #8
sta puffer
lda puffer+1
adc #0
sta puffer+1
:keinrest
transw puffer,x2
lda flag1 ;Autostop ?
beq darstellen
dsubtr x2,x1,zp10
loadw 264,zp9
dsubtr zp10,zp9,zp8
bcc darstellen
lda flag6
bne aktx2
clc ;Breite herunter-
lda x1 ;setzen
adc #8 ;(X1 + 8)
sta x1
lda x1+1
adc #0
sta x1+1
jmp darstellen
:aktx2
loadw 8,zp10 ;X2 - 8
dsubtr x2,zp10,x2 ;(Breite heruntersetzen)
;
; ** neuen Bereich darstellen **
;
:darstellen
transw x1,r3
transw x2,r4 ;neuen Bereich
cop y1,6 ;invertieren
cop y2,7
invbox
transw x1,r3
transw x2,r4 ;und Rechteck zeichnen
cop y1,6
cop y2,7
lda #%11110000 ;Zeichenmuster
frame
;
; ** Farben fuer Bereichsueberschreitung setzen **
;
poke flag5,set
poke flag1,clear
jsr invertieren
initio
cop farbe,53280 ;Farbe setzen
doneio
wait 4
dialbox ausschnittok
lda r0
cmp #yes
beq inordnung
recvbox 0,0,319,199
jmp bildrichtig ;neuen Ausschnitt waehlen
:inordnung
initio
poke 53280,0
doneio
;
; ** Bitmapformat konvertieren **
;
mouseoff
clearam $a000,8000 ;Bitmap 1 loeschen
poke $2f,%01000000 ;Bitmap 2 auslesen
loadw $a000,zp1 ;Zeiger festlegen
poke puffer,0 ; '' ''
lda x2 ;X2 erhoehen
bne x2nichtnull ;(durch 8 teil-
lda x2+1 ; bar machen)
beq gleichnull
:x2nichtnull
dinc x2
; ** Breite und Hoehe festhalten **
:gleichnull
sec
lda y2
sbc y1
sta hoehe ;weil kleinstes Y=0
inc hoehe ;muss Hoehe incrementiert werden
sec
lda x2
sbc x1
sta r0
lda x2+1
sbc x1+1
sta r0+1
loadw 8,r1
ddiv r0,r1 ;Breite/8 steht in r0 (Lowbyte)
cop r0,breite
transw x1,altx ;retten
; ** und jetzt geht's los **
:copyloop
ldx y1
scan
clc
lda r5
adc x1
sta r5
lda r5+1
adc x1+1
sta r5+1
ldy #0
lda (r5),y
sta (zp1),y
dinc zp1 ;Zielzeiger erhoehen
clc ;X-Koord. erhoehen
lda x1 ;(um 8)
adc #8
sta x1
lda x1+1
adc #0
sta x1+1
lda x2 ;pruefen,ob X1=X2
cmp x1
bne copyloop
lda x2+1
cmp x1+1
bne copyloop
lda y1 ;pruefen,ob letzte Zeile
cmp y2
beq fertig
inc y1 ;Y erhoehen
transw altx,x1 ;Anfangswert zurueck
jmp copyloop
;
; ** Bitmap packen **
;
:fertig
loadw $a000-1,lese ;Lesezeiger
loadw puffer+3,write ;Schreibzeiger
lda hoehe
sta r1
sta puffer+1 ;Vorbereitung fuer speichern
lda breite
sta r2
sta puffer ; '' '' ''
poke puffer+2,0 ; '' '' ''
poke r2+1,0
bmult r1,r2
transw r2,bytes ;Bytezahl
; ** neues Kopfbyte + 1.Byte schreiben **
:neuerkopf
lda #1 ;Kopfbyte
ldy #0 ;Datenbyteanzahl
ldx #0 ;Dummy
sta (write),y ;Kopfbyte speichern
transw write,kopf ;Zeiger auf Kopfbyte
iny ;Y=1
lda (lese),y ;erstes Datenbyte
sta (write),y
pushcpu
ddec bytes
cmp #0 ;letztes Byte ?
beq anzeigen1
popcpu
iny ;Y=2
lda (lese),y ;naechstes lesen
dey ;Y=1 (vorheriges Byte)
cmp (lese),y ;gleich ?
bne gruppe2
ldy #3
cmp (lese),y ;3 gleiche Bytes ?
bne gruppe2
ldy #1
; ** Wiederholung **
:gruppe1
iny ;Y wiederherstellen
tya
sta (kopf),x ;Kopfbyte=Datenbytezahl
pushcpu
ddec bytes
cmp #0 ;letztes Byte ?
beq anzeigen1
popcpu
iny ;naechstes Byte lesen
lda (lese),y
dey ;Zeiger 1 zurueck
cmp (lese),y ;gleich vorherigem ?
bne ungleich1
cpy #$7f ;maximale Anzahl von
bne gruppe1 ;Wiederholungen ?
; ** Wiederholung zuende **
:ungleich1
tya ;Zeiger in Akku
clc
adc lese ;Lesezg.=
sta lese ;Lesezg.+Bytezahl
lda lese+1
adc #0
sta lese+1
dinc write ;Writezg.=
dinc write ;Writezg.+2 (Kopfbyte+1 Datenb.)
jmp neuerkopf
; ** alle Bytes gepackt **
:anzeigen1
dinc write
dinc write
jmp anzg
; ** keine Packmoeglichkeit **
:gruppe2
ldy #1
lda #$81 ;Kopfbyte (Y=1)
sta (kopf),x ;speichern
iny
lda (lese),y ;zweites
sta (write),y ;Datenbyte
tya
ora #$80
sta (kopf),x ;Kopfbye +1 (Bit 7 gesetzt)
pushcpu
ddec bytes
cmp #0
beq anzeigen2
popcpu
:weiterlesen
iny ;naechstes Byte
lda (lese),y ;lesen
dey ;und mit
cmp (lese),y ;vorherigem vergl.
bne ungleich
iny
iny
cmp (lese),y ;3 gleiche ?
php ;Flags retten
dey
dey
plp ;Flags zurueck
beq gleich2
:ungleich
iny ;falls nicht gleich,
sta (write),y ;speichern
pushcpu
ddec bytes
cmp #0 ;alle Bytes ?
beq anzeigen2
popcpu
tya
ora #$80 ;Bit 7 setzen
sta (kopf),x ;neues Kopfbyte speichern
cmp #$db ;maximal moegliche Anzahl ?
bne weiterlesen
pushcpu
ddec bytes
popcpu
jmp maxzahl
; ** neue Wiederholung gefunden **
:gleich2
dey
tya
ora #$80
sta (kopf),x ;Kopfbyte -1
:maxzahl
tya ;Zeiger in Akku
clc
adc lese ;Lesezg.=
sta lese ;Lesezg.+Bytezahl
lda lese+1
adc #0
sta lese+1
iny ;Datenbytes +1 Kopfbyte
tya
clc
adc write ;Write plus
sta write ;Datenbytezahl
lda write+1
adc #0
sta write+1
dinc bytes ;Byte wieder +1
jmp neuerkopf ;neues Kopfbyte
; ** alle Bytes gepackt **
:anzeigen2
popcpu
tya
clc
adc write ;Write plus
sta write ;Datenbytezahl
lda write+1
adc #0
sta write+1
jmp anzg
;
; ** Probeanzeigen **
;
:anzg
poke $2f,%10000000
clearam $a000,8000
bitmap puffer+3,0,0,breite,hoehe
wait 3
;
; ** Farbcodes hinter Bitmap speichern **
;
;
; * Preferences laden *
;
:neudisk
dialbox newdisk ;Zieldisk einlegen
lda r0
cmp #ok
beq diskoeff
recvbox 0,0,319,199 ;Bild wiederherstellen
jmp neuerscrap ;und neuen Scrap waehlen
:diskoeff
opendisk
txa
beq ok3
error neudisk
:ok3
findfile pref
txa
bne anzahl ;Preferences nicht da
cop $8400+1,4 ;Track
cop $8400+2,5 ;+Block
getblk $8000 ;Pref. nach $8000 einlesen
txa
beq ok3a
error neudisk
:ok3a
lda $8000+5 ;Farben zu einem Byte zusammenfassen
ora $8000+6
sta farben
;
; * Anzahl der Farbkacheln berechnen *
;
:anzahl
lsr hoehe
lsr hoehe ;Hoehe=Hoehe/8
lsr hoehe
cop hoehe,zp1
cop breite,zp2
poke zp2+1,0
bmult zp1,zp2
transw zp2,kacheln ;Anzahl der Farbbytes
dinc kacheln ;sicherheitshalber+1
:farbkopf
lda #0 ;Kopfbyte
ldy #0
sta (write),y
ldy #1
lda farben
sta (write),y ;Datenbyte
ldy #0
:farbloop
lda (write),y
tax
inx
txa
sta (write),y
ddec kacheln
cmp #0
beq farbfert
ldy #0
lda (write),y
cmp #$7f
bne farbloop
dinc write ;Zeiger auf Datenbyte
dinc write ; '' auf naechsten Kopf
jmp farbkopf
:farbfert
dinc write ;Zeiger auf letztes Byte
dinc write
;
; ** Speichern **
;
:speichern
delete neunam
loadw puffer,ladeadr
transw write,endadr
save infoblock,1
rename neunam,altnam
desktop
;
; ** Dialogboxparameter **
;
:sprache
stddialbox 1
textaus 16,16,sprtxt
textaus 80,34,langtx
textaus 80,58,langtx
textaus 80,82,quittx
usricon 16,24,englic
usricon 16,48,germic
usricon 16,72,quitic
b null
;
:titel
initdialbox 1,20,170,64,255
vartextaus 16,16,titeltxt
feld ok,136,127
b null
;
:insertdisk
stddialbox 1
vartextaus 16,16,insertdisktxt
feld ok,8,72
feld cancel,136,72
b null
;
:iofehler
stddialbox 1
vartextaus 16,16,fehlermeldung
textaus 16,52,fehlernr
feld ok,136,72
b null
;
:choosefiles
stddialbox 1
getfiles 2,2
feld ok,136,8
feld cancel,136,72
b null
;
:filetypebox
stddialbox 1
vartextaus 16,16,fehlermeldung
vartextaus 16,52,filetyp
feld ok,136,72
b null
;
:bildok
stddialbox 1
vartextaus 16,16,bildoktxt
feld yes,8,72
feld no,136,72
b null
;
:autostop
stddialbox 1
vartextaus 16,16,stoptxt
feld yes,8,72
feld no,136,72
b null
;
:ausschnittok
stddialbox 1
vartextaus 16,16,schnittoktxt
feld yes,8,72
feld no,136,72
b null
;
:newdisk
stddialbox 1
vartextaus 16,16,newdisktxt
feld ok,8,72
feld cancel,136,72
b null
;
; *** Texte, allgemeine ***
;
:sprtxt
b boldon,"Please Select Option:"
b null
;
:langtx
b plaintext,"language"
b null
;
:quittx
b "to deskTop"
b null
;
; *** Texte, englische ***
;
:titeltxte
b italicon,boldon,"GEOS BitmapConverter V 1.44",cr,cr
gotox 80
b plaintext,boldon,"designed by:"
gotox 160
b plaintext,outline,"Carsten",cr
gotox 160
b "Clasohm",cr,cr
gotox 80
b plaintext,"Many thanks to Florian Mueller for",cr
gotox 80
b "sending me the idea for this program",cr
gotox 80
b "and for writing the book",cr
gotox 80
b 34,"Alles ueber Geos",34,".",cr,cr
gotox 80
b boldon,"(C) in 1987 by Carsten Clasohm",cr,cr
b null
;
:insertxte
b boldon,"Please insert the disk",cr,cr
gotox 80
b "containing the bitmap",cr,cr
gotox 80
b "to convert."
b null
;
:fehlermeldunge
b boldon,"Operation canceled due to",cr,cr
gotox 80
b "disk error:"
b null
;
:filetype
b "File type mismatch"
b null
;
:bildoktxte
b boldon,"Is this the right picture ?"
b null
;
:stoptxte
b boldon,"Do you want 'Autostop' ?"
b null
;
:schnittoktxte
b boldon,"Is this the right scrap ?"
b null
;
:newdisktxte
b boldon,"Please insert a disk",cr,cr
gotox 80
b "on which I can save",cr,cr
gotox 80
b "the photoscrap."
b null
;
; *** Texte, deutsche ***
;
:titeltxtd
b italicon,boldon,"GEOS BitmapConverter V 1.44",cr,cr
gotox 80
b plaintext,boldon,"geschrieben von:"
gotox 175
b plaintext,outline,"Carsten",cr
gotox 175
b "Clasohm",cr,cr
gotox 80
b plaintext,"Vielen Dank an Florian Mueller",cr
gotox 80
b "fuer die Idee zu diesem Programm",cr
gotox 80
b "und fuer das Schreiben des Buches",cr
gotox 80
b 34,"Alles ueber Geos",34,".",cr,cr
gotox 80
b boldon,"(C) in 1987 by Carsten Clasohm",cr,cr
b null
;
:insertxtd
b boldon,"Bitte die Disk mit der zu",cr,cr
gotox 80
b "konvertierenden Bitmap",cr,cr
gotox 80
b "einlegen."
b null
;
:fehlermeldungd
b boldon,"Operation abgebrochen",cr,cr
gotox 80
b "wegen Diskfehler:"
b null
;
:filetypd
b "Falscher Filetyp"
b null
;
:bildoktxtd
b boldon,"Ist dies das richtige Bild ?"
b null
;
:stoptxtd
b boldon,"Moechten Sie 'Autostop' ?"
b null
;
:schnittoktxtd
gotox 72
b boldon,"Ist dies der richtige Ausschnitt ?"
b null
;
:newdisktxtd
b boldon,"Bitte die Disk einlegen,",cr,cr
gotox 80
b "auf die der Ausschnitt",cr,cr
gotox 80
b "gespeichert werden soll."
b null
;
; *** Filenamen ***
;
:altnam
b 133,176,18,173,139,254,56,237,3,133,141,139,254,176,9,206,null
;
:neunam
b 80,104,111,116,111,32,83,99,114,97,112,null
;
:pref
b 80,114,101,102,101,114,101,110,99,101,115,null
;
; *** Icontabellen ***
;
:englic
icon englbm,0,0,6,16,englrt
b null
;
:germic
icon germbm,0,0,7,16,germrt
b null
;
:quitic
icon quitbm,0,0,6,16,quitrt
b null
;
; *** Bitmaps der Icons ***
;
:englbm
b $05,$ff,$82
b $fe,$80,$04,$00,$c9,$02,$bf,$00
b $01,$cc,$03,$03,$b0,$00,$00,$c0
b $03,$03,$b0,$7c,$7c,$dc,$f3,$e3
b $b0,$76,$cc,$cd,$9b,$b3,$be,$66
b $cc,$cd,$83,$33,$b0,$66,$cc,$cc
b $f3,$33,$b0,$66,$cc,$cc,$1b,$33
b $b0,$66,$cc,$cd,$9b,$33,$bf,$66
b $7c,$cc,$f3,$33,$80,$00,$0c,$00
b $00,$03,$80,$00,$cc,$00,$00,$03
b $80,$00,$78,$00,$00,$03,$06,$ff
b $81,$3f,$05,$ff
;
:germbm
b $06,$ff,$82
b $fe,$80,$05,$00,$83,$02,$87,$c0
b $04,$00,$83,$03,$8c,$60,$04,$00
b $b3,$03,$8c,$07,$9f,$be,$e3,$cf
b $83,$8c,$0c,$dc,$3b,$b6,$6e,$c3
b $8d,$ec,$d8,$33,$33,$ec,$c3,$8c
b $6f,$d8,$33,$36,$6c,$c3,$8c,$6c
b $18,$33,$36,$6c,$c3,$8c,$6c,$d8
b $33,$36,$6c,$c3,$87,$c7,$98,$33
b $33,$ec,$c3,$80,$05,$00,$82,$03
b $80,$05,$00,$82,$03,$80,$05,$00
b $81,$03,$07,$ff,$81,$3f,$06,$ff
;
:quitbm
b $05,$ff,$82
b $fe,$80,$04,$00,$be,$02,$80,$0f
b $80,$19,$80,$03,$80,$18,$c0,$01
b $80,$03,$80,$18,$d9,$bb,$c0,$03
b $80,$18,$d9,$99,$80,$03,$80,$18
b $d9,$99,$80,$03,$80,$18,$d9,$99
b $80,$03,$80,$18,$d9,$99,$80,$03
b $80,$1b,$db,$99,$80,$03,$80,$0f
b $8f,$98,$e0,$03,$80,$00,$c0,$00
b $00,$03,$80,$04,$00,$82,$03,$80
b $04,$00,$81,$03,$06,$ff,$81,$3f
b $05,$ff
;
; ** Daten **
;
:farben
b 0
:track
:breite
b 0
:block
:hoehe
b 0
:x1
b 0,0
:y1
b 0
:x2
b 0,0
:y2
b 0
:aktx
b 0,0
:akty
b 0
:altx
b 0,0
:alty
b 0
:farbe
b 0
:name
:flag1 ;Autostop ?
b 0
:flag2 ;Y-Bereichsueberschreitung geblieben ?
b 0
:flag3 ;Y gleich geblieben ?
b 0
:flag4 ;X-Bereichsueberschreitung geblieben ?
b 0
:flag5 ;Fremdaufruf der WARTESCHLEIFE ?
b 0
:flag6 ;Akty links (0) oder rechts ($ff) ?
s 11
:infoblock
b 0,255,3,21,191,255,255,255
b 128,64,1,128,96,1,128,96
b 1,128,96,13,128,80,53,128
b 80,217,128,83,33,128,92,193
b 128,89,1,135,206,1,159,200
b 1,184,248,1,177,252,1,191
b 110,1,156,102,1,128,102,1
b 128,108,1,128,56,1,128,0
b 1,255,255,255,131,4,0
:ladeadr
b 0,0
:endadr
b 0,0
b 0,0,80,104,111
b 116,111,32,83,99,114,97,112
b 32,86,49,46,48
s 42
b 80
b 104,111,116,111,32,83,99,114
b 97,112,0,32,119,194,96,169
b 66,133,3,169,182,133,2,32
b 0
:puffer