findword rts findreplace php rep $30 jsr getreplace plp rts find php rep $30 stz :findpos lda position sta :oldpos lda pos and #$ff clc adc position bcs :atend inc beq :atend cmp flen blt :fp :atend lda #$00 sta findstr :fp sta :pos tay beq :sta sep $20 ]l lda [fileptr],y and #$7f cmp #$0d beq :sta0 dey bne ]l bra :sta1 :sta0 iny :sta1 rep $30 :sta sty :linepos lda linenum sta :line lda findstr and #$ff bne :find jsr getfind jcs :xit lda findstr and #$ff jeq :xit sep $30 ldx findstr ]l lda findstr,x and #$7f cmp #'a' blt :lc1 cmp #'z'+1 bge :lc1 and #$5f :lc1 sta findstr,x dex bne ]l rep $30 stz :pos stz :linepos lda #$01 sta :line :find ldy :pos sep $20 :f0 ldx #$01 ]f cpy flen bge :notfound :f2 lda [fileptr],y and #$7f cmp #$0d beq :no1 cmp #'a' blt :f1 cmp #'z'+1 bge :f1 and #$5f :f1 cmp findstr,x bne :nexty inx iny txa cmp findstr blt ]f beq ]f sty :findpos jmp :done ;found here :nexty iny bra :f0 :no1 iny sty :linepos :no rep $30 sty :pos inc :line jmp :find :notfound rep $30 stz gotoposition jsr gotopos stz findstr jmp :xit :done rep $30 lda :line sta gotolnum jsr gotoline lda :findpos beq :xit sec sbc :linepos bcc :xit tax lda findstr and #$ff pha txa sec sbc 1,s sta 1,s pla bcc :xit and #$ff sta pos jsr poscurs :xit plp rts :oldpos ds 2 :pos ds 2 :line ds 2 :linepos ds 2 :findpos ds 2 checkcommands php rep $30 lda commandlen and #$00ff jeq :sec sta :len stz :which stz :max :loop rep $20 ldy :max lda cstrings,y and #$ff jeq :sec pha clc adc :max sta :max pla cmp :len bne :next ldx #$00 :find sep $20 lda externname,x and #$7f cmp #'a' blt :ok cmp #'z'+1 bge :ok and #$5f :ok cmp cstrings+1,y bne :next inx iny cpy :max blt :find jmp :found :next rep $30 inc :which inc :max jmp :loop :found rep $30 lda :which asl tax lda croutines,x sta :jsr+1 :jsr jsr $ffff jmp :clc :sec rep $30 lda #$00 plp sec rts :clc plp clc rts :which ds 2 :max ds 2 :len ds 2 cstrings str 'PFX' str 'PREFIX' str 'CATALOG' str 'CAT' str 'NEW' hex 0000 str 'DELETE' croutines dw setprefix dw setprefix dw docatalog dw docatalog dw donew dw delete mx %00 delete tll $2c03 tll $2c03 lda #$00 clc rts donew php rep $30 jsr newdoc jsr drawfname jsr gotoline lda #$00 plp clc rts mx %00 docatalog lda instring and #$ff sta :len cmp commandlen jlt :xit jeq :current lda commandlen and #$ff tax inx ldy #$00 sep $20 ]flush cpx :len blt :fl beq :fl jmp :current :fl lda instring,x inx and #$7f cmp #' ' jlt :current beq ]flush sta :pfx+1 ldy #$01 :save ]lup cpy #64 bge :setit lda instring,x and #$7f cmp #'/' beq :sta cmp #'.' beq :sta cmp #'0' blt :setit cmp #'9'+1 blt :sta cmp #'A' blt :setit cmp #'Z'+1 blt :sta cmp #'a' blt :setit cmp #'z'+1 bge :setit and #$5f :sta sta :pfx+1,y iny inx cpx :len blt ]lup beq ]lup :setit sep $20 tya sta :pfx rep $30 jmp :showcat :current rep $30 jsl prodos dw $0a adrl :pfxparm jcs :err sep $20 dec :pfx jmp :showcat :xit :err rep $30 lda #syntaxerr :err1 jsr doerror lda #$00 sec rts :nomem rep $30 lda #outofmem jmp :err1 :showcat rep $30 stz :openflag stz :close stz :handle stz :handle+2 jsl prodos dw $06 adrl :info jcs :caterr lda :type cmp #$0f jne :nodir jsl prodos dw $10 adrl :open jcs :caterr sec ror :openflag lda :open sta :eof sta :close sta :read jsl prodos dw $19 adrl :eof jcs :caterr psl #$00 psl :eof1 lda userid pha pea $C000 psl #$00 tll $0902 plx ply jcs :nomem stx :handle stx zpage sty :handle+2 sty zpage+2 lda :eof1 sta :request lda :eof1+2 sta :request+2 ldy #$02 lda [zpage] sta :buffer lda [zpage],y sta :buffer+2 jsl prodos dw $12 adrl :read jcs :caterr jsl prodos dw $14 adrl :close jcs :caterr stz :openflag jsr erasebox jsr drawbox1 lda :handle sta dirzp lda :handle+2 sta dirzp+2 ldy #$02 lda [dirzp] tax lda [dirzp],y sta dirzp+2 stx dirzp do 0 lda dirzp clc adc #$04 sta dirzp bcc :adc1 inc dirzp+2 fin :adc1 ldy #$23 lda [dirzp],y and #$00ff sta :entrylen iny lda [dirzp],y and #$ff sta :entper iny lda [dirzp],y sta :count stz :filepos :adc ldy #$04 lda [dirzp],y and #$0f sta :entlen lda #6 sta mycv lda #22-7 sta mych jsl textbascalc pea "/" tll $180c ldy #$05 ldx #$01 ]lup lda [dirzp],y phy phx and #$7f pha tll $180c plx ply iny inx cpx :entlen blt ]lup beq ]lup jsl print dfb 22-7 dfb 7 asc "-----name-------typ---aux----len---------date------",00 stz :catwhich jsr :catdraw :key do mouse ;jsr initmouse stz mousecr stz mousecrchar :key2 jsr mousekey bmi :and7f else :key2 fin ;--- mouse --- jsl keyscan bpl :key2 :and7f and #$7f cmp #$1b jeq :showxit cmp #$0d jeq :showxit cmp #$0a jeq :down cmp #$0b bne :key jmp :up :showxit jsr erasebox1 lda #$01 :catxit pha lda :handle ora :handle+2 beq :nodis psl :handle _Disposehandle :nodis pla clc rts :nodir rep $30 lda #notdir :caterr rep $30 jsr doerror bit :openflag bpl :cat1 jsl prodos dw $14 adrl :close :cat1 lda #$00 jmp :catxit :up lda :filepos beq :upxit dec :filepos lda #$8000 sta :catwhich jsr catscrolldn jsr :catdraw :upxit jmp :key :down lda :filepos clc adc #catentries cmp :count bge :upxit inc :filepos lda #$4000 sta :catwhich jsr catscrollup jsr :catdraw jmp :key :count ds 2 :entrylen ds 2 :filepos ds 2 :entper ds 2 :len ds 2 :handle ds 4 :openflag ds 2 :open dw $00 adrl :pfx adrl $00 :info adrl :pfx dw $00 :type dw $00 adrl $00 ds 14,0 :read dw $00 :buffer adrl $00 :request adrl $00 :transfer adrl $00 :eof dw $00 :eof1 adrl $00 :close dw $00 :pfxparm dw $00 adrl :pfx :pfx ds 68,0 :cdpos ds 2 :catwhich ds 2 :catdraw php rep $30 lda #08 sta mycv lda :filepos sta :cdpos sta :cdcount :cdloop lda :cdpos cmp :count jge :cdxit lda mycv cmp #8+catentries jge :cdxit lda #22-7 sta mych jsl textbascalc :pha pha pha lda :cdcount inc pha lda :entper pha tll $0b0b pla sta :blocknum pla sta :remain lda :blocknum xba asl ;* $200 clc adc #$04 sta :ypos pha pha lda :entrylen pha lda :remain pha tll $090b pla plx clc adc :ypos sta :ypos ldy :ypos lda [dirzp],y and #$f0 bne :cshow :inccd inc :cdcount jmp :pha :cshow bit :catwhich bvc :cshow1 lda mycv inc cmp #8+catentries jlt :inccv :cshow1 jsr :printent bit :catwhich bmi :cdxit :inccv inc mycv inc :cdcount inc :cdpos jmp :cdloop :cdxit plp rts :printent php rep $30 ldy :ypos lda [dirzp],y and #$0f beq :inccd sta :entlen iny ldx #$01 ]lup lda [dirzp],y and #$7f ora #$80 phx phy pha tll $180c ply plx inx iny cpx :entlen blt ]lup beq ]lup ]lup cpx #$11 bge :dtype lda #$a0 phx pha tll $180c plx inx jmp ]lup :dtype lda :ypos clc adc #$10 tay lda [dirzp],y and #$ff pha asl clc adc 1,s plx tax lda filetypelist,x phx pha tll $180c plx inx lda filetypelist,x phx pha tll $180c plx inx lda filetypelist,x pha tll $180c pea $a0 tll $180c pea $a0 tll $180c :daux pea #"$" tll $180c lda :ypos clc adc #$1f tay lda [dirzp],y jsr :prbytel pea $a0 tll $180c pea $a0 tll $180c :dlen pea #"$" tll $180c lda :ypos clc adc #$15 tay lda [dirzp],y jsr :prbytel pea $a0 tll $180c pea $a0 tll $180c lda :ypos clc adc #$21 tay lda [dirzp],y sta :year iny iny lda [dirzp],y sta :time lda :year and #%11111 sta :decimal cmp #$0a bge :d1 pea #" " tll $180c :d1 psl #:decimal pea $0000 jsl printdec pea #"-" tll $180c lda :year lsr lsr lsr lsr lsr and #%1111 dec asl asl tax lda ftmonths,x phx pha tll $180c plx inx lda ftmonths,x phx pha tll $180c plx inx lda ftmonths,x pha tll $180c pea #"-" tll $180c lda :year xba lsr and #%1111111 sta :decimal cmp #$0a bge :d2 pea #"0" tll $180c :d2 psl #:decimal pea $0000 jsl printdec pea #" " tll $180c pea #" " tll $180c lda :time xba and #%11111 sta :decimal cmp #$0a bge :d3 pea #" " tll $180c :d3 psl #:decimal pea $0000 jsl printdec pea #":" tll $180c lda :time and #%111111 sta :decimal cmp #$0a bge :d4 pea #"0" tll $180c :d4 psl #:decimal pea $0000 jsl printdec plp rts :cdcount ds 2 :ypos ds 2 :entlen ds 2 :blocknum ds 2 :remain ds 2 :decimal ds 2 :year ds 2 :time ds 2 :prbytel php rep $30 sta :byte xba jsr :prbyte lda :byte jsr :prbyte plp rts :byte ds 2 :prbyte php rep $30 pha lsr lsr lsr lsr and #$0F jsr :nib pla and #$F jsr :nib plp rts :nib ora #"0" cmp #"9"+1 blt :ok adc #"A"-"9"-2 :ok and #$7F pha tll $180c rts catscrollup ;fast scroll routine phy php phb rep $30 ldy #32 ;get ready for each column :start pea $0101 plb plb lda $4a8,y sta $428,y lda $528,Y sta $4A8,Y lda $5A8,Y sta $528,Y lda $628,Y sta $5A8,Y lda $6A8,Y sta $628,Y lda $728,Y sta $6A8,Y lda $7A8,Y sta $728,Y lda $450,Y sta $7A8,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $450,Y pea $0000 plb plb * rep $30 :lda2 lda $4a8,y sta $428,y lda $528,Y sta $4A8,Y lda $5A8,Y sta $528,Y lda $628,Y sta $5A8,Y lda $6A8,Y sta $628,Y lda $728,Y sta $6A8,Y lda $7A8,Y sta $728,Y lda $450,Y sta $7A8,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $450,Y dey ;decrement index dey cpy #6 blt :exit ;if not done with screen.. brl :start ;continue :exit plb plp ;restore flags ply rts ;and return catscrolldn phy php phb rep $30 ldy #32 ;get ready for each column :start pea $0101 plb plb lda $7A8,Y sta $450,Y lda $728,Y sta $7A8,Y lda $6A8,Y sta $728,Y lda $628,Y sta $6A8,Y lda $5A8,Y sta $628,Y lda $528,Y sta $5A8,Y lda $4A8,Y sta $528,Y lda $428,Y sta $4A8,Y ** lda $780,Y * sta $428,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $780,Y pea $0000 plb plb * rep $30 :lda2 lda $7A8,Y sta $450,Y lda $728,Y sta $7A8,Y lda $6A8,Y sta $728,Y lda $628,Y sta $6A8,Y lda $5A8,Y sta $628,Y lda $528,Y sta $5A8,Y lda $4A8,Y sta $528,Y lda $428,Y sta $4A8,Y * lda $780,Y * sta $428,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $780,Y dey ;decrement index dey cpy #6 blt :exit ;if not done with screen.. jmp :start ;continue :exit plb plp ;restore flags ply rts ;and return catscrollup1 ;fast scroll routine phy php phb rep $30 ldy #20 ;get ready for each column :start pea $0101 plb plb lda $4a8,y sta $428,y lda $528,Y sta $4A8,Y lda $5A8,Y sta $528,Y lda $628,Y sta $5A8,Y lda $6A8,Y sta $628,Y lda $728,Y sta $6A8,Y lda $7A8,Y sta $728,Y lda $450,Y sta $7A8,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $450,Y pea $0000 plb plb :lda2 lda $4a8,y sta $428,y lda $528,Y sta $4A8,Y lda $5A8,Y sta $528,Y lda $628,Y sta $5A8,Y lda $6A8,Y sta $628,Y lda $728,Y sta $6A8,Y lda $7A8,Y sta $728,Y lda $450,Y sta $7A8,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $450,Y dey ;decrement index dey cpy #6 blt :exit ;if not done with screen.. jmp :start ;continue :exit plb plp ;restore flags ply rts ;and return catscrolldn1 phy php phb rep $30 ldy #20 ;get ready for each column :start pea $0101 plb plb lda $7A8,Y sta $450,Y lda $728,Y sta $7A8,Y lda $6A8,Y sta $728,Y lda $628,Y sta $6A8,Y lda $5A8,Y sta $628,Y lda $528,Y sta $5A8,Y lda $4A8,Y sta $528,Y lda $428,Y sta $4A8,Y ** lda $780,Y * sta $428,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $780,Y pea $0000 plb plb :lda2 lda $7A8,Y sta $450,Y lda $728,Y sta $7A8,Y lda $6A8,Y sta $728,Y lda $628,Y sta $6A8,Y lda $5A8,Y sta $628,Y lda $528,Y sta $5A8,Y lda $4A8,Y sta $528,Y lda $428,Y sta $4A8,Y * lda $780,Y * sta $428,Y * php * sep $20 * lda #$A0 ;last line gets cleared * xba * lda #$A0 * plp * sta $780,Y dey ;decrement index dey cpy #6 blt :exit ;if not done with screen.. jmp :start ;continue :exit plb plp ;restore flags ply rts ;and return mx %00 setprefix lda instring and #$ff sta :len cmp commandlen jlt :xit jeq :xit lda commandlen and #$ff tax inx ldy #$00 sep $20 ]flush cpx :len blt :fl beq :fl jmp :err :fl lda instring,x inx and #$7f cmp #' ' jlt :xit beq ]flush sta :pfx+1 ldy #$01 :save ]lup cpy #64 bge :setit lda instring,x and #$7f cmp #'/' beq :sta cmp #'.' beq :sta cmp #'0' blt :setit cmp #'9'+1 blt :sta cmp #'A' blt :setit cmp #'Z'+1 blt :sta cmp #'a' blt :setit cmp #'z'+1 bge :setit and #$5f :sta sta :pfx+1,y iny inx cpx :len blt ]lup beq ]lup :setit sep $20 tya sta :pfx rep $30 jsl prodos dw $09 adrl :pfxparm jcs :err1 jsl prodos dw $0a adrl mypfxparm lda #$00 clc rts :xit :err rep $30 lda #syntaxerr jsr doerror lda #$00 sec rts :err1 pha jsl prodos dw $09 adrl mypfxparm pla jmp :err :len ds 2 :pfxparm dw $00 adrl :pfx :pfx ds 68,0 runcommand php plp sec rts rep $30 stz extdplen ;zero out all variables stz extdpadd stz extuserid stz extadd stz extadd+2 stz dpsave stz stacksave stz extdphdl stz extdphdl+2 stz extrunflag jsl prodos dw $06 ;file info adrl :infoparm bcc :chktype jmp :xit :chktype lda :type cmp #$b5 ;EXE file? jne :xit do 0 pha pea $5000 tll $2003 pla fin pha pha pha pha pha pea $0000 psl #externpath pea $FFFF tll $0911 ;InitialLoad..load the file * brk $02 tll $2C03 sec ror equitflag jmp :remove bcs :remove ;error loading?? pla sta extuserid ;Save new userid pla sta :extjsl+1 ;save Init address sta extadd ;save it again pla sep $20 sta :extjsl+3 ;do the high byte sta extadd+2 rep $20 pla sta extdpadd ;Get DP address pla sta extdplen ;Get length of DP jmp :ok ;go run it... :remove nop ;brk $02 :remove1 tsc ;remove bad parameters from stack clc adc #10 tcs jml :norun ;fall through and don't run it! :ok lda extdplen ;Was DP assigned? bne :setup ;Yes...so just setup our stuff psl #$00 ;We need to get some DP for Script psl #1024 ;$400 bytes lda extuserid ;Use it's UserID pha pea $c015 ;DP attributes psl #$00 ;must be bank $00 tll $0902 ;NewHandle pla ;get the low handle plx ;high handle jcs :norun ;Error? sta zpage ;dereference it sta extdphdl ;and also save handle for Shutdown stx zpage+2 ;do the High word stx extdphdl+2 lda [zpage] sta extdpadd ;we just need the low word b'cuz it's bank $00 lda #1024 ;tell setup that we got $400 bytes sta extdplen :setup lda extadd ora extadd+2 jeq :norun lda extadd sta zpage lda extadd+2 sta zpage+2 ldx #$00 ldy #24 ;offset to ID word lda [zpage],y cmp #$01 ;QuickEdit ID? jne :norun iny iny sep $20 ]lup lda [zpage],y cmp asciiid,x bne :norun iny inx cpx #$05 ;"QUICK" blt ]lup rep $20 tll $2c03 :setup1 phd pla sta dpsave ;save our current DP tsc ;Save our current stack sta stacksave php ;save the interupt status sei ;turn of interupts so no problems do 0 ldal $e100a8 ;replace P16 vectors sta p16vec ldal $e100a8+2 sta p16vec+2 ldal $e100b0 sta p16vec1 ldal $e100b0+2 sta p16vec1+2 lda p16jmp stal $e100a8 lda p16jmp+2 stal $e100a8+2 lda p16jmp1 stal $e100b0 lda p16jmp1+2 stal $e100b0+2 fin plp ;restore interupts sec ror extrunflag ;set high bit lda extdpadd ;set DP to Script DP pha pld clc ;add in the length to set up stack adc extdplen tcs ;put it in stack lda extuserid ;A=Scripts UserID * ldx #hsvectors ;X=Low word of vectortbl address * ldy #^hsvectors ;Y=High word of vectortbl address jmp :extjsl ;go call the script init routine :norun rep $30 phd ;if we get here...there was some error pla ;save some stuff needed below sta dpsave tsc sta stacksave jmp :restore ;and fall through to the RESTORE routine :extjsl jsl $FFFFFF ;this gets modified above..to call script :restore clc ;OK make sure everything is kosher xce phk plb rep $30 lda stacksave ;restore "our" stack tcs lda dpsave ;restore "our" DP pha pld bit extrunflag ;did we run the utility? bpl :xit ;minus=yes php ;save the interupt status sei ;turn of interupts so no problems do 0 lda p16vec stal $e100a8 ;replace P16 vectors lda p16vec+2 stal $e100a8+2 lda p16vec1 stal $e100b0 lda p16vec1+2 stal $e100b0+2 fin plp ;restore interupts :xit jsr unloadext ;and continue!!! plp rts :infoparm adrl externpath dw $00 :type dw $00 ds 20,0 :busy ds 2,0 p16jmp jml p16quit p16jmp1 jml p16quit1 p16qhandle clc ;OK make sure everything is kosher xce phk plb rep $30 lda stacksave ;restore "our" stack tcs lda dpsave ;restore "our" DP pha pld bit extrunflag ;did we run the utility? bpl :xit ;minus=yes php ;save the interupt status sei ;turn of interupts so no problems do 0 lda p16vec stal $e100a8 ;replace P16 vectors lda p16vec+2 stal $e100a8+2 lda p16vec1 stal $e100b0 lda p16vec1+2 stal $e100b0+2 fin plp ;restore interupts :xit jsr unloadext plp rts p16quit phb ;save the environment phk plb sty p16y ;save the Y reg php sep $20 lda $05,s ;get bank of call pha plb ;set to current bank ldy #$01 lda ($03,s),y ;read the command num of p16 call cmp #$29 ;is it QUIT? beq p16qhandle ;yes, so shutdown/restore everything plp ;if not restore what we changed phk plb ldy p16y ;restore the Y plb ;and the bank p16vec jml $FFFFFF ;jump to P16 entry vector p16y ds 2 p16quit1 phb ;save the current bank phk plb ;set to our bank php ;save the processor sep $20 lda $06,s ;get command num from stack cmp #$29 ;quit? beq p16qhandle ;yes so restore/shutdown external plp ;restore what we changed and call plb ;old P16 vector p16vec1 jml $FFFFFF unloadext rts php rep $30 lda extuserid ;check for valid UserID beq :handle ;Script doesn't exist!=> pea $00 ;Free Script memory lda extuserid pha pea $00 tll $1211 ;User ShutDown pla ;Don't know the meaning of this! * lda extuserid * pha * tll $2103 ;delete id :handle lda extdphdl ;Check for valid DP handle ora extdphdl+2 beq :xit ;if = then no DP was allocated by us. psl extdphdl _Disposehandle ;Kill the handle :xit stz extuserid stz extdphdl stz extdphdl+2 stz extrunflag plp rts ;and Return asciiid asc 'QUICK' extdpadd ds 2,0 ;Script DP address extdplen ds 2,0 ;Script DP length extuserid ds 2,0 ;Script UserID extdphdl ds 4,0 ;Script DP Handle extadd ds 4,0 ;Script Init Address extrunflag ds 2,0 ;flag indicating "running" application externdflt dw externname-extpath externpath dfb externname-extpath extpath asc '/PROFILE/' ;Name of the script file. externname ds 64,0 commandlen ds 2 drawbox php rep $30 lda termcv sta :cv lda termch sta :ch lda #$05 sta termcv lda #40 sta termch jsl setch sep $20 ldx #$0000 :main ldy #40 :loop phy phx jsl pickchar plx ply sta boxbuff,x cpy #40 beq :left cpy #40+36 beq :right lda termcv cmp #$05 beq :top cmp #$05+6 beq :bottom lda #" " jmp :next :left lda #$DA-$80 jmp :next :right lda #$DF-$80 jmp :next :top lda #$CC-$80 jmp :next :bottom lda #"_" :next phx phy jsl storchar ply plx inx iny cpy #40+36 blt :loop beq :loop lda termcv inc cmp #5+7 bge :done sta termcv phx jsl setch plx jmp :main :done rep $30 lda :cv sta termcv lda :ch sta termch jsl setch plp rts :ch ds 2 :cv ds 2 erasebox php rep $30 lda termcv sta :cv lda termch sta :ch lda #$05 sta termcv lda #40 sta termch jsl setch sep $20 ldx #$0000 :main ldy #40 :loop lda boxbuff,x :next phx phy jsl storchar ply plx inx iny cpy #40+36 blt :loop beq :loop lda termcv inc cmp #5+7 bge :done sta termcv phx jsl setch plx jmp :main :done rep $30 lda :cv sta termcv lda :ch sta termch jsl setch plp rts :ch ds 2 :cv ds 2 ]top equ 5 ]bottom equ 17 ]left equ 10 ]right equ 70 drawbox1 php rep $30 lda termcv sta :cv lda termch sta :ch lda #]top sta termcv lda #]left sta termch jsl setch sep $20 ldx #$0000 :main ldy #]left :loop phy phx jsl pickchar plx ply sta boxbuff,x cpy #]left beq :left cpy #]right beq :right lda termcv cmp #]top beq :top cmp #]bottom beq :bottom lda #" " jmp :next :left lda #$DA-$80 jmp :next :right lda #$DF-$80 jmp :next :top lda #$CC-$80 jmp :next :bottom lda #"_" :next phx phy jsl storchar ply plx inx iny cpy #]right blt :loop beq :loop lda termcv inc cmp #]bottom+1 bge :done sta termcv phx jsl setch plx jmp :main :done rep $30 lda :cv sta termcv lda :ch sta termch jsl setch plp rts :ch ds 2 :cv ds 2 drawbox1a php rep $30 lda termcv sta :cv lda termch sta :ch lda #]top sta termcv lda #]left sta termch jsl setch sep $20 ldx #$0000 :main ldy #]left :loop cpy #]left beq :left cpy #]right beq :right lda termcv cmp #]top beq :top cmp #]bottom beq :bottom lda #" " jmp :next :left lda #$DA-$80 jmp :next :right lda #$DF-$80 jmp :next :top lda #$CC-$80 jmp :next :bottom lda #"_" :next phx phy jsl storchar ply plx inx iny cpy #]right blt :loop beq :loop lda termcv inc cmp #]bottom+1 bge :done sta termcv phx jsl setch plx jmp :main :done rep $30 lda :cv sta termcv lda :ch sta termch jsl setch plp rts :ch ds 2 :cv ds 2 erasebox1 php rep $30 lda termcv sta :cv lda termch sta :ch lda #]top sta termcv lda #]left sta termch jsl setch sep $20 ldx #$0000 :main ldy #]left :loop lda boxbuff,x :next phx phy jsl storchar ply plx inx iny cpy #]right blt :loop beq :loop lda termcv inc cmp #]bottom+1 bge :done sta termcv phx jsl setch plx jmp :main :done rep $30 lda :cv sta termcv lda :ch sta termch jsl setch plp rts :ch ds 2 :cv ds 2 ]top equ 7 ]bottom equ 17 ]left equ 10+3 ]right equ 34+1 drawbox2 php rep $30 lda termcv sta :cv lda termch sta :ch lda #]top sta termcv lda #]left sta termch jsl setch sep $20 ldx #$0000 :main ldy #]left :loop lda termcv cmp #]top beq :top cmp #]bottom beq :bottom :loop2 cpy #]left beq :left cpy #]right beq :right :spc lda #" " jmp :next :left lda #$DA-$80 jmp :next :right lda #$DF-$80 jmp :next :top cpy #]right beq :spc cpy #]left beq :spc lda #"_" ;#$CC-$80 jmp :next :bottom cpy #]right beq :ul cpy #]left beq :ul lda #$dc-$80 ;#"_" jmp :next :ul lda #"_" :next phx phy jsl storchar ply plx inx iny cpy #]right blt :loop beq :loop lda termcv inc cmp #]bottom+1 bge :done sta termcv phx jsl setch plx jmp :main :done rep $30 lda :cv sta termcv lda :ch sta termch jsl setch plp rts :ch ds 2 :cv ds 2 insertcr rep $30 ;NOT a subroutine lda flen cmp #$ffff bge :cmdxit sep $20 ldy pos lda #$8d sta linebuff+1,y lda pos sta oldlen inc sta linebuff rep $30 lda #$ffff sta dirty jsr savebuff rep $30 jsr updatescreen lda termcv inc cmp #22 blt :dok jsl scroll lda #21 :dok sta termcv jsl setch jsr foreptr jsr getbuff jsr drawline stz pos stz pos1 jsr poscurs rep $30 inc linenum jsr drawcpos :cmdxit plp clc rts do 0 jsr drawcpos jsr getbuff jsr drawline stz pos stz pos1 inc linenum jsr poscurs jsr setfflags fin loadfile rep $30 ;NOT a subroutine!!!! stz getname stz :flag jsr getfname lda getname and #$ff beq :all cmp #$ff jeq :cmdxit sec ror :flag tax sep $20 :m1 lda getname,x sta efilename,x dex bpl :m1 rep $20 jmp :l :all lda alldirty beq :l :l stz :openflag stz :merlin stz :toolarge stz :loaded lda linenum sta gotolnum :sep sep $30 ldx efilename ]lup lda efilename,x and #$7f cmp #'a' blt :uc1 cmp #'z'+1 bge :uc1 and #$5f :uc1 sta :filename,x sta loadfilename,x dex bpl ]lup rep $30 jsr drawbox bit :flag jmi :rep jsr drawesccan jsl print dfb 44 dfb 7 asc "Load which file:",00 jsl getline adrl :filename dfb 15 dfb 44 dfb 10 php jsr drawesc plp jcs :sfplp :rep rep $30 lda :filename and #$00FF jeq :sfplp jsl print dfb 44 dfb 7 asc "Loading... ",00 stz :openflag lda :filename and #$ff cmp #3 blt :ginfo tax lda :filename,x and #$7f cmp #'S' beq :gdex cmp #'s' bne :ginfo :gdex dex lda :filename,x and #$7f cmp #'.' bne :ginfo sec ror :merlin :ginfo jsl prodos dw $06 adrl :info bcc :gtype jmp :err do 0 cmp #$46 jne :err :chk bit :merlin jmi :err sec ror :merlin sta :errcode lda :filename and #$00ff cmp #14 blt :chkmerlin :ec lda :errcode jmp :err :chkmerlin lda :filename and #$00ff tax lda :filename,x and #$7f cmp #'/' bne :cm sep $20 dec :filename rep $30 jmp :ginfo :cm lda :filename and #$ff inc tax sep $20 lda #'.' sta :filename,x inx lda #'S' sta :filename,x txa sta :filename rep $20 jmp :ginfo fin :gtype lda :type cmp #$04 ;text beq :doopen cmp #$b0 ;SRC beq :srcb0 cmp #$1a beq :apw jmp :nottxt :srcb0 stz :merlin jmp :doopen :nottxt lda #nottext jmp :err :apw jmp loadapw :doopen jsl prodos dw $10 adrl :open jcs :err sec ror :openflag lda :open sta :read sta :close sta :eof jsl prodos dw $19 ;get eof adrl :eof lda :eof+2 sta :request cmp #$ffff beq :too lda :eof+4 beq :z :too sec ror :toolarge lda #$fffe sta :request :z stz :request+2 lda fileptr sta :where lda fileptr+2 sta :where+2 jsr newdoc1 ;everything is wasted here.... jsl prodos dw $12 adrl :read jcs :err jsl prodos dw $14 adrl :close stz :openflag lda :request+4 sta flen sta editlen stz gotolnum sec ror :loaded :sfplp rep $30 bit :openflag bpl :set jsl prodos dw $14 adrl :close stz :openflag :set bit :loaded bpl :bit bit :merlin bpl :zero sep $20 :tabson ldx #$07 ]lup lda tabs1,x sta tabs,x dex bpl ]lup :zero sep $30 ldx :filename ]lup lda :filename,x and #$7f cmp #'a' blt :uc cmp #'z'+1 bge :uc and #$5f :uc sta efilename,x dex bpl ]lup rep $30 :bit bit :toolarge bpl :sfplp1 jmp :toolarge1 :sfplp1 jsr erasebox jsr gotoline jsr drawmem jsr drawtabs jsr drawfname :cmdxit plp clc rts :err rep $30 jsr doerror stz :toolarge jmp :sfplp :toolarge1 lda #toobigerr jmp :err :merlin ds 2 :errcode ds 2 :toolarge ds 2 :loaded ds 2 :openflag ds 2 :flag ds 2 :close ds 2 :open ds 2 adrl :filename adrl $0000 :read ds 2 :where adrl $00 :request adrl $00 adrl $00 :info adrl :filename ds 2 :type ds 2 :aux ds 4 ds 16 :eof ds 6 :filename ds 20 checkload php rep $30 stz :flag psl #tempbuff pea 128 _QAGetCmdLine ldx #tempbuff ldy #^tempbuff jsr parsepath bcc :load plp sec rts :load sec ror :flag lda filename and #$ff tax sep $20 :m1 lda filename,x sta efilename,x dex bpl :m1 rep $20 jmp :l :all lda alldirty beq :l :l stz :openflag stz :merlin stz :toolarge stz :loaded lda linenum sta gotolnum :sep sep $30 ldx efilename ]lup lda efilename,x and #$7f cmp #'a' blt :uc1 cmp #'z'+1 bge :uc1 and #$5f :uc1 sta filename,x sta loadfilename,x dex bpl ]lup stz efilename stz loadfilename rep $30 lda filename and #$00FF jeq :sfplp stz :openflag sep $30 ldx filename lda filename,x and #$7f cmp #'/' beq :nosufx cpx #63 bge :nosufx inx lda #'.' sta filename,x inx lda #'S' sta filename,x stx filename rep $30 sec ror :merlin :nosufx rep $30 :ginfo jsl prodos dw $06 adrl :info bcc :gtype jmp :err :gtype lda :type cmp #$04 ;text beq :doopen cmp #$b0 ;SRC beq :srcb0 * cmp #$1a * beq :apw jmp :nottxt :srcb0 stz :merlin jmp :doopen :nottxt lda #nottext jmp :err :apw jmp loadapw :doopen jsl prodos dw $10 adrl :open jcs :err sec ror :openflag lda :open sta :read sta :close sta :eof jsl prodos dw $19 ;get eof adrl :eof lda :eof+2 sta :request cmp #$ffff beq :too lda :eof+4 beq :z :too sec ror :toolarge lda #$fffe sta :request :z stz :request+2 lda fileptr sta :where lda fileptr+2 sta :where+2 jsr newdoc1 ;everything is wasted here.... jsl prodos dw $12 adrl :read jcs :err jsl prodos dw $14 adrl :close stz :openflag lda :request+4 sta flen sta editlen stz gotolnum sec ror :loaded :sfplp rep $30 bit :openflag bpl :set jsl prodos dw $14 adrl :close stz :openflag :set bit :loaded bpl :bit bit :merlin bpl :zero sep $20 :tabson ldx #$07 ]lup lda tabs1,x sta tabs,x dex bpl ]lup :zero sep $30 ldx filename ]lup lda filename,x and #$7f cmp #'a' blt :uc cmp #'z'+1 bge :uc and #$5f :uc sta efilename,x dex bpl ]lup rep $30 :bit bit :toolarge bpl :sfplp1 jmp :toolarge1 :sfplp1 jsr gotoline jsr drawmem jsr drawtabs jsr drawfname :cmdxit plp clc rts :err rep $30 pha jsr drawbox pla jsr doerror jsr erasebox stz :toolarge jmp :sfplp :toolarge1 lda #toobigerr jmp :err :merlin ds 2 :errcode ds 2 :toolarge ds 2 :loaded ds 2 :openflag ds 2 :flag ds 2 :close ds 2 :open ds 2 adrl filename adrl $0000 :read ds 2 :where adrl $00 :request adrl $00 adrl $00 :info adrl filename ds 2 :type ds 2 :aux ds 4 ds 16 :eof ds 6 filename ds 130,0 tempbuff ds 256,0 ptr = 0 parsepath php rep $30 :get stx ptr sty ptr+2 stz filename :go ldy #1 sep $20 lda [ptr] beq :nopath ]lup lda [ptr],y and #$7F cmp #' ' blt :nopath bne :l1 iny jmp ]lup :l1 iny lda [ptr],y and #$7F cmp #' ' blt :nopath bne :l1 :l2 iny lda [ptr],y and #$7F cmp #' ' blt :nopath beq :l2 cmp #';' beq :nopath rep $30 dey jsr :getword ;look for pathname or save bcc :nopath lda #$0000 jmp :error :nopath rep $30 lda #$46 * _getprefix :pfx :error plp cmp :one rts :pfx dw $00 adrl filename :getword php sep $30 ldx #0 ;no chars yet! stx filename ]loop iny lda [ptr],y ;get pathname till eol or delimiter found and #$7F clc beq :done ; 0 = end of line! cmp #'.' blt :done inx ;part of path, count & store it cpx #65 bge :done ;let's not let the bad boys in! cmp #'a' blt :sta cmp #'z'+1 bge :sta and #$5F :sta sta filename,x ;update pathname & it's length stx filename bra ]loop :done lda filename plp cmp :one rts :one dw $01 showhelp rep $30 plp clc rts lda termch pha lda termcv pha jsr drawbox1 jsl print dfb 18 dfb 8 asc "No Help available. ",00 lda #20 sta mych lda #7 sta mycv jsl textbascalc :pkey jsl keyscan bpl :pkey jsr erasebox1 pla sta termcv pla sta termch jsl setch plp clc rts ]left equ 20 exitquestion php rep $30 jsr drawbox jsr drawesccan1 jsl print dfb 47 dfb 7 asc "Release buffer memory?",00 sep $30 jsr yesno dfb 51+3 dfb 9 rep $30 and #$00ff pha php jsr erasebox jsr drawesc plp pla bcs :sec cmp #$01 blt :clc lda #$ffff sta superquit :clc plp clc rts :sec plp sec rts aboutsd do softdisk php rep $30 * jsr erasebox1 jsr drawbox1a jsl print dfb ]left dfb 12-6 asc "Another fine program from:",00 jsl print dfb ]left dfb 14-6 asc " SoftDisk Publishing, Inc.",00 jsl print dfb ]left dfb 15-6 asc " 606 Common Street",00 jsl print dfb ]left dfb 16-6 asc " Shreveport, LA 71101"00 jsl print dfb ]left-4 dfb 18-6 asc "For more information on SoftDisk, or to subscribe",00 jsl print dfb ]left-4 dfb 19-6 asc " to our monthly disk magazine that contains more",00 jsl print dfb ]left-4 dfb 20-6 asc " GREAT programs like this one....call us at:",00 jsl print dfb ]left-4 dfb 22-6 asc " 1-800-831-2694",00 plp rts else rts fin getfname rep $30 lda termch sta :tch lda termcv sta :tcv stz :iflag stz :handle stz :handle+2 :current rep $30 stz :count stz :errflag stz getname jsl prodos dw $0a adrl :pfxparm sep $20 dec :pfx :showcat rep $30 stz :openflag stz :close stz :handle stz :handle+2 jsl prodos dw $06 adrl :info jcs :caterr lda :type cmp #$0f jne :nodir jsl prodos dw $10 adrl :open jcs :caterr sec ror :openflag lda :open sta :eof sta :close sta :read jsl prodos dw $19 adrl :eof jcs :caterr psl #$00 psl :eof1 lda userid pha pea $C000 psl #$00 tll $0902 plx ply jcs :nomem stx :handle stx zpage sty :handle+2 sty zpage+2 lda :eof1 sta :request lda :eof1+2 sta :request+2 ldy #$02 lda [zpage] sta :buffer lda [zpage],y sta :buffer+2 jsl prodos dw $12 adrl :read jcs :caterr jsl prodos dw $14 adrl :close jcs :caterr stz :openflag jmp :bx :caterr rep $30 bit :openflag bpl :nodir jsl prodos dw $14 adrl :close stz :openflag jcs :caterr :nodir :nomem sec ror :errflag :bx rep $30 bit :iflag jmi :h jsr drawbox1 jsr drawbox2 lda #$07 ldx #50-4 ldy #$00 jsr drawbutton lda #$07+2 ldx #50-4 ldy #$8000 jsr drawbutton lda #$07+4 ldx #50-4 ldy #$8000 jsr drawbutton lda #$07+6 ldx #50-4 ldy #$ffff jsr drawbutton jsl print hex 3208 asc "Drive: ",00 jsl print hex 320A asc "Open: ",00 jsl print hex 320C asc "Close: ",00 jsl print hex 320E asc "Cancel:",00 :h sec ror :iflag jsr :erase1 bit :errflag bpl :deref stz :entrylen stz :entper stz :count stz :filepos stz :selectpos jmp :adc3 :deref lda :handle sta dirzp lda :handle+2 sta dirzp+2 ldy #$02 lda [dirzp] tax lda [dirzp],y sta dirzp+2 stx dirzp :adc1 ldy #$23 lda [dirzp],y and #$00ff sta :entrylen iny lda [dirzp],y and #$ff sta :entper iny lda [dirzp],y sta :count stz :filepos stz :selectpos :adc ldy #$04 lda [dirzp],y and #$0f sta :entlen :adc3 rep $30 lda #6 sta mycv lda #22-7 sta mych jsl textbascalc jsl prodos dw $0a adrl :pfxparm ldx #$01 lda :pfx and #$ff beq :c tay ]lup lda :pfx,x phy phx and #$7f pha tll $180c plx ply inx dey bne ]lup :c ]lup cpx #$40-8 bge :scd phx pea $a0 tll $180c plx inx jmp ]lup :scd stz :catwhich jsr :catdraw lda #$00 jsr :select :key do mouse ;jsr initmouse lda #$8d sta mousecrchar lda #$FFFF sta mousecr :key2 jsr mousekey bmi :and7f else :key2 fin ;--- mouse --- jsl keyscan bpl :key2 :and7f and #$7f cmp #$1b jeq :tab cmp #$0d jeq :showxitcr cmp #$7f jeq :showxitesc cmp #$09 jeq :tab1 ldy :count beq :key cmp #$0a jeq :down cmp #$0b jeq :up jmp :key :showxitcr rep $30 jsr :but2 lda getname and #$ff jeq :key jsl prodos dw $06 adrl :info1 jcs :key lda :type1 cmp #$0f beq :crdir cmp #$04 beq :eb1 cmp #$b0 beq :eb1 cmp #$1a beq :eb1 jmp :key :crdir lda :pfx and #$ff tax sep $20 clc adc getname cmp #64 bge :bell sta :pfx ldy #$01 inx ]lup lda getname,y sta :pfx,x iny inx cpy #$10 blt ]lup jmp :pfxset1 :bell rep $20 tll $2c03 jmp :key :showxitesc lda #$ff sta getname jsr :but4 :eb1 jsr erasebox1 lda #$01 :catxit pha lda :handle ora :handle+2 beq :nodis psl :handle _Disposehandle :nodis rep $30 lda :tch sta termch lda :tcv sta termcv jsl setch pla clc rts :tch ds 2 :tcv ds 2 :errflag ds 2 :tab jmp :poppfx :tab1 jmp :newdisk :up lda :selectpos beq :upxit cmp :filepos beq :ups jsr :erase dec :selectpos lda :selectpos sec sbc :filepos jsr :select jmp :key :ups lda #$8000 sta :catwhich jsr :erase jsr catscrolldn1 dec :filepos dec :selectpos jsr :catdraw lda #$00 jsr :select :upxit jmp :key :down lda :selectpos sec sbc :filepos bcc :down1 cmp #catentries-1 bge :down1 lda :selectpos inc cmp :count bge :upxit sta :selectpos jsr :erase lda :selectpos sec sbc :filepos jsr :select jmp :key :down1 lda :filepos clc adc #catentries cmp :count bge :upxit inc :filepos inc :selectpos jsr :erase jsr catscrollup1 lda #$4000 sta :catwhich jsr :catdraw lda #catentries-1 jsr :select jmp :key :select php rep $30 stz getname ldx :count jeq :sexit clc adc #$08 sta termcv sta :oldselect lda #22-7 sta termch lda termcv jsl setch lda termch tay stz :sbit ldx #$00 sep $20 :sloop1 jsl pickchar and #$7f bit :sbit bmi :scmp cmp #'.' beq :son cmp #'0' blt :soff cmp #'9'+1 blt :son cmp #'A' blt :soff cmp #'Z'+1 blt :son cmp #'a' blt :soff cmp #'z'+1 bge :soff :son sta getname+1,x inx pha txa sta getname pla jmp :scmp :soff sec ror :sbit :scmp cmp #$40 blt :stor cmp #$60 bge :stor sec sbc #$40 :stor jsl storchar iny cpy #34 blt :sloop1 rep $20 :sexit nop ;jsr showpath plp rts :sbit ds 2 :newdisk rep $30 jsr :but1 jsl prodos dw $21 adrl :lastdev lda :lastdev sta :ldev1 ]loop inc :lastdev lda :lastdev cmp :ldev1 jeq :nonew sta :devname jsl prodos dw $2c adrl :devname bcc :dpfxset1 cmp #$11 bne ]loop stz :lastdev jmp ]loop :dpfxset1 jsl prodos dw $08 adrl :volume jcs ]loop lda :volname sta zpage lda :volname+2 sta zpage+2 lda [zpage] and #$ff tay sep $20 ]lup lda [zpage],y sta :pfx,y dey bpl ]lup rep $30 jmp :pfxset1 :lastdev ds 2 :ldev1 ds 2 :devname ds 2 adrl :devname1 :devname1 ds 33,0 :volume adrl :devname1 :volname adrl $00 ds 4 ds 4 dw $00 :poppfx rep $30 jsr :but3 stz :pfx jsl prodos dw $0a adrl :pfxparm2 lda :pfx and #$00ff beq :nonew dec beq :nonew tay ]lup lda :pfx,y and #$7f cmp #'/' beq :pfxset dey cpy #$03 bge ]lup jmp :nonew :pfxset cpy #$02 blt :nonew tya sep $20 sta :pfx :pfxset1 rep $20 jsl prodos dw $09 adrl :pfxparm2 lda :handle ora :handle+2 beq :np1 psl :handle _Disposehandle stz :handle stz :handle+2 :np1 jmp :current :nonew rep $30 jmp :key :savech php rep $30 lda termch sta :sch1 lda termcv sta :sch2 sta termch stx termcv jsl setch plp rts :rstch php rep $30 lda :sch1 sta termch lda :sch2 sta termcv jsl setch plp rts :sch1 ds 2 :sch2 ds 2 :but1 php rep $30 lda #$08 jsr :invbut plp rts :but2 php rep $30 lda #$0A jsr :invbut plp rts :but3 php rep $30 lda #$0C jsr :invbut plp rts :but4 php rep $30 lda #$0E jsr :invbut plp rts :invbut php rep $30 tax lda #$30 jsr :savech ldy #$30 ]lup jsl pickchar and #$7f cmp #$40 blt :ibok cmp #$60 bge :ibok sec sbc #$40 :ibok jsl storchar iny cpy #$40 blt ]lup ldx #$7000 ]lup sec sbc #$01 dex bne ]lup ldy #$30 ]lup jsl pickchar ora #$80 jsl storchar iny cpy #$40 blt ]lup jsr :rstch plp rts :erase php rep $30 lda :oldselect sta termcv sta :oldselect lda #22-7 sta termch lda termcv jsl setch lda termch tay sep $20 :sloop2 jsl pickchar cmp #$01 blt :ora cmp #$20 bge :ora clc adc #$40 :ora ora #$80 jsl storchar iny cpy #34 blt :sloop2 rep $20 plp rts :erase1 php rep $30 lda #$08 sta termcv :e1l1 lda #22-7 sta termch lda termcv jsl setch lda termch tay sep $20 :sloop21 lda #$a0 jsl storchar iny cpy #34 blt :sloop21 rep $30 inc termcv lda termcv cmp #8+catentries blt :e1l1 rep $20 plp rts :count ds 2 :entrylen ds 2 :filepos ds 2 :entper ds 2 :selectpos ds 2 :oldselect ds 2 :len ds 2 :handle ds 4 :openflag ds 2 :open dw $00 adrl :pfx adrl $00 :info adrl :pfx dw $00 :type dw $00 adrl $00 ds 14,0 :info1 adrl getname dw $00 :type1 dw $00 adrl $00 ds 14,0 :read dw $00 :buffer adrl $00 :request adrl $00 :transfer adrl $00 :eof dw $00 :eof1 adrl $00 :close dw $00 :pfxparm dw $00 adrl :pfx :pfxparm2 dw $00 adrl :pfx :pfx ds 129,0 :iflag ds 2 :cdpos ds 2 :catwhich ds 2 :catdraw php rep $30 lda #08 sta mycv lda :filepos sta :cdpos sta :cdcount :cdloop lda :cdpos cmp :count jge :cdxit lda mycv cmp #8+catentries jge :cdxit lda #22-7 sta mych jsl textbascalc :pha pha pha lda :cdcount inc pha lda :entper pha tll $0b0b pla sta :blocknum pla sta :remain lda :blocknum xba asl ;* $200 clc adc #$04 sta :ypos pha pha lda :entrylen pha lda :remain pha tll $090b pla plx clc adc :ypos sta :ypos ldy :ypos lda [dirzp],y and #$f0 bne :cshow :inccd inc :cdcount jmp :pha :cshow bit :catwhich bvc :cshow1 lda mycv inc cmp #8+catentries jlt :inccv :cshow1 jsr :printent bit :catwhich bmi :cdxit :inccv inc mycv inc :cdcount inc :cdpos jmp :cdloop :cdxit plp rts :printent php rep $30 * pea $FF * pea $80 * tll $0a0c * lda :cdpos * cmp :selectpos * bne :ly * pea $FF * pea $00 * tll $0a0c :ly ldy :ypos lda [dirzp],y and #$0f beq :inccd sta :entlen iny ldx #$01 ]lup lda [dirzp],y and #$7f phx phy pha tll $180c ply plx inx iny cpx :entlen blt ]lup beq ]lup ]lup cpx #$11 bge :dtype lda #$a0 phx pha and #$7f tll $180c plx inx jmp ]lup :dtype lda :ypos clc adc #$10 tay lda [dirzp],y and #$ff pha asl clc adc 1,s plx tax lda filetypelist,x phx pha and #$7f tll $180c plx inx lda filetypelist,x phx pha and #$7f tll $180c plx inx lda filetypelist,x pha and #$7f tll $180c do 0 pea $20 tll $180c pea $20 tll $180c :daux pea #'$' tll $180c lda :ypos clc adc #$1f tay lda [dirzp],y jsr :prbytel pea $20 tll $180c pea $20 tll $180c :dlen pea #'$' tll $180c lda :ypos clc adc #$15 tay lda [dirzp],y jsr :prbytel pea $20 tll $180c pea $20 tll $180c lda :ypos clc adc #$21 tay lda [dirzp],y sta :year iny iny lda [dirzp],y sta :time lda :year and #%11111 sta :decimal cmp #$0a bge :d1 pea #' ' tll $180c :d1 psl #:decimal pea $0000 jsl printdec pea #'-' tll $180c lda :year lsr lsr lsr lsr lsr and #%1111 dec asl asl tax lda ftmonths,x phx pha and #$7f tll $180c plx inx lda ftmonths,x phx pha and #$7f tll $180c plx inx lda ftmonths,x pha and #$7f tll $180c pea #'-' tll $180c lda :year xba lsr and #%1111111 sta :decimal cmp #$0a bge :d2 pea #'0' tll $180c :d2 psl #:decimal pea $0000 jsl printdec pea #' ' tll $180c pea #' ' tll $180c lda :time xba and #%11111 sta :decimal cmp #$0a bge :d3 pea #' ' tll $180c :d3 psl #:decimal pea $0000 jsl printdec pea #':' tll $180c lda :time and #%111111 sta :decimal cmp #$0a bge :d4 pea #'0' tll $180c :d4 psl #:decimal pea $0000 jsl printdec fin * pea $FF * pea $80 * tll $0a0c plp rts :cdcount ds 2 :ypos ds 2 :entlen ds 2 :blocknum ds 2 :remain ds 2 :decimal ds 2 :year ds 2 :time ds 2 :prbytel php rep $30 sta :byte xba jsr :prbyte lda :byte jsr :prbyte plp rts :byte ds 2 :prbyte php rep $30 pha lsr lsr lsr lsr and #$0F jsr :nib pla and #$F jsr :nib plp rts :nib ora #"0" cmp #"9"+1 blt :ok adc #"A"-"9"-2 :ok and #$7F pha tll $180c rts drawbutton php rep $30 sta :temp sty :flag lda termch pha lda termcv pha lda :temp sta termcv stx termch stx :temp jsl setch bit :flag bmi :1 ldx #$00 ldy :temp iny ]lup lda #"_" phx phy jsl storchar ply plx iny inx cpx #20-2 blt ]lup :1 inc termcv jsl setch ldy :temp lda #$da-$80 jsl storchar iny lda #$20 jsl storchar iny ldx #$00 ]lup lda #$a0 jsl storchar iny inx cpx #20-4 blt ]lup lda #$20 jsl storchar iny lda #$df-$80 jsl storchar inc termcv jsl setch ldy :temp iny ldx #$00 ]lup bit :flag bvs :n lda #$dc-$80 bra :jsl :n lda #$cc-$80 :jsl jsl storchar iny inx cpx #20-2 blt ]lup :xit rep $30 pla sta termcv pla sta termch plp rts :temp ds 2 :flag ds 2 clrescreen ;ent ;routine clears the editor screen ;top 2 and bottom 2 lines left alone phy php phb rep $30 ldy #$26 ;get ready for each column :start pea $0101 plb plb lda #$A0A0 sta $6D0,Y sta $650,Y sta $5D0,Y sta $550,Y sta $4D0,Y sta $450,Y sta $7A8,Y sta $728,Y sta $6A8,Y sta $628,Y sta $5A8,Y sta $528,Y sta $4A8,Y sta $428,Y sta $780,Y sta $700,Y sta $680,Y sta $600,Y sta $580,Y sta $500,Y pea #$0000 plb plb sta $6D0,Y sta $650,Y sta $5D0,Y sta $550,Y sta $4D0,Y sta $450,Y sta $7A8,Y sta $728,Y sta $6A8,Y sta $628,Y sta $5A8,Y sta $528,Y sta $4A8,Y sta $428,Y sta $780,Y sta $700,Y sta $680,Y sta $600,Y sta $580,Y sta $500,Y dey ;decrement index dey bmi :exit ;if not done with screen.. jmp :start ;continue :exit plb plp ;restore flags ply rtl ;and return scrtbl ;ent ;table of screen offsets dw $400 dw $480 dw $500 dw $580 dw $600 dw $680 dw $700 dw $780 dw $428 dw $4A8 dw $528 dw $5A8 dw $628 dw $6A8 dw $728 dw $7A8 dw $450 dw $4D0 dw $550 dw $5D0 dw $650 dw $6D0 dw $750 dw $7D0 mx %11 inczp inc zpage1 bne :1 inc zpage1+1 :1 rts yesno pla ;get return address sta zpage1 ;and store in zero page pla sta zpage1+$1 jsr inczp ;point it at cursor position ldy #$00 lda (zpage1),y ;get cursor horizontal sta :pos1 ;store in this subroutine sta :pos2 jsr inczp lda (zpage1),y ;get cursor vertical sta :pos1+$1 ;save value in subroutine sta :pos2+$1 lda zpage1+$1 ;put new return address on pha ;stack lda zpage1 pha stz :pos ;initialize our position jsr :prno :wait do mouse ;jsr initmouse sec ror mousecr+1 lda #$8d sta mousecrchar :wait2 jsr mousekey bmi :kand else :wait2 fin ;--- mouse --- jsl keyscan ;get a key bpl :wait2 ;wait if not valid :kand and #$7f do mouse stz mousecr+1 ;only w/mouse usage fin :key cmp #$1B ;? beq :esc cmp #$0D ;? beq :cr cmp #$0a beq :wait cmp #$0b beq :wait cmp #'Y' ;check for "Y" and "N" beq :yes ;chars cmp #'y' beq :yes cmp #'N' beq :no cmp #'n' beq :no cmp #$08 ;backspace? beq :bs cmp #$15 ;right arrow? beq :rs :err jsr :bell ;error encountered jmp :wait ;get another char :bell rep $30 tll $2c03 sep $30 rts :esc sec ;indicate escape pressed rts ;return :cr lda :pos ;get answer clc ;ok char rts ;return :yes lda #$01 ;signal "YES" clc rts ;return :no lda #$00 ;nope.. clc ;valid answer rts ;return :bs jsr :prno stz :pos ;signal "NO" jmp :wait ;wait for another char :rs jsr :pryes lda #$01 ;signal "YES" sta :pos ;and save it jmp :wait ;get another char :pos hex 00 :prno jsl print :pos1 hex 0000 dfb 'O'&$1f asc ' No ' ;print an inverted no dfb 'N'&$1f asc ' Yes ',00 rts :pryes jsl print ;print an inverted yes :pos2 hex 1f17 asc ' No ' dfb 'O'&$1f asc ' Yes ' dfb 'N'&$1f hex 00 rts *-----------------------------------------------* * Name : GETLINE * * Function : GET A LINE OF INPUT * * Input : JSL GETLINE * * ADRL
* * HEX * * HEX CH/CV * * Output : CARRY * * CLEAR : INPUT LINE VALID * * SET : ESCAPE KEY PRESSED * * Volatile : NOTHING * * Calls : GETKEY, STORCHAR, SETCH * *-----------------------------------------------* getline ;ent ;read in a line of text php phb phk plb rep $30 sta :asave stx :xsave sty :ysave lda termch sta :oldch lda termcv sta :oldcv lda cursor sta :curs lda #' ' sta cursor lda 3,s sta tempzp lda 5,s and #$00FF sta tempzp+2 inc tempzp bne :zp1 inc tempzp+2 :zp1 ldy #$02 lda [tempzp] sta tempzp1 lda [tempzp],y sta tempzp1+2 iny iny lda [tempzp],y and #$FF sta :maxlen iny lda [tempzp],y sep $20 sta termch sta :prompt xba sta termcv rep $30 jsl setch lda #$06 clc adc tempzp sta tempzp lda #$00 adc tempzp+2 sta tempzp+2 sep $20 sta 5,s rep $20 lda tempzp sta 3,s stz :cflag sep $30 :start ldy #$FF ;transfer current :trnsfr iny ;string to buffer lda [tempzp1],y sta buffer,y cpy buffer blt :trnsfr ldy buffer ;get length of current iny ;string lda #$00 sta buffer,y ;place marker at end sta :pos ;initialize position inc :pos ;position 1 :loop jsr :prline ;show the string ldy :pos ;get our pos dey tya clc adc :prompt ;add with offset sta termch ;and move cursor. jsl setch do mouse sec ror mousecr+1 lda #$9b ;escape w/mouse control sta mousecrchar fin jsr getkey ;get a key from keyboard ora #$80 ;set high bit sta :char ;and save it cmp #$8b beq :loop cmp #$8a beq :loop cmp #$9B ;is it ? beq :key1 ;yes.. cmp #$8D ;? beq :key2 cmp #$88 ;back space? beq :key3 cmp #$FF ;delete? beq :key4 cmp #$95 ;right arrow? beq :key5 cmp #$99 ;control-y? beq :key6 cmp #$A0 ;valid char? blt :bell cmp #$45+$80 beq :key7 cmp #$65+$80 beq :key7 cmp #$FF bge :bell :k7ins jsr :insert ;ok, so insert it jmp :loop :key1 jmp :esc ;jump to key handler routines :key2 jmp :cr :key3 jmp :bkspc :key4 jmp :delete :key5 jmp :rghtarr :key6 jmp :cntrly :key7 jmp :ekey :bell rep $30 tll $2C03 sep $30 jmp :loop :ekey pha lda $E0C061 tax pla cpx #$80 blt :k7ins lda cursor and #$7F cmp #' ' beq :ul lda #' ' sta cursor jmp :loop :ul lda #"_" sta cursor jmp :loop :cr ldy #$00 ;execute a carriage return :mov lda buffer,y sta [tempzp1],y iny cpy :maxlen bne :mov ;done with move? lda buffer,y ;get last char sta [tempzp1],y ;move it lda buffer ;get length of input string cmp :maxlen ;greater than maximum? blt :setsize ;no=> lda :maxlen ;yes, so get maximum :setsize ldy #$00 ;set index to length byte sta [tempzp1],y ;store length lda :cflag ;read change flag beq :crout ;if zero, don't move STRING lda #$00 jsl bascalc ;move cursor there ldy #$32 ;reset counter ldx #$00 ;loop counter :restr lda topbuff,x ;get a char jsl storchar ;restore it on screen inx ;increment counter iny ;increment pos cpy #$50 ;end of screen? blt :restr ;nope=> :crout clc ;signal php ;save status jmp :exit ;exit :esc lda :cflag :read beq :escout ;if zero, exit lda termcv ;save cv value pha ;save it lda #$00 jsl bascalc ;set base address ldy #$32 ;set screen pos ldx #$00 ;set counter :res lda topbuff,x ;get a char jsl storchar ;restore it inx ;increment counter iny ;increment screen pos cpy #$50 ;end of screen? blt :res ;nope=> pla ;get cv value sta termcv ;save it jsl setch ;set cursor stz :cflag ;reset change flag jmp :start ;do it all over! :escout sec ;signal pressed php ;put on stack :exit rep $30 lda :oldch ;get old cursor ch sta termch ;restore it lda :oldcv ;get old cv sta termcv ;restore it jsl setch ;set ch/cv lda :curs sta cursor lda :asave ;restore a-reg ldy :ysave ;restore y-reg ldx :asave ;restore x-reg plp ;restore status bcs :sec plb plp clc rtl :sec plb plp sec rtl ;and return mx %11 :delete lda :pos ;get our position cmp #$01 ;at the beginning? beq :nodel ;yes=> tay ;put value in y-reg :delmov lda buffer,y ;get a char beq :delsize ;if at end, continue dey ;move it left sta buffer,y ;store it iny ;get ready for next char iny bne :delmov ;continue until done :delsize dey sta buffer,y ;move last char dec buffer ;decrement length dec termch ;our cursor pos dec :pos ;and our pos in line jsr :change ;set the change flag jmp :loop ;return for more :nodel rep $30 ;beeeeep! tll $2C03 sep $30 jmp :loop ;continue :bkspc lda :pos :get cmp #$01 ;at left edge? beq :nobkspc ;yes=> dec :pos ;decrement position dec termch ;cursor position jmp :loop ;and continue :nobkspc jmp :loop ;continue :rghtarr ldy :pos :get dey ;set for correct value cpy buffer ;compare with length bge :norght ;can't go Right cpy :maxlen ;greater than max? bge :norght ;yes=> inc :pos ;otherwise, increment pos inc termch ;cursor, jmp :loop ;and continue :norght jmp :nobkspc ;ring the bell :cntrly ldy :pos :get dey ;modify it sty buffer ;set length to that value iny ;set y to end lda #$00 ;get e.o.l marker sta buffer,y ;indicating end of line jsr :change ;set change flag jmp :loop ;continue :insert lda :pos cmp #$02 bge :ins1 stz buffer stz buffer+1 lda #$01 sta :pos :ins1 lda cursor ;get current cursor type and #$7F ;clear high bit cmp #$20 ;is it a space? beq :solid ;yes=> lda buffer ;get length byte cmp #$FE ;full? bge :full ;yes=> ldy :pos ;get our position dey cpy :maxlen ;at max length? bge :full ;yes=> iny ;reset y-reg ldy buffer ;get length byte iny ;add one :movrt dey ;set for previous char lda buffer+1,y ;get the char iny ;move it right sta buffer+1,y ;store it dey ;ready for next char cpy :pos ;done? bge :movrt ;no, so loop ldy :pos ;get :pos lda :char ;get last char pressed sta buffer,y ;insert in string inc buffer ;increment length inc :pos ;increment our position inc termch ;our cursor pos jsr :change ;set the change flag rts ;return to main return :solid lda buffer ;get length cmp #$FE ;are we full? bge :full ;yes=> ldy :pos ;get our pos dey cpy :maxlen ;at max length? bge :full ;yes, so can't insert iny cpy buffer ;at the end? blt :ins ;no, so no problems iny ;otherwise, move e.o.l. char lda #$00 sta buffer,y dey :ins lda :char ;get the char sta buffer,y ;insert it inc termch ;increment cursor lda buffer ;get length cmp :pos ;compare with position bge :insmid inc buffer ;increment length :insmid inc :pos ;increment our position jsr :change ;set change flag rts ;return :full rep $30 ;ring bell tll $2C03 sep $30 rts ;return :prline pha ;save the registers tya pha lda :prompt ;get start position sta termch ;store in cursor jsl setch ;move cursor to it ldy #$00 ;reset index :prt lda buffer+1,y ;get a char beq :end ;if done, continue cpy :maxlen ;at our max length? bge :end ;yes, so stop jsr :prntchar ;otherwise, print the char iny ;increment index bne :prt ;go back for more :end lda #$A0 ;get a space char :clr cpy :maxlen ;have we printed all chars bge :lineout ;yes, so exit jsr :prntchar ;otherwise, clear to end iny bne :clr :lineout pla ;restore registers tay pla rts ;and return :change php sep $30 lda termch :save pha lda termcv pha lda :cflag ;read change flag bmi :mexit ;if already set exit lda #$FF ;get a negative value sta :cflag ;set the flag lda #$00 jsl bascalc ;set base address ldx #$00 ;reset loop counter ldy #$32 ;get position counter :movit jsl pickchar ;get a char sta topbuff,x ;save it in buffer lda #$A0 ;get a space char jsl storchar ;clear a position iny ;increment position inx ;increment counter cpy #$50 ;at end of screen? blt :movit ;nope=> lda #$3C sta termch sta mych stz termcv stz mycv jsl textbascalc jsl setch rep $30 psl #:escstr jsl drawstr sep $30 :mexit pla ;restore old cursor pos sta termcv pla sta termch jsl setch ;set values plp rts ;and return :prntchar phy php sep $30 ldy termch ora #$80 jsl storchar inc termch plp ply rts :escstr str "Escape: Erase entry" :asave ds 2 :ysave ds 2 :xsave ds 2 :oldch ds 2 :oldcv ds 2 :cflag ds 2 :char ds 2 :prompt ds 2 :pos ds 2 :maxlen ds 2 :curs ds 2 buffer ds 275,0 topbuff ds 40,0 keyscan ;ent ;read the keyboard using the php ;event manager. phb phk plb rep $30 bit emstarted bmi :emyes sep $20 ldal $E0C000 bmi :hwyes jmp :no :hwyes pha ldal $E0C010 ldal $E0C025 sta emod+1 pla rep $20 and #$00FF jmp :yes1 :emyes pha pea $FFFF psl #event tll $0A06 ;getnextevent pla beq :no lda event cmp #$03 beq :yes cmp #$05 beq :yes :no plb plp rep $80 rtl :yes lda emess and #$00FF ora #$0080 :yes1 plb plp sep $80 rtl memfull php rep $30 jsr drawbox jsl print dfb 44 dfb 7 asc "Memory Full",00 lda selecting pha lda #$8000 sta selecting jsr getkey pla sta selecting jsr erasebox plp rts getfind php rep $30 jsr drawbox stz findstr jsl print dfb 44 dfb 7 asc "Text to FIND:",00 jsl getline adrl findstr dfb 30 dfb 44 dfb 10 php jsr erasebox plp bcs :sec plp clc rts :sec plp sec rts getreplace php rep $30 jsr drawbox stz findstr stz replacestr jsl print dfb 44 dfb 7 asc "Change: ",00 jsl print dfb 44 dfb 7+2 asc " To: ",00 jsl getline adrl findstr dfb 20 dfb 44+9 dfb 7 bcs :erase jsl getline adrl replacestr dfb 20 dfb 44+9 dfb 7+2 bcs :sec :erase php jsr erasebox plp bcs :sec plp clc rts :sec plp sec rts doerror php rep $30 and #$00ff sta :errcode jsl print dfb 44 dfb 7 asc " ",00 stz :which :loop lda :which asl tax lda :tbl,x beq :nocode cmp :errcode beq :found inc :which jmp :loop :found lda :which asl tax lda :tbl1,x sta :add+1 sta :add1+1 lda #44 sta mych lda #7 sta mycv jsl textbascalc :add lda $ffff and #$00ff sta :len ldx #$01 ]lup phx :add1 lda $ffff,x and #$007f jsl drawchar plx inx cpx :len blt ]lup beq ]lup jmp :wait :nocode jsl print dfb 44 dfb 7 asc "GS/OS Error $",00 lda #57 sta mych lda #7 sta mycv jsl textbascalc lda :errcode jsl prbyte :wait tll $2C03 :key jsl keyscan bpl :key plp rts :which ds 2 :errcode ds 2 :len ds 2 :tbl dw nottext dw toobigerr dw syntaxerr dw $07 ;ProDOS busy dw $27 ;I/O error dw $28 ;No Device dw $2b ;Write Protected dw $2f ;No Device dw $40 ;bad pathname dw $44 ;directory not found dw $45 ;volume not found dw $46 ;file not found dw $47 ;duplicate filename dw $48 ;disk full dw $49 ;volume full dw outofmem dw notdir dw $4e ;File locked dw $0000 :tbl1 dw :str1 dw :str2 dw :str3 dw :str4 dw :str5 dw :str6 dw :str7 dw :str8 dw :str9 dw :str10 dw :str11 dw :str12 dw :str13 dw :str14 dw :str15 dw :str16 dw :str17 dw :str18 :str1 str 'Not a TXT/SRC file.' :str2 str 'File too Large!' :str3 str 'Syntax Error' :str4 str 'ProDOS busy' :str5 str 'I/O error' :str6 str 'No Device Connected' :str7 str 'Write Protected' :str8 str 'No Device Connected' :str9 str 'Bad Pathname' :str10 str 'Directory not Found' :str11 str 'Volume not Found' :str12 str 'File not Found' :str13 str 'Duplicate Filename' :str14 str 'Disk Full' :str15 str 'Volume Full' :str16 str 'Not Enough Memory' :str17 str 'Not Subdirectory' :str18 str 'File Locked' do library userid ext else userid ds 2,0 fin editlen ds 4,0 dphandle ds 4,0 dppointer ds 2,0 efilename ds 130,0 loadfilename ds 130,0 getname ds 67,0 pfxsave ds 67,0 mypfx ds 67,0 pfxparm dw $00 adrl pfxsave mypfxparm dw $00 adrl mypfx dpsave ds 2 stacksave ds 2 event ds 2 ;event record...use by taskmaster emess ds 4 ;event message ewhen ds 4 ;tick count ewhere cursy ds 2 ;cursor y in global coords cursx ds 2 ;cursor x in global coords emod ds 2 ;modifier keys instring ds 256,0