64'er Special 48

home *** CD-ROM | disk | FTP | other *** search

/ 64'er Special 48 / 64er_Magazin_Sonderheft_48_19xx_Markt__Technik_de.d64 / mustereditor.q < prev next >

Wrap

Text File | 1990-01-01 | 19.2 KB | 1,051 lines

org $c000 org $0400 :verticalline = $c121 :horizontalline = $c118 :putstring = $c148 :usesystemfont = $c14b :putdecimal = $c184 :setpattern = $c139 :irectangle = $c19f :invertrectangle = $c12a :am = $80 :counter1 = $81 :counter2 = $82 :ab = $83 :x = $84 :y = $85 :d1 = $86 :raster = $88 :flag = $89 :nz2 = $10 :nz1 = $12 :puffer = $90 :screen = $2f :doicons = $c15a :dshiftleft = $c15d :rectangle = $c124 :domenu = $c151 :gotofirstmenu = $c1bd :dodlgbox = $c256 :copyfstring = $c265 :renamefile = $c259 :ismseinregion = $c2b3 :savefile = $c1ed :getfile = $c208 :movedata = $c17e :deletefile = $c238 :findfile = $c20b :readfile = $c1ff :start jsr usesystemfont lda #<aname sta nz2 lda #>aname sta nz2+1 jsr init lda #04 sta am lda #00 sta $84b5 lda #<tab sta $02 lda #>tab sta $03 jsr doicons lda #<hmenu sta $02 lda #>hmenu sta $03 jsr domenu jsr weg1 jsr weg2 lda #<145 sta $08 lda #>145 sta $09 lda #<319 sta $0a lda #>319 sta $0b lda #$00 sta $18 lda #$ff jsr horizontalline lda #12 sta $18 lda #$ff jsr horizontalline lda #$00 sta $08 lda #12 sta $09 lda #<319 sta $0a lda #>319 sta $0b lda #$ff jsr verticalline jsr snam jsr nom lda #00 sta raster jsr showpat jsr fill jsr show rts :hmenu b 00 b 12 w 00 w 144 b %00000011 w datei b %10000000 w menu1 w muster b %10000000 w menu2 w spezial b %10000000 w menu3 :datei b "datei" b 00 :muster b "muster" b 00 :spezial b "spezial" b 00 :menu3 b 12 b 40 w 00 w 144 b %10000010 w begr31 b 00 w on w begr32 b 00 w off :menu2 b 12 b 82 w 00 w 144 b %10000101 w begr21 b 00 w neg w begr22 b 128 w spiegel w begr23 b 00 w clr w begr24 b 00 w next w begr25 b 00 w previous :spiegel b 12 b 40 w 00 w 144 b 130 w begr221 b 00 w mirrorx w begr222 b 00 w mirrory :menu1 b 12 b 82 w 00 w 144 b %10000101 w begr11 b 00 w close w begr12 b 00 w aktuell w begr13 b 00 w recover w begr14 b 00 w rename w begr15 b 00 w quit :begr221 b "x" b 00 :begr222 b "y" b 00 :begr31 b "raster an" b $00 :begr32 b "raster aus" b $00 :begr21 b "invertieren" b $00 :begr22 b "spiegeln" b $00 :begr23 b "loeschen" b $00 :begr24 b "naechstes muster" b $00 :begr25 b "vorhergehendes muster" b $00 :begr11 b "schliessen" b $00 :begr12 b "aktualisieren" b 00 :begr13 b "wiederherstellen" b $00 :begr14 b "umbenennen" b $00 :begr15 b "verlassen" b $00 :on jsr gotofirstmenu lda #00 sta raster jmp showpat :off jsr gotofirstmenu lda #$ff sta raster jmp showpat :neg jsr gotofirstmenu lda am jsr setpattern ldx #00 stx counter1 :neg1 ldy counter1 lda ($22),y eor #$ff sta ($22),y inc counter1 ldx counter1 cpx #08 bne neg1 jsr showpat jsr fill jsr show rts :clr jsr gotofirstmenu lda am jsr setpattern ldx #$00 stx counter1 :doclr ldy counter1 lda #$00 sta ($22),y inc counter1 ldx counter1 cpx #08 bne doclr jsr showpat jsr fill jsr show rts :next jsr gotofirstmenu ldx am cpx #31 bne next1 rts :next1 inc am jsr showpat jsr fill jsr show jsr weg1 jsr nom rts :previous jsr gotofirstmenu ldx am cpx #00 bne prev1 rts :prev1 dec am jsr showpat jsr fill jsr show jsr weg1 jsr nom rts :mirrorx jsr gotofirstmenu lda am jsr setpattern ldx #00 stx counter1 :dox1 ldy counter1 lda ($22),y sta ab ldx #00 stx counter2 :dox2 ldy counter1 lda ab rol sta ab lda puffer,y ror sta puffer,y inc counter2 ldx counter2 cpx #08 bne dox2 inc counter1 ldx counter1 cpx #08 bne dox1 ldx #00 stx counter1 :dox3 ldy counter1 lda puffer,y sta ($22),y inc counter1 ldx counter1 cpx #08 bne dox3 jsr showpat jsr fill jsr show rts :mirrory jsr gotofirstmenu lda am jsr setpattern ldx #00 stx counter1 :doy1 ldy counter1 lda ($22),y sta puffer,y inc counter1 ldx counter1 cpx #08 bne doy1 ldx #00 stx counter1 ldx #07 stx counter2 :doy2 ldy counter1 lda puffer,y ldy counter2 sta ($22),y inc counter1 dec counter2 ldx counter1 cpx #08 bne doy2 jsr showpat jsr fill jsr show rts :close jsr gotofirstmenu jsr aktuell jmp start :aktuell jsr gotofirstmenu lda #<aname sta $02 lda #>aname sta $03 jsr deletefile jmp save :recover jsr gotofirstmenu jsr open jsr showpat jsr fill rts :rename jsr gotofirstmenu lda #<name sta nz1 lda #>name sta nz1+1 lda #<aname sta nz2 lda #>aname sta nz2+1 jsr copyan lda #<box1 sta $02 lda #>box1 sta $03 jsr dodlgbox lda $02 cmp #$02 bne dr1 jsr copyna rts :dr1 lda #<name sta $02 lda #>name sta $03 jsr deletefile jsr save jsr weg2 jsr snam rts :quit jsr aktuell jmp $c22c :init jsr scnclr :doinit jsr clrn1 jsr clrn2 jsr moveprg lda #<box2 sta $02 lda #>box2 sta $03 jsr dodlgbox lda $3c cmp #53 bcc new cmp #83 bcc old jmp $c22c :old lda #<box3 sta $02 lda #>box3 sta $03 lda #<klass sta $16 lda #>klass sta $17 lda #<aname sta $0c lda #>aname sta $0d lda #05 sta $10 jsr dodlgbox lda $02 cmp #$02 beq init jmp open :new lda #<aname sta nz2 lda #>aname sta nz2+1 jsr clrn2 lda #00 sta aname lda #<box1 sta $02 lda #>box1 sta $03 jsr dodlgbox lda $02 cmp #$02 beq init lda #$00 sta $16 :save lda #<53248 sta $02 lda #>53248 sta $03 lda #<data sta $04 lda #>data sta $05 lda #<256 sta $06 lda #>256 sta $07 jsr movedata lda #<info sta $14 lda #>info sta $15 jsr savefile :open lda #<aname sta $0e lda #>aname sta $0f jsr findfile lda $8401 sta $04 lda $8402 sta $05 lda #<320 sta $06 lda #>320 sta $07 lda #<prg sta $10 lda #>prg sta $11 jsr readfile lda #<data sta $02 lda #>data sta $03 lda #<53248 sta $04 lda #>53248 sta $05 lda #<256 sta $06 lda #>256 sta $07 jsr movedata jsr show rts :info w aname b $03 b $15 b $bf b 255,255,255 b 128,000,001 b 128,000,001 b 128,000,001 b 155,109,177 b 142,056,225 b 159,125,241 b 142,056,225 b 155,109,177 b 129,199,001 b 131,239,129 b 129,199,001 b 155,109,177 b 142,056,225 b 159,125,241 b 142,056,225 b 155,109,177 b 128,000,001 b 128,000,001 b 128,000,001 b 255,255,255 b $83 b 05 b 00 w prg w data+256 w prg b "muster" b $00 s 13 b "mustereditor v1.3" b $00 s 2 s 20 s 23 :dt b "diese application" b " kopiert das muster" b " in das kernal" s 47 :tab b 03 w 18 b 18 w icon1 b 02 b 16 b 08 b 64 w klick1 w icon2 b 22 b 16 b 16 b 64 w klick2 w icon1 b 12 b 16 b 08 b 64 w klick3 :icon1 b 127 b 00 b 127 b 00 b 127 b 00 b 127 b 00 b 4 b 00 :icon2 b 127 b 00 b 127 b 00 b 127 b 00 b 127 b 00 b 127 b 00 b 127 b 00 b 127 b 00 b 127 b 00 b 08 b 00 :klick1 lda $3a sec sbc links lsr lsr lsr sta x lda $3c sec sbc oben lsr lsr lsr sta y lda x sta $08 lda y sta $06 jsr invert lda #01 sta d1 lda #00 sta d1+1 ldx #d1 lda #07 sec sbc x tay jsr dshiftleft ldy y lda ($22),y eor d1 sta ($22),y jsr fill jsr show rts :klick2 sec lda $3a sbc #176 sta x lda $3b sbc #00 sta y lsr y ror x lsr y ror x lsr y ror x lsr y ror x sec lda $3c sbc #16 sta y lsr y lsr y lsr y lsr y lda y asl asl asl clc adc x sta ab lda flag cmp #$ff beq cm lda ab cmp #$00 beq ek2 cmp #$01 beq ek2 cmp #$02 beq ek2 sta am jsr setpattern jsr fill jsr showpat jsr weg1 jsr nom :ek2 rts :cm lda am jsr setpattern lda $22 sta nz1 lda $23 sta nz1+1 lda ab sta am jsr setpattern lda $22 sta nz2 lda $23 sta nz2+1 ldy #$00 :cm1 lda (nz1),y sta (nz2),y iny cpy #$08 bne cm1 inc flag jsr show jsr weg1 jsr nom rts :klick3 lda #$ff sta flag rts :showpat lda raster bne aus lda #<m1 ; Klick-Muster sta $22 ; laden lda #>m1 ; und sta $23 ; aktivieren jsr irectangle ; und Rechteck b 16 ; loeschen b 80 ; w 16 ; w 80 ; jmp okpat :aus lda #00 jsr setpattern jsr irectangle b 16 b 80 w 16 w 80 :okpat lda am ; Muster jsr setpattern ; aktivieren ldx #$00 ; Zaehler 1 stx counter1 ; auf #00 :get ldy counter1 ; Zaehler holen lda ($22),y ; Byte des Musters holen sta ab ; und sichern ldx #$00 ; Zaehler 2 stx counter2 ; auf #00 :print lda ab ; Byte holen clc ; Carry loeschen :test cmp #128 ; Bit 7 Gesetzt ? bmi weiter ; Nein ! :set pha ; Akku retten lda #$c0 ; Beide Bildschirme sta screen ; ansprechen lda counter2 ; X holen sta $08 ; sichern lda counter1 ; Y holen sta $06 ; sichern jsr invert ; Invertieren pla ; Akku holen :weiter inc counter2 ; Zaehler erhoehen ldx counter2 ; Zaehler holen cpx #$08 ; Schon fertig ? bne print2 ; Nein inc counter1 ; Zaehler erhoehen ldx counter1 ; Zaehler holen cpx #$08 bne get rts :print2 rol jmp test :invert lda $06 ; Y holen asl ; Position asl ; ausrechnen asl ; clc ; Addition vorbereiten adc oben ; addieren sta $06 ; sichern clc ; Addition vorbereiten adc #07 ; addieren sta $07 ; und sichern lda $08 ; X holen asl ; Position asl ; ausrechnen asl ; clc ; Addition vorbereiten adc links ; addieren sta $08 ; sichern clc ; Addition vorbereiten adc #07 ; addieren sta $0a ; und sichern lda #$00 ; High Bytes sta $09 ; loeschen sta $0b ; und schreiben jsr invertrectangle rts :oben b 16 :links b 16 :fill lda am jsr setpattern jsr irectangle b 16 b 80 w 96 w 160 rts :scnclr lda #02 ; Muster #00 jsr setpattern ; aktivieren jsr irectangle ; Rechteck b $00 b 199 w 00 w 319 rts :copyan ldx #$00 :docopy1 lda aname,x sta name,x inx cpx #18 bne docopy1 rts :copyna ldx #$00 :docopy2 lda name,x sta aname,x inx cpx #18 bne docopy2 rts :clrn1 ldx #00 lda $00 :doc1 sta aname,x inx cpx #18 bne doc1 rts :clrn2 ldx #00 lda $00 :doc2 sta name,x inx cpx #18 bne doc2 rts :show ldx #31 stx counter1 :show1 lda counter1 jsr setpattern lda counter1 lsr lsr lsr tax lda y1,x sta $06 lda y2,x sta $07 lda counter1 and #$07 asl tax lda x1,x sta $08 lda x2,x sta $0a inx lda x1,x sta $09 lda x2,x sta $0b jsr rectangle dec counter1 ldx counter1 cpx #$ff bne show1 lda am jsr setpattern rts :weg1 lda #$00 jsr setpattern jsr irectangle b 01 b 11 w 145 w 199 lda am jsr setpattern rts :weg2 lda #$00 jsr setpattern jsr irectangle b 01 b 11 w 200 w 318 lda am jsr setpattern rts :nom lda #$00 sta $03 lda am sta $02 lda #09 sta $05 lda #<160 sta $18 lda #>160 sta $19 lda #%11000000 jsr putdecimal rts :snam lda #<aname sta $02 lda #>aname sta $03 lda #09 sta $05 lda #<200 sta $18 lda #>200 sta $19 jsr putstring rts :moveprg lda #<prgq sta $02 lda #>prgq sta $03 lda #<prg sta $04 lda #>prg sta $05 lda #<$28 sta $06 lda #>$28 sta $07 jsr movedata lda #$a9 sta prg rts :m1 b 00 b 00 b 00 b 24 b 24 b 00 b 00 b 00 :box1 b $81 b $0b b 08 b 08 w text1 b $0d b 08 b 24 b nz2 b 16 b 02 b 08 b 40 b 00 :box2 b $81 b $0b b 08 b 16 w text2 b $0b b 08 b 48 w text3 b $0b b 08 b 80 w text4 b 05 b 08 b 04 b 05 b 08 b 36 b 05 b 08 b 68 b 00 :box3 b $81 b $10 b $01 b 04 b 05 b 16 b 16 b 02 b 16 b 40 b 00 :text1 b "bitte neuen namen eingeben" b $00 :text2 b "neues file" b $00 :text3 b "altes file" b $00 :text4 b "desktop" b $00 :klass b "muster" b $00 :x1 w 176 w 192 w 208 w 224 w 240 w 256 w 272 w 288 :x2 w 191 w 207 w 223 w 239 w 255 w 271 w 287 w 303 :y1 b 16 b 32 b 48 b 64 :y2 b 31 b 47 b 63 b 79 :aname s 17 :name s 17 :prgq lda #<data sta $02 lda #>data sta $03 lda #<53248 sta $04 lda #>53248 sta $05 lda #<256 sta $06 lda #>256 sta $07 jsr movedata ldx #$3e ldy #$c2 stx $849b sty $849c rts s 26 org $5000 :prg s $30 :data