storchar php phd ;save everything rep $30 phx phy pha pha tsc inc tcd ;make 4 bytes of DP lda basl sta 0 ;save our offset sep $30 cpy #80 bge :bad ldx #^mainbank tya lsr tay bcs :bank0 ldx #^auxbank :bank0 lda 2 ;get the char back stx 2 ;save the bank byte sta [0],y ; :bad rep $30 lda 2 plx ;remove the ptr plx ply plx pld ;restore the DP plp ;and P rts *====================================================== * Get a character from screen at location in Y reg from left margin pickchar php phd ;save everything rep $30 phx phy pha pha tsc inc tcd ;make 4 bytes of DP lda basl sta 0 ;save our offset sep $30 cpy #80 bge :bad ldx #^mainbank tya lsr tay bcs :bank0 ldx #^auxbank :bank0 stx 2 ;save the bank byte lda [0],y ; :bad rep $30 and #$FF plx ;remove the ptr plx ply ;restore the registers plx pld ;restore the DP plp ;and P rts clearwindow bit fullwindow jmi :port lda #$A0A0 ldx #40-2 ]lup stal $400+mainbank,x stal $400+auxbank,x stal $480+mainbank,x stal $480+auxbank,x stal $500+mainbank,x stal $500+auxbank,x stal $580+mainbank,x stal $580+auxbank,x stal $600+mainbank,x stal $600+auxbank,x stal $680+mainbank,x stal $680+auxbank,x stal $700+mainbank,x stal $700+auxbank,x stal $780+mainbank,x stal $780+auxbank,x stal $428+mainbank,x stal $428+auxbank,x stal $4a8+mainbank,x stal $4a8+auxbank,x stal $528+mainbank,x stal $528+auxbank,x stal $5a8+mainbank,x stal $5a8+auxbank,x stal $628+mainbank,x stal $628+auxbank,x stal $6a8+mainbank,x stal $6a8+auxbank,x stal $728+mainbank,x stal $728+auxbank,x stal $7a8+mainbank,x stal $7a8+auxbank,x stal $450+mainbank,x stal $450+auxbank,x stal $4d0+mainbank,x stal $4d0+auxbank,x stal $550+mainbank,x stal $550+auxbank,x stal $5d0+mainbank,x stal $5d0+auxbank,x stal $650+mainbank,x stal $650+auxbank,x stal $6d0+mainbank,x stal $6d0+auxbank,x stal $750+mainbank,x stal $750+auxbank,x stal $7d0+mainbank,x stal $7d0+auxbank,x dex dex jpl ]lup rts :port phd ;save the DP pha ;make some room on the stack pha tsc ;to use as DP inc tcd lda wintop ;get the topline sta :ct ;save it as a counter lda winwidth ;get the right margin beq :done cmp #80+1 ;too big? blt :1 lda #80 ;force to right side :1 sta :width ]lup rep $30 lda :ct ;what line are we on? cmp winbot blt :ok ;done yet? bne :done :ok asl tax lda table,x ;get the base offset clc adc winleft ;add with left margin sta 0 ;and save in our temp DP sep $30 ;8 bit now for speed ldy #0 ;start at 0 lda #' ' ;space char ]lup1 ldx #^mainbank ;default to bank1 xba tya lsr bcs :bank0 ldx #^auxbank :bank0 stx 2 ;save in bank byte of ptr xba sta [0],y iny cpy :width blt ]lup inc :ct bra ]lup :done rep $30 pla pla ;pull off ptr from stack pld ;retore dp rts :ct ds 2 :width ds 2 scrollup ;ent ;fast scroll routine php phb rep $30 phy ldy #40-2 ;get ready for each column :start pea $0101 plb plb lda $480,y sta $400,y lda $500,y sta $480,y lda $580,Y ;scroll one column sta $500,Y lda $600,Y sta $580,Y lda $680,Y sta $600,Y lda $700,Y sta $680,Y lda $780,Y sta $700,Y lda $428,Y sta $780,Y 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 lda $4D0,Y sta $450,Y lda $550,Y sta $4D0,Y lda $5D0,Y sta $550,Y lda $650,Y sta $5D0,Y lda $6D0,Y sta $650,Y lda $750,Y sta $6D0,Y lda $7D0,y sta $750,y lda #$A0A0 sta $7D0,Y pea $0000 plb plb :lda2 lda $480,y sta $400,y lda $500,y sta $480,y lda $580,Y ;scroll an odd column sta $500,Y lda $600,Y sta $580,Y lda $680,Y sta $600,Y lda $700,Y sta $680,Y lda $780,Y sta $700,Y lda $428,Y sta $780,Y 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 lda $4D0,Y sta $450,Y lda $550,Y sta $4D0,Y lda $5D0,Y sta $550,Y lda $650,Y sta $5D0,Y lda $6D0,Y sta $650,Y lda $750,Y sta $6D0,Y lda $7D0,y sta $750,y lda #$A0A0 sta $7D0,Y dey ;decrement index dey bmi :exit ;if not done with screen.. brl :start ;continue :exit ply plb plp ;restore flags rts ;and return table 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 *====================================================== printchar php sep $30 and #$7f xba lda charflag+1 and #%1110_0000 beq :print cmp #%1110_0000 beq :print brl :multiple :print lda charflag+1 ;printing time/version/justify and #%000_0111 beq :p1 brl printTVJ ; yes- handle it! :p1 lda charflag and #%111 bne :gotoxy xba cmp #' ' jlt :control bit charflag bvs :mouse bmi :ora cmp #'A' ;inverse starts here blt :jsr cmp #'Z'+1 bge :jsr sec sbc #$40 ;convert to inverse uppercase bra :jsr :ora ora #$80 bra :jsr :mouse and #$1f ora #$40 ;convert to mouse text :jsr xba lda cursx clc adc winleft cmp #80 bge :cr tay xba jsr storchar inc cursx lda cursx cmp winwidth blt :xit :cr stz cursx :lf inc cursy lda cursy cmp winbot blt :update beq :update jsr scrollup lda winbot sta cursy :update rep $30 and #$7f asl tay lda table,y sta basl sep $30 :xit plp rts mx %11 :gotoxy bit #%100 bne :tabx and #$03 cmp #$01 beq :x :y xba :y1 sec sbc #32 ;subtract out space sta cursy lda :xtemp sec sbc #32 ; because zero is EOB sta cursx lda #$07 trb charflag jsr setcurs brl :xit :x lda #$03 tsb charflag xba :x1 sta :xtemp brl :xit :tabx xba sta cursx lda #$7 trb charflag jsr setcurs brl :xit :xtemp ds 2 :control rep $30 and #$1f pha cmp #$0d beq :cr2 cmp #$0a beq :lf2 stz outflag :c1 pla asl tax jsr (:tbl,x) plp rts :cr2 lda #$80 tsb outflag bra :c1 :lf2 lda #$40 tsb outflag bra :c1 mx %11 :multiple cmp #%1000_0000 beq :m2 :m3 xba sta :outchar lda #%1110_0000 tsb charflag+1 :ml lda :outcount beq :moff lda :outchar jsr printchar dec :outcount bra :ml :moff lda #%1110_0000 trb charflag+1 stz :outcount stz :outchar brl :xit :m2 xba sta :outcount lda #%1100_0000 tsb charflag+1 brl :xit :outcount ds 2 :outchar ds 2 :tbl da nil ;0 da savex ;^A da savey ;^B da restorex ;^C da restorey ;^D da nil ;^E da nil ;^F da bell ;^G da backspace ;^H da tab2 ;^I da linefeed ;^J da clreos ;^K da formfeed ;^L da textcr ;^M da normal ;^N da inverse ;^0 da savexy ;^P da nil ;^Q da nil ;^R da nil ;^S da restorexy ;^T da printmult ;^U da scrollup ;^V da nil ;^W da mouseoff ;^X da home ;^Y da clrline ;^Z da mouseon ;^[ $1B da nil ;^\ $1C da clreoln ;^] $1D da gotoxy ;^^ $1E da upone ;^_ $1F upone php rep $30 lda cursy beq :plp dec sta cursy jsr setcurs :plp plp rts backspace php rep $30 lda cursx beq :plp dec sta cursx jsr setcurs :plp plp rts bell php rep $30 tll $2c03 plp rts *====================================================== * Return the quit/launch information we have obtained QAGetLaunch dum $00 ]rtl ds 6 ;these are passed on stack ]newstack = *-6 ;must be at end of passed params ]flags ds 2 ]pathptr ds 4 dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda #launchpath sta ]pathptr lda #^launchpath sta ]pathptr+2 lda launchflags sta ]flags lda #0 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit *====================================================== * Tell the controlling program how we wish to exit... QASetLaunch dum $00 ]rtl ds 6 ;these are passed on stack ]flags ds 2 ]pathptr ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda ]flags sta launchflags lda []pathptr] and #$ff tay sep $20 ]lup lda []pathptr],y sta launchpath,y dey bpl ]lup rep $20 lda #0 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit mygetline dum $00 ]rtl ds 6 ;these are passed on stack ]abortptr ds 4 ]cursor ds 2 ]cursors ds 2 ]startpos ds 2 ]maxlen ds 2 ]prompt ds 4 ]lineptr ds 4 ]newstack = *-6 ;must be at end of passed params ]cursout ds 2 ]endpos ds 2 ]endkey ds 2 dend mx %00 lda ]cursor sep $20 sta cursor xba sta fillchar rep $20 lda ]cursors sep $20 sta insert xba sta overstrike rep $20 stz curpos lda ]maxlen cmp #80 blt :max lda #80 :max sta ]maxlen lda cursx sta startx lda []prompt] and #$FF clc adc cursx sta startpos ;save starting position restore rep $30 lda []lineptr] ;get length and #$FF tay ;length in Y sep $20 sta tempbuff lda ]startpos cmp tempbuff blt :scp lda tempbuff :scp sta curpos ;save current position lda tempbuff beq prtnew :1 lda []lineptr],y ;get a character sta tempbuff,y ;copy bytes over dey bne :1 ;copy the string over prtnew rep $30 lda startx sta cursx ldx ]prompt+2 lda ]prompt jsl pstr lda startpos sta cursx ;move cursor over again ldx #^tempbuff lda #tempbuff ;get my buffer jsl pstr sep $20 lda ]maxlen sec sbc tempbuff ;get remaining length rep $20 and #$FF tax ;amount of spaces sep $20 ;use short bcc :spconly beq :spconly :9 ldy cursx :91 lda fillchar ;get fill char phy phx jsr storchar ;add the fill character plx ply iny dex bne :91 :spconly lda #" " ;add space at the end ldy cursx jsr storchar *------------------------------------------------- newpos rep $30 lda curpos clc adc startpos ;add starting x-pos sta cursx ;position cursor newkey rep $30 jsr getkey and #%11010000_11111111 cmp #$FF ;char? bge :find cmp #" " ;space? bge tochar ;its a character! :find ldx i_Cmds ;get # cmds *2 :cmdloop cmp cmds,x ;found it yet? beq gotcmd ;yep-->handle command dex dex bpl :cmdloop ;keep trying * Check the 'Abort' list: pha ;save character lda []abortptr] ;get # abort chars beq :noabrt asl ;x2 tay pla :lp cmp []abortptr],y beq iabort ;abort the mission dey dey bne :lp pha :noabrt pla ;restore keypress * See if 'regular' character: and #%00_000000_11111111 cmp #$8D ;enter? beq irtn cmp #" " blt badchar ;no more cntrl chars cmp #"@" ;regular keypad? bge badchar tochar brl char ;take the character badchar rep $30 bra newkey gotcmd jmp (cmdadrs,x) ;jump to the command * Commands: *------------------------------------------------- oar brl restore ;restore old value *------------------------------------------------- irtn sta ]endkey lda curpos sta ]endpos lda cursor and #$ff sta ]cursout lda tempbuff and #$FF cmp ]maxlen blt :tay0 lda ]maxlen :tay0 tay sep $20 sta []lineptr] beq :x0 :lp lda tempbuff,y and #$7f sta []lineptr],y dey bne :lp :x0 rep $20 clc ;flag all is well rtl *------------------------------------------------- iabort pha lda curpos sta ]endpos lda cursor and #$ff sta ]cursout lda tempbuff and #$FF cmp ]maxlen blt :tay1 lda ]maxlen :tay1 tay sep $20 sta []lineptr] beq :x1 :lp lda tempbuff,y and #$7F sta []lineptr],y dey bne :lp :x1 rep $20 plx stx ]endkey clc ;flag abort exit rtl *------------------------------------------------- mx %00 iesc sta ]endkey lda curpos sta ]endpos lda cursor and #$ff sta ]cursout sec ;flag abort rtl ;and leave here *------------------------------------------------- mx %00 ileft lda curpos ;current position jeq badchar ;cannot move left :1 dec curpos ;move cursor over brl newpos ;do new position *------------------------------------------------- mx %00 iright lda curpos ;get current spot sep $20 cmp tempbuff ;maxed out? jge badchar ;yep-->no good inc curpos brl newpos ;do new position *------------------------------------------------- mx %00 oay lda curpos ;get current position sep $20 sta tempbuff ;set length at this value brl prtnew ;print new string *------------------------------------------------- mx %00 oax sep $20 stz tempbuff rep $30 stz curpos ;also set position brl prtnew ;print new value *------------------------------------------------- mx %00 oae sep $20 lda overstrike cmp cursor bne :fin lda insert :fin sta cursor ;save new cursor rep $20 brl newkey ;get new keypres *------------------------------------------------- mx %00 del lda curpos bne :ok brl badchar ;cannot delete left if @ start :ok tay ;offset sep $30 :1 lda tempbuff+1,y sta tempbuff,y iny cpy tempbuff ;at end yet? blt :1 dec tempbuff ;1 less char dec curpos rep $30 brl prtnew ;move left 1 spot *------------------------------------------------- oadel sep $20 lda curpos cmp tempbuff blt :ok brl badchar ;cannot delete right :ok inc curpos ;move right 1 bra del ;then delete left mx %00 *------------------------------------------------- oaleft stz curpos ;move to begining brl newpos ;at a new position *------------------------------------------------- oaright lda tempbuff and #$FF sta curpos ;move to the far right brl newpos *------------------------------------------------- char pha ;save character lda curpos ;get current position sep $20 cmp tempbuff rep $20 blt :notend ;not at the end * Cursor is at end of line: cmp ]maxlen ;is line full? blt :ok pla brl badchar ;line is full/no good :ok ldy curpos pla sep $20 ;use short A sta tempbuff+1,y ;save value inc curpos ;move to next position inc tempbuff ;bump up the counter rep $20 brl prtnew ;print a new line * Cursor is not at the end: :notend sep $20 lda overstrike cmp cursor ;in overstrike mode?? beq :putit ;yep-->just put it in there lda tempbuff and #$FF cmp ]maxlen ;are we maxed? blt :ok2 rep %00100000 ;back to long pla brl badchar ;bad input mx %10 ;assembler knows short :ok2 lda tempbuff ;get current length and #$ff tay :lp lda tempbuff+1,y ;get position sta tempbuff+2,y ;move it up cpy curpos beq :dne dey bra :lp :dne inc tempbuff ;bump up the buffer rep $20 pla sep $20 sta tempbuff+1,y ;insert the value inc curpos ;move cursor over rep $20 brl prtnew *------------------------------------------------- mx %10 ;enters short :putit ldy curpos rep $20 pla sep $20 sta tempbuff+1,y ;save new char inc curpos rep $20 brl prtnew ;now move right 1 spot *------------------------------------------------- i_Cmds dw #54 ;27 commands cmds dw $008D ;return dw $009B ;esc dw $0088 ;left arrow dw $0095 ;right arrow dw $0092 ;cntrl-R, replace dw $0098 ;cntrl-X, clear dw $1098 ;keypad cntrl-X dw $0099 ;cntrl-Y, clr EOL dw $0085 ;cntrl-E, toggle dw $00FF ;delete key dw $80FF ;oa-delete dw $10F5 ;keypad del dw $8088 ;oa-left dw $10F3 ;keypad home dw $8095 ;oa-right dw $10F7 ;keypad end dw $80D2 dw $80F2 ;oa-R,r dw $80C5 dw $80E5 ;oa-E,e dw $80D8 dw $80F8 ;oa-X,x dw $80D9 dw $80F9 ;oa-Y,y dw $80C4 dw $80E4 ;oa-Dd,cntrl-D dw $0084 cmdadrs dw irtn dw iesc dw ileft dw iright dw oar dw oax dw oax dw oay dw oae dw del dw oadel dw oadel dw oaleft dw oaleft dw oaright dw oaright dw oar dw oar dw oae dw oae dw oax dw oax dw oay dw oay dw oadel dw oadel dw oadel cursor dw #"_" insert dw #"_" overstrike dw ' ' fillchar dw 'I' getkey php rep $30 ldy cursx jsr pickchar and #$FF sta :screenchar stz :on jsr :invert :keyl ldx #380*2 :keyl1 phx pha _QAKeyAvail pla bne :read _QARun ;send a run command to utilities plx dex bne :keyl1 jsr :invert bra :keyl :read plx ldy cursx lda :screenchar jsr storchar pha _QAGetChar pla plp rts :invert php sep $30 bit :on bpl :curson lda :screenchar ldy cursx jsr storchar stz :on plp rts :curson ldy cursx lda cursor cmp overstrike beq :cover lda cursor jsr storchar sec ror :on brl :ixit :cover lda :screenchar cmp #'A' blt :c0 cmp #'Z'+1 bge :c0 lda overstrike bra :cover1 :c0 and #$7f cmp #'A' blt :cover1 cmp #'Z'+1 bge :cover1 sec sbc #$40 :cover1 jsr storchar sec ror :on :ixit plp rts :screenchar ds 2 :on ds 2 qagetline dum $00 ]rtl ds 6 ;these are passed on stack ]abortptr ds 4 ]cursors ds 2 ]cursor ds 2 ]startpos ds 2 ]maxlen ds 2 ]prompt ds 4 ]lineptr ds 4 ]newstack = *-6 ;must be at end of passed params ]cursout ds 2 ]endpos ds 2 ]endkey ds 2 dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb ldx #0 tdc jsl {vgetline*4}+vectortbl-4 bcs :xit lda #0 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit * FLAGS word defined as: * b15 - value is signed * b14.b13 - %0x value is not justified * - %10 value is left justifed (leading spaces) * - %01 value is right justified (trailing spaces) * b12 - print leading 0's * b11 - print leading $ (QADrawHEX only) qadrawhex dum $00 ]zp ds 2 ]negflag ds 2 ]rtl ds 6 ;these are passed on stack ]fieldsize ds 2 ]flags ds 2 ]int ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb stz hdstr stz hdfinalstr stz ]negflag stz ]zp lda ]fieldsize cmp #$10 blt :and lda #$0f :and and #$0f sta ]fieldsize lda ]flags bpl :noneg lda ]int+2 bpl :noneg lda ]int+2 eor #-1 tax lda ]int eor #-1 inc sta ]int bne :neg inx :neg stx ]int+2 lda #-1 sta ]negflag :noneg psl ]int psl #hdstr+1 pea hexlen tll $230b ;_Long2Hex brl :normal :print rep $30 lda ]flags psl #hdfinalstr _QADrawstring :noerr rep $30 lda #0 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit :normal sep $30 ldx #0 bit ]negflag bpl :nn1 lda #'-' sta hdfinalstr+1,x inx :nn1 lda ]flags+1 bit #$08 beq :nn2 lda #'$' sta hdfinalstr+1,x inx :nn2 ldy #0 ]lup lda hdstr+1,y and #$7f cmp #' ' beq :s cmp #'0' bne :p :zero xba lda ]zp bne :p1 lda ]flags+1 bit #$10 beq :nnext lda #'0' inc ]zp+1 bra :p2 :s lda #'0' bra :zero :p1 xba :p sta ]zp :p2 sta hdfinalstr+1,x inx :nnext iny cpy #hexlen blt ]lup stx hdfinalstr cpx #0 bne :f lda #'0' sta hdfinalstr+1 inc hdfinalstr :f lda ]flags+1 bit #$40 bne :justify brl :print :justify lda ]fieldsize jeq :noerr lda hdfinalstr sec sbc ]zp+1 ;subtract out any leading zeros cmp ]fieldsize blt :just beq :just ldy ]fieldsize ;if it won't fit print #'s lda #'#' ]lup sta hdfinalstr,y dey bne ]lup lda ]fieldsize sta hdfinalstr brl :print :just lda hdfinalstr sec sbc ]fieldsize bcc :just1 beq :just1 tay ;y now holds "over" len ldx #0 lda hdfinalstr+1 and #$7f cmp #'-' bne :nots1 iny inx lda hdfinalstr+2 and #$7f :nots1 cmp #'$' bne :nots iny inx :nots lda hdfinalstr+1,y sta hdfinalstr+1,x iny inx cpy hdfinalstr blt :nots lda ]fieldsize sta hdfinalstr :just1 lda ]flags+1 bit #$20 bne :left lda ]fieldsize sec sbc hdfinalstr beq :j2 jsr DrawSpaces :j2 brl :print :left rep $30 psl #hdfinalstr _QADrawString sep $30 lda ]fieldsize sec sbc hdfinalstr beq :sxit jsr DrawSpaces :sxit brl :noerr *====================================================== * Draw a decimal value in ASCII to output device QADrawDec dum $00 ]zp ds 2 ]negflag ds 2 ]rtl ds 6 ;these are passed on stack ]fieldsize ds 2 ]flags ds 2 ]int ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb stz hdstr stz hdfinalstr stz ]negflag stz ]zp lda ]fieldsize cmp #$10 blt :and lda #$0f :and and #$0f sta ]fieldsize lda ]flags bpl :noneg lda ]int+2 bpl :noneg lda ]int+2 eor #-1 tax lda ]int eor #-1 inc sta ]int bne :neg inx :neg stx ]int+2 lda #-1 sta ]negflag :noneg psl ]int psl #hdstr+1 pea declen pea 0 tll $270b ;_Long2DEC brl :normal :print rep $30 psl #hdfinalstr _QADrawstring :noerr rep $30 lda #0 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit :normal sep $30 ldx #0 bit ]negflag bpl :nn1 lda #'-' sta hdfinalstr+1,x inx :nn1 ldy #0 ]lup lda hdstr+1,y and #$7f cmp #' ' beq :s cmp #'0' bne :p :zero xba lda ]zp bne :p1 lda ]flags+1 bit #$10 beq :nnext lda #'0' inc ]zp+1 bra :p2 :s lda #'0' bra :zero :p1 xba :p sta ]zp :p2 sta hdfinalstr+1,x inx :nnext iny cpy #declen blt ]lup stx hdfinalstr cpx #0 bne :f lda #'0' sta hdfinalstr+1 inc hdfinalstr :f lda ]flags+1 bit #$40 bne :justify brl :print :justify lda ]fieldsize jeq :noerr lda hdfinalstr sec sbc ]zp+1 ;subtract out any leading zeros cmp ]fieldsize blt :just beq :just ldy ]fieldsize ;if it won't fit print #'s lda #'#' ]lup sta hdfinalstr,y dey bne ]lup lda ]fieldsize sta hdfinalstr brl :print :just lda hdfinalstr sec sbc ]fieldsize bcc :just1 beq :just1 tay ;y now holds "over" len ldx #0 lda hdfinalstr+1 and #$7f cmp #'-' bne :nots iny inx :nots lda hdfinalstr+1,y sta hdfinalstr+1,x iny inx cpy hdfinalstr blt :nots lda ]fieldsize sta hdfinalstr :just1 lda ]flags+1 bit #$20 bne :left lda ]fieldsize sec sbc hdfinalstr beq :j2 jsr DrawSpaces ;print some spaces :j2 brl :print :left rep $30 psl #hdfinalstr _QADrawString sep $30 lda ]fieldsize sec sbc hdfinalstr beq :sxit jsr DrawSpaces :sxit brl :noerr *====================================================== * Print date and/or time to screen, w/option read of clock * Flags: 0= time, 1= date, 2= ASCII string, 3= read clock * (if not 'ASCII' & 'readclock' use ReadASCIITime) QADateTime dum $00 ]temp ds 2 ]rtl ds 6 ;these are passed on stack ]flags ds 2 ]date ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda ]flags ;anything to print? beq :gxit and #%0011 lda ]flags ;read GS clock? and #%1000 beq :no lda ]flags and #%0100 ;hex or ascii? beq :hex ~ReadASCIITime #tempbuff sep #$30 stz tempbuff+8 rep #$30 stz tempbuff+17 ;end of date/time fields lda ]flags and #%0010 ;show date? beq :asciitime ~QADrawCString #tempbuff ; yes jsl DrawSpace :asciitime lda ]flags and #%0001 ;show time? beq :gxit ~QADrawCString #tempbuff+9 ; yes :gxit bra :xit :hex ~ReadTimeHex ;get time in hex ldx #4 ldy #0 ]loop pla sta []date],y ;save data to user's buffer iny iny dex bne ]loop ; & fall into print routine! :no lda ]flags ;show date? and #%0010 beq :time ldy #4 lda []date],y ;print day inc jsr sNumDraw ldy #4 lda []date],y xba and #$ff asl sta ]temp ;print month w/seperators asl adc ]temp adc #ftmonths pea #^ftmonths pha _QADrawString ldy #2 lda []date],y ;print year xba jsr zNumDraw jsl DrawSpace :time lda ]flags ;show time? and #%0001 beq :done ldy #2 lda []date],y jsr sNumDraw lda #':' jsl {vprintchar*4}+vectortbl-4 ;print time lda []date] xba jsr zNumDraw :done lda #0 :xit tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit ftmonths str '-Jan-' str '-Feb-' str '-Mar-' str '-Apr-' str '-May-' str '-Jun-' str '-Jul-' str '-Aug-' str '-Sep-' str '-Oct-' str '-Nov-' str '-Dec-' zNumDraw ldx #%0101_0000_0000_0000 bra NumDraw sNumDraw ldx #%0100_0000_0000_0000 NumDraw pea #0 and #$FF ;only a byte! pha phx pea #2 _QADrawDec rts *------------------------------------------------------ QADrawCR jsl DrawCR brl noerror QADrawSpace jsl DrawSpace brl noerror DrawSpaces php rep $30 ;insure 16 bit pea 32 and #$FF pha ;count _QADrawCharX plp rts *====================================================== * Text driver stuff, patched into text tools so that * we can support Merlin and APW EXE commands TTDevice brl inittt brl readtt brl writett brl statustt brl controltt TTErrDevice brl inittt brl readtt brl writett1 brl statustt brl controltt inittt rtl statustt rtl controltt rtl readtt pha _QAKeyAvail pla beq readtt pha _QAGetChar pla and #$ff rtl DrawCR lda #13 bra writett DrawSpace lda #' ' writett phb phk plb jsl {vprintchar*4}+vectortbl-4 plb rtl writett1 phb phk plb jsl {verrchar*4}+vectortbl-4 plb rtl *====================================================== * Print a version number to the screen in Apple format * Format of parameter: aaaaaaaa_ccccdddd_eeeeeeee_ffffffff * a=major version, c=minor version, d=revision * e = alpha, beta, etc. ASCII letter (0 = null), f=delta version * $01006410 = v1.00d16 QAPrintVersion dum $00 ]rtl ds 6 ;these are passed on stack ]version ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda ]version+2 xba ;draw major version and #$FF pea #0 pha pea #0 pea #2 _QADrawDec lda #'.' jsl {vprintchar*4}+vectortbl-4 lda ]version+2 pha _QAPrByte ;show minor version/revision numbers lda ]version beq :done ;is there a delta? xba and #$7F ; yes- print ASCII part jsl {vprintchar*4}+vectortbl-4 lda ]version and #$FF ;print delta version pea #0 pha pea #0 pea #3 _QADrawDec :done lda #0 :xit tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit *====================================================== * Got a time control code (^R)--set to print time/date pTime rts pVersion rts *====================================================== * Print Time/Version/Set Justification * Code: 1=Time Code, 2=Version byte * PrintTVJ php sep #$30 ;back to 8 bit lsr lsr ;position bits to get 1-7 lsr dec asl ;get index tax jsr (:tbl,x) ; & pass control to routine plp rts :tbl da sTime da gTime da sVersion da gVersion da sJustify da gJustify da pJString *------------------------------------------------------ * Want to print the time as part of our stuff sTime gTime sVersion gVersion sJustify gJustify pJString rts *====================================================== * Read a directory and return filenames which match the * current wildcard value. Must have called InitWildCard QAReadDir dum $00 ]temp ds 4 ]curptr ds 4 ]zp ds 4 ]ptr ds 4 ]rtl ds 6 ;these are passed on stack ]flags ds 2 ]hook ds 4 ]path ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda :level beq :allok lda #qaalreadyactive jmp :xit1 :allok stz :level lda #tpfx sta pptr lda #^tpfx sta pptr+2 lda #256 sta tpfx lda #2 sta spfx jsl $e100a8 dw $200A adrl spfx bcc :e1 jmp :xit :e1 lda []path] beq :stz ;could do a getpfx here tay iny sep $20 lda []path],y and #$7f cmp #'/' beq :chop cmp #':' bne :stz :chop rep $30 lda []path] dec sta []path] :stz rep $30 lda []path] tax ldy #$01 sep $20 ]syntax iny lda []path],y and #$7f cmp #'/' bne :s1 lda #':' :s1 sta []path],y dex bne ]syntax rep $30 jsr :newdir jcs :xit :main rep $30 lda :level jeq :done dec asl asl asl tax lda dhandles+4,x sta ]curptr lda dhandles+6,x sta ]curptr+2 ldy #:count lda []curptr],y jeq :backup lda #:dirparms clc adc ]curptr sta :entp lda #$00 adc ]curptr+2 sta :entp+2 jsl $e100a8 dw $201c :entp adrl 0 jcs :xit ldy #:count lda []curptr],y dec sta []curptr],y :go ldy #:filetype lda []curptr],y cmp #$0f bne :file lda ]flags * bit #$01 ;nesting enabled? * beq :next bit #$02 beq :nwc0 jsr :wildcard bcc :nwc :nwc0 lda :level and #$ff ora #$8000 bra :cl2 :nwc lda :level and #$ff :cl2 ora #$0100 jmp :c :file lda ]flags bit #$02 beq :file1 jsr :wildcard ;does the file match wildcard bcs :file1 lda :level and #$ff bra :c :file1 lda :level and #$ff ora #$8000 :c jsr :call jcs :xit :next ldy #:filetype lda []curptr],y cmp #$0f jne :main lda ]flags bit #$0001 ;are subdirectories enabled? bne :new * beq :m1 * bit #$02 ;should we check to see if this DIR should be * beq :new ;opened? * jsr :wildcard * bcs :new :m1 brl :main :new jsr :newdir jcs :xit brl :main :backup lda :level jeq :done dec sta :level asl asl asl tax lda dhandles+4,x sta ]curptr lda dhandles+6,x sta ]curptr+2 lda #:clsparms clc adc ]curptr sta :cp2 lda #$00 adc ]curptr+2 sta :cp2+2 jsl $e100a8 dw $2014 :cp2 adrl 0 lda :level asl asl asl tax lda dhandles+2,x pha lda dhandles,x pha _Disposehandle lda :level beq :done dec asl asl asl tax lda dhandles+4,x sta ]curptr lda dhandles+6,x sta ]curptr+2 lda ]curptr clc adc #:filename sta pptr lda ]curptr+2 adc #^:filename sta pptr+2 jsl prodos dw $2009 adrl spfx bcc :bdone jmp :xit :bdone lda ]flags bit #$02 ;wildcards? beq :nwc2 jsr :wildcard bcc :nwc1 :nwc2 lda :level and #$ff ora #$8000 bra :cl1 :nwc1 lda :level and #$FF :cl1 ora #$0200 ;closing a dir jsr :call bcs :xit :chk lda :level beq :done jmp :main :done rep $30 lda #$00 :xit rep $30 pha :clup lda :level beq :nocls dec asl asl asl tax lda dhandles+4,x sta ]curptr lda dhandles+6,x sta ]curptr+2 lda #:clsparms clc adc ]curptr sta :cp lda #$00 adc ]curptr+2 sta :cp+2 jsl $e100a8 dw $2014 :cp adrl 0 lda :level dec sta :level asl asl asl tax lda dhandles+2,x pha lda dhandles,x pha _Disposehandle brl :clup :nocls pla :xit1 rep $30 pha lda #tpfx+2 sta pptr lda #^tpfx+2 sta pptr+2 jsl prodos dw $2009 adrl spfx lda #$ffff sta wcauxmask sta wcauxmask+2 sta wcftypemask lda #$00 sta wcaux sta wcaux+2 sta wcftype sta wcstring pla tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa jmp errxit :newdir php rep $30 stz :ndhdl stz :ndhdl+2 psl #$00 lda :level jeq :first psl #$00 dec asl asl asl tax lda dhandles+4,x sta ]curptr lda dhandles+6,x sta ]curptr+2 lda dhandles+2,x pha lda dhandles,x pha _GetHandleSize ldy #:namelen lda []curptr],y clc adc 1,s sta 1,s bcc :nd0 lda 3,s adc #$00 sta 3,s :nd0 lda 1,s inc sta 1,s bne :nd00 lda 3,s inc sta 3,s :nd00 ldal userid ora #$A00 pha pea $C000 psl #$00 _NewHandle plx ply jcs :nderr jmp :deref :first ldx #$00 lda #recsize clc adc []path] bcc :nd2 inx :nd2 phx pha ldal userid ora #$A00 pha pea $C000 psl #$00 _NewHandle plx ply jcs :nderr :deref sty :ndhdl+2 sty ]zp+2 stx :ndhdl stx ]zp ldy #$02 lda []zp] tax lda []zp],y sta ]zp+2 stx ]zp psl #$00 psl :ndhdl _GetHandleSize pll :size lda #$00 tay sep $20 ]lup sta []zp],y iny cpy :size blt ]lup rep $30 lda :level beq :first1 dec asl asl asl tax lda dhandles+4,x sta ]temp lda dhandles+6,x sta ]temp+2 ldy #:filename lda []temp],y inc inc sta :ct ]lup sep $20 lda []temp],y sta []zp],y iny rep $30 dec :ct bne ]lup lda #':' sep $20 sta []zp],y iny tyx rep $20 ldy #:namelen lda []temp],y beq :d2 sta :ct ldy #:buffer ]l sep $20 lda []temp],y phy txy sta []zp],y ply iny inx rep $20 dec :ct bne ]l :d2 rep $30 txa sec sbc #:filename+2 ldy #:filename sta []zp],y jmp :f1 :first1 rep $30 ldy #$02 lda []path],y and #$7f cmp #':' beq :full cmp #'/' beq :full :full lda []path] inc inc sta :ct ldx #:filename ldy #$00 ]lup sep $20 lda []path],y phy txy sta []zp],y ply inx iny rep $30 dec :ct bne ]lup :f1 rep $30 lda ]zp clc adc #:filename sta pptr lda ]zp+2 adc #$00 sta pptr+2 jsl prodos dw $2009 adrl spfx bcc :l1 jmp :nderr :l1 ldy #:oparms lda #$04 sta []zp],y ldy #:request lda #$01 sta []zp],y ldy #:dirparms lda #17 sta []zp],y ldy #:fstid lda #$01 sta []zp],y ldy #:clsparms lda #$01 sta []zp],y ldy #:dirbuf lda #65 sta []zp],y lda ]zp clc adc #:dirbuf pha lda ]zp+2 adc #$00 ldy #:bufptr+2 sta []zp],y dey dey pla sta []zp],y lda ]zp clc adc #:filename pha lda ]zp+2 adc #$00 ldy #:ptr1+2 sta []zp],y dey dey pla sta []zp],y lda ]zp sta ]curptr lda ]zp+2 sta ]curptr+2 lda #:oparms clc adc ]curptr sta :p1 lda #$00 adc ]curptr+2 sta :p1+2 lda #:dirparms clc adc ]curptr sta :p2 lda #$00 adc ]curptr+2 sta :p2+2 jsl $e100a8 dw $2010 :p1 adrl 0 jcs :nderr ldy #:oref lda []curptr],y ldy #:dirref sta []curptr],y ldy #:clsref sta []curptr],y jsl $e100a8 dw $201c :p2 adrl 0 jcs :nderr ldy #:entnum lda []curptr],y ldy #:count sta []curptr],y ldy #:base lda #$01 sta []curptr],y ldy #:displace sta []curptr],y lda :level asl asl asl tax lda :ndhdl sta dhandles,x lda :ndhdl+2 sta dhandles+2,x lda ]curptr sta dhandles+4,x lda ]curptr+2 sta dhandles+6,x inc :level plp clc rts :nderr rep $30 pha lda :ndhdl ora :ndhdl+2 beq :nde1 psl :ndhdl _disposehandle stz :ndhdl stz :ndhdl+2 :nde1 pla plp sec rts :ndhdl ds 4 :call php rep $30 sta :temp lda ]hook ora ]hook+2 jeq :cclc lda ]hook sta :jsl1+1 lda ]hook+2 sep $20 sta :jsl1+3 rep $20 phd phb lda #:dirparms clc adc ]curptr tay lda #$00 adc ]curptr+2 tax tya ldy :temp :jsl1 jsl $FFFFFF php clc xce rep $30 plp plb pld bcc :cclc plp sec rts :cclc plp clc rts :temp ds 2 :wildcard ;carry = C no wildcard match ; = S wildcard matches php rep $30 lda #$ffff sta :wc ;default to valid lda wcstring and #$ff jeq :ftype sta :wclen ldy #:namelen lda []curptr],y jeq :noname sta :nlen iny iny ;point y to first char of name ldx #$01 ;point x to first char of WC sep $20 ]look lda wcstring,x and #$7f cmp #'a' blt :1 cmp #'z'+1 bge :1 and #$5f :1 cmp #'=' beq :chars cmp #'?' beq :nextxy ;any char is valid sta :cmp lda []curptr],y and #$7f cmp #'a' blt :2 cmp #'z'+1 bge :2 and #$5f :2 cmp :cmp beq :nextxy jmp :noname :chars inx dec :wclen beq :ftype ;is wildcard done? lda wcstring,x and #$7f cmp #'a' blt :3 cmp #'z'+1 bge :3 and #$5f :3 sta :cmp bra :n ]equ iny dec :nlen beq :noname :n lda []curptr],y and #$7f cmp #'a' blt :4 cmp #'z'+1 bge :4 and #$5f :4 cmp :cmp bne ]equ ;keep looping until char found :nextxy inx dec :wclen :nexty iny dec :nlen jmp :chklen :nextx inx dec :wclen :chklen lda :nlen ora :wclen beq :ftype jmp ]look ;check here for string match :noname rep $30 stz :wc :ftype rep $30 lda wcftypemask beq :tryaux ldy #:filetype lda []curptr],y and wcftypemask cmp wcftype beq :tryaux stz :wc :tryaux lda wcauxmask ora wcauxmask+2 beq :wcchk ldy #:aux lda []curptr],y and wcauxmask cmp wcaux bne :zero iny iny lda []curptr],y and wcauxmask+2 cmp wcaux+2 beq :wcchk :zero stz :wc :wcchk lda :wc bne :wcsec :wcclc plp ;wildcard doesn't match clc rts :wcsec plp ;wild card matches sec rts :wc ds 2 :wclen ds 2 :nlen ds 2 :cmp ds 2 *=============================== :ct ds 2 :size ds 4 :level ds 2 dum 0 :count ds 2 :oparms dw 4 ;parms for open :oref dw 0 :ptr1 adrl :filename :request dw $0001 ;read only dw 0 ;data fork :dirparms ;parms for getdirentry dw 17 :dirref dw 0 ;ref # :flags dw 0 ;reserved :base dw 0 :displace dw 0 :bufptr adrl :dirbuf :entnum dw 0 ;entry number in DIR :filetype dw 0 ;filetype :eof adrl 0 ;eof :blocks adrl 0 ;block count :cdate ds 8 ;create date :mdate ds 8 ;mod date :access da 0 ;access :aux adrl 0 ;auxtype :fstid dw 1 ;file system id :oplist adrl 0 :reof adrl 0 :rblks adrl 0 :clsparms dw 1 :clsref ds 2 :dirbuf dw 65 ;buff size for getdirentry :namelen dw 0 ;filename length for " :buffer ds 65 ;filename put here :filename ds 2 recsize = * dend *====================================================== QAInitWildCard dum $00 ]rtl ds 6 ;these are passed on stack ]auxmask ds 4 ]ftmask ds 2 ]aux ds 4 ]ft ds 2 ]wcstr ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda ]ft sta wcftype lda ]aux sta wcaux lda ]aux+2 sta wcaux+2 lda ]ftmask sta wcftypemask lda ]auxmask sta wcauxmask lda ]auxmask+2 sta wcauxmask+2 sep $30 lda []wcstr] cmp #15 blt :ok lda #15 :ok sta wcstring tay beq :done ]l lda []wcstr],y and #$7f cmp #'a' blt :sta cmp #'z'+1 bge :sta and #$5f :sta sta wcstring,y dey bne ]l :done rep $30 lda #$00 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa jmp errxit *====================================================== * Trap some GS/OS vectors so we can safely work! SetVects php sei rep $30 ldal $E100A8 sta GSOSVect1 ldal $E100A8+2 sta GSOSVect1+2 ldal $E100B0 sta GSOSVect2 ldal $E100B0+2 sta GSOSVect2+2 lda #P16Quit stal $E100A8+1 lda #^P16Quit sep $20 stal $E100A8+3 rep $30 lda #p16quit1 stal $E100B0+1 lda #^P16Quit sep $20 stal $E100B0+3 rep $30 plp rts RestoreVects php sei rep $30 lda GSOSVect1 stal $E100A8 lda GSOSVect1+2 stal $E100A8+2 lda GSOSVect2 stal $E100B0 lda GSOSVect2+2 stal $E100B0+2 plp rts P16QHandle clc xce phk plb rep $30 lda stack tcs ldx #$00 lda #$00 clc jmp (return,x) 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 GSOSVect1 jml $FFFFFF ;jump to P16 entry vector 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 GSOSVect2 jml $FFFFFF *====================================================== * Draw a box on the screen, saving what is underneath it QADrawBox dum $00 ]cx ds 2 ]cy ds 2 ]top ds 2 ]left ds 2 ]bottom ds 2 ]right ds 2 ]size ds 4 ]ptr ds 4 ]tempy ds 2 ]rtl ds 6 ;these are passed on stack ]height ds 2 ]width ds 2 ]y ds 2 ]x ds 2 ]newstack = *-6 ;must be at end of passed params ]bufhdl ds 4 dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb stz ]bufhdl stz ]bufhdl+2 lda cursx sta ]cx lda cursy sta ]cy lda ]x clc adc ]width cmp #80 blt :1 sec sbc #80 sec sbc ]width eor #$FFFF inc sta ]width :1 lda ]y clc adc ]height cmp #24 blt :2 sec sbc #24 sec sbc ]height eor #$FFFF inc sta ]height :2 psl #$00 pei ]width pei ]height tll $090B ;_Multiply lda 1,s clc adc #8 sta 1,s lda 3,s adc #0 sta 3,s pll ]size psl #$00 psl ]size ldal userid ora #$A00 pha pea $8000 psl #$00 _NewHandle plx ply jcs :xit stx ]bufhdl sty ]bufhdl+2 ldy #$02 lda []bufhdl] sta ]ptr lda []bufhdl],y sta ]ptr+2 lda ]x sta []ptr] ldy #$02 lda ]y sta []ptr],y ldy #$04 lda ]width sta []ptr],y ldy #$06 lda ]height sta []ptr],y lda ]x sta cursx lda ]y sta cursy lda ]x sta ]left clc adc ]width dec sta ]right lda ]y sta ]top clc adc ]height dec sta ]bottom ldy #$08 sty ]tempy ]l1 rep $30 lda cursx pha lda cursy pha _QAGotoXY sep $30 lda ]height beq :noerr ldx ]width ldy ]left ]l2 cpx #$00 beq :next phy jsr pickchar rep $10 ldy ]tempy sta []ptr],y rep $20 inc ]tempy sep $30 ply lda cursy cmp ]top beq :t cmp ]bottom beq :b cpy ]left beq :l cpy ]right beq :r bra :spc :t cpy ]left beq :spc cpy ]right beq :spc lda #$5f.$80 bra :sta :b cpy ]left beq :spc cpy ]right beq :spc lda #$4c bra :sta :r lda #$5f bra :sta :l lda #$5a bra :sta :spc lda #$a0 :sta phy jsr storchar ply iny dex bne ]l2 :next inc cursy dec ]height bne ]l1 :noerr rep $30 lda #$00 :xit rep $30 pha lda ]cx sta cursx lda ]cy sta cursy lda cursx pha lda cursy pha _QAGotoXY lda ]bufhdl+2 ora ]bufhdl beq :pla psl ]bufhdl _HUnlock :pla pla tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa jmp errxit *====================================================== * Restore a box on the screen, with what was originally there QAEraseBox dum $00 ]cx ds 2 ]cy ds 2 ]top ds 2 ]left ds 2 ]bottom ds 2 ]right ds 2 ]ptr ds 4 ]tempy ds 2 ]x ds 2 ]y ds 2 ]width ds 2 ]height ds 2 ]rtl ds 6 ;these are passed on stack ]bufhdl ds 4 ]newstack = *-6 ;must be at end of passed params dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb lda cursx sta ]cx lda cursy sta ]cy psl ]bufhdl _Hlock jcs :xit ldy #$02 lda []bufhdl] sta ]ptr lda []bufhdl],y sta ]ptr+2 lda []ptr] sta ]x ldy #$02 lda []ptr],y sta ]y ldy #$04 lda []ptr],y sta ]width ldy #$06 lda []ptr],y sta ]height lda ]x sta cursx lda ]y sta cursy lda ]x sta ]left clc adc ]width dec sta ]right lda ]y sta ]top clc adc ]height dec sta ]bottom ldy #$08 sty ]tempy ]l1 rep $30 lda cursx pha lda cursy pha _QAGotoXY sep $30 lda ]height beq :noerr ldx ]width ldy ]left ]l2 cpx #$00 beq :next phy rep $10 ldy ]tempy lda []ptr],y sep $30 ply jsr storchar rep $20 inc ]tempy sep $30 iny dex bne ]l2 :next inc cursy dec ]height bne ]l1 :noerr rep $30 lda #$00 :xit rep $30 pha lda ]cx sta cursx lda ]cy sta cursy lda cursx pha lda cursy pha _QAGotoXY lda ]bufhdl+2 ora ]bufhdl beq :pla psl ]bufhdl _HUnlock :pla pla tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa jmp errxit *====================================================== * Convert a string from/to GS/OS class 1 to PString format QAConvertStr dum $00 ]maxlen ds 2 ]rtl ds 6 ;these are passed on stack ]cmdcode ds 2 ]buffptr ds 4 ]textptr ds 4 ]newstack = *-6 ;must be at end of passed params ]rtncode ds 2 dend mx %00 tsc sec sbc #]rtl tcs phd inc tcd phb phk plb :noerr rep $30 lda #$0000 :xit rep $30 tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa jmp errxit *====================================================== * Return the address of the current keypress handler QAGetKeyAdrs mx %00 lda #keyaddress sta 7,s lda #^keyaddress sta 9,s brl noerror InstallKey php phb phk plb sei rep $30 stz keyintsactive psl #$00 pea $000f ;keyboard vector tll $1103 ;getvector pla sta eventkey+1 pla sep $20 sta eventkey+3 rep $30 pea $000f psl #keyhandler tll $1003 ;set vector pea $00 tll $0606 pla bcs :noem beq :noem lda #$FFFF sta emactive bra :xit :noem sep $20 ldal $e0c027 pha and #%00000100 sta keyintsactive pla ora #%00000100 stal $e0c027 rep $30 :xit plb plp rts *====================================================== * Remove our key handler from the event vector RemoveKey php phb phk plb rep $30 sei pea $000f lda eventkey+3 and #$ff pha lda eventkey pha tll $1003 ;set vector lda emactive stz emactive * cmp #$00 bne :xit lda keyintsactive bne :xit sep $20 ldal $e0c027 and #%00000100!$ffff stal $e0c027 rep $20 stz keyintsactive :xit plb plp rts *====================================================== * This routine is called by the event manager to handle * any keyboard events it recieves. 8 BIT EMULATION MODE! mx %11 KeyHandler php phb phk plb pha ldal $e0c000 stal keyaddress ldal $e0c025 stal keyaddress+1 ldal emactive bmi :ekey ldal $e0c010 :clc pla plb plp clc rtl :ekey pla plb plp eventkey jml $FFFFF *====================================================== * Find the next word in a string of text. < SPC = EOL (TAB = SPC) * ENTRY: Pointer to text, current index , max length (64K) * EXIT: Start of word, End of word+1 (BCS = err, A = BMI if at EOF) QAGetWord dum $00 ]rtl ds 6 ;these are passed on stack ]maxlen ds 2 ;max length of text ]index ds 2 ;starting index in text ]TxtPtr ds 4 ;pointer to text ]newstack = *-6 ;must be at end of passed parms ]EndWord ds 2 ;end of word ]BegWord ds 2 ;start of word (index into text) dend mx %00 tsc phd inc tcd phb phk plb stz ]BegWord ;assume error stz ]EndWord ldy ]index ;get index into text dey ]loop iny cpy ]maxlen ;past eof? bge :eof lda []TxtPtr],y ;get a char and #$7F cmp #8 ;tabs = spaces beq ]loop cmp #' ' ;must be a space or greater blt :xit beq ]loop ;flush spaces sty ]BegWord ]loop iny cpy ]maxlen ;past eof? bge :eof lda []TxtPtr],y ;get a char and #$7F cmp #' '+1 ;skip to next space or EOL bge ]loop sty ]EndWord lda #0 bra :xit ;skip error :eof lda #qaeof ;reached EOF! :xit tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit *====================================================== * Find the end of the current line of text (EOL) * ENTRY: Pointer to text, current index , max length (64K) * EXIT: Index to start of next line (BCS = reached EOF) QANextLine dum $00 ]rtl ds 6 ;these are passed on stack ]maxlen ds 2 ;max length of text ]index ds 2 ;starting index in text ]TxtPtr ds 4 ;pointer to text ]newstack = *-6 ;must be at end of passed parms ]newline ds 2 ;start of word (index into text) dend mx %00 tsc phd inc tcd phb phk plb dec ]maxlen ldy ]index ;get index into text dey ]loop iny cpy ]maxlen ;past eof? bge :eof lda []TxtPtr],y ;get a char and #$7F cmp #8 ;tabs = spaces beq ]loop cmp #' ' ;must be a space or greater bge ]loop iny sty ]newline ;save index to start of next line lda #0 bra :xit :eof lda #qaeof ;reached EOF! :xit tax lda ]rtl+4 sta ]newstack+4 lda ]rtl+2 sta ]newstack+2 lda ]rtl sta ]newstack plb pld tsc clc adc #]newstack tcs txa brl errxit