[ 53280,0:53281,0:646,(162):"":" USE LYNX TO DISSOLVE THIS FILE":10 3 *LYNX XV BY WILL CORLEY 15 GEOBEAVER.LN.CVT 7 S 117 S/GEOBEAVER.CVT 62 S 74 S/GEOBOPEN.CVT 35 S 72 S/GEOBMODE1.CVT 125 S 77 S/GEOBMODE1B.CVT 61 S 91 S/GEOBMODE2.CVT 143 S 90 S/GEOBMODE3.CVT 54 S 90 S/GEOBMODE3B.CVT 120 S 94 S/GEOBMODE3C.CVT 139 S 90 S/GEOBEXPORT.CVT 50 S 94 S/GEOBEXPORS.CVT 52 S 66 S/GEOBEXPORD.CVT 75 S 85 S/GEOBEXPORM.CVT 48 S 214 H/GEOBEAVER.CVT 9 S 70 GEOBEAVERDOC.CVT 85 S 238 geoBeaver.lnkPRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V&uP ;***************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman ;***************************** .output geoBeaver .header H/geoBeaver.rel .vlir .psect $0400 ; beginning of main .ramsect $1300 ; must mark end of main S/geoBeaver.rel APIcommon.rel MODdaAB.rel MODferr.rel MODclicks.rel MODscrn.rel MODvPrg.rel .mod 1 .psect VPRGbase ; end of main ramsect S/geoBOpen.rel MODfbox.rel .mod 2 .psect VPRGbase ; end of main ramsect S/geoBMode1.rel S/geoBMode1b.rel .mod 3 .psect VPRGbase ; end of main ramsect S/geoBExport.rel S/geoBExporS.rel S/geoBExporM.rel S/geoBExporD.rel MODgeoWx.rel .mod 4 .psect VPRGbase ; end of main ramsect S/geoBMode2.rel .mod 5 .psect VPRGbase ; end of main ramsect S/geoBMode3.rel S/geoBMode3b.rel S/geoBMode3c.relel/geoBMode3b.rel S/geoBMode3c.relode3b.rel S/geoBMode3c.relrel Those using geoBEAVER should already know how to program GEOS asS/geoBeaver(=PRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V& OgNUK]<S*pAJ8P ;****************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman  ;****************************** 8P  .if Pass1 .include GEOSequates  DEFMTOP = 30 DEFMLFT = 50 ; MENU mode equates DEFMRIT = 70 ; which EXPORT needs also DEFMBOT = 44  .endif  .psect l MODvPrg.rel .mod 1 .psect VPRGbase ; end of main ramsect S/geoBOpen.rel MODfbo8P0 ProgStart:  ldb dispBufferOn,#(ST_WR_FORE|ST_WR_BACK) 8P0 jsr UseSystemFont ldw EndOData,#DataStart ; reset for safetys sake jsr i_InitVPrg ; init the VLIR vectors .word PermName cpx #0 ; check for errors bne ByeBye ; if any, then exit  jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+24 ; show shareware  jsr i_LdMod ; next load rec 1 8P0 .byte 1 jsr VPRGbase + 9 ; do a ClrScrn jsr VPRGbase ; perform DoOpen stuff ldb MenuMode,#0 ; clear the initial menu setup jsr InitStuff jsr GoMode ; set up for mode 1 at first rts ; return to geos kernal ByeBye: jmp EnterDeskTop PermName: .byte "geoBeaver 1.0",0 1.0",0 0LastB4: .block 1 ; 2:8P0 InitStuff: jsr i_InitDaAb .word 0 .word BeavRecv ; reset the titlebar in file window .word 0 .word AbtText jsr ClrBuf2End ; clear the buffer first time! sei ldb Mode,#0 ; set the mode to "screen" jsr MenuStar ldb DragFlag,#0 ; clear the screen drag flag ldw Mod3IFlg,#0 ; input blink flag for mode 3 ldw otherPressVec,#MainClick ldw RecoverVector,#BeavRecv ldw appMain,#BigLoop cli jsr UseSystemFont ldb SelMove,#0 ; clear the selection flag  ldw DummyH+2,#7  rts : jmp EnterDeskTop PermName: .byte "geoBeaver 1.0",0 byte "geoBeaver 1.0",0 ,0 ,0 8P0 GoMode: jsr Crsr3Off; turn off blinkers lda Mode beq 10$ cmp #1 beq 11$ cmp #2 beq 12$ bne 13$ 10$: jsr i_LdMod ; mode 1 .byte 2 jsr VPRGbase + 0 ; now set up mode Main1 rts 11$: jsr i_LdMod ; mode 2 .byte 4 jsr VPRGbase + 0 ; now set up mode Main2 rts 12$: jsr i_LdMod .byte 5 jsr VPRGbase + 0 13$: rts Crsr3Off: jsr PromptOff ldb alphaFlag,#60 ldb R3L,#1 jmp DisablSprite Crsr3On: lda Mod3IFlg+1 ; first check ye olde flag bne 11$ 10$: rts 11$: cbi Mode,#2 ; then check mode bne 10$ mvw Mod3IFlg,A0 ldy #0 lda (A0),y ; last check the pointer cmp #54 bne 10$ ldy #6 lda (A0),y add DlgDims+2 ; then move in dimensions sta $84c0 ldy #4 lda (A0),y add DlgDims sta $84be iny lda (A0),y adc DlgDims+1 sta $84bf jsr PromptOn ldb alphaFlag,#252 ldb R3L,#1 jmp EnablSprite jmp EnablSprite w to adjust, 0=s, N=a AdjAmt: .block 2 ; amount to adjust cells by other modes 99$: rts RCTxt0: .byte $18,"Recover last saved data?",27,0 8P0 ClrBuf2End: mvw EndOData,R1 ldw R0,#DataEndP sbw R1,R0 jmp ClearRam p8P0 MainClick: cbi Mode,#0 beq 50$ cmp #1 beq 51$ cmp #2 beq 52$ rts ; other modes not yet supported 50$: jsr i_Ld8P0 MainClick: cbi Mode,#0 beq 50$ cmp #1 beq 51$ cmp #2 beq 52$ rts ; other modes not yet supported 50$: jsr i_LdMod ; button press in mode 1 .byte 2 jmp VPRGbase + 3 ; mode1click 51$: jsr i_LdMod .byte 4 jmp VPRGbase + 3 ; mode2click 52$: jsr i_LdMod .byte 5 jmp VPRGbase + 3 ; mode3click Yr8P0 BeavRecv: mvw R2,Temp ; save recover vectors mvw R3,Temp+2 mvw R4,Temp+4 cbi Mode,#0 beq 10$ cmp #1 beq 11$ cmp #2 beq 12$ jmp Recove8P0 BeavRecv: mvw R2,Temp ; save recover vectors mvw R3,Temp+2 mvw R4,Temp+4 cbi Mode,#0 beq 10$ cmp #1 beq 11$ cmp #2 beq 12$ jmp RecoverRectangle ; other modes not yet supported 10$: jsr i_LdMod .byte 2 mvw Temp,R2 ; restore recover vectors mvw Temp+2,R3 mvw Temp+4,R4 jmp VPRGbase + 6 ; mode1recv 11$: jsr i_LdMod .byte 4 mvw Temp,R2 ; restore recover vectors mvw Temp+2,R3 mvw Temp+4,R4 jmp VPRGbase + 6 ; mode2recv 12$: jsr i_LdMod .byte 5 mvw Temp,R2 ; restore recover vectors mvw Temp+2,R3 mvw Temp+4,R4 jmp VPRGbase + 6 ; mode3recv u8P0 BigLoop: cbi DragFlag,#0 ; are we dragging along? bne 50$ lda pressFlag ; keyboard pressed? and #$80 ; mask out the 7th bit (keyboar8P0 BigLoop: cbi DragFlag,#0 ; are we dragging along? bne 50$ lda pressFlag ; keyboard pressed? and #$80 ; mask out the 7th bit (keyboard) beq 10$ cbi Mode,#0 ; check mode for keypress beq 52$ cmp #1 beq 54$ ; check mode 2 for keypress cmp #2 beq 56$ 10$: rts ; no draggin goin on 50$: cbi Mode,#0 beq 51$ cmp #1 beq 53$ ; check mode 2 for click cmp #2 beq 55$ rts ; other modes not yet supported 51$: jsr i_LdMod .byte 2 jmp VPRGbase + 9 ; mode1drag 52$: jsr i_LdMod ; key press in mode 1 .byte 2 jmp VPRGbase + 12 53$: jsr i_LdMod ; something in mode 2 .byte 4 jmp VPRGbase + 9 ; mode2drag 54$: jsr i_LdMod ; key press in mode 2 .byte 4 jmp VPRGbase + 12 55$: jsr i_LdMod .byte 5 jmp VPRGbase + 9 ; mode3drag 56$: jsr i_LdMod ; key press in mode 1 .byte 5 jmp VPRGbase + 12 w8P0 DisMode: jsr CrsrOff ; turn off blinkers sei ldw otherPressVec,#0 ldw RecoverVector,#RecoverRectangle ldw appMain,#0 cli mvb windowBottom,R8P0 DisMode: jsr Crsr3Off ; turn off blinkers sei ldw otherPressVec,#0 ldw RecoverVector,#RecoverRectangle ldw appMain,#0 cli mvb windowBottom,R2L ; make an arbitrary recover pt sta R2H dec R2L mvb rightMargin,R3L sta R4L mvb rightMargin+1,R3H sta R4H dew R3 jmp BeavRecv 99$: rts ReMode: sei ldw otherPressVec,#MainClick ldw RecoverVector,#BeavRecv ldw appMain,#BigLoop cli jmp Crsr3On ; possibly restore blinker UnMode: sei ; clear up my vectors ldw otherPressVec,#0 ldw RecoverVector,#0 ldw appMain,#0 cli jmp Crsr3Off ; turn off blinkers rs .byte 4 jmp VPRGbase + 9 ; mode2drag 54$: jsr i_LdMod ; key press in mode 2 .byte 4 jmp VPRGbase + 12 55$: jsr i_LdMod .byte 5 jmp VPRGbase + 9 ; mode38P0 MyMenu: ; main menu data .byte 0,14 .word 0,80 .byte 3|HORIZONTAL .word MNtxt0 .byte VERTICAL .word DAABMenu .word MNtxt1 .byte VERTICAL .word FImenu .word MNtxt2 .byte VERTICAL .word MDmenu MNtxt0: .byte "geos",0 MNtxt1: .byte "file",0 MNtxt2: .byte "mode",0 AbtText: .byte $1a,$18," geoBeaver",27,0 .byte " Version 1.0",27,0 .byte $18," Copyright (C) 1998",27,0 .byte $18," by Bo Zimmerman",27,0 e: sei ; clear up my vectors ldw othe8P0 FImenu: .byte 15,15+1+(6*14) ; file menu data .word 29,29+40 .byte VERTICAL | 6 .word FItxt0 .byte MENU_ACTION .word R_DoClose .word FItxt1 .byte MENU_ACTION .word R_DoUpdate .word FItxt2 .byte MENU_ACTION .word R_DoExport .word FItxt3 .byte MENU_ACTION .word R_DoRecover .word FItxt4 .byte MENU_ACTION .word R_DoRename .word FItxt5 .byte MENU_ACTION .word R_DoExit FItxt0: .byte "close",0 FItxt1: .byte "update",0 FItxt2: .byte "export",0 FItxt3: .byte "recover",0 FItxt4: .byte "rename",0 FItxt5: .byte "quit",0 |8P0 MDmenu: .byte 15,15+1+(3*14) ; mode menu data .word 49,49+40 .byte VERTICAL | 3 .word MDtxt0 .byte MENU_ACTION .word R_DoM1 .word MDtxt1 .byte MENU_ACT8P0 MDmenu: .byte 15,15+1+(3*14) ; mode menu data .word 49,49+40 .byte VERTICAL | 3 .word MDtxt0 .byte MENU_ACTION .word R_DoM1 .word MDtxt1 .byte MENU_ACTION .word R_DoM2 .word MDtxt2 .byte MENU_ACTION .word R_DoM3 MDtxt0: .byte "screen ",0 MDtxt1: .byte "menu ",0 MDtxt2: .byte "dialog ",0 h8P0 R_DoM1: ldb Temp+9,#0 jmp ChgMode R_DoM2: ldb Temp+9,#1 jmp ChgMode R_DoM3: ldb Temp+9,#2 jmp ChgMode ChgMode: jsr GotoFirstMenu lda 8P0 R_DoM1: ldb Temp+9,#0 jmp ChgMode R_DoM2: ldb Temp+9,#1 jmp ChgMode R_DoM3: ldb Temp+9,#2 jmp ChgMode ChgMode: jsr GotoFirstMenu lda Mode ; are we already here? cmp Temp+9 bne 10$ rts ; nothing to do! 10$: lda Temp+9 ; now ready new mode sta Mode jsr MenuStar jsr ReDoMenu jmp GoMode ; and go do it visually MenuStar: lda #32 sta MDtxt0+6 sta MDtxt1+4 sta MDtxt2+6 lda #'*' ldx Mode bne 10$ sta MDtxt0+6 rts 10$: cpx #1 bne 11$ sta MDtxt1+4 rts 11$: cpx #2 bne 12$ sta MDtxt2+6 rts 12$: rts k8P0 R_DoNothing: jsr GotoFirstMenu rts R_DoExit: jsr GotoFirstMenu lda FileDrv ; reset the file drive jsr SetDevice jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGba8P0 R_DoNothing: jsr GotoFirstMenu rts R_DoExit: jsr GotoFirstMenu lda FileDrv ; reset the file drive jsr SetDevice jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+12 ; closefile (for saving) lda DAABdrv ; exit click -- exit the app jsr SetDevice jsr UnMode jmp EnterDeskTop R_DoClose: jsr GotoFirstMenu lda FileDrv ; reset the file drive jsr SetDevice jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+12 ; closefile (for saving) jsr VPRGbase+9 ; clear screen lda DAABdrv ; exit click -- exit the app jsr SetDevice jsr UnMode jmp ProgStart ; re-do EVERYTHING! e-do EVERYTHING! i_LdMod ; key press in mode 2 .byte 4 jmp VPRGbase + 12 55$: jsr i_LdMod .byte 5 jmp VPRGbase + 9 ; mode38`0 R_DoUpdate: jsr GotoFirstMenu lda FileDrv ; reset the file drive jsr SetDevice jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+12 ; closefile (for saving) ldw A2,#UDTxt0 jsr OKBox rts UDTxt0: .byte $18,"Update complete.",27,0 p8`0 R_DoRecover: jsr GotoFirstMenu ldw A2,RCTxt0 jsr YNBox cbi sysDBData,#3 ; was operation confirmed? bne 99$ lda FileDrv ; reset the file drive jsr SetDevice ldw EndOData,#DataStart jsr8`0 R_DoRecover: jsr GotoFirstMenu ldw A2,RCTxt0 jsr YNBox cbi sysDBData,#3 ; was operation confirmed? bne 99$ lda FileDrv ; reset the file drive jsr SetDevice ldw EndOData,#DataStart jsr ClrBuf2End ; Zero out the damn buffer jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+15 ; loadfile (for recovering) cpx #0 bne 99$ jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+18 ; recover EndOData ldb SaveFlag,#0 ; clear all savable offence lda Mode ; now do mode refreshes bne 10$ jsr i_LdMod ; must be mode "0", screen .byte 2 jmp VPRGbase + 15 ; now reset up mode 10$: cmp #1 bne 11$ ; are we in menu mode? jsr i_LdMod .byte 4 jmp VPRGbase + 15; now reset up this mode 11$: cmp #2 bne 12$ ; are we in dialog mode?  jsr i_LdMod ; must be mode 3, screen 8`0 .byte 5 jmp VPRGbase + 15 ; now reset up mode 12$: rts ; ** other modes 99$: rts RCTxt0: .byte $18,"Recover last saved data?",27,0 q8`8`0 R_DoRename: jsr GotoFirstMenu lda FileDrv ; reset the file drive jsr SetDevice jsr DisMode ; disable events, please jsr i_LdMod ; swap in the open/close mod .byte 1 jsr VPRGbase+21 ; rename file jmp ReMode rts 8`0 R_DoExport: jsr GotoFirstMenu  lda FileDrv ; reset the file drive jsr SetDevice jsr DisMode ; disable events, please jsr i_LdMod ; swap in the export module .byte 3 jsr VPRGbase+0 ; do the deed jmp ReMode rts 8`0 .ramsect ; ******* Resident module variables EndOData: .block 2 ; Data Storage End Pointer  DummyH: .block 7 ; have no idea what this is for  DataStart: .block 4000 ; main data block 8`0DataEndP: .block 1 ; place holder only ;***** Main menu block Mode: .block 1 ; screen mode MenuMode: .block 1 ; whether menus been created MenuSave: .block 6 ; save all menu x and y #](#DummyH) Error: Expression cannot be resolved In module: 3 In file: S/g8`0 ;***** Main file block FileName: .block 20 FileDrv: .block 1 SaveFlag: .block 1 veFlag: .block 1 art: .block 4000 ; main data block DataEndP: .block 1 ; place holder only ;***** Main menu block Mode: .block 1 ; screen mode8`0 ;***** Temporary storage Temp: .block 20 ; just a simple happy work area NextTmp: .block 2 ; byte total for NextItem SaveMgn: .block 2 ; save the rightMargin for GetText ;***** Main menu block Mode: .block 1 ; screen mode8`0 ;***** Selection variables -- Common OSelBox: .block 10 ; the original selection box OSelByts: .block 4 SelBox: .block 10 ; the box in motion SelByts: .block 4 SelMove: .block 6 ; dimensions for move box SelResi: .block 6 ; dimensions for resiZe box SelItem: .block 2 ; pointer to item moved or resiZed SelTool: .block 1 ; whether move or resiZe SelCode: .block 1 ; what type of thing is selected ol: .block 1 ; whether move or resiZe SelCode: .block 1 ; what type of thing is 8`0 ;******* SHARED GLOBALS!! GLOBAL: Tool: .block 1 ; 1,3:Toolbar tool#, 1 byte DragFlag: .block 1 ; 1,3:Status of motion, 1 byte DragX: .block 3 ; 1,3:Upper left of motion, 3 bytes DragX2: .block 3 ; 1,3:Last bottom of motion, 3 bytes LbxPattern: .block 1 ; 1,3:Line box pattern, 1 byte FilPattern: .block 1 ; 1,3:Fill pattern, 1 byte TxtPattern: .block 1 ; 1,3:Text pattern, 1 byte ScreenMode: .block 1 ; 1:0=normal, 1=full screen ldb SaveFlag,#0 ; clear all savable offence 8`0 DlgDims: ; 3:dimensions of dialog box, 6 bytes PlusBox: .block 6 ; 2:dimensions of plusbox, 6 bytes DlgByts: ; 3:dialog box right/left bytes, 4 bytes PlusType: .block 1 ; 2:whether VERT or HORZ, 1 byte SelLevel: .block 1 ; 2:menu level selected, 1 byte SelPapy: .block 2 ; 2:parent of selected item, 2 bytes  Find4Me: .block 1 ; 2:what code to look for, 1 byte 8`0NextHere: .block 2 ; 2:pointer after FoundOne, 2 bytes DlgPtr: ; 3:ptr to dialog box item, 2 bytes FounDims: .block 2 ; 2:dimensions of found one,6 bytes  Mod3IFlg: .block 2 ; 3:pointer to any INPUT flag, 2bytes  Mod3ISZ: .block 1 ; 3:temporary siZe pointer, 1 byte .block 1 8`0LastB4: .block 1 ; 2:what code to stop at ChkPlace: .block 3 ; 2:mousey, then mousex mensions of found one LastB4: .block 1 ; what code to stop at ChkPlace: .block 3 ; mousey, then mousex 3 ; mousey, then mousex ex ex 9,"$c151",9,"; DoMenu" ,13,0  jmp MenuLp3 8`0 ;******* mode 3 -- must be global ***** od3ISZ: .block 1 ; temporary siZe pointer plusbox, 6 bytes DlgByts: ; 3:dialog box right/left bytes, 4 bytes PlusType: .block 1 ; 2:whether VERT or HORZ, 1 byte SelLevel: .block S/geoBOpen#"PRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V&yx`#4MH0P ;****************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman  ;* S/geoBOpen 0P;* ;******************************  .if Pass1  .noeqin .noglbl  .include GEOSequates .eqin .glbl .endif  .psect jmp OpenUp ; VPRGbase + 0 jmp OKBox ; VPRGbase + 3 jmp CNCLBox ; VPRGbase + 6 jmp ClrScrn ; VPRGbase + 9 jmp CloseFile ; VPRGbase + 12 jmp LoadFile ; VPRGbase + 15 jmp RcvrEndD ; VPRGbase + 18 jmp RenWkFile ; VPRGbase + 21 jmp DlgBox ; VPRGbase + 24 in ramsect S/geoBExport.rel S/geoBExporS.rel S/geoBExporM.rel S/geoBExporD.rel MODgeoWx.rel .mod 4 .psect VPRGbase ; end of main rams0P0 OpenUp: ldw A2,#IntroGfx ldw A3,#ClrIGfx ldw A4,#DataPNam ldw A5,#FileName jsr FileBox ; do the open/create/quit box cpx #0 bne OpenUp ; restart if disk error! 10$: lda sysDBData beq 11$ jsr LoadFile ; file is being loaded!!! cpx #0 bne OpenUp ; restart if disk error! jsr RcvrEndD rts ; done, exit 11$: jsr CreateFi ; create her rts RcvrEndD: ldw A0,#$8100 ; recover EndOData from header ldy #$49 ; look into header lda (A0),y ; get eodata lsb sta EndOData iny lda (A0),y ; get eodata hsb sta EndOData+1 dew EndOData ; readjust for saved file rts IntroGfx: ldw R0,#IntroBox ;Put little text box in jmp GraphicsString  ClrIGfx: ldw R0,#ClrIBox ;Put little text box in jmp GraphicsString Rn0P0 IntroBox: .byte $05 ;Set pattern .byte $00 ;Clear pattern .byte $01 ;Set position .word 100 ; Xpos .byte 145 ; Ypos .byte $07 ;Make outline .word 225 ; Xpos .byte 185 ; Ypos .byte $01 ;Set fill position .word 101 ; Xpos .byte 146 ; Ypos .byte $03 ;Fill in box .word 224 ; Xpos .byte 184 ; Ypos .byte $06 ;First Text line .word 115 ; Xpos .byte 167 ; Ypos .byte $18," - geoBeaver 1.0 - ",27,0 .byte $00 ;End intro box ClrIBox: .byte $05 ;Set pattern .byte $02 ;Clear pattern .byte $01 ;Set position .word 100 ; Xpos .byte 145 ; Ypos .byte $03 ;Fill in box .word 225 ; Xpos .byte 185 ; Ypos .byte $00 ;End intro box mo0P0 CreateFi:  mvb curDri0P0 CreateFi:  mvb curDrive,FileDrv ;save drive of opened file  ldb SaveFlag,#$01 ;create the file ldw EndOData,#DataStart ldb DataStart,#$00 ;start off with nothing, please ;inw EndOData ; don't do this.. it screws it up jmp CloseFile p0P0 CloseFile: lda SaveFlag beq 15$ mvw EndOData,DataEnd inw DataEnd ldw R0,#FileName mvw R0,DataHeader ;update filename in header jsr DeleteFile ;erase old file ldw R9,#DataHeader ldb R10L,0P0 CloseFile: lda SaveFlag beq 15$ mvw EndOData,DataEnd inw DataEnd ldw R0,#FileName mvw R0,DataHeader ;update filename in header jsr DeleteFile ;erase old file ldw R9,#DataHeader ldb R10L,#0 ldb SaveFlag,#$00 ;re-clear save flag jsr SaveFile ;save new file cpx #0 beq 15$ jsr FError ; errors in save are bad jmp OpenUp 15$: rts 15$: rts 115 ; Xpos .byte 167 ; Ypos .byte $18," - geoBeaver 1.0 - ",27,0 .byte $00 ;End intro box ClrIBox: .byte $05 ;Set 0P0 LoadFile: ldb R0L,#$01 ;set up Load Code ldw R6,#FileName ldw R7,#DataStart ; for compatibility jsr GetFile ;read old file cpx #0 bne 10$ mvw DataEnd,EndOData ldx #0 10$: jmp FError ;handle errors MoveHead: ldw A0,#DataHeader ;copy new header block ldw A1,#$8100 lda #$ff ldx #A1 ldy #A0 jmp CopyFString u0P0 RenWkFile: ldw R0,#FileName ; rename the work file ldw R15,#FTemp ldy #R15 ldx #R0 jsr CopyString ; get the old filenam0P0 RenWkFile: ldw R0,#FileName ; rename the work file ldw R15,#FTemp ldy #R15 ldx #R0 jsr CopyString ; get the old filename in place ldw R15,#FTemp ldw R0,#RenBox ; open rename box please jsr DoDlgBox cbi FTemp,#0 ; was anything typed? bne 11$ 10$: rts ; ugh, so exit 11$: cbi sysDBData,#2 beq 10$ ; was cancel hit? ldw R0,#FTemp ldw R6,#FileName ; now try to rename on disk jsr RenameFile cpx #5 beq 12$ ; file not found error ok cpx #0 beq 12$ jmp FError ; handle other disk errors 12$: ldw R0,#FTemp ldw R15,#FileName ; no errors, so we're done! ldy #R15 ldx #R0 jsr CopyString ; make this filename permanent rts RenBox: .byte $80 | $01 .byte 11 ; PutString .byte $10,$18 .word RNTxt0 .byte 13 ; GetString .byte $1c,$23 .byte R15 .byte 16 ; max characters to accept .byte $02,$0e,$43 ; cancel icon .byte 0 RNTxt0: .byte $18,"Please enter new filename:",27,0 0P0 DlgBox: lda #[(DlgDat) sta $02 ; set lsb for dialog data ld0P0 DataHeader: .word FileName .byte $03,$15,$bf 0P` .byte $ff,$ff,$ff,$80,$00,$01,$b1,$39 .byte $01,$aa,$92,$81,$ab,$93,$81,$aa .byte $92,$8f,$b2,$92,$bf,$80,$00,$3f .byte $80,$00,$1f,$80,$3f,$3f,$8f,$cc .byte $fd,$b6,$18,$39,$90,$41,$9d,$94 .byte $d4,$91,$88,$37,$a1,$87,$3c,$61 .byte $82,$83,$31,$81,$00,$01,$d6,$b5 .byte $ad,$d6,$b5,$ad,$ff,$ff,$ff .byte $83 0P0 .byte APPL_DATA .byte SEQUENTIAL .word DataStart DataEnd: .word DataStart .word 0 DataPNam: .byte "geoBeaver Data",0,0,0,0,0,$00 .byte "Bo Zimmerman",0,0,0,0,0,0,0,0 .byte "geoBeaver 1.0",0,0,0,$00 Zeroes: .block 160-117 117 text .word DlgT08 .byte $0b,$08,$77 ; static text .word DlgT09 .byte $00P0 DlgBox: lda #[(DlgDat) sta $02 ; set lsb for dialog data lda #](DlgDat) sta $03 ; set msb for dialog data jmp $c256 ; call DoDlgBox and leave! DlgDat: .byte $01 ; size flag, and shadow pattern .byte $20,$b5,$40,$00,$1e,$01 ; dialog box dimensions .byte $0b,$06,$0b ; static text .word DlgT00 .byte $0b,$06,$17 ; static text .word DlgT01 .byte $0b,$06,$21 ; static text .word DlgT02 .byte $0b,$07,$2a ; static text .word DlgT03 .byte $0b,$07,$35 ; static text .word DlgT04 .byte $0b,$07,$47 ; static text .word DlgT05 .byte $0b,$07,$52 ; static text .word DlgT06 .byte $0b,$07,$5d ; static text .word DlgT07 .byte $0b,$08,$6d ; static text .word DlgT08 .byte $0b,$08,$77 ; static text .word DlgT09 .byte $0b,$08,$81 ; static text .word DlgT0a .byte $01,$12,$7e ; OK button .byte $13 ; all external dialog gfx .word DlgGfx .byte $00 ; end of table DlgT00: .byte $1a,$18,"geoBEAVER v1.0",27,0 DlgT01: .byte "This program is SHAREWARE. Distribute it",27,0 DlgT02: .byte "as you like. If you enjoy it, send your",27,0 DlgT03: .byte "registration fee of $20.00 USD to the",27,0 DlgT04: .byte "following address:",27,0 DlgT05: .byte "Bo Zimmerman",27,0 DlgT06: .byte "1907 Cameo Drive",27,0 DlgT07: .byte "Round Rock, TX 78664",27,0 DlgT08: .byte "Registering this program will entitle you",27,0 DlgT09: .byte "to notification of updates, and encourage",27,0 DlgT0a: .byte "future development.",27,0 DlgGfx: jsr $c1ab ; i_BitmapUp .word Bitmap00 .byte $19,$5a,$03,$18 ; col, row, width, height rts 0P0 Bitmap00: @ ck 20 ; for rename only nly og data lda #](DlgDat) sta $03 ; set msb for dialog data jmp $c256 ; call DoDlgBox and leave! DlgDat: .byte $01 ; size flag, and shadow pattern .byte $20,$b5,$40,$00,$1e0P0 .ramsect FTemp: .block 20 ; for rename only nly og data lda #](DlgDat) sta $03 ; set msb for dialog data jmp $c256 ; call DoDlgBox and leave! DlgDat: .byte $01 ; size flag, and shadow pattern .byte $20,$b5,$40,$00,$1e    ????9Aԑ71 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V&1mT KhT@5TQ.lM0P ;****************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman  ;* S/geoBMode1 0P;* ;******************************  .if Pass1  .noeqin .noglbl  .include GEOSequates .eqin .glbl .endif  .psect jmp Main1 ; VPRGbase + 0 jmp Mod1Click ; VPRGbase + 3 jmp Mod1Recv ; VPRGbase + 6 jmp Mod1Drag ; VPRGbase + 9 jmp Mod1Press ; VPRGbase + 12 jmp ReMain1 ; VPRGbase + 15 .word UnDo PRGbase + 18 jmp RenWkFile ; VPRGbase + 21 jmp DlgBox ; VPRGbase + 24 in ramsect S/geoBExport.rel S/geoBExporS.rel S/geoBExporM.rel S/geoBExporD.rel MODgeoWx.rel .mod 4 .psect VPRGbase ; end of main rams0P0 Main1: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK ldb Tool,#2 ; selection tool is default ldb FilPattern,#1 ; default pattern is filled ldb LbxPattern,#$ff; default pattern for line boxes ldb TxtPattern,#0 ; default text pattern ldb ScreenMode,#0 ; default is not full screen ReMain1: jsr UnWrap jsr ReClick jsr ReTool lda MenuMode ; has menu been initialiZed? bne 10$ inc MenuMode ; no, so initialiZe it ldw R0,#MyMenu lda #0 jsr DoMenu ; set up the pull-down windows bra 11$ ; and skip a redo 10$: jsr ReDoMenu 11$: mvb mouseOn,MenuSave ; save menu checking ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK rts T07 .byte $0b,$08,$6d ; static text .word DlgT08 .byte $0b,$08,$77 ; static text .word DlgT09 .byte $00P0 ReTool: ldb dispBufferOn,#ST_WR_FORE jsr i_BitmapUp .word Mode1Img .byte 0 .byte 20 .byte Mod1wid .byte Mod1hit mvb Tool,A2L jsr ChkClick ; to get Tools dims jsr InvertRectangle  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  rts 3o0P0 ReClick: ldb A2L,#20 ldb A2H,#20+16 ; init first box ldw A3,#0 ldw A4,#15 ldb Temp,#1 10$: ldw A5,#0 mvb Temp,A6L jsr SetClick lda A3L ; are we on the left bne 11$ ldb A3L,#16 ; yes, so 0P0 ReClick: ldb A2L,#20 ldb A2H,#20+16 ; init first box ldw A3,#0 ldw A4,#15 ldb Temp,#1 10$: ldw A5,#0 mvb Temp,A6L jsr SetClick lda A3L ; are we on the left bne 11$ ldb A3L,#16 ; yes, so move to the right ldb A4L,#31 bra 12$ ; stay on same row, height 11$: ldb A3L,#0 ldb A4L,#15 ; down a row, please avb #16,A2L avb #16,A2H 12$: inc Temp cbi Temp,#9 blt 10$ ; finish the top 7 ldb A4L,#31 ldw A5,#0 svb #1,A2H ; undo is a bit small? mvb Temp,A6L ; this is undo jsr SetClick avb #16,A2L avb #16,A2H ldw A5,#0 ldb A6L,#10 ; this is full screen jsr SetClick rts UnClick: ldb Temp,#0 sta A2L sta A2H sta A3L sta A3H sta A4L sta A4H sta A5L sta A5H 10$: lda Temp sta A6L jsr SetClick inc Temp cbi Temp,#11 blt 10$ rts p0P0 UnWrap: mvw rightMargin,UnWr1  lda #ST_WR_FORE | ST_WR_BACK sta  dispBufferOn 0P0 jsr i_GraphicsString .byte NEWPATTERN,0 .byte MOVEPENTO,0,0,0 .byte 0P0 UnWrap: mvw rightMargin,UnWr1  lda #ST_WR_FORE | ST_WR_BACK sta  dispBufferOn 0P0 jsr i_GraphicsString .byte NEWPATTERN,0 .byte MOVEPENTO,0,0,0 .byte RECTANGLETO UnWr1: .word 319 .byte 199 .byte 0 ; done clearing screen  ldw A0,#DataStart jsr UnWrpLp1 ldw A0,#DataStart jmp UnWrpLp2 (u0P0 UnWrpLp1: jsr UnWrpNx bne 10$ rts ; all done 10$: cmp #4 ; is it line, linebox, or fbox? bgt 15$ jsr UnWrB0P0 UnWrpLp1: jsr UnWrpNx bne 10$ rts ; all done 10$: cmp #4 ; is it line, linebox, or fbox? bgt 15$ jsr UnWrBox ; get R2-R4 lda Temp+3 ; now get command back cmp #1 ; do a simple line please bne 12$ mvw R2,R11 ; put y in right place lda #0 sec jsr DrawLine ; draw the damn line jmp UnWrapDo 12$: cmp #2 bne 13$ jmp UnWrapDo 13$: cmp #3 ; unwrap a lined box please bne 14$ mvb Temp+4,LbxPattern lda LbxPattern ; set this funny number up jsr FrameRectangle jmp UnWrapDo 14$: cmp #4 ; do a filled box please bne 15$ mvb Temp+4,FilPattern jsr SetPattern ; set the fill box pattern jsr Rectangle jmp UnWrapDo 15$: cmp #5 ; do some text please bne 16$ jsr UnWrBox ; get R2-R4 -- for what its worth mvb Temp+4,TxtPattern jsr UnWrTxt jmp UnWrapDo 16$: cmp #6 ; is it bitmap of some sort? beq 17$ jmp UnWrapDo ; don't unwrap clickboxes yet 17$: jsr UnWrBox mvw R3,R1 mvb R4L,R2H ; get bytes in right place mvw A0,R0 avw #8,R0 jsr BitmapUp ; put it on the screen! 99$: jmp UnWrapDo UnWrapDo: adw Temp,A0 ; get ready for next command lda #0 sta $2e ; always make sure text patt ok jmp UnWrpLp1 owing address:",27,0 DlgT05: .byte "Bo Zimmerman",27,0 DlgT06: .byte "9500 Dessau #1023",27,0 DlgT07: .byte "Austin0P0 UnWrpLp2: jsr UnWrpNx ; now unwrap click boxes beq 99$ cmp #7 beq 10$ adw Temp,A0 ; get ready for next command jmp UnWrpLp2 99$: rts ; all done 10$: jsr UnWrBox mvw R3,R1 mvb R4L,R2H ; get bytes in right place mvw A0,R0 avw #8,R0 jsr BitmapUp ; put it on the screen! adw Temp,A0 ; get ready for next command jmp UnWrpLp2 UnWrTxt: lda TxtPattern sta $2e ; set the fill box pattern mvw R3,R11 mvb R2H,R1H ; position the cursor svb #2,R1H ; underline adjustment mvw A0,R0 avw #10,R0 jsr PutString ; write out the text!! lda #0 sta $2e rts z0P0 UnWrapGet: lda (A0),y iny rts UnWrBox: ldy #4 jsr UnWrapGet ; get start x lsb sta R3L jsr UnWrapGet ; get start x hsb sta R3H js0P0 UnWrapGet: lda (A0),y iny rts UnWrBox: ldy #4 jsr UnWrapGet ; get start x lsb sta R3L jsr UnWrapGet ; get start x hsb sta R3H jsr UnWrapGet ; get start y sta R2L jsr UnWrapGet ; get end x lsb sta R4L jsr UnWrapGet ; get end x hsb sta R4H jsr UnWrapGet ; get end y sta R2H rts UnWrpNx: cpw A0,EndOData ; out of data yet? blt 11$ lda #0 rts ; nothing to do, exit 11$: ldy #1 lda (A0),y ; set the pattern first sta Temp+4 ; the temp place for patterns ldy #2 ; then get bytes lsb lda (A0),y sta Temp iny lda (A0),y ; then bytes hsb sta Temp+1 ldy #0 lda (A0),y ; now get command sta Temp+3 rts |0P0 Mod1Click: cbi mouseData,#0 ; is the button down or up? beq 11$ cb0P0 Mod1Click: cbi mouseData,#0 ; is the button down or up? beq 11$ cbi DragFlag,#1 ; need to permaniZe? bne 10$ ldb DragFlag,#2  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  jsr Mod1Drag ; make it permanent! jsr UnScrnMod 10$: ldb DragFlag,#0 ; clear the drag flag rts ; button is released 11$: ldb A2L,#1 ; start to check buttons, from 1 12$: jsr ChkClick ; check the main buttons cpx #0 beq 16$ ; found a click! inc A2L cbi A2L,#10 ; until 10, keep checking... ble 12$ ; no button pressed, so in screen? 90$: lda ScreenMode ; check for full screen bne 13$ ldw R3,#32 ; check for main screen area mvw rightMargin,R4 ldb R2L,#15 mvb windowBot,R2H ; menu and tool bar jsr IsMseInRegion ; not full screen, so check area cmp #$ff bne 10$ ; it's outside protected area, so exit 13$: cbi Tool,#8 ; do not set drag mode for non-tools bge 15$ cmp #2 ; the select tool is a special case bne 14$ jmp SelClick ; handle clicks for selection specially 14$: ldb DragFlag,#1 ; you can set the drag flag mvw mouseXPos,DragX mvb mouseYPos,DragX+2 ; save drag start ldw DragX2,#0 ldb DragX2+2,#$ff ; init old drag point 15$: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  rts ; nothing doin 16$: cpb A2L,Tool beq 15$ ; don't bother selected tool cbi A2L,#8 blt 18$ ; only 1-7 are REAL tools bne 17$ ; do a quick patt butt check cbi Tool,#2 ; is selection tool selected? bne 17$ jmp PattEdit ; do selected patts now, please 17$: ldb dispBufferOn,#ST_WR_FORE  mvb A2L,Temp jsr ChkClick ; invert the pseudo-tool jsr InvertRectangle jmp Mod1Othr ; and handle it (undo, fulscrn, etc) 18$: jsr ClrSelect ; clear selection just in case  ldb dispBufferOn,#ST_WR_FORE mvb A2L,Temp ; temporarily save new tool mvb Tool,A2L ; and restore old tool to uninvert jsr ChkClick ; to get R2-R4 jsr InvertRectangle ; to uninvert old tool mvb Temp,Tool ; now permaniZe the new tool mvb Tool,A2L ; and set up to invert it... jsr ChkClick ; to get R2-R4 jsr InvertRectangle ; to invert new tool ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  rts 3p0P0 Mod1Othr: cbi Temp,#8 beq 13$ ; the pattern button was chosen cmp #10 bne 14$ ; this is full screen jsr ClrSelect ; clear selection just in c0P0 Mod1Othr: cbi Temp,#8 beq 13$ ; the pattern button was chosen cmp #10 bne 14$ ; this is full screen jsr ClrSelect ; clear selection just in case jsr UnClick jsr UnWrap ; will all this work?? ldb mouseOn,#$a0 ; disable clicking lda #1 sta ScreenMode ; will now skip to 99$ 14$: cmp #9 ; clicked undo? bne 99$ jsr ClrSelect ; select is special for undo jsr UnDo 99$: rts ;** here begins the pattern box button stuff 13$: jsr ClrSelect ; clear selection just in case cbi Tool,#3 bne 10$ ldw R0,#LPatDlg jsr DoDlgBox rts 10$: cbi Tool,#4 bne 11$ ldw R0,#PattDlg jsr DoDlgBox cbi sysDBData,#32 ; illegal pattern selection bge 98$ mvb sysDBData,FilPattern 98$: rts 11$: cbi Tool,#5 bne 12$ ldw R0,#TPatDlg jsr DoDlgBox cbi sysDBData,#2 beq 98$ ; cancel is bad mvb Temp+19,TxtPattern rts 12$: ldw A2,#NoPaText jsr CNCLBox lda #8 jsr ChkClick ; don't do pattern jsr InvertRectangle jmp ReTool NoPaText: .byte $18,"No patterns for that tool.",0 b DragFlag,0P0 UnDo: cwi EndOData,#DataStart ; is there anything in there? beq 10$ jsr FindSLast ; look for the undoable cwi A1,#0 beq 10$ ; nothing found, so don't undo ldw R0,#UnDoDlg jsr DoDlgBox cbi sysDBData,#3 ; confirm the procedure beq 11$ 10$: jmp ReMain1 11$: mvw A1,A0 ; set source adw A3,A0 ; by adding length ldy #0 12$: lda (A0),y sta (A1),y ; copy data over cpw A0,EndOData bge 13$ ; if just wrote the end, stop inw A0 inw A1 ; otherwise, increment and continue bra 12$ 13$: sbw A3,EndOData ; pull back EndOData jsr ClrBuf2End ; Zero out all we've found... ldb SaveFlag,#1 ; set the damn save flag jmp ReMain1 FindSLast: ldw A0,#DataStart ; start at beginning ldw A2,#0 ; with no movement, bytes=A2 ldw A1,#0 ; save the last move 12$: ldy #2 lda (A0),y ; get the supposed bytes L & h sta A2L iny lda (A0),y ; get the supposed bytes l & H sta A2H ldy #0 lda (A0),y cmp #20 bge 13$ mvw A0,A1 ; found one, so save it mvw A2,A3 ; and save its width 13$: adw A2,A0 ; skip ahead = A0  cpw A0,EndOData ; have we reached the end yet? 0P0 blt 12$ ; no, so keep looping rts ; A1 should point to last now UnDoDlg: .byte $80 | $01 .byte 11 ;add text .byte $0d,$12 .word UDTxtA .byte $03,$01,$47 ;Yes icon .byte $04,$0f,$47 ;No icon .byte 0 ;end of defintion UDTxtA: .byte $18,"Undo last operation?",27,0 yz0P0 Mod1Recv: jsr RecoverRectangle jsr ClrSelect ; kinda dangerous!! jmp ReTool Mod1Drag: l0P0 Mod1Recv: jsr RecoverRectangle jsr ClrSelect ; kinda dangerous!! jmp ReTool Mod1Drag: lda DragFlag ; don't bother if not set bne 89$ rts 89$: mvw mouseXPos,Temp ; save your mousex and y mvb mouseYPos,Temp+2 cbi DragFlag,#2 ; if making permanent... bne 90$ mvw DragX2,Temp mvb DragX2+2,Temp+2 ldb DragX2+2,#$ff ; ensure a write cbi Tool,#2 ; selections don't permaniZe beq 91$ jsr EntryDo ; save the entry in buffer beq 90$ ; leave on an error jmp ReMain1 90$: lda ScreenMode ; check for full screen bne 91$ ldw R3,#32 mvw rightMargin,R4 ldb R2L,#15 ldb R2H,#199 ; menu and tool bar jsr IsMseInRegion ; protect these cmp #$ff bne 99$ ; it's out, so exit 91$: cbi DragFlag,#2 ; if making permanent... beq 92$ ldb dispBufferOn,#ST_WR_FORE 92$: cbi Tool,#1 ; is it a line? bne 10$ jmp DragLine 10$: cbi Tool,#3 ; this would be open rec bne 11$ jmp DragOBox 11$: cbi Tool,#4 bne 12$ jmp DragFBox 12$: cbi Tool,#5 bne 13$ jmp StartText 13$: cbi Tool,#6 beq 14$ cbi Tool,#7 bne 15$ ; a bitmap or icon?? 14$: jmp Iconfirm 15$: cbi Tool,#2 ; moving/resiZing selection? bne 99$ ; nope.. and its the last tool jmp DragSel 99$: rts ; only these are done for now  add text .byte $0d,$12 .word UDTxtA .0P0 StartText: ldw R15,# DataEndP ; check memory remaining sbw EndOData,R15 ; check for 16 bytes cwi R15,#17 bge 90$ ldb DragFlag,#0 ; clear the dragging jsr NoMem ldx #1 ; nope, so leave rts 90$: cbi DragX+2,#192 bge 10$ ; nothing too far down cbi DragX+2,#3 bge 11$ ; nothing up too far 10$: rts 11$: ldb Tool,#9 ; un-set the tool jsr MouseOff jsr ClrBuf2End ; a Zero terminator is important ldb DragFlag,#0 ; disable all that nasty stuff mvw EndOData,R0 avw #10,R0 ; to get past stuff ldy #0 tya sta (R0),y ; to clear text buffer ldb R1L,#0 ; no control stuff ldb R2L,#$f0 ; no minimum input! ldw Temp,#DataEndP sbw EndOData,Temp cwi Temp,#$0d ; check remaining buffer space blt 99$ cwi Temp,#$f0 ; now find usable max bge 12$ svb #8,Temp mvb Temp,R2L ; get usable max chars 12$: mvw DragX,R11 ; starting column mvb DragX+2,R1H ; starting underline  avb #6,DragX+2 ; putstring adjustment  ldw keyVector,#CRText 0P0 ldb dispBufferOn,#ST_WR_FORE lda TxtPattern sta $2e ; give me pattern!! jmp GetString 99$: jmp NoMem (n0P0 CRText: ldb Tool,#5 ; re-set the tool jsr EntryDo beq 11$ ; an error, so exit 10$: lda #0 sta $2e ; clear pattern0P0 CRText: ldb Tool,#5 ; re-set the tool jsr EntryDo beq 11$ ; an error, so exit 10$: lda #0 sta $2e ; clear pattern jmp UserMode ; and exit 11$: mvw EndOData,A0 ; reset our pointer... mvw R11,Temp ; save true end x for a spell... ldy #4 lda DragX sta (A0),y ; get mousex< sta R3L ; and save for restore box sta Temp+2 ; and for reprint, save iny lda DragX+1 ; get mousex> sta (A0),y sta R3H ; and save for restore box sta Temp+3 ; and for reprint, save iny lda DragX+2 ; get mousey sta R1H sub curHeight sta (A0),y ; save the y position sta R2L ; save the restore box top iny lda Temp ; R11 saved here before sta (A0),y ; save end x lsb iny lda Temp+1 ; R11 saved here before sta (A0),y ; save end x hsb iny lda R1H add #2 sta (A0),y ; save end y sta R2H ; and save again for restore below iny ldw Temp,#0 ; for text siZe counting lda (A0),y ; first check for ANYTHING! beq 10$ 12$: lda (A0),y ; now check for END beq 13$ iny inc Temp ; keep going til end is found bra 12$ 13$: avb #11,Temp ldy #2 lda Temp ; save actual siZe sta (A0),y adw Temp,EndOData ; make new data end mvw A0,R0 ; restore string pointer avw #10,R0 ; to be pointing at string mvw rightMargin,R4 jsr RecoverRectangle ; here is the restore!!! ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK mvw Temp+2,R11 ; starting x saved here earler jsr PutString ; now permaniZe the string lda #0 sta $2e ; clear pattern jmp UserMode yq0P0 DragLine: jsr PreDra0P0 DragLine: jsr PreDrag bcc 10$ ; if carry clear, then exit mvw DragX,R3 ; orig col point mvb DragX+2,R11L ; orig row point mvw Temp,R4 ; new mouse x mvb Temp+2,R11H ; new mouse y lda FilPattern ; set up the drawing pattern jsr SetPattern ; from the FilPattern lda #0 ; sets norecover flag sec ; sets the draw flag jsr DrawLine ; draw the new line 10$: jmp DragOut ; get out now DragOBox: jsr PreDrag bcc 10$ ; if carry clear, then exit jsr PrepBox ; get dimensions ready lda LbxPattern ; set up the drawing pattern as full jsr FrameRectangle 10$: jmp DragOut ; get out now DragFBox: jsr PreDrag bcc 10$ ; if carry clear, then exit lda FilPattern ; set up the drawing pattern jsr SetPattern ; from the FilPattern jsr PrepBox ; get dimensions ready jsr Rectangle 10$: jmp DragOut ; get out now below iny ldw Temp,#0 ; for text siZe counting lda (A0),y ; first check for ANYTHING! beq 10$ 12$: lda (A0),y ; now check for END beq 13$ iny inc Temp ; keep going 0P0 PreDrag: cbi DragX2+2,#$ff ; dragged before? beq 21$ cpw DragX2,Temp bne 10$ ; are we in the same place? cpb DragX2+2,Temp+2 beq 32$ ; yes, so just get out 10$: mvb DragX+2,R2L ; guess that the orig is the lowest mvb DragX2+2,R2H cpb R2L,R2H ; see if it IS the lowest blt 11$ ; ok so far mvb DragX2+2,R2L mvb DragX+2,R2H ; wrong way on the y, so fix 11$: mvw DragX,R3 mvw DragX2,R4 ; guess that the orig is the lowest cpw R3,R4 blt 12$ ; right, so continue mvw DragX2,R3 mvw DragX,R4 ; wrong way on the x, so fix 12$: jsr RecoverRectangle 21$: sec rts 32$: clc rts PrepBox: 10$: mvb DragX+2,R2L ; guess that the orig is the lowest mvb Temp+2,R2H cpb R2L,R2H ; see if it IS the lowest blt 11$ ; ok so far mvb Temp+2,R2L mvb DragX+2,R2H ; wrong way on the y, so fix 11$: mvw DragX,R3 mvw Temp,R4 ; guess that the orig is the lowest cpw R3,R4 blt 12$ ; right, so continue mvw Temp,R3 mvw DragX,R4 ; wrong way on the x, so fix 12$: rts DragOut: mvw Temp,DragX2 ; make THIS drawn line, the last... mvb Temp+2,DragX2+2 rts x0P0 EntryDo: ldw R15,# DataEndP ; DragX has start, Temp has mousexy sbw EndOData,R15 ; check for 10 bytes cwi R15,#11 bge 10$ jsr NoMem ldx #1 ; nop0P0 EntryDo: ldw R15,# DataEndP ; DragX has start, Temp has mousexy sbw EndOData,R15 ; check for 10 bytes cwi R15,#11 bge 10$ jsr NoMem ldx #1 ; nope, so leave rts 10$: ldb SaveFlag,#1 ; flag the file as dirty cbi Tool,#5 ; was it a line, linebox, or fbox? bge 13$ cmp #1 ; a line needs no adjustment beq 11$ jsr EntrySwap ; possibly transpose boxes 11$: jsr EntryXY ; then save data & startx ldx #0 12$: lda Temp,x ; save endx,y jsr EntrySta inx cpx #3 blt 12$ jmp EntryDone 13$: cbi Tool,#5 ; was it a text tool? bne 14$ jsr EntryXY ; just do position stuff for txt... 14$: ldx #0 rts EntryDone: mvw A0,EndOData ; save new end of data, exit ldx #0 rts EntrySta: ldy #0 ; easy way to put to (A0),y sta (A0),y ; and increment A0 as well... inw A0 rts {0P0 EntryXY: mvw EndOData,A0 ; yes, so write 10 bytes... lda Tool jsr EntrySta ; save tool ldy Tool ; get the right pattern lda LbxPattern-3,y ; get the right pattern 0P0 EntryXY: mvw EndOData,A0 ; yes, so write 10 bytes... lda Tool jsr EntrySta ; save tool ldy Tool ; get the right pattern lda LbxPattern-3,y ; get the right pattern for the job jsr EntrySta ; save pattern lda #10 jsr EntrySta ; save lsb of bytes lda #0 jsr EntrySta ; save hsb of bytes ldx #0 10$: lda DragX,x ; save startx,y jsr EntrySta inx cpx #3 blt 10$ rts EntrySwap: cpb Temp+2,DragX+2 bge 10$ ; bottom is lower (greater) than start? lda Temp+2 tax lda DragX+2 ; no, so swap the y's sta Temp+2 txa sta DragX+2 10$: cpw Temp,DragX bcs 11$ ; right is righter (greater) than start? mvw Temp,Temp+4 mvw DragX,Temp mvw Temp+4,DragX ; no, so swap 'em 11$: rts |0P0 UnScrnMod: 0P0 UnScrnMod: mvb MenuSave,mouseOn ; restore menu pointers lda ScreenMode bne 10$ ; time to END full screen rts 10$: lda #0 sta ScreenMode jmp ReMain1 ; and restart main screen UserMode: jsr MouseUp ; restart the mouse jsr ReDoMenu ; restore the menu (if necessary) jsr ReClick ldb ScreenMode,#0 ; clear it just in case, thanks. jmp ReTool Hj0P0 TPatDlg: .byte $80 | $01 .byte 11 ;add text .byte $06,$0d .word TTxtA .byte 11 ;add 0P0 TPatDlg: .byte $80 | $01 .byte 11 ;add text .byte $06,$0d .word TTxtA .byte 11 ;add text .byte $40,$22 .word TTxtB .byte 11 ;add text .byte $40,$2f .word TTxtC .byte 11 ;add text .byte $40,$3e .word TTxtD .byte 11 ;add text .byte $40,$4d .word TTxtE .byte $01,$10,$2d ;OK icon .byte $02,$10,$45 ;Cancel icon .byte 19 ;Routine on draw .word TPatDraw ;routine to execute when DB is drawn .byte 17 ;Routine on Click .word TPatClick ;routine to execute on otherPress .byte 0 ;end of defintion TTxtA: .byte $18,"Select all that apply:",27,0 TTxtB: .byte $18,"Bold",27,0 TTxtC: .byte $0e,"Underline",27,0 TTxtD: .byte $1a,"Outline",27,0 TTxtE: .byte $19,"Italics",27,0 TPatDraw: ldb Temp,#0 ; counter, this routine ldb Temp+19,#0 ; pattern holder ldb R2L,#$3a ldw R3,#110 10$: mvb R2L,R2H avb #10,R2H mvw R3,R4 avw #10,R4 lda #$ff jsr FrameRectangle avb #14,R2L inc Temp cbi Temp,#4 blt 10$ rts l0P0 TPatClick: lda mouseData0P0 TPatClick: lda mouseData bne 99$ ; no action on depression ldb Temp,#0 ; counter, this routine ldb R2L,#$3a ldw R3,#110 10$: mvb R2L,R2H avb #10,R2H mvw R3,R4 avw #10,R4 jsr IsMseInRegion ; check in the box cmp #$ff beq 11$ avb #14,R2L inc Temp cbi Temp,#4 blt 10$ rts 11$: jsr InvertRectangle ldy Temp ; fix new pattern now lda Temp+19 eor TPatTabl,y sta Temp+19 99$: rts TPatTabl: .byte 64,128,8,16 p0P0 LPatDlg: .byte $000P0 LPatDlg: .byte $00 | 01 ;user position .byte $19 ;top .byte $af ;bottom .word $036 ;left .word $0fa ;right .byte 11 ;add text .byte $07,$0e .word PTTextA .byte $02,$11,$7f ;Cancel icon .byte 19 ;Routine on draw .word LPatDraw ;routine to execute when DB is drawn .byte 17 ;Routine on Click .word LPatClick ;routine to execute on otherPress .byte 0 ;end of defintion PTTextA: .byte $18,"Please select from the following:",27,0 LPatDraw: ldb Temp+2,#$2f ; init the top and bottom ldw Temp,#$040 ldb Temp+3,#0 ; init the pattern LPatLp: cwi Temp,#$ed ; check x bge 11$ ; if gone too far right, CR cbi Temp+2,#$90 ; check y blt 12$ ; if not gone too far, ok rts 11$: ldw Temp,#$040 ; do a semi CR avb #15,Temp+2 jmp LPatLp 12$: mvb Temp+2,R2L sta R2H ; set up a box mvb Temp,R3L sta R4L mvb Temp+1,R3H sta R4H avb #10,R2H avw #10,R4 lda #$ff ; get the pattern jsr FrameRectangle inc R2L inc R2L dec R2H dec R2H ; hope these havn't changed!! avw #2,R3 svw #2,R4 ; lots of bytes lda Temp+3 ; get the current pattern jsr FrameRectangle; and do it real this time avw #15,Temp ; move right avb #3,Temp+3 ; add to pattern..? cbi Temp+3,#249 blt 13$ ldb Temp+3,#$ff 13$: jmp LPatLp s0P0P0 LPatClick: ldb Temp+2,#$2f ; init the top and bottom ldw Temp,#$040 ldb Temp+3,#0 ; init the pattern LPatCLp: cwi Temp,#$ed ; check x bge 11$ ; if gone too far right, CR cbi Temp+2,#$90 ; check y blt 12$ ; if not gone too far, ok rts 11$: ldw Temp,#$040 ; do a semi CR avb #15,Temp+2 jmp LPatCLp 12$: mvb Temp+2,R2L sta R2H ; set up a box mvb Temp,R3L sta R4L mvb Temp+1,R3H sta R4H avb #10,R2H avw #10,R4 jsr IsMseInRegion cmp #$ff ; get the pattern beq 15$ avw #15,Temp ; move right avb #3,Temp+3 ; add to pattern..? cbi Temp+3,#249 blt 13$ ldb Temp+3,#$ff 13$: jmp LPatCLp 15$: jsr InvertRectangle mvb Temp+3,LbxPattern jmp RstrFrmDialog Yx0P0 Iconfirm: ldb DragFlag,#0 ; th0P0 Iconfirm: ldb DragFlag,#0 ; this is necessary ldw A2,#ICTxtA jsr YNBox cbi sysDBData,#3 ; confirm the procedure beq 11$ ldx #0 10$: jsr FError ; do file errors if any lda  FileDrv jsr SetDevice jmp UnScrnMod 11$: lda DAABdrv ; set up the scrap device jsr SetDevice ldw R6,#ICFNA ldb $886e,#$ff jsr FindFile cpx #0 bne 10$ ; if there were errors, exit (for now) ldy #1 lda (R5),y sta R1L ; get initial track/sector info iny lda (R5),y sta R1H ; now get the first photo scrap blk ldw R4,#$8000 jsr GetBlock ldw R5,#0 ; clear this pointer mvw EndOData,A0 avw #5,A0 ; puts first byte on rowbyte 12$: jsr ReadByte cpx #0 beq 13$ ; can we continue? cpx #11 beq 14$ ; was eof reached? bra 10$ ;****arghhh!!! errors on disk!!!! 13$: ldy #0 sta (A0),y ; store byte inw A0 ; increment pointer cwi A0,#DataEndP ; see if end is reached blt 12$ lda  FileDrv ; reset the drive, dammit jsr SetDevice jmp NoMem ; ** this is a bad bad error!!!!! 14$: lda  FileDrv ; reset the drive, dammit jsr SetDevice jmp IconDo ; ** see next page ICTxtA: .byte $18,"Paste photo scrap?",27,0 ICFNA: .byte "Photo Scrap",0 U|0P0 IconDo: mvw A0,A1 ; save this valuable pointer sbw0P0 IconDo: mvw A0,A1 ; save this valuable pointer sbw EndOData,A1 ; get the total bytes, hopefully mvw EndOData,A2 ldy #7 lda (A2),y ; check an over-height first sta Temp+1 ; save for later beq 16$ 15$: ldw A2,#ICTxtB jsr CNCLBox rts 16$: ldy #6 lda (A2),y ldy #7 sta (A2),y ; save the height byte sta R2H ; save height for bitmapup sta Temp ; get the height ldb DragX+3,#0 ; make the y start a word adw DragX+2,Temp ; add them cwi Temp,#200 99$: bge 15$ ; if it's too big.. bye bye! ldy #5 lda (A2),y ; now get width byte ldy #6 sta (A2),y ; save it for later sta R2L ; save width for bitmapup mvw A2,R0 avw #8,R0 ; position the gfx pointer for later mvb DragX+2,R1H ; set the start y for later ldy #5 sta (A2),y ; save the column byte for later lsr DragX+1 ; start division baby ror DragX lsr DragX lsr DragX ; division by eight? mvb DragX,R1L ; save col start for bitmap! ldy #4 sta (A2),y ; save the column byte for later adb R2L,DragX ; and make a nice add cwi rightMargin,#320 bge 17$ ; be nice to VDC cbi DragX,#40 ; now check pic width bge 99$ blt 18$ 17$: cbi DragX,#80 ; check it again for VDC bge 99$ ; now we know its cool!!!! ldb DragFlag,#0 ; it all ends here  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  18$: jsr BitmapUp ; PRAY!!!! ldy #0 lda Tool sta (A2),y ; store the tool, now iny iny ; skip the pattern to bytes lda A1L sta (A2),y ; store total bytes lb iny lda A1H sta (A2),y ; store total bytes hb mvw A0,EndOData ; now save the data! ldb SaveFlag,#1 ; set the save-me flag jmp UserMode ; undo everything ICTxtB: .byte $18,"Bitmap is too large.",0 m0P0 NoMem:  ldw A2,#NMTxt0 jsr CNCLBox rts NMTxt0: .byte $18,"Not enough memory."0P0 NoMem:  ldw A2,#NMTxt0 jsr CNCLBox rts NMTxt0: .byte $18,"Not enough memory.",0  0P0 PattDlg: .byte $00 | 01 ;user position .byte $1f ;top .byte $84 ;bottom .word $038 ;left .word $0c4 ;right .byte 17 .word PattClick .byte 19 ;user icon .word PattDraw .byte 0 ;end of defintion  PattClick: ldb R2L,#$23 ; the pattern area ldb R2H,#$7e ldw R3,#$40 ldw R4,#$bc jsr IsMseInRegion ; did you click in it? cmp #$ff beq 10$ rts ; no, so go back to dialog 10$: ldb Temp+5,#$23 ; Temp+5 is checkable y ldb Temp+9,#$0 ; Temp+9 is pattern number 11$: ldw Temp+3,#$40 ; Temp+3 is checkable x 12$: mvw Temp+3,R3 mvb Temp+5,R2L mvw Temp+3,R4 mvb Temp+5,R2H ; prepare check box avw #25,R4 avb #13,R2H jsr IsMseInRegion ; is it in there? cmp #$ff beq 99$ ; yes, so exit inc Temp+9 ; set next box # mvw R4,Temp+3 ; move to the right cwi R4,#$bc ; moved too far right? blt 12$ ; no, so continue mvb R2H,Temp+5 ; yes, so move down cpb R2H,#$7e ; have we moved too far down? blt 11$ ; no, so continue rts 99$: jsr InvertRectangle mvb Temp+9,sysDBData jmp RstrFrmDialog ; yes, so save where and exit PattDraw: ldw R0,#Patt1Img ldb R1L,#8 ldb R1H,#$23 ldb R2L,#Patt1wid ldb R2H,#Patt1hit jmp BitmapUp m0P0 Patt1Img: `A Patt1wid =picW Patt1hit =picH Hn0P0 Mode1Img: `@ Mod1wid =picW Mod1hit =picH yn0P0 .ramsect =n0P0 Patt1Img: `A Patt1wid =picW Patt1hit =picH Hn0P0 Mode1Img: `@ Mod1wid =picW Mod1hit =picH yn0P0 .ramsect =n@p`0P0 Mode1Img: `@ Mod1wid =picW Mod1hit =picH yn0P0 .ramsect =n@p`  A!   Y0P0 .ramsect =n@p`  A!   Y Y Yuuuu@p`  A!   Y Y Yuuuu`  A!   Y Y Yuuuu    ||f͙f͙f͙f|660ALu`ꪪ UUVffo؀ꪪffoUUY ؀ꪪUUVffo؀ꪪffoUUP؀`ꪪ UUVffo؀ꪪffoUUY ؀ꪪUUVffo؀ꪪffoUUP؀ꪪ UUVffoס؀ꪪffoUUY ww`""]""=ww`""]興wwww`""]""=ww`""]興wwww`""]""=ww`""]興wwUUD"UUH!UUP xUU` @@_߆UU@` ?UU@UUA(UUB$UUD"UUH!UUP xUU` @@_߃""B 4""B 8 ""B 0 *""(""B"ppxPPX""B"""B" ? ""(""B 4""B 8 ""B 0 *""($!!(@1P* 00>8h(($ \\X @$@$ ȂA*  B$!!(@1P* 00>8h(($ \\X 8 U`@@P؂BAAN&&(A1QQR"".>>8*"".>>8 U""-ؠ h(""*bbhP0 8 U`@@P؂BAAN&&(A1QQR"".>>8„UU`„訨PP` "&t S)D D` htPP`(D訨(DUU`'w„訨„PP` @A(for now) ldy #1 lda (R5),y sta R1L ; get initial track/sector info iny lda (R5),y sta R1H ; now get the first photo scrap blk ldw R4,#$8000 jsr GetBlock ldw R5,#0 ; cleS/geoBMode1b)<PRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V&k*QF+[0P ;****************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman  ;* S/geoBMode1b 0P;* ;******************************  .if Pass1  .noeqin .noglbl  .include GEOSequates .eqin .glbl .endif + 0 jmp Mod1Click ; VPRGbase + 3 jmp Mod1Recv ; VPRGbase + 6 jmp Mod1Drag ; VPRGbase + 9 jmp Mod1Press ; VPRGbase + 12 jmp ReMain1 ; VPRGbase 0P0  .psect  Mod1Press: lda SelMove beq 10$ ; have we selected anything? jsr GetNextChar cmp #0 bne 11$ 10$: rts ; nothing done! 11$: cmp #$1d ; this is backspace? bne 10$ ; only care about this one mvb SelItem,R15L ; for destination = R14 sta R14L ; for start=R15 mvb SelItem+1,R15H sta R14H ldy #2 ; get the bytes long lda (R14),y sta Temp+14 ; width for EndOData iny lda (R14),y sta Temp+15 ; width for EndOData adw Temp+14,R14 ; now have start move jsr ClrSelect ; and now clear out the selection ldw A2,#PTxt0 jsr YNBox cbi sysDBData,#3 ; confirm the procedure beq 12$ jmp UnScrnMod ; cancelled, so clear full screen 12$: ldy #0 ; start the copy 13$: cwi R14,#DataEndP beq 14$ lda (R14),y sta (R15),y ; shuffle the data left inw R14 inw R15 bra 13$ 14$: sbw Temp+14,EndOData ; get the new endodata jsr  ClrBuf2End ; Zero out the new end ldb SaveFlag,#1 ; deleting is a savable offence jmp ReMain1 ; and redraw the whole damn screen PTxt0: .byte $18,"Delete this item?",27,0 elete this item?",27,0 0P0 SelClick: lda SelMove beq 12$ ; have we selected anything? ldw A5,#SelResi jsr SelLoad jsr IsMseInRegion ; resiZe box clicked? cmp #$ff bne 10$ jsr ClrSelLines ldb DragFlag,#1 ldb SelTool,#2 ; set for resiZe tool rts 10$: ldw A5,#SelMove jsr SelLoad jsr IsMseInRegion ; mvw box clicked? cmp #$ff bne 11$ jsr ClrSelLines ldb DragFlag,#1 ldb SelTool,#1 ; set for move tool rts 11$: lda SelMove ; is anything selected? beq 12$ ldw A5,#SelBox ; yes, but... jsr SelLoad jsr IsMseInRegion ; was the old box clicked? cmp #$ff bne 18$ lda dblClickCount ; yes, but are we double-clicking? beq 18$ ldb dblClickCount,#0 ; for accounting purposes ldb mouseYPos,#170 jmp PattEdit 18$: ldb dblClickCount,#50 ; reload doubleclick counter jsr ClrSelect ; clear out old selection 12$: jmp SelLook ook ook the new endodata jsr  ClrBuf2End ; Zero out the new end ldb SaveFlag,#1 ; deleting is a savable offence jmp ReMain1 ; and redraw the whole damn screen PTxt00P0 SelLook: cwi EndOData,#DataStart ; anything to find? bgt 13$ ; nope, so exit rts 13$: mvw EndOData,A3 ; start from the end 14$: lda SelMove ; stupid, redundant check! bne 15$ ; already got one, so exit! cwi A3,#DataStart bgt 16$ ; nothing found, damn lda SelMove bne 15$ ; anything selected? yes, so skip nxt jsr UnScrnMod ; unfullscreenmode if necessary 15$: rts 16$: jsr FindLast mvw A1,A3 ; make the last the end ldy #0 lda (A1),y cmp #5 ; lines, linebox, and fbox are easy bge 17$ jsr SelLChk bne 14$ rts 17$: cmp #5 ; text tool bne 18$ jsr SelTChk bne 14$ rts 18$: cmp #8 ; 6 or 7 is bitmap/icon bge 14$ ; invalid tool? jsr SelBChk bne 14$ rts FindLast: ldw A0,#DataStart ; start at beginning ldw A2,#0 ; with no movement, bytes=A2 12$: mvw A0,A1 ; save the last move adw A2,A0 ; skip ahead = A0 ldy #2 lda (A0),y ; get the supposed bytes L & h sta A2L iny lda (A0),y ; get the supposed bytes l & H sta A2H cpw A0,A3 ; have we reached the end yet? blt 12$ ; no, so keep looping rts ; A1 should point to last now +s0P0 SelLChk: ldy #4 10$: lda (A1),y sta Temp,y ; store the easy coords in Temp+4.. iny cpy #10 bne 10$ jsr SelChk ; now check for it mvw A1,SelItem 0P0 SelLChk: ldy #4 10$: lda (A1),y sta Temp,y ; store the easy coords in Temp+4.. iny cpy #10 bne 10$ jsr SelChk ; now check for it mvw A1,SelItem ; save the item selected rts ; success is already in .x v0P0P0 SelBChk: ldy #4 ; time to do the bitmaps!!! lda (A1),y sta Temp+4 ; get the ok ys and the char xs iny lda (A1),y sta Temp+6 ldb Temp+5,#0 sta Temp+8 iny lda (A1),y sta Temp+7 iny lda (A1),y sta Temp+9 ; now time to math the xs asl Temp+4 ; multiply by two rol Temp+5 asl Temp+4 ; multiply by four rol Temp+5 asl Temp+4 ; multiply by eight rol Temp+5 asl Temp+7 ; multiply by two rol Temp+8 asl Temp+7 ; multiply by four rol Temp+8 asl Temp+7 ; multiply by eight rol Temp+8 adb Temp+6,Temp+9 ; have to add top to height adw Temp+4,Temp+7 ; have to add width to left jsr SelChk ; now we can check!!! yea!!! mvw A1,SelItem ; save the item selected rts ; success is already in .x SelTChk: ldy #4 10$: lda (A1),y sta Temp,y ; store the easy coords in Temp+4.. iny cpy #10 bne 10$ jsr SelChk ; now we can check!!! yea!!! mvw A1,SelItem ; save the item selected rts ; success is already in .x x0P0 SelChk: jsr SelMvTmp cp0P0 SelChk: jsr SelMvTmp cpb R2L,R2H ; do they-y need swapping blt 10$ mvb Temp+6,R2H mvb Temp+9,R2L sta Temp+6 mvb R2H,Temp+9 ; fix it permanently 10$: cpw R3,R4 ; do they-x need swapping blt 11$ mvw Temp+7,R3 mvw Temp+4,R4 mvw Temp+7,Temp+4 mvw R4,Temp+7 ; fix it permanently 11$: jsr IsMseInRegion ; now finally check! cmp #$ff beq 12$ ldx #$ff rts ; nope, so return error 12$: jmp SelDo |0P0 SelDo: ; ** see bottom for notes 12$: l0P0 SelDo: ; ** see bottom for notes 12$: ldb dispBufferOn,#ST_WR_FORE ldw A5,#SelBox jsr SelSave ; save the dotted box, please  ldw A5,#OSelBox jsr SelSave ; and again for posterity  lda #%10101010 0P0 jsr FrameRectangle ; make the sel frame please lda #2 jsr SetPattern ; prepare to make two boxes jsr SelMvTmp mvb R2L,R2H avb #5,R2H ; move a little off top cpb R2H,windowBottom ble 13$ ; just make sure y is ok mvb windowBottom,R2H 13$: mvw R3,R4 avw #10,R4 ; move a little off left cpw R4,rightMargin ble 14$ ; just make sure x is ok mvw rightMargin,R4 14$: ldw A5,#SelMove ; good to go jsr SelSave jsr Rectangle ; and make it!!! jsr SelMvTmp ; now for resiZe box mvb R2H,R2L svb #5,R2L ; move a little off top cpb R2L,windowBottom ble 15$ ; just make sure y is ok ldb R2L,#0 15$: mvw R4,R3 svw #10,R3 ; move a little off left cpw R3,rightMargin ble 16$ ; just make sure x is ok ldw R4,#0 16$: ldw A5,#SelResi ; good to go jsr SelSave jsr Rectangle ; and make it!!! ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK ldx #0 ; return success!! rts ;** there is a bug in these routines that makes its return code ;** incorrect. This has caused heartache, and much patching ;** so far. fix it, dammit. j0P0 SelMvTmp: mvb Temp+6,R2L ; setup move box region mvb Temp+9,R2H mvw Temp+4,R3 mvw Temp+7,R4 rts SelSave: ldw A6,#6 ; R2L ldy #0 10$: lda (A6),y sta (A5),y iny cpy #6 blt 10$ rts SelLo0P0 SelMvTmp: mvb Temp+6,R2L ; setup move box region mvb Temp+9,R2H mvw Temp+4,R3 mvw Temp+7,R4 rts SelSave: ldw A6,#6 ; R2L ldy #0 10$: lda (A6),y sta (A5),y iny cpy #6 blt 10$ rts SelLoad: ldw A6,#6 ; R2L ldy #0 10$: lda (A5),y sta (A6),y iny cpy #6 blt 10$ rts ClrSelect: lda SelMove bne 99$ rts ; nothing to do!! 99$: jsr ClrSelLines ldb SelMove,#0 ldw SelItem,#0 ldb DragFlag,#0 ; clear out the drag flag rts ; now all recovered! ClrSelLines: ldw A5,#SelResi jsr SelLoad ; get bottom right from resiZe box mvw R2,Temp mvw R3,Temp+2 mvw R4,Temp+4 ldw A5,#SelMove jsr SelLoad ; get top left from move box cpb R2L,Temp ; make sure we get it all! blt 10$ mvb Temp,R2L 10$: cpb R2H,Temp+1 bge 11$ mvb Temp+1,R2H 11$: cpw R3,Temp+2 blt 12$ mvw Temp+2,R3 12$: cpw R4,Temp+4 bge 13$ mvw Temp+4,R4 13$: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK jmp RecoverRectangle n0P0 DragSel: ; ** needs to do click, and unclick0P0 DragSel: ; ** needs to do click, and unclick, move, and resiZe ldw A5,#SelBox ; set up old dimensions for all ops jsr SelLoad jsr RecoverRectangle ; first undo the old box ldw A5,#SelBox ; restore old position jsr SelLoad cbi DragFlag,#2 bne 10$ jmp SelUnDrag 10$: cbi SelTool,#1 ; are we moving or resiZing? bne 13$ lda Temp+2 ; we are moving... sub R2L add R2H sta R2H mvb Temp+2,R2L mvw Temp,Temp+3 ; the new x, for safe keeping sbw R3,Temp+3 adw Temp+3,R4 cpb R2H,windowBottom bgt 99$ ; check to see if too far down cpw R4,rightMargin ble 11$ 99$: ldw A5,#SelBox ; too far right, so quietly exit jsr SelLoad bra 12$ 11$: mvw Temp,R3 12$: ldw A5,#SelBox jsr SelSave lda #%10101010 jsr FrameRectangle ; ** here is move code rts 13$: cpb Temp+2,SelBox ; can't resiZe past the top ble 12$ cpw Temp,SelBox+2 ble 12$ ; or resiZe past the left mvb Temp+2,R2H mvw Temp,R4 bra 12$ ; ** here is resiZe code SelPut: sta (A0),y iny rts r0P0P0 SelUnDrag: mvw SelItem,A0 ; restore old item pointer ldy #0 lda (A0),y ; get the affected tool cmp #5 blt 10$ ; line, fbox, or lbox? jmp SelRest ; next page for icon/bitmap/text 10$: jsr UnWrBox ; get old box dims into R2-R4   ldw A6,#SelBox ; to compare against new space ldw A7,#OSelBox ldy #0 11$: lda (A6),y ; see if anything changed... sta Temp,y ; saving for funs sake cmp (A7),y bne 13$ iny cpy #6 blt 11$ 12$: ldb SelMove,#0 ldw SelItem,#0 ldb DragFlag,#0 ; clear out the drag flag rts 13$: ldy #0 lda (A0),y ; check what im unselling 1 mo time cmp #1 bne 14$ jsr SelUnLine ; the damn LINE exception beq 14$ jmp SelOut 14$: ldy #4 ; something did, so... lda SelBox+2 jsr SelPut ; write new dimensions lda SelBox+3 jsr SelPut lda SelBox jsr SelPut lda SelBox+4 jsr SelPut lda SelBox+5 jsr SelPut lda SelBox+1 jsr SelPut SelOut: ldb SelMove,#0 ldw SelItem,#0 ldb DragFlag,#0 ; clear out the drag flag ldb SaveFlag,#1 ; you must save jmp ReMain1 ; redo the whole damn screen w0P0 SelRest: ldy #0 lda (A0),y ; get the affected tool cmp #5 beq 20$ ; save the hardest for last (text) cbi SelTool,#1 beq 11$ ; only move is relevant for these... 10$: ldb S0P0 SelRest: ldy #0 lda (A0),y ; get the affected tool cmp #5 beq 20$ ; save the hardest for last (text) cbi SelTool,#1 beq 11$ ; only move is relevant for these... 10$: ldb SelMove,#0 ldw SelItem,#0 ldb DragFlag,#0 ; clear out the drag flag rts 11$: lsr SelBox+3 ; start division baby ror SelBox+2 lsr SelBox+2 lsr SelBox+2 ; division by eight? ldy #5 ; have we moved up or down? lda (A0),y cmp SelBox bne 12$ ; yes, so go ahead dey lda (A0),y ; no up/down, so check r/l cmp SelBox+2 beq 10$ ; no movement, so exit 12$: ldy #4 lda SelBox+2 jsr SelPut lda SelBox ; reposition the bitmap jsr SelPut jmp SelOut ; starting text below 20$: cbi SelTool,#2 ; no resiZing of text, moves are ok beq 21$ ldy #4 jsr UnWrapGet ; get startx, then y sta R3L jsr UnWrapGet sta R3H jsr UnWrapGet sta R2L cpb R2L,SelBox ; check for y move bne 22$ cpw R3,SelBox+2 ; now confirm a x move bne 22$ 21$: ldb SelMove,#0 ; no move, so quiet exit ldw SelItem,#0 ldb DragFlag,#0 ; clear out the drag flag rts 22$: ldy #4 ; something did, so... lda SelBox+2 jsr SelPut ; write new dimensions lda SelBox+3 jsr SelPut lda SelBox jsr SelPut lda SelBox+4 jsr SelPut lda SelBox+5 jsr SelPut lda SelBox+1 jsr SelPut jmp SelOut |0P0 SelUnLine: cbi SelTool,#1 ; if we are moving, its easy! bne 50$ ; resiZe is harder jsr UnWrBox ; get old dimensions into R2-R4 cpb R2L,R2H php mvb SelBox,R2L mvb SelBox+1,R2H plp bge 10$ mvb SelBox+1,R2L 0P0 SelUnLine: cbi SelTool,#1 ; if we are moving, its easy! bne 50$ ; resiZe is harder jsr UnWrBox ; get old dimensions into R2-R4 cpb R2L,R2H php mvb SelBox,R2L mvb SelBox+1,R2H plp bge 10$ mvb SelBox+1,R2L mvb SelBox,R2H 10$: cpw R3,R4 php mvw SelBox+2,R3 mvw SelBox+4,R4 plp bge 11$ mvw SelBox+4,R3 mvw SelBox+2,R4 11$: ldw A5,#SelBox ; fake like its the new box jsr SelSave lda #0 rts ; let normal routines do the rest! 50$: mvw A0,R1 ; now find the low point mvw A0,R0 avw #4,R1 ; assume its the first y avw #7,R0 ldy #9 ; so... lda (A0),y ; grab the second y ldy #2 cmp (R1),y ; compare to the first blt 51$ ; if i was right, don't swap mvw R1,R0 avw #3,R1 ; i was wrong.. 51$: lda SelBox+1 ldy #2 sta (R1),y ; apply the new bottom ldy #1 ; now see if bottom is right lda (R1),y cmp (R0),y bne 52$ dey lda (R1),y cmp (R0),y 52$: blt 53$ ldy #0 lda SelBox+4 ; bottom is to right, so okee dokee sta (R1),y iny lda SelBox+5 sta (R1),y ; the easy parts are done ldx #1 rts 53$: ldy #0 lda SelBox+4 ; bottom is left, so resiZe the right sta (R0),y iny lda SelBox+5 sta (R0),y ; this wont look TOOO bad. ldx #1 rts ; all done! od to go UUUUUUUUUUUUUUUUUUUUUUUU0P0 PattEdit: cpw SelItem,#0 ; this routine does edit on selected bne 10$ rts ; meaningless if nothing selected 10$: mvw SelItem,A0 ldy #0 lda (A0),y  cmp #3 ; is it a linebox? bne 11$ ldw R0,#LPatDlg jsr DoDlgBox lda LbxPattern ; new lined pattern bra 99$ rts 11$: cmp #4 ; is it a filled box? bne 13$ ldw R0,#PattDlg jsr DoDlgBox cbi sysDBData,#32 ; illegal pattern selection bge 12$ lda sysDBData ; new fill pattern sta FilPattern bra 99$ 12$: rts 13$: cmp #5 ; is it some text? bne 14$ ldw R0,#TPatDlg jsr DoDlgBox cbi sysDBData,#2 beq 12$ ; cancel is bad lda Temp+19 sta TxtPattern ; new text pattern jsr UnWrBox ; get R2-R4 -- for what its worth jsr UnWrTxt ; re-unwrap the text ldy #7 lda R11L sta (A0),y ; re-adjust the right border iny lda R11H sta (A0),y ; and get the msb lda TxtPattern bra 99$ 14$: ldw A2,#NoPaText ; nothing valid, so don't do jsr CNCLBox jmp ReTool 99$: ldy #1 ; new pattern, so redraw it ALL!!! sta (A0),y ; save it ldb SaveFlag,#$01 ; make the file dirty jmp ReMain1 ; and redraw the screen, pleasethe right sta (R0),y iny lda SelBox+5 sta (R0),y ; this wont look TOOO bad. ldx #1 rts ; all done! lda SelBox+5 jsr SelPut lda SelBox+1 jsr SelPut jmp SeS/geoBMode2)PRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V&C5)`U]C'..DZZ0P ;****************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman  ;* S/geoBMode2 0P;* ;******************************  .if Pass1  .noeqin .noglbl  .include GEOSequates .eqin .glbl .endif  .psect jmp Main2 ; VPRGbase + 0 jmp Mod2Click ; VPRGbase + 3 jmp Mod2Recv ; VPRGbase + 6 jmp Mod2Drag ; VPRGbase + 9 jmp Mod2Press ; VPRGbase + 12 jmp ReMain2 ; VPRGbase + 15 .word DelDone .word SelPapy RenWkFile ; VPRGbase + 21 jmp DlgBox ; VPRGbase + 24 in ramsect S/geoBExport.rel S/geoBExporS.rel S/geoBExporM.rel S/geoBExporD.rel MODgeoWx.rel .mod 4 .psect VPRGbase ; end of main rams0P0 Main2: ldw SelItem,#0 ; pointer to selected node ldw NextHere,#0 ; pointer to add point ldb SelLevel,#20 ; menu level naught is default ldb SelBox,#0 ; selbox > 0 means drag is on ldb DragFlag,#0 ; everyone must use it ReMain2: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK jsr $c1a8 ; i_GraphicsString -to clear screen .byte $05,$00 ; NEWPATTERN is blank .byte $01,$00,$00,$00 ; MOVEPENTO top left .byte $03,$3f,$01,$c8 ; RECTANGLETO whole screen .byte $00 ; end of clrscn table jsr $c1ab ; i_BitmapUp .word EdtCon .byte $01,$3d,$06,$10  ldb R2L,#$3d ; click in edit box? ldb R2H,#$4d ldw R3,#$0008 ; set the edit box as a click ldw R4,#$0038 jsr i_WSetClick .word 0 ; no routine .byte 1 ; 1 is now the edit box  jsr $c1ab ; i_BitmapUp .word DelCon .byte $01,$1e,$06,$10  ldb R2L,#$1e ; click in delete box? ldb R2H,#$2e ldw R3,#$0008 ; set the delete box as a click ldw R4,#$0038 jsr i_WSetClick .word 0 ; no routine .byte 3 ; 3 is now the delete box  lda MenuMode ; has menu been initialiZed? bne 10$ inc MenuMode ; no, so initialiZe it ldw R0,#MyMenu lda #0 jsr DoMenu ; set up the pull-down windows bra 11$ ; and skip a redo 10$: jsr ReDoMenu 11$: mvb mouseOn,MenuSave ; save menu checking jsr DrawTop ; unwrapping is easy... rts CanChk: ldw Temp,#DataEndP sbw EndOData,Temp cwi Temp,#30 blt 10$ ldx #0 rts 10$: ldw A2,#CanTxt jsr CNCLBox ldx #$ff rts CanTxt: .byte $18,"Not enough memory.",0 p0P0 0P0 DrawTop : ; ** this is easy.. just one level, please, from SelItem  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK jsr FstItem ; start from the top 11$: cpw A0,EndOData beq 13$ ldy #0 lda (A0),y ; grab the code, please beq 13$ ; a Zero is universal end cmp #21 ; now compare it to our look4 beq 14$ ; either we find one blt 13$ ; or the end end (look4 > x > 20) 12$: jsr NxtItem ; always returns a menu coder bra 11$ 13$: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK jsr PutAPlus rts 14$: sec jsr DrMenuItm bra 12$ s0P0 DrMenuItm: php ; send clc for no clear mvw A0,SaveReg ; save the item pointer mvw rightMargin,SaveMgn ; save the screen margin ldb dispBufferOn,#ST_WR_FORE | ST_WR0P0 DrMenuItm: php ; send clc for no clear mvw A0,SaveReg ; save the item pointer mvw rightMargin,SaveMgn ; save the screen margin ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK plp bcc 10$ lda #0 jsr SetPattern ; clear out the pattern jsr LoadR2 jsr Rectangle ; blank it 10$: jsr LoadR2 lda #$ff jsr FrameRectangle ; and draw the box ; dotted lines are tough.... jsr LoadR2 ; get them again for text mvw R3,R11 ; assume left is perfect avw #4,R11 ; but we know its not mvw R4,rightMargin ; and limit the text by our box lda R2H ; get the y pos sec sbc #5 sta R1H ; and pull back a bit mvw A0,R0 ; get string pointer avw #10,R0 ; by adding 10 to item pointer jsr PutString ; now pray mvw SaveMgn,rightMargin ; restore screen margin mvw SaveReg,A0 rts z0P0 TreeVers: ; send A0 = selected item, go back up tree for parents ; put all parent pointers on the stack jsr PrepS ; prepare the stack cwi A0,#0 bne 10$ ; if nothing selected d0P0 TreeVers: ; send A0 = selected item, go back up tree for parents ; put all parent pointers on the stack jsr PrepS ; prepare the stack cwi A0,#0 bne 10$ ; if nothing selected do top level lda #21 sta Find4Me jsr FindMyPapy ; this returns DataStart beq 13$ ; and without errors, we go on! 99$: rts 10$: ldy #0 ; get its sellevel code lda (A0),y sta Find4Me ; get the level examining inc Find4Me ; look for kids, if any bra 13$ 11$: ldy #0 ; get its sellevel code lda (A0),y sta Find4Me ; get the level examining 12$: lda Find4Me jsr FindMyPapy ; get my papypointer beq 13$ rts ; none left, so exit! 13$: mvw A0,Temp+8 ; save this for next papysearch cpw A0,EndOData beq 17$ ; if at the end, next papy cbi Find4Me,#21 beq 14$ ; top level gets no skip priv jsr NxtItem 14$: cpw A0,EndOData beq 17$ ; if at the end, next papy ldy #0 lda (A0),y ; get the code cmp Find4Me ; if its one of me, save it blt 17$ bne 16$ 15$: mvw A0,A5 ; found one, so push jsr PushS 16$: jsr NxtItem ; and keep looking for these bra 14$ 17$: cbi Find4Me,#21 ; top level is special case bgt 18$ ; when it comes up, just stop rts 18$: mvw Temp+8,A0 ; time for next papy bra 11$ FindMyPapy: sta Temp+7 ; comes in with A0 and .a=my cod cmp #20 beq 12$ ; if already at top, return error dec Temp+7 ; otherwise, set for papys code cmp #21 ; non-level is a special case bne 11$ ; but its ok -- read top level jsr FstItem ldx #0 ; but has set values rts 11$: cwi A0,#DataStart bgt 13$ 12$: ldx #$ff ; bne is an error rts ; the top is the end of life itself 13$: jsr PrvItem ; going back one menu code ldy #0 lda (A0),y ; check this code cmp Temp+7 ; keep looking till its found bne 11$ rts |0P0 M0P0 Mod2Click: cbi mouseData,#0 ; is the button down or up? beq 11$ lda SelBox beq 10$ ; releasing on a drag is only jmp PlusUnDg ; button up on a drag release 10$: rts 11$: mvb mouseYPos,ChkPlace mvw mouseXPos,ChkPlace+1 jsr PlusChk ; click in the plus thing? bne 10$ ; eq means no, or continue cwi SelItem,#0 beq 13$ jsr i_ChkClick ; check for the click .byte 3 ; see if our delete button is clicked cpx #0 ; was it inside? bne 12$ jsr InvertRectangle jmp  DelSelItem 12$: jsr i_ChkClick ; check for the click .byte 1 ; see if our edit box is clicked cpx #0 ; was it inside? bne 13$ jsr InvertRectangle ldb dblClickCount,#0 ; for accounting purposes jmp EditBox ; get text for selected item 13$: mvw SelItem,A0 ; sel A0 = Selected Item jsr TreeVers ; and find all clickable squares 14$: cbi StackX,#0 ; see if anythings on the stack beq 16$ jsr PullS ; there is, so pull a pointer mvw A5,A0 ; save this for selecting jsr LoadR2 jsr IsMseInRegion cmp #$00 beq 14$ ; nope! cpw A0,SelItem bne 18$ ; are we reselecting? lda dblClickCount ; yes, but are we double-clicking? beq 18$ jmp EditBox 18$: ldb dblClickCount,#50 ; reload the doubleclickcounter jsr SelThisI ; found, so select and exit! jsr PutAPlus ; put the new plus box 15$: rts 16$: cwi SelItem,#0 beq 17$ jsr USelThis ; unselect the old thing jsr ClrBottom ; clear out open windows jsr PutAPlus ; put the top level plus box 17$: rts ; but has set values rts 11$: cwi A0,#DataStart bgt 0P0 Mod1AChk: ldw A0,#SelItem ; now look in open boxes... ldy #0 lda (A0),y sta LastB4 ; look only for this, thanks. 51$: cwi A0,#DataStart ; stop at the beginning ble 60$ ; if at the end, leave ldy #0 lda (A0),y cmp LastB4 beq 56$ clc adc #1 cmp LastB4 ; is this found one, one below? bne 55$ ; no, so keep looking cmp #20 ble 55$ ; a 20 means we look too long.. sta LastB4 ; put this in the srch code place bra 56$ ; and look at it... 55$: jsr PrvItem ; not a level one, so back up.. bra 51$ 56$: jsr LoadR2 jsr IsMseInRegion cmp #$00 beq 55$ ; nope! jsr SelThisI ; found, so select and exit! lda #0 beq 61$ ; eq means selected, so exit 60$: lda #$ff 61$: rts Kp0P0 PlusChk: jsr 0P0 PlusChk: jsr i_ChkClick ; free hZ, free vt, add vt .byte 2 ; see if our plus is clicked cpx #0 ; was it inside? beq 10$ ldx #0 ; eq means continue 99$: rts 10$: jsr CanChk ; check memory, or exit bne 99$ mvw rightMargin,WorkTxt+96 ; make a right margin svw #20,WorkTxt+96 mvb windowBottom,WorkTxt+94 ; make a bottom margin svb #10,WorkTxt+94 cpw R4,WorkTxt+96 ; is the box too far right? bge 99$ ; if so, then ignore the click cpb R2H,WorkTxt+94 ; is the box too low? bge 99$ ; if so, then ignore the click cwi SelItem,#0 ; now see if drag is warranted beq 13$ ; if at top level, it is mvw SelItem,A0 ldy #0 lda (A0),y ; get selected item's code tax 11$: jsr NxtItem ; get pointer to next cpw A0,EndOData ; always returns a menu coder beq 13$ ldy #0 ; get next item's code txa ; and compare ours to it cmp (A0),y ; if same as me, or above me bge 13$ ; go ahead and drag. ldw A5,#SelBox jsr SvDims ; save Plus-Box dimensions jsr PlusUnDg ; now make an equi-siZe box ldx #$ff ; non-eq means we're done! rts 13$: jsr PlusClicked ldx #$ff ; exit from click checking now rts s0P0 PlusClicked:  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  lda #0 jsr SetPattern ; s0P0 PlusClicked:  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  lda #0 jsr SetPattern ; set a clear pattern jsr i_ChkClick .byte 2 ; restore the dimensions jsr Rectangle ; clear the old plus box out ldy #0 mvw PlusBox,SelBox ; hor. siZe never an option mvw PlusBox+2,SelBox+2 ; x start never an option lda PlusType cmp #$40 ; HORZONTAL bne 50$ ; handle the horiZontals first mvw ChkPlace+1,SelBox+4 ldw A5,#SelBox jsr LdDims bra 79$ 50$: mvw ChkPlace+1,SelBox+4 ldw A5,#SelBox jsr LdDims 79$: ldb dispBufferOn,#ST_WR_FORE lda #%10101010 sta DragFlag ; since we are starting a drag jsr FrameRectangle ; draw the durn thing ldx #$ff ; exit from click checking now rts yw0P0 PlusUnDg0P0 PlusUnDg: ldw A5,#SelBox jsr LdDims ; get the dimensions mvw R4,Temp sbw R3,Temp ; if box too small cwi Temp,#15 bgt 10$  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  jsr PutAPlus ; just abort... ldb SelBox,#0 ; clear out sel mode box sta DragFlag rts 10$: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK lda #0 jsr SetPattern ; set a clear pattern jsr Rectangle ; fill in with Zeroes cwi NextHere,#0 beq 99$ mvw NextHere,A0 lda #11 ; 4+3+3+1 (Zero term) jsr GimiRoom mvw NextHere,A0 ldb WorkTxt,#0 ; make a null, please lda SelLevel clc adc #1 ; undrag always adds sellevel+1 jsr MenuMake ; now we have an entry mvw NextHere,A0 sec jsr DrMenuItm ldy #0 lda (A0),y ; is new item first level? cmp #21 ; if not, don't select it. bne 98$ jsr SelThisI ; now do an official select 98$: ldb dispBufferOn,#ST_WR_FORE jsr PutAPlus ; this is the right time, believe me 99$: ldb SelBox,#0 ; clear out sel mode box sta DragFlag ldy #0 lda (A0),y ; is new item first level? cmp #21 ; if not, don't select it. beq PlusUnTop rts PlusUnTop: jmp GetText fy0P0 GimiRoom: sta RoomTmp ; store bytes forward ldb RoomTmp+1,#0 ; ***************** cpw A0,EndOData ; ** should check mem rem0P0 GimiRoom: sta RoomTmp ; store bytes forward ldb RoomTmp+1,#0 ; ***************** cpw A0,EndOData ; ** should check mem remain!! bge 99$ ; if the end, no worries mvw A0,R1 adw RoomTmp,R1 ; find the destination mvw A0,R0 ; and the start mvw EndOData,R2 sbw A0,R2 ; number of bytes to move inw R2 ; just to get the Zero jsr MoveData ; now we got room! 99$: adw RoomTmp,EndOData ldb SaveFlag,#1 ; set the dirty flag ldx #0 ; return no error! rts d|0P0P0 MenuMake: sta Temp+7 ; save for later ldy #0 jsr MkPut ; stored the code 11$: lda # $00 ; MENU_ACTION 0P0 jsr MkPut ldw RoomTmp,#0 ; start siZe calc ldx #$ff 12$: inx lda WorkTxt,x ; find # bytes in the text bne 12$ inx stx RoomTmp ; and use it to calc siZe avw #10,RoomTmp ; 10 is the constant lda RoomTmp jsr MkPut ; got siZe lb lda RoomTmp+1 jsr MkPut ; got siZe hb ldw A5,#SelBox mvw A0,A6 avw #4,A6 ; point to box dest point jsr TabLd ldx #$ff ldy #10 ; point to text destination 13$: inx lda WorkTxt,x ; keep putting text in jsr MkPut cmp #0 bne 13$ ; keep going till null reached cbi SelLevel,#21 ; now make the type CORRECT blt 14$ ; if top level, don't bother.... lda Temp+7 ; otherwise, adjust parent jsr FindMyPapy ; get our parent bne 14$ ; and error means bye bye ldy #1 lda # $80 ; VERTICAL sta (A0),y ; and make it a menu, I said. 14$: rts MkPut: sta (A0),y iny rts j0P00P0 SelThisI: jsr USelThis 10$: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK mvw A0,SelItem ldy #0 ; get the code lda (A0),y sta SelLevel ; now were cookin cmp #21 bne 11$ ; top level is special case ldw SelPapy,#0 beq 12$ ; so just clear my papy 11$: jsr FindMyPapy php  mvw A0,SelPapy ; save my papy 0P0 plp beq 12$ jmp USelThis ; some sort of error, so crash! 12$: mvw SelItem,A0 ; restore selectable lda SelLevel jsr TreeVers ; now get redisplayables 14$: cbi StackX,#0 ; see if anythings on the stack beq 16$ jsr PullS ; there is, so pull a pointer ldy #0 ; before drawing, check it out lda (A5),y ; get its code cmp #21 ; if a top level, don't bother. beq 14$ ; because its not necessary mvw A5,A0 ; save this for selecting sec jsr DrMenuItm ; draw this item  bra 14$  16$: cbi SelLevel,#21 bne 17$ mvw SelItem,A0 sec jsr DrMenuItm ; just in case 17$: mvw SelItem,A0 jsr LoadR2 jsr InvertRectangle ; invert the puppy rts m0P0 USelThis: mvw A0,SaveReg+4 ; save the soon selected  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  cwi SelItem,#0 ; don't unselect the nonexistant bne 10$ lda #0 jsr SetPattern ; but there's still the plus0P0 USelThis: mvw A0,SaveReg+4 ; save the soon selected  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  cwi SelItem,#0 ; don't unselect the nonexistant bne 10$ lda #0 jsr SetPattern ; but there's still the plus jsr i_ChkClick .byte 2 ; get the old plus' box inw R3 ; don't get the left, please jsr Rectangle rts 10$: cbi SelLevel,#21 ; only top levels are manual bgt 11$ mvw SelItem,A0 ; now do a real unselect jsr LoadR2 jsr InvertRectangle ; uninvert the puppy 11$: jsr ClrBottom ; just empty the place ldw SelItem,#0 ; those happy pointers.. ldb SelLevel,#20 ; back to basics mvw SaveReg+4,A0 ; restore the soon selected rts o0P0 ClrBottom: ; ** this clears the whole bottom, and th0P0 ClrBottom: ; ** this clears the whole bottom, and the sel-flags ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK lda #0 jsr SetPattern ; clear the bottom area  ldb R2L,#DEFMBOT+1 ldb R2H,#$c7 ; this is the top level ldw R3,#DEFMLFT+16  mvw rightMargin,R4 jsr Rectangle rts ClrTop: ldw R3,#DEFMLFT+16 ClrTop2: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  lda #0 jsr SetPattern ; prepare to clear the rest ldb R2L,#DEFMTOP ldb R2H,#DEFMBOT ; this is the top level mvw rightMargin,R4 ; clear ALL of it jmp Rectangle ; clear and then... 3u0P0 EditBox: jsr CanChk ; check memory, or exit bne 99$ 0P0 cpw SelItem,#0 ; was anything selected? bne 10P0 EditBox: jsr CanChk ; check memory, or exit bne 99$ cpw SelItem,#0 ; was anything selected? bne 10$ 99$: jsr i_ChkClick .byte 1 jmp InvertRectangle ; nothing to do 10$: mvw SelItem,A0 ; grab ye old selected ldy #0 lda (A0),y cmp #21 ; is it a HORIZONTAL item? beq 12$ 11$: jmp EditOut ; no, so just do normal 12$: mvw SelItem,SaveReg+6; probably a bad idea jsr USelThis ; this should clear bottom & topiZe jsr FindMeLast ; this should get last top one mvw A0,A1 ; save the last one mvw SaveReg+6,A0 ; restore the selected one jsr SelThisI ; reselect this one mvw A1,A0 cwi A0,#0 beq 11$ jsr LoadR2 ; get last dimensions mvw rightMargin,AdjAmt svw #20,AdjAmt cpw R4,AdjAmt bgt 11$ ; no room, so use whatcha have sbw R4,AdjAmt ; now have difference cwi AdjAmt,#50 ; arbitrary siZe *** blt 14$ ; its smaller, so use less ldw AdjAmt,#50 ; arbitrary siZe **** 14$: Edit2: jsr ClrTop ; clear the top bar ldb AdjTyp,#1 ; set for right moving ldb AdjCod,#21 mvw SelItem,A0 jsr LoadR2 ; get this ones dimensions adw AdjAmt,R4 jsr SaveR2 mvw SelItem,A0 jsr MyBrother ; get my brother bne 15$ jsr CelAdjust ; move all other cells please 15$: jsr DrawTop ; and unwrap all top levels EditOut: lda dblClickCount ; was this a doubleclicker? bne 10$  jsr i_ChkClick 0P0 .byte 1 jsr InvertRectangle ; nothing to do 10$: jmp GetText etText ext put the top level plus box 17$: rts ; but has set values rts 11$: cwi A0,#DataStart bgt 0P0 GetText: cpw SelItem,#0 bne 10$ rts ; nothing to do 10$: mvw SelItem,A0 ; grab ye old selected ldy #9 11$: iny ; put the text in WorkText lda (A0),y sta WorkTxt-10,y bne 11$  jsr MouseOff ; turn off mouseability sec jsr DrMenuItm  12$: ldy #9 lda (A0),y ; get the bottom 'y' sta R1H ; and store it for GetString svb #11,R1H ; pull up a bit ldy #4 lda (A0),y ; get the start 'x' sta R11L iny lda (A0),y sta R11H avw #4,R11 ; move right a bit mvw rightMargin,SaveMgn ; save our rightMargin ldy #7 lda (A0),y ; get the right 'x' sta rightMargin iny lda (A0),y sta rightMargin+1 ; and save it svw #5,rightMargin ; and move it left a bit ldb R1L,#0 ; no right margin routine ldw R0,#WorkTxt ldb R2L,#99 ; that should be more than enough ldw keyVector,#CapDone jmp GetString ; good luck! |0P0 CapDone: cwi SelItem,#0 ; was anything selected? bne 10$ rts 10$: jsr MouseUp ; restore mouse mode mvw SaveMgn,rightMargin ;0P0 CapDone: cwi SelItem,#0 ; was anything selected? bne 10$ rts 10$: jsr MouseUp ; restore mouse mode mvw SaveMgn,rightMargin ; restore our rightMargin mvw SelItem,A0 ldy #2 lda (A0),y ; get the actual length o item sta Temp+7 iny lda (A0),y sta Temp+8 ldx #$ff ; see how long the caption is 11$: inx lda WorkTxt,x ; and include the 0 bne 11$ inx ; add one for the Zero stx RoomTmp ldb RoomTmp+1,#0 ; get the total length of the new avw #10,RoomTmp ; now its comparible ldy #2 lda RoomTmp sta (A0),y ; save the new length iny lda RoomTmp+1 sta (A0),y cpw RoomTmp,Temp+7 beq 50$ blt 12$ ; the new must be greater adw Temp+7,A0 ; now points to next sbw Temp+7,RoomTmp ; now have the difference! lda RoomTmp jsr GimiRoom ; now have expanded bytes bra 50$ 12$: jsr CapBack ; the new one is smaller... 50$: mvw SelItem,A0 avw #10,A0 ldy #$ff 51$: iny ; finally move the text over lda WorkTxt,y sta (A0),y bne 51$ ; keep going until null mvw SelItem,A0 sec jsr DrMenuItm ; redraw the damn thing jsr EdAdjust ; check for top level chills,SelItem ldb SaveFlag,#1 ; every CR is a dirty one mvw SelItem,A0 ; restore main pointer jsr SelThisI ; and reselect it please jmp PutAPlus ; to get new NextHere h0P0 CapBack: mvw A0,A1 ; copy pointer over adw Temp+7,A0 ; get the source address adw RoomTmp,A1 ; get the dest address ldy #0 13$: cpw A0,EndOData ; the back-copy loop beq 14$ ldy #0 lda (A0),y ; copy back the data sta (A1),y inw A0 inw A1 bra 13$ 14$: ldy #0 ; dont forget the last byte lda (A0),y sta (A1),y mvw A1,EndOData ; make the new EndOData jsr ClrBuf2End ; fill the rest with Zeroes rts l0P0 EdAdjust: mvw SelItem,A0 ; check 0P0 EdAdjust: mvw SelItem,A0 ; check for top level shifts ldy #0 lda (A0),y cmp #21 ; only the top level needs it beq 10$ rts 10$: avw #4,R11 ; line up the right edge mvw R11,Temp ; save this please jsr ClrBottom ; do a pseudo close jsr LoadR2 ; get dimensions into R2-R4 jsr ClrTop2 ; now clear from here right mvw SelItem,A0 ; check for top level shifts jsr LoadR2 ; re-get dimensions into R2-R4 mvw Temp,R11 ; restore R11 for boundry compare ldb AdjCod,#21 ; get this ready for the adjust cpw R11,R4 bge 11$ ldb AdjTyp,#0 ; set a leftward movement svw sbw R11,R4 ; subtract new from the old mvw R4,AdjAmt ; amount to subtract the rest bra 12$ 11$: ldb AdjTyp,#1 ; set a rightward movement adw sbw R4,R11 mvw R11,AdjAmt ; amount to add to rest 12$: mvw Temp,R4 ; the first one is now done. jsr SaveR2 jsr MyBrother ; get my brother beq 13$ mvw SelItem,A0 ; no brothers, so just exit jsr DrMenuItm rts ; bye! 13$: jsr CelAdjust ; move all other cells please jsr DrawTop ; and unwrap all top levels rts ; and exit please m0P0 LdDims: ldw A6,#6 ; 6 byte data move to R2L ldy #0 10$: lda (A5),y sta (A6),y iny cpy #6 blt 10$ rts SvDims: ldw A6,#6 ; 6 byte data move from R2L 0P0 LdDims: ldw A6,#6 ; 6 byte data move to R2L ldy #0 10$: lda (A5),y sta (A6),y iny cpy #6 blt 10$ rts SvDims: ldw A6,#6 ; 6 byte data move from R2L ldy #0 10$: lda (A6),y sta (A5),y iny cpy #6 blt 10$ rts r0P0 LoadR2: mvw A0,A5 avw #4,A5 ; get table pointer ldw A6,#6 ; destination is R2... jmp TabSv ; now convert over SaveR2: ldw A5,#6 mvw A0,A6 avw #4,A6 jmp TabLd  TabPut: sta (A6),y ; support for TabSv iny rts TabSv: ldy #0 ; 6 byte conv from tabA5->geoA6 10$: lda (A5),y sta TableTmp,y iny cpy #6 blt 10$ ldy #0 lda TableTmp+2 ; get the start y jsr TabPut lda TableTmp+5 ; get the end y jsr TabPut lda TableTmp+0 ; get the start x lb jsr TabPut lda TableTmp+1 ; get the start x hb jsr TabPut lda TableTmp+3 ; get the end x lb jsr TabPut lda TableTmp+4 ; get the end x hb jsr TabPut rts ; all done, easy as pie TabGet: lda (A5),y ; support for TabLd iny rts TabLd: ldy #0 ; 6 byte conv from geoA5->tabA6 jsr TabGet sta TableTmp+2 ; get the start y jsr TabGet sta TableTmp+5 ; get the end y jsr TabGet sta TableTmp+0 ; get the start x lb jsr TabGet sta TableTmp+1 ; get the start x hb jsr TabGet sta TableTmp+3 ; get the end x lb jsr TabGet sta TableTmp+4 ; get the end x hb ldy #0 ; UnTableTmpiZe the data block 10$: lda TableTmp,y sta (A6),y iny cpy #6 blt 10$ rts ; all done, easy as pie \u0P0 Mod2Recv: jsr RecoverRectangle rts Mod2Drag: lda SelBox bn0P0 Mod2Recv: jsr RecoverRectangle rts Mod2Drag: lda SelBox bne 11$ 10$: rts 11$: mvb mouseYPos,ChkPlace mvw mouseXPos,ChkPlace+1 ; save the x pos mvw rightMargin,WorkTxt+96 svw #20,WorkTxt+96 ; get a working right margin cpb ChkPlace,SelBox blt 10$ ; no higher than allowed cpb ChkPlace,SelBox+1; no lower than allowed bgt 10$ cpw ChkPlace+1,SelBox+2 blt 10$ ; no more left than allowed cpw ChkPlace+1,WorkTxt+96 bgt 10$ ; no righter than allowed ldw A5,#SelBox jsr LdDims jsr RecoverRectangle ; make old box disappear! mvw ChkPlace+1,SelBox+4 ldw A5,#SelBox jsr LdDims ldb dispBufferOn,#ST_WR_FORE lda #%10101010 jsr FrameRectangle ; draw the durn thing rts $w0P0 Mod2Press: lda0P0 Mod2Press: lda keyVector bne 10$ ; only do this if input is OFF!! cwi SelItem,#0 beq 10$ ; have we selected anything? jsr GetNextChar cmp #0 bne 11$ 10$: rts ; nothing done! 11$: cmp #$1d ; this is backspace? bne 10$ ; only care about this one  jsr i_ChkClick ; nope, nothing to do .byte 3 jsr InvertRectangle ; invert the delete button  jsr DelSelItem 0P0 rts ; exit anyways.. z0P0 PutAPlus: ldw FounDim0P0 PutAPlus: ldw FounDims,#DEFMLFT ldw FounDims+3,#DEFMRIT ; default for only plus ldb FounDims+2,#DEFMTOP ; only need the right ldb FounDims+5,#DEFMBOT jsr FindMeLast ; find the subitems of selected 10$: cwi A0,#0 ; see what FindMeLast found beq 13$ ldy #4 ; now get dimensions of last 12$: lda (A0),y sta FounDims-4,y ; get the found box dims iny cpy #10 blt 12$ 13$: cbi PlusType,# $80 ; VERTICAL 0P0 bne 15$ ; skip the verticals for now mvw FounDims,R3 ; VERTICAL = ! mvw FounDims+3,R4 ; keep the same x coords mvb FounDims+5,R2L ; bottom becomes top cmp #DEFMBOT bne 14$ inc R2L 14$: mvb R2L,R2H avb #14,R2H ; and the standard y move bra 20$ 15$: mvb FounDims+2,R2L ; HZONTAL keep the same y coords mvb FounDims+5,R2H ; HORIZONTAL = ---- mvw FounDims+3,R3 ; right becomes left mvw R3,R4 avw #16,R4 ; and a little more to the right 20$: jmp PutAClk |0P0 FindMeLast: ; * SelItem should point to starti0P0 FindMeLast: ; * SelItem should point to starting place ldb PlusType,# $40 ; HORZONTAL mvw SelItem,A0 ; set work pointer as selitem mvw SelItem,Temp ; default found to the selected item cwi SelItem,#0 ; see if anythings selected bne 10$ ; if not, top level case... jsr FstItem ; start from the top of buffer ldb Find4Me,#21 ; default for top level bra 12$ ; start a top level search 10$: ldy #0 lda (A0),y sta Find4Me inc Find4Me ; always SelLevel +1 jsr NxtItem ; look ahead for the first one 12$: cpw A0,EndOData beq 15$ ldy #0 lda (A0),y ; grab the code, please beq 15$ ; a Zero is universal end cmp Find4Me ; now compare it to our look4 beq 14$ ; either we find one blt 15$ ; or the end end (look4 > x > 20) 13$: jsr NxtItem bra 12$ ; always returns a menu coder 14$: mvw A0,Temp ldb PlusType,#$80 ; VERTICAL bra 13$ 15$: mvw A0,NextHere ; next one is before the end mvw Temp,A0 ; and restore the Last Item cwi SelItem,#0 beq 16$ ; final top level adjustments cbi SelLevel,#21 bne 17$ ldb PlusType,# $80 ; VERTICAL 0P0 bne 17$ 16$: ldb PlusType,# $40 ; HORZONTAL 17$: rts Qk0P0 PutAClk: ldw A5,#PlusBox jsr SvDims ; save for posteri0P0 PutAClk: ldw A5,#PlusBox jsr SvDims ; save for posterity jsr i_WSetClick .word 0 ; no execution routine, please .byte 2 ; set the first click ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK lda #$ff jsr FrameRectangle ; draw the damn thing jsr PutAMid svw #5,R3 avw #5,R4 mvb R11L,R11H lda #0 sec jsr DrawLine ; horiZontal line drawn jsr PutAMid svb #4,R11L avb #4,R11H mvw R3,R4 lda #0 sec jsr DrawLine ; vertical line drawn rts PutAMid: mvw PlusBox,R11 mvw PlusBox+2,R3 mvw PlusBox+4,R4 ; reget the box for a line 16$: cpw R3,R4 bge 17$ inw R3 dew R4 bra 16$ 17$: cpb R11L,R11H bge 18$ inc R11L dec R11H bra 17$ 18$: rts Np0P0 FstItem: ldw A0,#DataStart  cpw A0,End0P0 FstItem: ldw A0,#DataStart  cpw A0,EndOData ; if starts at end, forget it 0P0 beq 10$  ldy #0 ; otherwise, see if its good lda (A0),y cmp #20 ; a non-code is useless ble NxtItem cmp #49 bgt NxtItem ; >49 is a non-code too 10$: rts  NxtItem: cpw A0,EndOData 0P0 blt 10$ rts 10$: ldy #2 ; get this items length lda (A0),y sta NextTmp iny lda (A0),y ; and store it in NxtTmp sta NextTmp+1 adw NextTmp,A0 ; add it to A0 ldy #0 lda (A0),y cmp #20 ; a non-code is useless ble NxtItem cmp #49 bgt NxtItem ; >49 is a non-code too rts PrvItem: mvw A0,WorkTxt+96 ; one looked for cwi A0,#DataStart ; cant find one before first beq 15$ ldw A0,#DataStart 10$: cpw A0,EndOData ; dont go beyond the end bge 15$ ldy #2 lda (A0),y ; get the skip bytes this one sta NextTmp iny lda (A0),y sta NextTmp+1 adw A0,NextTmp ; put one after in NextTmp cpw NextTmp,WorkTxt+96 ; see if one after is one looked 4 beq 14$ ; A0 still has one before mvw NextTmp,A0 ; nope, so put in next and keep bra 10$ ; going... 14$ ldy #0 ; now see if it is a menu code lda (A0),y cmp #20 ; a non-code is useless ble PrvItem cmp #49 bgt PrvItem ; >49 is a non-code too 15$: rts iq0P0 PrepS: ldb StackX,#0 rts PushS: ldx StackX lda A5L sta Stack,x inx lda A5H sta Stack,x inc StackX inc StackX rts PullS: ldx StackX bne 10$ rts 10$: dec StackX dec StackX ldx StackX lda Stack,x sta A5L 0P0 PrepS: ldb StackX,#0 rts PushS: ldx StackX lda A5L sta Stack,x inx lda A5H sta Stack,x inc StackX inc StackX rts PullS: ldx StackX bne 10$ rts 10$: dec StackX dec StackX ldx StackX lda Stack,x sta A5L inx lda Stack,x sta A5H rts 0v0P0 DelSelItem: cwi SelItem,#0 ; is anything selected? bne 10$ 99$: jsr i_ChkClick ; nope, nothing to do .byte 3 jmp InvertRectangle 10$: mvw SelItem,A0 ; is it a menu? check.. ldy #1 lda (A0)0P0 DelSelItem: cwi SelItem,#0 ; is anything selected? bne 10$ 99$: jsr i_ChkClick ; nope, nothing to do .byte 3 jmp InvertRectangle 10$: mvw SelItem,A0 ; is it a menu? check.. ldy #1 lda (A0),y cmp #$00 ; MENU_ACTION beq 12$ ; if not, put up a yes/no box ldw A2,#DELBOX  jsr YNBox cbi sysDBData,#3 ; confirm the procedure  bne 99$ ; NO, so exit.. 12$: ldy #0 lda (A0),y sta AdjCod ; store its code, for redraw jsr GetWidth ldw AdjAmt,#14 ; assume a up/down vertical adj cbi AdjCod,#21 bne 14$ ; always delete this one mvw Temp,AdjAmt ; if horiZontal, use the width bra 14$ ; always delete THIS one 13$: cpw A0,EndOData beq 17$ ; if at the end, then done ldy #0 lda (A0),y ; look at this ones code cmp AdjCod blt 17$ ; if at higher level, done beq 15$ ; if at same level, more work... 14$: ldw RoomTmp,#0 ; the destination is ME! ldy #2 lda (A0),y sta Temp+7 ; get this items length iny lda (A0),y ; so that we point to the new one sta Temp+8 mvw A0,Temp+5 jsr CapBack ; now delete it mvw Temp+5,A0 bra 13$ ; go back for more 15$: ldb AdjTyp,#0 ; set subtract adjustment jsr CelAdjust 17$: jmp DelDone DELBOX: .byte $18,"Delete this menu set?",27,0 3z0P0 DelDone: mvw Sel0P0 DelDone: mvw SelPapy,A0 ; check for papy status cwi A0,#0 beq 17$ ; if no papy, go bye bye cbi SelLevel,#20 ble 17$ ; if sel level is off, so are you 14$: jsr NxtItem ; a papy, so look at next cpw A0,EndOData ; have we reached the end? beq 16$ ldy #0 lda (A0),y ; get next item's code cmp SelLevel ; have we found a brother? beq 17$ ; yes, so don't convert! 16$: mvw SelPapy,A0 ; restore papy pointer  ldy #1 ; no, so convert to an action 0P0 lda #$00 ; MENU_ACTION sta (A0),y 17$: jsr USelThis ; DONE. Unselect this item jsr ClrBottom ; clear extraneous stuff cbi AdjCod,#21 bne 18$ ; if not a top level, dont redraw jsr ClrTop ; clear whole top level jsr DrawTop ; redraw the top level 18$: cwi SelPapy,#0 beq 19$ ; if no papy, go bye bye mvw SelPapy,A0 ; select my papy if ok jsr SelThisI jsr PutAPlus ; put the plus mark back 19$: jsr i_ChkClick ; now unhighlight the del button .byte 3 ; all done, bye bye now jmp InvertRectangle 3|0P0 CelAdjust: cpw A0,EndOData bne 11$ ; if at end, then done 10$: ldb SaveFlag,#1 rts 11$: ldy #0 lda (A0),y ; now check this ones code cmp AdjCod blt 10$ ; if reached higher level, done jsr LoadR2 lda AdjTyp0P0 CelAdjust: cpw A0,EndOData bne 11$ ; if at end, then done 10$: ldb SaveFlag,#1 rts 11$: ldy #0 lda (A0),y ; now check this ones code cmp AdjCod blt 10$ ; if reached higher level, done jsr LoadR2 lda AdjTyp bne 14$ cbi AdjCod,#21 ; is it top level? bne 12$ ; if yes, adjust differently sbw AdjAmt,R3 sbw AdjAmt,R4 ; move top levels left bra 13$ 12$: sbb AdjAmt,R2L sbb AdjAmt,R2H ; pull lower level siblings, UP 13$: jsr SaveR2 ; put R2 back into table  jsr NxtItem ; look at what's next jmp CelAdjust ; and go back for more 14$: cbi AdjCod,#21 ; is it top level? bne 15$ ; if yes, adjust differently adw AdjAmt,R3 adw AdjAmt,R4 ; move top levels right bra 13$ 15$: adb AdjAmt,R2L adb AdjAmt,R2H ; push lower level siblings, down? bra 13$ h0P0 MyBrother: cpw A0,EndOData ; reached the end? bad! bge 11$ ldy #0 ; get its code lda (A0),y sta Temp 10$: jsr NxtItem ; go to the next cpw A0,EndOData ; reached the end? bad! 0P0 MyBrother: cpw A0,EndOData ; reached the end? bad! bge 11$ ldy #0 ; get its code lda (A0),y sta Temp 10$: jsr NxtItem ; go to the next cpw A0,EndOData ; reached the end? bad! blt 12$ 11$: ldx #$ff ; return a NO SIR rts 12$: ldy #0 ; keep a lookin lda (A0),y cmp Temp bne 10$ ; if its not one, keep looking rts ; kaplah! GetWidth: jsr LoadR2 sbw R3,R4 ; subtract left from/to right mvw R4,Temp ; and save it in Temp rts !0i0P  EdtCon0P  EdtCon: A "ai0P  DelCon: B #i0P0 .ramsect =i>iA-j 0P  DelCon: B #i0P0 .ramsect =i>iA-j    p Bj0P0 .ramsect ;***** Stack variables Stack: .block 50 ; THE stack StackX: .block 1 CurrOne: .block 2 ;***** Temporary storage RoomTmp: .block 2 ; byte total for gimmi room WorkTxt: .block 100 ; work text area SaveReg: .block 10 ; A0, ...  TableTmp: .block 7 ; block storage for tabLd,tabSv its not one, keep looking rts ; kaplah! GetWidth: jsr LoadR2 sbw R3,R4 ; subtract left from/to right mvw R4,Temp ; and save it in Temp rts veR2 ; put R2 back into table  jsr Nx0P0 ;***** For EditBox work AdjCod: .block 1 ; adjust code, horiZontal or vert AdjTyp: .block 1 ; how to adjust, 0=s, N=a AdjAmt: .block 2 ; amount to adjust cells byroom WorkTxt: .block 100 ; work text area  SaveReg: .bloc>iA-j    p Bj0{6͙6͙36͙x Mid: mvwA-j    p Bj0{6͙6͙36͙x Mid: mvw PlusBox,R11 mvw PlusBox+2,R3     p Bj0{6͙6͙36͙x Mid: mvw PlusBox,R11 mvw PlusBox+2,R3 mvw PlusBox+4,R4 ; reget the box0{6͙6͙36͙x Mid: mvw PlusBox,R11 mvw PlusBox+2,R3 mvw PlusBox+4,R4 ; reget the box for a line 16$: cpw R3,R4 bge 17$ inw R3 dew R4 bra 16$ 17$: cpb R11L,R11H bge 18$ incS/geoBMode3)5PRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V&4sRNtMZZZZ\Z0P ;****************************** ;* ;*  geoBEAVER ;* "Bo's Excellent Assembly ;* Visual Editor Resource" ;* ;* (C) 1998 Bo Zimmerman  ;* S/geoBMode3 0P;* Main, unwraps ;******************************  .if Pass1  .noeqin .noglbl  .include GEOSequates .eqin .glbl .endif .psect  jmp Main3 ; VPRGbase + 0 jmp Mod3Click ; VPRGbase + 3 jmp Mod3Recv ; VPRGbase + 6 jmp Mod3Drag ; VPRGbase + 9 jmp Mod3Press ; VPRGbase + 12 jmp ReMain3 ; VPRGbase + 15 .word SelPapy RenWkFile ; VPRGbase + 21 jmp DlgBox ; VPRGbase + 24 in ramsect S/geoBExport.rel S/geoBExporS.rel S/geoBExporM.rel S/geoBExporD.rel MODgeoWx.rel .mod 4 .psect VPRGbase ; end of main rams0P0 Main3: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK ldb Tool,#2 ; selection tool is default ldb FilPattern,#1 ; default pattern is filled ldb LbxPattern,#$ff; default pattern for line boxes ldb TxtPattern,#0 ; default text pattern ReMain3: jsr Crsr3Off ; kill the little blinker jsr ReDialog jsr UnWrap jsr ReClick jsr ReTool lda MenuMode ; has menu been initialiZed? bne 10$ inc MenuMode ; no, so initialiZe it ldw R0,#MyMenu lda #0 jsr DoMenu ; set up the pull-down windows bra 11$ ; and skip a redo 10$: jsr ReDoMenu 11$: mvb mouseOn,MenuSave ; save menu checking ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK rts  Amt,R3 adw AdjAmt,R4 ; move top levels right bra 13$ 15$: adb AdjAmt,R2L adb AdjAmt,R2H ; push l0P0 ReDialog: ldw A0,#DataStart 10$: ldy #0 lda (A0),y ; look for dialog def cmp #51 beq 12$ jsr NxtItem ; not it, so go next cpw A0,EndOData blt 10$ ldy #0 11$: lda DiaT1,y ; none found, so add one sta (A0),y iny cpy #12 blt 11$ ldb SaveFlag,#$01 ; dirty up after the add avw #13,EndOData ; and adjust the end 12$: mvw A0,DlgPtr ; now write the dimensions ldy #4 13$: lda (A0),y sta DlgDims-4,y ; by using that nice little table iny cpy #10 blt 13$ mvw DlgDims,DlgByts mvw DlgDims+3,DlgByts+2 ldw A4,#DlgByts jsr RORING ldw A4,#DlgByts+2 jsr RORING avw #1,DlgByts avw #1,DlgByts+2 rts DiaT1: .byte 51,1,13,0,64,0,32,255,0,127,0,0,0 RORING: ldy #1 lda (A4),y ; start division body lsr a sta (A4),y dey lda (A4),y ror a lsr a lsr a clc adc #1 ; and add one? sta (A4),y iny lda (A4),y adc #0 sta (A4),y rts 0P0 ReTool: ldb dispBufferOn,#ST_WR_FORE jsr i_BitmapUp .word Mod3Bar .byte 0 .byte 20 .byte Bar3wid .byte Bar3hit mvb Tool,A2L jsr ChkClick ; to get Tools dims jsr InvertRectangle ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK rts  NxtItem: cpw A0,EndOData bne 10$ rts 10$: ldy #2 lda (A0),y sta NextTmp iny lda (A0),y sta NextTmp+1 adw NextTmp,A0 rts   ; finish the top 12 ldb A4L,#31 ldw A5,#0 mvb Temp,A6L ; this is dialog jsr SetClick avb #160P0 ReClick: ldb A2L,#20 ldb A2H,#20+16 ; init first box ldw A3,#0 ldw A4,#15 ldb Temp,#1 10$: ldw A5,#0 mvb Temp,A6L jsr SetClick lda A3L ; are we on the left bne 11$ ldb A3L,#16 ; yes, so move to the right ldb A4L,#31 bra 12$ ; stay on same row, height 11$: ldb A3L,#0 ldb A4L,#15 ; down a row, please avb #16,A2L avb #16,A2H 12$: inc Temp cbi Temp,#13 blt 10$ ; finish the top 12 ldb A4L,#31 ldw A5,#0 mvb Temp,A6L ; this is dialog jsr SetClick avb #16,A2L avb #16,A2H ldw A5,#0 ldb A6L,#14 ; this is undo jsr SetClick rts UnClick: ldb Temp,#0 sta A2L sta A2H sta A3L sta A3H sta A4L sta A4H sta A5L sta A5H 10$: lda Temp sta A6L jsr SetClick inc Temp cbi Temp,#15 blt 10$ rts  0P0 UnWrap: mvw rightMargin,UnWr1  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK jsr i_GraphicsString .byte NEWPATTERN,0 .byte MOVEPENTO,0,0,0 .byte RECTANGLETO UnWr1: .word 319 .byte 199 .byte 0 ; done clearing screen jsr ReDialog mvw DlgPtr,A0 ; do the dialog box by hand ldy #1 lda (A0),y ; get the pattern jsr SetPattern ; and set it, dammit jsr LdDialog lda #$ff ; assume the box is clear jsr FrameRectangle ; outline it first jsr LdDialog mvw R4,R3 ; make the right the left avw #9,R4 ; move the right right avb #8,R2L avb #8,R2H jsr Rectangle ; draw the right shadow jsr LdDialog mvb R2H,R2L ; make the bottom the top avw #9,R4 ; move the right right avw #8,R3 avb #8,R2H jsr Rectangle ; now it's done!, yea!  ldw A0,#DataStart jsr UnWrpLp1 ldw A0,#DataStart jmp UnWrpLp2 LdDialog: mvw DlgDims,R3 mvb DlgDims+2,R2L mvw DlgDims+3,R4 mvb DlgDims+5,R2H rts _ChkClick ; now unhighlight the del button .byte 3 ; all done, bye bye now jmp InvertRec0P0 UnWrpLp1: jsr UnWrpNx bne 10$ rts ; all done 10$: cmp #60 ; is it line, linebox, or fbox? blt 15$ cmp #62 ; 60=line, 61=linebox, 62=fbox bgt 15$ jsr UnWrBox ; get R2-R4 lda Temp+3 ; now get command back cmp #60 ; do a simple line please bne 13$ mvw R2,R11 ; put y in right place lda #0 sec jsr DrawLine ; draw the damn line jmp UnWrapDo 13$: cmp #61 ; unwrap a lined box please bne 14$ mvb Temp+4,LbxPattern lda LbxPattern ; set this funny number up jsr FrameRectangle jmp UnWrapDo 14$: cmp #62 ; do a filled box please bne 15$ mvb Temp+4,FilPattern jsr SetPattern ; set the fill box pattern jsr Rectangle jmp UnWrapDo 15$: cmp #53 ; do some text please bne 16$ jsr UnWrBox ; get R2-R4 -- for what its worth jsr StdDlgAd mvb Temp+4,TxtPattern jsr UnWrTxt jmp UnWrapDo 16$: cmp #63 ; is it bitmap of some sort? bne 17$ jsr UnWrBox mvw R3,R1 mvb R4L,R2H ; get bytes in right place mvw A0,R0 avw #8,R0 jsr BitmapUp ; put it on the screen! jmp UnWrapDo 17$: cmp #54 bne 18$ mvw A0, Mod3IFlg jsr Crsr3On jmp UnWrapDo ; don't unwrap clickboxes yet (top) 18$: cmp #56 bne 19$ jsr DrawFBox jmp UnWrapDo 19$: cmp #58 bne 99$ jsr UnWrVar 99$: jmp UnWrapDo UnWrapDo: adw Temp,A0 ; get ready for next command lda #0 sta $2e ; always make sure text patt ok jmp UnWrpLp1 StdDlgAd: adb DlgDims+2,R2L adb DlgDims+2,R2H adw DlgDims,R3 ; adjust for movement adw DlgDims,R4 rts 17$: rts ; but has set values rts 11$: cwi A0,#DataStart bgt 0P0 UnWrpLp2: jsr UnWrpNx ; now unwrap user click boxes beq 99$ cmp #59 beq 10$ cmp #52 beq 10$ adw Temp,A0 ; get ready for next command jmp UnWrpLp2 99$: rts ; all done 10$: jsr UnWrBox mvw R3,R1 adb DlgByts,R1L ; get actual x by adding dlg left adb DlgDims+2,R1H ; get actual y by adding dlg top mvb R4L,R2H ; get bytes in right place cbi Temp+3,#59 beq 11$ lda Temp+4 ; get user icon type asl a tay lda SysBoxT,y sta R0L ; now get sys box address iny lda SysBoxT,y sta R0H bne 12$ 11$: mvw A0,R0 avw #8,R0 12$: jsr BitmapUp ; put it on the screen! adw Temp,A0 ; get ready for next command jmp UnWrpLp2 UnWrTxt: lda TxtPattern sta $2e ; set the fill box pattern mvw R3,R11 mvb R2H,R1H ; position the cursor svb #2,R1H ; underline adjustment mvw A0,R0 avw #10,R0 jsr PutString ; write out the text!! lda #0 sta $2e rts UnWrVar: jsr UnWrBox jsr StdDlgAdj mvw R3,R11 mvb R2H,R1H ; position the cursor svb #2,R1H ; underline adjustment ldw R0,#VarStr jsr PutString ; write out the text!! rts VarStr: .byte 27,25,"?",27,0 SysBoxT: .word $0000,OKpic,CANpic,YESpic,NOpic,OPENpic,DISKpic jsr DrawFBox jmp UnWrapDo 19$: cmp #58 bne 99$ jsr UnWrVar 99$: jmp UnWrapDo UnWrapDo: adw Temp,A0 ; get ready 0P0 UnWrapGet: lda (A0),y iny rts UnWrBox: ldy #4 jsr UnWrapGet ; get start x lsb sta R3L jsr UnWrapGet ; get start x hsb sta R3H jsr UnWrapGet ; get start y sta R2L jsr UnWrapGet ; get end x lsb sta R4L jsr UnWrapGet ; get end x hsb sta R4H jsr UnWrapGet ; get end y sta R2H rts UnWrpNx: cpw A0,EndOData ; out of data yet? blt 11$ lda #0 rts ; nothing to do, exit 11$: ldy #1 lda (A0),y ; set the pattern first sta Temp+4 ; the temp place for patterns ldy #2 ; then get bytes lsb lda (A0),y sta Temp iny lda (A0),y ; then bytes hsb sta Temp+1 ldy #0 lda (A0),y ; now get command sta Temp+3 rts WrTxt: lda TxtPattern sta $2e ; set the fill box pattern mvw R3,R11 mvb R2H,R1H ; position the cur0P0 Mod3Patt: `@ Patt3wid = picW Patt3hit = picH sr UnWrapGet ; get start x lsb sta R3L jsr UnWrapGet ; get start x hsb sta R3H jsr UnWrapGet ; get start y sta R2L jsr UnWrapGet ; get end x lsb sta R4L jsr UnWrapG0P0 Mod3Bar: A Bar3wid = picW Bar3hit = picH  sr UnWrapGet ; get start x lsb sta R3L jsr UnWrapGet ; get start x hsb sta R3H jsr UnWrapGet ; get start y sta R2L jsr UnWrapGet ; get end x lsb sta R4L jsr UnWrapG0P0 OKpic: B CANpic: C YESpic: D NOpic: E OPENpic: F DISKpic: G Gipic: F DISKpic: Gic: D NOpic: E OPENpic: F DISKpic: G3L jsr UnWrapGet ; get start x hsb sta R3H jsr 0P  .ramsect  TTemp: .block 40 ; temporary string holders NTemp: .block 40 ; temporary name storage  Kpic: Gic: D NOpic: E OPENpic: F DISKpic: G3L jsr UnWrapGet ; get start x hsb sta R3H jsr `ꪪ UUVffo؀ꪪffoUUY ؀ꪪUUVffo؀ꪪffoUUP؀ꪪ UUVffoס؀ꪪffoUUY ww`""]""=ww`""]興wwww`""]""=ww`""]興wwww`""]""=ww`""]興wwUUD"UUH!UUP xUU` @@_߆UU@` ?UU@UUA(UUB$UUD"UUH!UUP xUU` @@_߃""B 4""B 8 ""B 0 *""(""B"ppxPPX""B"""B" ? ""(""B 4""B 8 ""B 0 *""($!!(@1P* 00>8h(($ \\X @$@$ ȂA*  B$!!(@1P* 00>8h(($ \\X 8 U`@@P؂BAAN&&(A1QQR"".>>8*"".>>8 U""-ؠ h(""*bbhP0 8 U`@@P؂BAAN&&(A1QQR"".>>8„UU`„訨PP` "&t S)D D` htPP`(D訨(DUU`'w„訨„PP` @A0 8 U`@@P؂BAAN&&(A1QQR"".>>8„UU`„訨PP` "&t S)D D` htPP`(D  A!   Y Y Yuuuu ͢͢ u``gl۶l۶lۼg    ||f͙f͙f͙f|@ `ccc|ycfcf͘cfcfcf͘>|y``  0͛`̓` 0 S/geoBMode3bc ;wPRG formatted GEOS file V1.0AWrite Image V2.0geoWrite V2.1  ...݅ ( >1 59 ..  9 < <` " . r " `(@1ʎsAڢ9 V& &qpT@}:07IN[^0P ;****************************** ;* S/geoBMode3b ;* Click, main drags, creates ;******************************  .if Pass1  .noeqin .noglbl  .include GEOSequates .eqin .glbl .endif sect quates .endif  .psec0P0 .psect  Mod3Click: cbi mouseData,#0 ; is the button down or up? beq 11$ cbi DragFlag,#1 ; need to permaniZe? bne 10$ ldb DragFlag,#2  ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  ldw A5,#SelBox ; set up old dimensions for all ops jsr SelLoad jsr RecoverRectangle ; first undo the old box jsr Mod3Drag ; make it permanent! 10$: ldb DragFlag,#0 ; clear the drag flag rts ; button is released 11$: ldb A2L,#1 ; start to check buttons, from 1 12$: jsr ChkClick ; check the main buttons cpx #0 beq 16$ ; found a click! inc A2L cbi A2L,#14 ; until 14, keep checking... ble 12$ ; no button pressed, so in screen? 90$: jsr LdDialog jsr IsMseInRegion ; not full screen, so check area cmp #$ff bne 10$ ; it's outside protected area, so exit 13$: cbi Tool,#12 ; do not set drag mode for non-tools bge 15$ cmp #2 ; the select tool is a special case bne 14$ jmp SelClick ; handle clicks for selection specially 14$: ldb DragFlag,#1 ; you can set the drag flag mvw mouseXPos,DragX mvb mouseYPos,DragX+2 ; save drag start ldw DragX2,#0 ldb DragX2+2,#$ff ; init old drag point 15$: ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  rts ; nothing doin 16$: cpb A2L,Tool beq 15$ ; don't bother selected tool cbi A2L,#12 blt 18$ ; only 1-11 are REAL tools bne 17$ ; do a quick patt butt check cbi Tool,#2 ; is selection tool selected? bne 17$ jmp PattEdit ; do selected patts now, please 17$: ldb dispBufferOn,#ST_WR_FORE  mvb A2L,Temp jsr ChkClick ; invert the pseudo-tool jsr InvertRectangle jmp Mod3ClkO ; and handle it (undo, dialog, etc) 18$: jsr ClrSelect ; clear selection just in case  ldb dispBufferOn,#ST_WR_FORE mvb A2L,Temp ; temporarily save new tool mvb Tool,A2L ; and restore old tool to uninvert jsr ChkClick ; to get R2-R4 jsr InvertRectangle ; to uninvert old tool mvb Temp,Tool ; now permaniZe the new tool mvb Tool,A2L ; and set up to invert it... jsr ChkClick ; to get R2-R4 jsr InvertRectangle ; to invert new tool ldb dispBufferOn,#ST_WR_FORE | ST_WR_BACK  rts ts 0P0 Mod3ClkO: cbi Temp,#12 beq 13$ ; the pattern button was chosen cmp #13 bne 14$ ; this is dialog ldw A0,#DataStart 10$: ldy #0 lda (A0),y cmp #51 ; found the dbox? beq 11$ jsr NxtItem cpw A0,EndOData blt 10$ rts 11$: jmp  DlgPatt 0P014$: cmp #14 ; clicked undo? bne 99$ jsr ClrSelect ; select is special for undo jsr UnDo 99$: rts ;** here begins the pattern box button stuff 13$: jmp PattBox eck buttons, from 1 12$: jsr ChkClick ;0P0 UnDo: cwi EndOData,#DataStart ; is there anything in there? beq 10$ jsr FindDLast ; look for the undoable cwi A1,#0 beq 10$ ; nothing found, so don't undo ldw R0,#UnDoDlg jsr DoDlgBox cbi sysDBData,#3 ; confirm the procedure beq 11$ 10$: jmp ReMain3 11$: mvw A1,A0 ; set source adw A3,A0 ; by adding length ldy #0 12$: lda (A0),y sta (A1),y ; copy data over cpw A0,EndOData beq 13$ ; if just wrote the end, stop inw A0 inw A1 ; otherwise, increment and continue bra 12$ 13$: sbw A3,EndOData ; pull back EndOData jsr ClrBuf2End ; Zero out all we've found... ldb SaveFlag,#1 ; set the damn save flag jmp ReMain3 FindDLast: ldw A0,#DataStart ; start at beginning ldw A2,#0 ; with no movement, bytes=A2 ldw A1,#0 ; save the last move 12$: ldy #2 lda (A0),y ; get the supposed bytes L & h sta A2L iny lda (A0),y ; get the supposed bytes l & H sta A2H ldy #0 lda (A0),y cmp #52 blt 13$ cmp #70 bge 13$ mvw A0,A1 ; found one, so save it mvw A2,A3 ; and save its width 13$: adw A2,A0 ; skip ahead = A0 cpw A0,EndOData ; have we reached the end yet? blt 12$ ; no, so keep looping rts ; A1 should point to last now UnDoDlg: .byte $80 | $01 .byte 11 ;add text .byte $0d,$12 .word UDTxtA .byte $03,$01,$47 ;Yes icon .byte $04,$0f,$47 ;No icon .byte 0 ;end of defintion UDTxtA: .byte $18,"Undo last operation?",27,0 lected? bne 17$ jmp PattEdit ; do selected patts now, please 17$: ldb dispBufferOn,#ST_WR_FORE  mvb A2L,Temp jsr ChkClick ; invert 0P0 Mod3Recv: jsr RecoverRectangle jsr ClrSelect ; kinda dangerous!! jmp ReTool Mod3Drag: lda DragFlag ; don't bother if not set bne 89$ rts 89$: mvw mouseXPos,Temp ; save your mousex and y mvb mouseYPos,Temp+2 cbi DragFlag,#2 ; if making permanent... bne 90$ mvw DragX2,Temp mvb DragX2+2,Temp+2 ldb DragX2+2,#$ff ; ensure a write cbi Tool,#2 ; selections don't permaniZe beq 90$ jsr EntryDo ; save the entry in buffer beq 90$ ; leave on an error jmp ReMain3 90$: jsr LdDialog cbi SelCode,#51 ; dialog is code #51 bne 88$ mvw rightMargin,R4 ; and has different limitations mvb windowBottom,R2H ldw R3,#32 ldb R2L,#15 88$: ldy #0 jsr IsMseInRegion ; protect these cmp #$ff beq 91$ ; it's out, so exit rts 91$: jmp DragTols j0P0 DragTols: cbi DragFlag,#2 ; if making permanent... beq 92$ ldb dispBufferOn,#ST_WR_FORE 92$: cbi Tool,#1 ; is it a line? bne 10$ jmp DragLine 10$